+++ /dev/null
-module a9
-
-/*
- Advanced Progrmming 2018, Assignment 8
- Pieter Koopman, pieter@cs.ru.nl
-*/
-import StdEnv
-
-
-import Control.Applicative
-import Control.Monad => qualified join
-import Control.Monad.State
-import Control.Monad.Trans
-import Data.Func
-import Data.Functor
-import Data.Either
-import Data.Maybe
-import Data.List
-
-import Text
-
-import qualified Data.List as List
-import qualified Data.Map as Map
-
-:: Set :== Sem [Int]
-:: Elem :== Sem Int
-:: Ident :== String
-
-// === State
-:: Val :== Either Int [Int]
-:: SemState :== 'Map'.Map String Val
-
-:: Sem a =
- { evaluator :: StateT SemState (Either String) a
- , printer :: [String] -> [String]
- }
-
-fail :: String -> StateT SemState (Either String) a
-fail s = liftT (Left s)
-
-//Sets
-integer :: Int -> Elem
-integer i = {evaluator=pure i,printer = \c->[toString i:c]}
-
-set :: [Int] -> Set
-set i =
- { evaluator = pure (removeDup i)
- , printer = \c->["[":intersperse "," (map toString i)] ++ ["]":c]
- }
-
-size :: Set -> Elem
-size s =
- { evaluator = length <$> s.evaluator
- , printer = \c->["size(":s.printer [")"]]
- }
-
-class variable a :: String -> a
-instance variable Set
-where
- variable i =
- { evaluator
- = gets ('Map'.get i) >>= \v->case v of
- Nothing = fail ("No set with identifier " +++ i)
- Just (Left v) = fail (i +++ " is an element")
- Just (Right v) = pure v
- , printer = \c->[i:c]
- }
-instance variable Elem
-where
- variable i =
- { evaluator
- = gets ('Map'.get i) >>= \v->case v of
- Nothing = fail ("No element with identifier " +++ i)
- Just (Right v) = fail (i +++ " is a set")
- Just (Left v) = pure v
- , printer = \c->[i:c]
- }
-class (+.) infixl 6 a b ~c :: a b -> c
-instance +. Elem Elem Elem
-where
- +. a b =
- { evaluator = (+) <$> a.evaluator <*> b.evaluator
- , printer = \c->a.printer ["+":b.printer c]
- }
-instance +. Elem Set Set
-where
- +. a b =
- { evaluator = 'List'.union <$> pure <$> a.evaluator <*> b.evaluator
- , printer = \c->a.printer ["+":b.printer c]
- }
-instance +. Set Elem Set
-where
- +. a b =
- { evaluator = 'List'.union <$> a.evaluator <*> (pure <$> b.evaluator)
- , printer = \c->a.printer ["+":b.printer c]
- }
-instance +. Set Set Set
-where
- +. a b =
- { evaluator = 'List'.union <$> a.evaluator <*> b.evaluator
- , printer = \c->a.printer ["+":b.printer c]
- }
-class (-.) infixl 6 a b ~c :: a b -> c
-instance -. Elem Elem Elem
-where
- -. a b =
- { evaluator = (-) <$> a.evaluator <*> b.evaluator
- , printer = \c->a.printer ["-":b.printer c]
- }
-instance -. Set Elem Set
-where
- -. a b =
- { evaluator = 'List'.difference <$> a.evaluator <*> (pure <$> b.evaluator)
- , printer = \c->a.printer ["-":b.printer c]
- }
-instance -. Set Set Set
-where
- -. a b =
- { evaluator = 'List'.difference <$> a.evaluator <*> b.evaluator
- , printer = \c->a.printer ["-":b.printer c]
- }
-class (*.) infixl 6 a b ~c :: a b -> c
-instance *. Elem Elem Elem
-where
- *. a b =
- { evaluator = (*) <$> a.evaluator <*> b.evaluator
- , printer = \c->a.printer ["*":b.printer c]
- }
-instance *. Elem Set Set
-where
- *. a b =
- { evaluator = a.evaluator >>= \x->map ((*)x) <$> b.evaluator
- , printer = \c->a.printer ["*":b.printer c]
- }
-instance *. Set Set Set
-where
- *. a b =
- { evaluator = 'List'.intersect <$> a.evaluator <*> b.evaluator
- , printer = \c->a.printer ["*":b.printer c]
- }
-
-class (=.) infixl 2 a :: Ident a -> a
-instance =. Set
-where
- =. n s =
- { evaluator = s.evaluator >>= \v->modify ('Map'.put n (Right v)) *> pure v
- , printer = \c->[n,"=":s.printer c]
- }
-instance =. Elem
-where
- =. n s =
- { evaluator = s.evaluator >>= \v->modify ('Map'.put n (Left v)) *> pure v
- , printer = \c->[n,"=":s.printer c]
- }
-
-//Logicals
-:: Logical :== Sem Bool
-true :: Logical
-true = {evaluator = pure True, printer = \c->["True":c]}
-
-false :: Logical
-false = {evaluator = pure False, printer = \c->["False":c]}
-
-In :: Elem Set -> Logical
-In e s =
- { evaluator = elem <$> e.evaluator <*> s.evaluator
- , printer = \c->e.printer ["In":s.printer c]
- }
-
-class (==.) infix 4 a :: a a -> Logical
-instance ==. Elem
-where
- ==. a b =
- {evaluator = (==) <$> a.evaluator <*> b.evaluator
- ,printer = \c->a.printer ["==":b.printer c]
- }
-instance ==. Set
-where
- ==. a b =
- {evaluator = (==) <$> a.evaluator <*> b.evaluator
- ,printer = \c->a.printer ["==":b.printer c]
- }
-
-class (<=.) infixl 6 a b :: a b -> Logical
-instance <=. Elem Elem
-where
- <=. a b =
- {evaluator = (<=) <$> a.evaluator <*> b.evaluator
- ,printer = \c->a.printer ["<=":b.printer c]
- }
-instance <=. Set Set
-where
- <=. a b =
- {evaluator = ((<=) `on` length) <$> a.evaluator <*> b.evaluator
- ,printer = \c->a.printer ["<=":b.printer c]
- }
-
-Not :: Logical -> Logical
-Not a = {evaluator = not <$> a.evaluator, printer = \c->["not":a.printer c]}
-
-(||.) infixr 2 :: Logical Logical -> Logical
-(||.) a b =
- {evaluator = (||) <$> a.evaluator <*> b.evaluator
- ,printer = \c->a.printer ["||":b.printer c]
- }
-
-(&&.) infixr 2 :: Logical Logical -> Logical
-(&&.) a b =
- {evaluator = (&&) <$> a.evaluator <*> b.evaluator
- ,printer = \c->a.printer ["&&":b.printer c]
- }
-
-//Stmts
-:: Stmt :== Sem ()
-expression :: Set -> Stmt
-expression e = {evaluator = e.evaluator *> pure (), printer = e.printer}
-
-logical :: Logical -> Stmt
-logical e = {evaluator = e.evaluator *> pure (), printer = e.printer}
-
-For :: String Set Stmt -> Stmt
-For i e s =
- { evaluator = (i =. e).evaluator *> s.evaluator
- , printer = \c->["For",i,"=":e.printer ["In":s.printer c]]
- }
-
-If :: Logical Stmt Stmt -> Stmt
-If l s1 s2 =
- { evaluator = l.evaluator >>= \b->if b s1.evaluator s2.evaluator
- , printer = \c->["If":l.printer ["then":s1.printer ["else":s2.printer c]]]
- }
-
-evalSem :: (Sem a) -> (SemState -> Either String a)
-evalSem s = evalStateT s.evaluator
-
-printSem :: (Sem a) -> ([String] -> [String])
-printSem s = s.printer
-
-Start =
- ( evalSem (integer 42 +. integer 42 +. set [] +. integer 4 +. set [42]) 'Map'.newMap
- , join " " $ printSem (integer 42 +. integer 42 +. set [] +. integer 4 +. set [42]) []
- )
repositories / clean-tests.git / blobdiff