aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/lux/analyser/module.clj8
-rw-r--r--src/lux/base.clj22
-rw-r--r--src/lux/lexer.clj85
-rw-r--r--src/lux/parser.clj11
-rw-r--r--src/lux/reader.clj15
5 files changed, 94 insertions, 47 deletions
diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj
index ddec601b1..c15062783 100644
--- a/src/lux/analyser/module.clj
+++ b/src/lux/analyser/module.clj
@@ -42,7 +42,7 @@
(|do [current-module &/get-module-name]
(fn [state]
(if (&/|member? module (->> state (&/get$ &/$modules) (&/|get current-module) (&/get$ $imports)))
- (fail* (str "Can't import module " (pr-str module) " twice @ " current-module))
+ (fail* (str "[Analyser Error] Can't import module " (pr-str module) " twice @ " current-module))
(return* (&/update$ &/$modules
(fn [ms]
(&/|update current-module
@@ -125,12 +125,12 @@
(fn [state]
(if-let [real-name (->> state (&/get$ &/$modules) (&/|get current-module) (&/get$ $module-aliases) (&/|get name))]
(return* state real-name)
- (fail* (str "Unknown alias: " name))))))
+ (fail* (str "[Analyser Error] Unknown alias: " name))))))
(defn alias [module alias reference]
(fn [state]
(if-let [real-name (->> state (&/get$ &/$modules) (&/|get module) (&/get$ $module-aliases) (&/|get alias))]
- (fail* (str "Can't re-use alias \"" alias "\" @ " module))
+ (fail* (str "[Analyser Error] Can't re-use alias \"" alias "\" @ " module))
(return* (->> state
(&/update$ &/$modules
(fn [ms]
@@ -262,7 +262,7 @@
(if (or ?exported
(= module current-module))
(return* state &/unit-tag)
- (fail* (str "Can't access tag #" (&/ident->text (&/T [module tag-name])) " from module " current-module))))
+ (fail* (str "[Analyser Error] Can't access tag #" (&/ident->text (&/T [module tag-name])) " from module " current-module))))
(fail* (str "[Module Error] Unknown tag: " (&/ident->text (&/T [module tag-name])))))
(fail* (str "[Module Error] Unknown module: " module))))))
diff --git a/src/lux/base.clj b/src/lux/base.clj
index a507362f9..c9050a7e6 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -614,6 +614,28 @@
)))
))
+(defn try-all-% [prefix monads]
+ (|case monads
+ ($Nil)
+ (fail "There are no alternatives to try!")
+
+ ($Cons m monads*)
+ (fn [state]
+ (let [output (m state)]
+ (|case [output monads*]
+ [($Right _) _]
+ output
+
+ [_ ($Nil)]
+ output
+
+ [($Left ^String error) _]
+ (if (.contains error prefix)
+ ((try-all-% prefix monads*) state)
+ output)
+ )))
+ ))
+
(defn exhaust% [step]
(fn [state]
(|case (step state)
diff --git a/src/lux/lexer.clj b/src/lux/lexer.clj
index e30e08c19..f6113cc7c 100644
--- a/src/lux/lexer.clj
+++ b/src/lux/lexer.clj
@@ -6,7 +6,7 @@
(ns lux.lexer
(:require (clojure [template :refer [do-template]]
[string :as string])
- (lux [base :as & :refer [defvariant |do return* return fail fail*]]
+ (lux [base :as & :refer [defvariant |do return* return fail fail* |case]]
[reader :as &reader])
[lux.analyser.module :as &module]))
@@ -62,7 +62,7 @@
(if (< idx line-length)
(let [current-char (.charAt raw-line idx)]
(if (= \\ current-char)
- (do (assert (< (+ 1 idx) line-length) (str "[Lexer] Text is too short for escaping: " raw-line " " idx))
+ (do (assert (< (+ 1 idx) line-length) (str "[Lexer Error] Text is too short for escaping: " raw-line " " idx))
(case (.charAt raw-line (+ 1 idx))
\t (do (.append buffer "\t")
(recur (+ 2 idx)))
@@ -78,11 +78,11 @@
(recur (+ 2 idx)))
\\ (do (.append buffer "\\")
(recur (+ 2 idx)))
- \u (do (assert (< (+ 5 idx) line-length) (str "[Lexer] Text is too short for unicode-escaping: " raw-line " " idx))
+ \u (do (assert (< (+ 5 idx) line-length) (str "[Lexer Error] Text is too short for unicode-escaping: " raw-line " " idx))
(.append buffer (char (Integer/valueOf (.substring raw-line (+ 2 idx) (+ 6 idx)) 16)))
(recur (+ 6 idx)))
;; else
- (assert false (str "[Lexer] Invalid escaping syntax: " raw-line " " idx))))
+ (assert false (str "[Lexer Error] Invalid escaping syntax: " raw-line " " idx))))
(do (.append buffer current-char)
(recur (+ 1 idx)))))
(.toString buffer)))))
@@ -90,14 +90,14 @@
(defn ^:private lex-text-body [multi-line? offset]
(|do [[_ eol? ^String pre-quotes**] (&reader/read-regex #"^([^\"]*)")
^String pre-quotes* (if multi-line?
- (|do [:let [empty-line? (and eol? (= "" pre-quotes**))]
- _ (&/assert! (or empty-line?
- (>= (.length pre-quotes**) offset))
- "Each line of a multi-line text must have an appropriate offset!")]
- (return (if empty-line?
- "\n"
- (str "\n" (.substring pre-quotes** offset)))))
- (return pre-quotes**))
+ (|do [:let [empty-line? (and eol? (= "" pre-quotes**))]
+ _ (&/assert! (or empty-line?
+ (>= (.length pre-quotes**) offset))
+ "Each line of a multi-line text must have an appropriate offset!")]
+ (return (if empty-line?
+ "\n"
+ (str "\n" (.substring pre-quotes** offset)))))
+ (return pre-quotes**))
[pre-quotes post-quotes] (if (.endsWith pre-quotes* "\\")
(if eol?
(fail "[Lexer Error] Can't leave dangling back-slash \\")
@@ -173,24 +173,28 @@
(return (&/T [meta ($Char token)]))))
(def ^:private lex-ident
- (&/try-all% (&/|list (|do [[meta _ token] (&reader/read-regex +ident-re+)]
- (&/try-all% (&/|list (|do [_ (&reader/read-text ";")
- [_ _ local-token] (&reader/read-regex +ident-re+)
- ? (&module/exists? token)]
- (if ?
- (return (&/T [meta (&/T [token local-token])]))
- (|do [unaliased (&module/dealias token)]
- (return (&/T [meta (&/T [unaliased local-token])])))))
- (return (&/T [meta (&/T ["" token])]))
- )))
- (|do [[meta _ _] (&reader/read-text ";;")
- [_ _ token] (&reader/read-regex +ident-re+)
- module-name &/get-module-name]
- (return (&/T [meta (&/T [module-name token])])))
- (|do [[meta _ _] (&reader/read-text ";")
- [_ _ token] (&reader/read-regex +ident-re+)]
- (return (&/T [meta (&/T ["lux" token])])))
- )))
+ (&/try-all-% "[Reader Error]"
+ (&/|list (|do [[meta _ token] (&reader/read-regex +ident-re+)
+ [_ _ got-it?] (&reader/read-text? ";")]
+ (|case got-it?
+ (&/$Some _)
+ (|do [[_ _ local-token] (&reader/read-regex +ident-re+)
+ ? (&module/exists? token)]
+ (if ?
+ (return (&/T [meta (&/T [token local-token])]))
+ (|do [unaliased (&module/dealias token)]
+ (return (&/T [meta (&/T [unaliased local-token])])))))
+
+ (&/$None)
+ (return (&/T [meta (&/T ["" token])]))))
+ (|do [[meta _ _] (&reader/read-text ";;")
+ [_ _ token] (&reader/read-regex +ident-re+)
+ module-name &/get-module-name]
+ (return (&/T [meta (&/T [module-name token])])))
+ (|do [[meta _ _] (&reader/read-text ";")
+ [_ _ token] (&reader/read-regex +ident-re+)]
+ (return (&/T [meta (&/T ["lux" token])])))
+ )))
(def ^:private lex-symbol
(|do [[meta ident] lex-ident]
@@ -224,13 +228,14 @@
;; [Exports]
(def lex
- (&/try-all% (&/|list lex-white-space
- lex-comment
- lex-bool
- lex-real
- lex-int
- lex-char
- lex-text
- lex-symbol
- lex-tag
- lex-delimiter)))
+ (&/try-all-% "[Reader Error]"
+ (&/|list lex-white-space
+ lex-comment
+ lex-bool
+ lex-real
+ lex-int
+ lex-char
+ lex-text
+ lex-symbol
+ lex-tag
+ lex-delimiter)))
diff --git a/src/lux/parser.clj b/src/lux/parser.clj
index e0f35df3d..0534ac973 100644
--- a/src/lux/parser.clj
+++ b/src/lux/parser.clj
@@ -18,9 +18,14 @@
(fn [state]
(|case (action state)
(&/$Left ^String error)
- (if (.contains error base-uneven-record-error)
- (&/$Left error)
- (&/$Right (&/T [state &/$Nil])))
+ (cond (.contains error base-uneven-record-error)
+ (&/$Left error)
+
+ (not (.contains error "[Parser Error]"))
+ (&/$Left error)
+
+ :else
+ (&/$Right (&/T [state &/$Nil])))
(&/$Right state* head)
((|do [tail (repeat% action)]
diff --git a/src/lux/reader.clj b/src/lux/reader.clj
index f0509ec19..571a6c5dc 100644
--- a/src/lux/reader.clj
+++ b/src/lux/reader.clj
@@ -93,6 +93,7 @@
(&/$Left (str "[Reader Error] Pattern failed: " regex))))))))
(defn read-text [^String text]
+ "(-> Text (Reader Text))"
(with-line
(fn [file-name line-num column-num ^String line]
(if (.startsWith line text column-num)
@@ -104,6 +105,20 @@
(&/T [(&/T [file-name line-num column-num*]) line]))))
($No (str "[Reader Error] Text failed: " text))))))
+(defn read-text? [^String text]
+ "(-> Text (Reader (Maybe Text)))"
+ (with-line
+ (fn [file-name line-num column-num ^String line]
+ (if (.startsWith line text column-num)
+ (let [match-length (.length text)
+ column-num* (+ column-num match-length)]
+ (if (= column-num* (.length line))
+ ($Done (&/T [(&/T [file-name line-num column-num]) true (&/$Some text)]))
+ ($Yes (&/T [(&/T [file-name line-num column-num]) false (&/$Some text)])
+ (&/T [(&/T [file-name line-num column-num*]) line]))))
+ ($Yes (&/T [(&/T [file-name line-num column-num]) false &/$None])
+ (&/T [(&/T [file-name line-num column-num]) line]))))))
+
(defn from [^String name ^String source-code]
(let [lines (string/split-lines source-code)
indexed-lines (map (fn [line line-num]
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-28 03:04:49 +0000