on master help sign in
javascript: unlock primitives
commitc47bd867bbff40434d5f2228ddf7d12f6a9cdf10 authorraichoo <raichoo@googlemail.com> dateSat 21 Jun 2014, 15:47 (12 years ago) parent8c3a1ef
1 file changed+381−385
src/IRTS/CodegenJavaScript.hs+381−385
src/IRTS/CodegenJavaScript.hs+381−385
@@ -81,7 +81,6 @@ data JS = JSRaw String
8181 | JSPreOp String JS
8282 | JSPostOp String JS
8383 | JSProj JS String
84− | JSVar LVar
8584 | JSNull
8685 | JSThis
8786 | JSTrue
@@ -171,9 +170,6 @@ compileJS (JSProj obj field)
171170 | otherwise =
172171 compileJS obj ++ '.' : field
173172
174−{-compileJS (JSVar var) =-}
175− {-translateVariableName var-}
176−
177173compileJS JSNull =
178174 "null"
179175
@@ -705,430 +701,430 @@ jsOP reg op args = JSAssign (translateReg reg) jsOP'
705701 | (LSGe ATFloat) <- op
706702 , (lhs:rhs:_) <- args = translateBinaryOp ">=" lhs rhs
707703
708− {-| (LPlus (ATInt ITChar)) <- op-}
709− {-, (lhs:rhs:_) <- args =-}
710− {-jsCall "__IDRRT__fromCharCode" [-}
711− {-JSBinOp "+" (-}
712− {-jsCall "__IDRRT__charCode" [JSVar lhs]-}
713− {-) (-}
714− {-jsCall "__IDRRT__charCode" [JSVar rhs]-}
715− {-)-}
716− {-]-}
717−
718− {-| (LTrunc (ITFixed IT16) (ITFixed IT8)) <- op-}
719− {-, (arg:_) <- args =-}
720− {-jsPackUBits8 (-}
721− {-JSBinOp "&" (jsUnPackBits $ JSVar arg) (JSNum (JSInt 0xFF))-}
722− {-)-}
723−
724− {-| (LTrunc (ITFixed IT32) (ITFixed IT16)) <- op-}
725− {-, (arg:_) <- args =-}
726− {-jsPackUBits16 (-}
727− {-JSBinOp "&" (jsUnPackBits $ JSVar arg) (JSNum (JSInt 0xFFFF))-}
728− {-)-}
729−
730− {-| (LTrunc (ITFixed IT64) (ITFixed IT32)) <- op-}
731− {-, (arg:_) <- args =-}
732− {-jsPackUBits32 (-}
733− {-jsMeth (jsMeth (JSVar arg) "and" [-}
734− {-jsBigInt (JSString $ show 0xFFFFFFFF)-}
735− {-]) "intValue" []-}
736− {-)-}
737−
738− {-| (LTrunc ITBig (ITFixed IT64)) <- op-}
739− {-, (arg:_) <- args =-}
740− {-jsMeth (JSVar arg) "and" [-}
741− {-jsBigInt (JSString $ show 0xFFFFFFFFFFFFFFFF)-}
742− {-]-}
743−
744− {-| (LLSHR (ITFixed IT8)) <- op-}
745− {-, (lhs:rhs:_) <- args =-}
746− {-jsPackUBits8 (-}
747− {-JSBinOp ">>" (jsUnPackBits $ JSVar lhs) (jsUnPackBits $ JSVar rhs)-}
748− {-)-}
749−
750− {-| (LLSHR (ITFixed IT16)) <- op-}
751− {-, (lhs:rhs:_) <- args =-}
752− {-jsPackUBits16 (-}
753− {-JSBinOp ">>" (jsUnPackBits $ JSVar lhs) (jsUnPackBits $ JSVar rhs)-}
754− {-)-}
755−
756− {-| (LLSHR (ITFixed IT32)) <- op-}
757− {-, (lhs:rhs:_) <- args =-}
758− {-jsPackUBits32 (-}
759− {-JSBinOp ">>" (jsUnPackBits $ JSVar lhs) (jsUnPackBits $ JSVar rhs)-}
760− {-)-}
704+ | (LPlus (ATInt ITChar)) <- op
705+ , (lhs:rhs:_) <- args =
706+ jsCall "__IDRRT__fromCharCode" [
707+ JSBinOp "+" (
708+ jsCall "__IDRRT__charCode" [translateReg lhs]
709+ ) (
710+ jsCall "__IDRRT__charCode" [translateReg rhs]
711+ )
712+ ]
713+
714+ | (LTrunc (ITFixed IT16) (ITFixed IT8)) <- op
715+ , (arg:_) <- args =
716+ jsPackUBits8 (
717+ JSBinOp "&" (jsUnPackBits $ translateReg arg) (JSNum (JSInt 0xFF))
718+ )
719+
720+ | (LTrunc (ITFixed IT32) (ITFixed IT16)) <- op
721+ , (arg:_) <- args =
722+ jsPackUBits16 (
723+ JSBinOp "&" (jsUnPackBits $ translateReg arg) (JSNum (JSInt 0xFFFF))
724+ )
725+
726+ | (LTrunc (ITFixed IT64) (ITFixed IT32)) <- op
727+ , (arg:_) <- args =
728+ jsPackUBits32 (
729+ jsMeth (jsMeth (translateReg arg) "and" [
730+ jsBigInt (JSString $ show 0xFFFFFFFF)
731+ ]) "intValue" []
732+ )
733+
734+ | (LTrunc ITBig (ITFixed IT64)) <- op
735+ , (arg:_) <- args =
736+ jsMeth (translateReg arg) "and" [
737+ jsBigInt (JSString $ show 0xFFFFFFFFFFFFFFFF)
738+ ]
739+
740+ | (LLSHR (ITFixed IT8)) <- op
741+ , (lhs:rhs:_) <- args =
742+ jsPackUBits8 (
743+ JSBinOp ">>" (jsUnPackBits $ translateReg lhs) (jsUnPackBits $ translateReg rhs)
744+ )
745+
746+ | (LLSHR (ITFixed IT16)) <- op
747+ , (lhs:rhs:_) <- args =
748+ jsPackUBits16 (
749+ JSBinOp ">>" (jsUnPackBits $ translateReg lhs) (jsUnPackBits $ translateReg rhs)
750+ )
751+
752+ | (LLSHR (ITFixed IT32)) <- op
753+ , (lhs:rhs:_) <- args =
754+ jsPackUBits32 (
755+ JSBinOp ">>" (jsUnPackBits $ translateReg lhs) (jsUnPackBits $ translateReg rhs)
756+ )
761757
762758 | (LLSHR (ITFixed IT64)) <- op
763759 , (lhs:rhs:_) <- args =
764760 jsMeth (translateReg lhs) "shiftRight" [translateReg rhs]
765761
766− {-| (LSHL (ITFixed IT8)) <- op-}
767− {-, (lhs:rhs:_) <- args =-}
768− {-jsPackUBits8 (-}
769− {-JSBinOp "<<" (jsUnPackBits $ JSVar lhs) (jsUnPackBits $ JSVar rhs)-}
770− {-)-}
771−
772− {-| (LSHL (ITFixed IT16)) <- op-}
773− {-, (lhs:rhs:_) <- args =-}
774− {-jsPackUBits16 (-}
775− {-JSBinOp "<<" (jsUnPackBits $ JSVar lhs) (jsUnPackBits $ JSVar rhs)-}
776− {-)-}
777−
778− {-| (LSHL (ITFixed IT32)) <- op-}
779− {-, (lhs:rhs:_) <- args =-}
780− {-jsPackUBits32 (-}
781− {-JSBinOp "<<" (jsUnPackBits $ JSVar lhs) (jsUnPackBits $ JSVar rhs)-}
782− {-)-}
783−
784− {-| (LSHL (ITFixed IT64)) <- op-}
785− {-, (lhs:rhs:_) <- args =-}
786− {-jsMeth (jsMeth (JSVar lhs) "shiftLeft" [JSVar rhs]) "and" [-}
787− {-jsBigInt (JSString $ show 0xFFFFFFFFFFFFFFFF)-}
788− {-]-}
789−
790− {-| (LAnd (ITFixed IT8)) <- op-}
791− {-, (lhs:rhs:_) <- args =-}
792− {-jsPackUBits8 (-}
793− {-JSBinOp "&" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
794− {-)-}
795−
796− {-| (LAnd (ITFixed IT16)) <- op-}
797− {-, (lhs:rhs:_) <- args =-}
798− {-jsPackUBits16 (-}
799− {-JSBinOp "&" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
800− {-)-}
801−
802− {-| (LAnd (ITFixed IT32)) <- op-}
803− {-, (lhs:rhs:_) <- args =-}
804− {-jsPackUBits32 (-}
805− {-JSBinOp "&" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
806− {-)-}
762+ | (LSHL (ITFixed IT8)) <- op
763+ , (lhs:rhs:_) <- args =
764+ jsPackUBits8 (
765+ JSBinOp "<<" (jsUnPackBits $ translateReg lhs) (jsUnPackBits $ translateReg rhs)
766+ )
767+
768+ | (LSHL (ITFixed IT16)) <- op
769+ , (lhs:rhs:_) <- args =
770+ jsPackUBits16 (
771+ JSBinOp "<<" (jsUnPackBits $ translateReg lhs) (jsUnPackBits $ translateReg rhs)
772+ )
773+
774+ | (LSHL (ITFixed IT32)) <- op
775+ , (lhs:rhs:_) <- args =
776+ jsPackUBits32 (
777+ JSBinOp "<<" (jsUnPackBits $ translateReg lhs) (jsUnPackBits $ translateReg rhs)
778+ )
779+
780+ | (LSHL (ITFixed IT64)) <- op
781+ , (lhs:rhs:_) <- args =
782+ jsMeth (jsMeth (translateReg lhs) "shiftLeft" [translateReg rhs]) "and" [
783+ jsBigInt (JSString $ show 0xFFFFFFFFFFFFFFFF)
784+ ]
785+
786+ | (LAnd (ITFixed IT8)) <- op
787+ , (lhs:rhs:_) <- args =
788+ jsPackUBits8 (
789+ JSBinOp "&" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
790+ )
791+
792+ | (LAnd (ITFixed IT16)) <- op
793+ , (lhs:rhs:_) <- args =
794+ jsPackUBits16 (
795+ JSBinOp "&" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
796+ )
797+
798+ | (LAnd (ITFixed IT32)) <- op
799+ , (lhs:rhs:_) <- args =
800+ jsPackUBits32 (
801+ JSBinOp "&" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
802+ )
807803
808804 | (LAnd (ITFixed IT64)) <- op
809805 , (lhs:rhs:_) <- args =
810806 jsMeth (translateReg lhs) "and" [translateReg rhs]
811807
812− {-| (LOr (ITFixed IT8)) <- op-}
813− {-, (lhs:rhs:_) <- args =-}
814− {-jsPackUBits8 (-}
815− {-JSBinOp "|" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
816− {-)-}
808+ | (LOr (ITFixed IT8)) <- op
809+ , (lhs:rhs:_) <- args =
810+ jsPackUBits8 (
811+ JSBinOp "|" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
812+ )
817813
818− {-| (LOr (ITFixed IT16)) <- op-}
819− {-, (lhs:rhs:_) <- args =-}
820− {-jsPackUBits16 (-}
821− {-JSBinOp "|" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
822− {-)-}
814+ | (LOr (ITFixed IT16)) <- op
815+ , (lhs:rhs:_) <- args =
816+ jsPackUBits16 (
817+ JSBinOp "|" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
818+ )
823819
824− {-| (LOr (ITFixed IT32)) <- op-}
825− {-, (lhs:rhs:_) <- args =-}
826− {-jsPackUBits32 (-}
827− {-JSBinOp "|" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
828− {-)-}
820+ | (LOr (ITFixed IT32)) <- op
821+ , (lhs:rhs:_) <- args =
822+ jsPackUBits32 (
823+ JSBinOp "|" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
824+ )
829825
830826 | (LOr (ITFixed IT64)) <- op
831827 , (lhs:rhs:_) <- args =
832828 jsMeth (translateReg lhs) "or" [translateReg rhs]
833829
834− {-| (LXOr (ITFixed IT8)) <- op-}
835− {-, (lhs:rhs:_) <- args =-}
836− {-jsPackUBits8 (-}
837− {-JSBinOp "^" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
838− {-)-}
830+ | (LXOr (ITFixed IT8)) <- op
831+ , (lhs:rhs:_) <- args =
832+ jsPackUBits8 (
833+ JSBinOp "^" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
834+ )
839835
840− {-| (LXOr (ITFixed IT16)) <- op-}
841− {-, (lhs:rhs:_) <- args =-}
842− {-jsPackUBits16 (-}
843− {-JSBinOp "^" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
844− {-)-}
836+ | (LXOr (ITFixed IT16)) <- op
837+ , (lhs:rhs:_) <- args =
838+ jsPackUBits16 (
839+ JSBinOp "^" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
840+ )
845841
846− {-| (LXOr (ITFixed IT32)) <- op-}
847− {-, (lhs:rhs:_) <- args =-}
848− {-jsPackUBits32 (-}
849− {-JSBinOp "^" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
850− {-)-}
842+ | (LXOr (ITFixed IT32)) <- op
843+ , (lhs:rhs:_) <- args =
844+ jsPackUBits32 (
845+ JSBinOp "^" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
846+ )
851847
852848 | (LXOr (ITFixed IT64)) <- op
853849 , (lhs:rhs:_) <- args =
854850 jsMeth (translateReg lhs) "xor" [translateReg rhs]
855851
856− {-| (LPlus (ATInt (ITFixed IT8))) <- op-}
857− {-, (lhs:rhs:_) <- args =-}
858− {-jsPackUBits8 (-}
859− {-JSBinOp "+" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
860− {-)-}
861−
862− {-| (LPlus (ATInt (ITFixed IT16))) <- op-}
863− {-, (lhs:rhs:_) <- args =-}
864− {-jsPackUBits16 (-}
865− {-JSBinOp "+" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
866− {-)-}
867−
868− {-| (LPlus (ATInt (ITFixed IT32))) <- op-}
869− {-, (lhs:rhs:_) <- args =-}
870− {-jsPackUBits32 (-}
871− {-JSBinOp "+" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
872− {-)-}
873−
874− {-| (LPlus (ATInt (ITFixed IT64))) <- op-}
875− {-, (lhs:rhs:_) <- args =-}
876− {-jsMeth (jsMeth (JSVar lhs) "add" [JSVar rhs]) "and" [-}
877− {-jsBigInt (JSString $ show 0xFFFFFFFFFFFFFFFF)-}
878− {-]-}
879−
880− {-| (LMinus (ATInt (ITFixed IT8))) <- op-}
881− {-, (lhs:rhs:_) <- args =-}
882− {-jsPackUBits8 (-}
883− {-JSBinOp "-" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
884− {-)-}
885−
886− {-| (LMinus (ATInt (ITFixed IT16))) <- op-}
887− {-, (lhs:rhs:_) <- args =-}
888− {-jsPackUBits16 (-}
889− {-JSBinOp "-" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
890− {-)-}
891−
892− {-| (LMinus (ATInt (ITFixed IT32))) <- op-}
893− {-, (lhs:rhs:_) <- args =-}
894− {-jsPackUBits32 (-}
895− {-JSBinOp "-" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
896− {-)-}
897−
898− {-| (LMinus (ATInt (ITFixed IT64))) <- op-}
899− {-, (lhs:rhs:_) <- args =-}
900− {-jsMeth (jsMeth (JSVar lhs) "subtract" [JSVar rhs]) "and" [-}
901− {-jsBigInt (JSString $ show 0xFFFFFFFFFFFFFFFF)-}
902− {-]-}
903−
904− {-| (LTimes (ATInt (ITFixed IT8))) <- op-}
905− {-, (lhs:rhs:_) <- args =-}
906− {-jsPackUBits8 (-}
907− {-JSBinOp "*" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
908− {-)-}
909−
910− {-| (LTimes (ATInt (ITFixed IT16))) <- op-}
911− {-, (lhs:rhs:_) <- args =-}
912− {-jsPackUBits16 (-}
913− {-JSBinOp "*" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
914− {-)-}
915−
916− {-| (LTimes (ATInt (ITFixed IT32))) <- op-}
917− {-, (lhs:rhs:_) <- args =-}
918− {-jsPackUBits32 (-}
919− {-JSBinOp "*" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
920− {-)-}
921−
922− {-| (LTimes (ATInt (ITFixed IT64))) <- op-}
923− {-, (lhs:rhs:_) <- args =-}
924− {-jsMeth (jsMeth (JSVar lhs) "multiply" [JSVar rhs]) "and" [-}
925− {-jsBigInt (JSString $ show 0xFFFFFFFFFFFFFFFF)-}
926− {-]-}
927−
928− {-| (LEq (ATInt (ITFixed IT8))) <- op-}
929− {-, (lhs:rhs:_) <- args =-}
930− {-jsPackUBits8 (-}
931− {-JSBinOp "==" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
932− {-)-}
933−
934− {-| (LEq (ATInt (ITFixed IT16))) <- op-}
935− {-, (lhs:rhs:_) <- args =-}
936− {-jsPackUBits16 (-}
937− {-JSBinOp "==" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
938− {-)-}
939−
940− {-| (LEq (ATInt (ITFixed IT32))) <- op-}
941− {-, (lhs:rhs:_) <- args =-}
942− {-jsPackUBits32 (-}
943− {-JSBinOp "==" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
944− {-)-}
945−
946− {-| (LEq (ATInt (ITFixed IT64))) <- op-}
947− {-, (lhs:rhs:_) <- args =-}
948− {-jsMeth (jsMeth (JSVar lhs) "equals" [JSVar rhs]) "and" [-}
949− {-jsBigInt (JSString $ show 0xFFFFFFFFFFFFFFFF)-}
950− {-]-}
951−
952− {-| (LLt (ITFixed IT8)) <- op-}
953− {-, (lhs:rhs:_) <- args =-}
954− {-jsPackUBits8 (-}
955− {-JSBinOp "<" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
956− {-)-}
957−
958− {-| (LLt (ITFixed IT16)) <- op-}
959− {-, (lhs:rhs:_) <- args =-}
960− {-jsPackUBits16 (-}
961− {-JSBinOp "<" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
962− {-)-}
963−
964− {-| (LLt (ITFixed IT32)) <- op-}
965− {-, (lhs:rhs:_) <- args =-}
966− {-jsPackUBits32 (-}
967− {-JSBinOp "<" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
968− {-)-}
852+ | (LPlus (ATInt (ITFixed IT8))) <- op
853+ , (lhs:rhs:_) <- args =
854+ jsPackUBits8 (
855+ JSBinOp "+" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
856+ )
857+
858+ | (LPlus (ATInt (ITFixed IT16))) <- op
859+ , (lhs:rhs:_) <- args =
860+ jsPackUBits16 (
861+ JSBinOp "+" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
862+ )
863+
864+ | (LPlus (ATInt (ITFixed IT32))) <- op
865+ , (lhs:rhs:_) <- args =
866+ jsPackUBits32 (
867+ JSBinOp "+" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
868+ )
869+
870+ | (LPlus (ATInt (ITFixed IT64))) <- op
871+ , (lhs:rhs:_) <- args =
872+ jsMeth (jsMeth (translateReg lhs) "add" [translateReg rhs]) "and" [
873+ jsBigInt (JSString $ show 0xFFFFFFFFFFFFFFFF)
874+ ]
875+
876+ | (LMinus (ATInt (ITFixed IT8))) <- op
877+ , (lhs:rhs:_) <- args =
878+ jsPackUBits8 (
879+ JSBinOp "-" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
880+ )
881+
882+ | (LMinus (ATInt (ITFixed IT16))) <- op
883+ , (lhs:rhs:_) <- args =
884+ jsPackUBits16 (
885+ JSBinOp "-" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
886+ )
887+
888+ | (LMinus (ATInt (ITFixed IT32))) <- op
889+ , (lhs:rhs:_) <- args =
890+ jsPackUBits32 (
891+ JSBinOp "-" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
892+ )
893+
894+ | (LMinus (ATInt (ITFixed IT64))) <- op
895+ , (lhs:rhs:_) <- args =
896+ jsMeth (jsMeth (translateReg lhs) "subtract" [translateReg rhs]) "and" [
897+ jsBigInt (JSString $ show 0xFFFFFFFFFFFFFFFF)
898+ ]
899+
900+ | (LTimes (ATInt (ITFixed IT8))) <- op
901+ , (lhs:rhs:_) <- args =
902+ jsPackUBits8 (
903+ JSBinOp "*" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
904+ )
905+
906+ | (LTimes (ATInt (ITFixed IT16))) <- op
907+ , (lhs:rhs:_) <- args =
908+ jsPackUBits16 (
909+ JSBinOp "*" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
910+ )
911+
912+ | (LTimes (ATInt (ITFixed IT32))) <- op
913+ , (lhs:rhs:_) <- args =
914+ jsPackUBits32 (
915+ JSBinOp "*" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
916+ )
917+
918+ | (LTimes (ATInt (ITFixed IT64))) <- op
919+ , (lhs:rhs:_) <- args =
920+ jsMeth (jsMeth (translateReg lhs) "multiply" [translateReg rhs]) "and" [
921+ jsBigInt (JSString $ show 0xFFFFFFFFFFFFFFFF)
922+ ]
923+
924+ | (LEq (ATInt (ITFixed IT8))) <- op
925+ , (lhs:rhs:_) <- args =
926+ jsPackUBits8 (
927+ JSBinOp "==" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
928+ )
929+
930+ | (LEq (ATInt (ITFixed IT16))) <- op
931+ , (lhs:rhs:_) <- args =
932+ jsPackUBits16 (
933+ JSBinOp "==" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
934+ )
935+
936+ | (LEq (ATInt (ITFixed IT32))) <- op
937+ , (lhs:rhs:_) <- args =
938+ jsPackUBits32 (
939+ JSBinOp "==" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
940+ )
941+
942+ | (LEq (ATInt (ITFixed IT64))) <- op
943+ , (lhs:rhs:_) <- args =
944+ jsMeth (jsMeth (translateReg lhs) "equals" [translateReg rhs]) "and" [
945+ jsBigInt (JSString $ show 0xFFFFFFFFFFFFFFFF)
946+ ]
947+
948+ | (LLt (ITFixed IT8)) <- op
949+ , (lhs:rhs:_) <- args =
950+ jsPackUBits8 (
951+ JSBinOp "<" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
952+ )
953+
954+ | (LLt (ITFixed IT16)) <- op
955+ , (lhs:rhs:_) <- args =
956+ jsPackUBits16 (
957+ JSBinOp "<" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
958+ )
959+
960+ | (LLt (ITFixed IT32)) <- op
961+ , (lhs:rhs:_) <- args =
962+ jsPackUBits32 (
963+ JSBinOp "<" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
964+ )
969965
970966 | (LLt (ITFixed IT64)) <- op
971967 , (lhs:rhs:_) <- args = invokeMeth lhs "lesser" [rhs]
972968
973− {-| (LLe (ITFixed IT8)) <- op-}
974− {-, (lhs:rhs:_) <- args =-}
975− {-jsPackUBits8 (-}
976− {-JSBinOp "<=" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
977− {-)-}
969+ | (LLe (ITFixed IT8)) <- op
970+ , (lhs:rhs:_) <- args =
971+ jsPackUBits8 (
972+ JSBinOp "<=" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
973+ )
978974
979− {-| (LLe (ITFixed IT16)) <- op-}
980− {-, (lhs:rhs:_) <- args =-}
981− {-jsPackUBits16 (-}
982− {-JSBinOp "<=" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
983− {-)-}
975+ | (LLe (ITFixed IT16)) <- op
976+ , (lhs:rhs:_) <- args =
977+ jsPackUBits16 (
978+ JSBinOp "<=" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
979+ )
984980
985− {-| (LLe (ITFixed IT32)) <- op-}
986− {-, (lhs:rhs:_) <- args =-}
987− {-jsPackUBits32 (-}
988− {-JSBinOp "<=" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
989− {-)-}
981+ | (LLe (ITFixed IT32)) <- op
982+ , (lhs:rhs:_) <- args =
983+ jsPackUBits32 (
984+ JSBinOp "<=" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
985+ )
990986
991987 | (LLe (ITFixed IT64)) <- op
992988 , (lhs:rhs:_) <- args = invokeMeth lhs "lesserOrEquals" [rhs]
993989
994− {-| (LGt (ITFixed IT8)) <- op-}
995− {-, (lhs:rhs:_) <- args =-}
996− {-jsPackUBits8 (-}
997− {-JSBinOp ">" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
998− {-)-}
999−
1000− {-| (LGt (ITFixed IT16)) <- op-}
1001− {-, (lhs:rhs:_) <- args =-}
1002− {-jsPackUBits16 (-}
1003− {-JSBinOp ">" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
1004− {-)-}
1005− {-| (LGt (ITFixed IT32)) <- op-}
1006− {-, (lhs:rhs:_) <- args =-}
1007− {-jsPackUBits32 (-}
1008− {-JSBinOp ">" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
1009− {-)-}
990+ | (LGt (ITFixed IT8)) <- op
991+ , (lhs:rhs:_) <- args =
992+ jsPackUBits8 (
993+ JSBinOp ">" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
994+ )
995+
996+ | (LGt (ITFixed IT16)) <- op
997+ , (lhs:rhs:_) <- args =
998+ jsPackUBits16 (
999+ JSBinOp ">" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
1000+ )
1001+ | (LGt (ITFixed IT32)) <- op
1002+ , (lhs:rhs:_) <- args =
1003+ jsPackUBits32 (
1004+ JSBinOp ">" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
1005+ )
10101006
10111007 | (LGt (ITFixed IT64)) <- op
10121008 , (lhs:rhs:_) <- args = invokeMeth lhs "greater" [rhs]
10131009
1014− {-| (LGe (ITFixed IT8)) <- op-}
1015− {-, (lhs:rhs:_) <- args =-}
1016− {-jsPackUBits8 (-}
1017− {-JSBinOp ">=" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
1018− {-)-}
1019−
1020− {-| (LGe (ITFixed IT16)) <- op-}
1021− {-, (lhs:rhs:_) <- args =-}
1022− {-jsPackUBits16 (-}
1023− {-JSBinOp ">=" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
1024− {-)-}
1025− {-| (LGe (ITFixed IT32)) <- op-}
1026− {-, (lhs:rhs:_) <- args =-}
1027− {-jsPackUBits32 (-}
1028− {-JSBinOp ">=" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
1029− {-)-}
1010+ | (LGe (ITFixed IT8)) <- op
1011+ , (lhs:rhs:_) <- args =
1012+ jsPackUBits8 (
1013+ JSBinOp ">=" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
1014+ )
1015+
1016+ | (LGe (ITFixed IT16)) <- op
1017+ , (lhs:rhs:_) <- args =
1018+ jsPackUBits16 (
1019+ JSBinOp ">=" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
1020+ )
1021+ | (LGe (ITFixed IT32)) <- op
1022+ , (lhs:rhs:_) <- args =
1023+ jsPackUBits32 (
1024+ JSBinOp ">=" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
1025+ )
10301026
10311027 | (LGe (ITFixed IT64)) <- op
10321028 , (lhs:rhs:_) <- args = invokeMeth lhs "greaterOrEquals" [rhs]
10331029
1034− {-| (LUDiv (ITFixed IT8)) <- op-}
1035− {-, (lhs:rhs:_) <- args =-}
1036− {-jsPackUBits8 (-}
1037− {-JSBinOp "/" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
1038− {-)-}
1039−
1040− {-| (LUDiv (ITFixed IT16)) <- op-}
1041− {-, (lhs:rhs:_) <- args =-}
1042− {-jsPackUBits16 (-}
1043− {-JSBinOp "/" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
1044− {-)-}
1045−
1046− {-| (LUDiv (ITFixed IT32)) <- op-}
1047− {-, (lhs:rhs:_) <- args =-}
1048− {-jsPackUBits32 (-}
1049− {-JSBinOp "/" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))-}
1050− {-)-}
1051−
1052− {-| (LUDiv (ITFixed IT64)) <- op-}
1053− {-, (lhs:rhs:_) <- args = invokeMeth lhs "divide" [rhs]-}
1054−
1055− {-| (LSDiv (ATInt (ITFixed IT8))) <- op-}
1056− {-, (lhs:rhs:_) <- args =-}
1057− {-jsPackSBits8 (-}
1058− {-JSBinOp "/" (-}
1059− {-jsUnPackBits $ jsPackSBits8 $ jsUnPackBits (JSVar lhs)-}
1060− {-) (-}
1061− {-jsUnPackBits $ jsPackSBits8 $ jsUnPackBits (JSVar rhs)-}
1062− {-)-}
1063− {-)-}
1064−
1065− {-| (LSDiv (ATInt (ITFixed IT16))) <- op-}
1066− {-, (lhs:rhs:_) <- args =-}
1067− {-jsPackSBits16 (-}
1068− {-JSBinOp "/" (-}
1069− {-jsUnPackBits $ jsPackSBits16 $ jsUnPackBits (JSVar lhs)-}
1070− {-) (-}
1071− {-jsUnPackBits $ jsPackSBits16 $ jsUnPackBits (JSVar rhs)-}
1072− {-)-}
1073− {-)-}
1074−
1075− {-| (LSDiv (ATInt (ITFixed IT32))) <- op-}
1076− {-, (lhs:rhs:_) <- args =-}
1077− {-jsPackSBits32 (-}
1078− {-JSBinOp "/" (-}
1079− {-jsUnPackBits $ jsPackSBits32 $ jsUnPackBits (JSVar lhs)-}
1080− {-) (-}
1081− {-jsUnPackBits $ jsPackSBits32 $ jsUnPackBits (JSVar rhs)-}
1082− {-)-}
1083− {-)-}
1030+ | (LUDiv (ITFixed IT8)) <- op
1031+ , (lhs:rhs:_) <- args =
1032+ jsPackUBits8 (
1033+ JSBinOp "/" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
1034+ )
1035+
1036+ | (LUDiv (ITFixed IT16)) <- op
1037+ , (lhs:rhs:_) <- args =
1038+ jsPackUBits16 (
1039+ JSBinOp "/" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
1040+ )
1041+
1042+ | (LUDiv (ITFixed IT32)) <- op
1043+ , (lhs:rhs:_) <- args =
1044+ jsPackUBits32 (
1045+ JSBinOp "/" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
1046+ )
1047+
1048+ | (LUDiv (ITFixed IT64)) <- op
1049+ , (lhs:rhs:_) <- args = invokeMeth lhs "divide" [rhs]
1050+
1051+ | (LSDiv (ATInt (ITFixed IT8))) <- op
1052+ , (lhs:rhs:_) <- args =
1053+ jsPackSBits8 (
1054+ JSBinOp "/" (
1055+ jsUnPackBits $ jsPackSBits8 $ jsUnPackBits (translateReg lhs)
1056+ ) (
1057+ jsUnPackBits $ jsPackSBits8 $ jsUnPackBits (translateReg rhs)
1058+ )
1059+ )
1060+
1061+ | (LSDiv (ATInt (ITFixed IT16))) <- op
1062+ , (lhs:rhs:_) <- args =
1063+ jsPackSBits16 (
1064+ JSBinOp "/" (
1065+ jsUnPackBits $ jsPackSBits16 $ jsUnPackBits (translateReg lhs)
1066+ ) (
1067+ jsUnPackBits $ jsPackSBits16 $ jsUnPackBits (translateReg rhs)
1068+ )
1069+ )
1070+
1071+ | (LSDiv (ATInt (ITFixed IT32))) <- op
1072+ , (lhs:rhs:_) <- args =
1073+ jsPackSBits32 (
1074+ JSBinOp "/" (
1075+ jsUnPackBits $ jsPackSBits32 $ jsUnPackBits (translateReg lhs)
1076+ ) (
1077+ jsUnPackBits $ jsPackSBits32 $ jsUnPackBits (translateReg rhs)
1078+ )
1079+ )
10841080
10851081 | (LSDiv (ATInt (ITFixed IT64))) <- op
10861082 , (lhs:rhs:_) <- args = invokeMeth lhs "divide" [rhs]
10871083
1088− {-| (LSRem (ATInt (ITFixed IT8))) <- op-}
1089− {-, (lhs:rhs:_) <- args =-}
1090− {-jsPackSBits8 (-}
1091− {-JSBinOp "%" (-}
1092− {-jsUnPackBits $ jsPackSBits8 $ jsUnPackBits (JSVar lhs)-}
1093− {-) (-}
1094− {-jsUnPackBits $ jsPackSBits8 $ jsUnPackBits (JSVar rhs)-}
1095− {-)-}
1096− {-)-}
1097−
1098− {-| (LSRem (ATInt (ITFixed IT16))) <- op-}
1099− {-, (lhs:rhs:_) <- args =-}
1100− {-jsPackSBits16 (-}
1101− {-JSBinOp "%" (-}
1102− {-jsUnPackBits $ jsPackSBits16 $ jsUnPackBits (JSVar lhs)-}
1103− {-) (-}
1104− {-jsUnPackBits $ jsPackSBits16 $ jsUnPackBits (JSVar rhs)-}
1105− {-)-}
1106− {-)-}
1107−
1108− {-| (LSRem (ATInt (ITFixed IT32))) <- op-}
1109− {-, (lhs:rhs:_) <- args =-}
1110− {-jsPackSBits32 (-}
1111− {-JSBinOp "%" (-}
1112− {-jsUnPackBits $ jsPackSBits32 $ jsUnPackBits (JSVar lhs)-}
1113− {-) (-}
1114− {-jsUnPackBits $ jsPackSBits32 $ jsUnPackBits (JSVar rhs)-}
1115− {-)-}
1116− {-)-}
1084+ | (LSRem (ATInt (ITFixed IT8))) <- op
1085+ , (lhs:rhs:_) <- args =
1086+ jsPackSBits8 (
1087+ JSBinOp "%" (
1088+ jsUnPackBits $ jsPackSBits8 $ jsUnPackBits (translateReg lhs)
1089+ ) (
1090+ jsUnPackBits $ jsPackSBits8 $ jsUnPackBits (translateReg rhs)
1091+ )
1092+ )
1093+
1094+ | (LSRem (ATInt (ITFixed IT16))) <- op
1095+ , (lhs:rhs:_) <- args =
1096+ jsPackSBits16 (
1097+ JSBinOp "%" (
1098+ jsUnPackBits $ jsPackSBits16 $ jsUnPackBits (translateReg lhs)
1099+ ) (
1100+ jsUnPackBits $ jsPackSBits16 $ jsUnPackBits (translateReg rhs)
1101+ )
1102+ )
1103+
1104+ | (LSRem (ATInt (ITFixed IT32))) <- op
1105+ , (lhs:rhs:_) <- args =
1106+ jsPackSBits32 (
1107+ JSBinOp "%" (
1108+ jsUnPackBits $ jsPackSBits32 $ jsUnPackBits (translateReg lhs)
1109+ ) (
1110+ jsUnPackBits $ jsPackSBits32 $ jsUnPackBits (translateReg rhs)
1111+ )
1112+ )
11171113
11181114 | (LSRem (ATInt (ITFixed IT64))) <- op
11191115 , (lhs:rhs:_) <- args = invokeMeth lhs "mod" [rhs]
11201116
1121− {-| (LCompl (ITFixed IT8)) <- op-}
1122− {-, (arg:_) <- args =-}
1123− {-jsPackSBits8 $ JSPreOp "~" $ jsUnPackBits (JSVar arg)-}
1117+ | (LCompl (ITFixed IT8)) <- op
1118+ , (arg:_) <- args =
1119+ jsPackSBits8 $ JSPreOp "~" $ jsUnPackBits (translateReg arg)
11241120
1125− {-| (LCompl (ITFixed IT16)) <- op-}
1126− {-, (arg:_) <- args =-}
1127− {-jsPackSBits16 $ JSPreOp "~" $ jsUnPackBits (JSVar arg)-}
1121+ | (LCompl (ITFixed IT16)) <- op
1122+ , (arg:_) <- args =
1123+ jsPackSBits16 $ JSPreOp "~" $ jsUnPackBits (translateReg arg)
11281124
1129− {-| (LCompl (ITFixed IT32)) <- op-}
1130− {-, (arg:_) <- args =-}
1131− {-jsPackSBits32 $ JSPreOp "~" $ jsUnPackBits (JSVar arg)-}
1125+ | (LCompl (ITFixed IT32)) <- op
1126+ , (arg:_) <- args =
1127+ jsPackSBits32 $ JSPreOp "~" $ jsUnPackBits (translateReg arg)
11321128
11331129 | (LCompl (ITFixed IT64)) <- op
11341130 , (arg:_) <- args =
@@ -1232,13 +1228,15 @@ jsOP reg op args = JSAssign (translateReg reg) jsOP'
12321228 | LStrIndex <- op
12331229 , (lhs:rhs:_) <- args = JSIndex (translateReg lhs) (translateReg rhs)
12341230 | LStrTail <- op
1235− , (arg:_) <- args = let v = translateReg arg in
1236− JSApp (JSProj v "substr") [
1237− JSNum (JSInt 1),
1238− JSBinOp "-" (JSProj v "length") (JSNum (JSInt 1))
1239− ]
1240− {-| LSystemInfo <- op-}
1241− {-, (arg:_) <- args = jsCall "__IDRRT__systemInfo" [JSVar arg]-}
1231+ , (arg:_) <- args =
1232+ let v = translateReg arg in
1233+ JSApp (JSProj v "substr") [
1234+ JSNum (JSInt 1),
1235+ JSBinOp "-" (JSProj v "length") (JSNum (JSInt 1))
1236+ ]
1237+
1238+ | LSystemInfo <- op
1239+ , (arg:_) <- args = jsCall "__IDRRT__systemInfo" [translateReg arg]
12421240 | LNullPtr <- op
12431241 , (_) <- args = JSNull
12441242 | otherwise = JSError $ "Not implemented: " ++ show op
@@ -1258,8 +1256,6 @@ jsOP reg op args = JSAssign (translateReg reg) jsOP'
12581256 jsCall :: String -> [JS] -> JS
12591257 jsCall fun args = JSApp (JSIdent fun) args
12601258
1261−
1262−
12631259jsRESERVE :: Int -> JS
12641260jsRESERVE n = JSApp (JSIdent "i$RESERVE") [JSIdent "vm", JSNum $ JSInt n]
12651261