summaryrefslogtreecommitdiff
path: root/assignment-13/uFPL/Bootstrap.icl
diff options
context:
space:
mode:
Diffstat (limited to 'assignment-13/uFPL/Bootstrap.icl')
-rw-r--r--assignment-13/uFPL/Bootstrap.icl120
1 files changed, 120 insertions, 0 deletions
diff --git a/assignment-13/uFPL/Bootstrap.icl b/assignment-13/uFPL/Bootstrap.icl
new file mode 100644
index 0000000..8e00e97
--- /dev/null
+++ b/assignment-13/uFPL/Bootstrap.icl
@@ -0,0 +1,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=[]}