diff --git a/compiler/Gen/Cases.hs b/compiler/Gen/Cases.hs index da602a2..8607860 100644 --- a/compiler/Gen/Cases.hs +++ b/compiler/Gen/Cases.hs @@ -62,7 +62,7 @@ matchVar (v:vs) cs def = match vs (map subVar cs) def let loc = L t s subOnePattern (PVar x) = subst x (Var v) e - subOnePattern (PAtVar x p) = + subOnePattern (PAsVar x p) = subst x (Var v) e subOnePattern PAnything = e subOnePattern (PRecord fs) = diff --git a/compiler/Model/Ast.hs b/compiler/Model/Ast.hs index ea948a7..a5ee232 100644 --- a/compiler/Model/Ast.hs +++ b/compiler/Model/Ast.hs @@ -19,7 +19,7 @@ data ImportMethod = As String | Importing [String] | Hiding [String] data Pattern = PData String [Pattern] | PRecord [String] - | PAtVar String Pattern + | PAsVar String Pattern | PVar String | PAnything deriving (Eq, Data, Typeable) @@ -83,7 +83,7 @@ instance Show Pattern where case p of PRecord fs -> brkt (intercalate ", " fs) PVar x -> x - PAtVar x p -> x ++ "@(" ++ show p ++ ")" + PAsVar x p -> x ++ "@(" ++ show p ++ ")" PAnything -> "_" PData "Cons" [hd@(PData "Cons" _),tl] -> parens (show hd) ++ " :: " ++ show tl diff --git a/compiler/Parse/Patterns.hs b/compiler/Parse/Patterns.hs index 9fca5fb..ddc1176 100644 --- a/compiler/Parse/Patterns.hs +++ b/compiler/Parse/Patterns.hs @@ -3,7 +3,7 @@ module Parse.Patterns (patternTerm, patternExpr, makeLambda, flattenPatterns) wh import Ast import Located -import Control.Applicative ((<$>),(<*>)) +import Control.Applicative ((<$>),(<*>),(*>),pure) import Control.Monad import Control.Monad.State import Data.Char (isUpper) @@ -19,12 +19,11 @@ patternBasic = return $ if isUpper c then PData x [] else PVar x ] -patternMaybeAtVar :: Pattern -> IParser Pattern -patternMaybeAtVar (PVar x) = - (char '@' >> - PAtVar x <$> patternExpr) <|> - ({- empty -} return $ PVar x) -patternMaybeAtVar x = return x +patternMaybeAsVar :: Pattern -> IParser Pattern +patternMaybeAsVar x = + choice [ PAsVar <$> + (optional whitespace *> reserved "as" *> whitespace *> lowVar) <*> pure x, + pure x ] patternRecord :: IParser Pattern patternRecord = PRecord <$> brackets (commaSep1 lowVar) @@ -37,15 +36,17 @@ patternList :: IParser Pattern patternList = plist <$> braces (commaSep patternExpr) patternTerm :: IParser Pattern -patternTerm = choice [ patternRecord, patternTuple, patternList, - patternMaybeAtVar =<< patternBasic ] - "pattern" +patternTerm = (choice [ patternRecord, patternTuple, patternList, + patternBasic ]) + "pattern" patternConstructor :: IParser Pattern patternConstructor = PData <$> capVar <*> spacePrefix patternTerm patternExpr :: IParser Pattern -patternExpr = foldr1 pcons <$> consSep1 (patternConstructor <|> patternTerm) "pattern" +patternExpr = (patternMaybeAsVar =<< + (foldr1 pcons <$> consSep1 (patternConstructor <|> patternTerm))) + "pattern" makeLambda :: [Pattern] -> CExpr -> GuidCounter CExpr makeLambda pats body = go (reverse pats) body @@ -61,8 +62,8 @@ extract pattern body@(L t s _) = case pattern of PAnything -> return $ fn "_" body PVar x -> return $ fn x body - PAtVar x PAnything -> return $ fn x body - PAtVar x p -> do + PAsVar x PAnything -> return $ fn x body + PAsVar x p -> do (x', body') <- extract p body return $ fn x (loc $ Let [FnDef x' [] (loc $ Var x)] body') PData name ps -> do @@ -109,7 +110,7 @@ matchSingle pat exp@(L t s _) p = PVar x -> return [ FnDef x [] (loc $ Case exp [(pat, loc $ Var x)]) ] - PAtVar x p' -> do + PAsVar x p' -> do subPat <- matchSingle p' (loc $ Var x) p' return $ (FnDef x [] (loc $ Case exp [(pat, loc $ Var x)])):subPat diff --git a/compiler/Transform/Rename.hs b/compiler/Transform/Rename.hs index e6c668c..c22f1e7 100644 --- a/compiler/Transform/Rename.hs +++ b/compiler/Transform/Rename.hs @@ -130,10 +130,10 @@ patternExtend pattern env = case pattern of PAnything -> return (PAnything, env) PVar x -> first PVar `liftM` extend env x - PAtVar x p -> do + PAsVar x p -> do (x', env') <- extend env x (p', env'') <- patternExtend p env' - return (PAtVar x' p', env'') + return (PAsVar x' p', env'') PData name ps -> first (PData name . reverse) `liftM` foldM f ([], env) ps where f (rps,env') p = do (rp,env'') <- patternExtend p env' diff --git a/compiler/Transform/Replace.hs b/compiler/Transform/Replace.hs index 28595e7..43772db 100644 --- a/compiler/Transform/Replace.hs +++ b/compiler/Transform/Replace.hs @@ -33,7 +33,7 @@ patternVars pattern = case pattern of PData _ ps -> unions (map patternVars ps) PVar x -> singleton x - PAtVar _ p -> patternVars p + PAsVar _ p -> patternVars p PAnything -> empty depth :: Expr -> Integer diff --git a/compiler/Types/Constrain.hs b/compiler/Types/Constrain.hs index 8c44121..209f489 100644 --- a/compiler/Types/Constrain.hs +++ b/compiler/Types/Constrain.hs @@ -259,7 +259,7 @@ patternGen loc tipe as pattern = b <- beta let cs = map (loc . (b :=:) . VarT) (Map.findWithDefault [] v as) return ( Map.delete v as, Set.fromList (loc (b :=: tipe) : cs), b ) - PAtVar v p -> do + PAsVar v p -> do b <- beta let cs = map (loc . (b :=:) . VarT) (Map.findWithDefault [] v as) (as', cs', tipe') <- patternGen loc b as p