You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 

174 lines
5.6 KiB

{
{-|
Module: Lexer.Lexer
Description: Lexer generated by alex
Contains the lexer generated by alex as well as some functions used
to interact with the Alex monad.
-}
{-# LANGUAGE LambdaCase #-}
module Lexer.Lexer
( runAlex'
, alexError'
, alexMonadScan'
, Alex(..)
, liftGetter
, liftSetter
, getPN
, fromPN
) where
import Lens.Micro
import Lexer.Types
import Types
import Error
import Prelude hiding (lex)
import Text.Read (readMaybe)
import Data.Char (isDigit)
}
%wrapper "monadUserState"
$digit = [0-9]
$special = [\[\]\(\)\{\}:_∀λ⇒→]
$ident = $printable # $special # $white
@lambda = λ | "lambda"
@forall = ∀ | "forall"
@imparr = ⇒ | "=>"
@exparr = → | "->"
@escape = \\ $printable
@rawchar = $printable | @escape
@char = ' @rawchar '
@string = \" (@rawchar) * \"
@Npl = $digit+pl
@inttype = ℤ | "Integer"
@typetype = "Type"
@stringtype = "String"
@chartype = "Char"
@lambdacase = λcase | "lambdacase"
tokens :-
$white+ ;
"--".* ;
\( { lex LParen }
\) { lex RParen }
\[ { lex LBracket }
\] { lex RBracket }
\{ { lex LBrace }
\} { lex RBrace }
@lambda { lex Lambda }
@forall { lex Forall }
@imparr { lex ImpArr }
@exparr { lex ExpArr }
@Npl { lexNpl }
@typetype { lex TypeType }
@chartype { lex CharType }
@stringtype { lex StringType }
@inttype { lex IntType }
: { lex Colon }
_ { lex WildCard }
def { lex Def }
case { lex Case }
let { lex Let }
in { lex In }
@lambdacase { lex LambdaCase }
record { lex Record }
data { lex Data }
instance { lex Instance }
def { lex Def }
$digit+ { lexInt }
@char { lexChar }
@string { lexString }
$ident+ { lexIdent }
{
-- | Lift a getter function over our user state
liftGetter :: (AlexUserState -> a) -> Alex a
liftGetter f = f <$> alexGetUserState
-- | Lift a setter function over our user state
liftSetter :: (AlexUserState -> AlexUserState) -> Alex ()
liftSetter f = alexSetUserState =<< f <$> alexGetUserState
-- | Convery from AlexPosn to PN, having to import the lexer module
-- everywhere we want a position is very unideal, this simply serves
-- as a way to remove this dependency.
toPN :: AlexPosn -> PN
toPN (AlexPn o l c) = PN o l c
-- | Convert from PN back to AlexPosn. Needed for use of alexError'
fromPN :: PN -> AlexPosn
fromPN (PN o l c) = AlexPn o l c
-- | Gets the current position
getPN :: Alex PN
getPN = Alex $ \s -> Right (s, toPN (alex_pos s))
-- | Creation of end of file token
alexEOF :: Alex Tk
alexEOF = alexGetInput >>= \(p,_,_,_) -> pure (Tk (toPN p) EOF)
-- | Lex a token from a string
lex' :: (String -> TkTp) -> AlexAction Tk
lex' f (p,_,_,s) i = pure $ Tk (toPN p) (f (take i s))
-- | Lex a simple token
lex :: TkTp -> AlexAction Tk
lex = lex' . const
-- | Lex a number
lexInt :: AlexAction Tk
lexInt = lex' (Int . read)
-- | Extract Char from quotes, convert escape code to char.
lexChar :: AlexAction Tk
lexChar (p,_,_,s) i = let char = take i s in case readMaybe char of
Nothing -> alexError' p ("Unable to lex literal character " <> char)
Just c -> pure $ Tk (toPN p) (Char c)
-- | Extract String from quotes.
lexString :: AlexAction Tk
lexString (p,_,_,s) i = let str = take i s in case readMaybe str of
Nothing -> alexError' p ("Unable to lex literal string " <> str)
Just s' -> pure $ Tk (toPN p) (String s')
-- | Lex an identifier
lexIdent :: AlexAction Tk
lexIdent = lex' (Identifier . Id)
-- | Lex a Npl
lexNpl :: AlexAction Tk
lexNpl (p,_,_,s) i = let str = take i s in case readMaybe (takeWhile isDigit str) of
Nothing -> alexError' p ("Unable to lex Npl " <> s)
Just n -> pure $ Tk (toPN p) (Npl n)
-- | Lex a token
alexMonadScan' :: Alex Tk
alexMonadScan' = do
inp <- alexGetInput
sc <- alexGetStartCode
case alexScan inp sc of
AlexEOF -> alexEOF
AlexError (p,_,_,s) -> alexError' p ("lexing error at character '" <> (show (head s)) <> "'")
AlexSkip inp' _ -> alexSetInput inp' >> alexMonadScan'
AlexToken inp' len action -> alexSetInput inp' >> action (ignorePendingBytes inp) len
-- | Return a pretty, formatted error string
alexError' :: AlexPosn -> String -> Alex a
alexError' p msg = do
fp <- liftGetter (^. filePath)
tx <- liftGetter (^. fileText)
alexError $ errorMessage (toPN p) fp tx msg
-- | Parse input given a parser which operates on the Alex monad, a filepath and file contents
runAlex' :: Alex a -> FilePath -> String -> Either String a
runAlex' a fp input = runAlex input (liftSetter ((filePath .~ fp) . (fileText .~ input)) >> a)
}