summaryrefslogtreecommitdiff
path: root/assignment-13/uFPL/C.icl
blob: 87f857307e332979fb2de79803b7e11421cd00c8 (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
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