From 2caf39ea09ae96669466e0e17fd2949347acda7a Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 1 Mar 2015 17:16:52 -0400 Subject: - Fixed some bugs with pattern matching and macros. - Simplified the code for handling definitions and macros. - Slightly changed the names of the fields of tuple classes. - Added a (currently empty) optimization phase. --- source/lux.lux | 84 +++++++++++++++++++++++++++++++++------------ src/lux.clj | 2 ++ src/lux/analyser.clj | 5 +-- src/lux/analyser/base.clj | 2 +- src/lux/analyser/case.clj | 4 +-- src/lux/analyser/def.clj | 44 ++++++++++-------------- src/lux/analyser/env.clj | 1 + src/lux/analyser/host.clj | 2 +- src/lux/analyser/lux.clj | 44 +++++++++++++++--------- src/lux/compiler.clj | 22 +++++++----- src/lux/compiler/case.clj | 7 ++-- src/lux/compiler/lambda.clj | 3 +- src/lux/compiler/lux.clj | 16 ++++----- src/lux/macro.clj | 58 ++++++++++++++++++------------- src/lux/optimizer.clj | 5 +++ 15 files changed, 184 insertions(+), 115 deletions(-) create mode 100644 src/lux/optimizer.clj diff --git a/source/lux.lux b/source/lux.lux index 8c1cb5695..03c2a6054 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -5,33 +5,33 @@ (jvm;class Tuple0 java.lang.Object []) (jvm;class Tuple1 java.lang.Object - [[java.lang.Object _1]]) + [[java.lang.Object _0]]) (jvm;class Tuple2 java.lang.Object - [[java.lang.Object _1] [java.lang.Object _2]]) + [[java.lang.Object _0] [java.lang.Object _1]]) (jvm;class Tuple3 java.lang.Object - [[java.lang.Object _1] [java.lang.Object _2] - [java.lang.Object _3]]) + [[java.lang.Object _0] [java.lang.Object _1] + [java.lang.Object _2]]) (jvm;class Tuple4 java.lang.Object - [[java.lang.Object _1] [java.lang.Object _2] - [java.lang.Object _3] [java.lang.Object _4]]) + [[java.lang.Object _0] [java.lang.Object _1] + [java.lang.Object _2] [java.lang.Object _3]]) (jvm;class Tuple5 java.lang.Object - [[java.lang.Object _1] [java.lang.Object _2] - [java.lang.Object _3] [java.lang.Object _4] - [java.lang.Object _5]]) + [[java.lang.Object _0] [java.lang.Object _1] + [java.lang.Object _2] [java.lang.Object _3] + [java.lang.Object _4]]) (jvm;class Tuple6 java.lang.Object - [[java.lang.Object _1] [java.lang.Object _2] - [java.lang.Object _3] [java.lang.Object _4] - [java.lang.Object _5] [java.lang.Object _6]]) + [[java.lang.Object _0] [java.lang.Object _1] + [java.lang.Object _2] [java.lang.Object _3] + [java.lang.Object _4] [java.lang.Object _5]]) (jvm;class Tuple7 java.lang.Object - [[java.lang.Object _1] [java.lang.Object _2] - [java.lang.Object _3] [java.lang.Object _4] - [java.lang.Object _5] [java.lang.Object _6] - [java.lang.Object _7]]) + [[java.lang.Object _0] [java.lang.Object _1] + [java.lang.Object _2] [java.lang.Object _3] + [java.lang.Object _4] [java.lang.Object _5] + [java.lang.Object _6]]) (jvm;class Tuple8 java.lang.Object - [[java.lang.Object _1] [java.lang.Object _2] - [java.lang.Object _3] [java.lang.Object _4] - [java.lang.Object _5] [java.lang.Object _6] - [java.lang.Object _7] [java.lang.Object _8]]) + [[java.lang.Object _0] [java.lang.Object _1] + [java.lang.Object _2] [java.lang.Object _3] + [java.lang.Object _4] [java.lang.Object _5] + [java.lang.Object _6] [java.lang.Object _7]]) (jvm;class Variant java.lang.Object [[java.lang.String tag] [java.lang.Object value]]) @@ -46,6 +46,49 @@ #Nil]) state]) ))) +(declare-macro let') + +(def' lambda + (lambda' _ tokens + (lambda' _ state + (let' output (case' tokens + (#Cons [(#Form (#Cons [self (#Cons [arg args'])])) (#Cons [body #Nil])]) + (#Form (#Cons [(#Ident "lambda'") + (#Cons [self + (#Cons [arg + (#Cons [(case' args' + #Nil + body + + _ + (#Form (#Cons [(#Ident "lux;lambda") + (#Cons [(#Form (#Cons [(#Ident "_") args'])) + (#Cons [body #Nil])])]))) + #Nil])])])]))) + [(#Cons [output #Nil]) state]) + ))) +(declare-macro lambda) + +## (def' lambda +## (lambda' _ tokens +## (lambda' _ state +## (let' output (case' tokens +## (#Cons [(#Form (#Cons [self (#Cons [arg args'])])) (#Cons [body #Nil])]) +## (#Form (#Cons [(#Ident "lambda'") +## (#Cons [self +## (#Cons [arg +## (#Cons [(case' args' +## #Nil +## body + +## _ +## (#Form (#Cons [(#Ident "lux;lambda") +## (#Cons [(#Form (#Cons [(#Ident "_") args'])) +## (#Cons [body #Nil])])]))) +## #Nil])])])]))) +## [(#Cons [output #Nil]) state]) +## ))) + ## (def' lambda ## (lambda' _ tokens @@ -66,7 +109,6 @@ ## #Nil])])])]))) ## [(#Cons output #Nil) state]) ## ))) -## (declare-macro lambda) ## (def' def ## (lambda (_ tokens state) diff --git a/src/lux.clj b/src/lux.clj index b42d0bb42..ccab7ec3f 100644 --- a/src/lux.clj +++ b/src/lux.clj @@ -25,3 +25,5 @@ ;; jar cvf test2.jar *.class test2 && java -cp "test2.jar" test2 ;; cd output && jar cvf test2.jar * && java -cp "test2.jar" test2 && cd .. ) + + diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index fccbb4377..e46d424f2 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -14,7 +14,7 @@ ;; [Utils] (defn ^:private analyse-basic-ast [analyse-ast token] - (prn 'analyse-basic-ast token) + ;; (prn 'analyse-basic-ast token) (match token ;; Standard special forms [::&parser/Bool ?value] @@ -181,5 +181,6 @@ ;; [Resources] (def analyse (exec [asts &parser/parse - :let [_ (prn 'analyse/asts asts)]] + ;; :let [_ (prn 'analyse/asts asts)] + ] (mapcat-m analyse-ast asts))) diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj index c4da0511d..f9028673d 100644 --- a/src/lux/analyser/base.clj +++ b/src/lux/analyser/base.clj @@ -6,7 +6,7 @@ ;; [Resources] (defn expr-type [syntax+] - (prn 'expr-type syntax+) + ;; (prn 'expr-type syntax+) (match syntax+ [::Expression _ type] (return type) diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj index bbd454fc1..4aec4af10 100644 --- a/src/lux/analyser/case.clj +++ b/src/lux/analyser/case.clj @@ -24,11 +24,11 @@ (list))) (defn analyse-branch [analyse 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* _] (&env/with-local "#" :local &type/+dont-care-type+ body*)) (&&/analyse-1 analyse body) (range (- max-registers (count bindings)))) - bindings)) - + (reverse bindings))) diff --git a/src/lux/analyser/def.clj b/src/lux/analyser/def.clj index c8994bc67..c6443ca22 100644 --- a/src/lux/analyser/def.clj +++ b/src/lux/analyser/def.clj @@ -1,43 +1,35 @@ (ns lux.analyser.def - (:require [clojure.core.match :refer [match]] + (:require (clojure [template :refer [do-template]]) + [clojure.core.match :refer [match]] (lux [base :as & :refer [exec return fail if-m try-all-m map-m mapcat-m reduce-m assert!]]) [lux.analyser.base :as &&])) ;; [Exports] -(defn defined? [module name] - (fn [state] - [::&/ok [state (get-in state [::&/modules module name :defined?])]])) +(def init-module + {::defs {} + ::macros #{}}) -(defn annotated? [module name] - (fn [state] - [::&/ok [state (boolean (get-in state [::&/modules module name]))]])) +(do-template [ ] + (defn [module name] + (fn [state] + [::&/ok [state (boolean (get-in state [::&/modules module name]))]])) + + defined? ::defs + macro? ::macros + ) -(defn macro? [module name] +(defn declare-macro [module name] (fn [state] - [::&/ok [state (boolean (get-in state [::&/modules module :macros name]))]])) + [::&/ok [(update-in state [::&/modules module ::macros] conj name) + nil]])) -(defn annotate [module name access type] +(defn define [module name type] (fn [state] (let [full-name (str module &/+name-separator+ name) bound [::&&/Expression [::&&/global module name] type]] [::&/ok [(-> state - (assoc-in [::&/modules module name] {:args-n [:None] - :access access - :type type - :defined? false}) + (assoc-in [::&/modules module ::defs name] type) (update-in [::&/global-env] merge {full-name bound, name bound})) nil]]))) - -(defn declare-macro [module name] - (fn [state] - [::&/ok [(assoc-in state [::&/modules module :macros name] true) - nil]])) - -(defn define [module name] - (if-m (annotated? module name) - (fn [state] - [::&/ok [(assoc-in state [::&/modules module name :defined?] true) - nil]]) - (fail (str "[Analyser Error] Can't define an unannotated element: " name)))) diff --git a/src/lux/analyser/env.clj b/src/lux/analyser/env.clj index 020b9a899..c68641f7e 100644 --- a/src/lux/analyser/env.clj +++ b/src/lux/analyser/env.clj @@ -15,6 +15,7 @@ (let [old-mappings (-> state ::&/local-envs first (get-in [:locals :mappings])) =return (body (update-in state [::&/local-envs] (fn [[top & stack]] + (prn 'env/with-local name mode (get-in top [:locals :counter])) (let [bound-unit (case mode :self [::&&/self (list)] :local [::&&/local (get-in top [:locals :counter])])] diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index e27745748..fd4444671 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -116,7 +116,7 @@ (return (list [::&&/Statement [::&&/jvm-class $module ?name ?super-class =fields {}]])))) (defn analyse-jvm-interface [analyse ?name ?members] - (prn 'analyse-jvm-interface ?name ?members) + ;; (prn 'analyse-jvm-interface ?name ?members) (exec [?members (map-m (fn [member] (match member [::&parser/Form ([[::&parser/Ident ":"] [::&parser/Ident ?member-name] diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index c821a085d..4dc949d05 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -56,8 +56,11 @@ [::&&/global ?module ?name] (exec [macro? (&&def/macro? ?module ?name)] (if macro? - (let [macro-class (&host/location (list ?name ?module)) - [macro-expansion state*] (¯o/expand loader macro-class ?args)] + (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))] (mapcat-m analyse macro-expansion)) (exec [=args (mapcat-m analyse ?args) :let [[needs-num =return-type] (match =fn-type @@ -78,18 +81,26 @@ )) (defn analyse-case [analyse ?variant ?branches] - (exec [=variant (&&/analyse-1 analyse ?variant) - _ (assert! (and (> (count ?branches) 0) (even? (count ?branches))) + (prn 'analyse-case ?variant ?branches) + (exec [:let [num-branches (count ?branches)] + _ (assert! (and (> num-branches 0) (even? num-branches)) "Unbalanced branches in \"case'\" expression.") :let [branches (partition 2 ?branches) - locals-per-branch (map &&case/locals (map first 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])] base-register &&env/next-local-idx + :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)] =bodies (map-m (partial &&case/analyse-branch analyse max-locals) (map vector locals-per-branch (map second branches))) - :let [_ (prn 'analyse-case/=bodies =bodies)] + :let [_ (prn '=bodies =bodies)] + ;; :let [_ (prn 'analyse-case/=bodies =bodies)] =body-types (map-m &&/expr-type =bodies) - =case-type (reduce-m &type/merge [::&type/Nothing] =body-types) + =case-type (return [::&type/Any]) ;; (reduce-m &type/merge [::&type/Nothing] =body-types) :let [=branches (map vector (map first branches) =bodies)]] (return (list [::&&/Expression [::&&/case =variant base-register max-locals =branches] =case-type])))) @@ -100,13 +111,14 @@ (&&/analyse-1 analyse ?body)) =body-type (&&/expr-type =body) =lambda-type (exec [_ (&type/solve =return =body-type)] - (&type/clean =lambda-type)) + (&type/clean =lambda-type)) :let [=lambda-form (match =body - [::&&/Expression [::&&/lambda ?sub-scope ?sub-captured ?sub-args ?sub-body] _] - [::&&/lambda =scope =captured (cons ?arg ?sub-args) (&&lambda/raise-expr ?arg ?sub-body)] + [::&&/Expression [::&&/lambda ?sub-scope ?sub-captured ?sub-args ?sub-body] _] + [::&&/lambda =scope =captured (cons ?arg ?sub-args) (&&lambda/raise-expr ?arg ?sub-body)] - _ - [::&&/lambda =scope =captured (list ?arg) =body])]] + _ + [::&&/lambda =scope =captured (list ?arg) =body]) + _ (prn '=lambda-form =lambda-form)]] (return (list [::&&/Expression =lambda-form =lambda-type])))) (defn analyse-def [analyse ?name ?value] @@ -127,14 +139,12 @@ _ (fail "")) =value-type (&&/expr-type =value) - _ (if-m (&&def/annotated? module-name ?name) - (return nil) - (&&def/annotate module-name ?name :public =value-type)) - _ (&&def/define module-name ?name)] + _ (&&def/define module-name ?name =value-type)] (return (list [::&&/Statement [::&&/def ?name =value]])))))) (defn analyse-declare-macro [?ident] - (exec [_ (&&def/annotate ?ident :public [::&type/Any])] + (exec [module-name &/get-module-name + _ (&&def/declare-macro module-name ?ident)] (return (list)))) (defn analyse-require [analyse ?path] diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 17748a1eb..c32d1218a 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -12,8 +12,10 @@ [lexer :as &lexer] [parser :as &parser] [analyser :as &analyser] + [optimizer :as &optimizer] [host :as &host]) [lux.analyser.base :as &a] + [lux.analyser.def :as &a-def] (lux.compiler [base :as &&] [lux :as &&lux] [host :as &&host] @@ -27,7 +29,7 @@ ;; [Utils/Compilers] (defn ^:private compile-expression [syntax] - (prn 'compile-expression syntax) + ;; (prn 'compile-expression syntax) (match syntax [::&a/Expression ?form ?type] (match ?form @@ -171,7 +173,7 @@ (fail "[Compiler Error] Can't compile statements as expressions."))) (defn ^:private compile-statement [syntax] - (prn 'compile-statement syntax) + ;; (prn 'compile-statement syntax) (match syntax [::&a/Statement ?form] (match ?form @@ -187,8 +189,9 @@ _ (fail "[Compiler Error] Can't compile expressions as top-level forms."))) -(let [compiler-step (exec [analysis+ &analyser/analyse - :let [_ (prn 'analysis+ analysis+)]] +(let [compiler-step (exec [analysis+ &optimizer/optimize + ;; :let [_ (prn 'analysis+ analysis+)] + ] (mapcat-m compile-statement analysis+))] (defn ^:private compile-module [name] (fn [state] @@ -197,13 +200,14 @@ (let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) (&host/->class name) nil "java/lang/Object" nil))] - (match (&/run-state (exhaust-m compiler-step) (assoc state - ::&/source (slurp (str "source/" name ".lux")) - ::&/global-env (&/env name) - ::&/writer =class)) + (match (&/run-state (exhaust-m compiler-step) (-> state + (assoc ::&/source (slurp (str "source/" name ".lux")) + ::&/global-env (&/env name) + ::&/writer =class) + (assoc-in [::&/modules name] &a-def/init-module))) [::&/ok [?state ?vals]] (do (.visitEnd =class) - (prn 'compile-module/?vals ?vals) + ;; (prn 'compile-module/?vals ?vals) (&/run-state (&&/save-class! name (.toByteArray =class)) ?state)) [::&/failure ?message] diff --git a/src/lux/compiler/case.clj b/src/lux/compiler/case.clj index ba27d2c12..593a85d34 100644 --- a/src/lux/compiler/case.clj +++ b/src/lux/compiler/case.clj @@ -158,6 +158,7 @@ (let [ex-class (&host/->class "java.lang.IllegalStateException")] (defn ^:private compile-pattern-matching [writer compile mappings patterns $end] + ;; (prn 'compile-pattern-matching patterns) (let [entries (for [[?branch ?body] mappings :let [label (new Label)]] [[?branch label] @@ -167,7 +168,7 @@ (-> (doto (compile-match ?match (get mappings* ?body) $else) (.visitLabel $else)) (->> (doseq [[_ ?body ?match :as pattern] patterns - :let [_ (prn 'compile-pattern-matching/pattern pattern) + :let [;; _ (prn 'compile-pattern-matching/pattern pattern) $else (new Label)]]))) (.visitInsn Opcodes/POP) (.visitTypeInsn Opcodes/NEW ex-class) @@ -195,9 +196,9 @@ :let [_ (doto *writer* (.visitInsn Opcodes/DUP) (.visitLabel $start))] - :let [_ (prn "PRE Compiled ?branches")] + ;; :let [_ (prn "PRE Compiled ?branches")] :let [[mappings patterns] (process-branches ?base-register ?branches)] _ (compile-pattern-matching *writer* compile mappings patterns $end) - :let [_ (prn "POST Compiled ?branches")] + ;; :let [_ (prn "POST Compiled ?branches")] :let [_ (.visitLabel *writer* $end)]] (return nil))) diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj index 0b7ad1183..5c83b159e 100644 --- a/src/lux/compiler/lambda.clj +++ b/src/lux/compiler/lambda.clj @@ -93,7 +93,7 @@ (.visitTypeInsn Opcodes/NEW class-name) (.visitInsn Opcodes/DUP) (add-closure-vars class-name closed-over) - (.visitLdcInsn (int current-captured)) + (.visitLdcInsn (int (inc current-captured))) (add-partial-vars class-name (take current-captured args)) (.visitVarInsn Opcodes/ALOAD 1) (&&/add-nulls (- (dec num-captured) current-captured)) @@ -162,6 +162,7 @@ ;; [Resources] (defn compile-lambda [compile *type* ?scope ?closure ?args ?body with-datum? instance?] + (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 81d68c31c..cbab1fdd4 100644 --- a/src/lux/compiler/lux.clj +++ b/src/lux/compiler/lux.clj @@ -56,20 +56,20 @@ :let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC (&host/->class "java.lang.Boolean") (if ?value "TRUE" "FALSE") (&host/->type-signature "java.lang.Boolean"))]] (return nil)))) -(do-template [ ] +(do-template [ ] (let [+class+ (&host/->class )] (defn [compile *type* value] (exec [*writer* &/get-writer :let [_ (doto *writer* - (.visitTypeInsn Opcodes/NEW ) + (.visitTypeInsn Opcodes/NEW +class+) (.visitInsn Opcodes/DUP) - (.visitLdcInsn value) - (.visitMethodInsn Opcodes/INVOKESPECIAL "" ))]] + (.visitLdcInsn ( value)) + (.visitMethodInsn Opcodes/INVOKESPECIAL +class+ "" ))]] (return nil)))) - compile-int "java.lang.Long" "(J)V" - compile-real "java.lang.Double" "(D)V" - compile-char "java.lang.Character" "(C)V" + compile-int "java.lang.Long" "(J)V" long + compile-real "java.lang.Double" "(D)V" double + compile-char "java.lang.Character" "(C)V" char ) (defn compile-text [compile *type* ?value] @@ -88,7 +88,7 @@ _ (map-m (fn [idx] (exec [:let [_ (.visitInsn *writer* Opcodes/DUP)] ret (compile (nth ?elems idx)) - :let [_ (.visitFieldInsn *writer* Opcodes/PUTFIELD tuple-class (str &&/partial-prefix idx) "Ljava/lang/Object;")]] + :let [_ (.visitFieldInsn *writer* Opcodes/PUTFIELD tuple-class (str &&/tuple-field-prefix idx) "Ljava/lang/Object;")]] (return ret))) (range num-elems))] (return nil))) diff --git a/src/lux/macro.clj b/src/lux/macro.clj index 511ffb7a7..76784a4a9 100644 --- a/src/lux/macro.clj +++ b/src/lux/macro.clj @@ -5,23 +5,25 @@ ;; [Utils] (defn ^:private ->lux+ [->lux loader xs] (reduce (fn [tail x] - (doto (.newInstance (.loadClass loader "lux.Variant2")) + (doto (.newInstance (.loadClass loader "lux.Variant")) (-> .-tag (set! "Cons")) - (-> .-_1 (set! (->lux loader x))) - (-> .-_2 (set! tail)))) - (doto (.newInstance (.loadClass loader "lux.Variant0")) - (-> .-tag (set! "Nil"))) + (-> .-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"))))) (reverse xs))) (defn ^:private ->lux-one [loader tag value] - (doto (.newInstance (.loadClass loader "lux.Variant1")) + (doto (.newInstance (.loadClass loader "lux.Variant")) (-> .-tag (set! tag)) - (-> .-_1 (set! value)))) + (-> .-value (set! value)))) (defn ^:private ->lux-many [->lux loader tag values] - (doto (.newInstance (.loadClass loader "lux.Variant1")) + (doto (.newInstance (.loadClass loader "lux.Variant")) (-> .-tag (set! tag)) - (-> .-_1 (set! (->lux+ ->lux loader values))))) + (-> .-value (set! (->lux+ ->lux loader values))))) (defn ^:private ->lux [loader x] (match x @@ -48,21 +50,22 @@ (defn ^:private ->clojure+ [->clojure xs] (case (.-tag xs) "Nil" (list) - "Cons" (cons (->clojure (.-_1 xs)) - (->clojure+ ->clojure (.-_2 xs))) + "Cons" (let [tuple2 (.-value xs)] + (cons (->clojure (.-_0 tuple2)) + (->clojure+ ->clojure (.-_1 tuple2)))) )) (defn ^:private ->clojure [x] (case (.-tag x) - "Bool" [::&parser/Bool (.-_1 x)] - "Int" [::&parser/Int (.-_1 x)] - "Real" [::&parser/Real (.-_1 x)] - "Char" [::&parser/Char (.-_1 x)] - "Text" [::&parser/Text (.-_1 x)] - "Tag" [::&parser/Tag (.-_1 x)] - "Ident" [::&parser/Ident (.-_1 x)] - "Tuple" [::&parser/Tuple (->clojure+ ->clojure (.-_1 x))] - "Form" [::&parser/Form (->clojure+ ->clojure (.-_1 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))])) ;; [Resources] (defn expand [loader macro-class tokens] @@ -70,7 +73,14 @@ .getDeclaredConstructors first (.newInstance (to-array [(int 0) nil])) - (.apply (->lux+ ->lux loader tokens)) - (.apply nil))] - [(->> output .-_1 (->clojure+ ->clojure)) - (.-_2 output)])) + ((fn [macro] (prn 'macro macro "#1") macro)) + (.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)])) diff --git a/src/lux/optimizer.clj b/src/lux/optimizer.clj new file mode 100644 index 000000000..c032bc7fb --- /dev/null +++ b/src/lux/optimizer.clj @@ -0,0 +1,5 @@ +(ns lux.optimizer + (:require [lux.analyser :as &analyser])) + +;; [Exports] +(def optimize &analyser/analyse) -- cgit v1.2.3