on master help sign in
javascript: substitute projections
commit167e4193e262a9c67de5340678fbe48a4a3ad38e authorraichoo <raichoo@googlemail.com> dateSun 13 Oct 2013, 18:18 (13 years ago) parentd2f5480
1 file changed+44−15
src/IRTS/CodegenJavaScript.hs+44−15
src/IRTS/CodegenJavaScript.hs+44−15
@@ -229,9 +229,11 @@ jsLet name value body =
229229jsSubst :: String -> JS -> JS -> JS
230230jsSubst var new (JSVar old)
231231 | var == translateVariableName old = new
232+ | otherwise = JSVar old
232233
233234jsSubst var new (JSIdent old)
234235 | var == old = new
236+ | otherwise = JSIdent old
235237
236238jsSubst var new (JSArray fields) =
237239 JSArray (map (jsSubst var new) fields)
@@ -241,25 +243,47 @@ jsSubst var new (JSNew con [tag, vals]) =
241243
242244jsSubst var new (JSNew con [JSFunction [] (JSReturn (JSApp fun vars))]) =
243245 JSNew con [JSFunction [] (
244− JSReturn $ JSApp fun (map (jsSubst var new) vars)
246+ JSReturn $ JSApp (jsSubst var new fun) (map (jsSubst var new) vars)
245247 )]
246248
247249jsSubst var new (JSApp (JSIdent "__IDRRT__tailcall") [JSFunction [] (
248250 JSReturn (JSApp fun args)
249251 )]) =
250252 JSApp (JSIdent "__IDRRT__tailcall") [JSFunction [] (
251− JSReturn $ JSApp fun (map (jsSubst var new) args)
253+ JSReturn $ JSApp (jsSubst var new fun) (map (jsSubst var new) args)
252254 )]
253255
256+jsSubst var new (JSApp (JSProj obj field) args) =
257+ JSApp (JSProj (jsSubst var new obj) field) $ map (jsSubst var new) args
258+
254259jsSubst var new (JSApp (JSFunction [arg] body) vals)
255260 | var /= arg =
256261 JSApp (JSFunction [arg] (
257262 jsSubst var new body
258263 )) $ map (jsSubst var new) vals
264+ | otherwise =
265+ JSApp (JSFunction [arg] (
266+ body
267+ )) $ map (jsSubst var new) vals
259268
260269jsSubst var new (JSReturn ret) =
261270 JSReturn $ jsSubst var new ret
262271
272+jsSubst var new (JSProj obj field) =
273+ JSProj (jsSubst var new obj) field
274+
275+jsSubst var new (JSSeq body) =
276+ JSSeq $ map (jsSubst var new) body
277+
278+jsSubst var new (JSOp op lhs rhs) =
279+ JSOp op (jsSubst var new lhs) (jsSubst var new rhs)
280+
281+jsSubst var new (JSIndex obj field) =
282+ JSIndex (jsSubst var new obj) (jsSubst var new field)
283+
284+jsSubst var new (JSCond conds) =
285+ JSCond (map ((jsSubst var new) *** (jsSubst var new)) conds)
286+
263287jsSubst _ _ js = js
264288
265289inlineJS :: JS -> JS
@@ -274,16 +298,12 @@ inlineJS (JSApp (JSFunction [arg] (JSReturn ret)) [val])
274298 | JSNew con [JSFunction [] (JSReturn (JSApp fun vars))] <- ret
275299 , opt <- inlineJS val =
276300 JSNew con [JSFunction [] (
277− JSReturn $ JSApp fun (map (jsSubst arg opt) vars)
301+ JSReturn $ JSApp (jsSubst arg opt fun) (map (jsSubst arg opt) vars)
278302 )]
279303
280− | JSApp (JSIdent "__IDRRT__tailcall") [JSFunction [] (
281− JSReturn (JSApp fun args)
282− )] <- ret
304+ | JSApp (JSProj obj field) args <- ret
283305 , opt <- inlineJS val =
284− JSApp (JSIdent "__IDRRT__tailcall") [JSFunction [] (
285− JSReturn $ JSApp fun (map (jsSubst arg opt) args)
286− )]
306+ JSApp (JSProj (jsSubst arg opt obj) field) $ map (jsSubst arg opt) args
287307
288308 | JSIndex (JSProj obj field) idx <- ret
289309 , opt <- inlineJS val =
@@ -292,9 +312,18 @@ inlineJS (JSApp (JSFunction [arg] (JSReturn ret)) [val])
292312 ) field
293313 ) (jsSubst arg opt idx)
294314
295− | JSOp op lhs rhs <- ret =
296− JSOp op (jsSubst arg (inlineJS val) lhs) $
297− (jsSubst arg (inlineJS val) rhs)
315+ | JSOp op lhs rhs <- ret
316+ , opt <- inlineJS val =
317+ JSOp op (jsSubst arg opt lhs) $
318+ (jsSubst arg opt rhs)
319+
320+ | JSApp (JSIdent "__IDRRT__tailcall") [JSFunction [] (
321+ JSReturn (JSApp fun args)
322+ )] <- ret
323+ , opt <- inlineJS val =
324+ JSApp (JSIdent "__IDRRT__tailcall") [JSFunction [] (
325+ JSReturn $ JSApp (jsSubst arg opt fun) (map (jsSubst arg opt) args)
326+ )]
298327
299328inlineJS (JSApp fun args) =
300329 JSApp (inlineJS fun) (map inlineJS args)
@@ -306,7 +335,7 @@ inlineJS (JSArray fields) =
306335 JSArray (map inlineJS fields)
307336
308337inlineJS (JSAssign lhs rhs) =
309− JSAssign lhs (inlineJS rhs)
338+ JSAssign (inlineJS lhs) (inlineJS rhs)
310339
311340inlineJS (JSSeq seq) =
312341 JSSeq (map inlineJS seq)
@@ -314,8 +343,8 @@ inlineJS (JSSeq seq) =
314343inlineJS (JSFunction args body) =
315344 JSFunction args (inlineJS body)
316345
317−inlineJS (JSProj (JSFunction args body) "apply") =
318− JSProj (JSFunction args (inlineJS body)) "apply"
346+inlineJS (JSProj (JSFunction args body) field) =
347+ JSProj (JSFunction args (inlineJS body)) field
319348
320349inlineJS (JSReturn js) =
321350 JSReturn $ inlineJS js