Optimized text clipping.

5 files changed, 90 insertions, 98 deletions

diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index bfbfe0678..5abcab3dc 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -1,23 +1,17 @@
 ("lux def" double-quote
- ("lux check" (0 "#Text" (0))
-  ("lux int char" +34))
+ ("lux int char" +34)
  [["" 0 0] (10 (0))])
 
 ("lux def" new-line
- ("lux check" (0 "#Text" (0))
-  ("lux int char" +10))
+ ("lux int char" +10)
  [["" 0 0] (10 (0))])
 
 ("lux def" __paragraph
- ("lux check" (0 "#Text" (0))
-  ("lux text concat" new-line new-line))
+ ("lux text concat" new-line new-line)
  [["" 0 0] (10 (0))])
 
 ("lux def" dummy-cursor
- ("lux check" (2 (0 "#Text" (0))
-                 (2 (0 "#I64" (1 (0 "#Nat" (0)) (0)))
-                    (0 "#I64" (1 (0 "#Nat" (0)) (0)))))
-  ["" 0 0])
+ ["" 0 0]
  [["" 0 0]
   (10 (1 [[["" 0 0] (7 ["lux" "export?"])]
           [["" 0 0] (0 #1)]]
@@ -3606,13 +3600,19 @@
     #None
     #None))
 
-(def: (clip1 from text)
+(def: (clip/1 from text)
   (-> Nat Text (Maybe Text))
-  ("lux text clip" text from ("lux text size" text)))
+  (let [size ("lux text size" text)]
+    (if (n/<= size from)
+      (#.Some ("lux text clip" text from size))
+      #.None)))
 
-(def: (clip2 from to text)
+(def: (clip/2 from to text)
   (-> Nat Nat Text (Maybe Text))
-  ("lux text clip" text from to))
+  (if (and (n/<= to from)
+           (n/<= ("lux text size" text) to))
+    (#.Some ("lux text clip" text from to))
+    #.None))
 
 (def: #export (error! message)
   {#.doc (text$ ($_ "lux text concat"
@@ -3651,10 +3651,10 @@
 
     (#Some idx)
     (list& (default (error! "UNDEFINED")
-                    (clip2 0 idx input))
+                    (clip/2 0 idx input))
            (text/split splitter
                        (default (error! "UNDEFINED")
-                                (clip1 (n/+ 1 idx) input))))))
+                                (clip/1 (n/+ 1 idx) input))))))
 
 (def: (nth idx xs)
   (All [a]
@@ -4146,7 +4146,7 @@
 
 (def: (split at x)
   (-> Nat Text (Maybe [Text Text]))
-  (case [(..clip2 0 at x) (..clip1 at x)]
+  (case [(..clip/2 0 at x) (..clip/1 at x)]
     [(#.Some pre) (#.Some post)]
     (#.Some [pre post])
 
@@ -4213,7 +4213,7 @@
                          list/reverse
                          (interpose "/")
                          text/join)
-              clean (|> module (clip1 ups) (default (error! "UNDEFINED")))
+              clean ("lux text clip" module ups ("lux text size" module))
               output (case ("lux text size" clean)
                        0 prefix
                        _ ($_ text/compose prefix "/" clean))]
diff --git a/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux b/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux
index 690a4accb..c654d9a00 100644
--- a/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux
+++ b/stdlib/source/lux/compiler/default/phase/extension/analysis/common.lux
@@ -202,7 +202,7 @@
           (bundle.install "index" (trinary Text Text Nat (type (Maybe Nat))))
           (bundle.install "size" (unary Text Nat))
           (bundle.install "char" (binary Text Nat (type (Maybe Nat))))
-          (bundle.install "clip" (trinary Text Nat Nat (type (Maybe Text))))
+          (bundle.install "clip" (trinary Text Nat Nat Text))
           )))
 
 (def: #export (bundle eval)
diff --git a/stdlib/source/lux/compiler/default/syntax.lux b/stdlib/source/lux/compiler/default/syntax.lux
index 7dc992471..69d214371 100644
--- a/stdlib/source/lux/compiler/default/syntax.lux
+++ b/stdlib/source/lux/compiler/default/syntax.lux
@@ -33,7 +33,6 @@
    [data
     ["." error (#+ Error)]
     ["." number]
-    ["." maybe]
     ["." text
      ["l" lexer (#+ Offset Lexer)]
      format]
@@ -135,11 +134,8 @@
         (..frac where)
         )))
 
-(type: (Simple a)
-  (-> Source (Error [Source a])))
-
-(type: (Parser a)
-  (-> Text Aliases (Simple a)))
+(type: Parser
+  (-> Source (Error [Source Code])))
 
 (do-template [<name> <extension> <diff>]
   [(template: (<name> value)
@@ -152,7 +148,7 @@
 
 (do-template [<name> <close> <tag>]
   [(def: (<name> parse source)
-     (-> (Simple Code) (Simple Code))
+     (-> Parser Parser)
      (loop [source source
             stack (: (List Code) #.Nil)]
        (case (parse source)
@@ -184,7 +180,7 @@
   )
 
 (def: (parse-record parse source)
-  (-> (Simple Code) (Simple Code))
+  (-> Parser Parser)
   (loop [source source
          stack (: (List [Code Code]) #.Nil)]
     (case (parse source)
@@ -214,8 +210,7 @@
       (#error.Error error))))
 
 (template: (!clip from to text)
-  ## TODO: Optimize-away "maybe.assume"
-  (maybe.assume ("lux text clip" text from to)))
+  ("lux text clip" text from to))
 
 (template: (!i/< reference subject)
   ("lux int <" subject reference))
@@ -237,7 +232,7 @@
     body))
 
 (def: (read-text [where offset source-code])
-  (Simple Code)
+  Parser
   (case ("lux text index" source-code (static ..text-delimiter) offset)
     (#.Some end)
     (let [content (!clip offset end source-code)]
@@ -300,7 +295,7 @@
     (#error.Error error)))
 
 (def: (parse-nat start [where offset source-code])
-  (-> Offset (Simple Code))
+  (-> Offset Parser)
   (loop [end offset]
     (case ("lux text char" source-code end)
       (#.Some char)
@@ -312,7 +307,7 @@
       (!discrete-output number.Codec<Text,Nat> #.Nat))))
 
 (def: (parse-int start [where offset source-code])
-  (-> Offset (Simple Code))
+  (-> Offset Parser)
   (loop [end offset]
     (case ("lux text char" source-code end)
       (#.Some char)
@@ -324,7 +319,7 @@
       (!discrete-output number.Codec<Text,Int> #.Int))))
 
 (def: (parse-rev start [where offset source-code])
-  (-> Offset (Simple Code))
+  (-> Offset Parser)
   (loop [end offset]
     (case ("lux text char" source-code end)
       (#.Some char)
@@ -360,17 +355,14 @@
         _
         <output>))))
 
-(template: (!leap-bit value)
-  ("lux i64 +" value 2))
-
 (template: (!new-line where)
   (let [[where::file where::line where::column] where]
     [where::file (!inc where::line) 0]))
 
 (with-expansions [<end> (ex.throw end-of-file current-module)
                   <failure> (ex.throw unrecognized-input where)
-                  <consume-1> (as-is [where (!inc offset) source-code])
-                  <consume-2> (as-is [where (!inc/2 offset) source-code])]
+                  <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)
@@ -451,20 +443,20 @@
   (def: #export (parse current-module aliases source)
     (-> Text Aliases Source (Error [Source Code]))
     (let [parse' (parse current-module aliases)]
-      (loop [[where offset source-code] source]
-        (<| (!with-char source-code offset char/0)
+      (loop [[where offset/0 source-code] source]
+        (<| (!with-char source-code offset/0 char/0)
             (`` (case char/0
                   ## White-space
                   (^template [<char> <direction>]
                     (^ (char <char>))
                     (recur [(update@ <direction> inc where)
-                            (!inc offset)
+                            (!inc offset/0)
                             source-code]))
                   ([(~~ (static ..space))              #.column]
                    [(~~ (static text.carriage-return)) #.column])
 
                   (^ (char (~~ (static text.new-line))))
-                  (recur [(!new-line where) (!inc offset) source-code])
+                  (recur [(!new-line where) (!inc offset/0) source-code])
 
                   ## Form
                   (^ (char (~~ (static ..open-form))))
@@ -484,13 +476,13 @@
 
                   ## Special code
                   (^ (char (~~ (static ..sigil))))
-                  (let [offset/1 (!inc offset)]
+                  (let [offset/1 (!inc offset/0)]
                     (<| (!with-char source-code offset/1 char/1)
                         (case char/1
                           (^template [<char> <bit>]
                             (^ (char <char>))
-                            (#error.Success [[(update@ #.column (|>> !leap-bit) where)
-                                              (!leap-bit offset)
+                            (#error.Success [[(update@ #.column (|>> !inc/2) where)
+                                              (!inc offset/1)
                                               source-code]
                                              [where (#.Bit <bit>)]]))
                           (["0" #0]
@@ -510,31 +502,31 @@
 
                           _
                           (cond (!name-char?|head char/1) ## Tag
-                                (!parse-full-name offset <consume-2> where #.Tag)
+                                (!parse-full-name offset/1 <consume-2> where #.Tag)
 
                                 ## else
                                 <failure>))))
 
                   (^ (char (~~ (static ..name-separator))))
-                  (let [offset/1 (!inc offset)]
+                  (let [offset/1 (!inc offset/0)]
                     (<| (!with-char source-code offset/1 char/1)
                         (if (!digit? char/1)
-                          (parse-rev offset [where (!inc offset/1) source-code])
+                          (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 where source-code))
+                    (!parse-int offset/0 where source-code))
                   ([(~~ (static ..positive-sign))]
                    [(~~ (static ..negative-sign))])
 
                   _
                   (cond (!digit? char/0) ## Natural number
-                        (parse-nat offset <consume-1>)
+                        (parse-nat offset/0 <consume-1>)
 
                         ## Identifier
                         (!name-char?|head char/0)
-                        (!parse-full-name offset <consume-1> where #.Identifier)
+                        (!parse-full-name offset/0 <consume-1> where #.Identifier)
                         
                         ## else
                         <failure>))))))))
diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux
index e45c4ff1c..f2845f48c 100644
--- a/stdlib/source/lux/data/number.lux
+++ b/stdlib/source/lux/data/number.lux
@@ -178,9 +178,9 @@
   )
 
 ## [Values & Syntax]
-(def: (get-char full idx)
-  (-> Text Nat (Maybe Text))
-  ("lux text clip" full idx (inc idx)))
+(def: (get-char! full idx)
+  (-> Text Nat Text)
+  ("lux text clip" full idx ("lux i64 +" 1 idx)))
 
 (def: (binary-character value)
   (-> Nat (Maybe Text))
@@ -312,14 +312,13 @@
            (loop [idx 0
                   output 0]
              (if (n/< input-size idx)
-               (let [digit (maybe.assume (get-char repr idx))]
-                 (case (<to-value> digit)
-                   #.None
-                   (#error.Error ("lux text concat" <error> repr))
-
-                   (#.Some digit-value)
-                   (recur (inc idx)
-                          (|> output (n/* <base>) (n/+ digit-value)))))
+               (case (<to-value> (get-char! repr idx))
+                 #.None
+                 (#error.Error ("lux text concat" <error> repr))
+
+                 (#.Some digit-value)
+                 (recur (inc idx)
+                        (|> output (n/* <base>) (n/+ digit-value))))
                (#error.Success output)))
            (#error.Error ("lux text concat" <error> repr))))))]
 
@@ -337,11 +336,11 @@
 
 (def: (int/sign?? representation)
   (-> Text (Maybe Int))
-  (case (get-char representation 0)
-    (^ (#.Some "-"))
+  (case (get-char! representation 0)
+    "-"
     (#.Some -1)
 
-    (^ (#.Some "+"))
+    "+"
     (#.Some +1)
 
     _
@@ -352,14 +351,13 @@
   (loop [idx 1
          output +0]
     (if (n/< input-size idx)
-      (let [digit (maybe.assume (get-char repr idx))]
-        (case (<to-value> digit)
-          #.None
-          (#error.Error <error>)
+      (case (<to-value> (get-char! repr idx))
+        #.None
+        (#error.Error <error>)
 
-          (#.Some digit-value)
-          (recur (inc idx)
-                 (|> output (i/* <base>) (i/+ (.int digit-value))))))
+        (#.Some digit-value)
+        (recur (inc idx)
+               (|> output (i/* <base>) (i/+ (.int digit-value)))))
       (#error.Success (i/* sign output)))))
 
 (do-template [<struct> <base> <to-character> <to-value> <error>]
@@ -396,7 +394,7 @@
 
 (def: (de-prefix input)
   (-> Text Text)
-  (maybe.assume ("lux text clip" input 1 ("lux text size" input))))
+  ("lux text clip" input 1 ("lux text size" input)))
 
 (do-template [<struct> <nat> <char-bit-size> <error>]
   [(structure: #export <struct> (Codec Text Rev)
@@ -444,8 +442,7 @@
                               (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>) maybe.assume)]
+                                      digit (|> shifted (f/% <base>) frac-to-int .nat (get-char! <char-set>))]
                                   (recur (f/% +1.0 shifted)
                                          ("lux text concat" output digit))))))]
          ("lux text concat" whole-part decimal-part)))
@@ -453,8 +450,8 @@
      (def: (decode repr)
        (case ("lux text index" repr "." 0)
          (#.Some split-index)
-         (let [whole-part (maybe.assume ("lux text clip" repr 0 split-index))
-               decimal-part (maybe.assume ("lux text clip" repr (inc split-index) ("lux text size" repr)))]
+         (let [whole-part ("lux text clip" repr 0 split-index)
+               decimal-part ("lux text clip" repr (inc split-index) ("lux text size" repr))]
            (case [(:: <int> decode whole-part)
                   (:: <int> decode decimal-part)]
              (^multi [(#error.Success whole) (#error.Success decimal)]
@@ -498,8 +495,8 @@
       (if (n/<= chunk-size num-digits)
         (list digits)
         (let [boundary (n/- chunk-size num-digits)
-              chunk (maybe.assume ("lux text clip" digits boundary num-digits))
-              remaining (maybe.assume ("lux text clip" digits 0 boundary))]
+              chunk ("lux text clip" digits boundary num-digits)
+              remaining ("lux text clip" digits 0 boundary)]
           (list& chunk (segment-digits chunk-size remaining)))))))
 
 (def: (bin-segment-to-hex input)
@@ -627,10 +624,10 @@
        (let [sign (:: Number<Frac> signum value)
              raw-bin (:: Binary@Codec<Text,Frac> encode value)
              dot-idx (maybe.assume ("lux text index" raw-bin "." 0))
-             whole-part (maybe.assume ("lux text clip" raw-bin
-                                       (if (f/= -1.0 sign) 1 0)
-                                       dot-idx))
-             decimal-part (maybe.assume ("lux text clip" raw-bin (inc dot-idx) ("lux text size" raw-bin)))
+             whole-part ("lux text clip" raw-bin
+                         (if (f/= -1.0 sign) 1 0)
+                         dot-idx)
+             decimal-part ("lux text clip" raw-bin (inc dot-idx) ("lux text size" raw-bin))
              hex-output (|> (<from> #0 decimal-part)
                             ("lux text concat" ".")
                             ("lux text concat" (<from> #1 whole-part))
@@ -646,8 +643,8 @@
                     +1.0)]
          (case ("lux text index" repr "." 0)
            (#.Some split-index)
-           (let [whole-part (maybe.assume ("lux text clip" repr 1 split-index))
-                 decimal-part (maybe.assume ("lux text clip" repr (inc split-index) ("lux text size" repr)))
+           (let [whole-part ("lux text clip" repr 1 split-index)
+                 decimal-part ("lux text clip" repr (inc split-index) ("lux text size" repr))
                  as-binary (|> (<to> decimal-part)
                                ("lux text concat" ".")
                                ("lux text concat" (<to> whole-part))
@@ -829,14 +826,13 @@
       (loop [idx 0
              output (make-digits [])]
         (if (n/< length idx)
-          (let [char (maybe.assume (get-char input idx))]
-            (case ("lux text index" "+0123456789" char 0)
-              #.None
-              #.None
-
-              (#.Some digit)
-              (recur (inc idx)
-                     (digits-put idx digit output))))
+          (case ("lux text index" "+0123456789" (get-char! input idx) 0)
+            #.None
+            #.None
+
+            (#.Some digit)
+            (recur (inc idx)
+                   (digits-put idx digit output)))
           (#.Some output)))
       #.None)))
 
@@ -900,9 +896,7 @@
                     #0)]
       (if (and dotted?
                (n/<= (inc i64.width) length))
-        (case (|> ("lux text clip" input 1 length)
-                  maybe.assume
-                  text-to-digits)
+        (case (text-to-digits ("lux text clip" input 1 length))
           (#.Some digits)
           (loop [digits digits
                  idx 0
diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux
index 3807275c1..c33ab03a3 100644
--- a/stdlib/source/lux/data/text.lux
+++ b/stdlib/source/lux/data/text.lux
@@ -105,11 +105,17 @@
 
 (def: #export (clip from to input)
   (-> Nat Nat Text (Maybe Text))
-  ("lux text clip" input from to))
+  (if (and (n/<= to from)
+           (n/<= ("lux text size" input) to))
+    (#.Some ("lux text clip" input from to))
+    #.None))
 
 (def: #export (clip' from input)
   (-> Nat Text (Maybe Text))
-  ("lux text clip" input from (size input)))
+  (let [size ("lux text size" input)]
+    (if (n/<= size from)
+      (#.Some ("lux text clip" input from size))
+      #.None)))
 
 (def: #export (split at x)
   (-> Nat Text (Maybe [Text Text]))