aboutsummaryrefslogtreecommitdiff
path: root/luxc/src
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--luxc/src/lux/analyser.clj10
-rw-r--r--luxc/src/lux/analyser/lux.clj46
-rw-r--r--luxc/src/lux/analyser/meta.clj1
-rw-r--r--luxc/src/lux/analyser/module.clj27
-rw-r--r--luxc/src/lux/compiler/cache.clj6
-rw-r--r--luxc/src/lux/compiler/core.clj7
-rw-r--r--luxc/src/lux/compiler/jvm.clj54
-rw-r--r--luxc/src/lux/compiler/jvm/lux.clj14
-rw-r--r--luxc/src/lux/compiler/parallel.clj15
9 files changed, 83 insertions, 97 deletions
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 <name> (&/T [tag-prefix <tag-name>]))
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!! (&&parallel/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))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-10 01:43:51 +0000