From fb72b937aba7886ce204379e97aa06c327a4029f Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 6 May 2018 23:27:12 -0400 Subject: - Implemented Nat functionality in pure Lux. --- luxc/src/lux/analyser/proc/common.clj | 49 +++-------- luxc/src/lux/compiler/jvm/proc/common.clj | 100 +++------------------- luxc/src/lux/compiler/jvm/rt.clj | 133 ------------------------------ 3 files changed, 24 insertions(+), 258 deletions(-) (limited to 'luxc') 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 ) (&/|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 ) (&/|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 [ ] @@ -271,10 +260,7 @@ (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ) (&/|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 [ ] - (defn [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" "(JJ)J") - (&&/wrap-long))]] - (return nil))) - - ^:private compile-nat-div "div_nat" - ^:private compile-nat-rem "rem_nat" - ) - (do-template [ ] (defn [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 [ ] (defn [compile ?values special-args] (|do [:let [(&/$Nil) ?values] @@ -334,9 +287,6 @@ )]] (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 [] - (defn [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 [ ] (defn [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 [ ] (defn [^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) -- cgit v1.2.3