Merge branch 'master' of git.martlubbers.net:minfp

[minfp.git] / parse.icl

diff --git a/parse.icl b/parse.icl
index da55517..b812ef9 100644 (file)
--- a/parse.icl
+++ b/parse.icl
@@ -9,13 +9,16 @@ import Data.GenEq
 import Data.Functor
 import Data.Func
 import Data.List
+import Data.Tuple
 import Text.GenPrint
 import StdEnv
 
 import ast
 
+cons x xs = [x:xs]
+
 (<:>) infixl 0 :: a (m [a]) -> m [a] | Functor m
-(<:>) l r = (\xs->[l:xs]) <$> r
+(<:>) l r = cons l <$> r
 
 :: Token = TTSemiColon | TTBrackOpen | TTBrackClose | TTBool Bool | TTInt Int
        | TTOp [Char] | TTIdent [Char]
@@ -83,12 +86,30 @@ pChainl op p = foldl (flip ($)) <$> p <*> many (flip <$> op <*> p)
 pChainr :: (Parser (a a -> a)) (Parser a) -> Parser a
 pChainr op p = flip ($) <$> p <*> (flip <$> op <*> pChainr op p) <|> p
 
-parse :: [Token] -> Either [String] [Function]
+parse :: [Token] -> Either [String] [Either TypeDef Function]
 parse ts = fst <$> runStateT (reverse <$> pAST <* pEof) {tokens=ts, ifxs=[]}
 where
-       pAST :: Parser [Function]
-       pAST = many pFunction >>= mapM \(id, args, body)->Function id args <$
-               modify (\t->{t & tokens=body}) <*> pExpression <* pEof
+       pAST :: Parser [Either TypeDef Function]
+       pAST = many (Right <$> pFunction <|> Left <$> pTypeDef)
+               >>= mapM (either (pure o Left) \(id, args, body)->Right o
+                       Function id args <$ modify (\t->{t & tokens=body}) <*> pExpression <* pEof)
+
+       pTypeDef :: Parser TypeDef
+       pTypeDef = TypeDef
+               <$  pToken (TTOp ['::'])
+               <*> pId
+               <*> many pId
+               <*  pToken (TTOp ['='])
+               <*> (cons <$> pCons <*> many (pToken (TTOp ['|']) *> pCons))
+               <*  pToken TTSemiColon
+
+       pCons = tuple <$> pId <*> many pType
+
+       pType
+               =   TInt  <$ pTop ? (\t->t=:(TTIdent ['Int']))
+               <|> TBool <$ pTop ? (\t->t=:(TTIdent ['Bool']))
+               <|> TVar  <$> pId
+//             <|> 
 
        pId = (\(TTIdent i)->i) <$> pTop ? (\t->t=:(TTIdent _))
        pOp = (\(TTOp i)->i) <$> pTop ? (\t->t=:(TTOp _))
@@ -97,7 +118,7 @@ where
 
        pFunction :: Parser ([Char], [[Char]], [Token])
        pFunction
-               =   (\x y z->(x, y, z))
+               =   tuple3
                <$> (pFunId <|> pId)
                <*> many pId
                <*  pToken (TTOp ['='])