aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/lux/compiler.clj100
-rw-r--r--src/lux/compiler/cache.clj126
-rw-r--r--src/lux/compiler/host.clj10
-rw-r--r--src/lux/compiler/io.clj18
4 files changed, 138 insertions, 116 deletions
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 3449900e0..b88bb9c0a 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -29,7 +29,8 @@
[host :as &&host]
[case :as &&case]
[lambda :as &&lambda]
- [package :as &&package]))
+ [package :as &&package]
+ [io :as &&io]))
(:import (org.objectweb.asm Opcodes
Label
ClassWriter
@@ -372,54 +373,55 @@
(defn ^:private compile-module [name]
;; (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 (&&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)]
- (if module-exists?
- (fail "[Compiler Error] Can't redefine a module!")
- (|do [_ (&a-module/enter-module name)
- :let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
- (.visit Opcodes/V1_6 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
- (str (&host/->module-class name) "/_") nil "java/lang/Object" nil)
- (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_hash" "I" nil file-hash)
- .visitEnd)
- (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_compiler" "Ljava/lang/String;" nil &&/version)
- .visitEnd))
- ;; _ (prn 'compile-module name =class)
- ]]
- (fn [state]
- (matchv ::M/objects [((&/with-writer =class
- (&/exhaust% compiler-step))
- (&/set$ &/$SOURCE (&reader/from file-name file-content) state))]
- [["lux;Right" [?state _]]]
- (&/run-state (|do [defs &a-module/defs
- imports &a-module/imports
- :let [_ (doto =class
- (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_defs" "Ljava/lang/String;" nil
- (->> defs
- (&/|map (fn [_def]
- (|let [[?exported ?name ?ann] _def]
- (str (if ?exported "1" "0") " " ?name " " ?ann))))
- (&/|interpose "\t")
- (&/fold str "")))
- .visitEnd)
- (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_imports" "Ljava/lang/String;" nil
- (->> imports (&/|interpose "\t") (&/fold str "")))
- .visitEnd)
- (.visitEnd))
- ;; _ (prn 'CLOSED name =class)
- ]]
- (&&/save-class! "_" (.toByteArray =class)))
- ?state)
-
- [["lux;Left" ?message]]
- (fail* ?message)))))))
- )))
+ (let [file-name (str &&/input-dir "/" name ".lux")]
+ (|do [file-content (&&io/read-file file-name)
+ :let [file-hash (hash file-content)]]
+ (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)]
+ (if module-exists?
+ (fail "[Compiler Error] Can't redefine a module!")
+ (|do [_ (&a-module/enter-module name)
+ :let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
+ (.visit Opcodes/V1_6 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
+ (str (&host/->module-class name) "/_") nil "java/lang/Object" nil)
+ (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_hash" "I" nil file-hash)
+ .visitEnd)
+ (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_compiler" "Ljava/lang/String;" nil &&/version)
+ .visitEnd))
+ ;; _ (prn 'compile-module name =class)
+ ]]
+ (fn [state]
+ (matchv ::M/objects [((&/with-writer =class
+ (&/exhaust% compiler-step))
+ (&/set$ &/$SOURCE (&reader/from file-name file-content) state))]
+ [["lux;Right" [?state _]]]
+ (&/run-state (|do [defs &a-module/defs
+ imports &a-module/imports
+ :let [_ (doto =class
+ (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_defs" "Ljava/lang/String;" nil
+ (->> defs
+ (&/|map (fn [_def]
+ (|let [[?exported ?name ?ann] _def]
+ (str (if ?exported "1" "0") " " ?name " " ?ann))))
+ (&/|interpose "\t")
+ (&/fold str "")))
+ .visitEnd)
+ (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_imports" "Ljava/lang/String;" nil
+ (->> imports (&/|interpose "\t") (&/fold str "")))
+ .visitEnd)
+ (.visitEnd))
+ ;; _ (prn 'CLOSED name =class)
+ ]]
+ (&&/save-class! "_" (.toByteArray =class)))
+ ?state)
+
+ [["lux;Left" ?message]]
+ (fail* ?message)))))))
+ ))
+ ))
(defn ^:private init! []
(.mkdirs (java.io.File. &&/output-dir)))
diff --git a/src/lux/compiler/cache.clj b/src/lux/compiler/cache.clj
index c0d978146..45513d0a5 100644
--- a/src/lux/compiler/cache.clj
+++ b/src/lux/compiler/cache.clj
@@ -17,7 +17,8 @@
[host :as &host])
(lux.analyser [base :as &a]
[module :as &a-module])
- (lux.compiler [base :as &&]))
+ (lux.compiler [base :as &&]
+ [io :as &&io]))
(:import (java.io File
BufferedOutputStream
FileOutputStream)
@@ -74,65 +75,66 @@
(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)
+ (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]
+ (|do [content (&&io/read-file (str &&/input-dir "/" _import ".lux"))]
+ (load _import (hash content) compile-module)))
+ (if (= [""] imports)
(&/|list)
- (&/->list defs)))]
- (return true))))
- redo-cache)))
- redo-cache)
- ))
- redo-cache)))))
+ (&/->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)))))
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index 346b66fd2..542bd9a40 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -88,11 +88,11 @@
(defn <name> [compile *type* ?x ?y]
(|do [:let [+wrapper-class+ (&host/->class <wrapper-class>)]
^MethodVisitor *writer* &/get-writer
- _ (compile ?x)
+ _ (compile ?y)
:let [_ (doto *writer*
(.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+)
(.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>))]
- _ (compile ?y)
+ _ (compile ?x)
:let [_ (doto *writer*
(.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+)
(.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>))
@@ -191,9 +191,9 @@
compile-jvm-flt Opcodes/FCMPG 1 "java.lang.Float" "floatValue" "()F"
compile-jvm-fgt Opcodes/FCMPG -1 "java.lang.Float" "floatValue" "()F"
- compile-jvm-deq Opcodes/DCMPG 0 "java.lang.Double" "doubleValue" "()I"
- compile-jvm-dlt Opcodes/DCMPG 1 "java.lang.Double" "doubleValue" "()I"
- compile-jvm-dgt Opcodes/FCMPG -1 "java.lang.Double" "doubleValue" "()I"
+ compile-jvm-deq Opcodes/DCMPG 0 "java.lang.Double" "doubleValue" "()D"
+ compile-jvm-dlt Opcodes/DCMPG 1 "java.lang.Double" "doubleValue" "()D"
+ compile-jvm-dgt Opcodes/FCMPG -1 "java.lang.Double" "doubleValue" "()D"
)
(defn compile-jvm-invokestatic [compile *type* ?class ?method ?classes ?args]
diff --git a/src/lux/compiler/io.clj b/src/lux/compiler/io.clj
new file mode 100644
index 000000000..176b4340d
--- /dev/null
+++ b/src/lux/compiler/io.clj
@@ -0,0 +1,18 @@
+;; 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.io
+ (:require (lux [base :as & :refer [|let |do return* return fail fail*]])
+ ))
+
+;; [Resources]
+(defn read-file [path]
+ (let [file (new java.io.File path)]
+ (if (.exists file)
+ (return (slurp file))
+ (fail (str "[I/O] File doesn't exist: " path)))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-25 07:40:51 +0000