git.iko.soy/elk
on master help sign in
Merge branch 'stable'
62498fcEvan 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+8−5
@@ -55,6 +55,7 @@ expression :: Expr -> State Int (Expression ())
55expression (A region expr) =
55expression (A region expr) =
56 case expr of
56 case expr of
57 Var (V.Raw x) -> return $ obj x
57 Var (V.Raw x) -> return $ obj x
58+
58 Literal lit -> return $ literal lit
59 Literal lit -> return $ literal lit
59
60
60 Range lo hi ->
61 Range lo hi ->
@@ -215,19 +216,19 @@ definition (Definition pattern expr@(A region _) _) = do
215 decl x n = varDecl x (dotSep ["$","_" ++ show n])
216 decl x n = varDecl x (dotSep ["$","_" ++ show n])
216 setup vars
217 setup vars
217 | Help.isTuple name = assign "$" : vars
218 | Help.isTuple name = assign "$" : vars
218− | otherwise = assign "$raw" : safeAssign : vars
219+ | otherwise = assign "_raw" : safeAssign : vars
219
220
220− safeAssign = varDecl "$" (CondExpr () if' (obj "$raw") exception)
221+ safeAssign = varDecl "$" (CondExpr () if' (obj "_raw") exception)
221− if' = InfixExpr () OpStrictEq (obj "$raw.ctor") (string name)
222+ if' = InfixExpr () OpStrictEq (obj "_raw.ctor") (string name)
222 exception = obj "_E.Case" `call` [ref "$moduleName", string (renderPretty region)]
223 exception = obj "_E.Case" `call` [ref "$moduleName", string (renderPretty region)]
223
224
224 _ ->
225 _ ->
225 do defs' <- concat <$> mapM toDef vars
226 do defs' <- concat <$> mapM toDef vars
226− return (VarDeclStmt () [assign "$"] : defs')
227+ return (VarDeclStmt () [assign "_"] : defs')
227 where
228 where
228 vars = P.boundVarList pattern
229 vars = P.boundVarList pattern
229 mkVar = A region . rawVar
230 mkVar = A region . rawVar
230− toDef y = let expr = A region $ Case (mkVar "$") [(pattern, mkVar y)]
231+ toDef y = let expr = A region $ Case (mkVar "_") [(pattern, mkVar y)]
231 in definition $ Definition (P.Var y) expr Nothing
232 in definition $ Definition (P.Var y) expr Nothing
232
233
233match :: Region -> Case.Match -> State Int [Statement ()]
234match :: Region -> Case.Match -> State Int [Statement ()]
@@ -254,9 +255,11 @@ match region mtch =
254 return [ ExprStmt () (obj "_E.Case" `call` [ref "$moduleName", string (renderPretty region)]) ]
255 return [ ExprStmt () (obj "_E.Case" `call` [ref "$moduleName", string (renderPretty region)]) ]
255
256
256 Case.Break -> return [BreakStmt () Nothing]
257 Case.Break -> return [BreakStmt () Nothing]
258+
257 Case.Other e ->
259 Case.Other e ->
258 do e' <- expression e
260 do e' <- expression e
259 return [ ret e' ]
261 return [ ret e' ]
262+
260 Case.Seq ms -> concat <$> mapM (match region) (dropEnd [] ms)
263 Case.Seq ms -> concat <$> mapM (match region) (dropEnd [] ms)
261 where
264 where
262 dropEnd acc [] = acc
265 dropEnd acc [] = acc