--
-- file:    Lexer.lhs
--
-- created: 3/12/96 by Andrew Rock.
--
-- purpose: This defines functions for lexing entre sources, be they
--          commands or entire scripts.
--

> module Lexer(lexerL) where

> import Char
> import Parser


This function performs the lexical analysis of any entre source.

> lexerL :: Lexer
> lexerL = (keywords . dropWhite . nofail . total) (listL lexList)

> lexList :: [Lexer]
> lexList = [ commentL,
>             whitespaceL,
>             stringL,
>             cardinalL,
>             nameL,
>             booleanL,
>             tokenL "->"     %> "symbol",
>             tokenL ":="     %> "symbol",
>             tokenL "/="     %> "symbol",
>             tokenL "`div`"  %> "symbol",
>             tokenL "`mod`"  %> "symbol",
>             tokenL "*"      %> "symbol",
>             tokenL "-"      %> "symbol",
>             tokenL "+"      %> "symbol",
>             tokenL "=="     %> "symbol",
>             tokenL "="      %> "symbol",
>             tokenL "("      %> "symbol",
>             tokenL ")"      %> "symbol",
>             tokenL "\\"     %> "symbol",
>             tokenL "||"     %> "symbol",
>             tokenL "&&"     %> "symbol",
>             tokenL ">="     %> "symbol",
>             tokenL ">"      %> "symbol",
>             tokenL "<="     %> "symbol",
>             tokenL "<"      %> "symbol",
>             tokenL ":"      %> "symbol",
>             tokenL "["      %> "symbol",
>             tokenL ","      %> "symbol",
>             tokenL ".."     %> "symbol",
>             tokenL "]"      %> "symbol",
>             tokenL "?"      %> "symbol",
>             tokenL ";"      %> ";"
>           ]

> stringL :: Lexer
> stringL =    literalL '"'
>           *> (many (satisfyL (\c -> c /= '\n' && c /= '"') "") *%> "")
>           <* nofail (literalL '"')
>           %> "string"

> commentL :: Lexer
> commentL =      tokenL "--"
>            <**> (many (satisfyL (/= '\n') "") *%> "")
>            <**> (optional (literalL '\n') *%> "")
>            %> " "

> nameL :: Lexer
> nameL = (satisfyL isLower "lower-case letter"
>          <**> ((many (satisfyL isNameChar "letter, digit, _, '")) *%> "")) %> "name"
>         where
>         isNameChar c = isAlpha c || isDigit c || c == '_' || c == '\''

> booleanL :: Lexer
> booleanL = (tokenL "True" <|> tokenL "False") %> "boolean" 

This is a Lexer modifier that forces the recognition of keywords
which look just like names and have been lexed as such.

> keywords :: Lexer -> Lexer
> keywords = (@> (map keyword))

This changes the tag of any "name" lexeme to "keyword" if the lexeme
is actually one of the keywords.

> keyword :: ((Tag, Lexeme), Pos) -> ((Tag, Lexeme), Pos)
> keyword (("name", lexeme), pos)
>    | lexeme `elem` ks = (("keyword", lexeme), pos)
>    | otherwise        = (("name", lexeme), pos)
> keyword x 
>    = x

This is the list of entre keywords and built-in function names.

> ks :: [Lexeme]
> ks = ["if", "then", "else", "head", "tail", "negate", "not", "abs", "signum",
>       "div", "mod"]