git.iko.soy/Idris-dev
on master help sign in
fixed tail call optim when closuser involved
a254920Rui Barreiro
src/IRTS/CodegenJavaScript.hs+32−6
compare with master
unifiedsplit
@@ -14,24 +14,50 @@ module IRTS.CodegenJavaScript (codegenJavaScript
14import IRTS.CodegenCommon
14import IRTS.CodegenCommon
15import IRTS.JavaScript.Codegen
15import IRTS.JavaScript.Codegen
16import System.Directory
16import System.Directory
17+import System.FilePath
18+import Data.Char
19+import Data.Text (Text)
20+import qualified Data.Text as T
17
21
18
22
19data JSTarget = Node | JavaScript deriving Eq
23data JSTarget = Node | JavaScript deriving Eq
20
24
21
25
26+htmlHeader :: Text
27+htmlHeader =
28+ T.concat [ "<html>\n"
29+ , " <head>\n"
30+ , " <meta charset='utf-8'>\n"
31+ , " </head>\n"
32+ , " <body>\n"
33+ , " <script type='text/javascript'>\n"
34+ ]
35+
36+htmlFooter :: Text
37+htmlFooter =
38+ T.concat [ "\n </script>\n"
39+ , " </body>\n"
40+ , "</html>"
41+ ]
42+
22codegenJavaScript :: CodeGenerator
43codegenJavaScript :: CodeGenerator
23codegenJavaScript ci =
44codegenJavaScript ci =
45+ let (h, f) = if (map toLower $ takeExtension $ outputFile ci) == ".html" then
46+ (htmlHeader, htmlFooter)
47+ else ("","")
24− codegenJs (CGConf { header = ""
48+ in codegenJs (CGConf { header = h
49+ , footer = f
25− , initialization = const ""
50+ , initialization = const ""
26− , writeStrTemplate = "console.log(%0)"
51+ , writeStrTemplate = "console.log(%0)"
27− }
52+ }
28− )
53+ )
29− ci
54+ ci
30
55
31codegenNode :: CodeGenerator
56codegenNode :: CodeGenerator
32codegenNode ci =
57codegenNode ci =
33 do
58 do
34 codegenJs (CGConf { header = "#!/usr/bin/env node\n"
59 codegenJs (CGConf { header = "#!/usr/bin/env node\n"
60+ , footer = ""
35 , initialization = \x -> if usedWriteStr x then "var fs = require('fs');\n" else ""
61 , initialization = \x -> if usedWriteStr x then "var fs = require('fs');\n" else ""
36 , writeStrTemplate = "fs.writeSync(1,%0)"
62 , writeStrTemplate = "fs.writeSync(1,%0)"
37 }
63 }
src/IRTS/JavaScript/AST.hs+24−13
@@ -19,15 +19,18 @@ import Data.Data
19data JsAST = JsEmpty
19data JsAST = JsEmpty
20 | JsNull
20 | JsNull
21 | JsLambda [Text] JsAST
21 | JsLambda [Text] JsAST
22+ | JsCurryLambda [Text] JsAST
22 | JsFun Text [Text] JsAST
23 | JsFun Text [Text] JsAST
23− | JsCurryFun Text [Text] JsAST
24+-- | JsCurryFun Text [Text] JsAST
24 | JsReturn JsAST
25 | JsReturn JsAST
25 | JsApp Text [JsAST]
26 | JsApp Text [JsAST]
26 | JsCurryApp JsAST [JsAST]
27 | JsCurryApp JsAST [JsAST]
27 | JsMethod JsAST Text [JsAST]
28 | JsMethod JsAST Text [JsAST]
28 | JsVar Text
29 | JsVar Text
29 | JsSeq JsAST JsAST
30 | JsSeq JsAST JsAST
30− | JsDecVar Text JsAST
31+ | JsConst Text JsAST
32+ | JsLet Text JsAST
33+ | JsLetList [(Text, JsAST)]
31 | JsSetVar Text JsAST
34 | JsSetVar Text JsAST
32 | JsArrayProj JsAST JsAST
35 | JsArrayProj JsAST JsAST
33 | JsInt Int
36 | JsInt Int
@@ -41,9 +44,11 @@ data JsAST = JsEmpty
41 | JsBinOp Text JsAST JsAST
44 | JsBinOp Text JsAST JsAST
42 | JsForeign Text [JsAST]
45 | JsForeign Text [JsAST]
43 | JsB2I JsAST
46 | JsB2I JsAST
44− | JsWhileTrue JsAST
47+ -- | JsWhileTrue JsAST
48+ | JsFor (JsAST, JsAST, JsAST) JsAST
45 | JsContinue
49 | JsContinue
46 | JsBreak
50 | JsBreak
51+ | JsTrue
47 | JsComment Text
52 | JsComment Text
48 | JsForce JsAST
53 | JsForce JsAST
49 | JsLazy JsAST
54 | JsLazy JsAST
@@ -60,9 +65,9 @@ curryDef :: [Text] -> JsAST -> Text
60curryDef [] body =
65curryDef [] body =
61 jsAst2Text body
66 jsAst2Text body
62curryDef (x:xs) body =
67curryDef (x:xs) body =
63− T.concat [ "return function", "(", x, "){\n"
68+ T.concat [ "(function", "(", x, "){return "
64− , indent $ curryDef xs body
69+ , curryDef xs body
65− , "}\n"
70+ , "})"
66 ]
71 ]
67
72
68
73
@@ -74,18 +79,20 @@ jsAst2Text (JsLambda args body) =
74 , jsAst2Text body
79 , jsAst2Text body
75 , "})"
80 , "})"
76 ]
81 ]
82+jsAst2Text (JsCurryLambda args body) = curryDef args body
77jsAst2Text (JsFun name args body) =
83jsAst2Text (JsFun name args body) =
78− T.concat [ "function ", name, "(", T.intercalate ", " args , "){\n"
84+ T.concat [ "var ", name, " = function(", T.intercalate ", " args , "){\n"
79 , indent $ jsAst2Text body
85 , indent $ jsAst2Text body
80 , "}\n"
86 , "}\n"
81 ]
87 ]
82−jsAst2Text (JsCurryFun name args body) =
88+{-jsAst2Text (JsCurryFun name args body) =
83 T.concat [ "var ", name, " = \n"
89 T.concat [ "var ", name, " = \n"
84 , indent $ T.concat [ "(function(){\n"
90 , indent $ T.concat [ "(function(){\n"
85 , indent $ curryDef args body
91 , indent $ curryDef args body
86 , "})()"
92 , "})()"
87 ]
93 ]
88 ]
94 ]
95+-}
89jsAst2Text (JsReturn x) = T.concat [ "return ", jsAst2Text x]
96jsAst2Text (JsReturn x) = T.concat [ "return ", jsAst2Text x]
90jsAst2Text (JsApp fn args) = T.concat [fn, "(", T.intercalate ", " $ map jsAst2Text args, ")"]
97jsAst2Text (JsApp fn args) = T.concat [fn, "(", T.intercalate ", " $ map jsAst2Text args, ")"]
91jsAst2Text (JsCurryApp fn []) = jsAst2Text fn
98jsAst2Text (JsCurryApp fn []) = jsAst2Text fn
@@ -101,7 +108,9 @@ jsAst2Text (JsVar x) = x
101jsAst2Text (JsSeq JsEmpty y) = jsAst2Text y
108jsAst2Text (JsSeq JsEmpty y) = jsAst2Text y
102jsAst2Text (JsSeq x JsEmpty) = jsAst2Text x
109jsAst2Text (JsSeq x JsEmpty) = jsAst2Text x
103jsAst2Text (JsSeq x y) = T.concat [jsAst2Text x, ";\n", jsAst2Text y]
110jsAst2Text (JsSeq x y) = T.concat [jsAst2Text x, ";\n", jsAst2Text y]
104−jsAst2Text (JsDecVar name exp) = T.concat [ "var ", name, " = ", jsAst2Text exp]
111+jsAst2Text (JsConst name exp) = T.concat [ "const ", name, " = ", jsAst2Text exp]
112+jsAst2Text (JsLet name exp) = T.concat [ "let ", name, " = ", jsAst2Text exp]
113+jsAst2Text (JsLetList lst) = T.concat [ "let ", T.intercalate ", " (map (\(n,v) -> T.concat [n, " = ", jsAst2Text v] ) lst) ]
105jsAst2Text (JsSetVar name exp) = T.concat [ name, " = ", jsAst2Text exp]
114jsAst2Text (JsSetVar name exp) = T.concat [ name, " = ", jsAst2Text exp]
106jsAst2Text (JsArrayProj i exp) = T.concat [ jsAst2Text exp, "[", jsAst2Text i, "]"]
115jsAst2Text (JsArrayProj i exp) = T.concat [ jsAst2Text exp, "[", jsAst2Text i, "]"]
107jsAst2Text (JsInt i) = T.pack $ show i
116jsAst2Text (JsInt i) = T.pack $ show i
@@ -126,15 +135,17 @@ jsAst2Text (JsForeign code args) =
126 args_repl c i (t:r) = args_repl (T.replace ("%" `T.append` T.pack (show i)) t c) (i+1) r
135 args_repl c i (t:r) = args_repl (T.replace ("%" `T.append` T.pack (show i)) t c) (i+1) r
127 in T.concat ["(", args_repl code 0 (map jsAst2Text args), ")"]
136 in T.concat ["(", args_repl code 0 (map jsAst2Text args), ")"]
128jsAst2Text (JsB2I x) = jsAst2Text $ JsBinOp "+" x (JsInt 0)
137jsAst2Text (JsB2I x) = jsAst2Text $ JsBinOp "+" x (JsInt 0)
129−jsAst2Text (JsWhileTrue x) =
138+jsAst2Text (JsFor (x,y,z) w) =
130− T.concat [ "while(true){\n"
139+ T.concat [ "for(", jsAst2Text x , "; ",jsAst2Text y, "; ",jsAst2Text z,"){\n"
131− , indent $ jsAst2Text x
140+ , indent $ jsAst2Text w
132 , "}\n"
141 , "}\n"
133 ]
142 ]
134jsAst2Text JsContinue =
143jsAst2Text JsContinue =
135 "continue"
144 "continue"
136jsAst2Text JsBreak =
145jsAst2Text JsBreak =
137 "break"
146 "break"
147+jsAst2Text JsTrue =
148+ "true"
138jsAst2Text (JsComment c)=
149jsAst2Text (JsComment c)=
139 T.concat ["/*",c,"*/"]
150 T.concat ["/*",c,"*/"]
140jsAst2Text (JsLazy e) =
151jsAst2Text (JsLazy e) =
@@ -159,7 +170,7 @@ throw2 = T.concat [ "var js_idris_throw2 = function (x){\n"
159 ]
170 ]
160
171
161force = T.concat [ "var js_idris_force = function (x){\n"
172force = T.concat [ "var js_idris_force = function (x){\n"
162− , " if(x.js_idris_lazy_calc === undefined){\n"
173+ , " if(x === undefined || x.js_idris_lazy_calc === undefined){\n"
163 , " return x\n"
174 , " return x\n"
164 , " }else{\n"
175 , " }else{\n"
165 , " if(x.js_idris_lazy_val === undefined){\n"
176 , " if(x.js_idris_lazy_val === undefined){\n"
src/IRTS/JavaScript/Codegen.hs+94−39
@@ -48,6 +48,7 @@ emptyStats :: CGStats
48emptyStats = CGStats {usedWriteStr = False}
48emptyStats = CGStats {usedWriteStr = False}
49
49
50data CGConf = CGConf { header :: Text
50data CGConf = CGConf { header :: Text
51+ , footer :: Text
51 , initialization :: CGStats -> Text
52 , initialization :: CGStats -> Text
52 , writeStrTemplate :: Text
53 , writeStrTemplate :: Text
53 }
54 }
@@ -81,7 +82,7 @@ codegenJs conf ci =
81 used `deepseq` if debug then
82 used `deepseq` if debug then
82 do
83 do
83 putStrLn $ "Finished calculating used"
84 putStrLn $ "Finished calculating used"
84− writeFile (outputFile ci ++ ".LDecls") $ (unlines $ intersperse "" $ map show used) ++ "\n\n\n"
85+ writeFile (outputFile ci ++ ".LDeclsDebug") $ (unlines $ intersperse "" $ map show used) ++ "\n\n\n"
85 else pure ()
86 else pure ()
86
87
87 let (out, stats) = doCodegen conf defs used --T.intercalate "\n" $ map (doCodegen conf defs) used
88 let (out, stats) = doCodegen conf defs used --T.intercalate "\n" $ map (doCodegen conf defs) used
@@ -94,8 +95,10 @@ codegenJs conf ci =
94 , includes, "\n"
95 , includes, "\n"
95 , js_aux_defs, "\n"
96 , js_aux_defs, "\n"
96 , out, "\n"
97 , out, "\n"
97− , "\n\n"
98+ , "\n"
99+ , jsName (sMN 0 "runMain"), "();\n\n"
98 , "\n}())"
100 , "\n}())"
101+ , footer conf
99 ]
102 ]
100
103
101jsName :: Name -> Text
104jsName :: Name -> Text
@@ -136,20 +139,43 @@ getNewCGName =
136 put $ st {lastIntName = v}
139 put $ st {lastIntName = v}
137 return $ T.pack $ "cgIdris_" ++ show v
140 return $ T.pack $ "cgIdris_" ++ show v
138
141
142+getNewCGNames :: Int -> State CGBodyState [Text]
143+getNewCGNames n =
144+ mapM (\_ -> getNewCGName) [1..n]
145+
139getConsId :: Name -> State CGBodyState Int
146getConsId :: Name -> State CGBodyState Int
140getConsId n =
147getConsId n =
141 do
148 do
142 st <- get
149 st <- get
143 case lookupCtxtExact n (defs st) of
150 case lookupCtxtExact n (defs st) of
144 Just (LConstructor _ conId _) -> pure conId
151 Just (LConstructor _ conId _) -> pure conId
145− _ -> error $ "ups " ++ showCG n
152+ _ -> error $ "Internal JS Backend error " ++ showCG n ++ " is not a constructor."
146
153
154+getArgList :: Name -> State CGBodyState (Maybe [Name])
155+getArgList n =
156+ do
157+ st <- get
158+ case lookupCtxtExact n (defs st) of
159+ Just (LFun _ _ a _) -> pure $ Just a
160+ _ -> pure Nothing
147
161
148data BodyResTarget = ReturnBT
162data BodyResTarget = ReturnBT
149− | DecVarBT Text
163+ | DecBT Text
150− | SetVarBT Text
164+ | SetBT Text
165+ | DecConstBT Text
151 | GetExpBT
166 | GetExpBT
152
167
168+replaceVarsByProj :: JsAST -> Map Text Int -> JsAST -> JsAST
169+replaceVarsByProj n d z =
170+ transform f z
171+ where
172+ f :: JsAST -> JsAST
173+ f (JsVar x) =
174+ case Map.lookup x d of
175+ Nothing -> (JsVar x)
176+ Just i -> JsArrayProj (JsInt i) n
177+ f x = x
178+
153cgFun :: CGConf -> LDefs -> Name -> [Name] -> LExp -> (JsAST, CGStats)
179cgFun :: CGConf -> LDefs -> Name -> [Name] -> LExp -> (JsAST, CGStats)
154cgFun cnf dfs n args def =
180cgFun cnf dfs n args def =
155 let
181 let
@@ -165,9 +191,15 @@ cgFun cnf dfs n args def =
165 , usedWrite = False
191 , usedWrite = False
166 }
192 }
167 )
193 )
168− body = if isTailRec st then JsWhileTrue $ (seqJs decs) `JsSeq` res `JsSeq` JsBreak
194+ body = if isTailRec st then
195+ JsFor (JsLetList [("cgArgs", JsApp "Array.prototype.slice.call" [JsVar "arguments"]), ("cgArgs2", JsNull) ] , JsTrue, JsSetVar "cgArgs" (JsVar "cgArgs2") ) $
196+ --JsSeq (JsDecVar "cgArgs" $ JsApp "Array.prototype.slice.call" [JsVar "arguments"]) $ JsWhileTrue $
197+ replaceVarsByProj
198+ (JsVar "cgArgs")
199+ (Map.fromList $ zip argNames [0..])
200+ ((seqJs decs) `JsSeq` res)
169 else JsSeq (seqJs decs) res
201 else JsSeq (seqJs decs) res
170− in (JsCurryFun fnName argNames $ body, CGStats {usedWriteStr = usedWrite st})
202+ in (JsFun fnName argNames $ body, CGStats {usedWriteStr = usedWrite st})
171
203
172getSwitchJs :: JsAST -> [LAlt] -> JsAST
204getSwitchJs :: JsAST -> [LAlt] -> JsAST
173getSwitchJs x alts =
205getSwitchJs x alts =
@@ -178,30 +210,61 @@ getSwitchJs x alts =
178
210
179addRT :: BodyResTarget -> JsAST -> JsAST
211addRT :: BodyResTarget -> JsAST -> JsAST
180addRT ReturnBT x = JsReturn x
212addRT ReturnBT x = JsReturn x
181−addRT (DecVarBT n) x = JsDecVar n x
213+addRT (DecBT n) x = JsLet n x
182−addRT (SetVarBT n) x = JsSetVar n x
214+addRT (SetBT n) x = JsSetVar n x
215+addRT (DecConstBT n) x = JsConst n x
183addRT GetExpBT x = x
216addRT GetExpBT x = x
184
217
185cgBody :: BodyResTarget -> LExp -> State CGBodyState ([JsAST], JsAST)
218cgBody :: BodyResTarget -> LExp -> State CGBodyState ([JsAST], JsAST)
186cgBody rt (LV (Glob n)) =
219cgBody rt (LV (Glob n)) =
220+ do
221+ argsFn <- getArgList n
222+ case argsFn of
223+ Just [] ->
224+ pure $ ([], addRT rt $ JsApp (jsName n) [])
225+ Just a ->
226+ do
227+ newNames <- getNewCGNames $ length a
228+ pure ([], addRT rt $ JsCurryLambda newNames (JsApp (jsName n) (map JsVar newNames)))
229+ Nothing ->
187− pure $ ([], addRT rt $ JsVar $ jsName n)
230+ pure $ ([], addRT rt $ JsVar $ jsName n)
188−cgBody rt (LApp _ (LV (Glob fn)) args) =
231+cgBody rt (LApp tailcall (LV (Glob fn)) args) =
189 do
232 do
190 let fname = jsName fn
233 let fname = jsName fn
191 st <- get
234 st <- get
192 let (currFn, argN) = currentFnNameAndArgs st
235 let (currFn, argN) = currentFnNameAndArgs st
193 z <- mapM (cgBody GetExpBT) args
236 z <- mapM (cgBody GetExpBT) args
237+ let argVals = map snd z
194 let preDecs = concat $ map fst z
238 let preDecs = concat $ map fst z
195− case (fname == currFn, rt) of
239+ case (fname == currFn && (length args) == (length argN), rt) of
196 (True, ReturnBT) ->
240 (True, ReturnBT) ->
197 do
241 do
198− put $ st {isTailRec = True}
242+ modify (\x-> x {isTailRec = True})
199− vars <- sequence $ map (\_->getNewCGName) argN
243+ --vars <- getNewCGNames $ length argN --sequence $ map (\_->getNewCGName) argN
244+ let refreshArgs = JsSetVar "cgArgs2" (JsArray argVals)
200− let calcs = map (\(n,v) -> JsDecVar n v) (zip vars (map snd z))
245+ --let calcs = map (\(n,v) -> JsDecVar n v) (zip vars argVals)
201− let calcsToArgs = map (\(n,v) -> JsSetVar n (JsVar v)) (zip argN vars)
246+ --let calcsToArgs = map (\(n,v) -> JsSetVar n (JsVar v)) (zip argN vars)
202− pure (preDecs ++ calcs ++ calcsToArgs, JsContinue)
247+ pure (preDecs, refreshArgs)
203 _ ->
248 _ ->
249+ do
250+ argsFn <- getArgList fn
251+ case argsFn of
252+ Nothing ->
204− pure $ (preDecs, addRT rt $ JsCurryApp (JsVar fname) (map snd z))
253+ pure (preDecs, addRT rt $ JsCurryApp (JsVar fname) argVals )
254+ Just agFn ->
255+ do
256+ let lenAgFn = length agFn
257+ let lenArgs = length args
258+ case compare lenAgFn lenArgs of
259+ EQ ->
260+ pure (preDecs, addRT rt $ JsApp fname argVals)
261+ LT ->
262+ pure (preDecs, addRT rt $ JsCurryApp (JsApp fname (take lenAgFn argVals )) (drop lenAgFn argVals) )
263+ GT ->
264+ do
265+ newNames <- getNewCGNames $ lenAgFn - lenArgs
266+ pure (preDecs, addRT rt $ JsCurryLambda newNames (JsApp fname (argVals ++ (map JsVar newNames) ) ) )
267+
205cgBody rt (LForce (LLazyApp n args)) = cgBody rt (LApp False (LV (Glob n)) args)
268cgBody rt (LForce (LLazyApp n args)) = cgBody rt (LApp False (LV (Glob n)) args)
206cgBody rt (LLazyApp n args) =
269cgBody rt (LLazyApp n args) =
207 do
270 do
@@ -213,7 +276,7 @@ cgBody rt (LForce e) =
213 pure (d, addRT rt $ JsForce v)
276 pure (d, addRT rt $ JsForce v)
214cgBody rt (LLet n v sc) =
277cgBody rt (LLet n v sc) =
215 do
278 do
216− (d1, v1) <- cgBody (DecVarBT $ jsName n) v
279+ (d1, v1) <- cgBody (DecConstBT $ jsName n) v
217 (d2, v2) <- cgBody rt sc
280 (d2, v2) <- cgBody rt sc
218 pure $ ((d1 ++ v1 : d2), v2 )
281 pure $ ((d1 ++ v1 : d2), v2 )
219cgBody rt (LProj e i) =
282cgBody rt (LProj e i) =
@@ -230,17 +293,19 @@ cgBody rt (LCase _ e alts) =
230 resName <- getNewCGName
293 resName <- getNewCGName
231 swName <- getNewCGName
294 swName <- getNewCGName
232 (altsJs,def) <- cgAlts rt resName (JsVar swName) alts
295 (altsJs,def) <- cgAlts rt resName (JsVar swName) alts
233− let decSw = JsDecVar swName v
296+ let decSw = JsConst swName v
234 let sw = JsSwitchCase (getSwitchJs (JsVar swName) alts) altsJs def
297 let sw = JsSwitchCase (getSwitchJs (JsVar swName) alts) altsJs def
235 case rt of
298 case rt of
236 ReturnBT ->
299 ReturnBT ->
237 pure (d ++ [decSw], sw)
300 pure (d ++ [decSw], sw)
238− (DecVarBT nvar) ->
301+ (DecBT nvar) ->
239− pure (d ++ [decSw, JsDecVar nvar JsNull], sw)
302+ pure (d ++ [decSw, JsLet nvar JsNull], sw)
240− (SetVarBT nvar) ->
303+ (SetBT nvar) ->
241 pure (d ++ [decSw], sw)
304 pure (d ++ [decSw], sw)
242 GetExpBT ->
305 GetExpBT ->
243− pure (d ++ [decSw, JsDecVar resName JsNull, sw], JsVar resName)
306+ pure (d ++ [decSw, JsLet resName JsNull, sw], JsVar resName)
307+ (DecConstBT nvar) ->
308+ pure (d ++ [decSw, JsLet nvar JsNull], sw)
244cgBody rt (LConst c) = pure ([], (addRT rt) $ cgConst c)
309cgBody rt (LConst c) = pure ([], (addRT rt) $ cgConst c)
245cgBody rt (LOp op args) =
310cgBody rt (LOp op args) =
246 do
311 do
@@ -256,22 +321,12 @@ cgBody rt x@(LForeign dres (FStr code) args ) =
256 pure $ (concat $ map fst z, addRT rt $ cgForeignRes dres $ JsForeign (T.pack code) jsArgs)
321 pure $ (concat $ map fst z, addRT rt $ cgForeignRes dres $ JsForeign (T.pack code) jsArgs)
257cgBody _ x = error $ "Instruction " ++ show x ++ " not compilable yet"
322cgBody _ x = error $ "Instruction " ++ show x ++ " not compilable yet"
258
323
259−replaceMatchVars :: JsAST -> Map Text Int -> JsAST -> JsAST
260−replaceMatchVars n d z =
261− transform f z
262− where
263− f :: JsAST -> JsAST
264− f (JsVar x) =
265− case Map.lookup x d of
266− Nothing -> (JsVar x)
267− Just i -> JsArrayProj (JsInt i) n
268− f x = x
269−
270altsRT :: Text -> BodyResTarget -> BodyResTarget
324altsRT :: Text -> BodyResTarget -> BodyResTarget
271altsRT rn ReturnBT = ReturnBT
325altsRT rn ReturnBT = ReturnBT
272−altsRT rn (DecVarBT n) = SetVarBT n
326+altsRT rn (DecBT n) = SetBT n
273−altsRT rn (SetVarBT n) = SetVarBT n
327+altsRT rn (SetBT n) = SetBT n
328+altsRT rn (DecConstBT n) = SetBT n
274−altsRT rn GetExpBT = SetVarBT rn
329+altsRT rn GetExpBT = SetBT rn
275
330
276cgAlts :: BodyResTarget -> Text -> JsAST -> [LAlt] -> State CGBodyState ([(JsAST, JsAST)], Maybe JsAST)
331cgAlts :: BodyResTarget -> Text -> JsAST -> [LAlt] -> State CGBodyState ([(JsAST, JsAST)], Maybe JsAST)
277cgAlts rt resName scrvar ((LConstCase t exp):r) =
332cgAlts rt resName scrvar ((LConstCase t exp):r) =
@@ -289,7 +344,7 @@ cgAlts rt resName scrvar ((LConCase _ n args exp):r) =
289 (ar, def) <- cgAlts rt resName scrvar r
344 (ar, def) <- cgAlts rt resName scrvar r
290 conId <- getConsId n
345 conId <- getConsId n
291 -- let branchBody = JsSeq (conCaseToProjs 1 scrvar args) $ JsSeq (seqJs d) v
346 -- let branchBody = JsSeq (conCaseToProjs 1 scrvar args) $ JsSeq (seqJs d) v
292− let replace = replaceMatchVars scrvar (Map.fromList $ zip (map jsName args) [1..])
347+ let replace = replaceVarsByProj scrvar (Map.fromList $ zip (map jsName args) [1..])
293 let branchBody = JsSeq (seqJs $ map replace d) (replace v)
348 let branchBody = JsSeq (seqJs $ map replace d) (replace v)
294 pure ((JsInt conId, branchBody) : ar, def)
349 pure ((JsInt conId, branchBody) : ar, def)
295cgAlts _ _ _ [] =
350cgAlts _ _ _ [] =