diff options
Diffstat (limited to 'assignment-13/C.icl')
-rw-r--r-- | assignment-13/C.icl | 39 |
1 files changed, 24 insertions, 15 deletions
diff --git a/assignment-13/C.icl b/assignment-13/C.icl index 5091def..b9b84f6 100644 --- a/assignment-13/C.icl +++ b/assignment-13/C.icl @@ -1,11 +1,14 @@ implementation module C -from StdFunc import id, o +from StdFunc import id, o, twice import StdList +import StdOrdList import StdString import StdTuple +from Data.Func import $ import Data.Generics.GenDefault +import Data.List import Data.Maybe import Data.Tuple @@ -25,18 +28,6 @@ gDefault{|Maybe|} _ = Nothing derive gDefault Button, Signedness, CType, CExpr, CBody, CFun -unCG :: (CG t p) -> CFun -> (t, CFun) -unCG (CG f) = f - -cg :: (CG t p) -> CFun -cg (CG f) = snd (f gDefault{|*|}) - -(>>-) infixl 1 :: (CG a p) (a -> CG b q) -> CG b q -(>>-) (CG f) g = CG \st -> case f st of (x, st) -> unCG (g x) st - -return :: (a -> CG a p) -return = CG o tuple - instance print Signedness where print Sig = print "signed" @@ -61,7 +52,7 @@ where print (CEButton b) = print b print (CEGlobal g) = print g print (CEInfix op a b) = print "(" o print a o print ") " o print op o print " (" o print b o print ")" - print (CEApp f ps) = print f o print "(" o prsperse (print ", ") ps o print ")" + print (CEApp f ps) = print f o print "(" o prsperse ", " ps o print ")" print (CEBool b) = print (if b "true" "false") print (CEInt i) = print i print (CEChar c) = print "'" o print (toString c) o print "'" @@ -94,5 +85,23 @@ where instance print CFun where print cf = print cf.CFun.type o print " " o print cf.CFun.name - o print "(" o prsperse (print ", ") cf.params o print ") {" o indent o nl + o print "(" o prsperse ", " cf.params o print ") {" o indent o nl o print cf.body o unindent o nl o print "}" + +instance print CProg +where + print prog = print prog.bootstrap o twice nl + o prsperse (twice nl) prog.globals o twice nl + o prsperse (twice nl) prog.funs + +combinePrograms :: CProg CProg -> CProg +combinePrograms a b = + { bootstrap = if (a.bootstrap == b.bootstrap) id ((+++) a.bootstrap) b.bootstrap + , globals = sortBy varLt $ nubBy varEq (a.globals ++ b.globals) + , funs = sortBy funLt $ nubBy funEq (a.funs ++ b.funs) + } +where + varEq a b = a.CVar.name == b.CVar.name + varLt a b = a.CVar.name < b.CVar.name + funEq a b = a.CFun.name == b.CFun.name + funLt a b = a.CFun.name < b.CFun.name |