Commit b47f401b authored by matthew-eads's avatar matthew-eads
Browse files

modest fixes to lexer generation

parent 940bc5a5
......@@ -9,7 +9,8 @@ data Exp = SET ID Exp
| IF SimpleExp Exp (Maybe Exp) --> if
| WHILE SimpleExp Exp --> while
| BEGIN (List1 Exp)
| LET [(String, Exp)] Exp deriving Show
| LET [(String, Exp)] Exp
| SIMPLE SimpleExp deriving Show
data BinOp = Plus SimpleExp SimpleExp --> infix +
| Mult SimpleExp SimpleExp --> infix *
......@@ -25,4 +26,4 @@ data SimpleExp = Lit Int
-- | ASet SimpleExp SimpleExp SimpleExp --(set arr[i] j)
-- | AMake ID SimpleExp --(new arr size)
data Dec = Val ID Exp deriving Show
\ No newline at end of file
data Dec = Val ID Exp deriving Show
......@@ -16,6 +16,7 @@ import Text.Regex
import Data.List.Unique
import Data.List
import Data.List.Split
import Data.Char
import FileStrings (makeParser, makeLexer)
type Directive = String
......@@ -149,17 +150,17 @@ rhsToRule rules =
[s])
"if" -> if length ts == 2
then ("IF " ++ (head ts) ++ " \"THEN\" " ++ (head (tail ts))
++ (rrhsL s [2,4]), ["IF", "THEN"])
++ (rrhsL s [2,4]), ["if", "then"])
else if length ts == 3
then ("IF " ++ (head ts) ++ " THEN " ++ (head (tail ts))
++ " ELSE " ++ (head (tail (tail ts))) ++ (rrhsL s [2,4,6]), ["IF", "THEN", "ELSE"])
++ " ELSE " ++ (head (tail (tail ts))) ++ (rrhsL s [2,4,6]), ["if", "then", "else"])
else error "bad number of constructions for if rule"
"ifelse" -> if length ts == 3
then ("if " ++ (head ts) ++ " then " ++ (head (tail ts))
++ " else " ++ (head (tail (tail ts))) ++ (rrhsL s [2,4,6]), ["IF", "THEN", "ELSE"])
++ " else " ++ (head (tail (tail ts))) ++ (rrhsL s [2,4,6]), ["if", "then", "else"])
else error "bad number of constructions for if rule"
"while" -> ("WHILE LPAREN " ++ (head ts) ++ " RPAREN LBRACE " ++ (head (tail ts))
++ " RBRACE" ++ (rrhsL s [3, 6]), ["WHILE"])
++ " RBRACE" ++ (rrhsL s [3, 6]), ["while"])
('i':'n':'f':'i':'x':rest) ->
let op = cleanWS rest
(op', t) = if op == "" then (" "++s++" ", [s]) else
......
......@@ -34,14 +34,61 @@ makeParser name tokes grammar ast =
"parseError t = error (\"Parse Error on token(s) \" ++ (show t))\n\n" ++
"}\n"
tokenToSym :: String -> String
tokenToSym "SET" = "set"
tokenToSym "IF" = "if"
tokenToSym "THEN" = "then"
tokenToSym "ELSE" = "else"
tokenToSym "WHILE" = "while"
tokenToSym "BEGIN" = "begin"
tokenToSym "LPAREN" = "("
tokenToSym "RPAREN" = ")"
tokenToSym "LT" = "<"
tokenToSym "GT" = ">"
tokenToSym "LE" = "<="
tokenToSym "GE" = ">="
tokenToSym "BANG" = "!"
tokenToSym "AT" = "@"
tokenToSym "POUND" = "#"
tokenToSym "DOLLAR" = "$"
tokenToSym "PERCENT" = "%"
tokenToSym "CARAT" = "^"
tokenToSym "AMPERSAND" = "&"
tokenToSym "STAR" = "*"
tokenToSym "DASH" = "-"
tokenToSym "UNDERSCORE" = "_"
tokenToSym "PLUS" = "+"
tokenToSym "EQ" = "="
tokenToSym "LBRACE" = "{"
tokenToSym "RBRACE" = "}"
tokenToSym "LBRACK" = "["
tokenToSym "RBRACK" = "]"
tokenToSym "FSLASH" = "/"
tokenToSym "BSLASH" = "\\"
tokenToSym "SEMICOLON" = ";"
tokenToSym "COLON" = ":"
tokenToSym "DOUBLEQUOTE" = "\\\""
tokenToSym "SINGLEQUOTE" = "\'"
tokenToSym "COMMA" = ","
tokenToSym "PERIOD" = "."
tokenToSym "QUESTION" = "?"
tokenToSym "TILDA" = "~"
tokenToSym "TICK" = "`"
tokenToSym "BAR" = "|"
tokenToSym s = s
defaultTokens :: [String]
defaultTokens = ["SET ", "IF", "THEN", "ELSE", "WHILE", "BEGIN", "LPAREN", "RPAREN", "LT", "GT", "LE", "GE", "BANG", "AT", "POUND", "DOLLAR", "PERCENT", "CARAT", "AMPERSAND", "STAR", "DASH", "UNDERSCORE", "PLUS", "EQ", "LBRACE", "RBRACE", "LBRACK", "RBRACK", "FSLASH", "BSLASH", "SEMICOLON", "COLON", "DOUBLEQUOTE", "SINGLEQUOTE", "COMMA", "PERIOD", "QUESTION", "TILDA", "TICK", "BAR"]
makeLexer :: String -> [String] -> String
makeLexer name tokes =
let f = \x -> if null x then x else (map toUpper x)
tokenRules = cleanNLs $ foldr (\t a ->
"<0> " ++ '"':t ++ "\"\t{ \\(pos,_,_,inp) len -> return Token"
++ (map toUpper t) ++ " :: Alex Token }\n" ++ a) "" tokes
"<0> " ++ '"':(tokenToSym t) ++ "\"\t{ \\(pos,_,_,inp) len -> return Token"
++ (map toUpper t) ++ " :: Alex Token }\n" ++ a) "" (nub (tokes ++ defaultTokens))
dataRules = cleanNLs $ foldr (\t a -> "\t| Token" ++ (map toUpper t)
++ "\n" ++ a) "" (nub (map f (tokes ++ ["SET ", "IF", "THEN", "ELSE", "WHILE", "BEGIN", "VAR", "EOF ", "NL", "LPAREN", "RPAREN", "LT", "GT", "LE", "GE", "BANG", "AT", "POUND", "DOLLAR", "PERCENT", "CARAT", "AMPERSAND", "STAR", "DASH", "UNDERSCORE", "PLUS", "EQ", "LBRACE", "RBRACE", "LBRACK", "RBRACK", "FSLASH", "BSLASH", "SEMICOLON", "COLON", "DOUBLEQUOTE", "SINGLEQUOTE", "COMMA", "PERIOD", "QUESTION", "TILDA", "TICK", "BAR"])))
++ "\n" ++ a) "" (nub (map f (tokes ++ defaultTokens )))
in ("{\nmodule " ++ name ++ "Lexer (runLexer, Token (..)) where\n" ++
"import Debug.Trace\n}\n\n" ++
......@@ -59,8 +106,10 @@ makeLexer name tokes =
":-\n\n" ++
"<0> @integer { \\(pos,_,_,inp) len -> return $ TokenINT (read (take len inp)) }\n" ++
"<0> @string { \\(pos,_,_,inp) len -> return $ TokenSTRING (take len inp) }\n\n" ++
"<0> @identifier { \\(pos,_,_,inp) len -> return $ TokenID (take len inp) }\n\n"
"<0> @identifier { \\(pos,_,_,inp) len -> return $ TokenID (take len inp) }\n\n" ++
"<0> \"\\n\" { \\(pos,_,_,inp) len -> return $ TokenNL :: Alex Token}\n"
++ tokenRules ++
{-
"<0> \"=\"\t { \\(pos,_,_,inp) len -> return $ TokenEQ :: Alex Token}\n" ++
"<0> \"+\" { \\(pos,_,_,inp) len -> return $ TokenPLUS :: Alex Token}\n" ++
"<0> \"-\" { \\(pos,_,_,inp) len -> return $ TokenDASH :: Alex Token}\n" ++
......@@ -71,7 +120,7 @@ makeLexer name tokes =
"<0> \">\" { \\(pos,_,_,inp) len -> return $ TokenGT :: Alex Token}\n" ++
"<0> \"(\" { \\(pos,_,_,inp) len -> return $ TokenLPAREN :: Alex Token}\n" ++
"<0> \")\" { \\(pos,_,_,inp) len -> return $ TokenRPAREN :: Alex Token}\n" ++
"<0> \"\\n\" { \\(pos,_,_,inp) len -> return $ TokenNL :: Alex Token}\n" ++
"<0> set { \\(pos,_,_,inp) len -> return $ TokenSET :: Alex Token}\n" ++
"<0> if { \\(pos,_,_,inp) len -> return $ TokenIF :: Alex Token }\n" ++
"<0> then { \\(pos,_,_,inp) len -> return $ TokenTHEN :: Alex Token }\n" ++
......@@ -104,6 +153,7 @@ makeLexer name tokes =
"<0> \"~\" { \\(pos,_,_,inp) len -> return $ TokenTILDA :: Alex Token }\n" ++
"<0> \"`\" { \\(pos,_,_,inp) len -> return $ TokenTICK :: Alex Token }\n" ++
"<0> \"|\" { \\(pos,_,_,inp) len -> return $ TokenBAR :: Alex Token }\n\n\n" ++
-}
"<0> @comment ;\n" ++
"<0> [\\ \\t \\n]+ ;\n" ++
"<0> \"/*\" { begin comment }\n" ++
......@@ -118,6 +168,8 @@ makeLexer name tokes =
"data Token = TokenID String \n" ++
" | TokenSTRING String \n" ++
" | TokenINT Int \n" ++
" | TokenEOF \n" ++
" | TokenNL \n" ++
dataRules ++
" deriving (Eq, Show)\n\n" ++
"tokens str = runAlex str $ do\n" ++
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment