diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/lux/base.clj | 38 | ||||
| -rw-r--r-- | src/lux/compiler.clj | 499 | ||||
| -rw-r--r-- | src/lux/lexer.clj | 83 | ||||
| -rw-r--r-- | src/lux/reader.clj | 80 |
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))))))) |