parseclas

diff --git a/parseclass/pc.icl b/parseclass/pc.icl
new file mode 100644 (file)
index 0000000..d9b5959
--- /dev/null
+++ b/parseclass/pc.icl
@@ -0,0 +1,88 @@
+module pc
+
+
+import StdEnv => qualified abs
+
+import Data.Either
+import Data.Functor
+import Data.Func
+import Data.Tuple
+import Control.Applicative
+import Control.Monad
+import Text.Parsers.Simple.ParserCombinators
+
+class type a | toString a
+
+class lit v where
+       lit :: a -> v a | type a
+class lambda v where
+       abs :: ((v a) -> v b) -> v (a -> b)
+       (@) infixl 9 :: (v (a -> b)) (v a) -> v b
+class tupl v where
+       tupl :: (v a) (v b) -> v (a, b)
+       first :: (v (a, b)) -> v a
+       second :: (v (a, b)) -> v b
+
+//Pretty printing
+:: Show a = Show (Int [String] -> [String])
+show :: (Show a) -> String
+show a = foldr (+++) "" (unShow a 0 [])
+unShow (Show a) = a
+instance lit Show where
+       lit a = Show \i c->[toString a:c]
+instance lambda Show where
+       abs l = Show \i c->let showV = Show \_ c->["\\v",toString i:c]
+               in ["(":unShow showV i [".":unShow (l showV) (i+1) [")":c]]]
+       (@) f x = Show \i c->["(":unShow f i [" ":unShow x i [")":c]]]
+instance tupl Show where
+       tupl l r = Show \i c->["(":unShow l i [",":unShow r i c]]
+       first t = Show \i c->unShow t i [".fst":c]
+       second t = Show \i c->unShow t i [".second":c]
+
+//Evaluation
+:: Eval a = Eval a
+eval = unEval
+unEval (Eval a) = a
+instance lit Eval where
+       lit a = Eval a
+instance lambda Eval where
+       abs l = Eval $ unEval o l o Eval
+       (@) f x = Eval o unEval f o unEval $ x
+instance tupl Eval where
+       tupl l r = Eval (unEval l, unEval r)
+       first t = Eval o fst o unEval $ t
+       second t = Eval o snd o unEval $ t
+
+//Parsing
+class parser a :: Parser Char a
+instance parser Int where
+       parser = foldl (\a b->10*a + digitToInt b) 0 <$> some pDigit <* many pSpace
+instance parser (a, b) | parser a & parser b where
+       parser = tuple <$ pToken '(' <*> parser <* pToken ',' <*> parser <* pToken ')'
+
+:: T = E.e: T e & type e
+instance toString T where toString (T e) = toString e
+instance toString (a, b) | toString a & toString b where
+       toString (a, b) = "(" +++ toString a +++ "," +++ toString b +++ ")"
+
+pIdent = toString <$> some pAlpha
+pBracket p = pToken '(' *> p <* pToken ')'
+
+eparser :: Parser Char (v T) | lit v
+eparser
+       = litparser
+
+
+litparser :: Parser Char T
+litparser
+       // parse Int
+       =   T o foldl (\a b->10*a+digitToInt b) 0 <$> some pDigit
+       // parse tuple
+       <|> pBracket ((\(T a) (T b)->T (a, b)) <$> litparser <* pToken ',' <*> litparser)
+
+Start = show <$> parse eparser ['(42,(44,45))']
+//Start :: (String, Int, Either [String] AST)
+//Start = (show t, eval t, parse parser ['(\\x.\\y.x)42 43'])
+//where
+//     t :: v Int | tupl, lambda, lit v
+//     t = (abs \x->abs \y->x) @ lit 42 @ lit 43