aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--ast/CC/Source.hs6
-rw-r--r--ast/CC/Typed.hs19
-rw-r--r--parser/CC/Parser.hs31
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