462d4f2 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

on master help sign in

improvment in tailcall optim usage of variables

462d4f2Rui Barreiro9 years ago

src/IRTS/JavaScript/AST.hs+11−6

compare with master

unifiedsplit

@@ -30,7 +30,7 @@ data JsAST = JsEmpty

30 | JsSeq JsAST JsAST

31 | JsConst Text JsAST

32 | JsLet Text JsAST

33− | JsLetList [(Text, JsAST)]

33+ -- | JsLetList [(Text, JsAST)]

34 | JsSetVar Text JsAST

35 | JsArrayProj JsAST JsAST

36 | JsInt Int

@@ -44,8 +44,8 @@ data JsAST = JsEmpty

44 | JsBinOp Text JsAST JsAST

45 | JsForeign Text [JsAST]

46 | JsB2I JsAST

47− -- | JsWhileTrue JsAST

47+ | JsWhileTrue JsAST

48− | JsFor (JsAST, JsAST, JsAST) JsAST

48+ -- | JsFor (JsAST, JsAST, JsAST) JsAST

49 | JsContinue

50 | JsBreak

51 | JsTrue

@@ -110,7 +110,7 @@ jsAst2Text (JsSeq x JsEmpty) = jsAst2Text x

110jsAst2Text (JsSeq x y) = T.concat [jsAst2Text x, ";\n", jsAst2Text y]

111jsAst2Text (JsConst name exp) = T.concat [ "const ", name, " = ", jsAst2Text exp]

112jsAst2Text (JsLet name exp) = T.concat [ "let ", name, " = ", jsAst2Text exp]

113−jsAst2Text (JsLetList lst) = T.concat [ "let ", T.intercalate ", " (map (\(n,v) -> T.concat [n, " = ", jsAst2Text v] ) lst) ]

113+--jsAst2Text (JsLetList lst) = T.concat [ "let ", T.intercalate ", " (map (\(n,v) -> T.concat [n, " = ", jsAst2Text v] ) lst) ]

114jsAst2Text (JsSetVar name exp) = T.concat [ name, " = ", jsAst2Text exp]

115jsAst2Text (JsArrayProj i exp) = T.concat [ jsAst2Text exp, "[", jsAst2Text i, "]"]

116jsAst2Text (JsInt i) = T.pack $ show i

@@ -135,11 +135,16 @@ jsAst2Text (JsForeign code args) =

135 args_repl c i (t:r) = args_repl (T.replace ("%" `T.append` T.pack (show i)) t c) (i+1) r

136 in T.concat ["(", args_repl code 0 (map jsAst2Text args), ")"]

137jsAst2Text (JsB2I x) = jsAst2Text $ JsBinOp "+" x (JsInt 0)

138−jsAst2Text (JsFor (x,y,z) w) =

138+jsAst2Text (JsWhileTrue w) =

139− T.concat [ "for(", jsAst2Text x , "; ",jsAst2Text y, "; ",jsAst2Text z,"){\n"

139+ T.concat [ "while(true){\n"

140 , indent $ jsAst2Text w

141 , "}\n"

142 ]

143+{-jsAst2Text (JsFor (x,y,z) w) =

144+ T.concat [ "for(", jsAst2Text x , "; ",jsAst2Text y, "; ",jsAst2Text z,"){\n"

145+ , indent $ jsAst2Text w

146+ , "}\n"

147+ ]-}

143jsAst2Text JsContinue =

148jsAst2Text JsContinue =

144 "continue"

149 "continue"

145jsAst2Text JsBreak =

150jsAst2Text JsBreak =

src/IRTS/JavaScript/Codegen.hs+30−8

@@ -113,6 +113,9 @@ jsName n = T.pack $ "idris_" ++ concatMap jschar (showCG n)

113jsPartialName :: Partial -> Text

114jsPartialName (Partial n i j) = T.concat ["partial_", T.pack $ show i, "_", T.pack $ show j, "_" , jsName n]

115

116+jsTailCallOptimName :: Text -> Text

117+jsTailCallOptimName x = T.concat ["tailCallOptim_cgIdris_", x]

118+

116doPartials :: Set Partial -> Text

119doPartials :: Set Partial -> Text

117doPartials x =

120doPartials x =

118 T.intercalate "\n" (map f $ Set.toList x)

121 T.intercalate "\n" (map f $ Set.toList x)

@@ -145,6 +148,7 @@ seqJs (x:xs) = JsSeq x (seqJs xs)

145data CGBodyState = CGBodyState { defs :: LDefs

148data CGBodyState = CGBodyState { defs :: LDefs

146 , lastIntName :: Int

149 , lastIntName :: Int

147 , currentFnNameAndArgs :: (Text, [Text])

150 , currentFnNameAndArgs :: (Text, [Text])

151+ , usedArgsTailCallOptim :: Set (Text, Text)

148 , isTailRec :: Bool

152 , isTailRec :: Bool

149 , conf :: CGConf

153 , conf :: CGConf

150 , usedWrite :: Bool

154 , usedWrite :: Bool

@@ -163,6 +167,9 @@ addPartial :: Partial -> State CGBodyState ()

163addPartial p =

167addPartial p =

164 modify (\s -> s {partialApps = Set.insert p (partialApps s) })

168 modify (\s -> s {partialApps = Set.insert p (partialApps s) })

165

169

170+addUsedArgsTailCallOptim :: Set (Text, Text) -> State CGBodyState ()

171+addUsedArgsTailCallOptim p =

172+ modify (\s -> s {usedArgsTailCallOptim = Set.union p (usedArgsTailCallOptim s) })

166

173

167getNewCGNames :: Int -> State CGBodyState [Text]

174getNewCGNames :: Int -> State CGBodyState [Text]

168getNewCGNames n =

175getNewCGNames n =

@@ -211,6 +218,7 @@ cgFun cnf dfs n args def =

211 (CGBodyState { defs=dfs

218 (CGBodyState { defs=dfs

212 , lastIntName = 0

219 , lastIntName = 0

213 , currentFnNameAndArgs = (fnName, argNames)

220 , currentFnNameAndArgs = (fnName, argNames)

221+ , usedArgsTailCallOptim = Set.empty

214 , isTailRec = False

222 , isTailRec = False

215 , conf = cnf

223 , conf = cnf

216 , usedWrite = False

224 , usedWrite = False

@@ -218,12 +226,10 @@ cgFun cnf dfs n args def =

218 }

226 }

219 )

227 )

220 body = if isTailRec st then

228 body = if isTailRec st then

221− JsFor (JsLetList [("cgArgs", JsApp "Array.prototype.slice.call" [JsVar "arguments"]), ("cgArgs2", JsNull) ] , JsTrue, JsSetVar "cgArgs" (JsVar "cgArgs2") ) $

229+ JsSeq

222− replaceVarsByProj

230+ (declareUsedOptimArgs $ usedArgsTailCallOptim st)

223− (JsVar "cgArgs")

224− (Map.fromList $ zip argNames [0..])

225− ((seqJs decs) `JsSeq` res)

231+ (JsWhileTrue ((seqJs decs) `JsSeq` res))

226− else JsSeq (seqJs decs) res

232+ else (seqJs decs) `JsSeq` res

227 in (JsFun fnName argNames $ body, CGStats {usedWriteStr = usedWrite st, partialApplications = partialApps st})

233 in (JsFun fnName argNames $ body, CGStats {usedWriteStr = usedWrite st, partialApplications = partialApps st})

228

234

229getSwitchJs :: JsAST -> [LAlt] -> JsAST

235getSwitchJs :: JsAST -> [LAlt] -> JsAST

@@ -240,6 +246,20 @@ addRT (SetBT n) x = JsSetVar n x

240addRT (DecConstBT n) x = JsConst n x

246addRT (DecConstBT n) x = JsConst n x

241addRT GetExpBT x = x

247addRT GetExpBT x = x

242

248

249+declareUsedOptimArgs :: Set (Text, Text) -> JsAST

250+declareUsedOptimArgs x = seqJs $ map (\(x,y) -> JsLet x (JsVar y) ) (Set.toList x)

251+

252+tailCallOptimRefreshArgs :: [(Text, JsAST)] -> Set Text -> ((JsAST, JsAST), Set (Text, Text))

253+tailCallOptimRefreshArgs [] s = ((JsEmpty, JsEmpty), Set.empty)

254+tailCallOptimRefreshArgs ((n,x):r) s =

255+ let ((y1,y2), y3) = tailCallOptimRefreshArgs r (Set.insert n s) --

256+ in if Set.null $ (Set.fromList [ z | z <- universeBi x ]) `Set.intersection` s then

257+ ((y1, JsSetVar n x `JsSeq` y2), y3)

258+ else

259+ let n' = jsTailCallOptimName n

260+ in ((JsSetVar n' x `JsSeq` y1, JsSetVar n (JsVar n') `JsSeq` y2), Set.insert (n',n) y3)

261+

262+

243cgBody :: BodyResTarget -> LExp -> State CGBodyState ([JsAST], JsAST)

263cgBody :: BodyResTarget -> LExp -> State CGBodyState ([JsAST], JsAST)

244cgBody rt (LV (Glob n)) =

264cgBody rt (LV (Glob n)) =

245 do

265 do

@@ -267,11 +287,13 @@ cgBody rt (LApp tailcall (LV (Glob fn)) args) =

267 (True, ReturnBT) ->

287 (True, ReturnBT) ->

268 do

288 do

269 modify (\x-> x {isTailRec = True})

289 modify (\x-> x {isTailRec = True})

290+ let ((y1,y2), y3) = tailCallOptimRefreshArgs (zip argN argVals) Set.empty

291+ addUsedArgsTailCallOptim y3

270 --vars <- getNewCGNames $ length argN --sequence $ map (\_->getNewCGName) argN

292 --vars <- getNewCGNames $ length argN --sequence $ map (\_->getNewCGName) argN

271− let refreshArgs = JsSetVar "cgArgs2" (JsArray argVals)

293+ --let refreshArgs = JsSetVar "cgArgs2" (JsArray argVals)

272 --let calcs = map (\(n,v) -> JsDecVar n v) (zip vars argVals)

294 --let calcs = map (\(n,v) -> JsDecVar n v) (zip vars argVals)

273 --let calcsToArgs = map (\(n,v) -> JsSetVar n (JsVar v)) (zip argN vars)

295 --let calcsToArgs = map (\(n,v) -> JsSetVar n (JsVar v)) (zip argN vars)

274− pure (preDecs, refreshArgs)

296+ pure (preDecs, y1 `JsSeq` y2)

275 _ ->

297 _ ->

276 do

298 do

277 argsFn <- getArgList fn

299 argsFn <- getArgList fn