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