aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2015-08-06 18:33:25 -0400
committerEduardo Julian2015-08-06 18:33:25 -0400
commit218af254c30f35d290ab944aef1cf2b33e179224 (patch)
treebeea3bd9f8dd6bd894320716baed51ae9558ff72
parent24cc40e76f83188688ad43c499a44508e1aa5d60 (diff)
- Refacted the compiler by shifting to a pattern-matching syntax more akin to Lux's, while also allowing non-literal tags that can be defined as constants elsewhere.
- Added some extra JVM ops for bit-fiddling that were missing.
Diffstat
-rw-r--r--src/lux/analyser.clj499
-rw-r--r--src/lux/analyser/base.clj13
-rw-r--r--src/lux/analyser/case.clj157
-rw-r--r--src/lux/analyser/env.clj10
-rw-r--r--src/lux/analyser/host.clj117
-rw-r--r--src/lux/analyser/lambda.clj23
-rw-r--r--src/lux/analyser/lux.clj169
-rw-r--r--src/lux/analyser/module.clj85
-rw-r--r--src/lux/base.clj297
-rw-r--r--src/lux/compiler.clj247
-rw-r--r--src/lux/compiler/cache.clj8
-rw-r--r--src/lux/compiler/case.clj24
-rw-r--r--src/lux/compiler/host.clj67
-rw-r--r--src/lux/compiler/lambda.clj16
-rw-r--r--src/lux/compiler/lux.clj16
-rw-r--r--src/lux/compiler/type.clj28
-rw-r--r--src/lux/host.clj12
-rw-r--r--src/lux/parser.clj87
-rw-r--r--src/lux/reader.clj34
-rw-r--r--src/lux/type.clj343
20 files changed, 1141 insertions, 1111 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 7dc4c7607..e49797fa5 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -8,9 +8,9 @@
(ns lux.analyser
(:require (clojure [template :refer [do-template]])
- [clojure.core.match :as M :refer [matchv]]
+ clojure.core.match
clojure.core.match.array
- (lux [base :as & :refer [|let |do return fail return* fail*]]
+ (lux [base :as & :refer [|let |do return fail return* fail* |case]]
[reader :as &reader]
[parser :as &parser]
[type :as &type]
@@ -21,471 +21,483 @@
;; [Utils]
(defn ^:private parse-handler [[catch+ finally+] token]
- (matchv ::M/objects [token]
- [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_catch"]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?ex-class]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?ex-arg]]]]
- ["lux;Cons" [?catch-body
- ["lux;Nil" _]]]]]]]]]]]]]
+ (|case token
+ ("lux;Meta" meta ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_catch"))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TextS" ?ex-class))
+ ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" "" ?ex-arg))
+ ("lux;Cons" ?catch-body
+ ("lux;Nil")))))))
(return (&/T (&/|++ catch+ (&/|list (&/T ?ex-class ?ex-arg ?catch-body))) finally+))
- [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_finally"]]]]
- ["lux;Cons" [?finally-body
- ["lux;Nil" _]]]]]]]]]
+ ("lux;Meta" meta ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_finally"))
+ ("lux;Cons" ?finally-body
+ ("lux;Nil")))))
(return (&/T catch+ (&/V "lux;Some" ?finally-body)))
- [_]
+ _
(fail (str "[Analyser Error] Wrong syntax for exception handler: " (&/show-ast token)))))
(defn ^:private aba7 [analyse eval! compile-module compile-token exo-type token]
- (matchv ::M/objects [token]
+ (|case token
;; Arrays
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_new-array"]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?class]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;IntS" ?length]]]
- ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_new-array"))
+ ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ ?class))
+ ("lux;Cons" ("lux;Meta" _ ("lux;IntS" ?length))
+ ("lux;Nil")))))
(&&host/analyse-jvm-new-array analyse ?class ?length)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_aastore"]]]]
- ["lux;Cons" [?array
- ["lux;Cons" [["lux;Meta" [_ ["lux;IntS" ?idx]]]
- ["lux;Cons" [?elem
- ["lux;Nil" _]]]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_aastore"))
+ ("lux;Cons" ?array
+ ("lux;Cons" ("lux;Meta" _ ("lux;IntS" ?idx))
+ ("lux;Cons" ?elem
+ ("lux;Nil"))))))
(&&host/analyse-jvm-aastore analyse ?array ?idx ?elem)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_aaload"]]]]
- ["lux;Cons" [?array
- ["lux;Cons" [["lux;Meta" [_ ["lux;IntS" ?idx]]]
- ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_aaload"))
+ ("lux;Cons" ?array
+ ("lux;Cons" ("lux;Meta" _ ("lux;IntS" ?idx))
+ ("lux;Nil")))))
(&&host/analyse-jvm-aaload analyse ?array ?idx)
;; Classes & interfaces
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_class"]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?name]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?super-class]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?interfaces]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?fields]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?methods]]]
- ["lux;Nil" _]]]]]]]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_class"))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TextS" ?name))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TextS" ?super-class))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TupleS" ?interfaces))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TupleS" ?fields))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TupleS" ?methods))
+ ("lux;Nil"))))))))
(&&host/analyse-jvm-class analyse compile-token ?name ?super-class ?interfaces ?fields ?methods)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_interface"]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?name]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?supers]]]
- ?methods]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_interface"))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TextS" ?name))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TupleS" ?supers))
+ ?methods))))
(&&host/analyse-jvm-interface analyse compile-token ?name ?supers ?methods)
;; Programs
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_program"]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?args]]]]
- ["lux;Cons" [?body
- ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_program"))
+ ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" "" ?args))
+ ("lux;Cons" ?body
+ ("lux;Nil")))))
(&&host/analyse-jvm-program analyse compile-token ?args ?body)
- [_]
+ _
(fail "")))
(defn ^:private aba6 [analyse eval! compile-module compile-token exo-type token]
- (matchv ::M/objects [token]
+ (|case token
;; Primitive conversions
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_d2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_d2f")) ("lux;Cons" ?value ("lux;Nil"))))
(&&host/analyse-jvm-d2f analyse exo-type ?value)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_d2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_d2i")) ("lux;Cons" ?value ("lux;Nil"))))
(&&host/analyse-jvm-d2i analyse exo-type ?value)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_d2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_d2l")) ("lux;Cons" ?value ("lux;Nil"))))
(&&host/analyse-jvm-d2l analyse exo-type ?value)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_f2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_f2d")) ("lux;Cons" ?value ("lux;Nil"))))
(&&host/analyse-jvm-f2d analyse exo-type ?value)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_f2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_f2i")) ("lux;Cons" ?value ("lux;Nil"))))
(&&host/analyse-jvm-f2i analyse exo-type ?value)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_f2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_f2l")) ("lux;Cons" ?value ("lux;Nil"))))
(&&host/analyse-jvm-f2l analyse exo-type ?value)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2b"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_i2b")) ("lux;Cons" ?value ("lux;Nil"))))
(&&host/analyse-jvm-i2b analyse exo-type ?value)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2c"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_i2c")) ("lux;Cons" ?value ("lux;Nil"))))
(&&host/analyse-jvm-i2c analyse exo-type ?value)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_i2d")) ("lux;Cons" ?value ("lux;Nil"))))
(&&host/analyse-jvm-i2d analyse exo-type ?value)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_i2f")) ("lux;Cons" ?value ("lux;Nil"))))
(&&host/analyse-jvm-i2f analyse exo-type ?value)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2l"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_i2l")) ("lux;Cons" ?value ("lux;Nil"))))
(&&host/analyse-jvm-i2l analyse exo-type ?value)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_i2s"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_i2s")) ("lux;Cons" ?value ("lux;Nil"))))
(&&host/analyse-jvm-i2s analyse exo-type ?value)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_l2d"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_l2d")) ("lux;Cons" ?value ("lux;Nil"))))
(&&host/analyse-jvm-l2d analyse exo-type ?value)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_l2f"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_l2f")) ("lux;Cons" ?value ("lux;Nil"))))
(&&host/analyse-jvm-l2f analyse exo-type ?value)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_l2i"]]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_l2i")) ("lux;Cons" ?value ("lux;Nil"))))
(&&host/analyse-jvm-l2i analyse exo-type ?value)
;; Bitwise operators
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_iand"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_iand")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil")))))
(&&host/analyse-jvm-iand analyse exo-type ?x ?y)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ior"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_ior")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil")))))
(&&host/analyse-jvm-ior analyse exo-type ?x ?y)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_land"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_ixor")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil")))))
+ (&&host/analyse-jvm-ixor analyse exo-type ?x ?y)
+
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_ishl")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil")))))
+ (&&host/analyse-jvm-ishl analyse exo-type ?x ?y)
+
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_ishr")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil")))))
+ (&&host/analyse-jvm-ishr analyse exo-type ?x ?y)
+
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_iushr")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil")))))
+ (&&host/analyse-jvm-iushr analyse exo-type ?x ?y)
+
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_land")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil")))))
(&&host/analyse-jvm-land analyse exo-type ?x ?y)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lor"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_lor")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil")))))
(&&host/analyse-jvm-lor analyse exo-type ?x ?y)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lxor"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_lxor")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil")))))
(&&host/analyse-jvm-lxor analyse exo-type ?x ?y)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lshl"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_lshl")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil")))))
(&&host/analyse-jvm-lshl analyse exo-type ?x ?y)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lshr"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_lshr")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil")))))
(&&host/analyse-jvm-lshr analyse exo-type ?x ?y)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lushr"]]]] ["lux;Cons" [?x ["lux;Cons" [?y ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_lushr")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil")))))
(&&host/analyse-jvm-lushr analyse exo-type ?x ?y)
- [_]
+ _
(aba7 analyse eval! compile-module compile-token exo-type token)))
(defn ^:private aba5 [analyse eval! compile-module compile-token exo-type token]
- (matchv ::M/objects [token]
+ (|case token
;; Objects
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_null?"]]]]
- ["lux;Cons" [?object
- ["lux;Nil" _]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_null?"))
+ ("lux;Cons" ?object
+ ("lux;Nil"))))
(&&host/analyse-jvm-null? analyse exo-type ?object)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_instanceof"]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]]
- ["lux;Cons" [?object
- ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_instanceof"))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TextS" ?class))
+ ("lux;Cons" ?object
+ ("lux;Nil")))))
(&&host/analyse-jvm-instanceof analyse exo-type ?class ?object)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_new"]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?classes]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?args]]]
- ["lux;Nil" _]]]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_new"))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TextS" ?class))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TupleS" ?classes))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TupleS" ?args))
+ ("lux;Nil"))))))
(&&host/analyse-jvm-new analyse exo-type ?class ?classes ?args)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_getstatic"]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?field]]]
- ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_getstatic"))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TextS" ?class))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TextS" ?field))
+ ("lux;Nil")))))
(&&host/analyse-jvm-getstatic analyse exo-type ?class ?field)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_getfield"]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?field]]]
- ["lux;Cons" [?object
- ["lux;Nil" _]]]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_getfield"))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TextS" ?class))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TextS" ?field))
+ ("lux;Cons" ?object
+ ("lux;Nil"))))))
(&&host/analyse-jvm-getfield analyse exo-type ?class ?field ?object)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_putstatic"]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?field]]]
- ["lux;Cons" [?value
- ["lux;Nil" _]]]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_putstatic"))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TextS" ?class))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TextS" ?field))
+ ("lux;Cons" ?value
+ ("lux;Nil"))))))
(&&host/analyse-jvm-putstatic analyse exo-type ?class ?field ?value)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_putfield"]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?field]]]
- ["lux;Cons" [?object
- ["lux;Cons" [?value
- ["lux;Nil" _]]]]]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_putfield"))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TextS" ?class))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TextS" ?field))
+ ("lux;Cons" ?object
+ ("lux;Cons" ?value
+ ("lux;Nil")))))))
(&&host/analyse-jvm-putfield analyse exo-type ?class ?field ?object ?value)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_invokestatic"]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?method]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?classes]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?args]]]
- ["lux;Nil" _]]]]]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_invokestatic"))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TextS" ?class))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TextS" ?method))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TupleS" ?classes))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TupleS" ?args))
+ ("lux;Nil")))))))
(&&host/analyse-jvm-invokestatic analyse exo-type ?class ?method ?classes ?args)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_invokevirtual"]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?method]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?classes]]]
- ["lux;Cons" [?object
- ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?args]]]
- ["lux;Nil" _]]]]]]]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_invokevirtual"))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TextS" ?class))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TextS" ?method))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TupleS" ?classes))
+ ("lux;Cons" ?object
+ ("lux;Cons" ("lux;Meta" _ ("lux;TupleS" ?args))
+ ("lux;Nil"))))))))
(&&host/analyse-jvm-invokevirtual analyse exo-type ?class ?method ?classes ?object ?args)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_invokeinterface"]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?method]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?classes]]]
- ["lux;Cons" [?object
- ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?args]]]
- ["lux;Nil" _]]]]]]]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_invokeinterface"))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TextS" ?class))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TextS" ?method))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TupleS" ?classes))
+ ("lux;Cons" ?object
+ ("lux;Cons" ("lux;Meta" _ ("lux;TupleS" ?args))
+ ("lux;Nil"))))))))
(&&host/analyse-jvm-invokeinterface analyse exo-type ?class ?method ?classes ?object ?args)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_invokespecial"]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?method]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?classes]]]
- ["lux;Cons" [?object
- ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?args]]]
- ["lux;Nil" _]]]]]]]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_invokespecial"))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TextS" ?class))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TextS" ?method))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TupleS" ?classes))
+ ("lux;Cons" ?object
+ ("lux;Cons" ("lux;Meta" _ ("lux;TupleS" ?args))
+ ("lux;Nil"))))))))
(&&host/analyse-jvm-invokespecial analyse exo-type ?class ?method ?classes ?object ?args)
;; Exceptions
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_try"]]]]
- ["lux;Cons" [?body
- ?handlers]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_try"))
+ ("lux;Cons" ?body
+ ?handlers)))
(|do [catches+finally (&/fold% parse-handler (&/T (&/|list) (&/V "lux;None" nil)) ?handlers)]
(&&host/analyse-jvm-try analyse exo-type ?body catches+finally))
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_throw"]]]]
- ["lux;Cons" [?ex
- ["lux;Nil" _]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_throw"))
+ ("lux;Cons" ?ex
+ ("lux;Nil"))))
(&&host/analyse-jvm-throw analyse exo-type ?ex)
;; Syncronization/monitos
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_monitorenter"]]]]
- ["lux;Cons" [?monitor
- ["lux;Nil" _]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_monitorenter"))
+ ("lux;Cons" ?monitor
+ ("lux;Nil"))))
(&&host/analyse-jvm-monitorenter analyse exo-type ?monitor)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_monitorexit"]]]]
- ["lux;Cons" [?monitor
- ["lux;Nil" _]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_monitorexit"))
+ ("lux;Cons" ?monitor
+ ("lux;Nil"))))
(&&host/analyse-jvm-monitorexit analyse exo-type ?monitor)
- [_]
+ _
(aba6 analyse eval! compile-module compile-token exo-type token)))
(defn ^:private aba4 [analyse eval! compile-module compile-token exo-type token]
- (matchv ::M/objects [token]
+ (|case token
;; Float arithmetic
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_fadd")) ("lux;Cons" ?y ("lux;Cons" ?x ("lux;Nil")))))
(&&host/analyse-jvm-fadd analyse exo-type ?x ?y)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_fsub")) ("lux;Cons" ?y ("lux;Cons" ?x ("lux;Nil")))))
(&&host/analyse-jvm-fsub analyse exo-type ?x ?y)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_fmul")) ("lux;Cons" ?y ("lux;Cons" ?x ("lux;Nil")))))
(&&host/analyse-jvm-fmul analyse exo-type ?x ?y)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fdiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_fdiv")) ("lux;Cons" ?y ("lux;Cons" ?x ("lux;Nil")))))
(&&host/analyse-jvm-fdiv analyse exo-type ?x ?y)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_frem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_frem")) ("lux;Cons" ?y ("lux;Cons" ?x ("lux;Nil")))))
(&&host/analyse-jvm-frem analyse exo-type ?x ?y)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_feq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_feq")) ("lux;Cons" ?y ("lux;Cons" ?x ("lux;Nil")))))
(&&host/analyse-jvm-feq analyse exo-type ?x ?y)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_flt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_flt")) ("lux;Cons" ?y ("lux;Cons" ?x ("lux;Nil")))))
(&&host/analyse-jvm-flt analyse exo-type ?x ?y)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_fgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_fgt")) ("lux;Cons" ?y ("lux;Cons" ?x ("lux;Nil")))))
(&&host/analyse-jvm-fgt analyse exo-type ?x ?y)
;; Double arithmetic
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_dadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_dadd")) ("lux;Cons" ?y ("lux;Cons" ?x ("lux;Nil")))))
(&&host/analyse-jvm-dadd analyse exo-type ?x ?y)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_dsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_dsub")) ("lux;Cons" ?y ("lux;Cons" ?x ("lux;Nil")))))
(&&host/analyse-jvm-dsub analyse exo-type ?x ?y)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_dmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_dmul")) ("lux;Cons" ?y ("lux;Cons" ?x ("lux;Nil")))))
(&&host/analyse-jvm-dmul analyse exo-type ?x ?y)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ddiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_ddiv")) ("lux;Cons" ?y ("lux;Cons" ?x ("lux;Nil")))))
(&&host/analyse-jvm-ddiv analyse exo-type ?x ?y)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_drem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_drem")) ("lux;Cons" ?y ("lux;Cons" ?x ("lux;Nil")))))
(&&host/analyse-jvm-drem analyse exo-type ?x ?y)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_deq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_deq")) ("lux;Cons" ?y ("lux;Cons" ?x ("lux;Nil")))))
(&&host/analyse-jvm-deq analyse exo-type ?x ?y)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_dlt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_dlt")) ("lux;Cons" ?y ("lux;Cons" ?x ("lux;Nil")))))
(&&host/analyse-jvm-dlt analyse exo-type ?x ?y)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_dgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_dgt")) ("lux;Cons" ?y ("lux;Cons" ?x ("lux;Nil")))))
(&&host/analyse-jvm-dgt analyse exo-type ?x ?y)
-
- [_]
+
+ _
(aba5 analyse eval! compile-module compile-token exo-type token)))
(defn ^:private aba3 [analyse eval! compile-module compile-token exo-type token]
- (matchv ::M/objects [token]
+ (|case token
;; Host special forms
;; Characters
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ceq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_ceq")) ("lux;Cons" ?y ("lux;Cons" ?x ("lux;Nil")))))
(&&host/analyse-jvm-ceq analyse exo-type ?x ?y)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_clt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_clt")) ("lux;Cons" ?y ("lux;Cons" ?x ("lux;Nil")))))
(&&host/analyse-jvm-clt analyse exo-type ?x ?y)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_cgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_cgt")) ("lux;Cons" ?y ("lux;Cons" ?x ("lux;Nil")))))
(&&host/analyse-jvm-cgt analyse exo-type ?x ?y)
;; Integer arithmetic
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_iadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_iadd")) ("lux;Cons" ?y ("lux;Cons" ?x ("lux;Nil")))))
(&&host/analyse-jvm-iadd analyse exo-type ?x ?y)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_isub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_isub")) ("lux;Cons" ?y ("lux;Cons" ?x ("lux;Nil")))))
(&&host/analyse-jvm-isub analyse exo-type ?x ?y)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_imul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_imul")) ("lux;Cons" ?y ("lux;Cons" ?x ("lux;Nil")))))
(&&host/analyse-jvm-imul analyse exo-type ?x ?y)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_idiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_idiv")) ("lux;Cons" ?y ("lux;Cons" ?x ("lux;Nil")))))
(&&host/analyse-jvm-idiv analyse exo-type ?x ?y)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_irem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_irem")) ("lux;Cons" ?y ("lux;Cons" ?x ("lux;Nil")))))
(&&host/analyse-jvm-irem analyse exo-type ?x ?y)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ieq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_ieq")) ("lux;Cons" ?y ("lux;Cons" ?x ("lux;Nil")))))
(&&host/analyse-jvm-ieq analyse exo-type ?x ?y)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ilt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_ilt")) ("lux;Cons" ?y ("lux;Cons" ?x ("lux;Nil")))))
(&&host/analyse-jvm-ilt analyse exo-type ?x ?y)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_igt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_igt")) ("lux;Cons" ?y ("lux;Cons" ?x ("lux;Nil")))))
(&&host/analyse-jvm-igt analyse exo-type ?x ?y)
;; Long arithmetic
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ladd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_ladd")) ("lux;Cons" ?y ("lux;Cons" ?x ("lux;Nil")))))
(&&host/analyse-jvm-ladd analyse exo-type ?x ?y)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lsub"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_lsub")) ("lux;Cons" ?y ("lux;Cons" ?x ("lux;Nil")))))
(&&host/analyse-jvm-lsub analyse exo-type ?x ?y)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lmul"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_lmul")) ("lux;Cons" ?y ("lux;Cons" ?x ("lux;Nil")))))
(&&host/analyse-jvm-lmul analyse exo-type ?x ?y)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_ldiv"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_ldiv")) ("lux;Cons" ?y ("lux;Cons" ?x ("lux;Nil")))))
(&&host/analyse-jvm-ldiv analyse exo-type ?x ?y)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lrem"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_lrem")) ("lux;Cons" ?y ("lux;Cons" ?x ("lux;Nil")))))
(&&host/analyse-jvm-lrem analyse exo-type ?x ?y)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_leq"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_leq")) ("lux;Cons" ?y ("lux;Cons" ?x ("lux;Nil")))))
(&&host/analyse-jvm-leq analyse exo-type ?x ?y)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_llt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_llt")) ("lux;Cons" ?y ("lux;Cons" ?x ("lux;Nil")))))
(&&host/analyse-jvm-llt analyse exo-type ?x ?y)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_lgt"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_lgt")) ("lux;Cons" ?y ("lux;Cons" ?x ("lux;Nil")))))
(&&host/analyse-jvm-lgt analyse exo-type ?x ?y)
- [_]
+ _
(aba4 analyse eval! compile-module compile-token exo-type token)))
(defn ^:private aba2 [analyse eval! compile-module compile-token exo-type token]
- (matchv ::M/objects [token]
- [["lux;SymbolS" ?ident]]
+ (|case token
+ ("lux;SymbolS" ?ident)
(&&lux/analyse-symbol analyse exo-type ?ident)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_case"]]]]
- ["lux;Cons" [?value ?branches]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_lux_case"))
+ ("lux;Cons" ?value ?branches)))
(&&lux/analyse-case analyse exo-type ?value ?branches)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_lambda"]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?self]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?arg]]]]
- ["lux;Cons" [?body
- ["lux;Nil" _]]]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_lux_lambda"))
+ ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" "" ?self))
+ ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" "" ?arg))
+ ("lux;Cons" ?body
+ ("lux;Nil"))))))
(&&lux/analyse-lambda analyse exo-type ?self ?arg ?body)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_def"]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?name]]]]
- ["lux;Cons" [?value
- ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_lux_def"))
+ ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" "" ?name))
+ ("lux;Cons" ?value
+ ("lux;Nil")))))
(&&lux/analyse-def analyse compile-token ?name ?value)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_declare-macro"]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?name]]]]
- ["lux;Nil" _]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_lux_declare-macro"))
+ ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" "" ?name))
+ ("lux;Nil"))))
(&&lux/analyse-declare-macro analyse compile-token ?name)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_import"]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?path]]]
- ["lux;Nil" _]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_lux_import"))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TextS" ?path))
+ ("lux;Nil"))))
(&&lux/analyse-import analyse compile-module compile-token ?path)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_:"]]]]
- ["lux;Cons" [?type
- ["lux;Cons" [?value
- ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_lux_:"))
+ ("lux;Cons" ?type
+ ("lux;Cons" ?value
+ ("lux;Nil")))))
(&&lux/analyse-check analyse eval! exo-type ?type ?value)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_:!"]]]]
- ["lux;Cons" [?type
- ["lux;Cons" [?value
- ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_lux_:!"))
+ ("lux;Cons" ?type
+ ("lux;Cons" ?value
+ ("lux;Nil")))))
(&&lux/analyse-coerce analyse eval! exo-type ?type ?value)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_export"]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?ident]]]]
- ["lux;Nil" _]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_lux_export"))
+ ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" "" ?ident))
+ ("lux;Nil"))))
(&&lux/analyse-export analyse compile-token ?ident)
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_alias"]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?alias]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?module]]]
- ["lux;Nil" _]]]]]]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_lux_alias"))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TextS" ?alias))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TextS" ?module))
+ ("lux;Nil")))))
(&&lux/analyse-alias analyse compile-token ?alias ?module)
- [_]
+ _
(aba3 analyse eval! compile-module compile-token exo-type token)))
(defn ^:private aba1 [analyse eval! compile-module compile-token exo-type token]
- (matchv ::M/objects [token]
+ (|case token
;; Standard special forms
- [["lux;BoolS" ?value]]
+ ("lux;BoolS" ?value)
(|do [_ (&type/check exo-type &type/Bool)]
(return (&/|list (&/T (&/V "bool" ?value) exo-type))))
- [["lux;IntS" ?value]]
+ ("lux;IntS" ?value)
(|do [_ (&type/check exo-type &type/Int)]
(return (&/|list (&/T (&/V "int" ?value) exo-type))))
- [["lux;RealS" ?value]]
+ ("lux;RealS" ?value)
(|do [_ (&type/check exo-type &type/Real)]
(return (&/|list (&/T (&/V "real" ?value) exo-type))))
- [["lux;CharS" ?value]]
+ ("lux;CharS" ?value)
(|do [_ (&type/check exo-type &type/Char)]
(return (&/|list (&/T (&/V "char" ?value) exo-type))))
- [["lux;TextS" ?value]]
+ ("lux;TextS" ?value)
(|do [_ (&type/check exo-type &type/Text)]
(return (&/|list (&/T (&/V "text" ?value) exo-type))))
- [["lux;TupleS" ?elems]]
+ ("lux;TupleS" ?elems)
(&&lux/analyse-tuple analyse exo-type ?elems)
- [["lux;RecordS" ?elems]]
+ ("lux;RecordS" ?elems)
(&&lux/analyse-record analyse exo-type ?elems)
- [["lux;TagS" ?ident]]
+ ("lux;TagS" ?ident)
(&&lux/analyse-variant analyse exo-type ?ident (&/|list))
- [["lux;SymbolS" [_ "_jvm_null"]]]
+ ("lux;SymbolS" _ "_jvm_null")
(&&host/analyse-jvm-null analyse exo-type)
- [_]
+ _
(aba2 analyse eval! compile-module compile-token exo-type token)
))
@@ -497,30 +509,27 @@
(defn ^:private analyse-basic-ast [analyse eval! compile-module compile-token exo-type token]
;; (prn 'analyse-basic-ast (&/show-ast token))
- (matchv ::M/objects [token]
- [["lux;Meta" [meta ?token]]]
+ (|case token
+ ("lux;Meta" meta ?token)
(fn [state]
- (matchv ::M/objects [((aba1 analyse eval! compile-module compile-token exo-type ?token) state)]
- [["lux;Right" [state* output]]]
+ (|case ((aba1 analyse eval! compile-module compile-token exo-type ?token) state)
+ ("lux;Right" state* output)
(return* state* output)
- [["lux;Left" ""]]
+ ("lux;Left" "")
(fail* (add-loc (&/get$ &/$cursor state) (str "[Analyser Error] Unrecognized token: " (&/show-ast token))))
- [["lux;Left" msg]]
+ ("lux;Left" msg)
(fail* (add-loc (&/get$ &/$cursor state) msg))
))
-
- ;; [_]
- ;; (assert false (aget token 0))
))
(defn ^:private just-analyse [analyser syntax]
(&type/with-var
(fn [?var]
(|do [[?output-term ?output-type] (&&/analyse-1 analyser ?var syntax)]
- (matchv ::M/objects [?var ?output-type]
- [["lux;VarT" ?e-id] ["lux;VarT" ?a-id]]
+ (|case [?var ?output-type]
+ [("lux;VarT" ?e-id) ("lux;VarT" ?a-id)]
(if (= ?e-id ?a-id)
(|do [?output-type* (&type/deref ?e-id)]
(return (&/T ?output-term ?output-type*)))
@@ -533,23 +542,21 @@
(defn ^:private analyse-ast [eval! compile-module compile-token exo-type token]
(&/with-cursor (aget token 1 0)
(&/with-expected-type exo-type
- (matchv ::M/objects [token]
- [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;TagS" ?ident]]] ?values]]]]]]
+ (|case token
+ ("lux;Meta" meta ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;TagS" ?ident)) ?values)))
(&&lux/analyse-variant (partial analyse-ast eval! compile-module compile-token) exo-type ?ident ?values)
- [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [?fn ?args]]]]]]
+ ("lux;Meta" meta ("lux;FormS" ("lux;Cons" ?fn ?args)))
(fn [state]
- (matchv ::M/objects [((just-analyse (partial analyse-ast eval! compile-module compile-token) ?fn) state)
- ;; ((&type/with-var #(&&/analyse-1 (partial analyse-ast eval! compile-module) % ?fn)) state)
- ]
- [["lux;Right" [state* =fn]]]
+ (|case ((just-analyse (partial analyse-ast eval! compile-module compile-token) ?fn) state)
+ ("lux;Right" state* =fn)
(do ;; (prn 'GOT_FUN (&/show-ast ?fn) (&/show-ast token) (aget =fn 0 0) (aget =fn 1 0))
((&&lux/analyse-apply (partial analyse-ast eval! compile-module compile-token) exo-type meta =fn ?args) state*))
- [_]
+ _
((analyse-basic-ast (partial analyse-ast eval! compile-module compile-token) eval! compile-module compile-token exo-type token) state)))
- [_]
+ _
(analyse-basic-ast (partial analyse-ast eval! compile-module compile-token) eval! compile-module compile-token exo-type token)))))
;; [Resources]
diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj
index 9fc3f1030..beeb57b08 100644
--- a/src/lux/analyser/base.clj
+++ b/src/lux/analyser/base.clj
@@ -7,24 +7,23 @@
;; You must not remove this notice, or any other, from this software.
(ns lux.analyser.base
- (:require [clojure.core.match :as M :refer [match matchv]]
+ (:require clojure.core.match
clojure.core.match.array
- (lux [base :as & :refer [|let |do return fail]]
+ (lux [base :as & :refer [|let |do return fail |case]]
[type :as &type])))
;; [Exports]
(defn expr-type [syntax+]
- (matchv ::M/objects [syntax+]
- [[_ type]]
+ (|let [[_ type] syntax+]
(return type)))
(defn analyse-1 [analyse exo-type elem]
(|do [output (analyse exo-type elem)]
- (matchv ::M/objects [output]
- [["lux;Cons" [x ["lux;Nil" _]]]]
+ (|case output
+ ("lux;Cons" x ("lux;Nil"))
(return x)
- [_]
+ _
(fail "[Analyser Error] Can't expand to other than 1 element."))))
(defn resolved-ident [ident]
diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj
index 7f2c34924..2cdf233cc 100644
--- a/src/lux/analyser/case.clj
+++ b/src/lux/analyser/case.clj
@@ -7,9 +7,9 @@
;; You must not remove this notice, or any other, from this software.
(ns lux.analyser.case
- (:require [clojure.core.match :as M :refer [match matchv]]
+ (:require clojure.core.match
clojure.core.match.array
- (lux [base :as & :refer [|do return fail |let]]
+ (lux [base :as & :refer [|do return fail |let |case]]
[parser :as &parser]
[type :as &type])
(lux.analyser [base :as &&]
@@ -20,13 +20,13 @@
(&/V "lux;Meta" (&/T (&/T "" -1 -1) (&/V "lux;TupleS" (&/|list)))))
(defn ^:private resolve-type [type]
- (matchv ::M/objects [type]
- [["lux;VarT" ?id]]
+ (|case type
+ ("lux;VarT" ?id)
(|do [type* (&/try-all% (&/|list (&type/deref ?id)
(fail "##9##")))]
(resolve-type type*))
- [["lux;AllT" [_aenv _aname _aarg _abody]]]
+ ("lux;AllT" _aenv _aname _aarg _abody)
;; (&type/actual-type _abody)
(|do [$var &type/existential
=type (&type/apply-type type $var)]
@@ -36,20 +36,20 @@
;; (|do [=type (&type/apply-type type $var)]
;; (&type/actual-type =type))))
- [_]
+ _
(&type/actual-type type)))
(defn adjust-type* [up type]
"(-> (List (, (Maybe (Env Text Type)) Text Text Type)) Type (Lux Type))"
- (matchv ::M/objects [type]
- [["lux;AllT" [_aenv _aname _aarg _abody]]]
+ (|case type
+ ("lux;AllT" _aenv _aname _aarg _abody)
(&type/with-var
(fn [$var]
(|do [=type (&type/apply-type type $var)]
(adjust-type* (&/|cons (&/T _aenv _aname _aarg $var) up) =type))))
- [["lux;TupleT" ?members]]
- (|do [["lux;TupleT" ?members*] (&/fold% (fn [_abody ena]
+ ("lux;TupleT" ?members)
+ (|do [("lux;TupleT" ?members*) (&/fold% (fn [_abody ena]
(|let [[_aenv _aname _aarg ["lux;VarT" _avar]] ena]
(|do [_ (&type/set-var _avar (&/V "lux;BoundT" _aarg))]
(&type/clean* _avar _abody))))
@@ -63,8 +63,8 @@
up))
?members*))))
- [["lux;RecordT" ?fields]]
- (|do [["lux;RecordT" ?fields*] (&/fold% (fn [_abody ena]
+ ("lux;RecordT" ?fields)
+ (|do [("lux;RecordT" ?fields*) (&/fold% (fn [_abody ena]
(|let [[_aenv _aname _aarg ["lux;VarT" _avar]] ena]
(|do [_ (&type/set-var _avar (&/V "lux;BoundT" _aarg))]
(&type/clean* _avar _abody))))
@@ -79,8 +79,8 @@
up))))
?fields*))))
- [["lux;VariantT" ?cases]]
- (|do [["lux;VariantT" ?cases*] (&/fold% (fn [_abody ena]
+ ("lux;VariantT" ?cases)
+ (|do [("lux;VariantT" ?cases*) (&/fold% (fn [_abody ena]
(|let [[_aenv _aname _aarg ["lux;VarT" _avar]] ena]
(|do [_ (&type/set-var _avar (&/V "lux;BoundT" _aarg))]
(&type/clean* _avar _abody))))
@@ -95,11 +95,11 @@
up))))
?cases*))))
- [["lux;AppT" [?tfun ?targ]]]
+ ("lux;AppT" ?tfun ?targ)
(|do [=type (&type/apply-type ?tfun ?targ)]
(adjust-type* up =type))
- [["lux;VarT" ?id]]
+ ("lux;VarT" ?id)
(|do [type* (&/try-all% (&/|list (&type/deref ?id)
(fail "##9##")))]
(adjust-type* up type*))
@@ -113,48 +113,47 @@
(adjust-type* (&/|list) type))
(defn ^:private analyse-pattern [value-type pattern kont]
- (matchv ::M/objects [pattern]
- [["lux;Meta" [_ pattern*]]]
- (matchv ::M/objects [pattern*]
- [["lux;SymbolS" ["" name]]]
+ (|let [("lux;Meta" _ pattern*) pattern]
+ (|case pattern*
+ ("lux;SymbolS" "" name)
(|do [=kont (&env/with-local name value-type
kont)
idx &env/next-local-idx]
(return (&/T (&/V "StoreTestAC" idx) =kont)))
- [["lux;SymbolS" ident]]
+ ("lux;SymbolS" ident)
(fail (str "[Pattern-matching Error] Symbols must be unqualified: " (&/ident->text ident)))
- [["lux;BoolS" ?value]]
+ ("lux;BoolS" ?value)
(|do [_ (&type/check value-type &type/Bool)
=kont kont]
(return (&/T (&/V "BoolTestAC" ?value) =kont)))
- [["lux;IntS" ?value]]
+ ("lux;IntS" ?value)
(|do [_ (&type/check value-type &type/Int)
=kont kont]
(return (&/T (&/V "IntTestAC" ?value) =kont)))
- [["lux;RealS" ?value]]
+ ("lux;RealS" ?value)
(|do [_ (&type/check value-type &type/Real)
=kont kont]
(return (&/T (&/V "RealTestAC" ?value) =kont)))
- [["lux;CharS" ?value]]
+ ("lux;CharS" ?value)
(|do [_ (&type/check value-type &type/Char)
=kont kont]
(return (&/T (&/V "CharTestAC" ?value) =kont)))
- [["lux;TextS" ?value]]
+ ("lux;TextS" ?value)
(|do [_ (&type/check value-type &type/Text)
=kont kont]
(return (&/T (&/V "TextTestAC" ?value) =kont)))
- [["lux;TupleS" ?members]]
+ ("lux;TupleS" ?members)
(|do [value-type* (adjust-type value-type)]
(do ;; (prn 'PM/TUPLE-1 (&type/show-type value-type*))
- (matchv ::M/objects [value-type*]
- [["lux;TupleT" ?member-types]]
+ (|case value-type*
+ ("lux;TupleT" ?member-types)
(do ;; (prn 'PM/TUPLE-2 (&/|length ?member-types) (&/|length ?members))
(if (not (.equals ^Object (&/|length ?member-types) (&/|length ?members)))
(fail (str "[Pattern-matching Error] Pattern-matching mismatch. Require tuple[" (&/|length ?member-types) "]. Given tuple [" (&/|length ?members) "]"))
@@ -167,48 +166,48 @@
(&/|reverse (&/zip2 ?member-types ?members)))]
(return (&/T (&/V "TupleTestAC" =tests) =kont)))))
- [_]
+ _
(fail (str "[Pattern-matching Error] Tuples require tuple-types: " (&type/show-type value-type*))))))
-
- [["lux;RecordS" ?slots]]
+
+ ("lux;RecordS" ?slots)
(|do [;; :let [_ (prn 'PRE (&type/show-type value-type))]
value-type* (adjust-type value-type)
;; :let [_ (prn 'POST (&type/show-type value-type*))]
;; value-type* (resolve-type value-type)
]
- (matchv ::M/objects [value-type*]
- [["lux;RecordT" ?slot-types]]
+ (|case value-type*
+ ("lux;RecordT" ?slot-types)
(if (not (.equals ^Object (&/|length ?slot-types) (&/|length ?slots)))
(fail (str "[Analyser Error] Pattern-matching mismatch. Require record[" (&/|length ?slot-types) "]. Given record[" (&/|length ?slots) "]"))
(|do [[=tests =kont] (&/fold (fn [kont* slot]
(|let [[sn sv] slot]
- (matchv ::M/objects [sn]
- [["lux;Meta" [_ ["lux;TagS" ?ident]]]]
+ (|case sn
+ ("lux;Meta" _ ("lux;TagS" ?ident))
(|do [=tag (&&/resolved-ident ?ident)]
(if-let [=slot-type (&/|get =tag ?slot-types)]
(|do [[=test [=tests =kont]] (analyse-pattern =slot-type sv kont*)]
(return (&/T (&/|put =tag =test =tests) =kont)))
(fail (str "[Pattern-matching Error] Record-type lacks slot: " =tag))))
- [_]
+ _
(fail (str "[Pattern-matching Error] Record must use tags as slot-names: " (&/show-ast sn))))))
(|do [=kont kont]
(return (&/T (&/|table) =kont)))
(&/|reverse ?slots))]
(return (&/T (&/V "RecordTestAC" =tests) =kont))))
- [_]
+ _
(fail "[Pattern-matching Error] Record requires record-type.")))
- [["lux;TagS" ?ident]]
+ ("lux;TagS" ?ident)
(|do [=tag (&&/resolved-ident ?ident)
value-type* (adjust-type value-type)
case-type (&type/variant-case =tag value-type*)
[=test =kont] (analyse-pattern case-type unit kont)]
(return (&/T (&/V "VariantTestAC" (&/T =tag =test)) =kont)))
- [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;TagS" ?ident]]]
- ?values]]]]
+ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;TagS" ?ident))
+ ?values))
(|do [=tag (&&/resolved-ident ?ident)
value-type* (adjust-type value-type)
case-type (&type/variant-case =tag value-type*)
@@ -228,50 +227,50 @@
(let [compare-kv #(.compareTo ^String (aget ^objects %1 0) ^String (aget ^objects %2 0))]
(defn ^:private merge-total [struct test+body]
(|let [[test ?body] test+body]
- (matchv ::M/objects [struct test]
- [["DefaultTotal" total?] ["StoreTestAC" ?idx]]
+ (|case [struct test]
+ [("DefaultTotal" total?) ("StoreTestAC" ?idx)]
(return (&/V "DefaultTotal" true))
- [[?tag [total? ?values]] ["StoreTestAC" ?idx]]
+ [[?tag [total? ?values]] ("StoreTestAC" ?idx)]
(return (&/V ?tag (&/T true ?values)))
- [["DefaultTotal" total?] ["BoolTestAC" ?value]]
+ [("DefaultTotal" total?) ("BoolTestAC" ?value)]
(return (&/V "BoolTotal" (&/T total? (&/|list ?value))))
- [["BoolTotal" [total? ?values]] ["BoolTestAC" ?value]]
+ [("BoolTotal" total? ?values) ("BoolTestAC" ?value)]
(return (&/V "BoolTotal" (&/T total? (&/|cons ?value ?values))))
- [["DefaultTotal" total?] ["IntTestAC" ?value]]
+ [("DefaultTotal" total?) ("IntTestAC" ?value)]
(return (&/V "IntTotal" (&/T total? (&/|list ?value))))
- [["IntTotal" [total? ?values]] ["IntTestAC" ?value]]
+ [("IntTotal" total? ?values) ("IntTestAC" ?value)]
(return (&/V "IntTotal" (&/T total? (&/|cons ?value ?values))))
- [["DefaultTotal" total?] ["RealTestAC" ?value]]
+ [("DefaultTotal" total?) ("RealTestAC" ?value)]
(return (&/V "RealTotal" (&/T total? (&/|list ?value))))
- [["RealTotal" [total? ?values]] ["RealTestAC" ?value]]
+ [("RealTotal" total? ?values) ("RealTestAC" ?value)]
(return (&/V "RealTotal" (&/T total? (&/|cons ?value ?values))))
- [["DefaultTotal" total?] ["CharTestAC" ?value]]
+ [("DefaultTotal" total?) ("CharTestAC" ?value)]
(return (&/V "CharTotal" (&/T total? (&/|list ?value))))
- [["CharTotal" [total? ?values]] ["CharTestAC" ?value]]
+ [("CharTotal" total? ?values) ("CharTestAC" ?value)]
(return (&/V "CharTotal" (&/T total? (&/|cons ?value ?values))))
- [["DefaultTotal" total?] ["TextTestAC" ?value]]
+ [("DefaultTotal" total?) ("TextTestAC" ?value)]
(return (&/V "TextTotal" (&/T total? (&/|list ?value))))
- [["TextTotal" [total? ?values]] ["TextTestAC" ?value]]
+ [("TextTotal" total? ?values) ("TextTestAC" ?value)]
(return (&/V "TextTotal" (&/T total? (&/|cons ?value ?values))))
- [["DefaultTotal" total?] ["TupleTestAC" ?tests]]
+ [("DefaultTotal" total?) ("TupleTestAC" ?tests)]
(|do [structs (&/map% (fn [t]
(merge-total (&/V "DefaultTotal" total?) (&/T t ?body)))
?tests)]
(return (&/V "TupleTotal" (&/T total? structs))))
- [["TupleTotal" [total? ?values]] ["TupleTestAC" ?tests]]
+ [("TupleTotal" total? ?values) ("TupleTestAC" ?tests)]
(if (.equals ^Object (&/|length ?values) (&/|length ?tests))
(|do [structs (&/map2% (fn [v t]
(merge-total v (&/T t ?body)))
@@ -279,7 +278,7 @@
(return (&/V "TupleTotal" (&/T total? structs))))
(fail "[Pattern-matching Error] Inconsistent tuple-size."))
- [["DefaultTotal" total?] ["RecordTestAC" ?tests]]
+ [("DefaultTotal" total?) ("RecordTestAC" ?tests)]
(|do [structs (&/map% (fn [t]
(|let [[slot value] t]
(|do [struct* (merge-total (&/V "DefaultTotal" total?) (&/T value ?body))]
@@ -290,7 +289,7 @@
&/->list))]
(return (&/V "RecordTotal" (&/T total? structs))))
- [["RecordTotal" [total? ?values]] ["RecordTestAC" ?tests]]
+ [("RecordTotal" total? ?values) ("RecordTestAC" ?tests)]
(if (.equals ^Object (&/|length ?values) (&/|length ?tests))
(|do [structs (&/map2% (fn [left right]
(|let [[lslot sub-struct] left
@@ -307,12 +306,12 @@
(return (&/V "RecordTotal" (&/T total? structs))))
(fail "[Pattern-matching Error] Inconsistent record-size."))
- [["DefaultTotal" total?] ["VariantTestAC" [?tag ?test]]]
+ [("DefaultTotal" total?) ("VariantTestAC" ?tag ?test)]
(|do [sub-struct (merge-total (&/V "DefaultTotal" total?)
(&/T ?test ?body))]
(return (&/V "VariantTotal" (&/T total? (&/|put ?tag sub-struct (&/|table))))))
- [["VariantTotal" [total? ?branches]] ["VariantTestAC" [?tag ?test]]]
+ [("VariantTotal" total? ?branches) ("VariantTestAC" ?tag ?test)]
(|do [sub-struct (merge-total (or (&/|get ?tag ?branches)
(&/V "DefaultTotal" total?))
(&/T ?test ?body))]
@@ -320,43 +319,43 @@
))))
(defn ^:private check-totality [value-type struct]
- (matchv ::M/objects [struct]
- [["BoolTotal" [?total ?values]]]
+ (|case struct
+ ("BoolTotal" ?total ?values)
(return (or ?total
(= #{true false} (set (&/->seq ?values)))))
- [["IntTotal" [?total _]]]
+ ("IntTotal" ?total _)
(return ?total)
- [["RealTotal" [?total _]]]
+ ("RealTotal" ?total _)
(return ?total)
- [["CharTotal" [?total _]]]
+ ("CharTotal" ?total _)
(return ?total)
- [["TextTotal" [?total _]]]
+ ("TextTotal" ?total _)
(return ?total)
- [["TupleTotal" [?total ?structs]]]
+ ("TupleTotal" ?total ?structs)
(if ?total
(return true)
(|do [value-type* (resolve-type value-type)]
- (matchv ::M/objects [value-type*]
- [["lux;TupleT" ?members]]
+ (|case value-type*
+ ("lux;TupleT" ?members)
(|do [totals (&/map2% (fn [sub-struct ?member]
(check-totality ?member sub-struct))
?structs ?members)]
(return (&/fold #(and %1 %2) true totals)))
- [_]
+ _
(fail "[Pattern-maching Error] Tuple is not total."))))
- [["RecordTotal" [?total ?structs]]]
+ ("RecordTotal" ?total ?structs)
(if ?total
(return true)
(|do [value-type* (resolve-type value-type)]
- (matchv ::M/objects [value-type*]
- [["lux;RecordT" ?fields]]
+ (|case value-type*
+ ("lux;RecordT" ?fields)
(|do [totals (&/map% (fn [field]
(|let [[?tk ?tv] field]
(if-let [sub-struct (&/|get ?tk ?structs)]
@@ -365,15 +364,15 @@
?fields)]
(return (&/fold #(and %1 %2) true totals)))
- [_]
+ _
(fail "[Pattern-maching Error] Record is not total."))))
- [["VariantTotal" [?total ?structs]]]
+ ("VariantTotal" ?total ?structs)
(if ?total
(return true)
(|do [value-type* (resolve-type value-type)]
- (matchv ::M/objects [value-type*]
- [["lux;VariantT" ?cases]]
+ (|case value-type*
+ ("lux;VariantT" ?cases)
(|do [totals (&/map% (fn [case]
(|let [[?tk ?tv] case]
(if-let [sub-struct (&/|get ?tk ?structs)]
@@ -382,10 +381,10 @@
?cases)]
(return (&/fold #(and %1 %2) true totals)))
- [_]
+ _
(fail "[Pattern-maching Error] Variant is not total."))))
- [["DefaultTotal" ?total]]
+ ("DefaultTotal" ?total)
(return ?total)
))
diff --git a/src/lux/analyser/env.clj b/src/lux/analyser/env.clj
index 391d78411..a39ec490a 100644
--- a/src/lux/analyser/env.clj
+++ b/src/lux/analyser/env.clj
@@ -7,9 +7,9 @@
;; You must not remove this notice, or any other, from this software.
(ns lux.analyser.env
- (:require [clojure.core.match :as M :refer [matchv]]
+ (:require clojure.core.match
clojure.core.match.array
- (lux [base :as & :refer [|do return return* fail]])
+ (lux [base :as & :refer [|do return return* fail |case]])
[lux.analyser.base :as &&]))
;; [Exports]
@@ -31,8 +31,8 @@
(&/|head stack))
(&/|tail stack))))
state))]
- (matchv ::M/objects [=return]
- [["lux;Right" [?state ?value]]]
+ (|case =return
+ ("lux;Right" ?state ?value)
(return* (&/update$ &/$ENVS (fn [stack*]
(&/|cons (&/update$ &/$LOCALS #(->> %
(&/update$ &/$COUNTER dec)
@@ -42,7 +42,7 @@
?state)
?value)
- [_]
+ _
=return))))
(def captured-vars
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index d03d0e65c..707060323 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -8,9 +8,9 @@
(ns lux.analyser.host
(:require (clojure [template :refer [do-template]])
- [clojure.core.match :as M :refer [match matchv]]
+ clojure.core.match
clojure.core.match.array
- (lux [base :as & :refer [|let |do return fail]]
+ (lux [base :as & :refer [|let |do return fail |case]]
[parser :as &parser]
[type :as &type]
[host :as &host])
@@ -19,39 +19,37 @@
;; [Utils]
(defn ^:private extract-text [text]
- (matchv ::M/objects [text]
- [["lux;Meta" [_ ["lux;TextS" ?text]]]]
+ (|case text
+ ("lux;Meta" _ ("lux;TextS" ?text))
(return ?text)
- [_]
+ _
(fail "[Analyser Error] Can't extract Text.")))
(defn ^:private analyse-1+ [analyse ?token]
(&type/with-var
(fn [$var]
- (|do [=expr (&&/analyse-1 analyse $var ?token)]
- (matchv ::M/objects [=expr]
- [[?item ?type]]
- (|do [=type (&type/clean $var ?type)]
- (return (&/T ?item =type)))
- )))))
+ (|do [=expr (&&/analyse-1 analyse $var ?token)
+ :let [[?item ?type] =expr]
+ =type (&type/clean $var ?type)]
+ (return (&/T ?item =type))))))
(defn ^:private ensure-object [token]
"(-> Analysis (Lux (,)))"
- (matchv ::M/objects [token]
- [[_ ["lux;DataT" _]]]
+ (|case token
+ [_ ("lux;DataT" _)]
(return nil)
- [_]
+ _
(fail "[Analyser Error] Expecting object")))
(defn ^:private as-object [type]
"(-> Type Type)"
- (matchv ::M/objects [type]
- [["lux;DataT" class]]
+ (|case type
+ ("lux;DataT" class)
(&/V "lux;DataT" (&type/as-obj class))
- [_]
+ _
type))
;; [Resources]
@@ -225,32 +223,32 @@
(defn ^:private analyse-modifiers [modifiers]
(&/fold% (fn [so-far modif]
- (matchv ::M/objects [modif]
- [["lux;Meta" [_ ["lux;TextS" "public"]]]]
+ (|case modif
+ ("lux;Meta" _ ("lux;TextS" "public"))
(return (assoc so-far :visibility "public"))
- [["lux;Meta" [_ ["lux;TextS" "private"]]]]
+ ("lux;Meta" _ ("lux;TextS" "private"))
(return (assoc so-far :visibility "private"))
- [["lux;Meta" [_ ["lux;TextS" "protected"]]]]
+ ("lux;Meta" _ ("lux;TextS" "protected"))
(return (assoc so-far :visibility "protected"))
- [["lux;Meta" [_ ["lux;TextS" "static"]]]]
+ ("lux;Meta" _ ("lux;TextS" "static"))
(return (assoc so-far :static? true))
- [["lux;Meta" [_ ["lux;TextS" "final"]]]]
+ ("lux;Meta" _ ("lux;TextS" "final"))
(return (assoc so-far :final? true))
- [["lux;Meta" [_ ["lux;TextS" "abstract"]]]]
+ ("lux;Meta" _ ("lux;TextS" "abstract"))
(return (assoc so-far :abstract? true))
- [["lux;Meta" [_ ["lux;TextS" "synchronized"]]]]
+ ("lux;Meta" _ ("lux;TextS" "synchronized"))
(return (assoc so-far :concurrency "synchronized"))
- [["lux;Meta" [_ ["lux;TextS" "volatile"]]]]
+ ("lux;Meta" _ ("lux;TextS" "volatile"))
(return (assoc so-far :concurrency "volatile"))
- [_]
+ _
(fail (str "[Analyser Error] Unknown modifier: " (&/show-ast modif)))))
{:visibility "default"
:static? false
@@ -276,35 +274,35 @@
(defn analyse-jvm-class [analyse compile-token ?name ?super-class ?interfaces ?fields ?methods]
(|do [=interfaces (&/map% extract-text ?interfaces)
=fields (&/map% (fn [?field]
- (matchv ::M/objects [?field]
- [["lux;Meta" [_ ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?field-name]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?field-type]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?field-modifiers]]]
- ["lux;Nil" _]]]]]]]]]]]
+ (|case ?field
+ ("lux;Meta" _ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;TextS" ?field-name))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TextS" ?field-type))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TupleS" ?field-modifiers))
+ ("lux;Nil"))))))
(|do [=field-modifiers (analyse-modifiers ?field-modifiers)]
(return {:name ?field-name
:modifiers =field-modifiers
:type ?field-type}))
- [_]
+ _
(fail "[Analyser Error] Wrong syntax for field.")))
?fields)
=methods (&/map% (fn [?method]
- (matchv ::M/objects [?method]
- [[?idx ["lux;Meta" [_ ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?method-name]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?method-inputs]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?method-output]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?method-modifiers]]]
- ["lux;Cons" [?method-body
- ["lux;Nil" _]]]]]]]]]]]]]]]]
+ (|case ?method
+ [?idx ("lux;Meta" _ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;TextS" ?method-name))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TupleS" ?method-inputs))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TextS" ?method-output))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TupleS" ?method-modifiers))
+ ("lux;Cons" ?method-body
+ ("lux;Nil"))))))))]
(|do [=method-inputs (&/map% (fn [minput]
- (matchv ::M/objects [minput]
- [["lux;Meta" [_ ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?input-name]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?input-type]]]
- ["lux;Nil" _]]]]]]]]]
+ (|case minput
+ ("lux;Meta" _ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" "" ?input-name))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TextS" ?input-type))
+ ("lux;Nil")))))
(return (&/T ?input-name ?input-type))
- [_]
+ _
(fail "[Analyser Error] Wrong syntax for method input.")))
?method-inputs)
=method-modifiers (analyse-modifiers ?method-modifiers)
@@ -326,7 +324,7 @@
:output ?method-output
:body =method-body}))
- [_]
+ _
(fail "[Analyser Error] Wrong syntax for method.")))
(&/enumerate ?methods))
_ (compile-token (&/V "jvm-class" (&/T ?name ?super-class =interfaces =fields =methods)))]
@@ -335,12 +333,12 @@
(defn analyse-jvm-interface [analyse compile-token ?name ?supers ?methods]
(|do [=supers (&/map% extract-text ?supers)
=methods (&/map% (fn [method]
- (matchv ::M/objects [method]
- [["lux;Meta" [_ ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?method-name]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?inputs]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?output]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?modifiers]]]
- ["lux;Nil" _]]]]]]]]]]]]]
+ (|case method
+ ("lux;Meta" _ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;TextS" ?method-name))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TupleS" ?inputs))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TextS" ?output))
+ ("lux;Cons" ("lux;Meta" _ ("lux;TupleS" ?modifiers))
+ ("lux;Nil")))))))
(|do [=inputs (&/map% extract-text ?inputs)
=modifiers (analyse-modifiers ?modifiers)]
(return {:name ?method-name
@@ -348,7 +346,7 @@
:inputs =inputs
:output ?output}))
- [_]
+ _
(fail (str "[Analyser Error] Invalid method signature: " (&/show-ast method)))))
?methods)
_ (compile-token (&/V "jvm-interface" (&/T ?name =supers =methods)))]
@@ -363,10 +361,10 @@
idx &&env/next-local-idx]
(return (&/T ?ex-class idx =catch-body))))
?catches)
- =finally (matchv ::M/objects [?finally]
- [["lux;None" _]] (return (&/V "lux;None" nil))
- [["lux;Some" ?finally*]] (|do [=finally (analyse-1+ analyse ?finally*)]
- (return (&/V "lux;Some" =finally))))]
+ =finally (|case [?finally]
+ ("lux;None") (return (&/V "lux;None" nil))
+ ("lux;Some" ?finally*) (|do [=finally (analyse-1+ analyse ?finally*)]
+ (return (&/V "lux;Some" =finally))))]
(return (&/|list (&/T (&/V "jvm-try" (&/T =body =catches =finally)) exo-type)))))
(defn analyse-jvm-throw [analyse exo-type ?ex]
@@ -423,11 +421,14 @@
analyse-jvm-iand "jvm-iand" "java.lang.Integer" "java.lang.Integer"
analyse-jvm-ior "jvm-ior" "java.lang.Integer" "java.lang.Integer"
+ analyse-jvm-ixor "jvm-ixor" "java.lang.Integer" "java.lang.Integer"
+ analyse-jvm-ishl "jvm-ishl" "java.lang.Integer" "java.lang.Integer"
+ analyse-jvm-ishr "jvm-ishr" "java.lang.Integer" "java.lang.Integer"
+ analyse-jvm-iushr "jvm-iushr" "java.lang.Integer" "java.lang.Integer"
analyse-jvm-land "jvm-land" "java.lang.Long" "java.lang.Long"
analyse-jvm-lor "jvm-lor" "java.lang.Long" "java.lang.Long"
analyse-jvm-lxor "jvm-lxor" "java.lang.Long" "java.lang.Long"
-
analyse-jvm-lshl "jvm-lshl" "java.lang.Long" "java.lang.Integer"
analyse-jvm-lshr "jvm-lshr" "java.lang.Long" "java.lang.Integer"
analyse-jvm-lushr "jvm-lushr" "java.lang.Long" "java.lang.Integer"
diff --git a/src/lux/analyser/lambda.clj b/src/lux/analyser/lambda.clj
index 7c7b80577..a230c8642 100644
--- a/src/lux/analyser/lambda.clj
+++ b/src/lux/analyser/lambda.clj
@@ -7,9 +7,9 @@
;; You must not remove this notice, or any other, from this software.
(ns lux.analyser.lambda
- (:require [clojure.core.match :as M :refer [matchv]]
+ (:require clojure.core.match
clojure.core.match.array
- (lux [base :as & :refer [|let |do return fail]]
+ (lux [base :as & :refer [|let |do return fail |case]]
[host :as &host])
(lux.analyser [base :as &&]
[env :as &env])))
@@ -25,13 +25,12 @@
(return (&/T scope-name =captured =return))))))))
(defn close-over [scope name register frame]
- (matchv ::M/objects [register]
- [[_ register-type]]
- (|let [register* (&/T (&/V "captured" (&/T scope
- (->> frame (&/get$ &/$CLOSURE) (&/get$ &/$COUNTER))
- register))
- register-type)]
- (&/T register* (&/update$ &/$CLOSURE #(->> %
- (&/update$ &/$COUNTER inc)
- (&/update$ &/$MAPPINGS (fn [mps] (&/|put name register* mps))))
- frame)))))
+ (|let [[_ register-type] register
+ register* (&/T (&/V "captured" (&/T scope
+ (->> frame (&/get$ &/$CLOSURE) (&/get$ &/$COUNTER))
+ register))
+ register-type)]
+ (&/T register* (&/update$ &/$CLOSURE #(->> %
+ (&/update$ &/$COUNTER inc)
+ (&/update$ &/$MAPPINGS (fn [mps] (&/|put name register* mps))))
+ frame))))
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 7aba5dd39..cd89764c3 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -8,9 +8,9 @@
(ns lux.analyser.lux
(:require (clojure [template :refer [do-template]])
- [clojure.core.match :as M :refer [matchv]]
+ clojure.core.match
clojure.core.match.array
- (lux [base :as & :refer [|do return return* fail fail* |let |list]]
+ (lux [base :as & :refer [|do return return* fail fail* |let |list |case]]
[parser :as &parser]
[type :as &type]
[host :as &host])
@@ -23,68 +23,66 @@
(defn ^:private analyse-1+ [analyse ?token]
(&type/with-var
(fn [$var]
- (|do [=expr (&&/analyse-1 analyse $var ?token)]
- (matchv ::M/objects [=expr]
- [[?item ?type]]
- (|do [=type (&type/clean $var ?type)]
- (return (&/T ?item =type)))
- )))))
+ (|do [=expr (&&/analyse-1 analyse $var ?token)
+ :let [[?item ?type] =expr]
+ =type (&type/clean $var ?type)]
+ (return (&/T ?item =type))))))
(defn ^:private with-cursor [cursor form]
- (matchv ::M/objects [form]
- [["lux;Meta" [_ syntax]]]
+ (|case form
+ ("lux;Meta" _ syntax)
(&/V "lux;Meta" (&/T cursor syntax))))
;; [Exports]
(defn analyse-tuple [analyse exo-type ?elems]
(|do [exo-type* (&type/actual-type exo-type)]
- (matchv ::M/objects [exo-type*]
- [["lux;TupleT" ?members]]
+ (|case exo-type*
+ ("lux;TupleT" ?members)
(|do [=elems (&/map2% (fn [elem-t elem]
(&&/analyse-1 analyse elem-t elem))
?members ?elems)]
(return (&/|list (&/T (&/V "tuple" =elems)
exo-type))))
- [["lux;AllT" _]]
+ ("lux;AllT" _)
(&type/with-var
(fn [$var]
(|do [exo-type** (&type/apply-type exo-type* $var)]
(analyse-tuple analyse exo-type** ?elems))))
- [_]
+ _
(fail (str "[Analyser Error] Tuples require tuple-types: " (&type/show-type exo-type*))))))
(defn ^:private analyse-variant-body [analyse exo-type ?values]
- (|do [output (matchv ::M/objects [?values]
- [["lux;Nil" _]]
+ (|do [output (|case ?values
+ ("lux;Nil")
(analyse-tuple analyse exo-type (&/|list))
- [["lux;Cons" [?value ["lux;Nil" _]]]]
+ ("lux;Cons" ?value ("lux;Nil"))
(analyse exo-type ?value)
- [_]
+ _
(analyse-tuple analyse exo-type ?values)
)]
- (matchv ::M/objects [output]
- [["lux;Cons" [x ["lux;Nil" _]]]]
+ (|case output
+ ("lux;Cons" x ("lux;Nil"))
(return x)
- [_]
+ _
(fail "[Analyser Error] Can't expand to other than 1 element."))))
(defn analyse-variant [analyse exo-type ident ?values]
- (|do [exo-type* (matchv ::M/objects [exo-type]
- [["lux;VarT" ?id]]
+ (|do [exo-type* (|case exo-type
+ ("lux;VarT" ?id)
(&/try-all% (&/|list (|do [exo-type* (&type/deref ?id)]
(&type/actual-type exo-type*))
(|do [_ (&type/set-var ?id &type/Type)]
(&type/actual-type &type/Type))))
- [_]
+ _
(&type/actual-type exo-type))]
- (matchv ::M/objects [exo-type*]
- [["lux;VariantT" ?cases]]
+ (|case exo-type*
+ ("lux;VariantT" ?cases)
(|do [?tag (&&/resolved-ident ident)]
(if-let [vtype (&/|get ?tag ?cases)]
(|do [=value (analyse-variant-body analyse vtype ?values)]
@@ -92,22 +90,22 @@
exo-type))))
(fail (str "[Analyser Error] There is no case " ?tag " for variant type " (&type/show-type exo-type*)))))
- [["lux;AllT" _]]
+ ("lux;AllT" _)
(&type/with-var
(fn [$var]
(|do [exo-type** (&type/apply-type exo-type* $var)]
(analyse-variant analyse exo-type** ident ?values))))
- [_]
+ _
(fail (str "[Analyser Error] Can't create a variant if the expected type is " (&type/show-type exo-type*))))))
(defn analyse-record [analyse exo-type ?elems]
- (|do [exo-type* (matchv ::M/objects [exo-type]
- [["lux;VarT" ?id]]
+ (|do [exo-type* (|case exo-type
+ ("lux;VarT" ?id)
(|do [exo-type* (&type/deref ?id)]
(&type/actual-type exo-type*))
- [["lux;AllT" _]]
+ ("lux;AllT" _)
(|do [$var &type/existential
=type (&type/apply-type exo-type $var)]
(&type/actual-type =type))
@@ -116,21 +114,21 @@
;; (|do [=type (&type/apply-type exo-type $var)]
;; (&type/actual-type =type))))
- [_]
+ _
(&type/actual-type exo-type))
- types (matchv ::M/objects [exo-type*]
- [["lux;RecordT" ?table]]
+ types (|case exo-type*
+ ("lux;RecordT" ?table)
(return ?table)
- [_]
+ _
(fail (str "[Analyser Error] The type of a record must be a record type:\n"
(&type/show-type exo-type*)
"\n")))
_ (&/assert! (= (&/|length types) (&/|length ?elems))
(str "[Analyser Error] Record length mismatch. Expected: " (&/|length types) "; actual: " (&/|length ?elems)))
=slots (&/map% (fn [kv]
- (matchv ::M/objects [kv]
- [[["lux;Meta" [_ ["lux;TagS" ?ident]]] ?value]]
+ (|case kv
+ [("lux;Meta" _ ["lux;TagS" ?ident]) ?value]
(|do [?tag (&&/resolved-ident ?ident)
slot-type (if-let [slot-type (&/|get ?tag types)]
(return slot-type)
@@ -138,7 +136,7 @@
=value (&&/analyse-1 analyse slot-type ?value)]
(return (&/T ?tag =value)))
- [_]
+ _
(fail "[Analyser Error] Wrong syntax for records. Odd elements must be tags.")))
?elems)]
(return (&/|list (&/T (&/V "record" =slots) (&/V "lux;RecordT" exo-type))))))
@@ -146,14 +144,14 @@
(defn ^:private analyse-global [analyse exo-type module name]
(|do [[[r-module r-name] $def] (&&module/find-def module name)
;; :let [_ (prn 'analyse-symbol/_1.1 r-module r-name)]
- endo-type (matchv ::M/objects [$def]
- [["lux;ValueD" [?type _]]]
+ endo-type (|case $def
+ ("lux;ValueD" ?type _)
(return ?type)
- [["lux;MacroD" _]]
+ ("lux;MacroD" _)
(return &type/Macro)
- [["lux;TypeD" _]]
+ ("lux;TypeD" _)
(return &type/Type))
_ (if (and (clojure.lang.Util/identical &type/Type endo-type)
(clojure.lang.Util/identical &type/Type exo-type))
@@ -168,28 +166,28 @@
no-binding? #(and (->> % (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|contains? name) not)
(->> % (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS) (&/|contains? name) not))
[inner outer] (&/|split-with no-binding? stack)]
- (matchv ::M/objects [outer]
- [["lux;Nil" _]]
+ (|case outer
+ ("lux;Nil")
(&/run-state (|do [module-name &/get-module-name]
(analyse-global analyse exo-type module-name name))
state)
- [["lux;Cons" [?genv ["lux;Nil" _]]]]
+ ("lux;Cons" ?genv ("lux;Nil"))
(do ;; (prn 'analyse-symbol/_2 ?module name name (->> ?genv (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) &/|keys &/->seq))
(if-let [global (->> ?genv (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|get name))]
(do ;; (prn 'analyse-symbol/_2.1 ?module name name (aget global 0))
- (matchv ::M/objects [global]
- [[["lux;Global" [?module* name*]] _]]
+ (|case global
+ [("lux;Global" ?module* name*) _]
((|do [[[r-module r-name] $def] (&&module/find-def ?module* name*)
;; :let [_ (prn 'analyse-symbol/_2.1.1 r-module r-name)]
- endo-type (matchv ::M/objects [$def]
- [["lux;ValueD" [?type _]]]
+ endo-type (|case $def
+ ("lux;ValueD" ?type _)
(return ?type)
- [["lux;MacroD" _]]
+ ("lux;MacroD" _)
(return &type/Macro)
- [["lux;TypeD" _]]
+ ("lux;TypeD" _)
(return &type/Type))
_ (if (and (clojure.lang.Util/identical &type/Type endo-type)
(clojure.lang.Util/identical &type/Type exo-type))
@@ -204,7 +202,7 @@
(fail* "[Analyser Error] Can't have anything other than a global def in the global environment."))))
(fail* "_{_ analyse-symbol _}_")))
- [["lux;Cons" [top-outer _]]]
+ ("lux;Cons" top-outer _)
(do ;; (prn 'analyse-symbol/_3 ?module name)
(|let [scopes (&/|tail (&/folds #(&/|cons (&/get$ &/$NAME %2) %1)
(&/|map #(&/get$ &/$NAME %) outer)
@@ -232,15 +230,15 @@
(defn ^:private analyse-apply* [analyse exo-type fun-type ?args]
;; (prn 'analyse-apply* (aget fun-type 0))
- (matchv ::M/objects [?args]
- [["lux;Nil" _]]
+ (|case ?args
+ ("lux;Nil")
(|do [_ (&type/check exo-type fun-type)]
(return (&/T fun-type (&/|list))))
- [["lux;Cons" [?arg ?args*]]]
+ ("lux;Cons" ?arg ?args*)
(|do [?fun-type* (&type/actual-type fun-type)]
- (matchv ::M/objects [?fun-type*]
- [["lux;AllT" [_aenv _aname _aarg _abody]]]
+ (|case ?fun-type*
+ ("lux;AllT" _aenv _aname _aarg _abody)
;; (|do [$var &type/existential
;; type* (&type/apply-type ?fun-type* $var)]
;; (analyse-apply* analyse exo-type type* ?args))
@@ -248,8 +246,8 @@
(fn [$var]
(|do [type* (&type/apply-type ?fun-type* $var)
[=output-t =args] (analyse-apply* analyse exo-type type* ?args)]
- (matchv ::M/objects [$var]
- [["lux;VarT" ?id]]
+ (|case $var
+ ("lux;VarT" ?id)
(|do [? (&type/bound? ?id)
type** (if ?
(&type/clean $var =output-t)
@@ -258,7 +256,7 @@
(return (&/T type** =args)))
))))
- [["lux;LambdaT" [?input-t ?output-t]]]
+ ("lux;LambdaT" ?input-t ?output-t)
(|do [[=output-t =args] (analyse-apply* analyse exo-type ?output-t ?args*)
=arg (&&/analyse-1 analyse ?input-t ?arg)]
(return (&/T =output-t (&/|cons =arg =args))))
@@ -266,19 +264,18 @@
;; [["lux;VarT" ?id-t]]
;; (|do [ (&type/deref ?id-t)])
- [_]
+ _
(fail (str "[Analyser Error] Can't apply a non-function: " (&type/show-type ?fun-type*)))))
))
(defn analyse-apply [analyse exo-type form-cursor =fn ?args]
(|do [loader &/loader]
- (matchv ::M/objects [=fn]
- [[=fn-form =fn-type]]
- (matchv ::M/objects [=fn-form]
- [["lux;Global" [?module ?name]]]
+ (|let [[=fn-form =fn-type] =fn]
+ (|case =fn-form
+ ("lux;Global" ?module ?name)
(|do [[[r-module r-name] $def] (&&module/find-def ?module ?name)]
- (matchv ::M/objects [$def]
- [["lux;MacroD" macro]]
+ (|case $def
+ ("lux;MacroD" macro)
(|do [;; :let [_ (prn 'MACRO-EXPAND|PRE (str r-module ";" r-name))]
macro-expansion #(-> macro (.apply ?args) (.apply %))
;; :let [_ (prn 'MACRO-EXPAND|POST (str r-module ";" r-name))]
@@ -293,12 +290,12 @@
]
(&/flat-map% (partial analyse exo-type) macro-expansion*))
- [_]
+ _
(|do [[=output-t =args] (analyse-apply* analyse exo-type =fn-type ?args)]
(return (&/|list (&/T (&/V "apply" (&/T =fn =args))
=output-t))))))
- [_]
+ _
(|do [[=output-t =args] (analyse-apply* analyse exo-type =fn-type ?args)]
(return (&/|list (&/T (&/V "apply" (&/T =fn =args))
=output-t)))))
@@ -316,8 +313,8 @@
(defn analyse-lambda* [analyse exo-type ?self ?arg ?body]
(|do [exo-type* (&type/actual-type exo-type)]
- (matchv ::M/objects [exo-type]
- [["lux;AllT" _]]
+ (|case exo-type
+ ("lux;AllT" _)
(&type/with-var
(fn [$var]
(|do [exo-type** (&type/apply-type exo-type* $var)]
@@ -326,38 +323,38 @@
;; exo-type** (&type/apply-type exo-type* $var)]
;; (analyse-lambda* analyse exo-type** ?self ?arg ?body))
- [["lux;LambdaT" [?arg-t ?return-t]]]
+ ("lux;LambdaT" ?arg-t ?return-t)
(|do [[=scope =captured =body] (&&lambda/with-lambda ?self exo-type*
?arg ?arg-t
(&&/analyse-1 analyse ?return-t ?body))]
(return (&/T (&/V "lambda" (&/T =scope =captured =body)) exo-type*)))
- [_]
+ _
(fail (str "[Analyser Error] Functions require function types: "
(&type/show-type exo-type*))))))
(defn analyse-lambda** [analyse exo-type ?self ?arg ?body]
- (matchv ::M/objects [exo-type]
- [["lux;AllT" [_env _self _arg _body]]]
+ (|case exo-type
+ ("lux;AllT" _env _self _arg _body)
(&type/with-var
(fn [$var]
(|do [exo-type* (&type/apply-type exo-type $var)
[_expr _] (analyse-lambda** analyse exo-type* ?self ?arg ?body)]
- (matchv ::M/objects [$var]
- [["lux;VarT" ?id]]
+ (|case $var
+ ("lux;VarT" ?id)
(|do [? (&type/bound? ?id)]
(if ?
(|do [dtype (&type/deref ?id)
;; dtype* (&type/actual-type dtype)
]
- (matchv ::M/objects [dtype]
- [["lux;BoundT" ?vname]]
+ (|case dtype
+ ("lux;BoundT" ?vname)
(return (&/T _expr exo-type))
- [["lux;ExT" _]]
+ ("lux;ExT" _)
(return (&/T _expr exo-type))
- [["lux;VarT" ?_id]]
+ ("lux;VarT" ?_id)
(|do [?? (&type/bound? ?_id)]
;; (return (&/T _expr exo-type))
(if ??
@@ -365,11 +362,11 @@
(return (&/T _expr exo-type)))
)
- [_]
+ _
(fail (str "[Analyser Error] Can't use type-var in any type-specific way inside polymorphic functions: " ?id ":" _arg " " (&type/show-type dtype)))))
(return (&/T _expr exo-type))))))))
- [_]
+ _
(|do [exo-type* (&type/actual-type exo-type)]
(analyse-lambda* analyse exo-type* ?self ?arg ?body))
))
@@ -389,15 +386,15 @@
(|do [=value (&/with-scope ?name
(analyse-1+ analyse ?value))
=value-type (&&/expr-type =value)]
- (matchv ::M/objects [=value]
- [[["lux;Global" [?r-module ?r-name]] _]]
+ (|case =value
+ [("lux;Global" ?r-module ?r-name) _]
(|do [_ (&&module/def-alias module-name ?name ?r-module ?r-name =value-type)
;; :let [_ (println 'analyse-def/ALIAS (str module-name ";" ?name) '=> (str ?r-module ";" ?r-name))
;; _ (println)]
]
(return (&/|list)))
- [_]
+ _
(do (println 'DEF (str module-name ";" ?name))
(|do [_ (compile-token (&/V "def" (&/T ?name =value)))]
(return (&/|list)))))
diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj
index 327dad27f..c92b7b976 100644
--- a/src/lux/analyser/module.clj
+++ b/src/lux/analyser/module.clj
@@ -9,9 +9,9 @@
(ns lux.analyser.module
(:refer-clojure :exclude [alias])
(:require [clojure.string :as string]
- [clojure.core.match :as M :refer [matchv]]
+ clojure.core.match
clojure.core.match.array
- (lux [base :as & :refer [|let |do return return* fail fail*]]
+ (lux [base :as & :refer [|let |do return return* fail fail* |case]]
[type :as &type]
[host :as &host])
[lux.analyser.base :as &&]))
@@ -44,8 +44,8 @@
(defn define [module name def-data type]
(fn [state]
- (matchv ::M/objects [(&/get$ &/$ENVS state)]
- [["lux;Cons" [?env ["lux;Nil" _]]]]
+ (|case (&/get$ &/$ENVS state)
+ ("lux;Cons" ?env ("lux;Nil"))
(return* (->> state
(&/update$ &/$MODULES
(fn [ms]
@@ -57,7 +57,7 @@
ms))))
nil)
- [_]
+ _
(fail* (str "[Analyser Error] Can't create a new global definition outside of a global environment: " module ";" name)))))
(defn def-type [module name]
@@ -65,17 +65,17 @@
(fn [state]
(if-let [$module (->> state (&/get$ &/$MODULES) (&/|get module))]
(if-let [$def (->> $module (&/get$ $DEFS) (&/|get name))]
- (matchv ::M/objects [$def]
- [[_ ["lux;TypeD" _]]]
+ (|case $def
+ [_ ("lux;TypeD" _)]
(return* state &type/Type)
- [[_ ["lux;MacroD" _]]]
+ [_ ("lux;MacroD" _)]
(return* state &type/Macro)
- [[_ ["lux;ValueD" [_type _]]]]
+ [_ ("lux;ValueD" _type _)]
(return* state _type)
- [[_ ["lux;AliasD" [?r-module ?r-name]]]]
+ [_ ("lux;AliasD" ?r-module ?r-name)]
(&/run-state (def-type ?r-module ?r-name)
state))
(fail* (str "[Analyser Error] Unknown definition: " (str module ";" name))))
@@ -84,8 +84,8 @@
(defn def-alias [a-module a-name r-module r-name type]
;; (prn 'def-alias [a-module a-name] [r-module r-name] (&type/show-type type))
(fn [state]
- (matchv ::M/objects [(&/get$ &/$ENVS state)]
- [["lux;Cons" [?env ["lux;Nil" _]]]]
+ (|case (&/get$ &/$ENVS state)
+ ("lux;Cons" ?env ("lux;Nil"))
(return* (->> state
(&/update$ &/$MODULES
(fn [ms]
@@ -97,7 +97,7 @@
ms))))
nil)
- [_]
+ _
(fail* "[Analyser Error] Can't alias a global definition outside of a global environment."))))
(defn exists? [name]
@@ -133,17 +133,16 @@
(if-let [$module (->> state (&/get$ &/$MODULES) (&/|get module))]
(do ;; (prn 'find-def/_0.1 module (&/->seq (&/|keys $module)))
(if-let [$def (->> $module (&/get$ $DEFS) (&/|get name))]
- (matchv ::M/objects [$def]
- [[exported? $$def]]
+ (|let [[exported? $$def] $def]
(do ;; (prn 'find-def/_1 module name 'exported? exported? (.equals ^Object current-module module))
(if (or exported? (.equals ^Object current-module module))
- (matchv ::M/objects [$$def]
- [["lux;AliasD" [?r-module ?r-name]]]
+ (|case $$def
+ ("lux;AliasD" ?r-module ?r-name)
(do ;; (prn 'find-def/_2 [module name] [?r-module ?r-name])
((find-def ?r-module ?r-name)
state))
- [_]
+ _
(return* state (&/T (&/T module name) $$def)))
(fail* (str "[Analyser Error] Can't use unexported definition: " (str module &/+name-separator+ name))))))
(fail* (str "[Analyser Error] Definition does not exist: " (str module &/+name-separator+ name)))))
@@ -158,8 +157,8 @@
(fn [state]
(if-let [$module (->> state (&/get$ &/$MODULES) (&/|get module) (&/get$ $DEFS))]
(if-let [$def (&/|get name $module)]
- (matchv ::M/objects [$def]
- [[exported? ["lux;ValueD" [?type _]]]]
+ (|case $def
+ [exported? ("lux;ValueD" ?type _)]
((|do [_ (&type/check &type/Macro ?type)
^ClassLoader loader &/loader
:let [macro (-> (.loadClass loader (str (&host/->module-class module) "." (&/normalize-name name)))
@@ -178,24 +177,24 @@
nil)))
state)
- [[_ ["lux;MacroD" _]]]
+ [_ ("lux;MacroD" _)]
(fail* (str "[Analyser Error] Can't re-declare a macro: " (str module &/+name-separator+ name)))
- [[_ _]]
+ [_ _]
(fail* (str "[Analyser Error] Definition does not have macro type: " (str module &/+name-separator+ name))))
(fail* (str "[Analyser Error] Definition does not exist: " (str module &/+name-separator+ name))))
(fail* (str "[Analyser Error] Module does not exist: " module)))))
(defn export [module name]
(fn [state]
- (matchv ::M/objects [(&/get$ &/$ENVS state)]
- [["lux;Cons" [?env ["lux;Nil" _]]]]
+ (|case (&/get$ &/$ENVS state)
+ ("lux;Cons" ?env ("lux;Nil"))
(if-let [$def (->> state (&/get$ &/$MODULES) (&/|get module) (&/get$ $DEFS) (&/|get name))]
- (matchv ::M/objects [$def]
- [[true _]]
+ (|case $def
+ [true _]
(fail* (str "[Analyser Error] Definition has already been exported: " module ";" name))
- [[false ?data]]
+ [false ?data]
(return* (->> state
(&/update$ &/$MODULES (fn [ms]
(&/|update module (fn [m]
@@ -206,7 +205,7 @@
nil))
(fail* (str "[Analyser Error] Can't export an inexistent definition: " (str module &/+name-separator+ name))))
- [_]
+ _
(fail* "[Analyser Error] Can't export a global definition outside of a global environment."))))
(def defs
@@ -214,22 +213,20 @@
(fn [state]
(return* state
(&/|map (fn [kv]
- (|let [[k v] kv]
- (matchv ::M/objects [v]
- [[?exported? ?def]]
- (do ;; (prn 'defs k ?exported?)
- (matchv ::M/objects [?def]
- [["lux;AliasD" [?r-module ?r-name]]]
- (&/T ?exported? k (str "A" ?r-module ";" ?r-name))
-
- [["lux;MacroD" _]]
- (&/T ?exported? k "M")
-
- [["lux;TypeD" _]]
- (&/T ?exported? k "T")
-
- [_]
- (&/T ?exported? k "V"))))))
+ (|let [[k [?exported? ?def]] kv]
+ (do ;; (prn 'defs k ?exported?)
+ (|case ?def
+ ("lux;AliasD" ?r-module ?r-name)
+ (&/T ?exported? k (str "A" ?r-module ";" ?r-name))
+
+ ("lux;MacroD" _)
+ (&/T ?exported? k "M")
+
+ ("lux;TypeD" _)
+ (&/T ?exported? k "T")
+
+ _
+ (&/T ?exported? k "V")))))
(->> state (&/get$ &/$MODULES) (&/|get module) (&/get$ $DEFS)))))))
(def imports
diff --git a/src/lux/base.clj b/src/lux/base.clj
index 85e8df4d1..bcd113daa 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -12,6 +12,7 @@
clojure.core.match.array))
;; [Tags]
+(def $Nil "lux;Nil")
(def $Cons "lux;Cons")
;; [Fields]
@@ -73,10 +74,33 @@
(defn return* [state value]
(V "lux;Right" (T state value)))
+(defn transform-pattern [pattern]
+ (cond (vector? pattern) (mapv transform-pattern pattern)
+ (seq? pattern) (let [parts (mapv transform-pattern (rest pattern))]
+ (vec (cons (eval (first pattern))
+ (list (case (count parts)
+ 0 '_
+ 1 (first parts)
+ ;; else
+ `[~@parts])))))
+ :else pattern
+ ))
+
+(defmacro |case [value & branches]
+ (assert (= 0 (mod (count branches) 2)))
+ (let [value* (if (vector? value)
+ [`(T ~@value)]
+ [value])]
+ `(matchv ::M/objects ~value*
+ ~@(mapcat (fn [[pattern body]]
+ (list [(transform-pattern pattern)]
+ body))
+ (partition 2 branches)))))
+
(defmacro |let [bindings body]
(reduce (fn [inner [left right]]
- `(matchv ::M/objects [~right]
- [~left]
+ `(|case ~right
+ ~left
~inner))
body
(reverse (partition 2 bindings))))
@@ -94,59 +118,62 @@
(reverse (partition 2 elems))))
(defn |get [slot table]
- (matchv ::M/objects [table]
- [["lux;Nil" _]]
+ (|case table
+ ($Nil)
nil
- [["lux;Cons" [[k v] table*]]]
+ ($Cons [k v] table*)
(if (.equals ^Object k slot)
v
(|get slot table*))))
(defn |put [slot value table]
- (matchv ::M/objects [table]
- [["lux;Nil" _]]
+ (|case table
+ ($Nil)
(V "lux;Cons" (T (T slot value) (V "lux;Nil" nil)))
- [["lux;Cons" [[k v] table*]]]
+ ($Cons [k v] table*)
(if (.equals ^Object k slot)
(V "lux;Cons" (T (T slot value) table*))
- (V "lux;Cons" (T (T k v) (|put slot value table*))))))
+ (V "lux;Cons" (T (T k v) (|put slot value table*))))
+
+ _
+ (assert false (prn-str '|put (aget table 0)))))
(defn |remove [slot table]
- (matchv ::M/objects [table]
- [["lux;Nil" _]]
+ (|case table
+ ($Nil)
table
- [["lux;Cons" [[k v] table*]]]
+ ($Cons [k v] table*)
(if (.equals ^Object k slot)
table*
(V "lux;Cons" (T (T k v) (|remove slot table*))))))
(defn |update [k f table]
- (matchv ::M/objects [table]
- [["lux;Nil" _]]
+ (|case table
+ ($Nil)
table
- [["lux;Cons" [[k* v] table*]]]
+ ($Cons [k* v] table*)
(if (.equals ^Object k k*)
(V "lux;Cons" (T (T k* (f v)) table*))
(V "lux;Cons" (T (T k* v) (|update k f table*))))))
(defn |head [xs]
- (matchv ::M/objects [xs]
- [["lux;Nil" _]]
+ (|case xs
+ ($Nil)
(assert false)
- [["lux;Cons" [x _]]]
+ ($Cons x _)
x))
(defn |tail [xs]
- (matchv ::M/objects [xs]
- [["lux;Nil" _]]
+ (|case xs
+ ($Nil)
(assert false)
- [["lux;Cons" [_ xs*]]]
+ ($Cons _ xs*)
xs*))
;; [Resources/Monads]
@@ -161,11 +188,11 @@
(defn bind [m-value step]
(fn [state]
(let [inputs (m-value state)]
- (matchv ::M/objects [inputs]
- [["lux;Right" [?state ?datum]]]
+ (|case inputs
+ ("lux;Right" ?state ?datum)
((step ?datum) ?state)
- [["lux;Left" _]]
+ ("lux;Left" _)
inputs
))))
@@ -177,8 +204,8 @@
;; else
`(bind ~computation
(fn [val#]
- (matchv ::M/objects [val#]
- [~label]
+ (|case val#
+ ~label
~inner)))))
return
(reverse (partition 2 steps))))
@@ -188,90 +215,90 @@
(V "lux;Cons" (T head tail)))
(defn |++ [xs ys]
- (matchv ::M/objects [xs]
- [["lux;Nil" _]]
+ (|case xs
+ ($Nil)
ys
- [["lux;Cons" [x xs*]]]
+ ($Cons x xs*)
(V "lux;Cons" (T x (|++ xs* ys)))))
(defn |map [f xs]
- (matchv ::M/objects [xs]
- [["lux;Nil" _]]
+ (|case xs
+ ($Nil)
xs
- [["lux;Cons" [x xs*]]]
+ ($Cons x xs*)
(V "lux;Cons" (T (f x) (|map f xs*)))))
(defn |empty? [xs]
- (matchv ::M/objects [xs]
- [["lux;Nil" _]]
+ (|case xs
+ ($Nil)
true
- [["lux;Cons" [_ _]]]
+ ($Cons _ _)
false))
(defn |filter [p xs]
- (matchv ::M/objects [xs]
- [["lux;Nil" _]]
+ (|case xs
+ ($Nil)
xs
- [["lux;Cons" [x xs*]]]
+ ($Cons x xs*)
(if (p x)
(V "lux;Cons" (T x (|filter p xs*)))
(|filter p xs*))))
(defn flat-map [f xs]
- (matchv ::M/objects [xs]
- [["lux;Nil" _]]
+ (|case xs
+ ($Nil)
xs
- [["lux;Cons" [x xs*]]]
+ ($Cons x xs*)
(|++ (f x) (flat-map f xs*))))
(defn |split-with [p xs]
- (matchv ::M/objects [xs]
- [["lux;Nil" _]]
+ (|case xs
+ ($Nil)
(T xs xs)
- [["lux;Cons" [x xs*]]]
+ ($Cons x xs*)
(if (p x)
(|let [[pre post] (|split-with p xs*)]
(T (|cons x pre) post))
(T (V "lux;Nil" nil) xs))))
(defn |contains? [k table]
- (matchv ::M/objects [table]
- [["lux;Nil" _]]
+ (|case table
+ ($Nil)
false
- [["lux;Cons" [[k* _] table*]]]
+ ($Cons [k* _] table*)
(or (.equals ^Object k k*)
(|contains? k table*))))
(defn fold [f init xs]
- (matchv ::M/objects [xs]
- [["lux;Nil" _]]
+ (|case xs
+ ($Nil)
init
- [["lux;Cons" [x xs*]]]
+ ($Cons x xs*)
(fold f (f init x) xs*)))
(defn fold% [f init xs]
- (matchv ::M/objects [xs]
- [["lux;Nil" _]]
+ (|case xs
+ ($Nil)
(return init)
- [["lux;Cons" [x xs*]]]
+ ($Cons x xs*)
(|do [init* (f init x)]
(fold% f init* xs*))))
(defn folds [f init xs]
- (matchv ::M/objects [xs]
- [["lux;Nil" _]]
+ (|case xs
+ ($Nil)
(|list init)
- [["lux;Cons" [x xs*]]]
+ ($Cons x xs*)
(|cons init (folds f (f init x) xs*))))
(defn |length [xs]
@@ -293,47 +320,47 @@
_2))
(defn zip2 [xs ys]
- (matchv ::M/objects [xs ys]
- [["lux;Cons" [x xs*]] ["lux;Cons" [y ys*]]]
+ (|case [xs ys]
+ [($Cons x xs*) ($Cons y ys*)]
(V "lux;Cons" (T (T x y) (zip2 xs* ys*)))
[_ _]
(V "lux;Nil" nil)))
(defn |keys [plist]
- (matchv ::M/objects [plist]
- [["lux;Nil" _]]
+ (|case plist
+ ($Nil)
(|list)
- [["lux;Cons" [[k v] plist*]]]
+ ($Cons [k v] plist*)
(|cons k (|keys plist*))))
(defn |vals [plist]
- (matchv ::M/objects [plist]
- [["lux;Nil" _]]
+ (|case plist
+ ($Nil)
(|list)
- [["lux;Cons" [[k v] plist*]]]
+ ($Cons [k v] plist*)
(|cons v (|vals plist*))))
(defn |interpose [sep xs]
- (matchv ::M/objects [xs]
- [["lux;Nil" _]]
+ (|case xs
+ ($Nil)
xs
- [["lux;Cons" [_ ["lux;Nil" _]]]]
+ ($Cons _ ($Nil))
xs
- [["lux;Cons" [x xs*]]]
+ ($Cons x xs*)
(V "lux;Cons" (T x (V "lux;Cons" (T sep (|interpose sep xs*)))))))
(do-template [<name> <joiner>]
(defn <name> [f xs]
- (matchv ::M/objects [xs]
- [["lux;Nil" _]]
+ (|case xs
+ ($Nil)
(return xs)
- [["lux;Cons" [x xs*]]]
+ ($Cons x xs*)
(|do [y (f x)
ys (<name> f xs*)]
(return (<joiner> y ys)))))
@@ -345,11 +372,11 @@
(fold |++ (V "lux;Nil" nil) xss))
(defn |as-pairs [xs]
- (matchv ::M/objects [xs]
- [["lux;Cons" [x ["lux;Cons" [y xs*]]]]]
+ (|case xs
+ ($Cons x ($Cons y xs*))
(V "lux;Cons" (T (T x y) (|as-pairs xs*)))
- [_]
+ _
(V "lux;Nil" nil)))
(defn |reverse [xs]
@@ -368,18 +395,18 @@
(return* state state)))
(defn try-all% [monads]
- (matchv ::M/objects [monads]
- [["lux;Nil" _]]
+ (|case monads
+ ($Nil)
(fail "There are no alternatives to try!")
- [["lux;Cons" [m monads*]]]
+ ($Cons m monads*)
(fn [state]
(let [output (m state)]
- (matchv ::M/objects [output monads*]
- [["lux;Right" _] _]
+ (|case [output monads*]
+ [("lux;Right" _) _]
output
- [_ ["lux;Nil" _]]
+ [_ ($Nil)]
output
[_ _]
@@ -395,11 +422,11 @@
(defn exhaust% [step]
(fn [state]
- (matchv ::M/objects [(step state)]
- [["lux;Right" [state* _]]]
+ (|case (step state)
+ ("lux;Right" state* _)
((exhaust% step) state*)
- [["lux;Left" msg]]
+ ("lux;Left" msg)
(if (.equals "[Reader Error] EOF" msg)
(return* state nil)
(fail* msg)))))
@@ -510,23 +537,23 @@
(defn save-module [body]
(fn [state]
- (matchv ::M/objects [(body state)]
- [["lux;Right" [state* output]]]
+ (|case (body state)
+ ("lux;Right" state* output)
(return* (->> state*
(set$ $ENVS (get$ $ENVS state))
(set$ $SOURCE (get$ $SOURCE state)))
output)
- [["lux;Left" msg]]
+ ("lux;Left" msg)
(fail* msg))))
(defn with-eval [body]
(fn [state]
- (matchv ::M/objects [(body (set$ $EVAL? true state))]
- [["lux;Right" [state* output]]]
+ (|case (body (set$ $EVAL? true state))
+ ("lux;Right" state* output)
(return* (set$ $EVAL? (get$ $EVAL? state) state*) output)
- [["lux;Left" msg]]
+ ("lux;Left" msg)
(fail* msg))))
(def get-eval
@@ -536,11 +563,11 @@
(def get-writer
(fn [state]
(let [writer* (->> state (get$ $HOST) (get$ $WRITER))]
- (matchv ::M/objects [writer*]
- [["lux;Some" datum]]
+ (|case writer*
+ ("lux;Some" datum)
(return* state datum)
- [_]
+ _
(fail* "Writer hasn't been set.")))))
(def get-top-local-env
@@ -556,11 +583,11 @@
(return* (set$ $SEED (inc seed) state) seed))))
(defn ->seq [xs]
- (matchv ::M/objects [xs]
- [["lux;Nil" _]]
+ (|case xs
+ ($Nil)
(list)
- [["lux;Cons" [x xs*]]]
+ ($Cons x xs*)
(cons x (->seq xs*))))
(defn ->list [seq]
@@ -575,21 +602,21 @@
(def get-module-name
(fn [state]
- (matchv ::M/objects [(|reverse (get$ $ENVS state))]
- [["lux;Nil"]]
+ (|case (|reverse (get$ $ENVS state))
+ ($Nil)
(fail* "[Analyser Error] Can't get the module-name without a module.")
- [["lux;Cons" [?global _]]]
+ ($Cons ?global _)
(return* state (get$ $NAME ?global)))))
(defn with-scope [name body]
(fn [state]
(let [output (body (update$ $ENVS #(|cons (env name) %) state))]
- (matchv ::M/objects [output]
- [["lux;Right" [state* datum]]]
+ (|case output
+ ("lux;Right" state* datum)
(return* (update$ $ENVS |tail state*) datum)
- [_]
+ _
output))))
(defn run-state [monad state]
@@ -611,24 +638,24 @@
(defn with-writer [writer body]
(fn [state]
(let [output (body (update$ $HOST #(set$ $WRITER (V "lux;Some" writer) %) state))]
- (matchv ::M/objects [output]
- [["lux;Right" [?state ?value]]]
+ (|case output
+ ("lux;Right" ?state ?value)
(return* (update$ $HOST #(set$ $WRITER (->> state (get$ $HOST) (get$ $WRITER)) %) ?state)
?value)
- [_]
+ _
output))))
(defn with-expected-type [type body]
"(All [a] (-> Type (Lux a)))"
(fn [state]
(let [output (body (set$ $EXPECTED type state))]
- (matchv ::M/objects [output]
- [["lux;Right" [?state ?value]]]
+ (|case output
+ ("lux;Right" ?state ?value)
(return* (set$ $EXPECTED (get$ $EXPECTED state) ?state)
?value)
- [_]
+ _
output))))
(defn with-cursor [cursor body]
@@ -637,50 +664,50 @@
body
(fn [state]
(let [output (body (set$ $cursor cursor state))]
- (matchv ::M/objects [output]
- [["lux;Right" [?state ?value]]]
+ (|case output
+ ("lux;Right" ?state ?value)
(return* (set$ $cursor (get$ $cursor state) ?state)
?value)
- [_]
+ _
output)))))
(defn show-ast [ast]
- (matchv ::M/objects [ast]
- [["lux;Meta" [_ ["lux;BoolS" ?value]]]]
+ (|case ast
+ ("lux;Meta" _ ["lux;BoolS" ?value])
(pr-str ?value)
- [["lux;Meta" [_ ["lux;IntS" ?value]]]]
+ ("lux;Meta" _ ["lux;IntS" ?value])
(pr-str ?value)
- [["lux;Meta" [_ ["lux;RealS" ?value]]]]
+ ("lux;Meta" _ ["lux;RealS" ?value])
(pr-str ?value)
- [["lux;Meta" [_ ["lux;CharS" ?value]]]]
+ ("lux;Meta" _ ["lux;CharS" ?value])
(pr-str ?value)
- [["lux;Meta" [_ ["lux;TextS" ?value]]]]
+ ("lux;Meta" _ ["lux;TextS" ?value])
(str "\"" ?value "\"")
- [["lux;Meta" [_ ["lux;TagS" [?module ?tag]]]]]
+ ("lux;Meta" _ ["lux;TagS" ?module ?tag])
(str "#" ?module ";" ?tag)
- [["lux;Meta" [_ ["lux;SymbolS" [?module ?ident]]]]]
+ ("lux;Meta" _ ["lux;SymbolS" ?module ?ident])
(if (.equals "" ?module)
?ident
(str ?module ";" ?ident))
- [["lux;Meta" [_ ["lux;TupleS" ?elems]]]]
+ ("lux;Meta" _ ["lux;TupleS" ?elems])
(str "[" (->> ?elems (|map show-ast) (|interpose " ") (fold str "")) "]")
- [["lux;Meta" [_ ["lux;RecordS" ?elems]]]]
+ ("lux;Meta" _ ["lux;RecordS" ?elems])
(str "{" (->> ?elems
(|map (fn [elem]
(|let [[k v] elem]
(str (show-ast k) " " (show-ast v)))))
(|interpose " ") (fold str "")) "}")
- [["lux;Meta" [_ ["lux;FormS" ?elems]]]]
+ ("lux;Meta" _ ["lux;FormS" ?elems])
(str "(" (->> ?elems (|map show-ast) (|interpose " ") (fold str "")) ")")
))
@@ -689,57 +716,57 @@
(str ?module ";" ?name)))
(defn fold2% [f init xs ys]
- (matchv ::M/objects [xs ys]
- [["lux;Cons" [x xs*]] ["lux;Cons" [y ys*]]]
+ (|case [xs ys]
+ [($Cons x xs*) ($Cons y ys*)]
(|do [init* (f init x y)]
(fold2% f init* xs* ys*))
- [["lux;Nil" _] ["lux;Nil" _]]
+ [($Nil) ($Nil)]
(return init)
[_ _]
(fail "Lists don't match in size.")))
(defn map2% [f xs ys]
- (matchv ::M/objects [xs ys]
- [["lux;Cons" [x xs*]] ["lux;Cons" [y ys*]]]
+ (|case [xs ys]
+ [($Cons x xs*) ($Cons y ys*)]
(|do [z (f x y)
zs (map2% f xs* ys*)]
(return (|cons z zs)))
- [["lux;Nil" _] ["lux;Nil" _]]
+ [($Nil) ($Nil)]
(return (V "lux;Nil" nil))
[_ _]
(fail "Lists don't match in size.")))
(defn map2 [f xs ys]
- (matchv ::M/objects [xs ys]
- [["lux;Cons" [x xs*]] ["lux;Cons" [y ys*]]]
+ (|case [xs ys]
+ [($Cons x xs*) ($Cons y ys*)]
(|cons (f x y) (map2 f xs* ys*))
[_ _]
(V "lux;Nil" nil)))
(defn fold2 [f init xs ys]
- (matchv ::M/objects [xs ys]
- [["lux;Cons" [x xs*]] ["lux;Cons" [y ys*]]]
+ (|case [xs ys]
+ [($Cons x xs*) ($Cons y ys*)]
(and init
(fold2 f (f init x y) xs* ys*))
- [["lux;Nil" _] ["lux;Nil" _]]
+ [($Nil) ($Nil)]
init
[_ _]
false))
(defn ^:private enumerate* [idx xs]
- (matchv ::M/objects [xs]
- [["lux;Cons" [x xs*]]]
+ (|case xs
+ ($Cons x xs*)
(V "lux;Cons" (T (T idx x)
(enumerate* (inc idx) xs*)))
- [["lux;Nil" _]]
+ ($Nil)
xs
))
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 4c12f9519..7463bdce7 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -11,9 +11,9 @@
(:require (clojure [string :as string]
[set :as set]
[template :refer [do-template]])
- [clojure.core.match :as M :refer [matchv]]
+ clojure.core.match
clojure.core.match.array
- (lux [base :as & :refer [|let |do return* return fail fail*]]
+ (lux [base :as & :refer [|let |do return* return fail fail* |case]]
[type :as &type]
[reader :as &reader]
[lexer :as &lexer]
@@ -38,327 +38,338 @@
;; [Utils/Compilers]
(defn ^:private compile-expression [syntax]
- (matchv ::M/objects [syntax]
- [[?form ?type]]
- (matchv ::M/objects [?form]
- [["bool" ?value]]
+ (|let [[?form ?type] syntax]
+ (|case ?form
+ ("bool" ?value)
(&&lux/compile-bool compile-expression ?type ?value)
- [["int" ?value]]
+ ("int" ?value)
(&&lux/compile-int compile-expression ?type ?value)
- [["real" ?value]]
+ ("real" ?value)
(&&lux/compile-real compile-expression ?type ?value)
- [["char" ?value]]
+ ("char" ?value)
(&&lux/compile-char compile-expression ?type ?value)
- [["text" ?value]]
+ ("text" ?value)
(&&lux/compile-text compile-expression ?type ?value)
- [["tuple" ?elems]]
+ ("tuple" ?elems)
(&&lux/compile-tuple compile-expression ?type ?elems)
- [["record" ?elems]]
+ ("record" ?elems)
(&&lux/compile-record compile-expression ?type ?elems)
- [["lux;Local" ?idx]]
+ ("lux;Local" ?idx)
(&&lux/compile-local compile-expression ?type ?idx)
- [["captured" [?scope ?captured-id ?source]]]
+ ("captured" ?scope ?captured-id ?source)
(&&lux/compile-captured compile-expression ?type ?scope ?captured-id ?source)
- [["lux;Global" [?owner-class ?name]]]
+ ("lux;Global" ?owner-class ?name)
(&&lux/compile-global compile-expression ?type ?owner-class ?name)
- [["apply" [?fn ?args]]]
+ ("apply" ?fn ?args)
(&&lux/compile-apply compile-expression ?type ?fn ?args)
- [["variant" [?tag ?members]]]
+ ("variant" ?tag ?members)
(&&lux/compile-variant compile-expression ?type ?tag ?members)
- [["case" [?value ?match]]]
+ ("case" ?value ?match)
(&&case/compile-case compile-expression ?type ?value ?match)
- [["lambda" [?scope ?env ?body]]]
+ ("lambda" ?scope ?env ?body)
(&&lambda/compile-lambda compile-expression ?scope ?env ?body)
- [["ann" [?value-ex ?type-ex]]]
+ ("ann" ?value-ex ?type-ex)
(&&lux/compile-ann compile-expression ?type ?value-ex ?type-ex)
;; Characters
- [["jvm-ceq" [?x ?y]]]
+ ("jvm-ceq" ?x ?y)
(&&host/compile-jvm-ceq compile-expression ?type ?x ?y)
- [["jvm-clt" [?x ?y]]]
+ ("jvm-clt" ?x ?y)
(&&host/compile-jvm-clt compile-expression ?type ?x ?y)
- [["jvm-cgt" [?x ?y]]]
+ ("jvm-cgt" ?x ?y)
(&&host/compile-jvm-cgt compile-expression ?type ?x ?y)
;; Integer arithmetic
- [["jvm-iadd" [?x ?y]]]
+ ("jvm-iadd" ?x ?y)
(&&host/compile-jvm-iadd compile-expression ?type ?x ?y)
- [["jvm-isub" [?x ?y]]]
+ ("jvm-isub" ?x ?y)
(&&host/compile-jvm-isub compile-expression ?type ?x ?y)
- [["jvm-imul" [?x ?y]]]
+ ("jvm-imul" ?x ?y)
(&&host/compile-jvm-imul compile-expression ?type ?x ?y)
- [["jvm-idiv" [?x ?y]]]
+ ("jvm-idiv" ?x ?y)
(&&host/compile-jvm-idiv compile-expression ?type ?x ?y)
- [["jvm-irem" [?x ?y]]]
+ ("jvm-irem" ?x ?y)
(&&host/compile-jvm-irem compile-expression ?type ?x ?y)
- [["jvm-ieq" [?x ?y]]]
+ ("jvm-ieq" ?x ?y)
(&&host/compile-jvm-ieq compile-expression ?type ?x ?y)
- [["jvm-ilt" [?x ?y]]]
+ ("jvm-ilt" ?x ?y)
(&&host/compile-jvm-ilt compile-expression ?type ?x ?y)
- [["jvm-igt" [?x ?y]]]
+ ("jvm-igt" ?x ?y)
(&&host/compile-jvm-igt compile-expression ?type ?x ?y)
;; Long arithmetic
- [["jvm-ladd" [?x ?y]]]
+ ("jvm-ladd" ?x ?y)
(&&host/compile-jvm-ladd compile-expression ?type ?x ?y)
- [["jvm-lsub" [?x ?y]]]
+ ("jvm-lsub" ?x ?y)
(&&host/compile-jvm-lsub compile-expression ?type ?x ?y)
- [["jvm-lmul" [?x ?y]]]
+ ("jvm-lmul" ?x ?y)
(&&host/compile-jvm-lmul compile-expression ?type ?x ?y)
- [["jvm-ldiv" [?x ?y]]]
+ ("jvm-ldiv" ?x ?y)
(&&host/compile-jvm-ldiv compile-expression ?type ?x ?y)
- [["jvm-lrem" [?x ?y]]]
+ ("jvm-lrem" ?x ?y)
(&&host/compile-jvm-lrem compile-expression ?type ?x ?y)
- [["jvm-leq" [?x ?y]]]
+ ("jvm-leq" ?x ?y)
(&&host/compile-jvm-leq compile-expression ?type ?x ?y)
- [["jvm-llt" [?x ?y]]]
+ ("jvm-llt" ?x ?y)
(&&host/compile-jvm-llt compile-expression ?type ?x ?y)
- [["jvm-lgt" [?x ?y]]]
+ ("jvm-lgt" ?x ?y)
(&&host/compile-jvm-lgt compile-expression ?type ?x ?y)
;; Float arithmetic
- [["jvm-fadd" [?x ?y]]]
+ ("jvm-fadd" ?x ?y)
(&&host/compile-jvm-fadd compile-expression ?type ?x ?y)
- [["jvm-fsub" [?x ?y]]]
+ ("jvm-fsub" ?x ?y)
(&&host/compile-jvm-fsub compile-expression ?type ?x ?y)
- [["jvm-fmul" [?x ?y]]]
+ ("jvm-fmul" ?x ?y)
(&&host/compile-jvm-fmul compile-expression ?type ?x ?y)
- [["jvm-fdiv" [?x ?y]]]
+ ("jvm-fdiv" ?x ?y)
(&&host/compile-jvm-fdiv compile-expression ?type ?x ?y)
- [["jvm-frem" [?x ?y]]]
+ ("jvm-frem" ?x ?y)
(&&host/compile-jvm-frem compile-expression ?type ?x ?y)
- [["jvm-feq" [?x ?y]]]
+ ("jvm-feq" ?x ?y)
(&&host/compile-jvm-feq compile-expression ?type ?x ?y)
- [["jvm-flt" [?x ?y]]]
+ ("jvm-flt" ?x ?y)
(&&host/compile-jvm-flt compile-expression ?type ?x ?y)
- [["jvm-fgt" [?x ?y]]]
+ ("jvm-fgt" ?x ?y)
(&&host/compile-jvm-fgt compile-expression ?type ?x ?y)
;; Double arithmetic
- [["jvm-dadd" [?x ?y]]]
+ ("jvm-dadd" ?x ?y)
(&&host/compile-jvm-dadd compile-expression ?type ?x ?y)
- [["jvm-dsub" [?x ?y]]]
+ ("jvm-dsub" ?x ?y)
(&&host/compile-jvm-dsub compile-expression ?type ?x ?y)
- [["jvm-dmul" [?x ?y]]]
+ ("jvm-dmul" ?x ?y)
(&&host/compile-jvm-dmul compile-expression ?type ?x ?y)
- [["jvm-ddiv" [?x ?y]]]
+ ("jvm-ddiv" ?x ?y)
(&&host/compile-jvm-ddiv compile-expression ?type ?x ?y)
- [["jvm-drem" [?x ?y]]]
+ ("jvm-drem" ?x ?y)
(&&host/compile-jvm-drem compile-expression ?type ?x ?y)
- [["jvm-deq" [?x ?y]]]
+ ("jvm-deq" ?x ?y)
(&&host/compile-jvm-deq compile-expression ?type ?x ?y)
- [["jvm-dlt" [?x ?y]]]
+ ("jvm-dlt" ?x ?y)
(&&host/compile-jvm-dlt compile-expression ?type ?x ?y)
- [["jvm-dgt" [?x ?y]]]
+ ("jvm-dgt" ?x ?y)
(&&host/compile-jvm-dgt compile-expression ?type ?x ?y)
- [["jvm-null" _]]
+ ("jvm-null" _)
(&&host/compile-jvm-null compile-expression ?type)
- [["jvm-null?" ?object]]
+ ("jvm-null?" ?object)
(&&host/compile-jvm-null? compile-expression ?type ?object)
- [["jvm-new" [?class ?classes ?args]]]
+ ("jvm-new" ?class ?classes ?args)
(&&host/compile-jvm-new compile-expression ?type ?class ?classes ?args)
- [["jvm-getstatic" [?class ?field]]]
+ ("jvm-getstatic" ?class ?field)
(&&host/compile-jvm-getstatic compile-expression ?type ?class ?field)
- [["jvm-getfield" [?class ?field ?object]]]
+ ("jvm-getfield" ?class ?field ?object)
(&&host/compile-jvm-getfield compile-expression ?type ?class ?field ?object)
- [["jvm-putstatic" [?class ?field ?value]]]
+ ("jvm-putstatic" ?class ?field ?value)
(&&host/compile-jvm-putstatic compile-expression ?type ?class ?field ?value)
- [["jvm-putfield" [?class ?field ?object ?value]]]
+ ("jvm-putfield" ?class ?field ?object ?value)
(&&host/compile-jvm-putfield compile-expression ?type ?class ?field ?object ?value)
- [["jvm-invokestatic" [?class ?method ?classes ?args]]]
+ ("jvm-invokestatic" ?class ?method ?classes ?args)
(&&host/compile-jvm-invokestatic compile-expression ?type ?class ?method ?classes ?args)
- [["jvm-invokevirtual" [?class ?method ?classes ?object ?args]]]
+ ("jvm-invokevirtual" ?class ?method ?classes ?object ?args)
(&&host/compile-jvm-invokevirtual compile-expression ?type ?class ?method ?classes ?object ?args)
- [["jvm-invokeinterface" [?class ?method ?classes ?object ?args]]]
+ ("jvm-invokeinterface" ?class ?method ?classes ?object ?args)
(&&host/compile-jvm-invokeinterface compile-expression ?type ?class ?method ?classes ?object ?args)
- [["jvm-invokespecial" [?class ?method ?classes ?object ?args]]]
+ ("jvm-invokespecial" ?class ?method ?classes ?object ?args)
(&&host/compile-jvm-invokespecial compile-expression ?type ?class ?method ?classes ?object ?args)
- [["jvm-new-array" [?class ?length]]]
+ ("jvm-new-array" ?class ?length)
(&&host/compile-jvm-new-array compile-expression ?type ?class ?length)
- [["jvm-aastore" [?array ?idx ?elem]]]
+ ("jvm-aastore" ?array ?idx ?elem)
(&&host/compile-jvm-aastore compile-expression ?type ?array ?idx ?elem)
- [["jvm-aaload" [?array ?idx]]]
+ ("jvm-aaload" ?array ?idx)
(&&host/compile-jvm-aaload compile-expression ?type ?array ?idx)
- [["jvm-try" [?body ?catches ?finally]]]
+ ("jvm-try" ?body ?catches ?finally)
(&&host/compile-jvm-try compile-expression ?type ?body ?catches ?finally)
- [["jvm-throw" ?ex]]
+ ("jvm-throw" ?ex)
(&&host/compile-jvm-throw compile-expression ?type ?ex)
- [["jvm-monitorenter" ?monitor]]
+ ("jvm-monitorenter" ?monitor)
(&&host/compile-jvm-monitorenter compile-expression ?type ?monitor)
- [["jvm-monitorexit" ?monitor]]
+ ("jvm-monitorexit" ?monitor)
(&&host/compile-jvm-monitorexit compile-expression ?type ?monitor)
- [["jvm-d2f" ?value]]
+ ("jvm-d2f" ?value)
(&&host/compile-jvm-d2f compile-expression ?type ?value)
- [["jvm-d2i" ?value]]
+ ("jvm-d2i" ?value)
(&&host/compile-jvm-d2i compile-expression ?type ?value)
- [["jvm-d2l" ?value]]
+ ("jvm-d2l" ?value)
(&&host/compile-jvm-d2l compile-expression ?type ?value)
- [["jvm-f2d" ?value]]
+ ("jvm-f2d" ?value)
(&&host/compile-jvm-f2d compile-expression ?type ?value)
- [["jvm-f2i" ?value]]
+ ("jvm-f2i" ?value)
(&&host/compile-jvm-f2i compile-expression ?type ?value)
- [["jvm-f2l" ?value]]
+ ("jvm-f2l" ?value)
(&&host/compile-jvm-f2l compile-expression ?type ?value)
- [["jvm-i2b" ?value]]
+ ("jvm-i2b" ?value)
(&&host/compile-jvm-i2b compile-expression ?type ?value)
- [["jvm-i2c" ?value]]
+ ("jvm-i2c" ?value)
(&&host/compile-jvm-i2c compile-expression ?type ?value)
- [["jvm-i2d" ?value]]
+ ("jvm-i2d" ?value)
(&&host/compile-jvm-i2d compile-expression ?type ?value)
- [["jvm-i2f" ?value]]
+ ("jvm-i2f" ?value)
(&&host/compile-jvm-i2f compile-expression ?type ?value)
- [["jvm-i2l" ?value]]
+ ("jvm-i2l" ?value)
(&&host/compile-jvm-i2l compile-expression ?type ?value)
- [["jvm-i2s" ?value]]
+ ("jvm-i2s" ?value)
(&&host/compile-jvm-i2s compile-expression ?type ?value)
- [["jvm-l2d" ?value]]
+ ("jvm-l2d" ?value)
(&&host/compile-jvm-l2d compile-expression ?type ?value)
- [["jvm-l2f" ?value]]
+ ("jvm-l2f" ?value)
(&&host/compile-jvm-l2f compile-expression ?type ?value)
- [["jvm-l2i" ?value]]
+ ("jvm-l2i" ?value)
(&&host/compile-jvm-l2i compile-expression ?type ?value)
- [["jvm-iand" [?x ?y]]]
+ ("jvm-iand" ?x ?y)
(&&host/compile-jvm-iand compile-expression ?type ?x ?y)
- [["jvm-ior" [?x ?y]]]
+ ("jvm-ior" ?x ?y)
(&&host/compile-jvm-ior compile-expression ?type ?x ?y)
- [["jvm-land" [?x ?y]]]
+ ("jvm-ixor" ?x ?y)
+ (&&host/compile-jvm-ixor compile-expression ?type ?x ?y)
+
+ ("jvm-ishl" ?x ?y)
+ (&&host/compile-jvm-ishl compile-expression ?type ?x ?y)
+
+ ("jvm-ishr" ?x ?y)
+ (&&host/compile-jvm-ishr compile-expression ?type ?x ?y)
+
+ ("jvm-iushr" ?x ?y)
+ (&&host/compile-jvm-iushr compile-expression ?type ?x ?y)
+
+ ("jvm-land" ?x ?y)
(&&host/compile-jvm-land compile-expression ?type ?x ?y)
- [["jvm-lor" [?x ?y]]]
+ ("jvm-lor" ?x ?y)
(&&host/compile-jvm-lor compile-expression ?type ?x ?y)
- [["jvm-lxor" [?x ?y]]]
+ ("jvm-lxor" ?x ?y)
(&&host/compile-jvm-lxor compile-expression ?type ?x ?y)
- [["jvm-lshl" [?x ?y]]]
+ ("jvm-lshl" ?x ?y)
(&&host/compile-jvm-lshl compile-expression ?type ?x ?y)
- [["jvm-lshr" [?x ?y]]]
+ ("jvm-lshr" ?x ?y)
(&&host/compile-jvm-lshr compile-expression ?type ?x ?y)
- [["jvm-lushr" [?x ?y]]]
+ ("jvm-lushr" ?x ?y)
(&&host/compile-jvm-lushr compile-expression ?type ?x ?y)
- [["jvm-instanceof" [?class ?object]]]
+ ("jvm-instanceof" ?class ?object)
(&&host/compile-jvm-instanceof compile-expression ?type ?class ?object)
)
))
(defn ^:private compile-statement [syntax]
- (matchv ::M/objects [syntax]
- [["def" [?name ?body]]]
+ (|case syntax
+ ("def" ?name ?body)
(&&lux/compile-def compile-expression ?name ?body)
- [["declare-macro" [?module ?name]]]
+ ("declare-macro" ?module ?name)
(&&lux/compile-declare-macro compile-expression ?module ?name)
- [["jvm-program" ?body]]
+ ("jvm-program" ?body)
(&&host/compile-jvm-program compile-expression ?body)
- [["jvm-interface" [?name ?supers ?methods]]]
+ ("jvm-interface" ?name ?supers ?methods)
(&&host/compile-jvm-interface compile-expression ?name ?supers ?methods)
- [["jvm-class" [?name ?super-class ?interfaces ?fields ?methods]]]
+ ("jvm-class" ?name ?super-class ?interfaces ?fields ?methods)
(&&host/compile-jvm-class compile-expression ?name ?super-class ?interfaces ?fields ?methods)))
(defn ^:private compile-token [syntax]
- (matchv ::M/objects [syntax]
- [["def" [?name ?body]]]
+ (|case syntax
+ ("def" ?name ?body)
(&&lux/compile-def compile-expression ?name ?body)
- [["declare-macro" [?module ?name]]]
+ ("declare-macro" ?module ?name)
(&&lux/compile-declare-macro compile-expression ?module ?name)
- [["jvm-program" ?body]]
+ ("jvm-program" ?body)
(&&host/compile-jvm-program compile-expression ?body)
- [["jvm-interface" [?name ?supers ?methods]]]
+ ("jvm-interface" ?name ?supers ?methods)
(&&host/compile-jvm-interface compile-expression ?name ?supers ?methods)
- [["jvm-class" [?name ?super-class ?interfaces ?fields ?methods]]]
+ ("jvm-class" ?name ?super-class ?interfaces ?fields ?methods)
(&&host/compile-jvm-class compile-expression ?name ?super-class ?interfaces ?fields ?methods)
- [_]
+ _
(compile-expression syntax)))
(defn ^:private eval! [expr]
@@ -413,10 +424,10 @@
;; _ (prn 'compile-module name =class)
]]
(fn [state]
- (matchv ::M/objects [((&/with-writer =class
- (&/exhaust% compiler-step))
- (&/set$ &/$SOURCE (&reader/from file-name file-content) state))]
- [["lux;Right" [?state _]]]
+ (|case ((&/with-writer =class
+ (&/exhaust% compiler-step))
+ (&/set$ &/$SOURCE (&reader/from file-name file-content) state))
+ ("lux;Right" ?state _)
(&/run-state (|do [defs &a-module/defs
imports &a-module/imports
:let [_ (doto =class
@@ -437,7 +448,7 @@
(&&/save-class! "_" (.toByteArray =class)))
?state)
- [["lux;Left" ?message]]
+ ("lux;Left" ?message)
(fail* ?message)))))))
))
))
@@ -448,11 +459,11 @@
;; [Resources]
(defn compile-program [program-module]
(init!)
- (matchv ::M/objects [((&/map% compile-module (&/|list "lux" program-module)) (&/init-state nil))]
- [["lux;Right" [?state _]]]
+ (|case ((&/map% compile-module (&/|list "lux" program-module)) (&/init-state nil))
+ ("lux;Right" ?state _)
(do (println "Compilation complete!")
(&&cache/clean ?state)
(&&package/package program-module))
- [["lux;Left" ?message]]
+ ("lux;Left" ?message)
(assert false ?message)))
diff --git a/src/lux/compiler/cache.clj b/src/lux/compiler/cache.clj
index 565eae898..2b6f2e919 100644
--- a/src/lux/compiler/cache.clj
+++ b/src/lux/compiler/cache.clj
@@ -10,9 +10,9 @@
(:refer-clojure :exclude [load])
(:require [clojure.string :as string]
[clojure.java.io :as io]
- [clojure.core.match :as M :refer [matchv]]
+ clojure.core.match
clojure.core.match.array
- (lux [base :as & :refer [|do return* return fail fail*]]
+ (lux [base :as & :refer [|do return* return fail fail* |case]]
[type :as &type]
[host :as &host])
(lux.analyser [base :as &a]
@@ -126,8 +126,8 @@
"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-meta (get-field "_meta" def-class)]
- (matchv ::M/objects [def-meta]
- [["lux;ValueD" [def-type _]]]
+ (|case def-meta
+ ("lux;ValueD" def-type _)
(&a-module/define module _name def-meta def-type)))
;; else
(let [[_ __module __name] (re-find #"^A(.*);(.*)$" _ann)]
diff --git a/src/lux/compiler/case.clj b/src/lux/compiler/case.clj
index 906cc1ca8..d27577be1 100644
--- a/src/lux/compiler/case.clj
+++ b/src/lux/compiler/case.clj
@@ -9,9 +9,9 @@
(ns lux.compiler.case
(:require (clojure [set :as set]
[template :refer [do-template]])
- [clojure.core.match :as M :refer [match matchv]]
+ clojure.core.match
clojure.core.match.array
- (lux [base :as & :refer [|do return* return fail fail* |let]]
+ (lux [base :as & :refer [|do return* return fail fail* |let |case]]
[type :as &type]
[lexer :as &lexer]
[parser :as &parser]
@@ -26,13 +26,13 @@
;; [Utils]
(let [compare-kv #(.compareTo ^String (aget ^objects %1 0) ^String (aget ^objects %2 0))]
(defn ^:private compile-match [^MethodVisitor writer ?match $target $else]
- (matchv ::M/objects [?match]
- [["StoreTestAC" ?idx]]
+ (|case ?match
+ ("StoreTestAC" ?idx)
(doto writer
(.visitVarInsn Opcodes/ASTORE ?idx)
(.visitJumpInsn Opcodes/GOTO $target))
- [["BoolTestAC" ?value]]
+ ("BoolTestAC" ?value)
(doto writer
(.visitTypeInsn Opcodes/CHECKCAST "java/lang/Boolean")
(.visitInsn Opcodes/DUP)
@@ -42,7 +42,7 @@
(.visitInsn Opcodes/POP)
(.visitJumpInsn Opcodes/GOTO $target))
- [["IntTestAC" ?value]]
+ ("IntTestAC" ?value)
(doto writer
(.visitTypeInsn Opcodes/CHECKCAST "java/lang/Long")
(.visitInsn Opcodes/DUP)
@@ -53,7 +53,7 @@
(.visitInsn Opcodes/POP)
(.visitJumpInsn Opcodes/GOTO $target))
- [["RealTestAC" ?value]]
+ ("RealTestAC" ?value)
(doto writer
(.visitTypeInsn Opcodes/CHECKCAST "java/lang/Double")
(.visitInsn Opcodes/DUP)
@@ -64,7 +64,7 @@
(.visitInsn Opcodes/POP)
(.visitJumpInsn Opcodes/GOTO $target))
- [["CharTestAC" ?value]]
+ ("CharTestAC" ?value)
(doto writer
(.visitTypeInsn Opcodes/CHECKCAST "java/lang/Character")
(.visitInsn Opcodes/DUP)
@@ -74,7 +74,7 @@
(.visitInsn Opcodes/POP)
(.visitJumpInsn Opcodes/GOTO $target))
- [["TextTestAC" ?value]]
+ ("TextTestAC" ?value)
(doto writer
(.visitInsn Opcodes/DUP)
(.visitLdcInsn ?value)
@@ -83,7 +83,7 @@
(.visitInsn Opcodes/POP)
(.visitJumpInsn Opcodes/GOTO $target))
- [["TupleTestAC" ?members]]
+ ("TupleTestAC" ?members)
(doto writer
(.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;")
(-> (doto (.visitInsn Opcodes/DUP)
@@ -101,7 +101,7 @@
(.visitInsn Opcodes/POP)
(.visitJumpInsn Opcodes/GOTO $target))
- [["RecordTestAC" ?slots]]
+ ("RecordTestAC" ?slots)
(doto writer
(.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;")
(-> (doto (.visitInsn Opcodes/DUP)
@@ -124,7 +124,7 @@
(.visitInsn Opcodes/POP)
(.visitJumpInsn Opcodes/GOTO $target))
- [["VariantTestAC" [?tag ?test]]]
+ ("VariantTestAC" ?tag ?test)
(doto writer
(.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;")
(.visitInsn Opcodes/DUP)
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index 542bd9a40..bde19d8fb 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -10,9 +10,9 @@
(:require (clojure [string :as string]
[set :as set]
[template :refer [do-template]])
- [clojure.core.match :as M :refer [match matchv]]
+ clojure.core.match
clojure.core.match.array
- (lux [base :as & :refer [|do return* return fail fail* |let]]
+ (lux [base :as & :refer [|do return* return fail fail* |let |case]]
[type :as &type]
[lexer :as &lexer]
[parser :as &parser]
@@ -51,35 +51,35 @@
double-class "java.lang.Double"
char-class "java.lang.Character"]
(defn prepare-return! [^MethodVisitor *writer* *type*]
- (matchv ::M/objects [*type*]
- [["lux;TupleT" ["lux;Nil" _]]]
+ (|case *type*
+ ("lux;TupleT" ("lux;Nil"))
(.visitInsn *writer* Opcodes/ACONST_NULL)
- [["lux;DataT" "boolean"]]
+ ("lux;DataT" "boolean")
(.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class boolean-class) "valueOf" (str "(Z)" (&host/->type-signature boolean-class)))
- [["lux;DataT" "byte"]]
+ ("lux;DataT" "byte")
(.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class byte-class) "valueOf" (str "(B)" (&host/->type-signature byte-class)))
- [["lux;DataT" "short"]]
+ ("lux;DataT" "short")
(.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class short-class) "valueOf" (str "(S)" (&host/->type-signature short-class)))
- [["lux;DataT" "int"]]
+ ("lux;DataT" "int")
(.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class int-class) "valueOf" (str "(I)" (&host/->type-signature int-class)))
- [["lux;DataT" "long"]]
+ ("lux;DataT" "long")
(.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class long-class) "valueOf" (str "(J)" (&host/->type-signature long-class)))
- [["lux;DataT" "float"]]
+ ("lux;DataT" "float")
(.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class float-class) "valueOf" (str "(F)" (&host/->type-signature float-class)))
- [["lux;DataT" "double"]]
+ ("lux;DataT" "double")
(.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class double-class) "valueOf" (str "(D)" (&host/->type-signature double-class)))
- [["lux;DataT" "char"]]
+ ("lux;DataT" "char")
(.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class char-class) "valueOf" (str "(C)" (&host/->type-signature char-class)))
- [["lux;DataT" _]]
+ ("lux;DataT" _)
nil)
*writer*))
@@ -413,16 +413,16 @@
$to (new Label)
$end (new Label)
$catch-finally (new Label)
- compile-finally (matchv ::M/objects [?finally]
- [["lux;Some" ?finally*]] (|do [_ (return nil)
- _ (compile ?finally*)
- :let [_ (doto *writer*
- (.visitInsn Opcodes/POP)
- (.visitJumpInsn Opcodes/GOTO $end))]]
- (return nil))
- [["lux;None" _]] (|do [_ (return nil)
- :let [_ (.visitJumpInsn *writer* Opcodes/GOTO $end)]]
- (return nil)))
+ compile-finally (|case ?finally
+ ("lux;Some" ?finally*) (|do [_ (return nil)
+ _ (compile ?finally*)
+ :let [_ (doto *writer*
+ (.visitInsn Opcodes/POP)
+ (.visitJumpInsn Opcodes/GOTO $end))]]
+ (return nil))
+ ("lux;None") (|do [_ (return nil)
+ :let [_ (.visitJumpInsn *writer* Opcodes/GOTO $end)]]
+ (return nil)))
catch-boundaries (&/|map (fn [[?ex-class ?ex-idx ?catch-body]] [?ex-class (new Label) (new Label)])
?catches)
_ (doseq [[?ex-class $handler-start $handler-end] (&/->seq catch-boundaries)
@@ -447,14 +447,14 @@
catch-boundaries)
;; :let [_ (prn 'handlers (&/->seq handlers))]
:let [_ (.visitLabel *writer* $catch-finally)]
- _ (matchv ::M/objects [?finally]
- [["lux;Some" ?finally*]] (|do [_ (compile ?finally*)
- :let [_ (.visitInsn *writer* Opcodes/POP)]
- :let [_ (.visitInsn *writer* Opcodes/ATHROW)]]
- (return nil))
- [["lux;None" _]] (|do [_ (return nil)
- :let [_ (.visitInsn *writer* Opcodes/ATHROW)]]
- (return nil)))
+ _ (|case ?finally
+ ("lux;Some" ?finally*) (|do [_ (compile ?finally*)
+ :let [_ (.visitInsn *writer* Opcodes/POP)]
+ :let [_ (.visitInsn *writer* Opcodes/ATHROW)]]
+ (return nil))
+ ("lux;None") (|do [_ (return nil)
+ :let [_ (.visitInsn *writer* Opcodes/ATHROW)]]
+ (return nil)))
:let [_ (.visitJumpInsn *writer* Opcodes/GOTO $end)]
:let [_ (.visitLabel *writer* $end)]]
(return nil)))
@@ -533,11 +533,14 @@
compile-jvm-iand Opcodes/IAND "intValue" "()I" "java.lang.Integer" "intValue" "()I" "java.lang.Integer" "java.lang.Integer" "(I)V"
compile-jvm-ior Opcodes/IOR "intValue" "()I" "java.lang.Integer" "intValue" "()I" "java.lang.Integer" "java.lang.Integer" "(I)V"
+ compile-jvm-ixor Opcodes/IXOR "intValue" "()I" "java.lang.Integer" "intValue" "()I" "java.lang.Integer" "java.lang.Integer" "(I)V"
+ compile-jvm-ishl Opcodes/ISHL "intValue" "()I" "java.lang.Integer" "intValue" "()I" "java.lang.Integer" "java.lang.Integer" "(I)V"
+ compile-jvm-ishr Opcodes/ISHR "intValue" "()I" "java.lang.Integer" "intValue" "()I" "java.lang.Integer" "java.lang.Integer" "(I)V"
+ compile-jvm-iushr Opcodes/IUSHR "intValue" "()I" "java.lang.Integer" "intValue" "()I" "java.lang.Integer" "java.lang.Integer" "(I)V"
compile-jvm-land Opcodes/LAND "longValue" "()J" "java.lang.Long" "longValue" "()J" "java.lang.Long" "java.lang.Long" "(J)V"
compile-jvm-lor Opcodes/LOR "longValue" "()J" "java.lang.Long" "longValue" "()J" "java.lang.Long" "java.lang.Long" "(J)V"
compile-jvm-lxor Opcodes/LXOR "longValue" "()J" "java.lang.Long" "longValue" "()J" "java.lang.Long" "java.lang.Long" "(J)V"
-
compile-jvm-lshl Opcodes/LSHL "longValue" "()J" "java.lang.Long" "intValue" "()I" "java.lang.Integer" "java.lang.Long" "(J)V"
compile-jvm-lshr Opcodes/LSHR "longValue" "()J" "java.lang.Long" "intValue" "()I" "java.lang.Integer" "java.lang.Long" "(J)V"
compile-jvm-lushr Opcodes/LUSHR "longValue" "()J" "java.lang.Long" "intValue" "()I" "java.lang.Integer" "java.lang.Long" "(J)V"
diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj
index ccd12e68a..0d1ea4844 100644
--- a/src/lux/compiler/lambda.clj
+++ b/src/lux/compiler/lambda.clj
@@ -10,9 +10,9 @@
(:require (clojure [string :as string]
[set :as set]
[template :refer [do-template]])
- [clojure.core.match :as M :refer [matchv]]
+ clojure.core.match
clojure.core.match.array
- (lux [base :as & :refer [|do return* return fail fail*]]
+ (lux [base :as & :refer [|do return* return fail fail* |case]]
[type :as &type]
[lexer :as &lexer]
[parser :as &parser]
@@ -46,8 +46,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)])
- (matchv ::M/objects [?name+?captured]
- [[?name [["captured" [_ ?captured-id ?source]] _]]])
+ (|case ?name+?captured
+ [?name [("captured" _ ?captured-id ?source) _]])
(doseq [?name+?captured (&/->seq env)])))
(.visitInsn Opcodes/RETURN)
(.visitMaxs 0 0)
@@ -83,8 +83,8 @@
(.visitTypeInsn Opcodes/NEW lambda-class)
(.visitInsn Opcodes/DUP))]
_ (&/map% (fn [?name+?captured]
- (matchv ::M/objects [?name+?captured]
- [[?name [["captured" [_ _ ?source]] _]]]
+ (|case ?name+?captured
+ [?name [("captured" _ _ ?source) _]]
(compile ?source)))
closed-over)
:let [_ (.visitMethodInsn *writer* Opcodes/INVOKESPECIAL lambda-class "<init>" init-signature)]]
@@ -101,8 +101,8 @@
(-> (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]] _]]])
+ (|case ?name+?captured
+ [?name [("captured" _ ?captured-id ?source) _]])
(doseq [?name+?captured (&/->seq ?env)])))
(add-lambda-apply class-name ?env)
(add-lambda-<init> class-name ?env)
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index def5220f7..9a3a7a6f2 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -10,9 +10,9 @@
(:require (clojure [string :as string]
[set :as set]
[template :refer [do-template]])
- [clojure.core.match :as M :refer [matchv]]
+ clojure.core.match
clojure.core.match.array
- (lux [base :as & :refer [|do return* return fail fail* |let]]
+ (lux [base :as & :refer [|do return* return fail fail* |let |case]]
[type :as &type]
[lexer :as &lexer]
[parser :as &parser]
@@ -138,8 +138,8 @@
(defn ^:private compile-def-type [compile current-class ?body def-type]
(|do [^MethodVisitor **writer** &/get-writer]
- (matchv ::M/objects [def-type]
- ["type"]
+ (|case def-type
+ "type"
(|do [:let [;; ?type* (&&type/->analysis ?type)
_ (doto **writer**
;; Tail: Begin
@@ -160,13 +160,13 @@
]
(return nil))
- ["value"]
+ "value"
(|let [;; _ (prn '?body (aget ?body 0) (aget ?body 1 0))
- ?def-type (matchv ::M/objects [?body]
- [[["ann" [?def-value ?type-expr]] ?def-type]]
+ ?def-type (|case ?body
+ [("ann" ?def-value ?type-expr) ?def-type]
?type-expr
- [[?def-value ?def-type]]
+ [?def-value ?def-type]
(&&type/->analysis ?def-type))]
(|do [:let [_ (doto **writer**
(.visitLdcInsn (int 2)) ;; S
diff --git a/src/lux/compiler/type.clj b/src/lux/compiler/type.clj
index 01141f8e4..bfa322206 100644
--- a/src/lux/compiler/type.clj
+++ b/src/lux/compiler/type.clj
@@ -7,9 +7,9 @@
;; You must not remove this notice, or any other, from this software.
(ns lux.compiler.type
- (:require [clojure.core.match :as M :refer [matchv]]
+ (:require clojure.core.match
clojure.core.match.array
- (lux [base :as & :refer [|do return* return fail fail* |let]]
+ (lux [base :as & :refer [|do return* return fail fail* |let |case]]
[type :as &type])))
;; [Utils]
@@ -39,18 +39,18 @@
;; [Exports]
(defn ->analysis [type]
"(-> Type Analysis)"
- (matchv ::M/objects [type]
- [["lux;DataT" ?class]]
+ (|case type
+ ("lux;DataT" ?class)
(variant$ "lux;DataT" (text$ ?class))
- [["lux;TupleT" ?members]]
+ ("lux;TupleT" ?members)
(variant$ "lux;TupleT"
(&/fold (fn [tail head]
(Cons$ (->analysis head) tail))
$Nil
(&/|reverse ?members)))
- [["lux;VariantT" ?cases]]
+ ("lux;VariantT" ?cases)
(variant$ "lux;VariantT"
(&/fold (fn [tail head]
(|let [[hlabel htype] head]
@@ -59,7 +59,7 @@
$Nil
(&/|reverse ?cases)))
- [["lux;RecordT" ?slots]]
+ ("lux;RecordT" ?slots)
(variant$ "lux;RecordT"
(&/fold (fn [tail head]
(|let [[hlabel htype] head]
@@ -68,16 +68,16 @@
$Nil
(&/|reverse ?slots)))
- [["lux;LambdaT" [?input ?output]]]
+ ("lux;LambdaT" ?input ?output)
(variant$ "lux;LambdaT" (tuple$ (&/|list (->analysis ?input) (->analysis ?output))))
- [["lux;AllT" [?env ?name ?arg ?body]]]
+ ("lux;AllT" ?env ?name ?arg ?body)
(variant$ "lux;AllT"
- (tuple$ (&/|list (matchv ::M/objects [?env]
- [["lux;None" _]]
+ (tuple$ (&/|list (|case ?env
+ ("lux;None")
(variant$ "lux;None" (tuple$ (&/|list)))
- [["lux;Some" ??env]]
+ ("lux;Some" ??env)
(variant$ "lux;Some"
(&/fold (fn [tail head]
(|let [[hlabel htype] head]
@@ -89,9 +89,9 @@
(text$ ?arg)
(->analysis ?body))))
- [["lux;BoundT" ?name]]
+ ("lux;BoundT" ?name)
(variant$ "lux;BoundT" (text$ ?name))
- [["lux;AppT" [?fun ?arg]]]
+ ("lux;AppT" ?fun ?arg)
(variant$ "lux;AppT" (tuple$ (&/|list (->analysis ?fun) (->analysis ?arg))))
))
diff --git a/src/lux/host.clj b/src/lux/host.clj
index 91582c526..2414d97b6 100644
--- a/src/lux/host.clj
+++ b/src/lux/host.clj
@@ -9,9 +9,9 @@
(ns lux.host
(:require (clojure [string :as string]
[template :refer [do-template]])
- [clojure.core.match :as M :refer [match matchv]]
+ clojure.core.match
clojure.core.match.array
- (lux [base :as & :refer [|do return* return fail fail* |let]]
+ (lux [base :as & :refer [|do return* return fail fail* |let |case]]
[type :as &type]))
(:import (java.lang.reflect Field Method Modifier)))
@@ -68,14 +68,14 @@
))
(defn ->java-sig [^objects type]
- (matchv ::M/objects [type]
- [["lux;DataT" ?name]]
+ (|case type
+ ("lux;DataT" ?name)
(->type-signature ?name)
- [["lux;LambdaT" [_ _]]]
+ ("lux;LambdaT" _ _)
(->type-signature function-class)
- [["lux;TupleT" ["lux;Nil" _]]]
+ ("lux;TupleT" ("lux;Nil"))
"V"
))
diff --git a/src/lux/parser.clj b/src/lux/parser.clj
index 966c322bf..aa05b48af 100644
--- a/src/lux/parser.clj
+++ b/src/lux/parser.clj
@@ -8,9 +8,9 @@
(ns lux.parser
(:require [clojure.template :refer [do-template]]
- [clojure.core.match :as M :refer [matchv]]
+ clojure.core.match
clojure.core.match.array
- (lux [base :as & :refer [|do return fail]]
+ (lux [base :as & :refer [|do return fail |case]]
[lexer :as &lexer])))
;; [Utils]
@@ -18,11 +18,11 @@
(defn <name> [parse]
(|do [elems (&/repeat% parse)
token &lexer/lex]
- (matchv ::M/objects [token]
- [["lux;Meta" [meta [<close-token> _]]]]
+ (|case token
+ ("lux;Meta" meta [<close-token> _])
(return (&/V <tag> (&/fold &/|++ (&/|list) elems)))
- [_]
+ _
(fail (str "[Parser Error] Unbalanced " <description> ".")))))
^:private parse-form "Close_Paren" "parantheses" "lux;FormS"
@@ -33,60 +33,59 @@
(|do [elems* (&/repeat% parse)
token &lexer/lex
:let [elems (&/fold &/|++ (&/|list) elems*)]]
- (matchv ::M/objects [token]
- [["lux;Meta" [meta ["Close_Brace" _]]]]
+ (|case token
+ ("lux;Meta" meta ("Close_Brace" _))
(if (even? (&/|length elems))
(return (&/V "lux;RecordS" (&/|as-pairs elems)))
(fail (str "[Parser Error] Records must have an even number of elements.")))
- [_]
+ _
(fail (str "[Parser Error] Unbalanced braces.")))))
;; [Interface]
(def parse
- (|do [token &lexer/lex]
- (matchv ::M/objects [token]
- [["lux;Meta" [meta token*]]]
- (matchv ::M/objects [token*]
- [["White_Space" _]]
- (return (&/|list))
+ (|do [token &lexer/lex
+ :let [("lux;Meta" meta token*) token]]
+ (|case token*
+ ("White_Space" _)
+ (return (&/|list))
- [["Comment" _]]
- (return (&/|list))
-
- [["Bool" ?value]]
- (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;BoolS" (Boolean/parseBoolean ?value))))))
+ ("Comment" _)
+ (return (&/|list))
+
+ ("Bool" ?value)
+ (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;BoolS" (Boolean/parseBoolean ?value))))))
- [["Int" ?value]]
- (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;IntS" (Integer/parseInt ?value))))))
+ ("Int" ?value)
+ (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;IntS" (Integer/parseInt ?value))))))
- [["Real" ?value]]
- (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;RealS" (Float/parseFloat ?value))))))
+ ("Real" ?value)
+ (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;RealS" (Float/parseFloat ?value))))))
- [["Char" ^String ?value]]
- (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;CharS" (.charAt ?value 0))))))
+ ("Char" ^String ?value)
+ (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;CharS" (.charAt ?value 0))))))
- [["Text" ?value]]
- (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;TextS" ?value)))))
+ ("Text" ?value)
+ (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;TextS" ?value)))))
- [["Symbol" ?ident]]
- (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;SymbolS" ?ident)))))
+ ("Symbol" ?ident)
+ (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;SymbolS" ?ident)))))
- [["Tag" ?ident]]
- (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;TagS" ?ident)))))
+ ("Tag" ?ident)
+ (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;TagS" ?ident)))))
- [["Open_Paren" _]]
- (|do [syntax (parse-form parse)]
- (return (&/|list (&/V "lux;Meta" (&/T meta syntax)))))
-
- [["Open_Bracket" _]]
- (|do [syntax (parse-tuple parse)]
- (return (&/|list (&/V "lux;Meta" (&/T meta syntax)))))
+ ("Open_Paren" _)
+ (|do [syntax (parse-form parse)]
+ (return (&/|list (&/V "lux;Meta" (&/T meta syntax)))))
+
+ ("Open_Bracket" _)
+ (|do [syntax (parse-tuple parse)]
+ (return (&/|list (&/V "lux;Meta" (&/T meta syntax)))))
- [["Open_Brace" _]]
- (|do [syntax (parse-record parse)]
- (return (&/|list (&/V "lux;Meta" (&/T meta syntax)))))
+ ("Open_Brace" _)
+ (|do [syntax (parse-record parse)]
+ (return (&/|list (&/V "lux;Meta" (&/T meta syntax)))))
- [_]
- (fail "[Parser Error] Unknown lexer token.")
- ))))
+ _
+ (fail "[Parser Error] Unknown lexer token.")
+ )))
diff --git a/src/lux/reader.clj b/src/lux/reader.clj
index 9fd9b14ea..6bda8f166 100644
--- a/src/lux/reader.clj
+++ b/src/lux/reader.clj
@@ -8,40 +8,40 @@
(ns lux.reader
(:require [clojure.string :as string]
- [clojure.core.match :as M :refer [matchv]]
+ clojure.core.match
clojure.core.match.array
- [lux.base :as & :refer [|do return* return fail fail* |let]]))
+ [lux.base :as & :refer [|do return* return fail fail* |let |case]]))
;; [Utils]
(defn ^:private with-line [body]
(fn [state]
- (matchv ::M/objects [(&/get$ &/$SOURCE state)]
- [["lux;Nil" _]]
+ (|case (&/get$ &/$SOURCE state)
+ ("lux;Nil")
(fail* "[Reader Error] EOF")
- [["lux;Cons" [[[file-name line-num column-num] line]
- more]]]
- (matchv ::M/objects [(body file-name line-num column-num line)]
- [["No" msg]]
+ ("lux;Cons" [[file-name line-num column-num] line]
+ more)
+ (|case (body file-name line-num column-num line)
+ ("No" msg)
(fail* msg)
- [["Done" output]]
+ ("Done" output)
(return* (&/set$ &/$SOURCE more state)
output)
- [["Yes" [output line*]]]
+ ("Yes" output line*)
(return* (&/set$ &/$SOURCE (&/|cons line* more) state)
output))
)))
(defn ^:private with-lines [body]
(fn [state]
- (matchv ::M/objects [(body (&/get$ &/$SOURCE state))]
- [["lux;Right" [reader* match]]]
+ (|case (body (&/get$ &/$SOURCE state))
+ ("lux;Right" reader* match)
(return* (&/set$ &/$SOURCE reader* state)
match)
- [["lux;Left" msg]]
+ ("lux;Left" msg)
(fail* msg)
)))
@@ -102,12 +102,12 @@
(fn [reader]
(loop [prefix ""
reader* reader]
- (matchv ::M/objects [reader*]
- [["lux;Nil" _]]
+ (|case reader*
+ ("lux;Nil")
(&/V "lux;Left" "[Reader Error] EOF")
- [["lux;Cons" [[[file-name line-num column-num] ^String line]
- reader**]]]
+ ("lux;Cons" [[file-name line-num column-num] ^String line]
+ reader**)
(if-let [^String match (do ;; (prn 'read-regex+ regex line)
(re-find1! regex column-num line))]
(let [match-length (.length match)
diff --git a/src/lux/type.clj b/src/lux/type.clj
index e4117492c..ab8ea4e61 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -8,9 +8,9 @@
(ns lux.type
(:refer-clojure :exclude [deref apply merge bound?])
- (:require [clojure.core.match :as M :refer [match matchv]]
+ (:require clojure.core.match
clojure.core.match.array
- [lux.base :as & :refer [|do return* return fail fail* assert! |let]]))
+ [lux.base :as & :refer [|do return* return fail fail* assert! |let |case]]))
(declare show-type)
@@ -191,33 +191,33 @@
(defn bound? [id]
(fn [state]
(if-let [type (->> state (&/get$ &/$TYPES) (&/get$ &/$MAPPINGS) (&/|get id))]
- (matchv ::M/objects [type]
- [["lux;Some" type*]]
+ (|case type
+ ("lux;Some" type*)
(return* state true)
- [["lux;None" _]]
+ ("lux;None")
(return* state false))
(fail* (str "[Type Error] <bound?> Unknown type-var: " id)))))
(defn deref [id]
(fn [state]
(if-let [type* (->> state (&/get$ &/$TYPES) (&/get$ &/$MAPPINGS) (&/|get id))]
- (matchv ::M/objects [type*]
- [["lux;Some" type]]
+ (|case type*
+ ("lux;Some" type)
(return* state type)
- [["lux;None" _]]
+ ("lux;None")
(fail* (str "[Type Error] Unbound type-var: " id)))
(fail* (str "[Type Error] <deref> Unknown type-var: " id)))))
(defn set-var [id type]
(fn [state]
(if-let [tvar (->> state (&/get$ &/$TYPES) (&/get$ &/$MAPPINGS) (&/|get id))]
- (matchv ::M/objects [tvar]
- [["lux;Some" bound]]
+ (|case tvar
+ ("lux;Some" bound)
(fail* (str "[Type Error] Can't rebind type var: " id " | Current type: " (show-type bound)))
- [["lux;None" _]]
+ ("lux;None")
(return* (&/update$ &/$TYPES (fn [ts] (&/update$ &/$MAPPINGS #(&/|put id (&/V "lux;Some" type) %)
ts))
state)
@@ -251,18 +251,18 @@
(|let [[?id ?type] binding]
(if (.equals ^Object id ?id)
(return binding)
- (matchv ::M/objects [?type]
- [["lux;None" _]]
+ (|case ?type
+ ("lux;None")
(return binding)
- [["lux;Some" ?type*]]
- (matchv ::M/objects [?type*]
- [["lux;VarT" ?id*]]
+ ("lux;Some" ?type*)
+ (|case ?type*
+ ("lux;VarT" ?id*)
(if (.equals ^Object id ?id*)
(return (&/T ?id (&/V "lux;None" nil)))
(return binding))
- [_]
+ _
(|do [?type** (clean* id ?type*)]
(return (&/T ?id (&/V "lux;Some" ?type**)))))
))))
@@ -288,46 +288,46 @@
(return output)))
(defn clean* [?tid type]
- (matchv ::M/objects [type]
- [["lux;VarT" ?id]]
+ (|case type
+ ("lux;VarT" ?id)
(if (.equals ^Object ?tid ?id)
(deref ?id)
(return type))
- [["lux;LambdaT" [?arg ?return]]]
+ ("lux;LambdaT" ?arg ?return)
(|do [=arg (clean* ?tid ?arg)
=return (clean* ?tid ?return)]
(return (&/V "lux;LambdaT" (&/T =arg =return))))
- [["lux;AppT" [?lambda ?param]]]
+ ("lux;AppT" ?lambda ?param)
(|do [=lambda (clean* ?tid ?lambda)
=param (clean* ?tid ?param)]
(return (&/V "lux;AppT" (&/T =lambda =param))))
- [["lux;TupleT" ?members]]
+ ("lux;TupleT" ?members)
(|do [=members (&/map% (partial clean* ?tid) ?members)]
(return (&/V "lux;TupleT" =members)))
- [["lux;VariantT" ?members]]
+ ("lux;VariantT" ?members)
(|do [=members (&/map% (fn [[k v]]
(|do [=v (clean* ?tid v)]
(return (&/T k =v))))
?members)]
(return (&/V "lux;VariantT" =members)))
- [["lux;RecordT" ?members]]
+ ("lux;RecordT" ?members)
(|do [=members (&/map% (fn [[k v]]
(|do [=v (clean* ?tid v)]
(return (&/T k =v))))
?members)]
(return (&/V "lux;RecordT" =members)))
- [["lux;AllT" [?env ?name ?arg ?body]]]
- (|do [=env (matchv ::M/objects [?env]
- [["lux;None" _]]
+ ("lux;AllT" ?env ?name ?arg ?body)
+ (|do [=env (|case ?env
+ ("lux;None")
(return ?env)
- [["lux;Some" ?env*]]
+ ("lux;Some" ?env*)
(|do [clean-env (&/map% (fn [[k v]]
(|do [=v (clean* ?tid v)]
(return (&/T k =v))))
@@ -336,96 +336,96 @@
body* (clean* ?tid ?body)]
(return (&/V "lux;AllT" (&/T =env ?name ?arg body*))))
- [_]
+ _
(return type)
))
(defn clean [tvar type]
- (matchv ::M/objects [tvar]
- [["lux;VarT" ?id]]
+ (|case tvar
+ ("lux;VarT" ?id)
(clean* ?id type)
- [_]
+ _
(fail (str "[Type Error] Not type-var: " (show-type tvar)))))
(defn ^:private unravel-fun [type]
- (matchv ::M/objects [type]
- [["lux;LambdaT" [?in ?out]]]
+ (|case type
+ ("lux;LambdaT" ?in ?out)
(|let [[??out ?args] (unravel-fun ?out)]
(&/T ??out (&/|cons ?in ?args)))
- [_]
+ _
(&/T type (&/|list))))
(defn ^:private unravel-app [fun-type]
- (matchv ::M/objects [fun-type]
- [["lux;AppT" [?left ?right]]]
+ (|case fun-type
+ ("lux;AppT" ?left ?right)
(|let [[?fun-type ?args] (unravel-app ?left)]
(&/T ?fun-type (&/|++ ?args (&/|list ?right))))
- [_]
+ _
(&/T fun-type (&/|list))))
(defn show-type [^objects type]
- (matchv ::M/objects [type]
- [["lux;DataT" name]]
+ (|case type
+ ("lux;DataT" name)
(str "(^ " name ")")
- [["lux;TupleT" elems]]
+ ("lux;TupleT" elems)
(if (&/|empty? elems)
"(,)"
(str "(, " (->> elems (&/|map show-type) (&/|interpose " ") (&/fold str "")) ")"))
- [["lux;VariantT" cases]]
+ ("lux;VariantT" cases)
(if (&/|empty? cases)
"(|)"
(str "(| " (->> cases
(&/|map (fn [kv]
- (matchv ::M/objects [kv]
- [[k ["lux;TupleT" ["lux;Nil" _]]]]
+ (|case kv
+ [k ("lux;TupleT" ("lux;Nil"))]
(str "#" k)
- [[k v]]
+ [k v]
(str "(#" k " " (show-type v) ")"))))
(&/|interpose " ")
(&/fold str "")) ")"))
- [["lux;RecordT" fields]]
+ ("lux;RecordT" fields)
(str "(& " (->> fields
(&/|map (fn [kv]
- (matchv ::M/objects [kv]
- [[k v]]
+ (|case kv
+ [k v]
(str "#" k " " (show-type v)))))
(&/|interpose " ")
(&/fold str "")) ")")
- [["lux;LambdaT" [input output]]]
+ ("lux;LambdaT" input output)
(|let [[?out ?ins] (unravel-fun type)]
(str "(-> " (->> ?ins (&/|map show-type) (&/|interpose " ") (&/fold str "")) " " (show-type ?out) ")"))
- [["lux;VarT" id]]
+ ("lux;VarT" id)
(str "⌈" id "⌋")
- [["lux;ExT" ?id]]
+ ("lux;ExT" ?id)
(str "⟨" ?id "⟩")
- [["lux;BoundT" name]]
+ ("lux;BoundT" name)
name
- [["lux;AppT" [_ _]]]
+ ("lux;AppT" _ _)
(|let [[?call-fun ?call-args] (unravel-app type)]
(str "(" (show-type ?call-fun) " " (->> ?call-args (&/|map show-type) (&/|interpose " ") (&/fold str "")) ")"))
- [["lux;AllT" [?env ?name ?arg ?body]]]
+ ("lux;AllT" ?env ?name ?arg ?body)
(if (= "" ?name)
(let [[args body] (loop [args (list ?arg)
body* ?body]
- (matchv ::M/objects [body*]
- [["lux;AllT" [?env* ?name* ?arg* ?body*]]]
+ (|case 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) ")"))
?name)
@@ -433,17 +433,17 @@
(defn type= [x y]
(or (clojure.lang.Util/identical x y)
- (let [output (matchv ::M/objects [x y]
- [["lux;DataT" xname] ["lux;DataT" yname]]
+ (let [output (|case [x y]
+ [("lux;DataT" xname) ("lux;DataT" yname)]
(.equals ^Object xname yname)
- [["lux;TupleT" xelems] ["lux;TupleT" yelems]]
+ [("lux;TupleT" xelems) ("lux;TupleT" yelems)]
(&/fold2 (fn [old x y]
(and old (type= x y)))
true
xelems yelems)
- [["lux;VariantT" xcases] ["lux;VariantT" ycases]]
+ [("lux;VariantT" xcases) ("lux;VariantT" ycases)]
(&/fold2 (fn [old xcase ycase]
(|let [[xname xtype] xcase
[yname ytype] ycase]
@@ -451,7 +451,7 @@
true
xcases ycases)
- [["lux;RecordT" xslots] ["lux;RecordT" yslots]]
+ [("lux;RecordT" xslots) ("lux;RecordT" yslots)]
(&/fold2 (fn [old xslot yslot]
(|let [[xname xtype] xslot
[yname ytype] yslot]
@@ -459,23 +459,23 @@
true
xslots yslots)
- [["lux;LambdaT" [xinput xoutput]] ["lux;LambdaT" [yinput youtput]]]
+ [("lux;LambdaT" xinput xoutput) ("lux;LambdaT" yinput youtput)]
(and (type= xinput yinput)
(type= xoutput youtput))
- [["lux;VarT" xid] ["lux;VarT" yid]]
+ [("lux;VarT" xid) ("lux;VarT" yid)]
(.equals ^Object xid yid)
- [["lux;BoundT" xname] ["lux;BoundT" yname]]
+ [("lux;BoundT" xname) ("lux;BoundT" yname)]
(.equals ^Object xname yname)
- [["lux;ExT" xid] ["lux;ExT" yid]]
+ [("lux;ExT" xid) ("lux;ExT" yid)]
(.equals ^Object xid yid)
- [["lux;AppT" [xlambda xparam]] ["lux;AppT" [ylambda yparam]]]
+ [("lux;AppT" xlambda xparam) ("lux;AppT" ylambda yparam)]
(and (type= xlambda ylambda) (type= xparam yparam))
- [["lux;AllT" [xenv xname xarg xbody]] ["lux;AllT" [yenv yname yarg ybody]]]
+ [("lux;AllT" xenv xname xarg xbody) ("lux;AllT" yenv yname yarg ybody)]
(and (.equals ^Object xname yname)
(.equals ^Object xarg yarg)
;; (matchv ::M/objects [xenv yenv]
@@ -501,11 +501,11 @@
(defn ^:private fp-get [k fixpoints]
(|let [[e a] k]
- (matchv ::M/objects [fixpoints]
- [["lux;Nil" _]]
+ (|case fixpoints
+ ("lux;Nil")
(&/V "lux;None" nil)
- [["lux;Cons" [[[e* a*] v*] fixpoints*]]]
+ ("lux;Cons" [[e* a*] v*] fixpoints*)
(if (and (type= e e*)
(type= a a*))
(&/V "lux;Some" v*)
@@ -521,73 +521,64 @@
"\n"))
(defn beta-reduce [env type]
- (matchv ::M/objects [type]
- [["lux;VariantT" ?cases]]
+ (|case type
+ ("lux;VariantT" ?cases)
(&/V "lux;VariantT" (&/|map (fn [kv]
(|let [[k v] kv]
(&/T k (beta-reduce env v))))
?cases))
- [["lux;RecordT" ?fields]]
+ ("lux;RecordT" ?fields)
(&/V "lux;RecordT" (&/|map (fn [kv]
(|let [[k v] kv]
(&/T k (beta-reduce env v))))
?fields))
- [["lux;TupleT" ?members]]
+ ("lux;TupleT" ?members)
(&/V "lux;TupleT" (&/|map (partial beta-reduce env) ?members))
- [["lux;AppT" [?type-fn ?type-arg]]]
+ ("lux;AppT" ?type-fn ?type-arg)
(&/V "lux;AppT" (&/T (beta-reduce env ?type-fn) (beta-reduce env ?type-arg)))
- [["lux;AllT" [?local-env ?local-name ?local-arg ?local-def]]]
- (matchv ::M/objects [?local-env]
- [["lux;None" _]]
+ ("lux;AllT" ?local-env ?local-name ?local-arg ?local-def)
+ (|case ?local-env
+ ("lux;None")
(&/V "lux;AllT" (&/T (&/V "lux;Some" env) ?local-name ?local-arg ?local-def))
- [["lux;Some" _]]
+ ("lux;Some" _)
type)
- [["lux;LambdaT" [?input ?output]]]
+ ("lux;LambdaT" ?input ?output)
(&/V "lux;LambdaT" (&/T (beta-reduce env ?input) (beta-reduce env ?output)))
- [["lux;BoundT" ?name]]
+ ("lux;BoundT" ?name)
(if-let [bound (&/|get ?name env)]
(beta-reduce env bound)
type)
- [_]
+ _
type
))
-(defn slot-type [record slot]
- (fn [state]
- (matchv ::M/objects [(&/|get slot record)]
- [["lux;Left" msg]]
- (fail* msg)
-
- [["lux;Right" type]]
- (return* state type))))
-
(defn apply-type [type-fn param]
- (matchv ::M/objects [type-fn]
- [["lux;AllT" [local-env local-name local-arg local-def]]]
- (let [local-env* (matchv ::M/objects [local-env]
- [["lux;None" _]]
+ (|case type-fn
+ ("lux;AllT" local-env local-name local-arg local-def)
+ (let [local-env* (|case local-env
+ ("lux;None")
(&/|table)
- [["lux;Some" local-env*]]
+ ("lux;Some" local-env*)
local-env*)]
(return (beta-reduce (->> local-env*
(&/|put local-name type-fn)
(&/|put local-arg param))
local-def)))
- [["lux;AppT" [F A]]]
+ ("lux;AppT" F A)
(|do [type-fn* (apply-type F A)]
(apply-type type-fn* param))
- [_]
+ _
(fail (str "[Type System] Not type function:\n" (show-type type-fn) "\n"))))
(defn as-obj [class]
@@ -610,85 +601,85 @@
(defn ^:private check* [class-loader fixpoints expected actual]
(if (clojure.lang.Util/identical expected actual)
(return (&/T fixpoints nil))
- (matchv ::M/objects [expected actual]
- [["lux;VarT" ?eid] ["lux;VarT" ?aid]]
+ (|case [expected actual]
+ [("lux;VarT" ?eid) ("lux;VarT" ?aid)]
(if (.equals ^Object ?eid ?aid)
(return (&/T fixpoints nil))
(|do [ebound (fn [state]
- (matchv ::M/objects [((deref ?eid) state)]
- [["lux;Right" [state* ebound]]]
+ (|case ((deref ?eid) state)
+ ("lux;Right" state* ebound)
(return* state* (&/V "lux;Some" ebound))
- [["lux;Left" _]]
+ ("lux;Left" _)
(return* state (&/V "lux;None" nil))))
abound (fn [state]
- (matchv ::M/objects [((deref ?aid) state)]
- [["lux;Right" [state* abound]]]
+ (|case ((deref ?aid) state)
+ ("lux;Right" state* abound)
(return* state* (&/V "lux;Some" abound))
- [["lux;Left" _]]
+ ("lux;Left" _)
(return* state (&/V "lux;None" nil))))]
- (matchv ::M/objects [ebound abound]
- [["lux;None" _] ["lux;None" _]]
+ (|case [ebound abound]
+ [("lux;None" _) ("lux;None" _)]
(|do [_ (set-var ?eid actual)]
(return (&/T fixpoints nil)))
- [["lux;Some" etype] ["lux;None" _]]
+ [("lux;Some" etype) ("lux;None" _)]
(check* class-loader fixpoints etype actual)
- [["lux;None" _] ["lux;Some" atype]]
+ [("lux;None" _) ("lux;Some" atype)]
(check* class-loader fixpoints expected atype)
- [["lux;Some" etype] ["lux;Some" atype]]
+ [("lux;Some" etype) ("lux;Some" atype)]
(check* class-loader fixpoints etype atype))))
- [["lux;VarT" ?id] _]
+ [("lux;VarT" ?id) _]
(fn [state]
- (matchv ::M/objects [((set-var ?id actual) state)]
- [["lux;Right" [state* _]]]
+ (|case ((set-var ?id actual) state)
+ ("lux;Right" state* _)
(return* state* (&/T fixpoints nil))
- [["lux;Left" _]]
+ ("lux;Left" _)
((|do [bound (deref ?id)]
(check* class-loader fixpoints bound actual))
state)))
- [_ ["lux;VarT" ?id]]
+ [_ ("lux;VarT" ?id)]
(fn [state]
- (matchv ::M/objects [((set-var ?id expected) state)]
- [["lux;Right" [state* _]]]
+ (|case ((set-var ?id expected) state)
+ ("lux;Right" state* _)
(return* state* (&/T fixpoints nil))
- [["lux;Left" _]]
+ ("lux;Left" _)
((|do [bound (deref ?id)]
(check* class-loader fixpoints expected bound))
state)))
- [["lux;AppT" [["lux;VarT" ?eid] A1]] ["lux;AppT" [["lux;VarT" ?aid] A2]]]
+ [("lux;AppT" ("lux;VarT" ?eid) A1) ("lux;AppT" ("lux;VarT" ?aid) A2)]
(fn [state]
- (matchv ::M/objects [((|do [F1 (deref ?eid)]
- (fn [state]
- (matchv ::M/objects [((|do [F2 (deref ?aid)]
- (check* class-loader fixpoints (&/V "lux;AppT" (&/T F1 A1)) (&/V "lux;AppT" (&/T F2 A2))))
- state)]
- [["lux;Right" [state* output]]]
- (return* state* output)
-
- [["lux;Left" _]]
- ((check* class-loader fixpoints (&/V "lux;AppT" (&/T F1 A1)) actual)
- state))))
- state)]
- [["lux;Right" [state* output]]]
+ (|case ((|do [F1 (deref ?eid)]
+ (fn [state]
+ (|case [((|do [F2 (deref ?aid)]
+ (check* class-loader fixpoints (&/V "lux;AppT" (&/T F1 A1)) (&/V "lux;AppT" (&/T F2 A2))))
+ state)]
+ ("lux;Right" state* output)
+ (return* state* output)
+
+ ("lux;Left" _)
+ ((check* class-loader fixpoints (&/V "lux;AppT" (&/T F1 A1)) actual)
+ state))))
+ state)
+ ("lux;Right" state* output)
(return* state* output)
- [["lux;Left" _]]
- (matchv ::M/objects [((|do [F2 (deref ?aid)]
- (check* class-loader fixpoints expected (&/V "lux;AppT" (&/T F2 A2))))
- state)]
- [["lux;Right" [state* output]]]
+ ("lux;Left" _)
+ (|case ((|do [F2 (deref ?aid)]
+ (check* class-loader fixpoints expected (&/V "lux;AppT" (&/T F2 A2))))
+ state)
+ ("lux;Right" state* output)
(return* state* output)
- [["lux;Left" _]]
+ ("lux;Left" _)
((|do [[fixpoints* _] (check* class-loader fixpoints (&/V "lux;VarT" ?eid) (&/V "lux;VarT" ?aid))
[fixpoints** _] (check* class-loader fixpoints* A1 A2)]
(return (&/T fixpoints** nil)))
@@ -697,15 +688,15 @@
;; _ (check* class-loader fixpoints A1 A2)]
;; (return (&/T fixpoints nil)))
- [["lux;AppT" [["lux;VarT" ?id] A1]] ["lux;AppT" [F2 A2]]]
+ [("lux;AppT" ("lux;VarT" ?id) A1) ("lux;AppT" F2 A2)]
(fn [state]
- (matchv ::M/objects [((|do [F1 (deref ?id)]
- (check* class-loader fixpoints (&/V "lux;AppT" (&/T F1 A1)) actual))
- state)]
- [["lux;Right" [state* output]]]
+ (|case ((|do [F1 (deref ?id)]
+ (check* class-loader fixpoints (&/V "lux;AppT" (&/T F1 A1)) actual))
+ state)
+ ("lux;Right" state* output)
(return* state* output)
- [["lux;Left" _]]
+ ("lux;Left" _)
((|do [[fixpoints* _] (check* class-loader fixpoints (&/V "lux;VarT" ?id) F2)
e* (apply-type F2 A1)
a* (apply-type F2 A2)
@@ -719,15 +710,15 @@
;; [fixpoints** _] (check* class-loader fixpoints* e* a*)]
;; (return (&/T fixpoints** nil)))
- [["lux;AppT" [F1 A1]] ["lux;AppT" [["lux;VarT" ?id] A2]]]
+ [("lux;AppT" F1 A1) ("lux;AppT" ("lux;VarT" ?id) A2)]
(fn [state]
- (matchv ::M/objects [((|do [F2 (deref ?id)]
- (check* class-loader fixpoints expected (&/V "lux;AppT" (&/T F2 A2))))
- state)]
- [["lux;Right" [state* output]]]
+ (|case ((|do [F2 (deref ?id)]
+ (check* class-loader fixpoints expected (&/V "lux;AppT" (&/T F2 A2))))
+ state)
+ ("lux;Right" state* output)
(return* state* output)
- [["lux;Left" _]]
+ ("lux;Left" _)
((|do [[fixpoints* _] (check* class-loader fixpoints F1 (&/V "lux;VarT" ?id))
e* (apply-type F1 A1)
a* (apply-type F1 A2)
@@ -741,7 +732,7 @@
;; [fixpoints** _] (check* class-loader fixpoints* e* a*)]
;; (return (&/T fixpoints** nil)))
- [["lux;AppT" [F A]] _]
+ [("lux;AppT" F A) _]
(let [fp-pair (&/T expected actual)
_ (when (> (&/|length fixpoints) 40)
(println 'FIXPOINTS (->> (&/|keys fixpoints)
@@ -752,33 +743,33 @@
(&/|interpose "\n\n")
(&/fold str "")))
(assert false))]
- (matchv ::M/objects [(fp-get fp-pair fixpoints)]
- [["lux;Some" ?]]
+ (|case (fp-get fp-pair fixpoints)
+ ("lux;Some" ?)
(if ?
(return (&/T fixpoints nil))
(fail (check-error expected actual)))
- [["lux;None" _]]
+ ("lux;None")
(|do [expected* (apply-type F A)]
(check* class-loader (fp-put fp-pair true fixpoints) expected* actual))))
- [_ ["lux;AppT" [F A]]]
+ [_ ("lux;AppT" F A)]
(|do [actual* (apply-type F A)]
(check* class-loader fixpoints expected actual*))
- [["lux;AllT" _] _]
+ [("lux;AllT" _) _]
(with-var
(fn [$arg]
(|do [expected* (apply-type expected $arg)]
(check* class-loader fixpoints expected* actual))))
- [_ ["lux;AllT" _]]
+ [_ ("lux;AllT" _)]
(with-var
(fn [$arg]
(|do [actual* (apply-type actual $arg)]
(check* class-loader fixpoints expected actual*))))
- [["lux;DataT" e!name] ["lux;DataT" "null"]]
+ [("lux;DataT" e!name) ("lux;DataT" "null")]
(if (contains? primitive-types e!name)
(fail (str "[Type Error] Can't use \"null\" with primitive types."))
(return (&/T fixpoints nil)))
@@ -791,11 +782,11 @@
(return (&/T fixpoints nil))
(fail (str "[Type Error] Names don't match: " e!name " =/= " a!name))))
- [["lux;LambdaT" [eI eO]] ["lux;LambdaT" [aI aO]]]
+ [("lux;LambdaT" eI eO) ("lux;LambdaT" aI aO)]
(|do [[fixpoints* _] (check* class-loader fixpoints aI eI)]
(check* class-loader fixpoints* eO aO))
- [["lux;TupleT" e!members] ["lux;TupleT" a!members]]
+ [("lux;TupleT" e!members) ("lux;TupleT" a!members)]
(|do [fixpoints* (&/fold2% (fn [fp e a]
(|do [[fp* _] (check* class-loader fp e a)]
(return fp*)))
@@ -803,7 +794,7 @@
e!members a!members)]
(return (&/T fixpoints* nil)))
- [["lux;VariantT" e!cases] ["lux;VariantT" a!cases]]
+ [("lux;VariantT" e!cases) ("lux;VariantT" a!cases)]
(|do [fixpoints* (&/fold2% (fn [fp e!case a!case]
(|let [[e!name e!type] e!case
[a!name a!type] a!case]
@@ -815,7 +806,7 @@
e!cases a!cases)]
(return (&/T fixpoints* nil)))
- [["lux;RecordT" e!slots] ["lux;RecordT" a!slots]]
+ [("lux;RecordT" e!slots) ("lux;RecordT" a!slots)]
(|do [fixpoints* (&/fold2% (fn [fp e!slot a!slot]
(|let [[e!name e!type] e!slot
[a!name a!type] a!slot]
@@ -827,7 +818,7 @@
e!slots a!slots)]
(return (&/T fixpoints* nil)))
- [["lux;ExT" e!id] ["lux;ExT" a!id]]
+ [("lux;ExT" e!id) ("lux;ExT" a!id)]
(if (.equals ^Object e!id a!id)
(return (&/T fixpoints nil))
(fail (check-error expected actual)))
@@ -842,41 +833,41 @@
(return nil)))
(defn apply-lambda [func param]
- (matchv ::M/objects [func]
- [["lux;LambdaT" [input output]]]
+ (|case func
+ ("lux;LambdaT" input output)
(|do [_ (check* init-fixpoints input param)]
(return output))
- [["lux;AllT" _]]
+ ("lux;AllT" _)
(with-var
(fn [$var]
(|do [func* (apply-type func $var)
=return (apply-lambda func* param)]
(clean $var =return))))
- [_]
+ _
(fail (str "[Type System] Not a function type:\n" (show-type func) "\n"))
))
(defn actual-type [type]
- (matchv ::M/objects [type]
- [["lux;AppT" [?all ?param]]]
+ (|case type
+ ("lux;AppT" ?all ?param)
(|do [type* (apply-type ?all ?param)]
(actual-type type*))
- [["lux;VarT" ?id]]
+ ("lux;VarT" ?id)
(deref ?id)
- [_]
+ _
(return type)
))
(defn variant-case [case type]
- (matchv ::M/objects [type]
- [["lux;VariantT" ?cases]]
+ (|case type
+ ("lux;VariantT" ?cases)
(if-let [case-type (&/|get case ?cases)]
(return case-type)
(fail (str "[Type Error] Variant lacks case: " case " | " (show-type type))))
- [_]
+ _
(fail (str "[Type Error] Type is not a variant: " (show-type type)))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-16 12:05:25 +0000