diff options
Diffstat (limited to 'luxc/src')
-rw-r--r-- | luxc/src/lux/analyser/lux.clj | 19 | ||||
-rw-r--r-- | luxc/src/lux/analyser/meta.clj | 44 | ||||
-rw-r--r-- | luxc/src/lux/analyser/module.clj | 124 | ||||
-rw-r--r-- | luxc/src/lux/compiler/cache.clj | 11 | ||||
-rw-r--r-- | luxc/src/lux/compiler/core.clj | 11 | ||||
-rw-r--r-- | luxc/src/lux/compiler/jvm/cache.clj | 3 | ||||
-rw-r--r-- | luxc/src/lux/compiler/jvm/lux.clj | 92 |
7 files changed, 108 insertions, 196 deletions
diff --git a/luxc/src/lux/analyser/lux.clj b/luxc/src/lux/analyser/lux.clj index 4353caefa..0a6858a92 100644 --- a/luxc/src/lux/analyser/lux.clj +++ b/luxc/src/lux/analyser/lux.clj @@ -12,8 +12,7 @@ [case :as &&case] [env :as &&env] [module :as &&module] - [record :as &&record] - [meta :as &&meta]))) + [record :as &&record]))) ;; [Utils] ;; TODO: Walk the type to set up the parameter-type, instead of doing a @@ -579,24 +578,12 @@ _ (&&module/declare-tags module-name tags exported? def-value)] (return &/$Nil))) -(def ^:private dummy-cursor - (&/T ["" -1 -1])) - -(defn ^:private alias-annotations [original-module original-name] - (&/T [dummy-cursor - (&/$Record (&/$Cons (&/T [(&/T [dummy-cursor (&/$Tag &&meta/alias-tag)]) - (&/T [dummy-cursor (&/$Identifier (&/T [original-module original-name]))])]) - &/$Nil))])) - (defn analyse-def-alias [?alias ?original] (|let [[r-module r-name] ?original] - (|do [[_ [exported? original-type original-anns original-value]] (&&module/find-def! r-module r-name) + (|do [_ (&&module/find-def r-module r-name) module-name &/get-module-name _ (&/without-repl-closure - (&&module/define module-name ?alias false - original-type - (alias-annotations r-module r-name) - original-value))] + (&&module/define-alias module-name ?alias ?original))] (return &/$Nil)))) (defn ^:private merge-module-states diff --git a/luxc/src/lux/analyser/meta.clj b/luxc/src/lux/analyser/meta.clj deleted file mode 100644 index 53d355867..000000000 --- a/luxc/src/lux/analyser/meta.clj +++ /dev/null @@ -1,44 +0,0 @@ -(ns lux.analyser.meta - (:require (clojure [template :refer [do-template]]) - clojure.core.match - clojure.core.match.array - (lux [base :as & :refer [|let |do return return* |case]]))) - -;; [Utils] -(defn ^:private ident= [x y] - (|let [[px nx] x - [py ny] y] - (and (= px py) - (= nx ny)))) - -(def ^:private tag-prefix "lux") - -;; [Values] -(defn meta-get - "(-> Ident Code (Maybe Code))" - [ident annotations] - (|case annotations - [_ (&/$Record dict)] - (loop [dict dict] - (|case dict - (&/$Cons [_k v] dict*) - (|case _k - [_ (&/$Tag k)] - (if (ident= k ident) - (&/$Some v) - (recur dict*)) - - _ - (recur dict*)) - - (&/$Nil) - &/$None)) - - _ - &/$None)) - -(do-template [<name> <tag-name>] - (def <name> (&/T [tag-prefix <tag-name>])) - - alias-tag "alias" - ) diff --git a/luxc/src/lux/analyser/module.clj b/luxc/src/lux/analyser/module.clj index 25f6428ca..3d53155cb 100644 --- a/luxc/src/lux/analyser/module.clj +++ b/luxc/src/lux/analyser/module.clj @@ -7,8 +7,7 @@ (lux [base :as & :refer [defvariant deftuple |let |do return return* |case]] [type :as &type] [host :as &host]) - [lux.host.generics :as &host-generics] - (lux.analyser [meta :as &meta]))) + [lux.host.generics :as &host-generics])) ;; [Utils] ;; ModuleState @@ -106,10 +105,8 @@ state) nil)))) -(defn define [module name exported? def-type def-meta def-value] +(defn define-alias [module name de-aliased] (fn [state] - (when (and (= "Macro'" name) (= "lux" module)) - (&type/set-macro*-type! def-value)) (|case (&/get$ &/$scopes state) (&/$Cons ?env (&/$Nil)) (return* (->> state @@ -118,7 +115,7 @@ (&/|update module (fn [m] (&/update$ $defs - #(&/|put name (&/T [exported? def-type def-meta def-value]) %) + #(&/|put name (&/$Left de-aliased) %) m)) ms)))) nil) @@ -127,17 +124,25 @@ ((&/fail-with-loc (str "[Analyser Error] Cannot create a new global definition outside of a global environment: " (str module &/+name-separator+ name))) state)))) -(defn def-type - "(-> Text Text (Lux Type))" - [module name] +(defn define [module name exported? def-type def-meta def-value] (fn [state] - (if-let [$module (->> state (&/get$ &/$modules) (&/|get module))] - (if-let [$def (->> $module (&/get$ $defs) (&/|get name))] - (|let [[exported? ?type ?meta ?value] $def] - (return* state ?type)) - ((&/fail-with-loc (str "[Analyser Error] Unknown definition: " (str module &/+name-separator+ name))) - state)) - ((&/fail-with-loc (str "[Analyser Error] Unknown module: " module)) + (when (and (= "Macro'" name) (= "lux" module)) + (&type/set-macro*-type! def-value)) + (|case (&/get$ &/$scopes state) + (&/$Cons ?env (&/$Nil)) + (return* (->> state + (&/update$ &/$modules + (fn [ms] + (&/|update module + (fn [m] + (&/update$ $defs + #(&/|put name (&/$Right (&/T [exported? def-type def-meta def-value])) %) + m)) + ms)))) + nil) + + _ + ((&/fail-with-loc (str "[Analyser Error] Cannot create a new global definition outside of a global environment: " (str module &/+name-separator+ name))) state)))) (defn type-def @@ -146,7 +151,11 @@ (fn [state] (if-let [$module (->> state (&/get$ &/$modules) (&/|get module))] (if-let [$def (->> $module (&/get$ $defs) (&/|get name))] - (|let [[exported? ?type ?meta ?value] $def] + (|case $def + (&/$Left [o-module o-name]) + ((type-def o-module o-name) state) + + (&/$Right [exported? ?type ?meta ?value]) (if (&type/type= &type/Type ?type) (return* state (&/T [exported? ?value])) ((&/fail-with-loc (str "[Analyser Error] Not a type: " (&/ident->text (&/T [module name])) @@ -224,56 +233,50 @@ (fn [state] (if-let [$module (->> state (&/get$ &/$modules) (&/|get module))] (if-let [$def (->> $module (&/get$ $defs) (&/|get name))] - (|let [[exported? ?type ?meta ?value] $def] - (if (.equals ^Object current-module module) - (|case (&meta/meta-get &meta/alias-tag ?meta) - (&/$Some [_ (&/$Identifier [?r-module ?r-name])]) - ((find-def! ?r-module ?r-name) - state) + (|case $def + (&/$Left [?r-module ?r-name]) + ((find-def! ?r-module ?r-name) + state) - _ - (return* state (&/T [(&/T [module name]) $def]))) - (return* state (&/T [(&/T [module name]) $def])))) + (&/$Right $def*) + (return* state (&/T [(&/T [module name]) $def*]))) ((&/fail-with-loc (str "[Analyser Error @ find-def!] Definition does not exist: " (str module &/+name-separator+ name) " at module: " current-module)) state)) ((&/fail-with-loc (str "[Analyser Error @ find-def!] Module does not exist: " module " at module: " current-module)) - state)) - ))) + state))))) (defn find-def [module name] (|do [current-module &/get-module-name] (fn [state] - (if (or (= "lux" module) - (= current-module module) - (imports? state module current-module)) - (if-let [$module (->> state (&/get$ &/$modules) (&/|get module))] - (if-let [$def (->> $module (&/get$ $defs) (&/|get name))] - (|let [[exported? ?type ?meta ?value] $def] - (if (.equals ^Object current-module module) - (|case (&meta/meta-get &meta/alias-tag ?meta) - (&/$Some [_ (&/$Identifier [?r-module ?r-name])]) - ((find-def ?r-module ?r-name) - state) - - _ - (return* state (&/T [(&/T [module name]) $def]))) - (if exported? - (return* state (&/T [(&/T [module name]) $def])) - ((&/fail-with-loc (str "[Analyser Error @ find-def] Cannot use private definition: " (str module &/+name-separator+ name) - " at module: " current-module)) - state)))) - ((&/fail-with-loc (str "[Analyser Error @ find-def] Definition does not exist: " (str module &/+name-separator+ name) - " at module: " current-module)) - state)) - ((&/fail-with-loc (str "[Analyser Error @ find-def] Module does not exist: " module + (if-let [$module (->> state (&/get$ &/$modules) (&/|get module))] + (if-let [$def (->> $module (&/get$ $defs) (&/|get name))] + (|case $def + (&/$Left [?r-module ?r-name]) + (if (.equals ^Object current-module module) + ((find-def! ?r-module ?r-name) + state) + ((&/fail-with-loc (str "[Analyser Error @ find-def] Cannot use (private) alias: " (str module &/+name-separator+ name) + " at module: " current-module)) + state)) + + (&/$Right [exported? ?type ?meta ?value]) + (if (or (.equals ^Object current-module module) + (and exported? + (or (.equals ^Object module "lux") + (imports? state module current-module)))) + (return* state (&/T [(&/T [module name]) + (&/T [exported? ?type ?meta ?value])])) + ((&/fail-with-loc (str "[Analyser Error @ find-def] Cannot use private definition: " (str module &/+name-separator+ name) + " at module: " current-module)) + state))) + ((&/fail-with-loc (str "[Analyser Error @ find-def] Definition does not exist: " (str module &/+name-separator+ name) " at module: " current-module)) state)) - ((&/fail-with-loc (str "[Analyser Error @ find-def] Unknown module: " module + ((&/fail-with-loc (str "[Analyser Error @ find-def] Module does not exist: " module " at module: " current-module)) - state)) - ))) + state))))) (defn defined? [module name] (&/try-all% (&/|list (|do [_ (find-def! module name)] @@ -398,18 +401,7 @@ (def defs (|do [module &/get-module-name] (fn [state] - (return* state - (->> state (&/get$ &/$modules) (&/|get module) (&/get$ $defs) - (&/|map (fn [kv] - (|let [[k _def-data] kv - [_ _ ?def-meta _] _def-data] - (|case (&meta/meta-get &meta/alias-tag ?def-meta) - (&/$Some [_ (&/$Identifier [?r-module ?r-name])]) - (&/T [k (str ?r-module &/+name-separator+ ?r-name) _def-data]) - - _ - (&/T [k "" _def-data]) - ))))))))) + (return* state (->> state (&/get$ &/$modules) (&/|get module) (&/get$ $defs)))))) (defn fetch-imports [imports] (|case imports diff --git a/luxc/src/lux/compiler/cache.clj b/luxc/src/lux/compiler/cache.clj index 06dabe108..a0f88aa09 100644 --- a/luxc/src/lux/compiler/cache.clj +++ b/luxc/src/lux/compiler/cache.clj @@ -8,8 +8,7 @@ [type :as &type] [host :as &host]) (lux.analyser [base :as &a] - [module :as &a-module] - [meta :as &a-meta]) + [module :as &a-module]) (lux.compiler [core :as &&core] [io :as &&io]) (lux.compiler.cache [type :as &&&type] @@ -99,12 +98,8 @@ (let [parts (.split _def-entry &&core/datum-separator)] (case (alength parts) 2 (let [[_name _alias] parts - [_ __module __name] (re-find #"^(.*)\.(.*)$" _alias) - def-anns (make-record (&/|list (&/T [(make-tag &a-meta/alias-tag) - (make-identifier (&/T [__module __name]))])))] - (|do [def-type (&a-module/def-type __module __name) - def-value (load-def-value __module __name)] - (&a-module/define module _name false def-type def-anns def-value))) + [__module __name] (.split _alias &/+name-separator+)] + (&a-module/define-alias module _name (&/T [__module __name]))) 4 (let [[_name _exported? _type _anns] parts [def-anns _] (&&&ann/deserialize _anns) [def-type _] (&&&type/deserialize-type _type)] diff --git a/luxc/src/lux/compiler/core.clj b/luxc/src/lux/compiler/core.clj index f2fe09887..88da626bd 100644 --- a/luxc/src/lux/compiler/core.clj +++ b/luxc/src/lux/compiler/core.clj @@ -50,13 +50,16 @@ tag-groups &a-module/tag-groups :let [def-entries (->> defs (&/|map (fn [_def] - (|let [[?name ?alias [exported? ?def-type ?def-anns ?def-value]] _def] - (if (= "" ?alias) + (|let [[?name _definition] _def] + (|case _definition + (&/$Left [_dmodule _dname]) + (str ?name datum-separator _dmodule &/+name-separator+ _dname) + + (&/$Right [exported? ?def-type ?def-anns ?def-value]) (str ?name datum-separator (if exported? "1" "0") datum-separator (&&&type/serialize-type ?def-type) - datum-separator (&&&ann/serialize ?def-anns)) - (str ?name datum-separator ?alias))))) + datum-separator (&&&ann/serialize ?def-anns)))))) (&/|interpose entry-separator) (&/fold str "")) import-entries (->> imports diff --git a/luxc/src/lux/compiler/jvm/cache.clj b/luxc/src/lux/compiler/jvm/cache.clj index a42c7afdd..f54eacc92 100644 --- a/luxc/src/lux/compiler/jvm/cache.clj +++ b/luxc/src/lux/compiler/jvm/cache.clj @@ -9,8 +9,7 @@ [host :as &host]) [lux.host.generics :as &host-generics] (lux.analyser [base :as &a] - [module :as &a-module] - [meta :as &a-meta]) + [module :as &a-module]) (lux.compiler [core :as &&core] [io :as &&io]) (lux.compiler.jvm [base :as &&])) diff --git a/luxc/src/lux/compiler/jvm/lux.clj b/luxc/src/lux/compiler/jvm/lux.clj index 28418a6f8..bfa8b2bdb 100644 --- a/luxc/src/lux/compiler/jvm/lux.clj +++ b/luxc/src/lux/compiler/jvm/lux.clj @@ -13,8 +13,7 @@ [optimizer :as &o]) [lux.host.generics :as &host-generics] (lux.analyser [base :as &a] - [module :as &a-module] - [meta :as &a-meta]) + [module :as &a-module]) (lux.compiler.jvm [base :as &&] [function :as &&function])) (:import (org.objectweb.asm Opcodes @@ -268,71 +267,26 @@ (defn compile-def [compile ?name ?body ?meta exported?] (|do [module-name &/get-module-name class-loader &/loader] - (|case (&a-meta/meta-get &a-meta/alias-tag ?meta) - (&/$Some [_ (&/$Identifier [r-module r-name])]) - (|case ?meta - [_ (&/$Record ?meta*)] - (if (= 1 (&/|length ?meta*)) - (|do [:let [current-class (&host-generics/->class-name (str (&host/->module-class r-module) "/" (&host/def-name r-name))) - def-class (&&/load-class! class-loader current-class) - def-value (-> def-class (.getField &/value-field) (.get nil))] - def-type (&a-module/def-type r-module r-name) - _ (&/without-repl-closure - (&a-module/define module-name ?name false def-type ?meta def-value))] - (return nil)) - (&/fail-with-loc (str "[Compilation Error] Aliases cannot contain meta-data: " (str module-name &/+name-separator+ ?name))))) - - (&/$Some _) - (&/fail-with-loc "[Compilation Error] Invalid syntax for lux;alias meta-data. Must be an identifier.") - - _ - (|case (de-ann ?body) - [_ (&o/$function _ _ __scope _ _)] - (|let [[_ (&o/$function _ _arity _scope _captured ?body+)] (&o/shift-function-body (&/|tail __scope) __scope - false - (de-ann ?body))] - (|do [[file-name _ _] &/cursor - :let [datum-sig "Ljava/lang/Object;" - def-name (&host/def-name ?name) - current-class (str (&host/->module-class module-name) "/" def-name) - =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) - (.visit &host/bytecode-version class-flags - current-class nil &&/function-class (into-array String [])) - (-> (.visitField field-flags &/value-field datum-sig nil nil) - (doto (.visitEnd))) - (.visitSource file-name nil))] - instancer (&&function/compile-function compile (&/$Some =class) _arity _scope _captured ?body+) - _ (&/with-writer (.visitMethod =class Opcodes/ACC_STATIC "<clinit>" "()V" nil nil) - (|do [^MethodVisitor **writer** &/get-writer - :let [_ (.visitCode **writer**)] - _ instancer - :let [_ (.visitFieldInsn **writer** Opcodes/PUTSTATIC current-class &/value-field datum-sig)] - :let [_ (doto **writer** - (.visitInsn Opcodes/RETURN) - (.visitMaxs 0 0) - (.visitEnd))]] - (return nil))) - :let [_ (.visitEnd =class)] - _ (&&/save-class! def-name (.toByteArray =class)) - def-value (install-def! class-loader current-class module-name ?name ?body ?meta exported?) - :let [_ (println 'DEF (str module-name &/+name-separator+ ?name))]] - (return def-value))) - - _ + (|case (de-ann ?body) + [_ (&o/$function _ _ __scope _ _)] + (|let [[_ (&o/$function _ _arity _scope _captured ?body+)] (&o/shift-function-body (&/|tail __scope) __scope + false + (de-ann ?body))] (|do [[file-name _ _] &/cursor :let [datum-sig "Ljava/lang/Object;" def-name (&host/def-name ?name) current-class (str (&host/->module-class module-name) "/" def-name) =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) (.visit &host/bytecode-version class-flags - current-class nil "java/lang/Object" (into-array String [])) + current-class nil &&/function-class (into-array String [])) (-> (.visitField field-flags &/value-field datum-sig nil nil) (doto (.visitEnd))) (.visitSource file-name nil))] + instancer (&&function/compile-function compile (&/$Some =class) _arity _scope _captured ?body+) _ (&/with-writer (.visitMethod =class Opcodes/ACC_STATIC "<clinit>" "()V" nil nil) (|do [^MethodVisitor **writer** &/get-writer :let [_ (.visitCode **writer**)] - _ (compile nil ?body) + _ instancer :let [_ (.visitFieldInsn **writer** Opcodes/PUTSTATIC current-class &/value-field datum-sig)] :let [_ (doto **writer** (.visitInsn Opcodes/RETURN) @@ -344,7 +298,33 @@ def-value (install-def! class-loader current-class module-name ?name ?body ?meta exported?) :let [_ (println 'DEF (str module-name &/+name-separator+ ?name))]] (return def-value))) - )))) + + _ + (|do [[file-name _ _] &/cursor + :let [datum-sig "Ljava/lang/Object;" + def-name (&host/def-name ?name) + current-class (str (&host/->module-class module-name) "/" def-name) + =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) + (.visit &host/bytecode-version class-flags + current-class nil "java/lang/Object" (into-array String [])) + (-> (.visitField field-flags &/value-field datum-sig nil nil) + (doto (.visitEnd))) + (.visitSource file-name nil))] + _ (&/with-writer (.visitMethod =class Opcodes/ACC_STATIC "<clinit>" "()V" nil nil) + (|do [^MethodVisitor **writer** &/get-writer + :let [_ (.visitCode **writer**)] + _ (compile nil ?body) + :let [_ (.visitFieldInsn **writer** Opcodes/PUTSTATIC current-class &/value-field datum-sig)] + :let [_ (doto **writer** + (.visitInsn Opcodes/RETURN) + (.visitMaxs 0 0) + (.visitEnd))]] + (return nil))) + :let [_ (.visitEnd =class)] + _ (&&/save-class! def-name (.toByteArray =class)) + def-value (install-def! class-loader current-class module-name ?name ?body ?meta exported?) + :let [_ (println 'DEF (str module-name &/+name-separator+ ?name))]] + (return def-value)))))) (defn compile-program [compile ?program] (|do [module-name &/get-module-name |