summaryrefslogtreecommitdiff
path: root/assignment-13/C.icl
diff options
context:
space:
mode:
Diffstat (limited to 'assignment-13/C.icl')
-rw-r--r--assignment-13/C.icl93
1 files changed, 93 insertions, 0 deletions
diff --git a/assignment-13/C.icl b/assignment-13/C.icl
new file mode 100644
index 0000000..328802f
--- /dev/null
+++ b/assignment-13/C.icl
@@ -0,0 +1,93 @@
+implementation module C
+
+from StdFunc import id, o
+import StdString
+import StdTuple
+
+import Data.Generics.GenDefault
+import Data.Maybe
+import Data.Tuple
+
+import Arduino
+import Util
+
+(`seq`) infix 0 :: CBody CBody -> CBody
+(`seq`) CBEmpty cb = cb
+(`seq`) cb CBEmpty = cb
+(`seq`) a b = CBSeq a b
+
+gDefault{|UNIT|} = UNIT
+gDefault{|RECORD|} f = RECORD f
+gDefault{|Bool|} = False
+gDefault{|Char|} = '\x00'
+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"
+ print Unsig = print "unsigned"
+
+instance print CType
+where
+ print (CTChar s) = print s o print " char"
+ print CTBool = print "bool"
+ print (CTInt s) = print s o print " int"
+ print (CTLong s) = print s o print " long"
+ print CTVoid = print "void"
+ print (CTArray t) = print "*" o print t
+ print (CTStruct s) = print "struct " o print s
+
+instance print (Int,CType) // Variable
+where
+ print (i,t) = print t o print " v" o print i
+
+instance print CExpr
+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 ", " 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 "'"
+ print (CEIf b t e) = print "(" o print b o print " ? " o print t o print " : " o print e o print ")"
+ print (CERef e) = print "&(" o print e o print ")"
+ print (CEDeref e) = print "*(" o print e o print ")"
+
+instance print CBody
+where
+ print (CBReturn Nothing) = print "return;"
+ print (CBReturn (Just e)) = print "return " o print e o print ";"
+ print (CBIf c t e) = print "if (" o print c o print ") {" o indent o nl
+ o print t o unindent o nl
+ o print "} else {" o indent o nl
+ o print e o unindent o nl o print "}"
+ print (CBWhile e b) = print "while (" o print e o print ") {" o nl o print b o nl o print "}"
+ print (CBAssign v e) = print v o print " = " o print e o print ";"
+ print (CBSeq a b) = print a o nl o print b
+ print CBEmpty = id
+ print (CBExpr e) = print e o print ";"
+
+instance print CVar
+where
+ print v = print v.CVar.type o print " " o print v.CVar.name o print " = " o print v.value o print ";"
+
+instance print CFun
+where
+ print cf = print cf.CFun.type o print " " o print cf.CFun.name
+ o print "(" o prsperse ", " cf.params o print ") {" o indent o nl
+ o print cf.body o unindent o nl o print "}"