From a57034a3afa166979bd88232b810dc88c3ae2bae Mon Sep 17 00:00:00 2001 From: Camil Staps Date: Wed, 3 Jan 2018 09:19:48 +0100 Subject: Cleanup --- assignment-13/Bootstrap.dcl | 4 ++++ assignment-13/Bootstrap.icl | 2 ++ assignment-13/C.dcl | 15 ++++++++------- assignment-13/C.icl | 39 ++++++++++++++++++++++++--------------- assignment-13/Util.dcl | 3 ++- assignment-13/Util.icl | 5 +++-- assignment-13/ufpl.dcl | 7 +++++-- assignment-13/ufpl.icl | 42 ++++++++++++++++++++++++++++-------------- 8 files changed, 76 insertions(+), 41 deletions(-) (limited to 'assignment-13') 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 = -- cgit v1.2.3