(;module:
  lux
  (lux (control [monad #+ do])
       (data [text]
             text/format
             (coll [list "list/" Functor<List>]
                   [dict #+ Dict]))
       [macro #+ with-gensyms]
       (macro [code]
              ["s" syntax #+ syntax:])
       [host])
  (luxc ["&" base]
        (lang ["la" analysis]
              ["ls" synthesis])
        ["&;" analyser]
        ["&;" synthesizer]
        (synthesizer [function])
        (generator ["&;" common]
                   ["&;" runtime]
                   (host ["$" jvm]
                         (jvm ["$t" type]
                              ["$d" def]
                              ["$i" inst]))))
  ["@" ../common])

(do-template [<name> <inst>]
  [(def: <name>
     $;Inst
     <inst>)]

  [L2S (|>. $i;L2I $i;I2S)]
  [L2B (|>. $i;L2I $i;I2B)]
  )

(do-template [<name> <unwrap> <conversion> <wrap>]
  [(def: (<name> inputI)
     @;Unary
     (if (is $i;NOP <conversion>)
       (|>. inputI
            ($i;unwrap <unwrap>)
            ($i;wrap <wrap>))
       (|>. inputI
            ($i;unwrap <unwrap>)
            <conversion>
            ($i;wrap <wrap>))))]
  
  [convert//double-to-float #$;Double $i;D2F #$;Float]
  [convert//double-to-int #$;Double $i;D2I #$;Int]
  [convert//double-to-long #$;Double $i;D2L #$;Long]
  [convert//float-to-double #$;Float $i;F2D #$;Double]
  [convert//float-to-int #$;Float $i;F2I #$;Int]
  [convert//float-to-long #$;Float $i;F2L #$;Long]
  [convert//int-to-byte #$;Int $i;I2B #$;Byte]
  [convert//int-to-char #$;Int $i;I2C #$;Char]
  [convert//int-to-double #$;Int $i;I2D #$;Double]
  [convert//int-to-float #$;Int $i;I2F #$;Float]
  [convert//int-to-long #$;Int $i;I2L #$;Long]
  [convert//int-to-short #$;Int $i;I2S #$;Short]
  [convert//long-to-double #$;Long $i;L2D #$;Double]
  [convert//long-to-float #$;Long $i;L2F #$;Float]
  [convert//long-to-int #$;Long $i;L2I #$;Int]
  [convert//long-to-short #$;Long L2S #$;Short]
  [convert//long-to-byte #$;Long L2B #$;Byte]
  [convert//char-to-byte #$;Char $i;I2B #$;Byte]
  [convert//char-to-short #$;Char $i;I2S #$;Short]
  [convert//char-to-int #$;Char $i;NOP #$;Int]
  [convert//char-to-long #$;Char $i;I2L #$;Long]
  [convert//byte-to-long #$;Byte $i;I2L #$;Long]
  [convert//short-to-long #$;Short $i;I2L #$;Long]
  )

(def: conversion-procs
  @;Bundle
  (<| (@;prefix "convert")
      (|> (dict;new text;Hash<Text>)
          (@;install "double-to-float" (@;unary convert//double-to-float))
          (@;install "double-to-int" (@;unary convert//double-to-int))
          (@;install "double-to-long" (@;unary convert//double-to-long))
          (@;install "float-to-double" (@;unary convert//float-to-double))
          (@;install "float-to-int" (@;unary convert//float-to-int))
          (@;install "float-to-long" (@;unary convert//float-to-long))
          (@;install "int-to-byte" (@;unary convert//int-to-byte))
          (@;install "int-to-char" (@;unary convert//int-to-char))
          (@;install "int-to-double" (@;unary convert//int-to-double))
          (@;install "int-to-float" (@;unary convert//int-to-float))
          (@;install "int-to-long" (@;unary convert//int-to-long))
          (@;install "int-to-short" (@;unary convert//int-to-short))
          (@;install "long-to-double" (@;unary convert//long-to-double))
          (@;install "long-to-float" (@;unary convert//long-to-float))
          (@;install "long-to-int" (@;unary convert//long-to-int))
          (@;install "long-to-short" (@;unary convert//long-to-short))
          (@;install "long-to-byte" (@;unary convert//long-to-byte))
          (@;install "char-to-byte" (@;unary convert//char-to-byte))
          (@;install "char-to-short" (@;unary convert//char-to-short))
          (@;install "char-to-int" (@;unary convert//char-to-int))
          (@;install "char-to-long" (@;unary convert//char-to-long))
          (@;install "byte-to-long" (@;unary convert//byte-to-long))
          (@;install "short-to-long" (@;unary convert//short-to-long))
          )))

(do-template [<name> <op> <unwrapX> <unwrapY> <wrap>]
  [(def: (<name> [xI yI])
     @;Binary
     (|>. xI ($i;unwrap <unwrapX>)
          yI ($i;unwrap <unwrapY>)
          <op> ($i;wrap <wrap>)))]

  [int//+ $i;IADD #$;Int #$;Int #$;Int]
  [int//- $i;ISUB #$;Int #$;Int #$;Int]
  [int//* $i;IMUL #$;Int #$;Int #$;Int]
  [int/// $i;IDIV #$;Int #$;Int #$;Int]
  [int//% $i;IREM #$;Int #$;Int #$;Int]
  [int//and $i;IAND #$;Int #$;Int #$;Int]
  [int//or $i;IOR #$;Int #$;Int #$;Int]
  [int//xor $i;IXOR #$;Int #$;Int #$;Int]
  [int//shl $i;ISHL #$;Int #$;Int #$;Int]
  [int//shr $i;ISHR #$;Int #$;Int #$;Int]
  [int//ushr $i;IUSHR #$;Int #$;Int #$;Int]
  
  [long//+ $i;LADD #$;Long #$;Long #$;Long]
  [long//- $i;LSUB #$;Long #$;Long #$;Long]
  [long//* $i;LMUL #$;Long #$;Long #$;Long]
  [long/// $i;LDIV #$;Long #$;Long #$;Long]
  [long//% $i;LREM #$;Long #$;Long #$;Long]
  [long//and $i;LAND #$;Long #$;Long #$;Long]
  [long//or $i;LOR #$;Long #$;Long #$;Long]
  [long//xor $i;LXOR #$;Long #$;Long #$;Long]
  [long//shl $i;LSHL #$;Long #$;Int #$;Long]
  [long//shr $i;LSHR #$;Long #$;Int #$;Long]
  [long//ushr $i;LUSHR #$;Long #$;Int #$;Long]

  [float//+ $i;FADD #$;Float #$;Float #$;Float]
  [float//- $i;FSUB #$;Float #$;Float #$;Float]
  [float//* $i;FMUL #$;Float #$;Float #$;Float]
  [float/// $i;FDIV #$;Float #$;Float #$;Float]
  [float//% $i;FREM #$;Float #$;Float #$;Float]
  
  [double//+ $i;DADD #$;Double #$;Double #$;Double]
  [double//- $i;DSUB #$;Double #$;Double #$;Double]
  [double//* $i;DMUL #$;Double #$;Double #$;Double]
  [double/// $i;DDIV #$;Double #$;Double #$;Double]
  [double//% $i;DREM #$;Double #$;Double #$;Double]
  )

(do-template [<name> <op> <unwrapX> <unwrapY> <wrap>]
  [(def: (<name> [xI yI])
     @;Binary
     (<| $i;with-label (function [@then])
         $i;with-label (function [@end])
         (|>. xI ($i;unwrap <unwrapX>)
              yI ($i;unwrap <unwrapY>)
              (<op> @then)
              ($i;GETSTATIC "java.lang.Boolean" "FALSE" ($t;class "java.lang.Boolean" (list)))
              ($i;GOTO @end)
              ($i;label @then)
              ($i;GETSTATIC "java.lang.Boolean" "TRUE" ($t;class "java.lang.Boolean" (list)))
              ($i;label @end))))]

  [int//= $i;IF_ICMPEQ #$;Int #$;Int #$;Boolean]
  [int//< $i;IF_ICMPLT #$;Int #$;Int #$;Boolean]

  [char//= $i;IF_ICMPEQ #$;Char #$;Char #$;Boolean]
  [char//< $i;IF_ICMPLT #$;Char #$;Char #$;Boolean]
  )

(do-template [<name> <op> <reference> <unwrapX> <unwrapY> <wrap>]
  [(def: (<name> [xI yI])
     @;Binary
     (<| $i;with-label (function [@then])
         $i;with-label (function [@end])
         (|>. xI ($i;unwrap <unwrapX>)
              yI ($i;unwrap <unwrapY>)
              <op>
              ($i;int <reference>)
              ($i;IF_ICMPEQ @then)
              ($i;GETSTATIC "java.lang.Boolean" "FALSE" ($t;class "java.lang.Boolean" (list)))
              ($i;GOTO @end)
              ($i;label @then)
              ($i;GETSTATIC "java.lang.Boolean" "TRUE" ($t;class "java.lang.Boolean" (list)))
              ($i;label @end))))]

  [long//= $i;LCMP  0 #$;Long #$;Long #$;Boolean]
  [long//< $i;LCMP -1 #$;Long #$;Long #$;Boolean]
  
  [float//= $i;FCMPG  0 #$;Float #$;Float #$;Boolean]
  [float//< $i;FCMPG -1 #$;Float #$;Float #$;Boolean]

  [double//= $i;DCMPG  0 #$;Double #$;Double #$;Boolean]
  [double//< $i;DCMPG -1 #$;Double #$;Double #$;Boolean]
  )

(def: int-procs
  @;Bundle
  (<| (@;prefix "int")
      (|> (dict;new text;Hash<Text>)
          (@;install "+" (@;binary int//+))
          (@;install "-" (@;binary int//-))
          (@;install "*" (@;binary int//*))
          (@;install "/" (@;binary int///))
          (@;install "%" (@;binary int//%))
          (@;install "=" (@;binary int//=))
          (@;install "<" (@;binary int//<))
          (@;install "and" (@;binary int//and))
          (@;install "or" (@;binary int//or))
          (@;install "xor" (@;binary int//xor))
          (@;install "shl" (@;binary int//shl))
          (@;install "shr" (@;binary int//shr))
          (@;install "ushr" (@;binary int//ushr))
          )))

(def: long-procs
  @;Bundle
  (<| (@;prefix "long")
      (|> (dict;new text;Hash<Text>)
          (@;install "+" (@;binary long//+))
          (@;install "-" (@;binary long//-))
          (@;install "*" (@;binary long//*))
          (@;install "/" (@;binary long///))
          (@;install "%" (@;binary long//%))
          (@;install "=" (@;binary long//=))
          (@;install "<" (@;binary long//<))
          (@;install "and" (@;binary long//and))
          (@;install "or" (@;binary long//or))
          (@;install "xor" (@;binary long//xor))
          (@;install "shl" (@;binary long//shl))
          (@;install "shr" (@;binary long//shr))
          (@;install "ushr" (@;binary long//ushr))
          )))

(def: float-procs
  @;Bundle
  (<| (@;prefix "float")
      (|> (dict;new text;Hash<Text>)
          (@;install "+" (@;binary float//+))
          (@;install "-" (@;binary float//-))
          (@;install "*" (@;binary float//*))
          (@;install "/" (@;binary float///))
          (@;install "%" (@;binary float//%))
          (@;install "=" (@;binary float//=))
          (@;install "<" (@;binary float//<))
          )))

(def: double-procs
  @;Bundle
  (<| (@;prefix "double")
      (|> (dict;new text;Hash<Text>)
          (@;install "+" (@;binary double//+))
          (@;install "-" (@;binary double//-))
          (@;install "*" (@;binary double//*))
          (@;install "/" (@;binary double///))
          (@;install "%" (@;binary double//%))
          (@;install "=" (@;binary double//=))
          (@;install "<" (@;binary double//<))
          )))

(def: char-procs
  @;Bundle
  (<| (@;prefix "char")
      (|> (dict;new text;Hash<Text>)
          (@;install "=" (@;binary char//=))
          (@;install "<" (@;binary char//<))
          )))

(def: (array//length arrayI)
  @;Unary
  (|>. arrayI
       $i;ARRAYLENGTH
       $i;I2L
       ($i;wrap #$;Long)))

(def: (array//new proc generate inputs)
  (-> Text @;Proc)
  (case inputs
    (^ (list (#ls;Nat level) (#ls;Text class) lengthS))
    (do macro;Monad<Lux>
      [lengthI (generate lengthS)
       #let [arrayJT ($t;array level (case class
                                       "boolean" $t;boolean
                                       "byte" $t;byte
                                       "short" $t;short
                                       "int" $t;int
                                       "long" $t;long
                                       "float" $t;float
                                       "double" $t;double
                                       "char" $t;char
                                       _ ($t;class class (list))))]]
      (wrap (|>. lengthI
                 ($i;unwrap #$;Long)
                 $i;L2I
                 ($i;array arrayJT))))

    _
    (&;fail (format "Wrong syntax for '" proc "'."))))

(def: (array//read proc generate inputs)
  (-> Text @;Proc)
  (case inputs
    (^ (list (#ls;Text class) idxS arrayS))
    (do macro;Monad<Lux>
      [arrayI (generate arrayS)
       idxI (generate idxS)
       #let [loadI (case class
                     "boolean" (|>. $i;BALOAD ($i;wrap #$;Boolean))
                     "byte" (|>. $i;BALOAD ($i;wrap #$;Byte))
                     "short" (|>. $i;SALOAD ($i;wrap #$;Short))
                     "int" (|>. $i;IALOAD ($i;wrap #$;Int))
                     "long" (|>. $i;LALOAD ($i;wrap #$;Long))
                     "float" (|>. $i;FALOAD ($i;wrap #$;Float))
                     "double" (|>. $i;DALOAD ($i;wrap #$;Double))
                     "char" (|>. $i;CALOAD ($i;wrap #$;Char))
                     _ $i;AALOAD)]]
      (wrap (|>. arrayI
                 idxI
                 ($i;unwrap #$;Long)
                 $i;L2I
                 loadI)))

    _
    (&;fail (format "Wrong syntax for '" proc "'."))))

(def: (array//write proc generate inputs)
  (-> Text @;Proc)
  (case inputs
    (^ (list (#ls;Text class) idxS valueS arrayS))
    (do macro;Monad<Lux>
      [arrayI (generate arrayS)
       idxI (generate idxS)
       valueI (generate valueS)
       #let [storeI (case class
                      "boolean" (|>. ($i;unwrap #$;Boolean) $i;BASTORE)
                      "byte" (|>. ($i;unwrap #$;Byte) $i;BASTORE)
                      "short" (|>. ($i;unwrap #$;Short) $i;SASTORE)
                      "int" (|>. ($i;unwrap #$;Int) $i;IASTORE)
                      "long" (|>. ($i;unwrap #$;Long) $i;LASTORE)
                      "float" (|>. ($i;unwrap #$;Float) $i;FASTORE)
                      "double" (|>. ($i;unwrap #$;Double) $i;DASTORE)
                      "char" (|>. ($i;unwrap #$;Char) $i;CASTORE)
                      _ $i;AASTORE)]]
      (wrap (|>. arrayI
                 $i;DUP
                 idxI
                 ($i;unwrap #$;Long)
                 $i;L2I
                 valueI
                 storeI)))

    _
    (&;fail (format "Wrong syntax for '" proc "'."))))

(def: array-procs
  @;Bundle
  (<| (@;prefix "array")
      (|> (dict;new text;Hash<Text>)
          (@;install "length" (@;unary array//length))
          (@;install "new" array//new)
          (@;install "read" array//read)
          (@;install "write" array//write)
          )))

(def: (object//null _)
  @;Nullary
  $i;NULL)

(def: (object//null? objectI)
  @;Unary
  (<| $i;with-label (function [@then])
      $i;with-label (function [@end])
      (|>. objectI
           ($i;IFNULL @then)
           ($i;GETSTATIC "java.lang.Boolean" "FALSE" ($t;class "java.lang.Boolean" (list)))
           ($i;GOTO @end)
           ($i;label @then)
           ($i;GETSTATIC "java.lang.Boolean" "TRUE" ($t;class "java.lang.Boolean" (list)))
           ($i;label @end))))

(def: (object//synchronized [monitorI exprI])
  @;Binary
  (|>. monitorI
       $i;DUP
       $i;MONITORENTER
       exprI
       $i;SWAP
       $i;MONITOREXIT))

(def: (object//throw exceptionI)
  @;Unary
  (|>. exceptionI
       $i;ATHROW))

(def: (object//class proc generate inputs)
  (-> Text @;Proc)
  (case inputs
    (^ (list (#ls;Text class)))
    (do macro;Monad<Lux>
      []
      (wrap (|>. ($i;string class)
                 ($i;INVOKESTATIC "java.lang.Class" "forName"
                                  ($t;method (list ($t;class "java.lang.String" (list)))
                                             (#;Some ($t;class "java.lang.Class" (list)))
                                             (list))
                                  false))))

    _
    (&;fail (format "Wrong syntax for '" proc "'."))))

(def: (object//instance? proc generate inputs)
  (-> Text @;Proc)
  (case inputs
    (^ (list (#ls;Text class) objectS))
    (do macro;Monad<Lux>
      [objectI (generate objectS)]
      (wrap (|>. objectI
                 ($i;INSTANCEOF class)
                 ($i;wrap #$;Boolean))))

    _
    (&;fail (format "Wrong syntax for '" proc "'."))))

(def: object-procs
  @;Bundle
  (<| (@;prefix "object")
      (|> (dict;new text;Hash<Text>)
          (@;install "null" (@;nullary object//null))
          (@;install "null?" (@;unary object//null?))
          (@;install "synchronized" (@;binary object//synchronized))
          (@;install "throw" (@;unary object//throw))
          (@;install "class" object//class)
          (@;install "instance?" object//instance?)
          )))

(def: #export procedures
  @;Bundle
  (<| (@;prefix "jvm")
      (|> (dict;new text;Hash<Text>)
          (dict;merge conversion-procs)
          (dict;merge int-procs)
          (dict;merge long-procs)
          (dict;merge float-procs)
          (dict;merge double-procs)
          (dict;merge char-procs)
          (dict;merge array-procs)
          (dict;merge object-procs)
          )))