git.iko.soy/Idris-dev
on master help sign in
javascript: substitute projections
167e419raichoo
src/IRTS/CodegenJavaScript.hs+44−15
compare with master
unifiedsplit
@@ -229,9 +229,11 @@ jsLet name value body =
229jsSubst :: String -> JS -> JS -> JS
229jsSubst :: String -> JS -> JS -> JS
230jsSubst var new (JSVar old)
230jsSubst var new (JSVar old)
231 | var == translateVariableName old = new
231 | var == translateVariableName old = new
232+ | otherwise = JSVar old
232
233
233jsSubst var new (JSIdent old)
234jsSubst var new (JSIdent old)
234 | var == old = new
235 | var == old = new
236+ | otherwise = JSIdent old
235
237
236jsSubst var new (JSArray fields) =
238jsSubst var new (JSArray fields) =
237 JSArray (map (jsSubst var new) fields)
239 JSArray (map (jsSubst var new) fields)
@@ -241,25 +243,47 @@ jsSubst var new (JSNew con [tag, vals]) =
241
243
242jsSubst var new (JSNew con [JSFunction [] (JSReturn (JSApp fun vars))]) =
244jsSubst var new (JSNew con [JSFunction [] (JSReturn (JSApp fun vars))]) =
243 JSNew con [JSFunction [] (
245 JSNew con [JSFunction [] (
244− JSReturn $ JSApp fun (map (jsSubst var new) vars)
246+ JSReturn $ JSApp (jsSubst var new fun) (map (jsSubst var new) vars)
245 )]
247 )]
246
248
247jsSubst var new (JSApp (JSIdent "__IDRRT__tailcall") [JSFunction [] (
249jsSubst var new (JSApp (JSIdent "__IDRRT__tailcall") [JSFunction [] (
248 JSReturn (JSApp fun args)
250 JSReturn (JSApp fun args)
249 )]) =
251 )]) =
250 JSApp (JSIdent "__IDRRT__tailcall") [JSFunction [] (
252 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)
252 )]
254 )]
253
255
256+jsSubst var new (JSApp (JSProj obj field) args) =
257+ JSApp (JSProj (jsSubst var new obj) field) $ map (jsSubst var new) args
258+
254jsSubst var new (JSApp (JSFunction [arg] body) vals)
259jsSubst var new (JSApp (JSFunction [arg] body) vals)
255 | var /= arg =
260 | var /= arg =
256 JSApp (JSFunction [arg] (
261 JSApp (JSFunction [arg] (
257 jsSubst var new body
262 jsSubst var new body
258 )) $ map (jsSubst var new) vals
263 )) $ map (jsSubst var new) vals
264+ | otherwise =
265+ JSApp (JSFunction [arg] (
266+ body
267+ )) $ map (jsSubst var new) vals
259
268
260jsSubst var new (JSReturn ret) =
269jsSubst var new (JSReturn ret) =
261 JSReturn $ jsSubst var new ret
270 JSReturn $ jsSubst var new ret
262
271
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+
263jsSubst _ _ js = js
287jsSubst _ _ js = js
264
288
265inlineJS :: JS -> JS
289inlineJS :: JS -> JS
@@ -274,16 +298,12 @@ inlineJS (JSApp (JSFunction [arg] (JSReturn ret)) [val])
274 | JSNew con [JSFunction [] (JSReturn (JSApp fun vars))] <- ret
298 | JSNew con [JSFunction [] (JSReturn (JSApp fun vars))] <- ret
275 , opt <- inlineJS val =
299 , opt <- inlineJS val =
276 JSNew con [JSFunction [] (
300 JSNew con [JSFunction [] (
277− JSReturn $ JSApp fun (map (jsSubst arg opt) vars)
301+ JSReturn $ JSApp (jsSubst arg opt fun) (map (jsSubst arg opt) vars)
278 )]
302 )]
279
303
280− | JSApp (JSIdent "__IDRRT__tailcall") [JSFunction [] (
304+ | JSApp (JSProj obj field) args <- ret
281− JSReturn (JSApp fun args)
282− )] <- ret
283 , opt <- inlineJS val =
305 , opt <- inlineJS val =
284− JSApp (JSIdent "__IDRRT__tailcall") [JSFunction [] (
285− JSReturn $ JSApp fun (map (jsSubst arg opt) args)
306+ JSApp (JSProj (jsSubst arg opt obj) field) $ map (jsSubst arg opt) args
286− )]
287
307
288 | JSIndex (JSProj obj field) idx <- ret
308 | JSIndex (JSProj obj field) idx <- ret
289 , opt <- inlineJS val =
309 , opt <- inlineJS val =
@@ -292,9 +312,18 @@ inlineJS (JSApp (JSFunction [arg] (JSReturn ret)) [val])
292 ) field
312 ) field
293 ) (jsSubst arg opt idx)
313 ) (jsSubst arg opt idx)
294
314
295− | JSOp op lhs rhs <- ret =
315+ | JSOp op lhs rhs <- ret
316+ , opt <- inlineJS val =
296− JSOp op (jsSubst arg (inlineJS val) lhs) $
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
297− (jsSubst arg (inlineJS val) rhs)
323+ , opt <- inlineJS val =
324+ JSApp (JSIdent "__IDRRT__tailcall") [JSFunction [] (
325+ JSReturn $ JSApp (jsSubst arg opt fun) (map (jsSubst arg opt) args)
326+ )]
298
327
299inlineJS (JSApp fun args) =
328inlineJS (JSApp fun args) =
300 JSApp (inlineJS fun) (map inlineJS args)
329 JSApp (inlineJS fun) (map inlineJS args)
@@ -306,7 +335,7 @@ inlineJS (JSArray fields) =
306 JSArray (map inlineJS fields)
335 JSArray (map inlineJS fields)
307
336
308inlineJS (JSAssign lhs rhs) =
337inlineJS (JSAssign lhs rhs) =
309− JSAssign lhs (inlineJS rhs)
338+ JSAssign (inlineJS lhs) (inlineJS rhs)
310
339
311inlineJS (JSSeq seq) =
340inlineJS (JSSeq seq) =
312 JSSeq (map inlineJS seq)
341 JSSeq (map inlineJS seq)
@@ -314,8 +343,8 @@ inlineJS (JSSeq seq) =
314inlineJS (JSFunction args body) =
343inlineJS (JSFunction args body) =
315 JSFunction args (inlineJS body)
344 JSFunction args (inlineJS body)
316
345
317−inlineJS (JSProj (JSFunction args body) "apply") =
346+inlineJS (JSProj (JSFunction args body) field) =
318− JSProj (JSFunction args (inlineJS body)) "apply"
347+ JSProj (JSFunction args (inlineJS body)) field
319
348
320inlineJS (JSReturn js) =
349inlineJS (JSReturn js) =
321 JSReturn $ inlineJS js
350 JSReturn $ inlineJS js