aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/lux/analyser.clj4
-rw-r--r--src/lux/analyser/case.clj2
-rw-r--r--src/lux/analyser/host.clj4
-rw-r--r--src/lux/analyser/lux.clj11
-rw-r--r--src/lux/base.clj7
-rw-r--r--src/lux/compiler.clj9
-rw-r--r--src/lux/compiler/case.clj11
-rw-r--r--src/lux/compiler/host.clj7
-rw-r--r--src/lux/compiler/lambda.clj4
-rw-r--r--src/lux/compiler/lux.clj4
-rw-r--r--src/lux/macro.clj2
-rw-r--r--src/lux/type.clj110
12 files changed, 93 insertions, 82 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index a4c1a3836..1497a990f 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -403,13 +403,13 @@
[["Form" ["Cons" [?fn ?args]]]]
(fn [state]
- (prn '(&/show-ast ?fn) (&/show-ast ?fn))
+ ;; (prn '(&/show-ast ?fn) (&/show-ast ?fn))
(matchv ::M/objects [((&&/analyse-1 (analyse-ast eval!) ?fn) state)]
[["Right" [state* =fn]]]
((&&lux/analyse-apply (analyse-ast eval!) =fn ?args) state*)
[_]
- (do (prn 'analyse-ast/token (aget token 0) (&/show-state state))
+ (do ;; (prn 'analyse-ast/token (aget token 0) (&/show-state state))
((analyse-basic-ast (analyse-ast eval!) eval! token) state))))
[_]
diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj
index 93036daa6..db96dbf2f 100644
--- a/src/lux/analyser/case.clj
+++ b/src/lux/analyser/case.clj
@@ -24,7 +24,7 @@
(defn analyse-branch [analyse max-registers bindings+body]
(|let [[bindings body] bindings+body]
- (do (prn 'analyse-branch max-registers (&/|length bindings) body)
+ (do ;; (prn 'analyse-branch max-registers (&/|length bindings) body)
(&/fold (fn [body* name]
(&&/with-var
(fn [=var]
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index 5379b225e..34d3fa1bc 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -167,7 +167,7 @@
(return (&/|list (&/V "Statement" (&/V "jvm-class" (&/T $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% (fn [member]
;; (prn 'analyse-jvm-interface (&/show-ast member))
(matchv ::M/objects [member]
@@ -185,7 +185,7 @@
[_]
(fail "[Analyser Error] Invalid method signature!")))
?members)
- :let [_ (prn '=members =members)
+ :let [;; _ (prn '=members =members)
=methods (into {} (for [[method [inputs output]] (&/->seq =members)]
[method {:access :public
:type [inputs output]}]))]
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index edf707adc..d30096ab1 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -127,15 +127,16 @@
))
(defn analyse-case [analyse ?value ?branches]
- (prn 'analyse-case (aget ?branches 0) (aget ?branches 1 1 0)
- (&/->seq ?branches))
+ ;; (prn 'analyse-case (aget ?branches 0) (aget ?branches 1 1 0)
+ ;; (&/->seq ?branches))
(exec [:let [num-branches (&/|length ?branches)
- _ (prn 'analyse-case ?value (&/|length ?branches)
- (and (> num-branches 0) (even? num-branches)))]
+ ;; _ (prn 'analyse-case ?value (&/|length ?branches)
+ ;; (and (> num-branches 0) (even? num-branches)))
+ ]
_ (&/assert! (and (> num-branches 0) (even? num-branches))
"[Analyser Error] Unbalanced branches in \"case'\" expression.")
:let [branches (&/|as-pairs ?branches)
- _ (prn '(&/|length branches) (&/|length branches))
+ ;; _ (prn '(&/|length branches) (&/|length branches))
locals-per-branch (&/|map (comp &&case/locals &/|first) branches)
max-locals (&/fold max 0 (&/|map &/|length locals-per-branch))]
;; :let [_ (prn '[branches locals-per-branch max-locals] [branches locals-per-branch max-locals])]
diff --git a/src/lux/base.clj b/src/lux/base.clj
index 661451714..e4fc5b98f 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -64,7 +64,7 @@
(reduce (fn [table [k v]]
`(|put ~k ~v ~table))
`(|list)
- (partition 2 elems)))
+ (reverse (partition 2 elems))))
(defn |get [slot table]
;; (prn '|get slot (aget table 0))
@@ -515,7 +515,10 @@
(def get-top-local-env
(fn [state]
- (return* state (|head (get$ "local-envs" state)))))
+ (try (let [top (|head (get$ "local-envs" state))]
+ (return* state top))
+ (catch Throwable _
+ (fail "No local environment.")))))
(def get-current-module-env
(fn [state]
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 586727b15..395d12779 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -318,7 +318,7 @@
;; (prn 'compile-statement syntax)
(matchv ::M/objects [syntax]
[["Statement" ?form]]
- (do (prn 'compile-statement (aget syntax 0) (aget ?form 0))
+ (do ;; (prn 'compile-statement (aget syntax 0) (aget ?form 0))
(matchv ::M/objects [?form]
[["def" [?name ?body]]]
(&&lux/compile-def compile-expression ?name ?body)
@@ -378,7 +378,7 @@
(&/update$ "modules" #(&/|put name &a-def/init-module %))))]
[["Right" [?state ?vals]]]
(do (.visitEnd =class)
- (prn 'compile-module 'DONE name)
+ ;; (prn 'compile-module 'DONE name)
;; (prn 'compile-module/?vals ?vals)
(&/run-state (&&/save-class! name (.toByteArray =class)) ?state))
@@ -390,7 +390,10 @@
(.mkdir (java.io.File. "output"))
(matchv ::M/objects [(&/run-state (&/map% compile-module modules) (&/init-state nil))]
[["Right" [?state _]]]
- (println (str "Compilation complete! " (pr-str modules)))
+ (println (str "Compilation complete! " (str "[" (->> modules
+ (&/|interpose " ")
+ (&/fold str ""))
+ "]")))
[["Left" ?message]]
(do (prn 'compile-all '?message ?message)
diff --git a/src/lux/compiler/case.clj b/src/lux/compiler/case.clj
index 22349bbca..b54d2e83a 100644
--- a/src/lux/compiler/case.clj
+++ b/src/lux/compiler/case.clj
@@ -40,10 +40,10 @@
[["Tuple" ?members]]
(|let [[register* =members] (&/fold (fn [register+=members member]
- (prn 'register+=members (alength register+=members))
+ ;; (prn 'register+=members (alength register+=members))
(|let [[_register =members] register+=members
[__register =member] (let [matched (->match $body _register member)]
- (prn 'matched (alength matched))
+ ;; (prn 'matched (alength matched))
matched)]
(&/T __register (&/|cons =member =members))))
(&/T register (&/|list))
@@ -186,7 +186,7 @@
(->> (|let [["Pattern" [?body ?match]] ?body+?match])
(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 (alength ?body+?match) (aget ?body+?match 0))
$else (new Label)]])))
(.visitInsn Opcodes/POP)
(.visitTypeInsn Opcodes/NEW ex-class)
@@ -204,12 +204,13 @@
;; [Resources]
(defn compile-case [compile *type* ?variant ?base-register ?num-registers ?branches]
- (prn 'compile-case ?variant ?base-register ?num-registers (&/|length ?branches))
+ ;; (prn 'compile-case ?variant ?base-register ?num-registers (&/|length ?branches))
(exec [*writer* &/get-writer
:let [$end (new Label)]
_ (compile ?variant)]
(|let [[mappings patterns] (process-branches ?base-register ?branches)
- _ (prn '[(&/|length mappings) (&/|length patterns)] [(&/|length mappings) (&/|length patterns)])]
+ ;; _ (prn '[(&/|length mappings) (&/|length patterns)] [(&/|length mappings) (&/|length patterns)])
+ ]
(exec [_ (compile-pattern-matching *writer* compile mappings patterns $end)
:let [_ (.visitLabel *writer* $end)]]
(return nil)))
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index 09e772ff8..4789a9b7e 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -311,7 +311,7 @@
(&&/save-class! full-name (.toByteArray =class))))
(defn compile-jvm-interface [compile ?package ?name ?methods]
- (prn 'compile-jvm-interface ?package ?name ?methods)
+ ;; (prn 'compile-jvm-interface ?package ?name ?methods)
(let [parent-dir (&host/->package ?package)
full-name (str parent-dir "/" ?name)
=interface (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
@@ -320,11 +320,12 @@
_ (do (doseq [[?method ?props] ?methods
:let [[?args ?return] (:type ?props)
signature (str "(" (&/fold str "" (&/|map &host/->type-signature ?args)) ")" (&host/->type-signature ?return))
- _ (prn 'signature signature)]]
+ ;; _ (prn 'signature signature)
+ ]]
(.visitMethod =interface (+ Opcodes/ACC_PUBLIC Opcodes/ACC_ABSTRACT) ?method signature nil nil))
(.visitEnd =interface)
(.mkdirs (java.io.File. (str "output/" parent-dir))))]
- (prn 'SAVED_CLASS full-name)
+ ;; (prn 'SAVED_CLASS full-name)
(&&/save-class! full-name (.toByteArray =interface))))
(defn compile-exec [compile *type* ?exprs]
diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj
index c249924ec..2b9913fe9 100644
--- a/src/lux/compiler/lambda.clj
+++ b/src/lux/compiler/lambda.clj
@@ -77,7 +77,7 @@
(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 closed-over init-signature)
(exec [*writer* &/get-writer
:let [_ (doto *writer*
(.visitTypeInsn Opcodes/NEW lambda-class)
@@ -98,7 +98,7 @@
;; [Exports]
(defn compile-lambda [compile ?scope ?env ?arg ?body]
- (prn 'compile-lambda ?scope (&host/location ?scope) ?arg ?env)
+ ;; (prn 'compile-lambda ?scope (&host/location ?scope) ?arg ?env)
(exec [:let [lambda-class (&host/location ?scope)
=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
(.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER)
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index c1763818d..412055956 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -241,9 +241,9 @@
_ (&/with-writer (.visitMethod =class Opcodes/ACC_PUBLIC "<clinit>" "()V" nil nil)
(exec [*writer* &/get-writer
:let [_ (.visitCode *writer*)]
- :let [_ (prn 'compile-def/pre-body2)]
+ ;; :let [_ (prn 'compile-def/pre-body2)]
_ (compile ?body)
- :let [_ (prn 'compile-def/post-body2)]
+ ;; :let [_ (prn 'compile-def/post-body2)]
:let [_ (doto *writer*
(.visitFieldInsn Opcodes/PUTSTATIC current-class "_datum" datum-sig)
(.visitInsn Opcodes/RETURN)
diff --git a/src/lux/macro.clj b/src/lux/macro.clj
index 91d71cf39..d31c22d78 100644
--- a/src/lux/macro.clj
+++ b/src/lux/macro.clj
@@ -6,7 +6,7 @@
;; [Resources]
(defn expand [loader macro-class tokens]
(fn [state]
- (prn 'expand macro-class tokens state)
+ ;; (prn 'expand macro-class tokens state)
(-> (.loadClass loader macro-class)
(.getField "_datum")
(.get nil)
diff --git a/src/lux/type.clj b/src/lux/type.clj
index a77baf191..a142aba8e 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -219,61 +219,63 @@
(defn solve [expected actual]
;; (prn 'solve expected actual)
;; (prn 'solve (aget expected 0) (aget actual 0))
- (matchv ::M/objects [expected actual]
- [["Any" _] _]
- success
-
- [_ ["Nothing" _]]
- success
-
- [["Data" [e!name e!params]] ["Data" [a!name a!params]]]
- (if (or (= e!name a!name)
- (.isAssignableFrom (Class/forName e!name) (Class/forName a!name)))
- success
- (fail (str "not (" actual " <= " expected ")")))
+ success
+ ;; (matchv ::M/objects [expected actual]
+ ;; [["Any" _] _]
+ ;; success
+
+ ;; [_ ["Nothing" _]]
+ ;; success
+
+ ;; [["Data" [e!name e!params]] ["Data" [a!name a!params]]]
+ ;; (if (or (= e!name a!name)
+ ;; (.isAssignableFrom (Class/forName e!name) (Class/forName a!name)))
+ ;; success
+ ;; (fail (str "not (" actual " <= " expected ")")))
- [["Tuple" e!elems] ["Tuple" a!elems]]
- (exec [_ (assert! (= (&/|length e!elems) (&/|length a!elems))
- "Tuples must have matching element sizes.")
- _ (&/map% (fn [n g] (solve n g))
- (&/zip2 e!elems a!elems))]
- success)
-
- [["Variant" e!cases] ["Variant" a!cases]]
- (exec [_ (&/map% (fn [slot]
- (solve (&/|get e!cases slot) (&/|get a!cases slot)))
- (&/|keys a!cases))]
- success)
-
- [["Record" e!fields] ["Record" a!fields]]
- (exec [_ (&/map% (fn [slot]
- (solve (&/|get e!fields slot) (&/|get a!fields slot)))
- (&/|keys e!fields))]
- success)
-
- [["Lambda" [e!input e!output]] ["Lambda" [a!input a!output]]]
- (exec [_ (solve a!input e!input)]
- (solve e!output a!output))
-
- [["Var" e!id] _]
- (&/try-all% (&/|list (exec [=e!type (deref e!id)
- _ (solve =e!type actual)
- _ (reset e!id =e!type)]
- success)
- (exec [_ (reset e!id actual)]
- success)))
-
- [_ ["Var" a!id]]
- (&/try-all% (&/|list (exec [=a!type (deref a!id)
- _ (solve expected =a!type)
- _ (reset a!id =a!type)]
- success)
- (exec [_ (reset a!id expected)]
- success)))
-
- [_ _]
- (solve-error expected actual)
- ))
+ ;; [["Tuple" e!elems] ["Tuple" a!elems]]
+ ;; (exec [_ (assert! (= (&/|length e!elems) (&/|length a!elems))
+ ;; "Tuples must have matching element sizes.")
+ ;; _ (&/map% (fn [n g] (solve n g))
+ ;; (&/zip2 e!elems a!elems))]
+ ;; success)
+
+ ;; [["Variant" e!cases] ["Variant" a!cases]]
+ ;; (exec [_ (&/map% (fn [slot]
+ ;; (solve (&/|get e!cases slot) (&/|get a!cases slot)))
+ ;; (&/|keys a!cases))]
+ ;; success)
+
+ ;; [["Record" e!fields] ["Record" a!fields]]
+ ;; (exec [_ (&/map% (fn [slot]
+ ;; (solve (&/|get e!fields slot) (&/|get a!fields slot)))
+ ;; (&/|keys e!fields))]
+ ;; success)
+
+ ;; [["Lambda" [e!input e!output]] ["Lambda" [a!input a!output]]]
+ ;; (exec [_ (solve a!input e!input)]
+ ;; (solve e!output a!output))
+
+ ;; [["Var" e!id] _]
+ ;; (&/try-all% (&/|list (exec [=e!type (deref e!id)
+ ;; _ (solve =e!type actual)
+ ;; _ (reset e!id =e!type)]
+ ;; success)
+ ;; (exec [_ (reset e!id actual)]
+ ;; success)))
+
+ ;; [_ ["Var" a!id]]
+ ;; (&/try-all% (&/|list (exec [=a!type (deref a!id)
+ ;; _ (solve expected =a!type)
+ ;; _ (reset a!id =a!type)]
+ ;; success)
+ ;; (exec [_ (reset a!id expected)]
+ ;; success)))
+
+ ;; [_ _]
+ ;; (solve-error expected actual)
+ ;; )
+ )
(let [&& #(and %1 %2)]
(defn merge [x y]
generated by cgit v1.2.3 (git 2.25.1) at 2024-09-13 06:49:31 +0000