summaryrefslogtreecommitdiff
path: root/assignment-13
diff options
context:
space:
mode:
Diffstat (limited to 'assignment-13')
-rw-r--r--assignment-13/uFPL.dcl4
-rw-r--r--assignment-13/uFPL.icl79
-rw-r--r--assignment-13/uFPL/Arduino.dcl10
-rw-r--r--assignment-13/uFPL/Arduino.icl16
-rw-r--r--assignment-13/uFPL/Bootstrap.icl5
-rw-r--r--assignment-13/uFPL/C.dcl13
-rw-r--r--assignment-13/uFPL/C.icl14
-rw-r--r--assignment-13/uFPL/Examples.dcl7
-rw-r--r--assignment-13/uFPL/Examples.icl70
-rw-r--r--assignment-13/uFPL/Sim.dcl4
-rw-r--r--assignment-13/uFPL/Sim.icl2
11 files changed, 107 insertions, 117 deletions
diff --git a/assignment-13/uFPL.dcl b/assignment-13/uFPL.dcl
index 4d69076..9850850 100644
--- a/assignment-13/uFPL.dcl
+++ b/assignment-13/uFPL.dcl
@@ -87,8 +87,10 @@ pressed :: (Expr Bool RO) -> Trigger
| (>>>) infixr 2 Trigger [Rule]
| E.rwa rwb: SetCursor (Expr Int rwa, Expr Int rwb)
| E.t rw: Print (Expr t rw) & Expr, toString t
+ | PrintS String
-:: NamedRule = E.r: (:=:) infixr 1 String r & gen r CBody & run, allShares, allTriggers, TC r
+:: NamedRule
+ = E.r: (:=:) infixr 1 String r & gen r CBody & run, allShares, allTriggers, TC r
class gen f t :: f -> t
diff --git a/assignment-13/uFPL.icl b/assignment-13/uFPL.icl
index 607eabd..f3b382b 100644
--- a/assignment-13/uFPL.icl
+++ b/assignment-13/uFPL.icl
@@ -22,9 +22,9 @@ import Data.Map
import Data.Tuple
from Text import class Text(concat), instance Text String
-import uFPL.Arduino
import uFPL.Bootstrap
import uFPL.C
+import uFPL.Examples
import uFPL.Sim
import uFPL.Util
@@ -86,6 +86,7 @@ where
allShares` (t >>> rs) = foldr1 append [allShares` t:map allShares` rs]
allShares` (SetCursor (c,r)) = append (allShares` c) (allShares` r)
allShares` (Print v) = allShares` v
+ allShares` (PrintS _) = NoShares
instance allShares NamedRule
where
@@ -104,6 +105,7 @@ where
allTriggers (t >>> rs) = [t:allTriggers rs]
allTriggers (SetCursor _) = []
allTriggers (Print _) = []
+ allTriggers (PrintS _) = []
instance allTriggers NamedRule
where
@@ -184,6 +186,7 @@ where
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])
+ gen (PrintS s) = CBExpr (CEApp "lcd.print" [CEString s])
instance gen [r] CBody | gen r CBody
where
@@ -193,16 +196,14 @@ where
instance gen NamedRule CFun
where
gen (name :=: rs) =
- { params = []
- , body = gen rs
+ { body = gen rs
, type = CTVoid
, name = "t" +++ name
}
fun_setup :: [NamedRule] -> CFun
fun_setup rs =
- { params = []
- , type = CTVoid
+ { type = CTVoid
, name = "setup"
, body =
CBExpr (CEApp "lcd.begin" [CEInt 16, CEInt 2]) `seq`
@@ -214,17 +215,15 @@ fun_setup rs =
fun_loop :: [NamedRule] -> CFun
fun_loop rs =
- { params = []
- , type = CTVoid
+ { 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
+fun_system :: CFun
+fun_system =
+ { type = CTVoid
, name = "system"
, body =
CBAssign "int val" (CEApp "analogRead" [CEGlobal "A0"]) `seq`
@@ -243,12 +242,12 @@ where
gen r = combinePrograms zero
{ bootstrap = ""
, globals = sharesMap gen (allShares r)
- , funs = [gen r, fun_setup [r], fun_loop [r], fun_system [r]]
+ , funs = [gen r, fun_setup [r], fun_loop [r], fun_system]
}
instance gen [NamedRule] CProg
where
- gen rs = combinePrograms {zero & funs=[fun_setup rs, fun_loop rs, fun_system rs]} $
+ gen rs = combinePrograms {zero & funs=[fun_setup rs, fun_loop rs, fun_system]} $
foldr (combinePrograms o gen) zero rs
instance toString Display
@@ -322,60 +321,10 @@ where
run (t >>> rs) = \st -> evalTrigger t st >>= \(b,st) -> if b (run rs) Just st
run (SetCursor (c,r)) = \st -> eval c st >>= \c -> eval r st >>= \r -> Just {State | st & display.cursor=(c,r)}
run (Print e) = \st -> eval e st >>= \e -> Just {State | st & display=display (toString e) st.State.display}
+ run (PrintS s) = \st -> Just {State | st & display=display s st.State.display}
instance run NamedRule
where
run (_ :=: r) = run r
-Start w = simulate example_countdown w
-
-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]
- ||| "print" :=: (Change scorea ?| Change scoreb) >>> (
- SetCursor (lit 0, lit 0) :.
- Print scorea :.
- Print (lit '-') :.
- Print scoreb
- ))
-where
- scorea = rwInt "scorea" 0
- scoreb = rwInt "scoreb" 0
-
-example_countdown :: (String, [NamedRule])
-example_countdown = ("countdown",
- "time" :=:
- (Change millis >>> [When (millis -. DELAY >. counter) (
- counter <# counter +. DELAY :.
- seconds <# running ? (seconds -. lit 1, seconds)
- )]) :.
- seconds ?= lit -1 >>> (
- minutes <# minutes -. lit 1 :.
- seconds <# lit 59
- ) :.
- minutes ?= lit -1 >>> (
- running <# false :.
- minutes <# lit 0 :.
- seconds <# lit 0
- ) :.
- Change seconds >>> (
- SetCursor (lit 0, lit 0) :.
- Print minutes :.
- Print (lit ':') :.
- Print seconds
- )
- ||| "setsec" :=: pressed b0 >>> [seconds <# seconds +. lit 1]
- ||| "setmin" :=: pressed b1 >>> [minutes <# minutes +. lit 1]
- ||| "on_off" :=: pressed b2 >>> [running <# running ? (false, true)]
- ||| "reset" :=: pressed b3 >>> (
- seconds <# lit 0 :.
- minutes <# lit 0
- ))
-where
- running = rwBool "running" False
- minutes = rwInt "minutes" 2
- seconds = rwInt "seconds" 0
- counter = rwULong "counter" 0 // If set to 0, this will overflow on first iteration
- DELAY = lit 1000
+Start w = simulate example_score w
diff --git a/assignment-13/uFPL/Arduino.dcl b/assignment-13/uFPL/Arduino.dcl
deleted file mode 100644
index efed603..0000000
--- a/assignment-13/uFPL/Arduino.dcl
+++ /dev/null
@@ -1,10 +0,0 @@
-definition module uFPL.Arduino
-
-from StdOverloaded import class toString
-
-from uFPL.Util import class print
-
-:: Button = B0 | B1 | B2 | B3 | B4 | B5
-
-instance toString Button
-instance print Button
diff --git a/assignment-13/uFPL/Arduino.icl b/assignment-13/uFPL/Arduino.icl
deleted file mode 100644
index 2fbab30..0000000
--- a/assignment-13/uFPL/Arduino.icl
+++ /dev/null
@@ -1,16 +0,0 @@
-implementation module uFPL.Arduino
-
-import StdOverloaded
-
-import uFPL.Util
-
-instance toString Button
-where
- toString B0 = "B0"
- toString B1 = "B1"
- toString B2 = "B2"
- toString B3 = "B3"
- toString B4 = "B4"
- toString B5 = "B5"
-
-instance print Button where print b = print (toString b)
diff --git a/assignment-13/uFPL/Bootstrap.icl b/assignment-13/uFPL/Bootstrap.icl
index 1ca75ac..4429cf5 100644
--- a/assignment-13/uFPL/Bootstrap.icl
+++ b/assignment-13/uFPL/Bootstrap.icl
@@ -7,7 +7,6 @@ import StdString
from Data.Func import $
-import uFPL.Arduino
import uFPL.C
import uFPL
@@ -127,9 +126,9 @@ where
"bool " +++ short +++ "dirty(struct " +++ short +++ "share *share) {" +:
" if (share->dirty) {" +:
" share->dirty--;" +:
- " return 1;" +:
+ " return true;" +:
" }" +:
- " return 0;" +:
+ " return false;" +:
"}"
instance zero CProg where zero = {bootstrap=rts, globals=sharesMap gen predefShares, funs=[]}
diff --git a/assignment-13/uFPL/C.dcl b/assignment-13/uFPL/C.dcl
index 3b25183..938707b 100644
--- a/assignment-13/uFPL/C.dcl
+++ b/assignment-13/uFPL/C.dcl
@@ -2,7 +2,6 @@ definition module uFPL.C
from Data.Maybe import :: Maybe
-from uFPL.Arduino import :: Button
from uFPL.Util import class print
:: Signedness = Sig | Unsig
@@ -13,28 +12,23 @@ from uFPL.Util import class print
| CTInt Signedness
| CTLong Signedness
| CTVoid
- | CTArray CType
| CTStruct String
:: CExpr
- = CEButton Button
- | CEGlobal String
+ = CEGlobal String
| CEInfix String CExpr CExpr
| CEApp String [CExpr]
| CEBool Bool
| CEInt Int
| CEChar Char
- | CEBArray Int [Bool]
- | CEIArray Int [Int]
+ | CEString String
| CEIf CExpr CExpr CExpr
| CERef CExpr
- | CEDeref CExpr
| CEStruct [(String, CExpr)]
:: CBody
= CBReturn (Maybe CExpr)
| CBIf CExpr CBody [(CExpr, CBody)] (Maybe CBody)
- | CBWhile CExpr CBody
| CBAssign String CExpr
| CBSeq CBody CBody
| CBEmpty
@@ -49,8 +43,7 @@ from uFPL.Util import class print
}
:: CFun =
- { params :: [(Int, CType)]
- , body :: CBody
+ { body :: CBody
, type :: CType
, name :: String
}
diff --git a/assignment-13/uFPL/C.icl b/assignment-13/uFPL/C.icl
index 87f8573..61e572e 100644
--- a/assignment-13/uFPL/C.icl
+++ b/assignment-13/uFPL/C.icl
@@ -12,7 +12,6 @@ import Data.List
import Data.Maybe
import Data.Tuple
-import uFPL.Arduino
import uFPL.Util
(`seq`) infixr 0 :: CBody CBody -> CBody
@@ -26,7 +25,7 @@ gDefault{|Bool|} = False
gDefault{|Char|} = '\x00'
gDefault{|Maybe|} _ = Nothing
-derive gDefault Button, Signedness, CType, CExpr, CBody, CFun
+derive gDefault Signedness, CType, CExpr, CBody, CFun
instance print Signedness
where
@@ -40,25 +39,19 @@ where
print (CTInt s) = print s o print " int"
print (CTLong s) = print s o print " long"
print CTVoid = print "void"
- print (CTArray t) = print "*" o print t
print (CTStruct s) = print "struct " o print s
-instance print (Int,CType) // Variable
-where
- print (i,t) = print t o print " v" o print i
-
instance print CExpr
where
- print (CEButton b) = print b
print (CEGlobal g) = print g
print (CEInfix op a b) = print "(" o print a o print ") " o print op o print " (" o print b o print ")"
print (CEApp f ps) = print f o print "(" o prsperse ", " ps o print ")"
print (CEBool b) = print (if b "true" "false")
print (CEInt i) = print i
print (CEChar c) = print "'" o print (toString c) o print "'"
+ print (CEString s) = print "\"" o print s o print "\""
print (CEIf b t e) = print "(" o print b o print " ? " o print t o print " : " o print e o print ")"
print (CERef e) = print "&(" o print e o print ")"
- print (CEDeref e) = print "*(" o print e o print ")"
print (CEStruct m) = print "{" o indent o nl o prsperse (print "," o nl) (map pr m) o unindent o nl o print "}"
where
pr :: (String, CExpr) -> String
@@ -76,7 +69,6 @@ where
o print e o unindent o nl o print "}"
Nothing ->
print "}"
- print (CBWhile e b) = print "while (" o print e o print ") {" o nl o print b o nl o print "}"
print (CBAssign v e) = print v o print " = " o print e o print ";"
print (CBSeq a b) = print a o nl o print b
print CBEmpty = id
@@ -89,7 +81,7 @@ where
instance print CFun
where
print cf = print cf.CFun.type o print " " o print cf.CFun.name
- o print "(" o prsperse ", " cf.params o print ") {" o indent o nl
+ o print "() {" o indent o nl
o print cf.body o unindent o nl o print "}"
instance print CProg
diff --git a/assignment-13/uFPL/Examples.dcl b/assignment-13/uFPL/Examples.dcl
new file mode 100644
index 0000000..de3512e
--- /dev/null
+++ b/assignment-13/uFPL/Examples.dcl
@@ -0,0 +1,7 @@
+definition module uFPL.Examples
+
+import uFPL
+
+example_empty :: (String, [NamedRule])
+example_score :: (String, [NamedRule])
+example_countdown :: (String, [NamedRule])
diff --git a/assignment-13/uFPL/Examples.icl b/assignment-13/uFPL/Examples.icl
new file mode 100644
index 0000000..1e870e6
--- /dev/null
+++ b/assignment-13/uFPL/Examples.icl
@@ -0,0 +1,70 @@
+implementation module uFPL.Examples
+
+import StdChar
+import StdInt
+import StdString
+
+import uFPL
+import uFPL.Bootstrap
+
+example_empty :: (String, [NamedRule])
+example_empty = ("my_program", [])
+
+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 :.
+ SetCursor (lit 0, lit 0) :. // Reset screen
+ PrintS " "
+ )
+ ||| "print" :=: (Change scorea ?| Change scoreb) >>> (
+ SetCursor (lit 0, lit 0) :.
+ PrintS "A: " :.
+ Print scorea :.
+ PrintS " - B: " :.
+ Print scoreb
+ ))
+where
+ scorea = rwInt "scorea" 0
+ scoreb = rwInt "scoreb" 0
+
+example_countdown :: (String, [NamedRule])
+example_countdown = ("countdown",
+ "time" :=:
+ (Change millis >>> [When (millis -. DELAY >. counter) (
+ counter <# counter +. DELAY :.
+ seconds <# running ? (seconds -. lit 1, seconds)
+ )]) :.
+ seconds ?= lit -1 >>> (
+ minutes <# minutes -. lit 1 :.
+ seconds <# lit 59
+ ) :.
+ minutes ?= lit -1 >>> (
+ running <# false :.
+ minutes <# lit 0 :.
+ seconds <# lit 0
+ ) :.
+ Change seconds >>> (
+ SetCursor (lit 0, lit 0) :.
+ When (minutes <. lit 10) [Print (lit 0)] :.
+ Print minutes :.
+ Print (lit ':') :.
+ When (seconds <. lit 10) [Print (lit 0)] :.
+ Print seconds
+ )
+ ||| "setsec" :=: pressed b0 >>> [seconds <# seconds +. lit 1]
+ ||| "setmin" :=: pressed b1 >>> [minutes <# minutes +. lit 1]
+ ||| "on_off" :=: pressed b2 >>> [running <# running ? (false, true)]
+ ||| "reset" :=: pressed b3 >>> (
+ seconds <# lit 0 :.
+ minutes <# lit 0
+ ))
+where
+ running = rwBool "running" False
+ minutes = rwInt "minutes" 0
+ seconds = rwInt "seconds" 15
+ counter = rwULong "counter" 0 // If set to 0, this will overflow on first iteration
+ DELAY = lit 1000
diff --git a/assignment-13/uFPL/Sim.dcl b/assignment-13/uFPL/Sim.dcl
index 96527db..6904033 100644
--- a/assignment-13/uFPL/Sim.dcl
+++ b/assignment-13/uFPL/Sim.dcl
@@ -53,8 +53,10 @@ instance toString UFPLException
| ITrigger ITrigger [IRule]
| ISetCursor (IExpr, IExpr)
| IPrint IExpr
+ | IPrintS String
-:: INamedRule = Rule String [IRule]
+:: INamedRule
+ = Rule String [IRule]
:: IShareState t =
{ isval :: t
diff --git a/assignment-13/uFPL/Sim.icl b/assignment-13/uFPL/Sim.icl
index 892708c..07f3103 100644
--- a/assignment-13/uFPL/Sim.icl
+++ b/assignment-13/uFPL/Sim.icl
@@ -249,6 +249,7 @@ where
(e :: Expr Char rw) -> return (dynamic Print e)
(e :: Expr Bool rw) -> return (dynamic Print e)
_ -> throw (LiftException "IPrint")
+ lift (IPrintS s) = return (dynamic PrintS s)
instance unlift IRule Rule
where
@@ -257,6 +258,7 @@ where
unlift (t >>> rs) = ITrigger (unlift t) (unlift rs)
unlift (SetCursor (c,r)) = ISetCursor (unlift c, unlift r)
unlift (Print e) = IPrint (unlift e)
+ unlift (PrintS s) = IPrintS s
instance lift INamedRule
where
generated by cgit v1.2.3 (git 2.39.1) at 2025-03-18 20:52:21 +0000