(.module: lux (lux (control [monad #+ do]) (data text/format) [macro] (macro [code] ["s" syntax #+ syntax:]) [io #+ Process]) [//]) (def: prefix Text "LuxRuntime") (def: #export unit //.Expression (%t //.unit)) (def: (flag value) (-> Bool //.JS) (if value (%t "") "null")) (def: #export (variant tag last? value) (-> Nat Bool //.Expression //.Expression) (format "[" (%i (nat-to-int tag)) "," (flag last?) "," value "]")) (def: none //.Expression (variant +0 false unit)) (def: some (-> //.Expression //.Expression) (variant +1 true)) (def: left (-> //.Expression //.Expression) (variant +0 false)) (def: right (-> //.Expression //.Expression) (variant +1 true)) (type: Runtime //.JS) (def: (runtime-name name) (-> Text Text) (format prefix "$" name)) (def: (feature name definition) (-> Text (-> Text //.Expression) //.Statement) (format "var " name " = " (definition name) ";\n")) (syntax: (runtime-implementation-name [runtime-name s.local-symbol]) (wrap (list (code.local-symbol (format "__" runtime-name))))) (template: (runtime: ) (def: #export Text (runtime-name )) (`` (def: ((~' ~~) (runtime-implementation-name )) Runtime (feature (function [(~' @)] ))))) (def: #export (int value) (-> Int //.Expression) (format "({" //.int-high-field " : " (|> value int-to-nat //.high nat-to-int %i) ", " //.int-low-field " : " (|> value int-to-nat //.low nat-to-int %i) "})")) (def: #export (frac value) (-> Frac //.Expression) (%f value)) (runtime: lux//try "runTry" (format "(function " @ "(op) {" (format "try {" (format "return " (right "op(null)") ";") "}" "catch(ex) {" (format "return " (left "ex.toString()") ";") "}") "})")) (runtime: lux//program-args "programArgs" (format "(function " @ "() {" (format "if(typeof process !== 'undefined' && process.argv) {" (format (format "var result = " none ";") "for(var idx = process.argv.length-1; idx >= 0; idx--) {" (format "result = " (some "[process.argv[idx],result]") ";") "}") (format "return result;") "}" "else {" (format "return " none ";") "}") "})")) (def: runtime//lux Runtime (format __lux//try __lux//program-args)) (runtime: product//left "product_left" (format "(function " @ "(product,index) {" "var index_min_length = (index+1);" "if(product.length > index_min_length) {" ## No need for recursion "return product[index];" "}" "else {" ## Needs recursion "return " @ "(product[product.length - 1], (index_min_length - product.length));" "}" "})")) (runtime: product//right "product_right" (format "(function " @ "(product,index) {" "var index_min_length = (index+1);" "if(product.length === index_min_length) {" ## Last element. "return product[index];" "}" "else if(product.length < index_min_length) {" ## Needs recursion "return " @ "(product[product.length - 1], (index_min_length - product.length));" "}" "else {" ## Must slice "return product.slice(index);" "}" "})")) (runtime: sum//get "sum_get" (let [no-match "return null;" extact-match "return sum[2];" test-recursion (format "if(sum[1] === '') {" ## Must recurse. "return " @ "(sum[2], (wantedTag - sum[0]), wantsLast);" "}" "else { " no-match " }")] (format "(function " @ "(sum,wantedTag,wantsLast) {" "if(wantedTag === sum[0]) {" (format "if(sum[1] === wantsLast) {" extact-match "}" "else {" test-recursion "}") "}" (format "else if(wantedTag > sum[0]) {" test-recursion "}") (format "else if(wantedTag < sum[0] && wantsLast === '') {" "return [(sum[0]-wantedTag),sum[1],sum[2]];" "}") "else { " no-match " }" "})"))) (def: runtime//adt Runtime (format __product//left __product//right __sum//get)) (runtime: int//new "makeI64" (format "(function " @ "(high,low) {" "return { H: (high|0), L: (low|0)};" "})")) (runtime: int//2^16 "TWO_PWR_16" "(1 << 16)") (runtime: int//2^32 "TWO_PWR_32" (format "(" int//2^16 " * " int//2^16 ")")) (runtime: int//2^64 "TWO_PWR_64" (format "(" int//2^32 " * " int//2^32 ")")) (runtime: int//2^63 "TWO_PWR_63" (format "(" int//2^64 " / 2)")) (runtime: int//unsigned-low "getLowBitsUnsigned" (format "(function " @ "(i64) {" "return (i64.L >= 0) ? i64.L : (" int//2^32 " + i64.L);" "})")) (runtime: int//to-number "toNumberI64" (format "(function " @ "(i64) {" "return (i64.H * " int//2^32 ") + " int//unsigned-low "(i64);" "})")) (runtime: int//zero "ZERO" "{ H: (0|0), L: (0|0)}") (runtime: int//min "MIN_VALUE_I64" "{ H: (0x80000000|0), L: (0|0)}") (runtime: int//max "MAX_VALUE_I64" "{ H: (0x7FFFFFFF|0), L: (0xFFFFFFFF|0)}") (runtime: int//one "ONE" "{ H: (0|0), L: (1|0)}") (runtime: int//= "eqI64" (format "(function " @ "(l,r) {" "return (l.H === r.H) && (l.L === r.L);" "})")) (runtime: int//+ "addI64" (format "(function " @ "(l,r) {" "var l48 = l.H >>> 16;" "var l32 = l.H & 0xFFFF;" "var l16 = l.L >>> 16;" "var l00 = l.L & 0xFFFF;" "var r48 = r.H >>> 16;" "var r32 = r.H & 0xFFFF;" "var r16 = r.L >>> 16;" "var r00 = r.L & 0xFFFF;" "var x48 = 0, x32 = 0, x16 = 0, x00 = 0;" "x00 += l00 + r00;" "x16 += x00 >>> 16;" "x00 &= 0xFFFF;" "x16 += l16 + r16;" "x32 += x16 >>> 16;" "x16 &= 0xFFFF;" "x32 += l32 + r32;" "x48 += x32 >>> 16;" "x32 &= 0xFFFF;" "x48 += l48 + r48;" "x48 &= 0xFFFF;" "return " int//new "((x48 << 16) | x32, (x16 << 16) | x00);" "})")) (template: (bit-operation: ) (runtime: (format "(function " (~' @) "(input,mask) {" "return " int//new "(input.H " " mask.H, input.L " " mask.L);" "})"))) (bit-operation: bit//and "andI64" "&") (bit-operation: bit//or "orI64" "|") (bit-operation: bit//xor "xorI64" "^") (runtime: bit//not "notI64" (format "(function " @ "(i64) {" "return " int//new "(~i64.H,~i64.L);" "})")) (runtime: int//negate "negateI64" (format "(function " @ "(i64) {" (format "if(" int//= "(" int//min ",i64)) {" "return " int//min ";" "}") (format "else {" "return " int//+ "(" bit//not "(i64)," int//one ");" "}") "})")) (runtime: int//from-number "fromNumberI64" (format "(function " @ "(num) {" (format "if(isNaN(num)) {" "return " int//zero ";" "}") (format "else if(num <= -" int//2^63 ") {" "return " int//min ";" "}") (format "else if((num + 1) >= " int//2^63 ") {" "return " int//max ";" "}") (format "else if(num < 0) {" "return " int//negate "(" @ "(-num));" "}") (format "else {" "return " int//new "((num / " int//2^32 "), (num % " int//2^32 "));" "}") "})")) (runtime: bit//count32 "countI32" (let [last-input-bit "input & 1" update-count! (format "count += " last-input-bit ";") consume-input! "input = input >>> 1;" input-remaining? "input !== 0"] (format "(function " @ "(input) {" "var count = 0;" "while(" input-remaining? ") {" update-count! consume-input! "}" "return count;" "})"))) (runtime: bit//count "countI64" (let [high (format bit//count32 "(input.H)") low (format bit//count32 "(input.L)") whole (format "(" high " + " low ")") cast (format int//from-number "(" whole ")")] (format "(function " @ "(input) {" "return " cast ";" "})"))) (runtime: bit//shift-left "shlI64" (format "(function " @ "(input,shift) {" "shift &= 63;" (format "if(shift === 0) {" "return input;" "}" "else {" (format "if (shift < 32) {" "var high = (input.H << shift) | (input.L >>> (32 - shift));" "var low = input.L << shift;" "return " int//new "(high, low);" "}" "else {" "var high = (input.L << (shift - 32));" "return " int//new "(high, 0);" "}") "}") "})")) (runtime: bit//signed-shift-right "shrI64" (format "(function " @ "(input,shift) {" "shift &= 63;" (format "if(shift === 0) {" "return input;" "}" "else {" (format "if (shift < 32) {" "var high = input.H >> shift;" "var low = (input.L >>> shift) | (input.H << (32 - shift));" "return " int//new "(high, low);" "}" "else {" "var low = (input.H >> (shift - 32));" "var high = input.H >= 0 ? 0 : -1;" "return " int//new "(high, low);" "}") "}") "})")) (runtime: bit//shift-right "ushrI64" (format "(function " @ "(input,shift) {" "shift &= 63;" (format "if(shift === 0) {" "return input;" "}" "else {" (format "if (shift < 32) {" "var high = input.H >>> shift;" "var low = (input.L >>> shift) | (input.H << (32 - shift));" "return " int//new "(high, low);" "}" "else if(shift === 32) {" "return " int//new "(0, input.H);" "}" "else {" "var low = (input.H >>> (shift - 32));" "return " int//new "(0, low);" "}") "}") "})")) (def: runtime//bit Runtime (format __bit//and __bit//or __bit//xor __bit//not __bit//count32 __bit//count __bit//shift-left __bit//signed-shift-right __bit//shift-right)) (runtime: int//- "subI64" (format "(function " @ "(l,r) {" "return " int//+ "(l, " int//negate "(r));" "})")) (runtime: int//* "mulI64" (format "(function " @ "(l,r) {" "if (l.H < 0) {" (format "if (r.H < 0) {" ## Both are negative "return " @ "( " int//negate "(l), " int//negate "(r));" "}" "else {" ## Left is negative "return " int//negate "(" @ "( " int//negate "(l),r));" "}") "}" "else if (r.H < 0) {" ## Right is negative "return " int//negate "(" @ "(l, " int//negate "(r)));" "}" ## Both are positive "else {" "var l48 = l.H >>> 16;" "var l32 = l.H & 0xFFFF;" "var l16 = l.L >>> 16;" "var l00 = l.L & 0xFFFF;" "var r48 = r.H >>> 16;" "var r32 = r.H & 0xFFFF;" "var r16 = r.L >>> 16;" "var r00 = r.L & 0xFFFF;" "var x48 = 0, x32 = 0, x16 = 0, x00 = 0;" "x00 += l00 * r00;" "x16 += x00 >>> 16;" "x00 &= 0xFFFF;" "x16 += l16 * r00;" "x32 += x16 >>> 16;" "x16 &= 0xFFFF;" "x16 += l00 * r16;" "x32 += x16 >>> 16;" "x16 &= 0xFFFF;" "x32 += l32 * r00;" "x48 += x32 >>> 16;" "x32 &= 0xFFFF;" "x32 += l16 * r16;" "x48 += x32 >>> 16;" "x32 &= 0xFFFF;" "x32 += l00 * r32;" "x48 += x32 >>> 16;" "x32 &= 0xFFFF;" "x48 += (l48 * r00) + (l32 * r16) + (l16 * r32) + (l00 * r48);" "x48 &= 0xFFFF;" "return " int//new "((x48 << 16) | x32, (x16 << 16) | x00);" "}" "})")) (runtime: int//< "ltI64" (format "(function " @ "(l,r) {" "var ln = l.H < 0;" "var rn = r.H < 0;" "if(ln && !rn) { return true; }" "if(!ln && rn) { return false; }" "return (" int//- "(l,r).H < 0);" "})")) (runtime: int/// "divI64" (format "(function " @ "(l,r) {" (format "if((r.H === 0) && (r.L === 0)) {" ## Special case: R = 0 "throw new Error('Cannot divide by zero!');" "}" "else if((l.H === 0) && (l.L === 0)) {" ## Special case: L = 0 "return l;" "}") (format "if(" int//= "(l," int//min ")) {" ## Special case: L = MIN (format "if(" int//= "(r," int//one ") || " int//= "(r, " int//negate "(" int//one "))) {" ## Special case: L = MIN, R = 1|-1 "return " int//min ";" "}" ## Special case: L = R = MIN "else if(" int//= "(r," int//min ")) {" "return " int//one ";" "}" ## Special case: L = MIN "else {" "var halfL = " bit//signed-shift-right "(l,1);" "var approx = " bit//shift-left "(" @ "(halfL,r),1);" (format "if((approx.H === 0) && (approx.L === 0)) {" (format "if(r.H < 0) {" "return " int//one ";" "}" "else {" "return " int//negate "(" int//one ");" "}") "}" "else {" "var rem = " int//- "(l," int//* "(r,approx));" "return " int//+ "(approx," @ "(rem,r));" "}") "}") "}" "else if(" int//= "(r," int//min ")) {" ## Special case: R = MIN "return " int//new "(0,0);" "}") ## Special case: negatives (format "if(l.H < 0) {" (format "if(r.H < 0) {" ## Both are negative "return " @ "( " int//negate "(l), " int//negate "(r));" "}" "else {" ## Only L is negative "return " int//negate "(" @ "( " int//negate "(l),r));" "}") "}" "else if(r.H < 0) {" ## R is negative "return " int//negate "(" @ "(l, " int//negate "(r)));" "}") ## Common case (format "var res = " int//zero ";" "var rem = l;" (format "while(" int//< "(r,rem) || " int//= "(r,rem)) {" "var approx = Math.max(1, Math.floor(" int//to-number "(rem) / " int//to-number "(r)));" "var log2 = Math.ceil(Math.log(approx) / Math.LN2);" "var delta = (log2 <= 48) ? 1 : Math.pow(2, log2 - 48);" "var approxRes = " int//from-number "(approx);" "var approxRem = " int//* "(approxRes,r);" (format "while((approxRem.H < 0) || " int//< "(rem,approxRem)) {" "approx -= delta;" "approxRes = " int//from-number "(approx);" "approxRem = " int//* "(approxRes,r);" "}") (format "if((approxRes.H === 0) && (approxRes.L === 0)) {" "approxRes = " int//one ";" "}") "res = " int//+ "(res,approxRes);" "rem = " int//- "(rem,approxRem);" "}") "return res;") "})")) (runtime: int//% "remI64" (format "(function " @ "(l,r) {" "return " int//- "(l," int//* "(" int/// "(l,r),r));" "})")) (def: runtime//int Runtime (format __int//2^16 __int//2^32 __int//2^64 __int//2^63 __int//unsigned-low __int//zero __int//new __int//min __int//max __int//one __int//= __int//+ __int//negate __int//to-number __int//from-number __int//- __int//* __int//< __int/// __int//%)) (runtime: nat//< "ltN64" (format "(function " @ "(l,r) {" "var li = " int//+ "(l," int//min ");" "var ri = " int//+ "(r," int//min ");" "return " int//< "(li,ri);" "})")) (runtime: nat//div-word "divWord" (format "(function " @ "(result, n, d) {" "var dLong = " int//new "(0,d);" (format "if (" int//= "(dLong," int//one ")) {" (format "result[0] = n.L;" "result[1] = 0;" "return") "}" "else {" ## Approximate the quotient and remainder (format "var q = " int/// "(" bit//shift-right "(n,1)," bit//shift-right "(dLong,1));" "var r = " int//- "(n," int//* "(q,dLong));" ## Correct the approximation (format "while(" int//< "(r," int//zero ")) {" "r = " int//+ "(r,dLong);" "q = " int//- "(q," int//one ");" "}") (format "while(" int//< "(dLong,r) || " int//= "(dLong,r)) {" "r = " int//- "(r,dLong);" "q = " int//+ "(q," int//one ");" "}") "result[0] = q.L;" "result[1] = r.L;" ) "}") "})")) (runtime: nat//shift-left|primitive "primitiveShiftLeftBigInt" (format "(function " @ "(input,shift) {" "var output = input.slice();" "var shift2 = 32 - shift;" (format "for(var i = 0, c = output[i], m = (i + (input.length - 1)); i < m; i++) {" "var b = c;" "c = output[i+1];" "output[i] = (b << shift) | (c >>> shift2);" "}") "output[(input.length - 1)] <<= shift;" "return output;" "})")) (runtime: nat//shift-right|primitive "primitiveShiftRightBigInt" (format "(function " @ "(input,shift) {" "var output = input.slice();" "var shift2 = 32 - shift;" (format "for(var i = (input.length - 1), c = output[i]; i > 0; i--) {" "var b = c;" "c = output[i-1];" "output[i] = (c << shift2) | (b >>> shift);" "}") "output[0] >>>= shift;" "return output;" "})")) (runtime: nat//shift-left "shiftLeftBigInt" (format "(function " @ "(input,shift) {" "var shiftInts = shift >>> 5;" "var shiftBits = shift & 0x1F;" "var bitsInHighWord = " bit//count "(" int//new "(input[0],0));" (format "if(shift <= (32 - bitsInHighWord)) {" "var shifted = " bit//shift-left "(" int//new "(input[0],input[1]),shiftBits);" "return [shifted.H,shifted.L];" "}") "var inputLen = input[0] === 0 ? 1 : 2;" "var newLen = inputLen + shiftInts + 1;" (format "if(shiftBits <= (32 - bitsInHighWord)) {" "newLen--;" "}") (format "if(input.length < newLen) {" ## The array must grow "input = [0|0,input[0],input[1]];" "}") (format "if(nBits == 0) {" "return input;" "}") (format "if(shiftBits <= (32 - bitsInHighWord)) {" "return " nat//shift-left|primitive "(input,shiftBits);" "}" "else {" "return " nat//shift-right|primitive "(input,(32 - shiftBits));" "}") "})")) (runtime: nat//shift-right "shiftRightBigInt" (format "(function " @ "(input,shift) {" "var shiftInts = shift >>> 5;" "var shiftBits = shift & 0x1F;" "if(shiftBits === 0) { return input; }" "var bitsInHighWord = " bit//count "(" int//new "(input[0],0));" (format "if(shiftBits >= bitsInHighWord) {" "return " nat//shift-left|primitive "(input,(32-shiftBits));" "}" "else {" "return " nat//shift-right|primitive "(input,shiftBits);" "}") "})")) (runtime: nat//mul-sub "mulsubBigInt" (format "(function " @ "(q, a, x, len, offset) {" "var xLong = " int//new "(0,x);" "var carry = " int//zero ";" "offset += len;" (format "for (var j = len-1; j >= 0; j--) {" "var product = " int//+ "(" int//* "(" int//new "(0,a[j]),xLong),carry);" "var difference = " int//- "(" int//new "(0,q[offset]),product);" "carry = " int//+ "(" bit//shift-right "(product,32),((difference.L > ~product.L) ? " int//one " : " int//zero "));" "}") "return carry.L;" "})")) (runtime: nat//div-add "divadd" (format "(function " @ "(a, result, offset) {" "var carry = " int//zero ";" (format "for (var j = a.length - 1; j >= 0; j--) {" "var sum = " int//+ "(" int//+ "(" int//new "(0,a[j])," int//new "(0,result[j+offset])),carry);" "result[j+offset] = sum.L;" "carry = " bit//shift-right "(sum,32);" "}") "return carry.L;" "})")) (runtime: nat//normalize "normalizeBigInt" (format "(function " @ "(input) {" (format "if(input[0] !== 0) {" "return " int//new "(input[0],input[1]);" "}" "else {" (format "var numZeros = 0;" (format "do {" "numZeros++;" "} while(numZeros < input.length && input[numZeros] == 0);") "var tempInput = input.slice(input.length-Math.max(2,input.length-numZeros));" "return " int//new "(tempInput[0],tempInput[1]);") "}") "})")) (runtime: nat//divide-one-word "divideOneWord" (format "(function " @ "(subject,param) {" (format "var divLong = " int//new "(0,param);" ## Special case of one word dividend (format "if(subject.H === 0) {" (format "var remValue = " int//new "(0,subject.L);" "var quotient = " int/// "(remValue,divLong);" "var remainder = " int//- "(remValue," int//* "(quotient.L,divLong));" "return [quotient,remainder];") "}") "var quotient = [0|0,0|0];" ## Normalize the divisor "var shift = 32 - " bit//count "(" int//new "(0,param));" "var rem = subject.H;" "var remLong = " int//new "(0,rem);" (format "if(" int//< "(remLong,divLong)) {" "quotient[0] = 0|0;" "}" "else {" "quotient[0] = " int/// "(remLong,divLong).L;" "rem = " int//- "(remLong," int//* "(quotient[0],divLong)).L;" "remLong = " int//new "(0,rem);" "}") "var remBI = [subject.H,subject.L];" "var xlen = 2;" "var qWord = [0|0,0|0];" (format "while(--xlen > 0) {" "var dividendEstimate = " bit//or "(" bit//shift-left "(remLong,32)," int//new "(0,remBI[2 - xlen]));" (format "if(dividendEstimate >= 0) {" "var highWord = " int/// "(dividendEstimate,divLong);" "qWord[0] = highWord.L;" "qWord[1] = " int//- "(dividendEstimate," int//* "(highWord,divLong)).L;" "}" "else {" "" nat//div-word "(qWord, dividendEstimate, param);" "}") "quotient[2 - xlen] = qWord[0];" "rem = qWord[1];" "remLong = " int//new "(0,rem);" "}") ## Unnormalize (format "if(shift > 0) {" "rem %= divisor;" "remBI[0] = rem;" "}" "else {" "remBI[0] = rem;" "}") "var quotI64 = " nat//normalize "(quotient);" "var remI64 = " int//new "(remBI[0],remBI[1]);" "return [quotI64,remI64];") "})")) (runtime: nat//div-mod "divmodBigInt" (format "(function " @ "(subject,param) {" (format "if(" int//= "(param," int//zero ")) {" "throw new Error('Cannot divide by zero!');" "}") (format "if(" int//= "(subject," int//zero ")) {" "return [" int//zero ", " int//zero "];" "}") (format "if(" nat//< "(subject,param)) {" "return [" int//zero ", subject];" "}") (format "if(" int//= "(subject,param)) {" "return [" int//one ", " int//zero "];" "}") ##################################### (format "if (param.H === 0) {" "return " nat//divide-one-word "(subject,param.L);" "}") ##################################### "var divisor = param;" "var remainder = subject.H === 0 ? [0|0,subject.L] : [0|0,subject.H,subject.L];" "var paramLength = param.H === 0 ? 1 : 2;" "var subjLength = subject.H === 0 ? 1 : 2;" "var limit = subjLength - paramLength + 1;" "var quotient = (limit === 1) ? [0|0] : [0|0,0|0];" ## Normalize the divisor "var shift = 32 - " bit//count "(" int//new "(divisor.H,0));" (format "if(shift > 0) {" "divisor = " bit//shift-left "(divisor,shift);" "remainder = " nat//shift-left "(remainder,shift);" "}") (format "if((remainder.length-1) === subjLength) {" "remainder[0] = 0;" "}") "var dh = divisor.H;" "var dhLong = " int//new "(0,dh);" "var dl = divisor.L;" "var qWord = [0|0,0|0];" ## D2 Initialize j (format "for(var j = 0; j < limit; j++) {" ## D3 Calculate qhat ## estimate qhat "var qhat = 0;" "var qrem = 0;" "var skipCorrection = false;" "var nh = remainder[j];" "var nh2 = nh + 0x80000000;" "var nm = remainder[j+1];" (format "if(nh == dh) {" (format "qhat = ~0;" "qrem = nh + nm;" "skipCorrection = (qrem + 0x80000000) < nh2;") "}" "else {" (format "var nChunk = " bit//or "(" bit//shift-left "(" int//from-number "(nh),32)," int//from-number "(nm));") (format "if(" int//< "(" int//zero ",nChunk) || " int//= "(" int//zero ",nChunk)) {" (format "qhat = " int/// "(nChunk,dhLong).L;" "qrem = " int//- "(nChunk," int//* "(qhat, dhLong)).L;") "}" "else {" (format "" nat//div-word "(qWord, nChunk, dh);" "qhat = qWord[0];" "qrem = qWord[1];" ) "}") "if(qhat == 0) { continue; }" (format "if(!skipCorrection) {" ## Correct qhat (format "var qremLong = " int//new "(0,qrem);" "var dlLong = " int//new "(0,dl);" "var nl = " int//new "(0,remainder[j+2]);" "var rs = " bit//or "(" bit//shift-left "(qremLong,32),nl);" "var estProduct = " int//* "(dlLong," int//new "(0,qhat));" (format "if(" nat//< "(rs,estProduct)) {" (format "qhat--;" "qrem = " int//+ "(qremLong,dhLong).L;" "qremLong = " int//new "(0,qrem);" (format "if(" int//< "(dhLong,qremLong) || " int//= "(dhLong,qremLong)) {" (format "estProduct = " int//* "(dlLong," int//new "(0,qhat));" "rs = " bit//or "(" bit//shift-left "(qremLong,32),nl);" "if(" nat//< "(rs,estProduct)) { qhat--; }") "}")) "}") ) "}") ## D4 Multiply and subtract "remainder[j] = 0;" "var borrow = " nat//mul-sub "(remainder, divisor, qhat, paramLength, j);" ## D5 Test remainder (format "if((borrow + 0x80000000) > nh2) {" ## D6 Add back nat//div-add "(divisor, remainder, j+1);" "qhat--;" "}") ## Store the quotient digit "quotient[j] = qhat;" "}") "}") ## D7 loop on j ## D8 Unnormalize "if(shift > 0) { remainder = " nat//shift-right "(remainder,shift); }" "return [" nat//normalize "(quotient), " nat//normalize "(remainder)];" "})")) (runtime: nat/// "divN64" (format "(function " @ "(l,r) {" (format "if(" int//< "(r," int//zero ")) {" (format "if(" nat//< "(l,r)) {" "return " int//zero ";" "}" "else {" "return " int//one ";" "}") "}" "else if(" int//< "(" int//zero ",l)) {" "return " int/// "(l,r);" "}" "else {" (format "if(" int//= "(" int//zero ",r)) {" "throw new Error('Cannot divide by zero!');" "}" "else {" (format "if(" int//< "(l,r)) {" "return " int//zero ";" "}" "else {" "return " nat//div-mod "(l,r)[0];" "}") "}") "}") "})")) (runtime: nat//% "remN64" (format "(function " @ "(l,r) {" (format "if(" int//< "(l," int//zero ") || " int//< "(r," int//zero ")) {" (format "if(" nat//< "(l,r)) {" "return l;" "}" "else {" "return " nat//div-mod "(l,r)[1];" "}") "}" "else {" "return " int//% "(l,r);" "}") "})")) (def: runtime//nat Runtime (format __nat//< __nat//div-word __nat//shift-left|primitive __nat//shift-right|primitive __nat//shift-left __nat//shift-right __nat//mul-sub __nat//div-add __nat//normalize __nat//divide-one-word __nat//div-mod __nat/// __nat//%)) (runtime: deg//* "mulD64" (format "(function " @ "(l,r) {" "var lL = " int//from-number "(l.L);" "var rL = " int//from-number "(r.L);" "var lH = " int//from-number "(l.H);" "var rH = " int//from-number "(r.H);" "var bottom = " bit//shift-right "(" int//* "(lL,rL),32);" "var middle = " int//+ "(" int//* "(lH,rL)," int//* "(lL,rH));" "var top = " int//* "(lH,rH);" "var bottomAndMiddle = " bit//shift-right "(" int//+ "(middle,bottom),32);" "return " int//+ "(top,bottomAndMiddle);" "})")) (runtime: deg//leading-zeroes "countLeadingZeroes" (format "(function " @ "(input) {" "var zeroes = 64;" (format "while(!" int//= "(input," int//zero ")) {" "zeroes--;" "input = " bit//shift-right "(input,1);" "}") "return zeroes;" "})")) (runtime: deg/// "divD64" (format "(function " @ "(l,r) {" (format "if(" int//= "(l,r)) {" "return " int//negate "(" int//one ");" ## ~= 1.0 DEG "}" "else {" "var minShift = Math.min(" deg//leading-zeroes "(l), " deg//leading-zeroes "(r));" "l = " bit//shift-left "(l,minShift);" "r = " bit//shift-left "(r,minShift);" "return " bit//shift-left "(" int/// "(l," int//from-number "(r.H)),32);" "}") "})")) (runtime: deg//to-frac "degToFrac" (format "(function " @ "(input) {" "var two32 = Math.pow(2,32);" "var high = input.H / two32;" "var low = (input.L / two32) / two32;" "return high+low;" "})")) (runtime: deg//from-frac "fracToDeg" (format "(function " @ "(input) {" "var two32 = Math.pow(2,32);" "var shifted = (input % 1.0) * two32;" "var low = ((shifted % 1.0) * two32) | 0;" "var high = shifted | 0;" "return " int//new "(high,low);" "})")) (def: runtime//deg Runtime (format __deg//* __deg//leading-zeroes __deg/// __deg//to-frac __deg//from-frac)) (runtime: text//index "index" (format "(function " @ "(text,part,start) {" "var idx = text.indexOf(part," int//to-number "(start));" (format (format "if(idx === -1) {" "return " none ";" "}") (format "else {" (format "return " (some (format int//from-number "(idx)")) ";") "}")) "})")) (runtime: text//last-index "lastIndex" (format "(function " @ "(text,part,start) {" "var idx = text.lastIndexOf(part," int//to-number "(start));" (format (format "if(idx === -1) {" "return " none ";" "}") (format "else {" (format "return " (some (format int//from-number "(idx)")) ";") "}")) "})")) (runtime: text//clip "clip" (format "(function " @ "(text,from,to) {" (format "if(from.L > text.length || to.L > text.length) {" (format "return " none ";") "}" "else {" (format "return " (some "text.substring(from.L,to.L)") ";") "}") "})")) (runtime: text//replace-all "replaceAll" (format "(function " @ "(text,toFind,replaceWith) {" "var reEscaped = toFind.replace(/[.*+?^${}()|[\\]\\\\]/g, '\\\\$&');" "return text.replace(new RegExp(reEscaped, 'g'), replaceWith);" "})")) (runtime: text//char "textChar" (format "(function " @ "(text,idx) {" "var result = text.charAt(idx.L);" (format "if(result === '') {" (format "return " none ";") "}" "else {" (format "return " (some "{'C':result}") ";") "}") "var reEscaped = toFind.replace(/[.*+?^${}()|[\\]\\\\]/g, '\\\\$&');" "return text.replace(new RegExp(reEscaped, 'g'), replaceWith);" "})")) (runtime: text//hash "textHash" (format "(function " @ "(input) {" "var hash = 0;" (format "for(var i = 0; i < input.length; i++) {" "hash = (((hash << 5) - hash) + input.charCodeAt(i)) & 0xFFFFFFFF;" "}") "return " int//from-number "(hash);" "})")) (def: runtime//text Runtime (format __text//index __text//last-index __text//clip __text//replace-all __text//char __text//hash)) (runtime: array//get "arrayGet" (format "(function " @ "(arr,idx) {" "var temp = arr[" int//to-number "(idx)];" (format "if(temp !== undefined) {" (format "return " (some "temp") ";") "}" "else {" (format "return " none ";") "}") "})")) (runtime: array//put "arrayPut" (format "(function " @ "(arr,idx,val) {" "arr[" int//to-number "(idx)] = val;" "return arr;" "})")) (runtime: array//remove "arrayRemove" (format "(function " @ "(arr,idx) {" "delete arr[" int//to-number "(idx)];" "return arr;" "})")) (def: runtime//array Runtime (format __array//get __array//put __array//remove)) (runtime: io//error "error" (format "(function " @ "(message) {" "throw new Error(message);" "})")) (def: runtime//io Runtime (format __io//error)) (def: #export atom-field Text "V") (runtime: atom//compare-and-swap "atomCompareAndSwap" (format "(function " @ "(atom,oldV,newV) {" "if(atom." atom-field " === oldV) {" "atom." atom-field " = newV;" "return true;" "}" "else {" "return false;" "}" "})")) (def: runtime//atom Runtime (format __atom//compare-and-swap)) (runtime: js//get "jsGetField" (format "(function " @ "(object, field) {" "var temp = object[field];" (format "if(temp !== undefined) {" (format "return " (some "temp") ";") "}" "else {" (format "return " none ";") "}") "})")) (runtime: js//set "jsSetField" (format "(function " @ "(object, field, input) {" "object[field] = input;" "return object;" "})")) (runtime: js//delete "jsDeleteField" (format "(function " @ "(object, field) {" "delete object[field];" "return object;" "})")) (runtime: js//call "jsObjectCall" (format "(function " @ "(object, method, args) {" "return object[method].apply(object, args);" "})")) (def: runtime//js Runtime (format __js//get __js//set __js//delete __js//call)) (def: runtime Runtime (format runtime//lux runtime//adt runtime//bit runtime//int runtime//nat runtime//deg runtime//text runtime//array runtime//io runtime//atom runtime//js)) (def: #export artifact Text (format prefix ".js")) (def: #export translate (Meta (Process Unit)) (do macro.Monad [_ //.init-module-buffer _ (//.save-js runtime)] (//.save-module! artifact)))