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]
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 _))
pFunction :: Parser ([Char], [[Char]], [Token])
pFunction
- = (\x y z->(x, y, z))
+ = tuple3
<$> (pFunId <|> pId)
<*> many pId
<* pToken (TTOp ['='])