aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/lux/analyser.clj6
-rw-r--r--src/lux/analyser/base.clj12
-rw-r--r--src/lux/analyser/case.clj4
-rw-r--r--src/lux/analyser/host.clj11
-rw-r--r--src/lux/analyser/lambda.clj10
-rw-r--r--src/lux/analyser/lux.clj42
-rw-r--r--src/lux/compiler/case.clj2
-rw-r--r--src/lux/compiler/lambda.clj62
8 files changed, 87 insertions, 62 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 181d76b5b..9097168e2 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -101,13 +101,13 @@
["lux;Nil" _]]]]]]]]]
(&&lux/analyse-import analyse ?path)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "check'"]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ":"]]]]
["lux;Cons" [?type
["lux;Cons" [?value
["lux;Nil" _]]]]]]]]]]]
(&&lux/analyse-check analyse eval! exo-type ?type ?value)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "coerce'"]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ":!"]]]]
["lux;Cons" [?type
["lux;Cons" [?value
["lux;Nil" _]]]]]]]]]]]
@@ -435,7 +435,7 @@
[["lux;Meta" [meta ["lux;Form" ["lux;Cons" [?fn ?args]]]]]]
(fn [state]
- ;; (prn '(&/show-ast ?fn) (&/show-ast ?fn))
+ ;; (prn 'analyse-ast '(&/show-ast ?fn) (&/show-ast ?fn))
(matchv ::M/objects [((&type/with-var #(&&/analyse-1 (partial analyse-ast eval!) % ?fn)) state)]
[["lux;Right" [state* =fn]]]
((&&lux/analyse-apply (partial analyse-ast eval!) exo-type =fn ?args) state*)
diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj
index 4b23f9460..1653a4fa1 100644
--- a/src/lux/analyser/base.clj
+++ b/src/lux/analyser/base.clj
@@ -26,18 +26,6 @@
[_]
(fail "[Analyser Error] Can't expand to other than 1 element.")))))
-(defn analyse-2 [analyse exo-type1 el1 exo-type2 el2]
- (|do [output1 (analyse exo-type1 el1)
- output2 (analyse exo-type2 el2)]
- (do ;; (prn 'analyse-2 (aget output 0))
- (matchv ::M/objects [output1 output2]
- [["lux;Cons" [x ["lux;Nil" _]]]
- ["lux;Cons" [y ["lux;Nil" _]]]]
- (return (&/T x y))
-
- [_ _]
- (fail "[Analyser Error] Can't expand to other than 2 elements.")))))
-
(defn resolved-ident [ident]
(|let [[?module ?name] ident]
(|do [module* (if (= "" ?module)
diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj
index a9424b50d..e1f5c4c84 100644
--- a/src/lux/analyser/case.clj
+++ b/src/lux/analyser/case.clj
@@ -203,7 +203,7 @@
))))
(defn ^:private check-totality [value-type struct]
- (prn 'check-totality (aget value-type 0) (aget struct 0) (&type/show-type value-type))
+ ;; (prn 'check-totality (aget value-type 0) (aget struct 0) (&type/show-type value-type))
(matchv ::M/objects [struct]
[["BoolTotal" [?total _]]]
(return ?total)
@@ -279,7 +279,7 @@
(analyse-branch analyse exo-type value-type pattern body patterns)))
(&/|list)
branches)
- :let [_ (prn 'PRE_MERGE_TOTALS)]
+ ;; :let [_ (prn 'PRE_MERGE_TOTALS)]
struct (&/fold% merge-total (&/V "DefaultTotal" false) patterns)
? (check-totality value-type struct)]
(if ?
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index b282f806e..299471ee8 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -23,7 +23,8 @@
(let [input-type (&/V "lux;DataT" <input-class>)
output-type (&/V "lux;DataT" <output-class>)]
(defn <name> [analyse ?x ?y]
- (|do [[=x =y] (&&/analyse-2 analyse input-type ?x input-type ?y)]
+ (|do [=x (&&/analyse-1 analyse input-type ?x)
+ =y (&&/analyse-1 analyse input-type ?y)]
(return (&/|list (&/V "Expression" (&/T (&/V <output-tag> (&/T =x =y)) output-type)))))))
analyse-jvm-iadd "jvm-iadd" "java.lang.Integer" "java.lang.Integer"
@@ -136,11 +137,9 @@
(&/V "lux;Nil" nil)))))))))
(defn analyse-jvm-aastore [analyse ?array ?idx ?elem]
- (|do [=array+=elem (&&/analyse-2 analyse ?array ?elem)
- :let [[=array =elem] (matchv ::M/objects [=array+=elem]
- [[=array =elem]]
- [=array =elem])]
- =array-type (&&/expr-type =array)]
+ (|do [=array (&&/analyse-1 analyse &type/Nothing ?array)
+ =elem (&&/analyse-1 analyse &type/Nothing ?elem)
+ =array-type (&&/expr-type =array)]
(return (&/|list (&/V "Expression" (&/T (&/V "jvm-aastore" (&/T =array ?idx =elem)) =array-type))))))
(defn analyse-jvm-aaload [analyse ?array ?idx]
diff --git a/src/lux/analyser/lambda.clj b/src/lux/analyser/lambda.clj
index 553c4ea9b..da9d6b044 100644
--- a/src/lux/analyser/lambda.clj
+++ b/src/lux/analyser/lambda.clj
@@ -21,11 +21,11 @@
(return (&/T scope-name =captured =return)))))))))
(defn close-over [scope ident register frame]
- (prn 'close-over
- (&host/location scope)
- (&host/location (&/|list ident))
- register
- (->> frame (&/get$ "lux;closure") (&/get$ "lux;counter")))
+ ;; (prn 'close-over
+ ;; (&host/location scope)
+ ;; (&host/location (&/|list ident))
+ ;; register
+ ;; (->> frame (&/get$ "lux;closure") (&/get$ "lux;counter")))
(matchv ::M/objects [register]
[["Expression" [_ register-type]]]
(|let [register* (&/V "Expression" (&/T (&/V "captured" (&/T scope
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index f1c7a6035..68d612db6 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -16,7 +16,7 @@
(defn ^:private analyse-1+ [analyse ?token]
(&type/with-var
(fn [$var]
- (prn 'analyse-1+ (aget $var 1) (&/show-ast ?token))
+ ;; (prn 'analyse-1+ (aget $var 1) (&/show-ast ?token))
(|do [=expr (&&/analyse-1 analyse $var ?token)]
(matchv ::M/objects [=expr]
[["Expression" [?item ?type]]]
@@ -125,7 +125,7 @@
;; _ (&type/check exo-type btype)]
;; (return (&/|list global)))
state)
- (do (prn (str "((" (->> stack (&/|map show-frame) &/->seq (interpose " ") (reduce str "")) "))"))
+ (do ;; (prn (str "((" (->> stack (&/|map show-frame) &/->seq (interpose " ") (reduce str "")) "))"))
(fail* (str "[Analyser Error] Unrecognized identifier: " local-ident))))
[["lux;Cons" [top-outer _]]]
@@ -150,7 +150,8 @@
))
(defn ^:private analyse-apply* [analyse exo-type =fn ?args]
- (prn 'analyse-apply*/exo-type (&type/show-type exo-type))
+ ;; (prn 'analyse-apply* (&/->seq (&/|map &/show-ast ?args)))
+ ;; (prn 'analyse-apply*/exo-type (&type/show-type exo-type))
(matchv ::M/objects [=fn]
[["Statement" _]]
(fail "[Analyser Error] Can't apply a statement!")
@@ -162,7 +163,7 @@
(return (&/|list =fn)))
[["lux;Cons" [?arg ?args*]]]
- (do (prn 'analyse-apply*/=fn (&type/show-type ?fun-type))
+ (do ;; (prn 'analyse-apply*/=fn (&type/show-type ?fun-type))
(matchv ::M/objects [?fun-type]
[["lux;AllT" _]]
(&type/with-var
@@ -175,13 +176,16 @@
(return (&/|list (&/V "Expression" (&/T ?expr* type**)))))
[_]
- (do (prn 'analyse-apply*/output (aget output 0))
- (assert false))))))
+ (assert false (prn-str 'analyse-apply*/output (aget output 0)))))))
[["lux;LambdaT" [?input-t ?output-t]]]
+ ;; (|do [=arg (&&/analyse-1 analyse ?input-t ?arg)]
+ ;; (return (&/|list (&/V "Expression" (&/T (&/V "apply" (&/T =fn =arg))
+ ;; ?output-t)))))
(|do [=arg (&&/analyse-1 analyse ?input-t ?arg)]
- (return (&/|list (&/V "Expression" (&/T (&/V "apply" (&/T =fn =arg))
- ?output-t)))))
+ (analyse-apply* analyse exo-type (&/V "Expression" (&/T (&/V "apply" (&/T =fn =arg))
+ ?output-t))
+ ?args*))
[_]
(fail "[Analyser Error] Can't apply a non-function.")))
@@ -199,7 +203,10 @@
(if macro?
(let [macro-class (&host/location (&/|list ?module ?name))]
(|do [macro-expansion (&macro/expand loader macro-class ?args)
- :let [_ (prn 'EXPANDING (&type/show-type exo-type))]
+ ;; :let [_ (when (and (= "lux" ?module)
+ ;; (= "`" ?name))
+ ;; (prn 'macro-expansion (->> macro-expansion (&/|map &/show-ast) (&/|interpose " ") (&/fold str ""))))]
+ ;; :let [_ (prn 'EXPANDING (&type/show-type exo-type))]
output (&/flat-map% (partial analyse exo-type) macro-expansion)]
(return output)))
(analyse-apply* analyse exo-type =fn ?args)))
@@ -212,15 +219,16 @@
))
(defn analyse-case [analyse exo-type ?value ?branches]
- (prn 'analyse-case 'exo-type (&type/show-type exo-type) (&/show-ast ?value))
+ ;; (prn 'analyse-case 'exo-type (&type/show-type exo-type) (&/show-ast ?value))
(|do [:let [num-branches (&/|length ?branches)]
_ (&/assert! (> num-branches 0) "[Analyser Error] Can't have empty branches in \"case'\" expression.")
_ (&/assert! (even? num-branches) "[Analyser Error] Unbalanced branches in \"case'\" expression.")
=value (analyse-1+ analyse ?value)
=value-type (&&/expr-type =value)
- :let [_ (prn 'analyse-case/GOT_VALUE (&type/show-type =value-type))]
+ ;; :let [_ (prn 'analyse-case/GOT_VALUE (&type/show-type =value-type))]
=match (&&case/analyse-branches analyse exo-type =value-type (&/|as-pairs ?branches))
- :let [_ (prn 'analyse-case/GOT_MATCH)]]
+ ;; :let [_ (prn 'analyse-case/GOT_MATCH)]
+ ]
(return (&/|list (&/V "Expression" (&/T (&/V "case" (&/T =value =match))
exo-type))))))
@@ -237,7 +245,7 @@
(fail (str "[Analyser Error] Functions require function types: " (&type/show-type exo-type)))))
(defn analyse-lambda** [analyse exo-type ?self ?arg ?body]
- (prn 'analyse-lambda**/&& (aget exo-type 0))
+ ;; (prn 'analyse-lambda**/&& (aget exo-type 0))
(matchv ::M/objects [exo-type]
[["lux;AllT" _]]
(&type/with-var
@@ -270,7 +278,8 @@
;; :let [_ (prn 'analyse-def/_1)]
=value-type (&&/expr-type =value)
;; :let [_ (prn 'analyse-def/_2)]
- :let [_ (prn 'analyse-def/TYPE ?name (&type/show-type =value-type))]
+ :let [_ (prn 'analyse-def/TYPE ?name (&type/show-type =value-type))
+ _ (println)]
_ (&&def/define module-name ?name =value-type)
;; :let [_ (prn 'analyse-def/_3)]
]
@@ -278,9 +287,10 @@
(defn analyse-declare-macro [ident]
(|do [current-module &/get-module-name
- :let [_ (prn 'analyse-declare-macro/current-module current-module)]
+ ;; :let [_ (prn 'analyse-declare-macro/current-module current-module)]
[?module ?name] (&&/resolved-ident* ident)
- :let [_ (prn 'analyse-declare-macro '[?module ?name] [?module ?name])]]
+ ;; :let [_ (prn 'analyse-declare-macro '[?module ?name] [?module ?name])]
+ ]
(if (= ?module current-module)
(|do [_ (&&def/declare-macro ?module ?name)]
(return (&/|list)))
diff --git a/src/lux/compiler/case.clj b/src/lux/compiler/case.clj
index 8f737af20..d6a259476 100644
--- a/src/lux/compiler/case.clj
+++ b/src/lux/compiler/case.clj
@@ -142,7 +142,7 @@
(doseq [?body+?match (&/->seq patterns)
:let [;; _ (prn 'compile-pattern-matching/pattern pattern)
;; _ (prn '?body+?match (alength ?body+?match) (aget ?body+?match 0))
- _ (prn '?body+?match (aget ?body+?match 0))
+ ;; _ (prn '?body+?match (aget ?body+?match 0))
$else (new Label)]])))
(.visitInsn Opcodes/POP)
(.visitTypeInsn Opcodes/NEW ex-class)
diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj
index 332f9804b..3c3774e7e 100644
--- a/src/lux/compiler/lambda.clj
+++ b/src/lux/compiler/lambda.clj
@@ -40,7 +40,8 @@
(.visitVarInsn Opcodes/ALOAD (inc ?captured-id))
(.visitFieldInsn Opcodes/PUTFIELD class-name captured-name clo-field-sig))
(->> (let [captured-name (str &&/closure-prefix ?captured-id)
- _ (prn 'add-lambda-<init> class-name ?captured-id)])
+ ;; _ (prn 'add-lambda-<init> class-name ?captured-id)
+ ])
(matchv ::M/objects [?name+?captured]
[[?name ["Expression" [["captured" [_ ?captured-id ?source]] _]]]])
(doseq [?name+?captured (&/->seq env)])))
@@ -78,23 +79,50 @@
(return ret))))
(defn ^:private instance-closure [compile lambda-class closed-over init-signature]
- ;; (prn 'instance-closure lambda-class closed-over init-signature)
+ ;; (prn 'instance-closure lambda-class (&/|length closed-over) init-signature)
(|do [*writer* &/get-writer
- :let [_ (doto *writer*
- (.visitTypeInsn Opcodes/NEW lambda-class)
- (.visitInsn Opcodes/DUP))]
- _ (->> closed-over
- &/->seq
- (sort #(matchv ::M/objects [(&/|second %1) (&/|second %2)]
- [["Expression" [["captured" [_ ?cid1 _]] _]]
- ["Expression" [["captured" [_ ?cid2 _]] _]]]
- (< ?cid1 ?cid2)))
- &/->list
- (&/map% (fn [?name+?captured]
- (matchv ::M/objects [?name+?captured]
- [[?name ["Expression" [["captured" [_ _ ?source]] _]]]]
- (compile ?source)))))
- :let [_ (.visitMethodInsn *writer* Opcodes/INVOKESPECIAL lambda-class "<init>" init-signature)]]
+ :let [_ (doto *writer*
+ (.visitTypeInsn Opcodes/NEW lambda-class)
+ (.visitInsn Opcodes/DUP))
+ ;; _ (prn 'closed-over/pre
+ ;; (&/->seq (&/|map #(matchv ::M/objects [(&/|second %1)]
+ ;; [["Expression" [["captured" [_ ?cid _]] _]]]
+ ;; ?cid)
+ ;; closed-over)))
+ ;; _ (prn 'closed-over/post
+ ;; (->> closed-over
+ ;; &/->seq
+ ;; (sort #(matchv ::M/objects [(&/|second %1) (&/|second %2)]
+ ;; [["Expression" [["captured" [_ ?cid1 _]] _]]
+ ;; ["Expression" [["captured" [_ ?cid2 _]] _]]]
+ ;; (< ?cid1 ?cid2)))
+ ;; &/->list
+ ;; (&/|map #(matchv ::M/objects [(&/|second %1)]
+ ;; [["Expression" [["captured" [_ ?cid _]] _]]]
+ ;; ?cid))
+ ;; &/->seq))
+ ]
+ _ (->> closed-over
+ &/->seq
+ (sort #(matchv ::M/objects [(&/|second %1) (&/|second %2)]
+ [["Expression" [["captured" [_ ?cid1 _]] _]]
+ ["Expression" [["captured" [_ ?cid2 _]] _]]]
+ (< ?cid1 ?cid2)))
+ &/->list
+ (&/map% (fn [?name+?captured]
+ (matchv ::M/objects [?name+?captured]
+ [[?name ["Expression" [["captured" [_ _ ?source]] _]]]]
+ (do ;; (prn '?source (aget ?source 1 0 0)
+ ;; (cond (= "captured" (aget ?source 1 0 0))
+ ;; ["captured" (aget ?source 1 0 1 1)]
+
+ ;; (= "local" (aget ?source 1 0 0))
+ ;; ["local" (aget ?source 1 0 1)]
+
+ ;; :else
+ ;; '???))
+ (compile ?source))))))
+ :let [_ (.visitMethodInsn *writer* Opcodes/INVOKESPECIAL lambda-class "<init>" init-signature)]]
(return nil)))
;; [Exports]
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-06 03:50:09 +0000