- Lexers now carry an offset which they use to figure out where to extract parts of the whole input, instead of having to clip the input as they lex. thereby doing a lot of unnecessary text allocations.

- Some refactoring.

4 files changed, 135 insertions, 147 deletions

diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux
index 0ce1b602a..d7469e24b 100644
--- a/stdlib/source/lux/data/format/json.lux
+++ b/stdlib/source/lux/data/format/json.lux
@@ -260,16 +260,16 @@
   (l;Lexer Number)
   (do p;Monad<Parser>
     [signed? (l;this? "-")
-     digits (l;many l;digit)
+     digits (l;many l;decimal)
      decimals (p;default "0"
                 (do @
                   [_ (l;this ".")]
-                  (l;many l;digit)))
+                  (l;many l;decimal)))
      exp (p;default ""
            (do @
              [mark (l;one-of "eE")
               signed?' (l;this? "-")
-              offset (l;many l;digit)]
+              offset (l;many l;decimal)]
              (wrap (format mark (if signed?' "-" "") offset))))]
     (case (Real/decode (format (if signed? "-" "") digits "." decimals exp))
       (#R;Error message)
diff --git a/stdlib/source/lux/data/format/xml.lux b/stdlib/source/lux/data/format/xml.lux
index ef2f5d44d..c87502e30 100644
--- a/stdlib/source/lux/data/format/xml.lux
+++ b/stdlib/source/lux/data/format/xml.lux
@@ -51,10 +51,10 @@
         [hex? (p;opt (l;this "x"))
          code (case hex?
                 #;None
-                (l;codec number;Codec<Text,Int> (l;many l;digit))
+                (l;codec number;Codec<Text,Int> (l;many l;decimal))
 
                 (#;Some _)
-                (l;codec number;Hex@Codec<Text,Int> (l;many l;hex-digit)))]
+                (l;codec number;Hex@Codec<Text,Int> (l;many l;hexadecimal)))]
         (wrap (|> code int-to-nat char;char char;as-text)))
       (p;before (l;this ";"))
       (p;after (l;this "&#"))))
diff --git a/stdlib/source/lux/data/text/lexer.lux b/stdlib/source/lux/data/text/lexer.lux
index 3d7423ca2..c57382134 100644
--- a/stdlib/source/lux/data/text/lexer.lux
+++ b/stdlib/source/lux/data/text/lexer.lux
@@ -13,31 +13,45 @@
              ["R" result]
              (coll [list "L/" Functor<List>]))))
 
+(type: Offset Nat)
+
+(def: start-offset Offset +0)
+
 (type: #export Lexer
-  (p;Parser Text))
+  (p;Parser [Offset Text]))
+
+(def: (remaining offset tape)
+  (-> Offset Text Text)
+  (|> tape (text;split offset) assume product;right))
+
+(def: cannot-lex-error Text "Cannot lex from empty text.")
+
+(def: (unconsumed-input-error offset tape)
+  (-> Offset Text Text)
+  (format "Unconsumed input: " (remaining offset tape)))
 
 (def: #export (run input lexer)
   (All [a] (-> Text (Lexer a) (R;Result a)))
-  (case (lexer input)
+  (case (lexer [start-offset input])
     (#R;Error msg)
     (#R;Error msg)
     
-    (#R;Success [input' output])
-    (if (T/= "" input')
+    (#R;Success [[end-offset _] output])
+    (if (n.= end-offset (text;size input))
       (#R;Success output)
-      (#R;Error (format "Remaining lexer input: " input')))
+      (#R;Error (unconsumed-input-error end-offset input)))
     ))
 
 (def: #export any
   {#;doc "Just returns the next character without applying any logic."}
   (Lexer Text)
-  (function [input]
-    (case [(text;nth +0 input) (text;split +1 input)]
-      [(#;Some output) (#;Some [_ input'])]
-      (#R;Success [input' (char;as-text output)])
+  (function [[offset tape]]
+    (case (text;nth offset tape)
+      (#;Some output)
+      (#R;Success [[(n.inc offset) tape] (char;as-text output)])
 
       _
-      (#R;Error "Cannot parse character from empty text."))
+      (#R;Error cannot-lex-error))
     ))
 
 (def: #export (not p)
@@ -54,59 +68,64 @@
 (def: #export (this reference)
   {#;doc "Lex a text if it matches the given sample."}
   (-> Text (Lexer Unit))
-  (function [input]
-    (if (text;starts-with? reference input)
-      (case (text;split (text;size reference) input)
-        #;None              (#R;Error "")
-        (#;Some [_ input']) (#R;Success [input' []]))
-      (#R;Error (format "Invalid match: " (text;encode reference) " @ " (text;encode input))))))
+  (function [[offset tape]]
+    (case (text;index-of reference offset tape)
+      (^multi (#;Some where) (n.= offset where))
+      (#R;Success [[(n.+ (text;size reference) offset) tape] []])
+
+      _
+      (#R;Error (format "Could not match: " (text;encode reference) " @ " tape)))))
 
 (def: #export (this? reference)
   {#;doc "Lex a text if it matches the given sample."}
   (-> Text (Lexer Bool))
-  (function [input]
-    (if (text;starts-with? reference input)
-      (case (text;split (text;size reference) input)
-        #;None              (#R;Success [input false])
-        (#;Some [_ input']) (#R;Success [input' true]))
-      (#R;Success [input false]))
-    ))
+  (function [(^@ input [offset tape])]
+    (case (text;index-of reference offset tape)
+      (^multi (#;Some where) (n.= offset where))
+      (#R;Success [[(n.+ (text;size reference) offset) tape] true])
+
+      _
+      (#R;Success [input false]))))
 
 (def: #export end
   {#;doc "Ensure the lexer's input is empty."}
   (Lexer Unit)
-  (function [input]
-    (case input
-      "" (#R;Success [input []])
-      _  (#R;Error (format "The text input has not been fully consumed @ " (text;encode input)))
-      )))
+  (function [(^@ input [offset tape])]
+    (if (n.= offset (text;size tape))
+      (#R;Success [input []])
+      (#R;Error (unconsumed-input-error offset tape)))))
+
+(def: #export end?
+  {#;doc "Ask if the lexer's input is empty."}
+  (Lexer Bool)
+  (function [(^@ input [offset tape])]
+    (#R;Success [input (n.= offset (text;size tape))])))
 
 (def: #export peek
   {#;doc "Lex the next character (without consuming it from the input)."}
   (Lexer Text)
-  (function [input]
-    (case (text;nth +0 input)
+  (function [(^@ input [offset tape])]
+    (case (text;nth offset tape)
       (#;Some output)
       (#R;Success [input (char;as-text output)])
 
       _
-      (#R;Error "Cannot peek character from empty text."))
+      (#R;Error cannot-lex-error))
     ))
 
 (def: #export get-input
   {#;doc "Get all of the remaining input (without consuming it)."}
   (Lexer Text)
-  (function [input]
-    (#R;Success [input input])))
+  (function [(^@ input [offset tape])]
+    (#R;Success [input (remaining offset tape)])))
 
-(def: #export (char-range bottom top)
+(def: #export (range bottom top)
   {#;doc "Only lex characters within a range."}
   (-> Char Char (Lexer Text))
   (do p;Monad<Parser>
-    [input get-input
-     char any
+    [char any
      #let [char' (|> char (text;nth +0) assume)]
-     _ (p;assert (format "Character is not within range: " (C/encode bottom) "-" (C/encode top) " @ " (text;encode input))
+     _ (p;assert (format "Character is not within range: " (C/encode bottom) "-" (C/encode top))
                  (and (C/>= bottom char')
                       (C/<= top char')))]
     (wrap char)))
@@ -115,12 +134,12 @@
   [(def: #export <name>
      {#;doc (#;TextA (format "Only lex " <desc> " characters."))}
      (Lexer Text)
-     (char-range <bottom> <top>))]
+     (range <bottom> <top>))]
 
-  [upper     #"A" #"Z" "uppercase"]
-  [lower     #"a" #"z" "lowercase"]
-  [digit     #"0" #"9" "decimal"]
-  [oct-digit #"0" #"7" "octal"]
+  [upper   #"A" #"Z" "uppercase"]
+  [lower   #"a" #"z" "lowercase"]
+  [decimal #"0" #"9" "decimal"]
+  [octal   #"0" #"7" "octal"]
   )
 
 (def: #export alpha
@@ -131,68 +150,56 @@
 (def: #export alpha-num
   {#;doc "Only lex alphanumeric characters."}
   (Lexer Text)
-  (p;either alpha digit))
+  (p;either alpha decimal))
 
-(def: #export hex-digit
+(def: #export hexadecimal
   {#;doc "Only lex hexadecimal digits."}
   (Lexer Text)
   ($_ p;either
-      digit
-      (char-range #"a" #"f")
-      (char-range #"A" #"F")))
+      decimal
+      (range #"a" #"f")
+      (range #"A" #"F")))
 
 (def: #export (one-of options)
   {#;doc "Only lex characters that are part of a piece of text."}
   (-> Text (Lexer Text))
-  (function [input]
-    (case (text;split +1 input)
-      (#;Some [init input'])
-      (if (text;contains? init options)
-        (case (text;nth +0 init)
-          (#;Some output)
-          (#R;Success [input' (char;as-text output)])
-
-          _
-          (#R;Error ""))
-        (#R;Error (format "Character (" init ") is not one of: " options " @ " (text;encode input))))
+  (function [[offset tape]]
+    (case (text;nth offset tape)
+      (#;Some output)
+      (let [output (char;as-text output)]
+        (if (text;contains? output options)
+          (#R;Success [[(n.inc offset) tape] output])
+          (#R;Error (format "Character (" output ") is not one of: " options))))
 
       _
-      (#R;Error "Cannot parse character from empty text."))))
+      (#R;Error cannot-lex-error))))
 
 (def: #export (none-of options)
   {#;doc "Only lex characters that are not part of a piece of text."}
   (-> Text (Lexer Text))
-  (function [input]
-    (case (text;split +1 input)
-      (#;Some [init input'])
-      (if (;not (text;contains? init options))
-        (case (text;nth +0 init)
-          (#;Some output)
-          (#R;Success [input' (char;as-text output)])
-
-          _
-          (#R;Error ""))
-        (#R;Error (format "Character (" init ") is one of: " options " @ " (text;encode input))))
+  (function [[offset tape]]
+    (case (text;nth offset tape)
+      (#;Some output)
+      (let [output (char;as-text output)]
+        (if (;not (text;contains? output options))
+          (#R;Success [[(n.inc offset) tape] output])
+          (#R;Error (format "Character (" output ") is one of: " options))))
 
       _
-      (#R;Error "Cannot parse character from empty text."))))
+      (#R;Error cannot-lex-error))))
 
 (def: #export (satisfies p)
   {#;doc "Only lex characters that satisfy a predicate."}
   (-> (-> Char Bool) (Lexer Text))
-  (function [input]
-    (case (: (Maybe [Text Char])
-             (do Monad<Maybe>
-               [[init input'] (text;split +1 input)
-                output (text;nth +0 init)]
-               (wrap [input' output])))
-      (#;Some [input' output])
+  (function [[offset tape]]
+    (case (text;nth offset tape)
+      (#;Some output)
       (if (p output)
-        (#R;Success [input' (char;as-text output)])
-        (#R;Error (format "Character does not satisfy predicate: " (text;encode input))))
+        (#R;Success [[(n.inc offset) tape] (char;as-text output)])
+        (#R;Error (format "Character does not satisfy predicate: " (char;as-text output))))
 
       _
-      (#R;Error "Cannot parse character from empty text."))))
+      (#R;Error cannot-lex-error))))
 
 (def: #export space
   {#;doc "Only lex white-space."}
@@ -210,9 +217,7 @@
   [(def: #export (<name> p)
      {#;doc <doc>}
      (-> (Lexer Text) (Lexer Text))
-     (do p;Monad<Parser>
-       []
-       (|> p <base> (:: @ map text;concat))))]
+     (|> p <base> (:: p;Monad<Parser> map text;concat)))]
 
   [some p;some "Lex some characters as a single continuous text."]
   [many p;many "Lex many characters as a single continuous text."]
@@ -236,13 +241,7 @@
   (-> Nat Nat (Lexer Text) (Lexer Text))
   (|> p (p;between from to) (:: p;Monad<Parser> map text;concat)))
 
-(def: #export end?
-  {#;doc "Ask if the lexer's input is empty."}
-  (Lexer Bool)
-  (function [input]
-    (#R;Success [input (text;empty? input)])))
-
-(def: #export (codec codec lexer)
+(def: #export (codec Codec<a> lexer)
   {#;doc "Lex a token by means of a codec."}
   (All [a] (-> (Codec Text a) (Lexer Text) (Lexer a)))
   (function [input]
@@ -251,7 +250,7 @@
       (#R;Error error)
 
       (#R;Success [input' to-decode])
-      (case (:: codec decode to-decode)
+      (case (:: Codec<a> decode to-decode)
         (#R;Error error)
         (#R;Error error)
         
@@ -268,11 +267,9 @@
   {#;doc "Run a lexer with the given input, instead of the real one."}
   (All [a] (-> Text (Lexer a) (Lexer a)))
   (function [real-input]
-    (case (p;run local-input lexer)
+    (case (run local-input lexer)
       (#R;Error error)
       (#R;Error error)
 
-      (#R;Success [unconsumed value])
-      (if (T/= "" unconsumed)
-        (#R;Success [real-input value])
-        (#R;Error (format "Unconsumed input: " unconsumed))))))
+      (#R;Success value)
+      (#R;Success [real-input value]))))
diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux
index 3666f68b8..86f215497 100644
--- a/stdlib/source/lux/data/text/regex.lux
+++ b/stdlib/source/lux/data/text/regex.lux
@@ -8,6 +8,7 @@
              text/format
              [number "Int/" Codec<Text,Int>]
              [product]
+             ["R" result]
              (coll [list "L/" Fold<List> Monad<List>]))
        [macro #- run]
        (macro [code]
@@ -26,21 +27,11 @@
       l;any
       regex-char^)))
 
-(def: (local^ state lexer)
-  (All [a] (-> Text (l;Lexer a) (l;Lexer a)))
-  (function [old-state]
-    (case (lexer state)
-      (#;Left error)
-      (#;Left error)
-
-      (#;Right [_ value])
-      (#;Right [old-state value]))))
-
 (def: #hidden (refine^ refinement^ base^)
   (All [a] (-> (l;Lexer a) (l;Lexer Text) (l;Lexer Text)))
   (do p;Monad<Parser>
     [output base^
-     _ (local^ output refinement^)]
+     _ (l;local output refinement^)]
     (wrap output)))
 
 (def: #hidden word^
@@ -65,7 +56,7 @@
 (def: identifier-part^
   (l;Lexer Text)
   (do p;Monad<Parser>
-    [head (refine^ (l;not l;digit)
+    [head (refine^ (l;not l;decimal)
                    identifier-char^)
      tail (l;some identifier-char^)]
     (wrap (format head tail))))
@@ -84,13 +75,13 @@
     [ident (l;enclosed ["\\@<" ">"] (identifier^ current-module))]
     (wrap (` (: (l;Lexer Text) (~ (code;symbol ident)))))))
 
-(def: re-char-range^
+(def: re-range^
   (l;Lexer Code)
   (do p;Monad<Parser>
     [from (|> regex-char^ (:: @ map (|>. (text;nth +0) assume)))
      _ (l;this "-")
      to (|> regex-char^ (:: @ map (|>. (text;nth +0) assume)))]
-    (wrap (` (l;char-range (~ (code;char from)) (~ (code;char to)))))))
+    (wrap (` (l;range (~ (code;char from)) (~ (code;char to)))))))
 
 (def: re-char^
   (l;Lexer Code)
@@ -98,7 +89,7 @@
     [char escaped-char^]
     (wrap (` (;;copy (~ (code;text char)))))))
 
-(def: re-char-options^
+(def: re-options^
   (l;Lexer Code)
   (do p;Monad<Parser>
     [options (l;many escaped-char^)]
@@ -109,8 +100,8 @@
   (do p;Monad<Parser>
     [negate? (p;opt (l;this "^"))
      parts (p;many ($_ p;either
-                       re-char-range^
-                       re-char-options^))]
+                       re-range^
+                       re-options^))]
     (wrap (case negate?
             (#;Some _) (` (l;not ($_ p;either (~@ parts))))
             #;None     (` ($_ p;either (~@ parts)))))))
@@ -132,11 +123,11 @@
 
 (def: #hidden ascii^
   (l;Lexer Text)
-  (l;char-range #"\u0000" #"\u007F"))
+  (l;range #"\u0000" #"\u007F"))
 
 (def: #hidden control^
   (l;Lexer Text)
-  (p;either (l;char-range #"\u0000" #"\u001F")
+  (p;either (l;range #"\u0000" #"\u001F")
             (l;one-of "\u007F")))
 
 (def: #hidden punct^
@@ -158,8 +149,8 @@
     []
     ($_ p;either
         (p;after (l;this ".") (wrap (` l;any)))
-        (p;after (l;this "\\d") (wrap (` l;digit)))
-        (p;after (l;this "\\D") (wrap (` (l;not l;digit))))
+        (p;after (l;this "\\d") (wrap (` l;decimal)))
+        (p;after (l;this "\\D") (wrap (` (l;not l;decimal))))
         (p;after (l;this "\\s") (wrap (` l;space)))
         (p;after (l;this "\\S") (wrap (` (l;not l;space))))
         (p;after (l;this "\\w") (wrap (` word^)))
@@ -168,11 +159,11 @@
         (p;after (l;this "\\p{Lower}") (wrap (` l;lower)))
         (p;after (l;this "\\p{Upper}") (wrap (` l;upper)))
         (p;after (l;this "\\p{Alpha}") (wrap (` l;alpha)))
-        (p;after (l;this "\\p{Digit}") (wrap (` l;digit)))
+        (p;after (l;this "\\p{Digit}") (wrap (` l;decimal)))
         (p;after (l;this "\\p{Alnum}") (wrap (` l;alpha-num)))
         (p;after (l;this "\\p{Space}") (wrap (` l;space)))
-        (p;after (l;this "\\p{HexDigit}") (wrap (` l;hex-digit)))
-        (p;after (l;this "\\p{OctDigit}") (wrap (` l;oct-digit)))
+        (p;after (l;this "\\p{HexDigit}") (wrap (` l;hexadecimal)))
+        (p;after (l;this "\\p{OctDigit}") (wrap (` l;octal)))
         (p;after (l;this "\\p{Blank}") (wrap (` blank^)))
         (p;after (l;this "\\p{ASCII}") (wrap (` ascii^)))
         (p;after (l;this "\\p{Contrl}") (wrap (` control^)))
@@ -188,7 +179,7 @@
 
 (def: number^
   (l;Lexer Nat)
-  (|> (l;many l;digit)
+  (|> (l;many l;decimal)
       (l;codec number;Codec<Text,Int>)
       (p/map int-to-nat)))
 
@@ -285,14 +276,14 @@
                                           [Int (List Code) (List (List Code))])
                                       (function [part [idx names steps]]
                                         (case part
-                                          (^or (#;Left complex) (#;Right [#Non-Capturing complex]))
+                                          (^or (#R;Error complex) (#R;Success [#Non-Capturing complex]))
                                           [idx
                                            names
                                            (list& (list g!temp complex
                                                         (' #let) (` [(~ g!total) (_Text/append_ (~ g!total) (~ g!temp))]))
                                                   steps)]
                                           
-                                          (#;Right [(#Capturing [?name num-captures]) scoped])
+                                          (#R;Success [(#Capturing [?name num-captures]) scoped])
                                           (let [[idx! name!] (case ?name
                                                                (#;Some _name)
                                                                [idx (code;symbol ["" _name])]
@@ -329,31 +320,31 @@
   (All [l r] (-> (l;Lexer [Text l]) (l;Lexer [Text r]) (l;Lexer [Text (| l r)])))
   (function [input]
     (case (left input)
-      (#;Right [input' [lt lv]])
-      (#;Right [input' [lt (+0 lv)]])
+      (#R;Success [input' [lt lv]])
+      (#R;Success [input' [lt (+0 lv)]])
 
-      (#;Left _)
+      (#R;Error _)
       (case (right input)
-        (#;Right [input' [rt rv]])
-        (#;Right [input' [rt (+1 rv)]])
+        (#R;Success [input' [rt rv]])
+        (#R;Success [input' [rt (+1 rv)]])
 
-        (#;Left error)
-        (#;Left error)))))
+        (#R;Error error)
+        (#R;Error error)))))
 
 (def: #hidden (|||_^ left right)
   (All [l r] (-> (l;Lexer [Text l]) (l;Lexer [Text r]) (l;Lexer Text)))
   (function [input]
     (case (left input)
-      (#;Right [input' [lt lv]])
-      (#;Right [input' lt])
+      (#R;Success [input' [lt lv]])
+      (#R;Success [input' lt])
 
-      (#;Left _)
+      (#R;Error _)
       (case (right input)
-        (#;Right [input' [rt rv]])
-        (#;Right [input' rt])
+        (#R;Success [input' [rt rv]])
+        (#R;Success [input' rt])
 
-        (#;Left error)
-        (#;Left error)))))
+        (#R;Error error)
+        (#R;Error error)))))
 
 (def: (prep-alternative [num-captures alt])
   (-> [Nat Code] Code)
@@ -471,11 +462,11 @@
     (case (|> (regex^ current-module)
               (p;before l;end)
               (l;run pattern))
-      (#;Left error)
+      (#R;Error error)
       (macro;fail (format "Error while parsing regular-expression:\n"
                           error))
 
-      (#;Right regex)
+      (#R;Success regex)
       (wrap (list regex))
       )))
 
@@ -497,7 +488,7 @@
     [g!temp (macro;gensym "temp")]
     (wrap (list& (` (^multi (~ g!temp)
                             [(l;run (~ g!temp) (regex (~ (code;text pattern))))
-                             (#;Right (~ (default g!temp
-                                           bindings)))]))
+                             (#R;Success (~ (default g!temp
+                                              bindings)))]))
                  body
                  branches))))