diff options
Diffstat (limited to 'src/lang')
| -rw-r--r-- | src/lang/compiler.clj | 73 | ||||
| -rw-r--r-- | src/lang/lexer.clj | 2 | ||||
| -rw-r--r-- | src/lang/parser.clj | 29 | ||||
| -rw-r--r-- | src/lang/type.clj | 4 |
4 files changed, 92 insertions, 16 deletions
diff --git a/src/lang/compiler.clj b/src/lang/compiler.clj index 0cb69462e..16b2dfe54 100644 --- a/src/lang/compiler.clj +++ b/src/lang/compiler.clj @@ -6,7 +6,8 @@ repeat-m try-m try-all-m map-m apply-m]] [parser :as &parser] - [lexer :as &lexer]) + [lexer :as &lexer] + [type :as &type]) :reload) (:import (org.objectweb.asm Opcodes ClassWriter @@ -18,11 +19,25 @@ (def ^:private +state+ {:globals {} :stack {} - :forms '()}) + :forms '() + :classes {}}) + +(defn define-class [class members] + (fn [state] + (return* (assoc-in state [:classes class] members) nil))) + +(defn find-class [class] + (fn [state] + (if-let [class-data (get-in state [:classes class])] + (return* state class-data) + (fail* (str "Unknown class: " class))))) (defn wrap [x] (update-in +state+ [:forms] conj x)) +(defn wrap-in [state x] + (assoc-in state [:forms] (list x))) + (defn wrap* [env x] (-> +state+ (update-in [:stack] merge env) @@ -205,29 +220,59 @@ (.visitLdcInsn ?string)) (return nil))) +(defn ->java-class [class] + (string/replace class #"\." "/")) + +(defn ->java-class* [class] + (case class + "Void" "V" + ;; else + (str "L" (->java-class class) ";"))) + +(defn method->signature [method] + (match method + [::&type/fn ?args ?return] + (str "(" (reduce str "" (map ->java-class* ?args)) ")" (->java-class* ?return)))) + (defcompiler compile-static-access [::&parser/static-access ?class ?member] - (let [?class* (string/replace ?class #"\." "/")] - (doto *code* - (.visitFieldInsn Opcodes/GETSTATIC ?class* ?member "Ljava/io/PrintStream;")) - (return nil))) + (exec [=class (find-class ?class) + :let [member-type (get-in =class [:fields ?member]) + ?field-class (match member-type + [::&type/object ?field-class _] + ?field-class)]] + (do (doto *code* + (.visitFieldInsn Opcodes/GETSTATIC (->java-class ?class) ?member (->java-class* ?field-class))) + (return member-type)))) (defcompiler compile-dynamic-access [::&parser/dynamic-access ?object ?access] - (exec [=object (apply-m compile-form (wrap ?object)) - [=method =args] (match ?access - [::&parser/fn-call [::&parser/ident ?method] ?args] - (exec [=args (map-m #(apply-m compile-form (wrap %)) - ?args)] - (return [?method =args])))] + (exec [_state &util/get-state + =object (apply-m compile-form (wrap-in _state ?object)) + :let [?oclass (match =object + [::&type/object ?oclass _] + ?oclass)] + =class (find-class ?oclass) + [method signature] (match ?access + [::&parser/fn-call [::&parser/ident ?method] ?args] + (exec [=args (map-m #(apply-m compile-form (wrap %)) + ?args)] + (return [?method (method->signature (get-in =class [:methods ?method]))])))] (do (doto *code* - (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/io/PrintStream" =method "(Ljava/lang/String;)V")) + (.visitMethodInsn Opcodes/INVOKEVIRTUAL (->java-class ?oclass) method signature)) (return nil)))) +(defcompiler compile-ann-class + [::&parser/ann-class ?class ?members] + (exec [_ (define-class ?class ?members) + _state &util/get-state] + (return nil))) + (def compile-form (try-all-m [compile-string compile-static-access - compile-dynamic-access])) + compile-dynamic-access + compile-ann-class])) (defn compile [inputs] (let [cw (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) diff --git a/src/lang/lexer.clj b/src/lang/lexer.clj index 54e83c078..e2de44d82 100644 --- a/src/lang/lexer.clj +++ b/src/lang/lexer.clj @@ -49,7 +49,7 @@ _ (lex-str "}")] (return [::record members]))) -(def +ident-re+ #"^([a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|'][0-9a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|']*)") +(def +ident-re+ #"^([a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|':][0-9a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|':]*)") (do-template [<name> <tag> <regex>] (def <name> diff --git a/src/lang/parser.clj b/src/lang/parser.clj index 7f1337558..d1bd3dbd8 100644 --- a/src/lang/parser.clj +++ b/src/lang/parser.clj @@ -3,7 +3,8 @@ (lang [util :as &util :refer [exec return* return fail fail* repeat-m try-m try-all-m map-m apply-m]] - [lexer :as &lexer]))) + [lexer :as &lexer] + [type :as &type]))) (declare parse-form) @@ -26,6 +27,11 @@ [::&lexer/float ?float] (return [::float (Double/parseDouble ?float)])) +(defn ident->string [ident] + (match ident + [::&lexer/ident ?ident] + ?ident)) + (defparser ^:private parse-ident [::&lexer/ident ?ident] (return [::ident ?ident])) @@ -124,6 +130,26 @@ =call (apply-m parse-form (list ?call))] (return [::dynamic-access =object =call]))) +(defparser ^:private parse-ann-class + [::&lexer/list ([[::&lexer/ident "ann-class"] [::&lexer/ident ?class] & ?decl] :seq)] + (let [[_ class-data] (reduce (fn [[mode data] event] + (match event + [::&lexer/ident "methods"] + [:methods data] + + [::&lexer/ident "fields"] + [:fields data] + + [::&lexer/list ([[::&lexer/ident ":"] [::&lexer/ident ?field-name] [::&lexer/ident ?field-class]] :seq)] + [mode (assoc-in data [mode ?field-name] [::&type/object ?field-class []])] + + [::&lexer/list ([[::&lexer/ident ":"] [::&lexer/ident ?method-name] [::&lexer/list ([[::&lexer/ident "->"] [::&lexer/tuple ?args*] [::&lexer/ident ?return]] :seq)]] :seq)] + [mode (assoc-in data [mode ?method-name] [::&type/fn (map ident->string ?args*) ?return])] + )) + [nil {}] + ?decl)] + (return [::ann-class ?class class-data]))) + (defparser ^:private parse-string [::&lexer/string ?string] (return [::string ?string])) @@ -153,6 +179,7 @@ parse-remove parse-static-access parse-dynamic-access + parse-ann-class parse-fn-call])) ;; [Interface] diff --git a/src/lang/type.clj b/src/lang/type.clj new file mode 100644 index 000000000..cab0ebeec --- /dev/null +++ b/src/lang/type.clj @@ -0,0 +1,4 @@ +(ns lang.type) + + + |