From 28ea867861a504c39b904a6dbf62a327b052f02f Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 3 May 2016 19:34:49 -0400 Subject: - Now, showing the right error when trying to lex an ident with an invalid/unknown prefix. --- src/lux/analyser/module.clj | 8 ++--- src/lux/base.clj | 22 ++++++++++++ src/lux/lexer.clj | 85 ++++++++++++++++++++++++--------------------- src/lux/parser.clj | 11 ++++-- src/lux/reader.clj | 15 ++++++++ 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] -- cgit v1.2.3