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

added imptest.y, other small changes

parent c47e8b80
module AST where
type ID = String
data Prog = Prog [AST]
data AST = Expression Exp
| TopLevlDec Dec
data Exp = SET ID Exp
| IF SimpleExp Exp (Maybe Exp)
| WHILE SimpleExp Exp
| BEGIN (List1 Exp)
| LET [(String, Exp)] Exp
data BinOp = Plus SimpleExp SimpleExp
| Mult SimpleExp SimpleExp
| Div SimpleExp SimpleExp
| Minus SimpleExp SimpleExp
| CheckExpect SimpleExp SimpleExp
data SimpleExp =
Lit Int
| Var ID
| Apply ID (List0 Exp)
| BinOp BinOp
-- | AGet SimpleExp SimpleExp --(arr[i])
-- | ASet SimpleExp SimpleExp SimpleExp --(set arr[i] j)
-- | AMake ID SimpleExp --(new arr size)
data Dec = Val ID Exp
matt@hal.2957:1457926303
\ No newline at end of file
......@@ -21,8 +21,8 @@ set { TokenSet }
int { TokenInt $$ }
var { TokenVar $$ }
String {TokenVar $$ }
Int {TokenInt $$}
ID {TokenVar $$ }
Int {TokenInt $$}
ID {TokenVar $$ }
"@" { TokenOp $$ }
"!" { TokenOp $$ }
"$" { TokenOp $$ }
......
......@@ -73,7 +73,7 @@ stypeToString (_, (AppT (ConT n) t)) =
in (("Maybe" ++ s),
rs ++ ("\n\nMaybe" ++ s ++ ": " ++ s ++ "\t{Just $1}\n" ++
(makeTab ("maybe" ++ s)) ++ "| \t{Nothing}"))
else ("", "")
else error "AppT not list or Maybe"
stypeToString (_, (AppT t1 t2)) =
let ts = flattenTuple t1 t2
......@@ -138,12 +138,12 @@ fixMultis s = (if isMulti1 s then "Multi1"
else if isMulti0 s then "Multi0"
else "") ++ (strip s)
rhsToRule :: [RHS] -> RHS -> String
rhsToRule :: [RHS] -> RHS -> (String, [(String, String)])
rhsToRule rules = \(RHS s ts) ->
let ts' = (map fixMultis ts) in
(if (isUnique rules (RHS s ts))
then foldr myappend "" ts'
else "\"" ++ s ++ "\" " ++ (foldr myappend "" ts')) ++ rrhs (RHS s ts')
((if (isUnique rules (RHS s ts))
then foldr myappend "" ts'
else "\"" ++ s ++ "\" " ++ (foldr myappend "" ts')) ++ rrhs (RHS s ts'), [])
strip :: String -> String
......@@ -174,17 +174,19 @@ makeTab s = let helper 0 a = a
-- converts the given DecT declaration to a grammar rule which
-- will in turn produce the given declaration.
decTToRule :: DecT -> String
decTToRule :: DecT -> (String, [(String,String)])
decTToRule (DecT n rhs) =
let -- multiRules = "" --foldr getMultiRules "" rhs
rhsStrings = map (rhsToRule rhs) rhs
let (rhsStrings, tokes) = unzip (map (rhsToRule rhs) rhs)
tab = makeTab n
in n ++ ": " ++ (head rhsStrings) ++ "\n" ++
(foldr (\r acc -> tab ++ "| " ++ r ++ "\n" ++ acc) "" (tail rhsStrings))-- ++ multiRules
tokes' = foldr (++) [] tokes
in (n ++ ": " ++ (head rhsStrings) ++ "\n" ++
(foldr (\r acc -> tab ++ "| " ++ r ++ "\n" ++ acc) "" (tail rhsStrings)), tokes')
-- Creates the grammar rules from the declarations
makeRules :: [DecT] -> String
makeRules decs = foldr (\dec acc -> (decTToRule dec) ++ "\n" ++ acc) "" decs
makeRules :: [DecT] -> (String, [(String, String)])
makeRules decs = (foldr (\r (r', ts') ->
let (rule, tokes) = (decTToRule r)
in ((rule ++ "\n" ++ r'), (ts' ++ tokes))) ("",[]) decs)
cleanNLs' :: String -> String
cleanNLs' ('\n':'\n':'\n':s) = cleanNLs' ('\n':'\n':s)
......@@ -224,7 +226,7 @@ parseAstDecs s = let decs = case parseDecs s of
(Left err) -> (trace err undefined)
dataDs = filter isDataD decs
decTs = (map dataDToDecT dataDs)
rules = makeRules (map (\(x,_) -> x) decTs)
(rules, tokes) = makeRules (map (\(x,_) -> x) decTs)
in cleanNLs (cleanMulti (foldr (\(_, y) acc -> y ++ acc) "" decTs)) ++ rules
-- in (foldr (\(x, y) acc -> y ++ acc) "" decTs) ++ rules
main :: IO ()
......
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