From febfa99c2823219c2e76d2c73b1fd8db8f6c9918 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 7 May 2018 01:37:38 -0400 Subject: - Implemented Deg functionality in pure Lux. --- luxc/src/lux/analyser/proc/common.clj | 42 -------- luxc/src/lux/compiler/jvm/proc/common.clj | 88 ---------------- luxc/src/lux/compiler/jvm/rt.clj | 166 ------------------------------ 3 files changed, 296 deletions(-) (limited to 'luxc/src') diff --git a/luxc/src/lux/analyser/proc/common.clj b/luxc/src/lux/analyser/proc/common.clj index 3606fab8b..93e83c2a2 100644 --- a/luxc/src/lux/analyser/proc/common.clj +++ b/luxc/src/lux/analyser/proc/common.clj @@ -177,14 +177,6 @@ ^:private analyse-int-eq ["int" "="] &type/Int &type/Bool ^:private analyse-int-lt ["int" "<"] &type/Int &type/Bool - ^:private analyse-deg-add ["deg" "+"] &type/Deg &type/Deg - ^:private analyse-deg-sub ["deg" "-"] &type/Deg &type/Deg - ^:private analyse-deg-mul ["deg" "*"] &type/Deg &type/Deg - ^:private analyse-deg-div ["deg" "/"] &type/Deg &type/Deg - ^:private analyse-deg-rem ["deg" "%"] &type/Deg &type/Deg - ^:private analyse-deg-eq ["deg" "="] &type/Deg &type/Bool - ^:private analyse-deg-lt ["deg" "<"] &type/Deg &type/Bool - ^:private analyse-frac-add ["frac" "+"] &type/Frac &type/Frac ^:private analyse-frac-sub ["frac" "-"] &type/Frac &type/Frac ^:private analyse-frac-mul ["frac" "*"] &type/Frac &type/Frac @@ -194,20 +186,6 @@ ^:private analyse-frac-lt ["frac" "<"] &type/Frac &type/Bool ) -(do-template [ ] - (defn [analyse exo-type ?values] - (|do [:let [(&/$Cons x (&/$Cons y (&/$Nil))) ?values] - =x (&&/analyse-1 analyse &type/Deg x) - =y (&&/analyse-1 analyse &type/Nat y) - _ (&type/check exo-type &type/Deg) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor - (&&/$proc (&/T ) (&/|list =x =y) (&/|list))))))) - - ^:private analyse-deg-scale ["deg" "scale"] - ^:private analyse-deg-reciprocal ["deg" "reciprocal"] - ) - (do-template [ ] (do (defn [analyse exo-type ?values] (|do [:let [(&/$Cons x (&/$Nil)) ?values] @@ -240,9 +218,6 @@ ^: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-frac-smallest &type/Frac ["frac" "smallest"] ^:private analyse-frac-min &type/Frac ["frac" "min"] ^:private analyse-frac-max &type/Frac ["frac" "max"] @@ -265,9 +240,6 @@ ^:private analyse-int-to-frac &type/Int &type/Frac ["int" "to-frac"] ^:private analyse-frac-to-int &type/Frac &type/Int ["frac" "to-int"] - ^:private analyse-deg-to-frac &type/Deg &type/Frac ["deg" "to-frac"] - ^:private analyse-frac-to-deg &type/Frac &type/Deg ["frac" "to-deg"] - ^:private analyse-io-log &type/Text &type/Top ["io" "log"] ^:private analyse-io-error &type/Text &type/Bottom ["io" "error"] ^:private analyse-io-exit &type/Int &type/Bottom ["io" "exit"] @@ -511,19 +483,6 @@ "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) - "lux deg *" (analyse-deg-mul analyse exo-type ?values) - "lux deg /" (analyse-deg-div analyse exo-type ?values) - "lux deg %" (analyse-deg-rem analyse exo-type ?values) - "lux deg =" (analyse-deg-eq analyse exo-type ?values) - "lux deg <" (analyse-deg-lt analyse exo-type ?values) - "lux deg min" (analyse-deg-min analyse exo-type ?values) - "lux deg max" (analyse-deg-max analyse exo-type ?values) - "lux deg to-frac" (analyse-deg-to-frac analyse exo-type ?values) - "lux deg scale" (analyse-deg-scale analyse exo-type ?values) - "lux deg reciprocal" (analyse-deg-reciprocal analyse exo-type ?values) - "lux frac +" (analyse-frac-add analyse exo-type ?values) "lux frac -" (analyse-frac-sub analyse exo-type ?values) "lux frac *" (analyse-frac-mul analyse exo-type ?values) @@ -539,7 +498,6 @@ "lux frac not-a-number" (analyse-frac-not-a-number analyse exo-type ?values) "lux frac positive-infinity" (analyse-frac-positive-infinity analyse exo-type ?values) "lux frac negative-infinity" (analyse-frac-negative-infinity analyse exo-type ?values) - "lux frac to-deg" (analyse-frac-to-deg analyse exo-type ?values) "lux frac to-int" (analyse-frac-to-int analyse exo-type ?values) "lux math cos" (analyse-math-cos 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 b79ceb3ae..018ccf55d 100644 --- a/luxc/src/lux/compiler/jvm/proc/common.clj +++ b/luxc/src/lux/compiler/jvm/proc/common.clj @@ -208,12 +208,6 @@ ^:private compile-int-div Opcodes/LDIV &&/unwrap-long &&/wrap-long ^:private compile-int-rem Opcodes/LREM &&/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 - ^:private compile-deg-scale Opcodes/LMUL &&/unwrap-long &&/wrap-long - ^:private compile-deg-reciprocal Opcodes/LDIV &&/unwrap-long &&/wrap-long - ^:private compile-frac-add Opcodes/DADD &&/unwrap-double &&/wrap-double ^:private compile-frac-sub Opcodes/DSUB &&/unwrap-double &&/wrap-double ^:private compile-frac-mul Opcodes/DMUL &&/unwrap-double &&/wrap-double @@ -251,33 +245,6 @@ ^:private compile-frac-lt Opcodes/DCMPG -1 &&/unwrap-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) - $then (new Label) - $end (new Label) - _ (doto *writer* - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "_compareUnsigned" "(JJ)I") - (.visitLdcInsn (int )) - (.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))) - - ^:private compile-deg-eq 0 - ^:private compile-deg-lt -1 - ) - (do-template [ ] (defn [compile ?values special-args] (|do [:let [(&/$Nil) ?values] @@ -290,9 +257,6 @@ ^:private compile-int-min (.visitLdcInsn Long/MIN_VALUE) &&/wrap-long ^:private compile-int-max (.visitLdcInsn Long/MAX_VALUE) &&/wrap-long - ^:private compile-deg-min (.visitLdcInsn 0) &&/wrap-long - ^:private compile-deg-max (.visitLdcInsn -1) &&/wrap-long - ^:private compile-frac-smallest (.visitLdcInsn Double/MIN_VALUE) &&/wrap-double ^:private compile-frac-min (.visitLdcInsn (* -1.0 Double/MAX_VALUE)) &&/wrap-double ^:private compile-frac-max (.visitLdcInsn Double/MAX_VALUE) &&/wrap-double @@ -330,41 +294,6 @@ ^:private compile-frac-decode "decode_frac" ) -(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)] - :let [_ (doto *writer* - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "(JJ)J") - &&/wrap-long)]] - (return nil))) - - ^:private compile-deg-mul "mul_deg" - ^:private compile-deg-div "div_deg" - ) - -(do-template [ ] - (let [+wrapper-class+ (&host-generics/->bytecode-class-name )] - (defn [compile ?values special-args] - (|do [:let [(&/$Cons ?x (&/$Nil)) ?values] - ^MethodVisitor *writer* &/get-writer - _ (compile ?x) - :let [_ (doto *writer* - - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" ) - )]] - (return nil)))) - - ^:private compile-deg-to-frac "java.lang.Long" "deg-to-frac" "(J)D" &&/unwrap-long &&/wrap-double - ^:private compile-frac-to-deg "java.lang.Double" "frac-to-deg" "(D)J" &&/unwrap-double &&/wrap-long - ) - (defn ^:private compile-int-char [compile ?values special-args] (|do [:let [(&/$Cons ?x (&/$Nil)) ?values] ^MethodVisitor *writer* &/get-writer @@ -787,22 +716,6 @@ "remove" (compile-array-remove compile ?values special-args) "size" (compile-array-size compile ?values special-args)) - "deg" - (case proc - "+" (compile-deg-add compile ?values special-args) - "-" (compile-deg-sub compile ?values special-args) - "*" (compile-deg-mul compile ?values special-args) - "/" (compile-deg-div compile ?values special-args) - "%" (compile-deg-rem compile ?values special-args) - "=" (compile-deg-eq compile ?values special-args) - "<" (compile-deg-lt compile ?values special-args) - "max" (compile-deg-max compile ?values special-args) - "min" (compile-deg-min compile ?values special-args) - "to-frac" (compile-deg-to-frac compile ?values special-args) - "scale" (compile-deg-scale compile ?values special-args) - "reciprocal" (compile-deg-reciprocal compile ?values special-args) - ) - "int" (case proc "+" (compile-int-add compile ?values special-args) @@ -834,7 +747,6 @@ "positive-infinity" (compile-frac-positive-infinity compile ?values special-args) "negative-infinity" (compile-frac-negative-infinity compile ?values special-args) "to-int" (compile-frac-to-int compile ?values special-args) - "to-deg" (compile-frac-to-deg compile ?values special-args) "encode" (compile-frac-encode compile ?values special-args) "decode" (compile-frac-decode compile ?values special-args) ) diff --git a/luxc/src/lux/compiler/jvm/rt.clj b/luxc/src/lux/compiler/jvm/rt.clj index dfd60b6a0..da5917e3b 100644 --- a/luxc/src/lux/compiler/jvm/rt.clj +++ b/luxc/src/lux/compiler/jvm/rt.clj @@ -292,30 +292,6 @@ (.visitEnd)))] nil)) -(defn ^:private low-4b [^MethodVisitor =method] - (doto =method - ;; Assume there is a long at the top of the stack... - ;; Add mask corresponding to -1 (FFFF...), on the low 32 bits. - (.visitLdcInsn (int -1)) - (.visitInsn Opcodes/I2L) - ;; Then do a bitwise and. - (.visitInsn Opcodes/LAND) - )) - -(defn ^:private high-4b [^MethodVisitor =method] - (doto =method - ;; Assume there is a long at the top of the stack... - (.visitLdcInsn (int 32)) - (.visitInsn Opcodes/LUSHR) - )) - -(defn ^:private swap2 [^MethodVisitor =method] - (doto =method - ;; X2, Y2 - (.visitInsn Opcodes/DUP2_X2) ;; Y2, X2, Y2 - (.visitInsn Opcodes/POP2) ;; Y2, X2 - )) - (defn ^:private swap2x1 [^MethodVisitor =method] (doto =method ;; X1, Y2 @@ -323,147 +299,6 @@ (.visitInsn Opcodes/POP2) ;; Y2, X1 )) -(defn ^:private bit-set-64? [^MethodVisitor =method] - (doto =method - ;; L, I - (.visitLdcInsn (long 1)) ;; L, I, L - (.visitInsn Opcodes/DUP2_X1) ;; L, L, I, L - (.visitInsn Opcodes/POP2) ;; L, L, I - (.visitInsn Opcodes/LSHL) ;; L, L - (.visitInsn Opcodes/LAND) ;; L - (.visitLdcInsn (long 0)) ;; L, L - (.visitInsn Opcodes/LCMP) ;; I - )) - -(defn ^:private compile-LuxRT-deg-methods [^ClassWriter =class] - (|let [deg-bits 64 - _ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "mul_deg" "(JJ)J" nil nil) - ;; Based on: http://stackoverflow.com/a/31629280/6823464 - (.visitCode) - ;; Bottom part - (.visitVarInsn Opcodes/LLOAD 0) low-4b - (.visitVarInsn Opcodes/LLOAD 2) low-4b - (.visitInsn Opcodes/LMUL) - (.visitLdcInsn (int 32)) - (.visitInsn Opcodes/LUSHR) - ;; Middle part - (.visitVarInsn Opcodes/LLOAD 0) high-4b - (.visitVarInsn Opcodes/LLOAD 2) low-4b - (.visitInsn Opcodes/LMUL) - (.visitVarInsn Opcodes/LLOAD 0) low-4b - (.visitVarInsn Opcodes/LLOAD 2) high-4b - (.visitInsn Opcodes/LMUL) - (.visitInsn Opcodes/LADD) - ;; Join middle and bottom - (.visitInsn Opcodes/LADD) - (.visitLdcInsn (int 32)) - (.visitInsn Opcodes/LUSHR) - ;; Top part - (.visitVarInsn Opcodes/LLOAD 0) high-4b - (.visitVarInsn Opcodes/LLOAD 2) high-4b - (.visitInsn Opcodes/LMUL) - ;; Join top with rest - (.visitInsn Opcodes/LADD) - ;; Return - (.visitInsn Opcodes/LRETURN) - (.visitMaxs 0 0) - (.visitEnd)) - _ (let [$loop-start (new Label) - $done (new Label)] - (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "count_leading_zeros" "(J)I" nil nil) - (.visitCode) - (.visitLdcInsn (int 64)) - (.visitLabel $loop-start) - (.visitVarInsn Opcodes/LLOAD 0) - (.visitLdcInsn (long 0)) - (.visitInsn Opcodes/LCMP) - (.visitJumpInsn Opcodes/IFEQ $done) - (.visitVarInsn Opcodes/LLOAD 0) - (.visitLdcInsn (int 1)) - (.visitInsn Opcodes/LUSHR) - (.visitVarInsn Opcodes/LSTORE 0) - (.visitLdcInsn (int 1)) - (.visitInsn Opcodes/ISUB) - (.visitJumpInsn Opcodes/GOTO $loop-start) - (.visitLabel $done) - (.visitInsn Opcodes/IRETURN) - (.visitMaxs 0 0) - (.visitEnd))) - _ (let [$same (new Label)] - (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "div_deg" "(JJ)J" nil nil) - (.visitCode) - (.visitVarInsn Opcodes/LLOAD 0) - (.visitVarInsn Opcodes/LLOAD 2) - (.visitInsn Opcodes/LCMP) - (.visitJumpInsn Opcodes/IFEQ $same) - ;; Based on: http://stackoverflow.com/a/8510587/6823464 - ;; Shifting the operands as much as possible can help - ;; avoid some loss of precision later. - (.visitVarInsn Opcodes/LLOAD 0) - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "count_leading_zeros" "(J)I") - (.visitVarInsn Opcodes/LLOAD 2) - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "count_leading_zeros" "(J)I") - (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Math" "min" "(II)I") - (.visitVarInsn Opcodes/ISTORE 4) - (.visitVarInsn Opcodes/LLOAD 0) (.visitVarInsn Opcodes/ILOAD 4) (.visitInsn Opcodes/LSHL) - (.visitVarInsn Opcodes/LLOAD 2) (.visitVarInsn Opcodes/ILOAD 4) (.visitInsn Opcodes/LSHL) high-4b - (.visitInsn Opcodes/LDIV) - (.visitLdcInsn (int 32)) - (.visitInsn Opcodes/LSHL) - (.visitInsn Opcodes/LRETURN) - (.visitLabel $same) - (.visitLdcInsn (long -1)) ;; ~= 1.0 DEG - (.visitInsn Opcodes/LRETURN) - (.visitMaxs 0 0) - (.visitEnd))) - _ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "deg-to-frac" "(J)D" nil nil) - (.visitCode) - ;; Translate high bytes - (.visitVarInsn Opcodes/LLOAD 0) high-4b - (.visitInsn Opcodes/L2D) - (.visitLdcInsn (double (Math/pow 2 32))) - (.visitInsn Opcodes/DDIV) - ;; Translate low bytes - (.visitVarInsn Opcodes/LLOAD 0) low-4b - (.visitInsn Opcodes/L2D) - (.visitLdcInsn (double (Math/pow 2 32))) - (.visitInsn Opcodes/DDIV) - (.visitLdcInsn (double (Math/pow 2 32))) - (.visitInsn Opcodes/DDIV) - ;; Combine and return - (.visitInsn Opcodes/DADD) - (.visitInsn Opcodes/DRETURN) - (.visitMaxs 0 0) - (.visitEnd)) - _ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "frac-to-deg" "(D)J" nil nil) - (.visitCode) - ;; Drop any excess - (.visitVarInsn Opcodes/DLOAD 0) - (.visitLdcInsn (double 1.0)) - (.visitInsn Opcodes/DREM) - ;; Shift upper half, but retain remaining decimals - (.visitLdcInsn (double (Math/pow 2 32))) - (.visitInsn Opcodes/DMUL) - ;; Make a copy, so the lower half can be extracted - (.visitInsn Opcodes/DUP2) - ;; Get that lower half - (.visitLdcInsn (double 1.0)) - (.visitInsn Opcodes/DREM) - (.visitLdcInsn (double (Math/pow 2 32))) - (.visitInsn Opcodes/DMUL) - ;; Turn it into a deg - (.visitInsn Opcodes/D2L) - ;; Turn the upper half into deg too - swap2 - (.visitInsn Opcodes/D2L) - ;; Combine both pieces - (.visitInsn Opcodes/LADD) - ;; FINISH - (.visitInsn Opcodes/LRETURN) - (.visitMaxs 0 0) - (.visitEnd))] - nil)) - (do-template [ ] (defn [^ClassWriter =class] (do (let [$from (new Label) @@ -755,7 +590,6 @@ (compile-LuxRT-pm-methods) (compile-LuxRT-adt-methods) (compile-LuxRT-int-methods) - (compile-LuxRT-deg-methods) (compile-LuxRT-frac-methods) (compile-LuxRT-text-methods) (compile-LuxRT-process-methods))]] -- cgit v1.2.3