From 1c2e2b58bca4e837bed6d701fe16be092be828a3 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 24 May 2019 21:22:48 -0400 Subject: Removed the (magical) "export?" annotations tag. --- luxc/src/lux/analyser.clj | 10 ++++--- luxc/src/lux/analyser/lux.clj | 46 ++++++++++++-------------------- luxc/src/lux/analyser/meta.clj | 1 - luxc/src/lux/analyser/module.clj | 27 +++++++------------ luxc/src/lux/compiler/cache.clj | 6 ++--- luxc/src/lux/compiler/core.clj | 7 +++-- luxc/src/lux/compiler/jvm.clj | 54 +++++++++++++++++++------------------- luxc/src/lux/compiler/jvm/lux.clj | 14 +++++----- luxc/src/lux/compiler/parallel.clj | 15 ++++++----- 9 files changed, 83 insertions(+), 97 deletions(-) (limited to 'luxc/src') diff --git a/luxc/src/lux/analyser.clj b/luxc/src/lux/analyser.clj index de5ff8725..4522b9aea 100644 --- a/luxc/src/lux/analyser.clj +++ b/luxc/src/lux/analyser.clj @@ -131,10 +131,11 @@ (|let [(&/$Cons [_ (&/$Identifier "" ?name)] (&/$Cons ?value (&/$Cons ?meta - (&/$Nil)) + (&/$Cons [_ (&/$Bit exported?)] + (&/$Nil))) )) parameters] (&/with-cursor cursor - (&&lux/analyse-def analyse optimize eval! compile-def ?name ?value ?meta))) + (&&lux/analyse-def analyse optimize eval! compile-def ?name ?value ?meta exported?))) "lux def alias" (|let [(&/$Cons [_ (&/$Identifier "" ?alias)] @@ -149,10 +150,11 @@ (&/$Cons ?value (&/$Cons ?meta (&/$Cons [_ (&/$Tuple ?tags)] - (&/$Nil))) + (&/$Cons [_ (&/$Bit exported?)] + (&/$Nil)))) )) parameters] (&/with-cursor cursor - (&&lux/analyse-def-type-tagged analyse optimize eval! compile-def ?name ?value ?meta ?tags))) + (&&lux/analyse-def-type-tagged analyse optimize eval! compile-def ?name ?value ?meta ?tags exported?))) "lux def program" (|let [(&/$Cons ?program (&/$Nil)) parameters] diff --git a/luxc/src/lux/analyser/lux.clj b/luxc/src/lux/analyser/lux.clj index 8b2428ef0..4353caefa 100644 --- a/luxc/src/lux/analyser/lux.clj +++ b/luxc/src/lux/analyser/lux.clj @@ -266,7 +266,7 @@ ))) (defn ^:private analyse-global [analyse exo-type module name] - (|do [[[r-module r-name] [endo-type ?meta ?value]] (&&module/find-def module name) + (|do [[[r-module r-name] [exported? endo-type ?meta ?value]] (&&module/find-def 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)) @@ -381,7 +381,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 [exported? ?type ?meta ?value]] (&&module/find-def! ?module ?name)] (if (&type/type= &type/Macro ?type) (|do [macro-expansion (fn [state] (|case (macro-caller ?value ?args state) @@ -390,13 +390,13 @@ (&/$Left error) ((&/fail-with-loc error) state))) - ;; module-name &/get-module-name + module-name &/get-module-name ;; :let [[r-prefix r-name] real-name - ;; _ (when (= "macro:'" r-name) - ;; (->> (&/|map &/show-ast macro-expansion) - ;; (&/|interpose "\n") + ;; _ (when (= "module:" r-name) + ;; (->> macro-expansion + ;; (&/|map (fn [ast] (str (&/show-ast ast) "\n"))) ;; (&/fold str "") - ;; (println 'macro-expansion (&/ident->text real-name) "@" module-name)))] + ;; (&/|log! (str 'macro-expansion " " (&/ident->text real-name) " @ " module-name "\n"))))] ] (&/flat-map% (partial analyse exo-type) macro-expansion)) (do-analyse-apply analyse exo-type =fn ?args))) @@ -542,7 +542,7 @@ (|do [output (analyse-function** analyse exo-type ?self ?arg ?body)] (return (&/|list output)))) -(defn analyse-def* [analyse optimize eval! compile-def ?name ?value ?meta & [?expected-type]] +(defn analyse-def* [analyse optimize eval! compile-def ?name ?value ?meta exported? & [?expected-type]] (|do [_ &/ensure-statement module-name &/get-module-name ? (&&module/defined? module-name ?name) @@ -556,24 +556,18 @@ (&&/analyse-1+ analyse ?value)))) =meta (&&/analyse-1 analyse &type/Code ?meta) ==meta (eval! (optimize =meta)) - def-value (compile-def ?name (optimize =value) ==meta) + def-value (compile-def ?name (optimize =value) ==meta exported?) _ &type/reset-mappings] - (return (&/T [module-name (&&/expr-type* =value) def-value ==meta])))) + (return (&/T [module-name (&&/expr-type* =value) def-value])))) -(defn analyse-def [analyse optimize eval! compile-def ?name ?value ?meta] - (|do [_ (analyse-def* analyse optimize eval! compile-def ?name ?value ?meta)] +(defn analyse-def [analyse optimize eval! compile-def ?name ?value ?meta exported?] + (|do [_ (analyse-def* analyse optimize eval! compile-def ?name ?value ?meta exported?)] (return &/$Nil))) -(defn analyse-def-type-tagged [analyse optimize eval! compile-def ?name ?value ?meta tags*] - (|do [[module-name def-type def-value ==meta] (analyse-def* analyse optimize eval! compile-def ?name ?value ?meta &type/Type) +(defn analyse-def-type-tagged [analyse optimize eval! compile-def ?name ?value ?meta tags* exported?] + (|do [[module-name def-type def-value] (analyse-def* analyse optimize eval! compile-def ?name ?value ?meta exported? &type/Type) _ (&/assert! (&type/type= &type/Type def-type) "[Analyser Error] Cannot define tags for non-type.") - :let [was-exported? (|case (&&meta/meta-get &&meta/export?-tag ==meta) - (&/$Some _) - true - - _ - false)] tags (&/map% (fn [tag*] (|case tag* [_ (&/$Text tag)] @@ -582,7 +576,7 @@ _ (&/fail-with-loc "[Analyser Error] Incorrect format for tags."))) tags*) - _ (&&module/declare-tags module-name tags was-exported? def-value)] + _ (&&module/declare-tags module-name tags exported? def-value)] (return &/$Nil))) (def ^:private dummy-cursor @@ -596,10 +590,10 @@ (defn analyse-def-alias [?alias ?original] (|let [[r-module r-name] ?original] - (|do [[_ [original-type original-anns original-value]] (&&module/find-def! r-module r-name) + (|do [[_ [exported? original-type original-anns original-value]] (&&module/find-def! r-module r-name) module-name &/get-module-name _ (&/without-repl-closure - (&&module/define module-name ?alias + (&&module/define module-name ?alias false original-type (alias-annotations r-module r-name) original-value))] @@ -694,12 +688,6 @@ (try-async-compilation path compile-module)))))) _imports) _compiler get-compiler - ;; Some type-vars in the typing environment stay in - ;; the environment forever, making type-checking slower. - ;; The merging process for compilers more-or-less "fixes" the - ;; problem by resetting the typing enviroment, but ideally - ;; those type-vars should not survive in the first place. - ;; TODO: MUST FIX _ (&/fold% (fn [compiler _async] (|case @_async (&/$Right _new-compiler) diff --git a/luxc/src/lux/analyser/meta.clj b/luxc/src/lux/analyser/meta.clj index fde261b0b..53d355867 100644 --- a/luxc/src/lux/analyser/meta.clj +++ b/luxc/src/lux/analyser/meta.clj @@ -41,5 +41,4 @@ (def (&/T [tag-prefix ])) alias-tag "alias" - export?-tag "export?" ) diff --git a/luxc/src/lux/analyser/module.clj b/luxc/src/lux/analyser/module.clj index 8bc7a64a1..25f6428ca 100644 --- a/luxc/src/lux/analyser/module.clj +++ b/luxc/src/lux/analyser/module.clj @@ -106,7 +106,7 @@ state) nil)))) -(defn define [module name def-type def-meta def-value] +(defn define [module name exported? def-type def-meta def-value] (fn [state] (when (and (= "Macro'" name) (= "lux" module)) (&type/set-macro*-type! def-value)) @@ -118,7 +118,7 @@ (&/|update module (fn [m] (&/update$ $defs - #(&/|put name (&/T [def-type def-meta def-value]) %) + #(&/|put name (&/T [exported? def-type def-meta def-value]) %) m)) ms)))) nil) @@ -133,7 +133,7 @@ (fn [state] (if-let [$module (->> state (&/get$ &/$modules) (&/|get module))] (if-let [$def (->> $module (&/get$ $defs) (&/|get name))] - (|let [[?type ?meta ?value] $def] + (|let [[exported? ?type ?meta ?value] $def] (return* state ?type)) ((&/fail-with-loc (str "[Analyser Error] Unknown definition: " (str module &/+name-separator+ name))) state)) @@ -146,15 +146,9 @@ (fn [state] (if-let [$module (->> state (&/get$ &/$modules) (&/|get module))] (if-let [$def (->> $module (&/get$ $defs) (&/|get name))] - (|let [[?type ?meta ?value] $def] + (|let [[exported? ?type ?meta ?value] $def] (if (&type/type= &type/Type ?type) - (return* state (&/T [(|case (&meta/meta-get &meta/export?-tag ?meta) - (&/$Some _) - true - - _ - false) - ?value])) + (return* state (&/T [exported? ?value])) ((&/fail-with-loc (str "[Analyser Error] Not a type: " (&/ident->text (&/T [module name])) "\nMETA: " (&/show-ast ?meta))) state))) @@ -230,7 +224,7 @@ (fn [state] (if-let [$module (->> state (&/get$ &/$modules) (&/|get module))] (if-let [$def (->> $module (&/get$ $defs) (&/|get name))] - (|let [[?type ?meta ?value] $def] + (|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])]) @@ -256,7 +250,7 @@ (imports? state module current-module)) (if-let [$module (->> state (&/get$ &/$modules) (&/|get module))] (if-let [$def (->> $module (&/get$ $defs) (&/|get name))] - (|let [[?type ?meta ?value] $def] + (|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])]) @@ -265,11 +259,8 @@ _ (return* state (&/T [(&/T [module name]) $def]))) - (|case (&meta/meta-get &meta/export?-tag ?meta) - (&/$Some [_ (&/$Bit true)]) + (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)))) @@ -411,7 +402,7 @@ (->> state (&/get$ &/$modules) (&/|get module) (&/get$ $defs) (&/|map (fn [kv] (|let [[k _def-data] kv - [_ ?def-meta _] _def-data] + [_ _ ?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]) diff --git a/luxc/src/lux/compiler/cache.clj b/luxc/src/lux/compiler/cache.clj index d6b5e8317..06dabe108 100644 --- a/luxc/src/lux/compiler/cache.clj +++ b/luxc/src/lux/compiler/cache.clj @@ -104,12 +104,12 @@ (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 def-type def-anns def-value))) - 3 (let [[_name _type _anns] parts + (&a-module/define module _name false def-type def-anns def-value))) + 4 (let [[_name _exported? _type _anns] parts [def-anns _] (&&&ann/deserialize _anns) [def-type _] (&&&type/deserialize-type _type)] (|do [def-value (load-def-value module _name)] - (&a-module/define module _name def-type def-anns def-value)))))) + (&a-module/define module _name (= "1" _exported?) def-type def-anns def-value)))))) (defn ^:private uninstall-cache [module] (|do [_ (delete module)] diff --git a/luxc/src/lux/compiler/core.clj b/luxc/src/lux/compiler/core.clj index d3fc0d9af..f2fe09887 100644 --- a/luxc/src/lux/compiler/core.clj +++ b/luxc/src/lux/compiler/core.clj @@ -50,9 +50,12 @@ tag-groups &a-module/tag-groups :let [def-entries (->> defs (&/|map (fn [_def] - (|let [[?name ?alias [?def-type ?def-anns ?def-value]] _def] + (|let [[?name ?alias [exported? ?def-type ?def-anns ?def-value]] _def] (if (= "" ?alias) - (str ?name datum-separator (&&&type/serialize-type ?def-type) datum-separator (&&&ann/serialize ?def-anns)) + (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))))) (&/|interpose entry-separator) (&/fold str "")) diff --git a/luxc/src/lux/compiler/jvm.clj b/luxc/src/lux/compiler/jvm.clj index b5e04792a..8b70862ab 100644 --- a/luxc/src/lux/compiler/jvm.clj +++ b/luxc/src/lux/compiler/jvm.clj @@ -185,33 +185,33 @@ :let [file-hash (hash file-content) compile-module!! (&¶llel/parallel-compilation (partial compile-module source-dirs))]] (&/|eitherL (&&cache/load name) - (let [compiler-step (&analyser/analyse &optimizer/optimize eval! compile-module!! all-compilers)] - (|do [module-exists? (&a-module/exists? name)] - (if module-exists? - (&/fail-with-loc (str "[Compiler Error] Cannot re-define a module: " name)) - (|do [_ (activate-module! name file-hash) - :let [module-class-name (str (&host/->module-class name) "/_") - =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) - (.visit &host/bytecode-version (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) - module-class-name nil "java/lang/Object" nil) - (.visitSource file-name nil))] - _ (if (= "lux" name) - (|do [_ &&rt/compile-Function-class - _ &&rt/compile-LuxRT-class] - (return nil)) - (return nil))] - (fn [state] - (|case ((&/with-writer =class - (&/exhaust% compiler-step)) - (&/set$ &/$source (&reader/from name file-content) state)) - (&/$Right ?state _) - (&/run-state (|do [:let [_ (.visitEnd =class)] - _ (save-module! name file-hash (.toByteArray =class))] - (return file-hash)) - ?state) - - (&/$Left ?message) - (&/fail* ?message)))))))) + (|do [module-exists? (&a-module/exists? name)] + (if module-exists? + (&/fail-with-loc (str "[Compiler Error] Cannot re-define a module: " name)) + (|do [_ (activate-module! name file-hash) + :let [module-class-name (str (&host/->module-class name) "/_") + =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) + (.visit &host/bytecode-version (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) + module-class-name nil "java/lang/Object" nil) + (.visitSource file-name nil))] + _ (if (= "lux" name) + (|do [_ &&rt/compile-Function-class + _ &&rt/compile-LuxRT-class] + (return nil)) + (return nil)) + :let [compiler-step (&analyser/analyse &optimizer/optimize eval! compile-module!! all-compilers)]] + (fn [state] + (|case ((&/with-writer =class + (&/exhaust% compiler-step)) + (&/set$ &/$source (&reader/from name file-content) state)) + (&/$Right ?state _) + (&/run-state (|do [:let [_ (.visitEnd =class)] + _ (save-module! name file-hash (.toByteArray =class))] + (return file-hash)) + ?state) + + (&/$Left ?message) + (&/fail* ?message))))))) ))) (let [define-class (doto (.getDeclaredMethod java.lang.ClassLoader "defineClass" (into-array [String diff --git a/luxc/src/lux/compiler/jvm/lux.clj b/luxc/src/lux/compiler/jvm/lux.clj index 4af29d2f6..28418a6f8 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) @@ -250,7 +250,7 @@ (str base "\n\n" "Caused by: " (throwable->text cause)) base))) -(defn ^:private install-def! [class-loader current-class module-name ?name ?body ?meta] +(defn ^:private install-def! [class-loader current-class module-name ?name ?body ?meta exported?] (|do [_ (return nil) :let [def-class (&&/load-class! class-loader (&host-generics/->class-name current-class)) def-type (&a/expr-type* ?body)] @@ -260,12 +260,12 @@ (str "Error during value initialization:\n" (throwable->text t))))) _ (&/without-repl-closure - (&a-module/define module-name ?name def-type ?meta def-value))] + (&a-module/define module-name ?name exported? def-type ?meta def-value))] (return def-value))) (let [class-flags (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER) field-flags (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC)] - (defn compile-def [compile ?name ?body ?meta] + (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) @@ -278,7 +278,7 @@ 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 def-type ?meta def-value))] + (&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))))) @@ -314,7 +314,7 @@ (return nil))) :let [_ (.visitEnd =class)] _ (&&/save-class! def-name (.toByteArray =class)) - def-value (install-def! class-loader current-class module-name ?name ?body ?meta) + 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))) @@ -341,7 +341,7 @@ (return nil))) :let [_ (.visitEnd =class)] _ (&&/save-class! def-name (.toByteArray =class)) - def-value (install-def! class-loader current-class module-name ?name ?body ?meta) + 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))) )))) diff --git a/luxc/src/lux/compiler/parallel.clj b/luxc/src/lux/compiler/parallel.clj index 1c4da1a11..28716b45b 100644 --- a/luxc/src/lux/compiler/parallel.clj +++ b/luxc/src/lux/compiler/parallel.clj @@ -31,12 +31,15 @@ (.start (new Thread (fn [] (let [out-str (with-out-str - (|case (&/run-state (compile-module* module-name) - compiler) - (&/$Right post-compiler _) - (deliver task (&/$Right post-compiler)) + (try (|case (&/run-state (compile-module* module-name) + compiler) + (&/$Right post-compiler _) + (deliver task (&/$Right post-compiler)) - (&/$Left ?error) - (deliver task (&/$Left ?error))))] + (&/$Left ?error) + (deliver task (&/$Left ?error))) + (catch Throwable ex + (.printStackTrace ex) + (deliver task (&/$Left "")))))] (&/|log! out-str))))))]] (return task)))) -- cgit v1.2.3