aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/lux/base.clj38
-rw-r--r--src/lux/compiler.clj499
-rw-r--r--src/lux/lexer.clj83
-rw-r--r--src/lux/reader.clj80
4 files changed, 394 insertions, 306 deletions
diff --git a/src/lux/base.clj b/src/lux/base.clj
index 2b6b17318..80340ec30 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -184,6 +184,16 @@
[["lux;Cons" [x xs*]]]
(V "lux;Cons" (T (f x) (|map f xs*)))))
+(defn |filter [p xs]
+ (matchv ::M/objects [xs]
+ [["lux;Nil" _]]
+ xs
+
+ [["lux;Cons" [x xs*]]]
+ (if (p x)
+ (V "lux;Cons" (T x (|filter p xs*)))
+ (|filter p xs*))))
+
(defn flat-map [f xs]
(matchv ::M/objects [xs]
[["lux;Nil" _]]
@@ -200,7 +210,7 @@
[["lux;Cons" [x xs*]]]
(if (p x)
(|let [[pre post] (|split-with p xs*)]
- (T (|cons x pre) post))
+ (T (|cons x pre) post))
(T (V "lux;Nil" nil) xs))))
(defn |contains? [k table]
@@ -380,15 +390,15 @@
(def source-consumed?
(fn [state]
- (return* state (empty? (get$ "lux;source" state)))))
+ (matchv ::M/objects [(get$ "lux;source" state)]
+ [["lux;None" _]]
+ (fail* "No source code.")
-(defn exhaust% [monad]
- (exec [output-h monad
- ? source-consumed?
- output-t (if ?
- (return (|list))
- (exhaust% monad))]
- (return (|cons output-h output-t))))
+ [["lux;Some" ["lux;Nil" _]]]
+ (return* state true)
+
+ [["lux;Some" _]]
+ (return* state false))))
(defn try-all% [monads]
(matchv ::M/objects [monads]
@@ -410,6 +420,16 @@
)))
))
+(defn exhaust% [step]
+ (try-all% (|list (exec [output-h step
+ output-t (exhaust% step)]
+ (return (|cons output-h output-t)))
+ (return (|list))
+ (exec [? source-consumed?]
+ (if ?
+ (return (|list))
+ (exhaust% step))))))
+
(defn ^:private normalize-char [char]
(case char
\* "_ASTER_"
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index d90171b2a..ab1a5012f 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -7,6 +7,7 @@
clojure.core.match.array
(lux [base :as & :refer [exec return* return fail fail*]]
[type :as &type]
+ [reader :as &reader]
[lexer :as &lexer]
[parser :as &parser]
[analyser :as &analyser]
@@ -32,284 +33,284 @@
(matchv ::M/objects [syntax]
[["Expression" [?form ?type]]]
(do ;; (prn 'compile-expression2 (aget ?form 0))
- (matchv ::M/objects [?form]
- [["bool" ?value]]
- (&&lux/compile-bool compile-expression ?type ?value)
-
- [["int" ?value]]
- (&&lux/compile-int compile-expression ?type ?value)
-
- [["real" ?value]]
- (&&lux/compile-real compile-expression ?type ?value)
-
- [["char" ?value]]
- (&&lux/compile-char compile-expression ?type ?value)
-
- [["text" ?value]]
- (&&lux/compile-text compile-expression ?type ?value)
-
- [["tuple" ?elems]]
- (&&lux/compile-tuple compile-expression ?type ?elems)
-
- [["record" ?elems]]
- (&&lux/compile-record compile-expression ?type ?elems)
-
- [["local" ?idx]]
- (&&lux/compile-local compile-expression ?type ?idx)
-
- [["captured" [?scope ?captured-id ?source]]]
- (&&lux/compile-captured compile-expression ?type ?scope ?captured-id ?source)
-
- [["global" [?owner-class ?name]]]
- (&&lux/compile-global compile-expression ?type ?owner-class ?name)
-
- [["apply" [?fn ?arg]]]
- (&&lux/compile-apply compile-expression ?type ?fn ?arg)
-
- [["variant" [?tag ?members]]]
- (&&lux/compile-variant compile-expression ?type ?tag ?members)
-
- [["case" [?variant ?base-register ?num-registers ?branches]]]
- (&&case/compile-case compile-expression ?type ?variant ?base-register ?num-registers ?branches)
-
- [["lambda" [?scope ?env ?args ?body]]]
- (&&lambda/compile-lambda compile-expression ?scope ?env ?args ?body)
-
- [["get" [?slot ?record]]]
- (&&lux/compile-get compile-expression ?type ?slot ?record)
-
- [["set" [?slot ?value ?record]]]
- (&&lux/compile-set compile-expression ?type ?slot ?value ?record)
-
- ;; Integer arithmetic
- [["jvm-iadd" [?x ?y]]]
- (&&host/compile-jvm-iadd compile-expression ?type ?x ?y)
-
- [["jvm-isub" [?x ?y]]]
- (&&host/compile-jvm-isub compile-expression ?type ?x ?y)
-
- [["jvm-imul" [?x ?y]]]
- (&&host/compile-jvm-imul compile-expression ?type ?x ?y)
-
- [["jvm-idiv" [?x ?y]]]
- (&&host/compile-jvm-idiv compile-expression ?type ?x ?y)
-
- [["jvm-irem" [?x ?y]]]
- (&&host/compile-jvm-irem compile-expression ?type ?x ?y)
-
- [["jvm-ieq" [?x ?y]]]
- (&&host/compile-jvm-ieq compile-expression ?type ?x ?y)
-
- [["jvm-ilt" [?x ?y]]]
- (&&host/compile-jvm-ilt compile-expression ?type ?x ?y)
-
- [["jvm-igt" [?x ?y]]]
- (&&host/compile-jvm-igt compile-expression ?type ?x ?y)
-
- ;; Long arithmetic
- [["jvm-ladd" [?x ?y]]]
- (&&host/compile-jvm-ladd compile-expression ?type ?x ?y)
-
- [["jvm-lsub" [?x ?y]]]
- (&&host/compile-jvm-lsub compile-expression ?type ?x ?y)
-
- [["jvm-lmul" [?x ?y]]]
- (&&host/compile-jvm-lmul compile-expression ?type ?x ?y)
-
- [["jvm-ldiv" [?x ?y]]]
- (&&host/compile-jvm-ldiv compile-expression ?type ?x ?y)
-
- [["jvm-lrem" [?x ?y]]]
- (&&host/compile-jvm-lrem compile-expression ?type ?x ?y)
-
- [["jvm-leq" [?x ?y]]]
- (&&host/compile-jvm-leq compile-expression ?type ?x ?y)
-
- [["jvm-llt" [?x ?y]]]
- (&&host/compile-jvm-llt compile-expression ?type ?x ?y)
-
- [["jvm-lgt" [?x ?y]]]
- (&&host/compile-jvm-lgt compile-expression ?type ?x ?y)
-
- ;; Float arithmetic
- [["jvm-fadd" [?x ?y]]]
- (&&host/compile-jvm-fadd compile-expression ?type ?x ?y)
-
- [["jvm-fsub" [?x ?y]]]
- (&&host/compile-jvm-fsub compile-expression ?type ?x ?y)
-
- [["jvm-fmul" [?x ?y]]]
- (&&host/compile-jvm-fmul compile-expression ?type ?x ?y)
-
- [["jvm-fdiv" [?x ?y]]]
- (&&host/compile-jvm-fdiv compile-expression ?type ?x ?y)
-
- [["jvm-frem" [?x ?y]]]
- (&&host/compile-jvm-frem compile-expression ?type ?x ?y)
-
- [["jvm-feq" [?x ?y]]]
- (&&host/compile-jvm-feq compile-expression ?type ?x ?y)
-
- [["jvm-flt" [?x ?y]]]
- (&&host/compile-jvm-flt compile-expression ?type ?x ?y)
-
- [["jvm-fgt" [?x ?y]]]
- (&&host/compile-jvm-fgt compile-expression ?type ?x ?y)
-
- ;; Double arithmetic
- [["jvm-dadd" [?x ?y]]]
- (&&host/compile-jvm-dadd compile-expression ?type ?x ?y)
-
- [["jvm-dsub" [?x ?y]]]
- (&&host/compile-jvm-dsub compile-expression ?type ?x ?y)
-
- [["jvm-dmul" [?x ?y]]]
- (&&host/compile-jvm-dmul compile-expression ?type ?x ?y)
-
- [["jvm-ddiv" [?x ?y]]]
- (&&host/compile-jvm-ddiv compile-expression ?type ?x ?y)
-
- [["jvm-drem" [?x ?y]]]
- (&&host/compile-jvm-drem compile-expression ?type ?x ?y)
-
- [["jvm-deq" [?x ?y]]]
- (&&host/compile-jvm-deq compile-expression ?type ?x ?y)
-
- [["jvm-dlt" [?x ?y]]]
- (&&host/compile-jvm-dlt compile-expression ?type ?x ?y)
-
- [["jvm-dgt" [?x ?y]]]
- (&&host/compile-jvm-dgt compile-expression ?type ?x ?y)
-
- [["exec" ?exprs]]
- (&&host/compile-exec compile-expression ?type ?exprs)
-
- [["jvm-null" _]]
- (&&host/compile-jvm-null compile-expression ?type)
-
- [["jvm-null?" ?object]]
- (&&host/compile-jvm-null? compile-expression ?type ?object)
-
- [["jvm-new" [?class ?classes ?args]]]
- (&&host/compile-jvm-new compile-expression ?type ?class ?classes ?args)
-
- [["jvm-getstatic" [?class ?field]]]
- (&&host/compile-jvm-getstatic compile-expression ?type ?class ?field)
-
- [["jvm-getfield" [?class ?field ?object]]]
- (&&host/compile-jvm-getfield compile-expression ?type ?class ?field ?object)
-
- [["jvm-putstatic" [?class ?field ?value]]]
- (&&host/compile-jvm-putstatic compile-expression ?type ?class ?field ?value)
-
- [["jvm-putfield" [?class ?field ?object ?value]]]
- (&&host/compile-jvm-putfield compile-expression ?type ?class ?field ?object ?value)
-
- [["jvm-invokestatic" [?class ?method ?classes ?args]]]
- (&&host/compile-jvm-invokestatic compile-expression ?type ?class ?method ?classes ?args)
-
- [["jvm-invokevirtual" [?class ?method ?classes ?object ?args]]]
- (&&host/compile-jvm-invokevirtual compile-expression ?type ?class ?method ?classes ?object ?args)
+ (matchv ::M/objects [?form]
+ [["bool" ?value]]
+ (&&lux/compile-bool compile-expression ?type ?value)
+
+ [["int" ?value]]
+ (&&lux/compile-int compile-expression ?type ?value)
+
+ [["real" ?value]]
+ (&&lux/compile-real compile-expression ?type ?value)
+
+ [["char" ?value]]
+ (&&lux/compile-char compile-expression ?type ?value)
+
+ [["text" ?value]]
+ (&&lux/compile-text compile-expression ?type ?value)
+
+ [["tuple" ?elems]]
+ (&&lux/compile-tuple compile-expression ?type ?elems)
+
+ [["record" ?elems]]
+ (&&lux/compile-record compile-expression ?type ?elems)
+
+ [["local" ?idx]]
+ (&&lux/compile-local compile-expression ?type ?idx)
- [["jvm-invokeinterface" [?class ?method ?classes ?object ?args]]]
- (&&host/compile-jvm-invokeinterface compile-expression ?type ?class ?method ?classes ?object ?args)
+ [["captured" [?scope ?captured-id ?source]]]
+ (&&lux/compile-captured compile-expression ?type ?scope ?captured-id ?source)
- [["jvm-invokespecial" [?class ?method ?classes ?object ?args]]]
- (&&host/compile-jvm-invokespecial compile-expression ?type ?class ?method ?classes ?object ?args)
-
- [["jvm-new-array" [?class ?length]]]
- (&&host/compile-jvm-new-array compile-expression ?type ?class ?length)
+ [["global" [?owner-class ?name]]]
+ (&&lux/compile-global compile-expression ?type ?owner-class ?name)
- [["jvm-aastore" [?array ?idx ?elem]]]
- (&&host/compile-jvm-aastore compile-expression ?type ?array ?idx ?elem)
+ [["apply" [?fn ?arg]]]
+ (&&lux/compile-apply compile-expression ?type ?fn ?arg)
- [["jvm-aaload" [?array ?idx]]]
- (&&host/compile-jvm-aaload compile-expression ?type ?array ?idx)
+ [["variant" [?tag ?members]]]
+ (&&lux/compile-variant compile-expression ?type ?tag ?members)
- [["jvm-try" [?body ?catches ?finally]]]
- (&&host/compile-jvm-try compile-expression ?type ?body ?catches ?finally)
+ [["case" [?variant ?base-register ?num-registers ?branches]]]
+ (&&case/compile-case compile-expression ?type ?variant ?base-register ?num-registers ?branches)
- [["jvm-throw" ?ex]]
- (&&host/compile-jvm-throw compile-expression ?type ?ex)
+ [["lambda" [?scope ?env ?args ?body]]]
+ (&&lambda/compile-lambda compile-expression ?scope ?env ?args ?body)
- [["jvm-monitorenter" ?monitor]]
- (&&host/compile-jvm-monitorenter compile-expression ?type ?monitor)
+ [["get" [?slot ?record]]]
+ (&&lux/compile-get compile-expression ?type ?slot ?record)
- [["jvm-monitorexit" ?monitor]]
- (&&host/compile-jvm-monitorexit compile-expression ?type ?monitor)
+ [["set" [?slot ?value ?record]]]
+ (&&lux/compile-set compile-expression ?type ?slot ?value ?record)
- [["jvm-d2f" ?value]]
- (&&host/compile-jvm-d2f compile-expression ?type ?value)
+ ;; Integer arithmetic
+ [["jvm-iadd" [?x ?y]]]
+ (&&host/compile-jvm-iadd compile-expression ?type ?x ?y)
- [["jvm-d2i" ?value]]
- (&&host/compile-jvm-d2i compile-expression ?type ?value)
+ [["jvm-isub" [?x ?y]]]
+ (&&host/compile-jvm-isub compile-expression ?type ?x ?y)
+
+ [["jvm-imul" [?x ?y]]]
+ (&&host/compile-jvm-imul compile-expression ?type ?x ?y)
+
+ [["jvm-idiv" [?x ?y]]]
+ (&&host/compile-jvm-idiv compile-expression ?type ?x ?y)
+
+ [["jvm-irem" [?x ?y]]]
+ (&&host/compile-jvm-irem compile-expression ?type ?x ?y)
+
+ [["jvm-ieq" [?x ?y]]]
+ (&&host/compile-jvm-ieq compile-expression ?type ?x ?y)
- [["jvm-d2l" ?value]]
- (&&host/compile-jvm-d2l compile-expression ?type ?value)
-
- [["jvm-f2d" ?value]]
- (&&host/compile-jvm-f2d compile-expression ?type ?value)
+ [["jvm-ilt" [?x ?y]]]
+ (&&host/compile-jvm-ilt compile-expression ?type ?x ?y)
- [["jvm-f2i" ?value]]
- (&&host/compile-jvm-f2i compile-expression ?type ?value)
+ [["jvm-igt" [?x ?y]]]
+ (&&host/compile-jvm-igt compile-expression ?type ?x ?y)
- [["jvm-f2l" ?value]]
- (&&host/compile-jvm-f2l compile-expression ?type ?value)
-
- [["jvm-i2b" ?value]]
- (&&host/compile-jvm-i2b compile-expression ?type ?value)
+ ;; Long arithmetic
+ [["jvm-ladd" [?x ?y]]]
+ (&&host/compile-jvm-ladd compile-expression ?type ?x ?y)
+
+ [["jvm-lsub" [?x ?y]]]
+ (&&host/compile-jvm-lsub compile-expression ?type ?x ?y)
+
+ [["jvm-lmul" [?x ?y]]]
+ (&&host/compile-jvm-lmul compile-expression ?type ?x ?y)
+
+ [["jvm-ldiv" [?x ?y]]]
+ (&&host/compile-jvm-ldiv compile-expression ?type ?x ?y)
+
+ [["jvm-lrem" [?x ?y]]]
+ (&&host/compile-jvm-lrem compile-expression ?type ?x ?y)
+
+ [["jvm-leq" [?x ?y]]]
+ (&&host/compile-jvm-leq compile-expression ?type ?x ?y)
+
+ [["jvm-llt" [?x ?y]]]
+ (&&host/compile-jvm-llt compile-expression ?type ?x ?y)
+
+ [["jvm-lgt" [?x ?y]]]
+ (&&host/compile-jvm-lgt compile-expression ?type ?x ?y)
+
+ ;; Float arithmetic
+ [["jvm-fadd" [?x ?y]]]
+ (&&host/compile-jvm-fadd compile-expression ?type ?x ?y)
+
+ [["jvm-fsub" [?x ?y]]]
+ (&&host/compile-jvm-fsub compile-expression ?type ?x ?y)
+
+ [["jvm-fmul" [?x ?y]]]
+ (&&host/compile-jvm-fmul compile-expression ?type ?x ?y)
+
+ [["jvm-fdiv" [?x ?y]]]
+ (&&host/compile-jvm-fdiv compile-expression ?type ?x ?y)
+
+ [["jvm-frem" [?x ?y]]]
+ (&&host/compile-jvm-frem compile-expression ?type ?x ?y)
+
+ [["jvm-feq" [?x ?y]]]
+ (&&host/compile-jvm-feq compile-expression ?type ?x ?y)
+
+ [["jvm-flt" [?x ?y]]]
+ (&&host/compile-jvm-flt compile-expression ?type ?x ?y)
+
+ [["jvm-fgt" [?x ?y]]]
+ (&&host/compile-jvm-fgt compile-expression ?type ?x ?y)
+
+ ;; Double arithmetic
+ [["jvm-dadd" [?x ?y]]]
+ (&&host/compile-jvm-dadd compile-expression ?type ?x ?y)
+
+ [["jvm-dsub" [?x ?y]]]
+ (&&host/compile-jvm-dsub compile-expression ?type ?x ?y)
+
+ [["jvm-dmul" [?x ?y]]]
+ (&&host/compile-jvm-dmul compile-expression ?type ?x ?y)
+
+ [["jvm-ddiv" [?x ?y]]]
+ (&&host/compile-jvm-ddiv compile-expression ?type ?x ?y)
+
+ [["jvm-drem" [?x ?y]]]
+ (&&host/compile-jvm-drem compile-expression ?type ?x ?y)
+
+ [["jvm-deq" [?x ?y]]]
+ (&&host/compile-jvm-deq compile-expression ?type ?x ?y)
+
+ [["jvm-dlt" [?x ?y]]]
+ (&&host/compile-jvm-dlt compile-expression ?type ?x ?y)
+
+ [["jvm-dgt" [?x ?y]]]
+ (&&host/compile-jvm-dgt compile-expression ?type ?x ?y)
+
+ [["exec" ?exprs]]
+ (&&host/compile-exec compile-expression ?type ?exprs)
+
+ [["jvm-null" _]]
+ (&&host/compile-jvm-null compile-expression ?type)
+
+ [["jvm-null?" ?object]]
+ (&&host/compile-jvm-null? compile-expression ?type ?object)
+
+ [["jvm-new" [?class ?classes ?args]]]
+ (&&host/compile-jvm-new compile-expression ?type ?class ?classes ?args)
+
+ [["jvm-getstatic" [?class ?field]]]
+ (&&host/compile-jvm-getstatic compile-expression ?type ?class ?field)
+
+ [["jvm-getfield" [?class ?field ?object]]]
+ (&&host/compile-jvm-getfield compile-expression ?type ?class ?field ?object)
+
+ [["jvm-putstatic" [?class ?field ?value]]]
+ (&&host/compile-jvm-putstatic compile-expression ?type ?class ?field ?value)
+
+ [["jvm-putfield" [?class ?field ?object ?value]]]
+ (&&host/compile-jvm-putfield compile-expression ?type ?class ?field ?object ?value)
+
+ [["jvm-invokestatic" [?class ?method ?classes ?args]]]
+ (&&host/compile-jvm-invokestatic compile-expression ?type ?class ?method ?classes ?args)
+
+ [["jvm-invokevirtual" [?class ?method ?classes ?object ?args]]]
+ (&&host/compile-jvm-invokevirtual compile-expression ?type ?class ?method ?classes ?object ?args)
+
+ [["jvm-invokeinterface" [?class ?method ?classes ?object ?args]]]
+ (&&host/compile-jvm-invokeinterface compile-expression ?type ?class ?method ?classes ?object ?args)
+
+ [["jvm-invokespecial" [?class ?method ?classes ?object ?args]]]
+ (&&host/compile-jvm-invokespecial compile-expression ?type ?class ?method ?classes ?object ?args)
+
+ [["jvm-new-array" [?class ?length]]]
+ (&&host/compile-jvm-new-array compile-expression ?type ?class ?length)
+
+ [["jvm-aastore" [?array ?idx ?elem]]]
+ (&&host/compile-jvm-aastore compile-expression ?type ?array ?idx ?elem)
+
+ [["jvm-aaload" [?array ?idx]]]
+ (&&host/compile-jvm-aaload compile-expression ?type ?array ?idx)
+
+ [["jvm-try" [?body ?catches ?finally]]]
+ (&&host/compile-jvm-try compile-expression ?type ?body ?catches ?finally)
+
+ [["jvm-throw" ?ex]]
+ (&&host/compile-jvm-throw compile-expression ?type ?ex)
+
+ [["jvm-monitorenter" ?monitor]]
+ (&&host/compile-jvm-monitorenter compile-expression ?type ?monitor)
+
+ [["jvm-monitorexit" ?monitor]]
+ (&&host/compile-jvm-monitorexit compile-expression ?type ?monitor)
+
+ [["jvm-d2f" ?value]]
+ (&&host/compile-jvm-d2f compile-expression ?type ?value)
+
+ [["jvm-d2i" ?value]]
+ (&&host/compile-jvm-d2i compile-expression ?type ?value)
+
+ [["jvm-d2l" ?value]]
+ (&&host/compile-jvm-d2l compile-expression ?type ?value)
+
+ [["jvm-f2d" ?value]]
+ (&&host/compile-jvm-f2d compile-expression ?type ?value)
+
+ [["jvm-f2i" ?value]]
+ (&&host/compile-jvm-f2i compile-expression ?type ?value)
+
+ [["jvm-f2l" ?value]]
+ (&&host/compile-jvm-f2l compile-expression ?type ?value)
+
+ [["jvm-i2b" ?value]]
+ (&&host/compile-jvm-i2b compile-expression ?type ?value)
- [["jvm-i2c" ?value]]
- (&&host/compile-jvm-i2c compile-expression ?type ?value)
+ [["jvm-i2c" ?value]]
+ (&&host/compile-jvm-i2c compile-expression ?type ?value)
- [["jvm-i2d" ?value]]
- (&&host/compile-jvm-i2d compile-expression ?type ?value)
+ [["jvm-i2d" ?value]]
+ (&&host/compile-jvm-i2d compile-expression ?type ?value)
- [["jvm-i2f" ?value]]
- (&&host/compile-jvm-i2f compile-expression ?type ?value)
+ [["jvm-i2f" ?value]]
+ (&&host/compile-jvm-i2f compile-expression ?type ?value)
- [["jvm-i2l" ?value]]
- (&&host/compile-jvm-i2l compile-expression ?type ?value)
+ [["jvm-i2l" ?value]]
+ (&&host/compile-jvm-i2l compile-expression ?type ?value)
- [["jvm-i2s" ?value]]
- (&&host/compile-jvm-i2s compile-expression ?type ?value)
+ [["jvm-i2s" ?value]]
+ (&&host/compile-jvm-i2s compile-expression ?type ?value)
- [["jvm-l2d" ?value]]
- (&&host/compile-jvm-l2d compile-expression ?type ?value)
+ [["jvm-l2d" ?value]]
+ (&&host/compile-jvm-l2d compile-expression ?type ?value)
- [["jvm-l2f" ?value]]
- (&&host/compile-jvm-l2f compile-expression ?type ?value)
+ [["jvm-l2f" ?value]]
+ (&&host/compile-jvm-l2f compile-expression ?type ?value)
- [["jvm-l2i" ?value]]
- (&&host/compile-jvm-l2i compile-expression ?type ?value)
+ [["jvm-l2i" ?value]]
+ (&&host/compile-jvm-l2i compile-expression ?type ?value)
- [["jvm-iand" [?x ?y]]]
- (&&host/compile-jvm-iand compile-expression ?type ?x ?y)
+ [["jvm-iand" [?x ?y]]]
+ (&&host/compile-jvm-iand compile-expression ?type ?x ?y)
- [["jvm-ior" [?x ?y]]]
- (&&host/compile-jvm-ior compile-expression ?type ?x ?y)
+ [["jvm-ior" [?x ?y]]]
+ (&&host/compile-jvm-ior compile-expression ?type ?x ?y)
- [["jvm-land" [?x ?y]]]
- (&&host/compile-jvm-land compile-expression ?type ?x ?y)
+ [["jvm-land" [?x ?y]]]
+ (&&host/compile-jvm-land compile-expression ?type ?x ?y)
- [["jvm-lor" [?x ?y]]]
- (&&host/compile-jvm-lor compile-expression ?type ?x ?y)
+ [["jvm-lor" [?x ?y]]]
+ (&&host/compile-jvm-lor compile-expression ?type ?x ?y)
- [["jvm-lxor" [?x ?y]]]
- (&&host/compile-jvm-lxor compile-expression ?type ?x ?y)
+ [["jvm-lxor" [?x ?y]]]
+ (&&host/compile-jvm-lxor compile-expression ?type ?x ?y)
- [["jvm-lshl" [?x ?y]]]
- (&&host/compile-jvm-lshl compile-expression ?type ?x ?y)
+ [["jvm-lshl" [?x ?y]]]
+ (&&host/compile-jvm-lshl compile-expression ?type ?x ?y)
- [["jvm-lshr" [?x ?y]]]
- (&&host/compile-jvm-lshr compile-expression ?type ?x ?y)
+ [["jvm-lshr" [?x ?y]]]
+ (&&host/compile-jvm-lshr compile-expression ?type ?x ?y)
- [["jvm-lushr" [?x ?y]]]
- (&&host/compile-jvm-lushr compile-expression ?type ?x ?y)
+ [["jvm-lushr" [?x ?y]]]
+ (&&host/compile-jvm-lushr compile-expression ?type ?x ?y)
- [["jvm-program" ?body]]
- (&&host/compile-jvm-program compile-expression ?type ?body)
- ))
+ [["jvm-program" ?body]]
+ (&&host/compile-jvm-program compile-expression ?type ?body)
+ ))
[_]
(fail "[Compiler Error] Can't compile statements as expressions.")))
@@ -372,7 +373,7 @@
(.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
(&host/->class name) nil "java/lang/Object" nil))]
(matchv ::M/objects [(&/run-state (&/exhaust% compiler-step) (->> state
- (&/set$ "lux;source" (slurp (str "source/" name ".lux")))
+ (&/set$ "lux;source" (&/V "lux;Some" (&reader/from (str "source/" name ".lux"))))
(&/set$ "lux;global-env" (&/V "lux;Some" (&/env name)))
(&/set$ "lux;writer" (&/V "lux;Some" =class))
(&/update$ "lux;modules" #(&/|put name &a-def/init-module %))))]
diff --git a/src/lux/lexer.clj b/src/lux/lexer.clj
index 2501161ac..38a6a40d7 100644
--- a/src/lux/lexer.clj
+++ b/src/lux/lexer.clj
@@ -1,27 +1,10 @@
(ns lux.lexer
(:require [clojure.template :refer [do-template]]
- [lux.base :as & :refer [exec return* return fail fail*]]
+ (lux [base :as & :refer [exec return* return fail fail*]]
+ [reader :as &reader])
[lux.analyser.def :as &def]))
;; [Utils]
-(defn ^:private lex-regex [regex]
- (fn [state]
- (if-let [[match] (re-find regex (&/get$ "lux;source" state))]
- (return* (&/update$ "lux;source" #(.substring % (.length match)) state) match)
- (fail* (str "[Lexer Error] Pattern failed: " regex)))))
-
-(defn ^:private lex-regex2 [regex]
- (fn [state]
- (if-let [[match tok1 tok2] (re-find regex (&/get$ "lux;source" state))]
- (return* (&/update$ "lux;source" #(.substring % (.length match)) state) [tok1 tok2])
- (fail* (str "[Lexer Error] Pattern failed: " regex)))))
-
-(defn ^:private lex-prefix [prefix]
- (fn [state]
- (if (.startsWith (&/get$ "lux;source" state) prefix)
- (return* (&/update$ "lux;source" #(.substring % (.length prefix)) state) prefix)
- (fail* (str "[Lexer Error] Text failed: " prefix)))))
-
(defn ^:private escape-char [escaped]
(condp = escaped
"\\t" (return "\t")
@@ -34,43 +17,46 @@
;; else
(fail (str "[Lexer Error] Unknown escape character: " escaped))))
-(def ^:private lex-text-body
- (&/try-all% (&/|list (exec [[prefix escaped] (lex-regex2 #"(?s)^([^\"\\]*)(\\.)")
+(defn ^:private lex-text-body [_____]
+ (&/try-all% (&/|list (exec [[_ [_ [prefix escaped]]] (&reader/read-regex2 #"(?s)^([^\"\\]*)(\\.)")
unescaped (escape-char escaped)
- postfix lex-text-body]
+ [_ [_ postfix]] (lex-text-body nil)]
(return (str prefix unescaped postfix)))
- (lex-regex #"(?s)^([^\"\\]*)"))))
+ (exec [[_ [_ body]] (&reader/read-regex #"(?s)^([^\"\\]*)")]
+ (return body)))))
(def ^:private +ident-re+ #"^([a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|'`:\~\?][0-9a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|'`:\~\?]*)")
;; [Lexers]
(def ^:private lex-white-space
- (exec [white-space (lex-regex #"^(\s+)")]
+ (exec [[_ [_ white-space]] (&reader/read-regex #"^(\s+)")]
(return (&/V "White_Space" white-space))))
(def ^:private lex-single-line-comment
- (exec [_ (lex-prefix "##")
- comment (lex-regex #"^([^\n]*)")
- _ (lex-regex #"^(\n?)")]
+ (exec [_ (&reader/read-text "##")
+ [_ [_ comment]] (&reader/read-regex #"^([^\n]*)")
+ _ (&reader/read-regex #"^(\n?)")]
(return (&/V "Comment" comment))))
(def ^:private lex-multi-line-comment
- (exec [_ (lex-prefix "#(")
- comment (&/try-all% (&/|list (lex-regex #"(?is)^((?!#\().)*?(?=\)#)")
- (exec [pre (lex-regex #"(?is)^(.+?(?=#\())")
+ (exec [_ (&reader/read-text "#(")
+ comment (&/try-all% (&/|list (exec [[_ [_ comment]] (&reader/read-regex #"(?is)^((?!#\().)*?(?=\)#)")]
+ (return comment))
+ (exec [[_ [_ pre]] (&reader/read-regex #"(?is)^(.+?(?=#\())")
[_ inner] lex-multi-line-comment
- post (lex-regex #"(?is)^(.+?(?=\)#))")]
+ [_ [_ post]] (&reader/read-regex #"(?is)^(.+?(?=\)#))")]
(return (str pre "#(" inner ")#" post)))))
- _ (lex-prefix ")#")]
+ _ (&reader/read-text ")#")]
(return (&/V "Comment" comment))))
(def ^:private lex-comment
(&/try-all% (&/|list lex-single-line-comment
- lex-multi-line-comment)))
+ ;; lex-multi-line-comment
+ )))
(do-template [<name> <tag> <regex>]
(def <name>
- (exec [token (lex-regex <regex>)]
+ (exec [[_ [_ token]] (&reader/read-regex <regex>)]
(return (&/V <tag> token))))
^:private lex-bool "Bool" #"^(true|false)"
@@ -79,27 +65,28 @@
)
(def ^:private lex-char
- (exec [_ (lex-prefix "#\"")
- token (&/try-all% (&/|list (exec [escaped (lex-regex #"^(\\.)")]
+ (exec [_ (&reader/read-text "#\"")
+ token (&/try-all% (&/|list (exec [escaped (&reader/read-regex #"^(\\.)")]
(escape-char escaped))
- (lex-regex #"^(.)")))
- _ (lex-prefix "\"")]
+ (exec [[_ [_ char]] (&reader/read-regex #"^(.)")]
+ (return char))))
+ _ (&reader/read-text "\"")]
(return (&/V "Char" token))))
(def ^:private lex-text
- (exec [_ (lex-prefix "\"")
- token lex-text-body
- _ (lex-prefix "\"")]
+ (exec [_ (&reader/read-text "\"")
+ token (lex-text-body nil)
+ _ (&reader/read-text "\"")]
(return (&/V "Text" token))))
(def ^:private lex-ident
- (&/try-all% (&/|list (exec [_ (lex-prefix ";")
- token (lex-regex +ident-re+)
+ (&/try-all% (&/|list (exec [_ (&reader/read-text ";")
+ [_ [_ token]] (&reader/read-regex +ident-re+)
module-name &/get-module-name]
(return (&/T module-name token)))
- (exec [token (lex-regex +ident-re+)]
- (&/try-all% (&/|list (exec [_ (lex-prefix ";")
- local-token (lex-regex +ident-re+)]
+ (exec [[_ [_ token]] (&reader/read-regex +ident-re+)]
+ (&/try-all% (&/|list (exec [_ (&reader/read-text ";")
+ [_ [_ local-token]] (&reader/read-regex +ident-re+)]
(&/try-all% (&/|list (exec [unaliased (&def/unalias-module token)]
(return (&/T unaliased local-token)))
(exec [? (&def/module-exists? token)]
@@ -116,13 +103,13 @@
(return (&/V "Symbol" ident))))
(def ^:private lex-tag
- (exec [_ (lex-prefix "#")
+ (exec [_ (&reader/read-text "#")
ident lex-ident]
(return (&/V "Tag" ident))))
(do-template [<name> <text> <tag>]
(def <name>
- (exec [_ (lex-prefix <text>)]
+ (exec [_ (&reader/read-text <text>)]
(return (&/V <tag> nil))))
^:private lex-open-paren "(" "Open_Paren"
diff --git a/src/lux/reader.clj b/src/lux/reader.clj
new file mode 100644
index 000000000..b4824261a
--- /dev/null
+++ b/src/lux/reader.clj
@@ -0,0 +1,80 @@
+(ns lux.reader
+ (:require [clojure.string :as string]
+ [clojure.core.match :as M :refer [matchv]]
+ clojure.core.match.array
+ [lux.base :as & :refer [exec return* return fail fail* |let]]))
+
+;; [Utils]
+(defn ^:private with-line [body]
+ (fn [state]
+ (matchv ::M/objects [(&/get$ "lux;source" state)]
+ [["lux;None" _]]
+ (fail* "[Reader Error] No source code.")
+
+ [["lux;Some" ["lux;Nil" _]]]
+ (fail* "[Reader Error] EOF")
+
+ [["lux;Some" ["lux;Cons" [["lux;Meta" [[file-name line-num column-num] line]]
+ more]]]]
+ (matchv ::M/objects [(body file-name line-num column-num line)]
+ [["No" msg]]
+ (fail* msg)
+
+ [["Yes" [meta ["lux;None" _]]]]
+ (return* (&/set$ "lux;source" (&/V "lux;Some" more) state)
+ meta)
+
+ [["Yes" [meta ["lux;Some" line-meta]]]]
+ (return* (&/set$ "lux;source" (&/V "lux;Some" (&/|cons line-meta more)) state)
+ meta))
+ )))
+
+;; [Exports]
+(defn read-regex [regex]
+ (with-line
+ (fn [file-name line-num column-num line]
+ (if-let [[match] (re-find regex line)]
+ (let [match-length (.length match)
+ line* (.substring line match-length)]
+ (&/V "Yes" (&/T (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) match))
+ (if (empty? line*)
+ (&/V "lux;None" nil)
+ (&/V "lux;Some" (&/V "lux;Meta" (&/T (&/T file-name line-num (+ column-num match-length)) line*)))))))
+ (&/V "No" (str "[Reader Error] Pattern failed: " regex))))))
+
+(defn read-regex2 [regex]
+ (with-line
+ (fn [file-name line-num column-num line]
+ (if-let [[match tok1 tok2] (re-find regex line)]
+ (let [match-length (.length match)
+ line* (.substring line match-length)]
+ (&/V "Yes" (&/T (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) [tok1 tok2]))
+ (if (empty? line*)
+ (&/V "lux;None" nil)
+ (&/V "lux;Some" (&/V "lux;Meta" (&/T (&/T file-name line-num (+ column-num match-length)) line*)))))))
+ (&/V "No" (str "[Reader Error] Pattern failed: " regex))))))
+
+(defn read-text [text]
+ (with-line
+ (fn [file-name line-num column-num line]
+ ;; (prn 'read-text text line)
+ (if (.startsWith line text)
+ (let [match-length (.length text)
+ line* (.substring line match-length)]
+ (&/V "Yes" (&/T (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) text))
+ (if (empty? line*)
+ (&/V "lux;None" nil)
+ (&/V "lux;Some" (&/V "lux;Meta" (&/T (&/T file-name line-num (+ column-num match-length)) line*)))))))
+ (&/V "No" (str "[Reader Error] Text failed: " text))))))
+
+(defn from [file-name]
+ (let [lines (&/->list (string/split-lines (slurp file-name)))]
+ (&/|map (fn [line+line-num]
+ (|let [[line line-num] line+line-num]
+ (&/V "lux;Meta" (&/T (&/T file-name line-num 0)
+ line))))
+ (&/|filter (fn [line+line-num]
+ (|let [[line line-num] line+line-num]
+ (not (empty? line))))
+ (&/zip2 lines
+ (&/|range (&/|length lines)))))))