aboutsummaryrefslogtreecommitdiff
path: root/luxc
diff options
context:
space:
mode:
authorEduardo Julian2018-05-07 01:37:38 -0400
committerEduardo Julian2018-05-07 01:37:38 -0400
commitfebfa99c2823219c2e76d2c73b1fd8db8f6c9918 (patch)
treef521419a80b04f465c6c9c5020c2063e2e555895 /luxc
parent3e2fddc6bfdda56dbe6947c476f85760b0811654 (diff)
- Implemented Deg functionality in pure Lux.
Diffstat (limited to '')
-rw-r--r--luxc/src/lux/analyser/proc/common.clj42
-rw-r--r--luxc/src/lux/compiler/jvm/proc/common.clj88
-rw-r--r--luxc/src/lux/compiler/jvm/rt.clj166
3 files changed, 0 insertions, 296 deletions
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 [<name> <proc>]
- (defn <name> [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 <proc>) (&/|list =x =y) (&/|list)))))))
-
- ^:private analyse-deg-scale ["deg" "scale"]
- ^:private analyse-deg-reciprocal ["deg" "reciprocal"]
- )
-
(do-template [<encode> <encode-op> <decode> <decode-op> <type>]
(do (defn <encode> [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 [<name> <cmp-output>]
- (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)
- $then (new Label)
- $end (new Label)
- _ (doto *writer*
- (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "_compareUnsigned" "(JJ)I")
- (.visitLdcInsn (int <cmp-output>))
- (.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 [<name> <instr> <wrapper>]
(defn <name> [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 [<name> <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)]
- :let [_ (doto *writer*
- (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" <method> "(JJ)J")
- &&/wrap-long)]]
- (return nil)))
-
- ^:private compile-deg-mul "mul_deg"
- ^:private compile-deg-div "div_deg"
- )
-
-(do-template [<name> <class> <method> <sig> <unwrap> <wrap>]
- (let [+wrapper-class+ (&host-generics/->bytecode-class-name <class>)]
- (defn <name> [compile ?values special-args]
- (|do [:let [(&/$Cons ?x (&/$Nil)) ?values]
- ^MethodVisitor *writer* &/get-writer
- _ (compile ?x)
- :let [_ (doto *writer*
- <unwrap>
- (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" <method> <sig>)
- <wrap>)]]
- (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 [<name> <method> <class> <parse-method> <signature> <wrapper>]
(defn <name> [^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))]]