f8547cf · elk · git.iko.soy

compiler/Gen/Cases.hs+1−1

compare with master

unifiedsplit

@@ -62,7 +62,7 @@ matchVar (v:vs) cs def = match vs (map subVar cs) def

62 let

63 loc = L t s

64 subOnePattern (PVar x) = subst x (Var v) e

65− subOnePattern (PAtVar x p) =

65+ subOnePattern (PAsVar x p) =

66 subst x (Var v) e

67 subOnePattern PAnything = e

68 subOnePattern (PRecord fs) =

compiler/Model/Ast.hs+2−2

@@ -19,7 +19,7 @@ data ImportMethod = As String | Importing [String] | Hiding [String]

19

20data Pattern = PData String [Pattern]

21 | PRecord [String]

22− | PAtVar String Pattern

22+ | PAsVar String Pattern

23 | PVar String

24 | PAnything

25 deriving (Eq, Data, Typeable)

@@ -83,7 +83,7 @@ instance Show Pattern where

83 case p of

84 PRecord fs -> brkt (intercalate ", " fs)

85 PVar x -> x

86− PAtVar x p -> x ++ "@(" ++ show p ++ ")"

86+ PAsVar x p -> x ++ "@(" ++ show p ++ ")"

87 PAnything -> "_"

88 PData "Cons" [hd@(PData "Cons" _),tl] ->

89 parens (show hd) ++ " :: " ++ show tl

compiler/Parse/Patterns.hs+15−14

@@ -3,7 +3,7 @@ module Parse.Patterns (patternTerm, patternExpr, makeLambda, flattenPatterns) wh

3

4import Ast

5import Located

6−import Control.Applicative ((<$>),(<*>))

6+import Control.Applicative ((<$>),(<*>),(*>),pure)

7import Control.Monad

8import Control.Monad.State

9import Data.Char (isUpper)

@@ -19,12 +19,11 @@ patternBasic =

19 return $ if isUpper c then PData x [] else PVar x

20 ]

21

22−patternMaybeAtVar :: Pattern -> IParser Pattern

22+patternMaybeAsVar :: Pattern -> IParser Pattern

23−patternMaybeAtVar (PVar x) =

23+patternMaybeAsVar x =

24− (char '@' >>

24+ choice [ PAsVar <$>

25− PAtVar x <$> patternExpr) <|>

25+ (optional whitespace *> reserved "as" *> whitespace *> lowVar) <*> pure x,

26− ({- empty -} return $ PVar x)

26+ pure x ]

27−patternMaybeAtVar x = return x

28

27

29patternRecord :: IParser Pattern

28patternRecord :: IParser Pattern

30patternRecord = PRecord <$> brackets (commaSep1 lowVar)

29patternRecord = PRecord <$> brackets (commaSep1 lowVar)

@@ -37,15 +36,17 @@ patternList :: IParser Pattern

37patternList = plist <$> braces (commaSep patternExpr)

36patternList = plist <$> braces (commaSep patternExpr)

38

37

39patternTerm :: IParser Pattern

38patternTerm :: IParser Pattern

40−patternTerm = choice [ patternRecord, patternTuple, patternList,

39+patternTerm = (choice [ patternRecord, patternTuple, patternList,

41− patternMaybeAtVar =<< patternBasic ]

40+ patternBasic ])

42− <?> "pattern"

41+ <?> "pattern"

43

42

44patternConstructor :: IParser Pattern

43patternConstructor :: IParser Pattern

45patternConstructor = PData <$> capVar <*> spacePrefix patternTerm

44patternConstructor = PData <$> capVar <*> spacePrefix patternTerm

46

45

47patternExpr :: IParser Pattern

46patternExpr :: IParser Pattern

47+patternExpr = (patternMaybeAsVar =<<

48−patternExpr = foldr1 pcons <$> consSep1 (patternConstructor <|> patternTerm) <?> "pattern"

48+ (foldr1 pcons <$> consSep1 (patternConstructor <|> patternTerm)))

49+ <?> "pattern"

49

50

50makeLambda :: [Pattern] -> CExpr -> GuidCounter CExpr

51makeLambda :: [Pattern] -> CExpr -> GuidCounter CExpr

51makeLambda pats body = go (reverse pats) body

52makeLambda pats body = go (reverse pats) body

@@ -61,8 +62,8 @@ extract pattern body@(L t s _) =

61 case pattern of

62 case pattern of

62 PAnything -> return $ fn "_" body

63 PAnything -> return $ fn "_" body

63 PVar x -> return $ fn x body

64 PVar x -> return $ fn x body

64− PAtVar x PAnything -> return $ fn x body

65+ PAsVar x PAnything -> return $ fn x body

65− PAtVar x p -> do

66+ PAsVar x p -> do

66 (x', body') <- extract p body

67 (x', body') <- extract p body

67 return $ fn x (loc $ Let [FnDef x' [] (loc $ Var x)] body')

68 return $ fn x (loc $ Let [FnDef x' [] (loc $ Var x)] body')

68 PData name ps -> do

69 PData name ps -> do

@@ -109,7 +110,7 @@ matchSingle pat exp@(L t s _) p =

109 PVar x ->

110 PVar x ->

110 return [ FnDef x [] (loc $ Case exp [(pat, loc $ Var x)]) ]

111 return [ FnDef x [] (loc $ Case exp [(pat, loc $ Var x)]) ]

111

112

112− PAtVar x p' -> do

113+ PAsVar x p' -> do

113 subPat <- matchSingle p' (loc $ Var x) p'

114 subPat <- matchSingle p' (loc $ Var x) p'

114 return $ (FnDef x [] (loc $ Case exp [(pat, loc $ Var x)])):subPat

115 return $ (FnDef x [] (loc $ Case exp [(pat, loc $ Var x)])):subPat

115

116

compiler/Transform/Rename.hs+2−2

@@ -130,10 +130,10 @@ patternExtend pattern env =

130 case pattern of

131 PAnything -> return (PAnything, env)

132 PVar x -> first PVar `liftM` extend env x

133− PAtVar x p -> do

133+ PAsVar x p -> do

134 (x', env') <- extend env x

135 (p', env'') <- patternExtend p env'

136− return (PAtVar x' p', env'')

136+ return (PAsVar x' p', env'')

137 PData name ps ->

138 first (PData name . reverse) `liftM` foldM f ([], env) ps

139 where f (rps,env') p = do (rp,env'') <- patternExtend p env'

compiler/Transform/Replace.hs+1−1

@@ -33,7 +33,7 @@ patternVars pattern =

33 case pattern of

34 PData _ ps -> unions (map patternVars ps)

35 PVar x -> singleton x

36− PAtVar _ p -> patternVars p

36+ PAsVar _ p -> patternVars p

37 PAnything -> empty

38

39depth :: Expr -> Integer

compiler/Types/Constrain.hs+1−1

@@ -259,7 +259,7 @@ patternGen loc tipe as pattern =

259 b <- beta

260 let cs = map (loc . (b :=:) . VarT) (Map.findWithDefault [] v as)

261 return ( Map.delete v as, Set.fromList (loc (b :=: tipe) : cs), b )

262− PAtVar v p -> do

262+ PAsVar v p -> do

263 b <- beta

264 let cs = map (loc . (b :=:) . VarT) (Map.findWithDefault [] v as)

265 (as', cs', tipe') <- patternGen loc b as p