Commit 940bc5a5 authored by matthew-eads's avatar matthew-eads
Browse files

capitalize all the tokens

parent bc551bec
module AST where
type ID = String
data Prog = Prog [AST]
data Prog = Prog [AST] deriving Show
data AST = Expression Exp
| TopLevlDec Dec
| TopLevlDec Dec deriving Show
data Exp = SET ID Exp
| IF SimpleExp Exp (Maybe Exp) --> if
| WHILE SimpleExp Exp --> while
| BEGIN (List1 Exp)
| LET [(String, Exp)] Exp
| LET [(String, Exp)] Exp deriving Show
data BinOp = Plus SimpleExp SimpleExp --> infix "+"
| Mult SimpleExp SimpleExp --> infix "*"
| Div SimpleExp SimpleExp --> infix "/"
| Minus SimpleExp SimpleExp --> infix "-"
| CheckExpect SimpleExp SimpleExp
data BinOp = Plus SimpleExp SimpleExp --> infix +
| Mult SimpleExp SimpleExp --> infix *
| Div SimpleExp SimpleExp --> infix FSLASH
| Minus SimpleExp SimpleExp --> infix DASH
| CheckExpect SimpleExp SimpleExp deriving Show
data SimpleExp =
Lit Int
data SimpleExp = Lit Int
| Var ID
| Apply ID (List0 Exp)
| BinOp BinOp
| BinOp BinOp deriving Show
-- | AGet SimpleExp SimpleExp --(arr[i])
-- | ASet SimpleExp SimpleExp SimpleExp --(set arr[i] j)
-- | AMake ID SimpleExp --(new arr size)
data Dec = Val ID Exp
data Dec = Val ID Exp deriving Show
\ No newline at end of file
......@@ -145,27 +145,28 @@ rhsToRule rules =
(case d of
"" -> if (isUnique rules (RHS' s ts d))
then ((foldr myappend "" ts') ++ (rrhsL s (nums0 (length ts))), [])
else (s ++ " " ++ (foldr myappend "" ts') ++ (rrhsL s (nums1 (length ts))),
else ((map toUpper s) ++ " " ++ (foldr myappend "" ts') ++ (rrhsL s (nums1 (length ts))),
[s])
"if" -> if length ts == 2
then ("if " ++ (head ts) ++ " \"then\" " ++ (head (tail ts))
++ (rrhsL s [2,4]), ["if", "then"])
then ("IF " ++ (head ts) ++ " \"THEN\" " ++ (head (tail ts))
++ (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"])
then ("IF " ++ (head ts) ++ " THEN " ++ (head (tail ts))
++ " 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"])
"while" -> ("WHILE LPAREN " ++ (head ts) ++ " RPAREN LBRACE " ++ (head (tail ts))
++ " RBRACE" ++ (rrhsL s [3, 6]), ["WHILE"])
('i':'n':'f':'i':'x':rest) ->
let op = cleanWS rest
(op', t) = if op == "" then (" "++s++" ", [s]) else
(case op of
"+" -> (" Plus ", ["Plus"])
_ -> (" FSlash ", ["FSlash"]))
"+" -> (" PLUS ", ["PLUS"])
"*" -> (" STAR ", ["STAR"])
_ -> (" "++op++" ", [op]))
in ((head ts) ++ op' ++ (head (tail ts)) ++ (rrhsL s [1,3]), t)
bad -> error ("directive " ++ bad ++ " not supported"))
......@@ -215,7 +216,7 @@ makeRules :: [DecT'] -> (String, [String])
makeRules decs = (foldr (\r (r', ts') ->
let (rule, tokes) = (decTToRule r)
in ((rule ++ "\n" ++ r'), (ts' ++ tokes))) ("",
["LParen", "RParen", "RBrace", "LBrace", "Plus", "Star", "FSlash", "Dash"]) decs)
["LPAREN", "RPAREN", "RBRACE", "LBRACE", "PLUS", "STAR", "FSLASH", "DASH"]) decs)
cleanNLs' :: String -> String
cleanNLs' ('\n':'\n':'\n':s) = cleanNLs' ('\n':'\n':s)
......
......@@ -12,8 +12,8 @@ cleanNLs s = cleanNLs' (dropWhile ((==) '\n') s)
makeParser :: String -> [String] -> String -> String -> String
makeParser name tokes grammar ast =
let tokenRules = cleanNLs $ foldr (\t a -> t
++ " { " ++ "Token" ++ ((toUpper (head t)):(tail t)) ++
let tokenRules = cleanNLs $ foldr (\t a -> (map toUpper t)
++ " { " ++ "Token" ++ (map toUpper t) ++
" }\n" ++ a) "" tokes
in
"{\nmodule " ++ name ++ "Parser where" ++
......@@ -22,9 +22,9 @@ makeParser name tokes grammar ast =
"\n%tokentype { Token }\n" ++
"%token\n" ++
tokenRules ++
"Int { TokenInt $$ }\n" ++
"Int { TokenINT $$ }\n" ++
"ID { TokenID $$ }\n" ++
"String { TokenString $$ }\n" ++
"String { TokenSTRING $$ }\n" ++
"eof { TokenEOF }\n" ++
"nl { TokenNL }\n" ++
"%error {parseError}\n\n%%\n\n" ++
......@@ -36,12 +36,12 @@ makeParser name tokes grammar ast =
makeLexer :: String -> [String] -> String
makeLexer name tokes =
let f = \x -> if null x then x else ((toUpper (head x)):(tail x))
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"
++ ((toUpper (head t)):(tail t)) ++ " :: Alex Token }\n" ++ a) "" tokes
dataRules = cleanNLs $ foldr (\t a -> "\t| Token" ++ ((toUpper (head t)):(tail 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"])))
++ (map toUpper t) ++ " :: Alex Token }\n" ++ a) "" tokes
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"])))
in ("{\nmodule " ++ name ++ "Lexer (runLexer, Token (..)) where\n" ++
"import Debug.Trace\n}\n\n" ++
......@@ -57,53 +57,53 @@ makeLexer name tokes =
"@integer = $digits+\n" ++
"@string = \\\"[^\\\"]*\\\"\n\n\n" ++
":-\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> @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"
++ 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" ++
"<0> \"_\" { \\(pos,_,_,inp) len -> return $ TokenUnderscore :: Alex Token}\n" ++
"<0> \"\\[\" { \\(pos,_,_,inp) len -> return $ TokenLBrack :: Alex Token}\n" ++
"<0> \"\\]\" { \\(pos,_,_,inp) len -> return $ TokenRBrack :: Alex Token}\n" ++
"<0> \";\" { \\(pos,_,_,inp) len -> return $ TokenSemiColon :: Alex Token}\n" ++
"<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" ++
"<0> \"_\" { \\(pos,_,_,inp) len -> return $ TokenUNDERSCORE :: Alex Token}\n" ++
"<0> \"\\[\" { \\(pos,_,_,inp) len -> return $ TokenLBRACK :: Alex Token}\n" ++
"<0> \"\\]\" { \\(pos,_,_,inp) len -> return $ TokenRBRACK :: Alex Token}\n" ++
"<0> \";\" { \\(pos,_,_,inp) len -> return $ TokenSEMICOLON :: Alex Token}\n" ++
"<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> \"(\" { \\(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" ++
"<0> else { \\(pos,_,_,inp) len -> return $ TokenElse :: Alex Token }\n" ++
"<0> while { \\(pos,_,_,inp) len -> return $ TokenWhile :: 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" ++
"<0> else { \\(pos,_,_,inp) len -> return $ TokenELSE :: Alex Token }\n" ++
"<0> while { \\(pos,_,_,inp) len -> return $ TokenWHILE :: Alex Token }\n" ++
"<0> \"<\" { \\(pos,_,_,inp) len -> return $ TokenLT :: Alex Token }\n" ++
"<0> \"<=\" { \\(pos,_,_,inp) len -> return $ TokenLE :: Alex Token }\n" ++
"<0> \">=\" { \\(pos,_,_,inp) len -> return $ TokenGE :: Alex Token }\n" ++
"<0> \"!\" { \\(pos,_,_,inp) len -> return $ TokenBang :: Alex Token }\n" ++
"<0> \"@\" { \\(pos,_,_,inp) len -> return $ TokenAt :: Alex Token }\n" ++
"<0> \"#\" { \\(pos,_,_,inp) len -> return $ TokenPound :: Alex Token }\n" ++
"<0> \"$\" { \\(pos,_,_,inp) len -> return $ TokenDollar :: Alex Token }\n" ++
"<0> \"%\" { \\(pos,_,_,inp) len -> return $ TokenPercent :: Alex Token }\n" ++
"<0> \"^\" { \\(pos,_,_,inp) len -> return $ TokenCarat :: Alex Token }\n" ++
"<0> \"&\" { \\(pos,_,_,inp) len -> return $ TokenAmpersand :: Alex Token }\n" ++
"<0> \"*\" { \\(pos,_,_,inp) len -> return $ TokenStar :: Alex Token }\n" ++
"<0> \"{\" { \\(pos,_,_,inp) len -> return $ TokenLBrace :: Alex Token }\n" ++
"<0> \"}\" { \\(pos,_,_,inp) len -> return $ TokenRBrace :: Alex Token }\n" ++
"<0> \"(\" { \\(pos,_,_,inp) len -> return $ TokenLParen :: Alex Token }\n" ++
"<0> \")\" { \\(pos,_,_,inp) len -> return $ TokenRParen :: Alex Token }\n" ++
"<0> \"?\" { \\(pos,_,_,inp) len -> return $ TokenQuestion :: Alex Token }\n" ++
"<0> \"/\" { \\(pos,_,_,inp) len -> return $ TokenFSlash :: Alex Token }\n" ++
"<0> \"\\\" { \\(pos,_,_,inp) len -> return $ TokenBSlash :: Alex Token }\n" ++
"<0> \":\" { \\(pos,_,_,inp) len -> return $ TokenColon :: Alex Token }\n" ++
"<0> \"\\\"\" { \\(pos,_,_,inp) len -> return $ TokenDoubleQuote :: Alex Token }\n" ++
"<0> \"'\" { \\(pos,_,_,inp) len -> return $ TokenSingleQuote :: Alex Token }\n" ++
"<0> \",\" { \\(pos,_,_,inp) len -> return $ TokenComma :: Alex Token }\n" ++
"<0> \".\" { \\(pos,_,_,inp) len -> return $ TokenPeriod :: Alex Token }\n" ++
"<0> \"?\" { \\(pos,_,_,inp) len -> return $ TokenQuestion :: Alex Token }\n" ++
"<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> \"!\" { \\(pos,_,_,inp) len -> return $ TokenBANG :: Alex Token }\n" ++
"<0> \"@\" { \\(pos,_,_,inp) len -> return $ TokenAT :: Alex Token }\n" ++
"<0> \"#\" { \\(pos,_,_,inp) len -> return $ TokenPOUND :: Alex Token }\n" ++
"<0> \"$\" { \\(pos,_,_,inp) len -> return $ TokenDOLLAR :: Alex Token }\n" ++
"<0> \"%\" { \\(pos,_,_,inp) len -> return $ TokenPERCENT :: Alex Token }\n" ++
"<0> \"^\" { \\(pos,_,_,inp) len -> return $ TokenCARAT :: Alex Token }\n" ++
"<0> \"&\" { \\(pos,_,_,inp) len -> return $ TokenAMPERSAND :: Alex Token }\n" ++
"<0> \"*\" { \\(pos,_,_,inp) len -> return $ TokenSTAR :: Alex Token }\n" ++
"<0> \"{\" { \\(pos,_,_,inp) len -> return $ TokenLBRACE :: Alex Token }\n" ++
"<0> \"}\" { \\(pos,_,_,inp) len -> return $ TokenRBRACE :: Alex Token }\n" ++
"<0> \"(\" { \\(pos,_,_,inp) len -> return $ TokenLPAREN :: Alex Token }\n" ++
"<0> \")\" { \\(pos,_,_,inp) len -> return $ TokenRPAREN :: Alex Token }\n" ++
"<0> \"?\" { \\(pos,_,_,inp) len -> return $ TokenQUESTION :: Alex Token }\n" ++
"<0> \"/\" { \\(pos,_,_,inp) len -> return $ TokenFSLASH :: Alex Token }\n" ++
"<0> \"\\\" { \\(pos,_,_,inp) len -> return $ TokenBSLASH :: Alex Token }\n" ++
"<0> \":\" { \\(pos,_,_,inp) len -> return $ TokenCOLON :: Alex Token }\n" ++
"<0> \"\\\"\" { \\(pos,_,_,inp) len -> return $ TokenDOUBLEQUOTE :: Alex Token }\n" ++
"<0> \"'\" { \\(pos,_,_,inp) len -> return $ TokenSINGLEQUOTE :: Alex Token }\n" ++
"<0> \",\" { \\(pos,_,_,inp) len -> return $ TokenCOMMA :: Alex Token }\n" ++
"<0> \".\" { \\(pos,_,_,inp) len -> return $ TokenPERIOD :: Alex Token }\n" ++
"<0> \"?\" { \\(pos,_,_,inp) len -> return $ TokenQUESTION :: Alex Token }\n" ++
"<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" ++
......@@ -116,8 +116,8 @@ makeLexer name tokes =
"alexEOF = return TokenEOF\n\n" ++
"lexwrap = (alexMonadScan >>=)\n\n" ++
"data Token = TokenID String \n" ++
" | TokenString String \n" ++
" | TokenInt Int \n" ++
" | TokenSTRING String \n" ++
" | TokenINT Int \n" ++
dataRules ++
" deriving (Eq, Show)\n\n" ++
"tokens str = runAlex str $ do\n" ++
......
(set x (if 0 (begin 1 2 3) (set y 3)))
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