git.iko.soy/elk
on master help sign in
Permit pattern matching on records in case-expressions.
1d04b34evancz
compiler/Gen/Cases.hs+9−2
compare with master
unifiedsplit
@@ -57,8 +57,15 @@ match vs cs def
57
57
58matchVar :: [String] -> [([Pattern],CExpr)] -> Match -> GuidCounter Match
58matchVar :: [String] -> [([Pattern],CExpr)] -> Match -> GuidCounter Match
59matchVar (v:vs) cs def = match vs (map subVar cs) def
59matchVar (v:vs) cs def = match vs (map subVar cs) def
60+ where
61+ subVar (p:ps, ce@(C t s e)) =
62+ let ctx = C t s in
63+ (ps, case p of
60− where subVar (PVar x : ps, C t s e) = (ps, C t s $ subst x (Var v) e)
64+ PVar x -> C t s $ subst x (Var v) e
61− subVar (PAnything : ps, ce) = (ps, ce)
65+ PAnything -> ce
66+ PRecord fs ->
67+ ctx $ foldr (\x -> subst x (Access (ctx (Var v)) x)) e fs
68+ )
62
69
63matchCon :: [String] -> [([Pattern],CExpr)] -> Match -> GuidCounter Match
70matchCon :: [String] -> [([Pattern],CExpr)] -> Match -> GuidCounter Match
64matchCon (v:vs) cs def = (flip (Match v) def) `liftM` mapM toClause css
71matchCon (v:vs) cs def = (flip (Match v) def) `liftM` mapM toClause css
compiler/Transform/Rename.hs+2
@@ -133,6 +133,8 @@ patternExtend pattern env =
133 first (PData name . reverse) `liftM` foldM f ([], env) ps
133 first (PData name . reverse) `liftM` foldM f ([], env) ps
134 where f (rps,env') p = do (rp,env'') <- patternExtend p env'
134 where f (rps,env') p = do (rp,env'') <- patternExtend p env'
135 return (rp:rps, env'')
135 return (rp:rps, env'')
136+ PRecord fs ->
137+ return (pattern, foldr (\f e n -> if n == f then f else env n) env fs)
136
138
137patternRename :: (String -> String) -> (Pattern, CExpr) -> GuidCounter (Pattern, CExpr)
139patternRename :: (String -> String) -> (Pattern, CExpr) -> GuidCounter (Pattern, CExpr)
138patternRename env (p,e) = do
140patternRename env (p,e) = do
compiler/Types/Constrain.hs+11−2
@@ -234,13 +234,13 @@ caseGen tipe (p, ce@(C _ span e)) = do
234 return ( as', Set.union cs cs', t )
234 return ( as', Set.union cs cs', t )
235
235
236patternGen :: (Constraint -> Context Constraint)
236patternGen :: (Constraint -> Context Constraint)
237− -> Type
237+ -> Type -- Type of e in `case e of ...`
238 -> TVarMap
238 -> TVarMap
239 -> Pattern
239 -> Pattern
240 -> GuidCounter (TVarMap, ConstraintSet, Type)
240 -> GuidCounter (TVarMap, ConstraintSet, Type)
241patternGen ctxt tipe as pattern =
241patternGen ctxt tipe as pattern =
242 case pattern of
242 case pattern of
243− PAnything -> do b <- beta ; return (Map.empty, Set.empty, b)
243+ PAnything -> do b <- beta ; return ( as, Set.empty, b )
244 PVar v -> do
244 PVar v -> do
245 b <- beta
245 b <- beta
246 let cs = map (ctxt . (b :=:) . VarT) (Map.findWithDefault [] v as)
246 let cs = map (ctxt . (b :=:) . VarT) (Map.findWithDefault [] v as)
@@ -255,6 +255,15 @@ patternGen ctxt tipe as pattern =
255 return ( Map.insert name [constr] as'
255 return ( Map.insert name [constr] as'
256 , Set.insert (ctxt (VarT constr :=: t)) cs
256 , Set.insert (ctxt (VarT constr :=: t)) cs
257 , output )
257 , 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 )
258
267
259
268
260defScheme :: Def -> GuidCounter (Map.Map String [X], Scheme)
269defScheme :: Def -> GuidCounter (Map.Map String [X], Scheme)