XXX Implement Text.Cursor.next_opt .

bootstrap/src/basis/text.ml

@@ -18,12 +18,10 @@ module Pos = struct
     let init ~line ~col =
       {line; col}
 
-(*
     let succ cp t =
       match cp with
       | cp when Codepoint.(cp = nl) -> {line=Uns.succ t.line; col=0}
       | _ -> {t with col=Uns.succ t.col}
-*)
 
     let line t =
       t.line
@@ -48,7 +46,6 @@ module Apos = struct
     let init ~bindex =
       {bindex}
 
-    (* XXX Should go away, since apos is agnostic to encoding errors. *)
     let succ t =
       {bindex=Uns.succ t.bindex}
 
@@ -65,7 +62,6 @@ module Excerpt = struct
     type t = {
       (* Absolute position at end of string. *)
       apos: Apos.t;
-      pos: Pos.t;
       (* Raw excerpt. *)
       bytes: Bytes.Slice.t;
     }
@@ -82,7 +78,6 @@ module Excerpt = struct
     (* Base excerpt, always hd of excerpts sets. *)
     let base = {
       apos=Apos.init ~bindex:0;
-      pos=Pos.init ~line:0 ~col:0;
       bytes=Bytes.Slice.of_container [||];
     }
 
@@ -93,19 +88,14 @@ module Excerpt = struct
 
     (* val of_string_slice: t -> Bytes.Slice.t -> t *)
     let of_string_slice pred slice =
-      (* XXX Compute apos. *)
-      {
-        apos=pred.apos;
-        pos=pred.pos;
-        bytes=Bytes.Slice.of_string_slice slice
-      } (* XXX *)
+      let apos = Apos.init
+        ~bindex:((Apos.bindex pred.apos) + (String.Slice.blength slice)) in
+      let bytes = Bytes.Slice.of_string_slice slice in
+      {apos; bytes}
 
     let apos t =
       t.apos
 
-    let pos t =
-      t.pos
-
     let bytes t =
       t.bytes
   end
@@ -209,50 +199,62 @@ module Cursor = struct
       {
         text;
         apos=Excerpt.apos excerpt;
-        pos=Excerpt.pos excerpt;
+        pos=Pos.init ~line:1 ~col:0;
         ecursor;
         bcursor;
       }
 
-    let tl text =
-      let fn text = begin
-        let ecursor = Ordset.Cursor.tl text.excerpts in
-        let excerpt = Ordset.Cursor.lget ecursor in
-        let bcursor = Bytes.Slice.past excerpt.bytes in
-        {
-          text;
-          apos=Excerpt.apos excerpt;
-          pos=Excerpt.pos excerpt;
-          ecursor;
-          bcursor;
-        }
-      end in
-      fn (force text)
-
-    let rec next_opt t =
-      match Bytes.Cursor.(
-        t.bcursor < Bytes.Cursor.tl (Bytes.Cursor.container t.bcursor)) with
-      | true -> begin
-(* XXX We have a bytes cursor, and we need to transcode to codepoint. *)
-(*XXX*) let cp, bcursor' = Codepoint.replacement, t.bcursor in
-(*XXX
-          let cp, bcursor' = Bytes.Cursor.next t.bcursor in
-*)
-          let apos' = Apos.succ t.apos in
-          Some (cp, {t with apos=apos'; bcursor=bcursor'})
-        end
-      | false -> begin
-          match Ordset.Cursor.(t.ecursor < tl t.text.excerpts) with
+    module Codepoint_seq = struct
+      module T = struct
+        type nonrec t = t
+
+        let init cursor =
+          cursor
+
+        let rec next t =
+          match Bytes.Cursor.(
+            t.bcursor < Bytes.Cursor.tl (Bytes.Cursor.container t.bcursor)) with
           | true -> begin
-              let excerpt', ecursor' = Ordset.Cursor.next t.ecursor in
-              let bcursor' = Bytes.Slice.base (Excerpt.bytes excerpt') in
-              next_opt {t with ecursor=ecursor'; bcursor=bcursor'}
+              let b, bcursor' = Bytes.Cursor.next t.bcursor in
+              Some (b, {t with apos=Apos.succ t.apos; bcursor=bcursor'})
             end
           | false -> begin
-              match Lazy.force (t.text.extend) with
-              | None -> None
-              | Some text' -> next_opt {t with text=text'}
+              match Ordset.Cursor.(t.ecursor < tl t.text.excerpts) with
+              | true -> begin
+                  let excerpt', ecursor' = Ordset.Cursor.next t.ecursor in
+                  let bcursor' = Bytes.Slice.base (Excerpt.bytes excerpt') in
+                  next {t with ecursor=ecursor'; bcursor=bcursor'}
+                end
+              | false -> begin
+                  match Lazy.force (t.text.extend) with
+                  | None -> None
+                  | Some text' -> next {t with text=text'}
+                end
             end
+      end
+      include T
+      include Codepoint.Seq.Make(T)
+    end
+
+    let next_opt t =
+      match Codepoint_seq.(to_codepoint (init t)) with
+      | None -> None
+      | Some (Valid (cp, t')) -> begin
+          let pos' = Pos.succ cp t.pos in
+          Some (cp, {t' with pos=pos'})
+        end
+      | Some (Invalid t') -> begin
+          let cp = Codepoint.replacement in
+          let pos' = Pos.succ cp t.pos in
+          Some (cp, {t' with pos=pos'})
+        end
+      | Some (Fragment _) -> begin
+          let cp = Codepoint.replacement in
+          let pos' = Pos.succ cp t.pos in
+          let bcursor' = Bytes.Cursor.(tl (container t.bcursor)) in
+          let apos' = Apos.init ~bindex:((Apos.bindex t.apos) +
+            ((Bytes.Cursor.index bcursor') - (Bytes.Cursor.index t.bcursor))) in
+          Some (cp, {t with apos=apos'; pos=pos'; bcursor=bcursor'})
         end
 
     let rget_opt t =
@@ -280,6 +282,14 @@ module Cursor = struct
         | _ -> fn (Uns.pred offset) (succ t)
       end in
       fn offset t
+
+    let tl text =
+      let rec fn cursor = begin
+        match next_opt cursor with
+        | None -> cursor
+        | Some (_, cursor') -> fn cursor'
+      end in
+      fn (hd text)
   end
   include T
   include Cmpable.Make(T)

bootstrap/src/basis/text.mli

@@ -26,7 +26,8 @@ val path: t -> string option
 (** [path t] returns the optional path associated with the text. *)
 
 val blength: t -> uns
-(** Text length in bytes. Forces source stream. *)
+(** Text length in bytes, which may be different than the string equivalent due
+    to encoding errors. Forces source stream. *)
 
 (** Position within a text. The associated text is intentionally not referenced,
     lest values retain references to arbitrary incremental texts. *)