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 "}"
|
