diff options
| -rw-r--r-- | src/lux/analyser.clj | 139 | ||||
| -rw-r--r-- | src/lux/compiler.clj | 40 | ||||
| -rw-r--r-- | src/lux/parser.clj | 29 | ||||
| -rw-r--r-- | test2.lux | 163 |
4 files changed, 221 insertions, 150 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index 7cea2ef5c..4866ab04e 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -92,7 +92,7 @@ (defn ^:private with-scoped-name [name type body] (fn [state] (let [=return (body (update-in state [:env] - #(cons (assoc-in (first %) [:mappings name] (annotated [::global (:name state) name] type)) + #(cons (assoc-in (first %) [:mappings name] (annotated [::global-fn (:name state) name] type)) (rest %))))] (match =return [::&util/ok [?state ?value]] @@ -368,7 +368,7 @@ :when (and (= method (.getName =method)) (case mode :static (java.lang.reflect.Modifier/isStatic (.getModifiers =method)) - :dynamic (not (java.lang.reflect.Modifier/isStatic (.getModifiers =method)))))] + :virtual (not (java.lang.reflect.Modifier/isStatic (.getModifiers =method)))))] [(.getDeclaringClass =method) =method]))] (map-m (fn [[owner method]] (exec [=method (&type/method->type method)] @@ -376,42 +376,102 @@ methods) (fail (str "Method does not exist: " target method mode)))) -(defanalyser analyse-access - [::&parser/access ?object ?member] - (match ?member - [::&parser/ident ?field] ;; Field - (try-all-m [(exec [?target (extract-ident ?object) - =target (resolve ?target) - ?class (extract-class (:form =target)) - [=owner =type] (lookup-field :static ?class ?field) - ;; :let [_ (prn '=type =type)] - ] - (return (annotated [::static-field =owner ?field] =type))) - (exec [=target (analyse-form* ?object) - ?class (class-type (:type =target)) - [=owner =type] (lookup-field :dynamic ?class ?field) - ;; :let [_ (prn '=type =type)] +(defn lookup-static-field [target field] + (if-let [type* (first (for [=field (.getFields target) + :when (and (= target (.getDeclaringClass =field)) + (= field (.getName =field)) + (java.lang.reflect.Modifier/isStatic (.getModifiers =field)))] + (.getType =field)))] + (exec [=type (&type/class->type type*)] + (return =type)) + (fail (str "Field does not exist: " target field)))) + +(defn lookup-virtual-method [target method-name args] + (prn 'lookup-virtual-method target method-name args) + (if-let [method (first (for [=method (.getMethods target) + :when (and (= target (.getDeclaringClass =method)) + (= method-name (.getName =method)) + (not (java.lang.reflect.Modifier/isStatic (.getModifiers =method))))] + =method))] + (do (prn 'lookup-virtual-method 'method method) + (exec [=method (&type/method->type method)] + (&type/return-type =method))) + (do (prn 'lookup-virtual-method (str "Virtual method does not exist: " target method-name)) + (fail (str "Virtual method does not exist: " target method-name))))) + +(defn full-class-name [class] + ;; (prn 'full-class-name class) + (if (.contains class ".") + (return class) + (try-all-m [(exec [=class (resolve class) + ;; :let [_ (prn '=class =class)] ] - (return (annotated [::dynamic-field =target =owner ?field] =type)))]) - [::&parser/fn-call [::&parser/ident ?method] ?args] ;; Method - (exec [=args (map-m analyse-form* ?args)] - (try-all-m [(exec [?target (extract-ident ?object) - =target (resolve ?target) - ?class (extract-class (:form =target)) - =methods (lookup-method :static ?class ?method (map :type =args)) - ;; :let [_ (prn '=methods =methods)] - [=owner =method] (within :types (&type/pick-matches =methods (map :type =args))) - ;; :let [_ (prn '=method =owner ?method =method)] - ] - (return (annotated [::static-method =owner ?method =method =args] (&type/return-type =method)))) - (exec [=target (analyse-form* ?object) - ?class (class-type (:type =target)) - =methods (lookup-method :dynamic ?class ?method (map :type =args)) - ;; :let [_ (prn '=methods =methods)] - [=owner =method] (within :types (&type/pick-matches =methods (map :type =args))) - ;; :let [_ (prn '=method =owner ?method =method)] - ] - (return (annotated [::dynamic-method =target =owner ?method =method =args] (&type/return-type =method))))])))) + (match (:form =class) + [::class ?full-name] + (return ?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 full-name) + (fail "Unknown class.")))]))) + +(defanalyser analyse-jvm-getstatic + [::&parser/jvm-getstatic ?class ?field] + (exec [=class (full-class-name ?class) + =type (lookup-static-field (Class/forName =class) ?field)] + (return (annotated [::jvm-getstatic =class ?field] =type)))) + +(defanalyser analyse-jvm-invokevirtual + [::&parser/jvm-invokevirtual ?class ?method ?classes ?object ?args] + (exec [=class (full-class-name ?class) + =classes (map-m full-class-name ?classes) + =return (lookup-virtual-method (Class/forName =class) ?method (map #(Class/forName %) =classes)) + :let [_ (prn 'analyse-jvm-invokevirtual '=return =return)] + ;; =return =return + =object (analyse-form* ?object) + =args (map-m analyse-form* ?args)] + (return (annotated [::jvm-invokevirtual =class ?method =classes =object =args] =return)))) + +;; (defanalyser analyse-access +;; [::&parser/access ?object ?member] +;; (match ?member +;; [::&parser/ident ?field] ;; Field +;; (try-all-m [(exec [?target (extract-ident ?object) +;; =target (resolve ?target) +;; ?class (extract-class (:form =target)) +;; [=owner =type] (lookup-field :static ?class ?field) +;; ;; :let [_ (prn '=type =type)] +;; ] +;; (return (annotated [::static-field =owner ?field] =type))) +;; (exec [=target (analyse-form* ?object) +;; ?class (class-type (:type =target)) +;; [=owner =type] (lookup-field :dynamic ?class ?field) +;; ;; :let [_ (prn '=type =type)] +;; ] +;; (return (annotated [::dynamic-field =target =owner ?field] =type)))]) +;; [::&parser/fn-call [::&parser/ident ?method] ?args] ;; Method +;; (exec [=args (map-m analyse-form* ?args)] +;; (try-all-m [(exec [?target (extract-ident ?object) +;; =target (resolve ?target) +;; ?class (extract-class (:form =target)) +;; =methods (lookup-method :static ?class ?method (map :type =args)) +;; ;; :let [_ (prn '=methods =methods)] +;; [=owner =method] (within :types (&type/pick-matches =methods (map :type =args))) +;; ;; :let [_ (prn '=method =owner ?method =method)] +;; ] +;; (return (annotated [::static-method =owner ?method =method =args] (&type/return-type =method)))) +;; (exec [=target (analyse-form* ?object) +;; ?class (class-type (:type =target)) +;; =methods (lookup-method :dynamic ?class ?method (map :type =args)) +;; ;; :let [_ (prn '=methods =methods)] +;; [=owner =method] (within :types (&type/pick-matches =methods (map :type =args))) +;; ;; :let [_ (prn '=method =owner ?method =method)] +;; ] +;; (return (annotated [::dynamic-method =target =owner ?method =method =args] (&type/return-type =method))))])))) (defn ->token [x] ;; (prn '->token x) @@ -801,7 +861,6 @@ analyse-tuple analyse-lambda analyse-ident - analyse-access analyse-fn-call analyse-if analyse-do @@ -817,7 +876,9 @@ analyse-jvm-i+ analyse-jvm-i- analyse-jvm-i* - analyse-jvm-idiv])) + analyse-jvm-idiv + analyse-jvm-getstatic + analyse-jvm-invokevirtual])) ;; [Interface] (defn analyse [module-name tokens] diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index e91e10f77..5db85d17f 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -75,6 +75,9 @@ (defn ^:private ->java-sig [type] (match type + ::&type/nothing + "V" + ::&type/any (->java-sig [::&type/object "java.lang.Object" []]) @@ -218,8 +221,8 @@ )) ))) -(defcompiler ^:private compile-static-field - [::&analyser/static-field ?owner ?field] +(defcompiler ^:private compile-jvm-getstatic + [::&analyser/jvm-getstatic ?owner ?field] (do ;; (prn 'compile-static-field ?owner ?field) ;; (assert false) (doto *writer* @@ -246,17 +249,22 @@ (.visitInsn Opcodes/ACONST_NULL))) )) -(defcompiler ^:private compile-dynamic-method - [::&analyser/dynamic-method ?target ?owner ?method-name ?method-type ?args] - (do ;; (prn 'compile-dynamic-method ?target ?owner ?method-name ?method-type ?args) - ;; (assert false) - (do (compile-form (assoc *state* :form ?target)) - (doseq [arg ?args] - (compile-form (assoc *state* :form arg))) - (doto *writer* - (.visitMethodInsn Opcodes/INVOKEVIRTUAL (->class ?owner) ?method-name (method->sig ?method-type)) - (.visitInsn Opcodes/ACONST_NULL) - )) +(defcompiler ^:private compile-jvm-invokevirtual + [::&analyser/jvm-invokevirtual ?class ?method ?classes ?object ?args] + (let [_ (prn 'compile-jvm-invokevirtual [?class ?method ?classes] '-> *type*) + method-sig (str "(" (reduce str "" (map ->type-signature ?classes)) ")" (->java-sig *type*))] + (compile-form (assoc *state* :form ?object)) + (.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)))) + (.visitMethodInsn *writer* Opcodes/INVOKEVIRTUAL (->class ?class) ?method method-sig) + (match *type* + ::&type/nothing + (.visitInsn *writer* Opcodes/ACONST_NULL) + + [::&type/object ?oclass _] + nil) )) (defcompiler ^:private compile-if @@ -917,10 +925,8 @@ compile-global compile-static-call compile-call - compile-static-field compile-dynamic-field compile-static-method - compile-dynamic-method compile-if compile-do compile-case @@ -935,7 +941,9 @@ compile-jvm-i+ compile-jvm-i- compile-jvm-i* - compile-jvm-idiv]] + compile-jvm-idiv + compile-jvm-getstatic + compile-jvm-invokevirtual]] (defn ^:private compile-form [state] ;; (prn 'compile-form/state state) (or (some #(% state) +compilers+) diff --git a/src/lux/parser.clj b/src/lux/parser.clj index bfc23fef8..4de0b6896 100644 --- a/src/lux/parser.clj +++ b/src/lux/parser.clj @@ -163,16 +163,30 @@ =record (apply-m parse-form (list ?record))] (return [::set ?tag =value =record]))) -(defparser ^:private parse-access - [::&lexer/list ([[::&lexer/ident "::"] ?object ?call] :seq)] - (exec [=object (apply-m parse-form (list ?object)) - =call (apply-m parse-form (list ?call))] - (return [::access =object =call]))) - (defparser ^:private parse-text [::&lexer/text ?text] (return [::text ?text])) +;; (defparser ^:private parse-access +;; [::&lexer/list ([[::&lexer/ident "::"] ?object ?call] :seq)] +;; (exec [=object (apply-m parse-form (list ?object)) +;; =call (apply-m parse-form (list ?call))] +;; (return [::access =object =call]))) + +(defparser ^:private parse-jvm-getstatic + [::&lexer/list ([[::&lexer/ident "jvm/getstatic"] [::&lexer/ident ?class] [::&lexer/ident ?field]] :seq)] + (return [::jvm-getstatic ?class ?field])) + +(defparser ^:private parse-jvm-invokevirtual + [::&lexer/list ([[::&lexer/ident "jvm/invokevirtual"] + [::&lexer/ident ?class] [::&lexer/text ?method] [::&lexer/tuple ?classes] + ?object [::&lexer/tuple ?args]] + :seq)] + (exec [=object (apply-m parse-form (list ?object)) + =args (map-m #(apply-m parse-form (list %)) + ?args)] + (return [::jvm-invokevirtual ?class ?method (map ident->string ?classes) =object =args]))) + (defparser ^:private parse-fn-call [::&lexer/list ([?f & ?args] :seq)] (exec [=f (apply-m parse-form (list ?f)) @@ -214,7 +228,6 @@ parse-get parse-set parse-remove - parse-access parse-defclass parse-definterface parse-import @@ -223,6 +236,8 @@ parse-jvm-i- parse-jvm-i* parse-jvm-idiv + parse-jvm-getstatic + parse-jvm-invokevirtual parse-fn-call])) ;; [Interface] @@ -1,4 +1,3 @@ -(import java.lang.System) ## (use "./another" as another) (jvm/definterface Function @@ -140,10 +139,7 @@ (def inc (+ 1)) -#( - - - (def (fold f init values) +#( (def (fold f init values) (case values #Nil init @@ -179,92 +175,83 @@ (as-pairs steps)) (#Text "Oh no!")))) )# +(def (println x) + (jvm/invokevirtual java.io.PrintStream "println" [Object] + (jvm/getstatic System out) [x])) + ## Program (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)))) + (do (println text) + (println (+ 10 20)) + (println (inc 10)) + (println (jvm/i- 10 20)) + (println (jvm/i* 10 20)) + (println (jvm/i/ 10 2))) )) -#( - (def (main args) - (case (' ((~ "Oh yeah..."))) - (#Form (#Cons (#Text text) #Nil)) - (do (jvm/invokevirtual (jvm/getstatic System out) - java.io.PrintStream "println" [String] - [text]) - (jvm/invokevirtual (jvm/getstatic System out) - java.io.PrintStream "println" [Object] - [(+ 10 20)]) - (jvm/invokevirtual (jvm/getstatic System out) - java.io.PrintStream "println" [Object] - [(inc 10)]) - (jvm/invokevirtual (jvm/getstatic System out) - java.io.PrintStream "println" [Object] - [(jvm/i- 10 20)]) - (jvm/invokevirtual (jvm/getstatic System out) - java.io.PrintStream "println" [Object] - [(jvm/i* 10 20)]) - (jvm/invokevirtual (jvm/getstatic System out) - java.io.PrintStream "println" [Object] - [(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)) - )) - )# +#( (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)) + )) + )# |