on master help sign in
Merge pull request #3821 from rbarreiro/liftDecls_js_backend

Lift decls js backend

commita859f655ffd84952ecd33d91436d679b175b180f authorNiklas Larsson <metaniklas@gmail.com> dateTue 23 May 2017, 10:04 (9 years ago) parent50b1b41ef9eac6
12 files changed+2549−3083
CHANGELOG.md+8−1 idris.cabal+4−2 jsrts/Runtime-browser.js−17 jsrts/Runtime-common.js+9−111 jsrts/Runtime-javascript.js+9 jsrts/Runtime-node.js+1−33 jsrts/jsbn/jsbn.js+1341−1226 src/IRTS/CodegenJavaScript.hs+73−1292 src/IRTS/JavaScript/AST.hs+178−399 src/IRTS/JavaScript/Codegen.hs+826 src/IRTS/JavaScript/LangTransforms.hs+96 src/IRTS/Lang.hs+4−2
CHANGELOG.md+8−1
@@ -1,6 +1,13 @@
1+
2+## Tool Updates
3+
4++ New javascript code generator that uses an higher level intermediate
5+ representation.
6+
17+ Names are now annotated with their representations over the IDE
28 protocol, which allows IDEs to provide commands that work on special
3− names that don't have syntax, such as case block names.
9+ names that don't have syntax, such as case block names
10+
411
512# New in 1.0
613
idris.cabal+4−2
@@ -47,10 +47,10 @@ Build-type: Custom
4747Tested-With: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1
4848
4949Data-files: idrisdoc/styles.css
50− jsrts/Runtime-browser.js
50+ jsrts/jsbn/jsbn.js
5151 jsrts/Runtime-common.js
52+ jsrts/Runtime-javascript.js
5253 jsrts/Runtime-node.js
53− jsrts/jsbn/jsbn.js
5454 jsrts/jsbn/LICENSE
5555 rts/arduino/idris_main.c
5656 rts/idris_bitstring.c
@@ -223,6 +223,8 @@ Library
223223 , IRTS.CodegenJavaScript
224224 , IRTS.Exports
225225 , IRTS.JavaScript.AST
226+ , IRTS.JavaScript.Codegen
227+ , IRTS.JavaScript.LangTransforms
226228 , IRTS.Compiler
227229 , IRTS.Defunctionalise
228230 , IRTS.DumpBC
jsrts/Runtime-browser.jsdeleted−17
@@ -1,17 +0,0 @@
1−var i$getLine = function() {
2− return prompt("Prelude.getLine");
3−}
4−
5−var i$putStr = function(s) {
6− console.log(s);
7−};
8−
9−var i$systemInfo = function(index) {
10− switch(index) {
11− case 0:
12− return "javascript";
13− case 1:
14− return navigator.platform;
15− }
16− return "";
17−}
jsrts/Runtime-common.js+9−111
@@ -1,117 +1,15 @@
1−/** @constructor */
2−var i$VM = function() {
3− this.valstack = {};
4− this.valstack_top = 0;
5− this.valstack_base = 0;
61
7− this.ret = null;
8−
9− this.callstack = [];
10−}
11−
12−var i$vm;
13−var i$valstack;
14−var i$valstack_top;
15−var i$valstack_base;
16−var i$ret;
17−var i$callstack;
18−
19−var i$Int = {};
20−var i$String = {};
21−var i$Integer = {};
22−var i$Float = {};
23−var i$Char = {};
24−var i$Ptr = {};
25−var i$Forgot = {};
26−
27−/** @constructor */
28−var i$CON = function(tag,args,app,ev) {
29− this.tag = tag;
30− this.args = args;
31− this.app = app;
32− this.ev = ev;
33−}
34−
35−/** @constructor */
36−var i$POINTER = function(addr) {
37− this.addr = addr;
38−}
39−
40−var i$SCHED = function(vm) {
41− i$vm = vm;
42− i$valstack = vm.valstack;
43− i$valstack_top = vm.valstack_top;
44− i$valstack_base = vm.valstack_base;
45− i$ret = vm.ret;
46− i$callstack = vm.callstack;
47−}
48−
49−var i$SLIDE = function(args) {
50− for (var i = 0; i < args; ++i)
51− i$valstack[i$valstack_base + i] = i$valstack[i$valstack_top + i];
52−}
53−
54−var i$PROJECT = function(val,loc,arity) {
55− for (var i = 0; i < arity; ++i)
56− i$valstack[i$valstack_base + i + loc] = val.args[i];
2+var js_idris_throw2 = function (x){
3+ throw x;
574}
585
59−var i$CALL = function(fun,args) {
60− i$callstack.push(args);
61− i$callstack.push(fun);
62−}
63−
64−var i$ffiWrap = function(fid,oldbase,myoldbase) {
65− return function() {
66− var oldstack = i$callstack;
67− i$callstack = [];
68−
69− var res = fid;
70−
71− for(var i = 0; i < (arguments.length ? arguments.length : 1); ++i) {
72− while (res instanceof i$CON) {
73− i$valstack_top += 1;
74− i$valstack[i$valstack_top] = res;
75− i$valstack[i$valstack_top + 1] = arguments[i];
76− i$SLIDE(2);
77− i$valstack_top = i$valstack_base + 2;
78− i$CALL(_idris__123_APPLY0_125_,[oldbase])
79− while (i$callstack.length) {
80− var func = i$callstack.pop();
81− var args = i$callstack.pop();
82− func.apply(this,args);
83− }
84− res = i$ret;
85− }
6+var js_idris_force = function (x){
7+ if(x === undefined || x.js_idris_lazy_calc === undefined){
8+ return x
9+ }else{
10+ if(x.js_idris_lazy_val === undefined){
11+ x.js_idris_lazy_val = x.js_idris_lazy_calc()
8612 }
87−
88− i$callstack = oldstack;
89−
90− return i$ret;
13+ return x.js_idris_lazy_val
9114 }
9215}
93−
94−var i$charCode = function(str) {
95− if (typeof str == "string")
96− return str.charCodeAt(0);
97− else
98− return str;
99−}
100−
101−var i$fromCharCode = function(chr) {
102− if (typeof chr == "string")
103− return chr;
104− else
105− return String.fromCharCode(chr);
106−}
107−
108−var i$RUN = function () {
109− for (var i = 0; i < 10000 && i$callstack.length; i++) {
110− var func = i$callstack.pop();
111− var args = i$callstack.pop();
112− func.apply(this,args);
113− };
114−
115− if (i$callstack.length)
116− setTimeout(i$RUN, 0);
117−}
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.js+1−33
@@ -1,36 +1,4 @@
1−var i$putStr = (function() {
2− var fs = require('fs');
3− return function(s) {
4− fs.writeSync(1,s);
5− };
6−})();
7−
8−var i$getLine = (function() {
9− var fs = require( "fs" )
10−
11− return function() {
12− var ret = "";
13− var b = new Buffer(1024);
14− var i = 0;
15− while(true) {
16− fs.readSync(0, b, i, 1 )
17− if (b[i] == 10) {
18− ret = b.toString('utf8', 0, i);
19− break;
20− }
21− i++;
22− if (i == b.length) {
23− nb = new Buffer (b.length*2);
24− b.copy(nb)
25− b = nb;
26− }
27− }
28−
29− return ret;
30− };
31−})();
32−
33−var i$systemInfo = function(index) {
1+var js_idris_systemInfo = function(index) {
342 var os = require('os')
353 switch(index) {
364 case 0:
jsrts/jsbn/jsbn.js+1341−1226
@@ -1,1238 +1,1353 @@
1−var i$bigInt = (function() {
2−// Copyright (c) 2005 Tom Wu
3−// All Rights Reserved.
4−// See "LICENSE" for details.
5−
6−// Basic JavaScript BN library - subset useful for RSA encryption.
7−
8−// Bits per digit
9−var dbits;
10−
11−// JavaScript engine analysis
12−var canary = 0xdeadbeefcafe;
13−var j_lm = ((canary&0xffffff)==0xefcafe);
14−
15−// (public) Constructor
16−function BigInteger(a,b,c) {
17− if(a != null)
18− if("number" == typeof a) this.fromNumber(a,b,c);
19− else if(b == null && "string" != typeof a) this.fromString(a,256);
20− else this.fromString(a,b);
21−}
22−
23−// return new, unset BigInteger
24−function nbi() { return new BigInteger(null); }
25−
26−// am: Compute w_j += (x*this_i), propagate carries,
27−// c is initial carry, returns final carry.
28−// c < 3*dvalue, x < 2*dvalue, this_i < dvalue
29−// We need to select the fastest one that works in this environment.
30−
31−// am1: use a single mult and divide to get the high bits,
32−// max digit bits should be 26 because
33−// max internal value = 2*dvalue^2-2*dvalue (< 2^53)
34−function am1(i,x,w,j,c,n) {
35− while(--n >= 0) {
36− var v = x*this[i++]+w[j]+c;
37− c = Math.floor(v/0x4000000);
38− w[j++] = v&0x3ffffff;
39− }
40− return c;
41−}
42−// am2 avoids a big mult-and-extract completely.
43−// Max digit bits should be <= 30 because we do bitwise ops
44−// on values up to 2*hdvalue^2-hdvalue-1 (< 2^31)
45−function am2(i,x,w,j,c,n) {
46− var xl = x&0x7fff, xh = x>>15;
47− while(--n >= 0) {
48− var l = this[i]&0x7fff;
49− var h = this[i++]>>15;
50− var m = xh*l+h*xl;
51− l = xl*l+((m&0x7fff)<<15)+w[j]+(c&0x3fffffff);
52− c = (l>>>30)+(m>>>15)+xh*h+(c>>>30);
53− w[j++] = l&0x3fffffff;
54− }
55− return c;
56−}
57−// Alternately, set max digit bits to 28 since some
58−// browsers slow down when dealing with 32-bit numbers.
59−function am3(i,x,w,j,c,n) {
60− var xl = x&0x3fff, xh = x>>14;
61− while(--n >= 0) {
62− var l = this[i]&0x3fff;
63− var h = this[i++]>>14;
64− var m = xh*l+h*xl;
65− l = xl*l+((m&0x3fff)<<14)+w[j]+c;
66− c = (l>>28)+(m>>14)+xh*h;
67− w[j++] = l&0xfffffff;
68− }
69− return c;
70−}
71−var in_browser = typeof navigator !== "undefined"
72−if(in_browser && j_lm && (navigator.appName == "Microsoft Internet Explorer")) {
73− BigInteger.prototype.am = am2;
74− dbits = 30;
75−}
76−else if(in_browser && j_lm && (navigator.appName != "Netscape")) {
77− BigInteger.prototype.am = am1;
78− dbits = 26;
79−}
80−else { // Mozilla/Netscape seems to prefer am3
81− BigInteger.prototype.am = am3;
82− dbits = 28;
83−}
84−
85−BigInteger.prototype.DB = dbits;
86−BigInteger.prototype.DM = ((1<<dbits)-1);
87−BigInteger.prototype.DV = (1<<dbits);
88−
89−var BI_FP = 52;
90−BigInteger.prototype.FV = Math.pow(2,BI_FP);
91−BigInteger.prototype.F1 = BI_FP-dbits;
92−BigInteger.prototype.F2 = 2*dbits-BI_FP;
93−
94−// Digit conversions
95−var BI_RM = "0123456789abcdefghijklmnopqrstuvwxyz";
96−var BI_RC = new Array();
97−var rr,vv;
98−rr = "0".charCodeAt(0);
99−for(vv = 0; vv <= 9; ++vv) BI_RC[rr++] = vv;
100−rr = "a".charCodeAt(0);
101−for(vv = 10; vv < 36; ++vv) BI_RC[rr++] = vv;
102−rr = "A".charCodeAt(0);
103−for(vv = 10; vv < 36; ++vv) BI_RC[rr++] = vv;
104−
105−function int2char(n) { return BI_RM.charAt(n); }
106−function intAt(s,i) {
107− var c = BI_RC[s.charCodeAt(i)];
108− return (c==null)?-1:c;
109−}
110−
111−// (protected) copy this to r
112−function bnpCopyTo(r) {
113− for(var i = this.t-1; i >= 0; --i) r[i] = this[i];
114− r.t = this.t;
115− r.s = this.s;
116−}
117−
118−// (protected) set from integer value x, -DV <= x < DV
119−function bnpFromInt(x) {
120− this.t = 1;
121− this.s = (x<0)?-1:0;
122− if(x > 0) this[0] = x;
123− else if(x < -1) this[0] = x+this.DV;
124− else this.t = 0;
125−}
126−
127−// return bigint initialized to value
128−function nbv(i) { var r = nbi(); r.fromInt(i); return r; }
129−
130−// (protected) set from string and radix
131−function bnpFromString(s,b) {
132− var k;
133− if(b == 16) k = 4;
134− else if(b == 8) k = 3;
135− else if(b == 256) k = 8; // byte array
136− else if(b == 2) k = 1;
137− else if(b == 32) k = 5;
138− else if(b == 4) k = 2;
139− else { this.fromRadix(s,b); return; }
140− this.t = 0;
141− this.s = 0;
142− var i = s.length, mi = false, sh = 0;
143− while(--i >= 0) {
144− var x = (k==8)?s[i]&0xff:intAt(s,i);
145− if(x < 0) {
146− if(s.charAt(i) == "-") mi = true;
147− continue;
148− }
149− mi = false;
150− if(sh == 0)
151− this[this.t++] = x;
152− else if(sh+k > this.DB) {
153− this[this.t-1] |= (x&((1<<(this.DB-sh))-1))<<sh;
154− this[this.t++] = (x>>(this.DB-sh));
155− }
156− else
157− this[this.t-1] |= x<<sh;
158− sh += k;
159− if(sh >= this.DB) sh -= this.DB;
160− }
161− if(k == 8 && (s[0]&0x80) != 0) {
162− this.s = -1;
163− if(sh > 0) this[this.t-1] |= ((1<<(this.DB-sh))-1)<<sh;
164− }
165− this.clamp();
166− if(mi) BigInteger.ZERO.subTo(this,this);
167−}
168−
169−// (protected) clamp off excess high words
170−function bnpClamp() {
171− var c = this.s&this.DM;
172− while(this.t > 0 && this[this.t-1] == c) --this.t;
173−}
174−
175−// (public) return string representation in given radix
176−function bnToString(b) {
177− if(this.s < 0) return "-"+this.negate().toString(b);
178− var k;
179− if(b == 16) k = 4;
180− else if(b == 8) k = 3;
181− else if(b == 2) k = 1;
182− else if(b == 32) k = 5;
183− else if(b == 4) k = 2;
184− else return this.toRadix(b);
185− var km = (1<<k)-1, d, m = false, r = "", i = this.t;
186− var p = this.DB-(i*this.DB)%k;
187− if(i-- > 0) {
188− if(p < this.DB && (d = this[i]>>p) > 0) { m = true; r = int2char(d); }
189− while(i >= 0) {
190− if(p < k) {
191− d = (this[i]&((1<<p)-1))<<(k-p);
192− d |= this[--i]>>(p+=this.DB-k);
1+var jsbn = (function(){
2+
3+ // Copyright (c) 2005 Tom Wu
4+ // All Rights Reserved.
5+ // See "LICENSE" for details.
6+
7+ // Basic JavaScript BN library - subset useful for RSA encryption.
8+
9+ // Bits per digit
10+ var dbits;
11+
12+ // JavaScript engine analysis
13+ var canary = 0xdeadbeefcafe;
14+ var j_lm = ((canary&0xffffff)==0xefcafe);
15+
16+ // (public) Constructor
17+ function BigInteger(a,b,c) {
18+ if(a != null)
19+ if("number" == typeof a) this.fromNumber(a,b,c);
20+ else if(b == null && "string" != typeof a) this.fromString(a,256);
21+ else this.fromString(a,b);
22+ }
23+
24+ // return new, unset BigInteger
25+ function nbi() { return new BigInteger(null); }
26+
27+ // am: Compute w_j += (x*this_i), propagate carries,
28+ // c is initial carry, returns final carry.
29+ // c < 3*dvalue, x < 2*dvalue, this_i < dvalue
30+ // We need to select the fastest one that works in this environment.
31+
32+ // am1: use a single mult and divide to get the high bits,
33+ // max digit bits should be 26 because
34+ // max internal value = 2*dvalue^2-2*dvalue (< 2^53)
35+ function am1(i,x,w,j,c,n) {
36+ while(--n >= 0) {
37+ var v = x*this[i++]+w[j]+c;
38+ c = Math.floor(v/0x4000000);
39+ w[j++] = v&0x3ffffff;
40+ }
41+ return c;
42+ }
43+ // am2 avoids a big mult-and-extract completely.
44+ // Max digit bits should be <= 30 because we do bitwise ops
45+ // on values up to 2*hdvalue^2-hdvalue-1 (< 2^31)
46+ function am2(i,x,w,j,c,n) {
47+ var xl = x&0x7fff, xh = x>>15;
48+ while(--n >= 0) {
49+ var l = this[i]&0x7fff;
50+ var h = this[i++]>>15;
51+ var m = xh*l+h*xl;
52+ l = xl*l+((m&0x7fff)<<15)+w[j]+(c&0x3fffffff);
53+ c = (l>>>30)+(m>>>15)+xh*h+(c>>>30);
54+ w[j++] = l&0x3fffffff;
55+ }
56+ return c;
57+ }
58+ // Alternately, set max digit bits to 28 since some
59+ // browsers slow down when dealing with 32-bit numbers.
60+ function am3(i,x,w,j,c,n) {
61+ var xl = x&0x3fff, xh = x>>14;
62+ while(--n >= 0) {
63+ var l = this[i]&0x3fff;
64+ var h = this[i++]>>14;
65+ var m = xh*l+h*xl;
66+ l = xl*l+((m&0x3fff)<<14)+w[j]+c;
67+ c = (l>>28)+(m>>14)+xh*h;
68+ w[j++] = l&0xfffffff;
69+ }
70+ return c;
71+ }
72+ var inBrowser = typeof navigator !== "undefined";
73+ if(inBrowser && j_lm && (navigator.appName == "Microsoft Internet Explorer")) {
74+ BigInteger.prototype.am = am2;
75+ dbits = 30;
76+ }
77+ else if(inBrowser && j_lm && (navigator.appName != "Netscape")) {
78+ BigInteger.prototype.am = am1;
79+ dbits = 26;
80+ }
81+ else { // Mozilla/Netscape seems to prefer am3
82+ BigInteger.prototype.am = am3;
83+ dbits = 28;
84+ }
85+
86+ BigInteger.prototype.DB = dbits;
87+ BigInteger.prototype.DM = ((1<<dbits)-1);
88+ BigInteger.prototype.DV = (1<<dbits);
89+
90+ var BI_FP = 52;
91+ BigInteger.prototype.FV = Math.pow(2,BI_FP);
92+ BigInteger.prototype.F1 = BI_FP-dbits;
93+ BigInteger.prototype.F2 = 2*dbits-BI_FP;
94+
95+ // Digit conversions
96+ var BI_RM = "0123456789abcdefghijklmnopqrstuvwxyz";
97+ var BI_RC = new Array();
98+ var rr,vv;
99+ rr = "0".charCodeAt(0);
100+ for(vv = 0; vv <= 9; ++vv) BI_RC[rr++] = vv;
101+ rr = "a".charCodeAt(0);
102+ for(vv = 10; vv < 36; ++vv) BI_RC[rr++] = vv;
103+ rr = "A".charCodeAt(0);
104+ for(vv = 10; vv < 36; ++vv) BI_RC[rr++] = vv;
105+
106+ function int2char(n) { return BI_RM.charAt(n); }
107+ function intAt(s,i) {
108+ var c = BI_RC[s.charCodeAt(i)];
109+ return (c==null)?-1:c;
110+ }
111+
112+ // (protected) copy this to r
113+ function bnpCopyTo(r) {
114+ for(var i = this.t-1; i >= 0; --i) r[i] = this[i];
115+ r.t = this.t;
116+ r.s = this.s;
117+ }
118+
119+ // (protected) set from integer value x, -DV <= x < DV
120+ function bnpFromInt(x) {
121+ this.t = 1;
122+ this.s = (x<0)?-1:0;
123+ if(x > 0) this[0] = x;
124+ else if(x < -1) this[0] = x+this.DV;
125+ else this.t = 0;
126+ }
127+
128+ // return bigint initialized to value
129+ function nbv(i) { var r = nbi(); r.fromInt(i); return r; }
130+
131+ // (protected) set from string and radix
132+ function bnpFromString(s,b) {
133+ var k;
134+ if(b == 16) k = 4;
135+ else if(b == 8) k = 3;
136+ else if(b == 256) k = 8; // byte array
137+ else if(b == 2) k = 1;
138+ else if(b == 32) k = 5;
139+ else if(b == 4) k = 2;
140+ else { this.fromRadix(s,b); return; }
141+ this.t = 0;
142+ this.s = 0;
143+ var i = s.length, mi = false, sh = 0;
144+ while(--i >= 0) {
145+ var x = (k==8)?s[i]&0xff:intAt(s,i);
146+ if(x < 0) {
147+ if(s.charAt(i) == "-") mi = true;
148+ continue;
149+ }
150+ mi = false;
151+ if(sh == 0)
152+ this[this.t++] = x;
153+ else if(sh+k > this.DB) {
154+ this[this.t-1] |= (x&((1<<(this.DB-sh))-1))<<sh;
155+ this[this.t++] = (x>>(this.DB-sh));
156+ }
157+ else
158+ this[this.t-1] |= x<<sh;
159+ sh += k;
160+ if(sh >= this.DB) sh -= this.DB;
161+ }
162+ if(k == 8 && (s[0]&0x80) != 0) {
163+ this.s = -1;
164+ if(sh > 0) this[this.t-1] |= ((1<<(this.DB-sh))-1)<<sh;
165+ }
166+ this.clamp();
167+ if(mi) BigInteger.ZERO.subTo(this,this);
168+ }
169+
170+ // (protected) clamp off excess high words
171+ function bnpClamp() {
172+ var c = this.s&this.DM;
173+ while(this.t > 0 && this[this.t-1] == c) --this.t;
174+ }
175+
176+ // (public) return string representation in given radix
177+ function bnToString(b) {
178+ if(this.s < 0) return "-"+this.negate().toString(b);
179+ var k;
180+ if(b == 16) k = 4;
181+ else if(b == 8) k = 3;
182+ else if(b == 2) k = 1;
183+ else if(b == 32) k = 5;
184+ else if(b == 4) k = 2;
185+ else return this.toRadix(b);
186+ var km = (1<<k)-1, d, m = false, r = "", i = this.t;
187+ var p = this.DB-(i*this.DB)%k;
188+ if(i-- > 0) {
189+ if(p < this.DB && (d = this[i]>>p) > 0) { m = true; r = int2char(d); }
190+ while(i >= 0) {
191+ if(p < k) {
192+ d = (this[i]&((1<<p)-1))<<(k-p);
193+ d |= this[--i]>>(p+=this.DB-k);
194+ }
195+ else {
196+ d = (this[i]>>(p-=k))&km;
197+ if(p <= 0) { p += this.DB; --i; }
198+ }
199+ if(d > 0) m = true;
200+ if(m) r += int2char(d);
201+ }
202+ }
203+ return m?r:"0";
204+ }
205+
206+ // (public) -this
207+ function bnNegate() { var r = nbi(); BigInteger.ZERO.subTo(this,r); return r; }
208+
209+ // (public) |this|
210+ function bnAbs() { return (this.s<0)?this.negate():this; }
211+
212+ // (public) return + if this > a, - if this < a, 0 if equal
213+ function bnCompareTo(a) {
214+ var r = this.s-a.s;
215+ if(r != 0) return r;
216+ var i = this.t;
217+ r = i-a.t;
218+ if(r != 0) return (this.s<0)?-r:r;
219+ while(--i >= 0) if((r=this[i]-a[i]) != 0) return r;
220+ return 0;
221+ }
222+
223+ // returns bit length of the integer x
224+ function nbits(x) {
225+ var r = 1, t;
226+ if((t=x>>>16) != 0) { x = t; r += 16; }
227+ if((t=x>>8) != 0) { x = t; r += 8; }
228+ if((t=x>>4) != 0) { x = t; r += 4; }
229+ if((t=x>>2) != 0) { x = t; r += 2; }
230+ if((t=x>>1) != 0) { x = t; r += 1; }
231+ return r;
232+ }
233+
234+ // (public) return the number of bits in "this"
235+ function bnBitLength() {
236+ if(this.t <= 0) return 0;
237+ return this.DB*(this.t-1)+nbits(this[this.t-1]^(this.s&this.DM));
238+ }
239+
240+ // (protected) r = this << n*DB
241+ function bnpDLShiftTo(n,r) {
242+ var i;
243+ for(i = this.t-1; i >= 0; --i) r[i+n] = this[i];
244+ for(i = n-1; i >= 0; --i) r[i] = 0;
245+ r.t = this.t+n;
246+ r.s = this.s;
247+ }
248+
249+ // (protected) r = this >> n*DB
250+ function bnpDRShiftTo(n,r) {
251+ for(var i = n; i < this.t; ++i) r[i-n] = this[i];
252+ r.t = Math.max(this.t-n,0);
253+ r.s = this.s;
254+ }
255+
256+ // (protected) r = this << n
257+ function bnpLShiftTo(n,r) {
258+ var bs = n%this.DB;
259+ var cbs = this.DB-bs;
260+ var bm = (1<<cbs)-1;
261+ var ds = Math.floor(n/this.DB), c = (this.s<<bs)&this.DM, i;
262+ for(i = this.t-1; i >= 0; --i) {
263+ r[i+ds+1] = (this[i]>>cbs)|c;
264+ c = (this[i]&bm)<<bs;
265+ }
266+ for(i = ds-1; i >= 0; --i) r[i] = 0;
267+ r[ds] = c;
268+ r.t = this.t+ds+1;
269+ r.s = this.s;
270+ r.clamp();
271+ }
272+
273+ // (protected) r = this >> n
274+ function bnpRShiftTo(n,r) {
275+ r.s = this.s;
276+ var ds = Math.floor(n/this.DB);
277+ if(ds >= this.t) { r.t = 0; return; }
278+ var bs = n%this.DB;
279+ var cbs = this.DB-bs;
280+ var bm = (1<<bs)-1;
281+ r[0] = this[ds]>>bs;
282+ for(var i = ds+1; i < this.t; ++i) {
283+ r[i-ds-1] |= (this[i]&bm)<<cbs;
284+ r[i-ds] = this[i]>>bs;
285+ }
286+ if(bs > 0) r[this.t-ds-1] |= (this.s&bm)<<cbs;
287+ r.t = this.t-ds;
288+ r.clamp();
289+ }
290+
291+ // (protected) r = this - a
292+ function bnpSubTo(a,r) {
293+ var i = 0, c = 0, m = Math.min(a.t,this.t);
294+ while(i < m) {
295+ c += this[i]-a[i];
296+ r[i++] = c&this.DM;
297+ c >>= this.DB;
298+ }
299+ if(a.t < this.t) {
300+ c -= a.s;
301+ while(i < this.t) {
302+ c += this[i];
303+ r[i++] = c&this.DM;
304+ c >>= this.DB;
305+ }
306+ c += this.s;
193307 }
194308 else {
195− d = (this[i]>>(p-=k))&km;
196− if(p <= 0) { p += this.DB; --i; }
309+ c += this.s;
310+ while(i < a.t) {
311+ c -= a[i];
312+ r[i++] = c&this.DM;
313+ c >>= this.DB;
314+ }
315+ c -= a.s;
316+ }
317+ r.s = (c<0)?-1:0;
318+ if(c < -1) r[i++] = this.DV+c;
319+ else if(c > 0) r[i++] = c;
320+ r.t = i;
321+ r.clamp();
322+ }
323+
324+ // (protected) r = this * a, r != this,a (HAC 14.12)
325+ // "this" should be the larger one if appropriate.
326+ function bnpMultiplyTo(a,r) {
327+ var x = this.abs(), y = a.abs();
328+ var i = x.t;
329+ r.t = i+y.t;
330+ while(--i >= 0) r[i] = 0;
331+ for(i = 0; i < y.t; ++i) r[i+x.t] = x.am(0,y[i],r,i,0,x.t);
332+ r.s = 0;
333+ r.clamp();
334+ if(this.s != a.s) BigInteger.ZERO.subTo(r,r);
335+ }
336+
337+ // (protected) r = this^2, r != this (HAC 14.16)
338+ function bnpSquareTo(r) {
339+ var x = this.abs();
340+ var i = r.t = 2*x.t;
341+ while(--i >= 0) r[i] = 0;
342+ for(i = 0; i < x.t-1; ++i) {
343+ var c = x.am(i,x[i],r,2*i,0,1);
344+ if((r[i+x.t]+=x.am(i+1,2*x[i],r,2*i+1,c,x.t-i-1)) >= x.DV) {
345+ r[i+x.t] -= x.DV;
346+ r[i+x.t+1] = 1;
347+ }
197348 }
198− if(d > 0) m = true;
199− if(m) r += int2char(d);
200− }
201− }
202− return m?r:"0";
203−}
204−
205−// (public) -this
206−function bnNegate() { var r = nbi(); BigInteger.ZERO.subTo(this,r); return r; }
207−
208−// (public) |this|
209−function bnAbs() { return (this.s<0)?this.negate():this; }
210−
211−// (public) return + if this > a, - if this < a, 0 if equal
212−function bnCompareTo(a) {
213− var r = this.s-a.s;
214− if(r != 0) return r;
215− var i = this.t;
216− r = i-a.t;
217− if(r != 0) return (this.s<0)?-r:r;
218− while(--i >= 0) if((r=this[i]-a[i]) != 0) return r;
219− return 0;
220−}
221−
222−// returns bit length of the integer x
223−function nbits(x) {
224− var r = 1, t;
225− if((t=x>>>16) != 0) { x = t; r += 16; }
226− if((t=x>>8) != 0) { x = t; r += 8; }
227− if((t=x>>4) != 0) { x = t; r += 4; }
228− if((t=x>>2) != 0) { x = t; r += 2; }
229− if((t=x>>1) != 0) { x = t; r += 1; }
230− return r;
231−}
232−
233−// (public) return the number of bits in "this"
234−function bnBitLength() {
235− if(this.t <= 0) return 0;
236− return this.DB*(this.t-1)+nbits(this[this.t-1]^(this.s&this.DM));
237−}
238−
239−// (protected) r = this << n*DB
240−function bnpDLShiftTo(n,r) {
241− var i;
242− for(i = this.t-1; i >= 0; --i) r[i+n] = this[i];
243− for(i = n-1; i >= 0; --i) r[i] = 0;
244− r.t = this.t+n;
245− r.s = this.s;
246−}
247−
248−// (protected) r = this >> n*DB
249−function bnpDRShiftTo(n,r) {
250− for(var i = n; i < this.t; ++i) r[i-n] = this[i];
251− r.t = Math.max(this.t-n,0);
252− r.s = this.s;
253−}
254−
255−// (protected) r = this << n
256−function bnpLShiftTo(n,r) {
257− var bs = n%this.DB;
258− var cbs = this.DB-bs;
259− var bm = (1<<cbs)-1;
260− var ds = Math.floor(n/this.DB), c = (this.s<<bs)&this.DM, i;
261− for(i = this.t-1; i >= 0; --i) {
262− r[i+ds+1] = (this[i]>>cbs)|c;
263− c = (this[i]&bm)<<bs;
264− }
265− for(i = ds-1; i >= 0; --i) r[i] = 0;
266− r[ds] = c;
267− r.t = this.t+ds+1;
268− r.s = this.s;
269− r.clamp();
270−}
271−
272−// (protected) r = this >> n
273−function bnpRShiftTo(n,r) {
274− r.s = this.s;
275− var ds = Math.floor(n/this.DB);
276− if(ds >= this.t) { r.t = 0; return; }
277− var bs = n%this.DB;
278− var cbs = this.DB-bs;
279− var bm = (1<<bs)-1;
280− r[0] = this[ds]>>bs;
281− for(var i = ds+1; i < this.t; ++i) {
282− r[i-ds-1] |= (this[i]&bm)<<cbs;
283− r[i-ds] = this[i]>>bs;
284− }
285− if(bs > 0) r[this.t-ds-1] |= (this.s&bm)<<cbs;
286− r.t = this.t-ds;
287− r.clamp();
288−}
289−
290−// (protected) r = this - a
291−function bnpSubTo(a,r) {
292− var i = 0, c = 0, m = Math.min(a.t,this.t);
293− while(i < m) {
294− c += this[i]-a[i];
295− r[i++] = c&this.DM;
296− c >>= this.DB;
297− }
298− if(a.t < this.t) {
299− c -= a.s;
300− while(i < this.t) {
301− c += this[i];
302− r[i++] = c&this.DM;
303− c >>= this.DB;
304− }
305− c += this.s;
306− }
307− else {
308− c += this.s;
309− while(i < a.t) {
310− c -= a[i];
311− r[i++] = c&this.DM;
312− c >>= this.DB;
313− }
314− c -= a.s;
315− }
316− r.s = (c<0)?-1:0;
317− if(c < -1) r[i++] = this.DV+c;
318− else if(c > 0) r[i++] = c;
319− r.t = i;
320− r.clamp();
321−}
322−
323−// (protected) r = this * a, r != this,a (HAC 14.12)
324−// "this" should be the larger one if appropriate.
325−function bnpMultiplyTo(a,r) {
326− var x = this.abs(), y = a.abs();
327− var i = x.t;
328− r.t = i+y.t;
329− while(--i >= 0) r[i] = 0;
330− for(i = 0; i < y.t; ++i) r[i+x.t] = x.am(0,y[i],r,i,0,x.t);
331− r.s = 0;
332− r.clamp();
333− if(this.s != a.s) BigInteger.ZERO.subTo(r,r);
334−}
335−
336−// (protected) r = this^2, r != this (HAC 14.16)
337−function bnpSquareTo(r) {
338− var x = this.abs();
339− var i = r.t = 2*x.t;
340− while(--i >= 0) r[i] = 0;
341− for(i = 0; i < x.t-1; ++i) {
342− var c = x.am(i,x[i],r,2*i,0,1);
343− if((r[i+x.t]+=x.am(i+1,2*x[i],r,2*i+1,c,x.t-i-1)) >= x.DV) {
344− r[i+x.t] -= x.DV;
345− r[i+x.t+1] = 1;
346− }
347− }
348− if(r.t > 0) r[r.t-1] += x.am(i,x[i],r,2*i,0,1);
349− r.s = 0;
350− r.clamp();
351−}
352−
353−// (protected) divide this by m, quotient and remainder to q, r (HAC 14.20)
354−// r != q, this != m. q or r may be null.
355−function bnpDivRemTo(m,q,r) {
356− var pm = m.abs();
357− if(pm.t <= 0) return;
358− var pt = this.abs();
359− if(pt.t < pm.t) {
360− if(q != null) q.fromInt(0);
361− if(r != null) this.copyTo(r);
362− return;
363− }
364− if(r == null) r = nbi();
365− var y = nbi(), ts = this.s, ms = m.s;
366− var nsh = this.DB-nbits(pm[pm.t-1]); // normalize modulus
367− if(nsh > 0) { pm.lShiftTo(nsh,y); pt.lShiftTo(nsh,r); }
368− else { pm.copyTo(y); pt.copyTo(r); }
369− var ys = y.t;
370− var y0 = y[ys-1];
371− if(y0 == 0) return;
372− var yt = y0*(1<<this.F1)+((ys>1)?y[ys-2]>>this.F2:0);
373− var d1 = this.FV/yt, d2 = (1<<this.F1)/yt, e = 1<<this.F2;
374− var i = r.t, j = i-ys, t = (q==null)?nbi():q;
375− y.dlShiftTo(j,t);
376− if(r.compareTo(t) >= 0) {
377− r[r.t++] = 1;
378− r.subTo(t,r);
379− }
380− BigInteger.ONE.dlShiftTo(ys,t);
381− t.subTo(y,y); // "negative" y so we can replace sub with am later
382− while(y.t < ys) y[y.t++] = 0;
383− while(--j >= 0) {
384− // Estimate quotient digit
385− var qd = (r[--i]==y0)?this.DM:Math.floor(r[i]*d1+(r[i-1]+e)*d2);
386− if((r[i]+=y.am(0,qd,r,j,0,ys)) < qd) { // Try it out
349+ if(r.t > 0) r[r.t-1] += x.am(i,x[i],r,2*i,0,1);
350+ r.s = 0;
351+ r.clamp();
352+ }
353+
354+ // (protected) divide this by m, quotient and remainder to q, r (HAC 14.20)
355+ // r != q, this != m. q or r may be null.
356+ function bnpDivRemTo(m,q,r) {
357+ var pm = m.abs();
358+ if(pm.t <= 0) return;
359+ var pt = this.abs();
360+ if(pt.t < pm.t) {
361+ if(q != null) q.fromInt(0);
362+ if(r != null) this.copyTo(r);
363+ return;
364+ }
365+ if(r == null) r = nbi();
366+ var y = nbi(), ts = this.s, ms = m.s;
367+ var nsh = this.DB-nbits(pm[pm.t-1]); // normalize modulus
368+ if(nsh > 0) { pm.lShiftTo(nsh,y); pt.lShiftTo(nsh,r); }
369+ else { pm.copyTo(y); pt.copyTo(r); }
370+ var ys = y.t;
371+ var y0 = y[ys-1];
372+ if(y0 == 0) return;
373+ var yt = y0*(1<<this.F1)+((ys>1)?y[ys-2]>>this.F2:0);
374+ var d1 = this.FV/yt, d2 = (1<<this.F1)/yt, e = 1<<this.F2;
375+ var i = r.t, j = i-ys, t = (q==null)?nbi():q;
387376 y.dlShiftTo(j,t);
388− r.subTo(t,r);
389− while(r[i] < --qd) r.subTo(t,r);
390− }
391− }
392− if(q != null) {
393− r.drShiftTo(ys,q);
394− if(ts != ms) BigInteger.ZERO.subTo(q,q);
395− }
396− r.t = ys;
397− r.clamp();
398− if(nsh > 0) r.rShiftTo(nsh,r); // Denormalize remainder
399− if(ts < 0) BigInteger.ZERO.subTo(r,r);
400−}
401−
402−// (public) this mod a
403−function bnMod(a) {
404− var r = nbi();
405− this.abs().divRemTo(a,null,r);
406− if(this.s < 0 && r.compareTo(BigInteger.ZERO) > 0) a.subTo(r,r);
407− return r;
408−}
409−
410−// Modular reduction using "classic" algorithm
411−function Classic(m) { this.m = m; }
412−function cConvert(x) {
413− if(x.s < 0 || x.compareTo(this.m) >= 0) return x.mod(this.m);
414− else return x;
415−}
416−function cRevert(x) { return x; }
417−function cReduce(x) { x.divRemTo(this.m,null,x); }
418−function cMulTo(x,y,r) { x.multiplyTo(y,r); this.reduce(r); }
419−function cSqrTo(x,r) { x.squareTo(r); this.reduce(r); }
420−
421−Classic.prototype.convert = cConvert;
422−Classic.prototype.revert = cRevert;
423−Classic.prototype.reduce = cReduce;
424−Classic.prototype.mulTo = cMulTo;
425−Classic.prototype.sqrTo = cSqrTo;
426−
427−// (protected) return "-1/this % 2^DB"; useful for Mont. reduction
428−// justification:
429−// xy == 1 (mod m)
430−// xy = 1+km
431−// xy(2-xy) = (1+km)(1-km)
432−// x[y(2-xy)] = 1-k^2m^2
433−// x[y(2-xy)] == 1 (mod m^2)
434−// if y is 1/x mod m, then y(2-xy) is 1/x mod m^2
435−// should reduce x and y(2-xy) by m^2 at each step to keep size bounded.
436−// JS multiply "overflows" differently from C/C++, so care is needed here.
437−function bnpInvDigit() {
438− if(this.t < 1) return 0;
439− var x = this[0];
440− if((x&1) == 0) return 0;
441− var y = x&3; // y == 1/x mod 2^2
442− y = (y*(2-(x&0xf)*y))&0xf; // y == 1/x mod 2^4
443− y = (y*(2-(x&0xff)*y))&0xff; // y == 1/x mod 2^8
444− y = (y*(2-(((x&0xffff)*y)&0xffff)))&0xffff; // y == 1/x mod 2^16
445− // last step - calculate inverse mod DV directly;
446− // assumes 16 < DB <= 32 and assumes ability to handle 48-bit ints
447− y = (y*(2-x*y%this.DV))%this.DV; // y == 1/x mod 2^dbits
448− // we really want the negative inverse, and -DV < y < DV
449− return (y>0)?this.DV-y:-y;
450−}
451−
452−// Montgomery reduction
453−function Montgomery(m) {
454− this.m = m;
455− this.mp = m.invDigit();
456− this.mpl = this.mp&0x7fff;
457− this.mph = this.mp>>15;
458− this.um = (1<<(m.DB-15))-1;
459− this.mt2 = 2*m.t;
460−}
461−
462−// xR mod m
463−function montConvert(x) {
464− var r = nbi();
465− x.abs().dlShiftTo(this.m.t,r);
466− r.divRemTo(this.m,null,r);
467− if(x.s < 0 && r.compareTo(BigInteger.ZERO) > 0) this.m.subTo(r,r);
468− return r;
469−}
470−
471−// x/R mod m
472−function montRevert(x) {
473− var r = nbi();
474− x.copyTo(r);
475− this.reduce(r);
476− return r;
477−}
478−
479−// x = x/R mod m (HAC 14.32)
480−function montReduce(x) {
481− while(x.t <= this.mt2) // pad x so am has enough room later
482− x[x.t++] = 0;
483− for(var i = 0; i < this.m.t; ++i) {
484− // faster way of calculating u0 = x[i]*mp mod DV
485− var j = x[i]&0x7fff;
486− var u0 = (j*this.mpl+(((j*this.mph+(x[i]>>15)*this.mpl)&this.um)<<15))&x.DM;
487− // use am to combine the multiply-shift-add into one call
488− j = i+this.m.t;
489− x[j] += this.m.am(0,u0,x,i,0,this.m.t);
490− // propagate carry
491− while(x[j] >= x.DV) { x[j] -= x.DV; x[++j]++; }
492− }
493− x.clamp();
494− x.drShiftTo(this.m.t,x);
495− if(x.compareTo(this.m) >= 0) x.subTo(this.m,x);
496−}
497−
498−// r = "x^2/R mod m"; x != r
499−function montSqrTo(x,r) { x.squareTo(r); this.reduce(r); }
500−
501−// r = "xy/R mod m"; x,y != r
502−function montMulTo(x,y,r) { x.multiplyTo(y,r); this.reduce(r); }
503−
504−Montgomery.prototype.convert = montConvert;
505−Montgomery.prototype.revert = montRevert;
506−Montgomery.prototype.reduce = montReduce;
507−Montgomery.prototype.mulTo = montMulTo;
508−Montgomery.prototype.sqrTo = montSqrTo;
509−
510−// (protected) true iff this is even
511−function bnpIsEven() { return ((this.t>0)?(this[0]&1):this.s) == 0; }
512−
513−// (protected) this^e, e < 2^32, doing sqr and mul with "r" (HAC 14.79)
514−function bnpExp(e,z) {
515− if(e > 0xffffffff || e < 1) return BigInteger.ONE;
516− var r = nbi(), r2 = nbi(), g = z.convert(this), i = nbits(e)-1;
517− g.copyTo(r);
518− while(--i >= 0) {
519− z.sqrTo(r,r2);
520− if((e&(1<<i)) > 0) z.mulTo(r2,g,r);
521− else { var t = r; r = r2; r2 = t; }
522− }
523− return z.revert(r);
524−}
525−
526−// (public) this^e % m, 0 <= e < 2^32
527−function bnModPowInt(e,m) {
528− var z;
529− if(e < 256 || m.isEven()) z = new Classic(m); else z = new Montgomery(m);
530− return this.exp(e,z);
531−}
532−
533−// protected
534−BigInteger.prototype.copyTo = bnpCopyTo;
535−BigInteger.prototype.fromInt = bnpFromInt;
536−BigInteger.prototype.fromString = bnpFromString;
537−BigInteger.prototype.clamp = bnpClamp;
538−BigInteger.prototype.dlShiftTo = bnpDLShiftTo;
539−BigInteger.prototype.drShiftTo = bnpDRShiftTo;
540−BigInteger.prototype.lShiftTo = bnpLShiftTo;
541−BigInteger.prototype.rShiftTo = bnpRShiftTo;
542−BigInteger.prototype.subTo = bnpSubTo;
543−BigInteger.prototype.multiplyTo = bnpMultiplyTo;
544−BigInteger.prototype.squareTo = bnpSquareTo;
545−BigInteger.prototype.divRemTo = bnpDivRemTo;
546−BigInteger.prototype.invDigit = bnpInvDigit;
547−BigInteger.prototype.isEven = bnpIsEven;
548−BigInteger.prototype.exp = bnpExp;
549−
550−// public
551−BigInteger.prototype.toString = bnToString;
552−BigInteger.prototype.negate = bnNegate;
553−BigInteger.prototype.abs = bnAbs;
554−BigInteger.prototype.compareTo = bnCompareTo;
555−BigInteger.prototype.bitLength = bnBitLength;
556−BigInteger.prototype.mod = bnMod;
557−BigInteger.prototype.modPowInt = bnModPowInt;
558−
559−// "constants"
560−BigInteger.ZERO = nbv(0);
561−BigInteger.ONE = nbv(1);
562−
563−// Copyright (c) 2005-2009 Tom Wu
564−// All Rights Reserved.
565−// See "LICENSE" for details.
566−
567−// Extended JavaScript BN functions, required for RSA private ops.
568−
569−// Version 1.1: new BigInteger("0", 10) returns "proper" zero
570−// Version 1.2: square() API, isProbablePrime fix
571−
572−// (public)
573−function bnClone() { var r = nbi(); this.copyTo(r); return r; }
574−
575−// (public) return value as integer
576−function bnIntValue() {
577− if(this.s < 0) {
578− if(this.t == 1) return this[0]-this.DV;
579− else if(this.t == 0) return -1;
580− }
581− else if(this.t == 1) return this[0];
582− else if(this.t == 0) return 0;
583− // assumes 16 < DB < 32
584− return ((this[1]&((1<<(32-this.DB))-1))<<this.DB)|this[0];
585−}
586−
587−// (public) return value as byte
588−function bnByteValue() { return (this.t==0)?this.s:(this[0]<<24)>>24; }
589−
590−// (public) return value as short (assumes DB>=16)
591−function bnShortValue() { return (this.t==0)?this.s:(this[0]<<16)>>16; }
592−
593−// (protected) return x s.t. r^x < DV
594−function bnpChunkSize(r) { return Math.floor(Math.LN2*this.DB/Math.log(r)); }
595−
596−// (public) 0 if this == 0, 1 if this > 0
597−function bnSigNum() {
598− if(this.s < 0) return -1;
599− else if(this.t <= 0 || (this.t == 1 && this[0] <= 0)) return 0;
600− else return 1;
601−}
602−
603−// (protected) convert to radix string
604−function bnpToRadix(b) {
605− if(b == null) b = 10;
606− if(this.signum() == 0 || b < 2 || b > 36) return "0";
607− var cs = this.chunkSize(b);
608− var a = Math.pow(b,cs);
609− var d = nbv(a), y = nbi(), z = nbi(), r = "";
610− this.divRemTo(d,y,z);
611− while(y.signum() > 0) {
612− r = (a+z.intValue()).toString(b).substr(1) + r;
613− y.divRemTo(d,y,z);
614− }
615− return z.intValue().toString(b) + r;
616−}
617−
618−// (protected) convert from radix string
619−function bnpFromRadix(s,b) {
620− this.fromInt(0);
621− if(b == null) b = 10;
622− var cs = this.chunkSize(b);
623− var d = Math.pow(b,cs), mi = false, j = 0, w = 0;
624− for(var i = 0; i < s.length; ++i) {
625− var x = intAt(s,i);
626− if(x < 0) {
627− if(s.charAt(i) == "-" && this.signum() == 0) mi = true;
628− continue;
629− }
630− w = b*w+x;
631− if(++j >= cs) {
632− this.dMultiply(d);
633− this.dAddOffset(w,0);
634− j = 0;
635− w = 0;
636− }
637− }
638− if(j > 0) {
639− this.dMultiply(Math.pow(b,j));
640− this.dAddOffset(w,0);
641− }
642− if(mi) BigInteger.ZERO.subTo(this,this);
643−}
644−
645−// (protected) alternate constructor
646−function bnpFromNumber(a,b,c) {
647− if("number" == typeof b) {
648− // new BigInteger(int,int,RNG)
649− if(a < 2) this.fromInt(1);
650− else {
651− this.fromNumber(a,c);
652− if(!this.testBit(a-1)) // force MSB set
653− this.bitwiseTo(BigInteger.ONE.shiftLeft(a-1),op_or,this);
654− if(this.isEven()) this.dAddOffset(1,0); // force odd
655− while(!this.isProbablePrime(b)) {
656− this.dAddOffset(2,0);
657− if(this.bitLength() > a) this.subTo(BigInteger.ONE.shiftLeft(a-1),this);
377+ if(r.compareTo(t) >= 0) {
378+ r[r.t++] = 1;
379+ r.subTo(t,r);
380+ }
381+ BigInteger.ONE.dlShiftTo(ys,t);
382+ t.subTo(y,y); // "negative" y so we can replace sub with am later
383+ while(y.t < ys) y[y.t++] = 0;
384+ while(--j >= 0) {
385+ // Estimate quotient digit
386+ var qd = (r[--i]==y0)?this.DM:Math.floor(r[i]*d1+(r[i-1]+e)*d2);
387+ if((r[i]+=y.am(0,qd,r,j,0,ys)) < qd) { // Try it out
388+ y.dlShiftTo(j,t);
389+ r.subTo(t,r);
390+ while(r[i] < --qd) r.subTo(t,r);
391+ }
392+ }
393+ if(q != null) {
394+ r.drShiftTo(ys,q);
395+ if(ts != ms) BigInteger.ZERO.subTo(q,q);
396+ }
397+ r.t = ys;
398+ r.clamp();
399+ if(nsh > 0) r.rShiftTo(nsh,r); // Denormalize remainder
400+ if(ts < 0) BigInteger.ZERO.subTo(r,r);
401+ }
402+
403+ // (public) this mod a
404+ function bnMod(a) {
405+ var r = nbi();
406+ this.abs().divRemTo(a,null,r);
407+ if(this.s < 0 && r.compareTo(BigInteger.ZERO) > 0) a.subTo(r,r);
408+ return r;
409+ }
410+
411+ // Modular reduction using "classic" algorithm
412+ function Classic(m) { this.m = m; }
413+ function cConvert(x) {
414+ if(x.s < 0 || x.compareTo(this.m) >= 0) return x.mod(this.m);
415+ else return x;
416+ }
417+ function cRevert(x) { return x; }
418+ function cReduce(x) { x.divRemTo(this.m,null,x); }
419+ function cMulTo(x,y,r) { x.multiplyTo(y,r); this.reduce(r); }
420+ function cSqrTo(x,r) { x.squareTo(r); this.reduce(r); }
421+
422+ Classic.prototype.convert = cConvert;
423+ Classic.prototype.revert = cRevert;
424+ Classic.prototype.reduce = cReduce;
425+ Classic.prototype.mulTo = cMulTo;
426+ Classic.prototype.sqrTo = cSqrTo;
427+
428+ // (protected) return "-1/this % 2^DB"; useful for Mont. reduction
429+ // justification:
430+ // xy == 1 (mod m)
431+ // xy = 1+km
432+ // xy(2-xy) = (1+km)(1-km)
433+ // x[y(2-xy)] = 1-k^2m^2
434+ // x[y(2-xy)] == 1 (mod m^2)
435+ // if y is 1/x mod m, then y(2-xy) is 1/x mod m^2
436+ // should reduce x and y(2-xy) by m^2 at each step to keep size bounded.
437+ // JS multiply "overflows" differently from C/C++, so care is needed here.
438+ function bnpInvDigit() {
439+ if(this.t < 1) return 0;
440+ var x = this[0];
441+ if((x&1) == 0) return 0;
442+ var y = x&3; // y == 1/x mod 2^2
443+ y = (y*(2-(x&0xf)*y))&0xf; // y == 1/x mod 2^4
444+ y = (y*(2-(x&0xff)*y))&0xff; // y == 1/x mod 2^8
445+ y = (y*(2-(((x&0xffff)*y)&0xffff)))&0xffff; // y == 1/x mod 2^16
446+ // last step - calculate inverse mod DV directly;
447+ // assumes 16 < DB <= 32 and assumes ability to handle 48-bit ints
448+ y = (y*(2-x*y%this.DV))%this.DV; // y == 1/x mod 2^dbits
449+ // we really want the negative inverse, and -DV < y < DV
450+ return (y>0)?this.DV-y:-y;
451+ }
452+
453+ // Montgomery reduction
454+ function Montgomery(m) {
455+ this.m = m;
456+ this.mp = m.invDigit();
457+ this.mpl = this.mp&0x7fff;
458+ this.mph = this.mp>>15;
459+ this.um = (1<<(m.DB-15))-1;
460+ this.mt2 = 2*m.t;
461+ }
462+
463+ // xR mod m
464+ function montConvert(x) {
465+ var r = nbi();
466+ x.abs().dlShiftTo(this.m.t,r);
467+ r.divRemTo(this.m,null,r);
468+ if(x.s < 0 && r.compareTo(BigInteger.ZERO) > 0) this.m.subTo(r,r);
469+ return r;
470+ }
471+
472+ // x/R mod m
473+ function montRevert(x) {
474+ var r = nbi();
475+ x.copyTo(r);
476+ this.reduce(r);
477+ return r;
478+ }
479+
480+ // x = x/R mod m (HAC 14.32)
481+ function montReduce(x) {
482+ while(x.t <= this.mt2) // pad x so am has enough room later
483+ x[x.t++] = 0;
484+ for(var i = 0; i < this.m.t; ++i) {
485+ // faster way of calculating u0 = x[i]*mp mod DV
486+ var j = x[i]&0x7fff;
487+ var u0 = (j*this.mpl+(((j*this.mph+(x[i]>>15)*this.mpl)&this.um)<<15))&x.DM;
488+ // use am to combine the multiply-shift-add into one call
489+ j = i+this.m.t;
490+ x[j] += this.m.am(0,u0,x,i,0,this.m.t);
491+ // propagate carry
492+ while(x[j] >= x.DV) { x[j] -= x.DV; x[++j]++; }
658493 }
494+ x.clamp();
495+ x.drShiftTo(this.m.t,x);
496+ if(x.compareTo(this.m) >= 0) x.subTo(this.m,x);
659497 }
660− }
661− else {
662− // new BigInteger(int,RNG)
663− var x = new Array(), t = a&7;
664− x.length = (a>>3)+1;
665− b.nextBytes(x);
666− if(t > 0) x[0] &= ((1<<t)-1); else x[0] = 0;
667− this.fromString(x,256);
668− }
669−}
670−
671−// (public) convert to bigendian byte array
672−function bnToByteArray() {
673− var i = this.t, r = new Array();
674− r[0] = this.s;
675− var p = this.DB-(i*this.DB)%8, d, k = 0;
676− if(i-- > 0) {
677− if(p < this.DB && (d = this[i]>>p) != (this.s&this.DM)>>p)
678− r[k++] = d|(this.s<<(this.DB-p));
679− while(i >= 0) {
680− if(p < 8) {
681− d = (this[i]&((1<<p)-1))<<(8-p);
682− d |= this[--i]>>(p+=this.DB-8);
498+
499+ // r = "x^2/R mod m"; x != r
500+ function montSqrTo(x,r) { x.squareTo(r); this.reduce(r); }
501+
502+ // r = "xy/R mod m"; x,y != r
503+ function montMulTo(x,y,r) { x.multiplyTo(y,r); this.reduce(r); }
504+
505+ Montgomery.prototype.convert = montConvert;
506+ Montgomery.prototype.revert = montRevert;
507+ Montgomery.prototype.reduce = montReduce;
508+ Montgomery.prototype.mulTo = montMulTo;
509+ Montgomery.prototype.sqrTo = montSqrTo;
510+
511+ // (protected) true iff this is even
512+ function bnpIsEven() { return ((this.t>0)?(this[0]&1):this.s) == 0; }
513+
514+ // (protected) this^e, e < 2^32, doing sqr and mul with "r" (HAC 14.79)
515+ function bnpExp(e,z) {
516+ if(e > 0xffffffff || e < 1) return BigInteger.ONE;
517+ var r = nbi(), r2 = nbi(), g = z.convert(this), i = nbits(e)-1;
518+ g.copyTo(r);
519+ while(--i >= 0) {
520+ z.sqrTo(r,r2);
521+ if((e&(1<<i)) > 0) z.mulTo(r2,g,r);
522+ else { var t = r; r = r2; r2 = t; }
523+ }
524+ return z.revert(r);
525+ }
526+
527+ // (public) this^e % m, 0 <= e < 2^32
528+ function bnModPowInt(e,m) {
529+ var z;
530+ if(e < 256 || m.isEven()) z = new Classic(m); else z = new Montgomery(m);
531+ return this.exp(e,z);
532+ }
533+
534+ // protected
535+ BigInteger.prototype.copyTo = bnpCopyTo;
536+ BigInteger.prototype.fromInt = bnpFromInt;
537+ BigInteger.prototype.fromString = bnpFromString;
538+ BigInteger.prototype.clamp = bnpClamp;
539+ BigInteger.prototype.dlShiftTo = bnpDLShiftTo;
540+ BigInteger.prototype.drShiftTo = bnpDRShiftTo;
541+ BigInteger.prototype.lShiftTo = bnpLShiftTo;
542+ BigInteger.prototype.rShiftTo = bnpRShiftTo;
543+ BigInteger.prototype.subTo = bnpSubTo;
544+ BigInteger.prototype.multiplyTo = bnpMultiplyTo;
545+ BigInteger.prototype.squareTo = bnpSquareTo;
546+ BigInteger.prototype.divRemTo = bnpDivRemTo;
547+ BigInteger.prototype.invDigit = bnpInvDigit;
548+ BigInteger.prototype.isEven = bnpIsEven;
549+ BigInteger.prototype.exp = bnpExp;
550+
551+ // public
552+ BigInteger.prototype.toString = bnToString;
553+ BigInteger.prototype.negate = bnNegate;
554+ BigInteger.prototype.abs = bnAbs;
555+ BigInteger.prototype.compareTo = bnCompareTo;
556+ BigInteger.prototype.bitLength = bnBitLength;
557+ BigInteger.prototype.mod = bnMod;
558+ BigInteger.prototype.modPowInt = bnModPowInt;
559+
560+ // "constants"
561+ BigInteger.ZERO = nbv(0);
562+ BigInteger.ONE = nbv(1);
563+
564+ // Copyright (c) 2005-2009 Tom Wu
565+ // All Rights Reserved.
566+ // See "LICENSE" for details.
567+
568+ // Extended JavaScript BN functions, required for RSA private ops.
569+
570+ // Version 1.1: new BigInteger("0", 10) returns "proper" zero
571+ // Version 1.2: square() API, isProbablePrime fix
572+
573+ // (public)
574+ function bnClone() { var r = nbi(); this.copyTo(r); return r; }
575+
576+ // (public) return value as integer
577+ function bnIntValue() {
578+ if(this.s < 0) {
579+ if(this.t == 1) return this[0]-this.DV;
580+ else if(this.t == 0) return -1;
581+ }
582+ else if(this.t == 1) return this[0];
583+ else if(this.t == 0) return 0;
584+ // assumes 16 < DB < 32
585+ return ((this[1]&((1<<(32-this.DB))-1))<<this.DB)|this[0];
586+ }
587+
588+ // (public) return value as byte
589+ function bnByteValue() { return (this.t==0)?this.s:(this[0]<<24)>>24; }
590+
591+ // (public) return value as short (assumes DB>=16)
592+ function bnShortValue() { return (this.t==0)?this.s:(this[0]<<16)>>16; }
593+
594+ // (protected) return x s.t. r^x < DV
595+ function bnpChunkSize(r) { return Math.floor(Math.LN2*this.DB/Math.log(r)); }
596+
597+ // (public) 0 if this == 0, 1 if this > 0
598+ function bnSigNum() {
599+ if(this.s < 0) return -1;
600+ else if(this.t <= 0 || (this.t == 1 && this[0] <= 0)) return 0;
601+ else return 1;
602+ }
603+
604+ // (protected) convert to radix string
605+ function bnpToRadix(b) {
606+ if(b == null) b = 10;
607+ if(this.signum() == 0 || b < 2 || b > 36) return "0";
608+ var cs = this.chunkSize(b);
609+ var a = Math.pow(b,cs);
610+ var d = nbv(a), y = nbi(), z = nbi(), r = "";
611+ this.divRemTo(d,y,z);
612+ while(y.signum() > 0) {
613+ r = (a+z.intValue()).toString(b).substr(1) + r;
614+ y.divRemTo(d,y,z);
615+ }
616+ return z.intValue().toString(b) + r;
617+ }
618+
619+ // (protected) convert from radix string
620+ function bnpFromRadix(s,b) {
621+ this.fromInt(0);
622+ if(b == null) b = 10;
623+ var cs = this.chunkSize(b);
624+ var d = Math.pow(b,cs), mi = false, j = 0, w = 0;
625+ for(var i = 0; i < s.length; ++i) {
626+ var x = intAt(s,i);
627+ if(x < 0) {
628+ if(s.charAt(i) == "-" && this.signum() == 0) mi = true;
629+ continue;
630+ }
631+ w = b*w+x;
632+ if(++j >= cs) {
633+ this.dMultiply(d);
634+ this.dAddOffset(w,0);
635+ j = 0;
636+ w = 0;
637+ }
638+ }
639+ if(j > 0) {
640+ this.dMultiply(Math.pow(b,j));
641+ this.dAddOffset(w,0);
642+ }
643+ if(mi) BigInteger.ZERO.subTo(this,this);
644+ }
645+
646+ // (protected) alternate constructor
647+ function bnpFromNumber(a,b,c) {
648+ if("number" == typeof b) {
649+ // new BigInteger(int,int,RNG)
650+ if(a < 2) this.fromInt(1);
651+ else {
652+ this.fromNumber(a,c);
653+ if(!this.testBit(a-1)) // force MSB set
654+ this.bitwiseTo(BigInteger.ONE.shiftLeft(a-1),op_or,this);
655+ if(this.isEven()) this.dAddOffset(1,0); // force odd
656+ while(!this.isProbablePrime(b)) {
657+ this.dAddOffset(2,0);
658+ if(this.bitLength() > a) this.subTo(BigInteger.ONE.shiftLeft(a-1),this);
659+ }
660+ }
683661 }
684662 else {
685− d = (this[i]>>(p-=8))&0xff;
686− if(p <= 0) { p += this.DB; --i; }
663+ // new BigInteger(int,RNG)
664+ var x = new Array(), t = a&7;
665+ x.length = (a>>3)+1;
666+ b.nextBytes(x);
667+ if(t > 0) x[0] &= ((1<<t)-1); else x[0] = 0;
668+ this.fromString(x,256);
687669 }
688− if((d&0x80) != 0) d |= -256;
689− if(k == 0 && (this.s&0x80) != (d&0x80)) ++k;
690− if(k > 0 || d != this.s) r[k++] = d;
691− }
692− }
693− return r;
694−}
695−
696−function bnEquals(a) { return(this.compareTo(a)==0); }
697−function bnMin(a) { return(this.compareTo(a)<0)?this:a; }
698−function bnMax(a) { return(this.compareTo(a)>0)?this:a; }
699−
700−// (protected) r = this op a (bitwise)
701−function bnpBitwiseTo(a,op,r) {
702− var i, f, m = Math.min(a.t,this.t);
703− for(i = 0; i < m; ++i) r[i] = op(this[i],a[i]);
704− if(a.t < this.t) {
705− f = a.s&this.DM;
706− for(i = m; i < this.t; ++i) r[i] = op(this[i],f);
707− r.t = this.t;
708− }
709− else {
710− f = this.s&this.DM;
711− for(i = m; i < a.t; ++i) r[i] = op(f,a[i]);
712− r.t = a.t;
713− }
714− r.s = op(this.s,a.s);
715− r.clamp();
716−}
717−
718−// (public) this & a
719−function op_and(x,y) { return x&y; }
720−function bnAnd(a) { var r = nbi(); this.bitwiseTo(a,op_and,r); return r; }
721−
722−// (public) this | a
723−function op_or(x,y) { return x|y; }
724−function bnOr(a) { var r = nbi(); this.bitwiseTo(a,op_or,r); return r; }
725−
726−// (public) this ^ a
727−function op_xor(x,y) { return x^y; }
728−function bnXor(a) { var r = nbi(); this.bitwiseTo(a,op_xor,r); return r; }
729−
730−// (public) this & ~a
731−function op_andnot(x,y) { return x&~y; }
732−function bnAndNot(a) { var r = nbi(); this.bitwiseTo(a,op_andnot,r); return r; }
733−
734−// (public) ~this
735−function bnNot() {
736− var r = nbi();
737− for(var i = 0; i < this.t; ++i) r[i] = this.DM&~this[i];
738− r.t = this.t;
739− r.s = ~this.s;
740− return r;
741−}
742−
743−// (public) this << n
744−function bnShiftLeft(n) {
745− var r = nbi();
746− if(n < 0) this.rShiftTo(-n,r); else this.lShiftTo(n,r);
747− return r;
748−}
749−
750−// (public) this >> n
751−function bnShiftRight(n) {
752− var r = nbi();
753− if(n < 0) this.lShiftTo(-n,r); else this.rShiftTo(n,r);
754− return r;
755−}
756−
757−// return index of lowest 1-bit in x, x < 2^31
758−function lbit(x) {
759− if(x == 0) return -1;
760− var r = 0;
761− if((x&0xffff) == 0) { x >>= 16; r += 16; }
762− if((x&0xff) == 0) { x >>= 8; r += 8; }
763− if((x&0xf) == 0) { x >>= 4; r += 4; }
764− if((x&3) == 0) { x >>= 2; r += 2; }
765− if((x&1) == 0) ++r;
766− return r;
767−}
768−
769−// (public) returns index of lowest 1-bit (or -1 if none)
770−function bnGetLowestSetBit() {
771− for(var i = 0; i < this.t; ++i)
772− if(this[i] != 0) return i*this.DB+lbit(this[i]);
773− if(this.s < 0) return this.t*this.DB;
774− return -1;
775−}
776−
777−// return number of 1 bits in x
778−function cbit(x) {
779− var r = 0;
780− while(x != 0) { x &= x-1; ++r; }
781− return r;
782−}
783−
784−// (public) return number of set bits
785−function bnBitCount() {
786− var r = 0, x = this.s&this.DM;
787− for(var i = 0; i < this.t; ++i) r += cbit(this[i]^x);
788− return r;
789−}
790−
791−// (public) true iff nth bit is set
792−function bnTestBit(n) {
793− var j = Math.floor(n/this.DB);
794− if(j >= this.t) return(this.s!=0);
795− return((this[j]&(1<<(n%this.DB)))!=0);
796−}
797−
798−// (protected) this op (1<<n)
799−function bnpChangeBit(n,op) {
800− var r = BigInteger.ONE.shiftLeft(n);
801− this.bitwiseTo(r,op,r);
802− return r;
803−}
804−
805−// (public) this | (1<<n)
806−function bnSetBit(n) { return this.changeBit(n,op_or); }
807−
808−// (public) this & ~(1<<n)
809−function bnClearBit(n) { return this.changeBit(n,op_andnot); }
810−
811−// (public) this ^ (1<<n)
812−function bnFlipBit(n) { return this.changeBit(n,op_xor); }
813−
814−// (protected) r = this + a
815−function bnpAddTo(a,r) {
816− var i = 0, c = 0, m = Math.min(a.t,this.t);
817− while(i < m) {
818− c += this[i]+a[i];
819− r[i++] = c&this.DM;
820− c >>= this.DB;
821− }
822− if(a.t < this.t) {
823− c += a.s;
824− while(i < this.t) {
825− c += this[i];
826− r[i++] = c&this.DM;
827− c >>= this.DB;
828− }
829− c += this.s;
830− }
831− else {
832− c += this.s;
833− while(i < a.t) {
834− c += a[i];
835− r[i++] = c&this.DM;
836− c >>= this.DB;
837− }
838− c += a.s;
839− }
840− r.s = (c<0)?-1:0;
841− if(c > 0) r[i++] = c;
842− else if(c < -1) r[i++] = this.DV+c;
843− r.t = i;
844− r.clamp();
845−}
846−
847−// (public) this + a
848−function bnAdd(a) { var r = nbi(); this.addTo(a,r); return r; }
849−
850−// (public) this - a
851−function bnSubtract(a) { var r = nbi(); this.subTo(a,r); return r; }
852−
853−// (public) this * a
854−function bnMultiply(a) { var r = nbi(); this.multiplyTo(a,r); return r; }
855−
856−// (public) this^2
857−function bnSquare() { var r = nbi(); this.squareTo(r); return r; }
858−
859−// (public) this / a
860−function bnDivide(a) { var r = nbi(); this.divRemTo(a,r,null); return r; }
861−
862−// (public) this % a
863−function bnRemainder(a) { var r = nbi(); this.divRemTo(a,null,r); return r; }
864−
865−// (public) [this/a,this%a]
866−function bnDivideAndRemainder(a) {
867− var q = nbi(), r = nbi();
868− this.divRemTo(a,q,r);
869− return new Array(q,r);
870−}
871−
872−// (protected) this *= n, this >= 0, 1 < n < DV
873−function bnpDMultiply(n) {
874− this[this.t] = this.am(0,n-1,this,0,0,this.t);
875− ++this.t;
876− this.clamp();
877−}
878−
879−// (protected) this += n << w words, this >= 0
880−function bnpDAddOffset(n,w) {
881− if(n == 0) return;
882− while(this.t <= w) this[this.t++] = 0;
883− this[w] += n;
884− while(this[w] >= this.DV) {
885− this[w] -= this.DV;
886− if(++w >= this.t) this[this.t++] = 0;
887− ++this[w];
888− }
889−}
890−
891−// A "null" reducer
892−function NullExp() {}
893−function nNop(x) { return x; }
894−function nMulTo(x,y,r) { x.multiplyTo(y,r); }
895−function nSqrTo(x,r) { x.squareTo(r); }
896−
897−NullExp.prototype.convert = nNop;
898−NullExp.prototype.revert = nNop;
899−NullExp.prototype.mulTo = nMulTo;
900−NullExp.prototype.sqrTo = nSqrTo;
901−
902−// (public) this^e
903−function bnPow(e) { return this.exp(e,new NullExp()); }
904−
905−// (protected) r = lower n words of "this * a", a.t <= n
906−// "this" should be the larger one if appropriate.
907−function bnpMultiplyLowerTo(a,n,r) {
908− var i = Math.min(this.t+a.t,n);
909− r.s = 0; // assumes a,this >= 0
910− r.t = i;
911− while(i > 0) r[--i] = 0;
912− var j;
913− for(j = r.t-this.t; i < j; ++i) r[i+this.t] = this.am(0,a[i],r,i,0,this.t);
914− for(j = Math.min(a.t,n); i < j; ++i) this.am(0,a[i],r,i,0,n-i);
915− r.clamp();
916−}
917−
918−// (protected) r = "this * a" without lower n words, n > 0
919−// "this" should be the larger one if appropriate.
920−function bnpMultiplyUpperTo(a,n,r) {
921− --n;
922− var i = r.t = this.t+a.t-n;
923− r.s = 0; // assumes a,this >= 0
924− while(--i >= 0) r[i] = 0;
925− for(i = Math.max(n-this.t,0); i < a.t; ++i)
926− r[this.t+i-n] = this.am(n-i,a[i],r,0,0,this.t+i-n);
927− r.clamp();
928− r.drShiftTo(1,r);
929−}
930−
931−// Barrett modular reduction
932−function Barrett(m) {
933− // setup Barrett
934− this.r2 = nbi();
935− this.q3 = nbi();
936− BigInteger.ONE.dlShiftTo(2*m.t,this.r2);
937− this.mu = this.r2.divide(m);
938− this.m = m;
939−}
940−
941−function barrettConvert(x) {
942− if(x.s < 0 || x.t > 2*this.m.t) return x.mod(this.m);
943− else if(x.compareTo(this.m) < 0) return x;
944− else { var r = nbi(); x.copyTo(r); this.reduce(r); return r; }
945−}
946−
947−function barrettRevert(x) { return x; }
948−
949−// x = x mod m (HAC 14.42)
950−function barrettReduce(x) {
951− x.drShiftTo(this.m.t-1,this.r2);
952− if(x.t > this.m.t+1) { x.t = this.m.t+1; x.clamp(); }
953− this.mu.multiplyUpperTo(this.r2,this.m.t+1,this.q3);
954− this.m.multiplyLowerTo(this.q3,this.m.t+1,this.r2);
955− while(x.compareTo(this.r2) < 0) x.dAddOffset(1,this.m.t+1);
956− x.subTo(this.r2,x);
957− while(x.compareTo(this.m) >= 0) x.subTo(this.m,x);
958−}
959−
960−// r = x^2 mod m; x != r
961−function barrettSqrTo(x,r) { x.squareTo(r); this.reduce(r); }
962−
963−// r = x*y mod m; x,y != r
964−function barrettMulTo(x,y,r) { x.multiplyTo(y,r); this.reduce(r); }
965−
966−Barrett.prototype.convert = barrettConvert;
967−Barrett.prototype.revert = barrettRevert;
968−Barrett.prototype.reduce = barrettReduce;
969−Barrett.prototype.mulTo = barrettMulTo;
970−Barrett.prototype.sqrTo = barrettSqrTo;
971−
972−// (public) this^e % m (HAC 14.85)
973−function bnModPow(e,m) {
974− var i = e.bitLength(), k, r = nbv(1), z;
975− if(i <= 0) return r;
976− else if(i < 18) k = 1;
977− else if(i < 48) k = 3;
978− else if(i < 144) k = 4;
979− else if(i < 768) k = 5;
980− else k = 6;
981− if(i < 8)
982− z = new Classic(m);
983− else if(m.isEven())
984− z = new Barrett(m);
985− else
986− z = new Montgomery(m);
987−
988− // precomputation
989− var g = new Array(), n = 3, k1 = k-1, km = (1<<k)-1;
990− g[1] = z.convert(this);
991− if(k > 1) {
992− var g2 = nbi();
993− z.sqrTo(g[1],g2);
994− while(n <= km) {
995− g[n] = nbi();
996− z.mulTo(g2,g[n-2],g[n]);
997− n += 2;
998− }
999− }
1000−
1001− var j = e.t-1, w, is1 = true, r2 = nbi(), t;
1002− i = nbits(e[j])-1;
1003− while(j >= 0) {
1004− if(i >= k1) w = (e[j]>>(i-k1))&km;
1005− else {
1006− w = (e[j]&((1<<(i+1))-1))<<(k1-i);
1007− if(j > 0) w |= e[j-1]>>(this.DB+i-k1);
1008− }
1009−
1010− n = k;
1011− while((w&1) == 0) { w >>= 1; --n; }
1012− if((i -= n) < 0) { i += this.DB; --j; }
1013− if(is1) { // ret == 1, don't bother squaring or multiplying it
1014− g[w].copyTo(r);
1015− is1 = false;
1016− }
1017− else {
1018− while(n > 1) { z.sqrTo(r,r2); z.sqrTo(r2,r); n -= 2; }
1019− if(n > 0) z.sqrTo(r,r2); else { t = r; r = r2; r2 = t; }
1020− z.mulTo(r2,g[w],r);
1021− }
1022−
1023− while(j >= 0 && (e[j]&(1<<i)) == 0) {
1024− z.sqrTo(r,r2); t = r; r = r2; r2 = t;
1025− if(--i < 0) { i = this.DB-1; --j; }
1026− }
1027− }
1028− return z.revert(r);
1029−}
1030−
1031−// (public) gcd(this,a) (HAC 14.54)
1032−function bnGCD(a) {
1033− var x = (this.s<0)?this.negate():this.clone();
1034− var y = (a.s<0)?a.negate():a.clone();
1035− if(x.compareTo(y) < 0) { var t = x; x = y; y = t; }
1036− var i = x.getLowestSetBit(), g = y.getLowestSetBit();
1037− if(g < 0) return x;
1038− if(i < g) g = i;
1039− if(g > 0) {
1040− x.rShiftTo(g,x);
1041− y.rShiftTo(g,y);
1042− }
1043− while(x.signum() > 0) {
1044− if((i = x.getLowestSetBit()) > 0) x.rShiftTo(i,x);
1045− if((i = y.getLowestSetBit()) > 0) y.rShiftTo(i,y);
1046− if(x.compareTo(y) >= 0) {
1047− x.subTo(y,x);
1048− x.rShiftTo(1,x);
1049− }
1050− else {
1051− y.subTo(x,y);
1052− y.rShiftTo(1,y);
1053− }
1054− }
1055− if(g > 0) y.lShiftTo(g,y);
1056− return y;
1057−}
1058−
1059−// (protected) this % n, n < 2^26
1060−function bnpModInt(n) {
1061− if(n <= 0) return 0;
1062− var d = this.DV%n, r = (this.s<0)?n-1:0;
1063− if(this.t > 0)
1064− if(d == 0) r = this[0]%n;
1065− else for(var i = this.t-1; i >= 0; --i) r = (d*r+this[i])%n;
1066− return r;
1067−}
1068−
1069−// (public) 1/this % m (HAC 14.61)
1070−function bnModInverse(m) {
1071− var ac = m.isEven();
1072− if((this.isEven() && ac) || m.signum() == 0) return BigInteger.ZERO;
1073− var u = m.clone(), v = this.clone();
1074− var a = nbv(1), b = nbv(0), c = nbv(0), d = nbv(1);
1075− while(u.signum() != 0) {
1076− while(u.isEven()) {
1077− u.rShiftTo(1,u);
1078− if(ac) {
1079− if(!a.isEven() || !b.isEven()) { a.addTo(this,a); b.subTo(m,b); }
1080− a.rShiftTo(1,a);
670+ }
671+
672+ // (public) convert to bigendian byte array
673+ function bnToByteArray() {
674+ var i = this.t, r = new Array();
675+ r[0] = this.s;
676+ var p = this.DB-(i*this.DB)%8, d, k = 0;
677+ if(i-- > 0) {
678+ if(p < this.DB && (d = this[i]>>p) != (this.s&this.DM)>>p)
679+ r[k++] = d|(this.s<<(this.DB-p));
680+ while(i >= 0) {
681+ if(p < 8) {
682+ d = (this[i]&((1<<p)-1))<<(8-p);
683+ d |= this[--i]>>(p+=this.DB-8);
684+ }
685+ else {
686+ d = (this[i]>>(p-=8))&0xff;
687+ if(p <= 0) { p += this.DB; --i; }
688+ }
689+ if((d&0x80) != 0) d |= -256;
690+ if(k == 0 && (this.s&0x80) != (d&0x80)) ++k;
691+ if(k > 0 || d != this.s) r[k++] = d;
692+ }
1081693 }
1082− else if(!b.isEven()) b.subTo(m,b);
1083− b.rShiftTo(1,b);
1084− }
1085− while(v.isEven()) {
1086− v.rShiftTo(1,v);
1087− if(ac) {
1088− if(!c.isEven() || !d.isEven()) { c.addTo(this,c); d.subTo(m,d); }
1089− c.rShiftTo(1,c);
694+ return r;
695+ }
696+
697+ function bnEquals(a) { return(this.compareTo(a)==0); }
698+ function bnMin(a) { return(this.compareTo(a)<0)?this:a; }
699+ function bnMax(a) { return(this.compareTo(a)>0)?this:a; }
700+
701+ // (protected) r = this op a (bitwise)
702+ function bnpBitwiseTo(a,op,r) {
703+ var i, f, m = Math.min(a.t,this.t);
704+ for(i = 0; i < m; ++i) r[i] = op(this[i],a[i]);
705+ if(a.t < this.t) {
706+ f = a.s&this.DM;
707+ for(i = m; i < this.t; ++i) r[i] = op(this[i],f);
708+ r.t = this.t;
1090709 }
1091− else if(!d.isEven()) d.subTo(m,d);
1092− d.rShiftTo(1,d);
1093− }
1094− if(u.compareTo(v) >= 0) {
1095− u.subTo(v,u);
1096− if(ac) a.subTo(c,a);
1097− b.subTo(d,b);
1098− }
1099− else {
1100− v.subTo(u,v);
1101− if(ac) c.subTo(a,c);
1102− d.subTo(b,d);
1103− }
1104− }
1105− if(v.compareTo(BigInteger.ONE) != 0) return BigInteger.ZERO;
1106− if(d.compareTo(m) >= 0) return d.subtract(m);
1107− if(d.signum() < 0) d.addTo(m,d); else return d;
1108− if(d.signum() < 0) return d.add(m); else return d;
1109−}
1110−
1111−var lowprimes = [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97,101,103,107,109,113,127,131,137,139,149,151,157,163,167,173,179,181,191,193,197,199,211,223,227,229,233,239,241,251,257,263,269,271,277,281,283,293,307,311,313,317,331,337,347,349,353,359,367,373,379,383,389,397,401,409,419,421,431,433,439,443,449,457,461,463,467,479,487,491,499,503,509,521,523,541,547,557,563,569,571,577,587,593,599,601,607,613,617,619,631,641,643,647,653,659,661,673,677,683,691,701,709,719,727,733,739,743,751,757,761,769,773,787,797,809,811,821,823,827,829,839,853,857,859,863,877,881,883,887,907,911,919,929,937,941,947,953,967,971,977,983,991,997];
1112−var lplim = (1<<26)/lowprimes[lowprimes.length-1];
1113−
1114−// (public) test primality with certainty >= 1-.5^t
1115−function bnIsProbablePrime(t) {
1116− var i, x = this.abs();
1117− if(x.t == 1 && x[0] <= lowprimes[lowprimes.length-1]) {
1118− for(i = 0; i < lowprimes.length; ++i)
1119− if(x[0] == lowprimes[i]) return true;
1120− return false;
1121− }
1122− if(x.isEven()) return false;
1123− i = 1;
1124− while(i < lowprimes.length) {
1125− var m = lowprimes[i], j = i+1;
1126− while(j < lowprimes.length && m < lplim) m *= lowprimes[j++];
1127− m = x.modInt(m);
1128− while(i < j) if(m%lowprimes[i++] == 0) return false;
1129− }
1130− return x.millerRabin(t);
1131−}
1132−
1133−// (protected) true if probably prime (HAC 4.24, Miller-Rabin)
1134−function bnpMillerRabin(t) {
1135− var n1 = this.subtract(BigInteger.ONE);
1136− var k = n1.getLowestSetBit();
1137− if(k <= 0) return false;
1138− var r = n1.shiftRight(k);
1139− t = (t+1)>>1;
1140− if(t > lowprimes.length) t = lowprimes.length;
1141− var a = nbi();
1142− for(var i = 0; i < t; ++i) {
1143− //Pick bases at random, instead of starting at 2
1144− a.fromInt(lowprimes[Math.floor(Math.random()*lowprimes.length)]);
1145− var y = a.modPow(r,this);
1146− if(y.compareTo(BigInteger.ONE) != 0 && y.compareTo(n1) != 0) {
1147− var j = 1;
1148− while(j++ < k && y.compareTo(n1) != 0) {
1149− y = y.modPowInt(2,this);
1150− if(y.compareTo(BigInteger.ONE) == 0) return false;
710+ else {
711+ f = this.s&this.DM;
712+ for(i = m; i < a.t; ++i) r[i] = op(f,a[i]);
713+ r.t = a.t;
1151714 }
1152− if(y.compareTo(n1) != 0) return false;
1153− }
1154− }
1155− return true;
1156−}
1157−
1158−// protected
1159−BigInteger.prototype.chunkSize = bnpChunkSize;
1160−BigInteger.prototype.toRadix = bnpToRadix;
1161−BigInteger.prototype.fromRadix = bnpFromRadix;
1162−BigInteger.prototype.fromNumber = bnpFromNumber;
1163−BigInteger.prototype.bitwiseTo = bnpBitwiseTo;
1164−BigInteger.prototype.changeBit = bnpChangeBit;
1165−BigInteger.prototype.addTo = bnpAddTo;
1166−BigInteger.prototype.dMultiply = bnpDMultiply;
1167−BigInteger.prototype.dAddOffset = bnpDAddOffset;
1168−BigInteger.prototype.multiplyLowerTo = bnpMultiplyLowerTo;
1169−BigInteger.prototype.multiplyUpperTo = bnpMultiplyUpperTo;
1170−BigInteger.prototype.modInt = bnpModInt;
1171−BigInteger.prototype.millerRabin = bnpMillerRabin;
1172−
1173−// public
1174−BigInteger.prototype.clone = bnClone;
1175−BigInteger.prototype.intValue = bnIntValue;
1176−BigInteger.prototype.byteValue = bnByteValue;
1177−BigInteger.prototype.shortValue = bnShortValue;
1178−BigInteger.prototype.signum = bnSigNum;
1179−BigInteger.prototype.toByteArray = bnToByteArray;
1180−BigInteger.prototype.equals = bnEquals;
1181−BigInteger.prototype.min = bnMin;
1182−BigInteger.prototype.max = bnMax;
1183−BigInteger.prototype.and = bnAnd;
1184−BigInteger.prototype.or = bnOr;
1185−BigInteger.prototype.xor = bnXor;
1186−BigInteger.prototype.andNot = bnAndNot;
1187−BigInteger.prototype.not = bnNot;
1188−BigInteger.prototype.shiftLeft = bnShiftLeft;
1189−BigInteger.prototype.shiftRight = bnShiftRight;
1190−BigInteger.prototype.getLowestSetBit = bnGetLowestSetBit;
1191−BigInteger.prototype.bitCount = bnBitCount;
1192−BigInteger.prototype.testBit = bnTestBit;
1193−BigInteger.prototype.setBit = bnSetBit;
1194−BigInteger.prototype.clearBit = bnClearBit;
1195−BigInteger.prototype.flipBit = bnFlipBit;
1196−BigInteger.prototype.add = bnAdd;
1197−BigInteger.prototype.subtract = bnSubtract;
1198−BigInteger.prototype.multiply = bnMultiply;
1199−BigInteger.prototype.divide = bnDivide;
1200−BigInteger.prototype.remainder = bnRemainder;
1201−BigInteger.prototype.divideAndRemainder = bnDivideAndRemainder;
1202−BigInteger.prototype.modPow = bnModPow;
1203−BigInteger.prototype.modInverse = bnModInverse;
1204−BigInteger.prototype.pow = bnPow;
1205−BigInteger.prototype.gcd = bnGCD;
1206−BigInteger.prototype.isProbablePrime = bnIsProbablePrime;
1207−
1208−// JSBN-specific extension
1209−BigInteger.prototype.square = bnSquare;
1210−
1211−// BigInteger interfaces not implemented in jsbn:
1212−
1213−// BigInteger(int signum, byte[] magnitude)
1214−// double doubleValue()
1215−// float floatValue()
1216−// int hashCode()
1217−// long longValue()
1218−//
1219−BigInteger.prototype.lesser = function(rhs) {
1220− return this.compareTo(rhs) < 0
1221−}
1222−BigInteger.prototype.lesserOrEquals = function(rhs) {
1223− return this.compareTo(rhs) <= 0
1224−}
1225−BigInteger.prototype.greater = function(rhs) {
1226− return this.compareTo(rhs) > 0
1227−}
1228−BigInteger.prototype.greaterOrEquals = function(rhs) {
1229− return this.compareTo(rhs) >= 0
1230−}
1231−
1232−return function(val) {
1233− return new BigInteger(val);
1234−}
1235−})();
1236−
1237−var i$ZERO = i$bigInt("0");
1238−var i$ONE = i$bigInt("1");
715+ r.s = op(this.s,a.s);
716+ r.clamp();
717+ }
718+
719+ // (public) this & a
720+ function op_and(x,y) { return x&y; }
721+ function bnAnd(a) { var r = nbi(); this.bitwiseTo(a,op_and,r); return r; }
722+
723+ // (public) this | a
724+ function op_or(x,y) { return x|y; }
725+ function bnOr(a) { var r = nbi(); this.bitwiseTo(a,op_or,r); return r; }
726+
727+ // (public) this ^ a
728+ function op_xor(x,y) { return x^y; }
729+ function bnXor(a) { var r = nbi(); this.bitwiseTo(a,op_xor,r); return r; }
730+
731+ // (public) this & ~a
732+ function op_andnot(x,y) { return x&~y; }
733+ function bnAndNot(a) { var r = nbi(); this.bitwiseTo(a,op_andnot,r); return r; }
734+
735+ // (public) ~this
736+ function bnNot() {
737+ var r = nbi();
738+ for(var i = 0; i < this.t; ++i) r[i] = this.DM&~this[i];
739+ r.t = this.t;
740+ r.s = ~this.s;
741+ return r;
742+ }
743+
744+ // (public) this << n
745+ function bnShiftLeft(n) {
746+ var r = nbi();
747+ if(n < 0) this.rShiftTo(-n,r); else this.lShiftTo(n,r);
748+ return r;
749+ }
750+
751+ // (public) this >> n
752+ function bnShiftRight(n) {
753+ var r = nbi();
754+ if(n < 0) this.lShiftTo(-n,r); else this.rShiftTo(n,r);
755+ return r;
756+ }
757+
758+ // return index of lowest 1-bit in x, x < 2^31
759+ function lbit(x) {
760+ if(x == 0) return -1;
761+ var r = 0;
762+ if((x&0xffff) == 0) { x >>= 16; r += 16; }
763+ if((x&0xff) == 0) { x >>= 8; r += 8; }
764+ if((x&0xf) == 0) { x >>= 4; r += 4; }
765+ if((x&3) == 0) { x >>= 2; r += 2; }
766+ if((x&1) == 0) ++r;
767+ return r;
768+ }
769+
770+ // (public) returns index of lowest 1-bit (or -1 if none)
771+ function bnGetLowestSetBit() {
772+ for(var i = 0; i < this.t; ++i)
773+ if(this[i] != 0) return i*this.DB+lbit(this[i]);
774+ if(this.s < 0) return this.t*this.DB;
775+ return -1;
776+ }
777+
778+ // return number of 1 bits in x
779+ function cbit(x) {
780+ var r = 0;
781+ while(x != 0) { x &= x-1; ++r; }
782+ return r;
783+ }
784+
785+ // (public) return number of set bits
786+ function bnBitCount() {
787+ var r = 0, x = this.s&this.DM;
788+ for(var i = 0; i < this.t; ++i) r += cbit(this[i]^x);
789+ return r;
790+ }
791+
792+ // (public) true iff nth bit is set
793+ function bnTestBit(n) {
794+ var j = Math.floor(n/this.DB);
795+ if(j >= this.t) return(this.s!=0);
796+ return((this[j]&(1<<(n%this.DB)))!=0);
797+ }
798+
799+ // (protected) this op (1<<n)
800+ function bnpChangeBit(n,op) {
801+ var r = BigInteger.ONE.shiftLeft(n);
802+ this.bitwiseTo(r,op,r);
803+ return r;
804+ }
805+
806+ // (public) this | (1<<n)
807+ function bnSetBit(n) { return this.changeBit(n,op_or); }
808+
809+ // (public) this & ~(1<<n)
810+ function bnClearBit(n) { return this.changeBit(n,op_andnot); }
811+
812+ // (public) this ^ (1<<n)
813+ function bnFlipBit(n) { return this.changeBit(n,op_xor); }
814+
815+ // (protected) r = this + a
816+ function bnpAddTo(a,r) {
817+ var i = 0, c = 0, m = Math.min(a.t,this.t);
818+ while(i < m) {
819+ c += this[i]+a[i];
820+ r[i++] = c&this.DM;
821+ c >>= this.DB;
822+ }
823+ if(a.t < this.t) {
824+ c += a.s;
825+ while(i < this.t) {
826+ c += this[i];
827+ r[i++] = c&this.DM;
828+ c >>= this.DB;
829+ }
830+ c += this.s;
831+ }
832+ else {
833+ c += this.s;
834+ while(i < a.t) {
835+ c += a[i];
836+ r[i++] = c&this.DM;
837+ c >>= this.DB;
838+ }
839+ c += a.s;
840+ }
841+ r.s = (c<0)?-1:0;
842+ if(c > 0) r[i++] = c;
843+ else if(c < -1) r[i++] = this.DV+c;
844+ r.t = i;
845+ r.clamp();
846+ }
847+
848+ // (public) this + a
849+ function bnAdd(a) { var r = nbi(); this.addTo(a,r); return r; }
850+
851+ // (public) this - a
852+ function bnSubtract(a) { var r = nbi(); this.subTo(a,r); return r; }
853+
854+ // (public) this * a
855+ function bnMultiply(a) { var r = nbi(); this.multiplyTo(a,r); return r; }
856+
857+ // (public) this^2
858+ function bnSquare() { var r = nbi(); this.squareTo(r); return r; }
859+
860+ // (public) this / a
861+ function bnDivide(a) { var r = nbi(); this.divRemTo(a,r,null); return r; }
862+
863+ // (public) this % a
864+ function bnRemainder(a) { var r = nbi(); this.divRemTo(a,null,r); return r; }
865+
866+ // (public) [this/a,this%a]
867+ function bnDivideAndRemainder(a) {
868+ var q = nbi(), r = nbi();
869+ this.divRemTo(a,q,r);
870+ return new Array(q,r);
871+ }
872+
873+ // (protected) this *= n, this >= 0, 1 < n < DV
874+ function bnpDMultiply(n) {
875+ this[this.t] = this.am(0,n-1,this,0,0,this.t);
876+ ++this.t;
877+ this.clamp();
878+ }
879+
880+ // (protected) this += n << w words, this >= 0
881+ function bnpDAddOffset(n,w) {
882+ if(n == 0) return;
883+ while(this.t <= w) this[this.t++] = 0;
884+ this[w] += n;
885+ while(this[w] >= this.DV) {
886+ this[w] -= this.DV;
887+ if(++w >= this.t) this[this.t++] = 0;
888+ ++this[w];
889+ }
890+ }
891+
892+ // A "null" reducer
893+ function NullExp() {}
894+ function nNop(x) { return x; }
895+ function nMulTo(x,y,r) { x.multiplyTo(y,r); }
896+ function nSqrTo(x,r) { x.squareTo(r); }
897+
898+ NullExp.prototype.convert = nNop;
899+ NullExp.prototype.revert = nNop;
900+ NullExp.prototype.mulTo = nMulTo;
901+ NullExp.prototype.sqrTo = nSqrTo;
902+
903+ // (public) this^e
904+ function bnPow(e) { return this.exp(e,new NullExp()); }
905+
906+ // (protected) r = lower n words of "this * a", a.t <= n
907+ // "this" should be the larger one if appropriate.
908+ function bnpMultiplyLowerTo(a,n,r) {
909+ var i = Math.min(this.t+a.t,n);
910+ r.s = 0; // assumes a,this >= 0
911+ r.t = i;
912+ while(i > 0) r[--i] = 0;
913+ var j;
914+ for(j = r.t-this.t; i < j; ++i) r[i+this.t] = this.am(0,a[i],r,i,0,this.t);
915+ for(j = Math.min(a.t,n); i < j; ++i) this.am(0,a[i],r,i,0,n-i);
916+ r.clamp();
917+ }
918+
919+ // (protected) r = "this * a" without lower n words, n > 0
920+ // "this" should be the larger one if appropriate.
921+ function bnpMultiplyUpperTo(a,n,r) {
922+ --n;
923+ var i = r.t = this.t+a.t-n;
924+ r.s = 0; // assumes a,this >= 0
925+ while(--i >= 0) r[i] = 0;
926+ for(i = Math.max(n-this.t,0); i < a.t; ++i)
927+ r[this.t+i-n] = this.am(n-i,a[i],r,0,0,this.t+i-n);
928+ r.clamp();
929+ r.drShiftTo(1,r);
930+ }
931+
932+ // Barrett modular reduction
933+ function Barrett(m) {
934+ // setup Barrett
935+ this.r2 = nbi();
936+ this.q3 = nbi();
937+ BigInteger.ONE.dlShiftTo(2*m.t,this.r2);
938+ this.mu = this.r2.divide(m);
939+ this.m = m;
940+ }
941+
942+ function barrettConvert(x) {
943+ if(x.s < 0 || x.t > 2*this.m.t) return x.mod(this.m);
944+ else if(x.compareTo(this.m) < 0) return x;
945+ else { var r = nbi(); x.copyTo(r); this.reduce(r); return r; }
946+ }
947+
948+ function barrettRevert(x) { return x; }
949+
950+ // x = x mod m (HAC 14.42)
951+ function barrettReduce(x) {
952+ x.drShiftTo(this.m.t-1,this.r2);
953+ if(x.t > this.m.t+1) { x.t = this.m.t+1; x.clamp(); }
954+ this.mu.multiplyUpperTo(this.r2,this.m.t+1,this.q3);
955+ this.m.multiplyLowerTo(this.q3,this.m.t+1,this.r2);
956+ while(x.compareTo(this.r2) < 0) x.dAddOffset(1,this.m.t+1);
957+ x.subTo(this.r2,x);
958+ while(x.compareTo(this.m) >= 0) x.subTo(this.m,x);
959+ }
960+
961+ // r = x^2 mod m; x != r
962+ function barrettSqrTo(x,r) { x.squareTo(r); this.reduce(r); }
963+
964+ // r = x*y mod m; x,y != r
965+ function barrettMulTo(x,y,r) { x.multiplyTo(y,r); this.reduce(r); }
966+
967+ Barrett.prototype.convert = barrettConvert;
968+ Barrett.prototype.revert = barrettRevert;
969+ Barrett.prototype.reduce = barrettReduce;
970+ Barrett.prototype.mulTo = barrettMulTo;
971+ Barrett.prototype.sqrTo = barrettSqrTo;
972+
973+ // (public) this^e % m (HAC 14.85)
974+ function bnModPow(e,m) {
975+ var i = e.bitLength(), k, r = nbv(1), z;
976+ if(i <= 0) return r;
977+ else if(i < 18) k = 1;
978+ else if(i < 48) k = 3;
979+ else if(i < 144) k = 4;
980+ else if(i < 768) k = 5;
981+ else k = 6;
982+ if(i < 8)
983+ z = new Classic(m);
984+ else if(m.isEven())
985+ z = new Barrett(m);
986+ else
987+ z = new Montgomery(m);
988+
989+ // precomputation
990+ var g = new Array(), n = 3, k1 = k-1, km = (1<<k)-1;
991+ g[1] = z.convert(this);
992+ if(k > 1) {
993+ var g2 = nbi();
994+ z.sqrTo(g[1],g2);
995+ while(n <= km) {
996+ g[n] = nbi();
997+ z.mulTo(g2,g[n-2],g[n]);
998+ n += 2;
999+ }
1000+ }
1001+
1002+ var j = e.t-1, w, is1 = true, r2 = nbi(), t;
1003+ i = nbits(e[j])-1;
1004+ while(j >= 0) {
1005+ if(i >= k1) w = (e[j]>>(i-k1))&km;
1006+ else {
1007+ w = (e[j]&((1<<(i+1))-1))<<(k1-i);
1008+ if(j > 0) w |= e[j-1]>>(this.DB+i-k1);
1009+ }
1010+
1011+ n = k;
1012+ while((w&1) == 0) { w >>= 1; --n; }
1013+ if((i -= n) < 0) { i += this.DB; --j; }
1014+ if(is1) { // ret == 1, don't bother squaring or multiplying it
1015+ g[w].copyTo(r);
1016+ is1 = false;
1017+ }
1018+ else {
1019+ while(n > 1) { z.sqrTo(r,r2); z.sqrTo(r2,r); n -= 2; }
1020+ if(n > 0) z.sqrTo(r,r2); else { t = r; r = r2; r2 = t; }
1021+ z.mulTo(r2,g[w],r);
1022+ }
1023+
1024+ while(j >= 0 && (e[j]&(1<<i)) == 0) {
1025+ z.sqrTo(r,r2); t = r; r = r2; r2 = t;
1026+ if(--i < 0) { i = this.DB-1; --j; }
1027+ }
1028+ }
1029+ return z.revert(r);
1030+ }
1031+
1032+ // (public) gcd(this,a) (HAC 14.54)
1033+ function bnGCD(a) {
1034+ var x = (this.s<0)?this.negate():this.clone();
1035+ var y = (a.s<0)?a.negate():a.clone();
1036+ if(x.compareTo(y) < 0) { var t = x; x = y; y = t; }
1037+ var i = x.getLowestSetBit(), g = y.getLowestSetBit();
1038+ if(g < 0) return x;
1039+ if(i < g) g = i;
1040+ if(g > 0) {
1041+ x.rShiftTo(g,x);
1042+ y.rShiftTo(g,y);
1043+ }
1044+ while(x.signum() > 0) {
1045+ if((i = x.getLowestSetBit()) > 0) x.rShiftTo(i,x);
1046+ if((i = y.getLowestSetBit()) > 0) y.rShiftTo(i,y);
1047+ if(x.compareTo(y) >= 0) {
1048+ x.subTo(y,x);
1049+ x.rShiftTo(1,x);
1050+ }
1051+ else {
1052+ y.subTo(x,y);
1053+ y.rShiftTo(1,y);
1054+ }
1055+ }
1056+ if(g > 0) y.lShiftTo(g,y);
1057+ return y;
1058+ }
1059+
1060+ // (protected) this % n, n < 2^26
1061+ function bnpModInt(n) {
1062+ if(n <= 0) return 0;
1063+ var d = this.DV%n, r = (this.s<0)?n-1:0;
1064+ if(this.t > 0)
1065+ if(d == 0) r = this[0]%n;
1066+ else for(var i = this.t-1; i >= 0; --i) r = (d*r+this[i])%n;
1067+ return r;
1068+ }
1069+
1070+ // (public) 1/this % m (HAC 14.61)
1071+ function bnModInverse(m) {
1072+ var ac = m.isEven();
1073+ if((this.isEven() && ac) || m.signum() == 0) return BigInteger.ZERO;
1074+ var u = m.clone(), v = this.clone();
1075+ var a = nbv(1), b = nbv(0), c = nbv(0), d = nbv(1);
1076+ while(u.signum() != 0) {
1077+ while(u.isEven()) {
1078+ u.rShiftTo(1,u);
1079+ if(ac) {
1080+ if(!a.isEven() || !b.isEven()) { a.addTo(this,a); b.subTo(m,b); }
1081+ a.rShiftTo(1,a);
1082+ }
1083+ else if(!b.isEven()) b.subTo(m,b);
1084+ b.rShiftTo(1,b);
1085+ }
1086+ while(v.isEven()) {
1087+ v.rShiftTo(1,v);
1088+ if(ac) {
1089+ if(!c.isEven() || !d.isEven()) { c.addTo(this,c); d.subTo(m,d); }
1090+ c.rShiftTo(1,c);
1091+ }
1092+ else if(!d.isEven()) d.subTo(m,d);
1093+ d.rShiftTo(1,d);
1094+ }
1095+ if(u.compareTo(v) >= 0) {
1096+ u.subTo(v,u);
1097+ if(ac) a.subTo(c,a);
1098+ b.subTo(d,b);
1099+ }
1100+ else {
1101+ v.subTo(u,v);
1102+ if(ac) c.subTo(a,c);
1103+ d.subTo(b,d);
1104+ }
1105+ }
1106+ if(v.compareTo(BigInteger.ONE) != 0) return BigInteger.ZERO;
1107+ if(d.compareTo(m) >= 0) return d.subtract(m);
1108+ if(d.signum() < 0) d.addTo(m,d); else return d;
1109+ if(d.signum() < 0) return d.add(m); else return d;
1110+ }
1111+
1112+ var lowprimes = [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97,101,103,107,109,113,127,131,137,139,149,151,157,163,167,173,179,181,191,193,197,199,211,223,227,229,233,239,241,251,257,263,269,271,277,281,283,293,307,311,313,317,331,337,347,349,353,359,367,373,379,383,389,397,401,409,419,421,431,433,439,443,449,457,461,463,467,479,487,491,499,503,509,521,523,541,547,557,563,569,571,577,587,593,599,601,607,613,617,619,631,641,643,647,653,659,661,673,677,683,691,701,709,719,727,733,739,743,751,757,761,769,773,787,797,809,811,821,823,827,829,839,853,857,859,863,877,881,883,887,907,911,919,929,937,941,947,953,967,971,977,983,991,997];
1113+ var lplim = (1<<26)/lowprimes[lowprimes.length-1];
1114+
1115+ // (public) test primality with certainty >= 1-.5^t
1116+ function bnIsProbablePrime(t) {
1117+ var i, x = this.abs();
1118+ if(x.t == 1 && x[0] <= lowprimes[lowprimes.length-1]) {
1119+ for(i = 0; i < lowprimes.length; ++i)
1120+ if(x[0] == lowprimes[i]) return true;
1121+ return false;
1122+ }
1123+ if(x.isEven()) return false;
1124+ i = 1;
1125+ while(i < lowprimes.length) {
1126+ var m = lowprimes[i], j = i+1;
1127+ while(j < lowprimes.length && m < lplim) m *= lowprimes[j++];
1128+ m = x.modInt(m);
1129+ while(i < j) if(m%lowprimes[i++] == 0) return false;
1130+ }
1131+ return x.millerRabin(t);
1132+ }
1133+
1134+ // (protected) true if probably prime (HAC 4.24, Miller-Rabin)
1135+ function bnpMillerRabin(t) {
1136+ var n1 = this.subtract(BigInteger.ONE);
1137+ var k = n1.getLowestSetBit();
1138+ if(k <= 0) return false;
1139+ var r = n1.shiftRight(k);
1140+ t = (t+1)>>1;
1141+ if(t > lowprimes.length) t = lowprimes.length;
1142+ var a = nbi();
1143+ for(var i = 0; i < t; ++i) {
1144+ //Pick bases at random, instead of starting at 2
1145+ a.fromInt(lowprimes[Math.floor(Math.random()*lowprimes.length)]);
1146+ var y = a.modPow(r,this);
1147+ if(y.compareTo(BigInteger.ONE) != 0 && y.compareTo(n1) != 0) {
1148+ var j = 1;
1149+ while(j++ < k && y.compareTo(n1) != 0) {
1150+ y = y.modPowInt(2,this);
1151+ if(y.compareTo(BigInteger.ONE) == 0) return false;
1152+ }
1153+ if(y.compareTo(n1) != 0) return false;
1154+ }
1155+ }
1156+ return true;
1157+ }
1158+
1159+ // protected
1160+ BigInteger.prototype.chunkSize = bnpChunkSize;
1161+ BigInteger.prototype.toRadix = bnpToRadix;
1162+ BigInteger.prototype.fromRadix = bnpFromRadix;
1163+ BigInteger.prototype.fromNumber = bnpFromNumber;
1164+ BigInteger.prototype.bitwiseTo = bnpBitwiseTo;
1165+ BigInteger.prototype.changeBit = bnpChangeBit;
1166+ BigInteger.prototype.addTo = bnpAddTo;
1167+ BigInteger.prototype.dMultiply = bnpDMultiply;
1168+ BigInteger.prototype.dAddOffset = bnpDAddOffset;
1169+ BigInteger.prototype.multiplyLowerTo = bnpMultiplyLowerTo;
1170+ BigInteger.prototype.multiplyUpperTo = bnpMultiplyUpperTo;
1171+ BigInteger.prototype.modInt = bnpModInt;
1172+ BigInteger.prototype.millerRabin = bnpMillerRabin;
1173+
1174+ // public
1175+ BigInteger.prototype.clone = bnClone;
1176+ BigInteger.prototype.intValue = bnIntValue;
1177+ BigInteger.prototype.byteValue = bnByteValue;
1178+ BigInteger.prototype.shortValue = bnShortValue;
1179+ BigInteger.prototype.signum = bnSigNum;
1180+ BigInteger.prototype.toByteArray = bnToByteArray;
1181+ BigInteger.prototype.equals = bnEquals;
1182+ BigInteger.prototype.min = bnMin;
1183+ BigInteger.prototype.max = bnMax;
1184+ BigInteger.prototype.and = bnAnd;
1185+ BigInteger.prototype.or = bnOr;
1186+ BigInteger.prototype.xor = bnXor;
1187+ BigInteger.prototype.andNot = bnAndNot;
1188+ BigInteger.prototype.not = bnNot;
1189+ BigInteger.prototype.shiftLeft = bnShiftLeft;
1190+ BigInteger.prototype.shiftRight = bnShiftRight;
1191+ BigInteger.prototype.getLowestSetBit = bnGetLowestSetBit;
1192+ BigInteger.prototype.bitCount = bnBitCount;
1193+ BigInteger.prototype.testBit = bnTestBit;
1194+ BigInteger.prototype.setBit = bnSetBit;
1195+ BigInteger.prototype.clearBit = bnClearBit;
1196+ BigInteger.prototype.flipBit = bnFlipBit;
1197+ BigInteger.prototype.add = bnAdd;
1198+ BigInteger.prototype.subtract = bnSubtract;
1199+ BigInteger.prototype.multiply = bnMultiply;
1200+ BigInteger.prototype.divide = bnDivide;
1201+ BigInteger.prototype.remainder = bnRemainder;
1202+ BigInteger.prototype.divideAndRemainder = bnDivideAndRemainder;
1203+ BigInteger.prototype.modPow = bnModPow;
1204+ BigInteger.prototype.modInverse = bnModInverse;
1205+ BigInteger.prototype.pow = bnPow;
1206+ BigInteger.prototype.gcd = bnGCD;
1207+ BigInteger.prototype.isProbablePrime = bnIsProbablePrime;
1208+
1209+ // JSBN-specific extension
1210+ BigInteger.prototype.square = bnSquare;
1211+
1212+ // Expose the Barrett function
1213+ BigInteger.prototype.Barrett = Barrett
1214+
1215+ // BigInteger interfaces not implemented in jsbn:
1216+
1217+ // BigInteger(int signum, byte[] magnitude)
1218+ // double doubleValue()
1219+ // float floatValue()
1220+ // int hashCode()
1221+ // long longValue()
1222+ // static BigInteger valueOf(long val)
1223+
1224+ // Random number generator - requires a PRNG backend, e.g. prng4.js
1225+
1226+ // For best results, put code like
1227+ // <body onClick='rng_seed_time();' onKeyPress='rng_seed_time();'>
1228+ // in your main HTML document.
1229+
1230+ var rng_state;
1231+ var rng_pool;
1232+ var rng_pptr;
1233+
1234+ // Mix in a 32-bit integer into the pool
1235+ function rng_seed_int(x) {
1236+ rng_pool[rng_pptr++] ^= x & 255;
1237+ rng_pool[rng_pptr++] ^= (x >> 8) & 255;
1238+ rng_pool[rng_pptr++] ^= (x >> 16) & 255;
1239+ rng_pool[rng_pptr++] ^= (x >> 24) & 255;
1240+ if(rng_pptr >= rng_psize) rng_pptr -= rng_psize;
1241+ }
1242+
1243+ // Mix in the current time (w/milliseconds) into the pool
1244+ function rng_seed_time() {
1245+ rng_seed_int(new Date().getTime());
1246+ }
1247+
1248+ // Initialize the pool with junk if needed.
1249+ if(rng_pool == null) {
1250+ rng_pool = new Array();
1251+ rng_pptr = 0;
1252+ var t;
1253+ if(typeof window !== "undefined" && window.crypto) {
1254+ if (window.crypto.getRandomValues) {
1255+ // Use webcrypto if available
1256+ var ua = new Uint8Array(32);
1257+ window.crypto.getRandomValues(ua);
1258+ for(t = 0; t < 32; ++t)
1259+ rng_pool[rng_pptr++] = ua[t];
1260+ }
1261+ else if(navigator.appName == "Netscape" && navigator.appVersion < "5") {
1262+ // Extract entropy (256 bits) from NS4 RNG if available
1263+ var z = window.crypto.random(32);
1264+ for(t = 0; t < z.length; ++t)
1265+ rng_pool[rng_pptr++] = z.charCodeAt(t) & 255;
1266+ }
1267+ }
1268+ while(rng_pptr < rng_psize) { // extract some randomness from Math.random()
1269+ t = Math.floor(65536 * Math.random());
1270+ rng_pool[rng_pptr++] = t >>> 8;
1271+ rng_pool[rng_pptr++] = t & 255;
1272+ }
1273+ rng_pptr = 0;
1274+ rng_seed_time();
1275+ //rng_seed_int(window.screenX);
1276+ //rng_seed_int(window.screenY);
1277+ }
1278+
1279+ function rng_get_byte() {
1280+ if(rng_state == null) {
1281+ rng_seed_time();
1282+ rng_state = prng_newstate();
1283+ rng_state.init(rng_pool);
1284+ for(rng_pptr = 0; rng_pptr < rng_pool.length; ++rng_pptr)
1285+ rng_pool[rng_pptr] = 0;
1286+ rng_pptr = 0;
1287+ //rng_pool = null;
1288+ }
1289+ // TODO: allow reseeding after first request
1290+ return rng_state.next();
1291+ }
1292+
1293+ function rng_get_bytes(ba) {
1294+ var i;
1295+ for(i = 0; i < ba.length; ++i) ba[i] = rng_get_byte();
1296+ }
1297+
1298+ function SecureRandom() {}
1299+
1300+ SecureRandom.prototype.nextBytes = rng_get_bytes;
1301+
1302+ // prng4.js - uses Arcfour as a PRNG
1303+
1304+ function Arcfour() {
1305+ this.i = 0;
1306+ this.j = 0;
1307+ this.S = new Array();
1308+ }
1309+
1310+ // Initialize arcfour context from key, an array of ints, each from [0..255]
1311+ function ARC4init(key) {
1312+ var i, j, t;
1313+ for(i = 0; i < 256; ++i)
1314+ this.S[i] = i;
1315+ j = 0;
1316+ for(i = 0; i < 256; ++i) {
1317+ j = (j + this.S[i] + key[i % key.length]) & 255;
1318+ t = this.S[i];
1319+ this.S[i] = this.S[j];
1320+ this.S[j] = t;
1321+ }
1322+ this.i = 0;
1323+ this.j = 0;
1324+ }
1325+
1326+ function ARC4next() {
1327+ var t;
1328+ this.i = (this.i + 1) & 255;
1329+ this.j = (this.j + this.S[this.i]) & 255;
1330+ t = this.S[this.i];
1331+ this.S[this.i] = this.S[this.j];
1332+ this.S[this.j] = t;
1333+ return this.S[(t + this.S[this.i]) & 255];
1334+ }
1335+
1336+ Arcfour.prototype.init = ARC4init;
1337+ Arcfour.prototype.next = ARC4next;
1338+
1339+ // Plug in your RNG constructor here
1340+ function prng_newstate() {
1341+ return new Arcfour();
1342+ }
1343+
1344+ // Pool size must be a multiple of 4 and greater than 32.
1345+ // An array of bytes the size of the pool will be passed to init()
1346+ var rng_psize = 256;
1347+
1348+ return {
1349+ BigInteger: BigInteger,
1350+ SecureRandom: SecureRandom
1351+ };
1352+
1353+}).call(this);
src/IRTS/CodegenJavaScript.hs+73−1292
@@ -11,1311 +11,92 @@ module IRTS.CodegenJavaScript (codegenJavaScript
1111 , JSTarget(..)
1212 ) where
1313
14−import Idris.AbsSyntax hiding (TypeCase)
15−import Idris.Core.TT
16−import IRTS.Bytecode
17−import IRTS.CodegenCommon
18−import IRTS.Defunctionalise
19−import IRTS.Exports
20−import IRTS.JavaScript.AST
21−import IRTS.Lang
22−import IRTS.Simplified
23−import IRTS.System
24−import Util.System
25−
26−import Control.Applicative (pure, (<$>), (<*>))
27−import Control.Arrow
28−import Control.Monad (mapM)
29−import Control.Monad.RWS hiding (mapM)
30−import Control.Monad.State
3114import Data.Char
32−import Data.List
33−import qualified Data.Map.Strict as M
34−import Data.Maybe
15+import Data.Text (Text)
3516import qualified Data.Text as T
36−import qualified Data.Text.IO as TIO
37−import Data.Traversable hiding (mapM)
38−import Data.Word
39−import Numeric
17+import IRTS.CodegenCommon
18+import IRTS.JavaScript.Codegen
4019import System.Directory
4120import System.FilePath
42−import System.IO
43−
44−
45−data CompileInfo = CompileInfo { compileInfoApplyCases :: [Int]
46− , compileInfoEvalCases :: [Int]
47− , compileInfoNeedsBigInt :: Bool
48− }
49−
50−
51−initCompileInfo :: [(Name, [BC])] -> CompileInfo
52−initCompileInfo bc =
53− CompileInfo (collectCases "APPLY" bc) (collectCases "EVAL" bc) (lookupBigInt bc)
54− where
55− lookupBigInt :: [(Name, [BC])] -> Bool
56− lookupBigInt = any (needsBigInt . snd)
57− where
58− needsBigInt :: [BC] -> Bool
59− needsBigInt bc = any testBCForBigInt bc
60− where
61− testBCForBigInt :: BC -> Bool
62− testBCForBigInt (ASSIGNCONST _ c) =
63− testConstForBigInt c
6421
65− testBCForBigInt (CONSTCASE _ c d) =
66− maybe False needsBigInt d
67− || any (needsBigInt . snd) c
68− || any (testConstForBigInt . fst) c
6922
70− testBCForBigInt (CASE _ _ c d) =
71− maybe False needsBigInt d
72− || any (needsBigInt . snd) c
73−
74− testBCForBigInt _ = False
75−
76− testConstForBigInt :: Const -> Bool
77− testConstForBigInt (BI _) = True
78− testConstForBigInt (B64 _) = True
79− testConstForBigInt _ = False
80−
81−
82− collectCases :: String -> [(Name, [BC])] -> [Int]
83− collectCases fun bc = getCases $ findFunction fun bc
84−
85− findFunction :: String -> [(Name, [BC])] -> [BC]
86− findFunction f ((MN 0 fun, bc):_)
87− | fun == txt f = bc
88− findFunction f (_:bc) = findFunction f bc
23+data JSTarget = Node | JavaScript deriving Eq
8924
90− getCases :: [BC] -> [Int]
91− getCases = concatMap analyze
92− where
93− analyze :: BC -> [Int]
94− analyze (CASE _ _ b _) = map fst b
95− analyze _ = []
9625
26+htmlHeader :: Text
27+htmlHeader =
28+ T.concat [ "<html>\n"
29+ , " <head>\n"
30+ , " <meta charset='utf-8'>\n"
31+ , " </head>\n"
32+ , " <body>\n"
33+ , " <script type='text/javascript'>\n"
34+ ]
9735
98−data JSTarget = Node | JavaScript deriving Eq
36+htmlFooter :: Text
37+htmlFooter =
38+ T.concat [ "\n </script>\n"
39+ , " </body>\n"
40+ , "</html>"
41+ ]
9942
43+nodeReadLine :: Text
44+nodeReadLine =
45+ T.concat [ "var js_idris_readStr = function() {\n"
46+ , " var ret = '';"
47+ , " var b = new Buffer(1024);"
48+ , " var i = 0;\n"
49+ , " while(true) {\n"
50+ , " fs.readSync(0, b, i, 1 )\n"
51+ , " if (b[i] == 10) {\n"
52+ , " ret = b.toString('utf8', 0, i);\n"
53+ , " break;\n"
54+ , " }\n"
55+ , " i++;\n"
56+ , " if (i == b.length) {\n"
57+ , " nb = new Buffer (b.length*2);\n"
58+ , " b.copy(nb)\n"
59+ , " b = nb;\n"
60+ , " }\n"
61+ , " }\n"
62+ , " return ret;\n"
63+ , " };\n"
64+ ]
10065
10166codegenJavaScript :: CodeGenerator
10267codegenJavaScript ci =
103− codegenJS_all JavaScript (simpleDecls ci)
104− (includes ci) [] (outputFile ci) (exportDecls ci) (outputType ci)
68+ let (h, f) = if (map toLower $ takeExtension $ outputFile ci) == ".html" then
69+ (htmlHeader, htmlFooter)
70+ else ("","")
71+ in codegenJs (CGConf { header = h
72+ , footer = f
73+ , initialization = const ""
74+ , writeStrTemplate = "console.log(%0)"
75+ , readStrTemplate = "prompt('Prelude.getLine')"
76+ , extraRunTime = "Runtime-javascript.js"
77+ }
78+ )
79+ ci
80+
81+initializationNode :: CGStats -> Text
82+initializationNode x =
83+ T.concat [ if usedWriteStr x || usedReadStr x then "var fs = require('fs');\n" else ""
84+ , if usedReadStr x then nodeReadLine else ""
85+ ]
10586
10687codegenNode :: CodeGenerator
10788codegenNode ci =
108− codegenJS_all Node (simpleDecls ci)
109− (includes ci) (compileLibs ci) (outputFile ci) (exportDecls ci) (outputType ci)
110−
111−codegenJS_all
112− :: JSTarget
113− -> [(Name, SDecl)]
114− -> [FilePath]
115− -> [String]
116− -> FilePath
117− -> [ExportIFace]
118− -> OutputType
119− -> IO ()
120−codegenJS_all target definitions includes libs filename exports outputType = do
121− let bytecode = map toBC definitions
122− let info = initCompileInfo bytecode
123− let js = concatMap (translateDecl info) bytecode
124− let full = concatMap processFunction js
125− let exportedNames = map translateName ((getExpNames exports) ++ [sUN "call__IO"])
126− let code = deadCodeElim exportedNames full
127− let ext = takeExtension filename
128− let isHtml = target == JavaScript && ext == ".html"
129− let htmlPrologue = T.pack "<!doctype html><html><head><script>\n"
130− let htmlEpilogue = T.pack "\n</script></head><body></body></html>"
131− let (cons, opt) = optimizeConstructors code
132− let (header, rt) = case target of
133− Node -> ("#!/usr/bin/env node\n", "-node")
134− JavaScript -> ("", "-browser")
135−
136− included <- concat <$> getIncludes includes
137− path <- getIdrisJSRTSDir
138− idrRuntime <- readFile $ path </> "Runtime-common.js"
139− tgtRuntime <- readFile $ path </> concat ["Runtime", rt, ".js"]
140− jsbn <- if compileInfoNeedsBigInt info
141− then readFile $ path </> "jsbn/jsbn.js"
142− else return ""
143− let runtime = ( header
144− ++ includeLibs libs
145− ++ included
146− ++ jsbn
147− ++ idrRuntime
148− ++ tgtRuntime
149− )
150− let jsSource = T.pack runtime
151− `T.append` T.concat (map compileJS opt)
152− `T.append` T.concat (map compileJS cons)
153− `T.append` T.concat (map compileJS (map genInterface (concatMap getExps exports)))
154− `T.append` main
155− `T.append` invokeMain
156− let source = if isHtml
157− then htmlPrologue `T.append` jsSource `T.append` htmlEpilogue
158− else jsSource
159− writeSourceText filename source
160− setPermissions filename (emptyPermissions { readable = True
161− , executable = target == Node
162− , writable = True
163− })
164− where
165− deadCodeElim :: [String] -> [JS] -> [JS]
166− deadCodeElim exports js = concatMap (collectFunctions exports) js
167− where
168− collectFunctions :: [String] -> JS -> [JS]
169− collectFunctions _ fun@(JSAlloc name _)
170− | name == translateName (sMN 0 "runMain") = [fun]
171−
172− collectFunctions exports fun@(JSAlloc name _)
173− | name `elem` exports = [fun]
174−
175− collectFunctions _ fun@(JSAlloc name (Just (JSFunction _ body))) =
176− let invokations = sum $ map (
177− \x -> execState (countInvokations name x) 0
178− ) js
179− in if invokations == 0
180− then []
181− else [fun]
182−
183− countInvokations :: String -> JS -> State Int ()
184− countInvokations name (JSAlloc _ (Just (JSFunction _ body))) =
185− countInvokations name body
186−
187− countInvokations name (JSSeq seq) =
188− void $ traverse (countInvokations name) seq
189−
190− countInvokations name (JSAssign _ rhs) =
191− countInvokations name rhs
192−
193− countInvokations name (JSCond conds) =
194− void $ traverse (
195− runKleisli $ arr id *** Kleisli (countInvokations name)
196− ) conds
197−
198− countInvokations name (JSSwitch _ conds def) =
199− void $ traverse (
200− runKleisli $ arr id *** Kleisli (countInvokations name)
201− ) conds >> traverse (countInvokations name) def
202−
203− countInvokations name (JSApp lhs rhs) =
204− void $ countInvokations name lhs >> traverse (countInvokations name) rhs
205−
206− countInvokations name (JSNew _ args) =
207− void $ traverse (countInvokations name) args
208−
209− countInvokations name (JSArray args) =
210− void $ traverse (countInvokations name) args
211−
212− countInvokations name (JSIdent name')
213− | name == name' = get >>= put . (+1)
214− | otherwise = return ()
215−
216− countInvokations _ _ = return ()
217−
218− processFunction :: JS -> [JS]
219− processFunction =
220− collectSplitFunctions . (\x -> evalRWS (splitFunction x) () 0)
221−
222− includeLibs :: [String] -> String
223− includeLibs =
224− concatMap (\lib -> "var " ++ lib ++ " = require(\"" ++ lib ++"\");\n")
225−
226− getIncludes :: [FilePath] -> IO [String]
227− getIncludes = mapM readFile
228−
229− main :: T.Text
230− main =
231− compileJS $ JSAlloc "main" (Just $
232− JSFunction [] (
233− case target of
234− Node -> mainFun
235− JavaScript -> jsMain
236− )
237− )
238−
239− jsMain :: JS
240− jsMain =
241− JSCond [ (exists document `jsAnd` isReady, mainFun)
242− , (exists window, windowMainFun)
243− , (JSTrue, mainFun)
244− ]
245− where
246− exists :: JS -> JS
247− exists js = jsTypeOf js `jsNotEq` JSString "undefined"
248−
249− window :: JS
250− window = JSIdent "window"
251−
252− document :: JS
253− document = JSIdent "document"
254−
255− windowMainFun :: JS
256− windowMainFun =
257− jsMeth window "addEventListener" [ JSString "DOMContentLoaded"
258− , JSFunction [] ( mainFun )
259− , JSFalse
260− ]
261−
262− isReady :: JS
263− isReady = JSParens $ readyState `jsEq` JSString "complete" `jsOr` readyState `jsEq` JSString "loaded"
264−
265− readyState :: JS
266− readyState = JSProj (JSIdent "document") "readyState"
267−
268− mainFun :: JS
269− mainFun =
270− JSSeq [ JSAlloc "vm" (Just $ JSNew "i$VM" [])
271− , JSApp (JSIdent "i$SCHED") [JSIdent "vm"]
272− , JSApp (
273− JSIdent (translateName (sMN 0 "runMain"))
274− ) [JSNew "i$POINTER" [JSNum (JSInt 0)]]
275− , JSApp (JSIdent "i$RUN") []
276− ]
277−
278− invokeMain :: T.Text
279− invokeMain = compileJS $ JSApp (JSIdent "main") []
280− getExps (Export _ _ exp) = exp
281−
282−optimizeConstructors :: [JS] -> ([JS], [JS])
283−optimizeConstructors js =
284− let (js', cons) = runState (traverse optimizeConstructor' js) M.empty in
285− (map (allocCon . snd) (M.toList cons), js')
286− where
287− allocCon :: (String, JS) -> JS
288− allocCon (name, con) = JSAlloc name (Just con)
289−
290− newConstructor :: Int -> String
291− newConstructor n = "i$CON$" ++ show n
292−
293− optimizeConstructor' :: JS -> State (M.Map Int (String, JS)) JS
294− optimizeConstructor' js@(JSNew "i$CON" [ JSNum (JSInt tag)
295− , JSArray []
296− , a
297− , e
298− ]) = do
299− s <- get
300− case M.lookup tag s of
301− Just (i, c) -> return $ JSIdent i
302− Nothing -> do let n = newConstructor tag
303− put $ M.insert tag (n, js) s
304− return $ JSIdent n
305−
306− optimizeConstructor' (JSSeq seq) =
307− JSSeq <$> traverse optimizeConstructor' seq
308−
309− optimizeConstructor' (JSSwitch reg cond def) = do
310− cond' <- traverse (runKleisli $ arr id *** Kleisli optimizeConstructor') cond
311− def' <- traverse optimizeConstructor' def
312− return $ JSSwitch reg cond' def'
313−
314− optimizeConstructor' (JSCond cond) =
315− JSCond <$> traverse (runKleisli $ arr id *** Kleisli optimizeConstructor') cond
316−
317− optimizeConstructor' (JSAlloc fun (Just (JSFunction args body))) = do
318− body' <- optimizeConstructor' body
319− return $ JSAlloc fun (Just (JSFunction args body'))
320−
321− optimizeConstructor' (JSAssign lhs rhs) = do
322− lhs' <- optimizeConstructor' lhs
323− rhs' <- optimizeConstructor' rhs
324− return $ JSAssign lhs' rhs'
325−
326− optimizeConstructor' js = return js
327−
328−collectSplitFunctions :: (JS, [(Int,JS)]) -> [JS]
329−collectSplitFunctions (fun, splits) = map generateSplitFunction splits ++ [fun]
330− where
331− generateSplitFunction :: (Int,JS) -> JS
332− generateSplitFunction (depth, JSAlloc name fun) =
333− JSAlloc (name ++ "$" ++ show depth) fun
334−
335−splitFunction :: JS -> RWS () [(Int,JS)] Int JS
336−splitFunction (JSAlloc name (Just (JSFunction args body@(JSSeq _)))) = do
337− body' <- splitSequence body
338− return $ JSAlloc name (Just (JSFunction args body'))
339− where
340− splitCondition :: JS -> RWS () [(Int,JS)] Int JS
341− splitCondition js
342− | JSCond branches <- js =
343− JSCond <$> processBranches branches
344− | JSSwitch cond branches def <- js =
345− JSSwitch cond <$> (processBranches branches) <*> (traverse splitSequence def)
346− | otherwise = return js
347− where
348− processBranches :: [(JS,JS)] -> RWS () [(Int,JS)] Int [(JS,JS)]
349− processBranches =
350− traverse (runKleisli (arr id *** Kleisli splitSequence))
351−
352− splitSequence :: JS -> RWS () [(Int, JS)] Int JS
353− splitSequence js@(JSSeq seq) =
354− let (pre,post) = break isBranch seq in
355− case post of
356− [_] -> JSSeq <$> traverse splitCondition seq
357− [call@(JSCond _),rest@(JSApp _ _)] -> do
358− rest' <- splitCondition rest
359− call' <- splitCondition call
360− return $ JSSeq (pre ++ [rest', call'])
361− [call@(JSSwitch _ _ _),rest@(JSApp _ _)] -> do
362− rest' <- splitCondition rest
363− call' <- splitCondition call
364− return $ JSSeq (pre ++ [rest', call'])
365− (call:rest) -> do
366− depth <- get
367− put (depth + 1)
368− new <- splitFunction (newFun rest)
369− tell [(depth, new)]
370− call' <- splitCondition call
371− return $ JSSeq (pre ++ (newCall depth : [call']))
372− _ -> JSSeq <$> traverse splitCondition seq
373−
374− splitSequence js = return js
375−
376− isBranch :: JS -> Bool
377− isBranch (JSApp (JSIdent "i$CALL") _) = True
378− isBranch (JSCond _) = True
379− isBranch (JSSwitch _ _ _) = True
380− isBranch _ = False
381−
382− newCall :: Int -> JS
383− newCall depth =
384− JSApp (JSIdent "i$CALL") [ JSIdent $ name ++ "$" ++ show depth
385− , JSArray [jsOLDBASE, jsMYOLDBASE]
386− ]
387−
388− newFun :: [JS] -> JS
389− newFun seq =
390− JSAlloc name (Just $ JSFunction ["oldbase", "myoldbase"] (JSSeq seq))
391−
392−splitFunction js = return js
393−
394−translateDecl :: CompileInfo -> (Name, [BC]) -> [JS]
395−translateDecl info (name@(MN 0 fun), bc)
396− | txt "APPLY" == fun =
397− allocCaseFunctions (snd body)
398− ++ [ JSAlloc (
399− translateName name
400− ) (Just $ JSFunction ["oldbase"] (
401− JSSeq $ jsFUNPRELUDE ++ map (translateBC info) (fst body) ++ [
402− JSCond [ ( (translateReg $ caseReg (snd body)) `jsInstanceOf` "i$CON" `jsAnd` (JSProj (translateReg $ caseReg (snd body)) "app")
403− , JSApp (JSProj (translateReg $ caseReg (snd body)) "app") [jsOLDBASE, jsMYOLDBASE]
404− )
405− , ( JSNoop
406− , JSSeq $ map (translateBC info) (defaultCase (snd body))
407− )
408− ]
409− ]
410− )
411− )
412− ]
413−
414− | txt "EVAL" == fun =
415− allocCaseFunctions (snd body)
416− ++ [ JSAlloc (
417− translateName name
418− ) (Just $ JSFunction ["oldbase"] (
419− JSSeq $ jsFUNPRELUDE ++ map (translateBC info) (fst body) ++ [
420− JSCond [ ( (translateReg $ caseReg (snd body)) `jsInstanceOf` "i$CON" `jsAnd` (JSProj (translateReg $ caseReg (snd body)) "ev")
421− , JSApp (JSProj (translateReg $ caseReg (snd body)) "ev") [jsOLDBASE, jsMYOLDBASE]
422− )
423− , ( JSNoop
424− , JSSeq $ map (translateBC info) (defaultCase (snd body))
425− )
426− ]
427− ]
428− )
429− )
430− ]
431− where
432− body :: ([BC], [BC])
433− body = break isCase bc
434−
435− isCase :: BC -> Bool
436− isCase bc
437− | CASE {} <- bc = True
438− | otherwise = False
439−
440− defaultCase :: [BC] -> [BC]
441− defaultCase ((CASE _ _ _ (Just d)):_) = d
442−
443− caseReg :: [BC] -> Reg
444− caseReg ((CASE _ r _ _):_) = r
445−
446− allocCaseFunctions :: [BC] -> [JS]
447− allocCaseFunctions ((CASE _ _ c _):_) = splitBranches c
448− allocCaseFunctions _ = []
449−
450− splitBranches :: [(Int, [BC])] -> [JS]
451− splitBranches = map prepBranch
452−
453− prepBranch :: (Int, [BC]) -> JS
454− prepBranch (tag, code) =
455− JSAlloc (
456− translateName name ++ "$" ++ show tag
457− ) (Just $ JSFunction ["oldbase", "myoldbase"] (
458− JSSeq $ map (translateBC info) code
459− )
460− )
461−
462−translateDecl info (name, bc) =
463− [ JSAlloc (
464− translateName name
465− ) (Just $ JSFunction ["oldbase"] (
466− JSSeq $ jsFUNPRELUDE ++ map (translateBC info)bc
467− )
468− )
469− ]
470−
471−jsFUNPRELUDE :: [JS]
472−jsFUNPRELUDE = [jsALLOCMYOLDBASE]
473−
474−jsALLOCMYOLDBASE :: JS
475−jsALLOCMYOLDBASE = JSAlloc "myoldbase" (Just $ JSNew "i$POINTER" [])
476−
477−translateReg :: Reg -> JS
478−translateReg reg
479− | RVal <- reg = jsRET
480− | Tmp <- reg = JSRaw "//TMPREG"
481− | L n <- reg = jsLOC n
482− | T n <- reg = jsTOP n
483−
484−translateConstant :: Const -> JS
485−translateConstant (I i) = JSNum (JSInt i)
486−translateConstant (Fl f) = JSNum (JSFloat f)
487−translateConstant (Ch c) = JSString $ translateChar c
488−translateConstant (Str s) = JSString $ concatMap translateChar s
489−translateConstant (AType (ATInt ITNative)) = JSType JSIntTy
490−translateConstant StrType = JSType JSStringTy
491−translateConstant (AType (ATInt ITBig)) = JSType JSIntegerTy
492−translateConstant (AType ATFloat) = JSType JSFloatTy
493−translateConstant (AType (ATInt ITChar)) = JSType JSCharTy
494−translateConstant Forgot = JSType JSForgotTy
495−translateConstant (BI 0) = JSNum (JSInteger JSBigZero)
496−translateConstant (BI 1) = JSNum (JSInteger JSBigOne)
497−translateConstant (BI i) = jsBigInt (JSString $ show i)
498−translateConstant (B8 b) = JSWord (JSWord8 b)
499−translateConstant (B16 b) = JSWord (JSWord16 b)
500−translateConstant (B32 b) = JSWord (JSWord32 b)
501−translateConstant (B64 b) = JSWord (JSWord64 b)
502−translateConstant c =
503− JSError $ "Unimplemented Constant: " ++ show c
504−
505−
506−translateChar :: Char -> String
507−translateChar ch
508− | '\a' <- ch = "\\u0007"
509− | '\b' <- ch = "\\b"
510− | '\f' <- ch = "\\f"
511− | '\n' <- ch = "\\n"
512− | '\r' <- ch = "\\r"
513− | '\t' <- ch = "\\t"
514− | '\v' <- ch = "\\v"
515− | '\SO' <- ch = "\\u000E"
516− | '\DEL' <- ch = "\\u007F"
517− | '\\' <- ch = "\\\\"
518− | '\"' <- ch = "\\\""
519− | '\'' <- ch = "\\\'"
520− | ch `elem` asciiTab = "\\u" ++ fill (showHex (ord ch) "")
521− | ord ch > 255 = "\\u" ++ fill (showHex (ord ch) "")
522− | otherwise = [ch]
523− where
524− fill :: String -> String
525− fill s = case length s of
526− 1 -> "000" ++ s
527− 2 -> "00" ++ s
528− 3 -> "0" ++ s
529− _ -> s
530−
531− asciiTab =
532− ['\NUL', '\SOH', '\STX', '\ETX', '\EOT', '\ENQ', '\ACK', '\BEL',
533− '\BS', '\HT', '\LF', '\VT', '\FF', '\CR', '\SO', '\SI',
534− '\DLE', '\DC1', '\DC2', '\DC3', '\DC4', '\NAK', '\SYN', '\ETB',
535− '\CAN', '\EM', '\SUB', '\ESC', '\FS', '\GS', '\RS', '\US']
536−
537−translateName :: Name -> String
538−translateName n = "_idris_" ++ concatMap cchar (showCG n)
539− where cchar x | isAlphaNum x = [x]
540− | otherwise = "_" ++ show (fromEnum x) ++ "_"
541−
542−jsASSIGN :: CompileInfo -> Reg -> Reg -> JS
543−jsASSIGN _ r1 r2 = JSAssign (translateReg r1) (translateReg r2)
544−
545−jsASSIGNCONST :: CompileInfo -> Reg -> Const -> JS
546−jsASSIGNCONST _ r c = JSAssign (translateReg r) (translateConstant c)
547−
548−jsCALL :: CompileInfo -> Name -> JS
549−jsCALL _ n =
550− JSApp (
551− JSIdent "i$CALL"
552− ) [JSIdent (translateName n), JSArray [jsMYOLDBASE]]
553−
554−jsTAILCALL :: CompileInfo -> Name -> JS
555−jsTAILCALL _ n =
556− JSApp (
557− JSIdent "i$CALL"
558− ) [JSIdent (translateName n), JSArray [jsOLDBASE]]
559−
560−jsFOREIGN :: CompileInfo -> Reg -> String -> [(FType, Reg)] -> JS
561−jsFOREIGN _ reg n args
562− | n == "isNull"
563− , [(FPtr, arg)] <- args =
564− JSAssign (
565− translateReg reg
566− ) (
567− JSBinOp "==" (translateReg arg) JSNull
568− )
569−
570− | n == "idris_eqPtr"
571− , [(_, lhs),(_, rhs)] <- args =
572− JSAssign (
573− translateReg reg
574− ) (
575− JSBinOp "==" (translateReg lhs) (translateReg rhs)
576− )
577− | otherwise =
578− JSAssign (
579− translateReg reg
580− ) (
581− JSFFI n (map generateWrapper args)
582− )
583− where
584− generateWrapper :: (FType, Reg) -> JS
585− generateWrapper (ty, reg)
586− | FFunction <- ty =
587− JSApp (JSIdent "i$ffiWrap") [ translateReg reg
588− , JSIdent "oldbase"
589− , JSIdent "myoldbase"
590− ]
591− | FFunctionIO <- ty =
592− JSApp (JSIdent "i$ffiWrap") [ translateReg reg
593− , JSIdent "oldbase"
594− , JSIdent "myoldbase"
595− ]
596−
597− generateWrapper (_, reg) =
598− translateReg reg
599−
600−jsREBASE :: CompileInfo -> JS
601−jsREBASE _ = JSAssign jsSTACKBASE (JSProj jsOLDBASE "addr")
602−
603−jsSTOREOLD :: CompileInfo ->JS
604−jsSTOREOLD _ = JSAssign (JSProj jsMYOLDBASE "addr") jsSTACKBASE
605−
606−jsADDTOP :: CompileInfo -> Int -> JS
607−jsADDTOP info n
608− | 0 <- n = JSNoop
609− | otherwise =
610− JSBinOp "+=" jsSTACKTOP (JSNum (JSInt n))
611−
612−jsTOPBASE :: CompileInfo -> Int -> JS
613−jsTOPBASE _ 0 = JSAssign jsSTACKTOP jsSTACKBASE
614−jsTOPBASE _ n = JSAssign jsSTACKTOP (JSBinOp "+" jsSTACKBASE (JSNum (JSInt n)))
615−
616−
617−jsBASETOP :: CompileInfo -> Int -> JS
618−jsBASETOP _ 0 = JSAssign jsSTACKBASE jsSTACKTOP
619−jsBASETOP _ n = JSAssign jsSTACKBASE (JSBinOp "+" jsSTACKTOP (JSNum (JSInt n)))
620−
621−jsNULL :: CompileInfo -> Reg -> JS
622−jsNULL _ r = JSClear (translateReg r)
623−
624−jsERROR :: CompileInfo -> String -> JS
625−jsERROR _ = JSError
626−
627−jsSLIDE :: CompileInfo -> Int -> JS
628−jsSLIDE _ 1 = JSAssign (jsLOC 0) (jsTOP 0)
629−jsSLIDE _ n = JSApp (JSIdent "i$SLIDE") [JSNum (JSInt n)]
630−
631−jsMKCON :: CompileInfo -> Reg -> Int -> [Reg] -> JS
632−jsMKCON info r t rs =
633− JSAssign (translateReg r) (
634− JSNew "i$CON" [ JSNum (JSInt t)
635− , JSArray (map translateReg rs)
636− , if t `elem` compileInfoApplyCases info
637− then JSIdent $ translateName (sMN 0 "APPLY") ++ "$" ++ show t
638− else JSNull
639− , if t `elem` compileInfoEvalCases info
640− then JSIdent $ translateName (sMN 0 "EVAL") ++ "$" ++ show t
641− else JSNull
642− ]
643− )
644−
645−jsCASE :: CompileInfo -> Bool -> Reg -> [(Int, [BC])] -> Maybe [BC] -> JS
646−jsCASE info safe reg cases def =
647− JSSwitch (tag safe $ translateReg reg) (
648− map ((JSNum . JSInt) *** prepBranch) cases
649− ) (fmap prepBranch def)
650− where
651− tag :: Bool -> JS -> JS
652− tag True = jsCTAG
653− tag False = jsTAG
654−
655− prepBranch :: [BC] -> JS
656− prepBranch bc = JSSeq $ map (translateBC info) bc
657−
658− jsTAG :: JS -> JS
659− jsTAG js =
660− (JSTernary (js `jsInstanceOf` "i$CON") (
661− JSProj js "tag"
662− ) (JSNum (JSInt $ negate 1)))
663−
664− jsCTAG :: JS -> JS
665− jsCTAG js = JSProj js "tag"
666−
667−
668−jsCONSTCASE :: CompileInfo -> Reg -> [(Const, [BC])] -> Maybe [BC] -> JS
669−jsCONSTCASE info reg cases def =
670− JSCond $ (
671− map (jsEq (translateReg reg) . translateConstant *** prepBranch) cases
672− ) ++ (maybe [] ((:[]) . ((,) JSNoop) . prepBranch) def)
673− where
674− prepBranch :: [BC] -> JS
675− prepBranch bc = JSSeq $ map (translateBC info) bc
676−
677−jsPROJECT :: CompileInfo -> Reg -> Int -> Int -> JS
678−jsPROJECT _ reg loc 0 = JSNoop
679−jsPROJECT _ reg loc 1 =
680− JSAssign (jsLOC loc) (
681− JSIndex (
682− JSProj (translateReg reg) "args"
683− ) (
684− JSNum (JSInt 0)
685− )
686− )
687−jsPROJECT _ reg loc ar =
688− JSApp (JSIdent "i$PROJECT") [ translateReg reg
689− , JSNum (JSInt loc)
690− , JSNum (JSInt ar)
691− ]
692−
693−jsOP :: CompileInfo -> Reg -> PrimFn -> [Reg] -> JS
694−jsOP _ reg op args = JSAssign (translateReg reg) jsOP'
695− where
696− jsOP' :: JS
697− jsOP'
698− | LNoOp <- op = translateReg (last args)
699−
700− | LWriteStr <- op,
701− (_:str:_) <- args = JSApp (JSIdent "i$putStr") [translateReg str]
702−
703− | LReadStr <- op = JSApp (JSIdent "i$getLine") []
704−
705− | (LZExt (ITFixed IT8) ITNative) <- op = jsUnPackBits $ translateReg (last args)
706− | (LZExt (ITFixed IT16) ITNative) <- op = jsUnPackBits $ translateReg (last args)
707− | (LZExt (ITFixed IT32) ITNative) <- op = jsUnPackBits $ translateReg (last args)
708−
709− | (LZExt _ ITBig) <- op = jsBigInt $ JSApp (JSIdent "String") [translateReg (last args)]
710− | (LPlus (ATInt ITBig)) <- op
711− , (lhs:rhs:_) <- args = invokeMeth lhs "add" [rhs]
712− | (LMinus (ATInt ITBig)) <- op
713− , (lhs:rhs:_) <- args = invokeMeth lhs "subtract" [rhs]
714− | (LTimes (ATInt ITBig)) <- op
715− , (lhs:rhs:_) <- args = invokeMeth lhs "multiply" [rhs]
716− | (LSDiv (ATInt ITBig)) <- op
717− , (lhs:rhs:_) <- args = invokeMeth lhs "divide" [rhs]
718− | (LSRem (ATInt ITBig)) <- op
719− , (lhs:rhs:_) <- args = invokeMeth lhs "mod" [rhs]
720− | (LEq (ATInt ITBig)) <- op
721− , (lhs:rhs:_) <- args = JSPreOp "+" $ invokeMeth lhs "equals" [rhs]
722− | (LSLt (ATInt ITBig)) <- op
723− , (lhs:rhs:_) <- args = JSPreOp "+" $ invokeMeth lhs "lesser" [rhs]
724− | (LSLe (ATInt ITBig)) <- op
725− , (lhs:rhs:_) <- args = JSPreOp "+" $ invokeMeth lhs "lesserOrEquals" [rhs]
726− | (LSGt (ATInt ITBig)) <- op
727− , (lhs:rhs:_) <- args = JSPreOp "+" $ invokeMeth lhs "greater" [rhs]
728− | (LSGe (ATInt ITBig)) <- op
729− , (lhs:rhs:_) <- args = JSPreOp "+" $ invokeMeth lhs "greaterOrEquals" [rhs]
730−
731− | (LPlus ATFloat) <- op
732− , (lhs:rhs:_) <- args = translateBinaryOp "+" lhs rhs
733− | (LMinus ATFloat) <- op
734− , (lhs:rhs:_) <- args = translateBinaryOp "-" lhs rhs
735− | (LTimes ATFloat) <- op
736− , (lhs:rhs:_) <- args = translateBinaryOp "*" lhs rhs
737− | (LSDiv ATFloat) <- op
738− , (lhs:rhs:_) <- args = translateBinaryOp "/" lhs rhs
739− | (LEq ATFloat) <- op
740− , (lhs:rhs:_) <- args = translateCompareOp "==" lhs rhs
741− | (LSLt ATFloat) <- op
742− , (lhs:rhs:_) <- args = translateCompareOp "<" lhs rhs
743− | (LSLe ATFloat) <- op
744− , (lhs:rhs:_) <- args = translateCompareOp "<=" lhs rhs
745− | (LSGt ATFloat) <- op
746− , (lhs:rhs:_) <- args = translateCompareOp ">" lhs rhs
747− | (LSGe ATFloat) <- op
748− , (lhs:rhs:_) <- args = translateCompareOp ">=" lhs rhs
749−
750− | (LPlus (ATInt ITChar)) <- op
751− , (lhs:rhs:_) <- args =
752− jsCall "i$fromCharCode" [
753− JSBinOp "+" (
754− jsCall "i$charCode" [translateReg lhs]
755− ) (
756− jsCall "i$charCode" [translateReg rhs]
757− )
758− ]
759−
760− | (LTrunc (ITFixed _from) (ITFixed IT8)) <- op
761− , (arg:_) <- args =
762− jsPackUBits8 (
763− JSBinOp "&" (jsUnPackBits $ translateReg arg) (JSNum (JSInt 0xFF))
764− )
765−
766− | (LTrunc (ITFixed _from) (ITFixed IT16)) <- op
767− , (arg:_) <- args =
768− jsPackUBits16 (
769− JSBinOp "&" (jsUnPackBits $ translateReg arg) (JSNum (JSInt 0xFFFF))
770− )
771−
772− | (LTrunc (ITFixed _from) (ITFixed IT32)) <- op
773− , (arg:_) <- args =
774− jsPackUBits32 (
775− jsMeth (jsMeth (translateReg arg) "and" [
776− jsBigInt (JSString $ show 0xFFFFFFFF)
777− ]) "intValue" []
778− )
779−
780− | (LTrunc ITBig (ITFixed IT64)) <- op
781− , (arg:_) <- args =
782− jsMeth (translateReg arg) "and" [
783− jsBigInt (JSString $ show 0xFFFFFFFFFFFFFFFF)
784− ]
785−
786− | (LLSHR (ITFixed IT8)) <- op
787− , (lhs:rhs:_) <- args = jsPackUBits8 $ bitsBinaryOp ">>" lhs rhs
788−
789− | (LLSHR (ITFixed IT16)) <- op
790− , (lhs:rhs:_) <- args = jsPackUBits16 $ bitsBinaryOp ">>" lhs rhs
791−
792− | (LLSHR (ITFixed IT32)) <- op
793− , (lhs:rhs:_) <- args = jsPackUBits32 $ bitsBinaryOp ">>" lhs rhs
794−
795− | (LLSHR (ITFixed IT64)) <- op
796− , (lhs:rhs:_) <- args =
797− jsMeth (translateReg lhs) "shiftRight" [translateReg rhs]
798−
799− | (LSHL (ITFixed IT8)) <- op
800− , (lhs:rhs:_) <- args = jsPackUBits8 $ bitsBinaryOp "<<" lhs rhs
801−
802− | (LSHL (ITFixed IT16)) <- op
803− , (lhs:rhs:_) <- args = jsPackUBits16 $ bitsBinaryOp "<<" lhs rhs
804−
805− | (LSHL (ITFixed IT32)) <- op
806− , (lhs:rhs:_) <- args = jsPackUBits32 $ bitsBinaryOp "<<" lhs rhs
807−
808− | (LSHL (ITFixed IT64)) <- op
809− , (lhs:rhs:_) <- args =
810− jsMeth (jsMeth (translateReg lhs) "shiftLeft" [translateReg rhs]) "and" [
811− jsBigInt (JSString $ show 0xFFFFFFFFFFFFFFFF)
812− ]
813−
814− | (LAnd (ITFixed IT8)) <- op
815− , (lhs:rhs:_) <- args = jsPackUBits8 $ bitsBinaryOp "&" lhs rhs
816−
817− | (LAnd (ITFixed IT16)) <- op
818− , (lhs:rhs:_) <- args = jsPackUBits16 $ bitsBinaryOp "&" lhs rhs
819−
820− | (LAnd (ITFixed IT32)) <- op
821− , (lhs:rhs:_) <- args = jsPackUBits32 $ bitsBinaryOp "&" lhs rhs
822−
823− | (LAnd (ITFixed IT64)) <- op
824− , (lhs:rhs:_) <- args =
825− jsMeth (translateReg lhs) "and" [translateReg rhs]
826−
827− | (LOr (ITFixed IT8)) <- op
828− , (lhs:rhs:_) <- args = jsPackUBits8 $ bitsBinaryOp "|" lhs rhs
829−
830− | (LOr (ITFixed IT16)) <- op
831− , (lhs:rhs:_) <- args = jsPackUBits16 $ bitsBinaryOp "|" lhs rhs
832−
833− | (LOr (ITFixed IT32)) <- op
834− , (lhs:rhs:_) <- args = jsPackUBits32 $ bitsBinaryOp "|" lhs rhs
835−
836− | (LOr (ITFixed IT64)) <- op
837− , (lhs:rhs:_) <- args =
838− jsMeth (translateReg lhs) "or" [translateReg rhs]
839−
840− | (LXOr (ITFixed IT8)) <- op
841− , (lhs:rhs:_) <- args = jsPackUBits8 $ bitsBinaryOp "^" lhs rhs
842−
843− | (LXOr (ITFixed IT16)) <- op
844− , (lhs:rhs:_) <- args = jsPackUBits16 $ bitsBinaryOp "^" lhs rhs
845−
846− | (LXOr (ITFixed IT32)) <- op
847− , (lhs:rhs:_) <- args = jsPackUBits32 $ bitsBinaryOp "^" lhs rhs
848−
849− | (LXOr (ITFixed IT64)) <- op
850− , (lhs:rhs:_) <- args =
851− jsMeth (translateReg lhs) "xor" [translateReg rhs]
852−
853− | (LPlus (ATInt (ITFixed IT8))) <- op
854− , (lhs:rhs:_) <- args = jsPackUBits8 $ bitsBinaryOp "+" lhs rhs
855−
856− | (LPlus (ATInt (ITFixed IT16))) <- op
857− , (lhs:rhs:_) <- args = jsPackUBits16 $ bitsBinaryOp "+" lhs rhs
858−
859− | (LPlus (ATInt (ITFixed IT32))) <- op
860− , (lhs:rhs:_) <- args = jsPackUBits32 $ bitsBinaryOp "+" lhs rhs
861−
862− | (LPlus (ATInt (ITFixed IT64))) <- op
863− , (lhs:rhs:_) <- args =
864− jsMeth (jsMeth (translateReg lhs) "add" [translateReg rhs]) "and" [
865− jsBigInt (JSString $ show 0xFFFFFFFFFFFFFFFF)
866− ]
867−
868− | (LMinus (ATInt (ITFixed IT8))) <- op
869− , (lhs:rhs:_) <- args = jsPackUBits8 $ bitsBinaryOp "-" lhs rhs
870−
871− | (LMinus (ATInt (ITFixed IT16))) <- op
872− , (lhs:rhs:_) <- args = jsPackUBits16 $ bitsBinaryOp "-" lhs rhs
873−
874− | (LMinus (ATInt (ITFixed IT32))) <- op
875− , (lhs:rhs:_) <- args = jsPackUBits32 $ bitsBinaryOp "-" lhs rhs
876−
877− | (LMinus (ATInt (ITFixed IT64))) <- op
878− , (lhs:rhs:_) <- args =
879− jsMeth (jsMeth (translateReg lhs) "subtract" [translateReg rhs]) "and" [
880− jsBigInt (JSString $ show 0xFFFFFFFFFFFFFFFF)
881− ]
882−
883− | (LTimes (ATInt (ITFixed IT8))) <- op
884− , (lhs:rhs:_) <- args = jsPackUBits8 $ bitsBinaryOp "*" lhs rhs
885−
886− | (LTimes (ATInt (ITFixed IT16))) <- op
887− , (lhs:rhs:_) <- args = jsPackUBits16 $ bitsBinaryOp "*" lhs rhs
888−
889− | (LTimes (ATInt (ITFixed IT32))) <- op
890− , (lhs:rhs:_) <- args = jsPackUBits32 $ bitsBinaryOp "*" lhs rhs
891−
892− | (LTimes (ATInt (ITFixed IT64))) <- op
893− , (lhs:rhs:_) <- args =
894− jsMeth (jsMeth (translateReg lhs) "multiply" [translateReg rhs]) "and" [
895− jsBigInt (JSString $ show 0xFFFFFFFFFFFFFFFF)
896− ]
897−
898− | (LEq (ATInt (ITFixed IT8))) <- op
899− , (lhs:rhs:_) <- args = bitsCompareOp "==" lhs rhs
900−
901− | (LEq (ATInt (ITFixed IT16))) <- op
902− , (lhs:rhs:_) <- args = bitsCompareOp "==" lhs rhs
903−
904− | (LEq (ATInt (ITFixed IT32))) <- op
905− , (lhs:rhs:_) <- args = bitsCompareOp "==" lhs rhs
906−
907− | (LEq (ATInt (ITFixed IT64))) <- op
908− , (lhs:rhs:_) <- args = JSPreOp "+" $ invokeMeth lhs "equals" [rhs]
909−
910− | (LLt (ITFixed IT8)) <- op
911− , (lhs:rhs:_) <- args = bitsCompareOp "<" lhs rhs
912−
913− | (LLt (ITFixed IT16)) <- op
914− , (lhs:rhs:_) <- args = bitsCompareOp "<" lhs rhs
915−
916− | (LLt (ITFixed IT32)) <- op
917− , (lhs:rhs:_) <- args = bitsCompareOp "<" lhs rhs
918−
919− | (LLt (ITFixed IT64)) <- op
920− , (lhs:rhs:_) <- args = JSPreOp "+" $ invokeMeth lhs "lesser" [rhs]
921−
922− | (LLe (ITFixed IT8)) <- op
923− , (lhs:rhs:_) <- args = bitsCompareOp "<=" lhs rhs
924−
925− | (LLe (ITFixed IT16)) <- op
926− , (lhs:rhs:_) <- args = bitsCompareOp "<=" lhs rhs
927−
928− | (LLe (ITFixed IT32)) <- op
929− , (lhs:rhs:_) <- args = bitsCompareOp "<=" lhs rhs
930−
931− | (LLe (ITFixed IT64)) <- op
932− , (lhs:rhs:_) <- args = JSPreOp "+" $ invokeMeth lhs "lesserOrEquals" [rhs]
933−
934− | (LGt (ITFixed IT8)) <- op
935− , (lhs:rhs:_) <- args = bitsCompareOp ">" lhs rhs
936−
937− | (LGt (ITFixed IT16)) <- op
938− , (lhs:rhs:_) <- args = bitsCompareOp ">" lhs rhs
939− | (LGt (ITFixed IT32)) <- op
940− , (lhs:rhs:_) <- args = bitsCompareOp ">" lhs rhs
941−
942− | (LGt (ITFixed IT64)) <- op
943− , (lhs:rhs:_) <- args = JSPreOp "+" $ invokeMeth lhs "greater" [rhs]
944−
945− | (LGe (ITFixed IT8)) <- op
946− , (lhs:rhs:_) <- args = bitsCompareOp ">=" lhs rhs
947−
948− | (LGe (ITFixed IT16)) <- op
949− , (lhs:rhs:_) <- args = bitsCompareOp ">=" lhs rhs
950− | (LGe (ITFixed IT32)) <- op
951− , (lhs:rhs:_) <- args = bitsCompareOp ">=" lhs rhs
952−
953− | (LGe (ITFixed IT64)) <- op
954− , (lhs:rhs:_) <- args = JSPreOp "+" $ invokeMeth lhs "greaterOrEquals" [rhs]
955−
956− | (LUDiv (ITFixed IT8)) <- op
957− , (lhs:rhs:_) <- args =
958− jsPackUBits8 (
959− JSBinOp "/" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
960− )
961−
962− | (LUDiv (ITFixed IT16)) <- op
963− , (lhs:rhs:_) <- args =
964− jsPackUBits16 (
965− JSBinOp "/" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
966− )
967−
968− | (LUDiv (ITFixed IT32)) <- op
969− , (lhs:rhs:_) <- args =
970− jsPackUBits32 (
971− JSBinOp "/" (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
972− )
973−
974− | (LUDiv (ITFixed IT64)) <- op
975− , (lhs:rhs:_) <- args = invokeMeth lhs "divide" [rhs]
976−
977− | (LSDiv (ATInt (ITFixed IT8))) <- op
978− , (lhs:rhs:_) <- args =
979− jsPackSBits8 (
980− JSBinOp "/" (
981− jsUnPackBits $ jsPackSBits8 $ jsUnPackBits (translateReg lhs)
982− ) (
983− jsUnPackBits $ jsPackSBits8 $ jsUnPackBits (translateReg rhs)
984− )
985− )
986−
987− | (LSDiv (ATInt (ITFixed IT16))) <- op
988− , (lhs:rhs:_) <- args =
989− jsPackSBits16 (
990− JSBinOp "/" (
991− jsUnPackBits $ jsPackSBits16 $ jsUnPackBits (translateReg lhs)
992− ) (
993− jsUnPackBits $ jsPackSBits16 $ jsUnPackBits (translateReg rhs)
994− )
995− )
996−
997− | (LSDiv (ATInt (ITFixed IT32))) <- op
998− , (lhs:rhs:_) <- args =
999− jsPackSBits32 (
1000− JSBinOp "/" (
1001− jsUnPackBits $ jsPackSBits32 $ jsUnPackBits (translateReg lhs)
1002− ) (
1003− jsUnPackBits $ jsPackSBits32 $ jsUnPackBits (translateReg rhs)
1004− )
1005− )
1006−
1007− | (LSDiv (ATInt (ITFixed IT64))) <- op
1008− , (lhs:rhs:_) <- args = invokeMeth lhs "divide" [rhs]
1009−
1010− | (LSRem (ATInt (ITFixed IT8))) <- op
1011− , (lhs:rhs:_) <- args =
1012− jsPackSBits8 (
1013− JSBinOp "%" (
1014− jsUnPackBits $ jsPackSBits8 $ jsUnPackBits (translateReg lhs)
1015− ) (
1016− jsUnPackBits $ jsPackSBits8 $ jsUnPackBits (translateReg rhs)
1017− )
1018− )
1019−
1020− | (LSRem (ATInt (ITFixed IT16))) <- op
1021− , (lhs:rhs:_) <- args =
1022− jsPackSBits16 (
1023− JSBinOp "%" (
1024− jsUnPackBits $ jsPackSBits16 $ jsUnPackBits (translateReg lhs)
1025− ) (
1026− jsUnPackBits $ jsPackSBits16 $ jsUnPackBits (translateReg rhs)
1027− )
1028− )
1029−
1030− | (LSRem (ATInt (ITFixed IT32))) <- op
1031− , (lhs:rhs:_) <- args =
1032− jsPackSBits32 (
1033− JSBinOp "%" (
1034− jsUnPackBits $ jsPackSBits32 $ jsUnPackBits (translateReg lhs)
1035− ) (
1036− jsUnPackBits $ jsPackSBits32 $ jsUnPackBits (translateReg rhs)
1037− )
1038− )
1039−
1040− | (LSRem (ATInt (ITFixed IT64))) <- op
1041− , (lhs:rhs:_) <- args = invokeMeth lhs "mod" [rhs]
1042−
1043− | (LCompl (ITFixed IT8)) <- op
1044− , (arg:_) <- args =
1045− jsPackSBits8 $ JSPreOp "~" $ jsUnPackBits (translateReg arg)
1046−
1047− | (LCompl (ITFixed IT16)) <- op
1048− , (arg:_) <- args =
1049− jsPackSBits16 $ JSPreOp "~" $ jsUnPackBits (translateReg arg)
1050−
1051− | (LCompl (ITFixed IT32)) <- op
1052− , (arg:_) <- args =
1053− jsPackSBits32 $ JSPreOp "~" $ jsUnPackBits (translateReg arg)
1054−
1055− | (LCompl (ITFixed IT64)) <- op
1056− , (arg:_) <- args = invokeMeth arg "not" []
1057−
1058− | (LPlus _) <- op
1059− , (lhs:rhs:_) <- args = translateBinaryOp "+" lhs rhs
1060− | (LMinus _) <- op
1061− , (lhs:rhs:_) <- args = translateBinaryOp "-" lhs rhs
1062− | (LTimes _) <- op
1063− , (lhs:rhs:_) <- args = translateBinaryOp "*" lhs rhs
1064− | (LSDiv _) <- op
1065− , (lhs:rhs:_) <- args = translateBinaryOp "/" lhs rhs
1066− | (LSRem _) <- op
1067− , (lhs:rhs:_) <- args = translateBinaryOp "%" lhs rhs
1068− | (LEq _) <- op
1069− , (lhs:rhs:_) <- args = translateCompareOp "==" lhs rhs
1070− | (LSLt _) <- op
1071− , (lhs:rhs:_) <- args = translateCompareOp "<" lhs rhs
1072− | (LSLe _) <- op
1073− , (lhs:rhs:_) <- args = translateCompareOp "<=" lhs rhs
1074− | (LSGt _) <- op
1075− , (lhs:rhs:_) <- args = translateCompareOp ">" lhs rhs
1076− | (LSGe _) <- op
1077− , (lhs:rhs:_) <- args = translateCompareOp ">=" lhs rhs
1078− | (LAnd _) <- op
1079− , (lhs:rhs:_) <- args = translateBinaryOp "&" lhs rhs
1080− | (LOr _) <- op
1081− , (lhs:rhs:_) <- args = translateBinaryOp "|" lhs rhs
1082− | (LXOr _) <- op
1083− , (lhs:rhs:_) <- args = translateBinaryOp "^" lhs rhs
1084− | (LSHL _) <- op
1085− , (lhs:rhs:_) <- args = translateBinaryOp "<<" rhs lhs
1086− | (LASHR _) <- op
1087− , (lhs:rhs:_) <- args = translateBinaryOp ">>" rhs lhs
1088− | (LCompl _) <- op
1089− , (arg:_) <- args = JSPreOp "~" (translateReg arg)
1090−
1091− | LStrConcat <- op
1092− , (lhs:rhs:_) <- args = translateBinaryOp "+" lhs rhs
1093− | LStrEq <- op
1094− , (lhs:rhs:_) <- args = translateCompareOp "==" lhs rhs
1095− | LStrLt <- op
1096− , (lhs:rhs:_) <- args = translateCompareOp "<" lhs rhs
1097− | LStrLen <- op
1098− , (arg:_) <- args = JSProj (translateReg arg) "length"
1099− | (LStrInt ITNative) <- op
1100− , (arg:_) <- args = jsCall "parseInt" [translateReg arg]
1101− | (LIntStr ITNative) <- op
1102− , (arg:_) <- args = jsCall "String" [translateReg arg]
1103− | (LSExt ITNative ITBig) <- op
1104− , (arg:_) <- args = jsBigInt $ jsCall "String" [translateReg arg]
1105− | (LTrunc ITBig ITNative) <- op
1106− , (arg:_) <- args = jsMeth (translateReg arg) "intValue" []
1107− | (LIntStr ITBig) <- op
1108− , (arg:_) <- args = jsMeth (translateReg arg) "toString" []
1109− | (LStrInt ITBig) <- op
1110− , (arg:_) <- args = jsBigInt $ translateReg arg
1111− | LFloatStr <- op
1112− , (arg:_) <- args = jsCall "String" [translateReg arg]
1113− | LStrFloat <- op
1114− , (arg:_) <- args = jsCall "parseFloat" [translateReg arg]
1115− | (LIntFloat ITNative) <- op
1116− , (arg:_) <- args = translateReg arg
1117− | (LIntFloat ITBig) <- op
1118− , (arg:_) <- args = jsMeth (translateReg arg) "intValue" []
1119− | (LFloatInt ITNative) <- op
1120− , (arg:_) <- args = translateReg arg
1121− | (LChInt ITNative) <- op
1122− , (arg:_) <- args = jsCall "i$charCode" [translateReg arg]
1123− | (LIntCh ITNative) <- op
1124− , (arg:_) <- args = jsCall "i$fromCharCode" [translateReg arg]
1125−
1126− | LFExp <- op
1127− , (arg:_) <- args = jsCall "Math.exp" [translateReg arg]
1128− | LFLog <- op
1129− , (arg:_) <- args = jsCall "Math.log" [translateReg arg]
1130− | LFSin <- op
1131− , (arg:_) <- args = jsCall "Math.sin" [translateReg arg]
1132− | LFCos <- op
1133− , (arg:_) <- args = jsCall "Math.cos" [translateReg arg]
1134− | LFTan <- op
1135− , (arg:_) <- args = jsCall "Math.tan" [translateReg arg]
1136− | LFASin <- op
1137− , (arg:_) <- args = jsCall "Math.asin" [translateReg arg]
1138− | LFACos <- op
1139− , (arg:_) <- args = jsCall "Math.acos" [translateReg arg]
1140− | LFATan <- op
1141− , (arg:_) <- args = jsCall "Math.atan" [translateReg arg]
1142− | LFSqrt <- op
1143− , (arg:_) <- args = jsCall "Math.sqrt" [translateReg arg]
1144− | LFFloor <- op
1145− , (arg:_) <- args = jsCall "Math.floor" [translateReg arg]
1146− | LFCeil <- op
1147− , (arg:_) <- args = jsCall "Math.ceil" [translateReg arg]
1148− | LFNegate <- op
1149− , (arg:_) <- args = JSPreOp "-" (translateReg arg)
1150−
1151− | LStrCons <- op
1152− , (lhs:rhs:_) <- args = invokeMeth lhs "concat" [rhs]
1153− | LStrHead <- op
1154− , (arg:_) <- args = JSIndex (translateReg arg) (JSNum (JSInt 0))
1155− | LStrRev <- op
1156− , (arg:_) <- args = JSProj (translateReg arg) "split('').reverse().join('')"
1157− | LStrIndex <- op
1158− , (lhs:rhs:_) <- args = JSIndex (translateReg lhs) (translateReg rhs)
1159− | LStrTail <- op
1160− , (arg:_) <- args =
1161− let v = translateReg arg in
1162− JSApp (JSProj v "substr") [
1163− JSNum (JSInt 1),
1164− JSBinOp "-" (JSProj v "length") (JSNum (JSInt 1))
1165− ]
1166− | LStrSubstr <- op
1167− , (offset:length:string:_) <- args =
1168− let off = translateReg offset
1169− len = translateReg length
1170− str = translateReg string
1171− in JSApp (JSProj str "substr") [
1172− jsCall "Math.max" [JSNum (JSInt 0), off],
1173− jsCall "Math.max" [JSNum (JSInt 0), len]
1174− ]
1175−
1176− | LSystemInfo <- op
1177− , (arg:_) <- args = jsCall "i$systemInfo" [translateReg arg]
1178− | LExternal nul <- op
1179− , nul == sUN "prim__null"
1180− , _ <- args = JSNull
1181− | LExternal ex <- op
1182− , ex == sUN "prim__eqPtr"
1183− , [lhs, rhs] <- args = translateCompareOp "==" lhs rhs
1184− | otherwise = JSError $ "Not implemented: " ++ show op
1185− where
1186− translateBinaryOp :: String -> Reg -> Reg -> JS
1187− translateBinaryOp op lhs rhs =
1188− JSBinOp op (translateReg lhs) (translateReg rhs)
1189−
1190− translateCompareOp :: String -> Reg -> Reg -> JS
1191− translateCompareOp op lhs rhs =
1192− JSPreOp "+" $ translateBinaryOp op lhs rhs
1193−
1194− bitsBinaryOp :: String -> Reg -> Reg -> JS
1195− bitsBinaryOp op lhs rhs =
1196− JSBinOp op (jsUnPackBits (translateReg lhs)) (jsUnPackBits (translateReg rhs))
1197−
1198− bitsCompareOp :: String -> Reg -> Reg -> JS
1199− bitsCompareOp op lhs rhs =
1200− JSPreOp "+" $ bitsBinaryOp op lhs rhs
1201−
1202− invokeMeth :: Reg -> String -> [Reg] -> JS
1203− invokeMeth obj meth args =
1204− JSApp (JSProj (translateReg obj) meth) $ map translateReg args
1205−
1206−
1207−jsRESERVE :: CompileInfo -> Int -> JS
1208−jsRESERVE _ _ = JSNoop
1209−
1210−jsSTACK :: JS
1211−jsSTACK = JSIdent "i$valstack"
1212−
1213−jsCALLSTACK :: JS
1214−jsCALLSTACK = JSIdent "i$callstack"
1215−
1216−jsSTACKBASE :: JS
1217−jsSTACKBASE = JSIdent "i$valstack_base"
1218−
1219−jsSTACKTOP :: JS
1220−jsSTACKTOP = JSIdent "i$valstack_top"
1221−
1222−jsOLDBASE :: JS
1223−jsOLDBASE = JSIdent "oldbase"
1224−
1225−jsMYOLDBASE :: JS
1226−jsMYOLDBASE = JSIdent "myoldbase"
1227−
1228−jsRET :: JS
1229−jsRET = JSIdent "i$ret"
1230−
1231−jsLOC :: Int -> JS
1232−jsLOC 0 = JSIndex jsSTACK jsSTACKBASE
1233−jsLOC n = JSIndex jsSTACK (JSBinOp "+" jsSTACKBASE (JSNum (JSInt n)))
1234−
1235−jsTOP :: Int -> JS
1236−jsTOP 0 = JSIndex jsSTACK jsSTACKTOP
1237−jsTOP n = JSIndex jsSTACK (JSBinOp "+" jsSTACKTOP (JSNum (JSInt n)))
1238−
1239−jsPUSH :: [JS] -> JS
1240−jsPUSH args = JSApp (JSProj jsCALLSTACK "push") args
1241−
1242−jsPOP :: JS
1243−jsPOP = JSApp (JSProj jsCALLSTACK "pop") []
1244−
1245−genInterface :: Export -> JS
1246−genInterface (ExportData name) = JSNoop
1247−genInterface (ExportFun name (FStr jsName) ret args) = JSAlloc jsName
1248− (Just (JSFunction [] (JSSeq $
1249− jsFUNPRELUDE ++
1250− pushArgs nargs ++
1251− [jsSTOREOLD d,
1252− jsBASETOP d 0,
1253− jsADDTOP d nargs,
1254− jsCALL d name] ++
1255− retval ret)))
1256− where
1257− nargs = length args
1258− d = CompileInfo [] [] False
1259− pushArg n = JSAssign (jsTOP n) (JSIndex (JSIdent "arguments") (JSNum (JSInt n)))
1260− pushArgs 0 = []
1261− pushArgs n = (pushArg (n-1)):pushArgs (n-1)
1262− retval (FIO t) = [JSApp (JSIdent "i$RUN") [],
1263− JSAssign (jsTOP 0) JSNull,
1264− JSAssign (jsTOP 1) JSNull,
1265− JSAssign (jsTOP 2) (translateReg RVal),
1266− jsSTOREOLD d,
1267− jsBASETOP d 0,
1268− jsADDTOP d 3,
1269− jsCALL d (sUN "call__IO")] ++ retval t
1270− retval t = [JSApp (JSIdent "i$RUN") [], JSReturn (translateReg RVal)]
1271−
1272−translateBC :: CompileInfo -> BC -> JS
1273−translateBC info bc
1274− | ASSIGN r1 r2 <- bc = jsASSIGN info r1 r2
1275− | ASSIGNCONST r c <- bc = jsASSIGNCONST info r c
1276− | UPDATE r1 r2 <- bc = jsASSIGN info r1 r2
1277− | ADDTOP n <- bc = jsADDTOP info n
1278− | NULL r <- bc = jsNULL info r
1279− | CALL n <- bc = jsCALL info n
1280− | TAILCALL n <- bc = jsTAILCALL info n
1281− | FOREIGNCALL r _ (FStr n) args
1282− <- bc = jsFOREIGN info r n (map fcall args)
1283− | FOREIGNCALL _ _ _ _ <- bc = error "JS FFI call not statically known"
1284− | TOPBASE n <- bc = jsTOPBASE info n
1285− | BASETOP n <- bc = jsBASETOP info n
1286− | STOREOLD <- bc = jsSTOREOLD info
1287− | SLIDE n <- bc = jsSLIDE info n
1288− | REBASE <- bc = jsREBASE info
1289− | RESERVE n <- bc = jsRESERVE info n
1290− | MKCON r _ t rs <- bc = jsMKCON info r t rs
1291− | CASE s r c d <- bc = jsCASE info s r c d
1292− | CONSTCASE r c d <- bc = jsCONSTCASE info r c d
1293− | PROJECT r l a <- bc = jsPROJECT info r l a
1294− | OP r o a <- bc = jsOP info r o a
1295− | ERROR e <- bc = jsERROR info e
1296− | otherwise = JSRaw $ "//" ++ show bc
1297− where fcall (t, arg) = (toFType t, arg)
1298−
1299−toAType (FCon i)
1300− | i == sUN "JS_IntChar" = ATInt ITChar
1301− | i == sUN "JS_IntNative" = ATInt ITNative
1302−toAType t = error (show t ++ " not defined in toAType")
1303−
1304−toFnType (FApp c [_,_,s,t])
1305− | c == sUN "JS_Fn" = toFnType t
1306−toFnType (FApp c [_,_,r])
1307− | c == sUN "JS_FnIO" = FFunctionIO
1308−toFnType (FApp c [_,r])
1309− | c == sUN "JS_FnBase" = FFunction
1310−toFnType t = error (show t ++ " not defined in toFnType")
1311−
1312−toFType (FCon c)
1313− | c == sUN "JS_Str" = FString
1314− | c == sUN "JS_Float" = FArith ATFloat
1315− | c == sUN "JS_Ptr" = FPtr
1316− | c == sUN "JS_Unit" = FUnit
1317−toFType (FApp c [_,ity])
1318− | c == sUN "JS_IntT" = FArith (toAType ity)
1319−toFType (FApp c [_,fty])
1320− | c == sUN "JS_FnT" = toFnType fty
1321−toFType t = error (show t ++ " not yet defined in toFType")
89+ do
90+ codegenJs (CGConf { header = "#!/usr/bin/env node\n"
91+ , footer = ""
92+ , initialization = initializationNode
93+ , writeStrTemplate = "fs.writeSync(1,%0)"
94+ , readStrTemplate = "js_idris_readStr()"
95+ , extraRunTime = "Runtime-node.js"
96+ }
97+ )
98+ ci
99+ setPermissions (outputFile ci) (emptyPermissions { readable = True
100+ , executable = True
101+ , writable = True
102+ })
src/IRTS/JavaScript/AST.hs+178−399
@@ -1,409 +1,188 @@
11{-|
22Module : IRTS.JavaScript.AST
3−Description : Data structures and functions used with the JavaScript codegen.
3+Description : AST for javascrit
44Copyright :
55License : BSD3
66Maintainer : The Idris Community.
77-}
8−{-# LANGUAGE OverloadedStrings, PatternGuards #-}
9−module IRTS.JavaScript.AST where
8+{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, PatternGuards #-}
109
11−import Data.Char (isDigit)
12−import qualified Data.Text as T
13−import Data.Word
14−
15−data JSType = JSIntTy
16− | JSStringTy
17− | JSIntegerTy
18− | JSFloatTy
19− | JSCharTy
20− | JSPtrTy
21− | JSForgotTy
22− deriving Eq
23−
24−
25−data JSInteger = JSBigZero
26− | JSBigOne
27− | JSBigInt Integer
28− | JSBigIntExpr JS
29− deriving Eq
30−
31−
32−data JSNum = JSInt Int
33− | JSFloat Double
34− | JSInteger JSInteger
35− deriving Eq
36−
37−
38−data JSWord = JSWord8 Word8
39− | JSWord16 Word16
40− | JSWord32 Word32
41− | JSWord64 Word64
42− deriving Eq
43−
44−
45−data JSAnnotation = JSConstructor deriving Eq
10+module IRTS.JavaScript.AST( JsAST(..)
11+ , jsAst2Text
12+ ) where
4613
47−
48−instance Show JSAnnotation where
49− show JSConstructor = "constructor"
50−
51−
52−data JS = JSRaw String
53− | JSIdent String
54− | JSFunction [String] JS
55− | JSType JSType
56− | JSSeq [JS]
57− | JSReturn JS
58− | JSApp JS [JS]
59− | JSNew String [JS]
60− | JSError String
61− | JSBinOp String JS JS
62− | JSPreOp String JS
63− | JSPostOp String JS
64− | JSProj JS String
65− | JSNull
66− | JSUndefined
67− | JSThis
68− | JSTrue
69− | JSFalse
70− | JSArray [JS]
71− | JSString String
72− | JSNum JSNum
73− | JSWord JSWord
74− | JSAssign JS JS
75− | JSAlloc String (Maybe JS)
76− | JSIndex JS JS
77− | JSSwitch JS [(JS, JS)] (Maybe JS)
78− | JSCond [(JS, JS)]
79− | JSTernary JS JS JS
80− | JSParens JS
81− | JSWhile JS JS
82− | JSFFI String [JS]
83− | JSAnnotation JSAnnotation JS
84− | JSDelete JS
85− | JSClear JS
86− | JSNoop
87− deriving Eq
88−
89−
90−data FFI = FFICode Char | FFIArg Int | FFIError String
91−
92−ffi :: String -> [String] -> T.Text
93−ffi code args = let parsed = ffiParse code in
94− case ffiError parsed of
95− Just err -> error err
96− Nothing -> renderFFI parsed args
14+import Data.Char
15+import Data.Data
16+import Data.Text (Text)
17+import qualified Data.Text as T
18+import Numeric
19+
20+data JsAST = JsEmpty
21+ | JsNull
22+ | JsLambda [Text] JsAST
23+ | JsCurryLambda [Text] JsAST
24+ | JsFun Text [Text] JsAST
25+ | JsReturn JsAST
26+ | JsApp Text [JsAST]
27+ | JsCurryApp JsAST [JsAST]
28+ | JsMethod JsAST Text [JsAST]
29+ | JsVar Text
30+ | JsSeq JsAST JsAST
31+ | JsConst Text JsAST
32+ | JsLet Text JsAST
33+ | JsSetVar Text JsAST
34+ | JsArrayProj JsAST JsAST
35+ | JsNum Double
36+ | JsInt Int
37+ | JsStr String
38+ | JsArray [JsAST]
39+ | JsSwitchCase JsAST [(JsAST, JsAST)] (Maybe JsAST)
40+ | JsError JsAST
41+ | JsErrorExp JsAST
42+ | JsBinOp Text JsAST JsAST
43+ | JsForeign Text [JsAST]
44+ | JsWhileTrue JsAST
45+ | JsContinue
46+ | JsBreak
47+ | JsTrue
48+ | JsComment Text
49+ | JsForce JsAST
50+ | JsLazy JsAST
51+ deriving (Show, Eq, Data, Typeable)
52+
53+
54+translateChar :: Char -> String
55+translateChar ch
56+ | '\a' <- ch = "\\u0007"
57+ | '\b' <- ch = "\\b"
58+ | '\f' <- ch = "\\f"
59+ | '\n' <- ch = "\\n"
60+ | '\r' <- ch = "\\r"
61+ | '\t' <- ch = "\\t"
62+ | '\v' <- ch = "\\v"
63+ | '\SO' <- ch = "\\u000E"
64+ | '\DEL' <- ch = "\\u007F"
65+ | '\\' <- ch = "\\\\"
66+ | '\"' <- ch = "\\\""
67+ | '\'' <- ch = "\\\'"
68+ | ch `elem` asciiTab = "\\u" ++ fill (showHex (ord ch) "")
69+ | ord ch > 255 = "\\u" ++ fill (showHex (ord ch) "")
70+ | otherwise = [ch]
9771 where
98− ffiParse :: String -> [FFI]
99− ffiParse "" = []
100− ffiParse ['%'] = [FFIError "FFI - Invalid positional argument"]
101− ffiParse ('%':'%':ss) = FFICode '%' : ffiParse ss
102− ffiParse ('%':s:ss)
103− | isDigit s =
104− FFIArg (
105− read $ s : takeWhile isDigit ss
106− ) : ffiParse (dropWhile isDigit ss)
107− | otherwise =
108− [FFIError "FFI - Invalid positional argument"]
109− ffiParse (s:ss) = FFICode s : ffiParse ss
110−
111−
112− ffiError :: [FFI] -> Maybe String
113− ffiError [] = Nothing
114− ffiError ((FFIError s):xs) = Just s
115− ffiError (x:xs) = ffiError xs
116−
117−
118− renderFFI :: [FFI] -> [String] -> T.Text
119− renderFFI [] _ = ""
120− renderFFI (FFICode c : fs) args = c `T.cons` renderFFI fs args
121− renderFFI (FFIArg i : fs) args
122− | i < length args && i >= 0 =
123− T.pack (args !! i)
124− `T.append` renderFFI fs args
125− | otherwise = error "FFI - Argument index out of bounds"
126−
127−compileJS :: JS -> T.Text
128−compileJS = compileJS' 0
129−
130−compileJS' :: Int -> JS -> T.Text
131−compileJS' indent JSNoop = ""
132−
133−compileJS' indent (JSAnnotation annotation js) =
134− "/** @"
135− `T.append` T.pack (show annotation)
136− `T.append` " */\n"
137− `T.append` compileJS' indent js
138−
139−compileJS' indent (JSDelete js) =
140− "delete " `T.append` compileJS' 0 js
141−
142−compileJS' indent (JSClear js) =
143− compileJS' 0 js `T.append` " = undefined"
144−
145−compileJS' indent (JSFFI raw args) =
146− ffi raw (map (T.unpack . compileJS' indent) args)
147−
148−compileJS' indent (JSRaw code) =
149− T.pack code
150−
151−compileJS' indent (JSIdent ident) =
152− T.pack ident
153−
154−compileJS' indent (JSFunction args body) =
155− T.replicate indent " " `T.append` "function("
156− `T.append` T.intercalate "," (map T.pack args)
157− `T.append` "){\n"
158− `T.append` compileJS' (indent + 2) body
159− `T.append` "\n}\n"
160−
161−compileJS' indent (JSType ty)
162− | JSIntTy <- ty = "i$Int"
163− | JSStringTy <- ty = "i$String"
164− | JSIntegerTy <- ty = "i$Integer"
165− | JSFloatTy <- ty = "i$Float"
166− | JSCharTy <- ty = "i$Char"
167− | JSPtrTy <- ty = "i$Ptr"
168− | JSForgotTy <- ty = "i$Forgot"
169−
170−compileJS' indent (JSSeq seq) =
171− T.intercalate ";\n" (
172− map (
173− (T.replicate indent " " `T.append`) . (compileJS' indent)
174− ) $ filter (/= JSNoop) seq
175− ) `T.append` ";"
176−
177−compileJS' indent (JSReturn val) =
178− "return " `T.append` compileJS' indent val
179−
180−compileJS' indent (JSApp lhs rhs)
181− | JSFunction {} <- lhs =
182− T.concat ["(", compileJS' indent lhs, ")(", args, ")"]
183− | otherwise =
184− T.concat [compileJS' indent lhs, "(", args, ")"]
185− where args :: T.Text
186− args = T.intercalate "," $ map (compileJS' 0) rhs
187−
188−compileJS' indent (JSNew name args) =
189− "new "
190− `T.append` T.pack name
191− `T.append` "("
192− `T.append` T.intercalate "," (map (compileJS' 0) args)
193− `T.append` ")"
194−
195−compileJS' indent (JSError exc) =
196− "(function(){throw new Error(\"" `T.append` T.pack exc `T.append` "\")})()"
197−
198−compileJS' indent (JSBinOp op lhs rhs) =
199− compileJS' indent lhs
200− `T.append` " "
201− `T.append` T.pack op
202− `T.append` " "
203− `T.append` compileJS' indent rhs
204−
205−compileJS' indent (JSPreOp op val) =
206− T.pack op `T.append` "(" `T.append` compileJS' indent val `T.append` ")"
207−
208−compileJS' indent (JSProj obj field)
209− | JSFunction {} <- obj =
210− T.concat ["(", compileJS' indent obj, ").", T.pack field]
211− | JSAssign {} <- obj =
212− T.concat ["(", compileJS' indent obj, ").", T.pack field]
213− | otherwise =
214− compileJS' indent obj `T.append` ('.' `T.cons` T.pack field)
215−
216−compileJS' indent JSNull =
217− "null"
218−
219−compileJS' indent JSUndefined =
220− "undefined"
221−
222−compileJS' indent JSThis =
223− "this"
224−
225−compileJS' indent JSTrue =
72+ fill :: String -> String
73+ fill s = case length s of
74+ 1 -> "000" ++ s
75+ 2 -> "00" ++ s
76+ 3 -> "0" ++ s
77+ _ -> s
78+
79+ asciiTab =
80+ ['\NUL', '\SOH', '\STX', '\ETX', '\EOT', '\ENQ', '\ACK', '\BEL',
81+ '\BS', '\HT', '\LF', '\VT', '\FF', '\CR', '\SO', '\SI',
82+ '\DLE', '\DC1', '\DC2', '\DC3', '\DC4', '\NAK', '\SYN', '\ETB',
83+ '\CAN', '\EM', '\SUB', '\ESC', '\FS', '\GS', '\RS', '\US']
84+
85+indent :: Text -> Text
86+indent x =
87+ let l = T.lines x
88+ il = map (\y -> T.replicate 3 " " `T.append` y) l
89+ in T.unlines il
90+
91+curryDef :: [Text] -> JsAST -> Text
92+curryDef [] body =
93+ jsAst2Text body
94+curryDef (x:xs) body =
95+ T.concat [ "(function", "(", x, "){return "
96+ , curryDef xs body
97+ , "})"
98+ ]
99+
100+
101+jsAst2Text :: JsAST -> Text
102+jsAst2Text JsEmpty = ""
103+jsAst2Text JsNull = "null"
104+jsAst2Text (JsLambda args body) =
105+ T.concat [ "(function", "(", T.intercalate ", " args , "){"
106+ , jsAst2Text body
107+ , "})"
108+ ]
109+jsAst2Text (JsCurryLambda args body) = curryDef args body
110+jsAst2Text (JsFun name args body) =
111+ T.concat [ "var ", name, " = function(", T.intercalate ", " args , "){\n"
112+ , indent $ jsAst2Text body
113+ , "}\n"
114+ ]
115+jsAst2Text (JsReturn x) = T.concat [ "return ", jsAst2Text x]
116+jsAst2Text (JsApp fn args) = T.concat [fn, "(", T.intercalate ", " $ map jsAst2Text args, ")"]
117+jsAst2Text (JsCurryApp fn []) = jsAst2Text fn
118+jsAst2Text (JsCurryApp fn args) = T.concat [jsAst2Text fn, "(", T.intercalate ")(" $ map jsAst2Text args, ")"]
119+jsAst2Text (JsMethod obj name args) =
120+ T.concat [ jsAst2Text obj
121+ , "."
122+ , name, "("
123+ , T.intercalate ", " $ map jsAst2Text args
124+ , ")"
125+ ]
126+jsAst2Text (JsVar x) = x
127+jsAst2Text (JsSeq JsEmpty y) = jsAst2Text y
128+jsAst2Text (JsSeq x JsEmpty) = jsAst2Text x
129+jsAst2Text (JsSeq x y) = T.concat [jsAst2Text x, ";\n", jsAst2Text y]
130+jsAst2Text (JsConst name exp) = T.concat [ "var ", name, " = ", jsAst2Text exp] -- using var instead of const until ES6
131+jsAst2Text (JsLet name exp) = T.concat [ "var ", name, " = ", jsAst2Text exp] -- using var instead of let until ES6
132+jsAst2Text (JsSetVar name exp) = T.concat [ name, " = ", jsAst2Text exp]
133+jsAst2Text (JsArrayProj i exp) = T.concat [ jsAst2Text exp, "[", jsAst2Text i, "]"]
134+jsAst2Text (JsInt i) = T.pack $ show i ++ "|0"
135+jsAst2Text (JsNum d) = T.pack $ show d
136+jsAst2Text (JsStr s) = "\"" `T.append` T.pack (concatMap translateChar s) `T.append` "\""
137+jsAst2Text (JsArray l) = T.concat [ "[", T.intercalate ", " (map jsAst2Text l), "]"]
138+jsAst2Text (JsSwitchCase exp l d) =
139+ T.concat [ "switch(", jsAst2Text exp, "){\n"
140+ , indent $ T.concat $ map case2Text l
141+ , indent $ default2Text d
142+ , "}\n"
143+ ]
144+jsAst2Text (JsError t) =
145+ T.concat ["throw new Error( ", jsAst2Text t, ")"]
146+jsAst2Text (JsErrorExp t) =
147+ T.concat ["js_idris_throw2(new Error( ", jsAst2Text t, "))"]
148+jsAst2Text (JsBinOp op a1 a2) =
149+ T.concat ["(", jsAst2Text a1," ", op, " ",jsAst2Text a2, ")"]
150+jsAst2Text (JsForeign code args) =
151+ let args_repl c i [] = c
152+ args_repl c i (t:r) = args_repl (T.replace ("%" `T.append` T.pack (show i)) t c) (i+1) r
153+ in T.concat ["(", args_repl code 0 (map jsAst2Text args), ")"]
154+jsAst2Text (JsWhileTrue w) =
155+ T.concat [ "while(true){\n"
156+ , indent $ jsAst2Text w
157+ , "}\n"
158+ ]
159+jsAst2Text JsContinue =
160+ "continue"
161+jsAst2Text JsBreak =
162+ "break"
163+jsAst2Text JsTrue =
226164 "true"
227−
228−compileJS' indent JSFalse =
229− "false"
230−
231−compileJS' indent (JSArray elems) =
232− "[" `T.append` T.intercalate "," (map (compileJS' 0) elems) `T.append` "]"
233−
234−compileJS' indent (JSString str) =
235− "\"" `T.append` T.pack str `T.append` "\""
236−
237−compileJS' indent (JSNum num)
238− | JSInt i <- num = T.pack (show i)
239− | JSFloat f <- num = T.pack (show f)
240− | JSInteger JSBigZero <- num = T.pack "i$ZERO"
241− | JSInteger JSBigOne <- num = T.pack "i$ONE"
242− | JSInteger (JSBigInt i) <- num = T.pack (show i)
243− | JSInteger (JSBigIntExpr e) <- num =
244− "i$bigInt(" `T.append` compileJS' indent e `T.append` ")"
245−
246−compileJS' indent (JSAssign lhs rhs) =
247− compileJS' indent lhs `T.append` " = " `T.append` compileJS' indent rhs
248−
249−compileJS' 0 (JSAlloc name (Just val@(JSNew _ _))) =
250− "var "
251− `T.append` T.pack name
252− `T.append` " = "
253− `T.append` compileJS' 0 val
254− `T.append` ";\n"
255−
256−compileJS' indent (JSAlloc name val) =
257− "var "
258− `T.append` T.pack name
259− `T.append` maybe "" ((" = " `T.append`) . compileJS' indent) val
260−
261−compileJS' indent (JSIndex lhs rhs) =
262− compileJS' indent lhs
263− `T.append` "["
264− `T.append` compileJS' indent rhs
265− `T.append` "]"
266−
267−compileJS' indent (JSCond branches) =
268− T.intercalate " else " $ map createIfBlock branches
269− where
270− createIfBlock (JSNoop, e@(JSSeq _)) =
271− "{\n"
272− `T.append` compileJS' (indent + 2) e
273− `T.append` "\n" `T.append` T.replicate indent " " `T.append` "}"
274− createIfBlock (JSNoop, e) =
275− "{\n"
276− `T.append` compileJS' (indent + 2) e
277− `T.append` ";\n" `T.append` T.replicate indent " " `T.append` "}"
278− createIfBlock (cond, e@(JSSeq _)) =
279− "if (" `T.append` compileJS' indent cond `T.append`") {\n"
280− `T.append` compileJS' (indent + 2) e
281− `T.append` "\n" `T.append` T.replicate indent " " `T.append` "}"
282− createIfBlock (cond, e) =
283− "if (" `T.append` compileJS' indent cond `T.append`") {\n"
284− `T.append` T.replicate (indent + 2) " "
285− `T.append` compileJS' (indent + 2) e
286− `T.append` ";\n"
287− `T.append` T.replicate indent " "
288− `T.append` "}"
289−
290−compileJS' indent (JSSwitch val [(_,JSSeq seq)] Nothing) =
291− let (h,t) = splitAt 1 seq in
292− (T.concat (map (compileJS' indent) h) `T.append` ";\n")
293− `T.append` (
294− T.intercalate ";\n" $ map (
295− (T.replicate indent " " `T.append`) . compileJS' indent
296− ) t
297− )
298−
299−compileJS' indent (JSSwitch val branches def) =
300− "switch(" `T.append` compileJS' indent val `T.append` "){\n"
301− `T.append` T.concat (map mkBranch branches)
302− `T.append` mkDefault def
303− `T.append` T.replicate indent " " `T.append` "}"
304− where
305− mkBranch :: (JS, JS) -> T.Text
306− mkBranch (tag, code) =
307− T.replicate (indent + 2) " "
308− `T.append` "case "
309− `T.append` compileJS' indent tag
310− `T.append` ":\n"
311− `T.append` compileJS' (indent + 4) code
312− `T.append` "\n"
313− `T.append` (T.replicate (indent + 4) " " `T.append` "break;\n")
314−
315− mkDefault :: Maybe JS -> T.Text
316− mkDefault Nothing = ""
317− mkDefault (Just def) =
318− T.replicate (indent + 2) " " `T.append` "default:\n"
319− `T.append` compileJS' (indent + 4)def
320− `T.append` "\n"
321−
322−
323−compileJS' indent (JSTernary cond true false) =
324− let c = compileJS' indent cond
325− t = compileJS' indent true
326− f = compileJS' indent false in
327− "("
328− `T.append` c
329− `T.append` ")?("
330− `T.append` t
331− `T.append` "):("
332− `T.append` f
333− `T.append` ")"
334−
335−compileJS' indent (JSParens js) =
336− "(" `T.append` compileJS' indent js `T.append` ")"
337−
338−compileJS' indent (JSWhile cond body) =
339− "while (" `T.append` compileJS' indent cond `T.append` ") {\n"
340− `T.append` compileJS' (indent + 2) body
341− `T.append` "\n" `T.append` T.replicate indent " " `T.append` "}"
342−
343−compileJS' indent (JSWord word)
344− | JSWord8 b <- word =
345− "new Uint8Array([" `T.append` T.pack (show b) `T.append` "])"
346− | JSWord16 b <- word =
347− "new Uint16Array([" `T.append` T.pack (show b) `T.append` "])"
348− | JSWord32 b <- word =
349− "new Uint32Array([" `T.append` T.pack (show b) `T.append` "])"
350− | JSWord64 b <- word =
351− "i$bigInt(\"" `T.append` T.pack (show b) `T.append` "\")"
352−
353−jsInstanceOf :: JS -> String -> JS
354−jsInstanceOf obj cls = JSBinOp "instanceof" obj (JSIdent cls)
355−
356−jsOr :: JS -> JS -> JS
357−jsOr lhs rhs = JSBinOp "||" lhs rhs
358−
359−jsAnd :: JS -> JS -> JS
360−jsAnd lhs rhs = JSBinOp "&&" lhs rhs
361−
362−jsMeth :: JS -> String -> [JS] -> JS
363−jsMeth obj meth args = JSApp (JSProj obj meth) args
364−
365−jsCall :: String -> [JS] -> JS
366−jsCall fun args = JSApp (JSIdent fun) args
367−
368−jsTypeOf :: JS -> JS
369−jsTypeOf js = JSPreOp "typeof " js
370−
371−jsEq :: JS -> JS -> JS
372−jsEq lhs@(JSNum (JSInteger _)) rhs = JSApp (JSProj lhs "equals") [rhs]
373−jsEq lhs rhs@(JSNum (JSInteger _)) = JSApp (JSProj lhs "equals") [rhs]
374−jsEq lhs rhs = JSBinOp "==" lhs rhs
375−
376−jsNotEq :: JS -> JS -> JS
377−jsNotEq lhs rhs = JSBinOp "!=" lhs rhs
378−
379−jsIsNumber :: JS -> JS
380−jsIsNumber js = (jsTypeOf js) `jsEq` (JSString "number")
381−
382−jsIsNull :: JS -> JS
383−jsIsNull js = JSBinOp "==" js JSNull
384−
385−jsBigInt :: JS -> JS
386−jsBigInt (JSString "0") = JSNum (JSInteger JSBigZero)
387−jsBigInt (JSString "1") = JSNum (JSInteger JSBigOne)
388−jsBigInt js = JSNum $ JSInteger $ JSBigIntExpr js
389−
390−jsUnPackBits :: JS -> JS
391−jsUnPackBits js = JSIndex js $ JSNum (JSInt 0)
392−
393−jsPackUBits8 :: JS -> JS
394−jsPackUBits8 js = JSNew "Uint8Array" [JSArray [js]]
395−
396−jsPackUBits16 :: JS -> JS
397−jsPackUBits16 js = JSNew "Uint16Array" [JSArray [js]]
398−
399−jsPackUBits32 :: JS -> JS
400−jsPackUBits32 js = JSNew "Uint32Array" [JSArray [js]]
401−
402−jsPackSBits8 :: JS -> JS
403−jsPackSBits8 js = JSNew "Int8Array" [JSArray [js]]
404−
405−jsPackSBits16 :: JS -> JS
406−jsPackSBits16 js = JSNew "Int16Array" [JSArray [js]]
407−
408−jsPackSBits32 :: JS -> JS
409−jsPackSBits32 js = JSNew "Int32Array" [JSArray [js]]
165+jsAst2Text (JsComment c)=
166+ T.concat ["/*",c,"*/"]
167+jsAst2Text (JsLazy e) =
168+ T.concat [ "{js_idris_lazy_calc:function(){"
169+ , indent $ jsAst2Text e
170+ , "}}"
171+ ]
172+jsAst2Text (JsForce e) =
173+ T.concat ["js_idris_force(", jsAst2Text e, ")"]
174+
175+
176+
177+case2Text :: (JsAST, JsAST) -> Text
178+case2Text (x,y) =
179+ T.concat [ "case ", jsAst2Text x, ":\n"
180+ , indent $ T.concat [ jsAst2Text y, ";\nbreak;\n"]
181+ ]
182+
183+default2Text :: Maybe JsAST -> Text
184+default2Text Nothing = ""
185+default2Text (Just z) =
186+ T.concat [ "default:\n"
187+ , indent $ T.concat [ jsAst2Text z, ";\nbreak;\n"]
188+ ]
src/IRTS/JavaScript/Codegen.hsnew file+826
@@ -0,0 +1,826 @@
1+{-|
2+Module : IRTS.JavaScript.Codegen
3+Description : The JavaScript common code generator.
4+Copyright :
5+License : BSD3
6+Maintainer : The Idris Community.
7+-}
8+{-# LANGUAGE OverloadedStrings #-}
9+
10+module IRTS.JavaScript.Codegen( codegenJs
11+ , CGConf(..)
12+ , CGStats(..)
13+ ) where
14+
15+import Idris.Core.TT
16+import IRTS.CodegenCommon
17+import IRTS.JavaScript.AST
18+import IRTS.JavaScript.LangTransforms
19+import IRTS.Lang
20+import IRTS.LangOpts
21+import IRTS.System
22+
23+import Control.Monad.Trans.State
24+import Data.List (nub)
25+import Data.Map.Strict (Map)
26+import qualified Data.Map.Strict as Map
27+import Data.Maybe (fromJust)
28+import Data.Set (Set)
29+import qualified Data.Set as Set
30+import Data.Text (Text)
31+import qualified Data.Text as T
32+import qualified Data.Text.IO as TIO
33+import System.Directory (doesFileExist)
34+import System.Environment
35+import System.FilePath
36+
37+import Control.Applicative (pure, (<$>))
38+import Data.Char
39+import Data.Data
40+import Data.Generics.Uniplate.Data
41+import Data.List
42+import GHC.Generics (Generic)
43+
44+data Partial = Partial Name Int Int deriving (Eq, Ord)
45+
46+data CGStats = CGStats { usedWriteStr :: Bool
47+ , usedReadStr :: Bool
48+ , usedBigInt :: Bool
49+ , partialApplications :: Set Partial
50+ }
51+
52+emptyStats :: CGStats
53+emptyStats = CGStats {usedWriteStr = False, partialApplications = Set.empty, usedBigInt = False, usedReadStr = False}
54+
55+data CGConf = CGConf { header :: Text
56+ , footer :: Text
57+ , initialization :: CGStats -> Text
58+ , writeStrTemplate :: Text
59+ , readStrTemplate :: Text
60+ , extraRunTime :: String
61+ }
62+
63+
64+getInclude :: FilePath -> IO Text
65+getInclude p = TIO.readFile p
66+
67+getIncludes :: [FilePath] -> IO Text
68+getIncludes l = do
69+ incs <- mapM getInclude l
70+ return $ T.intercalate "\n\n" incs
71+
72+isYes :: Maybe String -> Bool
73+isYes (Just "Y") = True
74+isYes (Just "y") = True
75+isYes _ = False
76+
77+
78+codegenJs :: CGConf -> CodeGenerator
79+codegenJs conf ci =
80+ do
81+ optim <- isYes <$> lookupEnv "IDRISJS_OPTIM"
82+ debug <- isYes <$> lookupEnv "IDRISJS_DEBUG"
83+ if debug then
84+ if optim then putStrLn "compiling width idris-js optimizations"
85+ else putStrLn "compiling widthout idris-js optimizations"
86+ else pure ()
87+ let defs = Map.fromList $ liftDecls ci
88+ let used = Map.elems $ removeDeadCode defs [sMN 0 "runMain"]
89+ if debug then
90+ do
91+ writeFile (outputFile ci ++ ".LDeclsDebug") $ (unlines $ intersperse "" $ map show used) ++ "\n\n\n"
92+ putStrLn $ "Finished calculating used"
93+ else pure ()
94+
95+ let (out, stats) = doCodegen conf defs used
96+
97+ path <- getIdrisJSRTSDir
98+ jsbn <- if usedBigInt stats
99+ then TIO.readFile $ path </> "jsbn/jsbn.js"
100+ else return ""
101+
102+ runtimeCommon <- TIO.readFile $ path </> "Runtime-common.js"
103+ extraRT <- TIO.readFile $ path </> (extraRunTime conf)
104+
105+ includes <- getIncludes $ includes ci
106+ TIO.writeFile (outputFile ci) $ T.concat [ header conf
107+ , "\"use strict\";\n\n"
108+ , "(function(){\n\n"
109+ , jsbn
110+ , initialization conf stats
111+ , doPartials (partialApplications stats)
112+ , includes, "\n"
113+ , runtimeCommon, "\n"
114+ , extraRT, "\n"
115+ , out, "\n"
116+ , "\n"
117+ , jsName (sMN 0 "runMain"), "();\n\n"
118+ , "\n}.call(this))"
119+ , footer conf
120+ ]
121+
122+jsName :: Name -> Text
123+jsName n = T.pack $ "idris_" ++ concatMap jschar (showCG n)
124+ where jschar x | isAlpha x || isDigit x = [x]
125+ | otherwise = "_" ++ show (fromEnum x) ++ "_"
126+
127+jsPartialName :: Partial -> Text
128+jsPartialName (Partial n i j) = T.concat ["partial_", T.pack $ show i, "_", T.pack $ show j, "_" , jsName n]
129+
130+jsTailCallOptimName :: Text -> Text
131+jsTailCallOptimName x = T.concat ["tailCallOptim_cgIdris_", x]
132+
133+doPartials :: Set Partial -> Text
134+doPartials x =
135+ T.intercalate "\n" (map f $ Set.toList x)
136+ where
137+ f p@(Partial n i j) =
138+ let vars1 = map (T.pack . ("x"++) . show) [1..i]
139+ vars2 = map (T.pack . ("x"++) . show) [(i+1)..j]
140+ in jsAst2Text $
141+ JsFun (jsPartialName p) vars1 $ JsReturn $ JsCurryLambda vars2 (JsApp (jsName n) (map JsVar (vars1 ++ vars2)) )
142+
143+doCodegen :: CGConf -> Map Name LDecl -> [LDecl] -> (Text, CGStats)
144+doCodegen conf defs decls =
145+ let xs = map (doCodegenDecl conf defs) decls
146+ groupCGStats x y = CGStats {usedWriteStr = usedWriteStr x || usedWriteStr y
147+ , partialApplications = partialApplications x `Set.union` partialApplications y
148+ , usedBigInt = usedBigInt x || usedBigInt y
149+ , usedReadStr = usedReadStr x || usedReadStr y
150+ }
151+ in (T.intercalate "\n" $ map fst xs, foldl' groupCGStats emptyStats (map snd xs) )
152+
153+doCodegenDecl :: CGConf -> Map Name LDecl -> LDecl -> (Text, CGStats)
154+doCodegenDecl conf defs (LFun _ n args def) =
155+ let (ast, stats) = cgFun conf defs n args def
156+ in (jsAst2Text $ ast, stats)
157+doCodegenDecl conf defs (LConstructor n i sz) =
158+ ("", emptyStats)
159+
160+seqJs :: [JsAST] -> JsAST
161+seqJs [] = JsEmpty
162+seqJs (x:xs) = JsSeq x (seqJs xs)
163+
164+
165+data CGBodyState = CGBodyState { defs :: Map Name LDecl
166+ , lastIntName :: Int
167+ , currentFnNameAndArgs :: (Text, [Text])
168+ , usedArgsTailCallOptim :: Set (Text, Text)
169+ , isTailRec :: Bool
170+ , conf :: CGConf
171+ , usedWrite :: Bool
172+ , usedRead :: Bool
173+ , usedITBig :: Bool
174+ , partialApps :: Set Partial
175+ }
176+
177+getNewCGName :: State CGBodyState Text
178+getNewCGName =
179+ do
180+ st <- get
181+ let v = lastIntName st + 1
182+ put $ st {lastIntName = v}
183+ return $ T.pack $ "cgIdris_" ++ show v
184+
185+addPartial :: Partial -> State CGBodyState ()
186+addPartial p =
187+ modify (\s -> s {partialApps = Set.insert p (partialApps s) })
188+
189+addUsedArgsTailCallOptim :: Set (Text, Text) -> State CGBodyState ()
190+addUsedArgsTailCallOptim p =
191+ modify (\s -> s {usedArgsTailCallOptim = Set.union p (usedArgsTailCallOptim s) })
192+
193+getNewCGNames :: Int -> State CGBodyState [Text]
194+getNewCGNames n =
195+ mapM (\_ -> getNewCGName) [1..n]
196+
197+getConsId :: Name -> State CGBodyState Int
198+getConsId n =
199+ do
200+ st <- get
201+ case Map.lookup n (defs st) of
202+ Just (LConstructor _ conId _) -> pure conId
203+ _ -> error $ "Internal JS Backend error " ++ showCG n ++ " is not a constructor."
204+
205+getArgList :: Name -> State CGBodyState (Maybe [Name])
206+getArgList n =
207+ do
208+ st <- get
209+ case Map.lookup n (defs st) of
210+ Just (LFun _ _ a _) -> pure $ Just a
211+ _ -> pure Nothing
212+
213+data BodyResTarget = ReturnBT
214+ | DecBT Text
215+ | SetBT Text
216+ | DecConstBT Text
217+ | GetExpBT
218+
219+replaceVarsByProj :: JsAST -> Map Text Int -> JsAST -> JsAST
220+replaceVarsByProj n d z =
221+ transform f z
222+ where
223+ f :: JsAST -> JsAST
224+ f (JsVar x) =
225+ case Map.lookup x d of
226+ Nothing -> (JsVar x)
227+ Just i -> JsArrayProj (JsInt i) n
228+ f x = x
229+
230+cgFun :: CGConf -> Map Name LDecl -> Name -> [Name] -> LExp -> (JsAST, CGStats)
231+cgFun cnf dfs n args def =
232+ let
233+ fnName = jsName n
234+ argNames = map jsName args
235+ ((decs, res),st) = runState
236+ (cgBody ReturnBT def)
237+ (CGBodyState { defs=dfs
238+ , lastIntName = 0
239+ , currentFnNameAndArgs = (fnName, argNames)
240+ , usedArgsTailCallOptim = Set.empty
241+ , isTailRec = False
242+ , conf = cnf
243+ , usedWrite = False
244+ , usedRead = False
245+ , usedITBig = False
246+ , partialApps = Set.empty
247+ }
248+ )
249+ body = if isTailRec st then
250+ JsSeq
251+ (declareUsedOptimArgs $ usedArgsTailCallOptim st)
252+ (JsWhileTrue ((seqJs decs) `JsSeq` res))
253+ else (seqJs decs) `JsSeq` res
254+ in (JsFun fnName argNames $ body, CGStats { usedWriteStr = usedWrite st
255+ , partialApplications = partialApps st
256+ , usedBigInt = usedITBig st
257+ , usedReadStr = usedRead st
258+ }
259+ )
260+
261+getSwitchJs :: JsAST -> [LAlt] -> JsAST
262+getSwitchJs x alts =
263+ if any conCase alts then JsArrayProj (JsInt 0) x
264+ else if any constBigIntCase alts then JsForeign "%0.toString()" [x]
265+ else x
266+ where conCase (LConCase _ _ _ _) = True
267+ conCase _ = False
268+ constBigIntCase (LConstCase (BI _) _) = True
269+ constBigIntCase _ = False
270+
271+addRT :: BodyResTarget -> JsAST -> JsAST
272+addRT ReturnBT x = JsReturn x
273+addRT (DecBT n) x = JsLet n x
274+addRT (SetBT n) x = JsSetVar n x
275+addRT (DecConstBT n) x = JsConst n x
276+addRT GetExpBT x = x
277+
278+declareUsedOptimArgs :: Set (Text, Text) -> JsAST
279+declareUsedOptimArgs x = seqJs $ map (\(x,y) -> JsLet x (JsVar y) ) (Set.toList x)
280+
281+tailCallOptimRefreshArgs :: [(Text, JsAST)] -> Set Text -> ((JsAST, JsAST), Set (Text, Text))
282+tailCallOptimRefreshArgs [] s = ((JsEmpty, JsEmpty), Set.empty)
283+tailCallOptimRefreshArgs ((n,x):r) s =
284+ let ((y1,y2), y3) = tailCallOptimRefreshArgs r (Set.insert n s) --
285+ in if Set.null $ (Set.fromList [ z | z <- universeBi x ]) `Set.intersection` s then
286+ ((y1, JsSetVar n x `JsSeq` y2), y3)
287+ else
288+ let n' = jsTailCallOptimName n
289+ in ((JsSetVar n' x `JsSeq` y1, JsSetVar n (JsVar n') `JsSeq` y2), Set.insert (n',n) y3)
290+
291+
292+cgBody :: BodyResTarget -> LExp -> State CGBodyState ([JsAST], JsAST)
293+cgBody rt (LV (Glob n)) =
294+ do
295+ argsFn <- getArgList n
296+ case argsFn of
297+ Just [] ->
298+ pure $ ([], addRT rt $ JsApp (jsName n) [])
299+ Just a ->
300+ do
301+ let part = Partial n 0 (length a)
302+ addPartial part
303+ pure ([], addRT rt $ JsApp (jsPartialName part) [])
304+ Nothing ->
305+ pure $ ([], addRT rt $ JsVar $ jsName n)
306+cgBody rt (LApp tailcall (LV (Glob fn)) args) =
307+ do
308+ let fname = jsName fn
309+ st <- get
310+ let (currFn, argN) = currentFnNameAndArgs st
311+ z <- mapM (cgBody GetExpBT) args
312+ let argVals = map snd z
313+ let preDecs = concat $ map fst z
314+ case (fname == currFn && (length args) == (length argN), rt) of
315+ (True, ReturnBT) ->
316+ do
317+ modify (\x-> x {isTailRec = True})
318+ let ((y1,y2), y3) = tailCallOptimRefreshArgs (zip argN argVals) Set.empty
319+ addUsedArgsTailCallOptim y3
320+ pure (preDecs, y1 `JsSeq` y2)
321+ _ ->
322+ do
323+ argsFn <- getArgList fn
324+ case argsFn of
325+ Nothing ->
326+ pure (preDecs, addRT rt $ JsCurryApp (JsVar fname) argVals )
327+ Just agFn ->
328+ do
329+ let lenAgFn = length agFn
330+ let lenArgs = length args
331+ case compare lenAgFn lenArgs of
332+ EQ ->
333+ pure (preDecs, addRT rt $ JsApp fname argVals)
334+ LT ->
335+ pure (preDecs, addRT rt $ JsCurryApp (JsApp fname (take lenAgFn argVals )) (drop lenAgFn argVals) )
336+ GT ->
337+ do
338+ let part = Partial fn lenArgs lenAgFn
339+ addPartial part
340+ pure (preDecs, addRT rt $ JsApp (jsPartialName part) argVals )
341+
342+cgBody rt (LForce (LLazyApp n args)) = cgBody rt (LApp False (LV (Glob n)) args)
343+cgBody rt (LLazyApp n args) =
344+ do
345+ (d,v) <- cgBody ReturnBT (LApp False (LV (Glob n)) args)
346+ pure ([], addRT rt $ JsLazy $ JsSeq (seqJs d) v)
347+cgBody rt (LForce e) =
348+ do
349+ (d,v) <- cgBody GetExpBT e
350+ pure (d, addRT rt $ JsForce v)
351+cgBody rt (LLet n v sc) =
352+ do
353+ (d1, v1) <- cgBody (DecConstBT $ jsName n) v
354+ (d2, v2) <- cgBody rt sc
355+ pure $ ((d1 ++ v1 : d2), v2 )
356+cgBody rt (LProj e i) =
357+ do
358+ (d, v) <- cgBody GetExpBT e
359+ pure $ (d, addRT rt $ JsArrayProj (JsInt $ i+1) $ v)
360+cgBody rt (LCon _ conId n args) =
361+ do
362+ z <- mapM (cgBody GetExpBT) args
363+ pure $ (concat $ map fst z, addRT rt $ JsArray (JsInt conId : map snd z))
364+cgBody rt (LCase _ e alts) =
365+ do
366+ (d,v) <- cgBody GetExpBT e
367+ resName <- getNewCGName
368+ swName <- getNewCGName
369+ (altsJs,def) <- cgAlts rt resName (JsVar swName) alts
370+ let decSw = JsConst swName v
371+ let sw = JsSwitchCase (getSwitchJs (JsVar swName) alts) altsJs def
372+ case rt of
373+ ReturnBT ->
374+ pure (d ++ [decSw], sw)
375+ (DecBT nvar) ->
376+ pure (d ++ [decSw, JsLet nvar JsNull], sw)
377+ (SetBT nvar) ->
378+ pure (d ++ [decSw], sw)
379+ GetExpBT ->
380+ pure (d ++ [decSw, JsLet resName JsNull, sw], JsVar resName)
381+ (DecConstBT nvar) ->
382+ pure (d ++ [decSw, JsLet nvar JsNull], sw)
383+cgBody rt (LConst c) =
384+ do
385+ cst <- cgConst c
386+ pure ([], (addRT rt) $ cst)
387+cgBody rt (LOp op args) =
388+ do
389+ z <- mapM (cgBody GetExpBT) args
390+ res <- cgOp op (map snd z)
391+ pure $ (concat $ map fst z, addRT rt $ res)
392+cgBody rt LNothing = pure ([], addRT rt JsNull)
393+cgBody rt (LError x) = pure ([], JsError $ JsStr x)
394+cgBody rt x@(LForeign dres (FStr code) args ) =
395+ do
396+ z <- mapM (cgBody GetExpBT) (map snd args)
397+ jsArgs <- sequence $ map cgForeignArg (zip (map fst args) (map snd z))
398+ jsDres <- cgForeignRes dres $ JsForeign (T.pack code) jsArgs
399+ pure $ (concat $ map fst z, addRT rt $ jsDres)
400+cgBody _ x = error $ "Instruction " ++ show x ++ " not compilable yet"
401+
402+altsRT :: Text -> BodyResTarget -> BodyResTarget
403+altsRT rn ReturnBT = ReturnBT
404+altsRT rn (DecBT n) = SetBT n
405+altsRT rn (SetBT n) = SetBT n
406+altsRT rn (DecConstBT n) = SetBT n
407+altsRT rn GetExpBT = SetBT rn
408+
409+cgAlts :: BodyResTarget -> Text -> JsAST -> [LAlt] -> State CGBodyState ([(JsAST, JsAST)], Maybe JsAST)
410+cgAlts rt resName scrvar ((LConstCase t exp):r) =
411+ do
412+ (d, v) <- cgBody (altsRT resName rt) exp
413+ (ar, def) <- cgAlts rt resName scrvar r
414+ cst <- case t of
415+ BI _ ->
416+ do
417+ setUsedITBig
418+ c' <- cgConst t
419+ pure $ JsForeign "%0.toString()" [c']
420+ _ -> cgConst t
421+ pure ((cst, JsSeq (seqJs d) v) : ar, def)
422+cgAlts rt resName scrvar ((LDefaultCase exp):r) =
423+ do
424+ (d, v) <- cgBody (altsRT resName rt) exp
425+ pure ([], Just $ JsSeq (seqJs d) v)
426+cgAlts rt resName scrvar ((LConCase _ n args exp):r) =
427+ do
428+ (d, v) <- cgBody (altsRT resName rt) exp
429+ (ar, def) <- cgAlts rt resName scrvar r
430+ conId <- getConsId n
431+ let replace = replaceVarsByProj scrvar (Map.fromList $ zip (map jsName args) [1..])
432+ let branchBody = JsSeq (seqJs $ map replace d) (replace v)
433+ pure ((JsInt conId, branchBody) : ar, def)
434+cgAlts _ _ _ [] =
435+ pure ([],Nothing)
436+
437+
438+cgForeignArg :: (FDesc, JsAST) -> State CGBodyState JsAST
439+cgForeignArg (FApp (UN "JS_IntT") _, v) = pure v
440+cgForeignArg (FCon (UN "JS_Str"), v) = pure v
441+cgForeignArg (FCon (UN "JS_Ptr"), v) = pure v
442+cgForeignArg (FCon (UN "JS_Unit"), v) = pure v
443+cgForeignArg (FCon (UN "JS_Float"), v) = pure v
444+cgForeignArg (FApp (UN "JS_FnT") [_,FApp (UN "JS_Fn") [_,_, a, FApp (UN "JS_FnBase") [_,b]]], f) =
445+ pure f
446+cgForeignArg (FApp (UN "JS_FnT") [_,FApp (UN "JS_Fn") [_,_, a, FApp (UN "JS_FnIO") [_,_, b]]], f) =
447+ do
448+ jsx <- cgForeignArg (a, JsVar "x")
449+ jsres <- cgForeignRes b $ JsCurryApp (JsCurryApp f [jsx]) [JsNull]
450+ pure $ JsLambda ["x"] $ JsReturn jsres
451+cgForeignArg (desc, _) =
452+ do
453+ st <- get
454+ error $ "Foreign arg type " ++ show desc ++ " not supported. While generating function " ++ (show $ fst $ currentFnNameAndArgs st)
455+
456+cgForeignRes :: FDesc -> JsAST -> State CGBodyState JsAST
457+cgForeignRes (FApp (UN "JS_IntT") _) x = pure x
458+cgForeignRes (FCon (UN "JS_Unit")) x = pure x
459+cgForeignRes (FCon (UN "JS_Str")) x = pure x
460+cgForeignRes (FCon (UN "JS_Ptr")) x = pure x
461+cgForeignRes (FCon (UN "JS_Float")) x = pure x
462+cgForeignRes desc val =
463+ do
464+ st <- get
465+ error $ "Foreign return type " ++ show desc ++ " not supported. While generating function " ++ (show $ fst $ currentFnNameAndArgs st)
466+
467+setUsedITBig :: State CGBodyState ()
468+setUsedITBig = modify (\s -> s {usedITBig = True})
469+
470+
471+cgConst :: Const -> State CGBodyState JsAST
472+cgConst (I i) = pure $ JsInt i
473+cgConst (BI i) =
474+ do
475+ setUsedITBig
476+ pure $ JsForeign "new jsbn.BigInteger(%0)" [JsStr $ show i]
477+cgConst (Ch c) = pure $ JsStr [c]
478+cgConst (Str s) = pure $ JsStr s
479+cgConst (Fl f) = pure $ JsNum f
480+cgConst (B8 x) = pure $ JsForeign (T.pack $ show x ++ " & 0xFF") []
481+cgConst (B16 x) = pure $ JsForeign (T.pack $ show x ++ " & 0xFFFF") []
482+cgConst (B32 x) = pure $ JsForeign (T.pack $ show x ++ "|0" ) []
483+cgConst (B64 x) =
484+ do
485+ setUsedITBig
486+ pure $ JsForeign "new jsbn.BigInteger(%0).and(new jsbn.BigInteger(%1))" [JsStr $ show x, JsStr $ show 0xFFFFFFFFFFFFFFFF]
487+cgConst x | isTypeConst x = pure $ JsInt 0
488+cgConst x = error $ "Constant " ++ show x ++ " not compilable yet"
489+
490+jsB2I :: JsAST -> JsAST
491+jsB2I x = JsForeign "%0 ? 1|0 : 0|0" [x]
492+
493+cgOp :: PrimFn -> [JsAST] -> State CGBodyState JsAST
494+cgOp (LPlus ATFloat) [l, r] = pure $ JsBinOp "+" l r
495+cgOp (LPlus (ATInt ITChar)) [l, r] = pure $ JsForeign "String.fromCharCode(%0.charCodeAt(0) + %1.charCodeAt(0))" [l,r]
496+cgOp (LPlus (ATInt ITNative)) [l, r] = pure $ JsForeign "%0+%1|0" [l,r]
497+cgOp (LPlus (ATInt (ITFixed IT8))) [l, r] = pure $ JsForeign "%0 + %1 & 0xFF" [l,r]
498+cgOp (LPlus (ATInt (ITFixed IT16))) [l, r] = pure $ JsForeign "%0 + %1 & 0xFFFF" [l,r]
499+cgOp (LPlus (ATInt (ITFixed IT32))) [l, r] = pure $ JsForeign "%0+%1|0" [l,r]
500+cgOp (LPlus (ATInt ITBig)) [l, r] =
501+ do
502+ setUsedITBig
503+ pure $ JsMethod l "add" [r]
504+cgOp (LPlus (ATInt (ITFixed IT64))) [l, r] =
505+ do
506+ setUsedITBig
507+ pure $ JsForeign "%0.add(%1).and(new jsbn.BigInteger(%2))" [l,r, JsStr $ show 0xFFFFFFFFFFFFFFFF]
508+cgOp (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]
510+cgOp (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]
514+cgOp (LMinus (ATInt ITBig)) [l, r] =
515+ do
516+ setUsedITBig
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]
522+cgOp (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]
524+cgOp (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]
528+cgOp (LTimes (ATInt ITBig)) [l, r] =
529+ do
530+ setUsedITBig
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 (LSHL (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]
640+cgOp (LEq ATFloat) [l, r] = pure $ jsB2I $ JsBinOp "==" l r
641+cgOp (LEq (ATInt ITNative)) [l, r] = pure $ jsB2I $ JsBinOp "==" l r
642+cgOp (LEq (ATInt ITChar)) [l,r] = pure $ jsB2I $ JsBinOp "==" l r
643+cgOp (LEq (ATInt ITBig)) [l, r] =
644+ do
645+ setUsedITBig
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]
682+cgOp (LSLt ATFloat) [l, r] = pure $ jsB2I $ JsBinOp "<" l r
683+cgOp (LSLt (ATInt ITChar)) [l, r] = pure $ jsB2I $ JsBinOp "<" l r
684+cgOp (LSLt (ATInt ITNative)) [l, r] = pure $ jsB2I $ JsBinOp "<" l r
685+cgOp (LSLt (ATInt ITBig)) [l, r] =
686+ do
687+ setUsedITBig
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]
696+cgOp (LSLe ATFloat) [l, r] = pure $ jsB2I $ JsBinOp "<=" l r
697+cgOp (LSLe (ATInt ITNative)) [l, r] = pure $ jsB2I $ JsBinOp "<=" l r
698+cgOp (LSLe (ATInt ITBig)) [l, r] =
699+ do
700+ setUsedITBig
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]
709+cgOp (LSGt ATFloat) [l, r] = pure $ jsB2I $ JsBinOp ">" l r
710+cgOp (LSGt (ATInt ITNative)) [l, r] = pure $ jsB2I $ JsBinOp ">" l r
711+cgOp (LSGt (ATInt ITBig)) [l, r] =
712+ do
713+ setUsedITBig
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]
722+cgOp (LSGe ATFloat) [l, r] = pure $ jsB2I $ JsBinOp ">=" l r
723+cgOp (LSGe (ATInt ITNative)) [l, r] = pure $ jsB2I $ JsBinOp ">=" l r
724+cgOp (LSGe (ATInt ITBig)) [l, r] =
725+ do
726+ setUsedITBig
727+ pure $ jsB2I $ JsForeign "%0.compareTo(%1) >= 0" [l,r]
728+cgOp (LSGe (ATInt (ITFixed IT8))) [l, r] = pure $ jsB2I $ JsBinOp ">=" l r
729+cgOp (LSGe (ATInt (ITFixed IT16))) [l, r] = pure $ jsB2I $ JsBinOp ">=" l r
730+cgOp (LSGe (ATInt (ITFixed IT32))) [l, r] = pure $ jsB2I $ JsBinOp ">=" l r
731+cgOp (LSGe (ATInt (ITFixed IT64))) [l, r] =
732+ do
733+ setUsedITBig
734+ pure $ jsB2I $ JsForeign "%0.compareTo(%1) >= 0" [l,r]
735+cgOp (LSExt ITNative ITBig) [x] =
736+ do
737+ setUsedITBig
738+ pure $ JsForeign "new jsbn.BigInteger(String(%0))" [x]
739+cgOp (LZExt (ITFixed IT8) ITNative) [x] = pure x
740+cgOp (LZExt (ITFixed IT16) ITNative) [x] = pure x
741+cgOp (LZExt (ITFixed IT32) ITNative) [x] = pure x
742+cgOp (LZExt ITNative ITBig) [x] =
743+ do
744+ setUsedITBig
745+ pure $ JsForeign "new jsbn.BigInteger(String(%0))" [x]
746+cgOp (LTrunc ITBig ITNative) [x] =
747+ do
748+ setUsedITBig
749+ pure $ JsForeign "%0.intValue()|0" [x]
750+cgOp (LTrunc (ITFixed IT16) (ITFixed IT8)) [x] = pure $ JsForeign "%0 & 0xFF" [x]
751+cgOp (LTrunc (ITFixed IT32) (ITFixed IT8)) [x] = pure $ JsForeign "%0 & 0xFF" [x]
752+cgOp (LTrunc (ITFixed IT64) (ITFixed IT8)) [x] =
753+ do
754+ setUsedITBig
755+ pure $ JsForeign "%0.intValue() & 0xFF" [x]
756+cgOp (LTrunc (ITFixed IT32) (ITFixed IT16)) [x] = pure $ JsForeign "%0 & 0xFFFF" [x]
757+cgOp (LTrunc (ITFixed IT64) (ITFixed IT16)) [x] =
758+ do
759+ setUsedITBig
760+ pure $ JsForeign "%0.intValue() & 0xFFFF" [x]
761+cgOp (LTrunc (ITFixed IT64) (ITFixed IT32)) [x] =
762+ do
763+ setUsedITBig
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]
773+cgOp (LIntFloat ITNative) [x] = pure $ x
774+cgOp (LIntFloat ITBig) [x] =
775+ do
776+ setUsedITBig
777+ pure $ JsForeign "%0.intValue()" [x]
778+cgOp (LFloatInt ITNative) [x] = pure $ JsForeign "%0|0" [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]
793+cgOp LFExp [x] = pure $ JsApp "Math.exp" [x]
794+cgOp LFLog [x] = pure $ JsApp "Math.log" [x]
795+cgOp LFSin [x] = pure $ JsApp "Math.sin" [x]
796+cgOp LFCos [x] = pure $ JsApp "Math.cos" [x]
797+cgOp LFTan [x] = pure $ JsApp "Math.tan" [x]
798+cgOp LFASin [x] = pure $ JsApp "Math.asin" [x]
799+cgOp LFACos [x] = pure $ JsApp "Math.acos" [x]
800+cgOp LFATan [x] = pure $ JsApp "Math.atan" [x]
801+cgOp 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]
804+cgOp LFNegate [x] = pure $ JsForeign "-%0" [x]
805+cgOp LStrHead [x] = pure $ JsArrayProj (JsInt 0) x
806+cgOp LStrTail [x] = pure $ JsMethod x "slice" [JsInt 1]
807+cgOp LStrCons [l,r] = pure $ JsForeign "%0+%1" [l,r]
808+cgOp LStrIndex [x, y] = pure $ JsArrayProj y x
809+cgOp LStrRev [x] = pure $ JsForeign "%0.split('').reverse().join('')" [x]
810+cgOp LStrSubstr [offset,len,str] = pure $ JsForeign "%0.substr(Math.max(0,%1), Math.max(0, %2))" [str, offset, len]
811+cgOp LReadStr [_] =
812+ do
813+ s <- get
814+ put $ s {usedRead = True}
815+ pure $ JsForeign (readStrTemplate $ conf s) []
816+cgOp LWriteStr [_,str] =
817+ do
818+ s <- get
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
824+cgOp LCrash [l] = pure $ JsErrorExp l
825+cgOp LNoOp [x] = pure x
826+cgOp op exps = error ("Operator " ++ show (op, exps) ++ " not implemented")
src/IRTS/JavaScript/LangTransforms.hsnew file+96
@@ -0,0 +1,96 @@
1+{-|
2+Module : IRTS.JavaScript.LangTransforms
3+Description : The JavaScript LDecl Transformations.
4+Copyright :
5+License : BSD3
6+Maintainer : The Idris Community.
7+-}
8+{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, StandaloneDeriving #-}
9+
10+module IRTS.JavaScript.LangTransforms( removeDeadCode
11+ ) where
12+
13+
14+import Control.DeepSeq
15+import Control.Monad.Trans.State
16+import Data.List
17+import Data.Map.Strict (Map)
18+import qualified Data.Map.Strict as Map
19+import Data.Maybe
20+import Data.Set (Set)
21+import qualified Data.Set as Set
22+import Data.Text (Text)
23+import qualified Data.Text as T
24+import Idris.Core.CaseTree
25+import Idris.Core.TT
26+import IRTS.Lang
27+
28+import Data.Data
29+import Data.Generics.Uniplate.Data
30+import GHC.Generics (Generic)
31+
32+deriving instance Typeable FDesc
33+deriving instance Data FDesc
34+deriving instance Typeable LVar
35+deriving instance Data LVar
36+deriving instance Typeable PrimFn
37+deriving instance Data PrimFn
38+deriving instance Typeable CaseType
39+deriving instance Data CaseType
40+deriving instance Typeable LExp
41+deriving instance Data LExp
42+deriving instance Typeable LDecl
43+deriving instance Data LDecl
44+deriving instance Typeable LOpt
45+deriving instance Data LOpt
46+
47+
48+restrictKeys :: Ord k => Map k a -> Set k -> Map k a
49+restrictKeys m s = Map.filterWithKey (\k _ -> k `Set.member` s) m
50+
51+mapMapListKeys :: Ord k => (a->a) -> [k] -> Map k a -> Map k a
52+mapMapListKeys _ [] x = x
53+mapMapListKeys f (t:r) x = mapMapListKeys f r $ Map.adjust f t x
54+
55+
56+extractGlobs :: Map Name LDecl -> LDecl -> [Name]
57+extractGlobs defs (LConstructor _ _ _) = []
58+extractGlobs defs (LFun _ _ _ e) =
59+ let f (LV (Glob x)) = Just x
60+ f (LLazyApp x _) = Just x
61+ f _ = Nothing
62+ in [x | Just x <- map f $ universe e, Map.member x defs]
63+
64+usedFunctions :: Map Name LDecl -> Set Name -> [Name] -> [Name]
65+usedFunctions _ _ [] = []
66+usedFunctions alldefs done names =
67+ let decls = catMaybes $ map (\x -> Map.lookup x alldefs) names
68+ used_names = (nub $ concat $ map (extractGlobs alldefs) decls) \\ names
69+ new_names = filter (\x -> not $ Set.member x done) used_names
70+ in used_names ++ usedFunctions alldefs (Set.union done $ Set.fromList new_names) new_names
71+
72+
73+usedDecls :: Map Name LDecl -> [Name] -> Map Name LDecl
74+usedDecls dcls start =
75+ let used = reverse $ start ++ usedFunctions dcls (Set.fromList start) start
76+ in restrictKeys dcls (Set.fromList used)
77+
78+getUsedConstructors :: Map Name LDecl -> Set Name
79+getUsedConstructors x = Set.fromList [ n | LCon _ _ n _ <- universeBi x]
80+
81+removeUnusedBranches :: Set Name -> Map Name LDecl -> Map Name LDecl
82+removeUnusedBranches used x =
83+ transformBi f x
84+ where
85+ f :: [LAlt] -> [LAlt]
86+ f ((LConCase x n y z):r) =
87+ if Set.member n used then ((LConCase x n y z):r)
88+ else r
89+ f x = x
90+
91+removeDeadCode :: Map Name LDecl -> [Name] -> Map Name LDecl
92+removeDeadCode dcls start =
93+ let used = usedDecls dcls start
94+ remCons = removeUnusedBranches (getUsedConstructors used) used
95+ in if Map.keys remCons == Map.keys dcls then remCons
96+ else removeDeadCode remCons start
src/IRTS/Lang.hs+4−2
@@ -5,7 +5,7 @@ Copyright :
55License : BSD3
66Maintainer : The Idris Community.
77-}
8−{-# LANGUAGE DeriveFunctor, DeriveGeneric, PatternGuards #-}
8+{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, DeriveGeneric, PatternGuards #-}
99
1010module IRTS.Lang where
1111
@@ -14,7 +14,9 @@ import Idris.Core.TT
1414
1515import Control.Applicative hiding (Const)
1616import Control.Monad.State hiding (lift)
17+import Data.Data (Data)
1718import Data.List
19+import Data.Typeable (Typeable)
1820import Debug.Trace
1921import GHC.Generics (Generic)
2022
@@ -117,7 +119,7 @@ data FType = FArith ArithTy
117119data LAlt' e = LConCase Int Name [Name] e
118120 | LConstCase Const e
119121 | LDefaultCase e
120− deriving (Show, Eq, Functor)
122+ deriving (Show, Eq, Functor, Data, Typeable)
121123
122124type LAlt = LAlt' LExp
123125