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, 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

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