aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--luxc/src/lux/analyser.clj3
-rw-r--r--luxc/src/lux/analyser/lux.clj30
-rw-r--r--luxc/src/lux/analyser/module.clj43
-rw-r--r--luxc/src/lux/base.clj76
-rw-r--r--luxc/src/lux/compiler/jvm.clj37
-rw-r--r--luxc/src/lux/compiler/jvm/cache.clj4
-rw-r--r--luxc/src/lux/compiler/jvm/lux.clj6
-rw-r--r--stdlib/source/lux.lux63
8 files changed, 139 insertions, 123 deletions
diff --git a/luxc/src/lux/analyser.clj b/luxc/src/lux/analyser.clj
index 614bc0a34..50edefac4 100644
--- a/luxc/src/lux/analyser.clj
+++ b/luxc/src/lux/analyser.clj
@@ -59,7 +59,8 @@
(defn ^:private analyse-ast [optimize eval! compile-module compilers exo-type ?token]
(|let [analyse (partial analyse-ast optimize eval! compile-module compilers)
[cursor token] ?token
- [compile-def compile-program compile-class compile-interface] compilers]
+ compile-def (aget compilers 0)
+ compile-program (aget compilers 1)]
(|case token
;; Standard special forms
(&/$BoolS ?value)
diff --git a/luxc/src/lux/analyser/lux.clj b/luxc/src/lux/analyser/lux.clj
index 5f3626900..27f4ee11e 100644
--- a/luxc/src/lux/analyser/lux.clj
+++ b/luxc/src/lux/analyser/lux.clj
@@ -560,7 +560,7 @@
module-name &/get-module-name
? (&&module/defined? module-name ?name)]
(if ?
- (&/fail-with-loc (str "[Analyser Error] Can't redefine " (str module-name ";" ?name)))
+ (&/fail-with-loc (str "[Analyser Error] Can't re-define " (str module-name ";" ?name)))
(|do [=value (&/without-repl-closure
(&/with-scope ?name
(&&/analyse-1+ analyse ?value)))
@@ -572,24 +572,23 @@
(return &/$Nil))
)))
-(defn ^:private merge-hosts
+(defn ^:private merge-module-states
"(-> Host Host Host)"
[new old]
- (|let [merged-module-states (&/fold (fn [total m-state]
- (|let [[_name _state] m-state]
- (|case _state
- (&/$Cached)
- (&/|put _name _state total)
+ (|let [merged-module-states (&/fold (fn [total new-module]
+ (|let [[_name _module] new-module]
+ (|case (&/get$ &&module/$module-state _module)
+ (&&module/$Cached)
+ (&/|put _name _module total)
- (&/$Compiled)
- (&/|put _name _state total)
+ (&&module/$Compiled)
+ (&/|put _name _module total)
_
total)))
- (&/get$ &/$module-states old)
- (&/get$ &/$module-states new))]
- (->> old
- (&/set$ &/$module-states merged-module-states))))
+ (&/get$ &/$modules old)
+ (&/get$ &/$modules new))]
+ (&/set$ &/$modules merged-module-states old)))
(defn ^:private merge-modules
"(-> Text Module Module Module)"
@@ -618,8 +617,7 @@
(&/get$ &/$modules old)))
(&/set$ &/$seed (max (&/get$ &/$seed new)
(&/get$ &/$seed old)))
- (&/set$ &/$host (merge-hosts (&/get$ &/$host new)
- (&/get$ &/$host old)))))
+ (merge-module-states new)))
(def ^:private get-compiler
(fn [compiler]
@@ -645,7 +643,7 @@
(&/fail-with-loc (str "[Analyser Error] Module can't import itself: " path))
(return nil))
already-compiled? (&&module/exists? path)
- active? (&/active-module? path)
+ active? (&&module/active-module? path)
_ (&/assert! (not active?)
(str "[Analyser Error] Can't import a module that is mid-compilation: " path " @ " current-module))
_ (&&module/add-import path)
diff --git a/luxc/src/lux/analyser/module.clj b/luxc/src/lux/analyser/module.clj
index 3ccb887ff..9df1054c8 100644
--- a/luxc/src/lux/analyser/module.clj
+++ b/luxc/src/lux/analyser/module.clj
@@ -4,13 +4,20 @@
[template :refer [do-template]])
clojure.core.match
clojure.core.match.array
- (lux [base :as & :refer [deftuple |let |do return return* |case]]
+ (lux [base :as & :refer [defvariant deftuple |let |do return return* |case]]
[type :as &type]
[host :as &host])
[lux.host.generics :as &host-generics]
(lux.analyser [meta :as &meta])))
;; [Utils]
+;; ModuleState
+(defvariant
+ ("Active" 0)
+ ("Compiled" 0)
+ ("Cached" 0))
+
+;; Module
(deftuple
["module-hash"
"module-aliases"
@@ -18,7 +25,8 @@
"imports"
"tags"
"types"
- "module-anns"])
+ "module-anns"
+ "module-state"])
(defn ^:private new-module [hash]
(&/T [;; lux;module-hash
@@ -34,9 +42,38 @@
;; "lux;types"
(&/|table)
;; module-anns
- (&/|list)]
+ (&/|list)
+ ;; "module-state"
+ $Active]
))
+(do-template [<flagger> <asker> <tag>]
+ (do (defn <flagger> [module-name]
+ "(-> Text (Lux Unit))"
+ (fn [state]
+ (let [state* (&/update$ &/$modules
+ (fn [modules]
+ (&/|update module-name
+ (fn [=module]
+ (&/set$ $module-state <tag> =module))
+ modules))
+ state)]
+ (&/$Right (&/T [state* &/unit-tag])))))
+ (defn <asker> [module-name]
+ "(-> Text (Lux Bool))"
+ (fn [state]
+ (if-let [=module (->> state (&/get$ &/$modules) (&/|get module-name))]
+ (&/$Right (&/T [state (|case (&/get$ $module-state =module)
+ (<tag>) true
+ _ false)]))
+ (&/$Right (&/T [state false])))
+ )))
+
+ flag-active-module active-module? $Active
+ flag-compiled-module compiled-module? $Compiled
+ flag-cached-module cached-module? $Cached
+ )
+
;; [Exports]
(defn add-import
"(-> Text (Lux Null))"
diff --git a/luxc/src/lux/base.clj b/luxc/src/lux/base.clj
index 9859db068..5e8c8c0d0 100644
--- a/luxc/src/lux/base.clj
+++ b/luxc/src/lux/base.clj
@@ -112,19 +112,12 @@
"locals"
"closure"])
-;; ModuleState
-(defvariant
- ("Active" 0)
- ("Compiled" 0)
- ("Cached" 0))
-
;; Host
(deftuple
["writer"
"loader"
"classes"
"catching"
- "module-states"
"type-env"
"dummy-mappings"
])
@@ -137,8 +130,7 @@
("REPL" 0))
(deftuple
- ["compiler-name"
- "compiler-version"
+ ["compiler-version"
"compiler-mode"])
(deftuple
@@ -231,7 +223,6 @@
(def ^:const module-class-name "_")
(def ^:const +name-separator+ ";")
-(def ^:const ^String compiler-name "Lux/JVM")
(def ^:const ^String compiler-version "0.6.0")
;; Constructors
@@ -718,41 +709,10 @@
+init-bindings+]
))
-(let [define-class (doto (.getDeclaredMethod java.lang.ClassLoader "defineClass" (into-array [String
- (class (byte-array []))
- Integer/TYPE
- Integer/TYPE]))
- (.setAccessible true))]
- (defn memory-class-loader [store]
- (proxy [java.lang.ClassLoader]
- []
- (findClass [^String class-name]
- (if-let [^bytes bytecode (get @store class-name)]
- (.invoke define-class this (to-array [class-name bytecode (int 0) (int (alength bytecode))]))
- (throw (IllegalStateException. (str "[Class Loader] Unknown class: " class-name))))))))
-
(def loader
(fn [state]
(return* state (->> state (get$ $host) (get$ $loader)))))
-(defn host [_]
- (let [store (atom {})]
- (T [;; "lux;writer"
- $None
- ;; "lux;loader"
- (memory-class-loader store)
- ;; "lux;classes"
- store
- ;; "lux;catching"
- $Nil
- ;; "lux;module-states"
- (|table)
- ;; lux;type-env
- (|table)
- ;; lux;dummy-mappings
- (|table)
- ])))
-
(defn with-no-catches [body]
"(All [a] (-> (Lux a) (Lux a)))"
(fn [state]
@@ -765,15 +725,13 @@
(fail* msg)))))
(defn default-compiler-info [mode]
- (T [;; compiler-name
- compiler-name
- ;; compiler-version
+ (T [;; compiler-version
compiler-version
;; compiler-mode
mode]
))
-(defn init-state [mode]
+(defn init-state [mode host-data]
(T [;; "lux;info"
(default-compiler-info mode)
;; "lux;source"
@@ -793,7 +751,7 @@
;; scope-type-vars
$Nil
;; "lux;host"
- (host nil)]
+ host-data]
))
(defn save-module [body]
@@ -1342,32 +1300,6 @@
($Some xs**) ($Some ($Cons x xs**)))
)))
-(do-template [<flagger> <asker> <tag>]
- (do (defn <flagger> [module]
- "(-> Text (Lux Unit))"
- (fn [state]
- (let [state* (update$ $host (fn [host]
- (update$ $module-states
- (fn [module-states]
- (|put module <tag> module-states))
- host))
- state)]
- ($Right (T [state* unit-tag])))))
- (defn <asker> [module]
- "(-> Text (Lux Bool))"
- (fn [state]
- (if-let [module-state (->> state (get$ $host) (get$ $module-states) (|get module))]
- ($Right (T [state (|case module-state
- (<tag>) true
- _ false)]))
- ($Right (T [state false])))
- )))
-
- flag-active-module active-module? $Active
- flag-compiled-module compiled-module? $Compiled
- flag-cached-module cached-module? $Cached
- )
-
(do-template [<name> <default> <op>]
(defn <name> [p xs]
"(All [a] (-> (-> a Bool) (List a) Bool))"
diff --git a/luxc/src/lux/compiler/jvm.clj b/luxc/src/lux/compiler/jvm.clj
index 5d787f5cd..bb333df57 100644
--- a/luxc/src/lux/compiler/jvm.clj
+++ b/luxc/src/lux/compiler/jvm.clj
@@ -178,7 +178,7 @@
(&/fail-with-loc "[Compiler Error] Can't re-define a module!")
(|do [_ (&&cache/delete name)
_ (&a-module/create-module name file-hash)
- _ (&/flag-active-module name)
+ _ (&a-module/flag-active-module name)
: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)
@@ -199,7 +199,7 @@
(&/set$ &/$source (&reader/from name file-content) state))
(&/$Right ?state _)
(&/run-state (|do [:let [_ (.visitEnd =class)]
- _ (&/flag-compiled-module name)
+ _ (&a-module/flag-compiled-module name)
_ (&&/save-class! &/module-class-name (.toByteArray =class))
module-descriptor &&core/generate-module-descriptor
_ (&&core/write-module-descriptor! name module-descriptor)]
@@ -211,12 +211,43 @@
)
)))
+(let [define-class (doto (.getDeclaredMethod java.lang.ClassLoader "defineClass" (into-array [String
+ (class (byte-array []))
+ Integer/TYPE
+ Integer/TYPE]))
+ (.setAccessible true))]
+ (defn memory-class-loader [store]
+ (proxy [java.lang.ClassLoader]
+ []
+ (findClass [^String class-name]
+ (if-let [^bytes bytecode (get @store class-name)]
+ (.invoke define-class this (to-array [class-name bytecode (int 0) (int (alength bytecode))]))
+ (throw (IllegalStateException. (str "[Class Loader] Unknown class: " class-name))))))))
+
+(defn jvm-host []
+ (let [store (atom {})]
+ (&/T [;; "lux;writer"
+ &/$None
+ ;; "lux;loader"
+ (memory-class-loader store)
+ ;; "lux;classes"
+ store
+ ;; "lux;catching"
+ &/$Nil
+ ;; "lux;module-states"
+ (&/|table)
+ ;; lux;type-env
+ (&/|table)
+ ;; lux;dummy-mappings
+ (&/|table)
+ ])))
+
(let [!err! *err*]
(defn compile-program [mode program-module resources-dir source-dirs target-dir]
(let [m-action (|do [_ (&&cache/pre-load-cache! source-dirs)
_ (compile-module source-dirs "lux")]
(compile-module source-dirs program-module))]
- (|case (m-action (&/init-state mode))
+ (|case (m-action (&/init-state mode (jvm-host)))
(&/$Right ?state _)
(do (println "Compilation complete!")
(&&cache/clean ?state))
diff --git a/luxc/src/lux/compiler/jvm/cache.clj b/luxc/src/lux/compiler/jvm/cache.clj
index 1746514bc..e75e09f1b 100644
--- a/luxc/src/lux/compiler/jvm/cache.clj
+++ b/luxc/src/lux/compiler/jvm/cache.clj
@@ -149,6 +149,7 @@
(defn ^:private install-module [loader module module-hash imports tag-groups module-anns def-entries]
(|do [_ (&a-module/create-module module module-hash)
+ _ (&a-module/flag-cached-module module)
_ (&a-module/set-anns module-anns module)
_ (&a-module/set-imports imports)
_ (&/map% (partial process-def-entry loader module)
@@ -269,7 +270,6 @@
(defn load [module-name]
"(-> Text (Lux Null))"
(if-let [module-struct (get @!pre-loaded-cache module-name)]
- (|do [_ (inject-module module-name module-struct)
- _ (&/flag-cached-module module-name)]
+ (|do [_ (inject-module module-name module-struct)]
(return nil))
(&/fail (str "[Cache Error] Module is not cached: " module-name))))
diff --git a/luxc/src/lux/compiler/jvm/lux.clj b/luxc/src/lux/compiler/jvm/lux.clj
index 591e490c4..64760bbb6 100644
--- a/luxc/src/lux/compiler/jvm/lux.clj
+++ b/luxc/src/lux/compiler/jvm/lux.clj
@@ -276,8 +276,7 @@
(|let [[_ (&o/$function _ _arity _scope _captured ?body+)] (&o/shift-function-body (&/|tail __scope) __scope
false
(de-ann ?body))]
- (|do [:let [=value-type (&a/expr-type* ?body)]
- [file-name _ _] &/cursor
+ (|do [[file-name _ _] &/cursor
:let [datum-sig "Ljava/lang/Object;"
def-name (&host/def-name ?name)
current-class (str (&host/->module-class module-name) "/" def-name)
@@ -347,8 +346,7 @@
(return nil)))
_
- (|do [:let [=value-type (&a/expr-type* ?body)]
- [file-name _ _] &/cursor
+ (|do [[file-name _ _] &/cursor
:let [datum-sig "Ljava/lang/Object;"
def-name (&host/def-name ?name)
current-class (str (&host/->module-class module-name) "/" def-name)
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 520e55434..19a7b4716 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -485,6 +485,26 @@
Text])]))
default-def-meta-exported)
+## (type: Module-State
+## #Active
+## #Compiled
+## #Cached)
+(_lux_def Module-State
+ (#NamedT ["lux" "Module-State"]
+ (#SumT
+ ## #Active
+ Unit
+ (#SumT
+ ## #Compiled
+ Unit
+ ## #Cached
+ Unit)))
+ (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "Active")
+ (#Cons (#TextA "Compiled")
+ (#Cons (#TextA "Cached")
+ #Nil))))]
+ default-def-meta-exported))
+
## (type: Module
## {#module-hash Int
## #module-aliases (List [Text Text])
@@ -493,6 +513,7 @@
## #tags (List [Text [Nat (List Ident) Bool Type]])
## #types (List [Text [(List Ident) Bool Type]])}
## #module-anns Anns
+## #module-state Module-State
## )
(_lux_def Module
(#NamedT ["lux" "Module"]
@@ -518,8 +539,9 @@
(#ProdT (#AppT List Ident)
(#ProdT Bool
Type))))
- ## "lux;module-anns"
- Anns)
+ (#ProdT ## "lux;module-anns"
+ Anns
+ Module-State))
))))))
(#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "module-hash")
(#Cons (#TextA "module-aliases")
@@ -528,7 +550,8 @@
(#Cons (#TextA "tags")
(#Cons (#TextA "types")
(#Cons (#TextA "module-anns")
- #Nil))))))))]
+ (#Cons (#TextA "module-state")
+ #Nil)))))))))]
(#Cons [["lux" "doc"] (#TextA "All the information contained within a Lux module.")]
default-def-meta-exported)))
@@ -556,21 +579,17 @@
default-def-meta-exported)))
## (type: Compiler-Info
-## {#compiler-name Text
-## #compiler-version Text
+## {#compiler-version Text
## #compiler-mode Compiler-Mode})
(_lux_def Compiler-Info
(#NamedT ["lux" "Compiler-Info"]
- (#ProdT ## "lux;compiler-name"
+ (#ProdT ## "lux;compiler-version"
Text
- (#ProdT ## "lux;compiler-version"
- Text
- ## "lux;compiler-mode"
- Compiler-Mode)))
- (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "compiler-name")
- (#Cons (#TextA "compiler-version")
- (#Cons (#TextA "compiler-mode")
- #Nil))))]
+ ## "lux;compiler-mode"
+ Compiler-Mode))
+ (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "compiler-version")
+ (#Cons (#TextA "compiler-mode")
+ #Nil)))]
(#Cons [["lux" "doc"] (#TextA "Information about the current version and type of compiler that is running.")]
default-def-meta-exported)))
@@ -1697,7 +1716,7 @@
#seed seed #expected expected #cursor cursor
#scope-type-vars scope-type-vars} state]
(_lux_case (get module modules)
- (#Some {#module-hash _ #module-aliases _ #defs defs #imports _ #tags tags #types types #module-anns _})
+ (#Some {#module-hash _ #module-aliases _ #defs defs #imports _ #tags tags #types types #module-anns _ #module-state _})
(_lux_case (get name defs)
(#Some [def-type def-meta def-value])
(_lux_case (get-meta ["lux" "alias"] def-meta)
@@ -2206,7 +2225,7 @@
($' Maybe Macro))
(do Monad<Maybe>
[$module (get module modules)
- gdef (let' [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags #types types #module-anns _} (_lux_: Module $module)]
+ gdef (let' [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags #types types #module-anns _ #module-state _} (_lux_: Module $module)]
(get name bindings))]
(let' [[def-type def-meta def-value] (_lux_: Def gdef)]
(_lux_case (get-meta ["lux" "macro?"] def-meta)
@@ -3374,7 +3393,7 @@
(-> Ident (Lux [Nat (List Ident) Bool Type]))
(do Monad<Lux>
[=module (find-module module)
- #let [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags-table #types types #module-anns _} =module]]
+ #let [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags-table #types types #module-anns _ #module-state _} =module]]
(case (get name tags-table)
(#Some output)
(return output)
@@ -3397,7 +3416,7 @@
(#NamedT [module name] _)
(do Monad<Lux>
[=module (find-module module)
- #let [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags #types types #module-anns _} =module]]
+ #let [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags #types types #module-anns _ #module-state _} =module]]
(case (get name types)
(#Some [tags exported? (#NamedT _ _type)])
(case (resolve-struct-type _type)
@@ -3956,7 +3975,7 @@
_
(list))))
- (let [{#module-hash _ #module-aliases _ #defs defs #imports _ #tags tags #types types #module-anns _} =module]
+ (let [{#module-hash _ #module-aliases _ #defs defs #imports _ #tags tags #types types #module-anns _ #module-state _} =module]
defs))]
(#Right state (List/join to-alias)))
@@ -4022,7 +4041,7 @@
#None
#None
- (#Some {#defs defs #module-hash _ #module-aliases _ #imports _ #tags tags #types types #module-anns _})
+ (#Some {#defs defs #module-hash _ #module-aliases _ #imports _ #tags tags #types types #module-anns _ #module-state _})
(case (get v-name defs)
#None
#None
@@ -4041,7 +4060,7 @@
#None
(#Left (Text/append "Unknown definition: " (Ident/encode name)))
- (#Some {#defs defs #module-hash _ #module-aliases _ #imports _ #tags tags #types types #module-anns _})
+ (#Some {#defs defs #module-hash _ #module-aliases _ #imports _ #tags tags #types types #module-anns _ #module-state _})
(case (get v-name defs)
#None
(#Left (Text/append "Unknown definition: " (Ident/encode name)))
@@ -4344,7 +4363,7 @@
(-> Text Text (Lux Bool))
(do Monad<Lux>
[module (find-module module-name)
- #let [{#module-hash _ #module-aliases _ #defs _ #imports imports #tags _ #types _ #module-anns _} module]]
+ #let [{#module-hash _ #module-aliases _ #defs _ #imports imports #tags _ #types _ #module-anns _ #module-state _} module]]
(wrap (is-member? imports import-name))))
(macro: #export (default tokens state)
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 18:28:20 +0000