From 97d1a9d0c5b469c3de4e9ee8af33e5a9d3144cb6 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 30 Jan 2017 17:35:20 -0400 Subject: - More refactorings. - Changed the place where module-compilation-state was being stored. - No longer keeping the compiler's name as part of the compiler's state. --- luxc/src/lux/analyser.clj | 3 +- luxc/src/lux/analyser/lux.clj | 30 +++++++-------- luxc/src/lux/analyser/module.clj | 43 +++++++++++++++++++-- luxc/src/lux/base.clj | 76 ++----------------------------------- luxc/src/lux/compiler/jvm.clj | 37 ++++++++++++++++-- luxc/src/lux/compiler/jvm/cache.clj | 4 +- luxc/src/lux/compiler/jvm/lux.clj | 6 +-- 7 files changed, 98 insertions(+), 101 deletions(-) (limited to 'luxc') 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 [ ] + (do (defn [module-name] + "(-> Text (Lux Unit))" + (fn [state] + (let [state* (&/update$ &/$modules + (fn [modules] + (&/|update module-name + (fn [=module] + (&/set$ $module-state =module)) + modules)) + state)] + (&/$Right (&/T [state* &/unit-tag]))))) + (defn [module-name] + "(-> Text (Lux Bool))" + (fn [state] + (if-let [=module (->> state (&/get$ &/$modules) (&/|get module-name))] + (&/$Right (&/T [state (|case (&/get$ $module-state =module) + () 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 [ ] - (do (defn [module] - "(-> Text (Lux Unit))" - (fn [state] - (let [state* (update$ $host (fn [host] - (update$ $module-states - (fn [module-states] - (|put module module-states)) - host)) - state)] - ($Right (T [state* unit-tag]))))) - (defn [module] - "(-> Text (Lux Bool))" - (fn [state] - (if-let [module-state (->> state (get$ $host) (get$ $module-states) (|get module))] - ($Right (T [state (|case module-state - () 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 [ ] (defn [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) -- cgit v1.2.3