aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/lux.clj2
-rw-r--r--src/lux/analyser.clj5
-rw-r--r--src/lux/analyser/base.clj2
-rw-r--r--src/lux/analyser/case.clj4
-rw-r--r--src/lux/analyser/def.clj44
-rw-r--r--src/lux/analyser/env.clj1
-rw-r--r--src/lux/analyser/host.clj2
-rw-r--r--src/lux/analyser/lux.clj44
-rw-r--r--src/lux/compiler.clj22
-rw-r--r--src/lux/compiler/case.clj7
-rw-r--r--src/lux/compiler/lambda.clj3
-rw-r--r--src/lux/compiler/lux.clj16
-rw-r--r--src/lux/macro.clj58
-rw-r--r--src/lux/optimizer.clj5
14 files changed, 121 insertions, 94 deletions
diff --git a/src/lux.clj b/src/lux.clj
index b42d0bb42..ccab7ec3f 100644
--- a/src/lux.clj
+++ b/src/lux.clj
@@ -25,3 +25,5 @@
;; jar cvf test2.jar *.class test2 && java -cp "test2.jar" test2
;; cd output && jar cvf test2.jar * && java -cp "test2.jar" test2 && cd ..
)
+
+
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index fccbb4377..e46d424f2 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -14,7 +14,7 @@
;; [Utils]
(defn ^:private analyse-basic-ast [analyse-ast token]
- (prn 'analyse-basic-ast token)
+ ;; (prn 'analyse-basic-ast token)
(match token
;; Standard special forms
[::&parser/Bool ?value]
@@ -181,5 +181,6 @@
;; [Resources]
(def analyse
(exec [asts &parser/parse
- :let [_ (prn 'analyse/asts asts)]]
+ ;; :let [_ (prn 'analyse/asts asts)]
+ ]
(mapcat-m analyse-ast asts)))
diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj
index c4da0511d..f9028673d 100644
--- a/src/lux/analyser/base.clj
+++ b/src/lux/analyser/base.clj
@@ -6,7 +6,7 @@
;; [Resources]
(defn expr-type [syntax+]
- (prn 'expr-type syntax+)
+ ;; (prn 'expr-type syntax+)
(match syntax+
[::Expression _ type]
(return type)
diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj
index bbd454fc1..4aec4af10 100644
--- a/src/lux/analyser/case.clj
+++ b/src/lux/analyser/case.clj
@@ -24,11 +24,11 @@
(list)))
(defn analyse-branch [analyse max-registers [bindings body]]
+ (prn 'analyse-branch max-registers bindings body)
(reduce (fn [body* name]
(&env/with-local name :local &type/+dont-care-type+ body*))
(reduce (fn [body* _]
(&env/with-local "#" :local &type/+dont-care-type+ body*))
(&&/analyse-1 analyse body)
(range (- max-registers (count bindings))))
- bindings))
-
+ (reverse bindings)))
diff --git a/src/lux/analyser/def.clj b/src/lux/analyser/def.clj
index c8994bc67..c6443ca22 100644
--- a/src/lux/analyser/def.clj
+++ b/src/lux/analyser/def.clj
@@ -1,43 +1,35 @@
(ns lux.analyser.def
- (:require [clojure.core.match :refer [match]]
+ (:require (clojure [template :refer [do-template]])
+ [clojure.core.match :refer [match]]
(lux [base :as & :refer [exec return fail
if-m try-all-m map-m mapcat-m reduce-m
assert!]])
[lux.analyser.base :as &&]))
;; [Exports]
-(defn defined? [module name]
- (fn [state]
- [::&/ok [state (get-in state [::&/modules module name :defined?])]]))
+(def init-module
+ {::defs {}
+ ::macros #{}})
-(defn annotated? [module name]
- (fn [state]
- [::&/ok [state (boolean (get-in state [::&/modules module name]))]]))
+(do-template [<name> <category>]
+ (defn <name> [module name]
+ (fn [state]
+ [::&/ok [state (boolean (get-in state [::&/modules module <category> name]))]]))
+
+ defined? ::defs
+ macro? ::macros
+ )
-(defn macro? [module name]
+(defn declare-macro [module name]
(fn [state]
- [::&/ok [state (boolean (get-in state [::&/modules module :macros name]))]]))
+ [::&/ok [(update-in state [::&/modules module ::macros] conj name)
+ nil]]))
-(defn annotate [module name access type]
+(defn define [module name type]
(fn [state]
(let [full-name (str module &/+name-separator+ name)
bound [::&&/Expression [::&&/global module name] type]]
[::&/ok [(-> state
- (assoc-in [::&/modules module name] {:args-n [:None]
- :access access
- :type type
- :defined? false})
+ (assoc-in [::&/modules module ::defs name] type)
(update-in [::&/global-env] merge {full-name bound, name bound}))
nil]])))
-
-(defn declare-macro [module name]
- (fn [state]
- [::&/ok [(assoc-in state [::&/modules module :macros name] true)
- nil]]))
-
-(defn define [module name]
- (if-m (annotated? module name)
- (fn [state]
- [::&/ok [(assoc-in state [::&/modules module name :defined?] true)
- nil]])
- (fail (str "[Analyser Error] Can't define an unannotated element: " name))))
diff --git a/src/lux/analyser/env.clj b/src/lux/analyser/env.clj
index 020b9a899..c68641f7e 100644
--- a/src/lux/analyser/env.clj
+++ b/src/lux/analyser/env.clj
@@ -15,6 +15,7 @@
(let [old-mappings (-> state ::&/local-envs first (get-in [:locals :mappings]))
=return (body (update-in state [::&/local-envs]
(fn [[top & stack]]
+ (prn 'env/with-local name mode (get-in top [:locals :counter]))
(let [bound-unit (case mode
:self [::&&/self (list)]
:local [::&&/local (get-in top [:locals :counter])])]
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index e27745748..fd4444671 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -116,7 +116,7 @@
(return (list [::&&/Statement [::&&/jvm-class $module ?name ?super-class =fields {}]]))))
(defn analyse-jvm-interface [analyse ?name ?members]
- (prn 'analyse-jvm-interface ?name ?members)
+ ;; (prn 'analyse-jvm-interface ?name ?members)
(exec [?members (map-m (fn [member]
(match member
[::&parser/Form ([[::&parser/Ident ":"] [::&parser/Ident ?member-name]
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index c821a085d..4dc949d05 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -56,8 +56,11 @@
[::&&/global ?module ?name]
(exec [macro? (&&def/macro? ?module ?name)]
(if macro?
- (let [macro-class (&host/location (list ?name ?module))
- [macro-expansion state*] (&macro/expand loader macro-class ?args)]
+ (let [macro-class (&host/location (list ?module ?name))
+ [macro-expansion state*] (&macro/expand loader macro-class ?args)
+ _ (prn 'macro-expansion)
+ _ (doseq [ast macro-expansion]
+ (prn '=> ast))]
(mapcat-m analyse macro-expansion))
(exec [=args (mapcat-m analyse ?args)
:let [[needs-num =return-type] (match =fn-type
@@ -78,18 +81,26 @@
))
(defn analyse-case [analyse ?variant ?branches]
- (exec [=variant (&&/analyse-1 analyse ?variant)
- _ (assert! (and (> (count ?branches) 0) (even? (count ?branches)))
+ (prn 'analyse-case ?variant ?branches)
+ (exec [:let [num-branches (count ?branches)]
+ _ (assert! (and (> num-branches 0) (even? num-branches))
"Unbalanced branches in \"case'\" expression.")
:let [branches (partition 2 ?branches)
- locals-per-branch (map &&case/locals (map first branches))
+ locals-per-branch (map (comp &&case/locals first) branches)
max-locals (reduce max 0 (map count locals-per-branch))]
+ :let [_ (prn '[branches locals-per-branch max-locals] [branches locals-per-branch max-locals])]
base-register &&env/next-local-idx
+ :let [_ (prn 'base-register base-register)]
+ =variant (reduce (fn [body* _] (&&env/with-local "#" :local &type/+dont-care-type+ body*))
+ (&&/analyse-1 analyse ?variant)
+ (range max-locals))
+ :let [_ (prn '=variant =variant)]
=bodies (map-m (partial &&case/analyse-branch analyse max-locals)
(map vector locals-per-branch (map second branches)))
- :let [_ (prn 'analyse-case/=bodies =bodies)]
+ :let [_ (prn '=bodies =bodies)]
+ ;; :let [_ (prn 'analyse-case/=bodies =bodies)]
=body-types (map-m &&/expr-type =bodies)
- =case-type (reduce-m &type/merge [::&type/Nothing] =body-types)
+ =case-type (return [::&type/Any]) ;; (reduce-m &type/merge [::&type/Nothing] =body-types)
:let [=branches (map vector (map first branches) =bodies)]]
(return (list [::&&/Expression [::&&/case =variant base-register max-locals =branches] =case-type]))))
@@ -100,13 +111,14 @@
(&&/analyse-1 analyse ?body))
=body-type (&&/expr-type =body)
=lambda-type (exec [_ (&type/solve =return =body-type)]
- (&type/clean =lambda-type))
+ (&type/clean =lambda-type))
:let [=lambda-form (match =body
- [::&&/Expression [::&&/lambda ?sub-scope ?sub-captured ?sub-args ?sub-body] _]
- [::&&/lambda =scope =captured (cons ?arg ?sub-args) (&&lambda/raise-expr ?arg ?sub-body)]
+ [::&&/Expression [::&&/lambda ?sub-scope ?sub-captured ?sub-args ?sub-body] _]
+ [::&&/lambda =scope =captured (cons ?arg ?sub-args) (&&lambda/raise-expr ?arg ?sub-body)]
- _
- [::&&/lambda =scope =captured (list ?arg) =body])]]
+ _
+ [::&&/lambda =scope =captured (list ?arg) =body])
+ _ (prn '=lambda-form =lambda-form)]]
(return (list [::&&/Expression =lambda-form =lambda-type]))))
(defn analyse-def [analyse ?name ?value]
@@ -127,14 +139,12 @@
_
(fail ""))
=value-type (&&/expr-type =value)
- _ (if-m (&&def/annotated? module-name ?name)
- (return nil)
- (&&def/annotate module-name ?name :public =value-type))
- _ (&&def/define module-name ?name)]
+ _ (&&def/define module-name ?name =value-type)]
(return (list [::&&/Statement [::&&/def ?name =value]]))))))
(defn analyse-declare-macro [?ident]
- (exec [_ (&&def/annotate ?ident :public [::&type/Any])]
+ (exec [module-name &/get-module-name
+ _ (&&def/declare-macro module-name ?ident)]
(return (list))))
(defn analyse-require [analyse ?path]
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 17748a1eb..c32d1218a 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -12,8 +12,10 @@
[lexer :as &lexer]
[parser :as &parser]
[analyser :as &analyser]
+ [optimizer :as &optimizer]
[host :as &host])
[lux.analyser.base :as &a]
+ [lux.analyser.def :as &a-def]
(lux.compiler [base :as &&]
[lux :as &&lux]
[host :as &&host]
@@ -27,7 +29,7 @@
;; [Utils/Compilers]
(defn ^:private compile-expression [syntax]
- (prn 'compile-expression syntax)
+ ;; (prn 'compile-expression syntax)
(match syntax
[::&a/Expression ?form ?type]
(match ?form
@@ -171,7 +173,7 @@
(fail "[Compiler Error] Can't compile statements as expressions.")))
(defn ^:private compile-statement [syntax]
- (prn 'compile-statement syntax)
+ ;; (prn 'compile-statement syntax)
(match syntax
[::&a/Statement ?form]
(match ?form
@@ -187,8 +189,9 @@
_
(fail "[Compiler Error] Can't compile expressions as top-level forms.")))
-(let [compiler-step (exec [analysis+ &analyser/analyse
- :let [_ (prn 'analysis+ analysis+)]]
+(let [compiler-step (exec [analysis+ &optimizer/optimize
+ ;; :let [_ (prn 'analysis+ analysis+)]
+ ]
(mapcat-m compile-statement analysis+))]
(defn ^:private compile-module [name]
(fn [state]
@@ -197,13 +200,14 @@
(let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
(.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
(&host/->class name) nil "java/lang/Object" nil))]
- (match (&/run-state (exhaust-m compiler-step) (assoc state
- ::&/source (slurp (str "source/" name ".lux"))
- ::&/global-env (&/env name)
- ::&/writer =class))
+ (match (&/run-state (exhaust-m compiler-step) (-> state
+ (assoc ::&/source (slurp (str "source/" name ".lux"))
+ ::&/global-env (&/env name)
+ ::&/writer =class)
+ (assoc-in [::&/modules name] &a-def/init-module)))
[::&/ok [?state ?vals]]
(do (.visitEnd =class)
- (prn 'compile-module/?vals ?vals)
+ ;; (prn 'compile-module/?vals ?vals)
(&/run-state (&&/save-class! name (.toByteArray =class)) ?state))
[::&/failure ?message]
diff --git a/src/lux/compiler/case.clj b/src/lux/compiler/case.clj
index ba27d2c12..593a85d34 100644
--- a/src/lux/compiler/case.clj
+++ b/src/lux/compiler/case.clj
@@ -158,6 +158,7 @@
(let [ex-class (&host/->class "java.lang.IllegalStateException")]
(defn ^:private compile-pattern-matching [writer compile mappings patterns $end]
+ ;; (prn 'compile-pattern-matching patterns)
(let [entries (for [[?branch ?body] mappings
:let [label (new Label)]]
[[?branch label]
@@ -167,7 +168,7 @@
(-> (doto (compile-match ?match (get mappings* ?body) $else)
(.visitLabel $else))
(->> (doseq [[_ ?body ?match :as pattern] patterns
- :let [_ (prn 'compile-pattern-matching/pattern pattern)
+ :let [;; _ (prn 'compile-pattern-matching/pattern pattern)
$else (new Label)]])))
(.visitInsn Opcodes/POP)
(.visitTypeInsn Opcodes/NEW ex-class)
@@ -195,9 +196,9 @@
:let [_ (doto *writer*
(.visitInsn Opcodes/DUP)
(.visitLabel $start))]
- :let [_ (prn "PRE Compiled ?branches")]
+ ;; :let [_ (prn "PRE Compiled ?branches")]
:let [[mappings patterns] (process-branches ?base-register ?branches)]
_ (compile-pattern-matching *writer* compile mappings patterns $end)
- :let [_ (prn "POST Compiled ?branches")]
+ ;; :let [_ (prn "POST Compiled ?branches")]
:let [_ (.visitLabel *writer* $end)]]
(return nil)))
diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj
index 0b7ad1183..5c83b159e 100644
--- a/src/lux/compiler/lambda.clj
+++ b/src/lux/compiler/lambda.clj
@@ -93,7 +93,7 @@
(.visitTypeInsn Opcodes/NEW class-name)
(.visitInsn Opcodes/DUP)
(add-closure-vars class-name closed-over)
- (.visitLdcInsn (int current-captured))
+ (.visitLdcInsn (int (inc current-captured)))
(add-partial-vars class-name (take current-captured args))
(.visitVarInsn Opcodes/ALOAD 1)
(&&/add-nulls (- (dec num-captured) current-captured))
@@ -162,6 +162,7 @@
;; [Resources]
(defn compile-lambda [compile *type* ?scope ?closure ?args ?body with-datum? instance?]
+ (prn 'compile-lambda ?scope ?closure ?args ?body)
(exec [:let [lambda-class (&host/location ?scope)
impl-signature (lambda-impl-signature ?args)
<init>-sig (lambda-<init>-signature ?closure ?args)
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index 81d68c31c..cbab1fdd4 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -56,20 +56,20 @@
:let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC (&host/->class "java.lang.Boolean") (if ?value "TRUE" "FALSE") (&host/->type-signature "java.lang.Boolean"))]]
(return nil))))
-(do-template [<name> <class> <sig>]
+(do-template [<name> <class> <sig> <caster>]
(let [+class+ (&host/->class <class>)]
(defn <name> [compile *type* value]
(exec [*writer* &/get-writer
:let [_ (doto *writer*
- (.visitTypeInsn Opcodes/NEW <class>)
+ (.visitTypeInsn Opcodes/NEW +class+)
(.visitInsn Opcodes/DUP)
- (.visitLdcInsn value)
- (.visitMethodInsn Opcodes/INVOKESPECIAL <class> "<init>" <sig>))]]
+ (.visitLdcInsn (<caster> value))
+ (.visitMethodInsn Opcodes/INVOKESPECIAL +class+ "<init>" <sig>))]]
(return nil))))
- compile-int "java.lang.Long" "(J)V"
- compile-real "java.lang.Double" "(D)V"
- compile-char "java.lang.Character" "(C)V"
+ compile-int "java.lang.Long" "(J)V" long
+ compile-real "java.lang.Double" "(D)V" double
+ compile-char "java.lang.Character" "(C)V" char
)
(defn compile-text [compile *type* ?value]
@@ -88,7 +88,7 @@
_ (map-m (fn [idx]
(exec [:let [_ (.visitInsn *writer* Opcodes/DUP)]
ret (compile (nth ?elems idx))
- :let [_ (.visitFieldInsn *writer* Opcodes/PUTFIELD tuple-class (str &&/partial-prefix idx) "Ljava/lang/Object;")]]
+ :let [_ (.visitFieldInsn *writer* Opcodes/PUTFIELD tuple-class (str &&/tuple-field-prefix idx) "Ljava/lang/Object;")]]
(return ret)))
(range num-elems))]
(return nil)))
diff --git a/src/lux/macro.clj b/src/lux/macro.clj
index 511ffb7a7..76784a4a9 100644
--- a/src/lux/macro.clj
+++ b/src/lux/macro.clj
@@ -5,23 +5,25 @@
;; [Utils]
(defn ^:private ->lux+ [->lux loader xs]
(reduce (fn [tail x]
- (doto (.newInstance (.loadClass loader "lux.Variant2"))
+ (doto (.newInstance (.loadClass loader "lux.Variant"))
(-> .-tag (set! "Cons"))
- (-> .-_1 (set! (->lux loader x)))
- (-> .-_2 (set! tail))))
- (doto (.newInstance (.loadClass loader "lux.Variant0"))
- (-> .-tag (set! "Nil")))
+ (-> .-value (set! (doto (.newInstance (.loadClass loader "lux.Tuple2"))
+ (-> .-_0 (set! (->lux loader x)))
+ (-> .-_1 (set! tail)))))))
+ (doto (.newInstance (.loadClass loader "lux.Variant"))
+ (-> .-tag (set! "Nil"))
+ (-> .-value (set! (.newInstance (.loadClass loader "lux.Tuple0")))))
(reverse xs)))
(defn ^:private ->lux-one [loader tag value]
- (doto (.newInstance (.loadClass loader "lux.Variant1"))
+ (doto (.newInstance (.loadClass loader "lux.Variant"))
(-> .-tag (set! tag))
- (-> .-_1 (set! value))))
+ (-> .-value (set! value))))
(defn ^:private ->lux-many [->lux loader tag values]
- (doto (.newInstance (.loadClass loader "lux.Variant1"))
+ (doto (.newInstance (.loadClass loader "lux.Variant"))
(-> .-tag (set! tag))
- (-> .-_1 (set! (->lux+ ->lux loader values)))))
+ (-> .-value (set! (->lux+ ->lux loader values)))))
(defn ^:private ->lux [loader x]
(match x
@@ -48,21 +50,22 @@
(defn ^:private ->clojure+ [->clojure xs]
(case (.-tag xs)
"Nil" (list)
- "Cons" (cons (->clojure (.-_1 xs))
- (->clojure+ ->clojure (.-_2 xs)))
+ "Cons" (let [tuple2 (.-value xs)]
+ (cons (->clojure (.-_0 tuple2))
+ (->clojure+ ->clojure (.-_1 tuple2))))
))
(defn ^:private ->clojure [x]
(case (.-tag x)
- "Bool" [::&parser/Bool (.-_1 x)]
- "Int" [::&parser/Int (.-_1 x)]
- "Real" [::&parser/Real (.-_1 x)]
- "Char" [::&parser/Char (.-_1 x)]
- "Text" [::&parser/Text (.-_1 x)]
- "Tag" [::&parser/Tag (.-_1 x)]
- "Ident" [::&parser/Ident (.-_1 x)]
- "Tuple" [::&parser/Tuple (->clojure+ ->clojure (.-_1 x))]
- "Form" [::&parser/Form (->clojure+ ->clojure (.-_1 x))]))
+ "Bool" [::&parser/Bool (.-value x)]
+ "Int" [::&parser/Int (.-value x)]
+ "Real" [::&parser/Real (.-value x)]
+ "Char" [::&parser/Char (.-value x)]
+ "Text" [::&parser/Text (.-value x)]
+ "Tag" [::&parser/Tag (.-value x)]
+ "Ident" [::&parser/Ident (.-value x)]
+ "Tuple" [::&parser/Tuple (->clojure+ ->clojure (.-value x))]
+ "Form" [::&parser/Form (->clojure+ ->clojure (.-value x))]))
;; [Resources]
(defn expand [loader macro-class tokens]
@@ -70,7 +73,14 @@
.getDeclaredConstructors
first
(.newInstance (to-array [(int 0) nil]))
- (.apply (->lux+ ->lux loader tokens))
- (.apply nil))]
- [(->> output .-_1 (->clojure+ ->clojure))
- (.-_2 output)]))
+ ((fn [macro] (prn 'macro macro "#1") macro))
+ (.impl (->lux+ ->lux loader tokens) nil)
+ ;; ((fn [macro] (prn 'macro macro "#2") macro))
+ ;; (.apply nil)
+ ((fn [macro] (prn 'macro macro "#3") macro))
+ ;; (.apply nil)
+ ;; ((fn [macro] (prn 'macro macro "#4?") macro))
+ )
+ _ (prn 'expand/output macro-class output (->> output .-_0 (->clojure+ ->clojure)))]
+ [(->> output .-_0 (->clojure+ ->clojure))
+ (.-_1 output)]))
diff --git a/src/lux/optimizer.clj b/src/lux/optimizer.clj
new file mode 100644
index 000000000..c032bc7fb
--- /dev/null
+++ b/src/lux/optimizer.clj
@@ -0,0 +1,5 @@
+(ns lux.optimizer
+ (:require [lux.analyser :as &analyser]))
+
+;; [Exports]
+(def optimize &analyser/analyse)
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-10 01:08:17 +0000