Start with assignment 13

1 files changed, 94 insertions, 0 deletions

diff --git a/assignment-13/ufpl.dcl b/assignment-13/ufpl.dcl
new file mode 100644
index 0000000..bf3e010
--- /dev/null
+++ b/assignment-13/ufpl.dcl
@@ -0,0 +1,94 @@
+definition module ufpl
+
+from StdGeneric import :: Bimap
+from StdOverloaded import class +, class -, class *, class /, class ==, class <
+
+from C import :: CType, :: CExpr, :: CBody, :: CVar, :: CFun
+
+:: RO = RO
+:: RW = RW
+
+:: Shared t w =
+	{ sname :: String
+	, stype :: CType
+	, sinit :: t
+	, srepr :: Bimap t CExpr
+	}
+
+:: Shares
+	= NoShares
+	| E.t rw: Shares (Shared t rw) Shares
+
+removeDupShares :: Shares -> Shares
+
+class allShares t
+where
+	allShares` :: t -> Shares
+
+	allShares :: t -> Shares
+	allShares x :== removeDupShares (allShares` x)
+
+instance allShares [t] | allShares t
+instance allShares (Expr t rw)
+instance allShares Trigger
+instance allShares Rule
+instance allShares NamedRule
+
+class Expr t where litExpr :: t -> CExpr
+instance Expr Int
+instance Expr Bool
+instance Expr Char
+
+:: Expr t rw
+	=                ELit           t
+	|                EShared        (Shared t rw)
+	| E.rwa rwb:     (+.)  infixl 6 (Expr t rwa) (Expr t rwb) & + t
+	| E.rwa rwb:     (-.)  infixl 6 (Expr t rwa) (Expr t rwb) & - t
+	| E.rwa rwb:     (*.)  infixl 7 (Expr t rwa) (Expr t rwb) & * t
+	| E.rwa rwb:     (/.)  infixl 7 (Expr t rwa) (Expr t rwb) & / t
+	| E.rwa rwb u:   EEq  (Bimap t Bool) (Expr u rwa) (Expr u rwb) & Expr, == u
+	| E.rwa rwb u:   ELt  (Bimap t Bool) (Expr u rwa) (Expr u rwb) & Expr, < u
+	| E.rwa rwb:     EAnd (Bimap t Bool) (Expr Bool rwa) (Expr Bool rwb)
+	| E.rwa rwb:     EOr  (Bimap t Bool) (Expr Bool rwa) (Expr Bool rwb)
+	| E.rwa rwb rwc: EIf            (Expr Bool rwa) (Expr t rwb) (Expr t rwc)
+
+lit :: (t -> Expr t RO)
+(?) infix 4 :: (Expr Bool rwa) (Expr t rwb, Expr t rwc) -> Expr t RO
+
+(==.) infix 4 :: (Expr t rwa) (Expr t rwb) -> Expr Bool RO | Expr, == t
+(<.) infix 4 :: (Expr t rwa) (Expr t rwb) -> Expr Bool RO | Expr, < t
+(>.) infix 4 :: (Expr t rwa) (Expr t rwb) -> Expr Bool RO | Expr, < t
+
+(&&.) infixr 3 :: (Expr Bool rwa) (Expr Bool rwb) -> Expr Bool RO
+(||.) infixr 4 :: (Expr Bool rwa) (Expr Bool rwb) -> Expr Bool RO
+
+:: Trigger
+	= E.t rw: Change (Expr t rw) & Expr t
+	| E.t rwa rwb: (?=) (Expr t rwa) (Expr t rwb) & Expr, == t
+	| (?&) infixr 3 Trigger Trigger
+	| (?|) infixr 4 Trigger Trigger
+
+:: Rule
+	= E.t rw:    (<#) infix 3   (Expr t RW) (Expr t rw) & Expr t
+	| E.rw:      When           (Expr Bool rw) [Rule]
+	|            (>>>) infixr 2 Trigger [Rule]
+	| E.rwa rwb: SetCursor      (Expr Int rwa, Expr Int rwb)
+	| E.t rw:    Print          (Expr t rw) & Expr t
+
+:: NamedRule = E.r: (:=:) infix 1 String r & gen r CBody & allShares r
+
+class gen f t :: f -> t
+
+class (:.) infixr 2 r :: Rule r -> [Rule]
+instance :. Rule
+instance :. [Rule]
+
+class (|||) infixr 0 r :: NamedRule r -> [NamedRule]
+instance ||| NamedRule
+instance ||| [NamedRule]
+
+instance gen (Expr t rw) CExpr | Expr t
+instance gen Rule CBody
+instance gen [r] CBody | gen r CBody
+instance gen NamedRule CFun
+instance gen (Shared t rw) CVar