From c5073f565d2aba36e98060321f6ceda66644144b Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 15 Feb 2016 13:43:00 -0400 Subject: - Now, you cannot use the tags of types that haven't been exported if you're not in that type's module. --- src/lux/analyser.clj | 1 + src/lux/analyser/module.clj | 36 ++++++++++++++++++++++++++++-------- src/lux/compiler/cache.clj | 4 ++-- src/lux/compiler/lux.clj | 10 ++++++++-- src/lux/compiler/module.clj | 2 +- 5 files changed, 40 insertions(+), 13 deletions(-) (limited to 'src') diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index 4d68ab0d5..d4b90cc3a 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -21,6 +21,7 @@ ;; [Utils] (defn analyse-variant+ [analyse exo-type ident values] (|do [[module tag-name] (&/normalize ident) + _ (&&module/ensure-can-see-tag module tag-name) idx (&&module/tag-index module tag-name) group (&&module/tag-group module tag-name) :let [is-last? (= idx (dec (&/|length group)))]] diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj index 1f980ba2c..23696dced 100644 --- a/src/lux/analyser/module.clj +++ b/src/lux/analyser/module.clj @@ -92,14 +92,20 @@ (fail* (str "[Analyser Error] Unknown module: " module))))) (defn type-def [module name] - "(-> Text Text (Lux Type))" + "(-> Text Text (Lux [Bool Type]))" (fn [state] (if-let [$module (->> state (&/get$ &/$modules) (&/|get module))] (if-let [$def (->> $module (&/get$ $defs) (&/|get name))] (|let [[?type ?meta ?value] $def] (|case (&meta/meta-get &meta/type?-tag ?meta) (&/$Some _) - (return* state ?value) + (return* state (&/T [(|case (&meta/meta-get &meta/export?-tag ?meta) + (&/$Some _) + true + + _ + false) + ?value])) _ (fail* (str "[Analyser Error] Not a type: " (&/ident->text (&/T [module name])))))) @@ -218,8 +224,8 @@ (str "[Analyser Error] Can't re-declare type: " (&/ident->text (&/T [module name]))))] (return nil))) -(defn declare-tags [module tag-names type] - "(-> Text (List Text) Type (Lux Null))" +(defn declare-tags [module tag-names was-exported? type] + "(-> Text (List Text) Bool Type (Lux Null))" (|do [_ (ensure-undeclared-tags module tag-names) type-name (&type/type-name type) :let [[_module _name] type-name] @@ -235,22 +241,36 @@ #(->> % (&/set$ $tags (&/fold (fn [table idx+tag-name] (|let [[idx tag-name] idx+tag-name] - (&/|put tag-name (&/T [idx tags type]) table))) + (&/|put tag-name (&/T [idx tags was-exported? type]) table))) (&/get$ $tags %) (&/enumerate tag-names))) - (&/update$ $types (partial &/|put _name (&/T [tags type])))) + (&/update$ $types (partial &/|put _name (&/T [tags was-exported? type])))) =modules)) state) nil)) (fail* (str "[Lux Error] Unknown module: " module)))))) +(defn ensure-can-see-tag [module tag-name] + "(-> Text Text (Lux Unit))" + (|do [current-module &/get-module-name] + (fn [state] + (if-let [=module (->> state (&/get$ &/$modules) (&/|get module))] + (if-let [^objects idx+tags+exported+type (&/|get tag-name (&/get$ $tags =module))] + (|let [[?idx ?tags ?exported ?type] idx+tags+exported+type] + (if (or ?exported + (= module current-module)) + (return* state &/unit-tag) + (fail* (str "Can't access tag #" (&/ident->text (&/T [module tag-name])) " from module " current-module)))) + (fail* (str "[Module Error] Unknown tag: " (&/ident->text (&/T [module tag-name]))))) + (fail* (str "[Module Error] Unknown module: " module)))))) + (do-template [ ] (defn [module tag-name] (fn [state] (if-let [=module (->> state (&/get$ &/$modules) (&/|get module))] - (if-let [^objects idx+tags+type (&/|get tag-name (&/get$ $tags =module))] - (|let [[?idx ?tags ?type] idx+tags+type] + (if-let [^objects idx+tags+exported+type (&/|get tag-name (&/get$ $tags =module))] + (|let [[?idx ?tags ?exported ?type] idx+tags+exported+type] (return* state )) (fail* (str "[Module Error] Unknown tag: " (&/ident->text (&/T [module tag-name]))))) (fail* (str "[Module Error] Unknown module: " module))))) diff --git a/src/lux/compiler/cache.clj b/src/lux/compiler/cache.clj index 93f8bf3e9..bd463635d 100644 --- a/src/lux/compiler/cache.clj +++ b/src/lux/compiler/cache.clj @@ -146,8 +146,8 @@ (&/->list defs))) _ (&/map% (fn [group] (|let [[_type _tags] group] - (|do [=type (&a-module/type-def module _type)] - (&a-module/declare-tags module _tags =type)))) + (|do [[was-exported? =type] (&a-module/type-def module _type)] + (&a-module/declare-tags module _tags was-exported? =type)))) tag-groups)] (return true)))) redo-cache))) diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj index 3003a0335..8f784cc11 100644 --- a/src/lux/compiler/lux.clj +++ b/src/lux/compiler/lux.clj @@ -206,7 +206,13 @@ _ (&a-module/define module-name ?name def-type def-meta def-value) _ (|case (&/T [is-type? (&a-meta/meta-get &a-meta/tags-tag def-meta)]) [true (&/$Some (&/$ListM tags*))] - (|do [tags (&/map% (fn [tag*] + (|do [:let [was-exported? (|case (&a-meta/meta-get &a-meta/export?-tag def-meta) + (&/$Some _) + true + + _ + false)] + tags (&/map% (fn [tag*] (|case tag* (&/$TextM tag) (return tag) @@ -214,7 +220,7 @@ _ (fail "[Compiler Error] Incorrect format for tags."))) tags*) - _ (&a-module/declare-tags module-name tags def-value)] + _ (&a-module/declare-tags module-name tags was-exported? def-value)] (return nil)) [false (&/$Some _)] diff --git a/src/lux/compiler/module.clj b/src/lux/compiler/module.clj index 23635f5bc..03bc311f2 100644 --- a/src/lux/compiler/module.clj +++ b/src/lux/compiler/module.clj @@ -19,7 +19,7 @@ (|do [module &/get-current-module] (return (&/|map (fn [pair] (|case pair - [name [tags _]] + [name [tags exported? _]] (&/T [name (&/|map (fn [tag] (|let [[t-prefix t-name] tag] t-name)) -- cgit v1.2.3