diff options
author | Camil Staps | 2018-01-03 09:24:21 +0100 |
---|---|---|
committer | Camil Staps | 2018-01-03 09:24:21 +0100 |
commit | 33db1946d2a09898761b7d397fe4028725f2215b (patch) | |
tree | 1f68cb8b276b7a20f42f325c76e6d4853ea8e68f /assignment-13/uFPL.dcl | |
parent | Cleanup (diff) |
Rename & restructure
Diffstat (limited to 'assignment-13/uFPL.dcl')
-rw-r--r-- | assignment-13/uFPL.dcl | 97 |
1 files changed, 97 insertions, 0 deletions
diff --git a/assignment-13/uFPL.dcl b/assignment-13/uFPL.dcl new file mode 100644 index 0000000..1bd3df4 --- /dev/null +++ b/assignment-13/uFPL.dcl @@ -0,0 +1,97 @@ +definition module uFPL + +from StdGeneric import :: Bimap +from StdOverloaded import class +, class -, class *, class /, class ==, class < + +from uFPL.C import :: CType, :: CExpr, :: CBody, :: CVar, :: CFun, :: CProg + +:: 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 (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 NamedRule CProg +instance gen [NamedRule] CProg |