From 4cd9b0c9242f1105e50ad9b42b7f6f5d074f14b4 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 25 Jul 2015 20:19:43 -0400 Subject: - The output directory is now being used as the cache. - "input" has been renamed as "source" and "output" has been renamed as "target". --- src/lux.clj | 4 +- src/lux/analyser/host.clj | 6 +- src/lux/analyser/lux.clj | 2 +- src/lux/compiler.clj | 34 ++++------- src/lux/compiler/base.clj | 144 +++++---------------------------------------- src/lux/compiler/cache.clj | 135 ++++++++++++++++++++++++++++++++++++++++++ 6 files changed, 165 insertions(+), 160 deletions(-) create mode 100644 src/lux/compiler/cache.clj (limited to 'src') diff --git a/src/lux.clj b/src/lux.clj index 7ff8fda37..9c913c9ac 100644 --- a/src/lux.clj +++ b/src/lux.clj @@ -14,9 +14,7 @@ :reload-all)) (defn -main [& _] - (do (time (&compiler/compile-all (&/|list "lux" "program"))) - ;; (prn @&type/counter) - ) + (time (&compiler/compile-all (&/|list "lux" "program"))) (System/exit 0)) (comment diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index 68bd627fc..e490bc62f 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -117,9 +117,9 @@ (defn analyse-jvm-invokestatic [analyse ?class ?method ?classes ?args] (|do [=classes (&/map% &host/extract-jvm-param ?classes) =return (&host/lookup-static-method ?class ?method =classes) - :let [_ (matchv ::M/objects [=return] - [["lux;DataT" _return-class]] - (prn 'analyse-jvm-invokestatic ?class ?method _return-class))] + ;; :let [_ (matchv ::M/objects [=return] + ;; [["lux;DataT" _return-class]] + ;; (prn 'analyse-jvm-invokestatic ?class ?method _return-class))] =args (&/map2% (fn [_class _arg] (&&/analyse-1 analyse (&/V "lux;DataT" _class) _arg)) =classes diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index 6acae193f..b25dff9eb 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -394,7 +394,7 @@ (return nil))] (&/save-module (|do [already-compiled? (&&module/exists? ?path) - :let [_ (prn 'analyse-import module-name ?path already-compiled?)] + ;; :let [_ (prn 'analyse-import module-name ?path already-compiled?)] _ (&&module/add-import ?path) _ (&/when% (not already-compiled?) (compile-module ?path))] (return (&/|list)))))) diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 05ab12bf1..bb1c72f66 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -24,6 +24,7 @@ [lux.analyser.base :as &a] [lux.analyser.module :as &a-module] (lux.compiler [base :as &&] + [cache :as &&cache] [lux :as &&lux] [host :as &&host] [case :as &&case] @@ -369,12 +370,12 @@ return)))) (defn ^:private compile-module [name] - ;; (prn 'compile-module name (&&/cached? name)) - (let [file-name (str "input/" name ".lux") + ;; (prn 'compile-module name (&&cache/cached? name)) + (let [file-name (str &&/input-dir "/" name ".lux") file-content (slurp file-name) file-hash (hash file-content)] - (if (&&/cached? name) - (&&/load-cache name file-hash compile-module) + (if (&&cache/cached? name) + (&&cache/load name file-hash compile-module) (let [compiler-step (|do [analysis+ (&optimizer/optimize eval! compile-module)] (&/map% compile-statement analysis+))] (|do [module-exists? (&a-module/exists? name)] @@ -416,31 +417,16 @@ (fail* ?message))))))) ))) -(defn ^:private clean-file [^java.io.File file] - (if (.isDirectory file) - (do (doseq [f (seq (.listFiles file))] - (clean-file f)) - (.delete file)) - (.delete file))) - -(defn ^:private setup-dirs! [] - (.mkdir (java.io.File. "cache")) - (.mkdir (java.io.File. "cache/jvm")) - (.mkdir (java.io.File. "output")) - (.mkdir (java.io.File. "output/jvm")) - (doseq [f (seq (.listFiles (java.io.File. "output/jvm")))] - (clean-file f))) +(defn ^:private init! [] + (.mkdirs (java.io.File. &&/output-dir))) ;; [Resources] (defn compile-all [modules] - (setup-dirs!) + (init!) (matchv ::M/objects [((&/map% compile-module modules) (&/init-state nil))] [["lux;Right" [?state _]]] - (println "Compilation complete!") + (do (println "Compilation complete!") + (&&cache/clean ?state)) [["lux;Left" ?message]] (assert false ?message))) - -(comment - (compile-all ["lux"]) - ) diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj index d3dfc8746..e7b338b16 100644 --- a/src/lux/compiler/base.clj +++ b/src/lux/compiler/base.clj @@ -25,43 +25,28 @@ FileOutputStream) (java.lang.reflect Field))) +;; [Constants] +(def ^String version "0.2") +(def ^String input-dir "source") +(def ^String output-dir "target/jvm") + +(def ^String local-prefix "l") +(def ^String partial-prefix "p") +(def ^String closure-prefix "c") +(def ^String apply-signature "(Ljava/lang/Object;)Ljava/lang/Object;") + ;; [Utils] (defn ^:private write-file [^String file ^bytes data] (with-open [stream (BufferedOutputStream. (FileOutputStream. file))] (.write stream data))) (defn ^:private write-output [module name data] - (let [module* (&host/->module-class module)] - (.mkdirs (File. (str "output/jvm/" module*))) - (write-file (str "output/jvm/" module* "/" name ".class") data))) - -(defn ^:private write-cache [module name data] - (let [module* (&host/->module-class module)] - (.mkdirs (File. (str "cache/jvm/" module*))) - (write-file (str "cache/jvm/" module* "/" name ".class") data))) - -(defn ^:private clean-file [^File file] - (if (.isDirectory file) - (do (doseq [f (seq (.listFiles file))] - (clean-file f)) - (.delete file)) - (.delete file))) - -(defn ^:private read-file [^File file] - (with-open [reader (io/input-stream file)] - (let [length (.length file) - buffer (byte-array length)] - (.read reader buffer 0 length) - buffer))) + (let [module* (&host/->module-class module) + module-dir (str output-dir "/" module*)] + (.mkdirs (File. module-dir)) + (write-file (str module-dir "/" name ".class") data))) ;; [Exports] -(def version "0.2") - -(def local-prefix "l") -(def partial-prefix "p") -(def closure-prefix "c") -(def apply-signature "(Ljava/lang/Object;)Ljava/lang/Object;") - (defn load-class! [^ClassLoader loader name] ;; (prn 'load-class! name) (.loadClass loader name)) @@ -75,104 +60,5 @@ _ (swap! !classes assoc real-name bytecode) _ (load-class! loader real-name) _ (when (not eval?) - (do (write-output module name bytecode) - (write-cache module name bytecode)))]] + (write-output module name bytecode))]] (return nil))) - -(defn cached? [module] - (.exists (File. (str "cache/jvm/" (&host/->module-class module) "/_.class")))) - -(defn delete-cache [module] - (fn [state] - (do (clean-file (File. (str "cache/jvm/" (&host/->module-class module)))) - (return* state nil)))) - -(defn ^:private replace-several [content & replacements] - (let [replacement-list (partition 2 replacements)] - (reduce #(try (let [[_pattern _rep] %2] - (string/replace %1 _pattern (string/re-quote-replacement _rep))) - (catch Exception e - (prn 'replace-several content %1 %2) - (throw e))) - content replacement-list))) - -(defn ^:private get-field [^String field-name ^Class class] - (-> class ^Field (.getField field-name) (.get nil)) - ;; (try (-> class ^Field (.getField field-name) (.get nil)) - ;; (catch Error e - ;; (assert false (prn-str 'get-field field-name class)))) - ) - -(defn load-cache [module module-hash compile-module] - (|do [loader &/loader - !classes &/classes - already-loaded? (&a-module/exists? module) - _modules &/modules - :let [redo-cache (|do [_ (delete-cache module) - _ (compile-module module)] - (return false))]] - (do (prn 'load-cache module 'sources already-loaded? - (&/->seq _modules)) - (if already-loaded? - (return true) - (if (cached? module) - (do (prn 'load-cache/HASH module module-hash) - (let [module* (&host/->module-class module) - module-path (str "cache/jvm/" module*) - class-name (str module* "._") - ^Class module-meta (do (swap! !classes assoc class-name (read-file (File. (str module-path "/_.class")))) - (load-class! loader class-name))] - (if (and (= module-hash (get-field "_hash" module-meta)) - (= version (get-field "_compiler" module-meta))) - (let [imports (string/split (-> module-meta (.getField "_imports") (.get nil)) #"\t") - _ (prn 'load-cache/IMPORTS module imports) - ] - (|do [loads (&/map% (fn [_import] - (load-cache _import (-> (str "input/" _import ".lux") slurp hash) compile-module)) - (if (= [""] imports) - (&/|list) - (&/->list imports)))] - (if (->> loads &/->seq (every? true?)) - (do (doseq [^File file (seq (.listFiles (File. module-path))) - :let [file-name (.getName file)] - :when (not= "_.class" file-name)] - (let [real-name (second (re-find #"^(.*)\.class$" file-name)) - bytecode (read-file file) - ;; _ (prn 'load-cache module real-name) - ] - (swap! !classes assoc (str module* "." real-name) bytecode) - (write-output module real-name bytecode))) - (let [defs (string/split (get-field "_defs" module-meta) #"\t")] - ;; (prn 'load-cache module defs) - (|do [_ (&a-module/enter-module module) - _ (&/map% (fn [_def] - (let [[_exported? _name _ann] (string/split _def #" ") - ;; _ (prn '[_exported? _name _ann] [_exported? _name _ann]) - ] - (|do [_ (case _ann - "T" (&a-module/define module _name (&/V "lux;TypeD" nil) &type/Type) - "M" (|do [_ (&a-module/define module _name (&/V "lux;ValueD" &type/Macro) &type/Macro)] - (&a-module/declare-macro module _name)) - "V" (let [def-class (load-class! loader (str module* "." (&/normalize-name _name))) - ;; _ (println "Fetching _meta" module _name (str module* "." (&/normalize-name _name)) def-class) - def-type (get-field "_meta" def-class)] - (matchv ::M/objects [def-type] - [["lux;ValueD" _def-type]] - (&a-module/define module _name def-type _def-type))) - ;; else - (let [[_ __module __name] (re-find #"^A(.*);(.*)$" _ann)] - (|do [__type (&a-module/def-type __module __name)] - (do ;; (prn '__type [__module __name] (&type/show-type __type)) - (&a-module/def-alias module _name __module __name __type)))))] - (if (= "1" _exported?) - (&a-module/export module _name) - (return nil))) - )) - (if (= [""] defs) - (&/|list) - (&/->list defs)))] - (return true)))) - redo-cache))) - redo-cache) - )) - redo-cache))))) diff --git a/src/lux/compiler/cache.clj b/src/lux/compiler/cache.clj new file mode 100644 index 000000000..d6f0b1db7 --- /dev/null +++ b/src/lux/compiler/cache.clj @@ -0,0 +1,135 @@ +;; Copyright (c) Eduardo Julian. All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this distribution. +;; By using this software in any fashion, you are agreeing to be bound by +;; the terms of this license. +;; You must not remove this notice, or any other, from this software. + +(ns lux.compiler.cache + (:refer-clojure :exclude [load]) + (:require [clojure.string :as string] + [clojure.java.io :as io] + [clojure.core.match :as M :refer [matchv]] + clojure.core.match.array + (lux [base :as & :refer [|do return* return fail fail*]] + [type :as &type] + [host :as &host]) + (lux.analyser [base :as &a] + [module :as &a-module]) + (lux.compiler [base :as &&])) + (:import (java.io File + BufferedOutputStream + FileOutputStream) + (java.lang.reflect Field))) + +;; [Utils] +(defn ^:private read-file [^File file] + (with-open [reader (io/input-stream file)] + (let [length (.length file) + buffer (byte-array length)] + (.read reader buffer 0 length) + buffer))) + +(defn ^:private clean-file [^File file] + (if (.isDirectory file) + (do (doseq [f (seq (.listFiles file))] + (clean-file f)) + (.delete file)) + (.delete file))) + +(defn ^:private get-field [^String field-name ^Class class] + (-> class ^Field (.getField field-name) (.get nil))) + +;; [Resources] +(defn cached? [module] + "(-> Text Bool)" + (.exists (new File (str &&/output-dir "/" (&host/->module-class module) "/_.class")))) + +(defn delete [module] + "(-> Text (Lux (,)))" + (fn [state] + (do (clean-file (new File (str &&/output-dir "/" (&host/->module-class module)))) + (return* state nil)))) + +(defn clean [state] + "(-> Compiler (,))" + (let [needed-modules (->> state (&/get$ &/$MODULES) &/|keys &/->seq set) + outdated? #(-> % .getName (string/replace " " "/") (->> (contains? needed-modules)) not) + outdate-files (->> &&/output-dir (new File) .listFiles seq (filter outdated?))] + (doseq [f outdate-files] + (clean-file f)) + nil)) + +(defn load [module module-hash compile-module] + (|do [loader &/loader + !classes &/classes + already-loaded? (&a-module/exists? module) + _modules &/modules + :let [redo-cache (|do [_ (delete module) + _ (compile-module module)] + (return false))]] + (do ;; (prn 'load module 'sources already-loaded? + ;; (&/->seq _modules)) + (if already-loaded? + (return true) + (if (cached? module) + (do ;; (prn 'load/HASH module module-hash) + (let [module* (&host/->module-class module) + module-path (str &&/output-dir "/" module*) + class-name (str module* "._") + ^Class module-meta (do (swap! !classes assoc class-name (read-file (File. (str module-path "/_.class")))) + (&&/load-class! loader class-name))] + (if (and (= module-hash (get-field "_hash" module-meta)) + (= &&/version (get-field "_compiler" module-meta))) + (let [imports (string/split (-> module-meta (.getField "_imports") (.get nil)) #"\t") + ;; _ (prn 'load/IMPORTS module imports) + ] + (|do [loads (&/map% (fn [_import] + (load _import (-> (str &&/input-dir "/" _import ".lux") slurp hash) compile-module)) + (if (= [""] imports) + (&/|list) + (&/->list imports)))] + (if (->> loads &/->seq (every? true?)) + (do (doseq [^File file (seq (.listFiles (File. module-path))) + :let [file-name (.getName file)] + :when (not= "_.class" file-name)] + (let [real-name (second (re-find #"^(.*)\.class$" file-name)) + bytecode (read-file file) + ;; _ (prn 'load module real-name) + ] + (swap! !classes assoc (str module* "." real-name) bytecode))) + (let [defs (string/split (get-field "_defs" module-meta) #"\t")] + ;; (prn 'load module defs) + (|do [_ (&a-module/enter-module module) + _ (&/map% (fn [_def] + (let [[_exported? _name _ann] (string/split _def #" ") + ;; _ (prn '[_exported? _name _ann] [_exported? _name _ann]) + ] + (|do [_ (case _ann + "T" (&a-module/define module _name (&/V "lux;TypeD" nil) &type/Type) + "M" (|do [_ (&a-module/define module _name (&/V "lux;ValueD" &type/Macro) &type/Macro)] + (&a-module/declare-macro module _name)) + "V" (let [def-class (&&/load-class! loader (str module* "." (&/normalize-name _name))) + ;; _ (println "Fetching _meta" module _name (str module* "." (&/normalize-name _name)) def-class) + def-type (get-field "_meta" def-class)] + (matchv ::M/objects [def-type] + [["lux;ValueD" _def-type]] + (&a-module/define module _name def-type _def-type))) + ;; else + (let [[_ __module __name] (re-find #"^A(.*);(.*)$" _ann)] + (|do [__type (&a-module/def-type __module __name)] + (do ;; (prn '__type [__module __name] (&type/show-type __type)) + (&a-module/def-alias module _name __module __name __type)))))] + (if (= "1" _exported?) + (&a-module/export module _name) + (return nil))) + )) + (if (= [""] defs) + (&/|list) + (&/->list defs)))] + (return true)))) + redo-cache))) + redo-cache) + )) + redo-cache))))) -- cgit v1.2.3