@@ -137,7 +137,7 @@ compileJS (JSType ty)
137137 | JSForgotTy <- ty = idrRTNamespace ++ "Forgot"
138138
139139compileJS (JSSeq seq) =
140− intercalate ";\n" (map compileJS $ filter (/= JSNoop) seq)
140+ intercalate ";\n" (map compileJS $ filter (/= JSNoop) seq) ++ ";"
141141
142142compileJS (JSReturn val) =
143143 "return " ++ compileJS val
@@ -272,7 +272,8 @@ codegenJS_all target definitions includes filename outputType = do
272272 path <- (++) <$> getDataDir <*> (pure "/jsrts/")
273273 idrRuntime <- readFile $ path ++ "Runtime-common.js"
274274 tgtRuntime <- readFile $ concat [path, "Runtime", rt, ".js"]
275− let runtime = header ++ idrRuntime ++ tgtRuntime
275+ jsbn <- readFile $ path ++ "jsbn/jsbn.js"
276+ let runtime = header ++ jsbn ++ idrRuntime ++ tgtRuntime
276277 writeFile filename $ runtime ++ concat code ++ main ++ invokeMain
277278 where
278279 main :: String
@@ -334,8 +335,7 @@ translateConstant (AType ATFloat) = JSType JSFloatTy
334335translateConstant (AType (ATInt ITChar)) = JSType JSCharTy
335336translateConstant PtrType = JSType JSPtrTy
336337translateConstant Forgot = JSType JSForgotTy
337−{-translateConstant (BI i) = jsBigInt $ JSString (show i)-}
338−translateConstant (BI i) = JSRaw $ show i
338+translateConstant (BI i) = jsBigInt $ JSString (show i)
339339translateConstant (B8 b) = JSWord (JSWord8 b)
340340translateConstant (B16 b) = JSWord (JSWord16 b)
341341translateConstant (B32 b) = JSWord (JSWord32 b)
@@ -472,11 +472,11 @@ jsTAILCALL n = JSApp (JSIdent (translateName n)) [JSIdent "vm", JSIdent "oldbase
472472
473473jsFOREIGN :: Reg -> String -> [(FType, Reg)] -> JS
474474jsFOREIGN reg n args =
475− JSAssign (translateReg reg) (JSApp (JSIdent n) (map extract args))
476− where
477− extract :: (FType, Reg) -> JS
478− extract (ty, reg) =
479− JSIndex (JSProj (translateReg reg) "args") (JSNum (JSInt 0))
475+ JSAssign (
476+ translateReg reg
477+ ) (
478+ JSApp (JSIdent n) (map (translateReg . snd) args)
479+ )
480480
481481jsREBASE :: JS
482482jsREBASE =
@@ -563,6 +563,9 @@ jsIsNumber js = (jsTypeOf js) `jsEq` (JSString "number")
563563jsIsNull :: JS -> JS
564564jsIsNull js = JSBinOp "==" js JSNull
565565
566+jsBigInt :: JS -> JS
567+jsBigInt arg = JSApp (JSIdent "__IDRRT__bigInt") [arg]
568+
566569jsTAG :: JS -> JS
567570jsTAG js =
568571 JSTernary (jsIsNumber js `jsOr` jsIsNull js) (
@@ -611,22 +614,609 @@ jsOP reg op args = JSAssign (translateReg reg) jsOP'
611614 where
612615 jsOP' :: JS
613616 jsOP'
617+ | LNoOp <- op = translateReg (last args)
618+
619+ {-| (LZExt (ITFixed IT8) ITNative) <- op = jsUnPackBits $ JSVar (last args)-}
620+ {-| (LZExt (ITFixed IT16) ITNative) <- op = jsUnPackBits $ JSVar (last args)-}
621+ {-| (LZExt (ITFixed IT32) ITNative) <- op = jsUnPackBits $ JSVar (last args)-}
622+
623+ | (LZExt _ ITBig) <- op = jsBigInt $ JSApp (JSIdent "String") [translateReg (last args)]
624+ | (LPlus (ATInt ITBig)) <- op
625+ , (lhs:rhs:_) <- args = invokeMeth lhs "add" [rhs]
626+ | (LMinus (ATInt ITBig)) <- op
627+ , (lhs:rhs:_) <- args = invokeMeth lhs "subtract" [rhs]
628+ | (LTimes (ATInt ITBig)) <- op
629+ , (lhs:rhs:_) <- args = invokeMeth lhs "multiply" [rhs]
630+ | (LSDiv (ATInt ITBig)) <- op
631+ , (lhs:rhs:_) <- args = invokeMeth lhs "divide" [rhs]
632+ | (LSRem (ATInt ITBig)) <- op
633+ , (lhs:rhs:_) <- args = invokeMeth lhs "mod" [rhs]
634+ | (LEq (ATInt ITBig)) <- op
635+ , (lhs:rhs:_) <- args = invokeMeth lhs "equals" [rhs]
636+ | (LSLt (ATInt ITBig)) <- op
637+ , (lhs:rhs:_) <- args = invokeMeth lhs "lesser" [rhs]
638+ | (LSLe (ATInt ITBig)) <- op
639+ , (lhs:rhs:_) <- args = invokeMeth lhs "lesserOrEquals" [rhs]
640+ | (LSGt (ATInt ITBig)) <- op
641+ , (lhs:rhs:_) <- args = invokeMeth lhs "greater" [rhs]
642+ | (LSGe (ATInt ITBig)) <- op
643+ , (lhs:rhs:_) <- args = invokeMeth lhs "greaterOrEquals" [rhs]
644+
645+ | (LPlus ATFloat) <- op
646+ , (lhs:rhs:_) <- args = translateBinaryOp "+" lhs rhs
647+ | (LMinus ATFloat) <- op
648+ , (lhs:rhs:_) <- args = translateBinaryOp "-" lhs rhs
649+ | (LTimes ATFloat) <- op
650+ , (lhs:rhs:_) <- args = translateBinaryOp "*" lhs rhs
651+ | (LSDiv ATFloat) <- op
652+ , (lhs:rhs:_) <- args = translateBinaryOp "/" lhs rhs
653+ | (LEq ATFloat) <- op
654+ , (lhs:rhs:_) <- args = translateBinaryOp "==" lhs rhs
655+ | (LSLt ATFloat) <- op
656+ , (lhs:rhs:_) <- args = translateBinaryOp "<" lhs rhs
657+ | (LSLe ATFloat) <- op
658+ , (lhs:rhs:_) <- args = translateBinaryOp "<=" lhs rhs
659+ | (LSGt ATFloat) <- op
660+ , (lhs:rhs:_) <- args = translateBinaryOp ">" lhs rhs
661+ | (LSGe ATFloat) <- op
662+ , (lhs:rhs:_) <- args = translateBinaryOp ">=" lhs rhs
663+
664+ {-| (LPlus (ATInt ITChar)) <- op-}
665+ {-, (lhs:rhs:_) <- args =-}
666+ {-jsCall "__IDRRT__fromCharCode" [-}
667+ {-JSBinOp "+" (-}
668+ {-jsCall "__IDRRT__charCode" [JSVar lhs]-}
669+ {-) (-}
670+ {-jsCall "__IDRRT__charCode" [JSVar rhs]-}
671+ {-)-}
672+ {-]-}
673+
674+ {-| (LTrunc (ITFixed IT16) (ITFixed IT8)) <- op-}
675+ {-, (arg:_) <- args =-}
676+ {-jsPackUBits8 (-}
677+ {-JSBinOp "&" (jsUnPackBits $ JSVar arg) (JSNum (JSInt 0xFF))-}
678+ {-)-}
679+
680+ {-| (LTrunc (ITFixed IT32) (ITFixed IT16)) <- op-}
681+ {-, (arg:_) <- args =-}
682+ {-jsPackUBits16 (-}
683+ {-JSBinOp "&" (jsUnPackBits $ JSVar arg) (JSNum (JSInt 0xFFFF))-}
684+ {-)-}
685+
686+ {-| (LTrunc (ITFixed IT64) (ITFixed IT32)) <- op-}
687+ {-, (arg:_) <- args =-}
688+ {-jsPackUBits32 (-}
689+ {-jsMeth (jsMeth (JSVar arg) "and" [-}
690+ {-jsBigInt (JSString $ show 0xFFFFFFFF)-}
691+ {-]) "intValue" []-}
692+ {-)-}
693+
694+ {-| (LTrunc ITBig (ITFixed IT64)) <- op-}
695+ {-, (arg:_) <- args =-}
696+ {-jsMeth (JSVar arg) "and" [-}
697+ {-jsBigInt (JSString $ show 0xFFFFFFFFFFFFFFFF)-}
698+ {-]-}
699+
700+ {-| (LLSHR (ITFixed IT8)) <- op-}
701+ {-, (lhs:rhs:_) <- args =-}
702+ {-jsPackUBits8 (-}
703+ {-JSBinOp ">>" (jsUnPackBits $ JSVar lhs) (jsUnPackBits $ JSVar rhs)-}
704+ {-)-}
705+
706+ {-| (LLSHR (ITFixed IT16)) <- op-}
707+ {-, (lhs:rhs:_) <- args =-}
708+ {-jsPackUBits16 (-}
709+ {-JSBinOp ">>" (jsUnPackBits $ JSVar lhs) (jsUnPackBits $ JSVar rhs)-}
710+ {-)-}
711+
712+ {-| (LLSHR (ITFixed IT32)) <- op-}
713+ {-, (lhs:rhs:_) <- args =-}
714+ {-jsPackUBits32 (-}
715+ {-JSBinOp ">>" (jsUnPackBits $ JSVar lhs) (jsUnPackBits $ JSVar rhs)-}
716+ {-)-}
717+
718+ | (LLSHR (ITFixed IT64)) <- op
719+ , (lhs:rhs:_) <- args =
720+ jsMeth (translateReg lhs) "shiftRight" [translateReg rhs]
721+
722+ {-| (LSHL (ITFixed IT8)) <- op-}
723+ {-, (lhs:rhs:_) <- args =-}
724+ {-jsPackUBits8 (-}
725+ {-JSBinOp "<<" (jsUnPackBits $ JSVar lhs) (jsUnPackBits $ JSVar rhs)-}
726+ {-)-}
727+
728+ {-| (LSHL (ITFixed IT16)) <- op-}
729+ {-, (lhs:rhs:_) <- args =-}
730+ {-jsPackUBits16 (-}
731+ {-JSBinOp "<<" (jsUnPackBits $ JSVar lhs) (jsUnPackBits $ JSVar rhs)-}
732+ {-)-}
733+
734+ {-| (LSHL (ITFixed IT32)) <- op-}
735+ {-, (lhs:rhs:_) <- args =-}
736+ {-jsPackUBits32 (-}
737+ {-JSBinOp "<<" (jsUnPackBits $ JSVar lhs) (jsUnPackBits $ JSVar rhs)-}
738+ {-)-}
739+
740+ {-| (LSHL (ITFixed IT64)) <- op-}
741+ {-, (lhs:rhs:_) <- args =-}
742+ {-jsMeth (jsMeth (JSVar lhs) "shiftLeft" [JSVar rhs]) "and" [-}
743+ {-jsBigInt (JSString $ show 0xFFFFFFFFFFFFFFFF)-}
744+ {-]-}
745+
746+ {-| (LAnd (ITFixed IT8)) <- op-}
747+ {-, (lhs:rhs:_) <- args =-}
748+ {-jsPackUBits8 (-}
749+ {-JSBinOp "&" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
750+ {-)-}
751+
752+ {-| (LAnd (ITFixed IT16)) <- op-}
753+ {-, (lhs:rhs:_) <- args =-}
754+ {-jsPackUBits16 (-}
755+ {-JSBinOp "&" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
756+ {-)-}
757+
758+ {-| (LAnd (ITFixed IT32)) <- op-}
759+ {-, (lhs:rhs:_) <- args =-}
760+ {-jsPackUBits32 (-}
761+ {-JSBinOp "&" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
762+ {-)-}
763+
764+ | (LAnd (ITFixed IT64)) <- op
765+ , (lhs:rhs:_) <- args =
766+ jsMeth (translateReg lhs) "and" [translateReg rhs]
767+
768+ {-| (LOr (ITFixed IT8)) <- op-}
769+ {-, (lhs:rhs:_) <- args =-}
770+ {-jsPackUBits8 (-}
771+ {-JSBinOp "|" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
772+ {-)-}
773+
774+ {-| (LOr (ITFixed IT16)) <- op-}
775+ {-, (lhs:rhs:_) <- args =-}
776+ {-jsPackUBits16 (-}
777+ {-JSBinOp "|" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
778+ {-)-}
779+
780+ {-| (LOr (ITFixed IT32)) <- op-}
781+ {-, (lhs:rhs:_) <- args =-}
782+ {-jsPackUBits32 (-}
783+ {-JSBinOp "|" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
784+ {-)-}
785+
786+ | (LOr (ITFixed IT64)) <- op
787+ , (lhs:rhs:_) <- args =
788+ jsMeth (translateReg lhs) "or" [translateReg rhs]
789+
790+ {-| (LXOr (ITFixed IT8)) <- op-}
791+ {-, (lhs:rhs:_) <- args =-}
792+ {-jsPackUBits8 (-}
793+ {-JSBinOp "^" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
794+ {-)-}
795+
796+ {-| (LXOr (ITFixed IT16)) <- op-}
797+ {-, (lhs:rhs:_) <- args =-}
798+ {-jsPackUBits16 (-}
799+ {-JSBinOp "^" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
800+ {-)-}
801+
802+ {-| (LXOr (ITFixed IT32)) <- op-}
803+ {-, (lhs:rhs:_) <- args =-}
804+ {-jsPackUBits32 (-}
805+ {-JSBinOp "^" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
806+ {-)-}
807+
808+ | (LXOr (ITFixed IT64)) <- op
809+ , (lhs:rhs:_) <- args =
810+ jsMeth (translateReg lhs) "xor" [translateReg rhs]
811+
812+ {-| (LPlus (ATInt (ITFixed IT8))) <- op-}
813+ {-, (lhs:rhs:_) <- args =-}
814+ {-jsPackUBits8 (-}
815+ {-JSBinOp "+" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
816+ {-)-}
817+
818+ {-| (LPlus (ATInt (ITFixed IT16))) <- op-}
819+ {-, (lhs:rhs:_) <- args =-}
820+ {-jsPackUBits16 (-}
821+ {-JSBinOp "+" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
822+ {-)-}
823+
824+ {-| (LPlus (ATInt (ITFixed IT32))) <- op-}
825+ {-, (lhs:rhs:_) <- args =-}
826+ {-jsPackUBits32 (-}
827+ {-JSBinOp "+" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
828+ {-)-}
829+
830+ {-| (LPlus (ATInt (ITFixed IT64))) <- op-}
831+ {-, (lhs:rhs:_) <- args =-}
832+ {-jsMeth (jsMeth (JSVar lhs) "add" [JSVar rhs]) "and" [-}
833+ {-jsBigInt (JSString $ show 0xFFFFFFFFFFFFFFFF)-}
834+ {-]-}
835+
836+ {-| (LMinus (ATInt (ITFixed IT8))) <- op-}
837+ {-, (lhs:rhs:_) <- args =-}
838+ {-jsPackUBits8 (-}
839+ {-JSBinOp "-" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
840+ {-)-}
841+
842+ {-| (LMinus (ATInt (ITFixed IT16))) <- op-}
843+ {-, (lhs:rhs:_) <- args =-}
844+ {-jsPackUBits16 (-}
845+ {-JSBinOp "-" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
846+ {-)-}
847+
848+ {-| (LMinus (ATInt (ITFixed IT32))) <- op-}
849+ {-, (lhs:rhs:_) <- args =-}
850+ {-jsPackUBits32 (-}
851+ {-JSBinOp "-" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
852+ {-)-}
853+
854+ {-| (LMinus (ATInt (ITFixed IT64))) <- op-}
855+ {-, (lhs:rhs:_) <- args =-}
856+ {-jsMeth (jsMeth (JSVar lhs) "subtract" [JSVar rhs]) "and" [-}
857+ {-jsBigInt (JSString $ show 0xFFFFFFFFFFFFFFFF)-}
858+ {-]-}
859+
860+ {-| (LTimes (ATInt (ITFixed IT8))) <- op-}
861+ {-, (lhs:rhs:_) <- args =-}
862+ {-jsPackUBits8 (-}
863+ {-JSBinOp "*" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
864+ {-)-}
865+
866+ {-| (LTimes (ATInt (ITFixed IT16))) <- op-}
867+ {-, (lhs:rhs:_) <- args =-}
868+ {-jsPackUBits16 (-}
869+ {-JSBinOp "*" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
870+ {-)-}
871+
872+ {-| (LTimes (ATInt (ITFixed IT32))) <- op-}
873+ {-, (lhs:rhs:_) <- args =-}
874+ {-jsPackUBits32 (-}
875+ {-JSBinOp "*" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
876+ {-)-}
877+
878+ {-| (LTimes (ATInt (ITFixed IT64))) <- op-}
879+ {-, (lhs:rhs:_) <- args =-}
880+ {-jsMeth (jsMeth (JSVar lhs) "multiply" [JSVar rhs]) "and" [-}
881+ {-jsBigInt (JSString $ show 0xFFFFFFFFFFFFFFFF)-}
882+ {-]-}
883+
884+ {-| (LEq (ATInt (ITFixed IT8))) <- op-}
885+ {-, (lhs:rhs:_) <- args =-}
886+ {-jsPackUBits8 (-}
887+ {-JSBinOp "==" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
888+ {-)-}
889+
890+ {-| (LEq (ATInt (ITFixed IT16))) <- op-}
891+ {-, (lhs:rhs:_) <- args =-}
892+ {-jsPackUBits16 (-}
893+ {-JSBinOp "==" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
894+ {-)-}
895+
896+ {-| (LEq (ATInt (ITFixed IT32))) <- op-}
897+ {-, (lhs:rhs:_) <- args =-}
898+ {-jsPackUBits32 (-}
899+ {-JSBinOp "==" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
900+ {-)-}
901+
902+ {-| (LEq (ATInt (ITFixed IT64))) <- op-}
903+ {-, (lhs:rhs:_) <- args =-}
904+ {-jsMeth (jsMeth (JSVar lhs) "equals" [JSVar rhs]) "and" [-}
905+ {-jsBigInt (JSString $ show 0xFFFFFFFFFFFFFFFF)-}
906+ {-]-}
907+
908+ {-| (LLt (ITFixed IT8)) <- op-}
909+ {-, (lhs:rhs:_) <- args =-}
910+ {-jsPackUBits8 (-}
911+ {-JSBinOp "<" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
912+ {-)-}
913+
914+ {-| (LLt (ITFixed IT16)) <- op-}
915+ {-, (lhs:rhs:_) <- args =-}
916+ {-jsPackUBits16 (-}
917+ {-JSBinOp "<" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
918+ {-)-}
919+
920+ {-| (LLt (ITFixed IT32)) <- op-}
921+ {-, (lhs:rhs:_) <- args =-}
922+ {-jsPackUBits32 (-}
923+ {-JSBinOp "<" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
924+ {-)-}
925+
926+ | (LLt (ITFixed IT64)) <- op
927+ , (lhs:rhs:_) <- args = invokeMeth lhs "lesser" [rhs]
928+
929+ {-| (LLe (ITFixed IT8)) <- op-}
930+ {-, (lhs:rhs:_) <- args =-}
931+ {-jsPackUBits8 (-}
932+ {-JSBinOp "<=" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
933+ {-)-}
934+
935+ {-| (LLe (ITFixed IT16)) <- op-}
936+ {-, (lhs:rhs:_) <- args =-}
937+ {-jsPackUBits16 (-}
938+ {-JSBinOp "<=" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
939+ {-)-}
940+
941+ {-| (LLe (ITFixed IT32)) <- op-}
942+ {-, (lhs:rhs:_) <- args =-}
943+ {-jsPackUBits32 (-}
944+ {-JSBinOp "<=" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
945+ {-)-}
946+
947+ | (LLe (ITFixed IT64)) <- op
948+ , (lhs:rhs:_) <- args = invokeMeth lhs "lesserOrEquals" [rhs]
949+
950+ {-| (LGt (ITFixed IT8)) <- op-}
951+ {-, (lhs:rhs:_) <- args =-}
952+ {-jsPackUBits8 (-}
953+ {-JSBinOp ">" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
954+ {-)-}
955+
956+ {-| (LGt (ITFixed IT16)) <- op-}
957+ {-, (lhs:rhs:_) <- args =-}
958+ {-jsPackUBits16 (-}
959+ {-JSBinOp ">" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
960+ {-)-}
961+ {-| (LGt (ITFixed IT32)) <- op-}
962+ {-, (lhs:rhs:_) <- args =-}
963+ {-jsPackUBits32 (-}
964+ {-JSBinOp ">" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
965+ {-)-}
966+
967+ | (LGt (ITFixed IT64)) <- op
968+ , (lhs:rhs:_) <- args = invokeMeth lhs "greater" [rhs]
969+
970+ {-| (LGe (ITFixed IT8)) <- op-}
971+ {-, (lhs:rhs:_) <- args =-}
972+ {-jsPackUBits8 (-}
973+ {-JSBinOp ">=" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
974+ {-)-}
975+
976+ {-| (LGe (ITFixed IT16)) <- op-}
977+ {-, (lhs:rhs:_) <- args =-}
978+ {-jsPackUBits16 (-}
979+ {-JSBinOp ">=" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
980+ {-)-}
981+ {-| (LGe (ITFixed IT32)) <- op-}
982+ {-, (lhs:rhs:_) <- args =-}
983+ {-jsPackUBits32 (-}
984+ {-JSBinOp ">=" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
985+ {-)-}
986+
987+ | (LGe (ITFixed IT64)) <- op
988+ , (lhs:rhs:_) <- args = invokeMeth lhs "greaterOrEquals" [rhs]
989+
990+ {-| (LUDiv (ITFixed IT8)) <- op-}
991+ {-, (lhs:rhs:_) <- args =-}
992+ {-jsPackUBits8 (-}
993+ {-JSBinOp "/" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
994+ {-)-}
995+
996+ {-| (LUDiv (ITFixed IT16)) <- op-}
997+ {-, (lhs:rhs:_) <- args =-}
998+ {-jsPackUBits16 (-}
999+ {-JSBinOp "/" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
1000+ {-)-}
1001+
1002+ {-| (LUDiv (ITFixed IT32)) <- op-}
1003+ {-, (lhs:rhs:_) <- args =-}
1004+ {-jsPackUBits32 (-}
1005+ {-JSBinOp "/" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
1006+ {-)-}
1007+
1008+ {-| (LUDiv (ITFixed IT64)) <- op-}
1009+ {-, (lhs:rhs:_) <- args = invokeMeth lhs "divide" [rhs]-}
1010+
1011+ {-| (LSDiv (ATInt (ITFixed IT8))) <- op-}
1012+ {-, (lhs:rhs:_) <- args =-}
1013+ {-jsPackSBits8 (-}
1014+ {-JSBinOp "/" (-}
1015+ {-jsUnPackBits $ jsPackSBits8 $ jsUnPackBits (JSVar lhs)-}
1016+ {-) (-}
1017+ {-jsUnPackBits $ jsPackSBits8 $ jsUnPackBits (JSVar rhs)-}
1018+ {-)-}
1019+ {-)-}
1020+
1021+ {-| (LSDiv (ATInt (ITFixed IT16))) <- op-}
1022+ {-, (lhs:rhs:_) <- args =-}
1023+ {-jsPackSBits16 (-}
1024+ {-JSBinOp "/" (-}
1025+ {-jsUnPackBits $ jsPackSBits16 $ jsUnPackBits (JSVar lhs)-}
1026+ {-) (-}
1027+ {-jsUnPackBits $ jsPackSBits16 $ jsUnPackBits (JSVar rhs)-}
1028+ {-)-}
1029+ {-)-}
1030+
1031+ {-| (LSDiv (ATInt (ITFixed IT32))) <- op-}
1032+ {-, (lhs:rhs:_) <- args =-}
1033+ {-jsPackSBits32 (-}
1034+ {-JSBinOp "/" (-}
1035+ {-jsUnPackBits $ jsPackSBits32 $ jsUnPackBits (JSVar lhs)-}
1036+ {-) (-}
1037+ {-jsUnPackBits $ jsPackSBits32 $ jsUnPackBits (JSVar rhs)-}
1038+ {-)-}
1039+ {-)-}
1040+
1041+ | (LSDiv (ATInt (ITFixed IT64))) <- op
1042+ , (lhs:rhs:_) <- args = invokeMeth lhs "divide" [rhs]
1043+
1044+ {-| (LSRem (ATInt (ITFixed IT8))) <- op-}
1045+ {-, (lhs:rhs:_) <- args =-}
1046+ {-jsPackSBits8 (-}
1047+ {-JSBinOp "%" (-}
1048+ {-jsUnPackBits $ jsPackSBits8 $ jsUnPackBits (JSVar lhs)-}
1049+ {-) (-}
1050+ {-jsUnPackBits $ jsPackSBits8 $ jsUnPackBits (JSVar rhs)-}
1051+ {-)-}
1052+ {-)-}
1053+
1054+ {-| (LSRem (ATInt (ITFixed IT16))) <- op-}
1055+ {-, (lhs:rhs:_) <- args =-}
1056+ {-jsPackSBits16 (-}
1057+ {-JSBinOp "%" (-}
1058+ {-jsUnPackBits $ jsPackSBits16 $ jsUnPackBits (JSVar lhs)-}
1059+ {-) (-}
1060+ {-jsUnPackBits $ jsPackSBits16 $ jsUnPackBits (JSVar rhs)-}
1061+ {-)-}
1062+ {-)-}
1063+
1064+ {-| (LSRem (ATInt (ITFixed IT32))) <- op-}
1065+ {-, (lhs:rhs:_) <- args =-}
1066+ {-jsPackSBits32 (-}
1067+ {-JSBinOp "%" (-}
1068+ {-jsUnPackBits $ jsPackSBits32 $ jsUnPackBits (JSVar lhs)-}
1069+ {-) (-}
1070+ {-jsUnPackBits $ jsPackSBits32 $ jsUnPackBits (JSVar rhs)-}
1071+ {-)-}
1072+ {-)-}
1073+
1074+ | (LSRem (ATInt (ITFixed IT64))) <- op
1075+ , (lhs:rhs:_) <- args = invokeMeth lhs "mod" [rhs]
1076+
1077+ {-| (LCompl (ITFixed IT8)) <- op-}
1078+ {-, (arg:_) <- args =-}
1079+ {-jsPackSBits8 $ JSPreOp "~" $ jsUnPackBits (JSVar arg)-}
1080+
1081+ {-| (LCompl (ITFixed IT16)) <- op-}
1082+ {-, (arg:_) <- args =-}
1083+ {-jsPackSBits16 $ JSPreOp "~" $ jsUnPackBits (JSVar arg)-}
1084+
1085+ {-| (LCompl (ITFixed IT32)) <- op-}
1086+ {-, (arg:_) <- args =-}
1087+ {-jsPackSBits32 $ JSPreOp "~" $ jsUnPackBits (JSVar arg)-}
1088+
1089+ | (LCompl (ITFixed IT64)) <- op
1090+ , (arg:_) <- args =
1091+ invokeMeth arg "not" []
1092+
1093+ | (LPlus _) <- op
1094+ , (lhs:rhs:_) <- args = translateBinaryOp "+" lhs rhs
1095+ | (LMinus _) <- op
1096+ , (lhs:rhs:_) <- args = translateBinaryOp "-" lhs rhs
1097+ | (LTimes _) <- op
1098+ , (lhs:rhs:_) <- args = translateBinaryOp "*" lhs rhs
1099+ | (LSDiv _) <- op
1100+ , (lhs:rhs:_) <- args = translateBinaryOp "/" lhs rhs
1101+ | (LSRem _) <- op
1102+ , (lhs:rhs:_) <- args = translateBinaryOp "%" lhs rhs
1103+ | (LEq _) <- op
1104+ , (lhs:rhs:_) <- args = translateBinaryOp "==" lhs rhs
1105+ | (LSLt _) <- op
1106+ , (lhs:rhs:_) <- args = translateBinaryOp "<" lhs rhs
1107+ | (LSLe _) <- op
1108+ , (lhs:rhs:_) <- args = translateBinaryOp "<=" lhs rhs
1109+ | (LSGt _) <- op
1110+ , (lhs:rhs:_) <- args = translateBinaryOp ">" lhs rhs
1111+ | (LSGe _) <- op
1112+ , (lhs:rhs:_) <- args = translateBinaryOp ">=" lhs rhs
1113+ | (LAnd _) <- op
1114+ , (lhs:rhs:_) <- args = translateBinaryOp "&" lhs rhs
1115+ | (LOr _) <- op
1116+ , (lhs:rhs:_) <- args = translateBinaryOp "|" lhs rhs
1117+ | (LXOr _) <- op
1118+ , (lhs:rhs:_) <- args = translateBinaryOp "^" lhs rhs
1119+ | (LSHL _) <- op
1120+ , (lhs:rhs:_) <- args = translateBinaryOp "<<" rhs lhs
1121+ | (LASHR _) <- op
1122+ , (lhs:rhs:_) <- args = translateBinaryOp ">>" rhs lhs
1123+ | (LCompl _) <- op
1124+ , (arg:_) <- args = JSPreOp "~" (translateReg arg)
1125+
6141126 | LStrConcat <- op
615− , (lhs:rhs:_) <- args = JSBinOp "+" (translateReg lhs) (translateReg rhs)
616− | LPlus _ <- op
617− , (lhs:rhs:_) <- args = JSBinOp "+" (translateReg lhs) (translateReg rhs)
618− | LMinus _ <- op
619− , (lhs:rhs:_) <- args = JSBinOp "-" (translateReg lhs) (translateReg rhs)
620− | LIntStr _ <- op
621− , (arg:_) <- args = JSApp (JSIdent "String") [translateReg arg]
622− | LEq _ <- op
623− , (lhs:rhs:_) <- args = JSBinOp "==" (translateReg lhs) (translateReg rhs)
624− | LSLt _ <- op
625− , (lhs:rhs:_) <- args = JSBinOp "<" (translateReg lhs) (translateReg rhs)
626− | otherwise = JSRaw $ show op
1127+ , (lhs:rhs:_) <- args = translateBinaryOp "+" lhs rhs
1128+ | LStrEq <- op
1129+ , (lhs:rhs:_) <- args = translateBinaryOp "==" lhs rhs
1130+ | LStrLt <- op
1131+ , (lhs:rhs:_) <- args = translateBinaryOp "<" lhs rhs
1132+ | LStrLen <- op
1133+ , (arg:_) <- args = JSProj (translateReg arg) "length"
1134+ | (LStrInt ITNative) <- op
1135+ , (arg:_) <- args = jsCall "parseInt" [translateReg arg]
1136+ | (LIntStr ITNative) <- op
1137+ , (arg:_) <- args = jsCall "String" [translateReg arg]
1138+ | (LSExt ITNative ITBig) <- op
1139+ , (arg:_) <- args = jsBigInt $ jsCall "String" [translateReg arg]
1140+ | (LTrunc ITBig ITNative) <- op
1141+ , (arg:_) <- args = jsMeth (translateReg arg) "intValue" []
1142+ | (LIntStr ITBig) <- op
1143+ , (arg:_) <- args = jsMeth (translateReg arg) "toString" []
1144+ | (LStrInt ITBig) <- op
1145+ , (arg:_) <- args = jsBigInt $ translateReg arg
1146+ | LFloatStr <- op
1147+ , (arg:_) <- args = jsCall "String" [translateReg arg]
1148+ | LStrFloat <- op
1149+ , (arg:_) <- args = jsCall "parseFloat" [translateReg arg]
1150+ | (LIntFloat ITNative) <- op
1151+ , (arg:_) <- args = translateReg arg
1152+ | (LFloatInt ITNative) <- op
1153+ , (arg:_) <- args = translateReg arg
1154+ | (LChInt ITNative) <- op
1155+ , (arg:_) <- args = jsCall "__IDRRT__charCode" [translateReg arg]
1156+ | (LIntCh ITNative) <- op
1157+ , (arg:_) <- args = jsCall "__IDRRT__fromCharCode" [translateReg arg]
1158+
1159+ | LFExp <- op
1160+ , (arg:_) <- args = jsCall "Math.exp" [translateReg arg]
1161+ | LFLog <- op
1162+ , (arg:_) <- args = jsCall "Math.log" [translateReg arg]
1163+ | LFSin <- op
1164+ , (arg:_) <- args = jsCall "Math.sin" [translateReg arg]
1165+ | LFCos <- op
1166+ , (arg:_) <- args = jsCall "Math.cos" [translateReg arg]
1167+ | LFTan <- op
1168+ , (arg:_) <- args = jsCall "Math.tan" [translateReg arg]
1169+ | LFASin <- op
1170+ , (arg:_) <- args = jsCall "Math.asin" [translateReg arg]
1171+ | LFACos <- op
1172+ , (arg:_) <- args = jsCall "Math.acos" [translateReg arg]
1173+ | LFATan <- op
1174+ , (arg:_) <- args = jsCall "Math.atan" [translateReg arg]
1175+ | LFSqrt <- op
1176+ , (arg:_) <- args = jsCall "Math.sqrt" [translateReg arg]
1177+ | LFFloor <- op
1178+ , (arg:_) <- args = jsCall "Math.floor" [translateReg arg]
1179+ | LFCeil <- op
1180+ , (arg:_) <- args = jsCall "Math.ceil" [translateReg arg]
1181+
1182+ | LStrCons <- op
1183+ , (lhs:rhs:_) <- args = invokeMeth lhs "concat" [rhs]
1184+ | LStrHead <- op
1185+ , (arg:_) <- args = JSIndex (translateReg arg) (JSNum (JSInt 0))
1186+ | LStrRev <- op
1187+ , (arg:_) <- args = JSProj (translateReg arg) "split('').reverse().join('')"
1188+ | LStrIndex <- op
1189+ , (lhs:rhs:_) <- args = JSIndex (translateReg lhs) (translateReg rhs)
1190+ {-| LStrTail <- op-}
1191+ {-, (arg:_) <- args = let v = translateVariableName arg in-}
1192+ {-JSApp (JSProj (JSIdent v) "substr") [-}
1193+ {-JSNum (JSInt 1),-}
1194+ {-JSBinOp "-" (JSProj (JSIdent v) "length") (JSNum (JSInt 1))-}
1195+ {-]-}
1196+ {-| LSystemInfo <- op-}
1197+ {-, (arg:_) <- args = jsCall "__IDRRT__systemInfo" [JSVar arg]-}
1198+ | LNullPtr <- op
1199+ , (_) <- args = JSNull
1200+ where
1201+ translateBinaryOp :: String -> Reg -> Reg -> JS
1202+ translateBinaryOp op lhs rhs =
1203+ JSBinOp op (translateReg lhs) (translateReg rhs)
1204+
1205+ invokeMeth :: Reg -> String -> [Reg] -> JS
1206+ invokeMeth obj meth args =
1207+ JSApp (JSProj (translateReg obj) meth) $ map translateReg args
1208+
1209+ jsMeth :: JS -> String -> [JS] -> JS
1210+ jsMeth obj meth args = JSApp (JSProj obj meth) args
1211+
1212+
1213+ jsCall :: String -> [JS] -> JS
1214+ jsCall fun args = JSApp (JSIdent fun) args
1215+
1216+
6271217
6281218jsRESERVE :: Int -> JS
629−jsRESERVE n = JSNoop -- JSApp (JSIdent "i$RESERVE") [JSIdent "vm", JSNum $ JSInt n]
1219+jsRESERVE n = JSApp (JSIdent "i$RESERVE") [JSIdent "vm", JSNum $ JSInt n]
6301220
6311221translateBC :: BC -> JS
6321222translateBC bc