aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/lux/analyser/def.clj65
-rw-r--r--src/lux/analyser/lux.clj163
-rw-r--r--src/lux/analyser/module.clj76
-rw-r--r--src/lux/compiler.clj8
-rw-r--r--src/lux/compiler/lux.clj196
-rw-r--r--src/lux/lexer.clj6
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 (&macro/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))))