From aa3b52309f2e920688d56b0b00ba12040bf0e841 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 27 Sep 2015 01:07:18 -0400 Subject: - Lux programs can now use libraries for both the JVM (.jar files) and pure Lux code (.tar.gz files). - Fixed a bug regarding indices and loading/storing from/to arrays. --- project.clj | 3 +- src/lux.clj | 28 ++++++++---- src/lux/analyser/lux.clj | 4 +- src/lux/base.clj | 1 + src/lux/compiler.clj | 8 ++-- src/lux/compiler/cache.clj | 2 +- src/lux/compiler/host.clj | 16 +++++-- src/lux/compiler/io.clj | 23 ++++++++-- src/lux/compiler/package.clj | 66 --------------------------- src/lux/lib/loader.clj | 55 +++++++++++++++++++++++ src/lux/packager/lib.clj | 40 +++++++++++++++++ src/lux/packager/program.clj | 103 +++++++++++++++++++++++++++++++++++++++++++ 12 files changed, 260 insertions(+), 89 deletions(-) delete mode 100644 src/lux/compiler/package.clj create mode 100644 src/lux/lib/loader.clj create mode 100644 src/lux/packager/lib.clj create mode 100644 src/lux/packager/program.clj diff --git a/project.clj b/project.clj index 88191109a..9d09c53fc 100644 --- a/project.clj +++ b/project.clj @@ -5,6 +5,7 @@ :url "http://www.eclipse.org/legal/epl-v10.html"} :dependencies [[org.clojure/clojure "1.6.0"] [org.clojure/core.match "0.2.1"] - [org.ow2.asm/asm-all "5.0.3"]] + [org.ow2.asm/asm-all "5.0.3"] + [org.apache.commons/commons-compress "1.10"]] :warn-on-reflection true :main lux) diff --git a/src/lux.clj b/src/lux.clj index 03d09ebba..8cd2c4b80 100644 --- a/src/lux.clj +++ b/src/lux.clj @@ -5,17 +5,29 @@ (ns lux (:gen-class) - (:require [lux.base :as &] + (:require [lux.base :as & :refer [|let |do return fail return* fail* |case]] + [lux.compiler.base :as &compiler-base] [lux.compiler :as &compiler] - :reload-all)) + [lux.packager.lib :as &lib] + :reload-all) + (:import (java.io File))) -(defn -main [& [program-module & _]] - (if program-module - (time (&compiler/compile-program program-module)) - (println "Please provide a module name to compile.")) - (System/exit 0) +(defn -main [& args] + (|case (&/->list args) + (&/$Cons "compile" (&/$Cons program-module (&/$Nil))) + (if program-module + (time (&compiler/compile-program program-module)) + (println "Please provide a module name to compile.")) + + (&/$Cons "lib" (&/$Cons lib-module (&/$Nil))) + (&lib/package lib-module (new File &compiler-base/input-dir)) + + _ + (println "Can't understand command.")) + ;; (System/exit 0) ) (comment - (-main "program") + (-main "compile" "program") + (-main "lib" "lux") ) diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index 488b7ae4f..9dd8cecdc 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -558,7 +558,9 @@ active? (&/active-module? path) _ (&/assert! (not active?) (str "[Analyser Error] Can't import a module that is mid-compilation: " path " @ " module-name)) _ (&&module/add-import path) - _ (&/when% (not already-compiled?) (compile-module path))] + _ (if (not already-compiled?) + (compile-module path) + (return nil))] (return &/Nil$))))) (defn analyse-export [analyse compile-token name] diff --git a/src/lux/base.clj b/src/lux/base.clj index 19f236ce1..d8bce5f87 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -118,6 +118,7 @@ (def tags-field "_tags") (def module-class-name "_") (def +name-separator+ ";") +(def lib-dir "lib") (defn T [& elems] (to-array elems)) diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 90b8bcc05..9e399205f 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -26,9 +26,9 @@ [host :as &&host] [case :as &&case] [lambda :as &&lambda] - [package :as &&package] [module :as &&module] - [io :as &&io])) + [io :as &&io]) + [lux.packager.program :as &packager-program]) (:import (org.objectweb.asm Opcodes Label ClassWriter @@ -473,7 +473,7 @@ (defn ^:private compile-module [name] ;; (prn 'compile-module name (&&cache/cached? name)) - (let [file-name (str &&/input-dir "/" name ".lux")] + (let [file-name (str name ".lux")] (|do [file-content (&&io/read-file file-name) :let [file-hash (hash file-content)]] (if (&&cache/cached? name) @@ -551,7 +551,7 @@ (&/$Right ?state _) (do (println "Compilation complete!") (&&cache/clean ?state) - (&&package/package program-module)) + (&packager-program/package program-module)) (&/$Left ?message) (assert false ?message))) diff --git a/src/lux/compiler/cache.clj b/src/lux/compiler/cache.clj index d4ce7516d..4f37e8b62 100644 --- a/src/lux/compiler/cache.clj +++ b/src/lux/compiler/cache.clj @@ -89,7 +89,7 @@ ;; _ (prn 'load/IMPORTS module imports) ] (|do [loads (&/map% (fn [_import] - (|do [content (&&io/read-file (str &&/input-dir "/" _import ".lux")) + (|do [content (&&io/read-file (str _import ".lux")) _ (load _import (hash content) compile-module)] (&/cached-module? _import))) (if (= [""] imports) diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj index 2322b0e32..afb3c9a49 100644 --- a/src/lux/compiler/host.clj +++ b/src/lux/compiler/host.clj @@ -300,7 +300,9 @@ _ (compile ?array) :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST "[Ljava/lang/Object;")] _ (compile ?idx) - :let [_ (.visitInsn *writer* Opcodes/L2I)] + :let [_ (doto *writer* + &&/unwrap-long + (.visitInsn Opcodes/L2I))] :let [_ (doto *writer* (.visitInsn ) )]] @@ -312,7 +314,9 @@ :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST "[Ljava/lang/Object;")] :let [_ (.visitInsn *writer* Opcodes/DUP)] _ (compile ?idx) - :let [_ (.visitInsn *writer* Opcodes/L2I)] + :let [_ (doto *writer* + &&/unwrap-long + (.visitInsn Opcodes/L2I))] _ (compile ?elem) :let [_ (doto *writer* @@ -342,7 +346,9 @@ _ (compile ?array) :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST "[Ljava/lang/Object;")] _ (compile ?idx) - :let [_ (.visitInsn *writer* Opcodes/L2I)] + :let [_ (doto *writer* + &&/unwrap-long + (.visitInsn Opcodes/L2I))] :let [_ (.visitInsn *writer* Opcodes/AALOAD)]] (return nil))) @@ -352,7 +358,9 @@ :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST "[Ljava/lang/Object;")] :let [_ (.visitInsn *writer* Opcodes/DUP)] _ (compile ?idx) - :let [_ (.visitInsn *writer* Opcodes/L2I)] + :let [_ (doto *writer* + &&/unwrap-long + (.visitInsn Opcodes/L2I))] _ (compile ?elem) :let [_ (.visitInsn *writer* Opcodes/AASTORE)]] (return nil))) diff --git a/src/lux/compiler/io.clj b/src/lux/compiler/io.clj index 93be57f17..d83ec1404 100644 --- a/src/lux/compiler/io.clj +++ b/src/lux/compiler/io.clj @@ -5,11 +5,26 @@ (ns lux.compiler.io (:require (lux [base :as & :refer [|let |do return* return fail fail*]]) - )) + (lux.compiler [base :as &&]) + [lux.lib.loader :as &lib])) + +;; [Utils] +(def ^:private !libs (atom nil)) + +(defn ^:private libs-imported? [] + (not (nil? @!libs))) + +(defn ^:private init-libs! [] + (reset! !libs (&lib/load &/lib-dir))) ;; [Resources] -(defn read-file [^String path] - (let [file (new java.io.File path)] +(defn read-file [^String file-name] + ;; (prn 'read-file file-name) + (let [file (new java.io.File (str &&/input-dir "/" file-name))] (if (.exists file) (return (slurp file)) - (fail (str "[I/O Error] File doesn't exist: " path))))) + (do (when (not (libs-imported?)) + (init-libs!)) + (if-let [code (get @!libs file-name)] + (return code) + (fail (str "[I/O Error] File doesn't exist: " file-name))))))) diff --git a/src/lux/compiler/package.clj b/src/lux/compiler/package.clj deleted file mode 100644 index 4f703f5d1..000000000 --- a/src/lux/compiler/package.clj +++ /dev/null @@ -1,66 +0,0 @@ -;; Copyright (c) Eduardo Julian. All rights reserved. -;; This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. -;; If a copy of the MPL was not distributed with this file, -;; You can obtain one at http://mozilla.org/MPL/2.0/. - -(ns lux.compiler.package - (:require [clojure.core.match :as M :refer [matchv]] - clojure.core.match.array - (lux [base :as & :refer [|let |do return* return fail fail*]] - [host :as &host]) - (lux.compiler [base :as &&])) - (:import (java.io File - FileInputStream - FileOutputStream - BufferedInputStream) - (java.util.jar Manifest - Attributes$Name - JarEntry - JarOutputStream - ))) - -;; [Utils] -(def ^:private kilobyte 1024) - -(defn ^:private manifest [^String module] - "(-> Text Manifest)" - (doto (new Manifest) - (-> .getMainAttributes (doto (.put Attributes$Name/MAIN_CLASS (str (&host/->module-class module) "._")) - (.put Attributes$Name/MANIFEST_VERSION "1.0"))))) - -(defn ^:private write-class! [^String path ^File file ^JarOutputStream out] - "(-> Text File JarOutputStream Unit)" - ;; (prn 'write-class! path file) - (with-open [in (new BufferedInputStream (new FileInputStream file))] - (let [buffer (byte-array (* 10 kilobyte))] - (doto out - (.putNextEntry (new JarEntry (str path "/" (.getName file)))) - (-> (.write buffer 0 bytes-read) - (->> (when (not= -1 bytes-read)) - (loop [bytes-read (.read in buffer)]))) - (.flush) - (.closeEntry) - )) - )) - -(let [output-dir-size (.length &&/output-dir)] - (defn ^:private write-module! [^File file ^JarOutputStream out] - "(-> File JarOutputStream Unit)" - (let [module-name (.substring (.getPath file) output-dir-size) ;; (.getName file) - ;; _ (prn 'write-module! module-name file (.getPath file) (.substring (.getPath file) output-dir-size)) - inner-files (.listFiles file) - inner-modules (filter #(.isDirectory %) inner-files) - inner-classes (filter #(not (.isDirectory %)) inner-files)] - (doseq [$class inner-classes] - (write-class! module-name $class out)) - (doseq [$module inner-modules] - (write-module! $module out))))) - -;; [Resources] -(defn package [module] - "(-> Text (,))" - ;; (prn 'package module) - (with-open [out (new JarOutputStream (->> &&/output-package (new File) (new FileOutputStream)) (manifest module))] - (doseq [$group (.listFiles (new File &&/output-dir))] - (write-module! $group out)) - )) diff --git a/src/lux/lib/loader.clj b/src/lux/lib/loader.clj new file mode 100644 index 000000000..6326fb835 --- /dev/null +++ b/src/lux/lib/loader.clj @@ -0,0 +1,55 @@ +;; Copyright (c) Eduardo Julian. All rights reserved. +;; This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +;; If a copy of the MPL was not distributed with this file, +;; You can obtain one at http://mozilla.org/MPL/2.0/. + +(ns lux.lib.loader + (:refer-clojure :exclude [load]) + (:require (lux [base :as & :refer [|let |do return fail return* fail* |case]])) + (:import (java.io InputStream + File + FileInputStream + ByteArrayInputStream + ByteArrayOutputStream) + java.util.zip.GZIPInputStream + (org.apache.commons.compress.archivers.tar TarArchiveEntry + TarArchiveInputStream))) + +;; [Utils] +(defn ^:private fetch-libs [from] + (seq (.listFiles (new File from)))) + +(let [init-capacity (* 100 1024) + buffer-size 1024] + (defn ^:private ^"[B" read-stream [^InputStream is] + (let [buffer (byte-array buffer-size)] + (with-open [os (new ByteArrayOutputStream init-capacity)] + (loop [bytes-read (.read is buffer 0 buffer-size)] + (when (not= -1 bytes-read) + (do (.write os buffer 0 bytes-read) + (recur (.read is buffer 0 buffer-size))))) + (.toByteArray os))))) + +(defn ^:private unpackage [^File lib-file] + (let [is (->> lib-file + (new FileInputStream) + (new GZIPInputStream) + (new TarArchiveInputStream))] + (loop [lib-data {} + entry (.getNextTarEntry is)] + (if entry + (recur (assoc lib-data (.getName entry) (new String (read-stream is))) + (.getNextTarEntry is)) + lib-data)))) + +;; [Exports] +(def lib-ext ".tar.gz") + +(defn load [from] + (reduce merge {} + (for [lib (fetch-libs from)] + (unpackage lib)))) + +(comment + (->> &/lib-dir load keys) + ) diff --git a/src/lux/packager/lib.clj b/src/lux/packager/lib.clj new file mode 100644 index 000000000..41f3143a0 --- /dev/null +++ b/src/lux/packager/lib.clj @@ -0,0 +1,40 @@ +;; Copyright (c) Eduardo Julian. All rights reserved. +;; This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +;; If a copy of the MPL was not distributed with this file, +;; You can obtain one at http://mozilla.org/MPL/2.0/. + +(ns lux.packager.lib + (:require [lux.lib.loader :as &lib]) + (:import (java.io File + FileOutputStream) + java.util.zip.GZIPOutputStream + (org.apache.commons.compress.archivers.tar TarArchiveEntry + TarArchiveOutputStream) + )) + +;; [Utils] +(defn ^:private read-file [file] + (with-open [is (java.io.FileInputStream. file)] + (let [data (byte-array (.length file))] + (.read is data) + data))) + +(defn ^:private add-to-tar! [prefix ^File file os] + "(-> Text File TarArchiveOutputStream Unit)" + (let [file-name (str prefix "/" (.getName file))] + (if (.isDirectory file) + (doseq [file (seq (.listFiles file))] + (add-to-tar! file-name file os)) + (doto os + (.putArchiveEntry (doto (new TarArchiveEntry file-name) + (.setSize (.length file)))) + (.write (read-file file)) + (.closeArchiveEntry))))) + +;; [Exports] +(defn package [output-lib-name ^File source-dir] + "(-> Text File Unit)" + (with-open [out (->> (str output-lib-name &lib/lib-ext) (new FileOutputStream) (new GZIPOutputStream) (new TarArchiveOutputStream))] + (doseq [file (seq (.listFiles source-dir))] + (add-to-tar! "" file out)) + )) diff --git a/src/lux/packager/program.clj b/src/lux/packager/program.clj new file mode 100644 index 000000000..7337bcb02 --- /dev/null +++ b/src/lux/packager/program.clj @@ -0,0 +1,103 @@ +;; Copyright (c) Eduardo Julian. All rights reserved. +;; This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +;; If a copy of the MPL was not distributed with this file, +;; You can obtain one at http://mozilla.org/MPL/2.0/. + +(ns lux.packager.program + (:require [clojure.core.match :as M :refer [matchv]] + clojure.core.match.array + (lux [base :as & :refer [|let |do return* return fail fail*]] + [host :as &host]) + (lux.compiler [base :as &&])) + (:import (java.io InputStream + File + FileInputStream + FileOutputStream + BufferedInputStream + ByteArrayOutputStream) + (java.util.jar Manifest + Attributes$Name + JarEntry + JarInputStream + JarOutputStream + ))) + +;; [Utils] +(def ^:private kilobyte 1024) + +(defn ^:private manifest [^String module] + "(-> Text Manifest)" + (doto (new Manifest) + (-> .getMainAttributes (doto (.put Attributes$Name/MAIN_CLASS (str (&host/->module-class module) "._")) + (.put Attributes$Name/MANIFEST_VERSION "1.0"))))) + +(defn ^:private write-class! [^String path ^File file ^JarOutputStream out] + "(-> Text File JarOutputStream Unit)" + ;; (prn 'write-class! path file) + (with-open [in (new BufferedInputStream (new FileInputStream file))] + (let [buffer (byte-array (* 10 kilobyte))] + (doto out + (.putNextEntry (new JarEntry (str path "/" (.getName file)))) + (-> (.write buffer 0 bytes-read) + (->> (when (not= -1 bytes-read)) + (loop [bytes-read (.read in buffer)]))) + (.flush) + (.closeEntry) + )) + )) + +(let [output-dir-size (.length &&/output-dir)] + (defn ^:private write-module! [^File file ^JarOutputStream out] + "(-> File JarOutputStream Unit)" + (let [module-name (.substring (.getPath file) output-dir-size) ;; (.getName file) + ;; _ (prn 'write-module! module-name file (.getPath file) (.substring (.getPath file) output-dir-size)) + inner-files (.listFiles file) + inner-modules (filter #(.isDirectory ^File %) inner-files) + inner-classes (filter #(not (.isDirectory ^File %)) inner-files)] + (doseq [$class inner-classes] + (write-class! module-name $class out)) + (doseq [$module inner-modules] + (write-module! $module out))))) + +(defn ^:private fetch-available-jars [] + (->> ^java.net.URLClassLoader (ClassLoader/getSystemClassLoader) + (.getURLs) + (map #(.getFile ^java.net.URL %)) + (filter #(.endsWith ^String % ".jar")))) + +(let [init-capacity (* 100 1024) + buffer-size 1024] + (defn ^:private ^"[B" read-stream [^InputStream is] + (let [buffer (byte-array buffer-size)] + (with-open [os (new ByteArrayOutputStream init-capacity)] + (loop [bytes-read (.read is buffer 0 buffer-size)] + (when (not= -1 bytes-read) + (do (.write os buffer 0 bytes-read) + (recur (.read is buffer 0 buffer-size))))) + (.toByteArray os))))) + +(defn ^:private add-jar! [^File jar-file ^JarOutputStream out] + (with-open [is (->> jar-file (new FileInputStream) (new JarInputStream))] + (loop [^JarEntry entry (.getNextJarEntry is)] + (when entry + ;; (prn 'add-jar! (.getName entry) (.isDirectory entry)) + (when (and (not (.isDirectory entry)) + (not (.startsWith (.getName entry) "META-INF/"))) + (let [entry-data (read-stream is)] + (doto out + (.putNextEntry entry) + (.write entry-data 0 (alength entry-data)) + (.flush) + (.closeEntry)))) + (recur (.getNextJarEntry is)))))) + +;; [Resources] +(defn package [module] + "(-> Text (,))" + ;; (prn 'package module) + (with-open [out (new JarOutputStream (->> &&/output-package (new File) (new FileOutputStream)) (manifest module))] + (doseq [$group (.listFiles (new File &&/output-dir))] + (write-module! $group out)) + (doseq [^String jar-file (fetch-available-jars)] + (add-jar! (new File jar-file) out)) + )) -- cgit v1.2.3