diff options
| author | Eduardo Julian | 2015-08-06 20:03:04 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2015-08-06 20:03:04 -0400 |
| commit | 8c448ad5500a732b2fd560f26d5e75fcaac80917 (patch) | |
| tree | 118ade3320cbd5b0ea1c6d8dab5a11b7775b10db | |
| parent | 39b1f7161c4fd5c9c5a90d2f85758ed9febfd4ef (diff) | |
Started factoring out the tags used in variants within the compiler.
Diffstat (limited to '')
| -rw-r--r-- | src/lux/analyser.clj | 440 | ||||
| -rw-r--r-- | src/lux/analyser/base.clj | 2 | ||||
| -rw-r--r-- | src/lux/analyser/case.clj | 30 | ||||
| -rw-r--r-- | src/lux/analyser/env.clj | 2 | ||||
| -rw-r--r-- | src/lux/analyser/host.clj | 62 | ||||
| -rw-r--r-- | src/lux/analyser/lux.clj | 22 | ||||
| -rw-r--r-- | src/lux/analyser/module.clj | 6 | ||||
| -rw-r--r-- | src/lux/base.clj | 131 | ||||
| -rw-r--r-- | src/lux/compiler.clj | 8 | ||||
| -rw-r--r-- | src/lux/compiler/host.clj | 14 | ||||
| -rw-r--r-- | src/lux/compiler/type.clj | 12 | ||||
| -rw-r--r-- | src/lux/host.clj | 2 | ||||
| -rw-r--r-- | src/lux/lexer.clj | 18 | ||||
| -rw-r--r-- | src/lux/parser.clj | 32 | ||||
| -rw-r--r-- | src/lux/reader.clj | 18 | ||||
| -rw-r--r-- | src/lux/type.clj | 156 |
16 files changed, 487 insertions, 468 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index 95e8f5f43..0ad6553bf 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -22,17 +22,17 @@ ;; [Utils] (defn ^:private parse-handler [[catch+ finally+] token] (|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"))))))) + (&/$Meta meta (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_catch")) + (&/$Cons (&/$Meta _ (&/$TextS ?ex-class)) + (&/$Cons (&/$Meta _ (&/$SymbolS "" ?ex-arg)) + (&/$Cons ?catch-body + (&/$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"))))) - (return (&/T catch+ (&/V "lux;Some" ?finally-body))) + (&/$Meta meta (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_finally")) + (&/$Cons ?finally-body + (&/$Nil))))) + (return (&/T catch+ (&/V &/$Some ?finally-body))) _ (fail (str "[Analyser Error] Wrong syntax for exception handler: " (&/show-ast token))))) @@ -40,46 +40,46 @@ (defn ^:private aba7 [analyse eval! compile-module compile-token exo-type 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"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_new-array")) + (&/$Cons (&/$Meta _ (&/$SymbolS _ ?class)) + (&/$Cons (&/$Meta _ (&/$IntS ?length)) + (&/$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")))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_aastore")) + (&/$Cons ?array + (&/$Cons (&/$Meta _ (&/$IntS ?idx)) + (&/$Cons ?elem + (&/$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"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_aaload")) + (&/$Cons ?array + (&/$Cons (&/$Meta _ (&/$IntS ?idx)) + (&/$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")))))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_class")) + (&/$Cons (&/$Meta _ (&/$TextS ?name)) + (&/$Cons (&/$Meta _ (&/$TextS ?super-class)) + (&/$Cons (&/$Meta _ (&/$TupleS ?interfaces)) + (&/$Cons (&/$Meta _ (&/$TupleS ?fields)) + (&/$Cons (&/$Meta _ (&/$TupleS ?methods)) + (&/$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)))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_interface")) + (&/$Cons (&/$Meta _ (&/$TextS ?name)) + (&/$Cons (&/$Meta _ (&/$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"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_program")) + (&/$Cons (&/$Meta _ (&/$SymbolS "" ?args)) + (&/$Cons ?body + (&/$Nil))))) (&&host/analyse-jvm-program analyse compile-token ?args ?body) _ @@ -88,86 +88,86 @@ (defn ^:private aba6 [analyse eval! compile-module compile-token exo-type token] (|case token ;; Primitive conversions - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_d2f")) ("lux;Cons" ?value ("lux;Nil")))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_d2f")) (&/$Cons ?value (&/$Nil)))) (&&host/analyse-jvm-d2f analyse exo-type ?value) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_d2i")) ("lux;Cons" ?value ("lux;Nil")))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_d2i")) (&/$Cons ?value (&/$Nil)))) (&&host/analyse-jvm-d2i analyse exo-type ?value) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_d2l")) ("lux;Cons" ?value ("lux;Nil")))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_d2l")) (&/$Cons ?value (&/$Nil)))) (&&host/analyse-jvm-d2l analyse exo-type ?value) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_f2d")) ("lux;Cons" ?value ("lux;Nil")))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_f2d")) (&/$Cons ?value (&/$Nil)))) (&&host/analyse-jvm-f2d analyse exo-type ?value) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_f2i")) ("lux;Cons" ?value ("lux;Nil")))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_f2i")) (&/$Cons ?value (&/$Nil)))) (&&host/analyse-jvm-f2i analyse exo-type ?value) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_f2l")) ("lux;Cons" ?value ("lux;Nil")))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_f2l")) (&/$Cons ?value (&/$Nil)))) (&&host/analyse-jvm-f2l analyse exo-type ?value) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_i2b")) ("lux;Cons" ?value ("lux;Nil")))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_i2b")) (&/$Cons ?value (&/$Nil)))) (&&host/analyse-jvm-i2b analyse exo-type ?value) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_i2c")) ("lux;Cons" ?value ("lux;Nil")))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_i2c")) (&/$Cons ?value (&/$Nil)))) (&&host/analyse-jvm-i2c analyse exo-type ?value) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_i2d")) ("lux;Cons" ?value ("lux;Nil")))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_i2d")) (&/$Cons ?value (&/$Nil)))) (&&host/analyse-jvm-i2d analyse exo-type ?value) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_i2f")) ("lux;Cons" ?value ("lux;Nil")))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_i2f")) (&/$Cons ?value (&/$Nil)))) (&&host/analyse-jvm-i2f analyse exo-type ?value) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_i2l")) ("lux;Cons" ?value ("lux;Nil")))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_i2l")) (&/$Cons ?value (&/$Nil)))) (&&host/analyse-jvm-i2l analyse exo-type ?value) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_i2s")) ("lux;Cons" ?value ("lux;Nil")))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_i2s")) (&/$Cons ?value (&/$Nil)))) (&&host/analyse-jvm-i2s analyse exo-type ?value) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_l2d")) ("lux;Cons" ?value ("lux;Nil")))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_l2d")) (&/$Cons ?value (&/$Nil)))) (&&host/analyse-jvm-l2d analyse exo-type ?value) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_l2f")) ("lux;Cons" ?value ("lux;Nil")))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_l2f")) (&/$Cons ?value (&/$Nil)))) (&&host/analyse-jvm-l2f analyse exo-type ?value) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_l2i")) ("lux;Cons" ?value ("lux;Nil")))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_l2i")) (&/$Cons ?value (&/$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"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_iand")) (&/$Cons ?x (&/$Cons ?y (&/$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"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_ior")) (&/$Cons ?x (&/$Cons ?y (&/$Nil))))) (&&host/analyse-jvm-ior analyse exo-type ?x ?y) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_ixor")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_ixor")) (&/$Cons ?x (&/$Cons ?y (&/$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"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_ishl")) (&/$Cons ?x (&/$Cons ?y (&/$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"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_ishr")) (&/$Cons ?x (&/$Cons ?y (&/$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"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_iushr")) (&/$Cons ?x (&/$Cons ?y (&/$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"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_land")) (&/$Cons ?x (&/$Cons ?y (&/$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"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_lor")) (&/$Cons ?x (&/$Cons ?y (&/$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"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_lxor")) (&/$Cons ?x (&/$Cons ?y (&/$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"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_lshl")) (&/$Cons ?x (&/$Cons ?y (&/$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"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_lshr")) (&/$Cons ?x (&/$Cons ?y (&/$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"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_lushr")) (&/$Cons ?x (&/$Cons ?y (&/$Nil))))) (&&host/analyse-jvm-lushr analyse exo-type ?x ?y) _ @@ -176,108 +176,108 @@ (defn ^:private aba5 [analyse eval! compile-module compile-token exo-type token] (|case token ;; Objects - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_null?")) - ("lux;Cons" ?object - ("lux;Nil")))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_null?")) + (&/$Cons ?object + (&/$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"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_instanceof")) + (&/$Cons (&/$Meta _ (&/$TextS ?class)) + (&/$Cons ?object + (&/$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")))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_new")) + (&/$Cons (&/$Meta _ (&/$TextS ?class)) + (&/$Cons (&/$Meta _ (&/$TupleS ?classes)) + (&/$Cons (&/$Meta _ (&/$TupleS ?args)) + (&/$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"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_getstatic")) + (&/$Cons (&/$Meta _ (&/$TextS ?class)) + (&/$Cons (&/$Meta _ (&/$TextS ?field)) + (&/$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")))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_getfield")) + (&/$Cons (&/$Meta _ (&/$TextS ?class)) + (&/$Cons (&/$Meta _ (&/$TextS ?field)) + (&/$Cons ?object + (&/$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")))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_putstatic")) + (&/$Cons (&/$Meta _ (&/$TextS ?class)) + (&/$Cons (&/$Meta _ (&/$TextS ?field)) + (&/$Cons ?value + (&/$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"))))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_putfield")) + (&/$Cons (&/$Meta _ (&/$TextS ?class)) + (&/$Cons (&/$Meta _ (&/$TextS ?field)) + (&/$Cons ?object + (&/$Cons ?value + (&/$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"))))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_invokestatic")) + (&/$Cons (&/$Meta _ (&/$TextS ?class)) + (&/$Cons (&/$Meta _ (&/$TextS ?method)) + (&/$Cons (&/$Meta _ (&/$TupleS ?classes)) + (&/$Cons (&/$Meta _ (&/$TupleS ?args)) + (&/$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")))))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_invokevirtual")) + (&/$Cons (&/$Meta _ (&/$TextS ?class)) + (&/$Cons (&/$Meta _ (&/$TextS ?method)) + (&/$Cons (&/$Meta _ (&/$TupleS ?classes)) + (&/$Cons ?object + (&/$Cons (&/$Meta _ (&/$TupleS ?args)) + (&/$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")))))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_invokeinterface")) + (&/$Cons (&/$Meta _ (&/$TextS ?class)) + (&/$Cons (&/$Meta _ (&/$TextS ?method)) + (&/$Cons (&/$Meta _ (&/$TupleS ?classes)) + (&/$Cons ?object + (&/$Cons (&/$Meta _ (&/$TupleS ?args)) + (&/$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")))))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_invokespecial")) + (&/$Cons (&/$Meta _ (&/$TextS ?class)) + (&/$Cons (&/$Meta _ (&/$TextS ?method)) + (&/$Cons (&/$Meta _ (&/$TupleS ?classes)) + (&/$Cons ?object + (&/$Cons (&/$Meta _ (&/$TupleS ?args)) + (&/$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))) - (|do [catches+finally (&/fold% parse-handler (&/T (&/|list) (&/V "lux;None" nil)) ?handlers)] + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_try")) + (&/$Cons ?body + ?handlers))) + (|do [catches+finally (&/fold% parse-handler (&/T (&/|list) (&/V &/$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")))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_throw")) + (&/$Cons ?ex + (&/$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")))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_monitorenter")) + (&/$Cons ?monitor + (&/$Nil)))) (&&host/analyse-jvm-monitorenter analyse exo-type ?monitor) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_monitorexit")) - ("lux;Cons" ?monitor - ("lux;Nil")))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_monitorexit")) + (&/$Cons ?monitor + (&/$Nil)))) (&&host/analyse-jvm-monitorexit analyse exo-type ?monitor) _ @@ -286,53 +286,53 @@ (defn ^:private aba4 [analyse eval! compile-module compile-token exo-type token] (|case token ;; Float arithmetic - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_fadd")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_fadd")) (&/$Cons ?x (&/$Cons ?y (&/$Nil))))) (&&host/analyse-jvm-fadd analyse exo-type ?x ?y) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_fsub")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_fsub")) (&/$Cons ?x (&/$Cons ?y (&/$Nil))))) (&&host/analyse-jvm-fsub analyse exo-type ?x ?y) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_fmul")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_fmul")) (&/$Cons ?x (&/$Cons ?y (&/$Nil))))) (&&host/analyse-jvm-fmul analyse exo-type ?x ?y) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_fdiv")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_fdiv")) (&/$Cons ?x (&/$Cons ?y (&/$Nil))))) (&&host/analyse-jvm-fdiv analyse exo-type ?x ?y) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_frem")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_frem")) (&/$Cons ?x (&/$Cons ?y (&/$Nil))))) (&&host/analyse-jvm-frem analyse exo-type ?x ?y) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_feq")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_feq")) (&/$Cons ?x (&/$Cons ?y (&/$Nil))))) (&&host/analyse-jvm-feq analyse exo-type ?x ?y) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_flt")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_flt")) (&/$Cons ?x (&/$Cons ?y (&/$Nil))))) (&&host/analyse-jvm-flt analyse exo-type ?x ?y) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_fgt")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_fgt")) (&/$Cons ?x (&/$Cons ?y (&/$Nil))))) (&&host/analyse-jvm-fgt analyse exo-type ?x ?y) ;; Double arithmetic - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_dadd")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_dadd")) (&/$Cons ?x (&/$Cons ?y (&/$Nil))))) (&&host/analyse-jvm-dadd analyse exo-type ?x ?y) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_dsub")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_dsub")) (&/$Cons ?x (&/$Cons ?y (&/$Nil))))) (&&host/analyse-jvm-dsub analyse exo-type ?x ?y) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_dmul")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_dmul")) (&/$Cons ?x (&/$Cons ?y (&/$Nil))))) (&&host/analyse-jvm-dmul analyse exo-type ?x ?y) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_ddiv")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_ddiv")) (&/$Cons ?x (&/$Cons ?y (&/$Nil))))) (&&host/analyse-jvm-ddiv analyse exo-type ?x ?y) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_drem")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_drem")) (&/$Cons ?x (&/$Cons ?y (&/$Nil))))) (&&host/analyse-jvm-drem analyse exo-type ?x ?y) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_deq")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_deq")) (&/$Cons ?x (&/$Cons ?y (&/$Nil))))) (&&host/analyse-jvm-deq analyse exo-type ?x ?y) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_dlt")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_dlt")) (&/$Cons ?x (&/$Cons ?y (&/$Nil))))) (&&host/analyse-jvm-dlt analyse exo-type ?x ?y) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_dgt")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_dgt")) (&/$Cons ?x (&/$Cons ?y (&/$Nil))))) (&&host/analyse-jvm-dgt analyse exo-type ?x ?y) _ @@ -342,63 +342,63 @@ (|case token ;; Host special forms ;; Characters - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_ceq")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_ceq")) (&/$Cons ?x (&/$Cons ?y (&/$Nil))))) (&&host/analyse-jvm-ceq analyse exo-type ?x ?y) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_clt")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_clt")) (&/$Cons ?x (&/$Cons ?y (&/$Nil))))) (&&host/analyse-jvm-clt analyse exo-type ?x ?y) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_cgt")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_cgt")) (&/$Cons ?x (&/$Cons ?y (&/$Nil))))) (&&host/analyse-jvm-cgt analyse exo-type ?x ?y) ;; Integer arithmetic - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_iadd")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_iadd")) (&/$Cons ?x (&/$Cons ?y (&/$Nil))))) (&&host/analyse-jvm-iadd analyse exo-type ?x ?y) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_isub")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_isub")) (&/$Cons ?x (&/$Cons ?y (&/$Nil))))) (&&host/analyse-jvm-isub analyse exo-type ?x ?y) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_imul")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_imul")) (&/$Cons ?x (&/$Cons ?y (&/$Nil))))) (&&host/analyse-jvm-imul analyse exo-type ?x ?y) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_idiv")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_idiv")) (&/$Cons ?x (&/$Cons ?y (&/$Nil))))) (&&host/analyse-jvm-idiv analyse exo-type ?x ?y) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_irem")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_irem")) (&/$Cons ?x (&/$Cons ?y (&/$Nil))))) (&&host/analyse-jvm-irem analyse exo-type ?x ?y) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_ieq")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_ieq")) (&/$Cons ?x (&/$Cons ?y (&/$Nil))))) (&&host/analyse-jvm-ieq analyse exo-type ?x ?y) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_ilt")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_ilt")) (&/$Cons ?x (&/$Cons ?y (&/$Nil))))) (&&host/analyse-jvm-ilt analyse exo-type ?x ?y) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_igt")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_igt")) (&/$Cons ?x (&/$Cons ?y (&/$Nil))))) (&&host/analyse-jvm-igt analyse exo-type ?x ?y) ;; Long arithmetic - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_ladd")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_ladd")) (&/$Cons ?x (&/$Cons ?y (&/$Nil))))) (&&host/analyse-jvm-ladd analyse exo-type ?x ?y) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_lsub")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_lsub")) (&/$Cons ?x (&/$Cons ?y (&/$Nil))))) (&&host/analyse-jvm-lsub analyse exo-type ?x ?y) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_lmul")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_lmul")) (&/$Cons ?x (&/$Cons ?y (&/$Nil))))) (&&host/analyse-jvm-lmul analyse exo-type ?x ?y) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_ldiv")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_ldiv")) (&/$Cons ?x (&/$Cons ?y (&/$Nil))))) (&&host/analyse-jvm-ldiv analyse exo-type ?x ?y) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_lrem")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_lrem")) (&/$Cons ?x (&/$Cons ?y (&/$Nil))))) (&&host/analyse-jvm-lrem analyse exo-type ?x ?y) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_leq")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_leq")) (&/$Cons ?x (&/$Cons ?y (&/$Nil))))) (&&host/analyse-jvm-leq analyse exo-type ?x ?y) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_llt")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_llt")) (&/$Cons ?x (&/$Cons ?y (&/$Nil))))) (&&host/analyse-jvm-llt analyse exo-type ?x ?y) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_jvm_lgt")) ("lux;Cons" ?x ("lux;Cons" ?y ("lux;Nil"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_jvm_lgt")) (&/$Cons ?x (&/$Cons ?y (&/$Nil))))) (&&host/analyse-jvm-lgt analyse exo-type ?x ?y) _ @@ -406,57 +406,57 @@ (defn ^:private aba2 [analyse eval! compile-module compile-token exo-type token] (|case token - ("lux;SymbolS" ?ident) + (&/$SymbolS ?ident) (&&lux/analyse-symbol analyse exo-type ?ident) - ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" _ "_lux_case")) - ("lux;Cons" ?value ?branches))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_lux_case")) + (&/$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")))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_lux_lambda")) + (&/$Cons (&/$Meta _ (&/$SymbolS "" ?self)) + (&/$Cons (&/$Meta _ (&/$SymbolS "" ?arg)) + (&/$Cons ?body + (&/$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"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_lux_def")) + (&/$Cons (&/$Meta _ (&/$SymbolS "" ?name)) + (&/$Cons ?value + (&/$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")))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_lux_declare-macro")) + (&/$Cons (&/$Meta _ (&/$SymbolS "" ?name)) + (&/$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")))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_lux_import")) + (&/$Cons (&/$Meta _ (&/$TextS ?path)) + (&/$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"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_lux_:")) + (&/$Cons ?type + (&/$Cons ?value + (&/$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"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_lux_:!")) + (&/$Cons ?type + (&/$Cons ?value + (&/$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")))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_lux_export")) + (&/$Cons (&/$Meta _ (&/$SymbolS "" ?ident)) + (&/$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"))))) + (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_lux_alias")) + (&/$Cons (&/$Meta _ (&/$TextS ?alias)) + (&/$Cons (&/$Meta _ (&/$TextS ?module)) + (&/$Nil))))) (&&lux/analyse-alias analyse compile-token ?alias ?module) _ @@ -465,36 +465,36 @@ (defn ^:private aba1 [analyse eval! compile-module compile-token exo-type token] (|case token ;; Standard special forms - ("lux;BoolS" ?value) + (&/$BoolS ?value) (|do [_ (&type/check exo-type &type/Bool)] (return (&/|list (&/T (&/V "bool" ?value) exo-type)))) - ("lux;IntS" ?value) + (&/$IntS ?value) (|do [_ (&type/check exo-type &type/Int)] (return (&/|list (&/T (&/V "int" ?value) exo-type)))) - ("lux;RealS" ?value) + (&/$RealS ?value) (|do [_ (&type/check exo-type &type/Real)] (return (&/|list (&/T (&/V "real" ?value) exo-type)))) - ("lux;CharS" ?value) + (&/$CharS ?value) (|do [_ (&type/check exo-type &type/Char)] (return (&/|list (&/T (&/V "char" ?value) exo-type)))) - ("lux;TextS" ?value) + (&/$TextS ?value) (|do [_ (&type/check exo-type &type/Text)] (return (&/|list (&/T (&/V "text" ?value) exo-type)))) - ("lux;TupleS" ?elems) + (&/$TupleS ?elems) (&&lux/analyse-tuple analyse exo-type ?elems) - ("lux;RecordS" ?elems) + (&/$RecordS ?elems) (&&lux/analyse-record analyse exo-type ?elems) - ("lux;TagS" ?ident) + (&/$TagS ?ident) (&&lux/analyse-variant analyse exo-type ?ident (&/|list)) - ("lux;SymbolS" _ "_jvm_null") + (&/$SymbolS _ "_jvm_null") (&&host/analyse-jvm-null analyse exo-type) _ @@ -510,16 +510,16 @@ (defn ^:private analyse-basic-ast [analyse eval! compile-module compile-token exo-type token] ;; (prn 'analyse-basic-ast (&/show-ast token)) (|case token - ("lux;Meta" meta ?token) + (&/$Meta meta ?token) (fn [state] (|case ((aba1 analyse eval! compile-module compile-token exo-type ?token) state) - ("lux;Right" state* output) + (&/$Right state* output) (return* state* output) - ("lux;Left" "") + (&/$Left "") (fail* (add-loc (&/get$ &/$cursor state) (str "[Analyser Error] Unrecognized token: " (&/show-ast token)))) - ("lux;Left" msg) + (&/$Left msg) (fail* (add-loc (&/get$ &/$cursor state) msg)) )) )) @@ -543,13 +543,13 @@ (&/with-cursor (aget token 1 0) (&/with-expected-type exo-type (|case token - ("lux;Meta" meta ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;TagS" ?ident)) ?values))) + (&/$Meta meta (&/$FormS (&/$Cons (&/$Meta _ (&/$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))) + (&/$Meta meta (&/$FormS (&/$Cons ?fn ?args))) (fn [state] (|case ((just-analyse (partial analyse-ast eval! compile-module compile-token) ?fn) state) - ("lux;Right" state* =fn) + (&/$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*)) diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj index beeb57b08..ed81aa9bc 100644 --- a/src/lux/analyser/base.clj +++ b/src/lux/analyser/base.clj @@ -20,7 +20,7 @@ (defn analyse-1 [analyse exo-type elem] (|do [output (analyse exo-type elem)] (|case output - ("lux;Cons" x ("lux;Nil")) + (&/$Cons x (&/$Nil)) (return x) _ diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj index 2cdf233cc..0bbbde2d7 100644 --- a/src/lux/analyser/case.clj +++ b/src/lux/analyser/case.clj @@ -17,7 +17,7 @@ ;; [Utils] (def ^:private unit - (&/V "lux;Meta" (&/T (&/T "" -1 -1) (&/V "lux;TupleS" (&/|list))))) + (&/V &/$Meta (&/T (&/T "" -1 -1) (&/V &/$TupleS (&/|list))))) (defn ^:private resolve-type [type] (|case type @@ -113,43 +113,43 @@ (adjust-type* (&/|list) type)) (defn ^:private analyse-pattern [value-type pattern kont] - (|let [("lux;Meta" _ pattern*) pattern] + (|let [(&/$Meta _ pattern*) pattern] (|case pattern* - ("lux;SymbolS" "" name) + (&/$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) + (&/$SymbolS ident) (fail (str "[Pattern-matching Error] Symbols must be unqualified: " (&/ident->text ident))) - ("lux;BoolS" ?value) + (&/$BoolS ?value) (|do [_ (&type/check value-type &type/Bool) =kont kont] (return (&/T (&/V "BoolTestAC" ?value) =kont))) - ("lux;IntS" ?value) + (&/$IntS ?value) (|do [_ (&type/check value-type &type/Int) =kont kont] (return (&/T (&/V "IntTestAC" ?value) =kont))) - ("lux;RealS" ?value) + (&/$RealS ?value) (|do [_ (&type/check value-type &type/Real) =kont kont] (return (&/T (&/V "RealTestAC" ?value) =kont))) - ("lux;CharS" ?value) + (&/$CharS ?value) (|do [_ (&type/check value-type &type/Char) =kont kont] (return (&/T (&/V "CharTestAC" ?value) =kont))) - ("lux;TextS" ?value) + (&/$TextS ?value) (|do [_ (&type/check value-type &type/Text) =kont kont] (return (&/T (&/V "TextTestAC" ?value) =kont))) - ("lux;TupleS" ?members) + (&/$TupleS ?members) (|do [value-type* (adjust-type value-type)] (do ;; (prn 'PM/TUPLE-1 (&type/show-type value-type*)) (|case value-type* @@ -169,7 +169,7 @@ _ (fail (str "[Pattern-matching Error] Tuples require tuple-types: " (&type/show-type value-type*)))))) - ("lux;RecordS" ?slots) + (&/$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*))] @@ -182,7 +182,7 @@ (|do [[=tests =kont] (&/fold (fn [kont* slot] (|let [[sn sv] slot] (|case sn - ("lux;Meta" _ ("lux;TagS" ?ident)) + (&/$Meta _ (&/$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*)] @@ -199,14 +199,14 @@ _ (fail "[Pattern-matching Error] Record requires record-type."))) - ("lux;TagS" ?ident) + (&/$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)) + (&/$FormS (&/$Cons (&/$Meta _ (&/$TagS ?ident)) ?values)) (|do [=tag (&&/resolved-ident ?ident) value-type* (adjust-type value-type) @@ -215,7 +215,7 @@ 0 (analyse-pattern case-type unit kont) 1 (analyse-pattern case-type (&/|head ?values) kont) ;; 1+ - (analyse-pattern case-type (&/V "lux;Meta" (&/T (&/T "" -1 -1) (&/V "lux;TupleS" ?values))) kont))] + (analyse-pattern case-type (&/V &/$Meta (&/T (&/T "" -1 -1) (&/V &/$TupleS ?values))) kont))] (return (&/T (&/V "VariantTestAC" (&/T =tag =test)) =kont))) ))) diff --git a/src/lux/analyser/env.clj b/src/lux/analyser/env.clj index a39ec490a..9a8a6a3d7 100644 --- a/src/lux/analyser/env.clj +++ b/src/lux/analyser/env.clj @@ -32,7 +32,7 @@ (&/|tail stack)))) state))] (|case =return - ("lux;Right" ?state ?value) + (&/$Right ?state ?value) (return* (&/update$ &/$ENVS (fn [stack*] (&/|cons (&/update$ &/$LOCALS #(->> % (&/update$ &/$COUNTER dec) diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index 707060323..06cb5ebfc 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -20,7 +20,7 @@ ;; [Utils] (defn ^:private extract-text [text] (|case text - ("lux;Meta" _ ("lux;TextS" ?text)) + (&/$Meta _ (&/$TextS ?text)) (return ?text) _ @@ -208,7 +208,7 @@ (defn analyse-jvm-new-array [analyse ?class ?length] (return (&/|list (&/T (&/V "jvm-new-array" (&/T ?class ?length)) (&/V "array" (&/T (&/V "lux;DataT" ?class) - (&/V "lux;Nil" nil))))))) + (&/V &/$Nil nil))))))) (defn analyse-jvm-aastore [analyse ?array ?idx ?elem] (|do [=array (analyse-1+ analyse ?array) @@ -224,28 +224,28 @@ (defn ^:private analyse-modifiers [modifiers] (&/fold% (fn [so-far modif] (|case modif - ("lux;Meta" _ ("lux;TextS" "public")) + (&/$Meta _ (&/$TextS "public")) (return (assoc so-far :visibility "public")) - ("lux;Meta" _ ("lux;TextS" "private")) + (&/$Meta _ (&/$TextS "private")) (return (assoc so-far :visibility "private")) - ("lux;Meta" _ ("lux;TextS" "protected")) + (&/$Meta _ (&/$TextS "protected")) (return (assoc so-far :visibility "protected")) - ("lux;Meta" _ ("lux;TextS" "static")) + (&/$Meta _ (&/$TextS "static")) (return (assoc so-far :static? true)) - ("lux;Meta" _ ("lux;TextS" "final")) + (&/$Meta _ (&/$TextS "final")) (return (assoc so-far :final? true)) - ("lux;Meta" _ ("lux;TextS" "abstract")) + (&/$Meta _ (&/$TextS "abstract")) (return (assoc so-far :abstract? true)) - ("lux;Meta" _ ("lux;TextS" "synchronized")) + (&/$Meta _ (&/$TextS "synchronized")) (return (assoc so-far :concurrency "synchronized")) - ("lux;Meta" _ ("lux;TextS" "volatile")) + (&/$Meta _ (&/$TextS "volatile")) (return (assoc so-far :concurrency "volatile")) _ @@ -275,10 +275,10 @@ (|do [=interfaces (&/map% extract-text ?interfaces) =fields (&/map% (fn [?field] (|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")))))) + (&/$Meta _ (&/$FormS (&/$Cons (&/$Meta _ (&/$TextS ?field-name)) + (&/$Cons (&/$Meta _ (&/$TextS ?field-type)) + (&/$Cons (&/$Meta _ (&/$TupleS ?field-modifiers)) + (&/$Nil)))))) (|do [=field-modifiers (analyse-modifiers ?field-modifiers)] (return {:name ?field-name :modifiers =field-modifiers @@ -289,17 +289,17 @@ ?fields) =methods (&/map% (fn [?method] (|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"))))))))] + [?idx (&/$Meta _ (&/$FormS (&/$Cons (&/$Meta _ (&/$TextS ?method-name)) + (&/$Cons (&/$Meta _ (&/$TupleS ?method-inputs)) + (&/$Cons (&/$Meta _ (&/$TextS ?method-output)) + (&/$Cons (&/$Meta _ (&/$TupleS ?method-modifiers)) + (&/$Cons ?method-body + (&/$Nil))))))))] (|do [=method-inputs (&/map% (fn [minput] (|case minput - ("lux;Meta" _ ("lux;FormS" ("lux;Cons" ("lux;Meta" _ ("lux;SymbolS" "" ?input-name)) - ("lux;Cons" ("lux;Meta" _ ("lux;TextS" ?input-type)) - ("lux;Nil"))))) + (&/$Meta _ (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS "" ?input-name)) + (&/$Cons (&/$Meta _ (&/$TextS ?input-type)) + (&/$Nil))))) (return (&/T ?input-name ?input-type)) _ @@ -334,11 +334,11 @@ (|do [=supers (&/map% extract-text ?supers) =methods (&/map% (fn [method] (|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"))))))) + (&/$Meta _ (&/$FormS (&/$Cons (&/$Meta _ (&/$TextS ?method-name)) + (&/$Cons (&/$Meta _ (&/$TupleS ?inputs)) + (&/$Cons (&/$Meta _ (&/$TextS ?output)) + (&/$Cons (&/$Meta _ (&/$TupleS ?modifiers)) + (&/$Nil))))))) (|do [=inputs (&/map% extract-text ?inputs) =modifiers (analyse-modifiers ?modifiers)] (return {:name ?method-name @@ -362,9 +362,9 @@ (return (&/T ?ex-class idx =catch-body)))) ?catches) =finally (|case [?finally] - ("lux;None") (return (&/V "lux;None" nil)) - ("lux;Some" ?finally*) (|do [=finally (analyse-1+ analyse ?finally*)] - (return (&/V "lux;Some" =finally))))] + (&/$None) (return (&/V &/$None nil)) + (&/$Some ?finally*) (|do [=finally (analyse-1+ analyse ?finally*)] + (return (&/V &/$Some =finally))))] (return (&/|list (&/T (&/V "jvm-try" (&/T =body =catches =finally)) exo-type))))) (defn analyse-jvm-throw [analyse exo-type ?ex] diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index cd89764c3..ac7e56ef4 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -30,8 +30,8 @@ (defn ^:private with-cursor [cursor form] (|case form - ("lux;Meta" _ syntax) - (&/V "lux;Meta" (&/T cursor syntax)))) + (&/$Meta _ syntax) + (&/V &/$Meta (&/T cursor syntax)))) ;; [Exports] (defn analyse-tuple [analyse exo-type ?elems] @@ -55,17 +55,17 @@ (defn ^:private analyse-variant-body [analyse exo-type ?values] (|do [output (|case ?values - ("lux;Nil") + (&/$Nil) (analyse-tuple analyse exo-type (&/|list)) - ("lux;Cons" ?value ("lux;Nil")) + (&/$Cons ?value (&/$Nil)) (analyse exo-type ?value) _ (analyse-tuple analyse exo-type ?values) )] (|case output - ("lux;Cons" x ("lux;Nil")) + (&/$Cons x (&/$Nil)) (return x) _ @@ -128,7 +128,7 @@ (str "[Analyser Error] Record length mismatch. Expected: " (&/|length types) "; actual: " (&/|length ?elems))) =slots (&/map% (fn [kv] (|case kv - [("lux;Meta" _ ["lux;TagS" ?ident]) ?value] + [(&/$Meta _ (&/$TagS ?ident)) ?value] (|do [?tag (&&/resolved-ident ?ident) slot-type (if-let [slot-type (&/|get ?tag types)] (return slot-type) @@ -167,12 +167,12 @@ (->> % (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS) (&/|contains? name) not)) [inner outer] (&/|split-with no-binding? stack)] (|case outer - ("lux;Nil") + (&/$Nil) (&/run-state (|do [module-name &/get-module-name] (analyse-global analyse exo-type module-name name)) state) - ("lux;Cons" ?genv ("lux;Nil")) + (&/$Cons ?genv (&/$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)) @@ -202,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 _) + (&/$Cons top-outer _) (do ;; (prn 'analyse-symbol/_3 ?module name) (|let [scopes (&/|tail (&/folds #(&/|cons (&/get$ &/$NAME %2) %1) (&/|map #(&/get$ &/$NAME %) outer) @@ -231,11 +231,11 @@ (defn ^:private analyse-apply* [analyse exo-type fun-type ?args] ;; (prn 'analyse-apply* (aget fun-type 0)) (|case ?args - ("lux;Nil") + (&/$Nil) (|do [_ (&type/check exo-type fun-type)] (return (&/T fun-type (&/|list)))) - ("lux;Cons" ?arg ?args*) + (&/$Cons ?arg ?args*) (|do [?fun-type* (&type/actual-type fun-type)] (|case ?fun-type* ("lux;AllT" _aenv _aname _aarg _abody) diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj index c92b7b976..78f5c675d 100644 --- a/src/lux/analyser/module.clj +++ b/src/lux/analyser/module.clj @@ -45,7 +45,7 @@ (defn define [module name def-data type] (fn [state] (|case (&/get$ &/$ENVS state) - ("lux;Cons" ?env ("lux;Nil")) + (&/$Cons ?env (&/$Nil)) (return* (->> state (&/update$ &/$MODULES (fn [ms] @@ -85,7 +85,7 @@ ;; (prn 'def-alias [a-module a-name] [r-module r-name] (&type/show-type type)) (fn [state] (|case (&/get$ &/$ENVS state) - ("lux;Cons" ?env ("lux;Nil")) + (&/$Cons ?env (&/$Nil)) (return* (->> state (&/update$ &/$MODULES (fn [ms] @@ -188,7 +188,7 @@ (defn export [module name] (fn [state] (|case (&/get$ &/$ENVS state) - ("lux;Cons" ?env ("lux;Nil")) + (&/$Cons ?env (&/$Nil)) (if-let [$def (->> state (&/get$ &/$MODULES) (&/|get module) (&/get$ $DEFS) (&/|get name))] (|case $def [true _] diff --git a/src/lux/base.clj b/src/lux/base.clj index bcd113daa..7ec9e3029 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -15,6 +15,25 @@ (def $Nil "lux;Nil") (def $Cons "lux;Cons") +(def $None "lux;None") +(def $Some "lux;Some") + +(def $Meta "lux;Meta") + +(def $Left "lux;Left") +(def $Right "lux;Right") + +(def $BoolS "lux;BoolS") +(def $IntS "lux;IntS") +(def $RealS "lux;RealS") +(def $CharS "lux;CharS") +(def $TextS "lux;TextS") +(def $SymbolS "lux;SymbolS") +(def $TagS "lux;TagS") +(def $FormS "lux;FormS") +(def $TupleS "lux;TupleS") +(def $RecordS "lux;RecordS") + ;; [Fields] ;; Binding (def $COUNTER 0) @@ -69,10 +88,10 @@ record#))) (defn fail* [message] - (V "lux;Left" message)) + (V $Left message)) (defn return* [state value] - (V "lux;Right" (T state value))) + (V $Right (T state value))) (defn transform-pattern [pattern] (cond (vector? pattern) (mapv transform-pattern pattern) @@ -107,8 +126,8 @@ (defmacro |list [& elems] (reduce (fn [tail head] - `(V "lux;Cons" (T ~head ~tail))) - `(V "lux;Nil" nil) + `(V $Cons (T ~head ~tail))) + `(V $Nil nil) (reverse elems))) (defmacro |table [& elems] @@ -130,12 +149,12 @@ (defn |put [slot value table] (|case table ($Nil) - (V "lux;Cons" (T (T slot value) (V "lux;Nil" nil))) + (V $Cons (T (T slot value) (V $Nil nil))) ($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 $Cons (T (T slot value) table*)) + (V $Cons (T (T k v) (|put slot value table*)))) _ (assert false (prn-str '|put (aget table 0))))) @@ -148,7 +167,7 @@ ($Cons [k v] table*) (if (.equals ^Object k slot) table* - (V "lux;Cons" (T (T k v) (|remove slot table*)))))) + (V $Cons (T (T k v) (|remove slot table*)))))) (defn |update [k f table] (|case table @@ -157,8 +176,8 @@ ($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*)))))) + (V $Cons (T (T k* (f v)) table*)) + (V $Cons (T (T k* v) (|update k f table*)))))) (defn |head [xs] (|case xs @@ -179,20 +198,20 @@ ;; [Resources/Monads] (defn fail [message] (fn [_] - (V "lux;Left" message))) + (V $Left message))) (defn return [value] (fn [state] - (V "lux;Right" (T state value)))) + (V $Right (T state value)))) (defn bind [m-value step] (fn [state] (let [inputs (m-value state)] (|case inputs - ("lux;Right" ?state ?datum) + ($Right ?state ?datum) ((step ?datum) ?state) - ("lux;Left" _) + ($Left _) inputs )))) @@ -212,7 +231,7 @@ ;; [Resources/Combinators] (defn |cons [head tail] - (V "lux;Cons" (T head tail))) + (V $Cons (T head tail))) (defn |++ [xs ys] (|case xs @@ -220,7 +239,7 @@ ys ($Cons x xs*) - (V "lux;Cons" (T x (|++ xs* ys))))) + (V $Cons (T x (|++ xs* ys))))) (defn |map [f xs] (|case xs @@ -228,7 +247,7 @@ xs ($Cons x xs*) - (V "lux;Cons" (T (f x) (|map f xs*))))) + (V $Cons (T (f x) (|map f xs*))))) (defn |empty? [xs] (|case xs @@ -245,7 +264,7 @@ ($Cons x xs*) (if (p x) - (V "lux;Cons" (T x (|filter p xs*))) + (V $Cons (T x (|filter p xs*))) (|filter p xs*)))) (defn flat-map [f xs] @@ -265,7 +284,7 @@ (if (p x) (|let [[pre post] (|split-with p xs*)] (T (|cons x pre) post)) - (T (V "lux;Nil" nil) xs)))) + (T (V $Nil nil) xs)))) (defn |contains? [k table] (|case table @@ -306,8 +325,8 @@ (let [|range* (fn |range* [from to] (if (< from to) - (V "lux;Cons" (T from (|range* (inc from) to))) - (V "lux;Nil" nil)))] + (V $Cons (T from (|range* (inc from) to))) + (V $Nil nil)))] (defn |range [n] (|range* 0 n))) @@ -322,10 +341,10 @@ (defn zip2 [xs ys] (|case [xs ys] [($Cons x xs*) ($Cons y ys*)] - (V "lux;Cons" (T (T x y) (zip2 xs* ys*))) + (V $Cons (T (T x y) (zip2 xs* ys*))) [_ _] - (V "lux;Nil" nil))) + (V $Nil nil))) (defn |keys [plist] (|case plist @@ -352,7 +371,7 @@ xs ($Cons x xs*) - (V "lux;Cons" (T x (V "lux;Cons" (T sep (|interpose sep xs*))))))) + (V $Cons (T x (V $Cons (T sep (|interpose sep xs*))))))) (do-template [<name> <joiner>] (defn <name> [f xs] @@ -369,15 +388,15 @@ flat-map% |++) (defn list-join [xss] - (fold |++ (V "lux;Nil" nil) xss)) + (fold |++ (V $Nil nil) xss)) (defn |as-pairs [xs] (|case xs ($Cons x ($Cons y xs*)) - (V "lux;Cons" (T (T x y) (|as-pairs xs*))) + (V $Cons (T (T x y) (|as-pairs xs*))) _ - (V "lux;Nil" nil))) + (V $Nil nil))) (defn |reverse [xs] (fold (fn [tail head] @@ -403,7 +422,7 @@ (fn [state] (let [output (m state)] (|case [output monads*] - [("lux;Right" _) _] + [($Right _) _] output [_ ($Nil)] @@ -423,10 +442,10 @@ (defn exhaust% [step] (fn [state] (|case (step state) - ("lux;Right" state* _) + ($Right state* _) ((exhaust% step) state*) - ("lux;Left" msg) + ($Left msg) (if (.equals "[Reader Error] EOF" msg) (return* state nil) (fail* msg))))) @@ -512,7 +531,7 @@ ;; "lux;loader" (memory-class-loader store) ;; "lux;writer" - (V "lux;None" nil)))) + (V $None nil)))) (defn init-state [_] (R ;; "lux;cursor" @@ -530,7 +549,7 @@ ;; "lux;seed" 0 ;; "lux;source" - (V "lux;None" nil) + (V $None nil) ;; "lux;types" +init-bindings+ )) @@ -538,22 +557,22 @@ (defn save-module [body] (fn [state] (|case (body state) - ("lux;Right" state* output) + ($Right state* output) (return* (->> state* (set$ $ENVS (get$ $ENVS state)) (set$ $SOURCE (get$ $SOURCE state))) output) - ("lux;Left" msg) + ($Left msg) (fail* msg)))) (defn with-eval [body] (fn [state] (|case (body (set$ $EVAL? true state)) - ("lux;Right" state* output) + ($Right state* output) (return* (set$ $EVAL? (get$ $EVAL? state) state*) output) - ("lux;Left" msg) + ($Left msg) (fail* msg)))) (def get-eval @@ -564,7 +583,7 @@ (fn [state] (let [writer* (->> state (get$ $HOST) (get$ $WRITER))] (|case writer* - ("lux;Some" datum) + ($Some datum) (return* state datum) _ @@ -613,7 +632,7 @@ (fn [state] (let [output (body (update$ $ENVS #(|cons (env name) %) state))] (|case output - ("lux;Right" state* datum) + ($Right state* datum) (return* (update$ $ENVS |tail state*) datum) _ @@ -637,9 +656,9 @@ (defn with-writer [writer body] (fn [state] - (let [output (body (update$ $HOST #(set$ $WRITER (V "lux;Some" writer) %) state))] + (let [output (body (update$ $HOST #(set$ $WRITER (V $Some writer) %) state))] (|case output - ("lux;Right" ?state ?value) + ($Right ?state ?value) (return* (update$ $HOST #(set$ $WRITER (->> state (get$ $HOST) (get$ $WRITER)) %) ?state) ?value) @@ -651,7 +670,7 @@ (fn [state] (let [output (body (set$ $EXPECTED type state))] (|case output - ("lux;Right" ?state ?value) + ($Right ?state ?value) (return* (set$ $EXPECTED (get$ $EXPECTED state) ?state) ?value) @@ -665,7 +684,7 @@ (fn [state] (let [output (body (set$ $cursor cursor state))] (|case output - ("lux;Right" ?state ?value) + ($Right ?state ?value) (return* (set$ $cursor (get$ $cursor state) ?state) ?value) @@ -674,40 +693,40 @@ (defn show-ast [ast] (|case ast - ("lux;Meta" _ ["lux;BoolS" ?value]) + ($Meta _ ($BoolS ?value)) (pr-str ?value) - ("lux;Meta" _ ["lux;IntS" ?value]) + ($Meta _ ($IntS ?value)) (pr-str ?value) - ("lux;Meta" _ ["lux;RealS" ?value]) + ($Meta _ ($RealS ?value)) (pr-str ?value) - ("lux;Meta" _ ["lux;CharS" ?value]) + ($Meta _ ($CharS ?value)) (pr-str ?value) - ("lux;Meta" _ ["lux;TextS" ?value]) + ($Meta _ ($TextS ?value)) (str "\"" ?value "\"") - ("lux;Meta" _ ["lux;TagS" ?module ?tag]) + ($Meta _ ($TagS ?module ?tag)) (str "#" ?module ";" ?tag) - ("lux;Meta" _ ["lux;SymbolS" ?module ?ident]) + ($Meta _ ($SymbolS ?module ?ident)) (if (.equals "" ?module) ?ident (str ?module ";" ?ident)) - ("lux;Meta" _ ["lux;TupleS" ?elems]) + ($Meta _ ($TupleS ?elems)) (str "[" (->> ?elems (|map show-ast) (|interpose " ") (fold str "")) "]") - ("lux;Meta" _ ["lux;RecordS" ?elems]) + ($Meta _ ($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]) + ($Meta _ ($FormS ?elems)) (str "(" (->> ?elems (|map show-ast) (|interpose " ") (fold str "")) ")") )) @@ -735,7 +754,7 @@ (return (|cons z zs))) [($Nil) ($Nil)] - (return (V "lux;Nil" nil)) + (return (V $Nil nil)) [_ _] (fail "Lists don't match in size."))) @@ -746,7 +765,7 @@ (|cons (f x y) (map2 f xs* ys*)) [_ _] - (V "lux;Nil" nil))) + (V $Nil nil))) (defn fold2 [f init xs ys] (|case [xs ys] @@ -763,8 +782,8 @@ (defn ^:private enumerate* [idx xs] (|case xs ($Cons x xs*) - (V "lux;Cons" (T (T idx x) - (enumerate* (inc idx) xs*))) + (V $Cons (T (T idx x) + (enumerate* (inc idx) xs*))) ($Nil) xs diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 7463bdce7..86359d26e 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -427,7 +427,7 @@ (|case ((&/with-writer =class (&/exhaust% compiler-step)) (&/set$ &/$SOURCE (&reader/from file-name file-content) state)) - ("lux;Right" ?state _) + (&/$Right ?state _) (&/run-state (|do [defs &a-module/defs imports &a-module/imports :let [_ (doto =class @@ -448,7 +448,7 @@ (&&/save-class! "_" (.toByteArray =class))) ?state) - ("lux;Left" ?message) + (&/$Left ?message) (fail* ?message))))))) )) )) @@ -460,10 +460,10 @@ (defn compile-program [program-module] (init!) (|case ((&/map% compile-module (&/|list "lux" program-module)) (&/init-state nil)) - ("lux;Right" ?state _) + (&/$Right ?state _) (do (println "Compilation complete!") (&&cache/clean ?state) (&&package/package program-module)) - ("lux;Left" ?message) + (&/$Left ?message) (assert false ?message))) diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj index 8a9c8dfcc..02e9e1430 100644 --- a/src/lux/compiler/host.clj +++ b/src/lux/compiler/host.clj @@ -52,7 +52,7 @@ char-class "java.lang.Character"] (defn prepare-return! [^MethodVisitor *writer* *type*] (|case *type* - ("lux;TupleT" ("lux;Nil")) + ("lux;TupleT" (&/$Nil)) (.visitInsn *writer* Opcodes/ACONST_NULL) ("lux;DataT" "boolean") @@ -414,13 +414,13 @@ $end (new Label) $catch-finally (new Label) compile-finally (|case ?finally - ("lux;Some" ?finally*) (|do [_ (return nil) + (&/$Some ?finally*) (|do [_ (return nil) _ (compile ?finally*) :let [_ (doto *writer* (.visitInsn Opcodes/POP) (.visitJumpInsn Opcodes/GOTO $end))]] (return nil)) - ("lux;None") (|do [_ (return nil) + (&/$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)]) @@ -448,11 +448,11 @@ ;; :let [_ (prn 'handlers (&/->seq handlers))] :let [_ (.visitLabel *writer* $catch-finally)] _ (|case ?finally - ("lux;Some" ?finally*) (|do [_ (compile ?finally*) + (&/$Some ?finally*) (|do [_ (compile ?finally*) :let [_ (.visitInsn *writer* Opcodes/POP)] :let [_ (.visitInsn *writer* Opcodes/ATHROW)]] (return nil)) - ("lux;None") (|do [_ (return nil) + (&/$None) (|do [_ (return nil) :let [_ (.visitInsn *writer* Opcodes/ATHROW)]] (return nil))) :let [_ (.visitJumpInsn *writer* Opcodes/GOTO $end)] @@ -564,7 +564,7 @@ (.visitTypeInsn Opcodes/ANEWARRAY "java/lang/Object") ;; V (.visitInsn Opcodes/DUP) ;; VV (.visitLdcInsn (int 0)) ;; VVI - (.visitLdcInsn "lux;Nil") ;; VVIT + (.visitLdcInsn &/$Nil) ;; VVIT (.visitInsn Opcodes/AASTORE) ;; V (.visitInsn Opcodes/DUP) ;; VV (.visitLdcInsn (int 1)) ;; VVI @@ -609,7 +609,7 @@ (.visitTypeInsn Opcodes/ANEWARRAY "java/lang/Object") ;; I2V (.visitInsn Opcodes/DUP) ;; I2VV (.visitLdcInsn (int 0)) ;; I2VVI - (.visitLdcInsn "lux;Cons") ;; I2VVIT + (.visitLdcInsn &/$Cons) ;; I2VVIT (.visitInsn Opcodes/AASTORE) ;; I2V (.visitInsn Opcodes/DUP_X1) ;; IV2V (.visitInsn Opcodes/SWAP) ;; IVV2 diff --git a/src/lux/compiler/type.clj b/src/lux/compiler/type.clj index bfa322206..6f785905a 100644 --- a/src/lux/compiler/type.clj +++ b/src/lux/compiler/type.clj @@ -30,11 +30,11 @@ (def ^:private $Nil "Analysis" - (variant$ "lux;Nil" (tuple$ (&/|list)))) + (variant$ &/$Nil (tuple$ (&/|list)))) (defn ^:private Cons$ [head tail] "(-> Analysis Analysis Analysis)" - (variant$ "lux;Cons" (tuple$ (&/|list head tail)))) + (variant$ &/$Cons (tuple$ (&/|list head tail)))) ;; [Exports] (defn ->analysis [type] @@ -74,11 +74,11 @@ ("lux;AllT" ?env ?name ?arg ?body) (variant$ "lux;AllT" (tuple$ (&/|list (|case ?env - ("lux;None") - (variant$ "lux;None" (tuple$ (&/|list))) + (&/$None) + (variant$ &/$None (tuple$ (&/|list))) - ("lux;Some" ??env) - (variant$ "lux;Some" + (&/$Some ??env) + (variant$ &/$Some (&/fold (fn [tail head] (|let [[hlabel htype] head] (Cons$ (tuple$ (&/|list (text$ hlabel) (->analysis htype))) diff --git a/src/lux/host.clj b/src/lux/host.clj index 2414d97b6..3f1ffb25a 100644 --- a/src/lux/host.clj +++ b/src/lux/host.clj @@ -75,7 +75,7 @@ ("lux;LambdaT" _ _) (->type-signature function-class) - ("lux;TupleT" ("lux;Nil")) + ("lux;TupleT" (&/$Nil)) "V" )) diff --git a/src/lux/lexer.clj b/src/lux/lexer.clj index bb6e54cb4..22e1b3de1 100644 --- a/src/lux/lexer.clj +++ b/src/lux/lexer.clj @@ -39,12 +39,12 @@ ;; [Lexers] (def ^:private lex-white-space (|do [[meta white-space] (&reader/read-regex #"^(\s+)")] - (return (&/V "lux;Meta" (&/T meta (&/V "White_Space" white-space)))))) + (return (&/V &/$Meta (&/T meta (&/V "White_Space" white-space)))))) (def ^:private lex-single-line-comment (|do [_ (&reader/read-text "##") [meta comment] (&reader/read-regex #"^(.*)$")] - (return (&/V "lux;Meta" (&/T meta (&/V "Comment" comment)))))) + (return (&/V &/$Meta (&/T meta (&/V "Comment" comment)))))) (defn ^:private lex-multi-line-comment [_] (|do [_ (&reader/read-text "#(") @@ -63,7 +63,7 @@ (return (&/T meta (str pre "#(" inner ")#" post)))))) ;; :let [_ (prn 'lex-multi-line-comment (str comment ")#"))] _ (&reader/read-text ")#")] - (return (&/V "lux;Meta" (&/T meta (&/V "Comment" comment)))))) + (return (&/V &/$Meta (&/T meta (&/V "Comment" comment)))))) (def ^:private lex-comment (&/try-all% (&/|list lex-single-line-comment @@ -72,7 +72,7 @@ (do-template [<name> <tag> <regex>] (def <name> (|do [[meta token] (&reader/read-regex <regex>)] - (return (&/V "lux;Meta" (&/T meta (&/V <tag> token)))))) + (return (&/V &/$Meta (&/T meta (&/V <tag> token)))))) ^:private lex-bool "Bool" #"^(true|false)" ^:private lex-int "Int" #"^(-?0|-?[1-9][0-9]*)" @@ -86,13 +86,13 @@ (|do [[_ char] (&reader/read-regex #"^(.)")] (return char)))) _ (&reader/read-text "\"")] - (return (&/V "lux;Meta" (&/T meta (&/V "Char" token)))))) + (return (&/V &/$Meta (&/T meta (&/V "Char" token)))))) (def ^:private lex-text (|do [[meta _] (&reader/read-text "\"") token (lex-text-body nil) _ (&reader/read-text "\"")] - (return (&/V "lux;Meta" (&/T meta (&/V "Text" token)))))) + (return (&/V &/$Meta (&/T meta (&/V "Text" token)))))) (def ^:private lex-ident (&/try-all% (&/|list (|do [[meta token] (&reader/read-regex +ident-re+)] @@ -118,17 +118,17 @@ (def ^:private lex-symbol (|do [[meta ident] lex-ident] - (return (&/V "lux;Meta" (&/T meta (&/V "Symbol" ident)))))) + (return (&/V &/$Meta (&/T meta (&/V "Symbol" ident)))))) (def ^:private lex-tag (|do [[meta _] (&reader/read-text "#") [_ ident] lex-ident] - (return (&/V "lux;Meta" (&/T meta (&/V "Tag" ident)))))) + (return (&/V &/$Meta (&/T meta (&/V "Tag" ident)))))) (do-template [<name> <text> <tag>] (def <name> (|do [[meta _] (&reader/read-text <text>)] - (return (&/V "lux;Meta" (&/T meta (&/V <tag> nil)))))) + (return (&/V &/$Meta (&/T meta (&/V <tag> nil)))))) ^:private lex-open-paren "(" "Open_Paren" ^:private lex-close-paren ")" "Close_Paren" diff --git a/src/lux/parser.clj b/src/lux/parser.clj index aa05b48af..762e2582f 100644 --- a/src/lux/parser.clj +++ b/src/lux/parser.clj @@ -19,14 +19,14 @@ (|do [elems (&/repeat% parse) token &lexer/lex] (|case token - ("lux;Meta" meta [<close-token> _]) + (&/$Meta meta [<close-token> _]) (return (&/V <tag> (&/fold &/|++ (&/|list) elems))) _ (fail (str "[Parser Error] Unbalanced " <description> "."))))) - ^:private parse-form "Close_Paren" "parantheses" "lux;FormS" - ^:private parse-tuple "Close_Bracket" "brackets" "lux;TupleS" + ^:private parse-form "Close_Paren" "parantheses" &/$FormS + ^:private parse-tuple "Close_Bracket" "brackets" &/$TupleS ) (defn ^:private parse-record [parse] @@ -34,9 +34,9 @@ token &lexer/lex :let [elems (&/fold &/|++ (&/|list) elems*)]] (|case token - ("lux;Meta" meta ("Close_Brace" _)) + (&/$Meta meta ("Close_Brace" _)) (if (even? (&/|length elems)) - (return (&/V "lux;RecordS" (&/|as-pairs elems))) + (return (&/V &/$RecordS (&/|as-pairs elems))) (fail (str "[Parser Error] Records must have an even number of elements."))) _ @@ -45,7 +45,7 @@ ;; [Interface] (def parse (|do [token &lexer/lex - :let [("lux;Meta" meta token*) token]] + :let [(&/$Meta meta token*) token]] (|case token* ("White_Space" _) (return (&/|list)) @@ -54,37 +54,37 @@ (return (&/|list)) ("Bool" ?value) - (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;BoolS" (Boolean/parseBoolean ?value)))))) + (return (&/|list (&/V &/$Meta (&/T meta (&/V &/$BoolS (Boolean/parseBoolean ?value)))))) ("Int" ?value) - (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;IntS" (Integer/parseInt ?value)))))) + (return (&/|list (&/V &/$Meta (&/T meta (&/V &/$IntS (Integer/parseInt ?value)))))) ("Real" ?value) - (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;RealS" (Float/parseFloat ?value)))))) + (return (&/|list (&/V &/$Meta (&/T meta (&/V &/$RealS (Float/parseFloat ?value)))))) ("Char" ^String ?value) - (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;CharS" (.charAt ?value 0)))))) + (return (&/|list (&/V &/$Meta (&/T meta (&/V &/$CharS (.charAt ?value 0)))))) ("Text" ?value) - (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;TextS" ?value))))) + (return (&/|list (&/V &/$Meta (&/T meta (&/V &/$TextS ?value))))) ("Symbol" ?ident) - (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;SymbolS" ?ident))))) + (return (&/|list (&/V &/$Meta (&/T meta (&/V &/$SymbolS ?ident))))) ("Tag" ?ident) - (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;TagS" ?ident))))) + (return (&/|list (&/V &/$Meta (&/T meta (&/V &/$TagS ?ident))))) ("Open_Paren" _) (|do [syntax (parse-form parse)] - (return (&/|list (&/V "lux;Meta" (&/T meta syntax))))) + (return (&/|list (&/V &/$Meta (&/T meta syntax))))) ("Open_Bracket" _) (|do [syntax (parse-tuple parse)] - (return (&/|list (&/V "lux;Meta" (&/T meta syntax))))) + (return (&/|list (&/V &/$Meta (&/T meta syntax))))) ("Open_Brace" _) (|do [syntax (parse-record parse)] - (return (&/|list (&/V "lux;Meta" (&/T meta syntax))))) + (return (&/|list (&/V &/$Meta (&/T meta syntax))))) _ (fail "[Parser Error] Unknown lexer token.") diff --git a/src/lux/reader.clj b/src/lux/reader.clj index 6bda8f166..7cdf9efdf 100644 --- a/src/lux/reader.clj +++ b/src/lux/reader.clj @@ -16,10 +16,10 @@ (defn ^:private with-line [body] (fn [state] (|case (&/get$ &/$SOURCE state) - ("lux;Nil") + (&/$Nil) (fail* "[Reader Error] EOF") - ("lux;Cons" [[file-name line-num column-num] line] + (&/$Cons [[file-name line-num column-num] line] more) (|case (body file-name line-num column-num line) ("No" msg) @@ -37,11 +37,11 @@ (defn ^:private with-lines [body] (fn [state] (|case (body (&/get$ &/$SOURCE state)) - ("lux;Right" reader* match) + (&/$Right reader* match) (return* (&/set$ &/$SOURCE reader* state) match) - ("lux;Left" msg) + (&/$Left msg) (fail* msg) ))) @@ -103,10 +103,10 @@ (loop [prefix "" reader* reader] (|case reader* - ("lux;Nil") - (&/V "lux;Left" "[Reader Error] EOF") + (&/$Nil) + (&/V &/$Left "[Reader Error] EOF") - ("lux;Cons" [[file-name line-num column-num] ^String line] + (&/$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))] @@ -114,10 +114,10 @@ column-num* (+ column-num match-length)] (if (= column-num* (.length line)) (recur (str prefix match "\n") reader**) - (&/V "lux;Right" (&/T (&/|cons (&/T (&/T file-name line-num column-num*) line) + (&/V &/$Right (&/T (&/|cons (&/T (&/T file-name line-num column-num*) line) reader**) (&/T (&/T file-name line-num column-num) (str prefix match)))))) - (&/V "lux;Left" (str "[Reader Error] Pattern failed: " regex)))))))) + (&/V &/$Left (str "[Reader Error] Pattern failed: " regex)))))))) (defn read-text [^String text] (with-line diff --git a/src/lux/type.clj b/src/lux/type.clj index ab8ea4e61..45c1f2247 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -24,26 +24,26 @@ (def $Void (&/V "lux;VariantT" (&/|list))) (def IO - (&/V "lux;AllT" (&/T (&/V "lux;Some" (&/V "lux;Nil" nil)) "IO" "a" + (&/V "lux;AllT" (&/T (&/V &/$Some (&/V &/$Nil nil)) "IO" "a" (&/V "lux;LambdaT" (&/T Unit (&/V "lux;BoundT" "a")))))) (def List - (&/V "lux;AllT" (&/T (&/V "lux;Some" (&/V "lux;Nil" nil)) "lux;List" "a" - (&/V "lux;VariantT" (&/|list (&/T "lux;Nil" Unit) - (&/T "lux;Cons" (&/V "lux;TupleT" (&/|list (&/V "lux;BoundT" "a") + (&/V "lux;AllT" (&/T (&/V &/$Some (&/V &/$Nil nil)) "lux;List" "a" + (&/V "lux;VariantT" (&/|list (&/T &/$Nil Unit) + (&/T &/$Cons (&/V "lux;TupleT" (&/|list (&/V "lux;BoundT" "a") (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "lux;List") (&/V "lux;BoundT" "a"))))))))))) (def Maybe - (&/V "lux;AllT" (&/T (&/V "lux;Some" (&/V "lux;Nil" nil)) "lux;Maybe" "a" - (&/V "lux;VariantT" (&/|list (&/T "lux;None" Unit) - (&/T "lux;Some" (&/V "lux;BoundT" "a"))))))) + (&/V "lux;AllT" (&/T (&/V &/$Some (&/V &/$Nil nil)) "lux;Maybe" "a" + (&/V "lux;VariantT" (&/|list (&/T &/$None Unit) + (&/T &/$Some (&/V "lux;BoundT" "a"))))))) (def Type (let [Type (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "Type") (&/V "lux;BoundT" "_"))) TypeEnv (&/V "lux;AppT" (&/T List (&/V "lux;TupleT" (&/|list Text Type)))) TypePair (&/V "lux;TupleT" (&/|list Type Type))] - (&/V "lux;AppT" (&/T (&/V "lux;AllT" (&/T (&/V "lux;Some" (&/V "lux;Nil" nil)) "Type" "_" + (&/V "lux;AppT" (&/T (&/V "lux;AllT" (&/T (&/V &/$Some (&/V &/$Nil nil)) "Type" "_" (&/V "lux;VariantT" (&/|list (&/T "lux;DataT" Text) (&/T "lux;TupleT" (&/V "lux;AppT" (&/T List Type))) (&/T "lux;VariantT" TypeEnv) @@ -58,7 +58,7 @@ $Void)))) (defn fAll [name arg body] - (&/V "lux;AllT" (&/T (&/V "lux;None" nil) name arg body))) + (&/V "lux;AllT" (&/T (&/V &/$None nil) name arg body))) (def Bindings (fAll "lux;Bindings" "k" @@ -84,9 +84,9 @@ (&/V "lux;TupleT" (&/|list Text Int Int))) (def Meta - (fAll "lux;Meta" "m" + (fAll &/$Meta "m" (fAll "" "v" - (&/V "lux;VariantT" (&/|list (&/T "lux;Meta" (&/V "lux;TupleT" (&/|list (&/V "lux;BoundT" "m") + (&/V "lux;VariantT" (&/|list (&/T &/$Meta (&/V "lux;TupleT" (&/|list (&/V "lux;BoundT" "m") (&/V "lux;BoundT" "v"))))))))) (def Ident (&/V "lux;TupleT" (&/|list Text Text))) @@ -97,16 +97,16 @@ (&/V "lux;BoundT" "w"))))) AST*List (&/V "lux;AppT" (&/T List AST*))] (fAll "lux;AST'" "w" - (&/V "lux;VariantT" (&/|list (&/T "lux;BoolS" Bool) - (&/T "lux;IntS" Int) - (&/T "lux;RealS" Real) - (&/T "lux;CharS" Char) - (&/T "lux;TextS" Text) - (&/T "lux;SymbolS" Ident) - (&/T "lux;TagS" Ident) - (&/T "lux;FormS" AST*List) - (&/T "lux;TupleS" AST*List) - (&/T "lux;RecordS" (&/V "lux;AppT" (&/T List (&/V "lux;TupleT" (&/|list AST* AST*)))))) + (&/V "lux;VariantT" (&/|list (&/T &/$BoolS Bool) + (&/T &/$IntS Int) + (&/T &/$RealS Real) + (&/T &/$CharS Char) + (&/T &/$TextS Text) + (&/T &/$SymbolS Ident) + (&/T &/$TagS Ident) + (&/T &/$FormS AST*List) + (&/T &/$TupleS AST*List) + (&/T &/$RecordS (&/V "lux;AppT" (&/T List (&/V "lux;TupleT" (&/|list AST* AST*)))))) )))) (def AST @@ -118,8 +118,8 @@ (def Either (fAll "lux;Either" "l" (fAll "" "r" - (&/V "lux;VariantT" (&/|list (&/T "lux;Left" (&/V "lux;BoundT" "l")) - (&/T "lux;Right" (&/V "lux;BoundT" "r"))))))) + (&/V "lux;VariantT" (&/|list (&/T &/$Left (&/V "lux;BoundT" "l")) + (&/T &/$Right (&/V "lux;BoundT" "r"))))))) (def StateE (fAll "lux;StateE" "s" @@ -192,10 +192,10 @@ (fn [state] (if-let [type (->> state (&/get$ &/$TYPES) (&/get$ &/$MAPPINGS) (&/|get id))] (|case type - ("lux;Some" type*) + (&/$Some type*) (return* state true) - ("lux;None") + (&/$None) (return* state false)) (fail* (str "[Type Error] <bound?> Unknown type-var: " id))))) @@ -203,10 +203,10 @@ (fn [state] (if-let [type* (->> state (&/get$ &/$TYPES) (&/get$ &/$MAPPINGS) (&/|get id))] (|case type* - ("lux;Some" type) + (&/$Some type) (return* state type) - ("lux;None") + (&/$None) (fail* (str "[Type Error] Unbound type-var: " id))) (fail* (str "[Type Error] <deref> Unknown type-var: " id))))) @@ -214,11 +214,11 @@ (fn [state] (if-let [tvar (->> state (&/get$ &/$TYPES) (&/get$ &/$MAPPINGS) (&/|get id))] (|case tvar - ("lux;Some" bound) + (&/$Some bound) (fail* (str "[Type Error] Can't rebind type var: " id " | Current type: " (show-type bound))) - ("lux;None") - (return* (&/update$ &/$TYPES (fn [ts] (&/update$ &/$MAPPINGS #(&/|put id (&/V "lux;Some" type) %) + (&/$None) + (return* (&/update$ &/$TYPES (fn [ts] (&/update$ &/$MAPPINGS #(&/|put id (&/V &/$Some type) %) ts)) state) nil)) @@ -231,7 +231,7 @@ (let [id (->> state (&/get$ &/$TYPES) (&/get$ &/$COUNTER))] (return* (&/update$ &/$TYPES #(->> % (&/update$ &/$COUNTER inc) - (&/update$ &/$MAPPINGS (fn [ms] (&/|put id (&/V "lux;None" nil) ms)))) + (&/update$ &/$MAPPINGS (fn [ms] (&/|put id (&/V &/$None nil) ms)))) state) id)))) @@ -252,19 +252,19 @@ (if (.equals ^Object id ?id) (return binding) (|case ?type - ("lux;None") + (&/$None) (return binding) - ("lux;Some" ?type*) + (&/$Some ?type*) (|case ?type* ("lux;VarT" ?id*) (if (.equals ^Object id ?id*) - (return (&/T ?id (&/V "lux;None" nil))) + (return (&/T ?id (&/V &/$None nil))) (return binding)) _ (|do [?type** (clean* id ?type*)] - (return (&/T ?id (&/V "lux;Some" ?type**))))) + (return (&/T ?id (&/V &/$Some ?type**))))) )))) (->> state (&/get$ &/$TYPES) (&/get$ &/$MAPPINGS)))] (fn [state] @@ -324,15 +324,15 @@ ("lux;AllT" ?env ?name ?arg ?body) (|do [=env (|case ?env - ("lux;None") + (&/$None) (return ?env) - ("lux;Some" ?env*) + (&/$Some ?env*) (|do [clean-env (&/map% (fn [[k v]] (|do [=v (clean* ?tid v)] (return (&/T k =v)))) ?env*)] - (return (&/V "lux;Some" clean-env)))) + (return (&/V &/$Some clean-env)))) body* (clean* ?tid ?body)] (return (&/V "lux;AllT" (&/T =env ?name ?arg body*)))) @@ -382,7 +382,7 @@ (str "(| " (->> cases (&/|map (fn [kv] (|case kv - [k ("lux;TupleT" ("lux;Nil"))] + [k ("lux;TupleT" (&/$Nil))] (str "#" k) [k v] @@ -479,10 +479,10 @@ (and (.equals ^Object xname yname) (.equals ^Object xarg yarg) ;; (matchv ::M/objects [xenv yenv] - ;; [["lux;None" _] ["lux;None" _]] + ;; [[&/$None _] [&/$None _]] ;; true - ;; [["lux;Some" xenv*] ["lux;Some" yenv*]] + ;; [[&/$Some xenv*] [&/$Some yenv*]] ;; (&/fold (fn [old bname] ;; (and old ;; (type= (&/|get bname xenv*) (&/|get bname yenv*)))) @@ -502,13 +502,13 @@ (defn ^:private fp-get [k fixpoints] (|let [[e a] k] (|case fixpoints - ("lux;Nil") - (&/V "lux;None" nil) + (&/$Nil) + (&/V &/$None nil) - ("lux;Cons" [[e* a*] v*] fixpoints*) + (&/$Cons [[e* a*] v*] fixpoints*) (if (and (type= e e*) (type= a a*)) - (&/V "lux;Some" v*) + (&/V &/$Some v*) (fp-get k fixpoints*)) ))) @@ -542,10 +542,10 @@ ("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)) + (&/$None) + (&/V "lux;AllT" (&/T (&/V &/$Some env) ?local-name ?local-arg ?local-def)) - ("lux;Some" _) + (&/$Some _) type) ("lux;LambdaT" ?input ?output) @@ -564,10 +564,10 @@ (|case type-fn ("lux;AllT" local-env local-name local-arg local-def) (let [local-env* (|case local-env - ("lux;None") + (&/$None) (&/|table) - ("lux;Some" local-env*) + (&/$Some local-env*) local-env*)] (return (beta-reduce (->> local-env* (&/|put local-name type-fn) @@ -607,39 +607,39 @@ (return (&/T fixpoints nil)) (|do [ebound (fn [state] (|case ((deref ?eid) state) - ("lux;Right" state* ebound) - (return* state* (&/V "lux;Some" ebound)) + (&/$Right state* ebound) + (return* state* (&/V &/$Some ebound)) - ("lux;Left" _) - (return* state (&/V "lux;None" nil)))) + (&/$Left _) + (return* state (&/V &/$None nil)))) abound (fn [state] (|case ((deref ?aid) state) - ("lux;Right" state* abound) - (return* state* (&/V "lux;Some" abound)) + (&/$Right state* abound) + (return* state* (&/V &/$Some abound)) - ("lux;Left" _) - (return* state (&/V "lux;None" nil))))] + (&/$Left _) + (return* state (&/V &/$None nil))))] (|case [ebound abound] - [("lux;None" _) ("lux;None" _)] + [(&/$None _) (&/$None _)] (|do [_ (set-var ?eid actual)] (return (&/T fixpoints nil))) - [("lux;Some" etype) ("lux;None" _)] + [(&/$Some etype) (&/$None _)] (check* class-loader fixpoints etype actual) - [("lux;None" _) ("lux;Some" atype)] + [(&/$None _) (&/$Some atype)] (check* class-loader fixpoints expected atype) - [("lux;Some" etype) ("lux;Some" atype)] + [(&/$Some etype) (&/$Some atype)] (check* class-loader fixpoints etype atype)))) [("lux;VarT" ?id) _] (fn [state] (|case ((set-var ?id actual) state) - ("lux;Right" state* _) + (&/$Right state* _) (return* state* (&/T fixpoints nil)) - ("lux;Left" _) + (&/$Left _) ((|do [bound (deref ?id)] (check* class-loader fixpoints bound actual)) state))) @@ -647,10 +647,10 @@ [_ ("lux;VarT" ?id)] (fn [state] (|case ((set-var ?id expected) state) - ("lux;Right" state* _) + (&/$Right state* _) (return* state* (&/T fixpoints nil)) - ("lux;Left" _) + (&/$Left _) ((|do [bound (deref ?id)] (check* class-loader fixpoints expected bound)) state))) @@ -662,24 +662,24 @@ (|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) + (&/$Right state* output) (return* state* output) - ("lux;Left" _) + (&/$Left _) ((check* class-loader fixpoints (&/V "lux;AppT" (&/T F1 A1)) actual) state)))) state) - ("lux;Right" state* output) + (&/$Right state* output) (return* state* output) - ("lux;Left" _) + (&/$Left _) (|case ((|do [F2 (deref ?aid)] (check* class-loader fixpoints expected (&/V "lux;AppT" (&/T F2 A2)))) state) - ("lux;Right" state* output) + (&/$Right state* output) (return* state* output) - ("lux;Left" _) + (&/$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))) @@ -693,10 +693,10 @@ (|case ((|do [F1 (deref ?id)] (check* class-loader fixpoints (&/V "lux;AppT" (&/T F1 A1)) actual)) state) - ("lux;Right" state* output) + (&/$Right state* output) (return* state* output) - ("lux;Left" _) + (&/$Left _) ((|do [[fixpoints* _] (check* class-loader fixpoints (&/V "lux;VarT" ?id) F2) e* (apply-type F2 A1) a* (apply-type F2 A2) @@ -715,10 +715,10 @@ (|case ((|do [F2 (deref ?id)] (check* class-loader fixpoints expected (&/V "lux;AppT" (&/T F2 A2)))) state) - ("lux;Right" state* output) + (&/$Right state* output) (return* state* output) - ("lux;Left" _) + (&/$Left _) ((|do [[fixpoints* _] (check* class-loader fixpoints F1 (&/V "lux;VarT" ?id)) e* (apply-type F1 A1) a* (apply-type F1 A2) @@ -744,12 +744,12 @@ (&/fold str ""))) (assert false))] (|case (fp-get fp-pair fixpoints) - ("lux;Some" ?) + (&/$Some ?) (if ? (return (&/T fixpoints nil)) (fail (check-error expected actual))) - ("lux;None") + (&/$None) (|do [expected* (apply-type F A)] (check* class-loader (fp-put fp-pair true fixpoints) expected* actual)))) |