(.module:
  [lux #*
   [abstract
    ["." monad (#+ do)]]
   [control
    ["p" parser]
    ["ex" exception (#+ exception:)]]
   [data
    ["." text
     format]
    [collection
     ["." dictionary]]]
   [tool
    [compiler
     ["." synthesis (#+ Synthesis)]
     ["." phase
      [generation
       [extension (#+ Nullary Unary Binary Trinary Variadic
                      nullary unary binary trinary variadic)]]
      ["." extension
       ["." bundle]]]]]
   [host (#+ import:)]]
  [luxc
   [lang
    [host
     ["$" jvm (#+ Label Inst Method Bundle)
      ["_t" type]
      ["_" inst]]]]]
  ["." ///
   ["." runtime]])

(import: java/lang/Double
  (#static MIN_VALUE Double)
  (#static MAX_VALUE Double))

(def: $Object-Array $.Type (_t.array 1 ///.$Object))
(def: $String $.Type (_t.class "java.lang.String" (list)))
(def: $CharSequence $.Type (_t.class "java.lang.CharSequence" (list)))

(def: lux-intI Inst (|>> _.I2L (_.wrap #$.Long)))
(def: jvm-intI Inst (|>> (_.unwrap #$.Long) _.L2I))
(def: check-stringI Inst (_.CHECKCAST "java.lang.String"))

(def: (predicateI tester)
  (-> (-> Label Inst)
      Inst)
  (<| _.with-label (function (_ @then))
      _.with-label (function (_ @end))
      (|>> (tester @then)
           (_.GETSTATIC "java.lang.Boolean" "FALSE" (_t.class "java.lang.Boolean" (list)))
           (_.GOTO @end)
           (_.label @then)
           (_.GETSTATIC "java.lang.Boolean" "TRUE" (_t.class "java.lang.Boolean" (list)))
           (_.label @end)
           )))

(def: unitI Inst (_.string synthesis.unit))

(def: (lux::is [referenceI sampleI])
  (Binary Inst)
  (|>> referenceI
       sampleI
       (predicateI _.IF_ACMPEQ)))

(def: (lux::try riskyI)
  (Unary Inst)
  (|>> riskyI
       (_.CHECKCAST ///.function-class)
       (_.INVOKESTATIC ///.runtime-class "try"
                       (_t.method (list ///.$Function) (#.Some $Object-Array) (list))
                       #0)))

(template [<name> <op>]
  [(def: (<name> [maskI inputI])
     (Binary Inst)
     (|>> inputI (_.unwrap #$.Long)
          maskI (_.unwrap #$.Long)
          <op> (_.wrap #$.Long)))]

  [bit::and _.LAND]
  [bit::or  _.LOR]
  [bit::xor _.LXOR]
  )

(template [<name> <op>]
  [(def: (<name> [shiftI inputI])
     (Binary Inst)
     (|>> inputI (_.unwrap #$.Long)
          shiftI jvm-intI
          <op>
          (_.wrap #$.Long)))]

  [bit::left-shift             _.LSHL]
  [bit::arithmetic-right-shift _.LSHR]
  [bit::logical-right-shift    _.LUSHR]
  )

(template [<name> <const> <type>]
  [(def: (<name> _)
     (Nullary Inst)
     (|>> <const> (_.wrap <type>)))]

  [frac::smallest (_.double (Double::MIN_VALUE))            #$.Double]
  [frac::min      (_.double (f/* -1.0 (Double::MAX_VALUE))) #$.Double]
  [frac::max      (_.double (Double::MAX_VALUE))            #$.Double]
  )

(template [<name> <type> <op>]
  [(def: (<name> [paramI subjectI])
     (Binary Inst)
     (|>> subjectI (_.unwrap <type>)
          paramI (_.unwrap <type>)
          <op>
          (_.wrap <type>)))]

  [i64::+  #$.Long   _.LADD]
  [i64::-  #$.Long   _.LSUB]
  [int::*  #$.Long   _.LMUL]
  [int::/  #$.Long   _.LDIV]
  [int::%  #$.Long   _.LREM]
  
  [frac::+ #$.Double _.DADD]
  [frac::- #$.Double _.DSUB]
  [frac::* #$.Double _.DMUL]
  [frac::/ #$.Double _.DDIV]
  [frac::% #$.Double _.DREM]
  )

(template [<eq> <lt> <unwrap> <cmp>]
  [(template [<name> <reference>]
     [(def: (<name> [paramI subjectI])
        (Binary Inst)
        (|>> subjectI <unwrap>
             paramI <unwrap>
             <cmp>
             (_.int <reference>)
             (predicateI _.IF_ICMPEQ)))]
     
     [<eq> +0]
     [<lt> -1])]

  [i64::= int::< (_.unwrap #$.Long)   _.LCMP]
  [frac::= frac::< (_.unwrap #$.Double) _.DCMPG]
  )

(template [<name> <prepare> <transform>]
  [(def: (<name> inputI)
     (Unary Inst)
     (|>> inputI <prepare> <transform>))]

  [int::frac (_.unwrap #$.Long) (<| (_.wrap #$.Double) _.L2D)]
  [int::char (_.unwrap #$.Long)
   ((|>> _.L2I _.I2C (_.INVOKESTATIC "java.lang.Character" "toString" (_t.method (list _t.char) (#.Some $String) (list)) #0)))]

  [frac::int (_.unwrap #$.Double) (<| (_.wrap #$.Long) _.D2L)]
  [frac::encode (_.unwrap #$.Double)
   (_.INVOKESTATIC "java.lang.Double" "toString" (_t.method (list _t.double) (#.Some $String) (list)) #0)]
  [frac::decode ..check-stringI
   (_.INVOKESTATIC ///.runtime-class "decode_frac" (_t.method (list $String) (#.Some $Object-Array) (list)) #0)]
  )

(def: (text::size inputI)
  (Unary Inst)
  (|>> inputI
       ..check-stringI
       (_.INVOKEVIRTUAL "java.lang.String" "length" (_t.method (list) (#.Some _t.int) (list)) #0)
       lux-intI))

(template [<name> <pre-subject> <pre-param> <op> <post>]
  [(def: (<name> [paramI subjectI])
     (Binary Inst)
     (|>> subjectI <pre-subject>
          paramI <pre-param>
          <op> <post>))]

  [text::= (<|) (<|)
   (_.INVOKEVIRTUAL "java.lang.Object" "equals" (_t.method (list ///.$Object) (#.Some _t.boolean) (list)) #0)
   (_.wrap #$.Boolean)]
  [text::< ..check-stringI ..check-stringI
   (_.INVOKEVIRTUAL "java.lang.String" "compareTo" (_t.method (list $String) (#.Some _t.int) (list)) #0)
   (predicateI _.IFLT)]
  [text::char ..check-stringI jvm-intI
   (_.INVOKEVIRTUAL "java.lang.String" "charAt" (_t.method (list _t.int) (#.Some _t.char) (list)) #0)
   lux-intI]
  )

(def: (text::concat [leftI rightI])
  (Binary Inst)
  (|>> leftI ..check-stringI
       rightI ..check-stringI
       (_.INVOKEVIRTUAL "java.lang.String" "concat" (_t.method (list $String) (#.Some $String) (list)) #0)))

(def: (text::clip [startI endI subjectI])
  (Trinary Inst)
  (|>> subjectI ..check-stringI
       startI jvm-intI
       endI jvm-intI
       (_.INVOKEVIRTUAL "java.lang.String" "substring" (_t.method (list _t.int _t.int) (#.Some $String) (list)) #0)))

(def: index-method Method (_t.method (list $String _t.int) (#.Some _t.int) (list)))
(def: (text::index [startI partI textI])
  (Trinary Inst)
  (<| _.with-label (function (_ @not-found))
      _.with-label (function (_ @end))
      (|>> textI ..check-stringI
           partI ..check-stringI
           startI jvm-intI
           (_.INVOKEVIRTUAL "java.lang.String" "indexOf" index-method #0)
           _.DUP
           (_.int -1)
           (_.IF_ICMPEQ @not-found)
           lux-intI
           runtime.someI
           (_.GOTO @end)
           (_.label @not-found)
           _.POP
           runtime.noneI
           (_.label @end))))

(def: string-method Method (_t.method (list $String) #.None (list)))
(def: (io::log messageI)
  (Unary Inst)
  (|>> (_.GETSTATIC "java.lang.System" "out" (_t.class "java.io.PrintStream" (list)))
       messageI
       ..check-stringI
       (_.INVOKEVIRTUAL "java.io.PrintStream" "println" string-method #0)
       unitI))

(def: (io::error messageI)
  (Unary Inst)
  (|>> (_.NEW "java.lang.Error")
       _.DUP
       messageI
       ..check-stringI
       (_.INVOKESPECIAL "java.lang.Error" "<init>" string-method #0)
       _.ATHROW))

(def: (io::exit codeI)
  (Unary Inst)
  (|>> codeI jvm-intI
       (_.INVOKESTATIC "java.lang.System" "exit" (_t.method (list _t.int) #.None (list)) #0)
       _.NULL))

(def: (io::current-time _)
  (Nullary Inst)
  (|>> (_.INVOKESTATIC "java.lang.System" "currentTimeMillis" (_t.method (list) (#.Some _t.long) (list)) #0)
       (_.wrap #$.Long)))

(def: bundle::lux
  Bundle
  (|> (: Bundle bundle.empty)
      (bundle.install "is" (binary lux::is))
      (bundle.install "try" (unary lux::try))))

(def: bundle::i64
  Bundle
  (<| (bundle.prefix "i64")
      (|> (: Bundle bundle.empty)
          (bundle.install "and" (binary bit::and))
          (bundle.install "or" (binary bit::or))
          (bundle.install "xor" (binary bit::xor))
          (bundle.install "left-shift" (binary bit::left-shift))
          (bundle.install "logical-right-shift" (binary bit::logical-right-shift))
          (bundle.install "arithmetic-right-shift" (binary bit::arithmetic-right-shift))
          (bundle.install "+" (binary i64::+))
          (bundle.install "-" (binary i64::-))
          (bundle.install "=" (binary i64::=)))))

(def: bundle::int
  Bundle
  (<| (bundle.prefix "int")
      (|> (: Bundle bundle.empty)
          (bundle.install "*" (binary int::*))
          (bundle.install "/" (binary int::/))
          (bundle.install "%" (binary int::%))
          (bundle.install "<" (binary int::<))
          (bundle.install "frac" (unary int::frac))
          (bundle.install "char" (unary int::char)))))

(def: bundle::frac
  Bundle
  (<| (bundle.prefix "frac")
      (|> (: Bundle bundle.empty)
          (bundle.install "+" (binary frac::+))
          (bundle.install "-" (binary frac::-))
          (bundle.install "*" (binary frac::*))
          (bundle.install "/" (binary frac::/))
          (bundle.install "%" (binary frac::%))
          (bundle.install "=" (binary frac::=))
          (bundle.install "<" (binary frac::<))
          (bundle.install "smallest" (nullary frac::smallest))
          (bundle.install "min" (nullary frac::min))
          (bundle.install "max" (nullary frac::max))
          (bundle.install "int" (unary frac::int))
          (bundle.install "encode" (unary frac::encode))
          (bundle.install "decode" (unary frac::decode)))))

(def: bundle::text
  Bundle
  (<| (bundle.prefix "text")
      (|> (: Bundle bundle.empty)
          (bundle.install "=" (binary text::=))
          (bundle.install "<" (binary text::<))
          (bundle.install "concat" (binary text::concat))
          (bundle.install "index" (trinary text::index))
          (bundle.install "size" (unary text::size))
          (bundle.install "char" (binary text::char))
          (bundle.install "clip" (trinary text::clip)))))

(def: bundle::io
  Bundle
  (<| (bundle.prefix "io")
      (|> (: Bundle bundle.empty)
          (bundle.install "log" (unary io::log))
          (bundle.install "error" (unary io::error))
          (bundle.install "exit" (unary io::exit))
          (bundle.install "current-time" (nullary io::current-time)))))

(def: #export bundle
  Bundle
  (<| (bundle.prefix "lux")
      (|> bundle::lux
          (dictionary.merge bundle::i64)
          (dictionary.merge bundle::int)
          (dictionary.merge bundle::frac)
          (dictionary.merge bundle::text)
          (dictionary.merge bundle::io))))