summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPhilFreeman <>2014-01-10 04:55:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2014-01-10 04:55:00 (GMT)
commit8c76ca27dc08843206b3b8eedbc3a3962e88115f (patch)
tree6e312515f1db3459fdf4d90e49b2bc4f6beab4bc
parent5bf0423ba6bf0b30eb0891ea9bcf37706b1af380 (diff)
version 0.2.9.10.2.9.1
-rw-r--r--purescript.cabal2
-rw-r--r--src/Language/PureScript/Optimize.hs12
2 files changed, 9 insertions, 5 deletions
diff --git a/purescript.cabal b/purescript.cabal
index 88a3f88..2b90b20 100644
--- a/purescript.cabal
+++ b/purescript.cabal
@@ -1,5 +1,5 @@
name: purescript
-version: 0.2.9
+version: 0.2.9.1
cabal-version: >=1.8
build-type: Simple
license: MIT
diff --git a/src/Language/PureScript/Optimize.hs b/src/Language/PureScript/Optimize.hs
index 366fd67..63c1470 100644
--- a/src/Language/PureScript/Optimize.hs
+++ b/src/Language/PureScript/Optimize.hs
@@ -121,6 +121,9 @@ tco' = everywhere (mkT convert)
tcoVar :: Ident -> Ident
tcoVar (Ident arg) = Ident $ "__tco_" ++ arg
tcoVar _ = error "Invalid name in tcoVar"
+ copyVar :: Ident -> Ident
+ copyVar (Ident arg) = Ident $ "__copy_" ++ arg
+ copyVar _ = error "Invalid name in copyVar"
convert :: JS -> JS
convert js@(JSVariableIntroduction name (Just fn@(JSFunction Nothing _ _))) =
let
@@ -135,11 +138,11 @@ tco' = everywhere (mkT convert)
convert js = js
collectAllFunctionArgs :: [[Ident]] -> (JS -> JS) -> JS -> ([[Ident]], JS, JS -> JS)
collectAllFunctionArgs allArgs f (JSFunction Nothing args (JSBlock (body@(JSReturn _):_))) =
- collectAllFunctionArgs (args : allArgs) (\b -> f (JSFunction Nothing args (JSBlock [b]))) body
+ collectAllFunctionArgs (args : allArgs) (\b -> f (JSFunction Nothing (map copyVar args) (JSBlock [b]))) body
collectAllFunctionArgs allArgs f (JSReturn (JSFunction Nothing args (JSBlock [body]))) =
- collectAllFunctionArgs (args : allArgs) (\b -> f (JSReturn (JSFunction Nothing args (JSBlock [b])))) body
+ collectAllFunctionArgs (args : allArgs) (\b -> f (JSReturn (JSFunction Nothing (map copyVar args) (JSBlock [b])))) body
collectAllFunctionArgs allArgs f (JSReturn (JSFunction Nothing args body@(JSBlock _))) =
- (args : allArgs, body, \b -> f (JSReturn (JSFunction Nothing args b)))
+ (args : allArgs, body, \b -> f (JSReturn (JSFunction Nothing (map copyVar args) b)))
collectAllFunctionArgs allArgs f body = (allArgs, body, f)
isTailCall :: Ident -> JS -> Bool
isTailCall ident js =
@@ -161,7 +164,8 @@ tco' = everywhere (mkT convert)
countSelfCallsUnderFunctions (JSFunction _ _ js') = everything (+) (mkQ 0 countSelfCalls) js'
countSelfCallsUnderFunctions _ = 0
toLoop :: Ident -> [Ident] -> JS -> JS
- toLoop ident allArgs js = JSBlock
+ toLoop ident allArgs js = JSBlock $
+ map (\arg -> JSVariableIntroduction arg (Just (JSVar (copyVar arg)))) allArgs ++
[ JSLabel tcoLabel $ JSWhile (JSBooleanLiteral True) (JSBlock [ everywhere (mkT loopify) js ]) ]
where
loopify :: JS -> JS