f8547cf · elk · git.iko.soy

git.iko.soy/elk

Update 'at patterns' to use the as notation per mailing list discussion

commitf8547cf4bed85d0bda7b6fde89e76be42bb3a22d authorAndrew Miller <ak.miller@auckland.ac.nz> dateFri 7 Jun 2013, 12:53 (13 years ago) parent3c71ee1

6 files changed+22−21

compare with master

unifiedsplit

compiler/Gen/Cases.hs+1−1 compiler/Model/Ast.hs+2−2 compiler/Parse/Patterns.hs+15−14 compiler/Transform/Rename.hs+2−2 compiler/Transform/Replace.hs+1−1 compiler/Types/Constrain.hs+1−1

compiler/Gen/Cases.hs+1−1

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

6262 let

6363 loc = L t s

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

65− subOnePattern (PAtVar x p) =

65+ subOnePattern (PAsVar x p) =

6666 subst x (Var v) e

6767 subOnePattern PAnything = e

6868 subOnePattern (PRecord fs) =

compiler/Model/Ast.hs+2−2

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

1919

2020data Pattern = PData String [Pattern]

2121 | PRecord [String]

22− | PAtVar String Pattern

22+ | PAsVar String Pattern

2323 | PVar String

2424 | PAnything

2525 deriving (Eq, Data, Typeable)

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

8383 case p of

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

8585 PVar x -> x

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

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

8787 PAnything -> "_"

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

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

compiler/Parse/Patterns.hs+15−14

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

44import Ast

55import Located

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

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

77import Control.Monad

88import Control.Monad.State

99import Data.Char (isUpper)

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

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

2020 ]

2121

22−patternMaybeAtVar :: Pattern -> IParser Pattern

23−patternMaybeAtVar (PVar x) =

24− (char '@' >>

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

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

27−patternMaybeAtVar x = return x

22+patternMaybeAsVar :: Pattern -> IParser Pattern

23+patternMaybeAsVar x =

24+ choice [ PAsVar <$>

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

26+ pure x ]

2827

2928patternRecord :: IParser Pattern

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

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

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

3837

3938patternTerm :: IParser Pattern

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

41− patternMaybeAtVar =<< patternBasic ]

42− <?> "pattern"

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

40+ patternBasic ])

41+ <?> "pattern"

4342

4443patternConstructor :: IParser Pattern

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

4645

4746patternExpr :: IParser Pattern

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

47+patternExpr = (patternMaybeAsVar =<<

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

49+ <?> "pattern"

4950

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

5152makeLambda pats body = go (reverse pats) body

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

6162 case pattern of

6263 PAnything -> return $ fn "_" body

6364 PVar x -> return $ fn x body

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

65− PAtVar x p -> do

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

66+ PAsVar x p -> do

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

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

6869 PData name ps -> do

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

109110 PVar x ->

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

111112

112− PAtVar x p' -> do

113+ PAsVar x p' -> do

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

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

115116

compiler/Transform/Rename.hs+2−2

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

130130 case pattern of

131131 PAnything -> return (PAnything, env)

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

133− PAtVar x p -> do

133+ PAsVar x p -> do

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

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

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

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

137137 PData name ps ->

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

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

compiler/Transform/Replace.hs+1−1

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

3333 case pattern of

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

3535 PVar x -> singleton x

36− PAtVar _ p -> patternVars p

36+ PAsVar _ p -> patternVars p

3737 PAnything -> empty

3838

3939depth :: Expr -> Integer

compiler/Types/Constrain.hs+1−1

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

259259 b <- beta

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

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

262− PAtVar v p -> do

262+ PAsVar v p -> do

263263 b <- beta

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

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