@@ -113,6 +113,9 @@ jsName n = T.pack $ "idris_" ++ concatMap jschar (showCG n)
113113jsPartialName :: Partial -> Text
114114jsPartialName (Partial n i j) = T.concat ["partial_", T.pack $ show i, "_", T.pack $ show j, "_" , jsName n]
115115
116+jsTailCallOptimName :: Text -> Text
117+jsTailCallOptimName x = T.concat ["tailCallOptim_cgIdris_", x]
118+
116119doPartials :: Set Partial -> Text
117120doPartials x =
118121 T.intercalate "\n" (map f $ Set.toList x)
@@ -145,6 +148,7 @@ seqJs (x:xs) = JsSeq x (seqJs xs)
145148data CGBodyState = CGBodyState { defs :: LDefs
146149 , lastIntName :: Int
147150 , currentFnNameAndArgs :: (Text, [Text])
151+ , usedArgsTailCallOptim :: Set (Text, Text)
148152 , isTailRec :: Bool
149153 , conf :: CGConf
150154 , usedWrite :: Bool
@@ -163,6 +167,9 @@ addPartial :: Partial -> State CGBodyState ()
163167addPartial p =
164168 modify (\s -> s {partialApps = Set.insert p (partialApps s) })
165169
170+addUsedArgsTailCallOptim :: Set (Text, Text) -> State CGBodyState ()
171+addUsedArgsTailCallOptim p =
172+ modify (\s -> s {usedArgsTailCallOptim = Set.union p (usedArgsTailCallOptim s) })
166173
167174getNewCGNames :: Int -> State CGBodyState [Text]
168175getNewCGNames n =
@@ -211,6 +218,7 @@ cgFun cnf dfs n args def =
211218 (CGBodyState { defs=dfs
212219 , lastIntName = 0
213220 , currentFnNameAndArgs = (fnName, argNames)
221+ , usedArgsTailCallOptim = Set.empty
214222 , isTailRec = False
215223 , conf = cnf
216224 , usedWrite = False
@@ -218,12 +226,10 @@ cgFun cnf dfs n args def =
218226 }
219227 )
220228 body = if isTailRec st then
221− JsFor (JsLetList [("cgArgs", JsApp "Array.prototype.slice.call" [JsVar "arguments"]), ("cgArgs2", JsNull) ] , JsTrue, JsSetVar "cgArgs" (JsVar "cgArgs2") ) $
222− replaceVarsByProj
223− (JsVar "cgArgs")
224− (Map.fromList $ zip argNames [0..])
225− ((seqJs decs) `JsSeq` res)
226− else JsSeq (seqJs decs) res
229+ JsSeq
230+ (declareUsedOptimArgs $ usedArgsTailCallOptim st)
231+ (JsWhileTrue ((seqJs decs) `JsSeq` res))
232+ else (seqJs decs) `JsSeq` res
227233 in (JsFun fnName argNames $ body, CGStats {usedWriteStr = usedWrite st, partialApplications = partialApps st})
228234
229235getSwitchJs :: JsAST -> [LAlt] -> JsAST
@@ -240,6 +246,20 @@ addRT (SetBT n) x = JsSetVar n x
240246addRT (DecConstBT n) x = JsConst n x
241247addRT GetExpBT x = x
242248
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+
243263cgBody :: BodyResTarget -> LExp -> State CGBodyState ([JsAST], JsAST)
244264cgBody rt (LV (Glob n)) =
245265 do
@@ -267,11 +287,13 @@ cgBody rt (LApp tailcall (LV (Glob fn)) args) =
267287 (True, ReturnBT) ->
268288 do
269289 modify (\x-> x {isTailRec = True})
290+ let ((y1,y2), y3) = tailCallOptimRefreshArgs (zip argN argVals) Set.empty
291+ addUsedArgsTailCallOptim y3
270292 --vars <- getNewCGNames $ length argN --sequence $ map (\_->getNewCGName) argN
271− let refreshArgs = JsSetVar "cgArgs2" (JsArray argVals)
293+ --let refreshArgs = JsSetVar "cgArgs2" (JsArray argVals)
272294 --let calcs = map (\(n,v) -> JsDecVar n v) (zip vars argVals)
273295 --let calcsToArgs = map (\(n,v) -> JsSetVar n (JsVar v)) (zip argN vars)
274− pure (preDecs, refreshArgs)
296+ pure (preDecs, y1 `JsSeq` y2)
275297 _ ->
276298 do
277299 argsFn <- getArgList fn