git.iko.soy/elk
on master help sign in
cosmetic
01593aaEvan Czaplicki
compiler/Generate/Cases.hs+14−11
compare with master
unifiedsplit
@@ -13,7 +13,6 @@ import qualified SourceSyntax.Pattern as P
13import qualified SourceSyntax.Variable as V
13import qualified SourceSyntax.Variable as V
14import Transform.Substitute
14import Transform.Substitute
15
15
16−
17toMatch :: [(P.Pattern, Expr)] -> State Int (String, Match)
16toMatch :: [(P.Pattern, Expr)] -> State Int (String, Match)
18toMatch patterns = do
17toMatch patterns = do
19 v <- newVar
18 v <- newVar
@@ -37,16 +36,19 @@ data Clause =
37 deriving Show
36 deriving Show
38
37
39matchSubst :: [(String,String)] -> Match -> Match
38matchSubst :: [(String,String)] -> Match -> Match
40−matchSubst _ Break = Break
39+matchSubst pairs match =
40+ case match of
41+ Break -> Break
41−matchSubst _ Fail = Fail
42+ Fail -> Fail
42−matchSubst pairs (Seq ms) = Seq (map (matchSubst pairs) ms)
43+ Seq ms -> Seq (map (matchSubst pairs) ms)
43−matchSubst pairs (Other (A a e)) =
44+ Other (A a e) ->
44− Other . A a $ foldr ($) e $ map (\(x,y) -> subst x (rawVar y)) pairs
45+ Other . A a $ foldr ($) e $ map (\(x,y) -> subst x (rawVar y)) pairs
45−matchSubst pairs (Match n cs m) =
46+ Match n cs m ->
46− Match (varSubst n) (map clauseSubst cs) (matchSubst pairs m)
47+ Match (varSubst n) (map clauseSubst cs) (matchSubst pairs m)
48+ where
47− where varSubst v = fromMaybe v (lookup v pairs)
49+ varSubst v = fromMaybe v (lookup v pairs)
48− clauseSubst (Clause c vs m) =
50+ clauseSubst (Clause c vs m) =
49− Clause c (map varSubst vs) (matchSubst pairs m)
51+ Clause c (map varSubst vs) (matchSubst pairs m)
50
52
51isCon (p:_, _) =
53isCon (p:_, _) =
52 case p of
54 case p of
@@ -68,6 +70,7 @@ match vs@(v:_) cs def
68 where
70 where
69 cs' = map (dealias v) cs
71 cs' = map (dealias v) cs
70
72
73+dealias :: String -> ([P.Pattern],Expr) -> ([P.Pattern],Expr)
71dealias v c@(p:ps, A a e) =
74dealias v c@(p:ps, A a e) =
72 case p of
75 case p of
73 P.Alias x pattern -> (pattern:ps, A a $ subst x (rawVar v) e)
76 P.Alias x pattern -> (pattern:ps, A a $ subst x (rawVar v) e)
compiler/Generate/JavaScript.hs+2
@@ -255,9 +255,11 @@ match region mtch =
255 return [ ExprStmt () (obj "_E.Case" `call` [ref "$moduleName", string (renderPretty region)]) ]
255 return [ ExprStmt () (obj "_E.Case" `call` [ref "$moduleName", string (renderPretty region)]) ]
256
256
257 Case.Break -> return [BreakStmt () Nothing]
257 Case.Break -> return [BreakStmt () Nothing]
258+
258 Case.Other e ->
259 Case.Other e ->
259 do e' <- expression e
260 do e' <- expression e
260 return [ ret e' ]
261 return [ ret e' ]
262+
261 Case.Seq ms -> concat <$> mapM (match region) (dropEnd [] ms)
263 Case.Seq ms -> concat <$> mapM (match region) (dropEnd [] ms)
262 where
264 where
263 dropEnd acc [] = acc
265 dropEnd acc [] = acc