diff options
Diffstat (limited to '')
| -rw-r--r-- | luxc/src/lux/compiler/jvm/proc/common.clj | 105 | ||||
| -rw-r--r-- | luxc/src/lux/compiler/jvm/rt.clj | 102 |
2 files changed, 161 insertions, 46 deletions
diff --git a/luxc/src/lux/compiler/jvm/proc/common.clj b/luxc/src/lux/compiler/jvm/proc/common.clj index c48403e52..01048fd98 100644 --- a/luxc/src/lux/compiler/jvm/proc/common.clj +++ b/luxc/src/lux/compiler/jvm/proc/common.clj @@ -265,6 +265,16 @@ ^:private compile-real-lt Opcodes/DCMPG -1 &&/unwrap-double ) +(defn ^:private compile-real-hash [compile ?values special-args] + (|do [:let [(&/$Cons ?input (&/$Nil)) ?values] + ^MethodVisitor *writer* &/get-writer + _ (compile ?input) + :let [_ (doto *writer* + &&/unwrap-double + (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Double" "doubleToRawLongBits" "(D)J") + &&/wrap-long)]] + (return nil))) + (do-template [<name> <cmp-output>] (defn <name> [compile ?values special-args] (|do [:let [(&/$Cons ?x (&/$Cons ?y (&/$Nil))) ?values] @@ -328,8 +338,18 @@ ^:private compile-nat-min-value (.visitLdcInsn 0) &&/wrap-long ^:private compile-nat-max-value (.visitLdcInsn -1) &&/wrap-long + ^:private compile-int-min-value (.visitLdcInsn Long/MIN_VALUE) &&/wrap-long + ^:private compile-int-max-value (.visitLdcInsn Long/MAX_VALUE) &&/wrap-long + ^:private compile-deg-min-value (.visitLdcInsn 0) &&/wrap-long ^:private compile-deg-max-value (.visitLdcInsn -1) &&/wrap-long + + ^:private compile-real-min-value (.visitLdcInsn (* -1.0 Double/MAX_VALUE)) &&/wrap-double + ^:private compile-real-max-value (.visitLdcInsn Double/MAX_VALUE) &&/wrap-double + + ^:private compile-real-not-a-number (.visitLdcInsn Double/NaN) &&/wrap-double + ^:private compile-real-positive-infinity (.visitLdcInsn Double/POSITIVE_INFINITY) &&/wrap-double + ^:private compile-real-negative-infinity (.visitLdcInsn Double/NEGATIVE_INFINITY) &&/wrap-double ) (do-template [<encode-name> <encode-method> <decode-name> <decode-method>] @@ -356,23 +376,34 @@ ^:private compile-deg-encode "encode_deg" ^:private compile-deg-decode "decode_deg" ) -(defn ^:private compile-int-encode [compile ?values special-args] - (|do [:let [(&/$Cons ?x (&/$Nil)) ?values] - ^MethodVisitor *writer* &/get-writer - _ (compile ?x) - :let [_ (doto *writer* - &&/unwrap-long - (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Long" "toString" "(J)Ljava/lang/String;"))]] - (return nil))) +(do-template [<name> <class> <signature> <unwrap>] + (defn <name> [compile ?values special-args] + (|do [:let [(&/$Cons ?input (&/$Nil)) ?values] + ^MethodVisitor *writer* &/get-writer + _ (compile ?input) + :let [_ (doto *writer* + <unwrap> + (.visitMethodInsn Opcodes/INVOKESTATIC <class> "toString" <signature>))]] + (return nil))) + + ^:private compile-int-encode "java/lang/Long" "(J)Ljava/lang/String;" &&/unwrap-long + ^:private compile-real-encode "java/lang/Double" "(D)Ljava/lang/String;" &&/unwrap-double + ) -(defn ^:private compile-real-encode [compile ?values special-args] - (|do [:let [(&/$Cons ?x (&/$Nil)) ?values] - ^MethodVisitor *writer* &/get-writer - _ (compile ?x) - :let [_ (doto *writer* - &&/unwrap-double - (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Double" "toString" "(D)Ljava/lang/String;"))]] - (return nil))) + +(do-template [<name> <method>] + (defn <name> [compile ?values special-args] + (|do [:let [(&/$Cons ?input (&/$Nil)) ?values] + ^MethodVisitor *writer* &/get-writer + _ (compile ?input) + :let [_ (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST "java/lang/String") + (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" <method> "(Ljava/lang/String;)[Ljava/lang/Object;"))]] + (return nil))) + + ^:private compile-int-decode "decode_int" + ^:private compile-real-decode "decode_real" + ) (do-template [<name> <method>] (defn <name> [compile ?values special-args] @@ -565,13 +596,32 @@ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "replace" "(Ljava/lang/CharSequence;Ljava/lang/CharSequence;)Ljava/lang/String;"))]] (return nil))) -(defn ^:private compile-text-trim [compile ?values special-args] - (|do [:let [(&/$Cons ?text (&/$Nil)) ?values] +(do-template [<name> <method>] + (defn <name> [compile ?values special-args] + (|do [:let [(&/$Cons ?text (&/$Nil)) ?values] + ^MethodVisitor *writer* &/get-writer + _ (compile ?text) + :let [_ (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST "java/lang/String") + (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" <method> "()Ljava/lang/String;"))]] + (return nil))) + + ^:private compile-text-trim "trim" + ^:private compile-text-upper-case "toUpperCase" + ^:private compile-text-lower-case "toLowerCase" + ) + +(defn ^:private compile-text-char [compile ?values special-args] + (|do [:let [(&/$Cons ?text (&/$Cons ?idx (&/$Nil))) ?values] ^MethodVisitor *writer* &/get-writer _ (compile ?text) :let [_ (doto *writer* - (.visitTypeInsn Opcodes/CHECKCAST "java/lang/String") - (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "trim" "()Ljava/lang/String;"))]] + (.visitTypeInsn Opcodes/CHECKCAST "java/lang/String"))] + _ (compile ?idx) + :let [_ (doto *writer* + &&/unwrap-long + (.visitInsn Opcodes/L2I) + (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "text_char" "(Ljava/lang/String;I)[Ljava/lang/Object;"))]] (return nil))) (defn compile-io-log [compile ?values special-args] @@ -620,6 +670,9 @@ "size" (compile-text-size compile ?values special-args) "replace-all" (compile-text-replace-all compile ?values special-args) "trim" (compile-text-trim compile ?values special-args) + "upper-case" (compile-text-upper-case compile ?values special-args) + "lower-case" (compile-text-lower-case compile ?values special-args) + "char" (compile-text-char compile ?values special-args) ) "bit" @@ -683,9 +736,12 @@ "%" (compile-int-rem compile ?values special-args) "=" (compile-int-eq compile ?values special-args) "<" (compile-int-lt compile ?values special-args) + "max-value" (compile-int-max-value compile ?values special-args) + "min-value" (compile-int-min-value compile ?values special-args) "to-nat" (compile-int-to-nat compile ?values special-args) "to-real" (compile-int-to-real compile ?values special-args) "encode" (compile-int-encode compile ?values special-args) + "decode" (compile-int-decode compile ?values special-args) ) "real" @@ -697,9 +753,16 @@ "%" (compile-real-rem compile ?values special-args) "=" (compile-real-eq compile ?values special-args) "<" (compile-real-lt compile ?values special-args) - "encode" (compile-real-encode compile ?values special-args) + "hash" (compile-real-hash compile ?values special-args) + "max-value" (compile-real-max-value compile ?values special-args) + "min-value" (compile-real-min-value compile ?values special-args) + "not-a-number" (compile-real-not-a-number compile ?values special-args) + "positive-infinity" (compile-real-positive-infinity compile ?values special-args) + "negative-infinity" (compile-real-negative-infinity compile ?values special-args) "to-int" (compile-real-to-int compile ?values special-args) "to-deg" (compile-real-to-deg compile ?values special-args) + "encode" (compile-real-encode compile ?values special-args) + "decode" (compile-real-decode compile ?values special-args) ) "char" diff --git a/luxc/src/lux/compiler/jvm/rt.clj b/luxc/src/lux/compiler/jvm/rt.clj index 303d9ae0a..7f193a1cd 100644 --- a/luxc/src/lux/compiler/jvm/rt.clj +++ b/luxc/src/lux/compiler/jvm/rt.clj @@ -1160,6 +1160,34 @@ (.visitEnd)))] nil))) +(do-template [<name> <method> <class> <parse-method> <signature> <wrapper>] + (defn <name> [^ClassWriter =class] + (do (let [$from (new Label) + $to (new Label) + $handler (new Label)] + (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) <method> "(Ljava/lang/String;)[Ljava/lang/Object;" nil nil) + (.visitCode) + (.visitTryCatchBlock $from $to $handler "java/lang/Exception") + (.visitLabel $from) + (.visitVarInsn Opcodes/ALOAD 0) + (.visitMethodInsn Opcodes/INVOKESTATIC <class> <parse-method> <signature>) + <wrapper> + (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_some" "(Ljava/lang/Object;)Ljava/lang/Object;") + (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;") + (.visitInsn Opcodes/ARETURN) + (.visitLabel $to) + (.visitLabel $handler) + (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_none" "()Ljava/lang/Object;") + (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;") + (.visitInsn Opcodes/ARETURN) + (.visitMaxs 0 0) + (.visitEnd))) + nil)) + + ^:private compile-LuxRT-int-methods "decode_int" "java/lang/Long" "parseLong" "(Ljava/lang/String;)J" &&/wrap-long + ^:private compile-LuxRT-real-methods "decode_real" "java/lang/Double" "parseDouble" "(Ljava/lang/String;)D" &&/wrap-double + ) + (defn ^:private compile-LuxRT-pm-methods [^ClassWriter =class] (|let [_ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "pm_fail" "()V" nil nil) (.visitCode) @@ -1205,31 +1233,53 @@ nil)) (defn ^:private compile-LuxRT-text-methods [^ClassWriter =class] - (|do [:let [_ (let [$from (new Label) - $to (new Label) - $handler (new Label) - $end (new Label)] - (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "text_clip" "(Ljava/lang/String;II)[Ljava/lang/Object;" nil nil) - (.visitCode) - (.visitTryCatchBlock $from $to $handler "java/lang/IndexOutOfBoundsException") - (.visitLabel $from) - (.visitVarInsn Opcodes/ALOAD 0) - (.visitVarInsn Opcodes/ILOAD 1) - (.visitVarInsn Opcodes/ILOAD 2) - (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "substring" "(II)Ljava/lang/String;") - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_some" "(Ljava/lang/Object;)Ljava/lang/Object;") - (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;") - (.visitJumpInsn Opcodes/GOTO $end) - (.visitLabel $to) - (.visitLabel $handler) - (.visitInsn Opcodes/POP) - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_none" "()Ljava/lang/Object;") - (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;") - (.visitLabel $end) - (.visitInsn Opcodes/ARETURN) - (.visitMaxs 0 0) - (.visitEnd)))]] - (return nil))) + (do (let [$from (new Label) + $to (new Label) + $handler (new Label) + $end (new Label)] + (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "text_clip" "(Ljava/lang/String;II)[Ljava/lang/Object;" nil nil) + (.visitCode) + (.visitTryCatchBlock $from $to $handler "java/lang/IndexOutOfBoundsException") + (.visitLabel $from) + (.visitVarInsn Opcodes/ALOAD 0) + (.visitVarInsn Opcodes/ILOAD 1) + (.visitVarInsn Opcodes/ILOAD 2) + (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "substring" "(II)Ljava/lang/String;") + (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_some" "(Ljava/lang/Object;)Ljava/lang/Object;") + (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;") + (.visitJumpInsn Opcodes/GOTO $end) + (.visitLabel $to) + (.visitLabel $handler) + (.visitInsn Opcodes/POP) + (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_none" "()Ljava/lang/Object;") + (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;") + (.visitLabel $end) + (.visitInsn Opcodes/ARETURN) + (.visitMaxs 0 0) + (.visitEnd))) + (let [$from (new Label) + $to (new Label) + $handler (new Label)] + (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "text_char" "(Ljava/lang/String;I)[Ljava/lang/Object;" nil nil) + (.visitCode) + (.visitTryCatchBlock $from $to $handler "java/lang/IndexOutOfBoundsException") + (.visitLabel $from) + (.visitVarInsn Opcodes/ALOAD 0) + (.visitVarInsn Opcodes/ILOAD 1) + (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "charAt" "(I)C") + &&/wrap-char + (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_some" "(Ljava/lang/Object;)Ljava/lang/Object;") + (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;") + (.visitInsn Opcodes/ARETURN) + (.visitLabel $to) + (.visitLabel $handler) + (.visitInsn Opcodes/POP) + (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_none" "()Ljava/lang/Object;") + (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;") + (.visitInsn Opcodes/ARETURN) + (.visitMaxs 0 0) + (.visitEnd))) + nil)) (def compile-LuxRT-class (|do [_ (return nil) @@ -1291,7 +1341,9 @@ (compile-LuxRT-pm-methods) (compile-LuxRT-adt-methods) (compile-LuxRT-nat-methods) + (compile-LuxRT-int-methods) (compile-LuxRT-deg-methods) + (compile-LuxRT-real-methods) (compile-LuxRT-text-methods))]] (&&/save-class! (second (string/split &&/lux-utils-class #"/")) (.toByteArray (doto =class .visitEnd))))) |