fa07667 · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

Create copies of vars during TCO to prevent capture of state in function call.

commitfa07667651f0c8ad270432b9104bd991f1bb9e2a authorPhil Freeman <paf31@cantab.net> dateThu 9 Jan 2014, 20:54 (13 years ago) parent3e68d75

2 files changed+9−5

compare with golang

unifiedsplit

purescript.cabal+1−1 src/Language/PureScript/Optimize.hs+8−4

purescript.cabal+1−1

@@ -1,5 +1,5 @@

11name: purescript

2−version: 0.2.9

2+version: 0.2.9.1

33cabal-version: >=1.8

44build-type: Simple

55license: MIT

src/Language/PureScript/Optimize.hs+8−4

@@ -121,6 +121,9 @@ tco' = everywhere (mkT convert)

121121 tcoVar :: Ident -> Ident

122122 tcoVar (Ident arg) = Ident $ "__tco_" ++ arg

123123 tcoVar _ = error "Invalid name in tcoVar"

124+ copyVar :: Ident -> Ident

125+ copyVar (Ident arg) = Ident $ "__copy_" ++ arg

126+ copyVar _ = error "Invalid name in copyVar"

124127 convert :: JS -> JS

125128 convert js@(JSVariableIntroduction name (Just fn@(JSFunction Nothing _ _))) =

126129 let

@@ -135,11 +138,11 @@ tco' = everywhere (mkT convert)

135138 convert js = js

136139 collectAllFunctionArgs :: [[Ident]] -> (JS -> JS) -> JS -> ([[Ident]], JS, JS -> JS)

137140 collectAllFunctionArgs allArgs f (JSFunction Nothing args (JSBlock (body@(JSReturn _):_))) =

138− collectAllFunctionArgs (args : allArgs) (\b -> f (JSFunction Nothing args (JSBlock [b]))) body

141+ collectAllFunctionArgs (args : allArgs) (\b -> f (JSFunction Nothing (map copyVar args) (JSBlock [b]))) body

139142 collectAllFunctionArgs allArgs f (JSReturn (JSFunction Nothing args (JSBlock [body]))) =

140− collectAllFunctionArgs (args : allArgs) (\b -> f (JSReturn (JSFunction Nothing args (JSBlock [b])))) body

143+ collectAllFunctionArgs (args : allArgs) (\b -> f (JSReturn (JSFunction Nothing (map copyVar args) (JSBlock [b])))) body

141144 collectAllFunctionArgs allArgs f (JSReturn (JSFunction Nothing args body@(JSBlock _))) =

142− (args : allArgs, body, \b -> f (JSReturn (JSFunction Nothing args b)))

145+ (args : allArgs, body, \b -> f (JSReturn (JSFunction Nothing (map copyVar args) b)))

143146 collectAllFunctionArgs allArgs f body = (allArgs, body, f)

144147 isTailCall :: Ident -> JS -> Bool

145148 isTailCall ident js =

@@ -161,7 +164,8 @@ tco' = everywhere (mkT convert)

161164 countSelfCallsUnderFunctions (JSFunction _ _ js') = everything (+) (mkQ 0 countSelfCalls) js'

162165 countSelfCallsUnderFunctions _ = 0

163166 toLoop :: Ident -> [Ident] -> JS -> JS

164− toLoop ident allArgs js = JSBlock

167+ toLoop ident allArgs js = JSBlock $

168+ map (\arg -> JSVariableIntroduction arg (Just (JSVar (copyVar arg)))) allArgs ++

165169 [ JSLabel tcoLabel $ JSWhile (JSBooleanLiteral True) (JSBlock [ everywhere (mkT loopify) js ]) ]

166170 where

167171 loopify :: JS -> JS