summaryrefslogtreecommitdiff
path: root/assignment-13/C.icl
blob: 5091def635eb4071dc9fc0f96efb029d28a034d3 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
implementation module C

from StdFunc import id, o
import StdList
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 (print ", ") 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 ")"
	print (CEStruct m) = print "{" o indent o nl o prsperse (print "," o nl) (map pr m) o unindent o nl o print "}"
	where
		pr :: (String, CExpr) -> String
		pr (s, e) = "." +++ s +++ " = " +++ printToString e

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 (print ", ") cf.params o print ") {" o indent o nl
		o print cf.body o unindent o nl o print "}"