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
99
100
101
102
103
104
105
106
107
108
109
110
111
|
implementation module uFPL.C
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
import uFPL.Arduino
import uFPL.Util
(`seq`) infixr 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
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 ")"
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 eifs e) =
prsperse "} else " [print "if (" o print c o print ") {" o indent o nl o print t o unindent o nl \\ (c,t) <- [(c,t):eifs]]
o case e of
Just e ->
print "} else {" o indent o nl
o print e o unindent o nl o print "}"
Nothing ->
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 "}"
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
|
