- Nat encoding/decoding is now implemented in the standard library.

7 files changed, 80 insertions, 192 deletions

diff --git a/luxc/src/lux/analyser/proc/common.clj b/luxc/src/lux/analyser/proc/common.clj
index b2a9528c1..2bd6ba648 100644
--- a/luxc/src/lux/analyser/proc/common.clj
+++ b/luxc/src/lux/analyser/proc/common.clj
@@ -254,7 +254,6 @@
           (return (&/|list (&&/|meta exo-type _cursor
                                      (&&/$proc (&/T <decode-op>) (&/|list =x) (&/|list)))))))))
 
-  ^:private analyse-nat-encode ["nat" "encode"] ^:private analyse-nat-decode ["nat" "decode"] &type/Nat
   ^:private analyse-int-encode ["int" "encode"] ^:private analyse-int-decode ["int" "decode"] &type/Int
   ^:private analyse-deg-encode ["deg" "encode"] ^:private analyse-deg-decode ["deg" "decode"] &type/Deg
   ^:private analyse-real-encode ["real" "encode"] ^:private analyse-real-decode ["real" "decode"] &type/Real
@@ -544,8 +543,6 @@
       "%" (analyse-nat-rem analyse exo-type ?values)
       "=" (analyse-nat-eq analyse exo-type ?values)
       "<" (analyse-nat-lt analyse exo-type ?values)
-      "encode" (analyse-nat-encode analyse exo-type ?values)
-      "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)
diff --git a/luxc/src/lux/compiler/js/proc/common.clj b/luxc/src/lux/compiler/js/proc/common.clj
index 03ce5e936..130dbb298 100644
--- a/luxc/src/lux/compiler/js/proc/common.clj
+++ b/luxc/src/lux/compiler/js/proc/common.clj
@@ -149,11 +149,9 @@
       ))
 
   ^:private compile-int-encode "encodeI64"
-  ^:private compile-nat-encode "encodeN64"
   ^:private compile-deg-encode "encodeD64"
 
   ^:private compile-int-decode "decodeI64"
-  ^:private compile-nat-decode "decodeN64"
   ^:private compile-deg-decode "decodeD64"
 
   ^:private compile-real-decode "decodeReal"
@@ -501,8 +499,6 @@
       "%"         (compile-nat-rem compile ?values special-args)
       "="         (compile-nat-eq compile ?values special-args)
       "<"         (compile-nat-lt compile ?values special-args)
-      "encode"    (compile-nat-encode compile ?values special-args)
-      "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)
diff --git a/luxc/src/lux/compiler/js/rt.clj b/luxc/src/lux/compiler/js/rt.clj
index 889ced291..085cf5fe4 100644
--- a/luxc/src/lux/compiler/js/rt.clj
+++ b/luxc/src/lux/compiler/js/rt.clj
@@ -622,43 +622,6 @@
                        "if(shift > 0) { remainder = LuxRT$shiftRightBigInt(remainder,shift); }"
                        "return [LuxRT$normalizeBigInt(quotient), LuxRT$normalizeBigInt(remainder)];"
                        "})")
-   "encodeN64" (str "(function LuxRT$encodeN64(input) {"
-                    (str "if(input.H < 0) {"
-                         ;; Too big
-                         "var lastDigit = LuxRT$remI64(input, LuxRT$makeI64(0,10));"
-                         "var minusLastDigit = LuxRT$divI64(input, LuxRT$makeI64(0,10));"
-                         "return '+'.concat(LuxRT$encodeI64(minusLastDigit)).concat(LuxRT$encodeI64(lastDigit));"
-                         "}"
-                         "else {"
-                         ;; Small enough
-                         "return '+'.concat(LuxRT$encodeI64(input));"
-                         "}")
-                    "})")
-   "decodeN64" (str "(function LuxRT$decodeN64(input) {"
-                    "input = LuxRT$clean_separators(input);"
-                    (str "if(/^\\+\\d+$/.exec(input)) {"
-                         (str "input = input.substring(1);")
-                         (str "if(input.length <= 18) {"
-                              ;; Short enough...
-                              "return LuxRT$decodeI64(input);"
-                              "}"
-                              "else {"
-                              ;; Too long
-                              (str "var prefix = LuxRT$decodeI64(input.substring(0, input.length-1))[2];"
-                                   "var suffix = LuxRT$decodeI64(input.charAt(input.length-1))[2];"
-                                   "var total = LuxRT$addI64(LuxRT$mulI64(prefix,LuxRT$fromNumberI64(10)),suffix);"
-                                   (str "if(LuxRT$ltN64(total,prefix)) {"
-                                        (str "return " const-none ";")
-                                        "}"
-                                        "else {"
-                                        (str "return " (make-some "total") ";")
-                                        "}"))
-                              "}")
-                         "}"
-                         "else {"
-                         (str "return " const-none ";")
-                         "}")
-                    "})")
    "divN64" (str "(function LuxRT$divN64(l,r) {"
                  (str "if(LuxRT$ltI64(r,LuxRT$ZERO)) {"
                       (str "if(LuxRT$ltN64(l,r)) {"
diff --git a/luxc/src/lux/compiler/jvm/proc/common.clj b/luxc/src/lux/compiler/jvm/proc/common.clj
index 323213170..5e1fe8a1a 100644
--- a/luxc/src/lux/compiler/jvm/proc/common.clj
+++ b/luxc/src/lux/compiler/jvm/proc/common.clj
@@ -408,7 +408,6 @@
                         (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" <decode-method> "(Ljava/lang/String;)Ljava/lang/Object;"))]]
           (return nil)))))
 
-  ^:private compile-nat-encode "encode_nat" ^:private compile-nat-decode "decode_nat"
   ^:private compile-deg-encode "encode_deg" ^:private compile-deg-decode "decode_deg"
   )
 
@@ -946,8 +945,6 @@
       "%"         (compile-nat-rem compile ?values special-args)
       "="         (compile-nat-eq compile ?values special-args)
       "<"         (compile-nat-lt compile ?values special-args)
-      "encode"    (compile-nat-encode compile ?values special-args)
-      "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)
diff --git a/luxc/src/lux/compiler/jvm/rt.clj b/luxc/src/lux/compiler/jvm/rt.clj
index a98cf5b20..9bc94427e 100644
--- a/luxc/src/lux/compiler/jvm/rt.clj
+++ b/luxc/src/lux/compiler/jvm/rt.clj
@@ -945,146 +945,7 @@
 
 (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#677
-           _ (let [$from (new Label)
-                   $to (new Label)
-                   $handler (new Label)
-                   
-                   $good-start (new Label)
-                   $short-enough (new Label)
-                   $bad-digit (new Label)
-                   $out-of-bounds (new Label)]
-               (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "decode_nat" "(Ljava/lang/String;)Ljava/lang/Object;" nil nil)
-                 (.visitCode)
-                 (.visitTryCatchBlock $from $to $handler "java/lang/Exception")
-                 (.visitLabel $from)
-                 ;; Remove the + at the beginning...
-                 (.visitVarInsn Opcodes/ALOAD 0)
-                 (.visitLdcInsn (int 0))
-                 (.visitLdcInsn (int 1))
-                 (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "substring" "(II)Ljava/lang/String;")
-                 (.visitLdcInsn "+")
-                 (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/Object" "equals" "(Ljava/lang/Object;)Z")
-                 (.visitJumpInsn Opcodes/IFNE $good-start)
-                 ;; Doesn't start with +
-                 (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_none" "()Ljava/lang/Object;")
-                 (.visitInsn Opcodes/ARETURN)
-                 ;; Starts with +
-                 (.visitLabel $good-start)
-                 (.visitVarInsn Opcodes/ALOAD 0)
-                 (.visitLdcInsn (int 1))
-                 (.visitVarInsn Opcodes/ALOAD 0)
-                 (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "length" "()I")
-                 (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "substring" "(II)Ljava/lang/String;")
-                 (.visitVarInsn Opcodes/ASTORE 0) ;; Removed the + prefix...
-                 ;; Begin parsing processs
-                 (.visitVarInsn Opcodes/ALOAD 0)
-                 (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "length" "()I")
-                 (.visitLdcInsn (int 18))
-                 (.visitJumpInsn Opcodes/IF_ICMPLE $short-enough)
-                 ;; Too long
-                 ;; Get prefix...
-                 (.visitVarInsn Opcodes/ALOAD 0)
-                 (.visitLdcInsn (int 0))
-                 (.visitVarInsn Opcodes/ALOAD 0)
-                 (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "length" "()I")
-                 (.visitLdcInsn (int 1))
-                 (.visitInsn Opcodes/ISUB)
-                 (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "substring" "(II)Ljava/lang/String;")
-                 (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Long" "parseLong" "(Ljava/lang/String;)J")
-                 (.visitInsn Opcodes/DUP2) ;; Clone prefix, for later...
-                 ;; Get last digit...
-                 (.visitVarInsn Opcodes/ALOAD 0)
-                 (.visitVarInsn Opcodes/ALOAD 0)
-                 (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "length" "()I")
-                 (.visitLdcInsn (int 1))
-                 (.visitInsn Opcodes/ISUB)
-                 (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "charAt" "(I)C")
-                 (.visitLdcInsn (int 10))
-                 (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Character" "digit" "(CI)I")
-                 ;; Test last digit...
-                 (.visitInsn Opcodes/DUP)
-                 (.visitJumpInsn Opcodes/IFLT $bad-digit)
-                 ;; Good digit...
-                 ;; Stack: prefix::L, prefix::L, last-digit::I
-                 (.visitInsn Opcodes/I2L)
-                 ;; Build the result...
-                 swap2
-                 (.visitLdcInsn (long 10))
-                 (.visitInsn Opcodes/LMUL)
-                 (.visitInsn Opcodes/LADD) ;; Stack: prefix::L, result::L
-                 (.visitInsn Opcodes/DUP2_X2) ;; Stack: result::L, prefix::L, result::L
-                 swap2 ;; Stack: result::L, result::L, prefix::L
-                 (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "_compareUnsigned" "(JJ)I")
-                 (.visitJumpInsn Opcodes/IFLT $out-of-bounds)
-                 ;; Within bounds
-                 ;; Stack: result::L
-                 &&/wrap-long
-                 (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_some" "(Ljava/lang/Object;)Ljava/lang/Object;")
-                 (.visitInsn Opcodes/ARETURN)
-                 ;; Out of bounds
-                 (.visitLabel $out-of-bounds)
-                 (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_none" "()Ljava/lang/Object;")
-                 (.visitInsn Opcodes/ARETURN)
-                 ;; Bad digit...
-                 (.visitLabel $bad-digit)
-                 (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_none" "()Ljava/lang/Object;")
-                 (.visitInsn Opcodes/ARETURN)
-                 ;; 18 chars or less
-                 (.visitLabel $short-enough)
-                 (.visitVarInsn Opcodes/ALOAD 0)
-                 (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Long" "parseLong" "(Ljava/lang/String;)J")
-                 &&/wrap-long
-                 (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_some" "(Ljava/lang/Object;)Ljava/lang/Object;")
-                 (.visitInsn Opcodes/ARETURN)
-                 (.visitLabel $to)
-                 (.visitLabel $handler)
-                 (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_none" "()Ljava/lang/Object;")
-                 (.visitInsn Opcodes/ARETURN)
-                 (.visitMaxs 0 0)
-                 (.visitEnd)))
-           ;; http://grepcode.com/file/repository.grepcode.com/java/root/jdk/openjdk/8u40-b25/java/lang/Long.java#172
-           _ (let [$too-big (new Label)]
-               (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "encode_nat" "(J)Ljava/lang/String;" nil nil)
-                 (.visitCode)
-                 (.visitLdcInsn "+")
-                 (.visitVarInsn Opcodes/LLOAD 0)
-                 (.visitLdcInsn (long 0))
-                 (.visitInsn Opcodes/LCMP)
-                 (.visitJumpInsn Opcodes/IFLT $too-big)
-                 ;; then
-                 (.visitVarInsn Opcodes/LLOAD 0)
-                 (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Long" "toString" "(J)Ljava/lang/String;")
-                 (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "concat" "(Ljava/lang/String;)Ljava/lang/String;")
-                 (.visitInsn Opcodes/ARETURN)
-                 ;; else
-                 (.visitLabel $too-big)
-                 ;; Set up parts of the number string...
-                 ;; First digits
-                 (.visitVarInsn Opcodes/LLOAD 0)
-                 (.visitLdcInsn (int 1))
-                 (.visitInsn Opcodes/LUSHR)
-                 (.visitLdcInsn (long 5))
-                 (.visitInsn Opcodes/LDIV) ;; quot
-                 ;; Last digit
-                 (.visitInsn Opcodes/DUP2)
-                 (.visitLdcInsn (long 10))
-                 (.visitInsn Opcodes/LMUL)
-                 (.visitVarInsn Opcodes/LLOAD 0)
-                 swap2
-                 (.visitInsn Opcodes/LSUB) ;; quot, rem
-                 ;; Conversion to string...
-                 (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Long" "toString" "(J)Ljava/lang/String;") ;; quot, rem*
-                 (.visitInsn Opcodes/DUP_X2);; rem*, quot, rem*
-                 (.visitInsn Opcodes/POP) ;; rem*, quot
-                 (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Long" "toString" "(J)Ljava/lang/String;") ;; rem*, quot*
-                 (.visitInsn Opcodes/SWAP) ;; quot*, rem*
-                 (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "concat" "(Ljava/lang/String;)Ljava/lang/String;")
-                 (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "concat" "(Ljava/lang/String;)Ljava/lang/String;")
-                 (.visitInsn Opcodes/ARETURN)
-                 (.visitMaxs 0 0)
-                 (.visitEnd)))
-           ;; http://grepcode.com/file/repository.grepcode.com/java/root/jdk/openjdk/8u40-b25/java/lang/Long.java#215
+    (|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)
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index fc606bc36..964cf5b57 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -1544,8 +1544,7 @@
   #Nil
   ($' Monad Maybe)
   {#wrap
-   (lambda' return [x]
-            (#Some x))
+   (lambda' [x] (#Some x))
    
    #bind
    (lambda' [f ma]
@@ -2070,10 +2069,32 @@
   (-> Bool Text)
   (if x "true" "false"))
 
-(def:''' (Nat/encode x)
+(def:''' (digit-to-text digit)
   #Nil
   (-> Nat Text)
-  (_lux_proc ["nat" "encode"] [x]))
+  (_lux_case digit
+    +0 "0"
+    +1 "1" +2 "2" +3 "3"
+    +4 "4" +5 "5" +6 "6"
+    +7 "7" +8 "8" +9 "9"
+    _ (_lux_proc ["io" "error"] ["undefined"])))
+
+(def:''' (Nat/encode value)
+  #Nil
+  (-> Nat Text)
+  (_lux_case value
+    +0
+    "+0"
+
+    _
+    (let' [loop (_lux_: (-> Nat Text Text)
+                  (lambda' recur [input output]
+                           (if (_lux_proc ["nat" "="] [input +0])
+                             (_lux_proc ["text" "append"] ["+" output])
+                             (recur (_lux_proc ["nat" "/"] [input +10])
+                                    (_lux_proc ["text" "append"] [(digit-to-text (_lux_proc ["nat" "%"] [input +10]))
+                                                                  output])))))]
+          (loop value ""))))
 
 (def:''' (Int/encode x)
   #Nil
diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux
index c90abf76d..9b828ec25 100644
--- a/stdlib/source/lux/data/number.lux
+++ b/stdlib/source/lux/data/number.lux
@@ -144,12 +144,65 @@
          #;None
          (#;Left <error>))))]
 
-  [ Nat [ "nat" "encode"] [ "nat" "decode"] "Couldn't decode Nat"]
   [ Int [ "int" "encode"] [ "int" "decode"] "Couldn't decode Int"]
   [ Deg [ "deg" "encode"] [ "deg" "decode"] "Couldn't decode Deg"]
   [Real ["real" "encode"] ["real" "decode"] "Couldn't decode Real"]
   )
 
+(def: (digit-to-text digit)
+  (-> Nat Text)
+  (case digit
+    +0 "0"
+    +1 "1" +2 "2" +3 "3"
+    +4 "4" +5 "5" +6 "6"
+    +7 "7" +8 "8" +9 "9"
+    _ (undefined)))
+
+(def: (text-to-digit digit)
+  (-> Text (Maybe Nat))
+  (case digit
+    "0" (#;Some +0)
+    "1" (#;Some +1) "2" (#;Some +2) "3" (#;Some +3)
+    "4" (#;Some +4) "5" (#;Some +5) "6" (#;Some +6)
+    "7" (#;Some +7) "8" (#;Some +8) "9" (#;Some +9)
+    _ #;None))
+
+(struct: #export _ (Codec Text Nat)
+  (def: (encode value)
+    (case value
+      +0
+      "+0"
+
+      _
+      (loop [input value
+             output ""]
+        (if (n.= +0 input)
+          (_lux_proc ["text" "append"] ["+" output])
+          (recur (n./ +10 input)
+                 (_lux_proc ["text" "append"] [(digit-to-text (n.% +10 input)) output]))))))
+
+  (def: (decode repr)
+    (let [input-size (_lux_proc ["text" "size"] [repr])]
+      (if (n.>= +2 input-size)
+        (case (_lux_proc ["text" "char"] [repr +0])
+          (#;Some #"+")
+          (loop [idx +1
+                 output +0]
+            (if (n.< input-size idx)
+              (case (_lux_proc ["text" "char"] [repr idx])
+                (^=> (#;Some sample)
+                     [(text-to-digit (_lux_proc ["char" "to-text"] [sample])) (#;Some digit)])
+                (recur (n.inc idx)
+                       (|> output (n.* +10) (n.+ digit)))
+
+                _
+                (undefined))
+              (#;Right output)))
+
+          _
+          (#;Left "Invalid binary syntax."))
+        (#;Left "Invalid binary syntax.")))))
+
 (struct: #export _ (Hash Nat)
   (def: eq Eq<Nat>)
   (def: hash id))