- Implemented Nat functionality in pure Lux.

3 files changed, 24 insertions, 258 deletions

diff --git a/luxc/src/lux/analyser/proc/common.clj b/luxc/src/lux/analyser/proc/common.clj
index 9a90c219e..3606fab8b 100644
--- a/luxc/src/lux/analyser/proc/common.clj
+++ b/luxc/src/lux/analyser/proc/common.clj
@@ -169,14 +169,6 @@
       (return (&/|list (&&/|meta exo-type _cursor
                                  (&&/$proc (&/T <proc>) (&/|list =x =y) (&/|list)))))))
 
-  ^:private analyse-nat-add  ["nat" "+"]  &type/Nat  &type/Nat
-  ^:private analyse-nat-sub  ["nat" "-"]  &type/Nat  &type/Nat
-  ^:private analyse-nat-mul  ["nat" "*"]  &type/Nat  &type/Nat
-  ^:private analyse-nat-div  ["nat" "/"]  &type/Nat  &type/Nat
-  ^:private analyse-nat-rem  ["nat" "%"]  &type/Nat  &type/Nat
-  ^:private analyse-nat-eq   ["nat" "="]  &type/Nat  &type/Bool
-  ^:private analyse-nat-lt   ["nat" "<"]  &type/Nat  &type/Bool
-
   ^:private analyse-int-add  ["int" "+"]  &type/Int  &type/Int
   ^:private analyse-int-sub  ["int" "-"]  &type/Int  &type/Int
   ^:private analyse-int-mul  ["int" "*"]  &type/Int  &type/Int
@@ -245,21 +237,18 @@
       (return (&/|list (&&/|meta exo-type _cursor
                                  (&&/$proc (&/T <op>) (&/|list) (&/|list)))))))
 
-  ^:private analyse-nat-min                  &type/Nat  ["nat"  "min"]
-  ^:private analyse-nat-max                  &type/Nat  ["nat"  "max"]
-
-  ^:private analyse-int-min                  &type/Int  ["int"  "min"]
-  ^:private analyse-int-max                  &type/Int  ["int"  "max"]
+  ^:private analyse-int-min                 &type/Int  ["int"  "min"]
+  ^:private analyse-int-max                 &type/Int  ["int"  "max"]
 
-  ^:private analyse-deg-min                 &type/Deg ["deg" "min"]
-  ^:private analyse-deg-max                 &type/Deg ["deg" "max"]
+  ^:private analyse-deg-min                 &type/Deg  ["deg" "min"]
+  ^:private analyse-deg-max                 &type/Deg  ["deg" "max"]
 
-  ^:private analyse-frac-smallest           &type/Frac  ["frac"  "smallest"]
-  ^:private analyse-frac-min                &type/Frac  ["frac"  "min"]
-  ^:private analyse-frac-max                &type/Frac  ["frac"  "max"]
-  ^:private analyse-frac-not-a-number       &type/Frac  ["frac"  "not-a-number"]
-  ^:private analyse-frac-positive-infinity  &type/Frac  ["frac"  "positive-infinity"]
-  ^:private analyse-frac-negative-infinity  &type/Frac  ["frac"  "negative-infinity"]
+  ^:private analyse-frac-smallest           &type/Frac ["frac"  "smallest"]
+  ^:private analyse-frac-min                &type/Frac ["frac"  "min"]
+  ^:private analyse-frac-max                &type/Frac ["frac"  "max"]
+  ^:private analyse-frac-not-a-number       &type/Frac ["frac"  "not-a-number"]
+  ^:private analyse-frac-positive-infinity  &type/Frac ["frac"  "positive-infinity"]
+  ^:private analyse-frac-negative-infinity  &type/Frac ["frac"  "negative-infinity"]
   )
 
 (do-template [<name> <from-type> <to-type> <op>]
@@ -271,10 +260,7 @@
       (return (&/|list (&&/|meta exo-type _cursor
                                  (&&/$proc (&/T <op>) (&/|list =x) (&/|list)))))))
 
-  ^:private analyse-nat-to-int   &type/Nat  &type/Int    ["nat" "to-int"]
-  ^:private analyse-int-to-nat   &type/Int  &type/Nat    ["int" "to-nat"]
-  
-  ^:private analyse-nat-char     &type/Nat  &type/Text   ["nat" "char"]
+  ^:private analyse-int-char     &type/Int  &type/Text   ["int" "char"]
   
   ^:private analyse-int-to-frac  &type/Int  &type/Frac   ["int" "to-frac"]
   ^:private analyse-frac-to-int  &type/Frac &type/Int    ["frac" "to-int"]
@@ -512,17 +498,6 @@
          "lux array remove" (analyse-array-remove analyse exo-type ?values)
          "lux array size"   (analyse-array-size analyse exo-type ?values)
 
-         "lux nat +" (analyse-nat-add analyse exo-type ?values)
-         "lux nat -" (analyse-nat-sub analyse exo-type ?values)
-         "lux nat *" (analyse-nat-mul analyse exo-type ?values)
-         "lux nat /" (analyse-nat-div analyse exo-type ?values)
-         "lux nat %" (analyse-nat-rem analyse exo-type ?values)
-         "lux nat =" (analyse-nat-eq analyse exo-type ?values)
-         "lux nat <" (analyse-nat-lt analyse exo-type ?values)
-         "lux nat min" (analyse-nat-min analyse exo-type ?values)
-         "lux nat max" (analyse-nat-max analyse exo-type ?values)
-         "lux nat to-int" (analyse-nat-to-int analyse exo-type ?values)
-         "lux nat char" (analyse-nat-char analyse exo-type ?values)
          
          "lux int +" (analyse-int-add analyse exo-type ?values)
          "lux int -" (analyse-int-sub analyse exo-type ?values)
@@ -533,8 +508,8 @@
          "lux int <" (analyse-int-lt analyse exo-type ?values)
          "lux int min" (analyse-int-min analyse exo-type ?values)
          "lux int max" (analyse-int-max analyse exo-type ?values)
-         "lux int to-nat" (analyse-int-to-nat analyse exo-type ?values)
          "lux int to-frac" (analyse-int-to-frac analyse exo-type ?values)
+         "lux int char" (analyse-int-char analyse exo-type ?values)
          
          "lux deg +" (analyse-deg-add analyse exo-type ?values)
          "lux deg -" (analyse-deg-sub analyse exo-type ?values)
diff --git a/luxc/src/lux/compiler/jvm/proc/common.clj b/luxc/src/lux/compiler/jvm/proc/common.clj
index fdd5f8c8a..b79ceb3ae 100644
--- a/luxc/src/lux/compiler/jvm/proc/common.clj
+++ b/luxc/src/lux/compiler/jvm/proc/common.clj
@@ -208,10 +208,6 @@
   ^:private compile-int-div   Opcodes/LDIV &&/unwrap-long &&/wrap-long
   ^:private compile-int-rem   Opcodes/LREM &&/unwrap-long &&/wrap-long
   
-  ^:private compile-nat-add   Opcodes/LADD &&/unwrap-long &&/wrap-long
-  ^:private compile-nat-sub   Opcodes/LSUB &&/unwrap-long &&/wrap-long
-  ^:private compile-nat-mul   Opcodes/LMUL &&/unwrap-long &&/wrap-long
-
   ^:private compile-deg-add   Opcodes/LADD &&/unwrap-long &&/wrap-long
   ^:private compile-deg-sub   Opcodes/LSUB &&/unwrap-long &&/wrap-long
   ^:private compile-deg-rem   Opcodes/LSUB &&/unwrap-long &&/wrap-long
@@ -225,25 +221,6 @@
   ^:private compile-frac-rem  Opcodes/DREM &&/unwrap-double &&/wrap-double
   )
 
-(do-template [<name> <comp-method>]
-  (defn <name> [compile ?values special-args]
-    (|do [:let [(&/$Cons ?x (&/$Cons ?y (&/$Nil))) ?values]
-          ^MethodVisitor *writer* &/get-writer
-          _ (compile ?x)
-          :let [_ (doto *writer*
-                    &&/unwrap-long)]
-          _ (compile ?y)
-          :let [_ (doto *writer*
-                    &&/unwrap-long)
-                _ (doto *writer*
-                    (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" <comp-method> "(JJ)J")
-                    (&&/wrap-long))]]
-      (return nil)))
-
-  ^:private compile-nat-div "div_nat"
-  ^:private compile-nat-rem "rem_nat"
-  )
-
 (do-template [<name> <cmpcode> <cmp-output> <unwrap>]
   (defn <name> [compile ?values special-args]
     (|do [:let [(&/$Cons ?x (&/$Cons ?y (&/$Nil))) ?values]
@@ -297,34 +274,10 @@
                     (.visitLabel $end))]]
       (return nil)))
 
-  ^:private compile-nat-eq   0
-  
   ^:private compile-deg-eq  0
   ^:private compile-deg-lt -1
   )
 
-(defn ^:private compile-nat-lt [compile ?values special-args]
-  (|do [:let [(&/$Cons ?x (&/$Cons ?y (&/$Nil))) ?values]
-        ^MethodVisitor *writer* &/get-writer
-        _ (compile ?x)
-        :let [_ (doto *writer*
-                  &&/unwrap-long)]
-        _ (compile ?y)
-        :let [_ (doto *writer*
-                  &&/unwrap-long)
-              $then (new Label)
-              $end (new Label)
-              _ (doto *writer*
-                  (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "_compareUnsigned" "(JJ)I")
-                  (.visitLdcInsn (int -1))
-                  (.visitJumpInsn Opcodes/IF_ICMPEQ $then)
-                  (.visitFieldInsn Opcodes/GETSTATIC (&host-generics/->bytecode-class-name "java.lang.Boolean") "FALSE"  (&host-generics/->type-signature "java.lang.Boolean"))
-                  (.visitJumpInsn Opcodes/GOTO $end)
-                  (.visitLabel $then)
-                  (.visitFieldInsn Opcodes/GETSTATIC (&host-generics/->bytecode-class-name "java.lang.Boolean") "TRUE" (&host-generics/->type-signature "java.lang.Boolean"))
-                  (.visitLabel $end))]]
-    (return nil)))
-
 (do-template [<name> <instr> <wrapper>]
   (defn <name> [compile ?values special-args]
     (|do [:let [(&/$Nil) ?values]
@@ -334,9 +287,6 @@
                     <wrapper>)]]
       (return nil)))
 
-  ^:private compile-nat-min (.visitLdcInsn 0)  &&/wrap-long
-  ^:private compile-nat-max (.visitLdcInsn -1) &&/wrap-long
-
   ^:private compile-int-min (.visitLdcInsn Long/MIN_VALUE)  &&/wrap-long
   ^:private compile-int-max (.visitLdcInsn Long/MAX_VALUE) &&/wrap-long
   
@@ -415,7 +365,7 @@
   ^:private compile-frac-to-deg "java.lang.Double" "frac-to-deg" "(D)J" &&/unwrap-double &&/wrap-long
   )
 
-(defn ^:private compile-nat-char [compile ?values special-args]
+(defn ^:private compile-int-char [compile ?values special-args]
   (|do [:let [(&/$Cons ?x (&/$Nil)) ?values]
         ^MethodVisitor *writer* &/get-writer
         _ (compile ?x)
@@ -426,17 +376,6 @@
                   (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/String" "valueOf" "(C)Ljava/lang/String;"))]]
     (return nil)))
 
-(do-template [<name>]
-  (defn <name> [compile ?values special-args]
-    (|do [:let [(&/$Cons ?x (&/$Nil)) ?values]
-          ^MethodVisitor *writer* &/get-writer
-          _ (compile ?x)]
-      (return nil)))
-
-  ^:private compile-nat-to-int
-  ^:private compile-int-to-nat
-  )
-
 (do-template [<name> <unwrap> <op> <wrap>]
   (defn <name> [compile ?values special-args]
     (|do [:let [(&/$Cons ?input (&/$Nil)) ?values]
@@ -848,21 +787,6 @@
       "remove" (compile-array-remove compile ?values special-args)
       "size" (compile-array-size compile ?values special-args))
 
-    "nat"
-    (case proc
-      "+"         (compile-nat-add compile ?values special-args)
-      "-"         (compile-nat-sub compile ?values special-args)
-      "*"         (compile-nat-mul compile ?values special-args)
-      "/"         (compile-nat-div compile ?values special-args)
-      "%"         (compile-nat-rem compile ?values special-args)
-      "="         (compile-nat-eq compile ?values special-args)
-      "<"         (compile-nat-lt compile ?values special-args)
-      "max" (compile-nat-max compile ?values special-args)
-      "min" (compile-nat-min compile ?values special-args)
-      "to-int"    (compile-nat-to-int compile ?values special-args)
-      "char"   (compile-nat-char compile ?values special-args)
-      )
-    
     "deg"
     (case proc
       "+"         (compile-deg-add compile ?values special-args)
@@ -881,17 +805,17 @@
 
     "int"
     (case proc
-      "+"         (compile-int-add compile ?values special-args)
-      "-"         (compile-int-sub compile ?values special-args)
-      "*"         (compile-int-mul compile ?values special-args)
-      "/"         (compile-int-div compile ?values special-args)
-      "%"         (compile-int-rem compile ?values special-args)
-      "="         (compile-int-eq compile ?values special-args)
-      "<"         (compile-int-lt compile ?values special-args)
-      "max" (compile-int-max compile ?values special-args)
-      "min" (compile-int-min compile ?values special-args)
-      "to-nat"    (compile-int-to-nat compile ?values special-args)
-      "to-frac"   (compile-int-to-frac compile ?values special-args)
+      "+"       (compile-int-add compile ?values special-args)
+      "-"       (compile-int-sub compile ?values special-args)
+      "*"       (compile-int-mul compile ?values special-args)
+      "/"       (compile-int-div compile ?values special-args)
+      "%"       (compile-int-rem compile ?values special-args)
+      "="       (compile-int-eq compile ?values special-args)
+      "<"       (compile-int-lt compile ?values special-args)
+      "max"     (compile-int-max compile ?values special-args)
+      "min"     (compile-int-min compile ?values special-args)
+      "to-frac" (compile-int-to-frac compile ?values special-args)
+      "char"    (compile-int-char compile ?values special-args)
       )
 
     "frac"
diff --git a/luxc/src/lux/compiler/jvm/rt.clj b/luxc/src/lux/compiler/jvm/rt.clj
index 83f02af3e..dfd60b6a0 100644
--- a/luxc/src/lux/compiler/jvm/rt.clj
+++ b/luxc/src/lux/compiler/jvm/rt.clj
@@ -464,138 +464,6 @@
              (.visitEnd))]
     nil))
 
-(let [+wrapper-class+ (&host-generics/->bytecode-class-name "java.lang.Long")]
-  (defn ^:private compile-LuxRT-nat-methods [^ClassWriter =class]
-    (|let [;; http://grepcode.com/file/repository.grepcode.com/java/root/jdk/openjdk/8u40-b25/java/lang/Long.java#215
-           _ (let [$simple-case (new Label)]
-               (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "_toUnsignedBigInteger" "(J)Ljava/math/BigInteger;" nil nil)
-                 (.visitCode)
-                 (.visitVarInsn Opcodes/LLOAD 0)
-                 (.visitLdcInsn (long 0))
-                 (.visitInsn Opcodes/LCMP)
-                 (.visitJumpInsn Opcodes/IFGE $simple-case)
-                 ;; else
-                 (.visitVarInsn Opcodes/LLOAD 0)
-                 (.visitLdcInsn (int 32))
-                 (.visitInsn Opcodes/LUSHR)
-                 (.visitMethodInsn Opcodes/INVOKESTATIC "java/math/BigInteger" "valueOf" "(J)Ljava/math/BigInteger;")
-                 (.visitLdcInsn (int 32))
-                 (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/math/BigInteger" "shiftLeft" "(I)Ljava/math/BigInteger;")
-                 (.visitVarInsn Opcodes/LLOAD 0)
-                 (.visitLdcInsn (int 32))
-                 (.visitInsn Opcodes/LSHL)
-                 (.visitLdcInsn (int 32))
-                 (.visitInsn Opcodes/LUSHR)
-                 (.visitMethodInsn Opcodes/INVOKESTATIC "java/math/BigInteger" "valueOf" "(J)Ljava/math/BigInteger;")
-                 (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/math/BigInteger" "add" "(Ljava/math/BigInteger;)Ljava/math/BigInteger;")
-                 (.visitInsn Opcodes/ARETURN)
-                 ;; then
-                 (.visitLabel $simple-case)
-                 (.visitVarInsn Opcodes/LLOAD 0)
-                 (.visitMethodInsn Opcodes/INVOKESTATIC "java/math/BigInteger" "valueOf" "(J)Ljava/math/BigInteger;")
-                 (.visitInsn Opcodes/ARETURN)
-                 (.visitMaxs 0 0)
-                 (.visitEnd)))
-           ;; http://grepcode.com/file/repository.grepcode.com/java/root/jdk/openjdk/8u40-b25/java/lang/Long.java?av=f#1267
-           _ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "_compareUnsigned" "(JJ)I" nil nil)
-               (.visitCode)
-               (.visitVarInsn Opcodes/LLOAD 0)
-               (.visitFieldInsn Opcodes/GETSTATIC "java/lang/Long" "MIN_VALUE" "J")
-               (.visitInsn Opcodes/LADD)
-               (.visitVarInsn Opcodes/LLOAD 2)
-               (.visitFieldInsn Opcodes/GETSTATIC "java/lang/Long" "MIN_VALUE" "J")
-               (.visitInsn Opcodes/LADD)
-               (.visitInsn Opcodes/LCMP)
-               (.visitInsn Opcodes/IRETURN)
-               (.visitMaxs 0 0)
-               (.visitEnd))
-           ;; http://grepcode.com/file/repository.grepcode.com/java/root/jdk/openjdk/8u40-b25/java/lang/Long.java#1290
-           _ (let [$case-1 (new Label)
-                   $0 (new Label)
-                   $case-2 (new Label)]
-               (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "div_nat" "(JJ)J" nil nil)
-                 (.visitCode)
-                 ;; Test #1
-                 (.visitVarInsn Opcodes/LLOAD 2)
-                 (.visitLdcInsn (long 0))
-                 (.visitInsn Opcodes/LCMP)
-                 (.visitJumpInsn Opcodes/IFLT $case-1)
-                 ;; Test #2
-                 (.visitVarInsn Opcodes/LLOAD 0)
-                 (.visitLdcInsn (long 0))
-                 (.visitInsn Opcodes/LCMP)
-                 (.visitJumpInsn Opcodes/IFGT $case-2)
-                 ;; Case #3
-                 (.visitVarInsn Opcodes/LLOAD 0)
-                 (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "_toUnsignedBigInteger" "(J)Ljava/math/BigInteger;")
-                 (.visitVarInsn Opcodes/LLOAD 2)
-                 (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "_toUnsignedBigInteger" "(J)Ljava/math/BigInteger;")
-                 (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/math/BigInteger" "divide" "(Ljava/math/BigInteger;)Ljava/math/BigInteger;")
-                 (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/math/BigInteger" "longValue" "()J")
-                 (.visitInsn Opcodes/LRETURN)
-                 ;; Case #2
-                 (.visitLabel $case-2)
-                 (.visitVarInsn Opcodes/LLOAD 0)
-                 (.visitVarInsn Opcodes/LLOAD 2)
-                 (.visitInsn Opcodes/LDIV)
-                 (.visitInsn Opcodes/LRETURN)
-                 ;; Case #1
-                 (.visitLabel $case-1)
-                 (.visitVarInsn Opcodes/LLOAD 0)
-                 (.visitVarInsn Opcodes/LLOAD 2)
-                 (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "_compareUnsigned" "(JJ)I")
-                 (.visitJumpInsn Opcodes/IFLT $0)
-                 ;; 1
-                 (.visitLdcInsn (long 1))
-                 (.visitInsn Opcodes/LRETURN)
-                 ;; 0
-                 (.visitLabel $0)
-                 (.visitLdcInsn (long 0))
-                 (.visitInsn Opcodes/LRETURN)
-                 (.visitMaxs 0 0)
-                 (.visitEnd)))
-           ;; http://grepcode.com/file/repository.grepcode.com/java/root/jdk/openjdk/8u40-b25/java/lang/Long.java#1323
-           _ (let [$test-2 (new Label)
-                   $case-2 (new Label)]
-               (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "rem_nat" "(JJ)J" nil nil)
-                 (.visitCode)
-                 ;; Test #1
-                 (.visitVarInsn Opcodes/LLOAD 0)
-                 (.visitLdcInsn (long 0))
-                 (.visitInsn Opcodes/LCMP)
-                 (.visitJumpInsn Opcodes/IFLE $test-2)
-                 (.visitVarInsn Opcodes/LLOAD 2)
-                 (.visitLdcInsn (long 0))
-                 (.visitInsn Opcodes/LCMP)
-                 (.visitJumpInsn Opcodes/IFLE $test-2)
-                 ;; Case #1
-                 (.visitVarInsn Opcodes/LLOAD 0)
-                 (.visitVarInsn Opcodes/LLOAD 2)
-                 (.visitInsn Opcodes/LREM)
-                 (.visitInsn Opcodes/LRETURN)
-                 ;; Test #2
-                 (.visitLabel $test-2)
-                 (.visitVarInsn Opcodes/LLOAD 0)
-                 (.visitVarInsn Opcodes/LLOAD 2)
-                 (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "_compareUnsigned" "(JJ)I")
-                 (.visitJumpInsn Opcodes/IFLT $case-2)
-                 ;; Case #3
-                 (.visitVarInsn Opcodes/LLOAD 0)
-                 (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "_toUnsignedBigInteger" "(J)Ljava/math/BigInteger;")
-                 (.visitVarInsn Opcodes/LLOAD 2)
-                 (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "_toUnsignedBigInteger" "(J)Ljava/math/BigInteger;")
-                 (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/math/BigInteger" "remainder" "(Ljava/math/BigInteger;)Ljava/math/BigInteger;")
-                 (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/math/BigInteger" "longValue" "()J")
-                 (.visitInsn Opcodes/LRETURN)
-                 ;; Case #2
-                 (.visitLabel $case-2)
-                 (.visitVarInsn Opcodes/LLOAD 0)
-                 (.visitInsn Opcodes/LRETURN)
-                 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-                 (.visitMaxs 0 0)
-                 (.visitEnd)))]
-      nil)))
-
 (do-template [<name> <method> <class> <parse-method> <signature> <wrapper>]
   (defn <name> [^ClassWriter =class]
     (do (let [$from (new Label)
@@ -886,7 +754,6 @@
               _ (doto =class
                   (compile-LuxRT-pm-methods)
                   (compile-LuxRT-adt-methods)
-                  (compile-LuxRT-nat-methods)
                   (compile-LuxRT-int-methods)
                   (compile-LuxRT-deg-methods)
                   (compile-LuxRT-frac-methods)