diff options
Diffstat (limited to 'src/lang/compiler.clj')
| -rw-r--r-- | src/lang/compiler.clj | 207 |
1 files changed, 113 insertions, 94 deletions
diff --git a/src/lang/compiler.clj b/src/lang/compiler.clj index dbc088668..1976c48e9 100644 --- a/src/lang/compiler.clj +++ b/src/lang/compiler.clj @@ -2,7 +2,9 @@ (:refer-clojure :exclude [compile]) (:require [clojure.string :as string] [clojure.core.match :refer [match]] - [lang.parser :as &parser] + (lang [type :as &type] + [parser :as &parser] + [analyser :as &analyser]) :reload) (:import (org.objectweb.asm Opcodes Label @@ -12,21 +14,18 @@ (declare compile-form) ;; [Utils/General] +(def ^:private +variant-class+ "test2.Tagged") + (defmacro ^:private defcompiler [name match body] `(defn ~name [~'*state*] - (let [~'*name* (:name ~'*state*) - ~'*writer* (:writer ~'*state*) - ~'*form* (:form ~'*state*)] - (match ~'*form* + (let [~'*writer* (:writer ~'*state*)] + (match (:form (:form ~'*state*)) ~match (do ~body true) _# false)))) -(defn compile-form* [writer form] - (compile-form {:writer writer, :form form})) - (defn ^:private unwrap-ident [ident] (match ident [::&parser/ident ?label] @@ -40,78 +39,98 @@ (defn ^:private ->class [class] (string/replace class #"\." "/")) +(def ^:private ->package ->class) + (defn ^:private ->type-signature [class] (case class "Void" "V" ;; else (str "L" (->class class) ";"))) +(defn ^:private ->java-sig [type] + (match type + [::&type/object ?name []] + (->type-signature ?name) + + [::&type/variant ?tag ?value] + (->type-signature +variant-class+))) + ;; [Utils/Compilers] -(defcompiler ^:private compile-boolean - [::&parser/boolean ?boolean] - (if ?boolean - (.visitLdcInsn *writer* (int 1)) - (.visitLdcInsn *writer* (int 0)))) +(defcompiler ^:private compile-literal + [::&analyser/literal ?literal] + (cond (string? ?literal) + (.visitLdcInsn *writer* ?literal) + + (instance? java.lang.Boolean ?literal) + (if ?literal + ;; (.visitLdcInsn *writer* (int 1)) + (.visitFieldInsn *writer* Opcodes/GETSTATIC (->class "java.lang.Boolean") "TRUE" (->type-signature "java.lang.Boolean")) + ;; (.visitLdcInsn *writer* (int 0)) + (.visitFieldInsn *writer* Opcodes/GETSTATIC (->class "java.lang.Boolean") "FALSE" (->type-signature "java.lang.Boolean"))) -(defcompiler ^:private compile-string - [::&parser/string ?string] - (.visitLdcInsn *writer* ?string)) + :else + (assert false (str "[Unknown literal type] " ?literal " : " (class ?literal))))) (defcompiler ^:private compile-ident - [::&parser/ident ?name] + [::&analyser/ident ?name] (doto *writer* - (.visitVarInsn Opcodes/ALOAD (int 0))) - ;; nil - ) + (.visitVarInsn Opcodes/ALOAD (int 0)))) -(defcompiler ^:private compile-fn-call - [::&parser/fn-call [::&parser/ident ?fn] ?args] +(defcompiler ^:private compile-call + [::&analyser/call [?owner-class ?fn] ?args] (do (doseq [arg ?args] (compile-form (assoc *state* :form arg))) (doto *writer* - (.visitMethodInsn Opcodes/INVOKESTATIC (->class *name*) ?fn "(Ljava/lang/Object;)Ljava/lang/Object;")))) + (.visitMethodInsn Opcodes/INVOKESTATIC (->class ?owner-class) ?fn "(Ljava/lang/Object;)Ljava/lang/Object;")))) (defcompiler ^:private compile-static-access - [::&parser/static-access ?class ?member] + [::&analyser/static-access ?class ?member] (doto *writer* (.visitFieldInsn Opcodes/GETSTATIC (->class ?class) ?member (->type-signature "java.io.PrintStream")))) (defcompiler ^:private compile-dynamic-access - [::&parser/dynamic-access ?object ?access] - (let [=object (compile-form (assoc *state* :form ?object)) - method (match ?access - [::&parser/fn-call [::&parser/ident ?method] ?args] - (do (doseq [arg ?args] - (compile-form (assoc *state* :form arg))) - ?method))] + [::&analyser/dynamic-access ?object [?method ?args]] + (do (compile-form (assoc *state* :form ?object)) + (doseq [arg ?args] + (compile-form (assoc *state* :form arg))) (doto *writer* - (.visitMethodInsn Opcodes/INVOKEVIRTUAL (->class "java.io.PrintStream") method "(Ljava/lang/Object;)V")))) + (.visitMethodInsn Opcodes/INVOKEVIRTUAL (->class "java.io.PrintStream") ?method "(Ljava/lang/Object;)V")))) (defcompiler ^:private compile-ann-class - [::&parser/ann-class ?class ?members] + [::&analyser/ann-class ?class ?members] nil) (defcompiler ^:private compile-if - [::&parser/if ?test ?then ?else] + [::&analyser/if ?test ?then ?else] (let [else-label (new Label) end-label (new Label)] - (compile-form (assoc *state* :form ?test)) - (.visitJumpInsn *writer* Opcodes/IFEQ else-label) - (compile-form (assoc *state* :form ?then)) + (println "PRE") + (assert (compile-form (assoc *state* :form ?test)) "CAN't COMPILE TEST") + (doto *writer* + (.visitMethodInsn Opcodes/INVOKEVIRTUAL (->class "java.lang.Boolean") "booleanValue" "()Z") + (.visitJumpInsn Opcodes/IFEQ else-label)) + (assert (compile-form (assoc *state* :form ?then)) "CAN't COMPILE THEN") (doto *writer* (.visitJumpInsn Opcodes/GOTO end-label) (.visitLabel else-label)) - (compile-form (assoc *state* :form ?else)) + (assert (compile-form (assoc *state* :form ?else)) "CAN't COMPILE ELSE") (.visitLabel *writer* end-label))) (defcompiler ^:private compile-def - [::&parser/def ?form ?body] + [::&analyser/def ?form ?body] (match ?form - [::&parser/fn-call [::&parser/ident ?name] ?args] + (?name :guard string?) + (let [=type (:type ?body) + _ (prn '?body ?body)] + (doto (.visitField *writer* (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) ?name (->java-sig =type) nil nil) + (.visitEnd))) + + [?name ?args] (if (= "main" ?name) (let [=method (doto (.visitMethod *writer* (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) ?name "([Ljava/lang/String;)V" nil nil) (.visitCode))] - (compile-form (assoc *state* :writer =method :form ?body)) + (prn 'FN/?body ?body) + (assert (compile-form (assoc *state* :writer =method :form ?body)) (str "Body couldn't compile: " (pr-str ?body))) (doto =method (.visitInsn Opcodes/RETURN) (.visitMaxs 0 0) @@ -123,23 +142,21 @@ (.visitInsn Opcodes/ARETURN) (.visitMaxs 0 0) (.visitEnd)))) - [::&parser/ident ?name] - (doto (.visitField *writer* (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) ?name "Ljava/lang/Object;" nil nil) - (.visitEnd)) )) (defcompiler ^:private compile-module - [::&parser/module] + [::&analyser/module ?name] (.visit *writer* Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) - (->class *name*) nil "java/lang/Object" nil)) + (->class ?name) nil "java/lang/Object" nil)) (defcompiler ^:private compile-defclass - [::&parser/defclass ?name ?fields] - (let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) + [::&analyser/defclass [?package ?name] ?members] + (let [parent-dir (->package ?package) + =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) - (->class (str *name* "." ?name)) nil "java/lang/Object" nil))] - (doseq [[class field] ?fields] - (doto (.visitField =class Opcodes/ACC_PUBLIC field (->type-signature class) nil nil) + (str parent-dir "/" ?name) nil "java/lang/Object" nil))] + (doseq [[field props] (:fields ?members)] + (doto (.visitField =class Opcodes/ACC_PUBLIC field (->type-signature (:type props)) nil nil) (.visitEnd))) (doto (.visitMethod =class Opcodes/ACC_PUBLIC "<init>" "()V" nil nil) (.visitCode) @@ -149,46 +166,45 @@ (.visitMaxs 0 0) (.visitEnd)) (.visitEnd =class) - (let [parent-dir (->class *name*)] - (.mkdirs (java.io.File. parent-dir)) - (with-open [stream (java.io.BufferedOutputStream. (java.io.FileOutputStream. (str parent-dir "/" ?name ".class")))] - (.write stream (.toByteArray =class)))))) + (.mkdirs (java.io.File. parent-dir)) + (with-open [stream (java.io.BufferedOutputStream. (java.io.FileOutputStream. (str parent-dir "/" ?name ".class")))] + (.write stream (.toByteArray =class))))) (defcompiler ^:private compile-definterface - [::&parser/definterface ?name ?members] - (let [=interface (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) + [::&analyser/definterface [?package ?name] ?members] + (let [parent-dir (->package ?package) + =interface (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_ABSTRACT Opcodes/ACC_INTERFACE) - (->class (str *name* "." ?name)) nil "java/lang/Object" nil))] - (doseq [[?method [?args ?return]] ?members - :let [signature (str "(" (reduce str "" (map ->type-signature ?args)) ")" (->type-signature ?return))]] + (str parent-dir "/" ?name) nil "java/lang/Object" nil))] + (doseq [[?method ?props] (:methods ?members) + :let [[?args ?return] (:type ?props) + signature (str "(" (reduce str "" (map ->type-signature ?args)) ")" (->type-signature ?return))]] (.visitMethod =interface (+ Opcodes/ACC_PUBLIC) ?method signature nil nil)) (.visitEnd =interface) - (let [parent-dir (->class *name*)] - (.mkdirs (java.io.File. parent-dir)) - (with-open [stream (java.io.BufferedOutputStream. (java.io.FileOutputStream. (str parent-dir "/" ?name ".class")))] - (.write stream (.toByteArray =interface)))))) - -(let [+tagged+ "test2/Tagged"] - (defcompiler ^:private compile-tagged - [::&parser/tagged ?tag ?value] - (do (prn 'compile-tagged ?tag ?value) - (doto *writer* - (.visitTypeInsn Opcodes/NEW +tagged+) - (.visitInsn Opcodes/DUP) - (.visitMethodInsn Opcodes/INVOKESPECIAL +tagged+ "<init>" "()V") - (.visitInsn Opcodes/DUP) - (.visitLdcInsn ?tag) - (.visitFieldInsn Opcodes/PUTFIELD +tagged+ "tag" "Ljava/lang/String;") - (.visitInsn Opcodes/DUP)) - (compile-form (assoc *state* :form ?value)) - (doto *writer* - (.visitFieldInsn Opcodes/PUTFIELD +tagged+ "value" "Ljava/lang/Object;")) - ))) - -(let [+compilers+ [compile-boolean - compile-string + (.mkdirs (java.io.File. parent-dir)) + (with-open [stream (java.io.BufferedOutputStream. (java.io.FileOutputStream. (str parent-dir "/" ?name ".class")))] + (.write stream (.toByteArray =interface))))) + +(defcompiler ^:private compile-variant + [::&analyser/variant ?tag ?value] + (let [variant-class* (->class +variant-class+)] + (prn 'compile-variant ?tag ?value) + (doto *writer* + (.visitTypeInsn Opcodes/NEW variant-class*) + (.visitInsn Opcodes/DUP) + (.visitMethodInsn Opcodes/INVOKESPECIAL variant-class* "<init>" "()V") + (.visitInsn Opcodes/DUP) + (.visitLdcInsn ?tag) + (.visitFieldInsn Opcodes/PUTFIELD variant-class* "tag" "Ljava/lang/String;") + (.visitInsn Opcodes/DUP)) + (assert (compile-form (assoc *state* :form ?value)) (pr-str "Can't compile value: " ?value)) + (doto *writer* + (.visitFieldInsn Opcodes/PUTFIELD variant-class* "value" "Ljava/lang/Object;")) + )) + +(let [+compilers+ [compile-literal compile-ident - compile-fn-call + compile-call compile-static-access compile-dynamic-access compile-ann-class @@ -197,10 +213,11 @@ compile-module compile-defclass compile-definterface - compile-tagged]] + compile-variant]] (defn ^:private compile-form [state] (prn 'compile-form/state state) - (some #(% state) +compilers+))) + (or (some #(% state) +compilers+) + (assert false (str "Can't compile: " (pr-str (:form state))))))) ;; [Interface] (defn compile [class-name inputs] @@ -209,8 +226,7 @@ ;; (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) ;; (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) ;; "output" nil "java/lang/Object" nil)) - state {:name class-name - :writer =class + state {:writer =class :form nil}] ;; (doto (.visitMethod =class Opcodes/ACC_PUBLIC "<init>" "()V" nil nil) ;; (.visitCode) @@ -223,19 +239,22 @@ (when (not (compile-form (assoc state :form input))) (assert false input))) ;; (doall (map #(compile-form (assoc state :form %)) inputs)) + (prn 'inputs inputs) (when-let [constants (seq (for [input inputs - :let [payload (match input - [::&parser/def [::&parser/ident ?name] ?body] + :let [payload (match (:form input) + [::&analyser/def (?name :guard string?) ?body] [?name ?body] _ nil)] :when payload] payload))] (let [=init (doto (.visitMethod =class Opcodes/ACC_PUBLIC "<clinit>" "()V" nil nil) - (.visitCode))] + (.visitCode)) + state* (assoc state :writer =init) + class-name* (->class class-name)] (doseq [[?name ?body] constants] - (do (compile-form (assoc state :writer =init :form ?body)) - (.visitFieldInsn =init Opcodes/PUTSTATIC (->class class-name) ?name "Ljava/lang/Object;"))) + (do (assert (compile-form (assoc state* :form ?body)) (str "Couldn't compile init: " (pr-str ?body))) + (.visitFieldInsn =init Opcodes/PUTSTATIC class-name* ?name (->java-sig (:type ?body))))) (doto =init (.visitInsn Opcodes/RETURN) (.visitMaxs 0 0) |