parseclass/pc.icl

   1 module pc
   2
   3
   4 import StdEnv => qualified abs
   5
   6 import Data.Either
   7 import Data.Functor
   8 import Data.Func
   9 import Data.Tuple
  10 import Control.Applicative
  11 import Control.Monad
  12 import Text.Parsers.Simple.ParserCombinators
  13
  14 class type a | toString a
  15
  16 class lit v where
  17         lit :: a -> v a | type a
  18 class lambda v where
  19         abs :: ((v a) -> v b) -> v (a -> b)
  20         (@) infixl 9 :: (v (a -> b)) (v a) -> v b
  21 class tupl v where
  22         tupl :: (v a) (v b) -> v (a, b)
  23         first :: (v (a, b)) -> v a
  24         second :: (v (a, b)) -> v b
  25
  26 //Pretty printing
  27 :: Show a = Show (Int [String] -> [String])
  28 show :: (Show a) -> String
  29 show a = foldr (+++) "" (unShow a 0 [])
  30 unShow (Show a) = a
  31 instance lit Show where
  32         lit a = Show \i c->[toString a:c]
  33 instance lambda Show where
  34         abs l = Show \i c->let showV = Show \_ c->["\\v",toString i:c]
  35                 in ["(":unShow showV i [".":unShow (l showV) (i+1) [")":c]]]
  36         (@) f x = Show \i c->["(":unShow f i [" ":unShow x i [")":c]]]
  37 instance tupl Show where
  38         tupl l r = Show \i c->["(":unShow l i [",":unShow r i c]]
  39         first t = Show \i c->unShow t i [".fst":c]
  40         second t = Show \i c->unShow t i [".second":c]
  41
  42 //Evaluation
  43 :: Eval a = Eval a
  44 eval = unEval
  45 unEval (Eval a) = a
  46 instance lit Eval where
  47         lit a = Eval a
  48 instance lambda Eval where
  49         abs l = Eval $ unEval o l o Eval
  50         (@) f x = Eval o unEval f o unEval $ x
  51 instance tupl Eval where
  52         tupl l r = Eval (unEval l, unEval r)
  53         first t = Eval o fst o unEval $ t
  54         second t = Eval o snd o unEval $ t
  55
  56 //Parsing
  57 class parser a :: Parser Char a
  58 instance parser Int where
  59         parser = foldl (\a b->10*a + digitToInt b) 0 <$> some pDigit <* many pSpace
  60 instance parser (a, b) | parser a & parser b where
  61         parser = tuple <$ pToken '(' <*> parser <* pToken ',' <*> parser <* pToken ')'
  62
  63 :: T = E.e: T e & type e
  64 instance toString T where toString (T e) = toString e
  65 instance toString (a, b) | toString a & toString b where
  66         toString (a, b) = "(" +++ toString a +++ "," +++ toString b +++ ")"
  67
  68 pIdent = toString <$> some pAlpha
  69 pBracket p = pToken '(' *> p <* pToken ')'
  70
  71 eparser :: Parser Char (v T) | lit v
  72 eparser
  73         = lit <$> litparser
  74
  75 litparser :: Parser Char T
  76 litparser
  77         // parse Int
  78         =   T o foldl (\a b->10*a+digitToInt b) 0 <$> some pDigit
  79         // parse tuple
  80         <|> pBracket ((\(T a) (T b)->T (a, b)) <$> litparser <* pToken ',' <*> litparser)
  81
  82 Start = show <$> parse eparser ['(42,(44,45))']
  83 //Start :: (String, Int, Either [String] AST)
  84 //Start = (show t, eval t, parse parser ['(\\x.\\y.x)42 43'])
  85 //where
  86 //      t :: v Int | tupl, lambda, lit v
  87 //      t = (abs \x->abs \y->x) @ lit 42 @ lit 43