diff options
Diffstat (limited to 'lux-bootstrapper')
-rw-r--r-- | lux-bootstrapper/src/lux/analyser.clj | 8 | ||||
-rw-r--r-- | lux-bootstrapper/src/lux/analyser/lux.clj | 30 | ||||
-rw-r--r-- | lux-bootstrapper/src/lux/analyser/module.clj | 47 | ||||
-rw-r--r-- | lux-bootstrapper/src/lux/compiler/core.clj | 4 | ||||
-rw-r--r-- | lux-bootstrapper/src/lux/compiler/jvm.clj | 2 | ||||
-rw-r--r-- | lux-bootstrapper/src/lux/compiler/jvm/lux.clj | 2 |
6 files changed, 43 insertions, 50 deletions
diff --git a/lux-bootstrapper/src/lux/analyser.clj b/lux-bootstrapper/src/lux/analyser.clj index 32d6a0e58..0e7b4b48a 100644 --- a/lux-bootstrapper/src/lux/analyser.clj +++ b/lux-bootstrapper/src/lux/analyser.clj @@ -98,14 +98,6 @@ (&/with-location location (&&lux/analyse-def analyse optimize eval! compile-def ?name ?value exported?))) - (&/$Identifier "library/lux" "alias#") - (|let [(&/$Item [_ (&/$Identifier "" ?alias)] - (&/$Item [_ (&/$Identifier ?original)] - (&/$End) - )) parameters] - (&/with-location location - (&&lux/analyse-def-alias ?alias ?original))) - (&/$Identifier "library/lux" "module#") (|let [(&/$Item ?imports (&/$End)) parameters] (&/with-location location diff --git a/lux-bootstrapper/src/lux/analyser/lux.clj b/lux-bootstrapper/src/lux/analyser/lux.clj index d28a92051..64238bc62 100644 --- a/lux-bootstrapper/src/lux/analyser/lux.clj +++ b/lux-bootstrapper/src/lux/analyser/lux.clj @@ -290,7 +290,7 @@ (analyse-tuple analyse (&/$Right exo-type) ?elems)))) (defn ^:private analyse-global [analyse exo-type quoted_module module name] - (|do [[[r-module r-name] [exported? endo-type ?value]] (&&module/find-def quoted_module module name) + (|do [[[r-module r-name] [exported? [endo-type ?value]]] (&&module/find-def quoted_module module name) ;; This is a small shortcut to optimize analysis of typing code. _ (if (and (&type/type= &type/Type endo-type) (&type/type= &type/Type exo-type)) @@ -403,7 +403,7 @@ (defn analyse-apply [analyse location exo-type macro-caller =fn ?args] (|case =fn [_ (&&/$def ?module ?name)] - (|do [[real-name [exported? ?type ?value]] (&&module/find-def! ?module ?name)] + (|do [[real-name [exported? [?type ?value]]] (&&module/find-def! ?module ?name)] (if (&type/type= &type/Macro ?type) (|do [macro-expansion (fn [state] (|case (macro-caller ?value ?args state) @@ -592,27 +592,29 @@ (&/with-expected-type ?expected-type (&&/analyse-1 analyse ?expected-type ?value)) (&&/analyse-1+ analyse ?value)))) + :let [aliased (|case =value + [_ (&&/$def ?original)] + ?original + + _ + nil)] ==exported? (eval analyse optimize eval! &type/Bit exported?) - def-value (compile-def ?name (optimize =value) ==exported?) + def-value (if aliased + (&/without-repl-closure + (&&module/define-alias module-name ?name ==exported? aliased)) + (compile-def ?name (optimize =value) ==exported?)) _ &type/reset-mappings :let [def-type (&&/expr-type* =value) - _ (println 'DEF (str module-name &/+name-separator+ ?name - " : " (&type/show-type def-type)))]] + _ (if aliased + nil + (println 'DEF (str module-name &/+name-separator+ ?name + " : " (&type/show-type def-type))))]] (return (&/T [module-name def-type def-value ==exported?])))) (defn analyse-def [analyse optimize eval! compile-def ?name ?value exported?] (|do [_ (analyse-def* analyse optimize eval! compile-def ?name ?value exported?)] (return &/$End))) -(defn analyse-def-alias [?alias ?original] - (|let [[r-module r-name] ?original] - (|do [module-name &/get-module-name - _ (ensure-undefined! module-name ?alias) - _ (&&module/find-def "" r-module r-name) - _ (&/without-repl-closure - (&&module/define-alias module-name ?alias ?original))] - (return &/$End)))) - (defn ^:private merge-module-states "(-> Host Host Host)" [new old] diff --git a/lux-bootstrapper/src/lux/analyser/module.clj b/lux-bootstrapper/src/lux/analyser/module.clj index 426d0bfb6..048734766 100644 --- a/lux-bootstrapper/src/lux/analyser/module.clj +++ b/lux-bootstrapper/src/lux/analyser/module.clj @@ -103,10 +103,10 @@ (if-let [$module (->> state (&/get$ &/$modules) (&/|get module))] (if-let [$def (->> $module (&/get$ $defs) (&/|get name))] (|case $def - (&/$AliasG [o-module o-name]) + [exported? (&/$AliasG [o-module o-name])] ((type-def o-module o-name) state) - (&/$DefinitionG [exported? ?type ?value]) + [exported? (&/$DefinitionG [?type ?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])))) @@ -165,12 +165,13 @@ (if-let [$module (->> state (&/get$ &/$modules) (&/|get module))] (if-let [$def (->> $module (&/get$ $defs) (&/|get name))] (|case $def - (&/$AliasG [?r-module ?r-name]) + [exported? (&/$AliasG [?r-module ?r-name])] ((find-def! ?r-module ?r-name) state) - (&/$DefinitionG $def*) - (return* state (&/T [(&/T [module name]) $def*]))) + [exported? (&/$DefinitionG $def*)] + (return* state (&/T [(&/T [module name]) + (&/T [exported? $def*])]))) ((&/fail-with-loc (str "[Analyser Error @ find-def!] Definition does not exist: " (&/ident->text (&/T [module name])) " at module: " (pr-str current-module))) state)) @@ -185,23 +186,21 @@ (if-let [$module (->> state (&/get$ &/$modules) (&/|get module))] (if-let [$def (->> $module (&/get$ $defs) (&/|get name))] (|case $def - (&/$AliasG [?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)) - - (&/$DefinitionG [exported? ?type ?value]) + [exported? $def*] (if (or (.equals ^Object current-module module) (and exported? (or (.equals ^Object &/prelude module) (.equals ^Object quoted_module module) (imports? state module current-module)))) - (return* state (&/T [(&/T [module name]) - (&/T [exported? ?type ?value])])) - ((&/fail-with-loc (str "[Analyser Error @ find-def] Cannot use private definition: " (str module &/+name-separator+ name) + (|case $def* + (&/$AliasG [?r-module ?r-name]) + ((find-def! ?r-module ?r-name) + state) + + (&/$DefinitionG [?type ?value]) + (return* state (&/T [(&/T [module name]) + (&/T [exported? (&/T [?type ?value])])]))) + ((&/fail-with-loc (str "[Analyser Error @ find-def] Cannot use private global: " (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) @@ -217,8 +216,8 @@ (if-let [$module (->> state (&/get$ &/$modules) (&/|get module))] (if-let [$def (->> $module (&/get$ $defs) (&/|get name))] (|case $def - (&/$AliasG [?r-module ?r-name]) (return* state $def) - (&/$DefinitionG _) (return* state $def)) + [exported? (&/$AliasG [?r-module ?r-name])] (return* state $def) + [exported? (&/$DefinitionG _)] (return* state $def)) ((&/fail-with-loc (str "[Analyser Error @ find-def] Global does not exist: " (str module &/+name-separator+ name) " at module: " current-module)) state)) @@ -269,7 +268,7 @@ (if-let [$module (->> state (&/get$ &/$modules) (&/|get module))] (if-let [$def (->> $module (&/get$ $defs) (&/|get name))] (|case $def - (&/$AliasG [?r-module ?r-name]) + [exported? (&/$AliasG [?r-module ?r-name])] (if (.equals ^Object current-module module) ((<find!> ?r-module ?r-name) state) @@ -278,7 +277,7 @@ " @ " (quote <find>))) state)) - (&/$DefinitionG [exported? ?type ?value]) + [exported? (&/$DefinitionG [?type ?value])] (if (or (.equals ^Object current-module module) exported?) (if (&type/type= <definition_type> ?type) @@ -355,7 +354,7 @@ (return (&/T [_module _hash])))) _imports))) -(defn define-alias [module name de-aliased] +(defn define-alias [module name exported? de-aliased] (if_not_defined module name (fn [state] @@ -367,7 +366,7 @@ (&/|update module (fn [m] (&/update$ $defs - #(&/|put name (&/$AliasG de-aliased) %) + #(&/|put name (&/T [exported? (&/$AliasG de-aliased)]) %) m)) ms)))) nil) @@ -388,7 +387,7 @@ (&/|update module (fn [m] (&/update$ $defs - #(&/|put name (&/$DefinitionG (&/T [exported? def-type def-value])) %) + #(&/|put name (&/T [exported? (&/$DefinitionG (&/T [def-type def-value]))]) %) m)) ms)))) nil) diff --git a/lux-bootstrapper/src/lux/compiler/core.clj b/lux-bootstrapper/src/lux/compiler/core.clj index f3fefdc74..07cd8c759 100644 --- a/lux-bootstrapper/src/lux/compiler/core.clj +++ b/lux-bootstrapper/src/lux/compiler/core.clj @@ -46,7 +46,7 @@ defs &a-module/defs imports &a-module/imports :let [def-entries (&/fold (fn [def-entries _def] - (|let [[?name _definition] _def] + (|let [[?name [exported? _definition]] _def] (|case _definition (&/$AliasG [_dmodule _dname]) (str "A" @@ -55,7 +55,7 @@ ;; Next entry-separator def-entries) - (&/$DefinitionG [exported? ?def-type ?def-value]) + (&/$DefinitionG [?def-type ?def-value]) (str "D" datum-separator ?name datum-separator (if exported? "1" "0") diff --git a/lux-bootstrapper/src/lux/compiler/jvm.clj b/lux-bootstrapper/src/lux/compiler/jvm.clj index fcccfec9e..717f75a16 100644 --- a/lux-bootstrapper/src/lux/compiler/jvm.clj +++ b/lux-bootstrapper/src/lux/compiler/jvm.clj @@ -251,7 +251,7 @@ &&jvm-cache/uninstall-all-defs-in-module) _ (compile-module source-dirs &/prelude nil)] (compile-module source-dirs program-module - (|do [[de_aliased_symbol [exported? actual-type ?value]] (&a-module/find-def "" program-module program-definition) + (|do [[de_aliased_symbol [exported? [actual-type ?value]]] (&a-module/find-def "" program-module program-definition) _ (&type/check program-type actual-type) here &/location] (&&lux/compile-program (partial compile-expression nil) diff --git a/lux-bootstrapper/src/lux/compiler/jvm/lux.clj b/lux-bootstrapper/src/lux/compiler/jvm/lux.clj index eabda4265..0eedf22bd 100644 --- a/lux-bootstrapper/src/lux/compiler/jvm/lux.clj +++ b/lux-bootstrapper/src/lux/compiler/jvm/lux.clj @@ -119,7 +119,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) |