aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorEduardo Julian2016-05-08 18:22:14 -0400
committerEduardo Julian2016-05-08 18:22:14 -0400
commitcee3a2febb99820095963ff973b2dbe29ff3668d (patch)
tree59d799d0cb39cdaf76f01c108996d5e9b5ffd6b5 /src
parent4155c6bc9f74be2fc55197f823a452c4ec923f54 (diff)
- Removed _jvm_class, _jvm_interface and _jvm_anon-class from the list of special forms.
Diffstat (limited to 'src')
-rw-r--r--src/lux/analyser.clj54
-rw-r--r--src/lux/analyser/base.clj3
-rw-r--r--src/lux/analyser/host.clj427
-rw-r--r--src/lux/analyser/parser.clj813
-rw-r--r--src/lux/compiler.clj19
-rw-r--r--src/lux/compiler/host.clj4
-rw-r--r--src/lux/lexer.clj10
-rw-r--r--src/lux/optimizer.clj65
-rw-r--r--src/lux/reader.clj10
-rw-r--r--src/lux/repl.clj2
10 files changed, 732 insertions, 675 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 1b5c24bc3..c5fabb409 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -54,56 +54,8 @@
(fn [state]
(fail* (add-loc (&/get$ &/$cursor state) msg))))
-(defn ^:private aba2 [analyse eval! compile-module compilers exo-type token]
- (|let [[compile-statement compile-def compile-program] compilers]
- (|case token
- ;; Classes & interfaces
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_class")]
- (&/$Cons ?class-decl
- (&/$Cons ?super-class
- (&/$Cons [_ (&/$TupleS ?interfaces)]
- (&/$Cons ?inheritance-modifier
- (&/$Cons [_ (&/$TupleS ?anns)]
- (&/$Cons [_ (&/$TupleS ?fields)]
- (&/$Cons [_ (&/$TupleS ?methods)]
- (&/$Nil))))))))))
- (|do [=gclass-decl (&&a-parser/parse-gclass-decl ?class-decl)
- =super-class (&&a-parser/parse-gclass-super ?super-class)
- =interfaces (&/map% &&a-parser/parse-gclass-super ?interfaces)
- =inheritance-modifier (&&a-parser/parse-inheritance-modifier ?inheritance-modifier)
- =anns (&/map% &&a-parser/parse-ann ?anns)
- =fields (&/map% &&a-parser/parse-field ?fields)
- =methods (&/map% &&a-parser/parse-method-def ?methods)]
- (&&host/analyse-jvm-class analyse compile-statement =gclass-decl =super-class =interfaces =inheritance-modifier =anns =fields =methods))
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_interface")]
- (&/$Cons ?class-decl
- (&/$Cons [_ (&/$TupleS ?supers)]
- (&/$Cons [_ (&/$TupleS ?anns)]
- ?methods)))))
- (|do [=gclass-decl (&&a-parser/parse-gclass-decl ?class-decl)
- =supers (&/map% &&a-parser/parse-gclass-super ?supers)
- =anns (&/map% &&a-parser/parse-ann ?anns)
- =methods (&/map% &&a-parser/parse-method-decl ?methods)]
- (&&host/analyse-jvm-interface analyse compile-statement =gclass-decl =supers =anns =methods))
-
- (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_anon-class")]
- (&/$Cons ?super-class
- (&/$Cons [_ (&/$TupleS ?interfaces)]
- (&/$Cons [_ (&/$TupleS ?ctor-args)]
- (&/$Cons [_ (&/$TupleS ?methods)]
- (&/$Nil)))))))
- (|do [=super-class (&&a-parser/parse-gclass-super ?super-class)
- =interfaces (&/map% &&a-parser/parse-gclass-super ?interfaces)
- =ctor-args (&/map% &&a-parser/parse-ctor-arg ?ctor-args)
- =methods (&/map% &&a-parser/parse-method-def ?methods)]
- (&&host/analyse-jvm-anon-class analyse compile-statement exo-type =super-class =interfaces =ctor-args =methods))
-
- _
- (fail-with-loc (str "[Analyser Error] Unknown syntax: " (prn-str (&/show-ast (&/T [(&/T ["" -1 -1]) token]))))))))
-
(defn ^:private aba1 [analyse eval! compile-module compilers exo-type token]
- (|let [[compile-statement compile-def compile-program] compilers]
+ (|let [[compile-def compile-program compile-class compile-interface] compilers]
(|case token
;; Standard special forms
(&/$BoolS ?value)
@@ -191,7 +143,7 @@
(&/$Nil))))]
(&/$Cons [_ (&/$TupleS ?args)]
(&/$Nil)))))
- (&&host/analyse-host analyse exo-type ?category ?proc ?args)
+ (&&host/analyse-host analyse exo-type compilers ?category ?proc ?args)
(&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_program")]
(&/$Cons [_ (&/$SymbolS "" ?args)]
@@ -200,7 +152,7 @@
(&&lux/analyse-program analyse compile-program ?args ?body)
_
- (aba2 analyse eval! compile-module compilers exo-type token)
+ (fail-with-loc (str "[Analyser Error] Unknown syntax: " (prn-str (&/show-ast (&/T [(&/T ["" -1 -1]) token])))))
)))
(defn ^:private analyse-basic-ast [analyse eval! compile-module compilers exo-type token]
diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj
index 7674f4503..5ee60d4cf 100644
--- a/src/lux/analyser/base.clj
+++ b/src/lux/analyser/base.clj
@@ -25,9 +25,6 @@
("var" 1)
("captured" 1)
("proc" 2)
-
- ("jvm-class" 1) ;; Eliminate
- ("jvm-interface" 1) ;; Eliminate
)
;; [Exports]
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index bb70bf0e2..dd3172dab 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -10,7 +10,10 @@
clojure.core.match.array
(lux [base :as & :refer [|let |do return* return fail |case assert!]]
[type :as &type]
- [host :as &host])
+ [host :as &host]
+ [lexer :as &lexer]
+ [parser :as &parser]
+ [reader :as &reader])
[lux.type.host :as &host-type]
[lux.host.generics :as &host-generics]
(lux.analyser [base :as &&]
@@ -423,80 +426,6 @@
(return (&/$VariableFieldAnalysis ?name ?privacy-modifier ?state-modifier ?anns ?type))
))
-(defn analyse-jvm-class [analyse compile-statement class-decl super-class interfaces =inheritance-modifier =anns ?fields methods]
- (&/with-closure
- (|do [module &/get-module-name
- :let [[?name ?params] class-decl
- full-name (str (string/replace module "/" ".") "." ?name)
- class-decl* (&/T [full-name ?params])
- all-supers (&/$Cons super-class interfaces)]
- class-env (make-type-env ?params)
- =fields (&/map% (partial analyse-field analyse class-env) ?fields)
- _ (&host/use-dummy-class class-decl super-class interfaces &/$None =fields methods)
- =methods (&/map% (partial analyse-method analyse class-decl* class-env all-supers) methods)
- _ (check-method-completion all-supers =methods)
- _ (compile-statement (&&/$jvm-class (&/T [class-decl super-class interfaces =inheritance-modifier =anns =fields =methods &/$Nil &/$None])))
- :let [_ (println 'DEF full-name)]]
- (return &/$Nil))))
-
-(defn analyse-jvm-interface [analyse compile-statement interface-decl supers =anns =methods]
- (|do [module &/get-module-name
- _ (compile-statement (&&/$jvm-interface (&/T [interface-decl supers =anns =methods])))
- :let [_ (println 'DEF (str module "." (&/|first interface-decl)))]]
- (return &/$Nil)))
-
-(defn ^:private captured-source [env-entry]
- (|case env-entry
- [name [_ (&&/$captured _ _ source)]]
- source))
-
-(let [default-<init> (&/$ConstructorMethodSyntax (&/T [&/$PublicPM
- false
- &/$Nil
- &/$Nil
- &/$Nil
- &/$Nil
- &/$Nil
- (&/$TupleS &/$Nil)]))
- captured-slot-class "java.lang.Object"
- captured-slot-type (&/$GenericClass captured-slot-class &/$Nil)]
- (defn analyse-jvm-anon-class [analyse compile-statement exo-type super-class interfaces ctor-args methods]
- (&/with-closure
- (|do [module &/get-module-name
- scope &/get-scope-name
- :let [name (&host/location (&/|tail scope))
- class-decl (&/T [name &/$Nil])
- anon-class (str (string/replace module "/" ".") "." name)
- anon-class-type (&/$HostT anon-class &/$Nil)]
- =ctor-args (&/map% (fn [ctor-arg]
- (|let [[arg-type arg-term] ctor-arg]
- (|do [=arg-term (&&/analyse-1+ analyse arg-term)]
- (return (&/T [arg-type =arg-term])))))
- ctor-args)
- _ (->> methods
- (&/$Cons default-<init>)
- (&host/use-dummy-class class-decl super-class interfaces (&/$Some =ctor-args) &/$Nil))
- :let [all-supers (&/$Cons super-class interfaces)
- class-env &/$Nil]
- =methods (&/map% (partial analyse-method analyse class-decl class-env all-supers) methods)
- _ (check-method-completion all-supers =methods)
- =captured &&env/captured-vars
- :let [=fields (&/|map (fn [^objects idx+capt]
- (|let [[idx _] idx+capt]
- (&/$VariableFieldAnalysis (str &c!base/closure-prefix idx)
- &/$PublicPM
- &/$FinalSM
- &/$Nil
- captured-slot-type)))
- (&/enumerate =captured))]
- :let [sources (&/|map captured-source =captured)]
- _ (compile-statement (&&/$jvm-class (&/T [class-decl super-class interfaces &/$DefaultIM &/$Nil =fields =methods =captured (&/$Some =ctor-args)])))
- _cursor &/cursor]
- (return (&/|list (&&/|meta anon-class-type _cursor
- (&&/$proc (&/T ["jvm" "new"]) (&/|list anon-class (&/|repeat (&/|length sources) captured-slot-class) sources))
- )))
- ))))
-
(do-template [<name> <proc> <from-class> <to-class>]
(let [output-type (&/$HostT <to-class> &/$Nil)]
(defn <name> [analyse exo-type _?value]
@@ -662,8 +591,9 @@
(let [length-type &type/Int
idx-type &type/Int]
(defn ^:private analyse-jvm-anewarray [analyse exo-type ?values]
- (|do [:let [(&/$Cons _gclass (&/$Cons length (&/$Nil))) ?values]
- gclass (&&a-parser/parse-gclass _gclass)
+ (|do [:let [(&/$Cons [_ (&/$TextS _gclass)] (&/$Cons length (&/$Nil))) ?values]
+ gclass (&reader/with-source "jvm-anewarray" _gclass
+ &&a-parser/parse-gclass)
gtype-env &/get-type-env
=gclass (&host-type/instance-gtype &type/existential gtype-env gclass)
:let [array-type (&/$HostT &host-type/array-data-tag (&/|list =gclass))]
@@ -958,124 +888,227 @@
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T ["jvm" "aastore"]) (&/|list =array =idx =elem))))))))
-(defn analyse-host [analyse exo-type category proc ?values]
- (case category
- "array"
- (case proc
- "new" (analyse-array-new analyse exo-type ?values)
- "get" (analyse-array-get analyse exo-type ?values)
- "put" (analyse-jvm-aastore analyse exo-type ?values)
- "remove" (analyse-array-remove analyse exo-type ?values)
- "size" (analyse-jvm-arraylength analyse exo-type ?values))
-
- "jvm"
- (case proc
- "try" (analyse-jvm-try analyse exo-type ?values)
- "throw" (analyse-jvm-throw analyse exo-type ?values)
- "monitorenter" (analyse-jvm-monitorenter analyse exo-type ?values)
- "monitorexit" (analyse-jvm-monitorexit analyse exo-type ?values)
- "null?" (analyse-jvm-null? analyse exo-type ?values)
- "null" (analyse-jvm-null analyse exo-type ?values)
- "anewarray" (analyse-jvm-anewarray analyse exo-type ?values)
- "aaload" (analyse-jvm-aaload analyse exo-type ?values)
- "aastore" (analyse-jvm-aastore analyse exo-type ?values)
- "arraylength" (analyse-jvm-arraylength analyse exo-type ?values)
- "znewarray" (analyse-jvm-znewarray analyse exo-type ?values)
- "bnewarray" (analyse-jvm-bnewarray analyse exo-type ?values)
- "snewarray" (analyse-jvm-snewarray analyse exo-type ?values)
- "inewarray" (analyse-jvm-inewarray analyse exo-type ?values)
- "lnewarray" (analyse-jvm-lnewarray analyse exo-type ?values)
- "fnewarray" (analyse-jvm-fnewarray analyse exo-type ?values)
- "dnewarray" (analyse-jvm-dnewarray analyse exo-type ?values)
- "cnewarray" (analyse-jvm-cnewarray analyse exo-type ?values)
- "iadd" (analyse-jvm-iadd analyse exo-type ?values)
- "isub" (analyse-jvm-isub analyse exo-type ?values)
- "imul" (analyse-jvm-imul analyse exo-type ?values)
- "idiv" (analyse-jvm-idiv analyse exo-type ?values)
- "irem" (analyse-jvm-irem analyse exo-type ?values)
- "ieq" (analyse-jvm-ieq analyse exo-type ?values)
- "ilt" (analyse-jvm-ilt analyse exo-type ?values)
- "igt" (analyse-jvm-igt analyse exo-type ?values)
- "ceq" (analyse-jvm-ceq analyse exo-type ?values)
- "clt" (analyse-jvm-clt analyse exo-type ?values)
- "cgt" (analyse-jvm-cgt analyse exo-type ?values)
- "ladd" (analyse-jvm-ladd analyse exo-type ?values)
- "lsub" (analyse-jvm-lsub analyse exo-type ?values)
- "lmul" (analyse-jvm-lmul analyse exo-type ?values)
- "ldiv" (analyse-jvm-ldiv analyse exo-type ?values)
- "lrem" (analyse-jvm-lrem analyse exo-type ?values)
- "leq" (analyse-jvm-leq analyse exo-type ?values)
- "llt" (analyse-jvm-llt analyse exo-type ?values)
- "lgt" (analyse-jvm-lgt analyse exo-type ?values)
- "fadd" (analyse-jvm-fadd analyse exo-type ?values)
- "fsub" (analyse-jvm-fsub analyse exo-type ?values)
- "fmul" (analyse-jvm-fmul analyse exo-type ?values)
- "fdiv" (analyse-jvm-fdiv analyse exo-type ?values)
- "frem" (analyse-jvm-frem analyse exo-type ?values)
- "feq" (analyse-jvm-feq analyse exo-type ?values)
- "flt" (analyse-jvm-flt analyse exo-type ?values)
- "fgt" (analyse-jvm-fgt analyse exo-type ?values)
- "dadd" (analyse-jvm-dadd analyse exo-type ?values)
- "dsub" (analyse-jvm-dsub analyse exo-type ?values)
- "dmul" (analyse-jvm-dmul analyse exo-type ?values)
- "ddiv" (analyse-jvm-ddiv analyse exo-type ?values)
- "drem" (analyse-jvm-drem analyse exo-type ?values)
- "deq" (analyse-jvm-deq analyse exo-type ?values)
- "dlt" (analyse-jvm-dlt analyse exo-type ?values)
- "dgt" (analyse-jvm-dgt analyse exo-type ?values)
- "iand" (analyse-jvm-iand analyse exo-type ?values)
- "ior" (analyse-jvm-ior analyse exo-type ?values)
- "ixor" (analyse-jvm-ixor analyse exo-type ?values)
- "ishl" (analyse-jvm-ishl analyse exo-type ?values)
- "ishr" (analyse-jvm-ishr analyse exo-type ?values)
- "iushr" (analyse-jvm-iushr analyse exo-type ?values)
- "land" (analyse-jvm-land analyse exo-type ?values)
- "lor" (analyse-jvm-lor analyse exo-type ?values)
- "lxor" (analyse-jvm-lxor analyse exo-type ?values)
- "lshl" (analyse-jvm-lshl analyse exo-type ?values)
- "lshr" (analyse-jvm-lshr analyse exo-type ?values)
- "lushr" (analyse-jvm-lushr analyse exo-type ?values)
- "d2f" (analyse-jvm-d2f analyse exo-type ?values)
- "d2i" (analyse-jvm-d2i analyse exo-type ?values)
- "d2l" (analyse-jvm-d2l analyse exo-type ?values)
- "f2d" (analyse-jvm-f2d analyse exo-type ?values)
- "f2i" (analyse-jvm-f2i analyse exo-type ?values)
- "f2l" (analyse-jvm-f2l analyse exo-type ?values)
- "i2b" (analyse-jvm-i2b analyse exo-type ?values)
- "i2c" (analyse-jvm-i2c analyse exo-type ?values)
- "i2d" (analyse-jvm-i2d analyse exo-type ?values)
- "i2f" (analyse-jvm-i2f analyse exo-type ?values)
- "i2l" (analyse-jvm-i2l analyse exo-type ?values)
- "i2s" (analyse-jvm-i2s analyse exo-type ?values)
- "l2d" (analyse-jvm-l2d analyse exo-type ?values)
- "l2f" (analyse-jvm-l2f analyse exo-type ?values)
- "l2i" (analyse-jvm-l2i analyse exo-type ?values)
- "c2b" (analyse-jvm-c2b analyse exo-type ?values)
- "c2s" (analyse-jvm-c2s analyse exo-type ?values)
- "c2i" (analyse-jvm-c2i analyse exo-type ?values)
- "c2l" (analyse-jvm-c2l analyse exo-type ?values)
- ;; else
- (->> (fail (str "[Analyser Error] Unknown host procedure: " [category proc]))
- (if-let [[_ _class] (re-find #"^instanceof:([^:]+)$" proc)]
- (analyse-jvm-instanceof analyse exo-type _class ?values))
- (if-let [[_ _class _arg-classes] (re-find #"^new:([^:]+):([^:]*)$" proc)]
- (analyse-jvm-new analyse exo-type _class (if (= "" _arg-classes) (&/|list) (&/->list (string/split _arg-classes #","))) ?values))
- (if-let [[_ _class _method _arg-classes] (re-find #"^invokestatic:([^:]+):([^:]+):([^:]*)$" proc)]
- (analyse-jvm-invokestatic analyse exo-type _class _method (if (= "" _arg-classes) (&/|list) (&/->list (string/split _arg-classes #","))) ?values))
- (if-let [[_ _class _method _arg-classes] (re-find #"^invokeinterface:([^:]+):([^:]+):([^:]*)$" proc)]
- (analyse-jvm-invokeinterface analyse exo-type _class _method (if (= "" _arg-classes) (&/|list) (&/->list (string/split _arg-classes #","))) ?values))
- (if-let [[_ _class _method _arg-classes] (re-find #"^invokevirtual:([^:]+):([^:]+):([^:]*)$" proc)]
- (analyse-jvm-invokevirtual analyse exo-type _class _method (if (= "" _arg-classes) (&/|list) (&/->list (string/split _arg-classes #","))) ?values))
- (if-let [[_ _class _method _arg-classes] (re-find #"^invokespecial:([^:]+):([^:]+):([^:]*)$" proc)]
- (analyse-jvm-invokespecial analyse exo-type _class _method (if (= "" _arg-classes) (&/|list) (&/->list (string/split _arg-classes #","))) ?values))
- (if-let [[_ _class _field] (re-find #"^getstatic:([^:]+):([^:]+)$" proc)]
- (analyse-jvm-getstatic analyse exo-type _class _field ?values))
- (if-let [[_ _class _field] (re-find #"^getfield:([^:]+):([^:]+)$" proc)]
- (analyse-jvm-getfield analyse exo-type _class _field ?values))
- (if-let [[_ _class _field] (re-find #"^putstatic:([^:]+):([^:]+)$" proc)]
- (analyse-jvm-putstatic analyse exo-type _class _field ?values))
- (if-let [[_ _class _field] (re-find #"^putfield:([^:]+):([^:]+)$" proc)]
- (analyse-jvm-putfield analyse exo-type _class _field ?values))))
+(defn ^:private analyse-jvm-interface [analyse compile-interface interface-decl supers =anns =methods]
+ (|do [module &/get-module-name
+ _ (compile-interface interface-decl supers =anns =methods)
+ :let [_ (println 'DEF (str module "." (&/|first interface-decl)))]
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta &/$UnitT _cursor
+ (&&/$tuple (&/|list)))))))
- ;; else
- (fail (str "[Analyser Error] Unknown host procedure: " [category proc]))))
+(defn ^:private analyse-jvm-class [analyse compile-class class-decl super-class interfaces =inheritance-modifier =anns ?fields methods]
+ (&/with-closure
+ (|do [module &/get-module-name
+ :let [[?name ?params] class-decl
+ full-name (str (string/replace module "/" ".") "." ?name)
+ class-decl* (&/T [full-name ?params])
+ all-supers (&/$Cons super-class interfaces)]
+ class-env (make-type-env ?params)
+ =fields (&/map% (partial analyse-field analyse class-env) ?fields)
+ _ (&host/use-dummy-class class-decl super-class interfaces &/$None =fields methods)
+ =methods (&/map% (partial analyse-method analyse class-decl* class-env all-supers) methods)
+ _ (check-method-completion all-supers =methods)
+ _ (compile-class class-decl super-class interfaces =inheritance-modifier =anns =fields =methods &/$Nil &/$None)
+ :let [_ (println 'DEF full-name)]
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta &/$UnitT _cursor
+ (&&/$tuple (&/|list))))))))
+
+(defn ^:private captured-source [env-entry]
+ (|case env-entry
+ [name [_ (&&/$captured _ _ source)]]
+ source))
+
+(let [default-<init> (&/$ConstructorMethodSyntax (&/T [&/$PublicPM
+ false
+ &/$Nil
+ &/$Nil
+ &/$Nil
+ &/$Nil
+ &/$Nil
+ (&/$TupleS &/$Nil)]))
+ captured-slot-class "java.lang.Object"
+ captured-slot-type (&/$GenericClass captured-slot-class &/$Nil)]
+ (defn ^:private analyse-jvm-anon-class [analyse compile-class exo-type super-class interfaces ctor-args methods]
+ (&/with-closure
+ (|do [module &/get-module-name
+ scope &/get-scope-name
+ :let [name (&host/location (&/|tail scope))
+ class-decl (&/T [name &/$Nil])
+ anon-class (str (string/replace module "/" ".") "." name)
+ anon-class-type (&/$HostT anon-class &/$Nil)]
+ =ctor-args (&/map% (fn [ctor-arg]
+ (|let [[arg-type arg-term] ctor-arg]
+ (|do [=arg-term (&&/analyse-1+ analyse arg-term)]
+ (return (&/T [arg-type =arg-term])))))
+ ctor-args)
+ _ (->> methods
+ (&/$Cons default-<init>)
+ (&host/use-dummy-class class-decl super-class interfaces (&/$Some =ctor-args) &/$Nil))
+ :let [all-supers (&/$Cons super-class interfaces)
+ class-env &/$Nil]
+ =methods (&/map% (partial analyse-method analyse class-decl class-env all-supers) methods)
+ _ (check-method-completion all-supers =methods)
+ =captured &&env/captured-vars
+ :let [=fields (&/|map (fn [^objects idx+capt]
+ (|let [[idx _] idx+capt]
+ (&/$VariableFieldAnalysis (str &c!base/closure-prefix idx)
+ &/$PublicPM
+ &/$FinalSM
+ &/$Nil
+ captured-slot-type)))
+ (&/enumerate =captured))]
+ :let [sources (&/|map captured-source =captured)]
+ _ (compile-class class-decl super-class interfaces &/$DefaultIM &/$Nil =fields =methods =captured (&/$Some =ctor-args))
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta anon-class-type _cursor
+ (&&/$proc (&/T ["jvm" "new"]) (&/|list anon-class (&/|repeat (&/|length sources) captured-slot-class) sources))
+ )))
+ ))))
+
+(defn analyse-host [analyse exo-type compilers category proc ?values]
+ (|let [[_ _ compile-class compile-interface] compilers]
+ (case category
+ "array"
+ (case proc
+ "new" (analyse-array-new analyse exo-type ?values)
+ "get" (analyse-array-get analyse exo-type ?values)
+ "put" (analyse-jvm-aastore analyse exo-type ?values)
+ "remove" (analyse-array-remove analyse exo-type ?values)
+ "size" (analyse-jvm-arraylength analyse exo-type ?values))
+
+ "jvm"
+ (case proc
+ "try" (analyse-jvm-try analyse exo-type ?values)
+ "throw" (analyse-jvm-throw analyse exo-type ?values)
+ "monitorenter" (analyse-jvm-monitorenter analyse exo-type ?values)
+ "monitorexit" (analyse-jvm-monitorexit analyse exo-type ?values)
+ "null?" (analyse-jvm-null? analyse exo-type ?values)
+ "null" (analyse-jvm-null analyse exo-type ?values)
+ "anewarray" (analyse-jvm-anewarray analyse exo-type ?values)
+ "aaload" (analyse-jvm-aaload analyse exo-type ?values)
+ "aastore" (analyse-jvm-aastore analyse exo-type ?values)
+ "arraylength" (analyse-jvm-arraylength analyse exo-type ?values)
+ "znewarray" (analyse-jvm-znewarray analyse exo-type ?values)
+ "bnewarray" (analyse-jvm-bnewarray analyse exo-type ?values)
+ "snewarray" (analyse-jvm-snewarray analyse exo-type ?values)
+ "inewarray" (analyse-jvm-inewarray analyse exo-type ?values)
+ "lnewarray" (analyse-jvm-lnewarray analyse exo-type ?values)
+ "fnewarray" (analyse-jvm-fnewarray analyse exo-type ?values)
+ "dnewarray" (analyse-jvm-dnewarray analyse exo-type ?values)
+ "cnewarray" (analyse-jvm-cnewarray analyse exo-type ?values)
+ "iadd" (analyse-jvm-iadd analyse exo-type ?values)
+ "isub" (analyse-jvm-isub analyse exo-type ?values)
+ "imul" (analyse-jvm-imul analyse exo-type ?values)
+ "idiv" (analyse-jvm-idiv analyse exo-type ?values)
+ "irem" (analyse-jvm-irem analyse exo-type ?values)
+ "ieq" (analyse-jvm-ieq analyse exo-type ?values)
+ "ilt" (analyse-jvm-ilt analyse exo-type ?values)
+ "igt" (analyse-jvm-igt analyse exo-type ?values)
+ "ceq" (analyse-jvm-ceq analyse exo-type ?values)
+ "clt" (analyse-jvm-clt analyse exo-type ?values)
+ "cgt" (analyse-jvm-cgt analyse exo-type ?values)
+ "ladd" (analyse-jvm-ladd analyse exo-type ?values)
+ "lsub" (analyse-jvm-lsub analyse exo-type ?values)
+ "lmul" (analyse-jvm-lmul analyse exo-type ?values)
+ "ldiv" (analyse-jvm-ldiv analyse exo-type ?values)
+ "lrem" (analyse-jvm-lrem analyse exo-type ?values)
+ "leq" (analyse-jvm-leq analyse exo-type ?values)
+ "llt" (analyse-jvm-llt analyse exo-type ?values)
+ "lgt" (analyse-jvm-lgt analyse exo-type ?values)
+ "fadd" (analyse-jvm-fadd analyse exo-type ?values)
+ "fsub" (analyse-jvm-fsub analyse exo-type ?values)
+ "fmul" (analyse-jvm-fmul analyse exo-type ?values)
+ "fdiv" (analyse-jvm-fdiv analyse exo-type ?values)
+ "frem" (analyse-jvm-frem analyse exo-type ?values)
+ "feq" (analyse-jvm-feq analyse exo-type ?values)
+ "flt" (analyse-jvm-flt analyse exo-type ?values)
+ "fgt" (analyse-jvm-fgt analyse exo-type ?values)
+ "dadd" (analyse-jvm-dadd analyse exo-type ?values)
+ "dsub" (analyse-jvm-dsub analyse exo-type ?values)
+ "dmul" (analyse-jvm-dmul analyse exo-type ?values)
+ "ddiv" (analyse-jvm-ddiv analyse exo-type ?values)
+ "drem" (analyse-jvm-drem analyse exo-type ?values)
+ "deq" (analyse-jvm-deq analyse exo-type ?values)
+ "dlt" (analyse-jvm-dlt analyse exo-type ?values)
+ "dgt" (analyse-jvm-dgt analyse exo-type ?values)
+ "iand" (analyse-jvm-iand analyse exo-type ?values)
+ "ior" (analyse-jvm-ior analyse exo-type ?values)
+ "ixor" (analyse-jvm-ixor analyse exo-type ?values)
+ "ishl" (analyse-jvm-ishl analyse exo-type ?values)
+ "ishr" (analyse-jvm-ishr analyse exo-type ?values)
+ "iushr" (analyse-jvm-iushr analyse exo-type ?values)
+ "land" (analyse-jvm-land analyse exo-type ?values)
+ "lor" (analyse-jvm-lor analyse exo-type ?values)
+ "lxor" (analyse-jvm-lxor analyse exo-type ?values)
+ "lshl" (analyse-jvm-lshl analyse exo-type ?values)
+ "lshr" (analyse-jvm-lshr analyse exo-type ?values)
+ "lushr" (analyse-jvm-lushr analyse exo-type ?values)
+ "d2f" (analyse-jvm-d2f analyse exo-type ?values)
+ "d2i" (analyse-jvm-d2i analyse exo-type ?values)
+ "d2l" (analyse-jvm-d2l analyse exo-type ?values)
+ "f2d" (analyse-jvm-f2d analyse exo-type ?values)
+ "f2i" (analyse-jvm-f2i analyse exo-type ?values)
+ "f2l" (analyse-jvm-f2l analyse exo-type ?values)
+ "i2b" (analyse-jvm-i2b analyse exo-type ?values)
+ "i2c" (analyse-jvm-i2c analyse exo-type ?values)
+ "i2d" (analyse-jvm-i2d analyse exo-type ?values)
+ "i2f" (analyse-jvm-i2f analyse exo-type ?values)
+ "i2l" (analyse-jvm-i2l analyse exo-type ?values)
+ "i2s" (analyse-jvm-i2s analyse exo-type ?values)
+ "l2d" (analyse-jvm-l2d analyse exo-type ?values)
+ "l2f" (analyse-jvm-l2f analyse exo-type ?values)
+ "l2i" (analyse-jvm-l2i analyse exo-type ?values)
+ "c2b" (analyse-jvm-c2b analyse exo-type ?values)
+ "c2s" (analyse-jvm-c2s analyse exo-type ?values)
+ "c2i" (analyse-jvm-c2i analyse exo-type ?values)
+ "c2l" (analyse-jvm-c2l analyse exo-type ?values)
+ ;; else
+ (->> (fail (str "[Analyser Error] Unknown host procedure: " [category proc]))
+ (if-let [[_ _def-code] (re-find #"^interface:(.*)$" proc)]
+ (&reader/with-source "interface" _def-code
+ (|do [[=gclass-decl =supers =anns =methods] &&a-parser/parse-interface-def]
+ (analyse-jvm-interface analyse compile-interface =gclass-decl =supers =anns =methods))))
+
+ (if-let [[_ _def-code] (re-find #"^class:(.*)$" proc)]
+ (&reader/with-source "class" _def-code
+ (|do [[=gclass-decl =super-class =interfaces =inheritance-modifier =anns =fields =methods] &&a-parser/parse-class-def]
+ (analyse-jvm-class analyse compile-class =gclass-decl =super-class =interfaces =inheritance-modifier =anns =fields =methods))))
+
+ (if-let [[_ _def-code] (re-find #"^anon-class:(.*)$" proc)]
+ (&reader/with-source "anon-class" _def-code
+ (|do [[=super-class =interfaces =ctor-args =methods] &&a-parser/parse-anon-class-def]
+ (analyse-jvm-anon-class analyse compile-class exo-type =super-class =interfaces =ctor-args =methods))))
+
+ (if-let [[_ _class] (re-find #"^instanceof:([^:]+)$" proc)]
+ (analyse-jvm-instanceof analyse exo-type _class ?values))
+
+ (if-let [[_ _class _arg-classes] (re-find #"^new:([^:]+):([^:]*)$" proc)]
+ (analyse-jvm-new analyse exo-type _class (if (= "" _arg-classes) (&/|list) (&/->list (string/split _arg-classes #","))) ?values))
+
+ (if-let [[_ _class _method _arg-classes] (re-find #"^invokestatic:([^:]+):([^:]+):([^:]*)$" proc)]
+ (analyse-jvm-invokestatic analyse exo-type _class _method (if (= "" _arg-classes) (&/|list) (&/->list (string/split _arg-classes #","))) ?values))
+
+ (if-let [[_ _class _method _arg-classes] (re-find #"^invokeinterface:([^:]+):([^:]+):([^:]*)$" proc)]
+ (analyse-jvm-invokeinterface analyse exo-type _class _method (if (= "" _arg-classes) (&/|list) (&/->list (string/split _arg-classes #","))) ?values))
+
+ (if-let [[_ _class _method _arg-classes] (re-find #"^invokevirtual:([^:]+):([^:]+):([^:]*)$" proc)]
+ (analyse-jvm-invokevirtual analyse exo-type _class _method (if (= "" _arg-classes) (&/|list) (&/->list (string/split _arg-classes #","))) ?values))
+
+ (if-let [[_ _class _method _arg-classes] (re-find #"^invokespecial:([^:]+):([^:]+):([^:]*)$" proc)]
+ (analyse-jvm-invokespecial analyse exo-type _class _method (if (= "" _arg-classes) (&/|list) (&/->list (string/split _arg-classes #","))) ?values))
+
+ (if-let [[_ _class _field] (re-find #"^getstatic:([^:]+):([^:]+)$" proc)]
+ (analyse-jvm-getstatic analyse exo-type _class _field ?values))
+
+ (if-let [[_ _class _field] (re-find #"^getfield:([^:]+):([^:]+)$" proc)]
+ (analyse-jvm-getfield analyse exo-type _class _field ?values))
+
+ (if-let [[_ _class _field] (re-find #"^putstatic:([^:]+):([^:]+)$" proc)]
+ (analyse-jvm-putstatic analyse exo-type _class _field ?values))
+
+ (if-let [[_ _class _field] (re-find #"^putfield:([^:]+):([^:]+)$" proc)]
+ (analyse-jvm-putfield analyse exo-type _class _field ?values))))
+
+ ;; else
+ (fail (str "[Analyser Error] Unknown host procedure: " [category proc])))))
diff --git a/src/lux/analyser/parser.clj b/src/lux/analyser/parser.clj
index db41b5edb..e0851100d 100644
--- a/src/lux/analyser/parser.clj
+++ b/src/lux/analyser/parser.clj
@@ -7,375 +7,454 @@
(:require (clojure [template :refer [do-template]])
clojure.core.match
clojure.core.match.array
- (lux [base :as & :refer [|do return* return fail fail* |let |case]])))
+ (lux [base :as & :refer [|do return* return fail fail* |let |case]]
+ [reader :as &reader]
+ [lexer :as &lexer]
+ [parser :as &parser])))
(declare parse-gclass)
;; [Parsers]
-(defn parse-tag [ast]
- (|case ast
- [_ (&/$TagS "" name)]
- (return name)
-
- _
- (fail (str "[Analyser Error] Not a tag: " (&/show-ast ast)))))
-
-(defn parse-text [ast]
- (|case ast
- [_ (&/$TextS text)]
- (return text)
-
- _
- (fail (str "[Analyser Error] Not text: " (&/show-ast ast)))))
-
-(defn parse-type-param [ast]
- (|case ast
- [_ (&/$TupleS (&/$Cons [_ (&/$TextS tname)] (&/$Cons [_ (&/$TupleS ?bounds)] (&/$Nil))))]
- (|do [=bounds (&/map% parse-gclass ?bounds)]
- (return (&/T [tname =bounds])))
-
- _
- (fail (str "[Analyser Error] Not a type-param: " (&/show-ast ast)))))
-
-(defn parse-gclass-decl [ast]
- (|case ast
- [_ (&/$FormS (&/$Cons [_ (&/$TextS class-name)] (&/$Cons [_ (&/$TupleS args)] (&/$Nil))))]
- (|do [=args (&/map% parse-type-param args)]
- (return (&/T [class-name =args])))
-
- _
- (fail (str "[Analyser Error] Not generic class declaration: " (&/show-ast ast)))))
-
-(defn parse-bound-kind [ast]
- (|case ast
- [_ (&/$TextS "<")]
- (return &/$UpperBound)
-
- [_ (&/$TextS ">")]
- (return &/$LowerBound)
-
- _
- (fail (str "[Analyser Error] Not a bound kind: " (&/show-ast ast)))))
-
-(defn parse-gclass [ast]
- (|case ast
- [_ (&/$TupleS (&/$Cons [_ (&/$TextS "*")] (&/$Nil)))]
- (return (&/$GenericWildcard &/$None))
-
- [_ (&/$TupleS (&/$Cons [_ (&/$TextS "*")] (&/$Cons ?bound-kind (&/$Cons ?bound (&/$Nil)))))]
- (|do [=bound-kind (parse-bound-kind ?bound-kind)
- =bound (parse-gclass ?bound)]
- (return (&/$GenericWildcard (&/$Some (&/T [=bound-kind =bound])))))
-
- [_ (&/$TextS var-name)]
- (return (&/$GenericTypeVar var-name))
-
- [_ (&/$FormS (&/$Cons [_ (&/$TextS class-name)] (&/$Cons [_ (&/$TupleS params)] (&/$Nil))))]
- (|do [=params (&/map% parse-gclass params)]
- (return (&/$GenericClass class-name =params)))
-
- [_ (&/$FormS (&/$Cons [_ (&/$TextS "Array")] (&/$Cons param (&/$Nil))))]
- (|do [=param (parse-gclass param)]
- (return (&/$GenericArray =param)))
-
- _
- (fail (str "[Analyser Error] Not generic class: " (&/show-ast ast)))))
-
-(defn parse-gclass-super [ast]
- (|case ast
- [_ (&/$FormS (&/$Cons [_ (&/$TextS class-name)] (&/$Cons [_ (&/$TupleS params)] (&/$Nil))))]
- (|do [=params (&/map% parse-gclass params)]
- (return (&/T [class-name =params])))
-
- _
- (fail (str "[Analyser Error] Not generic super-class: " (&/show-ast ast)))))
-
-(defn parse-ctor-arg [ast]
- (|case ast
- [_ (&/$TupleS (&/$Cons ?class (&/$Cons ?term (&/$Nil))))]
- (|do [=class (parse-gclass ?class)]
- (return (&/T [=class ?term])))
-
- _
- (fail (str "[Analyser Error] Not constructor argument: " (&/show-ast ast)))))
-
-(let [failure (fail (str "[Analyser Error] Invalid annotation parameter."))]
- (defn ^:private parse-ann-param [param]
- (|case param
- [[_ (&/$TextS param-name)] param-value]
- (|case param-value
- [_ (&/$BoolS param-value*)] (return (&/T [param-name (boolean param-value*)]))
- [_ (&/$IntS param-value*)] (return (&/T [param-name (int param-value*)]))
- [_ (&/$RealS param-value*)] (return (&/T [param-name (float param-value*)]))
- [_ (&/$CharS param-value*)] (return (&/T [param-name (char param-value*)]))
- [_ (&/$TextS param-value*)] (return (&/T [param-name param-value*]))
-
- _
- failure)
-
- _
- failure)))
-
-(defn parse-ann [ast]
- (|case ast
- [_ (&/$FormS (&/$Cons [_ (&/$TextS ann-name)] (&/$Cons [_ (&/$RecordS ann-params)] (&/$Nil))))]
- (|do [=ann-params (&/map% parse-ann-param ann-params)]
+(def ^:private _space_ (&reader/read-text " "))
+
+(defn ^:private repeat% [action]
+ (fn [state]
+ (|case (action state)
+ (&/$Left ^String error)
+ (&/$Right (&/T [state &/$Nil]))
+
+ (&/$Right state* head)
+ ((|do [tail (repeat% action)]
+ (return (&/$Cons head tail)))
+ state*))))
+
+(defn ^:private spaced [action]
+ (fn [state]
+ (|case (action state)
+ (&/$Left ^String error)
+ (&/$Right (&/T [state &/$Nil]))
+
+ (&/$Right state* head)
+ ((&/try-all% (&/|list (|do [_ _space_
+ tail (spaced action)]
+ (return (&/$Cons head tail)))
+ (return (&/|list head))))
+ state*))))
+
+(def ^:private parse-name
+ (|do [[_ _ =name] (&reader/read-regex #"^([a-zA-Z0-9_\.]+)")]
+ (return =name)))
+
+(defn ^:private with-parens [body]
+ (|do [_ (&reader/read-text "(")
+ output body
+ _ (&reader/read-text ")")]
+ (return output)))
+
+(defn ^:private with-brackets [body]
+ (|do [_ (&reader/read-text "[")
+ output body
+ _ (&reader/read-text "]")]
+ (return output)))
+
+(defn ^:private with-braces [body]
+ (|do [_ (&reader/read-text "{")
+ output body
+ _ (&reader/read-text "}")]
+ (return output)))
+
+(def ^:private parse-type-param
+ (with-parens
+ (|do [=name parse-name
+ _ _space_
+ =bounds (spaced parse-gclass)]
+ (return (&/T [=name =bounds])))))
+
+(def ^:private parse-gclass-decl
+ (with-parens
+ (|do [=class-name parse-name
+ _ _space_
+ =params (spaced parse-type-param)]
+ (return (&/T [=class-name =params])))))
+
+(def ^:private parse-bound-kind
+ (&/try-all% (&/|list (|do [_ (&reader/read-text "<")]
+ (return &/$UpperBound))
+
+ (|do [_ (&reader/read-text ">")]
+ (return &/$LowerBound))
+ )))
+
+(def parse-gclass
+ (&/try-all% (&/|list (|do [=bound-kind parse-bound-kind
+ =bound parse-gclass]
+ (return (&/$GenericWildcard (&/$Some (&/T [=bound-kind =bound])))))
+
+ (|do [_ (&reader/read-text "?")]
+ (return (&/$GenericWildcard &/$None)))
+
+ (|do [var-name parse-name]
+ (return (&/$GenericTypeVar var-name)))
+
+ (with-parens
+ (|do [class-name parse-name
+ _ _space_
+ =params (spaced parse-gclass)]
+ (return (&/$GenericClass class-name =params))))
+
+ (with-parens
+ (|do [_ (&reader/read-text "Array")
+ _ _space_
+ =param parse-gclass]
+ (return (&/$GenericArray =param))))
+ )))
+
+(def ^:private parse-gclass-super
+ (with-parens
+ (|do [class-name parse-name
+ _ _space_
+ =params (spaced parse-gclass)]
+ (return (&/T [class-name =params])))))
+
+(def ^:private parse-ctor-arg
+ (with-brackets
+ (|do [=class parse-gclass
+ (&/$Cons =term (&/$Nil)) &parser/parse]
+ (return (&/T [=class =term])))))
+
+(def ^:private parse-ann-param
+ (|do [param-name parse-name
+ _ (&reader/read-text "=")
+ param-value (&/try-all% (&/|list (|do [[_ (&lexer/$Bool param-value*)] &lexer/lex-bool]
+ (return (boolean param-value*)))
+
+ (|do [[_ (&lexer/$Int param-value*)] &lexer/lex-int]
+ (return (int param-value*)))
+
+ (|do [_ (&reader/read-text "l")
+ [_ (&lexer/$Int param-value*)] &lexer/lex-int]
+ (return (long param-value*)))
+
+ (|do [[_ (&lexer/$Real param-value*)] &lexer/lex-real]
+ (return (float param-value*)))
+
+ (|do [_ (&reader/read-text "d")
+ [_ (&lexer/$Real param-value*)] &lexer/lex-real]
+ (return (double param-value*)))
+
+ (|do [[_ (&lexer/$Char param-value*)] &lexer/lex-char]
+ (return (char param-value*)))
+
+ (|do [[_ (&lexer/$Text param-value*)] &lexer/lex-text]
+ (return param-value*))
+ ))]
+ (return (&/T [param-name param-value]))))
+
+(def ^:private parse-ann
+ (with-parens
+ (|do [ann-name parse-name
+ _ _space_
+ =ann-params (with-braces
+ (spaced parse-ann-param))]
(return {:name ann-name
- :params =ann-params}))
-
- _
- (fail (str "[Analyser Error] Invalid annotation: " (&/show-ast ast)))))
-
-(defn ^:private parse-arg-decl [ast]
- (|case ast
- [_ (&/$FormS (&/$Cons [_ (&/$SymbolS ["" arg-name])]
- (&/$Cons gclass
- (&/$Nil))))]
- (|do [=gclass (parse-gclass gclass)]
- (return (&/T [arg-name =gclass])))
-
- _
- (fail (str "[Analyser Error] Invalid argument declaration: " (&/show-ast ast)))))
-
-(defn parse-method-decl [ast]
- (|case ast
- [_ (&/$FormS (&/$Cons [_ (&/$TextS method-name)]
- (&/$Cons [_ (&/$TupleS anns)]
- (&/$Cons [_ (&/$TupleS gvars)]
- (&/$Cons [_ (&/$TupleS exceptions)]
- (&/$Cons [_ (&/$TupleS inputs)]
- (&/$Cons output
- (&/$Nil))))))))]
- (|do [=anns (&/map% parse-ann anns)
- =gvars (&/map% parse-text gvars)
- =exceptions (&/map% parse-gclass exceptions)
- =inputs (&/map% parse-gclass inputs)
- =output (parse-gclass output)]
- (return (&/T [method-name =anns =gvars =exceptions =inputs =output])))
-
- _
- (fail (str "[Analyser Error] Invalid method declaration: " (&/show-ast ast)))))
-
-(defn parse-privacy-modifier [ast]
- (|case ast
- [_ (&/$TextS "default")]
- (return &/$DefaultPM)
-
- [_ (&/$TextS "public")]
- (return &/$PublicPM)
-
- [_ (&/$TextS "protected")]
- (return &/$ProtectedPM)
-
- [_ (&/$TextS "private")]
- (return &/$PrivatePM)
-
- _
- (fail (str "[Analyser Error] Invalid privacy modifier: " (&/show-ast ast)))))
-
-(defn parse-state-modifier [ast]
- (|case ast
- [_ (&/$TextS "default")]
- (return &/$DefaultSM)
-
- [_ (&/$TextS "volatile")]
- (return &/$VolatileSM)
-
- [_ (&/$TextS "final")]
- (return &/$FinalSM)
-
- _
- (fail (str "[Analyser Error] Invalid state modifier: " (&/show-ast ast)))))
-
-(defn parse-inheritance-modifier [ast]
- (|case ast
- [_ (&/$TextS "default")]
- (return &/$DefaultIM)
-
- [_ (&/$TextS "abstract")]
- (return &/$AbstractIM)
-
- [_ (&/$TextS "final")]
- (return &/$FinalIM)
-
- _
- (fail (str "[Analyser Error] Invalid inheritance modifier: " (&/show-ast ast)))))
-
-(defn ^:private parse-method-init-def [ast]
- (|case ast
- [_ (&/$FormS (&/$Cons [_ (&/$TextS "init")]
- (&/$Cons ?privacy-modifier
- (&/$Cons [_ (&/$BoolS ?strict)]
- (&/$Cons [_ (&/$TupleS anns)]
- (&/$Cons [_ (&/$TupleS gvars)]
- (&/$Cons [_ (&/$TupleS exceptions)]
- (&/$Cons [_ (&/$TupleS inputs)]
- (&/$Cons [_ (&/$TupleS ?ctor-args)]
- (&/$Cons body
- (&/$Nil)))))))))))]
- (|do [=privacy-modifier (parse-privacy-modifier ?privacy-modifier)
- =anns (&/map% parse-ann anns)
- =gvars (&/map% parse-type-param gvars)
- =exceptions (&/map% parse-gclass exceptions)
- =inputs (&/map% parse-arg-decl inputs)
- =ctor-args (&/map% parse-ctor-arg ?ctor-args)]
- (return (&/$ConstructorMethodSyntax (&/T [=privacy-modifier ?strict =anns =gvars =exceptions =inputs =ctor-args body]))))
-
- _
- (fail "")))
-
-(defn ^:private parse-method-virtual-def [ast]
- (|case ast
- [_ (&/$FormS (&/$Cons [_ (&/$TextS "virtual")]
- (&/$Cons [_ (&/$TextS ?name)]
- (&/$Cons ?privacy-modifier
- (&/$Cons [_ (&/$BoolS =final?)]
- (&/$Cons [_ (&/$BoolS ?strict)]
- (&/$Cons [_ (&/$TupleS anns)]
- (&/$Cons [_ (&/$TupleS gvars)]
- (&/$Cons [_ (&/$TupleS exceptions)]
- (&/$Cons [_ (&/$TupleS inputs)]
- (&/$Cons output
- (&/$Cons body
- (&/$Nil)))))))))))))]
- (|do [=privacy-modifier (parse-privacy-modifier ?privacy-modifier)
- =anns (&/map% parse-ann anns)
- =gvars (&/map% parse-type-param gvars)
- =exceptions (&/map% parse-gclass exceptions)
- =inputs (&/map% parse-arg-decl inputs)
- =output (parse-gclass output)]
- (return (&/$VirtualMethodSyntax (&/T [?name =privacy-modifier =final? ?strict =anns =gvars =exceptions =inputs =output body]))))
-
- _
- (fail "")))
-
-(defn ^:private parse-method-override-def [ast]
- (|case ast
- [_ (&/$FormS (&/$Cons [_ (&/$TextS "override")]
- (&/$Cons ?class-decl
- (&/$Cons ?name
- (&/$Cons [_ (&/$BoolS ?strict)]
- (&/$Cons [_ (&/$TupleS anns)]
- (&/$Cons [_ (&/$TupleS gvars)]
- (&/$Cons [_ (&/$TupleS exceptions)]
- (&/$Cons [_ (&/$TupleS inputs)]
- (&/$Cons output
- (&/$Cons body
- (&/$Nil))))))))))))]
- (|do [=name (parse-text ?name)
- =class-decl (parse-gclass-decl ?class-decl)
- =anns (&/map% parse-ann anns)
- =gvars (&/map% parse-type-param gvars)
- =exceptions (&/map% parse-gclass exceptions)
- =inputs (&/map% parse-arg-decl inputs)
- =output (parse-gclass output)]
- (return (&/$OverridenMethodSyntax (&/T [=class-decl =name ?strict =anns =gvars =exceptions =inputs =output body]))))
-
- _
- (fail "")))
-
-(defn ^:private parse-method-static-def [ast]
- (|case ast
- [_ (&/$FormS (&/$Cons [_ (&/$TextS "static")]
- (&/$Cons [_ (&/$TextS ?name)]
- (&/$Cons ?privacy-modifier
- (&/$Cons [_ (&/$BoolS ?strict)]
- (&/$Cons [_ (&/$TupleS anns)]
- (&/$Cons [_ (&/$TupleS gvars)]
- (&/$Cons [_ (&/$TupleS exceptions)]
- (&/$Cons [_ (&/$TupleS inputs)]
- (&/$Cons output
- (&/$Cons body
- (&/$Nil))))))))))))]
- (|do [=privacy-modifier (parse-privacy-modifier ?privacy-modifier)
- =anns (&/map% parse-ann anns)
- =gvars (&/map% parse-type-param gvars)
- =exceptions (&/map% parse-gclass exceptions)
- =inputs (&/map% parse-arg-decl inputs)
- =output (parse-gclass output)]
- (return (&/$StaticMethodSyntax (&/T [?name =privacy-modifier ?strict =anns =gvars =exceptions =inputs =output body]))))
-
- _
- (fail "")))
-
-(defn ^:private parse-method-abstract-def [ast]
- (|case ast
- [_ (&/$FormS (&/$Cons [_ (&/$TextS "abstract")]
- (&/$Cons [_ (&/$TextS ?name)]
- (&/$Cons ?privacy-modifier
- (&/$Cons [_ (&/$TupleS anns)]
- (&/$Cons [_ (&/$TupleS gvars)]
- (&/$Cons [_ (&/$TupleS exceptions)]
- (&/$Cons [_ (&/$TupleS inputs)]
- (&/$Cons output
- (&/$Nil))))))))))]
- (|do [=privacy-modifier (parse-privacy-modifier ?privacy-modifier)
- =anns (&/map% parse-ann anns)
- =gvars (&/map% parse-type-param gvars)
- =exceptions (&/map% parse-gclass exceptions)
- =inputs (&/map% parse-arg-decl inputs)
- =output (parse-gclass output)]
- (return (&/$AbstractMethodSyntax (&/T [?name =privacy-modifier =anns =gvars =exceptions =inputs =output]))))
-
- _
- (fail "")))
-
-(defn ^:private parse-method-native-def [ast]
- (|case ast
- [_ (&/$FormS (&/$Cons [_ (&/$TextS "native")]
- (&/$Cons [_ (&/$TextS ?name)]
- (&/$Cons ?privacy-modifier
- (&/$Cons [_ (&/$TupleS anns)]
- (&/$Cons [_ (&/$TupleS gvars)]
- (&/$Cons [_ (&/$TupleS exceptions)]
- (&/$Cons [_ (&/$TupleS inputs)]
- (&/$Cons output
- (&/$Nil))))))))))]
- (|do [=privacy-modifier (parse-privacy-modifier ?privacy-modifier)
- =anns (&/map% parse-ann anns)
- =gvars (&/map% parse-type-param gvars)
- =exceptions (&/map% parse-gclass exceptions)
- =inputs (&/map% parse-arg-decl inputs)
- =output (parse-gclass output)]
- (return (&/$NativeMethodSyntax (&/T [?name =privacy-modifier =anns =gvars =exceptions =inputs =output]))))
-
- _
- (fail "")))
-
-(defn parse-method-def [ast]
- (&/try-all% (&/|list #((parse-method-init-def ast) %)
- #((parse-method-virtual-def ast) %)
- #((parse-method-override-def ast) %)
- #((parse-method-static-def ast) %)
- #((parse-method-abstract-def ast) %)
- #((parse-method-native-def ast) %)
- (fn [state]
- (fail* (str "[Analyser Error] Invalid method definition: " (&/show-ast ast)))))))
-
-(defn parse-field [ast]
- (|case ast
- [_ (&/$FormS (&/$Cons [_ (&/$TextS "constant")]
- (&/$Cons [_ (&/$TextS ?name)]
- (&/$Cons [_ (&/$TupleS ?anns)]
- (&/$Cons ?type
- (&/$Cons ?value
- (&/$Nil)))))))]
- (|do [=anns (&/map% parse-ann ?anns)
- =type (parse-gclass ?type)]
- (return (&/$ConstantFieldSyntax ?name =anns =type ?value)))
-
- [_ (&/$FormS (&/$Cons [_ (&/$TextS "variable")]
- (&/$Cons [_ (&/$TextS ?name)]
- (&/$Cons ?privacy-modifier
- (&/$Cons ?state-modifier
- (&/$Cons [_ (&/$TupleS ?anns)]
- (&/$Cons ?type
- (&/$Nil))))))))]
- (|do [=privacy-modifier (parse-privacy-modifier ?privacy-modifier)
- =state-modifier (parse-state-modifier ?state-modifier)
- =anns (&/map% parse-ann ?anns)
- =type (parse-gclass ?type)]
- (return (&/$VariableFieldSyntax ?name =privacy-modifier =state-modifier =anns =type)))
-
- _
- (fail (str "[Analyser Error] Invalid field declaration: " (&/show-ast ast)))))
+ :params =ann-params}))))
+
+(def ^:private parse-arg-decl
+ (with-parens
+ (|do [=arg-name parse-name
+ _ (&reader/read-text " ")
+ =gclass parse-gclass]
+ (return (&/T [=arg-name =gclass])))))
+
+(def ^:private parse-gvars
+ (|do [=head parse-name
+ [_ _ ?] (&reader/read-text? " ")]
+ (if ?
+ (|do [=tail parse-gvars]
+ (return (&/$Cons =head =tail)))
+ (return (&/|list =head)))))
+
+(def ^:private parse-method-decl
+ (with-parens
+ (|do [=method-name parse-name
+ _ _space_
+ =anns (with-brackets
+ (spaced parse-ann))
+ _ _space_
+ =gvars (with-brackets
+ parse-gvars)
+ _ _space_
+ =exceptions (with-brackets
+ (spaced parse-gclass))
+ _ _space_
+ =inputs (with-brackets
+ (spaced parse-gclass))
+ _ _space_
+ =output parse-gclass]
+ (return (&/T [=method-name =anns =gvars =exceptions =inputs =output])))))
+
+(def ^:private parse-privacy-modifier
+ (&/try-all% (&/|list (|do [_ (&reader/read-text "default")]
+ (return &/$DefaultPM))
+
+ (|do [_ (&reader/read-text "public")]
+ (return &/$PublicPM))
+
+ (|do [_ (&reader/read-text "protected")]
+ (return &/$ProtectedPM))
+
+ (|do [_ (&reader/read-text "private")]
+ (return &/$PrivatePM))
+ )))
+
+(def ^:private parse-state-modifier
+ (&/try-all% (&/|list (|do [_ (&reader/read-text "default")]
+ (return &/$DefaultSM))
+
+ (|do [_ (&reader/read-text "volatile")]
+ (return &/$VolatileSM))
+
+ (|do [_ (&reader/read-text "final")]
+ (return &/$FinalSM))
+ )))
+
+(def ^:private parse-inheritance-modifier
+ (&/try-all% (&/|list (|do [_ (&reader/read-text "default")]
+ (return &/$DefaultIM))
+
+ (|do [_ (&reader/read-text "abstract")]
+ (return &/$AbstractIM))
+
+ (|do [_ (&reader/read-text "final")]
+ (return &/$FinalIM))
+ )))
+
+(def ^:private parse-method-init-def
+ (|do [_ (&reader/read-text "init")
+ _ _space_
+ =privacy-modifier parse-privacy-modifier
+ _ _space_
+ [_ (&lexer/$Bool =strict)] &lexer/lex-bool
+ _ _space_
+ =anns (with-brackets
+ (spaced parse-ann))
+ _ _space_
+ =gvars (with-brackets
+ (spaced parse-type-param))
+ _ _space_
+ =exceptions (with-brackets
+ (spaced parse-gclass))
+ _ _space_
+ =inputs (with-brackets
+ (spaced parse-arg-decl))
+ _ _space_
+ =ctor-args (with-brackets
+ (spaced parse-ctor-arg))
+ _ _space_
+ (&/$Cons =body (&/$Nil)) &parser/parse]
+ (return (&/$ConstructorMethodSyntax (&/T [=privacy-modifier =strict =anns =gvars =exceptions =inputs =ctor-args =body])))))
+
+(def ^:private parse-method-virtual-def
+ (|do [_ (&reader/read-text "virtual")
+ _ _space_
+ =name parse-name
+ _ _space_
+ =privacy-modifier parse-privacy-modifier
+ _ _space_
+ [_ (&lexer/$Bool =final?)] &lexer/lex-bool
+ _ _space_
+ [_ (&lexer/$Bool =strict)] &lexer/lex-bool
+ _ _space_
+ =anns (with-brackets
+ (spaced parse-ann))
+ _ _space_
+ =gvars (with-brackets
+ (spaced parse-type-param))
+ _ _space_
+ =exceptions (with-brackets
+ (spaced parse-gclass))
+ _ _space_
+ =inputs (with-brackets
+ (spaced parse-arg-decl))
+ _ _space_
+ =output parse-gclass
+ _ _space_
+ (&/$Cons =body (&/$Nil)) &parser/parse]
+ (return (&/$VirtualMethodSyntax (&/T [=name =privacy-modifier =final? =strict =anns =gvars =exceptions =inputs =output =body])))))
+
+(def ^:private parse-method-override-def
+ (|do [_ (&reader/read-text "override")
+ _ _space_
+ =class-decl parse-gclass-decl
+ _ _space_
+ =name parse-name
+ _ _space_
+ [_ (&lexer/$Bool =strict)] &lexer/lex-bool
+ _ _space_
+ =anns (with-brackets
+ (spaced parse-ann))
+ _ _space_
+ =gvars (with-brackets
+ (spaced parse-type-param))
+ _ _space_
+ =exceptions (with-brackets
+ (spaced parse-gclass))
+ _ _space_
+ =inputs (with-brackets
+ (spaced parse-arg-decl))
+ _ _space_
+ =output parse-gclass
+ _ _space_
+ (&/$Cons =body (&/$Nil)) &parser/parse]
+ (return (&/$OverridenMethodSyntax (&/T [=class-decl =name =strict =anns =gvars =exceptions =inputs =output =body])))))
+
+(def ^:private parse-method-static-def
+ (|do [_ (&reader/read-text "static")
+ _ _space_
+ =name parse-name
+ _ _space_
+ =privacy-modifier parse-privacy-modifier
+ _ _space_
+ [_ (&lexer/$Bool =strict)] &lexer/lex-bool
+ _ _space_
+ =anns (with-brackets
+ (spaced parse-ann))
+ _ _space_
+ =gvars (with-brackets
+ (spaced parse-type-param))
+ _ _space_
+ =exceptions (with-brackets
+ (spaced parse-gclass))
+ _ _space_
+ =inputs (with-brackets
+ (spaced parse-arg-decl))
+ _ _space_
+ =output parse-gclass
+ _ _space_
+ (&/$Cons =body (&/$Nil)) &parser/parse]
+ (return (&/$StaticMethodSyntax (&/T [=name =privacy-modifier =strict =anns =gvars =exceptions =inputs =output =body])))))
+
+(def ^:private parse-method-abstract-def
+ (|do [_ (&reader/read-text "abstract")
+ _ _space_
+ =name parse-name
+ _ _space_
+ =privacy-modifier parse-privacy-modifier
+ _ _space_
+ =anns (with-brackets
+ (spaced parse-ann))
+ _ _space_
+ =gvars (with-brackets
+ (spaced parse-type-param))
+ _ _space_
+ =exceptions (with-brackets
+ (spaced parse-gclass))
+ _ _space_
+ =inputs (with-brackets
+ (spaced parse-arg-decl))
+ _ _space_
+ =output parse-gclass]
+ (return (&/$AbstractMethodSyntax (&/T [=name =privacy-modifier =anns =gvars =exceptions =inputs =output])))))
+
+(def ^:private parse-method-native-def
+ (|do [_ (&reader/read-text "native")
+ _ _space_
+ =name parse-name
+ _ _space_
+ =privacy-modifier parse-privacy-modifier
+ _ _space_
+ =anns (with-brackets
+ (spaced parse-ann))
+ _ _space_
+ =gvars (with-brackets
+ (spaced parse-type-param))
+ _ _space_
+ =exceptions (with-brackets
+ (spaced parse-gclass))
+ _ _space_
+ =inputs (with-brackets
+ (spaced parse-arg-decl))
+ _ _space_
+ =output parse-gclass]
+ (return (&/$NativeMethodSyntax (&/T [=name =privacy-modifier =anns =gvars =exceptions =inputs =output])))))
+
+(def ^:private parse-method-def
+ (with-parens
+ (&/try-all% (&/|list parse-method-init-def
+ parse-method-virtual-def
+ parse-method-override-def
+ parse-method-static-def
+ parse-method-abstract-def
+ parse-method-native-def
+ ))))
+
+(def ^:private parse-field
+ (with-parens
+ (&/try-all% (&/|list (|do [_ (&reader/read-text "constant")
+ _ _space_
+ =name parse-name
+ _ _space_
+ =anns (with-brackets
+ (spaced parse-ann))
+ _ _space_
+ =type parse-gclass
+ _ _space_
+ (&/$Cons =value (&/$Nil)) &parser/parse]
+ (return (&/$ConstantFieldSyntax =name =anns =type =value)))
+
+ (|do [_ (&reader/read-text "variable")
+ _ _space_
+ =name parse-name
+ _ _space_
+ =privacy-modifier parse-privacy-modifier
+ _ _space_
+ =state-modifier parse-state-modifier
+ _ _space_
+ =anns (with-brackets
+ (spaced parse-ann))
+ _ _space_
+ =type parse-gclass]
+ (return (&/$VariableFieldSyntax =name =privacy-modifier =state-modifier =anns =type)))
+ ))))
+
+(def parse-interface-def
+ (|do [=gclass-decl parse-gclass-decl
+ =supers (with-brackets
+ (spaced parse-gclass-super))
+ =anns (with-brackets
+ (spaced parse-ann))
+ =methods (spaced parse-method-decl)]
+ (return (&/T [=gclass-decl =supers =anns =methods]))))
+
+(def parse-class-def
+ (|do [=gclass-decl parse-gclass-decl
+ _ _space_
+ =super-class parse-gclass-super
+ _ _space_
+ =interfaces (with-brackets
+ (spaced parse-gclass-super))
+ _ _space_
+ =inheritance-modifier parse-inheritance-modifier
+ _ _space_
+ =anns (with-brackets
+ (spaced parse-ann))
+ _ _space_
+ =fields (with-brackets
+ (spaced parse-field))
+ _ _space_
+ =methods (with-brackets
+ (spaced parse-method-def))]
+ (return (&/T [=gclass-decl =super-class =interfaces =inheritance-modifier =anns =fields =methods]))))
+
+(def parse-anon-class-def
+ (|do [=super-class parse-gclass-super
+ _ _space_
+ =interfaces (with-brackets
+ (spaced parse-gclass-super))
+ _ _space_
+ =ctor-args (with-brackets
+ (spaced parse-ctor-arg))
+ _ _space_
+ =methods (with-brackets
+ (spaced parse-method-def))]
+ (return (&/T [=super-class =interfaces =ctor-args =methods]))))
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 124796788..713d5ea9a 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -99,15 +99,6 @@
))
))
-(defn compile-statement [syntax]
- (|case syntax
- (&o/$jvm-interface ?name ?supers ?anns ?methods)
- (&&host/compile-jvm-interface compile-expression ?name ?supers ?anns ?methods)
-
- (&o/$jvm-class ?name ?super-class ?interfaces ?anns ?inheritance-modifier ?fields ?methods ??env ??ctor-args)
- (&&host/compile-jvm-class compile-expression ?name ?super-class ?interfaces ?anns ?inheritance-modifier ?fields ?methods ??env ??ctor-args)
- ))
-
(defn init! []
(reset! !source->last-line {})
(.mkdirs (java.io.File. &&/output-dir))
@@ -146,15 +137,19 @@
(.get nil)
return))))
+(def all-compilers
+ (&/T [(partial &&lux/compile-def compile-expression)
+ (partial &&lux/compile-program compile-expression)
+ (partial &&host/compile-jvm-class compile-expression)
+ &&host/compile-jvm-interface]))
+
(defn compile-module [source-dirs name]
(let [file-name (str name ".lux")]
(|do [file-content (&&io/read-file source-dirs file-name)
:let [file-hash (hash file-content)]]
(if (&&cache/cached? name)
(&&cache/load source-dirs name file-hash compile-module)
- (let [compiler-step (&optimizer/optimize eval! (partial compile-module source-dirs) (&/T [compile-statement
- (partial &&lux/compile-def compile-expression)
- (partial &&lux/compile-program compile-expression)]))]
+ (let [compiler-step (&optimizer/optimize eval! (partial compile-module source-dirs) all-compilers)]
(|do [module-exists? (&a-module/exists? name)]
(if module-exists?
(fail "[Compiler Error] Can't redefine a module!")
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index 198e77254..cb2777124 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -502,7 +502,7 @@
(return nil)))]
(&&/save-class! ?name (.toByteArray (doto =class .visitEnd)))))
-(defn compile-jvm-interface [compile interface-decl ?supers ?anns ?methods]
+(defn compile-jvm-interface [interface-decl ?supers ?anns ?methods]
(|do [:let [[interface-name interface-vars] interface-decl]
module &/get-module-name
[file-name _ _] &/cursor
@@ -530,7 +530,7 @@
(&/|list)
(&/|list object-class)
object-class]))]
- (compile-jvm-interface nil interface-decl ?supers ?anns ?methods)))
+ (compile-jvm-interface interface-decl ?supers ?anns ?methods)))
(def compile-LuxUtils-class
(|do [_ (return nil)
diff --git a/src/lux/lexer.clj b/src/lux/lexer.clj
index f6113cc7c..8262e5be0 100644
--- a/src/lux/lexer.clj
+++ b/src/lux/lexer.clj
@@ -116,7 +116,7 @@
(return (&/T [pre-quotes* ""]))))]
(return (str (clean-line pre-quotes) post-quotes))))
-(def ^:private lex-text
+(def lex-text
(|do [[meta _ _] (&reader/read-text "\"")
:let [[_ _ _column] meta]
token (lex-text-body false (inc _column))
@@ -156,12 +156,12 @@
(|do [[meta _ token] (&reader/read-regex <regex>)]
(return (&/T [meta (<tag> token)]))))
- ^:private lex-bool $Bool #"^(true|false)"
- ^:private lex-int $Int #"^-?(0|[1-9][0-9]*)"
- ^:private lex-real $Real #"^-?(0\.[0-9]+|[1-9][0-9]*\.[0-9]+)(e-?[1-9][0-9]*)?"
+ lex-bool $Bool #"^(true|false)"
+ lex-int $Int #"^-?(0|[1-9][0-9]*)"
+ lex-real $Real #"^-?(0\.[0-9]+|[1-9][0-9]*\.[0-9]+)(e-?[1-9][0-9]*)?"
)
-(def ^:private lex-char
+(def lex-char
(|do [[meta _ _] (&reader/read-text "#\"")
token (&/try-all% (&/|list (|do [[_ _ escaped] (&reader/read-regex #"^(\\.)")]
(escape-char escaped))
diff --git a/src/lux/optimizer.clj b/src/lux/optimizer.clj
index 704473935..f996587b5 100644
--- a/src/lux/optimizer.clj
+++ b/src/lux/optimizer.clj
@@ -24,62 +24,53 @@
("var" 1)
("captured" 1)
("proc" 2)
-
- ("jvm-class" 1)
- ("jvm-interface" 1)
)
;; [Exports]
(defn optimize-token [analysis]
"(-> Analysis Optimized)"
(|case analysis
- (&-base/$bool value)
- (return ($bool value))
+ [meta (&-base/$bool value)]
+ (return (&/T [meta ($bool value)]))
- (&-base/$int value)
- (return ($int value))
+ [meta (&-base/$int value)]
+ (return (&/T [meta ($int value)]))
- (&-base/$real value)
- (return ($real value))
+ [meta (&-base/$real value)]
+ (return (&/T [meta ($real value)]))
- (&-base/$char value)
- (return ($char value))
+ [meta (&-base/$char value)]
+ (return (&/T [meta ($char value)]))
- (&-base/$text value)
- (return ($text value))
+ [meta (&-base/$text value)]
+ (return (&/T [meta ($text value)]))
- (&-base/$variant value)
- (return ($variant value))
+ [meta (&-base/$variant value)]
+ (return (&/T [meta ($variant value)]))
- (&-base/$tuple value)
- (return ($tuple value))
+ [meta (&-base/$tuple value)]
+ (return (&/T [meta ($tuple value)]))
- (&-base/$apply value)
- (return ($apply value))
+ [meta (&-base/$apply value)]
+ (return (&/T [meta ($apply value)]))
- (&-base/$case value)
- (return ($case value))
+ [meta (&-base/$case value)]
+ (return (&/T [meta ($case value)]))
- (&-base/$lambda value)
- (return ($lambda value))
+ [meta (&-base/$lambda value)]
+ (return (&/T [meta ($lambda value)]))
- (&-base/$ann value)
- (return ($ann value))
+ [meta (&-base/$ann value)]
+ (return (&/T [meta ($ann value)]))
- (&-base/$var value)
- (return ($var value))
+ [meta (&-base/$var value)]
+ (return (&/T [meta ($var value)]))
- (&-base/$captured value)
- (return ($captured value))
+ [meta (&-base/$captured value)]
+ (return (&/T [meta ($captured value)]))
- (&-base/$proc ?proc-ident ?args)
- (return ($proc ?proc-ident ?args))
-
- (&-base/$jvm-class value)
- (return ($jvm-class value))
-
- (&-base/$jvm-interface value)
- (return ($jvm-interface value))
+ [meta (&-base/$proc ?proc-ident ?args)]
+ (return (&/T [meta ($proc ?proc-ident ?args)]))
_
(assert false (prn-str 'optimize-token (&/adt->text analysis)))
diff --git a/src/lux/reader.clj b/src/lux/reader.clj
index 571a6c5dc..b81b7c826 100644
--- a/src/lux/reader.clj
+++ b/src/lux/reader.clj
@@ -129,3 +129,13 @@
(reduce (fn [tail head] (&/$Cons head tail))
&/$Nil
(reverse indexed-lines))))
+
+(defn with-source [name content body]
+ (fn [state]
+ (|let [old-source (&/get$ &/$source state)]
+ (|case (body (&/set$ &/$source (from name content) state))
+ (&/$Left error)
+ (&/$Left error)
+
+ (&/$Right state* output)
+ (&/$Right (&/T [(&/set$ &/$source old-source state*) output]))))))
diff --git a/src/lux/repl.clj b/src/lux/repl.clj
index 134aacafe..3861806ed 100644
--- a/src/lux/repl.clj
+++ b/src/lux/repl.clj
@@ -51,7 +51,7 @@
state* (&/update$ &/$source
(fn [_source] (&/|++ _source line*))
state)]
- (|case ((|do [analysed-tokens (&analyser/repl-analyse &compiler/eval! (partial &compiler/compile-module source-dirs) &compiler/compile-statement)
+ (|case ((|do [analysed-tokens (&analyser/repl-analyse &compiler/eval! (partial &compiler/compile-module source-dirs) &compiler/all-compilers)
optimized-tokens (->> analysed-tokens
(&/|map &a-base/expr-term)
(&/map% &optimizer/optimize-token))