Source

cadastr / src / cd_Buffer.ml

Full commit
module Buffer
 =
  struct


    include Buffer;



    module Copy_on_modify
     :
      sig
        type t;
        value on_string : string -> t;
        value add_char : t -> char -> unit;
        value add_substring : t -> string -> int -> int -> unit;
        value add_string : t -> string -> unit;
        value contents : t -> string;
      end
     =
      struct

        module Scom = Cd_StringsCommon;

        type t = ref tcont
         and tcont =
          [ Orig of string and ref int  (* current offset *)
          | Buf of Buffer.t
          ]
        ;

        value on_string s = ref (Orig s (ref 0))
        ;

        value contents t =
          match t.val with
          [ Orig base { val = base_ofs } ->
              if base_ofs = String.length base
              then base
              else String.sub base 0 base_ofs
          | Buf b ->
              Buffer.contents b
          ]
        ;

        value rec add_substring t str ofs len =
          let () = assert (len >= 0) in
          if len = 0
          then
            ()
          else
            if not (Scom.is_valid_substring str ofs len)
            then
              invalid_arg "Cd_Buffer.Copy_on_write.add_substring"
            else
              match t.val with
              [ Buf b ->
                  Buffer.add_substring b str ofs len
              | Orig base ref_base_ofs ->
                  let base_ofs = ref_base_ofs.val in
                  let base_len = String.length base in
                  let copy_rerun () =
                    let new_buf = Buffer.create
                      (max base_len (base_ofs + len)) in
                    ( Buffer.add_substring new_buf base 0 base_ofs
                    ; t.val := Buf new_buf
                    ; add_substring t str ofs len
                    )
                  in
                  let base_left = base_len - base_ofs in
                  let () = assert (base_left >= 0) in
                  if base_left = 0
                  then
                    copy_rerun ()
                  else
                    let piece_len = min base_left len in
                    let () = assert (piece_len > 0) in
                    if Scom.substring_eq
                         ~s1:base ~ofs1:base_ofs
                         ~s2:str ~ofs2:ofs
                         ~len:piece_len
                    then
                      ( ref_base_ofs.val := base_ofs + piece_len
                      ; add_substring t
                          str (ofs + piece_len) (len - piece_len)
                      )
                    else
                      copy_rerun ()
              ]
        ;

        value add_string t s = add_substring t s 0 (String.length s)
        ;

        (* to optimize later, maybe: *)
        value add_char t c = add_string t (String.make 1 c)
        ;
        (* как вариант -- сделать строку из "\000..\255" и брать
           оттуда через add_substring.*)

      end
    ;


  end
;