- Improved support for Nat.

6 files changed, 76 insertions, 24 deletions

diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index 110bf253f..194205487 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -549,8 +549,8 @@
   ^:private analyse-jvm-dgt  "dgt"  "java.lang.Double"  "java.lang.Boolean"
   )
 
-(let [length-type &type/Int
-      idx-type &type/Int]
+(let [length-type &type/Nat
+      idx-type &type/Nat]
   (do-template [<elem-class> <array-class> <new-name> <new-tag> <load-name> <load-tag> <store-name> <store-tag>]
     (let [elem-type (&/$HostT <elem-class> &/$Nil)
           array-type (&/$HostT <array-class> &/$Nil)]
@@ -599,8 +599,8 @@
         ;; else
         false)))
 
-(let [length-type &type/Int
-      idx-type &type/Int]
+(let [length-type &type/Nat
+      idx-type &type/Nat]
   (defn ^:private analyse-jvm-anewarray [analyse exo-type ?values]
     (|do [:let [(&/$Cons [_ (&/$TextS _gclass)] (&/$Cons length (&/$Nil))) ?values]
           gclass (&reader/with-source "jvm-anewarray" _gclass
@@ -645,7 +645,7 @@
         =array (&&/analyse-1+ analyse array)
         [arr-class arr-params] (ensure-object (&&/expr-type* =array))
         _ (&/assert! (array-class? arr-class) (str "[Analyser Error] Expected array. Instead got: " arr-class))
-        _ (&type/check exo-type &type/Int)
+        _ (&type/check exo-type &type/Nat)
         _cursor &/cursor]
     (return (&/|list (&&/|meta exo-type _cursor
                                (&&/$proc (&/T ["jvm" "arraylength"]) (&/|list =array) (&/|list))
@@ -885,8 +885,8 @@
     (return (&/|list (&&/|meta output-type _cursor
                                (&&/$proc (&/T ["jvm" "load-class"]) (&/|list) (&/|list _class-name output-type)))))))
 
-(let [length-type &type/Int
-      idx-type &type/Int]
+(let [length-type &type/Nat
+      idx-type &type/Nat]
   (defn ^:private analyse-array-new [analyse exo-type ?values]
     (|do [:let [(&/$Cons length (&/$Nil)) ?values]
           :let [gclass (&/$GenericClass "java.lang.Object" (&/|list))
@@ -1008,9 +1008,9 @@
 (do-template [<name> <op>]
   (defn <name> [analyse exo-type ?values]
     (|do [:let [(&/$Cons input (&/$Cons mask (&/$Nil))) ?values]
-          =mask (&&/analyse-1 analyse &type/Int mask)
-          =input (&&/analyse-1 analyse &type/Int input)
-          _ (&type/check exo-type &type/Int)
+          =mask (&&/analyse-1 analyse &type/Nat mask)
+          =input (&&/analyse-1 analyse &type/Nat input)
+          _ (&type/check exo-type &type/Nat)
           _cursor &/cursor]
       (return (&/|list (&&/|meta exo-type _cursor
                                  (&&/$proc (&/T ["bit" <op>]) (&/|list =input =mask) (&/|list)))))))
@@ -1022,25 +1022,25 @@
 
 (defn ^:private analyse-bit-count [analyse exo-type ?values]
   (|do [:let [(&/$Cons input (&/$Nil)) ?values]
-        =input (&&/analyse-1 analyse &type/Int input)
-        _ (&type/check exo-type &type/Int)
+        =input (&&/analyse-1 analyse &type/Nat input)
+        _ (&type/check exo-type &type/Nat)
         _cursor &/cursor]
     (return (&/|list (&&/|meta exo-type _cursor
                                (&&/$proc (&/T ["bit" "count"]) (&/|list =input) (&/|list)))))))
 
-(do-template [<name> <op>]
+(do-template [<name> <op> <type>]
   (defn <name> [analyse exo-type ?values]
     (|do [:let [(&/$Cons input (&/$Cons shift (&/$Nil))) ?values]
-          =shift (&&/analyse-1 analyse &type/Int shift)
-          =input (&&/analyse-1 analyse &type/Int input)
-          _ (&type/check exo-type &type/Int)
+          =shift (&&/analyse-1 analyse &type/Nat shift)
+          =input (&&/analyse-1 analyse <type> input)
+          _ (&type/check exo-type <type>)
           _cursor &/cursor]
       (return (&/|list (&&/|meta exo-type _cursor
                                  (&&/$proc (&/T ["bit" <op>]) (&/|list =input =shift) (&/|list)))))))
 
-  ^:private analyse-bit-shift-left           "shift-left"
-  ^:private analyse-bit-shift-right          "shift-right"
-  ^:private analyse-bit-unsigned-shift-right "unsigned-shift-right"
+  ^:private analyse-bit-shift-left           "shift-left" &type/Nat
+  ^:private analyse-bit-shift-right          "shift-right" &type/Int
+  ^:private analyse-bit-unsigned-shift-right "unsigned-shift-right" &type/Nat
   )
 
 (defn ^:private analyse-lux-== [analyse exo-type ?values]
@@ -1101,6 +1101,19 @@
   ^:private analyse-nat-max-value &type/Nat ["nat" "max-value"]
   )
 
+(do-template [<name> <from-type> <to-type> <op>]
+  (defn <name> [analyse exo-type ?values]
+    (|do [:let [(&/$Cons x (&/$Nil)) ?values]
+          =x (&&/analyse-1 analyse <from-type> x)
+          _ (&type/check exo-type <to-type>)
+          _cursor &/cursor]
+      (return (&/|list (&&/|meta <to-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"]
+  )
+
 (defn analyse-host [analyse exo-type compilers category proc ?values]
   (|let [[_ _ compile-class compile-interface] compilers]
     (case category
@@ -1139,6 +1152,12 @@
         "decode" (analyse-nat-decode analyse exo-type ?values)
         "min-value" (analyse-nat-min-value analyse exo-type ?values)
         "max-value" (analyse-nat-max-value analyse exo-type ?values)
+        "to-int" (analyse-nat-to-int analyse exo-type ?values)
+        )
+
+      "int"
+      (case proc
+        "to-nat" (analyse-int-to-nat analyse exo-type ?values)
         )
       
       "jvm"
diff --git a/src/lux/base.clj b/src/lux/base.clj
index ba42f702d..b5bd4e732 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -1047,7 +1047,7 @@
     (pr-str ?value)
 
     [_ ($NatS ?value)]
-    (Long/toUnsignedString ?value)
+    (str "+" (Long/toUnsignedString ?value))
 
     [_ ($IntS ?value)]
     (pr-str ?value)
diff --git a/src/lux/compiler/case.clj b/src/lux/compiler/case.clj
index 08624d171..4ca543b8e 100644
--- a/src/lux/compiler/case.clj
+++ b/src/lux/compiler/case.clj
@@ -72,6 +72,16 @@
       (.visitLdcInsn _value)
       (.visitJumpInsn Opcodes/IF_ICMPNE $else))
 
+    (&o/$NatPM _value)
+    (doto writer
+      (.visitInsn Opcodes/DUP)
+      (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "pm_stack_peek" "([Ljava/lang/Object;)Ljava/lang/Object;")
+      (.visitTypeInsn Opcodes/CHECKCAST "java/lang/Long")
+      (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/Long" "longValue" "()J")
+      (.visitLdcInsn (long _value))
+      (.visitInsn Opcodes/LCMP)
+      (.visitJumpInsn Opcodes/IFNE $else))
+
     (&o/$IntPM _value)
     (doto writer
       (.visitInsn Opcodes/DUP)
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index cdfc7dc7e..b6cd643d6 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -1570,7 +1570,10 @@
                   (.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+)
                   (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ "longValue" "()J"))]
         :let [_ (doto *writer*
-                  (.visitMethodInsn Opcodes/INVOKESTATIC +wrapper-class+ "toUnsignedString" "(J)Ljava/lang/String;"))]]
+                  (.visitMethodInsn Opcodes/INVOKESTATIC +wrapper-class+ "toUnsignedString" "(J)Ljava/lang/String;")
+                  (.visitLdcInsn "+")
+                  (.visitInsn Opcodes/SWAP)
+                  (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "concat" "(Ljava/lang/String;)Ljava/lang/String;"))]]
     (return nil)))
 
 (defn ^:private compile-nat-decode [compile ?values special-args]
@@ -1597,6 +1600,17 @@
   ^:private compile-nat-max-value (.visitLdcInsn -1) &&/wrap-long
   )
 
+(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
+  )
+
 (defn compile-host [compile proc-category proc-name ?values special-args]
   (case proc-category
     "lux"
@@ -1630,6 +1644,12 @@
       "decode"    (compile-nat-decode compile ?values special-args)
       "max-value" (compile-nat-max-value compile ?values special-args)
       "min-value" (compile-nat-min-value compile ?values special-args)
+      "to-int"    (compile-nat-to-int compile ?values special-args)
+      )
+
+    "int"
+    (case proc-name
+      "to-nat"    (compile-int-to-nat compile ?values special-args)
       )
     
     "jvm"
diff --git a/src/lux/type.clj b/src/lux/type.clj
index 7ca4145a6..8099eb914 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -92,7 +92,7 @@
                                         TypePair
                                         (&/$SumT
                                          ;; BoundT
-                                         Int
+                                         Nat
                                          (&/$SumT
                                           ;; VarT
                                           Int
diff --git a/src/lux/type/host.clj b/src/lux/type/host.clj
index a3252ddb7..fe910c76e 100644
--- a/src/lux/type/host.clj
+++ b/src/lux/type/host.clj
@@ -269,11 +269,14 @@
                     (not= array-data-tag a!name))
                (check-error "" (&/$HostT e!name e!params) (&/$HostT a!name a!params))
 
-               (and (or (= nat-data-tag e!name)
-                        (= "java.lang.Long" e!name))
+               (and (= nat-data-tag e!name)
                     (= nat-data-tag a!name))
                (return fixpoints)
 
+               (or (= nat-data-tag e!name)
+                   (= nat-data-tag a!name))
+               (check-error "" (&/$HostT e!name e!params) (&/$HostT a!name a!params))
+
                :else
                (let [e!name (as-obj e!name)
                      a!name (as-obj a!name)]