fa07667 · rowtype-yoga/purescript-native

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

on golang help sign in

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

fa07667Phil Freeman13 years ago

purescript.cabal+1−1

compare with golang

unifiedsplit

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

1name: purescript

2−version: 0.2.9

2+version: 0.2.9.1

3cabal-version: >=1.8

4build-type: Simple

5license: MIT

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

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

121 tcoVar :: Ident -> Ident

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

123 tcoVar _ = error "Invalid name in tcoVar"

124+ copyVar :: Ident -> Ident

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

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

124 convert :: JS -> JS

127 convert :: JS -> JS

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

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

126 let

129 let

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

135 convert js = js

138 convert js = js

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

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

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

140 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

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

142 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

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

144 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)))

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

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

144 isTailCall :: Ident -> JS -> Bool

147 isTailCall :: Ident -> JS -> Bool

145 isTailCall ident js =

148 isTailCall ident js =

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

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

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

162 countSelfCallsUnderFunctions _ = 0

165 countSelfCallsUnderFunctions _ = 0

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

166 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 ++

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

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

166 where

170 where

167 loopify :: JS -> JS

171 loopify :: JS -> JS