diff options
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."} |