git.iko.soy/Idris-dev
on master help sign in
javascript: remove identity functions
16fe40draichoo
src/IRTS/CodegenJavaScript.hs+69−4
compare with master
unifiedsplit
@@ -334,6 +334,74 @@ inlineJS js = js
334reduceJS :: [JS] -> [JS]
334reduceJS :: [JS] -> [JS]
335reduceJS js = reduceLoop [] ([], js)
335reduceJS js = reduceLoop [] ([], js)
336
336
337+funName :: JS -> String
338+funName (JSAlloc fun _) = fun
339+
340+removeIDs :: [JS] -> [JS]
341+removeIDs js =
342+ case partition isID js of
343+ ([], rest) -> rest
344+ (ids, rest) -> removeIDs $ map (removeIDCall (map idFor ids)) rest
345+ where isID :: JS -> Bool
346+ isID (JSAlloc _ (Just (JSFunction _ (JSSeq body))))
347+ | JSReturn (JSVar _) <- last body = True
348+
349+ isID _ = False
350+
351+ idFor :: JS -> (String, Int)
352+ idFor (JSAlloc fun (Just (JSFunction _ (JSSeq body))))
353+ | JSReturn (JSVar (Loc pos)) <- last body = (fun, pos)
354+
355+ removeIDCall :: [(String, Int)] -> JS -> JS
356+ removeIDCall ids (JSApp (JSIdent "__IDRRT__tailcall") [JSFunction [] (
357+ JSReturn (JSApp (JSIdent fun) args)
358+ )])
359+ | Just pos <- lookup fun ids
360+ , pos < length args = args !! pos
361+
362+ removeIDCall ids (JSNew _ [JSFunction [] (
363+ JSReturn (JSApp (JSIdent fun) args)
364+ )])
365+ | Just pos <- lookup fun ids
366+ , pos < length args = args !! pos
367+
368+ removeIDCall ids js@(JSApp id@(JSIdent fun) args)
369+ | Just pos <- lookup fun ids
370+ , pos < length args = args !! pos
371+
372+ removeIDCall ids (JSAlloc fun (Just body)) =
373+ JSAlloc fun (Just $ removeIDCall ids body)
374+
375+ removeIDCall ids (JSReturn js) =
376+ JSReturn $ removeIDCall ids js
377+
378+ removeIDCall ids (JSSeq js) =
379+ JSSeq $ map (removeIDCall ids) js
380+
381+ removeIDCall ids (JSNew con args) =
382+ JSNew con $ map (removeIDCall ids) args
383+
384+ removeIDCall ids (JSFunction args body) =
385+ JSFunction args $ removeIDCall ids body
386+
387+ removeIDCall ids (JSApp fun args) =
388+ JSApp (removeIDCall ids fun) $ map (removeIDCall ids) args
389+
390+ removeIDCall ids (JSProj obj field) =
391+ JSProj (removeIDCall ids obj) field
392+
393+ removeIDCall ids (JSCond conds) =
394+ JSCond $ map (removeIDCall ids *** removeIDCall ids) conds
395+
396+ removeIDCall ids (JSAssign lhs rhs) =
397+ JSAssign (removeIDCall ids lhs) (removeIDCall ids rhs)
398+
399+ removeIDCall ids (JSArray fields) =
400+ JSArray $ map (removeIDCall ids) fields
401+
402+ removeIDCall _ js = js
403+
404+
337reduceLoop :: [String] -> ([JS], [JS]) -> [JS]
405reduceLoop :: [String] -> ([JS], [JS]) -> [JS]
338reduceLoop reduced (cons, program) =
406reduceLoop reduced (cons, program) =
339 case partition findConstructors program of
407 case partition findConstructors program of
@@ -363,9 +431,6 @@ reduceLoop reduced (cons, program) =
363
431
364 reduce js = js
432 reduce js = js
365
433
366− funName :: JS -> String
367− funName (JSAlloc fun _) = fun
368−
369 reduceCall :: [String] -> JS -> JS
434 reduceCall :: [String] -> JS -> JS
370 reduceCall funs (JSApp (JSIdent "__IDRRT__tailcall") [JSFunction [] (
435 reduceCall funs (JSApp (JSIdent "__IDRRT__tailcall") [JSFunction [] (
371 JSReturn (JSApp id@(JSIdent ret) _)
436 JSReturn (JSApp id@(JSIdent ret) _)
@@ -448,7 +513,7 @@ codegenJavaScript target definitions filename outputType = do
448
513
449 functions :: [String]
514 functions :: [String]
450 functions =
515 functions =
451− map compileJS (reduceJS $ map (optimizeJS . translateDeclaration) def)
516+ map compileJS ((reduceJS . removeIDs) $ map (optimizeJS . translateDeclaration) def)
452
517
453 mainLoop :: String
518 mainLoop :: String
454 mainLoop = compileJS $
519 mainLoop = compileJS $