aboutsummaryrefslogtreecommitdiff
path: root/luxc
diff options
context:
space:
mode:
Diffstat (limited to 'luxc')
-rw-r--r--luxc/src/lux.clj1
-rw-r--r--luxc/src/lux/analyser.clj4
-rw-r--r--luxc/src/lux/analyser/jvm.clj (renamed from luxc/src/lux/analyser/host.clj)4
-rw-r--r--luxc/src/lux/analyser/module.clj13
-rw-r--r--luxc/src/lux/compiler.clj276
-rw-r--r--luxc/src/lux/compiler/core.clj82
-rw-r--r--luxc/src/lux/compiler/io.clj2
-rw-r--r--luxc/src/lux/compiler/jvm.clj228
-rw-r--r--luxc/src/lux/compiler/jvm/base.clj (renamed from luxc/src/lux/compiler/base.clj)37
-rw-r--r--luxc/src/lux/compiler/jvm/cache.clj (renamed from luxc/src/lux/compiler/cache.clj)35
-rw-r--r--luxc/src/lux/compiler/jvm/case.clj (renamed from luxc/src/lux/compiler/case.clj)4
-rw-r--r--luxc/src/lux/compiler/jvm/host.clj (renamed from luxc/src/lux/compiler/host.clj)4
-rw-r--r--luxc/src/lux/compiler/jvm/lambda.clj (renamed from luxc/src/lux/compiler/lambda.clj)4
-rw-r--r--luxc/src/lux/compiler/jvm/lux.clj (renamed from luxc/src/lux/compiler/lux.clj)6
-rw-r--r--luxc/src/lux/compiler/module.clj23
-rw-r--r--luxc/src/lux/repl.clj2
16 files changed, 384 insertions, 341 deletions
diff --git a/luxc/src/lux.clj b/luxc/src/lux.clj
index 76778346d..182ddf46f 100644
--- a/luxc/src/lux.clj
+++ b/luxc/src/lux.clj
@@ -1,7 +1,6 @@
(ns lux
(:gen-class)
(:require [lux.base :as & :refer [|let |do return return* |case]]
- [lux.compiler.base :as &compiler-base]
[lux.compiler :as &compiler]
[lux.repl :as &repl]
[clojure.string :as string]
diff --git a/luxc/src/lux/analyser.clj b/luxc/src/lux/analyser.clj
index 51b5b4028..614bc0a34 100644
--- a/luxc/src/lux/analyser.clj
+++ b/luxc/src/lux/analyser.clj
@@ -9,7 +9,7 @@
[host :as &host])
(lux.analyser [base :as &&]
[lux :as &&lux]
- [host :as &&host]
+ [jvm :as &&jvm]
[module :as &&module]
[parser :as &&a-parser])))
@@ -130,7 +130,7 @@
(&/$Cons [_ (&/$TupleS ?args)]
(&/$Nil))) parameters]
(&/with-analysis-meta cursor exo-type
- (&&host/analyse-host analyse exo-type compilers ?category ?proc ?args)))
+ (&&jvm/analyse-host analyse exo-type compilers ?category ?proc ?args)))
"_lux_:"
(|let [(&/$Cons ?type
diff --git a/luxc/src/lux/analyser/host.clj b/luxc/src/lux/analyser/jvm.clj
index d89de457b..24d2b2017 100644
--- a/luxc/src/lux/analyser/host.clj
+++ b/luxc/src/lux/analyser/jvm.clj
@@ -1,4 +1,4 @@
-(ns lux.analyser.host
+(ns lux.analyser.jvm
(:require (clojure [template :refer [do-template]]
[string :as string])
clojure.core.match
@@ -15,7 +15,7 @@
[lambda :as &&lambda]
[env :as &&env]
[parser :as &&a-parser])
- [lux.compiler.base :as &c!base])
+ [lux.compiler.jvm.base :as &c!base])
(:import (java.lang.reflect Type TypeVariable)))
;; [Utils]
diff --git a/luxc/src/lux/analyser/module.clj b/luxc/src/lux/analyser/module.clj
index c6a079cab..3ccb887ff 100644
--- a/luxc/src/lux/analyser/module.clj
+++ b/luxc/src/lux/analyser/module.clj
@@ -396,3 +396,16 @@
_
(&/fail-with-loc "[Analyser Error] No import meta-data.")))
+
+(def tag-groups
+ "(Lux (List [Text (List Text)]))"
+ (|do [module &/get-current-module]
+ (return (&/|map (fn [pair]
+ (|case pair
+ [name [tags exported? _]]
+ (&/T [name (&/|map (fn [tag]
+ (|let [[t-prefix t-name] tag]
+ t-name))
+ tags)])))
+ (&/get$ $types module)))
+ ))
diff --git a/luxc/src/lux/compiler.clj b/luxc/src/lux/compiler.clj
index 4792a1809..fafb35818 100644
--- a/luxc/src/lux/compiler.clj
+++ b/luxc/src/lux/compiler.clj
@@ -1,267 +1,35 @@
(ns lux.compiler
(:refer-clojure :exclude [compile])
- (:require (clojure [string :as string]
- [set :as set]
- [template :refer [do-template]])
- clojure.core.match
+ (:require clojure.core.match
clojure.core.match.array
- (lux [base :as & :refer [|let |do return* return |case]]
- [type :as &type]
- [reader :as &reader]
- [lexer :as &lexer]
- [parser :as &parser]
- [analyser :as &analyser]
- [optimizer :as &optimizer]
- [host :as &host])
- [lux.host.generics :as &host-generics]
- [lux.optimizer :as &o]
- [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]
- [lambda :as &&lambda]
- [module :as &&module]
+ (lux [base :as & :refer [|let |do return* return |case]])
+ (lux.compiler [core :as &&core]
[io :as &&io]
- [parallel :as &&parallel])
- (lux.compiler.cache [type :as &&&type]
- [ann :as &&&ann]))
- (:import (org.objectweb.asm Opcodes
- Label
- ClassWriter
- MethodVisitor)))
+ [parallel :as &&parallel]
+ [jvm :as &&jvm]
+ ;; [js :as &&js]
+ )))
-;; [Resources]
-(def ^:private !source->last-line (atom nil))
-
-(defn compile-expression [$begin syntax]
- (|let [[[?type [_file-name _line _]] ?form] syntax]
- (|do [^MethodVisitor *writer* &/get-writer
- :let [debug-label (new Label)
- _ (when (not= _line (get @!source->last-line _file-name))
- (doto *writer*
- (.visitLabel debug-label)
- (.visitLineNumber (int _line) debug-label))
- (swap! !source->last-line assoc _file-name _line))]]
- (|case ?form
- (&o/$bool ?value)
- (&&lux/compile-bool ?value)
-
- (&o/$nat ?value)
- (&&lux/compile-nat ?value)
-
- (&o/$int ?value)
- (&&lux/compile-int ?value)
-
- (&o/$deg ?value)
- (&&lux/compile-deg ?value)
-
- (&o/$real ?value)
- (&&lux/compile-real ?value)
-
- (&o/$char ?value)
- (&&lux/compile-char ?value)
-
- (&o/$text ?value)
- (&&lux/compile-text ?value)
-
- (&o/$tuple ?elems)
- (&&lux/compile-tuple (partial compile-expression $begin) ?elems)
-
- (&o/$var (&/$Local ?idx))
- (&&lux/compile-local (partial compile-expression $begin) ?idx)
-
- (&o/$captured ?scope ?captured-id ?source)
- (&&lux/compile-captured (partial compile-expression $begin) ?scope ?captured-id ?source)
-
- (&o/$var (&/$Global ?owner-class ?name))
- (&&lux/compile-global (partial compile-expression $begin) ?owner-class ?name)
-
- (&o/$apply ?fn ?args)
- (&&lux/compile-apply (partial compile-expression $begin) ?fn ?args)
-
- (&o/$loop _register-offset _inits _body)
- (&&lux/compile-loop compile-expression _register-offset _inits _body)
-
- (&o/$iter _register-offset ?args)
- (&&lux/compile-iter (partial compile-expression $begin) $begin _register-offset ?args)
-
- (&o/$variant ?tag ?tail ?members)
- (&&lux/compile-variant (partial compile-expression $begin) ?tag ?tail ?members)
-
- (&o/$case ?value [?pm ?bodies])
- (&&case/compile-case (partial compile-expression $begin) ?value ?pm ?bodies)
-
- (&o/$let _value _register _body)
- (&&lux/compile-let (partial compile-expression $begin) _value _register _body)
-
- (&o/$record-get _value _path)
- (&&lux/compile-record-get (partial compile-expression $begin) _value _path)
-
- (&o/$if _test _then _else)
- (&&lux/compile-if (partial compile-expression $begin) _test _then _else)
-
- (&o/$function _register-offset ?arity ?scope ?env ?body)
- (&&lambda/compile-function compile-expression &/$None ?arity ?scope ?env ?body)
-
- (&o/$ann ?value-ex ?type-ex)
- (compile-expression $begin ?value-ex)
-
- (&o/$proc [?proc-category ?proc-name] ?args special-args)
- (&&host/compile-host (partial compile-expression $begin) ?proc-category ?proc-name ?args special-args)
-
- _
- (assert false (prn-str 'compile-expression (&/adt->text syntax)))
- ))
- ))
-
-(defn init!
- "(-> (List Text) Null)"
- [resources-dirs ^String target-dir]
- (do (reset! &&/!output-dir target-dir)
+(defn init! [resources-dirs ^String target-dir]
+ (do (reset! &&core/!output-dir target-dir)
(&&parallel/setup!)
(&&io/init-libs!)
- (reset! !source->last-line {})
(.mkdirs (new java.io.File target-dir))
- (let [class-loader (ClassLoader/getSystemClassLoader)
- addURL (doto (.getDeclaredMethod java.net.URLClassLoader "addURL" (into-array [java.net.URL]))
- (.setAccessible true))]
- (doseq [^String resources-dir (&/->seq resources-dirs)]
- (.invoke addURL class-loader
- (to-array [(->> resources-dir (new java.io.File) .toURI .toURL)]))))))
-
-(defn eval! [expr]
- (&/with-eval
- (|do [module &/get-module-name
- id &/gen-id
- [file-name _ _] &/cursor
- :let [class-name (str (&host/->module-class module) "/" id)
- =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
- (.visit &host/bytecode-version (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
- class-name nil "java/lang/Object" nil)
- (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) &/eval-field "Ljava/lang/Object;" nil nil)
- (doto (.visitEnd)))
- (.visitSource file-name nil))]
- _ (&/with-writer (.visitMethod =class Opcodes/ACC_STATIC "<clinit>" "()V" nil nil)
- (|do [^MethodVisitor *writer* &/get-writer
- :let [_ (.visitCode *writer*)]
- _ (compile-expression nil expr)
- :let [_ (doto *writer*
- (.visitFieldInsn Opcodes/PUTSTATIC class-name &/eval-field "Ljava/lang/Object;")
- (.visitInsn Opcodes/RETURN)
- (.visitMaxs 0 0)
- (.visitEnd))]]
- (return nil)))
- :let [bytecode (.toByteArray (doto =class
- .visitEnd))]
- _ (&&/save-class! (str id) bytecode)
- loader &/loader]
- (-> (.loadClass ^ClassLoader loader (str (&host-generics/->class-name module) "." id))
- (.getField &/eval-field)
- (.get nil)
- return))))
+ (&&jvm/init! resources-dirs target-dir)
+ ;; (&&js/init! resources-dirs target-dir)
+ ))
(def all-compilers
- (let [compile-expression* (partial compile-expression nil)]
- (&/T [(partial &&lux/compile-def compile-expression)
- (partial &&lux/compile-program compile-expression*)
- (partial &&host/compile-jvm-class compile-expression*)
- &&host/compile-jvm-interface])))
+ &&jvm/all-compilers)
-(let [+field-flags+ (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC)
- +datum-sig+ "Ljava/lang/Object;"]
- (defn compile-module [source-dirs name]
- (let [file-name (str name ".lux")]
- (|do [file-content (&&io/read-file source-dirs file-name)
- :let [file-hash (hash file-content)
- compile-module!! (&&parallel/parallel-compilation (partial compile-module source-dirs))]]
- (&/|eitherL (&&cache/load name)
- (let [compiler-step (&analyser/analyse &optimizer/optimize eval! compile-module!! all-compilers)]
- (|do [module-exists? (&a-module/exists? name)]
- (if module-exists?
- (&/fail-with-loc "[Compiler Error] Can't redefine a module!")
- (|do [_ (&&cache/delete name)
- _ (&a-module/create-module name file-hash)
- _ (&/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)
- module-class-name nil "java/lang/Object" nil)
- (-> (.visitField +field-flags+ &/hash-field "I" nil file-hash)
- .visitEnd)
- (-> (.visitField +field-flags+ &/compiler-field "Ljava/lang/String;" nil &/compiler-version)
- .visitEnd)
- (.visitSource file-name nil))]
- _ (if (= "lux" name)
- (|do [_ &&host/compile-Function-class
- _ &&host/compile-LuxRT-class]
- (return nil))
- (return nil))]
- (fn [state]
- (|case ((&/with-writer =class
- (&/exhaust% compiler-step))
- (&/set$ &/$source (&reader/from name file-content) state))
- (&/$Right ?state _)
- (&/run-state (|do [:let [_ (.visitEnd =class)]
- module-anns (&a-module/get-anns name)
- defs &a-module/defs
- imports &a-module/imports
- tag-groups &&module/tag-groups
- :let [def-entries (->> defs
- (&/|map (fn [_def]
- (|let [[?name ?alias [?def-type ?def-anns ?def-value]] _def]
- (if (= "" ?alias)
- (str ?name &&/datum-separator (&&&type/serialize-type ?def-type) &&/datum-separator (&&&ann/serialize-anns ?def-anns))
- (str ?name &&/datum-separator ?alias)))))
- (&/|interpose &&/entry-separator)
- (&/fold str ""))
- import-entries (->> imports
- (&/|map (fn [import]
- (|let [[_module _hash] import]
- (str _module &&/datum-separator _hash))))
- (&/|interpose &&/entry-separator)
- (&/fold str ""))
- tag-entries (->> tag-groups
- (&/|map (fn [group]
- (|let [[type tags] group]
- (->> tags
- (&/|interpose &&/datum-separator)
- (&/fold str "")
- (str type &&/datum-separator)))))
- (&/|interpose &&/entry-separator)
- (&/fold str ""))
- module-descriptor (->> (&/|list import-entries
- tag-entries
- (&&&ann/serialize-anns module-anns)
- def-entries)
- (&/|interpose &&/section-separator)
- (&/fold str ""))]
- _ (&/flag-compiled-module name)
- _ (&&/save-class! &/module-class-name (.toByteArray =class))
- _ (&&/write-module-descriptor! name module-descriptor)]
- (return file-hash))
- ?state)
-
- (&/$Left ?message)
- (&/fail* ?message))))))))
- )
- )))
+(defn eval! [expr]
+ (&&jvm/eval! expr))
-(let [!err! *err*]
- (defn compile-program [mode program-module resources-dir source-dirs target-dir]
- (do (init! resources-dir 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))
- (&/$Right ?state _)
- (do (println "Compilation complete!")
- (&&cache/clean ?state))
+(defn compile-module [source-dirs name]
+ (&&jvm/compile-module source-dirs name))
- (&/$Left ?message)
- (binding [*out* !err!]
- (do (println (str "Compilation failed:\n" ?message))
- (flush)
- (System/exit 1))))))))
+(defn compile-program [mode program-module resources-dir source-dirs target-dir]
+ (init! resources-dir target-dir)
+ (&&jvm/compile-program mode program-module resources-dir source-dirs target-dir)
+ ;; (&&js/compile-program mode program-module resources-dir source-dirs target-dir)
+ )
diff --git a/luxc/src/lux/compiler/core.clj b/luxc/src/lux/compiler/core.clj
new file mode 100644
index 000000000..4779c3c28
--- /dev/null
+++ b/luxc/src/lux/compiler/core.clj
@@ -0,0 +1,82 @@
+(ns lux.compiler.core
+ (:require (clojure [template :refer [do-template]]
+ [string :as string])
+ [clojure.java.io :as io]
+ [clojure.core.match :as M :refer [matchv]]
+ clojure.core.match.array
+ (lux [base :as & :refer [|let |do return* return fail*]]
+ [type :as &type]
+ [host :as &host])
+ (lux.analyser [base :as &a]
+ [module :as &a-module])
+ (lux.compiler.cache [type :as &&&type]
+ [ann :as &&&ann]))
+ (:import (java.io File
+ BufferedOutputStream
+ FileOutputStream)))
+
+;; [Constants]
+(def !output-dir (atom nil))
+
+(def ^:const section-separator (->> 29 char str))
+(def ^:const datum-separator (->> 31 char str))
+(def ^:const entry-separator (->> 30 char str))
+
+;; [Utils]
+(defn write-file [^String file-name ^bytes data]
+ (do (assert (not (.exists (File. file-name))) (str "Can't overwrite file: " file-name))
+ (with-open [stream (BufferedOutputStream. (FileOutputStream. file-name))]
+ (.write stream data)
+ (.flush stream))))
+
+;; [Exports]
+(def ^String lux-module-descriptor-name "lux_module_descriptor")
+
+(defn write-module-descriptor! [^String name ^String descriptor]
+ (|do [_ (return nil)
+ :let [lmd-dir (str @!output-dir java.io.File/separator (.replace name "/" java.io.File/separator))
+ _ (.mkdirs (File. lmd-dir))
+ _ (write-file (str lmd-dir java.io.File/separator lux-module-descriptor-name) (.getBytes descriptor java.nio.charset.StandardCharsets/UTF_8))]]
+ (return nil)))
+
+(defn read-module-descriptor! [^String name]
+ (|do [_ (return nil)]
+ (return (slurp (str @!output-dir java.io.File/separator (.replace name "/" java.io.File/separator) java.io.File/separator lux-module-descriptor-name)
+ :encoding "UTF-8"))))
+
+(def generate-module-descriptor
+ (|do [module-name &/get-module-name
+ module-anns (&a-module/get-anns module-name)
+ defs &a-module/defs
+ imports &a-module/imports
+ tag-groups &a-module/tag-groups
+ :let [def-entries (->> defs
+ (&/|map (fn [_def]
+ (|let [[?name ?alias [?def-type ?def-anns ?def-value]] _def]
+ (if (= "" ?alias)
+ (str ?name datum-separator (&&&type/serialize-type ?def-type) datum-separator (&&&ann/serialize-anns ?def-anns))
+ (str ?name datum-separator ?alias)))))
+ (&/|interpose entry-separator)
+ (&/fold str ""))
+ import-entries (->> imports
+ (&/|map (fn [import]
+ (|let [[_module _hash] import]
+ (str _module datum-separator _hash))))
+ (&/|interpose entry-separator)
+ (&/fold str ""))
+ tag-entries (->> tag-groups
+ (&/|map (fn [group]
+ (|let [[type tags] group]
+ (->> tags
+ (&/|interpose datum-separator)
+ (&/fold str "")
+ (str type datum-separator)))))
+ (&/|interpose entry-separator)
+ (&/fold str ""))
+ module-descriptor (->> (&/|list import-entries
+ tag-entries
+ (&&&ann/serialize-anns module-anns)
+ def-entries)
+ (&/|interpose section-separator)
+ (&/fold str ""))]]
+ (return module-descriptor)))
diff --git a/luxc/src/lux/compiler/io.clj b/luxc/src/lux/compiler/io.clj
index 3ee19988f..82b80f624 100644
--- a/luxc/src/lux/compiler/io.clj
+++ b/luxc/src/lux/compiler/io.clj
@@ -1,6 +1,6 @@
(ns lux.compiler.io
(:require (lux [base :as & :refer [|case |let |do return* return fail*]])
- (lux.compiler [base :as &&])
+ (lux.compiler.jvm [base :as &&])
[lux.lib.loader :as &lib]))
;; [Utils]
diff --git a/luxc/src/lux/compiler/jvm.clj b/luxc/src/lux/compiler/jvm.clj
new file mode 100644
index 000000000..5d787f5cd
--- /dev/null
+++ b/luxc/src/lux/compiler/jvm.clj
@@ -0,0 +1,228 @@
+(ns lux.compiler.jvm
+ (:refer-clojure :exclude [compile])
+ (:require (clojure [string :as string]
+ [set :as set]
+ [template :refer [do-template]])
+ clojure.core.match
+ clojure.core.match.array
+ (lux [base :as & :refer [|let |do return* return |case]]
+ [type :as &type]
+ [reader :as &reader]
+ [lexer :as &lexer]
+ [parser :as &parser]
+ [analyser :as &analyser]
+ [optimizer :as &optimizer]
+ [host :as &host])
+ [lux.host.generics :as &host-generics]
+ [lux.optimizer :as &o]
+ [lux.analyser.base :as &a]
+ [lux.analyser.module :as &a-module]
+ (lux.compiler [core :as &&core]
+ [io :as &&io]
+ [parallel :as &&parallel])
+ (lux.compiler.jvm [base :as &&]
+ [cache :as &&cache]
+ [lux :as &&lux]
+ [host :as &&host]
+ [case :as &&case]
+ [lambda :as &&lambda]))
+ (:import (org.objectweb.asm Opcodes
+ Label
+ ClassWriter
+ MethodVisitor)))
+
+;; [Resources]
+(def ^:private !source->last-line (atom nil))
+
+(defn ^:private compile-expression [$begin syntax]
+ (|let [[[?type [_file-name _line _]] ?form] syntax]
+ (|do [^MethodVisitor *writer* &/get-writer
+ :let [debug-label (new Label)
+ _ (when (not= _line (get @!source->last-line _file-name))
+ (doto *writer*
+ (.visitLabel debug-label)
+ (.visitLineNumber (int _line) debug-label))
+ (swap! !source->last-line assoc _file-name _line))]]
+ (|case ?form
+ (&o/$bool ?value)
+ (&&lux/compile-bool ?value)
+
+ (&o/$nat ?value)
+ (&&lux/compile-nat ?value)
+
+ (&o/$int ?value)
+ (&&lux/compile-int ?value)
+
+ (&o/$deg ?value)
+ (&&lux/compile-deg ?value)
+
+ (&o/$real ?value)
+ (&&lux/compile-real ?value)
+
+ (&o/$char ?value)
+ (&&lux/compile-char ?value)
+
+ (&o/$text ?value)
+ (&&lux/compile-text ?value)
+
+ (&o/$tuple ?elems)
+ (&&lux/compile-tuple (partial compile-expression $begin) ?elems)
+
+ (&o/$var (&/$Local ?idx))
+ (&&lux/compile-local (partial compile-expression $begin) ?idx)
+
+ (&o/$captured ?scope ?captured-id ?source)
+ (&&lux/compile-captured (partial compile-expression $begin) ?scope ?captured-id ?source)
+
+ (&o/$var (&/$Global ?owner-class ?name))
+ (&&lux/compile-global (partial compile-expression $begin) ?owner-class ?name)
+
+ (&o/$apply ?fn ?args)
+ (&&lux/compile-apply (partial compile-expression $begin) ?fn ?args)
+
+ (&o/$loop _register-offset _inits _body)
+ (&&lux/compile-loop compile-expression _register-offset _inits _body)
+
+ (&o/$iter _register-offset ?args)
+ (&&lux/compile-iter (partial compile-expression $begin) $begin _register-offset ?args)
+
+ (&o/$variant ?tag ?tail ?members)
+ (&&lux/compile-variant (partial compile-expression $begin) ?tag ?tail ?members)
+
+ (&o/$case ?value [?pm ?bodies])
+ (&&case/compile-case (partial compile-expression $begin) ?value ?pm ?bodies)
+
+ (&o/$let _value _register _body)
+ (&&lux/compile-let (partial compile-expression $begin) _value _register _body)
+
+ (&o/$record-get _value _path)
+ (&&lux/compile-record-get (partial compile-expression $begin) _value _path)
+
+ (&o/$if _test _then _else)
+ (&&lux/compile-if (partial compile-expression $begin) _test _then _else)
+
+ (&o/$function _register-offset ?arity ?scope ?env ?body)
+ (&&lambda/compile-function compile-expression &/$None ?arity ?scope ?env ?body)
+
+ (&o/$ann ?value-ex ?type-ex)
+ (compile-expression $begin ?value-ex)
+
+ (&o/$proc [?proc-category ?proc-name] ?args special-args)
+ (&&host/compile-host (partial compile-expression $begin) ?proc-category ?proc-name ?args special-args)
+
+ _
+ (assert false (prn-str 'compile-expression (&/adt->text syntax)))
+ ))
+ ))
+
+(defn init!
+ "(-> (List Text) Null)"
+ [resources-dirs ^String target-dir]
+ (do (reset! !source->last-line {})
+ (let [class-loader (ClassLoader/getSystemClassLoader)
+ addURL (doto (.getDeclaredMethod java.net.URLClassLoader "addURL" (into-array [java.net.URL]))
+ (.setAccessible true))]
+ (doseq [^String resources-dir (&/->seq resources-dirs)]
+ (.invoke addURL class-loader
+ (to-array [(->> resources-dir (new java.io.File) .toURI .toURL)]))))))
+
+(defn eval! [expr]
+ (&/with-eval
+ (|do [module &/get-module-name
+ id &/gen-id
+ [file-name _ _] &/cursor
+ :let [class-name (str (&host/->module-class module) "/" id)
+ =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
+ (.visit &host/bytecode-version (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
+ class-name nil "java/lang/Object" nil)
+ (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) &/eval-field "Ljava/lang/Object;" nil nil)
+ (doto (.visitEnd)))
+ (.visitSource file-name nil))]
+ _ (&/with-writer (.visitMethod =class Opcodes/ACC_STATIC "<clinit>" "()V" nil nil)
+ (|do [^MethodVisitor *writer* &/get-writer
+ :let [_ (.visitCode *writer*)]
+ _ (compile-expression nil expr)
+ :let [_ (doto *writer*
+ (.visitFieldInsn Opcodes/PUTSTATIC class-name &/eval-field "Ljava/lang/Object;")
+ (.visitInsn Opcodes/RETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd))]]
+ (return nil)))
+ :let [bytecode (.toByteArray (doto =class
+ .visitEnd))]
+ _ (&&/save-class! (str id) bytecode)
+ loader &/loader]
+ (-> (.loadClass ^ClassLoader loader (str (&host-generics/->class-name module) "." id))
+ (.getField &/eval-field)
+ (.get nil)
+ return))))
+
+(def all-compilers
+ (let [compile-expression* (partial compile-expression nil)]
+ (&/T [(partial &&lux/compile-def compile-expression)
+ (partial &&lux/compile-program compile-expression*)
+ (partial &&host/compile-jvm-class compile-expression*)
+ &&host/compile-jvm-interface])))
+
+(let [+field-flags+ (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC)
+ +datum-sig+ "Ljava/lang/Object;"]
+ (defn compile-module [source-dirs name]
+ (let [file-name (str name ".lux")]
+ (|do [file-content (&&io/read-file source-dirs file-name)
+ :let [file-hash (hash file-content)
+ compile-module!! (&&parallel/parallel-compilation (partial compile-module source-dirs))]]
+ (&/|eitherL (&&cache/load name)
+ (let [compiler-step (&analyser/analyse &optimizer/optimize eval! compile-module!! all-compilers)]
+ (|do [module-exists? (&a-module/exists? name)]
+ (if module-exists?
+ (&/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)
+ :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)
+ module-class-name nil "java/lang/Object" nil)
+ (-> (.visitField +field-flags+ &/hash-field "I" nil file-hash)
+ .visitEnd)
+ (-> (.visitField +field-flags+ &/compiler-field "Ljava/lang/String;" nil &/compiler-version)
+ .visitEnd)
+ (.visitSource file-name nil))]
+ _ (if (= "lux" name)
+ (|do [_ &&host/compile-Function-class
+ _ &&host/compile-LuxRT-class]
+ (return nil))
+ (return nil))]
+ (fn [state]
+ (|case ((&/with-writer =class
+ (&/exhaust% compiler-step))
+ (&/set$ &/$source (&reader/from name file-content) state))
+ (&/$Right ?state _)
+ (&/run-state (|do [:let [_ (.visitEnd =class)]
+ _ (&/flag-compiled-module name)
+ _ (&&/save-class! &/module-class-name (.toByteArray =class))
+ module-descriptor &&core/generate-module-descriptor
+ _ (&&core/write-module-descriptor! name module-descriptor)]
+ (return file-hash))
+ ?state)
+
+ (&/$Left ?message)
+ (&/fail* ?message))))))))
+ )
+ )))
+
+(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))
+ (&/$Right ?state _)
+ (do (println "Compilation complete!")
+ (&&cache/clean ?state))
+
+ (&/$Left ?message)
+ (binding [*out* !err!]
+ (do (println (str "Compilation failed:\n" ?message))
+ (flush)
+ (System/exit 1)))))))
diff --git a/luxc/src/lux/compiler/base.clj b/luxc/src/lux/compiler/jvm/base.clj
index e57fc1e2b..268b293e9 100644
--- a/luxc/src/lux/compiler/base.clj
+++ b/luxc/src/lux/compiler/jvm/base.clj
@@ -1,4 +1,4 @@
-(ns lux.compiler.base
+(ns lux.compiler.jvm.base
(:require (clojure [template :refer [do-template]]
[string :as string])
[clojure.java.io :as io]
@@ -9,7 +9,8 @@
[host :as &host])
(lux.analyser [base :as &a]
[module :as &a-module])
- [lux.host.generics :as &host-generics])
+ [lux.host.generics :as &host-generics]
+ [lux.compiler.core :as &&])
(:import (org.objectweb.asm Opcodes
Label
ClassWriter
@@ -20,8 +21,6 @@
(java.lang.reflect Field)))
;; [Constants]
-(def !output-dir (atom nil))
-
(def ^:const ^String function-class "lux/Function")
(def ^:const ^String lux-utils-class "lux/LuxRT")
(def ^:const ^String unit-tag-field "unit_tag")
@@ -37,27 +36,17 @@
(def ^:const arity-field "_arity_")
(def ^:const partials-field "_partials_")
-(def ^:const section-separator (->> 29 char str))
-(def ^:const datum-separator (->> 31 char str))
-(def ^:const entry-separator (->> 30 char str))
-
;; [Utils]
-(defn ^:private write-file [^String file-name ^bytes data]
- (do (assert (not (.exists (File. file-name))) (str "Can't overwrite file: " file-name))
- (with-open [stream (BufferedOutputStream. (FileOutputStream. file-name))]
- (.write stream data)
- (.flush stream))))
-
(defn ^:private write-output [module name data]
(let [^String module* (&host/->module-class module)
- module-dir (str @!output-dir java.io.File/separator (.replace module* "/" java.io.File/separator))]
+ module-dir (str @&&/!output-dir java.io.File/separator (.replace module* "/" java.io.File/separator))]
(.mkdirs (File. module-dir))
- (write-file (str module-dir java.io.File/separator name ".class") data)))
+ (&&/write-file (str module-dir java.io.File/separator name ".class") data)))
(defn class-exists? [^String module ^String class-name]
"(-> Text Text (IO Bool))"
(|do [_ (return nil)
- :let [full-path (str @!output-dir java.io.File/separator module java.io.File/separator class-name ".class")
+ :let [full-path (str @&&/!output-dir java.io.File/separator module java.io.File/separator class-name ".class")
exists? (.exists (File. full-path))]]
(return exists?)))
@@ -78,20 +67,6 @@
_ (load-class! loader real-name)]]
(return nil)))
-(def ^String lux-module-descriptor-name "lux_module_descriptor")
-
-(defn write-module-descriptor! [^String name ^String descriptor]
- (|do [_ (return nil)
- :let [lmd-dir (str @!output-dir java.io.File/separator (.replace name "/" java.io.File/separator))
- _ (.mkdirs (File. lmd-dir))
- _ (write-file (str lmd-dir java.io.File/separator lux-module-descriptor-name) (.getBytes descriptor java.nio.charset.StandardCharsets/UTF_8))]]
- (return nil)))
-
-(defn read-module-descriptor! [^String name]
- (|do [_ (return nil)]
- (return (slurp (str @!output-dir java.io.File/separator (.replace name "/" java.io.File/separator) java.io.File/separator lux-module-descriptor-name)
- :encoding "UTF-8"))))
-
(do-template [<wrap-name> <unwrap-name> <class> <unwrap-method> <prim> <dup>]
(do (defn <wrap-name> [^MethodVisitor writer]
(doto writer
diff --git a/luxc/src/lux/compiler/cache.clj b/luxc/src/lux/compiler/jvm/cache.clj
index 8ca319d66..1746514bc 100644
--- a/luxc/src/lux/compiler/cache.clj
+++ b/luxc/src/lux/compiler/jvm/cache.clj
@@ -1,4 +1,4 @@
-(ns lux.compiler.cache
+(ns lux.compiler.jvm.cache
(:refer-clojure :exclude [load])
(:require [clojure.string :as string]
[clojure.java.io :as io]
@@ -11,10 +11,11 @@
(lux.analyser [base :as &a]
[module :as &a-module]
[meta :as &a-meta])
- (lux.compiler [base :as &&]
+ (lux.compiler [core :as &&core]
[io :as &&io])
(lux.compiler.cache [type :as &&&type]
- [ann :as &&&ann]))
+ [ann :as &&&ann])
+ (lux.compiler.jvm [base :as &&]))
(:import (java.io File
BufferedOutputStream
FileOutputStream)
@@ -44,7 +45,7 @@
(defn cached? [module]
"(-> Text Bool)"
- (.exists (new File (str @&&/!output-dir
+ (.exists (new File (str @&&core/!output-dir
java.io.File/separator
(.replace ^String (&host/->module-class module) "/" java.io.File/separator)
java.io.File/separator
@@ -53,7 +54,7 @@
(defn delete [module]
"(-> Text (Lux Null))"
(fn [state]
- (do (clean-file (new File (str @&&/!output-dir
+ (do (clean-file (new File (str @&&core/!output-dir
java.io.File/separator
(.replace ^String (&host/->module-class module) "/" java.io.File/separator))))
(return* state nil))))
@@ -71,9 +72,9 @@
(defn clean [state]
"(-> Compiler Null)"
(let [needed-modules (->> state (&/get$ &/$modules) &/|keys &/->seq set)
- output-dir-prefix (str (.getAbsolutePath (new File ^String @&&/!output-dir)) java.io.File/separator)
+ output-dir-prefix (str (.getAbsolutePath (new File ^String @&&core/!output-dir)) java.io.File/separator)
outdated? #(->> % (contains? needed-modules) not)
- outdated-modules (->> (new File ^String @&&/!output-dir)
+ outdated-modules (->> (new File ^String @&&core/!output-dir)
.listFiles (filter #(.isDirectory ^File %))
(map module-dirs) doall (apply concat)
(map (fn [^File dir-file]
@@ -113,10 +114,10 @@
(if (= "" tags-section)
&/$Nil
(-> tags-section
- (.split &&/entry-separator)
+ (.split &&core/entry-separator)
seq
(->> (map (fn [^String _group]
- (let [[_type & _tags] (.split _group &&/datum-separator)]
+ (let [[_type & _tags] (.split _group &&core/datum-separator)]
(&/T [_type (->> _tags seq &/->list)])))))
&/->list)))
@@ -126,7 +127,7 @@
(&a-module/declare-tags module _tags was-exported? =type))))
(defn ^:private process-def-entry [loader module ^String _def-entry]
- (let [parts (.split _def-entry &&/datum-separator)]
+ (let [parts (.split _def-entry &&core/datum-separator)]
(case (alength parts)
2 (let [[_name _alias] parts
[_ __module __name] (re-find #"^(.*);(.*)$" _alias)
@@ -156,13 +157,13 @@
(return nil)))
(defn ^:private process-module [pre-load! source-dirs cache-table module-name module-hash loader]
- (|do [^String descriptor (&&/read-module-descriptor! module-name)
- :let [[imports-section tags-section module-anns-section defs-section] (.split descriptor &&/section-separator)
- imports (let [imports (vec (.split ^String imports-section &&/entry-separator))
+ (|do [^String descriptor (&&core/read-module-descriptor! module-name)
+ :let [[imports-section tags-section module-anns-section defs-section] (.split descriptor &&core/section-separator)
+ imports (let [imports (vec (.split ^String imports-section &&core/entry-separator))
imports (if (= [""] imports)
&/$Nil
(&/->list imports))]
- (&/|map #(.split ^String % &&/datum-separator 2) imports))]
+ (&/|map #(.split ^String % &&core/datum-separator 2) imports))]
cache-table* (&/fold% (fn [cache-table* _import]
(|do [:let [[_module _hash] _import]
file-content (&&io/read-file source-dirs (str _module ".lux"))
@@ -176,7 +177,7 @@
imports)
(let [tag-groups (parse-tag-groups tags-section)
module-anns (&&&ann/deserialize-anns module-anns-section)
- def-entries (let [def-entries (vec (.split ^String defs-section &&/entry-separator))]
+ def-entries (let [def-entries (vec (.split ^String defs-section &&core/entry-separator))]
(if (= [""] def-entries)
&/$Nil
(&/->list def-entries)))]
@@ -198,7 +199,7 @@
(list)))
(defn ^:private enumerate-cached-modules! []
- (let [output-dir (new File ^String @&&/!output-dir)
+ (let [output-dir (new File ^String @&&core/!output-dir)
prefix-to-subtract (inc (.length (.getAbsolutePath output-dir)))]
(->> output-dir
enumerate-cached-modules!*
@@ -219,7 +220,7 @@
(|do [loader &/loader
!classes &/classes
:let [module* (&host-generics/->class-name module)
- module-path (str @&&/!output-dir java.io.File/separator module)
+ module-path (str @&&core/!output-dir java.io.File/separator module)
class-name (str module* "." &/module-class-name)
^Class module-class (do (swap! !classes assoc class-name (read-file (new File (str module-path java.io.File/separator module-class-file))))
(&&/load-class! loader class-name))
diff --git a/luxc/src/lux/compiler/case.clj b/luxc/src/lux/compiler/jvm/case.clj
index aac3b6c98..da8d8d0a9 100644
--- a/luxc/src/lux/compiler/case.clj
+++ b/luxc/src/lux/compiler/jvm/case.clj
@@ -1,4 +1,4 @@
-(ns lux.compiler.case
+(ns lux.compiler.jvm.case
(:require (clojure [set :as set]
[template :refer [do-template]])
clojure.core.match
@@ -11,7 +11,7 @@
[host :as &host]
[optimizer :as &o])
[lux.analyser.case :as &a-case]
- [lux.compiler.base :as &&])
+ [lux.compiler.jvm.base :as &&])
(:import (org.objectweb.asm Opcodes
Label
ClassWriter
diff --git a/luxc/src/lux/compiler/host.clj b/luxc/src/lux/compiler/jvm/host.clj
index f0249f3d3..34a5a2bb7 100644
--- a/luxc/src/lux/compiler/host.clj
+++ b/luxc/src/lux/compiler/jvm/host.clj
@@ -1,4 +1,4 @@
-(ns lux.compiler.host
+(ns lux.compiler.jvm.host
(:require (clojure [string :as string]
[set :as set]
[template :refer [do-template]])
@@ -14,7 +14,7 @@
[lux.type.host :as &host-type]
[lux.host.generics :as &host-generics]
[lux.analyser.base :as &a]
- [lux.compiler.base :as &&])
+ [lux.compiler.jvm.base :as &&])
(:import (org.objectweb.asm Opcodes
Label
ClassWriter
diff --git a/luxc/src/lux/compiler/lambda.clj b/luxc/src/lux/compiler/jvm/lambda.clj
index 006476bef..87d977012 100644
--- a/luxc/src/lux/compiler/lambda.clj
+++ b/luxc/src/lux/compiler/jvm/lambda.clj
@@ -1,4 +1,4 @@
-(ns lux.compiler.lambda
+(ns lux.compiler.jvm.lambda
(:require (clojure [string :as string]
[set :as set]
[template :refer [do-template]])
@@ -13,7 +13,7 @@
[optimizer :as &o])
[lux.host.generics :as &host-generics]
[lux.analyser.base :as &a]
- (lux.compiler [base :as &&]))
+ (lux.compiler.jvm [base :as &&]))
(:import (org.objectweb.asm Opcodes
Label
ClassWriter
diff --git a/luxc/src/lux/compiler/lux.clj b/luxc/src/lux/compiler/jvm/lux.clj
index 36d923e60..591e490c4 100644
--- a/luxc/src/lux/compiler/lux.clj
+++ b/luxc/src/lux/compiler/jvm/lux.clj
@@ -1,4 +1,4 @@
-(ns lux.compiler.lux
+(ns lux.compiler.jvm.lux
(:require (clojure [string :as string]
[set :as set]
[template :refer [do-template]])
@@ -15,8 +15,8 @@
(lux.analyser [base :as &a]
[module :as &a-module]
[meta :as &a-meta])
- (lux.compiler [base :as &&]
- [lambda :as &&lambda]))
+ (lux.compiler.jvm [base :as &&]
+ [lambda :as &&lambda]))
(:import (org.objectweb.asm Opcodes
Label
ClassWriter
diff --git a/luxc/src/lux/compiler/module.clj b/luxc/src/lux/compiler/module.clj
deleted file mode 100644
index 9ca4e040b..000000000
--- a/luxc/src/lux/compiler/module.clj
+++ /dev/null
@@ -1,23 +0,0 @@
-(ns lux.compiler.module
- (:require (clojure [string :as string]
- [set :as set]
- [template :refer [do-template]])
- clojure.core.match
- clojure.core.match.array
- (lux [base :as & :refer [|let |do return* return |case]]
- [type :as &type])
- [lux.analyser.module :as &module]))
-
-;; [Exports]
-(def tag-groups
- "(Lux (List (, Text (List Text))))"
- (|do [module &/get-current-module]
- (return (&/|map (fn [pair]
- (|case pair
- [name [tags exported? _]]
- (&/T [name (&/|map (fn [tag]
- (|let [[t-prefix t-name] tag]
- t-name))
- tags)])))
- (&/get$ &module/$types module)))
- ))
diff --git a/luxc/src/lux/repl.clj b/luxc/src/lux/repl.clj
index 22c2f47d2..7562aaf70 100644
--- a/luxc/src/lux/repl.clj
+++ b/luxc/src/lux/repl.clj
@@ -6,7 +6,7 @@
[analyser :as &analyser]
[optimizer :as &optimizer]
[compiler :as &compiler])
- [lux.compiler.cache :as &cache]
+ [lux.compiler.jvm.cache :as &cache]
[lux.analyser.base :as &a-base]
[lux.analyser.lux :as &a-lux]
[lux.analyser.module :as &module])
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-24 02:51:29 +0000