summaryrefslogtreecommitdiff
path: root/assignment-13/ufpl.dcl
blob: bf3e01044b5a8fe42cc3b2bbafce622d9f5a6b10 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
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