definition module uFPL

from StdGeneric import :: Bimap
from StdOverloaded import class +, class -, class *, class /, class ==, class <, class toString

from Data.Map import :: Map
from Data.Maybe import :: Maybe

from uFPL.C import :: CType, :: CExpr, :: CBody, :: CVar, :: CFun, :: CProg

:: RO = RO
:: RW = RW

:: UShared t rw =
	{ sname :: String
	, stype :: CType
	, sinit :: t
	, srepr :: Bimap t CExpr
	, srw   :: rw // to be able to check this in uFPL.Sim
	}

:: Shares
	= NoShares
	| E.t rw: Shares (UShared t rw) Shares & Expr t

removeDupShares :: Shares -> Shares
sharesMap :: (A.t rw: (UShared t rw) -> a | Expr t) Shares -> [a]

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) | Expr t
instance allShares Trigger
instance allShares Rule
instance allShares NamedRule

class allTriggers t :: t -> [Trigger]
instance allTriggers [t] | allTriggers t
instance allTriggers Trigger
instance allTriggers Rule
instance allTriggers NamedRule

class Expr t | TC t where litExpr :: t -> CExpr
instance Expr Int
instance Expr Bool
instance Expr Char

:: Expr t rw
	=                ELit           t
	|                EShared        (UShared 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 5 :: (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

pressed :: (Expr Bool RO) -> Trigger

:: Rule
	= E.t rw:    (<#) infix 4   (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, toString t
	|            PrintS         String

:: NamedRule
	= E.r: (:=:) infixr 1 String r & gen r CBody & run, allShares, allTriggers, TC r

class gen f t :: f -> t

class (:.) infixr 1 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 (UShared 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

:: ShareState =
	{ val           :: Dynamic
	, dirty         :: Int
	, subscriptions :: Int
	}

:: Display =
	{ size   :: (Int, Int)
	, cursor :: (Int, Int)
	, text   :: Map (Int, Int) Char
	}

instance toString Display

:: State =
	{ vars    :: Map String ShareState
	, display :: Display
	}

display :: String Display -> Display
eval :: (Expr t rw) State -> Maybe t | Expr t
evalTrigger :: Trigger State -> Maybe (Bool, State)

class run r :: r -> State -> Maybe State
instance run [r] | run r
instance run Rule
instance run NamedRule