"lux text char" is now unsafe/optimized.

4 files changed, 176 insertions, 215 deletions

diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 5abcab3dc..916b77797 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -3650,11 +3650,9 @@
     (list input)
 
     (#Some idx)
-    (list& (default (error! "UNDEFINED")
-                    (clip/2 0 idx input))
+    (list& ("lux text clip" input 0 idx)
            (text/split splitter
-                       (default (error! "UNDEFINED")
-                                (clip/1 (n/+ 1 idx) input))))))
+                       ("lux text clip" input (n/+ 1 idx) ("lux text size" input))))))
 
 (def: (nth idx xs)
   (All [a]
@@ -4144,23 +4142,17 @@
     _
     (return [#.Nil parts])))
 
-(def: (split at x)
-  (-> Nat Text (Maybe [Text Text]))
-  (case [(..clip/2 0 at x) (..clip/1 at x)]
-    [(#.Some pre) (#.Some post)]
-    (#.Some [pre post])
-
-    _
-    #.None))
+(def: (split! at x)
+  (-> Nat Text [Text Text])
+  [("lux text clip" x 0 at)
+   ("lux text clip" x at ("lux text size" x))])
 
 (def: (split-with token sample)
   (-> Text Text (Maybe [Text Text]))
   (do ..Monad<Maybe>
     [index (..index-of token sample)
-     pre+post' (split index sample)
-     #let [[pre post'] pre+post']
-     _+post (split ("lux text size" token) post')
-     #let [[_ post] _+post]]
+     #let [[pre post'] (split! index sample)
+           [_ post] (split! ("lux text size" token) post')]]
     (wrap [pre post])))
 
 (def: (replace-all pattern value template)
@@ -5961,7 +5953,6 @@
     (^multi (^ (list [_ (#Text input)]))
             (n/= 1 ("lux text size" input)))
     (|> ("lux text char" input 0)
-        (default (undefined))
         nat$ list
         [compiler] #Right)
 
diff --git a/stdlib/source/lux/compiler/default/syntax.lux b/stdlib/source/lux/compiler/default/syntax.lux
index 69d214371..af7c7ae90 100644
--- a/stdlib/source/lux/compiler/default/syntax.lux
+++ b/stdlib/source/lux/compiler/default/syntax.lux
@@ -146,6 +146,29 @@
   [!dec   "lux i64 -" 1]
   )
 
+(template: (!clip from to text)
+  ("lux text clip" text from to))
+
+(template: (!i/< reference subject)
+  ("lux int <" subject reference))
+
+(do-template [<name> <extension>]
+  [(template: (<name> param subject)
+     (<extension> subject param))]
+
+  [!n/+ "lux i64 +"]
+  [!n/- "lux i64 -"]
+  )
+
+(template: (!with-char @source-code @offset @char @else @body)
+  (if (!i/< (:coerce Int ("lux text size" @source-code))
+            ## TODO: Get rid of the above "lux text size" call.
+            ## The size should be calculated only once and re-used constantly.
+            (:coerce Int @offset))
+    (let [@char ("lux text char" @source-code @offset)]
+      @body)
+    @else))
+
 (do-template [<name> <close> <tag>]
   [(def: (<name> parse source)
      (-> Parser Parser)
@@ -157,20 +180,16 @@
          
          (#error.Error error)
          (let [[where offset source-code] source]
-           (case ("lux text char" source-code offset)
-             (#.Some char)
-             (`` (case char
-                   (^ (char (~~ (static <close>))))
-                   (#error.Success [[(update@ #.column inc where)
-                                     (!inc offset)
-                                     source-code]
-                                    [where (<tag> (list.reverse stack))]])
-
-                   _
-                   (ex.throw unrecognized-input where)))
-             
-             _
-             (#error.Error error))))))]
+           (<| (!with-char source-code offset char (#error.Error error))
+               (`` (case char
+                     (^ (char (~~ (static <close>))))
+                     (#error.Success [[(update@ #.column inc where)
+                                       (!inc offset)
+                                       source-code]
+                                      [where (<tag> (list.reverse stack))]])
+
+                     _
+                     (ex.throw unrecognized-input where))))))))]
 
   ## Form and tuple syntax is mostly the same, differing only in the
   ## delimiters involved.
@@ -191,38 +210,20 @@
 
         (#error.Error error)
         (let [[where offset source-code] source]
-          (case ("lux text char" source-code offset)
-            (#.Some char)
-            (`` (case char
-                  (^ (char (~~ (static ..close-record))))
-                  (#error.Success [[(update@ #.column inc where)
-                                    (!inc offset)
-                                    source-code]
-                                   [where (#.Record (list.reverse stack))]])
+          (<| (!with-char source-code offset char (#error.Error error))
+              (`` (case char
+                    (^ (char (~~ (static ..close-record))))
+                    (#error.Success [[(update@ #.column inc where)
+                                      (!inc offset)
+                                      source-code]
+                                     [where (#.Record (list.reverse stack))]])
 
-                  _
-                  (ex.throw unrecognized-input where)))
-            
-            _
-            (#error.Error error))))
+                    _
+                    (ex.throw unrecognized-input where))))))
 
       (#error.Error error)
       (#error.Error error))))
 
-(template: (!clip from to text)
-  ("lux text clip" text from to))
-
-(template: (!i/< reference subject)
-  ("lux int <" subject reference))
-
-(do-template [<name> <extension>]
-  [(template: (<name> param subject)
-     (<extension> subject param))]
-
-  [!n/+ "lux i64 +"]
-  [!n/- "lux i64 -"]
-  )
-
 (template: (!guarantee-no-new-lines content body)
   (case ("lux text index" content (static text.new-line) 0)
     (#.Some g!_)
@@ -294,45 +295,23 @@
     (#error.Error error)
     (#error.Error error)))
 
-(def: (parse-nat start [where offset source-code])
-  (-> Offset Parser)
-  (loop [end offset]
-    (case ("lux text char" source-code end)
-      (#.Some char)
-      (if (!digit?+ char)
-        (recur (!inc end))
-        (!discrete-output number.Codec<Text,Nat> #.Nat))
-      
-      _
-      (!discrete-output number.Codec<Text,Nat> #.Nat))))
-
-(def: (parse-int start [where offset source-code])
-  (-> Offset Parser)
-  (loop [end offset]
-    (case ("lux text char" source-code end)
-      (#.Some char)
-      (if (!digit?+ char)
-        (recur (!inc end))
-        (!discrete-output number.Codec<Text,Int> #.Int))
-      
-      _
-      (!discrete-output number.Codec<Text,Int> #.Int))))
-
-(def: (parse-rev start [where offset source-code])
-  (-> Offset Parser)
-  (loop [end offset]
-    (case ("lux text char" source-code end)
-      (#.Some char)
-      (if (!digit?+ char)
-        (recur (!inc end))
-        (!discrete-output number.Codec<Text,Rev> #.Rev))
-      
-      _
-      (!discrete-output number.Codec<Text,Rev> #.Rev))))
+(do-template [<name> <codec> <tag>]
+  [(def: (<name> start [where offset source-code])
+     (-> Offset Parser)
+     (loop [end offset]
+       (<| (!with-char source-code end char (!discrete-output <codec> <tag>))
+           (if (!digit?+ char)
+             (recur (!inc end))
+             (!discrete-output <codec> <tag>)))))]
+
+  [parse-nat number.Codec<Text,Nat> #.Nat]
+  [parse-int number.Codec<Text,Int> #.Int]
+  [parse-rev number.Codec<Text,Rev> #.Rev]
+  )
 
-(template: (!parse-int offset where source-code)
+(template: (!parse-int offset where source-code @end)
   (let [g!offset/1 (!inc offset)]
-    (<| (!with-char source-code g!offset/1 g!char/1)
+    (<| (!with-char source-code g!offset/1 g!char/1 @end)
         (if (!digit? g!char/1)
           (parse-int offset [where (!inc/2 offset) source-code])
           (!parse-full-name offset [where (!inc offset) source-code] where #.Identifier)))))
@@ -344,16 +323,12 @@
   (def: (parse-name-part start [where offset source-code])
     (-> Offset Source (Error [Source Text]))
     (loop [end offset]
-      (case ("lux text char" source-code end)
-        (#.Some char)
-        (cond (!name-char? char)
-              (recur (!inc end))
+      (<| (!with-char source-code end char <output>)
+          (cond (!name-char? char)
+                (recur (!inc end))
 
-              ## else
-              <output>)
-        
-        _
-        <output>))))
+                ## else
+                <output>)))))
 
 (template: (!new-line where)
   (let [[where::file where::line where::column] where]
@@ -364,14 +339,6 @@
                   <consume-1> (as-is [where (!inc offset/0) source-code])
                   <consume-2> (as-is [where (!inc/2 offset/0) source-code])]
 
-  (template: (!with-char @source-code @offset @char @body)
-    (case ("lux text char" @source-code @offset)
-      (#.Some @char)
-      @body
-      
-      _
-      <end>))
-
   (template: (!parse-half-name @offset//pre @offset//post @char @module)
     (let [@offset//post (!inc @offset//pre)]
       (cond (!name-char?|head @char)
@@ -387,11 +354,11 @@
 
   (`` (def: (parse-short-name current-module [where offset/0 source-code])
         (-> Text Source (Error [Source Name]))
-        (<| (!with-char source-code offset/0 char/0)
+        (<| (!with-char source-code offset/0 char/0 <end>)
             (case char/0
               (^ (char (~~ (static ..name-separator))))
               (let [offset/1 (!inc offset/0)]
-                (<| (!with-char source-code offset/1 char/1)
+                (<| (!with-char source-code offset/1 char/1 <end>)
                     (!parse-half-name offset/1 offset/2 char/1 current-module)))
 
               _
@@ -411,23 +378,19 @@
           (case (..parse-name-part start source)
             (#error.Success [source' simple])
             (let [[where' offset' source-code'] source']
-              (case ("lux text char" source-code' offset')
-                (#.Some char/separator)
-                (case char/separator
-                  (^ (char (~~ (static ..name-separator))))
-                  (let [offset'' (!inc offset')]
-                    (case (..parse-name-part offset'' [where' offset'' source-code'])
-                      (#error.Success [source'' complex])
-                      (#error.Success [source'' [simple complex]])
-                      
-                      (#error.Error error)
-                      (#error.Error error)))
+              (<| (!with-char source-code' offset' char/separator <simple>)
+                  (case char/separator
+                    (^ (char (~~ (static ..name-separator))))
+                    (let [offset'' (!inc offset')]
+                      (case (..parse-name-part offset'' [where' offset'' source-code'])
+                        (#error.Success [source'' complex])
+                        (#error.Success [source'' [simple complex]])
+                        
+                        (#error.Error error)
+                        (#error.Error error)))
 
-                  _
-                  <simple>)
-                
-                _
-                <simple>))
+                    _
+                    <simple>)))
             
             (#error.Error error)
             (#error.Error error)))))
@@ -444,7 +407,7 @@
     (-> Text Aliases Source (Error [Source Code]))
     (let [parse' (parse current-module aliases)]
       (loop [[where offset/0 source-code] source]
-        (<| (!with-char source-code offset/0 char/0)
+        (<| (!with-char source-code offset/0 char/0 <end>)
             (`` (case char/0
                   ## White-space
                   (^template [<char> <direction>]
@@ -477,7 +440,7 @@
                   ## Special code
                   (^ (char (~~ (static ..sigil))))
                   (let [offset/1 (!inc offset/0)]
-                    (<| (!with-char source-code offset/1 char/1)
+                    (<| (!with-char source-code offset/1 char/1 <end>)
                         (case char/1
                           (^template [<char> <bit>]
                             (^ (char <char>))
@@ -509,14 +472,14 @@
 
                   (^ (char (~~ (static ..name-separator))))
                   (let [offset/1 (!inc offset/0)]
-                    (<| (!with-char source-code offset/1 char/1)
+                    (<| (!with-char source-code offset/1 char/1 <end>)
                         (if (!digit? char/1)
                           (parse-rev offset/0 [where (!inc offset/1) source-code])
                           (!parse-short-name current-module <consume-1> where #.Identifier))))
 
                   (^template [<sign>]
                     (^ (char <sign>))
-                    (!parse-int offset/0 where source-code))
+                    (!parse-int offset/0 where source-code <end>))
                   ([(~~ (static ..positive-sign))]
                    [(~~ (static ..negative-sign))])
 
diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux
index f2845f48c..efd965d1b 100644
--- a/stdlib/source/lux/data/number.lux
+++ b/stdlib/source/lux/data/number.lux
@@ -178,9 +178,11 @@
   )
 
 ## [Values & Syntax]
+(type: Char Nat)
+
 (def: (get-char! full idx)
-  (-> Text Nat Text)
-  ("lux text clip" full idx ("lux i64 +" 1 idx)))
+  (-> Text Nat Char)
+  ("lux text char" full idx))
 
 (def: (binary-character value)
   (-> Nat (Maybe Text))
@@ -190,10 +192,10 @@
     _ #.None))
 
 (def: (binary-value digit)
-  (-> Text (Maybe Nat))
+  (-> Char (Maybe Nat))
   (case digit
-    "0" (#.Some 0)
-    "1" (#.Some 1)
+    (^ (char "0")) (#.Some 0)
+    (^ (char "1")) (#.Some 1)
     _ #.None))
 
 (def: (octal-character value)
@@ -210,16 +212,16 @@
     _ #.None))
 
 (def: (octal-value digit)
-  (-> Text (Maybe Nat))
+  (-> Char (Maybe Nat))
   (case digit
-    "0" (#.Some 0)
-    "1" (#.Some 1)
-    "2" (#.Some 2)
-    "3" (#.Some 3)
-    "4" (#.Some 4)
-    "5" (#.Some 5)
-    "6" (#.Some 6)
-    "7" (#.Some 7)
+    (^ (char "0")) (#.Some 0)
+    (^ (char "1")) (#.Some 1)
+    (^ (char "2")) (#.Some 2)
+    (^ (char "3")) (#.Some 3)
+    (^ (char "4")) (#.Some 4)
+    (^ (char "5")) (#.Some 5)
+    (^ (char "6")) (#.Some 6)
+    (^ (char "7")) (#.Some 7)
     _ #.None))
 
 (def: (decimal-character value)
@@ -238,18 +240,18 @@
     _ #.None))
 
 (def: (decimal-value digit)
-  (-> Text (Maybe Nat))
+  (-> Char (Maybe Nat))
   (case digit
-    "0" (#.Some 0)
-    "1" (#.Some 1)
-    "2" (#.Some 2)
-    "3" (#.Some 3)
-    "4" (#.Some 4)
-    "5" (#.Some 5)
-    "6" (#.Some 6)
-    "7" (#.Some 7)
-    "8" (#.Some 8)
-    "9" (#.Some 9)
+    (^ (char "0")) (#.Some 0)
+    (^ (char "1")) (#.Some 1)
+    (^ (char "2")) (#.Some 2)
+    (^ (char "3")) (#.Some 3)
+    (^ (char "4")) (#.Some 4)
+    (^ (char "5")) (#.Some 5)
+    (^ (char "6")) (#.Some 6)
+    (^ (char "7")) (#.Some 7)
+    (^ (char "8")) (#.Some 8)
+    (^ (char "9")) (#.Some 9)
     _ #.None))
 
 (def: (hexadecimal-character value)
@@ -274,24 +276,24 @@
     _ #.None))
 
 (def: (hexadecimal-value digit)
-  (-> Text (Maybe Nat))
+  (-> Char (Maybe Nat))
   (case digit
-    "0" (#.Some 0)
-    "1" (#.Some 1)
-    "2" (#.Some 2)
-    "3" (#.Some 3)
-    "4" (#.Some 4)
-    "5" (#.Some 5)
-    "6" (#.Some 6)
-    "7" (#.Some 7)
-    "8" (#.Some 8)
-    "9" (#.Some 9)
-    (^or "a" "A") (#.Some 10)
-    (^or "b" "B") (#.Some 11)
-    (^or "c" "C") (#.Some 12)
-    (^or "d" "D") (#.Some 13)
-    (^or "e" "E") (#.Some 14)
-    (^or "f" "F") (#.Some 15)
+    (^ (char "0")) (#.Some 0)
+    (^ (char "1")) (#.Some 1)
+    (^ (char "2")) (#.Some 2)
+    (^ (char "3")) (#.Some 3)
+    (^ (char "4")) (#.Some 4)
+    (^ (char "5")) (#.Some 5)
+    (^ (char "6")) (#.Some 6)
+    (^ (char "7")) (#.Some 7)
+    (^ (char "8")) (#.Some 8)
+    (^ (char "9")) (#.Some 9)
+    (^or (^ (char "a")) (^ (char "A"))) (#.Some 10)
+    (^or (^ (char "b")) (^ (char "B"))) (#.Some 11)
+    (^or (^ (char "c")) (^ (char "C"))) (#.Some 12)
+    (^or (^ (char "d")) (^ (char "D"))) (#.Some 13)
+    (^or (^ (char "e")) (^ (char "E"))) (#.Some 14)
+    (^or (^ (char "f")) (^ (char "F"))) (#.Some 15)
     _ #.None))
 
 (do-template [<struct> <base> <to-character> <to-value> <error>]
@@ -337,17 +339,17 @@
 (def: (int/sign?? representation)
   (-> Text (Maybe Int))
   (case (get-char! representation 0)
-    "-"
+    (^ (char "-"))
     (#.Some -1)
 
-    "+"
+    (^ (char "+"))
     (#.Some +1)
 
     _
     #.None))
 
 (def: (int-decode-loop input-size repr sign <base> <to-value> <error>)
-  (-> Nat Text Int Int (-> Text (Maybe Nat)) Text (Error Int))
+  (-> Nat Text Int Int (-> Char (Maybe Nat)) Text (Error Int))
   (loop [idx 1
          output +0]
     (if (n/< input-size idx)
@@ -397,32 +399,36 @@
   ("lux text clip" input 1 ("lux text size" input)))
 
 (do-template [<struct> <nat> <char-bit-size> <error>]
-  [(structure: #export <struct> (Codec Text Rev)
-     (def: (encode value)
-       (let [raw-output (de-prefix (:: <nat> encode (:coerce Nat value)))
-             max-num-chars (n// <char-bit-size> 64)
-             raw-size ("lux text size" raw-output)
-             zero-padding (loop [zeroes-left (n/- raw-size max-num-chars)
-                                 output ""]
-                            (if (n/= 0 zeroes-left)
-                              output
-                              (recur (dec zeroes-left)
-                                     ("lux text concat" "0" output))))
-             padded-output ("lux text concat" zero-padding raw-output)]
-         ("lux text concat" "." padded-output)))
-
-     (def: (decode repr)
-       (let [repr-size ("lux text size" repr)]
-         (if (n/>= 2 repr-size)
-           (case ("lux text char" repr 0)
-             (^multi (^ (#.Some (char ".")))
-                     [(:: <nat> decode (de-prefix repr))
-                      (#error.Success output)])
-             (#error.Success (:coerce Rev output))
-
-             _
-             (#error.Error ("lux text concat" <error> repr)))
-           (#error.Error ("lux text concat" <error> repr))))))]
+  [(with-expansions [<error-output> (as-is (#error.Error ("lux text concat" <error> repr)))]
+     (structure: #export <struct> (Codec Text Rev)
+       (def: (encode value)
+         (let [raw-output (de-prefix (:: <nat> encode (:coerce Nat value)))
+               max-num-chars (n// <char-bit-size> 64)
+               raw-size ("lux text size" raw-output)
+               zero-padding (loop [zeroes-left (n/- raw-size max-num-chars)
+                                   output ""]
+                              (if (n/= 0 zeroes-left)
+                                output
+                                (recur (dec zeroes-left)
+                                       ("lux text concat" "0" output))))
+               padded-output ("lux text concat" zero-padding raw-output)]
+           ("lux text concat" "." padded-output)))
+
+       (def: (decode repr)
+         (let [repr-size ("lux text size" repr)]
+           (if (n/>= 2 repr-size)
+             (case ("lux text char" repr 0)
+               (^ (char "."))
+               (case (:: <nat> decode (de-prefix repr))
+                 (#error.Success output)
+                 (#error.Success (:coerce Rev output))
+
+                 _
+                 <error-output>)
+               
+               _
+               <error-output>)
+             <error-output>)))))]
 
   [Binary@Codec<Text,Rev> Binary@Codec<Text,Nat> 1 "Invalid binary syntax: "]
   [Octal@Codec<Text,Rev>  Octal@Codec<Text,Nat>  3 "Invalid octal syntax: "]
@@ -442,9 +448,9 @@
                               (if (f/= +0.0 dec-left)
                                 ("lux text concat" "." output)
                                 (let [shifted (f/* <base> dec-left)
-                                      digit (|> shifted (f/% <base>) frac-to-int .nat (get-char! <char-set>))]
+                                      digit-idx (|> shifted (f/% <base>) frac-to-int .nat)]
                                   (recur (f/% +1.0 shifted)
-                                         ("lux text concat" output digit))))))]
+                                         ("lux text concat" output ("lux text clip" <char-set> digit-idx (inc digit-idx))))))))]
          ("lux text concat" whole-part decimal-part)))
 
      (def: (decode repr)
@@ -826,7 +832,7 @@
       (loop [idx 0
              output (make-digits [])]
         (if (n/< length idx)
-          (case ("lux text index" "+0123456789" (get-char! input idx) 0)
+          (case ("lux text index" "+0123456789" ("lux text clip" input idx (inc idx)) 0)
             #.None
             #.None
 
diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux
index c33ab03a3..18ad49032 100644
--- a/stdlib/source/lux/data/text.lux
+++ b/stdlib/source/lux/data/text.lux
@@ -38,7 +38,9 @@
 
 (def: #export (nth idx input)
   (-> Nat Text (Maybe Nat))
-  ("lux text char" input idx))
+  (if (n/< ("lux text size" input) idx)
+    (#.Some ("lux text char" input idx))
+    #.None))
 
 (def: #export (index-of' pattern from input)
   (-> Text Nat Text (Maybe Nat))
@@ -204,12 +206,11 @@
                (loop [idx 0
                       hash 0]
                  (if (n/< length idx)
-                   (let [char (|> idx ("lux text char" input) (maybe.default 0))]
-                     (recur (inc idx)
-                            (|> hash
-                                (i64.left-shift 5)
-                                (n/- hash)
-                                (n/+ char))))
+                   (recur (inc idx)
+                          (|> hash
+                              (i64.left-shift 5)
+                              (n/- hash)
+                              (n/+ ("lux text char" input idx))))
                    hash)))))))
 
 (def: #export concat