on master help sign in
javascript: added jsident for identifiers
commitf2309dd5dfdd975387e8df7f38b3883f404f2533 authorraichoo <raichoo@googlemail.com> dateSat 12 Oct 2013, 13:34 (13 years ago) parent549627c
1 file changed+33−29
src/IRTS/CodegenJavaScript.hs+33−29
src/IRTS/CodegenJavaScript.hs+33−29
@@ -41,6 +41,7 @@ data JSNum = JSInt Int
4141 deriving Eq
4242
4343data JS = JSRaw String
44+ | JSIdent String
4445 | JSFunction [String] JS
4546 | JSType JSType
4647 | JSSeq [JS]
@@ -70,6 +71,9 @@ compileJS :: JS -> String
7071compileJS (JSRaw code) =
7172 code
7273
74+compileJS (JSIdent ident) =
75+ ident
76+
7377compileJS (JSFunction args body) =
7478 "function("
7579 ++ intercalate "," args
@@ -179,7 +183,7 @@ jsTailcall call =
179183 ]
180184
181185jsCall :: String -> [JS] -> JS
182−jsCall fun = JSApp (JSRaw fun)
186+jsCall fun = JSApp (JSIdent fun)
183187
184188jsMeth :: JS -> String -> [JS] -> JS
185189jsMeth obj meth =
@@ -195,10 +199,10 @@ jsAnd :: JS -> JS -> JS
195199jsAnd = JSOp "&&"
196200
197201jsType :: JS
198−jsType = JSRaw $ idrRTNamespace ++ "Type"
202+jsType = JSIdent $ idrRTNamespace ++ "Type"
199203
200204jsCon :: JS
201−jsCon = JSRaw $ idrRTNamespace ++ "Con"
205+jsCon = JSIdent $ idrRTNamespace ++ "Con"
202206
203207jsTag :: JS -> JS
204208jsTag obj = JSProj obj "tag"
@@ -207,9 +211,9 @@ jsTypeTag :: JS -> JS
207211jsTypeTag obj = JSProj obj "type"
208212
209213jsBigInt :: JS -> JS
210−jsBigInt (JSString "0") = JSRaw "__IDRRT__ZERO"
211−jsBigInt (JSString "1") = JSRaw "__IDRRT__ONE"
212−jsBigInt val = JSApp (JSRaw $ idrRTNamespace ++ "bigInt") [val]
214+jsBigInt (JSString "0") = JSIdent "__IDRRT__ZERO"
215+jsBigInt (JSString "1") = JSIdent "__IDRRT__ONE"
216+jsBigInt val = JSApp (JSIdent $ idrRTNamespace ++ "bigInt") [val]
213217
214218jsVar :: Int -> String
215219jsVar = ("__var_" ++) . show
@@ -226,7 +230,7 @@ jsSubst :: String -> JS -> JS -> JS
226230jsSubst var new (JSVar old)
227231 | var == translateVariableName old = new
228232
229−jsSubst var new (JSRaw old)
233+jsSubst var new (JSIdent old)
230234 | var == old = new
231235
232236jsSubst var new (JSArray fields) =
@@ -240,10 +244,10 @@ jsSubst var new (JSNew con [JSFunction [] (JSReturn (JSApp fun vars))]) =
240244 JSReturn $ JSApp fun (map (jsSubst var new) vars)
241245 )]
242246
243−jsSubst var new (JSApp (JSRaw "__IDRRT__tailcall") [JSFunction [] (
247+jsSubst var new (JSApp (JSIdent "__IDRRT__tailcall") [JSFunction [] (
244248 JSReturn (JSApp fun args)
245249 )]) =
246− JSApp (JSRaw "__IDRRT__tailcall") [JSFunction [] (
250+ JSApp (JSIdent "__IDRRT__tailcall") [JSFunction [] (
247251 JSReturn $ JSApp fun (map (jsSubst var new) args)
248252 )]
249253
@@ -273,11 +277,11 @@ inlineJS (JSApp (JSFunction [arg] (JSReturn ret)) [val])
273277 JSReturn $ JSApp fun (map (jsSubst arg opt) vars)
274278 )]
275279
276− | JSApp (JSRaw "__IDRRT__tailcall") [JSFunction [] (
280+ | JSApp (JSIdent "__IDRRT__tailcall") [JSFunction [] (
277281 JSReturn (JSApp fun args)
278282 )] <- ret
279283 , opt <- inlineJS val =
280− JSApp (JSRaw "__IDRRT__tailcall") [JSFunction [] (
284+ JSApp (JSIdent "__IDRRT__tailcall") [JSFunction [] (
281285 JSReturn $ JSApp fun (map (jsSubst arg opt) args)
282286 )]
283287
@@ -353,13 +357,13 @@ reduceJS program =
353357 funNames (JSAlloc fun _) = fun
354358
355359 reduceCall :: [String] -> JS -> JS
356− reduceCall funs (JSApp (JSRaw "__IDRRT__tailcall") [JSFunction [] (
357− JSReturn (JSApp (JSRaw ret) [])
360+ reduceCall funs (JSApp (JSIdent "__IDRRT__tailcall") [JSFunction [] (
361+ JSReturn (JSApp (JSIdent ret) [])
358362 )])
359− | ret `elem` funs = JSRaw ret
363+ | ret `elem` funs = JSIdent ret
360364
361− reduceCall funs js@(JSApp (JSRaw fun) [])
362− | fun `elem` funs = JSRaw fun
365+ reduceCall funs js@(JSApp (JSIdent fun) [])
366+ | fun `elem` funs = JSIdent fun
363367 | otherwise = js
364368
365369 reduceCall funs (JSAlloc fun (Just body)) =
@@ -442,7 +446,7 @@ codegenJavaScript target definitions filename outputType = do
442446 JSAlloc "main" $ Just $ JSFunction [] (
443447 case target of
444448 Node -> mainFun
445− JavaScript -> jsMeth (JSRaw "window") "addEventListener" [
449+ JavaScript -> jsMeth (JSIdent "window") "addEventListener" [
446450 JSString "DOMContentLoaded", JSFunction [] (
447451 mainFun
448452 ), JSFalse
@@ -568,13 +572,13 @@ translateDeclaration (path, SFun name params stackSize body)
568572 lookup = "[" ++ lvar ++ ".tag](fn0,arg0," ++ lvar ++ ")" in
569573 JSSeq [ lookupTable [(var, "chk")] var cases
570574 , jsDecl $ JSFunction ["fn0", "arg0"] (
571− JSSeq [ JSAlloc "__var_0" (Just $ JSRaw "fn0")
575+ JSSeq [ JSAlloc "__var_0" (Just $ JSIdent "fn0")
572576 , JSReturn $ jsLet (translateVariableName var) (
573577 translateExpression val
574578 ) (JSTernary (
575579 (JSVar var `jsInstanceOf` jsCon) `jsAnd`
576580 (hasProp lookupTableName (translateVariableName var))
577− ) (JSRaw $
581+ ) (JSIdent $
578582 lookupTableName ++ lookup
579583 ) JSNull
580584 )
@@ -587,9 +591,9 @@ translateDeclaration (path, SFun name params stackSize body)
587591 JSSeq [ lookupTable [] var cases
588592 , jsDecl $ JSFunction ["arg0"] (JSReturn $
589593 JSTernary (
590− (JSRaw "arg0" `jsInstanceOf` jsCon) `jsAnd`
594+ (JSIdent "arg0" `jsInstanceOf` jsCon) `jsAnd`
591595 (hasProp lookupTableName "arg0")
592− ) (JSRaw $ lookupTableName ++ "[arg0.tag](arg0)") (JSRaw "arg0")
596+ ) (JSRaw $ lookupTableName ++ "[arg0.tag](arg0)") (JSIdent "arg0")
593597 )
594598 ]
595599 | otherwise =
@@ -599,7 +603,7 @@ translateDeclaration (path, SFun name params stackSize body)
599603 where
600604 hasProp :: String -> String -> JS
601605 hasProp table var =
602− JSIndex (JSRaw table) (JSProj (JSRaw var) "tag")
606+ JSIndex (JSIdent table) (JSProj (JSIdent var) "tag")
603607
604608 caseFun :: [(LVar, String)] -> LVar -> SAlt -> JS
605609 caseFun aux var cse =
@@ -619,7 +623,7 @@ translateDeclaration (path, SFun name params stackSize body)
619623 JSSeq $ [
620624 JSAlloc "t" $ Just (JSArray [])
621625 ] ++ assignEntries (catMaybes $ map (lookupEntry aux var) cases) ++ [
622− JSReturn (JSRaw "t")
626+ JSReturn (JSIdent "t")
623627 ]
624628 )) []
625629 )
@@ -627,7 +631,7 @@ translateDeclaration (path, SFun name params stackSize body)
627631 assignEntries :: [(Int, JS)] -> [JS]
628632 assignEntries entries =
629633 map (\(tag, fun) ->
630− JSAssign (JSIndex (JSRaw "t") (JSNum $ JSInt tag)) fun
634+ JSAssign (JSIndex (JSIdent "t") (JSNum $ JSInt tag)) fun
631635 ) entries
632636
633637 lookupEntry :: [(LVar, String)] -> LVar -> SAlt -> Maybe (Int, JS)
@@ -657,11 +661,11 @@ translateDeclaration (path, SFun name params stackSize body)
657661 allocVar n = JSAlloc (jsVar n) Nothing
658662
659663 assignVar :: Int -> String -> JS
660− assignVar n s = JSAlloc (jsVar n) (Just $ JSRaw s)
664+ assignVar n s = JSAlloc (jsVar n) (Just $ JSIdent s)
661665
662666 assignAux :: (LVar, String) -> JS
663667 assignAux (var, val) =
664− JSAssign (JSRaw $ translateVariableName var) (JSRaw val)
668+ JSAssign (JSIdent $ translateVariableName var) (JSIdent val)
665669
666670 p :: [String]
667671 p = map translateName params
@@ -830,7 +834,7 @@ translateExpression (SOp op vars)
830834 | LStrCons <- op
831835 , (lhs:rhs:_) <- vars = translateBinaryOp "+" lhs rhs
832836 | LStrHead <- op
833− , (arg:_) <- vars = JSIndex (JSVar arg) (JSRaw "0")
837+ , (arg:_) <- vars = JSIndex (JSVar arg) (JSNum (JSInt 0))
834838 | LStrRev <- op
835839 , (arg:_) <- vars = JSProj (JSVar arg) "split('').reverse().join('')"
836840 | LStrIndex <- op
@@ -877,8 +881,8 @@ translateExpression patterncase
877881 expandCase _ (CaseCond DefaultCase, branch) = (JSTrue , branch)
878882 expandCase var (CaseCond caseTy, branch)
879883 | ConCase tag <- caseTy =
880− let checkCon = JSRaw var `jsInstanceOf` jsCon
881− checkTag = (JSRaw $ show tag) `jsEq` jsTag (JSRaw var) in
884+ let checkCon = JSIdent var `jsInstanceOf` jsCon
885+ checkTag = (JSNum $ JSInt tag) `jsEq` jsTag (JSIdent var) in
882886 (checkCon `jsAnd` checkTag, branch)
883887
884888 | TypeCase ty <- caseTy =