From 4908fef51307348d8469d8e95885fa9a0d8eb821 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 1 Mar 2015 23:39:58 -0400 Subject: Simplified the compiler by using arrays to encode tuples & variants instead of using custom classes for that. --- src/lux/analyser.clj | 4 +-- src/lux/analyser/case.clj | 2 +- src/lux/analyser/host.clj | 16 ++++++------ src/lux/analyser/lux.clj | 20 ++++++++------- src/lux/compiler/base.clj | 1 - src/lux/compiler/case.clj | 41 +++++++++++++++---------------- src/lux/compiler/host.clj | 2 +- src/lux/compiler/lambda.clj | 2 +- src/lux/compiler/lux.clj | 36 +++++++++++++-------------- src/lux/host.clj | 4 +-- src/lux/macro.clj | 60 ++++++++++++++++----------------------------- 11 files changed, 85 insertions(+), 103 deletions(-) (limited to 'src') diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index faa41913f..4ddd8ecd1 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -166,9 +166,9 @@ ;; (prn 'analyse-ast token) (match token [::&parser/Form ([[::&parser/Tag ?tag] & ?values] :seq)] - (exec [:let [_ (prn 'PRE-ASSERT)] + (exec [;; :let [_ (prn 'PRE-ASSERT)] :let [_ (assert (= 1 (count ?values)) (str "[Analyser Error] Can only tag 1 value: " (pr-str token)))] - :let [_ (prn 'POST-ASSERT)] + ;; :let [_ (prn 'POST-ASSERT)] :let [?value (first ?values)] =value (&&/analyse-1 analyse-ast ?value) =value-type (&&/expr-type =value)] diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj index 4aec4af10..639395f33 100644 --- a/src/lux/analyser/case.clj +++ b/src/lux/analyser/case.clj @@ -24,7 +24,7 @@ (list))) (defn analyse-branch [analyse max-registers [bindings body]] - (prn 'analyse-branch max-registers bindings body) + ;; (prn 'analyse-branch max-registers bindings body) (reduce (fn [body* name] (&env/with-local name :local &type/+dont-care-type+ body*)) (reduce (fn [body* _] diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index ddc91d2b9..aa7812421 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -57,9 +57,10 @@ (defn analyse-jvm-getstatic [analyse ?class ?field] (exec [=class (&host/full-class-name ?class) - :let [_ (prn 'analyse-jvm-getstatic/=class =class)] + ;; :let [_ (prn 'analyse-jvm-getstatic/=class =class)] =type (&host/lookup-static-field =class ?field) - :let [_ (prn 'analyse-jvm-getstatic/=type =type)]] + ;; :let [_ (prn 'analyse-jvm-getstatic/=type =type)] + ] (return (list [::&&/Expression [::&&/jvm-getstatic =class ?field] =type])))) (defn analyse-jvm-getfield [analyse ?class ?field ?object] @@ -77,15 +78,16 @@ (defn analyse-jvm-invokevirtual [analyse ?class ?method ?classes ?object ?args] (exec [=class (&host/full-class-name ?class) - :let [_ (prn 'analyse-jvm-invokevirtual/=class =class)] + ;; :let [_ (prn 'analyse-jvm-invokevirtual/=class =class)] =classes (map-m &host/extract-jvm-param ?classes) - :let [_ (prn 'analyse-jvm-invokevirtual/=classes =classes)] + ;; :let [_ (prn 'analyse-jvm-invokevirtual/=classes =classes)] [=method-args =return] (&host/lookup-virtual-method =class ?method =classes) - :let [_ (prn 'analyse-jvm-invokevirtual/=return =return)] + ;; :let [_ (prn 'analyse-jvm-invokevirtual/=return =return)] =object (&&/analyse-1 analyse ?object) - :let [_ (prn 'analyse-jvm-invokevirtual/=object =object)] + ;; :let [_ (prn 'analyse-jvm-invokevirtual/=object =object)] =args (mapcat-m analyse ?args) - :let [_ (prn 'analyse-jvm-invokevirtual/=args =args)]] + ;; :let [_ (prn 'analyse-jvm-invokevirtual/=args =args)] + ] (return (list [::&&/Expression [::&&/jvm-invokevirtual =class ?method =classes =object =args] =return])))) (defn analyse-jvm-new [analyse ?class ?classes ?args] diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index b80321820..5e81cae0e 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -57,9 +57,10 @@ (if macro? (let [macro-class (&host/location (list ?module ?name)) [macro-expansion state*] (¯o/expand loader macro-class ?args) - _ (prn 'macro-expansion) - _ (doseq [ast macro-expansion] - (prn '=> ast))] + ;; _ (prn 'macro-expansion) + ;; _ (doseq [ast macro-expansion] + ;; (prn '=> ast)) + ] (mapcat-m analyse macro-expansion)) (exec [=args (mapcat-m analyse ?args)] (return (list [::&&/Expression [::&&/call =fn =args] &type/+dont-care-type+]))))) @@ -73,23 +74,23 @@ )) (defn analyse-case [analyse ?variant ?branches] - (prn 'analyse-case ?variant ?branches) + ;; (prn 'analyse-case ?variant ?branches) (exec [:let [num-branches (count ?branches)] _ (assert! (and (> num-branches 0) (even? num-branches)) "[Analyser Error] Unbalanced branches in \"case'\" expression.") :let [branches (partition 2 ?branches) locals-per-branch (map (comp &&case/locals first) branches) max-locals (reduce max 0 (map count locals-per-branch))] - :let [_ (prn '[branches locals-per-branch max-locals] [branches locals-per-branch max-locals])] + ;; :let [_ (prn '[branches locals-per-branch max-locals] [branches locals-per-branch max-locals])] base-register &&env/next-local-idx - :let [_ (prn 'base-register base-register)] + ;; :let [_ (prn 'base-register base-register)] =variant (reduce (fn [body* _] (&&env/with-local "#" :local &type/+dont-care-type+ body*)) (&&/analyse-1 analyse ?variant) (range max-locals)) - :let [_ (prn '=variant =variant)] + ;; :let [_ (prn '=variant =variant)] =bodies (map-m (partial &&case/analyse-branch analyse max-locals) (map vector locals-per-branch (map second branches))) - :let [_ (prn '=bodies =bodies)] + ;; :let [_ (prn '=bodies =bodies)] ;; :let [_ (prn 'analyse-case/=bodies =bodies)] =body-types (map-m &&/expr-type =bodies) =case-type (return [::&type/Any]) ;; (reduce-m &type/merge [::&type/Nothing] =body-types) @@ -110,7 +111,8 @@ _ [::&&/lambda =scope =captured (list ?arg) =body]) - _ (prn '=lambda-form =lambda-form)]] + ;; _ (prn '=lambda-form =lambda-form) + ]] (return (list [::&&/Expression =lambda-form =lambda-type])))) (defn analyse-def [analyse ?name ?value] diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj index 39c67f5d0..28c793e10 100644 --- a/src/lux/compiler/base.clj +++ b/src/lux/compiler/base.clj @@ -13,7 +13,6 @@ (def local-prefix "l") (def partial-prefix "p") (def closure-prefix "c") -(def tuple-field-prefix "_") (def apply-signature "(Ljava/lang/Object;)Ljava/lang/Object;") (defn add-nulls [writer amount] diff --git a/src/lux/compiler/case.clj b/src/lux/compiler/case.clj index b0a8a8ea6..48c52123f 100644 --- a/src/lux/compiler/case.clj +++ b/src/lux/compiler/case.clj @@ -63,9 +63,6 @@ [mappings (reverse pms)])) (let [+tag-sig+ (&host/->type-signature "java.lang.String") - +variant-class+ (&host/->class &host/variant-class) - tuple-class* (&host/->class &host/tuple-class) - +variant-value-sig+ (&host/->type-signature "java.lang.Object") +oclass+ (&host/->class "java.lang.Object") +equals-sig+ (str "(" (&host/->type-signature "java.lang.Object") ")Z")] (defn ^:private compile-match [writer ?match $target $else] @@ -123,32 +120,34 @@ (.visitJumpInsn Opcodes/GOTO $target)) [::TupleMatch ?members] - (let [tuple-class** (str tuple-class* (count ?members))] - (doto writer - (.visitTypeInsn Opcodes/CHECKCAST tuple-class**) - (-> (doto (.visitInsn Opcodes/DUP) - (.visitFieldInsn Opcodes/GETFIELD tuple-class** (str &&/tuple-field-prefix idx) +variant-value-sig+) - (compile-match member $next $sub-else) - (.visitLabel $sub-else) - (.visitInsn Opcodes/POP) - (.visitJumpInsn Opcodes/GOTO $else) - (.visitLabel $next)) - (->> (doseq [[idx [_ _ member]] (map vector (range (count ?members)) ?members) - :let [$next (new Label) - $sub-else (new Label)]]))) - (.visitInsn Opcodes/POP) - (.visitJumpInsn Opcodes/GOTO $target))) + (doto writer + (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;") + (-> (doto (.visitInsn Opcodes/DUP) + (.visitLdcInsn (int idx)) + (.visitInsn Opcodes/AALOAD) + (compile-match member $next $sub-else) + (.visitLabel $sub-else) + (.visitInsn Opcodes/POP) + (.visitJumpInsn Opcodes/GOTO $else) + (.visitLabel $next)) + (->> (doseq [[idx [_ _ member]] (map vector (range (count ?members)) ?members) + :let [$next (new Label) + $sub-else (new Label)]]))) + (.visitInsn Opcodes/POP) + (.visitJumpInsn Opcodes/GOTO $target)) [::VariantMatch ?tag [::Pattern _ ?value]] (doto writer - (.visitTypeInsn Opcodes/CHECKCAST +variant-class+) + (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;") (.visitInsn Opcodes/DUP) - (.visitFieldInsn Opcodes/GETFIELD +variant-class+ "tag" +tag-sig+) + (.visitLdcInsn (int 0)) + (.visitInsn Opcodes/AALOAD) (.visitLdcInsn ?tag) (.visitMethodInsn Opcodes/INVOKEVIRTUAL +oclass+ "equals" +equals-sig+) (.visitJumpInsn Opcodes/IFEQ $else) (.visitInsn Opcodes/DUP) - (.visitFieldInsn Opcodes/GETFIELD +variant-class+ "value" +variant-value-sig+) + (.visitLdcInsn (int 1)) + (.visitInsn Opcodes/AALOAD) (-> (doto (compile-match ?value $value-then $value-else) (.visitLabel $value-then) (.visitInsn Opcodes/POP) diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj index a141cecc3..879bc52f3 100644 --- a/src/lux/compiler/host.clj +++ b/src/lux/compiler/host.clj @@ -113,7 +113,7 @@ (return nil))) (defn compile-jvm-invokevirtual [compile *type* ?class ?method ?classes ?object ?args] - (prn 'compile-jvm-invokevirtual ?classes *type*) + ;; (prn 'compile-jvm-invokevirtual ?classes *type*) (exec [*writer* &/get-writer :let [method-sig (str "(" (reduce str "" (map &host/->type-signature ?classes)) ")" (&host/->java-sig *type*))] _ (compile ?object) diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj index b24ab9fc6..9afb2a289 100644 --- a/src/lux/compiler/lambda.clj +++ b/src/lux/compiler/lambda.clj @@ -162,7 +162,7 @@ ;; [Resources] (defn compile-lambda [compile *type* ?scope ?closure ?args ?body with-datum? instance?] - (prn 'compile-lambda ?scope ?closure ?args ?body) + ;; (prn 'compile-lambda ?scope ?closure ?args ?body) (exec [:let [lambda-class (&host/location ?scope) impl-signature (lambda-impl-signature ?args) -sig (lambda--signature ?closure ?args) diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj index bd09b603f..60a5dbdc0 100644 --- a/src/lux/compiler/lux.clj +++ b/src/lux/compiler/lux.clj @@ -80,32 +80,32 @@ (defn compile-tuple [compile *type* ?elems] (exec [*writer* &/get-writer :let [num-elems (count ?elems) - tuple-class (&host/->class (str &host/tuple-class num-elems)) _ (doto *writer* - (.visitTypeInsn Opcodes/NEW tuple-class) - (.visitInsn Opcodes/DUP) - (.visitMethodInsn Opcodes/INVOKESPECIAL tuple-class "" "()V"))] - _ (map-m (fn [idx] - (exec [:let [_ (.visitInsn *writer* Opcodes/DUP)] - ret (compile (nth ?elems idx)) - :let [_ (.visitFieldInsn *writer* Opcodes/PUTFIELD tuple-class (str &&/tuple-field-prefix idx) "Ljava/lang/Object;")]] + (.visitLdcInsn (int num-elems)) + (.visitTypeInsn Opcodes/ANEWARRAY (&host/->class "java.lang.Object")))] + _ (map-m (fn [[idx elem]] + (exec [:let [_ (doto *writer* + (.visitInsn Opcodes/DUP) + (.visitLdcInsn (int idx)))] + ret (compile elem) + :let [_ (.visitInsn *writer* Opcodes/AASTORE)]] (return ret))) - (range num-elems))] + (map vector (range num-elems) ?elems))] (return nil))) (defn compile-variant [compile *type* ?tag ?value] (exec [*writer* &/get-writer - :let [variant-class* (&host/->class &host/variant-class) - _ (doto *writer* - (.visitTypeInsn Opcodes/NEW variant-class*) - (.visitInsn Opcodes/DUP) - (.visitMethodInsn Opcodes/INVOKESPECIAL variant-class* "" "()V") + :let [_ (doto *writer* + (.visitLdcInsn (int 2)) + (.visitTypeInsn Opcodes/ANEWARRAY (&host/->class "java.lang.Object")) (.visitInsn Opcodes/DUP) + (.visitLdcInsn (int 0)) (.visitLdcInsn ?tag) - (.visitFieldInsn Opcodes/PUTFIELD variant-class* "tag" (&host/->type-signature "java.lang.String")) - (.visitInsn Opcodes/DUP))] + (.visitInsn Opcodes/AASTORE) + (.visitInsn Opcodes/DUP) + (.visitLdcInsn (int 1)))] _ (compile ?value) - :let [_ (.visitFieldInsn *writer* Opcodes/PUTFIELD variant-class* "value" (&host/->type-signature "java.lang.Object"))]] + :let [_ (.visitInsn *writer* Opcodes/AASTORE)]] (return nil))) (defn compile-local [compile *type* ?idx] @@ -184,7 +184,7 @@ (fail "Can only define expressions.")))) (defn compile-self-call [compile ?scope ?assumed-args] - (prn 'compile-self-call ?scope ?assumed-args) + ;; (prn 'compile-self-call ?scope ?assumed-args) (exec [*writer* &/get-writer :let [lambda-class (&host/location ?scope)] :let [_ (doto *writer* diff --git a/src/lux/host.clj b/src/lux/host.clj index 05a2b53ba..7490bf152 100644 --- a/src/lux/host.clj +++ b/src/lux/host.clj @@ -10,8 +10,6 @@ ;; [Constants] (def prefix "lux.") -(def variant-class (str prefix "Variant")) -(def tuple-class (str prefix "Tuple")) (def function-class (str prefix "Function")) ;; [Utils] @@ -129,7 +127,7 @@ (defn [target method-name args] (let [target (Class/forName target)] (if-let [method (first (for [=method (.getMethods target) - :let [_ (prn ' '=method =method (mapv #(.getName %) (.getParameterTypes =method)))] + ;; :let [_ (prn ' '=method =method (mapv #(.getName %) (.getParameterTypes =method)))] :when (and (= target (.getDeclaringClass =method)) (= method-name (.getName =method)) (= (java.lang.reflect.Modifier/isStatic (.getModifiers =method))) diff --git a/src/lux/macro.clj b/src/lux/macro.clj index 447387649..e7c54d8ac 100644 --- a/src/lux/macro.clj +++ b/src/lux/macro.clj @@ -5,25 +5,15 @@ ;; [Utils] (defn ^:private ->lux+ [->lux loader xs] (reduce (fn [tail x] - (doto (.newInstance (.loadClass loader "lux.Variant")) - (-> .-tag (set! "Cons")) - (-> .-value (set! (doto (.newInstance (.loadClass loader "lux.Tuple2")) - (-> .-_0 (set! (->lux loader x))) - (-> .-_1 (set! tail))))))) - (doto (.newInstance (.loadClass loader "lux.Variant")) - (-> .-tag (set! "Nil")) - (-> .-value (set! (.newInstance (.loadClass loader "lux.Tuple0"))))) + (to-array ["Cons" (to-array [(->lux loader x) tail])])) + (to-array ["Nil" (to-array [])]) (reverse xs))) (defn ^:private ->lux-one [loader tag value] - (doto (.newInstance (.loadClass loader "lux.Variant")) - (-> .-tag (set! tag)) - (-> .-value (set! value)))) + (to-array [tag value])) (defn ^:private ->lux-many [->lux loader tag values] - (doto (.newInstance (.loadClass loader "lux.Variant")) - (-> .-tag (set! tag)) - (-> .-value (set! (->lux+ ->lux loader values))))) + (to-array [tag (->lux+ ->lux loader values)])) (defn ^:private ->lux [loader x] (match x @@ -48,24 +38,24 @@ )) (defn ^:private ->clojure+ [->clojure xs] - (case (.-tag xs) + (case (aget xs 0) "Nil" (list) - "Cons" (let [tuple2 (.-value xs)] - (cons (->clojure (.-_0 tuple2)) - (->clojure+ ->clojure (.-_1 tuple2)))) + "Cons" (let [tuple2 (aget xs 1)] + (cons (->clojure (aget tuple2 0)) + (->clojure+ ->clojure (aget tuple2 1)))) )) (defn ^:private ->clojure [x] - (case (.-tag x) - "Bool" [::&parser/Bool (.-value x)] - "Int" [::&parser/Int (.-value x)] - "Real" [::&parser/Real (.-value x)] - "Char" [::&parser/Char (.-value x)] - "Text" [::&parser/Text (.-value x)] - "Tag" [::&parser/Tag (.-value x)] - "Ident" [::&parser/Ident (.-value x)] - "Tuple" [::&parser/Tuple (->clojure+ ->clojure (.-value x))] - "Form" [::&parser/Form (->clojure+ ->clojure (.-value x))])) + (case (aget x 0) + "Bool" [::&parser/Bool (aget x 1)] + "Int" [::&parser/Int (aget x 1)] + "Real" [::&parser/Real (aget x 1)] + "Char" [::&parser/Char (aget x 1)] + "Text" [::&parser/Text (aget x 1)] + "Tag" [::&parser/Tag (aget x 1)] + "Ident" [::&parser/Ident (aget x 1)] + "Tuple" [::&parser/Tuple (->clojure+ ->clojure (aget x 1))] + "Form" [::&parser/Form (->clojure+ ->clojure (aget x 1))])) ;; [Resources] (defn expand [loader macro-class tokens] @@ -73,15 +63,7 @@ .getDeclaredConstructors first (.newInstance (to-array [(int 0) nil])) - ((fn [macro] (prn 'macro macro "#1") macro)) (.apply (->lux+ ->lux loader tokens)) - ;; (.impl (->lux+ ->lux loader tokens) nil) - ((fn [macro] (prn 'macro macro "#2") macro)) - (.apply nil) - ((fn [macro] (prn 'macro macro "#3") macro)) - ;; (.apply nil) - ;; ((fn [macro] (prn 'macro macro "#4?") macro)) - ) - _ (prn 'expand/output macro-class output (->> output .-_0 (->clojure+ ->clojure)))] - [(->> output .-_0 (->clojure+ ->clojure)) - (.-_1 output)])) + (.apply nil))] + [(->clojure+ ->clojure (aget output 0)) + (aget output 1)])) -- cgit v1.2.3