summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--assignment-13/Bootstrap.dcl4
-rw-r--r--assignment-13/Bootstrap.icl2
-rw-r--r--assignment-13/C.dcl15
-rw-r--r--assignment-13/C.icl39
-rw-r--r--assignment-13/Util.dcl3
-rw-r--r--assignment-13/Util.icl5
-rw-r--r--assignment-13/ufpl.dcl7
-rw-r--r--assignment-13/ufpl.icl42
8 files changed, 76 insertions, 41 deletions
diff --git a/assignment-13/Bootstrap.dcl b/assignment-13/Bootstrap.dcl
index 682714c..eaf1521 100644
--- a/assignment-13/Bootstrap.dcl
+++ b/assignment-13/Bootstrap.dcl
@@ -1,5 +1,7 @@
definition module Bootstrap
+from StdOverloaded import class zero
+
import ufpl
rwBool :: String Bool -> Expr Bool RW
@@ -31,3 +33,5 @@ false :: Expr Bool RO
true :: Expr Bool RO
rts :: String
+
+instance zero CProg
diff --git a/assignment-13/Bootstrap.icl b/assignment-13/Bootstrap.icl
index 3982566..f603b18 100644
--- a/assignment-13/Bootstrap.icl
+++ b/assignment-13/Bootstrap.icl
@@ -116,3 +116,5 @@ where
" }" +:
" return 0;" +:
"}"
+
+instance zero CProg where zero = {bootstrap=rts, globals=[], funs=[]}
diff --git a/assignment-13/C.dcl b/assignment-13/C.dcl
index 1ec912a..40f93d0 100644
--- a/assignment-13/C.dcl
+++ b/assignment-13/C.dcl
@@ -56,13 +56,11 @@ from Util import class print
, name :: String
}
-:: CG t p = CG (CFun -> (t, CFun))
-
-unCG :: (CG t p) -> CFun -> (t, CFun)
-cg :: (CG t p) -> CFun
-
-(>>-) infixl 1 :: (CG a p) (a -> CG b q) -> CG b q
-return :: (a -> CG a p)
+:: CProg =
+ { bootstrap :: String
+ , globals :: [CVar]
+ , funs :: [CFun]
+ }
instance print Signedness
instance print CType
@@ -70,3 +68,6 @@ instance print CExpr
instance print CBody
instance print CVar
instance print CFun
+instance print CProg
+
+combinePrograms :: CProg CProg -> CProg
diff --git a/assignment-13/C.icl b/assignment-13/C.icl
index 5091def..b9b84f6 100644
--- a/assignment-13/C.icl
+++ b/assignment-13/C.icl
@@ -1,11 +1,14 @@
implementation module C
-from StdFunc import id, o
+from StdFunc import id, o, twice
import StdList
+import StdOrdList
import StdString
import StdTuple
+from Data.Func import $
import Data.Generics.GenDefault
+import Data.List
import Data.Maybe
import Data.Tuple
@@ -25,18 +28,6 @@ gDefault{|Maybe|} _ = Nothing
derive gDefault Button, Signedness, CType, CExpr, CBody, CFun
-unCG :: (CG t p) -> CFun -> (t, CFun)
-unCG (CG f) = f
-
-cg :: (CG t p) -> CFun
-cg (CG f) = snd (f gDefault{|*|})
-
-(>>-) infixl 1 :: (CG a p) (a -> CG b q) -> CG b q
-(>>-) (CG f) g = CG \st -> case f st of (x, st) -> unCG (g x) st
-
-return :: (a -> CG a p)
-return = CG o tuple
-
instance print Signedness
where
print Sig = print "signed"
@@ -61,7 +52,7 @@ 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 (print ", ") ps 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 "'"
@@ -94,5 +85,23 @@ where
instance print CFun
where
print cf = print cf.CFun.type o print " " o print cf.CFun.name
- o print "(" o prsperse (print ", ") cf.params o print ") {" o indent o nl
+ o print "(" o prsperse ", " cf.params o print ") {" o indent o nl
o print cf.body o unindent o nl o print "}"
+
+instance print CProg
+where
+ print prog = print prog.bootstrap o twice nl
+ o prsperse (twice nl) prog.globals o twice nl
+ o prsperse (twice nl) prog.funs
+
+combinePrograms :: CProg CProg -> CProg
+combinePrograms a b =
+ { bootstrap = if (a.bootstrap == b.bootstrap) id ((+++) a.bootstrap) b.bootstrap
+ , globals = sortBy varLt $ nubBy varEq (a.globals ++ b.globals)
+ , funs = sortBy funLt $ nubBy funEq (a.funs ++ b.funs)
+ }
+where
+ varEq a b = a.CVar.name == b.CVar.name
+ varLt a b = a.CVar.name < b.CVar.name
+ funEq a b = a.CFun.name == b.CFun.name
+ funLt a b = a.CFun.name < b.CFun.name
diff --git a/assignment-13/Util.dcl b/assignment-13/Util.dcl
index baef165..9e6ae0a 100644
--- a/assignment-13/Util.dcl
+++ b/assignment-13/Util.dcl
@@ -9,6 +9,7 @@ class print a :: a -> PrState -> PrState
printToString :: a -> String | print a
+instance print (PrState -> PrState)
instance print String
instance print Int
@@ -16,4 +17,4 @@ nl :: PrState -> PrState
indent :: PrState -> PrState
unindent :: PrState -> PrState
-prsperse :: (PrState -> PrState) [a] -> PrState -> PrState | print a
+prsperse :: a [b] -> PrState -> PrState | print a & print b
diff --git a/assignment-13/Util.icl b/assignment-13/Util.icl
index ba7de9f..8c246c7 100644
--- a/assignment-13/Util.icl
+++ b/assignment-13/Util.icl
@@ -19,6 +19,7 @@ where
printToString :: a -> String | print a
printToString x = concat (print x zero).output
+instance print (PrState -> PrState) where print p = p
instance print String where print s = \st -> {st & output=[s:st.output]}
instance print Int where print i = \st -> {st & output=[toString i:st.output]}
@@ -31,7 +32,7 @@ indent st = {st & indent=max 0 (st.indent - 1)}
unindent :: PrState -> PrState
unindent st = {st & indent=st.indent + 1}
-prsperse :: (PrState -> PrState) [a] -> PrState -> PrState | print a
+prsperse :: a [b] -> PrState -> PrState | print a & print b
prsperse _ [] = id
prsperse _ [x] = print x
-prsperse g [x:xs] = print x o g o prsperse g xs
+prsperse g [x:xs] = print x o print g o prsperse g xs
diff --git a/assignment-13/ufpl.dcl b/assignment-13/ufpl.dcl
index bf3e010..9f1036f 100644
--- a/assignment-13/ufpl.dcl
+++ b/assignment-13/ufpl.dcl
@@ -3,7 +3,7 @@ definition module ufpl
from StdGeneric import :: Bimap
from StdOverloaded import class +, class -, class *, class /, class ==, class <
-from C import :: CType, :: CExpr, :: CBody, :: CVar, :: CFun
+from C import :: CType, :: CExpr, :: CBody, :: CVar, :: CFun, :: CProg
:: RO = RO
:: RW = RW
@@ -88,7 +88,10 @@ instance ||| NamedRule
instance ||| [NamedRule]
instance gen (Expr t rw) CExpr | Expr t
+instance gen (Shared t rw) CVar
+instance gen Trigger CExpr
instance gen Rule CBody
instance gen [r] CBody | gen r CBody
instance gen NamedRule CFun
-instance gen (Shared t rw) CVar
+instance gen NamedRule CProg
+instance gen [NamedRule] CProg
diff --git a/assignment-13/ufpl.icl b/assignment-13/ufpl.icl
index 2f6de7e..bfd8a8a 100644
--- a/assignment-13/ufpl.icl
+++ b/assignment-13/ufpl.icl
@@ -128,6 +128,18 @@ where
gen (EOr _ a b) = CEInfix "||" (gen a) (gen b)
gen (EIf b t e) = CEIf (gen b) (gen t) (gen e)
+instance gen (Shared t rw) CVar
+where
+ gen shr =
+ { name = "s" +++ shr.sname
+ , type = CTStruct (typedfun shr.stype "share")
+ , value = CEStruct
+ [ ("val", shr.srepr.map_to shr.sinit)
+ , ("dirty", CEInt 0)
+ , ("subscriptions", CEInt 0)
+ ]
+ }
+
instance gen Trigger CExpr
where
gen (Change (EShared shr)) = CEApp (typedfun shr.stype "dirty") [CERef (CEGlobal ("s" +++ shr.sname))]
@@ -158,18 +170,6 @@ where
, name = "t" +++ name
}
-instance gen (Shared t rw) CVar
-where
- gen shr =
- { name = "s" +++ shr.sname
- , type = CTStruct (typedfun shr.stype "share")
- , value = CEStruct
- [ ("val", shr.srepr.map_to shr.sinit)
- , ("dirty", CEInt 0)
- , ("subscriptions", CEInt 0)
- ]
- }
-
instance gen [NamedRule] String
where
gen rs = foldl1 (+++) $
@@ -183,8 +183,22 @@ where
genv :: ((Shared t rw) -> CVar)
genv = gen
-Start :: String
-Start = gen example_score
+instance gen NamedRule CProg
+where
+ gen r = combinePrograms zero
+ { bootstrap = ""
+ , globals = sharesMap gen (allShares r)
+ , funs = [gen r]
+ }
+
+instance gen [NamedRule] CProg
+where
+ gen rs = foldr (combinePrograms o gen) zero rs
+
+Start = printToString (genp example_score)
+where
+ genp :: (a -> CProg) | gen a CProg
+ genp = gen
example_score :: [NamedRule]
example_score =
generated by cgit v1.2.3 (git 2.39.1) at 2025-03-16 20:19:49 +0000