diff options
Diffstat (limited to 'assignment-13/uFPL.icl')
| -rw-r--r-- | assignment-13/uFPL.icl | 85 |
1 files changed, 71 insertions, 14 deletions
diff --git a/assignment-13/uFPL.icl b/assignment-13/uFPL.icl index 881a11f..607eabd 100644 --- a/assignment-13/uFPL.icl +++ b/assignment-13/uFPL.icl @@ -6,7 +6,7 @@ import StdClass from StdFunc import const, flip, id, o from StdGeneric import :: Bimap{..}, bimapId; bm :== bimapId import StdInt -from StdList import any, foldl, map, instance fromString [a] +from StdList import any, filter, flatten, foldl, map, instance fromString [a] import StdMisc import StdOverloaded import StdString @@ -17,7 +17,7 @@ import Control.Monad from Data.Func import $ import Data.Functor import Data.Maybe -from Data.List import intersperse, foldr1 +from Data.List import concatMap, intersperse, foldr1 import Data.Map import Data.Tuple from Text import class Text(concat), instance Text String @@ -91,6 +91,24 @@ instance allShares NamedRule where allShares` (_ :=: r) = allShares` r +instance allTriggers [t] | allTriggers t +where + allTriggers xs = concatMap allTriggers xs + +instance allTriggers Trigger where allTriggers t = [t] + +instance allTriggers Rule +where + allTriggers (_ <# _) = [] + allTriggers (When _ rs) = allTriggers rs + allTriggers (t >>> rs) = [t:allTriggers rs] + allTriggers (SetCursor _) = [] + allTriggers (Print _) = [] + +instance allTriggers NamedRule +where + allTriggers (_ :=: r) = allTriggers r + instance Expr Int where litExpr i = CEInt i instance Expr Bool where litExpr b = CEBool b instance Expr Char where litExpr c = CEChar c @@ -162,8 +180,8 @@ where instance gen Rule CBody where gen (EShared shr <# val) = CBExpr (CEApp (typedfun shr.stype "set") [CERef (CEGlobal ("s" +++ shr.sname)), gen val]) - gen (When b rs) = CBIf (gen b) (gen rs) CBEmpty - gen (t >>> rs) = CBIf (gen t) (gen rs) CBEmpty + gen (When b rs) = CBIf (gen b) (gen rs) [] Nothing + gen (t >>> rs) = CBIf (gen t) (gen rs) [] Nothing gen (SetCursor (c,r)) = CBExpr (CEApp "lcd.setCursor" [gen c, gen r]) gen (Print e) = CBExpr (CEApp "lcd.print" [gen e]) @@ -177,22 +195,61 @@ where gen (name :=: rs) = { params = [] , body = gen rs - , fresh = 0 , type = CTVoid , name = "t" +++ name } +fun_setup :: [NamedRule] -> CFun +fun_setup rs = + { params = [] + , type = CTVoid + , name = "setup" + , body = + CBExpr (CEApp "lcd.begin" [CEInt 16, CEInt 2]) `seq` + CBExpr (CEApp "pinMode" [CEGlobal "A0", CEGlobal "INPUT"]) `seq` + foldr (`seq`) CBEmpty + [CBExpr $ CEApp (typedfun t "subscribe") [CERef (CEGlobal ("s" +++ s))] + \\ (s,t) <- flatten $ map (sharesMap \s -> (s.sname, s.stype)) $ map allShares` $ allTriggers rs] + } + +fun_loop :: [NamedRule] -> CFun +fun_loop rs = + { params = [] + , type = CTVoid + , name = "loop" + , body = + foldr (`seq`) (CBExpr $ CEApp "system" []) [CBExpr $ CEApp ("t" +++ r) [] \\ r :=: _ <- rs] + } + +fun_system :: [NamedRule] -> CFun +fun_system rs = + { params = [] + , type = CTVoid + , name = "system" + , body = + CBAssign "int val" (CEApp "analogRead" [CEGlobal "A0"]) `seq` + CBIf + (CEInfix "<" (CEGlobal "val") (CEInt 50)) + (CBExpr $ CEApp "bset" [CERef (CEGlobal "sb0"), CEBool True]) + [(CEInfix "<" (CEGlobal "val") (CEInt t), + CBExpr $ CEApp "bset" [CERef (CEGlobal b), CEBool True]) + \\ (t,b) <- [(190,"sb1"),(380,"sb2"),(555,"sb3"),(790,"sb4")]] + Nothing `seq` + CBExpr (CEApp "ulset" [CERef (CEGlobal "smillis"), CEApp "millis" []]) + } + instance gen NamedRule CProg where gen r = combinePrograms zero { bootstrap = "" , globals = sharesMap gen (allShares r) - , funs = [gen r] + , funs = [gen r, fun_setup [r], fun_loop [r], fun_system [r]] } instance gen [NamedRule] CProg where - gen rs = foldr (combinePrograms o gen) zero rs + gen rs = combinePrograms {zero & funs=[fun_setup rs, fun_loop rs, fun_system rs]} $ + foldr (combinePrograms o gen) zero rs instance toString Display where @@ -270,10 +327,10 @@ instance run NamedRule where run (_ :=: r) = run r -Start w = simulate example_score w +Start w = simulate example_countdown w -example_score :: [NamedRule] -example_score = +example_score :: (String, [NamedRule]) +example_score = ("score", "a" :=: pressed b0 >>> [scorea <# scorea +. lit 1] ||| "b" :=: pressed b1 >>> [scoreb <# scoreb +. lit 1] ||| "r" :=: pressed b2 >>> [scorea <# lit 0, scoreb <# lit 0] @@ -282,13 +339,13 @@ example_score = Print scorea :. Print (lit '-') :. Print scoreb - ) + )) where scorea = rwInt "scorea" 0 scoreb = rwInt "scoreb" 0 -example_countdown :: [NamedRule] -example_countdown = +example_countdown :: (String, [NamedRule]) +example_countdown = ("countdown", "time" :=: (Change millis >>> [When (millis -. DELAY >. counter) ( counter <# counter +. DELAY :. @@ -315,7 +372,7 @@ example_countdown = ||| "reset" :=: pressed b3 >>> ( seconds <# lit 0 :. minutes <# lit 0 - ) + )) where running = rwBool "running" False minutes = rwInt "minutes" 2 |