@@ -37,6 +37,7 @@ data JSType = JSIntTy
3737data JSNum = JSInt Int
3838 | JSFloat Double
3939 | JSInteger Integer
40+ deriving Eq
4041
4142data JS = JSRaw String
4243 | JSFunction [String] JS
@@ -62,6 +63,7 @@ data JS = JSRaw String
6263 | JSIndex JS JS
6364 | JSCond [(JS, JS)]
6465 | JSTernary JS JS JS
66+ deriving Eq
6567
6668compileJS :: JS -> String
6769compileJS (JSRaw code) =
@@ -254,43 +256,19 @@ jsSubst var new (JSReturn ret) =
254256
255257jsSubst _ _ js = js
256258
257−inlineAble :: Bool -> JS -> JS -> Bool
258−inlineAble _ (JSNew con [tag, args]) _ = True
259−inlineAble _ JSNull _ = True
260−inlineAble _ (JSString _) _ = True
261−inlineAble _ (JSType _) _ = True
262−inlineAble _ (JSNum _) _ = True
263−inlineAble _ (JSApp (JSRaw "__IDRRT__bigInt") _) _ = True
264−inlineAble insideTC (JSApp (JSRaw "__IDRRT__tailcall") _) into =
265− not insideTC && not (doesTailcall into)
266− where
267− doesTailcall :: JS -> Bool
268− doesTailcall (JSApp (JSRaw "__IDRRT__tailcall") _) = True
269− doesTailcall (JSApp (JSRaw _) args) = any id (map doesTailcall args)
270− doesTailcall (JSApp f args) = doesTailcall f || any id (map doesTailcall args)
271− doesTailcall (JSReturn ret) = doesTailcall ret
272− doesTailcall (JSFunction [_] body) = doesTailcall body
273− doesTailcall (JSNew _ [tag, args]) = doesTailcall args
274− doesTailcall (JSNew _ [JSFunction [] body]) = doesTailcall body
275− doesTailcall (JSArray vals) = any id (map doesTailcall vals)
276− doesTailcall (JSVar _) = False
277− doesTailcall _ = True
278−
279−inlineAble _ _ _ = False
259+inlineAble _ _ _ = True
280260
281−optimizeJS :: JS -> JS
282−optimizeJS (JSApp (JSFunction [] (JSSeq ret)) []) =
283− JSApp (JSFunction [] (JSSeq (map optimizeJS ret))) []
261+inlineJS :: JS -> JS
262+inlineJS (JSApp (JSFunction [] (JSSeq ret)) []) =
263+ JSApp (JSFunction [] (JSSeq (map inlineJS ret))) []
284264
285−optimizeJS (JSApp (JSFunction [arg] (JSReturn ret)) [val])
265+inlineJS (JSApp (JSFunction [arg] (JSReturn ret)) [val])
286266 | JSNew con [tag, vals] <- ret
287− , opt <- optimizeJS val
288− , inlineAble False opt vals =
267+ , opt <- inlineJS val =
289268 JSNew con [tag, jsSubst arg opt vals]
290269
291270 | JSNew con [JSFunction [] (JSReturn (JSApp fun vars))] <- ret
292− , opt <- optimizeJS val
293− , all id $ map (inlineAble False opt) vars =
271+ , opt <- inlineJS val =
294272 JSNew con [JSFunction [] (
295273 JSReturn $ JSApp fun (map (jsSubst arg opt) vars)
296274 )]
@@ -298,65 +276,58 @@ optimizeJS (JSApp (JSFunction [arg] (JSReturn ret)) [val])
298276 | JSApp (JSRaw "__IDRRT__tailcall") [JSFunction [] (
299277 JSReturn (JSApp fun args)
300278 )] <- ret
301− , opt <- optimizeJS val
302− , all id $ map (inlineAble True opt) args =
279+ , opt <- inlineJS val =
303280 JSApp (JSRaw "__IDRRT__tailcall") [JSFunction [] (
304281 JSReturn $ JSApp fun (map (jsSubst arg opt) args)
305282 )]
306283
307− | JSApp (JSFunction [x] (JSReturn body)) [y] <- ret
308− , opt <- optimizeJS val
309− , optBody <- optimizeJS body
310− , inlineAble False opt optBody =
311− optimizeJS (
312− JSApp (JSFunction [x] $
313− JSReturn $ jsSubst arg opt optBody
314− ) [y]
315− )
316−
317284 | JSIndex (JSProj obj field) idx <- ret
318− , opt <- optimizeJS val =
285+ , opt <- inlineJS val =
319286 JSIndex (JSProj (
320287 jsSubst arg opt obj
321288 ) field
322289 ) (jsSubst arg opt idx)
323290
324291 | JSOp op lhs rhs <- ret =
325− JSOp op (jsSubst arg (optimizeJS val) lhs) $
326− (jsSubst arg (optimizeJS val) rhs)
327−
292+ JSOp op (jsSubst arg (inlineJS val) lhs) $
293+ (jsSubst arg (inlineJS val) rhs)
328294
329−optimizeJS (JSApp fun args) =
330− JSApp (optimizeJS fun) (map optimizeJS args)
295+inlineJS (JSApp fun args) =
296+ JSApp (inlineJS fun) (map inlineJS args)
331297
332−optimizeJS (JSAssign lhs rhs) =
333− JSAssign lhs (optimizeJS rhs)
298+inlineJS (JSAssign lhs rhs) =
299+ JSAssign lhs (inlineJS rhs)
334300
335−optimizeJS (JSSeq seq) =
336− JSSeq (map optimizeJS seq)
301+inlineJS (JSSeq seq) =
302+ JSSeq (map inlineJS seq)
337303
338−optimizeJS (JSFunction args body) =
339− JSFunction args (optimizeJS body)
304+inlineJS (JSFunction args body) =
305+ JSFunction args (inlineJS body)
340306
341−optimizeJS (JSProj (JSFunction args body) "apply") =
342− JSProj (JSFunction args (optimizeJS body)) "apply"
307+inlineJS (JSProj (JSFunction args body) "apply") =
308+ JSProj (JSFunction args (inlineJS body)) "apply"
343309
344−optimizeJS (JSReturn js) =
345− JSReturn $ optimizeJS js
310+inlineJS (JSReturn js) =
311+ JSReturn $ inlineJS js
346312
347−optimizeJS (JSAlloc name (Just js)) =
348− JSAlloc name (Just $ optimizeJS js)
313+inlineJS (JSAlloc name (Just js)) =
314+ JSAlloc name (Just $ inlineJS js)
349315
350−optimizeJS (JSCond cases) =
351− JSCond (map (second optimizeJS) cases)
316+inlineJS (JSCond cases) =
317+ JSCond (map (second inlineJS) cases)
352318
353−optimizeJS (JSObject fields) =
354− JSObject (map (second optimizeJS) fields)
319+inlineJS (JSObject fields) =
320+ JSObject (map (second inlineJS) fields)
355321
356−optimizeJS js = js
322+inlineJS js = js
357323
358−optJS :: Int -> JS -> JS
359−optJS c = foldr (.) id $ take c $ repeat optimizeJS
324+optimizeJS :: JS -> JS
325+optimizeJS = inlineLoop
326+ where inlineLoop :: JS -> JS
327+ inlineLoop js
328+ | opt <- inlineJS js
329+ , opt /= js = inlineLoop opt
330+ | otherwise = js
360331
361332codegenJavaScript
362333 :: JSTarget
@@ -388,7 +359,7 @@ codegenJavaScript target definitions filename outputType = do
388359 def = map (first translateNamespace) definitions
389360
390361 functions :: [String]
391− functions = map (compileJS . optJS 1 . translateDeclaration) def
362+ functions = map (compileJS . optimizeJS . translateDeclaration) def
392363
393364 mainLoop :: String
394365 mainLoop = compileJS $