aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--luxc/src/lux/analyser/proc/common.clj49
-rw-r--r--luxc/src/lux/compiler/jvm/proc/common.clj100
-rw-r--r--luxc/src/lux/compiler/jvm/rt.clj133
-rw-r--r--new-luxc/source/luxc/lang/extension/analysis/common.lux20
-rw-r--r--new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux45
-rw-r--r--new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux94
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux44
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux89
-rw-r--r--new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux45
-rw-r--r--new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux31
-rw-r--r--new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux36
-rw-r--r--new-luxc/source/luxc/lang/translation/python/runtime.jvm.lux40
-rw-r--r--new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux37
-rw-r--r--new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux78
-rw-r--r--new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux47
-rw-r--r--new-luxc/source/luxc/lang/translation/ruby/runtime.jvm.lux35
-rw-r--r--new-luxc/source/luxc/lang/translation/scheme/procedure/common.jvm.lux37
-rw-r--r--new-luxc/source/luxc/lang/translation/scheme/runtime.jvm.lux38
-rw-r--r--new-luxc/test/test/luxc/lang/analysis/procedure/common.lux32
-rw-r--r--stdlib/source/lux.lux189
-rw-r--r--stdlib/source/lux/data/coll/queue/priority.lux6
-rw-r--r--stdlib/source/lux/data/number.lux2
-rw-r--r--stdlib/source/lux/data/text.lux4
23 files changed, 226 insertions, 1005 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)
diff --git a/new-luxc/source/luxc/lang/extension/analysis/common.lux b/new-luxc/source/luxc/lang/extension/analysis/common.lux
index c63d063cd..1d4429e09 100644
--- a/new-luxc/source/luxc/lang/extension/analysis/common.lux
+++ b/new-luxc/source/luxc/lang/extension/analysis/common.lux
@@ -209,22 +209,6 @@
(install "arithmetic-right-shift" (binary Int Nat Int))
)))
-(def: nat-procs
- Bundle
- (<| (prefix "nat")
- (|> (dict.new text.Hash<Text>)
- (install "+" (binary Nat Nat Nat))
- (install "-" (binary Nat Nat Nat))
- (install "*" (binary Nat Nat Nat))
- (install "/" (binary Nat Nat Nat))
- (install "%" (binary Nat Nat Nat))
- (install "=" (binary Nat Nat Bool))
- (install "<" (binary Nat Nat Bool))
- (install "min" (nullary Nat))
- (install "max" (nullary Nat))
- (install "to-int" (unary Nat Int))
- (install "char" (unary Nat Text)))))
-
(def: int-procs
Bundle
(<| (prefix "int")
@@ -239,7 +223,8 @@
(install "min" (nullary Int))
(install "max" (nullary Int))
(install "to-nat" (unary Int Nat))
- (install "to-frac" (unary Int Frac)))))
+ (install "to-frac" (unary Int Frac))
+ (install "char" (unary Int Text)))))
(def: deg-procs
Bundle
@@ -453,7 +438,6 @@
(|> (dict.new text.Hash<Text>)
(dict.merge lux-procs)
(dict.merge bit-procs)
- (dict.merge nat-procs)
(dict.merge int-procs)
(dict.merge deg-procs)
(dict.merge frac-procs)
diff --git a/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux
index 14e37efb8..f9e00be2a 100644
--- a/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux
@@ -210,9 +210,6 @@
Nullary
(<encode> <const>))]
- [nat//min 0 runtimeT.int]
- [nat//max -1 runtimeT.int]
-
[int//min Long::MIN_VALUE runtimeT.int]
[int//max Long::MAX_VALUE runtimeT.int]
@@ -238,12 +235,6 @@
[int//div runtimeT.int///]
[int//rem runtimeT.int//%]
- [nat//add runtimeT.int//+]
- [nat//sub runtimeT.int//-]
- [nat//mul runtimeT.int//*]
- [nat//div runtimeT.nat///]
- [nat//rem runtimeT.nat//%]
-
[deg//add runtimeT.int//+]
[deg//sub runtimeT.int//-]
[deg//mul runtimeT.deg//*]
@@ -275,21 +266,10 @@
Binary
(format <cmp> "(" subjectJS "," paramJS ")"))]
- [nat//= runtimeT.int//=]
- [nat//< runtimeT.nat//<]
[int//= runtimeT.int//=]
[int//< runtimeT.int//<]
[deg//= runtimeT.int//=]
- [deg//< runtimeT.nat//<]
- )
-
-(do-template [<name>]
- [(def: (<name> inputJS)
- Unary
- inputJS)]
-
- [nat//to-int]
- [int//to-nat]
+ [deg//< runtimeT.int//<]
)
(def: (frac//encode inputJS)
@@ -314,7 +294,7 @@
[text//hash runtimeT.text//hash]
)
-(def: (nat//char inputJS)
+(def: (int//char inputJS)
Unary
(format "String.fromCharCode" "(" (int//to-frac inputJS) ")"))
@@ -479,22 +459,6 @@
(install "arithmetic-right-shift" (binary bit//arithmetic-right-shift))
)))
-(def: nat-procs
- Bundle
- (<| (prefix "nat")
- (|> (dict.new text.Hash<Text>)
- (install "+" (binary nat//add))
- (install "-" (binary nat//sub))
- (install "*" (binary nat//mul))
- (install "/" (binary nat//div))
- (install "%" (binary nat//rem))
- (install "=" (binary nat//=))
- (install "<" (binary nat//<))
- (install "min" (nullary nat//min))
- (install "max" (nullary nat//max))
- (install "to-int" (unary nat//to-int))
- (install "char" (unary nat//char)))))
-
(def: int-procs
Bundle
(<| (prefix "int")
@@ -508,8 +472,8 @@
(install "<" (binary int//<))
(install "min" (nullary int//min))
(install "max" (nullary int//max))
- (install "to-nat" (unary int//to-nat))
- (install "to-frac" (unary int//to-frac)))))
+ (install "to-frac" (unary int//to-frac))
+ (install "char" (unary int//char)))))
(def: deg-procs
Bundle
@@ -638,7 +602,6 @@
(<| (prefix "lux")
(|> lux-procs
(dict.merge bit-procs)
- (dict.merge nat-procs)
(dict.merge int-procs)
(dict.merge deg-procs)
(dict.merge frac-procs)
diff --git a/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux
index afb3cd538..5fab92941 100644
--- a/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux
@@ -584,99 +584,6 @@
__int///
__int//%))
-(runtime: nat//< "ltN64"
- (let [high (function (_ i64) (format "(" i64 "." //.int-high-field ")"))
- low (function (_ i64) (format "(" i64 "." //.int-low-field ")"))
- i32 (function (_ word) (format "(" word " >>> 0)"))]
- (js.function @ (list "subject" "parameter")
- (list (js.return! (js.or (js.> (i32 (high "subject"))
- (i32 (high "parameter")))
- (js.and (js.= (high "subject")
- (high "parameter"))
- (js.> (i32 (low "subject"))
- (i32 (low "parameter"))))))))))
-
-(def: (<N param subject)
- (-> Expression Expression Expression)
- (js.apply nat//< (list subject param)))
-
-(def: (<=N param subject)
- (-> Expression Expression Expression)
- (js.or (js.apply nat//< (list subject param))
- (js.apply int//= (list subject param))))
-
-(def: (>N param subject)
- (-> Expression Expression Expression)
- (js.apply nat//< (list param subject)))
-
-(def: (>=N param subject)
- (-> Expression Expression Expression)
- (js.or (js.apply nat//< (list param subject))
- (js.apply int//= (list subject param))))
-
-(runtime: nat/// "divN64"
- (let [negative? (function (_ value)
- (js.apply int//< (list value int//zero)))
- valid-division-check [(=I int//zero "parameter")
- (js.throw! (js.string "Cannot divide by zero!"))]
- short-circuit-check [(=I int//zero "subject")
- (js.return! int//zero)]]
- (js.function @ (list "subject" "parameter")
- (list (js.cond! (list valid-division-check
- short-circuit-check
-
- [(>N "subject" "parameter")
- (js.return! int//zero)]
-
- [(>N (js.apply bit//logical-right-shift
- (list "subject" (js.number 1.0)))
- "parameter")
- (js.return! int//one)])
- (js.block! (list (js.var! "result" (#.Some int//zero))
- (js.var! "remainder" (#.Some "subject"))
- (js.while! (>=N "parameter" "remainder")
- (let [rough-estimate (js.apply "Math.floor" (list (js./ (js.apply int//to-number (list "parameter"))
- (js.apply int//to-number (list "remainder")))))
- log2 (js./ "Math.LN2"
- (js.apply "Math.log" (list "approximate")))
- approx-result (js.apply int//from-number (list "approximate"))
- approx-remainder (js.apply int//* (list "approximate_result" "parameter"))]
- (list (js.var! "approximate" (#.Some (js.apply "Math.max" (list (js.number 1.0)
- rough-estimate))))
- (js.var! "log2" (#.Some (js.apply "Math.ceil" (list log2))))
- (js.var! "delta" (#.Some (js.? (js.<= (js.number 48.0) "log2")
- (js.number 1.0)
- (js.apply "Math.pow" (list (js.number 2.0)
- (js.- (js.number 48.0)
- "log2"))))))
- (js.var! "approximate_result" (#.Some approx-result))
- (js.var! "approximate_remainder" (#.Some approx-remainder))
- (js.while! (js.or (negative? "approximate_remainder")
- (>N "remainder"
- "approximate_remainder"))
- (list (js.set! "approximate" (js.- "delta" "approximate"))
- (js.set! "approximate_result" approx-result)
- (js.set! "approximate_remainder" approx-remainder)))
- (js.block! (list (js.set! "result" (js.apply int//+ (list "result"
- (js.? (=I int//zero "approximate_result")
- int//one
- "approximate_result"))))
- (js.set! "remainder" (js.apply int//- (list "remainder" "approximate_remainder"))))))))
- (js.return! "result")))
- )))))
-
-(runtime: nat//% "remN64"
- (js.function @ (list "subject" "parameter")
- (list (let [flat (js.apply int//* (list (js.apply nat/// (list "subject" "parameter"))
- "parameter"))]
- (js.return! (js.apply int//- (list "subject" flat)))))))
-
-(def: runtime//nat
- Runtime
- (format __nat//<
- __nat///
- __nat//%))
-
(runtime: deg//* "mulD64"
(format "(function " @ "(l,r) {"
"var lL = " int//from-number "(l.L);"
@@ -900,7 +807,6 @@
runtime//adt
runtime//bit
runtime//int
- runtime//nat
runtime//deg
runtime//text
runtime//array
diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux
index 3a5cc9b70..05a38eb2f 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux
@@ -267,18 +267,11 @@
(def: deg-method $.Method nat-method)
-(def: compare-nat-method
- $.Method
- ($t.method (list $t.long $t.long) (#.Some $t.int) (list)))
-
(do-template [<name> <const> <type>]
[(def: (<name> _)
Nullary
(|>> <const> ($i.wrap <type>)))]
- [nat//min ($i.long 0) #$.Long]
- [nat//max ($i.long -1) #$.Long]
-
[int//min ($i.long Long::MIN_VALUE) #$.Long]
[int//max ($i.long Long::MAX_VALUE) #$.Long]
@@ -307,12 +300,6 @@
[int//div #$.Long $i.LDIV]
[int//rem #$.Long $i.LREM]
- [nat//add #$.Long $i.LADD]
- [nat//sub #$.Long $i.LSUB]
- [nat//mul #$.Long $i.LMUL]
- [nat//div #$.Long ($i.INVOKESTATIC hostL.runtime-class "div_nat" nat-method false)]
- [nat//rem #$.Long ($i.INVOKESTATIC hostL.runtime-class "rem_nat" nat-method false)]
-
[frac//add #$.Double $i.DADD]
[frac//sub #$.Double $i.DSUB]
[frac//mul #$.Double $i.DMUL]
@@ -340,10 +327,9 @@
[<eq> 0]
[<lt> -1])]
- [nat//eq nat//lt ($i.unwrap #$.Long) ($i.INVOKESTATIC hostL.runtime-class "compare_nat" compare-nat-method false)]
[int//eq int//lt ($i.unwrap #$.Long) $i.LCMP]
[frac//eq frac//lt ($i.unwrap #$.Double) $i.DCMPG]
- [deg//eq deg//lt ($i.unwrap #$.Long) ($i.INVOKESTATIC hostL.runtime-class "compare_nat" compare-nat-method false)]
+ [deg//eq deg//lt ($i.unwrap #$.Long) $i.LCMP]
)
(do-template [<name> <prepare> <transform>]
@@ -351,12 +337,9 @@
Unary
(|>> inputI <prepare> <transform>))]
- [nat//to-int id id]
- [nat//char ($i.unwrap #$.Long)
- ((|>> $i.L2I $i.I2C ($i.INVOKESTATIC "java.lang.Character" "toString" ($t.method (list $t.char) (#.Some $String) (list)) false)))]
-
- [int//to-nat id id]
[int//to-frac ($i.unwrap #$.Long) (<| ($i.wrap #$.Double) $i.L2D)]
+ [int//char ($i.unwrap #$.Long)
+ ((|>> $i.L2I $i.I2C ($i.INVOKESTATIC "java.lang.Character" "toString" ($t.method (list $t.char) (#.Some $String) (list)) false)))]
[frac//to-int ($i.unwrap #$.Double) (<| ($i.wrap #$.Long) $i.D2L)]
[frac//to-deg ($i.unwrap #$.Double)
@@ -623,22 +606,6 @@
(install "arithmetic-right-shift" (binary bit//arithmetic-right-shift))
)))
-(def: nat-procs
- Bundle
- (<| (prefix "nat")
- (|> (dict.new text.Hash<Text>)
- (install "+" (binary nat//add))
- (install "-" (binary nat//sub))
- (install "*" (binary nat//mul))
- (install "/" (binary nat//div))
- (install "%" (binary nat//rem))
- (install "=" (binary nat//eq))
- (install "<" (binary nat//lt))
- (install "min" (nullary nat//min))
- (install "max" (nullary nat//max))
- (install "to-int" (unary nat//to-int))
- (install "char" (unary nat//char)))))
-
(def: int-procs
Bundle
(<| (prefix "int")
@@ -652,8 +619,8 @@
(install "<" (binary int//lt))
(install "min" (nullary int//min))
(install "max" (nullary int//max))
- (install "to-nat" (unary int//to-nat))
- (install "to-frac" (unary int//to-frac)))))
+ (install "to-frac" (unary int//to-frac))
+ (install "char" (unary int//char)))))
(def: deg-procs
Bundle
@@ -782,7 +749,6 @@
(<| (prefix "lux")
(|> lux-procs
(dict.merge bit-procs)
- (dict.merge nat-procs)
(dict.merge int-procs)
(dict.merge deg-procs)
(dict.merge frac-procs)
diff --git a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
index b394a7f53..58ed736ab 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
@@ -167,94 +167,6 @@
$.Inst
($i.INVOKESTATIC hostL.runtime-class "force_text" ($t.method (list $Object) (#.Some $String) (list)) false))
-(def: nat-methods
- $.Def
- (let [compare-nat-method ($t.method (list $t.long $t.long) (#.Some $t.int) (list))
- less-thanI (function (_ @where) (|>> ($i.INVOKESTATIC hostL.runtime-class "compare_nat" compare-nat-method false) ($i.IFLT @where)))
- $BigInteger ($t.class "java.math.BigInteger" (list))
- upcast-method ($t.method (list $t.long) (#.Some $BigInteger) (list))
- div-method ($t.method (list $t.long $t.long) (#.Some $t.long) (list))
- upcastI ($i.INVOKESTATIC hostL.runtime-class "_toUnsignedBigInteger" upcast-method false)
- downcastI ($i.INVOKEVIRTUAL "java.math.BigInteger" "longValue" ($t.method (list) (#.Some $t.long) (list)) false)]
- (|>> ($d.method #$.Public $.staticM "_toUnsignedBigInteger" upcast-method
- (let [upcastI ($i.INVOKESTATIC "java.math.BigInteger" "valueOf" upcast-method false)
- discernI (function (_ @where) (|>> ($i.LLOAD +0) ($i.long 0) $i.LCMP ($i.IFGE @where)))
- prepare-upperI (|>> ($i.LLOAD +0) ($i.int 32) $i.LUSHR
- upcastI
- ($i.int 32) ($i.INVOKEVIRTUAL "java.math.BigInteger" "shiftLeft" ($t.method (list $t.int) (#.Some $BigInteger) (list)) false))
- prepare-lowerI (|>> ($i.LLOAD +0) ($i.int 32) $i.LSHL
- ($i.int 32) $i.LUSHR
- upcastI)]
- (<| $i.with-label (function (_ @simple))
- (|>> (discernI @simple)
- ## else
- prepare-upperI
- prepare-lowerI
- ($i.INVOKEVIRTUAL "java.math.BigInteger" "add" ($t.method (list $BigInteger) (#.Some $BigInteger) (list)) false)
- $i.ARETURN
- ## then
- ($i.label @simple)
- ($i.LLOAD +0)
- upcastI
- $i.ARETURN))))
- ($d.method #$.Public $.staticM "compare_nat" compare-nat-method
- (let [shiftI (|>> ($i.GETSTATIC "java.lang.Long" "MIN_VALUE" $t.long) $i.LADD)]
- (|>> ($i.LLOAD +0) shiftI
- ($i.LLOAD +2) shiftI
- $i.LCMP
- $i.IRETURN)))
- ($d.method #$.Public $.staticM "div_nat" div-method
- (let [is-param-largeI (function (_ @where) (|>> ($i.LLOAD +2) ($i.long 0) $i.LCMP ($i.IFLT @where)))
- is-subject-smallI (function (_ @where) (|>> ($i.LLOAD +0) ($i.long 0) $i.LCMP ($i.IFGT @where)))
- small-division (|>> ($i.LLOAD +0) ($i.LLOAD +2) $i.LDIV $i.LRETURN)
- big-divisionI ($i.INVOKEVIRTUAL "java.math.BigInteger" "divide" ($t.method (list $BigInteger) (#.Some $BigInteger) (list)) false)]
- (<| $i.with-label (function (_ @is-zero))
- $i.with-label (function (_ @param-is-large))
- $i.with-label (function (_ @subject-is-small))
- (|>> (is-param-largeI @param-is-large)
- ## Param is not too large
- (is-subject-smallI @subject-is-small)
- ## Param is small, but subject is large
- ($i.LLOAD +0) upcastI
- ($i.LLOAD +2) upcastI
- big-divisionI downcastI $i.LRETURN
- ## Both param and subject are small,
- ## and can thus be divided normally.
- ($i.label @subject-is-small)
- small-division
- ## Param is too large. Cannot simply divide.
- ## Depending on the result of the
- ## comparison, a result will be determined.
- ($i.label @param-is-large)
- ($i.LLOAD +0) ($i.LLOAD +2) (less-thanI @is-zero)
- ## Greater-than or equals
- ($i.long 1) $i.LRETURN
- ## Less than
- ($i.label @is-zero)
- ($i.long 0) $i.LRETURN))))
- ($d.method #$.Public $.staticM "rem_nat" div-method
- (let [is-subject-largeI (function (_ @where) (|>> ($i.LLOAD +0) ($i.long 0) $i.LCMP ($i.IFLE @where)))
- is-param-largeI (function (_ @where) (|>> ($i.LLOAD +2) ($i.long 0) $i.LCMP ($i.IFLE @where)))
- small-remainderI (|>> ($i.LLOAD +0) ($i.LLOAD +2) $i.LREM $i.LRETURN)
- big-remainderI ($i.INVOKEVIRTUAL "java.math.BigInteger" "remainder" ($t.method (list $BigInteger) (#.Some $BigInteger) (list)) false)]
- (<| $i.with-label (function (_ @large-number))
- $i.with-label (function (_ @subject-is-smaller-than-param))
- (|>> (is-subject-largeI @large-number)
- (is-param-largeI @large-number)
- small-remainderI
-
- ($i.label @large-number)
- ($i.LLOAD +0) ($i.LLOAD +2) (less-thanI @subject-is-smaller-than-param)
-
- ($i.LLOAD +0) upcastI
- ($i.LLOAD +2) upcastI
- big-remainderI downcastI $i.LRETURN
-
- ($i.label @subject-is-smaller-than-param)
- ($i.LLOAD +0)
- $i.LRETURN))))
- )))
-
(def: frac-shiftI $.Inst ($i.double (math.pow 32.0 2.0)))
(def: frac-methods
@@ -620,7 +532,6 @@
[_ (wrap [])
#let [bytecode ($d.class #$.V1_6 #$.Public $.finalC hostL.runtime-class (list) ["java.lang.Object" (list)] (list)
(|>> adt-methods
- nat-methods
frac-methods
deg-methods
text-methods
diff --git a/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux
index bdba05a9d..a9849b557 100644
--- a/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux
@@ -197,9 +197,6 @@
Nullary
(<encode> <const>))]
- [nat//min 0 lua.int]
- [nat//max -1 lua.int]
-
[frac//smallest Double::MIN_VALUE lua.float]
[frac//min (f/* -1.0 Double::MAX_VALUE) lua.float]
[frac//max Double::MAX_VALUE lua.float]
@@ -238,12 +235,6 @@
[int//div lua.//]
[int//rem lua.%]
- [nat//add lua.+]
- [nat//sub lua.-]
- [nat//mul lua.*]
- [nat//div runtimeT.nat///]
- [nat//rem runtimeT.nat//%]
-
[deg//add lua.+]
[deg//sub lua.-]
[deg//mul runtimeT.deg//*]
@@ -275,21 +266,10 @@
Binary
(<cmp> paramO subjectO))]
- [nat//= lua.=]
- [nat//< runtimeT.nat//<]
[int//= lua.=]
[int//< lua.<]
[deg//= lua.=]
- [deg//< runtimeT.nat//<]
- )
-
-(do-template [<name>]
- [(def: (<name> inputO)
- Unary
- inputO)]
-
- [nat//to-int]
- [int//to-nat]
+ [deg//< lua.<]
)
(def: frac//encode
@@ -320,7 +300,7 @@
[text//hash runtimeT.text//hash]
)
-(def: nat//char
+(def: int//char
Unary
(|>> (list) (lua.apply "string.char")))
@@ -466,22 +446,6 @@
(install "arithmetic-right-shift" (binary bit//arithmetic-right-shift))
)))
-(def: nat-procs
- Bundle
- (<| (prefix "nat")
- (|> (dict.new text.Hash<Text>)
- (install "+" (binary nat//add))
- (install "-" (binary nat//sub))
- (install "*" (binary nat//mul))
- (install "/" (binary nat//div))
- (install "%" (binary nat//rem))
- (install "=" (binary nat//=))
- (install "<" (binary nat//<))
- (install "min" (nullary nat//min))
- (install "max" (nullary nat//max))
- (install "to-int" (unary nat//to-int))
- (install "char" (unary nat//char)))))
-
(def: int-procs
Bundle
(<| (prefix "int")
@@ -495,8 +459,8 @@
(install "<" (binary int//<))
(install "min" (nullary int//min))
(install "max" (nullary int//max))
- (install "to-nat" (unary int//to-nat))
- (install "to-frac" (unary int//to-frac)))))
+ (install "to-frac" (unary int//to-frac))
+ (install "char" (unary int//char)))))
(def: deg-procs
Bundle
@@ -620,7 +584,6 @@
(<| (prefix "lux")
(|> lux-procs
(dict.merge bit-procs)
- (dict.merge nat-procs)
(dict.merge int-procs)
(dict.merge deg-procs)
(dict.merge frac-procs)
diff --git a/new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux
index 64253b1c3..cd5d0c090 100644
--- a/new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux
@@ -197,36 +197,6 @@
(format @@bit//count
@@bit//logical-right-shift))
-(runtime: (nat//< param subject)
- (lua.return! (lua.apply "math.ult" (list subject param))))
-
-(runtime: (nat/// param subject)
- (lua.if! (lua.< (lua.int 0) param)
- (lua.if! (nat//< param subject)
- (lua.return! (lua.int 0))
- (lua.return! (lua.int 1)))
- (lua.block! (list (lua.local! "quotient" (#.Some (|> subject
- (lua.bit-shr (lua.int 1))
- (lua.// param)
- (lua.bit-shl (lua.int 1)))))
- (lua.local! "remainder" (#.Some (lua.- (lua.* param "quotient")
- subject)))
- (lua.if! (lua.not (nat//< param "remainder"))
- (lua.return! (lua.+ (lua.int 1) "quotient"))
- (lua.return! "quotient"))))))
-
-(runtime: (nat//% param subject)
- (let [flat (|> subject
- (nat/// param)
- (lua.* param))]
- (lua.return! (lua.- flat subject))))
-
-(def: runtime//nat
- Runtime
- (format @@nat//<
- @@nat///
- @@nat//%))
-
(runtime: deg//low-mask
(|> (lua.int 1)
(lua.bit-shl (lua.int 32))
@@ -477,7 +447,6 @@
(format runtime//lux
runtime//adt
runtime//bit
- runtime//nat
runtime//deg
runtime//text
runtime//array
diff --git a/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux
index c201c417c..69b4aede4 100644
--- a/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux
@@ -228,9 +228,6 @@
Nullary
(<encode> <const>))]
- [nat//min 0 python.int]
- [nat//max -1 python.int]
-
[frac//smallest Double::MIN_VALUE python.float]
[frac//min (f/* -1.0 Double::MAX_VALUE) python.float]
[frac//max Double::MAX_VALUE python.float]
@@ -269,10 +266,6 @@
[int//sub python.-]
[int//mul python.*]
- [nat//add python.+]
- [nat//sub python.-]
- [nat//mul python.*]
-
[deg//add python.+]
[deg//sub python.-]
[deg//rem python.-]
@@ -288,9 +281,6 @@
[int//div python./]
[int//rem python.%]
- [nat//div runtimeT.nat///]
- [nat//rem runtimeT.nat//%]
-
[deg//mul runtimeT.deg//*]
[deg//div runtimeT.deg///]
[deg//reciprocal python./]
@@ -318,14 +308,11 @@
Binary
(<cmp> paramO subjectO))]
- [nat//= python.=]
- [nat//< runtimeT.nat//<]
-
[int//= python.=]
[int//< python.<]
[deg//= python.=]
- [deg//< runtimeT.nat//<]
+ [deg//< python.<]
)
(def: (apply1 func)
@@ -347,22 +334,6 @@
(python.global "float"))]
)
-(def: nat-procs
- Bundle
- (<| (prefix "nat")
- (|> (dict.new text.Hash<Text>)
- (install "+" (binary nat//add))
- (install "-" (binary nat//sub))
- (install "*" (binary nat//mul))
- (install "/" (binary nat//div))
- (install "%" (binary nat//rem))
- (install "=" (binary nat//=))
- (install "<" (binary nat//<))
- (install "min" (nullary nat//min))
- (install "max" (nullary nat//max))
- (install "to-int" (unary id))
- (install "char" (unary (apply1 (python.global "chr")))))))
-
(def: int-procs
Bundle
(<| (prefix "int")
@@ -376,8 +347,8 @@
(install "<" (binary int//<))
(install "min" (nullary int//min))
(install "max" (nullary int//max))
- (install "to-nat" (unary id))
- (install "to-frac" (unary (apply1 (python.global "float")))))))
+ (install "to-frac" (unary (apply1 (python.global "float"))))
+ (install "char" (unary (apply1 (python.global "chr")))))))
(def: deg-procs
Bundle
@@ -558,7 +529,6 @@
(<| (prefix "lux")
(|> lux-procs
(dict.merge bit-procs)
- (dict.merge nat-procs)
(dict.merge int-procs)
(dict.merge deg-procs)
(dict.merge frac-procs)
diff --git a/new-luxc/source/luxc/lang/translation/python/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/python/runtime.jvm.lux
index 65e864d91..3457cc49b 100644
--- a/new-luxc/source/luxc/lang/translation/python/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/python/runtime.jvm.lux
@@ -285,45 +285,6 @@
(def: high (-> Expression Expression) (bit//logical-right-shift (python.int 32)))
(def: low (-> Expression Expression) (python.bit-and full-32-bits))
-(runtime: (nat//< param subject)
- (with-vars [ph sh]
- ($_ python.then!
- (python.set! (list ph) (..high param))
- (python.set! (list sh) (..high subject))
- (python.return! (python.or (python.< (@@ ph) (@@ sh))
- (python.and (python.= (@@ ph) (@@ sh))
- (python.< (low param) (low subject))))))))
-
-(runtime: (nat/// param subject)
- (with-vars [quotient remainder]
- (python.if! (python.< (python.int 0) param)
- (python.if! (nat//< param subject)
- (python.return! (python.int 0))
- (python.return! (python.int 1)))
- ($_ python.then!
- (python.set! (list quotient) (|> subject
- (python.bit-shr (python.int 1))
- (python./ param)
- (python.bit-shl (python.int 1))))
- (let [remainder (python.- (python.* param (@@ quotient))
- subject)]
- (python.if! (python.not (nat//< param remainder))
- (python.return! (python.+ (python.int 1) (@@ quotient)))
- (python.return! (@@ quotient))))))))
-
-(runtime: (nat//% param subject)
- (let [flat (|> subject
- (nat/// param)
- (python.* param))]
- (python.return! (|> subject (python.- flat)))))
-
-(def: runtime//nat
- Runtime
- ($_ python.then!
- @@nat//<
- @@nat///
- @@nat//%))
-
(runtime: (deg//* param subject)
(with-vars [$sL $sH $pL $pH $bottom $middle $top]
($_ python.then!
@@ -561,7 +522,6 @@
runtime//lux
runtime//adt
runtime//bit
- runtime//nat
runtime//deg
runtime//frac
runtime//text
diff --git a/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux
index a9e661130..9554abc86 100644
--- a/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux
@@ -229,9 +229,6 @@
Nullary
<expression>)]
- [nat//min runtimeT.int//zero]
- [nat//max runtimeT.int//-one]
-
[int//min runtimeT.int//min]
[int//max runtimeT.int//max]
@@ -260,12 +257,6 @@
[int//div runtimeT.int///]
[int//rem runtimeT.int//%]
- [nat//add runtimeT.int//+]
- [nat//sub runtimeT.int//-]
- [nat//mul runtimeT.int//*]
- [nat//div runtimeT.nat///]
- [nat//rem runtimeT.nat//%]
-
[deg//add runtimeT.int//+]
[deg//sub runtimeT.int//-]
[deg//rem runtimeT.int//-]
@@ -297,14 +288,11 @@
Binary
(<cmp> paramO subjectO))]
- [nat//= runtimeT.int//=]
- [nat//< runtimeT.nat//<]
-
[int//= runtimeT.int//=]
[int//< runtimeT.int//<]
[deg//= runtimeT.int//=]
- [deg//< runtimeT.nat//<]
+ [deg//< runtimeT.int//<]
)
(def: (apply1 func)
@@ -312,23 +300,7 @@
(function (_ value)
(r.apply (list value) func)))
-(def: nat//char (|>> runtimeT.int64-low (apply1 (r.global "intToUtf8"))))
-
-(def: nat-procs
- Bundle
- (<| (prefix "nat")
- (|> (dict.new text.Hash<Text>)
- (install "+" (binary nat//add))
- (install "-" (binary nat//sub))
- (install "*" (binary nat//mul))
- (install "/" (binary nat//div))
- (install "%" (binary nat//rem))
- (install "=" (binary nat//=))
- (install "<" (binary nat//<))
- (install "min" (nullary nat//min))
- (install "max" (nullary nat//max))
- (install "to-int" (unary id))
- (install "char" (unary nat//char)))))
+(def: int//char (|>> runtimeT.int64-low (apply1 (r.global "intToUtf8"))))
(def: int-procs
Bundle
@@ -343,8 +315,8 @@
(install "<" (binary int//<))
(install "min" (nullary int//min))
(install "max" (nullary int//max))
- (install "to-nat" (unary id))
- (install "to-frac" (unary runtimeT.int//to-float)))))
+ (install "to-frac" (unary runtimeT.int//to-float))
+ (install "char" (unary int//char)))))
(def: deg-procs
Bundle
@@ -544,7 +516,6 @@
(<| (prefix "lux")
(|> lux-procs
(dict.merge bit-procs)
- (dict.merge nat-procs)
(dict.merge int-procs)
(dict.merge deg-procs)
(dict.merge frac-procs)
diff --git a/new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux
index 88b40bcca..70a9f62df 100644
--- a/new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux
@@ -664,83 +664,6 @@
@@bit//logical-right-shift
))
-(runtime: (nat//< param subject)
- (with-vars [pH sH]
- ($_ r.then
- (r.set! pH (..int64-high (@@ param)))
- (r.set! sH (..int64-high (@@ subject)))
- (let [lesser-high? (|> (@@ sH) (r.< (@@ pH)))
- equal-high? (|> (@@ sH) (r.= (@@ pH)))
- lesser-low? (|> (..int64-low (@@ subject)) (r.< (..int64-low (@@ param))))]
- (|> lesser-high?
- (r.or (|> equal-high?
- (r.and lesser-low?))))))))
-
-(runtime: (nat/// parameter subject)
- (let [negative? (int//< int//zero)
- valid-division-check [(|> (@@ parameter) (int//= int//zero))
- (r.stop (r.string "Cannot divide by zero!"))]
- short-circuit-check [(|> (@@ subject) (nat//< (@@ parameter)))
- int//zero]]
- (r.cond (list valid-division-check
- short-circuit-check
-
- [(|> (@@ parameter)
- (nat//< (|> (@@ subject) (bit//logical-right-shift (r.int 1)))))
- int//one])
- (with-vars [result remainder approximate log2 approximate-result approximate-remainder delta]
- ($_ r.then
- (r.set! result int//zero)
- (r.set! remainder (@@ subject))
- (r.while (|> (|> (@@ remainder) (nat//< (@@ parameter)))
- (r.or (|> (@@ remainder) (int//= (@@ parameter)))))
- (let [rough-estimate (r.apply (list (|> (int//to-float (@@ parameter)) (r./ (int//to-float (@@ remainder)))))
- (r.global "floor"))
- calculate-approximate-result (int//from-float (@@ approximate))
- calculate-approximate-remainder (int//* (@@ parameter) (@@ approximate-result))
- delta (r.if (|> (r.float 48.0) (r.<= (@@ log2)))
- (r.float 1.0)
- (r.** (|> (r.float 48.0) (r.- (@@ log2)))
- (r.float 2.0)))
- update-approximates! ($_ r.then
- (r.set! approximate-result calculate-approximate-result)
- (r.set! approximate-remainder calculate-approximate-remainder))]
- ($_ r.then
- (r.set! approximate (r.apply (list (r.float 1.0) rough-estimate)
- (r.global "max")))
- (r.set! log2 (let [log (function (_ input)
- (r.apply (list input) (r.global "log")))]
- (r.apply (list (|> (log (r.int 2))
- (r./ (log (@@ approximate)))))
- (r.global "ceil"))))
- update-approximates!
- (r.while (|> (negative? (@@ approximate-remainder))
- (r.or (|> (@@ approximate-remainder) (int//< (@@ remainder)))))
- ($_ r.then
- (r.set! approximate (|> delta (r.- (@@ approximate))))
- update-approximates!))
- ($_ r.then
- (r.set! result (|> (@@ result)
- (int//+ (r.if (|> (@@ approximate-result) (int//= int//zero))
- int//one
- (@@ approximate-result)))))
- (r.set! remainder (|> (@@ remainder) (int//- (@@ approximate-remainder))))))))
- (@@ result)))
- )))
-
-(runtime: (nat//% param subject)
- (let [flat (|> (@@ subject)
- (nat/// (@@ param))
- (int//* (@@ param)))]
- (|> (@@ subject) (int//- flat))))
-
-(def: runtime//nat
- Runtime
- ($_ r.then
- @@nat//<
- @@nat///
- @@nat//%))
-
(runtime: (deg//* param subject)
(with-vars [sL sH pL pH bottom middle top]
($_ r.then
@@ -1035,7 +958,6 @@
runtime//bit
runtime//int
runtime//adt
- runtime//nat
runtime//deg
runtime//frac
runtime//text
diff --git a/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux
index a13dae50b..e38dfff28 100644
--- a/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux
@@ -233,9 +233,6 @@
Nullary
(<encode> <const>))]
- [nat//min 0 ruby.int]
- [nat//max -1 ruby.int]
-
[frac//smallest Double::MIN_VALUE ruby.float]
[frac//min (f/* -1.0 Double::MAX_VALUE) ruby.float]
[frac//max Double::MAX_VALUE ruby.float]
@@ -282,12 +279,6 @@
[int//div ruby./]
[int//rem ruby.%]
- [nat//add ruby.+]
- [nat//sub ruby.-]
- [nat//mul ruby.*]
- [nat//div runtimeT.nat///]
- [nat//rem runtimeT.nat//%]
-
[deg//add ruby.+]
[deg//sub ruby.-]
[deg//mul runtimeT.deg//*]
@@ -319,21 +310,10 @@
Binary
(<cmp> paramO subjectO))]
- [nat//= ruby.=]
- [nat//< runtimeT.nat//<]
[int//= ruby.=]
[int//< ruby.<]
[deg//= ruby.=]
- [deg//< runtimeT.nat//<])
-
-(do-template [<name>]
- [(def: (<name> inputO)
- Unary
- inputO)]
-
- [nat//to-int]
- [int//to-nat]
- )
+ [deg//< ruby.<])
(def: frac//encode
Unary
@@ -370,26 +350,6 @@
[frac//to-deg runtimeT.deg//from-frac]
)
-(def: nat//char
- Unary
- (ruby.send "chr" (list)))
-
-(def: nat-procs
- Bundle
- (<| (prefix "nat")
- (|> (dict.new text.Hash<Text>)
- (install "+" (binary nat//add))
- (install "-" (binary nat//sub))
- (install "*" (binary nat//mul))
- (install "/" (binary nat//div))
- (install "%" (binary nat//rem))
- (install "=" (binary nat//=))
- (install "<" (binary nat//<))
- (install "min" (nullary nat//min))
- (install "max" (nullary nat//max))
- (install "to-int" (unary nat//to-int))
- (install "char" (unary nat//char)))))
-
(def: int-procs
Bundle
(<| (prefix "int")
@@ -403,8 +363,8 @@
(install "<" (binary int//<))
(install "min" (nullary int//min))
(install "max" (nullary int//max))
- (install "to-nat" (unary int//to-nat))
- (install "to-frac" (unary int//to-frac)))))
+ (install "to-frac" (unary int//to-frac))
+ (install "char" (unary (ruby.send "chr" (list)))))))
(def: deg-procs
Bundle
@@ -647,7 +607,6 @@
(<| (prefix "lux")
(|> lux-procs
(dict.merge bit-procs)
- (dict.merge nat-procs)
(dict.merge int-procs)
(dict.merge deg-procs)
(dict.merge frac-procs)
diff --git a/new-luxc/source/luxc/lang/translation/ruby/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/runtime.jvm.lux
index c3f2981e1..7f66b0cd5 100644
--- a/new-luxc/source/luxc/lang/translation/ruby/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/ruby/runtime.jvm.lux
@@ -181,40 +181,6 @@
(def: high (-> Expression Expression) (bit//logical-right-shift (ruby.int 32)))
(def: low (-> Expression Expression) (ruby.bit-and "0xFFFFFFFF"))
-(runtime: (nat//< param subject)
- (ruby.block! (list (ruby.set! (list "ph") (high param))
- (ruby.set! (list "sh") (high subject))
- (ruby.return! (ruby.or (ruby.< "ph" "sh")
- (ruby.and (ruby.= "ph" "sh")
- (ruby.< (low param) (low subject))))))))
-
-(runtime: (nat/// param subject)
- (ruby.if! (ruby.< (ruby.int 0) param)
- (ruby.if! (nat//< param subject)
- (ruby.return! (ruby.int 0))
- (ruby.return! (ruby.int 1)))
- (ruby.block! (list (ruby.set! (list "quotient") (|> subject
- (ruby.bit-shr (ruby.int 1))
- (ruby./ param)
- (ruby.bit-shl (ruby.int 1))))
- (ruby.set! (list "remainder") (ruby.- (ruby.* param "quotient")
- subject))
- (ruby.if! (ruby.not (nat//< param "remainder"))
- (ruby.return! (ruby.+ (ruby.int 1) "quotient"))
- (ruby.return! "quotient"))))))
-
-(runtime: (nat//% param subject)
- (let [flat (|> subject
- (nat/// param)
- (ruby.* param))]
- (ruby.return! (ruby.- flat subject))))
-
-(def: runtime//nat
- Runtime
- (format @@nat//<
- @@nat///
- @@nat//%))
-
(runtime: (deg//* param subject)
(ruby.block! (list (ruby.set! (list "sL") (low subject))
(ruby.set! (list "sH") (high subject))
@@ -366,7 +332,6 @@
(format runtime//lux "\n"
runtime//adt "\n"
runtime//bit "\n"
- runtime//nat "\n"
runtime//deg "\n"
runtime//text "\n"
runtime//array "\n"
diff --git a/new-luxc/source/luxc/lang/translation/scheme/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/scheme/procedure/common.jvm.lux
index cd828e082..67ec0e95c 100644
--- a/new-luxc/source/luxc/lang/translation/scheme/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/scheme/procedure/common.jvm.lux
@@ -235,9 +235,6 @@
Nullary
(_.int <expression>))]
- [nat//min 0]
- [nat//max -1]
-
[int//min ("lux int min")]
[int//max ("lux int max")]
@@ -266,12 +263,6 @@
[int//div _.quotient]
[int//rem _.remainder]
- [nat//add _.+]
- [nat//sub _.-]
- [nat//mul _.*]
- [nat//div runtimeT.nat///]
- [nat//rem runtimeT.nat//%]
-
[deg//add _.+]
[deg//sub _.-]
[deg//rem _.-]
@@ -303,14 +294,11 @@
Binary
(<cmp> paramO subjectO))]
- [nat//= _.=]
- [nat//< runtimeT.nat//<]
-
[int//= _.=]
[int//< _.<]
[deg//= _.=]
- [deg//< runtimeT.nat//<]
+ [deg//< _.<]
)
(def: deg//to-frac
@@ -321,25 +309,9 @@
(_./ f2^32)
(_./ (_.float 1.0)))))
-(def: nat//char (|>> (_.apply1 (_.global "integer->char"))
+(def: int//char (|>> (_.apply1 (_.global "integer->char"))
(_.apply1 (_.global "string"))))
-(def: nat-procs
- Bundle
- (<| (prefix "nat")
- (|> (dict.new text.Hash<Text>)
- (install "+" (binary nat//add))
- (install "-" (binary nat//sub))
- (install "*" (binary nat//mul))
- (install "/" (binary nat//div))
- (install "%" (binary nat//rem))
- (install "=" (binary nat//=))
- (install "<" (binary nat//<))
- (install "min" (nullary nat//min))
- (install "max" (nullary nat//max))
- (install "to-int" (unary id))
- (install "char" (unary nat//char)))))
-
(def: int-procs
Bundle
(<| (prefix "int")
@@ -353,8 +325,8 @@
(install "<" (binary int//<))
(install "min" (nullary int//min))
(install "max" (nullary int//max))
- (install "to-nat" (unary id))
- (install "to-frac" (unary (|>> (_./ (_.float 1.0))))))))
+ (install "to-frac" (unary (|>> (_./ (_.float 1.0)))))
+ (install "char" (unary int//char)))))
(def: deg-procs
Bundle
@@ -519,7 +491,6 @@
(<| (prefix "lux")
(|> lux-procs
(dict.merge bit-procs)
- (dict.merge nat-procs)
(dict.merge int-procs)
(dict.merge deg-procs)
(dict.merge frac-procs)
diff --git a/new-luxc/source/luxc/lang/translation/scheme/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/scheme/runtime.jvm.lux
index 09259c2b9..e8016eb0a 100644
--- a/new-luxc/source/luxc/lang/translation/scheme/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/scheme/runtime.jvm.lux
@@ -239,43 +239,6 @@
(def: int-high (bit//logical-right-shift (_.int 32)))
(def: int-low (_.bit-and (_.int (hex "FFFFFFFF"))))
-(runtime: (nat//< param subject)
- (with-vars [pH sH]
- (_.let (list [pH (int-high (@@ param))]
- [sH (int-high (@@ subject))])
- (_.or (list (_.< (@@ pH) (@@ sH))
- (_.and (list (_.= (@@ pH) (@@ sH))
- (_.< (int-low (@@ param)) (int-low (@@ subject))))))))))
-
-(runtime: (nat/// param subject)
- (_.if (_.< (_.int 0) (@@ param))
- (_.if (nat//< (@@ param) (@@ subject))
- (_.int 0)
- (_.int 1))
- (with-vars [quotient]
- (_.let (list [quotient (|> (@@ subject)
- (bit//logical-right-shift (_.int 1))
- (_.quotient (@@ param))
- (_.arithmetic-shift (_.int 1)))])
- (let [remainder (_.- (_.* (@@ param) (@@ quotient))
- (@@ subject))]
- (_.if (_.not (nat//< (@@ param) remainder))
- (_.+ (_.int 1) (@@ quotient))
- (@@ quotient)))))))
-
-(runtime: (nat//% param subject)
- (let [flat (|> (@@ subject)
- (nat/// (@@ param))
- (_.* (@@ param)))]
- (|> (@@ subject) (_.- flat))))
-
-(def: runtime//nat
- Runtime
- (_.begin
- (list @@nat//<
- @@nat///
- @@nat//%)))
-
(runtime: (frac//to-deg input)
(with-vars [two32 shifted]
(_.let* (list [two32 (|> (_.float 2.0) (_.expt (_.float 32.0)))]
@@ -405,7 +368,6 @@
runtime//lux
runtime//bit
runtime//adt
- runtime//nat
runtime//frac
## runtime//text
runtime//array
diff --git a/new-luxc/test/test/luxc/lang/analysis/procedure/common.lux b/new-luxc/test/test/luxc/lang/analysis/procedure/common.lux
index 9cd456f5d..632a798e3 100644
--- a/new-luxc/test/test/luxc/lang/analysis/procedure/common.lux
+++ b/new-luxc/test/test/luxc/lang/analysis/procedure/common.lux
@@ -80,36 +80,6 @@
(check-success+ "lux bit arithmetic-right-shift" (list signedC paramC) Int))
))))
-(context: "Nat procedures"
- (<| (times +100)
- (do @
- [subjectC (|> r.nat (:: @ map code.nat))
- paramC (|> r.nat (:: @ map code.nat))]
- ($_ seq
- (test "Can add natural numbers."
- (check-success+ "lux nat +" (list subjectC paramC) Nat))
- (test "Can subtract natural numbers."
- (check-success+ "lux nat -" (list subjectC paramC) Nat))
- (test "Can multiply natural numbers."
- (check-success+ "lux nat *" (list subjectC paramC) Nat))
- (test "Can divide natural numbers."
- (check-success+ "lux nat /" (list subjectC paramC) Nat))
- (test "Can calculate remainder of natural numbers."
- (check-success+ "lux nat %" (list subjectC paramC) Nat))
- (test "Can test equality of natural numbers."
- (check-success+ "lux nat =" (list subjectC paramC) Bool))
- (test "Can compare natural numbers."
- (check-success+ "lux nat <" (list subjectC paramC) Bool))
- (test "Can obtain minimum natural number."
- (check-success+ "lux nat min" (list) Nat))
- (test "Can obtain maximum natural number."
- (check-success+ "lux nat max" (list) Nat))
- (test "Can convert natural number to integer."
- (check-success+ "lux nat to-int" (list subjectC) Int))
- (test "Can convert natural number to text."
- (check-success+ "lux nat char" (list subjectC) Text))
- ))))
-
(context: "Int procedures"
(<| (times +100)
(do @
@@ -138,6 +108,8 @@
(check-success+ "lux int to-nat" (list subjectC) Nat))
(test "Can convert integer to frac number."
(check-success+ "lux int to-frac" (list subjectC) Frac))
+ (test "Can convert integer to text."
+ (check-success+ "lux int char" (list subjectC) Text))
))))
(context: "Deg procedures"
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 6bec61741..6e6397eeb 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -867,6 +867,11 @@
#Nil])]))))
(record$ #Nil))
+("lux def" export-meta
+ ("lux check" (#Product Code Code)
+ [(tag$ ["lux" "export?"]) (bool$ true)])
+ (record$ #Nil))
+
("lux def" export?-meta
("lux check" Code
(flag-meta "export?"))
@@ -893,6 +898,11 @@
(#Cons tail #Nil))))))
(record$ #Nil))
+("lux def" doc-meta
+ ("lux check" (#Function Text (#Product Code Code))
+ (function'' [doc] [(tag$ ["lux" "doc"]) (text$ doc)]))
+ (record$ #Nil))
+
("lux def" def:''
("lux check" Macro
(function'' [tokens]
@@ -1104,6 +1114,36 @@
syntax})
)
+(def:'' (n/+ param subject)
+ (#.Cons (doc-meta "Nat(ural) addition.")
+ (#.Cons export-meta
+ #.Nil))
+ (#Function Nat (#Function Nat Nat))
+ ("lux coerce" Nat
+ ("lux int +"
+ ("lux coerce" Int subject)
+ ("lux coerce" Int param))))
+
+(def:'' (n/- param subject)
+ (#.Cons (doc-meta "Nat(ural) substraction.")
+ (#.Cons export-meta
+ #.Nil))
+ (#Function Nat (#Function Nat Nat))
+ ("lux coerce" Nat
+ ("lux int -"
+ ("lux coerce" Int subject)
+ ("lux coerce" Int param))))
+
+(def:'' (n/* param subject)
+ (#.Cons (doc-meta "Nat(ural) multiplication.")
+ (#.Cons export-meta
+ #.Nil))
+ (#Function Nat (#Function Nat Nat))
+ ("lux coerce" Nat
+ ("lux int *"
+ ("lux coerce" Int subject)
+ ("lux coerce" Int param))))
+
(def:'' (update-bounds code)
#Nil
(#Function Code Code)
@@ -1119,7 +1159,7 @@
pairs))
[_ (#Form (#Cons [_ (#Tag "lux" "Bound")] (#Cons [_ (#Nat idx)] #Nil)))]
- (form$ (#Cons (tag$ ["lux" "Bound"]) (#Cons (nat$ ("lux nat +" +2 idx)) #Nil)))
+ (form$ (#Cons (tag$ ["lux" "Bound"]) (#Cons (nat$ (n/+ +2 idx)) #Nil)))
[_ (#Form members)]
(form$ (list/map update-bounds members))
@@ -1170,7 +1210,7 @@
#Nil
(#UnivQ #Nil
(#Function ($' List (#Bound +1)) Nat))
- (list/fold (function'' [_ acc] ("lux nat +" +1 acc)) +0 list))
+ (list/fold (function'' [_ acc] (n/+ +1 acc)) +0 list))
(macro:' #export (All tokens)
(#Cons [(tag$ ["lux" "doc"])
@@ -1209,10 +1249,7 @@
body'
[false _]
- (replace-syntax (#Cons [self-name (make-bound ("lux nat *"
- +2 ("lux nat -"
- (list/size names)
- +1)))]
+ (replace-syntax (#Cons [self-name (make-bound (n/* +2 (n/- +1 (list/size names))))]
#Nil)
body')})
#Nil)))))
@@ -1260,10 +1297,7 @@
body'
[false _]
- (replace-syntax (#Cons [self-name (make-bound ("lux nat *"
- +2 ("lux nat -"
- (list/size names)
- +1)))]
+ (replace-syntax (#Cons [self-name (make-bound (n/* +2 (n/- +1 (list/size names))))]
#Nil)
body')})
#Nil)))))
@@ -2163,6 +2197,73 @@
(-> (-> a Bool) ($' List a) Bool))
(list/fold (function' [_2 _1] (if _1 (p _2) false)) true xs))
+(def:''' #export (n/= test subject)
+ (list [(tag$ ["lux" "doc"])
+ (text$ "Nat(ural) equality.")])
+ (-> Nat Nat Bool)
+ ("lux int ="
+ ("lux coerce" Int subject)
+ ("lux coerce" Int test)))
+
+(def:''' (high-bits value)
+ (list)
+ (-> Nat Int)
+ ("lux coerce" Int ("lux bit logical-right-shift" value +32)))
+
+(def:''' low-mask
+ (list)
+ Nat
+ ("lux coerce" Nat
+ ("lux int -"
+ ("lux coerce" Int
+ ("lux bit left-shift" +1 +32))
+ 1)))
+
+(def:''' (low-bits value)
+ (list)
+ (-> Nat Int)
+ ("lux coerce" Int ("lux bit and" value low-mask)))
+
+(def:''' #export (n/< test subject)
+ (list [(tag$ ["lux" "doc"])
+ (text$ "Nat(ural) less-than.")])
+ (-> Nat Nat Bool)
+ (let' [testH (high-bits test)
+ subjectH (high-bits subject)]
+ (if ("lux int <" subjectH testH)
+ true
+ (if ("lux int =" subjectH testH)
+ ("lux int <"
+ (low-bits subject)
+ (low-bits test))
+ false))))
+
+(def:''' #export (n/<= test subject)
+ (list [(tag$ ["lux" "doc"])
+ (text$ "Nat(ural) less-than-equal.")])
+ (-> Nat Nat Bool)
+ (if (n/< test subject)
+ true
+ ("lux int ="
+ ("lux coerce" Int subject)
+ ("lux coerce" Int test))))
+
+(def:''' #export (n/> test subject)
+ (list [(tag$ ["lux" "doc"])
+ (text$ "Nat(ural) greater-than.")])
+ (-> Nat Nat Bool)
+ (n/< subject test))
+
+(def:''' #export (n/>= test subject)
+ (list [(tag$ ["lux" "doc"])
+ (text$ "Nat(ural) greater-than-equal.")])
+ (-> Nat Nat Bool)
+ (if (n/< subject test)
+ true
+ ("lux int ="
+ ("lux coerce" Int subject)
+ ("lux coerce" Int test))))
+
(macro:' #export (do-template tokens)
(list [(tag$ ["lux" "doc"])
(text$ "## By specifying a pattern (with holes), and the input data to fill those holes, repeats the pattern as many times as necessary.
@@ -2181,7 +2282,7 @@
(let' [apply ("lux check" (-> RepEnv ($' List Code))
(function' [env] (list/map (apply-template env) templates)))
num-bindings (list/size bindings')]
- (if (every? (function' [sample] ("lux nat =" num-bindings sample))
+ (if (every? (n/= num-bindings)
(list/map list/size data'))
(|> data'
(join-map (compose apply (make-env bindings')))
@@ -2231,9 +2332,6 @@
true
(<eq-proc> subject test)))]
- [ Nat "lux nat =" "lux nat <" n/= n/< n/<= n/> n/>=
- "Nat(ural) equality." "Nat(ural) less-than." "Nat(ural) less-than-equal." "Nat(ural) greater-than." "Nat(ural) greater-than-equal."]
-
[ Int "lux int =" "lux int <" i/= i/< i/<= i/> i/>=
"Int(eger) equality." "Int(eger) less-than." "Int(eger) less-than-equal." "Int(eger) greater-than." "Int(eger) greater-than-equal."]
@@ -2244,6 +2342,48 @@
"Frac(tion) equality." "Frac(tion) less-than." "Frac(tion) less-than-equal." "Frac(tion) greater-than." "Frac(tion) greater-than-equal."]
)
+(def:''' #export (n// param subject)
+ (list [(tag$ ["lux" "doc"])
+ (text$ "Nat(ural) division.")])
+ (-> Nat Nat Nat)
+ (if ("lux int <" ("lux coerce" Int param) 0)
+ (if (n/< param subject)
+ +0
+ +1)
+ (let' [quotient ("lux bit left-shift"
+ ("lux coerce" Nat
+ ("lux int /"
+ ("lux coerce" Int
+ ("lux bit logical-right-shift"
+ subject
+ +1))
+ ("lux coerce" Int param)))
+ +1)
+ remainder ("lux coerce" Nat
+ ("lux int -"
+ ("lux coerce" Int subject)
+ ("lux int *"
+ ("lux coerce" Int quotient)
+ ("lux coerce" Int param))))]
+ (if (n/< param remainder)
+ quotient
+ ("lux coerce" Nat
+ ("lux int +"
+ ("lux coerce" Int quotient)
+ 1))))))
+
+(def:''' #export (n/% param subject)
+ (list [(tag$ ["lux" "doc"])
+ (text$ "Nat(ural) remainder.")])
+ (-> Nat Nat Nat)
+ (let' [flat ("lux int *"
+ ("lux coerce" Int (n// param subject))
+ ("lux coerce" Int param))]
+ ("lux coerce" Nat
+ ("lux int -"
+ ("lux coerce" Int subject)
+ flat))))
+
(do-template [<type> <name> <op> <doc>]
[(def:''' #export (<name> param subject)
(list [(tag$ ["lux" "doc"])
@@ -2251,12 +2391,6 @@
(-> <type> <type> <type>)
(<op> subject param))]
- [ Nat n/+ "lux nat +" "Nat(ural) addition."]
- [ Nat n/- "lux nat -" "Nat(ural) substraction."]
- [ Nat n/* "lux nat *" "Nat(ural) multiplication."]
- [ Nat n// "lux nat /" "Nat(ural) division."]
- [ Nat n/% "lux nat %" "Nat(ural) remainder."]
-
[ Int i/+ "lux int +" "Int(eger) addition."]
[ Int i/- "lux int -" "Int(eger) substraction."]
[ Int i/* "lux int *" "Int(eger) multiplication."]
@@ -2305,8 +2439,8 @@
[d/min Deg d/< "Deg(ree) minimum."]
[d/max Deg d/> "Deg(ree) maximum."]
- [f/min Frac f/< "Frac minimum."]
- [f/max Frac f/> "Frac minimum."]
+ [f/min Frac f/< "Frac(tion) minimum."]
+ [f/max Frac f/> "Frac(tion) minimum."]
)
(def:''' (bool/encode x)
@@ -5069,13 +5203,20 @@
(-> Ident Text)
(|>> ident/encode (text/compose "#")))
+(do-template [<name> <from> <to>]
+ [(def: #export <name>
+ (-> <from> <to>)
+ (|>> (:! <to>)))]
+
+ [int-to-nat Int Nat]
+ [nat-to-int Nat Int]
+ )
+
(do-template [<name> <op> <from> <to>]
[(def: #export (<name> input)
(-> <from> <to>)
(<op> input))]
- [int-to-nat "lux int to-nat" Int Nat]
- [nat-to-int "lux nat to-int" Nat Int]
[frac-to-deg "lux frac to-deg" Frac Deg]
[deg-to-frac "lux deg to-frac" Deg Frac]
)
diff --git a/stdlib/source/lux/data/coll/queue/priority.lux b/stdlib/source/lux/data/coll/queue/priority.lux
index 833d3b3e1..970cb9cc9 100644
--- a/stdlib/source/lux/data/coll/queue/priority.lux
+++ b/stdlib/source/lux/data/coll/queue/priority.lux
@@ -3,7 +3,7 @@
(lux (control [eq #+ Eq]
[monad #+ do Monad])
(data (coll (tree ["F" finger]))
- [number]
+ [number "nat/" Interval<Nat>]
[maybe])))
(type: #export Priority Nat)
@@ -11,8 +11,8 @@
(type: #export (Queue a)
(Maybe (F.Fingers Priority a)))
-(def: max-priority Priority ("lux nat max"))
-(def: min-priority Priority ("lux nat min"))
+(def: #export max Priority nat/top)
+(def: #export min Priority nat/bottom)
(def: #export empty
Queue
diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux
index c784e81ef..bd1d34cad 100644
--- a/stdlib/source/lux/data/number.lux
+++ b/stdlib/source/lux/data/number.lux
@@ -103,7 +103,7 @@
(def: top <top>)
(def: bottom <bottom>))]
- [ Nat Enum<Nat> ("lux nat max") ("lux nat min")]
+ [ Nat Enum<Nat> ("lux coerce" Nat -1) +0]
[ Int Enum<Int> ("lux int max") ("lux int min")]
[Frac Enum<Frac> ("lux frac max") ("lux frac min")]
[ Deg Enum<Deg> ("lux deg max") ("lux deg min")]
diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux
index 90f9bec02..1a9aa112b 100644
--- a/stdlib/source/lux/data/text.lux
+++ b/stdlib/source/lux/data/text.lux
@@ -207,9 +207,9 @@
(-> Text Text Text)
(enclose [boundary boundary] content))
-(def: #export (from-code code)
+(def: #export from-code
(-> Nat Text)
- ("lux nat char" code))
+ (|>> (:! Int) "lux int char"))
(def: #export (space? char)
{#.doc "Checks whether the character is white-space."}