-

[clean-tests.git] / afp / a7 / a7.icl

diff --git a/afp/a7/a7.icl b/afp/a7/a7.icl
deleted file mode 100644 (file)
index b3d3c88..0000000
--- a/afp/a7/a7.icl
+++ /dev/null
@@ -1,108 +0,0 @@
-module a7
-
-import StdEnv
-
-import qualified Data.Map as Map
-
-import Data.Func
-import Data.Functor
-import Data.Maybe
-import Data.Tuple
-import Control.Applicative
-import Control.Monad
-
-:: Gram
-       = Lit String
-       | Idn
-       | Int
-       | Seq [Gram]
-       | Alt [Gram]
-       | Def Name Gram Gram
-       | Var Name
-:: Name :== String
-:: State = {input :: [String], store :: Store}
-:: Store :== 'Map'.Map Name Gram
-:: Parse a = Parse (State -> (Maybe a, State))
-:: TREE = LIT String | IDN String | INT Int | SEQ [TREE]
-
-runParse :: (Parse a) -> (State -> (Maybe a, State))
-runParse (Parse a) = a
-
-instance Functor Parse where fmap f a = Parse (appFst (fmap f) <$> runParse a)
-instance Applicative Parse
-where
-       pure a = Parse (tuple (pure a))
-       <*> fab fb = Parse \s->let
-                  (mab, (mb, s`)) = appSnd (runParse fb) (runParse fab s)
-               in (mab <*> mb, s`)
-instance Monad Parse
-where
-       bind ma a2mb = Parse \s->case runParse ma s of
-               (Just a, s`) = runParse (a2mb a) s`
-               (Nothing, s`) = (Nothing, s`)
-
-instance Alternative Parse
-where
-       empty = Parse (tuple Nothing)
-       <|> ma mb = Parse \s->case runParse ma s of
-               (Nothing, _) = runParse mb s
-               t = t
-
-next :: Parse String
-next = Parse \s->case s.input of
-       [] = (Nothing, s)
-       [i:is] = (Just i, {s & input=is})
-
-setGram :: Name Gram -> Parse Gram
-setGram n g = Parse \s->(Just g, {s & store='Map'.put n g s.store})
-
-getGram :: Name -> Parse Gram
-getGram n = Parse \s->('Map'.get n s.store, s)
-
-(?) infix 5 :: (a -> Bool) (Parse a) -> Parse a
-(?) p pa = pa >>= \a->if (p a) (pure a) empty
-
-parse :: Gram -> Parse TREE
-parse (Lit s) = LIT <$> ((==)s) ? next
-parse Idn = IDN <$> (\s->isAlpha s.[0]) ? next
-parse Int = INT o toInt <$> (\s->toString (toInt s) == s) ? next
-parse (Seq gs) = SEQ <$> sequence (map parse gs)
-parse (Alt as) = foldr (<|>) empty (map parse as)
-parse (Def n g1 g2) = setGram n g1 *> parse g2
-parse (Var n) = getGram n >>= parse
-parse _ = empty
-
-run :: Gram [String] -> Maybe TREE
-run g t = fst (runParse (parse g) {store='Map'.newMap,input=t})
-
-Start = (evalList <$> run listIntGram listIntInput, evalArith <$> run arithGram arithInput)
-where
-       listIntInput = ["mylist","=","[","7",":","[","42",":","[]","]","]"]
-       arithInput = ["12","*","2","+","4","*","3","*","2","-","6"]
-
-listIntGram :: Gram
-listIntGram
-       = Def "list" (Alt [Lit "[]",Seq [Lit "[",Int,Lit ":",Var "list",Lit "]"]])
-       $ Seq [Idn,Lit "=",Var "list"]
-
-arithGram :: Gram
-arithGram
-       = Def "fac" (Alt [Seq [Int, Lit "*", Var "fac"], Int])
-       $ Def "exp" (Alt [Seq [Var "fac", Lit "+", Var "exp"], Var "fac"])
-       $ Var "exp"
-
-evalList :: TREE -> Maybe [Int]
-evalList (LIT "[]") = Just []
-evalList (SEQ [LIT "[", INT i, LIT ":", r, LIT "]"]) = evalList r >>= \r->pure [i:r]
-evalList (SEQ [IDN _, LIT "=", l]) = evalList l
-evalList _ = Nothing
-
-evalArith :: TREE -> Maybe Int
-evalArith (INT i) = Just i
-evalArith (SEQ [a, LIT op, b]) = toOp op <*> evalArith a <*> evalArith b
-where
-       toOp :: String -> Maybe (Int Int -> Int)
-       toOp "+" = Just (+)
-       toOp "*" = Just (*)
-       toOp _ = Nothing
-evalArith _ = Nothing