diff options
Diffstat (limited to 'luxc/src/lux')
| -rw-r--r-- | luxc/src/lux/analyser.clj | 6 | ||||
| -rw-r--r-- | luxc/src/lux/analyser/lux.clj | 4 | ||||
| -rw-r--r-- | luxc/src/lux/analyser/module.clj | 37 | ||||
| -rw-r--r-- | luxc/src/lux/base.clj | 10 | ||||
| -rw-r--r-- | luxc/src/lux/compiler/cache.clj | 11 | ||||
| -rw-r--r-- | luxc/src/lux/compiler/jvm/lux.clj | 2 |
6 files changed, 55 insertions, 15 deletions
diff --git a/luxc/src/lux/analyser.clj b/luxc/src/lux/analyser.clj index 13bf3bc61..1202d4faf 100644 --- a/luxc/src/lux/analyser.clj +++ b/luxc/src/lux/analyser.clj @@ -162,6 +162,12 @@ (&/with-cursor cursor (&&lux/analyse-module analyse optimize eval! compile-module ?meta))) + "lux in-module" + (|let [(&/$Cons [_ (&/$Text ?module)] (&/$Cons ?expr (&/$Nil))) parameters] + (&/with-cursor cursor + (&/with-module ?module + (analyse exo-type ?expr)))) + ;; else (&/with-analysis-meta cursor exo-type (cond (.startsWith ^String ?procedure "jvm") diff --git a/luxc/src/lux/analyser/lux.clj b/luxc/src/lux/analyser/lux.clj index b9ea64839..07cf17d2f 100644 --- a/luxc/src/lux/analyser/lux.clj +++ b/luxc/src/lux/analyser/lux.clj @@ -365,7 +365,7 @@ (defn analyse-apply [analyse cursor exo-type macro-caller =fn ?args] (|case =fn [_ (&&/$def ?module ?name)] - (|do [[real-name [?type ?meta ?value]] (&&module/find-def ?module ?name)] + (|do [[real-name [?type ?meta ?value]] (&&module/find-def! ?module ?name)] (|case (&&meta/meta-get &&meta/macro?-tag ?meta) (&/$Some _) (|do [macro-expansion (fn [state] @@ -377,7 +377,7 @@ ((&/fail-with-loc error) state))) ;; module-name &/get-module-name ;; :let [[r-prefix r-name] real-name - ;; _ (when (= "refer" r-name) + ;; _ (when (= "syntax:" r-name) ;; (->> (&/|map &/show-ast macro-expansion) ;; (&/|interpose "\n") ;; (&/fold str "") diff --git a/luxc/src/lux/analyser/module.clj b/luxc/src/lux/analyser/module.clj index ef89777a4..8468249ab 100644 --- a/luxc/src/lux/analyser/module.clj +++ b/luxc/src/lux/analyser/module.clj @@ -226,6 +226,29 @@ ms)))) nil))) +(defn find-def! [module name] + (|do [current-module &/get-module-name] + (fn [state] + (if-let [$module (->> state (&/get$ &/$modules) (&/|get module))] + (if-let [$def (->> $module (&/get$ $defs) (&/|get name))] + (|let [[?type ?meta ?value] $def] + (if (.equals ^Object current-module module) + (|case (&meta/meta-get &meta/alias-tag ?meta) + (&/$Some [_ (&/$Symbol [?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])))) + ((&/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)) + ))) + (defn find-def [module name] (|do [current-module &/get-module-name] (fn [state] @@ -248,13 +271,17 @@ (return* state (&/T [(&/T [module name]) $def])) _ - ((&/fail-with-loc (str "[Analyser Error @ find-def] Cannot use unexported definition: " (str module &/+name-separator+ name))) + ((&/fail-with-loc (str "[Analyser Error @ find-def] Cannot use unexported 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))) + ((&/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)) + ((&/fail-with-loc (str "[Analyser Error @ find-def] Module does not exist: " module + " at module: " current-module)) state)) - ((&/fail-with-loc (str "[Analyser Error @ find-def] Unknown module: " module)) + ((&/fail-with-loc (str "[Analyser Error @ find-def] Unknown module: " module + " at module: " current-module)) state)) ))) @@ -270,7 +297,7 @@ (&/fail-with-loc (str "[Analyser Error] Not a type definition: " (&/adt->text def-data)))))) (defn defined? [module name] - (&/try-all% (&/|list (|do [_ (find-def module name)] + (&/try-all% (&/|list (|do [_ (find-def! module name)] (return true)) (return false)))) diff --git a/luxc/src/lux/base.clj b/luxc/src/lux/base.clj index ae9b2bb47..ee4bcde10 100644 --- a/luxc/src/lux/base.clj +++ b/luxc/src/lux/base.clj @@ -1437,6 +1437,16 @@ ($Left msg) ($Left msg)))) +(defn with-module [name body] + (fn [state] + (|case (body (set$ $current-module ($Some name) state)) + ($Right [state* output]) + ($Right (T [(set$ $current-module (get$ $current-module state) state*) + output])) + + ($Left msg) + ($Left msg)))) + (defn |eitherL [left right] (fn [compiler] (|case (run-state left compiler) diff --git a/luxc/src/lux/compiler/cache.clj b/luxc/src/lux/compiler/cache.clj index 28cfe53ee..4ec18798e 100644 --- a/luxc/src/lux/compiler/cache.clj +++ b/luxc/src/lux/compiler/cache.clj @@ -135,18 +135,15 @@ imports (if (= [""] imports) &/$Nil (&/->list imports))] - (&/|map #(.split ^String % &&core/datum-separator 2) imports))] - cache-table* (&/fold% (fn [cache-table* _import] - (|do [:let [[_module _hash] _import] - [file-name file-content] (&&io/read-file source-dirs _module) + (&/|map #(first (vec (.split ^String % &&core/datum-separator 2))) imports))] + cache-table* (&/fold% (fn [cache-table* _module] + (|do [[file-name file-content] (&&io/read-file source-dirs _module) output (pre-load! source-dirs cache-table* _module (hash file-content) load-def-value install-all-defs-in-module uninstall-all-defs-in-module)] (return output))) cache-table imports)] - (if (&/|every? (fn [_import] - (|let [[_module _hash] _import] - (contains? cache-table* _module))) + (if (&/|every? (fn [_module] (contains? cache-table* _module)) imports) (let [tag-groups (parse-tag-groups _tags-section) [?module-anns _] (if (= "..." _module-anns-section) diff --git a/luxc/src/lux/compiler/jvm/lux.clj b/luxc/src/lux/compiler/jvm/lux.clj index 024abeb73..d98c7537b 100644 --- a/luxc/src/lux/compiler/jvm/lux.clj +++ b/luxc/src/lux/compiler/jvm/lux.clj @@ -117,7 +117,7 @@ (defn compile-apply [compile ?fn ?args] (|case ?fn [_ (&o/$def ?module ?name)] - (|do [[_ [_ _ func-obj]] (&a-module/find-def ?module ?name) + (|do [[_ [_ _ func-obj]] (&a-module/find-def! ?module ?name) class-loader &/loader :let [func-class (class func-obj) func-arity (.get ^Field (.getDeclaredField func-class &&/arity-field) nil) |