From: Mart Lubbers <mart@martlubbers.net>
Date: Mon, 18 Feb 2019 06:57:03 +0000 (+0100)
Subject: parseclas
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=3842e90cb6c88f3073c433d30b52c3e2985df521;p=clean-tests.git

parseclas
---

diff --git a/parseclass/pc.icl b/parseclass/pc.icl
new file mode 100644
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