diff options
Diffstat (limited to '')
| -rw-r--r-- | src/lux/analyser.clj | 38 | ||||
| -rw-r--r-- | src/lux/compiler.clj | 70 | ||||
| -rw-r--r-- | test2.lux | 88 |
3 files changed, 113 insertions, 83 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index 07d3fb3b7..6f9573f4c 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -423,6 +423,36 @@ (return full-name) (fail "Unknown class.")))]))) +(defn full-class [class] + ;; (prn 'full-class-name class) + (case class + "boolean" (return Boolean/TYPE) + "byte" (return Byte/TYPE) + "short" (return Short/TYPE) + "int" (return Integer/TYPE) + "long" (return Long/TYPE) + "float" (return Float/TYPE) + "double" (return Double/TYPE) + "char" (return Character/TYPE) + ;; else + (if (.contains class ".") + (return class) + (try-all-m [(exec [=class (resolve class) + ;; :let [_ (prn '=class =class)] + ] + (match (:form =class) + [::class ?full-name] + (return (Class/forName ?full-name)) + _ + (fail "Unknown class."))) + (let [full-name* (str "java.lang." class)] + (if-let [full-name (try (Class/forName full-name*) + full-name* + (catch Exception e + nil))] + (return (Class/forName full-name)) + (fail "Unknown class.")))])))) + (defanalyser analyse-jvm-getstatic [::&parser/form ([[::&parser/ident "jvm/getstatic"] [::&parser/ident ?class] [::&parser/ident ?field]] :seq)] (exec [=class (full-class-name ?class) @@ -433,14 +463,14 @@ [::&parser/form ([[::&parser/ident "jvm/invokevirtual"] [::&parser/ident ?class] [::&parser/text ?method] [::&parser/tuple ?classes] ?object [::&parser/tuple ?args]] :seq)] (exec [=class (full-class-name ?class) =classes (map-m #(exec [class* (extract-ident %)] - (full-class-name class*)) + (full-class class*)) ?classes) - =return (lookup-virtual-method (Class/forName =class) ?method (map #(Class/forName %) =classes)) - ;; :let [_ (prn 'analyse-jvm-invokevirtual '=return =return)] + =return (lookup-virtual-method (Class/forName =class) ?method =classes) + :let [_ (prn 'analyse-jvm-invokevirtual ?class ?method =classes '-> =return)] ;; =return =return =object (analyse-form* ?object) =args (map-m analyse-form* ?args)] - (return (annotated [::jvm-invokevirtual =class ?method =classes =object =args] =return)))) + (return (annotated [::jvm-invokevirtual =class ?method (map #(.getName %) =classes) =object =args] =return)))) ;; (defanalyser analyse-access ;; [::&parser/access ?object ?member] diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index ae8c75aa0..76f3efb54 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -71,6 +71,14 @@ (defn ^:private ->type-signature [class] (case class "Void" "V" + "boolean" "Z" + "byte" "B" + "short" "S" + "int" "I" + "long" "J" + "float" "F" + "double" "D" + "char" "C" ;; else (str "L" (->class class) ";"))) @@ -85,6 +93,12 @@ [::&type/primitive "boolean"] "Z" + [::&type/primitive "int"] + "I" + + [::&type/primitive "char"] + "C" + [::&type/object ?name []] (->type-signature ?name) @@ -164,7 +178,10 @@ (do ;; (prn 'CAPTURED [?scope ?captured-id]) (doto *writer* (.visitVarInsn Opcodes/ALOAD 0) - (.visitFieldInsn Opcodes/GETFIELD (apply str (interpose "$" ?scope)) (str "__" ?captured-id) "Ljava/lang/Object;")))) + (.visitFieldInsn Opcodes/GETFIELD + (apply str (interpose "$" (map (comp normalize-ident str) ?scope))) + (str "__" ?captured-id) + "Ljava/lang/Object;")))) (defcompiler ^:private compile-global [::&analyser/global ?owner-class ?name] @@ -259,7 +276,9 @@ (.visitInsn Opcodes/ACONST_NULL))) )) -(let [boolean-class "java.lang.Boolean"] +(let [boolean-class "java.lang.Boolean" + integer-class "java.lang.Integer" + char-class "java.lang.Character"] (defcompiler ^:private compile-jvm-invokevirtual [::&analyser/jvm-invokevirtual ?class ?method ?classes ?object ?args] (let [_ (prn 'compile-jvm-invokevirtual [?class ?method ?classes] '-> *type*) @@ -268,12 +287,52 @@ (.visitTypeInsn *writer* Opcodes/CHECKCAST (->class ?class)) (doseq [[class-name arg] (map vector ?classes ?args)] (do (compile-form (assoc *state* :form arg)) - (.visitTypeInsn *writer* Opcodes/CHECKCAST (->class class-name)))) + (condp = class-name + "boolean" (let [wrapper-class (->class "java.lang.Boolean")] + (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST wrapper-class) + (.visitMethodInsn Opcodes/INVOKEVIRTUAL wrapper-class "booleanValue" "()Z"))) + "byte" (let [wrapper-class (->class "java.lang.Byte")] + (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST wrapper-class) + (.visitMethodInsn Opcodes/INVOKEVIRTUAL wrapper-class "byteValue" "()B"))) + "short" (let [wrapper-class (->class "java.lang.Short")] + (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST wrapper-class) + (.visitMethodInsn Opcodes/INVOKEVIRTUAL wrapper-class "shortValue" "()S"))) + "int" (let [wrapper-class (->class "java.lang.Integer")] + (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST wrapper-class) + (.visitMethodInsn Opcodes/INVOKEVIRTUAL wrapper-class "intValue" "()I"))) + "long" (let [wrapper-class (->class "java.lang.Long")] + (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST wrapper-class) + (.visitMethodInsn Opcodes/INVOKEVIRTUAL wrapper-class "longValue" "()J"))) + "float" (let [wrapper-class (->class "java.lang.Float")] + (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST wrapper-class) + (.visitMethodInsn Opcodes/INVOKEVIRTUAL wrapper-class "floatValue" "()F"))) + "double" (let [wrapper-class (->class "java.lang.Double")] + (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST wrapper-class) + (.visitMethodInsn Opcodes/INVOKEVIRTUAL wrapper-class "doubleValue" "()D"))) + "char" (let [wrapper-class (->class "java.lang.Character")] + (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST wrapper-class) + (.visitMethodInsn Opcodes/INVOKEVIRTUAL wrapper-class "charValue" "()C"))) + ;; else + (.visitTypeInsn *writer* Opcodes/CHECKCAST (->class class-name))))) (.visitMethodInsn *writer* Opcodes/INVOKEVIRTUAL (->class ?class) ?method method-sig) (match *type* ::&type/nothing (.visitInsn *writer* Opcodes/ACONST_NULL) + [::&type/primitive "char"] + (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (->class char-class) "valueOf" (str "(C)" (->type-signature char-class))) + + [::&type/primitive "int"] + (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (->class integer-class) "valueOf" (str "(I)" (->type-signature integer-class))) + [::&type/primitive "boolean"] (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (->class boolean-class) "valueOf" (str "(Z)" (->type-signature boolean-class))) @@ -790,12 +849,13 @@ [::&analyser/lambda ?scope ?frame ?args ?body] (let [_ (prn '[?scope ?frame] ?scope ?frame ?args) num-args (count ?args) - outer-class (->class *class-name*) + ;; outer-class (->class *class-name*) clo-field-sig (->type-signature "java.lang.Object") counter-sig "I" apply-signature "(Ljava/lang/Object;)Ljava/lang/Object;" real-signature (str "(" (apply str (repeat num-args clo-field-sig)) ")" "Ljava/lang/Object;") - current-class (apply str (interpose "$" ?scope)) + ;; current-class (apply str (interpose "$" ?scope)) + current-class (apply str (interpose "$" (map (comp normalize-ident str) ?scope))) num-captured (dec num-args) init-signature (str "(" (apply str (repeat (->> (:mappings ?frame) (map (comp :form second)) @@ -339,17 +339,21 @@ #Nil (#Cons from (range (inc from) to)))) +(def (text->list text) + (let length (jvm/invokevirtual String "length" [] + text []) + (map (lambda [idx] + (jvm/invokevirtual String "charAt" [int] + text [idx])) + (range 0 length)))) + +(def (normalize-ident ident) + (fold concat "" (map normalize-char (text->list ident)))) + #( - (def (text->list text) - (let length (jvm/invokevirtual String "length" [] - text []) - (map (lambda [idx] - (jvm/invokevirtual String "charAt" [int] - text [idx])) - (range-to 0 length)))) + - (def (normalize-ident ident) - (fold concat "" (map normalize-char (text->list ident)))) + (def (fresh-class-loader path) (let file (jvm/new java.io.File [String] [path]) @@ -482,70 +486,6 @@ (do (print (show char)) (print " -> ") (println (normalize-char char)))) (println (show-list (range 0 10))) + (println (normalize-ident "text->list")) ) )) - -#( (def (main args) - (case (' ((~ "Oh yeah..."))) - (#Form (#Cons (#Text text) #Nil)) - (do (:: (:: System out) (println text)) - (:: (:: System out) (println (+ 10 20))) - (:: (:: System out) (println (inc 10))) - (:: (:: System out) (println (jvm/i- 10 20))) - (:: (:: System out) (println (jvm/i* 10 20))) - (:: (:: System out) (println (jvm/i/ 10 2)))) - )) - - (defmacro (::+ pieces) - (case pieces - (#Cons init #Nil) - init - - (#Cons init (#Cons access others)) - (' (::+ (:: (~ init) (~ access)) (~@ others))) - )) - - (def (main args) - (if true - (let f (lambda [x] (lambda [y] (x y))) - (let g (lambda [x] x) - (::+ System out (println (f g "WE'VE GOT CLOSURES!"))))) - (:: (:: System out) (println "FALSE")))) - - (def (main args) - (if true - (case (++ (#Cons "Pattern" #Nil) (#Cons "Matching" #Nil)) - (#Cons "Pattern" (#Cons second #Nil)) - (do (:: (:: System out) (println "Branch #1")) - (:: (:: System out) (println second))) - - (#Cons first (#Cons second #Nil)) - (do (:: (:: System out) (println "Branch #2")) - (:: (:: System out) (println first)) - (:: (:: System out) (println second)))) - (:: (:: System out) (println "FALSE")))) - - (def (main args) - (case (template (#Cons (#Cons (#Symbol "~@") (#Cons (#Symbol "Pattern") #Nil)) #Nil) - ## (#Cons (#Cons (#Symbol "~") (#Cons (#Symbol "Pattern") #Nil)) #Nil) - ) - (#Cons word #Nil) - (do (:: (:: System out) (println "Branch #1")) - (:: (:: System out) (println word))) - - (#Cons (#Symbol op) spliced) - (do (:: (:: System out) (println "Branch #2")) - (:: (:: System out) (println op))) - )) - - (def (main args) - (case (' "YOLO") - (#Text text) - (:: (:: System out) (println text)))) - - (def (main args) - (case (' ((~ "TROLOLOL"))) - (#Form (#Cons (#Text text) #Nil)) - (:: (:: System out) (println text)) - )) - )# |