parseLetDecl :: Parser Token FunDecl
parseLetDecl = peekPos >>= \p->
satTok LetToken >>|
- (optional parseFunType) >>= \mt->
+ parseFunType >>= \mt->
parseIdent >>= \f->
satTok AssignmentToken >>|
parseExpr >>= \e->
satTok SColonToken >>|
- pure (FunDecl p f [] mt [] [ReturnStmt $ Just e])
+ pure (FunDecl p f [] (Just mt) [] [ReturnStmt $ Just e])
parseFunDecl :: Parser Token FunDecl
parseFunDecl = liftM6 FunDecl
parseOneLine = pure <$> parseStmt
parseFunType :: Parser Token Type
-parseFunType = parseFT
+parseFunType = parseFT >>= \t -> case t of
+ t1 ->> t2 = pure t
+ simpleT = pure $ FuncType simpleT
where
parseFT :: Parser Token Type
parseFT = (liftM2 (->>) (parseSF <* satTok ArrowToken) (parseFT)) <|>
- parseSF <|>
- (FuncType <$> parseType)
+ parseSF
parseSF :: Parser Token Type
- parseSF = parseBBraces parseFT
+ parseSF = parseBBraces parseFT <|> parseType
parseVarDecl :: Parser Token VarDecl
parseVarDecl = liftM4 VarDecl
derive gPrint TokenValue
derive gEq TokenValue
satTok :: TokenValue -> Parser Token Token
-satTok t = top >>= \tok=:({line,col},token) -> if (eq t token)
+satTok t = top >>= \tok=:({line,col},token) -> if (tokEq t token)
(pure tok) (fail <?> PositionalError line col
("ParseError: Unexpected token: " +++ printToString token
+++ "\nExpected: " +++ printToString t))
- where
- eq (IdentToken _) (IdentToken _) = True
- eq (NumberToken _) (NumberToken _) = True
- eq (CharToken _) (CharToken _) = True
- eq (StringToken _) (StringToken _) = True
- eq x y = gEq {|*|} x y
+
+tokEq (IdentToken _) (IdentToken _) = True
+tokEq (NumberToken _) (NumberToken _) = True
+tokEq (CharToken _) (CharToken _) = True
+tokEq (StringToken _) (StringToken _) = True
+tokEq x y = gEq {|*|} x y
parseSepList :: TokenValue (Parser Token a) -> Parser Token [a]
parseSepList sep p =
(case expected of
Nothing = pure zero
Just (FuncType expected_) = lift (unify expected_ given)
- Just expected_ = lift (unify expected_ given))
- >>= \s3 ->
+ Just expected_ = lift (unify expected_ given)
+ ) >>= \s3 ->
let ftype = subst (compose s3 $ compose s2 s1) given in
- (case expected of
- Just (FuncType _) = pure (FuncType ftype)
- _ = pure ftype)
- >>= \ftype_->
+ (case ftype of
+ _ ->> _ = pure ftype
+ _ = pure $ FuncType ftype
+ ) >>= \ftype_->
generalize ftype_ >>= \t->
putGamma outerScope >>|
changeGamma (extend f t) >>|