summaryrefslogtreecommitdiff
path: root/assignment-13/uFPL/Bootstrap.icl
blob: 8e00e976c30b8a99c2fbb4dc26f0d61f3dc7ad74 (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
112
113
114
115
116
117
118
119
120
implementation module uFPL.Bootstrap

from StdFunc import const
import StdGeneric
from StdMisc import undef
import StdString

import uFPL.Arduino
import uFPL.C
import uFPL

rwBool :: String Bool -> Expr Bool RW
rwBool n d = EShared {sname=n, stype=CTBool, sinit=d, srepr=boolmap}

roBool :: String Bool -> Expr Bool RO
roBool n d = EShared {sname=n, stype=CTBool, sinit=d, srepr=boolmap}

rwInt :: String Int -> Expr Int RW
rwInt n d = EShared {sname=n, stype=CTInt Sig, sinit=d, srepr=intmap}

roInt :: String Int -> Expr Int RO
roInt n d = EShared {sname=n, stype=CTInt Sig, sinit=d, srepr=intmap}

rwUInt :: String Int -> Expr Int RW
rwUInt n d = EShared {sname=n, stype=CTInt Unsig, sinit=d, srepr=intmap}

roUInt :: String Int -> Expr Int RO
roUInt n d = EShared {sname=n, stype=CTInt Unsig, sinit=d, srepr=intmap}

rwLong :: String Int -> Expr Int RW
rwLong n d = EShared {sname=n, stype=CTLong Sig, sinit=d, srepr=longmap}

roLong :: String Int -> Expr Int RO
roLong n d = EShared {sname=n, stype=CTLong Sig, sinit=d, srepr=longmap}

rwULong :: String Int -> Expr Int RW
rwULong n d = EShared {sname=n, stype=CTLong Unsig, sinit=d, srepr=longmap}

roULong :: String Int -> Expr Int RO
roULong n d = EShared {sname=n, stype=CTLong Unsig, sinit=d, srepr=longmap}

boolmap :: Bimap Bool CExpr
boolmap = {map_to=CEBool, map_from= \(CEBool b) -> b}

intmap :: Bimap Int CExpr
intmap = {map_to=CEInt, map_from= \(CEInt i) -> i}

longmap :: Bimap Int CExpr
longmap = {map_to=CEInt, map_from= \(CEInt i) -> i}

b0 :: Expr Bool RO
b0 = roBool "b0" False

b1 :: Expr Bool RO
b1 = roBool "b1" False

b2 :: Expr Bool RO
b2 = roBool "b2" False

b3 :: Expr Bool RO
b3 = roBool "b3" False

b4 :: Expr Bool RO
b4 = roBool "b4" False

millis :: Expr Int RO
millis = roLong "millis" 0

false :: Expr Bool RO
false = lit False

true :: Expr Bool RO
true = lit True

rts :: String
rts =
	"#include <LiquidCrystal.h>" +:
	"LiquidCrystal lcd = LiquidCrystal(8, 9, 4, 5, 6, 7);" +:
	
	sharetype "b"  "bool" +:
	sharetype "c"  "signed char" +:
	sharetype "uc" "unsigned char" +:
	sharetype "i"  "signed int" +:
	sharetype "ui" "unsigned int" +:
	sharetype "l"  "signed long" +:
	sharetype "ul" "unsigned long"
where
	(+:) infixl 6 :: String String -> String
	(+:) a b = a +++ "\n" +++ b

	sharetype :: String String -> String
	sharetype short long =
		"struct " +++ short +++ "share {" +:
		"	" +++ long +++ " val;" +:
		"	unsigned char dirty;" +:
		"	unsigned char subscriptions;" +:
		"};" +:

		"void " +++ short +++ "subscribe(struct " +++ short +++ "share *share) {" +:
		"	share->subscriptions++;" +:
		"}" +:

		"void " +++ short +++ "release(struct " +++ short +++ "share *share) {" +:
		"	share->subscriptions--;" +:
		"}" +:

		"void " +++ short +++ "set(struct " +++ short +++ "share *share, " +++ long +++ " val) {" +:
		"	share->val = val;" +:
		"	share->dirty = share->subscriptions;" +:
		"}" +:

		"bool " +++ short +++ "dirty(struct " +++ short +++ "share *share) {" +:
		"	if (share->dirty) {" +:
		"		share->dirty--;" +:
		"		return 1;" +:
		"	}" +:
		"	return 0;" +:
		"}"

instance zero CProg where zero = {bootstrap=rts, globals=[], funs=[]}