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
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
|
implementation module uFPL.Bootstrap
from StdFunc import const, o
import StdGeneric
from StdMisc import undef
import StdString
from Data.Func import $
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, srw=RW}
roBool :: String Bool -> Expr Bool RO
roBool n d = EShared {sname=n, stype=CTBool, sinit=d, srepr=boolmap, srw=RO}
rwInt :: String Int -> Expr Int RW
rwInt n d = EShared {sname=n, stype=CTInt Sig, sinit=d, srepr=intmap, srw=RW}
roInt :: String Int -> Expr Int RO
roInt n d = EShared {sname=n, stype=CTInt Sig, sinit=d, srepr=intmap, srw=RO}
rwUInt :: String Int -> Expr Int RW
rwUInt n d = EShared {sname=n, stype=CTInt Unsig, sinit=d, srepr=intmap, srw=RW}
roUInt :: String Int -> Expr Int RO
roUInt n d = EShared {sname=n, stype=CTInt Unsig, sinit=d, srepr=intmap, srw=RO}
rwLong :: String Int -> Expr Int RW
rwLong n d = EShared {sname=n, stype=CTLong Sig, sinit=d, srepr=longmap, srw=RW}
roLong :: String Int -> Expr Int RO
roLong n d = EShared {sname=n, stype=CTLong Sig, sinit=d, srepr=longmap, srw=RO}
rwULong :: String Int -> Expr Int RW
rwULong n d = EShared {sname=n, stype=CTLong Unsig, sinit=d, srepr=longmap, srw=RW}
roULong :: String Int -> Expr Int RO
roULong n d = EShared {sname=n, stype=CTLong Unsig, sinit=d, srepr=longmap, srw=RO}
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 = roULong "millis" 0
false :: Expr Bool RO
false = lit False
true :: Expr Bool RO
true = lit True
predefShares :: Shares
predefShares
= share b0
$ share b1
$ share b2
$ share b3
$ share b4
$ share millis
NoShares
where
share :: ((Expr t rw) Shares -> Shares) | Expr t
share = Shares o (\(EShared s) -> s)
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=sharesMap gen predefShares, funs=[]}
|
