git.iko.soy/Idris-dev
on master help sign in
added many missing primitives that were in the old backend
3e86df1Rui Barreiro
idris.cabal+2
compare with master
unifiedsplit
@@ -49,6 +49,8 @@ Tested-With: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1
49Data-files: idrisdoc/styles.css
49Data-files: idrisdoc/styles.css
50 jsrts/jsbn/jsbn.js
50 jsrts/jsbn/jsbn.js
51 jsrts/Runtime-common.js
51 jsrts/Runtime-common.js
52+ jsrts/Runtime-javascript.js
53+ jsrts/Runtime-node.js
52 jsrts/jsbn/LICENSE
54 jsrts/jsbn/LICENSE
53 rts/arduino/idris_main.c
55 rts/arduino/idris_main.c
54 rts/idris_bitstring.c
56 rts/idris_bitstring.c
jsrts/Runtime-javascript.jsnew file+9
@@ -0,0 +1,9 @@
1+var js_idris_systemInfo = function(index) {
2+ switch(index) {
3+ case 0:
4+ return "javascript";
5+ case 1:
6+ return navigator.platform;
7+ }
8+ return "";
9+}
jsrts/Runtime-node.jsnew file+10
@@ -0,0 +1,10 @@
1+var js_idris_systemInfo = function(index) {
2+ var os = require('os')
3+ switch(index) {
4+ case 0:
5+ return "node";
6+ case 1:
7+ return os.platform();
8+ }
9+ return "";
10+}
src/IRTS/CodegenJavaScript.hs+2
@@ -73,6 +73,7 @@ codegenJavaScript ci =
73 , initialization = const ""
73 , initialization = const ""
74 , writeStrTemplate = "console.log(%0)"
74 , writeStrTemplate = "console.log(%0)"
75 , readStrTemplate = "prompt('Prelude.getLine')"
75 , readStrTemplate = "prompt('Prelude.getLine')"
76+ , extraRunTime = "Runtime-javascript.js"
76 }
77 }
77 )
78 )
78 ci
79 ci
@@ -91,6 +92,7 @@ codegenNode ci =
91 , initialization = initializationNode
92 , initialization = initializationNode
92 , writeStrTemplate = "fs.writeSync(1,%0)"
93 , writeStrTemplate = "fs.writeSync(1,%0)"
93 , readStrTemplate = "js_idris_readStr()"
94 , readStrTemplate = "js_idris_readStr()"
95+ , extraRunTime = "Runtime-node.js"
94 }
96 }
95 )
97 )
96 ci
98 ci
src/IRTS/JavaScript/Codegen.hs+251−61
@@ -57,6 +57,7 @@ data CGConf = CGConf { header :: Text
57 , initialization :: CGStats -> Text
57 , initialization :: CGStats -> Text
58 , writeStrTemplate :: Text
58 , writeStrTemplate :: Text
59 , readStrTemplate :: Text
59 , readStrTemplate :: Text
60+ , extraRunTime :: String
60 }
61 }
61
62
62
63
@@ -99,6 +100,7 @@ codegenJs conf ci =
99 else return ""
100 else return ""
100
101
101 runtimeCommon <- TIO.readFile $ path </> "Runtime-common.js"
102 runtimeCommon <- TIO.readFile $ path </> "Runtime-common.js"
103+ extraRT <- TIO.readFile $ path </> (extraRunTime conf)
102
104
103 includes <- getIncludes $ includes ci
105 includes <- getIncludes $ includes ci
104 TIO.writeFile (outputFile ci) $ T.concat [ header conf
106 TIO.writeFile (outputFile ci) $ T.concat [ header conf
@@ -109,6 +111,7 @@ codegenJs conf ci =
109 , doPartials (partialApplications stats)
111 , doPartials (partialApplications stats)
110 , includes, "\n"
112 , includes, "\n"
111 , runtimeCommon, "\n"
113 , runtimeCommon, "\n"
114+ , extraRT, "\n"
112 , out, "\n"
115 , out, "\n"
113 , "\n"
116 , "\n"
114 , jsName (sMN 0 "runMain"), "();\n\n"
117 , jsName (sMN 0 "runMain"), "();\n\n"
@@ -474,8 +477,8 @@ cgConst (BI i) =
474cgConst (Ch c) = pure $ JsStr [c]
477cgConst (Ch c) = pure $ JsStr [c]
475cgConst (Str s) = pure $ JsStr s
478cgConst (Str s) = pure $ JsStr s
476cgConst (Fl f) = pure $ JsNum f
479cgConst (Fl f) = pure $ JsNum f
477−cgConst (B8 x) = pure $ JsForeign (T.pack $ "new Uint8Array([" ++ show x ++ "])") []
480+cgConst (B8 x) = pure $ JsForeign (T.pack $ show x ++ " & 0xFF") []
478−cgConst (B16 x) = pure $ JsForeign (T.pack $ "new Uint16Array([" ++ show x ++ "])") []
481+cgConst (B16 x) = pure $ JsForeign (T.pack $ show x ++ " & 0xFFFF") []
479cgConst (B32 x) = pure $ JsForeign (T.pack $ show x ++ "|0" ) []
482cgConst (B32 x) = pure $ JsForeign (T.pack $ show x ++ "|0" ) []
480cgConst (B64 x) =
483cgConst (B64 x) =
481 do
484 do
@@ -488,12 +491,11 @@ jsB2I :: JsAST -> JsAST
488jsB2I x = JsForeign "%0 ? 1|0 : 0|0" [x]
491jsB2I x = JsForeign "%0 ? 1|0 : 0|0" [x]
489
492
490cgOp :: PrimFn -> [JsAST] -> State CGBodyState JsAST
493cgOp :: PrimFn -> [JsAST] -> State CGBodyState JsAST
491−cgOp (LAnd (ITFixed IT8)) [l, r] = pure $ JsForeign "new Uint8Array([ %0[0] & %1[0] ])" [l,r]
492cgOp (LPlus ATFloat) [l, r] = pure $ JsBinOp "+" l r
494cgOp (LPlus ATFloat) [l, r] = pure $ JsBinOp "+" l r
493cgOp (LPlus (ATInt ITChar)) [l, r] = pure $ JsForeign "String.fromCharCode(%0.charCodeAt(0) + %1.charCodeAt(0))" [l,r]
495cgOp (LPlus (ATInt ITChar)) [l, r] = pure $ JsForeign "String.fromCharCode(%0.charCodeAt(0) + %1.charCodeAt(0))" [l,r]
494cgOp (LPlus (ATInt ITNative)) [l, r] = pure $ JsForeign "%0+%1|0" [l,r]
496cgOp (LPlus (ATInt ITNative)) [l, r] = pure $ JsForeign "%0+%1|0" [l,r]
495−cgOp (LPlus (ATInt (ITFixed IT8))) [l, r] = pure $ JsForeign "new Uint8Array([ %0[0] + %1[0] ])" [l,r]
497+cgOp (LPlus (ATInt (ITFixed IT8))) [l, r] = pure $ JsForeign "%0 + %1 & 0xFF" [l,r]
496−cgOp (LPlus (ATInt (ITFixed IT16))) [l, r] = pure $ JsForeign "new Uint16Array([ %0[0] + %1[0] ])" [l,r]
498+cgOp (LPlus (ATInt (ITFixed IT16))) [l, r] = pure $ JsForeign "%0 + %1 & 0xFFFF" [l,r]
497cgOp (LPlus (ATInt (ITFixed IT32))) [l, r] = pure $ JsForeign "%0+%1|0" [l,r]
499cgOp (LPlus (ATInt (ITFixed IT32))) [l, r] = pure $ JsForeign "%0+%1|0" [l,r]
498cgOp (LPlus (ATInt ITBig)) [l, r] =
500cgOp (LPlus (ATInt ITBig)) [l, r] =
499 do
501 do
@@ -503,25 +505,138 @@ cgOp (LPlus (ATInt (ITFixed IT64))) [l, r] =
503 do
505 do
504 setUsedITBig
506 setUsedITBig
505 pure $ JsForeign "%0.add(%1).and(new jsbn.BigInteger(%2))" [l,r, JsStr $ show 0xFFFFFFFFFFFFFFFF]
507 pure $ JsForeign "%0.add(%1).and(new jsbn.BigInteger(%2))" [l,r, JsStr $ show 0xFFFFFFFFFFFFFFFF]
506−cgOp (LLSHR (ITFixed IT8)) [l, r] = pure $ JsForeign "new Uint8Array([ %0[0] >> %1[0] ])" [l,r]
507−cgOp (LLSHR (ITFixed IT16)) [l, r] = pure $ JsForeign "new Uint16Array([ %0[0] >> %1[0] ])" [l,r]
508−cgOp (LLSHR (ITFixed IT32)) [l, r] = pure $ JsForeign "%0 >> %1|0" [l,r]
509−cgOp (LLSHR (ITFixed IT64)) [l, r] =
510− do
511− setUsedITBig
512− pure $ JsForeign "%0.shiftRight(%1)" [l,r]
513cgOp (LMinus ATFloat) [l, r] = pure $ JsBinOp "-" l r
508cgOp (LMinus ATFloat) [l, r] = pure $ JsBinOp "-" l r
509+cgOp (LMinus (ATInt ITChar)) [l, r] = pure $ JsForeign "String.fromCharCode(%0.charCodeAt(0) - %1.charCodeAt(0))" [l,r]
514cgOp (LMinus (ATInt ITNative)) [l, r] = pure $ JsForeign "%0-%1|0" [l,r]
510cgOp (LMinus (ATInt ITNative)) [l, r] = pure $ JsForeign "%0-%1|0" [l,r]
511+cgOp (LMinus (ATInt (ITFixed IT8))) [l, r] = pure $ JsForeign "%0 - %1 & 0xFF" [l,r]
512+cgOp (LMinus (ATInt (ITFixed IT16))) [l, r] = pure $ JsForeign "%0 - %1 & 0xFFFF" [l,r]
513+cgOp (LMinus (ATInt (ITFixed IT32))) [l, r] = pure $ JsForeign "%0-%1|0" [l,r]
515cgOp (LMinus (ATInt ITBig)) [l, r] =
514cgOp (LMinus (ATInt ITBig)) [l, r] =
516 do
515 do
517 setUsedITBig
516 setUsedITBig
518 pure $ JsMethod l "subtract" [r]
517 pure $ JsMethod l "subtract" [r]
518+cgOp (LMinus (ATInt (ITFixed IT64))) [l, r] =
519+ do
520+ setUsedITBig
521+ pure $ JsForeign "%0.subtract(%1).and(new jsbn.BigInteger(%2))" [l,r, JsStr $ show 0xFFFFFFFFFFFFFFFF]
519cgOp (LTimes ATFloat) [l, r] = pure $ JsBinOp "*" l r
522cgOp (LTimes ATFloat) [l, r] = pure $ JsBinOp "*" l r
523+cgOp (LTimes (ATInt ITChar)) [l, r] = pure $ JsForeign "String.fromCharCode(%0.charCodeAt(0) * %1.charCodeAt(0))" [l,r]
520cgOp (LTimes (ATInt ITNative)) [l, r] = pure $ JsForeign "%0*%1|0" [l,r]
524cgOp (LTimes (ATInt ITNative)) [l, r] = pure $ JsForeign "%0*%1|0" [l,r]
525+cgOp (LTimes (ATInt (ITFixed IT8))) [l, r] = pure $ JsForeign "%0 * %1 & 0xFF" [l,r]
526+cgOp (LTimes (ATInt (ITFixed IT16))) [l, r] = pure $ JsForeign "%0 * %1 & 0xFFFF" [l,r]
527+cgOp (LTimes (ATInt (ITFixed IT32))) [l, r] = pure $ JsForeign "%0*%1|0" [l,r]
521cgOp (LTimes (ATInt ITBig)) [l, r] =
528cgOp (LTimes (ATInt ITBig)) [l, r] =
522 do
529 do
523 setUsedITBig
530 setUsedITBig
524 pure $ JsMethod l "multiply" [r]
531 pure $ JsMethod l "multiply" [r]
532+cgOp (LTimes (ATInt (ITFixed IT64))) [l, r] =
533+ do
534+ setUsedITBig
535+ pure $ JsForeign "%0.multiply(%1).and(new jsbn.BigInteger(%2))" [l,r, JsStr $ show 0xFFFFFFFFFFFFFFFF]
536+cgOp (LUDiv (ITFixed IT8)) [l, r] = pure $ JsForeign "%0 / %1" [l,r]
537+cgOp (LUDiv (ITFixed IT16)) [l, r] = pure $ JsForeign "%0 / %1" [l,r]
538+cgOp (LUDiv (ITFixed IT32)) [l, r] = pure $ JsForeign "(%0>>>0) / (%1>>>0) |0" [l,r]
539+cgOp (LUDiv (ITFixed IT64)) [l, r] =
540+ do
541+ setUsedITBig
542+ pure $ JsForeign "%0.divide(%1)" [l,r]
543+cgOp (LSDiv ATFloat) [l,r] = pure $ JsBinOp "/" l r
544+cgOp (LSDiv (ATInt (ITFixed IT8))) [l, r] = pure $ JsForeign "%0 / %1" [l,r]
545+cgOp (LSDiv (ATInt (ITFixed IT16))) [l, r] = pure $ JsForeign "%0 / %1" [l,r]
546+cgOp (LSDiv (ATInt (ITFixed IT32))) [l, r] = pure $ JsForeign "%0 / %1 |0" [l,r]
547+cgOp (LSDiv (ATInt (ITFixed IT64))) [l, r] =
548+ do
549+ setUsedITBig
550+ pure $ JsForeign "%0.divide(%1)" [l,r]
551+cgOp (LSDiv (ATInt ITNative)) [l,r] = pure $ JsForeign "%0/%1|0" [l, r]
552+cgOp (LSDiv (ATInt ITBig)) [l,r] =
553+ do
554+ setUsedITBig
555+ pure $ JsMethod l "divide" [r]
556+cgOp (LURem (ITFixed IT8)) [l, r] = pure $ JsForeign "%0 % %1" [l,r]
557+cgOp (LURem (ITFixed IT16)) [l, r] = pure $ JsForeign "%0 % %1" [l,r]
558+cgOp (LURem (ITFixed IT32)) [l, r] = pure $ JsForeign "(%0>>>0) % (%1>>>0) |0" [l,r]
559+cgOp (LURem (ITFixed IT64)) [l,r] =
560+ do
561+ setUsedITBig
562+ pure $ JsMethod l "remainder" [r]
563+cgOp (LSRem ATFloat) [l,r] = pure $ JsBinOp "%" l r
564+cgOp (LSRem (ATInt ITNative)) [l,r] = pure $ JsForeign "%0 % %1 |0" [l,r]
565+cgOp (LSRem (ATInt (ITFixed IT8))) [l, r] = pure $ JsForeign "%0 % %1" [l,r]
566+cgOp (LSRem (ATInt (ITFixed IT16))) [l, r] = pure $ JsForeign "%0 % %1" [l,r]
567+cgOp (LSRem (ATInt (ITFixed IT32))) [l, r] = pure $ JsForeign "%0 % %1 |0" [l,r]
568+cgOp (LSRem (ATInt (ITFixed IT64))) [l, r] =
569+ do
570+ setUsedITBig
571+ pure $ JsMethod l "remainder" [r]
572+cgOp (LSRem (ATInt ITBig)) [l,r] =
573+ do
574+ setUsedITBig
575+ pure $ JsMethod l "remainder" [r]
576+cgOp (LAnd ITNative) [l, r] = pure $ JsForeign "%0 & %1" [l,r]
577+cgOp (LAnd (ITFixed IT8)) [l, r] = pure $ JsForeign "%0 & %1" [l,r]
578+cgOp (LAnd (ITFixed IT16)) [l, r] = pure $ JsForeign "%0 & %1" [l,r]
579+cgOp (LAnd (ITFixed IT32)) [l, r] = pure $ JsForeign "%0 & %1" [l,r]
580+cgOp (LAnd (ITFixed IT64)) [l,r] =
581+ do
582+ setUsedITBig
583+ pure $ JsMethod l "and" [r]
584+cgOp (LAnd ITBig) [l,r] =
585+ do
586+ setUsedITBig
587+ pure $ JsMethod l "and" [r]
588+cgOp (LOr ITNative) [l, r] = pure $ JsForeign "%0 | %1" [l,r]
589+cgOp (LOr (ITFixed IT8)) [l, r] = pure $ JsForeign "%0 | %1" [l,r]
590+cgOp (LOr (ITFixed IT16)) [l, r] = pure $ JsForeign "%0 | %1" [l,r]
591+cgOp (LOr (ITFixed IT32)) [l, r] = pure $ JsForeign "%0 | %1" [l,r]
592+cgOp (LOr (ITFixed IT64)) [l,r] =
593+ do
594+ setUsedITBig
595+ pure $ JsMethod l "or" [r]
596+cgOp (LOr ITBig) [l,r] =
597+ do
598+ setUsedITBig
599+ pure $ JsMethod l "or" [r]
600+cgOp (LXOr ITNative) [l, r] = pure $ JsForeign "%0 ^ %1" [l,r]
601+cgOp (LXOr (ITFixed IT8)) [l, r] = pure $ JsForeign "%0 ^ %1" [l,r]
602+cgOp (LXOr (ITFixed IT16)) [l, r] = pure $ JsForeign "%0 ^ %1" [l,r]
603+cgOp (LXOr (ITFixed IT32)) [l, r] = pure $ JsForeign "%0 ^ %1" [l,r]
604+cgOp (LXOr (ITFixed IT64)) [l,r] =
605+ do
606+ setUsedITBig
607+ pure $ JsMethod l "xor" [r]
608+cgOp (LXOr ITBig) [l,r] =
609+ do
610+ setUsedITBig
611+ pure $ JsMethod l "xor" [r]
612+cgOp (LSHL ITNative) [l, r] = pure $ JsForeign "%0 << %1 |0" [l,r]
613+cgOp (LSHL (ITFixed IT8)) [l, r] = pure $ JsForeign "%0 << %1 & 0xFF" [l,r]
614+cgOp (LSHL (ITFixed IT16)) [l, r] = pure $ JsForeign "%0 << %1 & 0xFFFF" [l,r]
615+cgOp (LSHL (ITFixed IT32)) [l, r] = pure $ JsForeign "%0 << %1 |0" [l,r]
616+cgOp (LTimes (ATInt (ITFixed IT64))) [l, r] =
617+ do
618+ setUsedITBig
619+ pure $ JsForeign "%0.shiftLeft(%1).and(new jsbn.BigInteger(%2))" [l,r, JsStr $ show 0xFFFFFFFFFFFFFFFF]
620+cgOp (LSHL ITBig) [l,r] =
621+ do
622+ setUsedITBig
623+ pure $ JsMethod l "shiftLeft" [r]
624+cgOp (LLSHR ITNative) [l, r] = pure $ JsForeign "%0 >> %1 |0" [l,r]
625+cgOp (LLSHR (ITFixed IT8)) [l, r] = pure $ JsForeign "%0 >> %1" [l,r]
626+cgOp (LLSHR (ITFixed IT16)) [l, r] = pure $ JsForeign "%0 >> %1" [l,r]
627+cgOp (LLSHR (ITFixed IT32)) [l, r] = pure $ JsForeign "%0 >> %1|0" [l,r]
628+cgOp (LLSHR (ITFixed IT64)) [l, r] =
629+ do
630+ setUsedITBig
631+ pure $ JsForeign "%0.shiftRight(%1)" [l,r]
632+cgOp (LASHR ITNative) [l, r] = pure $ JsForeign "%0 >> %1 |0" [l,r]
633+cgOp (LASHR (ITFixed IT8)) [l, r] = pure $ JsForeign "%0 >> %1" [l,r]
634+cgOp (LASHR (ITFixed IT16)) [l, r] = pure $ JsForeign "%0 >> %1" [l,r]
635+cgOp (LASHR (ITFixed IT32)) [l, r] = pure $ JsForeign "%0 >> %1|0" [l,r]
636+cgOp (LASHR (ITFixed IT64)) [l, r] =
637+ do
638+ setUsedITBig
639+ pure $ JsForeign "%0.shiftRight(%1)" [l,r]
525cgOp (LEq ATFloat) [l, r] = pure $ jsB2I $ JsBinOp "==" l r
640cgOp (LEq ATFloat) [l, r] = pure $ jsB2I $ JsBinOp "==" l r
526cgOp (LEq (ATInt ITNative)) [l, r] = pure $ jsB2I $ JsBinOp "==" l r
641cgOp (LEq (ATInt ITNative)) [l, r] = pure $ jsB2I $ JsBinOp "==" l r
527cgOp (LEq (ATInt ITChar)) [l,r] = pure $ jsB2I $ JsBinOp "==" l r
642cgOp (LEq (ATInt ITChar)) [l,r] = pure $ jsB2I $ JsBinOp "==" l r
@@ -529,6 +644,41 @@ cgOp (LEq (ATInt ITBig)) [l, r] =
529 do
644 do
530 setUsedITBig
645 setUsedITBig
531 pure $ jsB2I $ JsMethod l "equals" [r]
646 pure $ jsB2I $ JsMethod l "equals" [r]
647+cgOp (LEq (ATInt (ITFixed IT8))) [l, r] = pure $ jsB2I $ JsBinOp "==" l r
648+cgOp (LEq (ATInt (ITFixed IT16))) [l, r] = pure $ jsB2I $ JsBinOp "==" l r
649+cgOp (LEq (ATInt (ITFixed IT32))) [l, r] = pure $ jsB2I $ JsBinOp "==" l r
650+cgOp (LEq (ATInt (ITFixed IT64))) [l, r] =
651+ do
652+ setUsedITBig
653+ pure $ jsB2I $ JsMethod l "equals" [r]
654+cgOp (LLt (ITFixed IT8)) [l, r] = pure $ JsForeign "%0 < %1" [l,r]
655+cgOp (LLt (ITFixed IT16)) [l, r] = pure $ JsForeign "%0 < %1" [l,r]
656+cgOp (LLt (ITFixed IT32)) [l, r] = pure $ JsForeign "(%0>>>0) < (%1>>>0)" [l,r]
657+cgOp (LLt (ITFixed IT64)) [l, r] =
658+ do
659+ setUsedITBig
660+ pure $ jsB2I $ JsForeign "%0.compareTo(%1) < 0" [l,r]
661+cgOp (LLe (ITFixed IT8)) [l, r] = pure $ JsForeign "%0 <= %1" [l,r]
662+cgOp (LLe (ITFixed IT16)) [l, r] = pure $ JsForeign "%0 <= %1" [l,r]
663+cgOp (LLe (ITFixed IT32)) [l, r] = pure $ JsForeign "(%0>>>0) <= (%1>>>0)" [l,r]
664+cgOp (LLe (ITFixed IT64)) [l, r] =
665+ do
666+ setUsedITBig
667+ pure $ jsB2I $ JsForeign "%0.compareTo(%1) <= 0" [l,r]
668+cgOp (LGt (ITFixed IT8)) [l, r] = pure $ JsForeign "%0 > %1" [l,r]
669+cgOp (LGt (ITFixed IT16)) [l, r] = pure $ JsForeign "%0 > %1" [l,r]
670+cgOp (LGt (ITFixed IT32)) [l, r] = pure $ JsForeign "(%0>>>0) > (%1>>>0)" [l,r]
671+cgOp (LGt (ITFixed IT64)) [l, r] =
672+ do
673+ setUsedITBig
674+ pure $ jsB2I $ JsForeign "%0.compareTo(%1) > 0" [l,r]
675+cgOp (LGe (ITFixed IT8)) [l, r] = pure $ JsForeign "%0 >= %1" [l,r]
676+cgOp (LGe (ITFixed IT16)) [l, r] = pure $ JsForeign "%0 >= %1" [l,r]
677+cgOp (LGe (ITFixed IT32)) [l, r] = pure $ JsForeign "(%0>>>0) >= (%1>>>0)" [l,r]
678+cgOp (LGe (ITFixed IT64)) [l, r] =
679+ do
680+ setUsedITBig
681+ pure $ jsB2I $ JsForeign "%0.compareTo(%1) >= 0" [l,r]
532cgOp (LSLt ATFloat) [l, r] = pure $ jsB2I $ JsBinOp "<" l r
682cgOp (LSLt ATFloat) [l, r] = pure $ jsB2I $ JsBinOp "<" l r
533cgOp (LSLt (ATInt ITChar)) [l, r] = pure $ jsB2I $ JsBinOp "<" l r
683cgOp (LSLt (ATInt ITChar)) [l, r] = pure $ jsB2I $ JsBinOp "<" l r
534cgOp (LSLt (ATInt ITNative)) [l, r] = pure $ jsB2I $ JsBinOp "<" l r
684cgOp (LSLt (ATInt ITNative)) [l, r] = pure $ jsB2I $ JsBinOp "<" l r
@@ -536,101 +686,141 @@ cgOp (LSLt (ATInt ITBig)) [l, r] =
536 do
686 do
537 setUsedITBig
687 setUsedITBig
538 pure $ jsB2I $ JsForeign "%0.compareTo(%1) < 0" [l,r]
688 pure $ jsB2I $ JsForeign "%0.compareTo(%1) < 0" [l,r]
689+cgOp (LSLt (ATInt (ITFixed IT8))) [l, r] = pure $ jsB2I $ JsBinOp "<" l r
690+cgOp (LSLt (ATInt (ITFixed IT16))) [l, r] = pure $ jsB2I $ JsBinOp "<" l r
691+cgOp (LSLt (ATInt (ITFixed IT32))) [l, r] = pure $ jsB2I $ JsBinOp "<" l r
692+cgOp (LSLt (ATInt (ITFixed IT64))) [l, r] =
693+ do
694+ setUsedITBig
695+ pure $ jsB2I $ JsForeign "%0.compareTo(%1) < 0" [l,r]
539cgOp (LSLe ATFloat) [l, r] = pure $ jsB2I $ JsBinOp "<=" l r
696cgOp (LSLe ATFloat) [l, r] = pure $ jsB2I $ JsBinOp "<=" l r
540cgOp (LSLe (ATInt ITNative)) [l, r] = pure $ jsB2I $ JsBinOp "<=" l r
697cgOp (LSLe (ATInt ITNative)) [l, r] = pure $ jsB2I $ JsBinOp "<=" l r
541cgOp (LSLe (ATInt ITBig)) [l, r] =
698cgOp (LSLe (ATInt ITBig)) [l, r] =
542 do
699 do
543 setUsedITBig
700 setUsedITBig
544 pure $ jsB2I $ JsForeign "%0.compareTo(%1) <= 0" [l,r]
701 pure $ jsB2I $ JsForeign "%0.compareTo(%1) <= 0" [l,r]
702+cgOp (LSLe (ATInt (ITFixed IT8))) [l, r] = pure $ jsB2I $ JsBinOp "<=" l r
703+cgOp (LSLe (ATInt (ITFixed IT16))) [l, r] = pure $ jsB2I $ JsBinOp "<=" l r
704+cgOp (LSLe (ATInt (ITFixed IT32))) [l, r] = pure $ jsB2I $ JsBinOp "<=" l r
705+cgOp (LSLe (ATInt (ITFixed IT64))) [l, r] =
706+ do
707+ setUsedITBig
708+ pure $ jsB2I $ JsForeign "%0.compareTo(%1) <= 0" [l,r]
545cgOp (LSGt ATFloat) [l, r] = pure $ jsB2I $ JsBinOp ">" l r
709cgOp (LSGt ATFloat) [l, r] = pure $ jsB2I $ JsBinOp ">" l r
546cgOp (LSGt (ATInt ITNative)) [l, r] = pure $ jsB2I $ JsBinOp ">" l r
710cgOp (LSGt (ATInt ITNative)) [l, r] = pure $ jsB2I $ JsBinOp ">" l r
547cgOp (LSGt (ATInt ITBig)) [l, r] =
711cgOp (LSGt (ATInt ITBig)) [l, r] =
548 do
712 do
549 setUsedITBig
713 setUsedITBig
550 pure $ jsB2I $ JsForeign "%0.compareTo(%1) > 0" [l,r]
714 pure $ jsB2I $ JsForeign "%0.compareTo(%1) > 0" [l,r]
715+cgOp (LSGt (ATInt (ITFixed IT8))) [l, r] = pure $ jsB2I $ JsBinOp ">" l r
716+cgOp (LSGt (ATInt (ITFixed IT16))) [l, r] = pure $ jsB2I $ JsBinOp ">" l r
717+cgOp (LSGt (ATInt (ITFixed IT32))) [l, r] = pure $ jsB2I $ JsBinOp ">" l r
718+cgOp (LSGt (ATInt (ITFixed IT64))) [l, r] =
719+ do
720+ setUsedITBig
721+ pure $ jsB2I $ JsForeign "%0.compareTo(%1) > 0" [l,r]
551cgOp (LSGe ATFloat) [l, r] = pure $ jsB2I $ JsBinOp ">=" l r
722cgOp (LSGe ATFloat) [l, r] = pure $ jsB2I $ JsBinOp ">=" l r
552cgOp (LSGe (ATInt ITNative)) [l, r] = pure $ jsB2I $ JsBinOp ">=" l r
723cgOp (LSGe (ATInt ITNative)) [l, r] = pure $ jsB2I $ JsBinOp ">=" l r
553cgOp (LSGe (ATInt ITBig)) [l, r] =
724cgOp (LSGe (ATInt ITBig)) [l, r] =
554 do
725 do
555 setUsedITBig
726 setUsedITBig
556 pure $ jsB2I $ JsForeign "%0.compareTo(%1) >= 0" [l,r]
727 pure $ jsB2I $ JsForeign "%0.compareTo(%1) >= 0" [l,r]
557−cgOp LStrEq [l,r] = pure $ jsB2I $ JsBinOp "==" l r
728+cgOp (LSGe (ATInt (ITFixed IT8))) [l, r] = pure $ jsB2I $ JsBinOp ">=" l r
558−cgOp LStrLen [x] = pure $ JsForeign "%0.length" [x]
729+cgOp (LSGe (ATInt (ITFixed IT16))) [l, r] = pure $ jsB2I $ JsBinOp ">=" l r
559−cgOp LStrHead [x] = pure $ JsArrayProj (JsInt 0) x
560−cgOp LStrIndex [x, y] = pure $ JsArrayProj y x
561−cgOp LStrTail [x] = pure $ JsMethod x "slice" [JsInt 1]
562−cgOp LStrLt [l, r] = pure $ jsB2I $ JsBinOp "<" l r
730+cgOp (LSGe (ATInt (ITFixed IT32))) [l, r] = pure $ jsB2I $ JsBinOp ">=" l r
563−cgOp LStrRev [x] = pure $ JsForeign "%0.split('').reverse().join('')" [x]
731+cgOp (LSGe (ATInt (ITFixed IT64))) [l, r] =
564−cgOp (LFloatStr) [x] = pure $ JsApp "String" [x]
565−cgOp (LIntStr ITNative) [x] = pure $ JsApp "String" [x]
566−cgOp (LIntStr ITBig) [x] =
567 do
732 do
568 setUsedITBig
733 setUsedITBig
569− pure $ JsForeign "%0.toString()" [x]
734+ pure $ jsB2I $ JsForeign "%0.compareTo(%1) >= 0" [l,r]
570−cgOp (LFloatInt ITNative) [x] = pure $ JsForeign "%0|0" [x]
735+cgOp (LSExt ITNative ITBig) [x] =
736+ do
737+ setUsedITBig
738+ pure $ JsForeign "new jsbn.BigInteger(String(%0))" [x]
571−cgOp (LStrInt ITNative) [x] = pure $ JsForeign "parseInt(%0)|0" [x]
739+cgOp (LZExt (ITFixed IT8) ITNative) [x] = pure x
572−cgOp (LStrFloat) [x] = pure $ JsApp "parseFloat" [x]
740+cgOp (LZExt (ITFixed IT16) ITNative) [x] = pure x
573−cgOp (LChInt ITNative) [x] = pure $ JsForeign "%0.charCodeAt(0)|0" [x]
741+cgOp (LZExt (ITFixed IT32) ITNative) [x] = pure x
574−cgOp (LIntCh ITNative) [x] = pure $ JsApp "String.fromCharCode" [x]
742+cgOp (LZExt ITNative ITBig) [x] =
743+ do
744+ setUsedITBig
745+ pure $ JsForeign "new jsbn.BigInteger(String(%0))" [x]
575cgOp (LTrunc ITBig ITNative) [x] =
746cgOp (LTrunc ITBig ITNative) [x] =
576 do
747 do
577 setUsedITBig
748 setUsedITBig
578 pure $ JsForeign "%0.intValue()|0" [x]
749 pure $ JsForeign "%0.intValue()|0" [x]
579−cgOp (LTrunc (ITFixed IT16) (ITFixed IT8)) [x] = pure $ JsForeign "new Uint8Array([ %0[0] ])" [x]
750+cgOp (LTrunc (ITFixed IT16) (ITFixed IT8)) [x] = pure $ JsForeign "%0 & 0xFF" [x]
580−cgOp (LTrunc (ITFixed IT32) (ITFixed IT8)) [x] = pure $ JsForeign "new Uint8Array([ %0 ])" [x]
751+cgOp (LTrunc (ITFixed IT32) (ITFixed IT8)) [x] = pure $ JsForeign "%0 & 0xFF" [x]
581cgOp (LTrunc (ITFixed IT64) (ITFixed IT8)) [x] =
752cgOp (LTrunc (ITFixed IT64) (ITFixed IT8)) [x] =
582 do
753 do
583 setUsedITBig
754 setUsedITBig
584− pure $ JsForeign "new Uint8Array([ %0.and(new jsbn.BigInteger(%1)).intValue() ])" [x, JsStr $ show 0xFF]
755+ pure $ JsForeign "%0.intValue() & 0xFF" [x]
585−cgOp (LSExt ITNative ITBig) [x] =
756+cgOp (LTrunc (ITFixed IT32) (ITFixed IT16)) [x] = pure $ JsForeign "%0 & 0xFFFF" [x]
757+cgOp (LTrunc (ITFixed IT64) (ITFixed IT16)) [x] =
586 do
758 do
587 setUsedITBig
759 setUsedITBig
588− pure $ JsForeign "new jsbn.BigInteger(String(%0))" [x]
760+ pure $ JsForeign "%0.intValue() & 0xFFFF" [x]
589−cgOp (LZExt (ITFixed IT8) ITNative) [x] = pure $ JsForeign "%0[0]" [x]
761+cgOp (LTrunc (ITFixed IT64) (ITFixed IT32)) [x] =
590−cgOp (LZExt ITNative ITBig) [x] =
591 do
762 do
592 setUsedITBig
763 setUsedITBig
593− pure $ JsForeign "new jsbn.BigInteger(String(%0))" [x]
764+ pure $ JsForeign "%0.intValue() & 0xFFFFFFFF" [x]
765+cgOp (LTrunc ITBig (ITFixed IT64)) [x] =
766+ do
767+ setUsedITBig
768+ pure $ JsForeign "%0.and(new jsbn.BigInteger(%1))" [x, JsStr $ show 0xFFFFFFFFFFFFFFFF]
769+cgOp LStrConcat [l,r] = pure $ JsBinOp "+" l r
770+cgOp LStrLt [l, r] = pure $ jsB2I $ JsBinOp "<" l r
771+cgOp LStrEq [l,r] = pure $ jsB2I $ JsBinOp "==" l r
772+cgOp LStrLen [x] = pure $ JsForeign "%0.length" [x]
594cgOp (LIntFloat ITNative) [x] = pure $ x
773cgOp (LIntFloat ITNative) [x] = pure $ x
595cgOp (LIntFloat ITBig) [x] =
774cgOp (LIntFloat ITBig) [x] =
596 do
775 do
597 setUsedITBig
776 setUsedITBig
598 pure $ JsForeign "%0.intValue()" [x]
777 pure $ JsForeign "%0.intValue()" [x]
599−cgOp LFACos [x] = pure $ JsApp "Math.acos" [x]
778+cgOp (LFloatInt ITNative) [x] = pure $ JsForeign "%0|0" [x]
600−cgOp LFATan [x] = pure $ JsApp "Math.atan" [x]
779+cgOp (LIntStr ITNative) [x] = pure $ JsApp "String" [x]
780+cgOp (LIntStr ITBig) [x] =
781+ do
782+ setUsedITBig
783+ pure $ JsForeign "%0.toString()" [x]
784+cgOp (LStrInt ITNative) [x] = pure $ JsForeign "parseInt(%0)|0" [x]
785+cgOp (LStrInt ITBig) [x] =
786+ do
787+ setUsedITBig
788+ pure $ JsForeign "new jsbn.BigInteger(%0)" [x]
789+cgOp (LFloatStr) [x] = pure $ JsApp "String" [x]
790+cgOp (LStrFloat) [x] = pure $ JsApp "parseFloat" [x]
791+cgOp (LChInt ITNative) [x] = pure $ JsForeign "%0.charCodeAt(0)|0" [x]
792+cgOp (LIntCh ITNative) [x] = pure $ JsApp "String.fromCharCode" [x]
601−cgOp LFCos [x] = pure $ JsApp "Math.cos" [x]
793+cgOp LFExp [x] = pure $ JsApp "Math.exp" [x]
602−cgOp LFFloor [x] = pure $ JsApp "Math.floor" [x]
794+cgOp LFLog [x] = pure $ JsApp "Math.log" [x]
603cgOp LFSin [x] = pure $ JsApp "Math.sin" [x]
795cgOp LFSin [x] = pure $ JsApp "Math.sin" [x]
796+cgOp LFCos [x] = pure $ JsApp "Math.cos" [x]
604cgOp LFTan [x] = pure $ JsApp "Math.tan" [x]
797cgOp LFTan [x] = pure $ JsApp "Math.tan" [x]
605cgOp LFASin [x] = pure $ JsApp "Math.asin" [x]
798cgOp LFASin [x] = pure $ JsApp "Math.asin" [x]
606−cgOp LFCeil [x] = pure $ JsApp "Math.ceil" [x]
799+cgOp LFACos [x] = pure $ JsApp "Math.acos" [x]
607−cgOp LFExp [x] = pure $ JsApp "Math.exp" [x]
800+cgOp LFATan [x] = pure $ JsApp "Math.atan" [x]
608−cgOp LFLog [x] = pure $ JsApp "Math.log" [x]
609cgOp LFSqrt [x] = pure $ JsApp "Math.sqrt" [x]
801cgOp LFSqrt [x] = pure $ JsApp "Math.sqrt" [x]
802+cgOp LFFloor [x] = pure $ JsApp "Math.floor" [x]
803+cgOp LFCeil [x] = pure $ JsApp "Math.ceil" [x]
610cgOp LFNegate [x] = pure $ JsForeign "-%0" [x]
804cgOp LFNegate [x] = pure $ JsForeign "-%0" [x]
611−cgOp (LSDiv ATFloat) [l,r] = pure $ JsBinOp "/" l r
805+cgOp LStrHead [x] = pure $ JsArrayProj (JsInt 0) x
612−cgOp (LSDiv (ATInt ITNative)) [l,r] = pure $ JsForeign "%0/%1|0" [l, r]
613−cgOp (LSDiv (ATInt ITBig)) [l,r] =
614− do
615− setUsedITBig
616− pure $ JsMethod l "divide" [r]
806+cgOp LStrTail [x] = pure $ JsMethod x "slice" [JsInt 1]
617−cgOp LWriteStr [_,str] =
807+cgOp LStrCons [l,r] = pure $ JsForeign "%0+%1" [l,r]
618− do
808+cgOp LStrIndex [x, y] = pure $ JsArrayProj y x
619− s <- get
809+cgOp LStrRev [x] = pure $ JsForeign "%0.split('').reverse().join('')" [x]
620− put $ s {usedWrite = True}
810+cgOp LStrSubstr [offset,len,str] = pure $ JsForeign "%0.substr(Math.max(0,%1), Math.max(0, %2))" [str, offset, len]
621− pure $ JsForeign (writeStrTemplate $ conf s) [str]
622cgOp LReadStr [_] =
811cgOp LReadStr [_] =
623 do
812 do
624 s <- get
813 s <- get
625 put $ s {usedRead = True}
814 put $ s {usedRead = True}
626 pure $ JsForeign (readStrTemplate $ conf s) []
815 pure $ JsForeign (readStrTemplate $ conf s) []
627−cgOp LStrConcat [l,r] = pure $ JsBinOp "+" l r
816+cgOp LWriteStr [_,str] =
628−cgOp LStrCons [l,r] = pure $ JsForeign "%0+%1" [l,r]
629−cgOp LStrSubstr [offset,len,str] = pure $ JsForeign "%0.substr(Math.max(0,%1), Math.max(0, %2))" [str, offset, len] -- JsMethod str "substr" [offset, len]
630−cgOp (LSRem (ATInt ITNative)) [l,r] = pure $ JsBinOp "%" l r
631−cgOp (LSRem (ATInt ITBig)) [l,r] =
632 do
817 do
633− setUsedITBig
818+ s <- get
634− pure $ JsMethod l "remainder" [r]
819+ put $ s {usedWrite = True}
820+ pure $ JsForeign (writeStrTemplate $ conf s) [str]
821+cgOp LSystemInfo [x] = pure $ JsApp "js_idris_systemInfo" [x]
822+cgOp (LExternal name) _ | name == sUN "prim__null" = pure JsNull
823+cgOp (LExternal name) [l,r] | name == sUN "prim__eqPtr" = pure $ JsBinOp "==" l r
635cgOp LCrash [l] = pure $ JsErrorExp l
824cgOp LCrash [l] = pure $ JsErrorExp l
825+cgOp LNoOp [x] = pure x
636cgOp op exps = error ("Operator " ++ show (op, exps) ++ " not implemented")
826cgOp op exps = error ("Operator " ++ show (op, exps) ++ " not implemented")