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=[]}
|
