(.module:
  lux
  (lux (control [monad #+ do])
       (data text/format)
       [macro]
       (macro [code]
              ["s" syntax #+ syntax:])
       [io #+ Process])
  [//]
  (luxc (lang (host [js #+ JS Expression Statement]))))

(def: prefix Text "LuxRuntime")

(def: #export unit Expression (%t //.unit))

(def: (flag value)
  (-> Bool JS)
  (if value
    (%t "")
    "null"))

(def: (variant' tag last? value)
  (-> Expression Expression Expression Expression)
  (js.object (list [//.variant-tag-field tag]
                   [//.variant-flag-field last?]
                   [//.variant-value-field value])))

(def: #export (variant tag last? value)
  (-> Nat Bool Expression Expression)
  (variant' (%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: <lux-name> <js-name> <js-definition>)
  (def: #export <lux-name> Text (runtime-name <js-name>))
  (`` (def: ((~' ~~) (runtime-implementation-name <lux-name>))
        Runtime
        (feature <lux-name>
                 (function [(~' @)]
                   <js-definition>)))))

(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
  (-> Frac Expression)
  js.number)

(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;"
        sum-tag (format "sum." //.variant-tag-field)
        sum-flag (format "sum." //.variant-flag-field)
        sum-value (format "sum." //.variant-value-field)
        is-last? (format sum-flag " === ''")
        extact-match (format "return " sum-value ";")
        test-recursion (format "if(" is-last? ") {"
                               ## Must recurse.
                               "return " @ "(" sum-value ", (wantedTag - " sum-tag "), wantsLast);"
                               "}"
                               "else { " no-match " }")]
    (format "(function " @ "(sum,wantedTag,wantsLast) {"
            "if(wantedTag === " sum-tag ") {"
            (format "if(" sum-flag " === wantsLast) {" extact-match "}"
                    "else {" test-recursion "}")
            "}"
            (format "else if(wantedTag > " sum-tag ") {" test-recursion "}")
            (format "else if(wantedTag < " sum-tag " && wantsLast === '') {"
                    (let [updated-sum (variant' (format "(" sum-tag " - wantedTag)") sum-flag sum-value)]
                      (format "return " updated-sum ";"))
                    "}")
            "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: <lux-name> <js-name> <op>)
  (runtime: <lux-name> <js-name>
    (format "(function " (~' @) "(input,mask) {"
            "return " int//new "(input.H " <op> " mask.H, input.L " <op> " 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//-one "NEG_ONE"
  (js.apply int//negate (list 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);"
          "})"))

(def: (<I param subject)
  (-> Expression Expression Expression)
  (js.apply int//< (list subject param)))

(def: (<=I param subject)
  (-> Expression Expression Expression)
  (js.or (js.apply int//< (list subject param))
         (js.apply int//= (list subject param))))

(def: (>I param subject)
  (-> Expression Expression Expression)
  (js.apply int//< (list param subject)))

(def: (>=I param subject)
  (-> Expression Expression Expression)
  (js.or (js.apply int//< (list param subject))
         (js.apply int//= (list subject param))))

(def: (=I reference sample)
  (-> Expression Expression Expression)
  (js.apply int//= (list sample reference)))

(runtime: int/// "divI64"
  (let [negate (|>> (list) (js.apply int//negate))
        negative? (function [value]
                    (js.apply int//< (list value int//zero)))
        valid-division-check [(=I int//zero "parameter")
                              (js.throw! (js.string "Cannot divide by zero!"))]
        short-circuit-check [(=I int//zero "subject")
                             (js.return! int//zero)]
        recur (function [subject parameter]
                (js.apply @ (list subject parameter)))]
    (js.function @ (list "subject" "parameter")
      (list (js.cond! (list valid-division-check
                            short-circuit-check

                            [(=I int//min "subject")
                             (js.cond! (list [(js.or (=I int//one "parameter")
                                                     (=I int//-one "parameter"))
                                              (js.return! int//min)]
                                             [(=I int//min "parameter")
                                              (js.return! int//one)])
                                       (js.block! (list (js.var! "approximation"
                                                                 (#.Some (js.apply bit//shift-left
                                                                                   (list (recur (js.apply bit//signed-shift-right
                                                                                                          (list "subject" (js.number 1.0)))
                                                                                                "parameter")
                                                                                         (js.number 1.0)))))
                                                        (js.if! (=I int//zero "approximation")
                                                                (js.return! (js.? (negative? "parameter")
                                                                                  int//one
                                                                                  int//-one))
                                                                (let [remainder (js.apply int//- (list "subject"
                                                                                                       (js.apply int//* (list "parameter"
                                                                                                                              "approximation"))))
                                                                      result (js.apply int//+ (list "approximation"
                                                                                                    (recur remainder
                                                                                                           "parameter")))]
                                                                  (js.return! result))))))]
                            [(=I int//min "parameter")
                             (js.return! int//zero)]

                            [(negative? "subject")
                             (js.return! (js.? (negative? "parameter")
                                               (recur (negate "subject")
                                                      (negate "parameter"))
                                               (negate (recur (negate "subject")
                                                              "parameter"))))]

                            [(negative? "parameter")
                             (js.return! (negate (recur "subject" (negate "parameter"))))])
                      (js.block! (list (js.var! "result" (#.Some int//zero))
                                       (js.var! "remainder" (#.Some "subject"))
                                       (js.while! (>=I "parameter" "remainder")
                                                  (let [rough-estimate (js.apply "Math.floor" (list (js./ (js.apply int//to-number (list "parameter"))
                                                                                                          (js.apply int//to-number (list "remainder")))))
                                                        log2 (js./ "Math.LN2"
                                                                   (js.apply "Math.log" (list "approximate")))
                                                        approx-result (js.apply int//from-number (list "approximate"))
                                                        approx-remainder (js.apply int//* (list "approximate_result" "parameter"))]
                                                    (list (js.var! "approximate" (#.Some (js.apply "Math.max" (list (js.number 1.0)
                                                                                                                    rough-estimate))))
                                                          (js.var! "log2" (#.Some (js.apply "Math.ceil" (list log2))))
                                                          (js.var! "delta" (#.Some (js.? (js.<= (js.number 48.0) "log2")
                                                                                         (js.number 1.0)
                                                                                         (js.apply "Math.pow" (list (js.number 2.0)
                                                                                                                    (js.- (js.number 48.0)
                                                                                                                          "log2"))))))
                                                          (js.var! "approximate_result" (#.Some approx-result))
                                                          (js.var! "approximate_remainder" (#.Some approx-remainder))
                                                          (js.while! (js.or (negative? "approximate_remainder")
                                                                            (>I "remainder"
                                                                                "approximate_remainder"))
                                                                     (list (js.set! "approximate" (js.- "delta" "approximate"))
                                                                           (js.set! "approximate_result" approx-result)
                                                                           (js.set! "approximate_remainder" approx-remainder)))
                                                          (js.block! (list (js.set! "result" (js.apply int//+ (list "result"
                                                                                                                    (js.? (=I int//zero "approximate_result")
                                                                                                                          int//one
                                                                                                                          "approximate_result"))))
                                                                           (js.set! "remainder" (js.apply int//- (list "remainder" "approximate_remainder"))))))))
                                       (js.return! "result")))
                      )))))

(runtime: int//% "remI64"
  (js.function @ (list "subject" "parameter")
    (list (let [flat (js.apply int//* (list (js.apply int/// (list "subject" "parameter"))
                                            "parameter"))]
            (js.return! (js.apply int//- (list "subject" flat)))))))

(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.charCodeAt(idx.L);"
          (format "if(result === NaN) {"
                  (format "return " none ";")
                  "}"
                  "else {"
                  (format "return " (some (format int//from-number "(result)")) ";")
                  "}")
          "})"))

(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//log "log"
  (format "(function " @ "(message) {"
          "if(typeof console !== \"undefined\" && console.log) { console.log(message); }"
          "else if(typeof print !== \"undefined\") { print(message); }"
          "return " unit ";"
          "})"))

(runtime: io//error "error"
  (format "(function " @ "(message) {"
          "throw new Error(message);"
          "})"))

(def: runtime//io
  Runtime
  (format __io//log
          __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<Meta>
    [_ //.init-module-buffer
     _ (//.save-js runtime)]
    (//.save-module! artifact)))