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

diff --combined parse.icl
index 50539f8,da55517..b812ef9
--- 1/parse.icl
--- 2/parse.icl
+++ b/parse.icl
@@@ -9,21 -9,16 +9,19 @@@ import Data.GenE
  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
-       = TTEq | TTSemiColon | TTLambda | TTDot | TTBrackOpen | TTBrackClose
-       | TTComma | TTBool Bool | TTInt Int | TTOp [Char] | TTIdent [Char]
-       | TTDColon | TTPipe
+ :: Token = TTSemiColon | TTBrackOpen | TTBrackClose | TTBool Bool | TTInt Int
+       | TTOp [Char] | TTIdent [Char]
  
  derive gEq Token
  derive gPrint Token
@@@ -48,20 -43,14 +46,14 @@@ lex ['-',t:ts
  lex [t:ts]
        | isSpace t = lex ts
        | isDigit t
-               # (i, ts) = span isDigit [t:ts]
-               = TTInt (toInt (toString i)) <:> lex ts
+               # (d, ts) = span isDigit [t:ts]
+               = TTInt (toInt (toString d)) <:> lex ts
        | isAlpha t
-               # (i, ts) = span isAlpha [t:ts]
-               = TTIdent i <:> lex ts
+               # (d, ts) = span isAlpha [t:ts]
+               = TTIdent d <:> lex ts
        | isOp t
-               # (i, ts) = span isOp [t:ts]
-               | i =: ['='] = TTEq <:> lex ts
-               | i =: [','] = TTComma <:> lex ts
-               | i =: ['.'] = TTDot <:> lex ts
-               | i =: ['\\'] = TTLambda <:> lex ts
-               | i =: ['::'] = TTDColon <:> lex ts
-               | i =: ['|'] = TTPipe <:> lex ts
-               = TTOp i <:> lex ts
+               # (d, ts) = span isOp [t:ts]
+               = TTOp d <:> lex ts
        = Left ["Unexpected: " +++ toString t +++ " ord: " +++ toString (toInt t)]
  where
        isOp c = isMember c ['!@#$%^&*=+/?-_|\\\'",<>.:']
@@@ -94,54 -83,31 +86,49 @@@ pChainl op p = foldl (flip ($)) <$> 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 TTDColon
++              <$  pToken (TTOp ['::'])
 +              <*> pId
 +              <*> many pId
-               <*  pToken TTEq
-               <*> (cons <$> pCons <*> many (pToken TTPipe *> pCons))
++              <*  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
-               <|> 
- :: Type
-       = TVar [Char]
-       | TTuple Type Type
-       | TInt
-       | TBool
-       | (-->) infixr 9 Type Type
++//            <|> 
  
        pId = (\(TTIdent i)->i) <$> pTop ? (\t->t=:(TTIdent _))
        pOp = (\(TTOp i)->i) <$> pTop ? (\t->t=:(TTOp _))
+       pInt = (\(TTInt i)->i) <$> pTop ? (\t->t=:(TTInt _))
        pBrack p = pToken TTBrackOpen *> p <* pToken TTBrackClose
  
        pFunction :: Parser ([Char], [[Char]], [Token])
        pFunction
 -              =   (\x y z->(x, y, z))
 +              =   tuple3
                <$> (pFunId <|> pId)
                <*> many pId
-               <*  pToken TTEq
+               <*  pToken (TTOp ['='])
                <*> many (pTop ? ((=!=)TTSemiColon))
                <*  pToken TTSemiColon
        
        pFunId :: Parser [Char]
        pFunId = pOp
                >>= \i->pChainr <$ pId ? ((==) ['ifxr']) <|> pChainl <$ pId ? ((==)['ifxl'])
-               >>= \p->(\(TTInt i)->i) <$> pTop ? (\t->t=:(TTInt _))
+               >>= \p->pInt
                >>= \s->modify (\t->{t & ifxs=[(p (App o App (Var i) <$ pOp ? ((==)i)), s):t.ifxs]})
                >>| pure i
  
@@@ -149,11 -115,11 +136,11 @@@
        pExpression = getState >>= \{ifxs}->flip (foldr ($))
                        (map fst $ sortBy (on (<) snd) ifxs)
                $   pChainl (pure App)
-               $   Lambda <$ pToken TTLambda <*> pId <* pToken TTDot <*> pExpression
-               <|> pBrack (   Tuple <$> pExpression <* pToken TTComma <*> pExpression
+               $   Lambda <$ pToken (TTOp ['\\']) <*> pId <* pToken (TTOp ['.']) <*> pExpression
+               <|> pBrack (   Tuple <$> pExpression <* pToken (TTOp [',']) <*> pExpression
                               <|> Var <$> pOp
                               <|> pExpression)
-               <|> (\(TTInt i)->Lit (Int i)) <$> pTop ? (\t->t=:(TTInt _))
+               <|> Lit o Int <$> pInt
                <|> (\(TTBool i)->Lit (Bool i)) <$> pTop ? (\t->t=:(TTBool _))
-               <|> (\x->Var ['_':x]) <$ pId ? ((==)['code']) <*> pId
+               <|> (\x->Var ['_':x]) <$ pToken (TTIdent ['code']) <*> pId
                <|> Var <$> pId