diff options
author | Eduardo Julian | 2017-03-30 23:09:25 -0400 |
---|---|---|
committer | Eduardo Julian | 2017-03-30 23:09:25 -0400 |
commit | ae7c062bdf4ab8337f0eedae78b38df24e62822c (patch) | |
tree | 21654507c07c719b9d1a480d8b2ea6b9b439a6df | |
parent | 020f625b3d94cdb00242ead397595eeff842533c (diff) |
- Nat encoding/decoding is now implemented in the standard library.
-rw-r--r-- | luxc/src/lux/analyser/proc/common.clj | 3 | ||||
-rw-r--r-- | luxc/src/lux/compiler/js/proc/common.clj | 4 | ||||
-rw-r--r-- | luxc/src/lux/compiler/js/rt.clj | 37 | ||||
-rw-r--r-- | luxc/src/lux/compiler/jvm/proc/common.clj | 3 | ||||
-rw-r--r-- | luxc/src/lux/compiler/jvm/rt.clj | 141 | ||||
-rw-r--r-- | stdlib/source/lux.lux | 29 | ||||
-rw-r--r-- | stdlib/source/lux/data/number.lux | 55 |
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)) |