diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/lux/analyser/def.clj | 65 | ||||
| -rw-r--r-- | src/lux/analyser/lux.clj | 163 | ||||
| -rw-r--r-- | src/lux/analyser/module.clj | 76 | ||||
| -rw-r--r-- | src/lux/compiler.clj | 8 | ||||
| -rw-r--r-- | src/lux/compiler/lux.clj | 196 | ||||
| -rw-r--r-- | src/lux/lexer.clj | 6 |
6 files changed, 275 insertions, 239 deletions
diff --git a/src/lux/analyser/def.clj b/src/lux/analyser/def.clj deleted file mode 100644 index c44a7ea36..000000000 --- a/src/lux/analyser/def.clj +++ /dev/null @@ -1,65 +0,0 @@ -(ns lux.analyser.def - (:require (clojure [template :refer [do-template]]) - [clojure.core.match :as M :refer [matchv]] - clojure.core.match.array - (lux [base :as & :refer [|do return return* fail]]) - [lux.analyser.base :as &&])) - -(def $DEFS 0) -(def $MACROS 1) - -;; [Exports] -(def init-module - (&/R ;; "lux;defs" - (&/|table) - ;; "lux;macros" - (&/|table))) - -(do-template [<name> <category>] - (defn <name> [module name] - (fn [state] - (return* state - (->> state (&/get$ &/$MODULES) (&/|get module) (&/get$ <category>) (&/|contains? name))))) - - defined? $DEFS - macro? $MACROS - ) - -(defn declare-macro [module name] - (fn [state] - (return* (&/update$ &/$MODULES (fn [ms] (&/|update module (fn [m] (&/update$ $MACROS #(&/|put name true %) m)) ms)) state) - nil))) - -(defn define [module name type] - (fn [state] - (let [full-name (str module &/+name-separator+ name) - bound (&/V "Expression" (&/T (&/V "global" (&/T module name)) type))] - (matchv ::M/objects [(&/get$ &/$ENVS state)] - [["lux;Cons" [?env ["lux;Nil" _]]]] - (return* (->> state - (&/update$ &/$MODULES (fn [ms] - (&/|update module (fn [m] - (&/update$ $DEFS #(&/|put full-name type %) - m)) - ms))) - (&/set$ &/$ENVS (&/|list (&/update$ &/$LOCALS (fn [locals] - (&/update$ &/$MAPPINGS (fn [mappings] - (&/|put (str "" &/+name-separator+ name) bound mappings)) - locals)) - ?env)))) - nil) - - [_] - (fail "[Analyser Error] Can't create a new global definition outside of a global environment.")) - ))) - -(defn module-exists? [name] - (fn [state] - (return* state - (->> state (&/get$ &/$MODULES) (&/|contains? name))))) - -(defn unalias-module [name] - (fn [state] - (if-let [real-name (->> state (&/get$ &/$MODULE-ALIASES) (&/|get name))] - (return* state real-name) - (fail "Unknown alias.")))) diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index 1761ec1a2..e2d56c3e0 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -11,7 +11,7 @@ [lambda :as &&lambda] [case :as &&case] [env :as &&env] - [def :as &&def]))) + [module :as &&module]))) (defn ^:private analyse-1+ [analyse ?token] (&type/with-var @@ -95,48 +95,60 @@ &/|keys &/->seq (interpose " ") (reduce str "")) "}}")) -(defn ^:private type-test [exo-type binding] - (|do [btype (&&/expr-type binding) - o?? (&type/is-Type? exo-type)] - (if o?? - (|do [i?? (&type/is-Type? btype)] - (if i?? - (do ;; (println "FOUND TWO TYPES!") - (return (&/|list binding))) - (fail "[Type Error] Types don't match."))) - (|do [_ (&type/check exo-type btype)] - (return (&/|list binding)))))) - (defn analyse-symbol [analyse exo-type ident] (|do [module-name &/get-module-name] (fn [state] (|let [[?module ?name] ident + ;; _ (prn 'analyse-symbol ?module ?name) local-ident (str ?module ";" ?name) - global-ident (str (if (= "" ?module) module-name ?module) ";" ?name) stack (&/get$ &/$ENVS state) no-binding? #(and (->> % (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|contains? local-ident) not) (->> % (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS) (&/|contains? local-ident) not)) [inner outer] (&/|split-with no-binding? stack)] (matchv ::M/objects [outer] [["lux;Nil" _]] - (if-let [module-env (->> state - (&/get$ &/$MODULES) - (&/|get (if (= "" ?module) module-name ?module)))] - (if-let [def-type (do ;; (->> module-env (&/get$ &&def/$DEFS) &/|keys &/->seq (prn 'module-env global-ident)) - (->> module-env (&/get$ &&def/$DEFS) (&/|get global-ident)))] - (do ;; (prn 'GOT_DEF-TYPE global-ident) - (return* state (&/|list (&/V "Expression" (&/T (&/V "global" (&/T (if (= "" ?module) module-name ?module) ?name)) - def-type))))) - (fail* (str "[Analyser Error] Unknown module: " (if (= "" ?module) module-name ?module)))) - (fail* (str "[Analyser Error] Unrecognized identifier: " local-ident))) + (&/run-state (|do [$def (&&module/find-def (if (= "" ?module) module-name ?module) + ?name) + ;; :let [_ (println "Found def:" (if (= "" ?module) module-name ?module) + ;; ?name)] + endo-type (matchv ::M/objects [$def] + [["lux;ValueD" ?type]] + (return ?type) + + [["lux;MacroD" _]] + (return &type/Macro)) + ;; :let [_ (println "Got endo-type:" endo-type)] + _ (&type/check exo-type endo-type) + ;; :let [_ (println "Type-checked:" exo-type endo-type)] + ] + (return (&/|list (&/V "Expression" (&/T (&/V "global" (&/T (if (= "" ?module) module-name ?module) + ?name)) + endo-type))))) + state) [["lux;Cons" [?genv ["lux;Nil" _]]]] (if-let [global (->> ?genv (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|get local-ident))] - (&/run-state (type-test exo-type global) - ;; (|do [btype (&&/expr-type global) - ;; _ (&type/check exo-type btype)] - ;; (return (&/|list global))) - state) + (do ;; (prn 'GOT_GLOBAL local-ident) + (matchv ::M/objects [global] + [["Expression" [["global" [?module* ?name*]] _]]] + (&/run-state (|do [$def (&&module/find-def ?module* ?name*) + ;; :let [_ (println "Found def:" ?module* ?name*)] + endo-type (matchv ::M/objects [$def] + [["lux;ValueD" ?type]] + (return ?type) + + [["lux;MacroD" _]] + (return &type/Macro)) + ;; :let [_ (println "Got endo-type:" endo-type)] + _ (&type/check exo-type endo-type) + ;; :let [_ (println "Type-checked:" exo-type endo-type)] + ] + (return (&/|list (&/V "Expression" (&/T (&/V "global" (&/T ?module* ?name*)) + endo-type))))) + state) + + [_] + (fail* "[Analyser Error] Can't have anything other than a global def in the global environment."))) (fail* "")) [["lux;Cons" [top-outer _]]] @@ -152,10 +164,9 @@ (->> top-outer (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS) (&/|get local-ident))) (&/|list)) (&/zip2 (&/|reverse inner) scopes))] - (&/run-state (type-test exo-type =local) - ;; (|do [btype (&&/expr-type =local) - ;; _ (&type/check exo-type btype)] - ;; (return (&/|list =local))) + (&/run-state (|do [btype (&&/expr-type =local) + _ (&type/check exo-type btype)] + (return (&/|list =local))) (&/set$ &/$ENVS (&/|++ inner* outer) state))) ))) )) @@ -175,31 +186,31 @@ [["lux;Cons" [?arg ?args*]]] (do ;; (prn 'analyse-apply*/=fn (&type/show-type ?fun-type)) - (matchv ::M/objects [?fun-type] - [["lux;AllT" _]] - (&type/with-var - (fn [$var] - (|do [type* (&type/apply-type ?fun-type $var) - output (analyse-apply* analyse exo-type (&/V "Expression" (&/T ?fun-expr type*)) ?args)] - (matchv ::M/objects [output] - [["lux;Cons" [["Expression" [?expr* ?type*]] ["lux;Nil" _]]]] - (|do [type** (&type/clean $var ?type*)] - (return (&/|list (&/V "Expression" (&/T ?expr* type**))))) - - [_] - (assert false (prn-str 'analyse-apply*/output (aget output 0))))))) - - [["lux;LambdaT" [?input-t ?output-t]]] - ;; (|do [=arg (&&/analyse-1 analyse ?input-t ?arg)] - ;; (return (&/|list (&/V "Expression" (&/T (&/V "apply" (&/T =fn =arg)) - ;; ?output-t))))) - (|do [=arg (&&/analyse-1 analyse ?input-t ?arg)] - (analyse-apply* analyse exo-type (&/V "Expression" (&/T (&/V "apply" (&/T =fn =arg)) - ?output-t)) - ?args*)) - - [_] - (fail "[Analyser Error] Can't apply a non-function."))) + (matchv ::M/objects [?fun-type] + [["lux;AllT" _]] + (&type/with-var + (fn [$var] + (|do [type* (&type/apply-type ?fun-type $var) + output (analyse-apply* analyse exo-type (&/V "Expression" (&/T ?fun-expr type*)) ?args)] + (matchv ::M/objects [output] + [["lux;Cons" [["Expression" [?expr* ?type*]] ["lux;Nil" _]]]] + (|do [type** (&type/clean $var ?type*)] + (return (&/|list (&/V "Expression" (&/T ?expr* type**))))) + + [_] + (assert false (prn-str 'analyse-apply*/output (aget output 0))))))) + + [["lux;LambdaT" [?input-t ?output-t]]] + ;; (|do [=arg (&&/analyse-1 analyse ?input-t ?arg)] + ;; (return (&/|list (&/V "Expression" (&/T (&/V "apply" (&/T =fn =arg)) + ;; ?output-t))))) + (|do [=arg (&&/analyse-1 analyse ?input-t ?arg)] + (analyse-apply* analyse exo-type (&/V "Expression" (&/T (&/V "apply" (&/T =fn =arg)) + ?output-t)) + ?args*)) + + [_] + (fail (str "[Analyser Error] Can't apply a non-function: " (&type/show-type ?fun-type))))) ))) (defn analyse-apply [analyse exo-type =fn ?args] @@ -210,16 +221,18 @@ (do ;; (prn 'analyse-apply2 (aget =fn-form 0)) (matchv ::M/objects [=fn-form] [["global" [?module ?name]]] - (|do [macro? (&&def/macro? ?module ?name)] - (if macro? - (let [macro-class (&host/location (&/|list ?module ?name))] - (|do [macro-expansion (¯o/expand loader macro-class ?args) - ;; :let [_ (when (and (= "lux" ?module) - ;; (= "`" ?name)) - ;; (prn 'macro-expansion (->> macro-expansion (&/|map &/show-ast) (&/|interpose " ") (&/fold str ""))))] - ;; :let [_ (prn 'EXPANDING (&type/show-type exo-type))] - output (&/flat-map% (partial analyse exo-type) macro-expansion)] - (return output))) + (|do [$def (&&module/find-def ?module ?name)] + (matchv ::M/objects [$def] + [["lux;MacroD" _macro]] + (matchv ::M/objects [_macro] + [["lux;Some" macro]] + (|do [macro-expansion #(-> macro (.apply ?args) (.apply %))] + (&/flat-map% (partial analyse exo-type) macro-expansion)) + + [["lux;None" _]] + (fail (str "[Analyser Error] Macro has yet to be compiled: " (str ?module ";" ?name)))) + + [_] (analyse-apply* analyse exo-type =fn ?args))) [_] @@ -281,7 +294,7 @@ (defn analyse-def [analyse ?name ?value] (prn 'analyse-def/CODE ?name (&/show-ast ?value)) (|do [module-name &/get-module-name - ? (&&def/defined? module-name ?name)] + ? (&&module/defined? module-name ?name)] (if ? (fail (str "[Analyser Error] Can't redefine " ?name)) (|do [;; :let [_ (prn 'analyse-def/_0)] @@ -291,14 +304,14 @@ =value-type (&&/expr-type =value) ;; :let [_ (prn 'analyse-def/_2)] :let [_ (prn 'analyse-def/TYPE ?name (&type/show-type =value-type)) - _ (println)] - _ (&&def/define module-name ?name =value-type) - _ (if (&type/type= &type/Macro =value-type) - (&&def/declare-macro module-name ?name) - (return nil)) + _ (println) + def-data (if (&type/type= &type/Macro =value-type) + (&/V "lux;MacroD" (&/V "lux;None" nil)) + (&/V "lux;ValueD" =value-type))] + _ (&&module/define module-name ?name def-data) ;; :let [_ (prn 'analyse-def/_3)] ] - (return (&/|list (&/V "Statement" (&/V "def" (&/T ?name =value))))))))) + (return (&/|list (&/V "Statement" (&/V "def" (&/T ?name =value def-data))))))))) (defn analyse-import [analyse exo-type ?path] (return (&/|list))) diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj new file mode 100644 index 000000000..944e98580 --- /dev/null +++ b/src/lux/analyser/module.clj @@ -0,0 +1,76 @@ +(ns lux.analyser.module + (:require [clojure.core.match :as M :refer [matchv]] + clojure.core.match.array + (lux [base :as & :refer [|do return return* fail fail*]] + [type :as &type]) + [lux.analyser.base :as &&])) + +;; [Exports] +(def init-module + (&/|table)) + +(defn define [module name def-data] + (fn [state] + (matchv ::M/objects [(&/get$ &/$ENVS state)] + [["lux;Cons" [?env ["lux;Nil" _]]]] + (return* (->> state + (&/update$ &/$MODULES (fn [ms] + (&/|update module #(&/|put name def-data %) + ms))) + (&/set$ &/$ENVS (&/|list (&/update$ &/$LOCALS (fn [locals] + (&/update$ &/$MAPPINGS (fn [mappings] + (&/|put (str "" &/+name-separator+ name) + (&/V "Expression" (&/T (&/V "global" (&/T module name)) &type/$Void)) + mappings)) + locals)) + ?env)))) + nil) + + [_] + (fail "[Analyser Error] Can't create a new global definition outside of a global environment.")))) + +(defn exists? [name] + (fn [state] + (return* state + (->> state (&/get$ &/$MODULES) (&/|contains? name))))) + +(defn dealias [name] + (fn [state] + (if-let [real-name (->> state (&/get$ &/$MODULE-ALIASES) (&/|get name))] + (return* state real-name) + (fail (str "Unknown alias: " name))))) + +(defn find-def [module name] + (fn [state] + (if-let [$module (->> state (&/get$ &/$MODULES) (&/|get module))] + (if-let [$def (&/|get name $module)] + (return* state $def) + (fail* (str "[Analyser Error] Definition doesn't exist: " (str module &/+name-separator+ name)))) + (fail* (str "[Analyser Error] Module doesn't exist: " module))))) + +(defn defined? [module name] + (&/try-all% (&/|list (|do [_ (find-def module name)] + (return true)) + (return false)))) + +(defn install-macro [module name macro] + (fn [state] + (if-let [$module (->> state (&/get$ &/$MODULES) (&/|get module))] + (if-let [$def (&/|get name $module)] + (matchv ::M/objects [$def] + [["lux;MacroD" ["lux;None" _]]] + (return* (&/update$ &/$MODULES + (fn [$modules] + (&/|put module (&/|put name (&/V "lux;MacroD" (&/V "lux;Some" macro)) $module) + $modules)) + state) + nil) + + [["lux;MacroD" ["lux;Some" _]]] + (fail* (str "[Analyser Error] Can't re-install a macro: " (str module &/+name-separator+ name))) + + [_] + (fail* (str "[Analyser Error] Can't install a non-macro: " (str module &/+name-separator+ name)))) + (fail* (str "[Analyser Error] Definition doesn't exist: " (str module &/+name-separator+ name)))) + (fail* (str "[Analyser Error] Module doesn't exist: " module))) + )) diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 7bd31779a..59e3d9c36 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -14,7 +14,7 @@ [optimizer :as &optimizer] [host :as &host]) [lux.analyser.base :as &a] - [lux.analyser.def :as &a-def] + [lux.analyser.module :as &a-module] (lux.compiler [base :as &&] [lux :as &&lux] [host :as &&host] @@ -315,8 +315,8 @@ [["Statement" ?form]] (do ;; (prn 'compile-statement (aget syntax 0) (aget ?form 0)) (matchv ::M/objects [?form] - [["def" [?name ?body]]] - (&&lux/compile-def compile-expression ?name ?body) + [["def" [?name ?body ?def-data]]] + (&&lux/compile-def compile-expression ?name ?body ?def-data) [["jvm-interface" [?package ?name ?methods]]] (&&host/compile-jvm-interface compile-expression ?package ?name ?methods) @@ -375,7 +375,7 @@ (&/set$ &/$SOURCE (&/V "lux;Some" (&reader/from (str "source/" name ".lux")))) (&/set$ &/$ENVS (&/|list (&/env name))) (&/update$ &/$HOST #(&/set$ &/$WRITER (&/V "lux;Some" =class) %)) - (&/update$ &/$MODULES #(&/|put name &a-def/init-module %))))] + (&/update$ &/$MODULES #(&/|put name &a-module/init-module %))))] [["lux;Right" [?state _]]] (do (.visitEnd =class) ;; (prn 'compile-module 'DONE name) diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj index 2417a0459..f9a56e74e 100644 --- a/src/lux/compiler/lux.clj +++ b/src/lux/compiler/lux.clj @@ -10,7 +10,8 @@ [parser :as &parser] [analyser :as &analyser] [host :as &host]) - [lux.analyser.base :as &a] + (lux.analyser [base :as &a] + [module :as &a-module]) (lux.compiler [base :as &&] [lambda :as &&lambda]) ;; :reload @@ -25,18 +26,18 @@ +sig+ (&host/->type-signature "java.lang.Boolean")] (defn compile-bool [compile *type* ?value] (|do [*writer* &/get-writer - :let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC (&host/->class "java.lang.Boolean") (if ?value "TRUE" "FALSE") (&host/->type-signature "java.lang.Boolean"))]] + :let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC (&host/->class "java.lang.Boolean") (if ?value "TRUE" "FALSE") (&host/->type-signature "java.lang.Boolean"))]] (return nil)))) (do-template [<name> <class> <sig> <caster>] (let [+class+ (&host/->class <class>)] (defn <name> [compile *type* value] (|do [*writer* &/get-writer - :let [_ (doto *writer* - (.visitTypeInsn Opcodes/NEW +class+) - (.visitInsn Opcodes/DUP) - (.visitLdcInsn (<caster> value)) - (.visitMethodInsn Opcodes/INVOKESPECIAL +class+ "<init>" <sig>))]] + :let [_ (doto *writer* + (.visitTypeInsn Opcodes/NEW +class+) + (.visitInsn Opcodes/DUP) + (.visitLdcInsn (<caster> value)) + (.visitMethodInsn Opcodes/INVOKESPECIAL +class+ "<init>" <sig>))]] (return nil)))) compile-int "java.lang.Long" "(J)V" long @@ -46,121 +47,132 @@ (defn compile-text [compile *type* ?value] (|do [*writer* &/get-writer - :let [_ (.visitLdcInsn *writer* ?value)]] + :let [_ (.visitLdcInsn *writer* ?value)]] (return nil))) (defn compile-tuple [compile *type* ?elems] (|do [*writer* &/get-writer - :let [num-elems (&/|length ?elems) - _ (doto *writer* - (.visitLdcInsn (int num-elems)) - (.visitTypeInsn Opcodes/ANEWARRAY (&host/->class "java.lang.Object")))] - _ (&/map% (fn [idx+elem] - (|let [[idx elem] idx+elem] - (|do [:let [_ (doto *writer* - (.visitInsn Opcodes/DUP) - (.visitLdcInsn (int idx)))] - ret (compile elem) - :let [_ (.visitInsn *writer* Opcodes/AASTORE)]] - (return ret)))) - (&/zip2 (&/|range num-elems) ?elems))] + :let [num-elems (&/|length ?elems) + _ (doto *writer* + (.visitLdcInsn (int num-elems)) + (.visitTypeInsn Opcodes/ANEWARRAY (&host/->class "java.lang.Object")))] + _ (&/map% (fn [idx+elem] + (|let [[idx elem] idx+elem] + (|do [:let [_ (doto *writer* + (.visitInsn Opcodes/DUP) + (.visitLdcInsn (int idx)))] + ret (compile elem) + :let [_ (.visitInsn *writer* Opcodes/AASTORE)]] + (return ret)))) + (&/zip2 (&/|range num-elems) ?elems))] (return nil))) (defn compile-record [compile *type* ?elems] (|do [*writer* &/get-writer - :let [num-elems (&/|length ?elems) - _ (doto *writer* - (.visitLdcInsn (int (* 2 num-elems))) - (.visitTypeInsn Opcodes/ANEWARRAY (&host/->class "java.lang.Object")))] - _ (&/map% (fn [idx+kv] - (|let [[idx [k v]] idx+kv] - (|do [:let [idx* (* 2 idx) - _ (doto *writer* - (.visitInsn Opcodes/DUP) - (.visitLdcInsn (int idx*)) - (.visitLdcInsn k) - (.visitInsn Opcodes/AASTORE))] - :let [_ (doto *writer* - (.visitInsn Opcodes/DUP) - (.visitLdcInsn (int (inc idx*))))] - ret (compile v) - :let [_ (.visitInsn *writer* Opcodes/AASTORE)]] - (return ret)))) - (&/zip2 (&/|range num-elems) ?elems))] + :let [num-elems (&/|length ?elems) + _ (doto *writer* + (.visitLdcInsn (int (* 2 num-elems))) + (.visitTypeInsn Opcodes/ANEWARRAY (&host/->class "java.lang.Object")))] + _ (&/map% (fn [idx+kv] + (|let [[idx [k v]] idx+kv] + (|do [:let [idx* (* 2 idx) + _ (doto *writer* + (.visitInsn Opcodes/DUP) + (.visitLdcInsn (int idx*)) + (.visitLdcInsn k) + (.visitInsn Opcodes/AASTORE))] + :let [_ (doto *writer* + (.visitInsn Opcodes/DUP) + (.visitLdcInsn (int (inc idx*))))] + ret (compile v) + :let [_ (.visitInsn *writer* Opcodes/AASTORE)]] + (return ret)))) + (&/zip2 (&/|range num-elems) ?elems))] (return nil))) (defn compile-variant [compile *type* ?tag ?value] (|do [*writer* &/get-writer - :let [_ (doto *writer* - (.visitLdcInsn (int 2)) - (.visitTypeInsn Opcodes/ANEWARRAY (&host/->class "java.lang.Object")) - (.visitInsn Opcodes/DUP) - (.visitLdcInsn (int 0)) - (.visitLdcInsn ?tag) - (.visitInsn Opcodes/AASTORE) - (.visitInsn Opcodes/DUP) - (.visitLdcInsn (int 1)))] - _ (compile ?value) - :let [_ (.visitInsn *writer* Opcodes/AASTORE)]] + :let [_ (doto *writer* + (.visitLdcInsn (int 2)) + (.visitTypeInsn Opcodes/ANEWARRAY (&host/->class "java.lang.Object")) + (.visitInsn Opcodes/DUP) + (.visitLdcInsn (int 0)) + (.visitLdcInsn ?tag) + (.visitInsn Opcodes/AASTORE) + (.visitInsn Opcodes/DUP) + (.visitLdcInsn (int 1)))] + _ (compile ?value) + :let [_ (.visitInsn *writer* Opcodes/AASTORE)]] (return nil))) (defn compile-local [compile *type* ?idx] (|do [*writer* &/get-writer - :let [_ (.visitVarInsn *writer* Opcodes/ALOAD (int ?idx))]] + :let [_ (.visitVarInsn *writer* Opcodes/ALOAD (int ?idx))]] (return nil))) (defn compile-captured [compile *type* ?scope ?captured-id ?source] ;; (prn 'compile-captured ?scope ?captured-id) (|do [*writer* &/get-writer - :let [_ (doto *writer* - (.visitVarInsn Opcodes/ALOAD 0) - (.visitFieldInsn Opcodes/GETFIELD - (&host/location ?scope) - (str &&/closure-prefix ?captured-id) - "Ljava/lang/Object;"))]] + :let [_ (doto *writer* + (.visitVarInsn Opcodes/ALOAD 0) + (.visitFieldInsn Opcodes/GETFIELD + (&host/location ?scope) + (str &&/closure-prefix ?captured-id) + "Ljava/lang/Object;"))]] (return nil))) (defn compile-global [compile *type* ?owner-class ?name] (|do [*writer* &/get-writer - :let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC (&host/->class (&host/location (&/|list ?owner-class ?name))) "_datum" "Ljava/lang/Object;")]] + :let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC (&host/->class (&host/location (&/|list ?owner-class ?name))) "_datum" "Ljava/lang/Object;")]] (return nil))) (defn compile-apply [compile *type* ?fn ?arg] (|do [*writer* &/get-writer - _ (compile ?fn) - _ (compile ?arg) - :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE (&host/->class &host/function-class) "apply" &&/apply-signature)]] + _ (compile ?fn) + _ (compile ?arg) + :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE (&host/->class &host/function-class) "apply" &&/apply-signature)]] (return nil))) -(defn compile-def [compile ?name ?body] +(defn compile-def [compile ?name ?body ?def-data] (|do [*writer* &/get-writer - module-name &/get-module-name - :let [outer-class (&host/->class module-name) - datum-sig (&host/->type-signature "java.lang.Object") - current-class (&host/location (&/|list outer-class ?name)) - _ (.visitInnerClass *writer* current-class outer-class nil (+ Opcodes/ACC_STATIC Opcodes/ACC_SYNTHETIC)) - =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) - (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER) - current-class nil "java/lang/Object" (into-array [(&host/->class &host/function-class)])) - (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_datum" datum-sig nil nil) - (doto (.visitEnd))))] - ;; :let [_ (prn 'compile-def/pre-body)] - _ (&/with-writer (.visitMethod =class Opcodes/ACC_PUBLIC "<clinit>" "()V" nil nil) - (|do [**writer** &/get-writer - :let [_ (.visitCode **writer**)] - ;; :let [_ (prn 'compile-def/pre-body2)] - _ (compile ?body) - ;; :let [_ (prn 'compile-def/post-body2)] - :let [_ (doto **writer** - (.visitFieldInsn Opcodes/PUTSTATIC current-class "_datum" datum-sig) - (.visitInsn Opcodes/RETURN) - (.visitMaxs 0 0) - (.visitEnd))]] - (return nil))) - ;; :let [_ (prn 'compile-def/post-body)] - :let [_ (.visitEnd *writer*)] - ;; :let [_ (prn 'compile-def/_1 ?name current-class)] - _ (&&/save-class! current-class (.toByteArray =class)) - ;; :let [_ (prn 'compile-def/_2 ?name)] - ] + module-name &/get-module-name + :let [outer-class (&host/->class module-name) + datum-sig (&host/->type-signature "java.lang.Object") + current-class (&host/location (&/|list outer-class ?name)) + _ (.visitInnerClass *writer* current-class outer-class nil (+ Opcodes/ACC_STATIC Opcodes/ACC_SYNTHETIC)) + =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) + (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER) + current-class nil "java/lang/Object" (into-array [(&host/->class &host/function-class)])) + (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_datum" datum-sig nil nil) + (doto (.visitEnd))))] + ;; :let [_ (prn 'compile-def/pre-body)] + _ (&/with-writer (.visitMethod =class Opcodes/ACC_PUBLIC "<clinit>" "()V" nil nil) + (|do [**writer** &/get-writer + :let [_ (.visitCode **writer**)] + ;; :let [_ (prn 'compile-def/pre-body2)] + _ (compile ?body) + ;; :let [_ (prn 'compile-def/post-body2)] + :let [_ (doto **writer** + (.visitFieldInsn Opcodes/PUTSTATIC current-class "_datum" datum-sig) + (.visitInsn Opcodes/RETURN) + (.visitMaxs 0 0) + (.visitEnd))]] + (return nil))) + ;; :let [_ (prn 'compile-def/post-body)] + :let [_ (.visitEnd *writer*)] + ;; :let [_ (prn 'compile-def/_1 ?name current-class)] + _ (&&/save-class! current-class (.toByteArray =class)) + ;; :let [_ (prn 'compile-def/_2 ?name)] + loader &/loader + :let [full-macro-name (&host/location (&/|list module-name ?name))] + _ (if-let [macro (matchv ::M/objects [?def-data] + [["lux;MacroD" ["lux;None" _]]] + (-> (.loadClass loader full-macro-name) + (.getField "_datum") + (.get nil)) + + [_] + nil)] + (&a-module/install-macro module-name ?name macro) + (return nil))] (return nil))) diff --git a/src/lux/lexer.clj b/src/lux/lexer.clj index cae2fdcaf..ca63576ef 100644 --- a/src/lux/lexer.clj +++ b/src/lux/lexer.clj @@ -2,7 +2,7 @@ (:require [clojure.template :refer [do-template]] (lux [base :as & :refer [|do return* return fail fail*]] [reader :as &reader]) - [lux.analyser.def :as &def])) + [lux.analyser.module :as &module])) ;; [Utils] (defn ^:private escape-char [escaped] @@ -85,9 +85,9 @@ (|do [[_ [meta token]] (&reader/read-regex +ident-re+)] (&/try-all% (&/|list (|do [_ (&reader/read-text ";") [_ [_ local-token]] (&reader/read-regex +ident-re+)] - (&/try-all% (&/|list (|do [unaliased (&def/unalias-module token)] + (&/try-all% (&/|list (|do [unaliased (&module/dealias token)] (return (&/V "lux;Meta" (&/T meta (&/T unaliased local-token))))) - (|do [? (&def/module-exists? token)] + (|do [? (&module/exists? token)] (if ? (return (&/V "lux;Meta" (&/T meta (&/T token local-token)))) (fail (str "[Lexer Error] Unknown module: " token)))) |