@@ -224,7 +224,7 @@ codegenJavaScript target definitions filename outputType = do
224 ("#!/usr/bin/env node\n", "-node")
224 ("#!/usr/bin/env node\n", "-node")
225 JavaScript ->
225 JavaScript ->
226 ("", "-browser")
226 ("", "-browser")
227− path <- getDataDir
227+ path <- getDataDir
228 idrRuntime <- readFile $ path ++ "/js/Runtime-common.js"
228 idrRuntime <- readFile $ path ++ "/js/Runtime-common.js"
229 tgtRuntime <- readFile $ concat [path, "/js/Runtime", runtime, ".js"]
229 tgtRuntime <- readFile $ concat [path, "/js/Runtime", runtime, ".js"]
230 writeFile filename $ intercalate "\n" $ [ header
230 writeFile filename $ intercalate "\n" $ [ header
@@ -246,19 +246,22 @@ codegenJavaScript target definitions filename outputType = do
246 mainLoop :: String
246 mainLoop :: String
247 mainLoop = compileJS $
247 mainLoop = compileJS $
248 JSSeq [ JSAlloc "main" $ Just $ JSFunction [] (
248 JSSeq [ JSAlloc "main" $ Just $ JSFunction [] (
249− jsTailcall $ jsCall "__IDR__runMain0" []
249+ jsTailcall $ jsCall mainFun []
251 , jsCall "main" []
251 , jsCall "main" []
255+ mainFun = idrNamespace ++ translateName (MN 0 "runMain")
254translateIdentifier :: String -> String
257translateIdentifier :: String -> String
255translateIdentifier =
258translateIdentifier =
256 replaceReserved . concatMap replaceBadChars
259 replaceReserved . concatMap replaceBadChars
257 where replaceBadChars :: Char -> String
260 where replaceBadChars :: Char -> String
258 replaceBadChars c
261 replaceBadChars c
259− | ' ' <- c = "_"
262+ | ' ' <- c = "_"
260− | '_' <- c = "__"
263+ | '_' <- c = "__"
261− | isDigit c = "_" ++ [c] ++ "_"
264+ | isDigit c = '_' : show (ord c)
262 | not (isLetter c && isAscii c) = '_' : show (ord c)
265 | not (isLetter c && isAscii c) = '_' : show (ord c)
263 | otherwise = [c]
266 | otherwise = [c]
264 replaceReserved s
267 replaceReserved s
@@ -317,24 +320,24 @@ translateNamespace (SN name) = idrNamespace ++ translateSpecialName name
317translateNamespace NErased = idrNamespace
320translateNamespace NErased = idrNamespace
319translateName :: Name -> String
322translateName :: Name -> String
320−translateName (UN name) = translateIdentifier name
323+translateName (UN name) = 'u' : translateIdentifier name
321−translateName (NS name _) = translateName name
324+translateName (NS name _) = 'n' : translateName name
322−translateName (MN i name) = translateIdentifier name ++ show i
325+translateName (MN i name) = 'm' : translateIdentifier name ++ show i
323−translateName (SN name) = translateSpecialName name
326+translateName (SN name) = 's' : translateSpecialName name
324−translateName NErased = ""
327+translateName NErased = "e"
326translateSpecialName :: SpecialName -> String
329translateSpecialName :: SpecialName -> String
327translateSpecialName name
330translateSpecialName name
328 | WhereN i m n <- name =
331 | WhereN i m n <- name =
329− "_where" ++ show i ++ "_" ++ translateName m ++ translateName n
332+ 'w' : translateName m ++ translateName n ++ show i
330 | InstanceN n s <- name =
333 | InstanceN n s <- name =
331− "_inst_" ++ translateName n ++ concatMap translateIdentifier s
334+ 'i' : translateName n ++ concatMap translateIdentifier s
332 | ParentN n s <- name =
335 | ParentN n s <- name =
333− "_parent_" ++ translateName n ++ translateIdentifier s
336+ 'p' : translateName n ++ translateIdentifier s
334 | MethodN n <- name =
337 | MethodN n <- name =
335− "_meth_" ++ translateName n
338+ 'm' : translateName n
336 | CaseN n <- name =
339 | CaseN n <- name =
337− "_case_" ++ translateName n
340+ 'c' : translateName n
339translateConstant :: Const -> JS
342translateConstant :: Const -> JS
340translateConstant (I i) = JSNum (JSInt i)
343translateConstant (I i) = JSNum (JSInt i)
@@ -441,7 +444,8 @@ translateDeclaration (path, SFun name params stackSize body)
441 assignVar n s = JSAlloc (jsVar n) (Just $ JSRaw s)
444 assignVar n s = JSAlloc (jsVar n) (Just $ JSRaw s)
443 assignAux :: (LVar, String) -> JS
446 assignAux :: (LVar, String) -> JS
447+ assignAux (var, val) =
444− assignAux (var, val) = JSAssign (JSRaw $ translateVariableName var) (JSRaw val)
448+ JSAssign (JSRaw $ translateVariableName var) (JSRaw val)
446 p :: [String]
450 p :: [String]
447 p = map translateName params
451 p = map translateName params