Straightforward While lexer, parser and interpreter

1 files changed, 67 insertions, 0 deletions

diff --git a/paper/While/Common.icl b/paper/While/Common.icl
new file mode 100644
index 0000000..4f6e4c4
--- /dev/null
+++ b/paper/While/Common.icl
@@ -0,0 +1,67 @@
+implementation module Common
+
+import StdFunc, StdList, StdString
+
+instance Functor (Either e) where
+	(<$>) f (Left err) = Left err
+	(<$>) f (Right x) = Right (f x)
+
+instance Applicative (Either e) where
+	pure x = Right x
+	(<*>) (Left err) _ = Left err
+	(<*>) (Right f) x = f <$> x
+
+instance Monad (Either e) where
+	(>>=) (Left err) f = Left err
+	(>>=) (Right x) f = f x
+
+instance toString Error
+where
+	toString (Lextime e) = "Lexing error: " +++ e +++ "\n"
+	toString (Parsetime e) = "Parsing error: " +++ e +++ "\n"
+	toString (Runtime e) = "Runtime error: " +++ e +++ "\n"
+	toString (GenericError e) = "Error: " +++ e +++ "\n"
+
+(<+) infixr 5 :: a b -> String | toString a & toString b
+(<+) a b = toString a +++ toString b
+
+($) infixr 0 :: (a -> b) a -> b
+($) f x = f x
+
+(*>) infixl 4 :: (f a) (f b) -> f b | Applicative f
+(*>) fa fb = const id <$> fa <*> fb
+
+(<*) infixl 4 :: (f a) (f b) -> f a | Applicative f
+(<*) fa fb = const <$> fa <*> fb
+
+some :: (f a) -> f [a] | Alternative f
+some v = some_v
+where
+	many_v  = some_v <|> pure []
+	some_v  = (\x xs -> [x:xs]) <$> v <*> many_v
+
+many :: (f a) -> f [a] | Alternative f
+many v = many_v
+where
+	many_v  = some_v <|> pure []
+	some_v  = (\x xs -> [x:xs]) <$> v <*> many_v
+
+sequence :: [a b] -> a [b] | Monad a
+sequence ms = foldr k (pure []) ms
+where k m m` = m >>= \x -> m` >>= \xs -> pure [x:xs]
+
+mapM :: (a -> b c) [a] -> b [c] | Monad b
+mapM f as = sequence (map f as)
+
+foldM :: (a -> (b -> c a)) a [b] -> c a | Monad c
+foldM _ a []      = pure a
+foldM f a [x:xs]  = f a x >>= \fax -> foldM f fax xs
+
+liftM :: (a -> b) (c a) -> c b | Monad c
+liftM f m1 = m1 >>= \x1 -> pure (f x1)
+
+liftM2 :: (a -> (b -> c)) (d a) (d b) -> d c | Monad d
+liftM2 f m1 m2 = m1 >>= \x1 -> m2 >>= \x2 -> pure (f x1 x2)
+
+liftM3 :: (a -> (b -> (c -> d))) (e a) (e b) (e c) -> e d | Monad e
+liftM3 f m1 m2 m3 = m1 >>= \x1 -> m2 >>= \x2 -> m3 >>= \x3 -> pure (f x1 x2 x3)