aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/lux/analyser/module.clj14
-rw-r--r--src/lux/base.clj2
-rw-r--r--src/lux/compiler.clj108
-rw-r--r--src/lux/compiler/base.clj53
-rw-r--r--src/lux/compiler/lambda.clj13
-rw-r--r--src/lux/compiler/lux.clj13
-rw-r--r--src/lux/host.clj11
-rw-r--r--src/lux/type.clj66
8 files changed, 84 insertions, 196 deletions
diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj
index 830319549..68cdc4747 100644
--- a/src/lux/analyser/module.clj
+++ b/src/lux/analyser/module.clj
@@ -77,10 +77,7 @@
[[_ ["lux;AliasD" [?r-module ?r-name]]]]
(&/run-state (def-type ?r-module ?r-name)
- state)
-
- [_]
- (assert false (prn-str 'def-type (str module ";" name) (aget $def 0))))
+ state))
(fail* (str "[Analyser Error] Unknown definition: " (str module ";" name))))
(fail* (str "[Analyser Error] Unknown module: " module)))))
@@ -135,12 +132,7 @@
;; (prn 'find-def/_0 module name 'current-module current-module)
(if-let [$module (->> state (&/get$ &/$MODULES) (&/|get module))]
(do ;; (prn 'find-def/_0.1 module (&/->seq (&/|keys $module)))
- (if-let [$def (try (->> $module (&/get$ $DEFS) (&/|get name))
- (catch StackOverflowError e
- (assert false (prn-str 'find-def
- (str module ";" name)
- (&/->seq (&/|keys (&/get$ $DEFS $module)))
- (&/->seq (&/|keys (&/get$ &/$MODULES state)))))))]
+ (if-let [$def (->> $module (&/get$ $DEFS) (&/|get name))]
(matchv ::M/objects [$def]
[[exported? $$def]]
(do ;; (prn 'find-def/_1 module name 'exported? exported? (.equals ^Object current-module module))
@@ -170,7 +162,7 @@
[[exported? ["lux;ValueD" ?type]]]
((|do [_ (&type/check &type/Macro ?type)
^ClassLoader loader &/loader
- :let [macro (-> (.loadClass loader (str (string/replace module #"/" ".") ".$" (&/normalize-ident name)))
+ :let [macro (-> (.loadClass loader (str (&host/->module-class module) "." (&/normalize-name name)))
(.getField "_datum")
(.get nil))]]
(fn [state*]
diff --git a/src/lux/base.clj b/src/lux/base.clj
index f88ca560e..9f0a78fa7 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -427,7 +427,7 @@
;; default
char))
-(defn normalize-ident [ident]
+(defn normalize-name [ident]
(reduce str "" (map normalize-char ident)))
(def loader
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 9ecdcc6ad..05ab12bf1 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -342,7 +342,7 @@
(&/with-eval
(|do [module &/get-module-name
id &/gen-id
- :let [class-name (str module "/" id)
+ :let [class-name (str (&host/->module-class module) "/" id)
;; _ (prn 'eval! id class-name)
=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
(.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
@@ -363,62 +363,58 @@
.visitEnd))]
_ (&&/save-class! (str id) bytecode)
loader &/loader]
- (-> (.loadClass ^ClassLoader loader (str (string/replace module #"/" ".") "." id))
+ (-> (.loadClass ^ClassLoader loader (str (&host/->module-class module) "." id))
(.getField "_eval")
(.get nil)
return))))
(defn ^:private compile-module [name]
- (prn 'compile-module name (&&/cached? name))
- (if (&&/cached? name)
- (do ;; (println "YOLO")
- (let [file-name (str "input/" name ".lux")
- file-content (slurp file-name)]
- (&&/load-cache name (hash file-content) 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?
- (if (.equals ^Object name "lux")
- (return nil)
- (fail "[Compiler Error] Can't redefine a module!"))
- (|do [_ (&a-module/enter-module name)
- :let [file-name (str "input/" name ".lux")
- file-content (slurp file-name)
- =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
- (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
- (str name "/_") nil "java/lang/Object" nil)
- (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_hash" "I" nil (hash file-content))
- .visitEnd)
- (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_compiler" "Ljava/lang/String;" nil &&/version)
- .visitEnd))]]
- (fn [state]
- (matchv ::M/objects [((&/exhaust% compiler-step)
- (->> state
- (&/set$ &/$SOURCE (&reader/from file-name file-content))
- (&/update$ &/$HOST #(&/set$ &/$WRITER (&/V "lux;Some" =class) %))))]
- [["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))]]
- (&&/save-class! "_" (.toByteArray =class)))
- ?state)
-
- [["lux;Left" ?message]]
- (fail* ?message)))))))
- ))
+ ;; (prn 'compile-module name (&&/cached? name))
+ (let [file-name (str "input/" name ".lux")
+ file-content (slurp file-name)
+ file-hash (hash file-content)]
+ (if (&&/cached? name)
+ (&&/load-cache 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_5 (+ 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))]]
+ (fn [state]
+ (matchv ::M/objects [((&/exhaust% compiler-step)
+ (->> state
+ (&/set$ &/$SOURCE (&reader/from file-name file-content))
+ (&/update$ &/$HOST #(&/set$ &/$WRITER (&/V "lux;Some" =class) %))))]
+ [["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))]]
+ (&&/save-class! "_" (.toByteArray =class)))
+ ?state)
+
+ [["lux;Left" ?message]]
+ (fail* ?message)))))))
+ )))
(defn ^:private clean-file [^java.io.File file]
(if (.isDirectory file)
@@ -440,14 +436,10 @@
(setup-dirs!)
(matchv ::M/objects [((&/map% compile-module modules) (&/init-state nil))]
[["lux;Right" [?state _]]]
- (println (str "Compilation complete! " (str "[" (->> modules
- (&/|interpose " ")
- (&/fold str ""))
- "]")))
+ (println "Compilation complete!")
[["lux;Left" ?message]]
- (do (prn 'compile-all '?message ?message)
- (assert false ?message))))
+ (assert false ?message)))
(comment
(compile-all ["lux"])
diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj
index a9abe44fc..d3dfc8746 100644
--- a/src/lux/compiler/base.clj
+++ b/src/lux/compiler/base.clj
@@ -12,7 +12,8 @@
[clojure.core.match :as M :refer [matchv]]
clojure.core.match.array
(lux [base :as & :refer [|do return* return fail fail*]]
- [type :as &type])
+ [type :as &type]
+ [host :as &host])
(lux.analyser [base :as &a]
[module :as &a-module]))
(:import (org.objectweb.asm Opcodes
@@ -30,12 +31,12 @@
(.write stream data)))
(defn ^:private write-output [module name data]
- (let [module* module]
+ (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* (string/replace module #"/" " ")]
+ (let [module* (&host/->module-class module)]
(.mkdirs (File. (str "cache/jvm/" module*)))
(write-file (str "cache/jvm/" module* "/" name ".class") data)))
@@ -70,7 +71,7 @@
module &/get-module-name
loader &/loader
!classes &/classes
- :let [real-name (str (string/replace module #"/" ".") "." name)
+ :let [real-name (str (&host/->module-class module) "." name)
_ (swap! !classes assoc real-name bytecode)
_ (load-class! loader real-name)
_ (when (not eval?)
@@ -79,11 +80,11 @@
(return nil)))
(defn cached? [module]
- (.exists (File. (str "cache/jvm/" (string/replace module #"/" " ") "/_.class"))))
+ (.exists (File. (str "cache/jvm/" (&host/->module-class module) "/_.class"))))
(defn delete-cache [module]
(fn [state]
- (do (clean-file (File. (str "cache/jvm/" (string/replace module #"/" " "))))
+ (do (clean-file (File. (str "cache/jvm/" (&host/->module-class module))))
(return* state nil))))
(defn ^:private replace-several [content & replacements]
@@ -95,34 +96,6 @@
(throw e)))
content replacement-list)))
-(defn ^:private replace-cache [^String cache-name]
- (if (.startsWith cache-name "$")
- (replace-several cache-name
- #"_ASTER_" "*"
- #"_PLUS_" "+"
- #"_DASH_" "-"
- #"_SLASH_" "/"
- #"_BSLASH_" "\\"
- #"_UNDERS_" "_"
- #"_PERCENT_" "%"
- #"_DOLLAR_" "$"
- #"_QUOTE_" "'"
- #"_BQUOTE_" "`"
- #"_AT_" "@"
- #"_CARET_" "^"
- #"_AMPERS_" "&"
- #"_EQ_" "="
- #"_BANG_" "!"
- #"_QM_" "?"
- #"_COLON_" ":"
- #"_PERIOD_" "."
- #"_COMMA_" ","
- #"_LT_" "<"
- #"_GT_" ">"
- #"_TILDE_" "~"
- #"_PIPE_" "|")
- cache-name))
-
(defn ^:private get-field [^String field-name ^Class class]
(-> class ^Field (.getField field-name) (.get nil))
;; (try (-> class ^Field (.getField field-name) (.get nil))
@@ -144,8 +117,8 @@
(return true)
(if (cached? module)
(do (prn 'load-cache/HASH module module-hash)
- (let [module-path (str "cache/jvm/" (string/replace module #"/" " "))
- module* (string/replace module #"/" ".")
+ (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))]
@@ -167,12 +140,8 @@
bytecode (read-file file)
;; _ (prn 'load-cache module real-name)
]
- ;; (swap! !classes assoc (str module* "." (replace-cache real-name)) bytecode)
(swap! !classes assoc (str module* "." real-name) bytecode)
- ;; (swap! !classes assoc "__temp__" bytecode)
- ;; (swap! !classes assoc (-> (load-class! loader "__temp__") (.getField "_name") (.get nil)) bytecode)
(write-output module real-name bytecode)))
- ;; (swap! !classes dissoc "__temp__")
(let [defs (string/split (get-field "_defs" module-meta) #"\t")]
;; (prn 'load-cache module defs)
(|do [_ (&a-module/enter-module module)
@@ -184,8 +153,8 @@
"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-ident _name)))
- ;; _ (println "Fetching _meta" module _name (str module* ".$" (&/normalize-ident _name)) def-class)
+ "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]]
diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj
index 9f4bef80c..d97cc1f26 100644
--- a/src/lux/compiler/lambda.clj
+++ b/src/lux/compiler/lambda.clj
@@ -93,20 +93,21 @@
;; [Exports]
(defn compile-lambda [compile ?scope ?env ?body]
;; (prn 'compile-lambda (->> ?scope &/->seq))
- (|do [:let [lambda-class (str (&/|head ?scope) "/$" (&host/location (&/|tail ?scope)))
+ (|do [:let [name (&host/location (&/|tail ?scope))
+ class-name (str (&host/->module-class (&/|head ?scope)) "/" name)
=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
(.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER)
- lambda-class nil "java/lang/Object" (into-array ["lux/Function"]))
+ class-name nil "java/lang/Object" (into-array ["lux/Function"]))
(-> (doto (.visitField (+ Opcodes/ACC_PRIVATE Opcodes/ACC_FINAL) captured-name clo-field-sig nil nil)
(.visitEnd))
(->> (let [captured-name (str &&/closure-prefix ?captured-id)])
(matchv ::M/objects [?name+?captured]
[[?name [["captured" [_ ?captured-id ?source]] _]]])
(doseq [?name+?captured (&/->seq ?env)])))
- (add-lambda-apply lambda-class ?env)
- (add-lambda-<init> lambda-class ?env)
+ (add-lambda-apply class-name ?env)
+ (add-lambda-<init> class-name ?env)
)]
_ (add-lambda-impl =class compile lambda-impl-signature ?body)
:let [_ (.visitEnd =class)]
- _ (&&/save-class! (str "$" (&host/location (&/|tail ?scope))) (.toByteArray =class))]
- (instance-closure compile lambda-class ?env (lambda-<init>-signature ?env))))
+ _ (&&/save-class! name (.toByteArray =class))]
+ (instance-closure compile class-name ?env (lambda-<init>-signature ?env))))
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index 66db6923d..32a7af751 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -115,14 +115,14 @@
:let [_ (doto *writer*
(.visitVarInsn Opcodes/ALOAD 0)
(.visitFieldInsn Opcodes/GETFIELD
- (str (&/|head ?scope) "/$" (&host/location (&/|tail ?scope)))
+ (str (&host/->module-class (&/|head ?scope)) "/" (&host/location (&/|tail ?scope)))
(str &&/closure-prefix ?captured-id)
"Ljava/lang/Object;"))]]
(return nil)))
(defn compile-global [compile *type* ?owner-class ?name]
(|do [^MethodVisitor *writer* &/get-writer
- :let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC (str ?owner-class "/$" (&/normalize-ident ?name)) "_datum" "Ljava/lang/Object;")]]
+ :let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC (str (&host/->module-class ?owner-class) "/" (&/normalize-name ?name)) "_datum" "Ljava/lang/Object;")]]
(return nil)))
(defn compile-apply [compile *type* ?fn ?args]
@@ -279,10 +279,9 @@
(defn compile-def [compile ?name ?body ?def-data]
(|do [^ClassWriter *writer* &/get-writer
module-name &/get-module-name
- :let [outer-class (&host/->class module-name)
- datum-sig "Ljava/lang/Object;"
- current-class (str outer-class "/" (str "$" (&/normalize-ident ?name)))
- ;; _ (prn 'compile-def 'outer-class outer-class '?name ?name 'current-class current-class)
+ :let [datum-sig "Ljava/lang/Object;"
+ def-name (&/normalize-name ?name)
+ current-class (str (&host/->module-class module-name) "/" def-name)
=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
(.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER)
current-class nil "java/lang/Object" (into-array ["lux/Function"]))
@@ -305,7 +304,7 @@
(.visitEnd))]]
(return nil)))
:let [_ (.visitEnd *writer*)]
- _ (&&/save-class! (str "$" (&/normalize-ident ?name)) (.toByteArray =class))]
+ _ (&&/save-class! def-name (.toByteArray =class))]
(return nil)))
(defn compile-ann [compile *type* ?value-ex ?type-ex]
diff --git a/src/lux/host.clj b/src/lux/host.clj
index abbdb8c6d..d248c708e 100644
--- a/src/lux/host.clj
+++ b/src/lux/host.clj
@@ -39,7 +39,10 @@
(defn ^String ->class [class]
(string/replace class #"\." "/"))
-(def ->package ->class)
+(defn ^String ->module-class [module-name]
+ (string/replace module-name #"/" " "))
+
+(def ->package ->module-class)
(defn ->type-signature [class]
;; (assert (string? class))
@@ -70,9 +73,7 @@
[["lux;VariantT" ["lux;Nil" _]]]
"V"
-
- [_]
- (assert false (prn-str '->java-sig (aget type 0)))))
+ ))
(defn extract-jvm-param [token]
(matchv ::M/objects [token]
@@ -114,4 +115,4 @@
)
(defn location [scope]
- (->> scope (&/|map &/normalize-ident) (&/|interpose "$") (&/fold str "")))
+ (->> scope (&/|map &/normalize-name) (&/|interpose "$") (&/fold str "")))
diff --git a/src/lux/type.clj b/src/lux/type.clj
index 14e87e063..f1a5b7623 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -416,73 +416,7 @@
[args body*]))]
(str "(All " ?name " [" (->> args reverse (interpose " ") (reduce str "")) "] " (show-type body) ")"))
?name)
-
- [_]
- (assert false (prn-str 'show-type (aget type 0) (class (aget type 1))))
))
-;; (defn show-type [^objects type]
-;; (matchv ::M/objects [type]
-;; [["lux;DataT" name]]
-;; (str "(^ " name ")")
-
-;; [["lux;TupleT" elems]]
-;; (if (&/|empty? elems)
-;; "(,)"
-;; (str "(, " (->> elems (&/|map show-type) (&/|interpose " ") (&/fold str "")) ")"))
-
-;; [["lux;VariantT" cases]]
-;; (if (&/|empty? cases)
-;; "(|)"
-;; (str "(| " (->> cases
-;; (&/|map (fn [kv]
-;; (matchv ::M/objects [kv]
-;; [[k ["lux;TupleT" ["lux;Nil" _]]]]
-;; (str "#" k)
-
-;; [[k v]]
-;; (str "(#" k " " (show-type v) ")"))))
-;; (&/|interpose " ")
-;; (&/fold str "")) ")"))
-
-
-;; [["lux;RecordT" fields]]
-;; (str "(& " (->> fields
-;; (&/|map (fn [kv]
-;; (matchv ::M/objects [kv]
-;; [[k v]]
-;; (str "#" k " " (show-type v)))))
-;; (&/|interpose " ")
-;; (&/fold str "")) ")")
-
-;; [["lux;LambdaT" [input output]]]
-;; (str "(-> " (show-type input) " " (show-type output) ")")
-
-;; [["lux;VarT" id]]
-;; (str "⌈" id "⌋")
-
-;; [["lux;BoundT" name]]
-;; name
-
-;; [["lux;ExT" ?id]]
-;; (str "⟨" ?id "⟩")
-
-;; [["lux;AppT" [?lambda ?param]]]
-;; (str "(" (show-type ?lambda) " " (show-type ?param) ")")
-
-;; [["lux;AllT" [?env ?name ?arg ?body]]]
-;; (let [[args body] (loop [args (list ?arg)
-;; body* ?body]
-;; (matchv ::M/objects [body*]
-;; [["lux;AllT" [?env* ?name* ?arg* ?body*]]]
-;; (recur (cons ?arg* args) ?body*)
-
-;; [_]
-;; [args body*]))]
-;; (str "(All " ?name " [" (->> args reverse (interpose " ") (reduce str "")) "] " (show-type body) ")"))
-
-;; [_]
-;; (assert false (prn-str 'show-type (aget type 0) (class (aget type 1))))
-;; ))
(defn type= [x y]
(or (clojure.lang.Util/identical x y)
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-25 06:35:10 +0000