diff options
| -rw-r--r-- | ast/CC/Source.hs | 6 | ||||
| -rw-r--r-- | ast/CC/Typed.hs | 19 | ||||
| -rw-r--r-- | parser/CC/Parser.hs | 31 |
3 files changed, 37 insertions, 19 deletions
diff --git a/ast/CC/Source.hs b/ast/CC/Source.hs index 81e691b..080b850 100644 --- a/ast/CC/Source.hs +++ b/ast/CC/Source.hs @@ -20,9 +20,11 @@ data Type = TFun Type Type | TInt deriving (Show, Read) -data Expr = Call SourceRange Expr Expr +data Expr = Lam SourceRange [(Name, SourceRange)] Expr + | Call SourceRange Expr Expr | Int SourceRange Int | Var SourceRange Name + | Annot SourceRange Expr Type deriving (Show, Read) instance Pretty Type where @@ -31,6 +33,8 @@ instance Pretty Type where precParens p 2 (prettyPrec 3 a ++ " -> " ++ prettyPrec 2 b) instance HasRange Expr where + range (Lam sr _ _) = sr range (Call sr _ _) = sr range (Int sr _) = sr range (Var sr _) = sr + range (Annot sr _ _) = sr diff --git a/ast/CC/Typed.hs b/ast/CC/Typed.hs index 5b8ed38..535fd31 100644 --- a/ast/CC/Typed.hs +++ b/ast/CC/Typed.hs @@ -7,13 +7,10 @@ import CC.Pretty import CC.Types -data ProgramT = ProgramT [DeclT] +data ProgramT = ProgramT [DefT] deriving (Show, Read) -data DeclT = DefT DefT -- import? - deriving (Show, Read) - -data DefT = FunctionT TypeT Name [Name] ExprT +data DefT = DefT Name ExprT deriving (Show, Read) data TypeT = TFunT TypeT TypeT @@ -21,16 +18,17 @@ data TypeT = TFunT TypeT TypeT | TyVar Int deriving (Show, Read) -data ExprT = CallT TypeT ExprT ExprT +data ExprT = LamT TypeT Occ ExprT + | CallT TypeT ExprT ExprT | IntT Int | VarT Occ deriving (Show, Read) --- | Occurrence of a variable data Occ = Occ Name TypeT deriving (Show, Read) exprType :: ExprT -> TypeT +exprType (LamT typ _ _) = typ exprType (CallT typ _ _) = typ exprType (IntT _) = TIntT exprType (VarT (Occ _ typ)) = typ @@ -55,10 +53,7 @@ instance Pretty ExprT where show n ++ " :: " ++ pretty t instance Pretty DefT where - pretty (FunctionT n e) = n ++ " = " ++ pretty e - -instance Pretty DeclT where - pretty (DefT def) = pretty def + pretty (DefT n e) = n ++ " = " ++ pretty e instance Pretty ProgramT where - pretty (ProgramT decls) = concatMap ((++ "\n") . pretty) decls + pretty (ProgramT defs) = concatMap ((++ "\n") . pretty) defs diff --git a/parser/CC/Parser.hs b/parser/CC/Parser.hs index d6c2239..d9e5b40 100644 --- a/parser/CC/Parser.hs +++ b/parser/CC/Parser.hs @@ -54,9 +54,31 @@ pTypeAtom :: Parser Type pTypeAtom = (wordToken "Int" >> return TInt) <|> between (token "(") (token ")") pType pExpr :: Parser Expr -pExpr = lab "expression" $ do - atoms <- many1 pExprAtom - return (foldl1 (\a b -> Call (mergeRange (range a) (range b)) a b) atoms) +pExpr = label (pCall <|> pLam) "expression" + where + pCall = do + atoms <- many1 pExprAtom + annot <- optionMaybe (do symbol "::" + p1 <- getPosition + ty <- pType + p2 <- getPosition + return (ty, SourceRange p1 p2)) + let call = foldl1 (\a b -> Call (mergeRange (range a) (range b)) a b) atoms + case annot of + Just (ty, sr) -> return (Annot (mergeRange (range call) sr) call ty) + Nothing -> return call + + pLam = do + p1 <- try $ do + whitespace + p <- getPosition + void (char '\\') + return p + names <- many1 pName + symbol "->" + body <- pExpr + p2 <- getPosition + return (Lam (SourceRange p1 p2) names body) pExprAtom :: Parser Expr pExprAtom = @@ -106,9 +128,6 @@ emptyLines = (try (whitespace >> newline) >> emptyLines) <|> try (whitespace >> whitespace :: Parser () whitespace = void (many (char ' ')) -lab :: String -> Parser a -> Parser a -lab = flip label - getPosition :: Parser SourcePos getPosition = do pos <- Text.Parsec.getPosition |