a7/mart/skeleton7.icl

   1 module skeleton7
   2
   3 from iTasks import
   4         always, hasValue, :: TaskValue(..), :: Task, :: Stability,
   5         :: TaskCont(..), :: Action, updateInformation, viewInformation,
   6         class descr, instance descr String, :: UpdateOption, :: ViewOption(..),
   7         -||-, -||, ||-, startEngine, class Publishable, >>*, class TFunctor,
   8         instance TFunctor Task, class TApplicative, instance TApplicative Task,
   9         instance Publishable Task, Void
  10 import Data.Tuple, StdClass, StdList, iTasks._Framework.Generic, Text.JSON,
  11         Data.Functor, Control.Applicative, Control.Monad, Data.Map, Data.Either
  12 import qualified iTasks
  13 import qualified Text
  14 from Text import class Text, instance Text String
  15 from StdFunc import o
  16
  17 e = Insert New (Oper New +. (Union (Integer 7) (Size (Integer 9))))
  18
  19 :: Expression
  20         = New
  21         | Insert         Element Set
  22         | Delete         Element Set
  23         | Variable       Ident
  24         | Union  Set    Set
  25         | Difference     Set    Set
  26         | Intersection   Set    Set
  27         | Integer        Int
  28         | Size   Set
  29         | Oper   Element Op Element
  30         | (=.) infixl 2 Ident Expression
  31
  32 :: Op = +. | -. | *.
  33 :: Set  :== Expression
  34 :: Element      :== Expression
  35 :: Ident        :== String
  36
  37
  38 // === State
  39 :: Val = Int Int | Set Set
  40 :: State :== Map String Val
  41
  42 :: Sem a = Sem (State -> (Either String a, State))
  43
  44 unsem :: (Sem a) -> (State -> (Either String a, State))
  45 unsem (Sem a) = a
  46
  47 instance Functor Sem where
  48         fmap f s = Sem \st.let (a, st`)=unsem s st in (fmap f a, st`)
  49
  50 instance Applicative Sem where
  51         pure s = Sem \st.(pure s, st)
  52         (<*>) a f = ap a f
  53
  54 instance Monad Sem where
  55         bind (Sem s) f = Sem \st.case s st of
  56                 (Right v, st`) = unsem (f v) st`
  57                 (Left e, st`) = (Left e, st`)
  58
  59 store :: Ident Val -> Sem Val
  60 store i v = Sem \st.(pure v, put i v st)
  61
  62 read :: Ident -> Sem Val
  63 read i = Sem \st.case get i st of
  64                 (Just v) = (Right v, st)
  65                 _ = unsem (fail "variable not found") st
  66
  67 fail :: String -> Sem a
  68 fail s = Sem \st.(Left s,st)
  69
  70 // === semantics
  71
  72
  73 // === simulation
  74 (>>>=) :== 'iTasks'.tbind
  75 (>>>|) a b :== 'iTasks'.tbind a (\_ -> b)
  76 treturn :== 'iTasks'.return
  77 ActionOk :== 'iTasks'.ActionOk
  78 ActionQuit :== 'iTasks'.ActionQuit
  79 ActionNew :== 'iTasks'.ActionNew
  80
  81 Start = Void