@@ -35,9 +35,14 @@ data JSType = JSIntTy
3535 | JSForgotTy
3636 deriving Eq
3737
38+data JSInteger = JSBigZero
39+ | JSBigOne
40+ | JSBigInt Integer
41+ deriving Eq
42+
3843data JSNum = JSInt Int
3944 | JSFloat Double
40− | JSInteger Integer
45+ | JSInteger JSInteger
4146 deriving Eq
4247
4348data JS = JSRaw String
@@ -149,9 +154,11 @@ compileJS (JSString str) =
149154 show str
150155
151156compileJS (JSNum num)
152− | JSInt i <- num = show i
153− | JSFloat f <- num = show f
154− | JSInteger i <- num = show i
157+ | JSInt i <- num = show i
158+ | JSFloat f <- num = show f
159+ | JSInteger JSBigZero <- num = "__IDRRT__ZERO"
160+ | JSInteger JSBigOne <- num = "__IDRRT__ONE"
161+ | JSInteger (JSBigInt i) <- num = show i
155162
156163compileJS (JSAssign lhs rhs) =
157164 compileJS lhs ++ "=" ++ compileJS rhs
@@ -211,8 +218,8 @@ jsTypeTag :: JS -> JS
211218jsTypeTag obj = JSProj obj "type"
212219
213220jsBigInt :: JS -> JS
214−jsBigInt (JSString "0") = JSIdent "__IDRRT__ZERO"
215−jsBigInt (JSString "1") = JSIdent "__IDRRT__ONE"
221+jsBigInt (JSString "0") = JSNum $ JSInteger JSBigZero
222+jsBigInt (JSString "1") = JSNum $ JSInteger JSBigOne
216223jsBigInt val = JSApp (JSIdent $ idrRTNamespace ++ "bigInt") [val]
217224
218225jsVar :: Int -> String
@@ -229,9 +236,11 @@ jsLet name value body =
229236jsSubst :: String -> JS -> JS -> JS
230237jsSubst var new (JSVar old)
231238 | var == translateVariableName old = new
239+ | otherwise = JSVar old
232240
233241jsSubst var new (JSIdent old)
234242 | var == old = new
243+ | otherwise = JSIdent old
235244
236245jsSubst var new (JSArray fields) =
237246 JSArray (map (jsSubst var new) fields)
@@ -241,25 +250,47 @@ jsSubst var new (JSNew con [tag, vals]) =
241250
242251jsSubst var new (JSNew con [JSFunction [] (JSReturn (JSApp fun vars))]) =
243252 JSNew con [JSFunction [] (
244− JSReturn $ JSApp fun (map (jsSubst var new) vars)
253+ JSReturn $ JSApp (jsSubst var new fun) (map (jsSubst var new) vars)
245254 )]
246255
247256jsSubst var new (JSApp (JSIdent "__IDRRT__tailcall") [JSFunction [] (
248257 JSReturn (JSApp fun args)
249258 )]) =
250259 JSApp (JSIdent "__IDRRT__tailcall") [JSFunction [] (
251− JSReturn $ JSApp fun (map (jsSubst var new) args)
260+ JSReturn $ JSApp (jsSubst var new fun) (map (jsSubst var new) args)
252261 )]
253262
263+jsSubst var new (JSApp (JSProj obj field) args) =
264+ JSApp (JSProj (jsSubst var new obj) field) $ map (jsSubst var new) args
265+
254266jsSubst var new (JSApp (JSFunction [arg] body) vals)
255267 | var /= arg =
256268 JSApp (JSFunction [arg] (
257269 jsSubst var new body
258270 )) $ map (jsSubst var new) vals
271+ | otherwise =
272+ JSApp (JSFunction [arg] (
273+ body
274+ )) $ map (jsSubst var new) vals
259275
260276jsSubst var new (JSReturn ret) =
261277 JSReturn $ jsSubst var new ret
262278
279+jsSubst var new (JSProj obj field) =
280+ JSProj (jsSubst var new obj) field
281+
282+jsSubst var new (JSSeq body) =
283+ JSSeq $ map (jsSubst var new) body
284+
285+jsSubst var new (JSOp op lhs rhs) =
286+ JSOp op (jsSubst var new lhs) (jsSubst var new rhs)
287+
288+jsSubst var new (JSIndex obj field) =
289+ JSIndex (jsSubst var new obj) (jsSubst var new field)
290+
291+jsSubst var new (JSCond conds) =
292+ JSCond (map ((jsSubst var new) *** (jsSubst var new)) conds)
293+
263294jsSubst _ _ js = js
264295
265296inlineJS :: JS -> JS
@@ -274,16 +305,12 @@ inlineJS (JSApp (JSFunction [arg] (JSReturn ret)) [val])
274305 | JSNew con [JSFunction [] (JSReturn (JSApp fun vars))] <- ret
275306 , opt <- inlineJS val =
276307 JSNew con [JSFunction [] (
277− JSReturn $ JSApp fun (map (jsSubst arg opt) vars)
308+ JSReturn $ JSApp (jsSubst arg opt fun) (map (jsSubst arg opt) vars)
278309 )]
279310
280− | JSApp (JSIdent "__IDRRT__tailcall") [JSFunction [] (
281− JSReturn (JSApp fun args)
282− )] <- ret
311+ | JSApp (JSProj obj field) args <- ret
283312 , opt <- inlineJS val =
284− JSApp (JSIdent "__IDRRT__tailcall") [JSFunction [] (
285− JSReturn $ JSApp fun (map (jsSubst arg opt) args)
286− )]
313+ JSApp (JSProj (jsSubst arg opt obj) field) $ map (jsSubst arg opt) args
287314
288315 | JSIndex (JSProj obj field) idx <- ret
289316 , opt <- inlineJS val =
@@ -292,9 +319,18 @@ inlineJS (JSApp (JSFunction [arg] (JSReturn ret)) [val])
292319 ) field
293320 ) (jsSubst arg opt idx)
294321
295− | JSOp op lhs rhs <- ret =
296− JSOp op (jsSubst arg (inlineJS val) lhs) $
297− (jsSubst arg (inlineJS val) rhs)
322+ | JSOp op lhs rhs <- ret
323+ , opt <- inlineJS val =
324+ JSOp op (jsSubst arg opt lhs) $
325+ (jsSubst arg opt rhs)
326+
327+ | JSApp (JSIdent "__IDRRT__tailcall") [JSFunction [] (
328+ JSReturn (JSApp fun args)
329+ )] <- ret
330+ , opt <- inlineJS val =
331+ JSApp (JSIdent "__IDRRT__tailcall") [JSFunction [] (
332+ JSReturn $ JSApp (jsSubst arg opt fun) (map (jsSubst arg opt) args)
333+ )]
298334
299335inlineJS (JSApp fun args) =
300336 JSApp (inlineJS fun) (map inlineJS args)
@@ -306,7 +342,7 @@ inlineJS (JSArray fields) =
306342 JSArray (map inlineJS fields)
307343
308344inlineJS (JSAssign lhs rhs) =
309− JSAssign lhs (inlineJS rhs)
345+ JSAssign (inlineJS lhs) (inlineJS rhs)
310346
311347inlineJS (JSSeq seq) =
312348 JSSeq (map inlineJS seq)
@@ -314,8 +350,8 @@ inlineJS (JSSeq seq) =
314350inlineJS (JSFunction args body) =
315351 JSFunction args (inlineJS body)
316352
317−inlineJS (JSProj (JSFunction args body) "apply") =
318− JSProj (JSFunction args (inlineJS body)) "apply"
353+inlineJS (JSProj (JSFunction args body) field) =
354+ JSProj (JSFunction args (inlineJS body)) field
319355
320356inlineJS (JSReturn js) =
321357 JSReturn $ inlineJS js
@@ -401,6 +437,45 @@ removeIDs js =
401437
402438 removeIDCall _ js = js
403439
440+reduceConstant :: JS -> JS
441+reduceConstant (JSApp (JSIdent "__IDRRT__tailcall") [JSFunction [] (
442+ JSReturn (JSApp (JSIdent "__IDR__mEVAL0") [JSNum num])
443+ )]) = JSNum num
444+
445+reduceConstant (JSReturn ret) =
446+ JSReturn (reduceConstant ret)
447+
448+reduceConstant (JSApp fun args) =
449+ JSApp (reduceConstant fun) (map reduceConstant args)
450+
451+reduceConstant (JSArray fields) =
452+ JSArray (map reduceConstant fields)
453+
454+reduceConstant (JSAlloc name (Just val)) =
455+ JSAlloc name $ Just (reduceConstant val)
456+
457+reduceConstant (JSNew con args) =
458+ JSNew con (map reduceConstant args)
459+
460+reduceConstant (JSProj obj field) =
461+ JSProj (reduceConstant obj) field
462+
463+reduceConstant (JSCond conds) =
464+ JSCond $ map (reduceConstant *** reduceConstant) conds
465+
466+reduceConstant (JSSeq seq) =
467+ JSSeq $ map reduceConstant seq
468+
469+reduceConstant (JSFunction args body) =
470+ JSFunction args (reduceConstant body)
471+
472+reduceConstant js = js
473+
474+reduceConstants :: JS -> JS
475+reduceConstants js
476+ | ret <- reduceConstant js
477+ , ret /= js = reduceConstants ret
478+ | otherwise = js
404479
405480reduceLoop :: [String] -> ([JS], [JS]) -> [JS]
406481reduceLoop reduced (cons, program) =
@@ -513,7 +588,7 @@ codegenJavaScript target definitions filename outputType = do
513588
514589 functions :: [String]
515590 functions =
516− map compileJS ((reduceJS . removeIDs) $ map (optimizeJS . translateDeclaration) def)
591+ map (compileJS . reduceConstants) ((reduceJS . removeIDs) $ map (optimizeJS . translateDeclaration) def)
517592
518593 mainLoop :: String
519594 mainLoop = compileJS $