on master help sign in
Permit pattern matching on records in case-expressions.
commit1d04b342d89d65588a698901404aaf971509797c authorevancz <info@elm-lang.org> dateSun 7 Apr 2013, 06:46 (14 years ago) parent60e403b
3 files changed+22−4
compiler/Gen/Cases.hs+9−2 compiler/Transform/Rename.hs+2 compiler/Types/Constrain.hs+11−2
compiler/Gen/Cases.hs+9−2
@@ -57,8 +57,15 @@ match vs cs def
5757
5858matchVar :: [String] -> [([Pattern],CExpr)] -> Match -> GuidCounter Match
5959matchVar (v:vs) cs def = match vs (map subVar cs) def
60− where subVar (PVar x : ps, C t s e) = (ps, C t s $ subst x (Var v) e)
61− subVar (PAnything : ps, ce) = (ps, ce)
60+ where
61+ subVar (p:ps, ce@(C t s e)) =
62+ let ctx = C t s in
63+ (ps, case p of
64+ PVar x -> C t s $ subst x (Var v) e
65+ PAnything -> ce
66+ PRecord fs ->
67+ ctx $ foldr (\x -> subst x (Access (ctx (Var v)) x)) e fs
68+ )
6269
6370matchCon :: [String] -> [([Pattern],CExpr)] -> Match -> GuidCounter Match
6471matchCon (v:vs) cs def = (flip (Match v) def) `liftM` mapM toClause css
compiler/Transform/Rename.hs+2
@@ -133,6 +133,8 @@ patternExtend pattern env =
133133 first (PData name . reverse) `liftM` foldM f ([], env) ps
134134 where f (rps,env') p = do (rp,env'') <- patternExtend p env'
135135 return (rp:rps, env'')
136+ PRecord fs ->
137+ return (pattern, foldr (\f e n -> if n == f then f else env n) env fs)
136138
137139patternRename :: (String -> String) -> (Pattern, CExpr) -> GuidCounter (Pattern, CExpr)
138140patternRename env (p,e) = do
compiler/Types/Constrain.hs+11−2
@@ -234,13 +234,13 @@ caseGen tipe (p, ce@(C _ span e)) = do
234234 return ( as', Set.union cs cs', t )
235235
236236patternGen :: (Constraint -> Context Constraint)
237− -> Type
237+ -> Type -- Type of e in `case e of ...`
238238 -> TVarMap
239239 -> Pattern
240240 -> GuidCounter (TVarMap, ConstraintSet, Type)
241241patternGen ctxt tipe as pattern =
242242 case pattern of
243− PAnything -> do b <- beta ; return (Map.empty, Set.empty, b)
243+ PAnything -> do b <- beta ; return ( as, Set.empty, b )
244244 PVar v -> do
245245 b <- beta
246246 let cs = map (ctxt . (b :=:) . VarT) (Map.findWithDefault [] v as)
@@ -255,6 +255,15 @@ patternGen ctxt tipe as pattern =
255255 return ( Map.insert name [constr] as'
256256 , Set.insert (ctxt (VarT constr :=: t)) cs
257257 , output )
258+ PRecord fs ->
259+ do pairs <- mapM (\f -> do b <- beta; return (f,b)) fs
260+ b <- beta
261+ let t = RecordT (Map.fromList $ map (second (:[])) pairs) b
262+ mkCs (name,tipe) = map (ctxt . (tipe :=:) . VarT)
263+ (Map.findWithDefault [] name as)
264+ return ( foldr Map.delete as fs
265+ , Set.fromList (ctxt (t :=: tipe) : concatMap mkCs pairs)
266+ , t )
258267
259268
260269defScheme :: Def -> GuidCounter (Map.Map String [X], Scheme)