@@ -26,15 +26,28 @@ codegenJavaScript
2626 -> FilePath
2727 -> OutputType
2828 -> IO ()
29−codegenJavaScript definitions filename outputType = do
30− let def = map (first translateNamespace) definitions
31− let output = idrRuntime ++ concatMap (translateModule Nothing) def ++ "\nMain.main()"
29+codegenJavaScript definitions filename outputType =
3230 writeFile filename output
31+ where
32+ def = map (first translateNamespace) definitions
33+
34+ mainLoop :: String
35+ mainLoop = intercalate "\n" [ "\nfunction main() {"
36+ , createTrampoline "Main.main()" ++ ";"
37+ , "}\n\nmain();\n"
38+ ]
39+
40+ output :: String
41+ output = concat [ idrRuntime
42+ , concatMap (translateModule Nothing) def
43+ , mainLoop
44+ ]
3345
3446idrRuntime :: String
3547idrRuntime =
3648 createModule Nothing idrNamespace $ concat
3749 [ "__IDR__.IntType = { type: 'IntType' };"
50+ , "__IDR__.Tailcall = function(f) { this.f = f };"
3851 , "__IDR__.Con = function(i,name,vars)"
3952 , "{this.i = i;this.name = name;this.vars = vars;};"
4053 ]
@@ -165,13 +178,16 @@ translateExpression _ (SConst cst) =
165178translateExpression _ (SV var) =
166179 translateVariableName var
167180
168−translateExpression modname (SApp tc name vars) =
169− concat (intersperse "." $ translateNamespace name)
170− ++ "."
171− ++ translateName name
172− ++ "("
173− ++ intercalate "," (map translateVariableName vars)
174− ++ ")"
181+translateExpression modname (SApp False name vars) =
182+ createTrampoline $ translateFunctionCall name vars
183+
184+translateExpression modname (SApp True name vars) =
185+ "(function(){\n"
186+ ++ "throw new __IDR__.Tailcall("
187+ ++ "function(){\n"
188+ ++ "return " ++ translateFunctionCall name vars
189+ ++ ";\n});"
190+ ++ "\n})()"
175191
176192translateExpression _ (SOp op vars)
177193 | LPlus <- op
@@ -284,14 +300,10 @@ translateExpression _ (SCon i name vars) =
284300 ]
285301
286302translateExpression modname (SUpdate var e) =
287− "(function(){\nreturn ("
288− ++ translateVariableName var
289− ++ " = " ++ translateExpression modname e
290− ++ ");\n})()"
303+ translateVariableName var ++ " = " ++ translateExpression modname e
291304
292305translateExpression modname (SProj var i) =
293− "(function(){\nreturn "
294− ++ translateVariableName var ++ ".vars[" ++ show i ++"];\n})()"
306+ translateVariableName var ++ ".vars[" ++ show i ++"]"
295307
296308translateExpression _ SNothing = "null"
297309
@@ -324,3 +336,28 @@ createIfBlock cond e =
324336 "if (" ++ cond ++") {\n"
325337 ++ "return " ++ e
326338 ++ ";\n}"
339+
340+createTrampoline call =
341+ "(function(){\n"
342+ ++ "var __f = function(){return " ++ call ++ "};\n"
343+ ++ "while (__f) {\ntry {\n"
344+ ++ "var f = __f;\n"
345+ ++ "__f = null;\n"
346+ ++ "return f();"
347+ ++ "\n} catch(ex) {\n"
348+ ++ "if (ex instanceof __IDR__.Tailcall) {\n"
349+ ++ "__f = ex.f;"
350+ ++ "\n} else {\n"
351+ ++ "throw ex;"
352+ ++ "\n}"
353+ ++ "\n}"
354+ ++ "\n}"
355+ ++ "\n})()"
356+
357+translateFunctionCall name vars =
358+ concat (intersperse "." $ translateNamespace name)
359+ ++ "."
360+ ++ translateName name
361+ ++ "("
362+ ++ intercalate "," (map translateVariableName vars)
363+ ++ ")"