sml-projects/src/gap_buffer.sml

signature GAP_BUFFER =
sig
  type t = {idx: int, left: string list, right: string list}
  val empty: t
  val fromString: string -> t
  val toString: t -> string
  val insert: int * string * t -> t
  val delete: int * int * t -> t
end

structure GapBuffer: GAP_BUFFER =
struct
  type t = {idx: int, left: string list, right: string list}

  val targetLength = 1024

  val empty = {idx = 0, left = [], right = []}

  fun fromString string =
    {idx = String.size string, left = [string], right = []}

  local
    fun toList (acc, input) =
      case input of
        hd :: tl => toList (hd :: acc, tl)
      | [] => acc
  in
    fun toString ({left, right, ...}: t) =
      let val lst = toList (right, left)
      in String.concat lst
      end
  end

  fun isLessThanTarget (s1, s2) =
    String.size s1 + String.size s2 <= targetLength

  fun isThreeLessThanTarget (s1, s2, s3) =
    String.size s1 + String.size s2 + String.size s3 <= targetLength

  fun consLeft (curIdx, newString, left, right) =
    { idx = curIdx + String.size newString
    , left = newString :: left
    , right = right
    }

  fun joinEndOfLeft (newString, left) =
    case left of
      hd :: tail =>
        if isLessThanTarget (newString, hd) then (hd ^ newString) :: tail
        else newString :: left
    | [] => newString :: left

  fun joinStartOfRight (newString, right) =
    case right of
      hd :: tail =>
        if isLessThanTarget (newString, hd) then (newString ^ hd) :: tail
        else newString :: right
    | [] => newString :: right

  fun preferInsertLeft (curIdx, newString, left, right) =
    case left of
      hd :: tail =>
        if isLessThanTarget (hd, newString) then
          { idx = curIdx + String.size newString
          , left = (hd ^ newString) :: tail
          , right = right
          }
        else
          (case right of
             hd :: tail =>
               if isLessThanTarget (hd, newString) then
                 {idx = curIdx, left = left, right = (newString ^ hd) :: tail}
               else
                 consLeft (curIdx, newString, left, right)
           | [] => consLeft (curIdx, newString, left, right))
    | [] => consLeft (curIdx, newString, left, right)

  fun insLeft (prevIdx, idx, newString, curIdx, hd, tail, right) =
    (* The requested index is either:
         *  - At the start of the left string
         *  - In the middle of the left string
         *  Find out which and split the middle of the string if necessary. *)
    if idx = prevIdx then
      (* At start of string. *)
      { idx = curIdx + String.size newString
      , right = right
      , left =
          (* These two meant to look reversed, 
           * with respect to newString and hd.
           *
           * The line
           *   `newString ^ hd`
           * places the contents of newString before hd,
           * and the line
           *   `hd :: newString`
           * in a zipper also places newString before hd.
           *
           * Using `newString ^ hd` with `newString :: hd` gives
           * different contents in the case of a zipper.
           * *)
          if isLessThanTarget (newString, hd) then (newString ^ hd) :: tail
          else hd :: newString :: tail
      }
    else
      (* In middle of string. *)
      let
        val length = idx - prevIdx
        val sub1 = String.substring (hd, 0, length)
        val sub2 = String.substring (hd, length, String.size hd - length)
      in
        if isThreeLessThanTarget (sub1, newString, sub2) then
          { idx = curIdx + String.size newString
          , left = (sub1 ^ newString ^ sub2) :: tail
          , right = right
          }
        else if isLessThanTarget (sub1, newString) then
          { idx = prevIdx + String.size sub1 + String.size newString
          , left = (sub1 ^ newString) :: tail
          , right = joinStartOfRight (sub2, right)
          }
        else if isLessThanTarget (newString, sub2) then
          { idx = prevIdx + String.size sub1
          , left = joinEndOfLeft (sub1, tail)
          , right = (newString ^ sub2) :: right
          }
        else
          { idx = prevIdx
          , left = tail
          , right = sub1 :: newString :: sub2 :: right
          }
      end

  fun insRight (nextIdx, idx, newString, curIdx, left, hd, tail) =
    if idx = nextIdx then
      (* At end of next string. *)
      { idx = curIdx
      , left = left
      , right =
          if isLessThanTarget (newString, hd) then (hd ^ newString) :: tail
          else hd :: (joinStartOfRight (newString, tail))
      }
    else
      let
        val length = idx - curIdx
        val sub1 = String.substring (hd, 0, length)
        val sub2 = String.substring (hd, length, String.size hd - length)
      in
        if isThreeLessThanTarget (sub1, newString, sub2) then
          { idx =
              curIdx + String.size sub1 + String.size newString
              + String.size sub2
          , left = (sub1 ^ newString ^ sub2) :: left
          , right = tail
          }
        else if isLessThanTarget (sub1, newString) then
          { idx = curIdx + String.size sub1 + String.size newString
          , left = (sub1 ^ newString) :: left
          , right = joinStartOfRight (sub2, tail)
          }
        else if isLessThanTarget (newString, sub2) then
          { idx = curIdx + String.size sub1
          , left = sub1 :: left
          , right = (newString ^ sub2) :: tail
          }
        else
          { idx = curIdx + String.size sub1 + String.size newString
          , left = newString :: sub1 :: left
          , right = joinStartOfRight (sub2, tail)
          }
      end


  fun ins (idx, newString, curIdx, left, right) : t =
    if curIdx = idx then
      preferInsertLeft (curIdx, newString, left, right)
    else if idx < curIdx then
      (* Need to insert on the left. *)
      case left of
        [] =>
          (* If there is no string on the left, then add the new string there. *)
          {idx = String.size newString, left = [newString], right = right}
      | hd :: tail =>
          let
            val prevIdx = curIdx - String.size hd
          in
            if idx < prevIdx then
              (* The requested index is prior to the string on the left,
               * so move leftward one string. *)
              ins (idx, newString, prevIdx, tail, joinStartOfRight (hd, right))
            else
              insLeft (prevIdx, idx, newString, curIdx, hd, tail, right)
          end
    else
      (* Need to insert to the right. *)
      case right of
        [] => {idx = curIdx, left = left, right = [newString]}
      | hd :: tail =>
          let
            val nextIdx = String.size hd + curIdx
          in
            if idx > nextIdx then
              ins (idx, newString, nextIdx, joinEndOfLeft (hd, left), tail)
            else
              insRight (nextIdx, idx, newString, curIdx, left, hd, tail)
          end

  fun insert (idx, newString, buffer: t) =
    ins (idx, newString, #idx buffer, #left buffer, #right buffer)

  fun deleteRightFromHere (curIdx, finish, right) =
    case right of
      hd :: tail =>
        let
          val nextIdx = curIdx + String.size hd
        in
          if nextIdx < finish then
            deleteRightFromHere (nextIdx, finish, tail)
          else if nextIdx > finish then
            let
              val newStrStart = finish - curIdx
              val newStr = String.substring
                (hd, newStrStart, String.size hd - newStrStart)
            in
              newStr :: tail
            end
          else
            (* nextIdx = finish
             * Delete current head but no further. *)
            tail
        end
    | [] => right

  fun moveRightAndDelete (start, finish, curIdx, left, right) =
    case right of
      hd :: tail =>
        let
          val nextIdx = curIdx + String.size hd
        in
          if nextIdx < start then
            (* Keep moving right: haven't reached start yet. *)
            moveRightAndDelete
              (start, finish, nextIdx, joinEndOfLeft (hd, left), tail)
          else if nextIdx > start then
            if nextIdx < finish then
              (* Delete the start range contained in this string,
               * and then continue deleting right. *)
              let
                val length = start - curIdx
                val newString = String.substring (hd, 0, length)
              in
                { idx = curIdx + String.size newString
                , left = joinEndOfLeft (newString, left)
                , right = deleteRightFromHere (nextIdx, finish, tail)
                }
              end
            else if nextIdx > finish then
              (* Have to delete from middle of string. *)
              let
                val sub1Length = start - curIdx
                val sub1 = String.substring (hd, 0, sub1Length)
                val sub2Start = finish - curIdx
                val sub2 = String.substring
                  (hd, sub2Start, String.size hd - sub2Start)
              in
                { idx = curIdx + sub1Length
                , left = joinEndOfLeft (sub1, left)
                , right = joinStartOfRight (sub2, tail)
                }
              end
            else
              (* nextIdx = finish 
               * Have to delete from end of this string. *)
              let
                val strLength = start - curIdx
                val str = String.substring (hd, 0, strLength)
              in
                { idx = curIdx + strLength
                , left = joinEndOfLeft (str, left)
                , right = tail
                }
              end
          else
            (* nextIdx = start
             * The start range is contained fully at the next node,
             * without having to remove part of a string at this node.*)
            let
              val newRight = deleteRightFromHere (nextIdx, finish, tail)
            in
              { idx = curIdx
              , left = left
              , right = joinStartOfRight (hd, newRight)
              }
            end
        end
    | [] => {idx = curIdx, left = left, right = right}

  fun deleteLeftFromHere (start, curIdx, left, right) =
    case left of
      hd :: tail =>
        let
          val prevIdx = curIdx - String.size hd
        in
          if start < prevIdx then
            deleteLeftFromHere (start, prevIdx, tail, right)
          else if start > prevIdx then
            (* Need to delete from some part of this string. *)
            let
              val length = start - prevIdx
              val newStr = String.substring (hd, 0, length)
            in
              { idx = prevIdx
              , left = tail
              , right = joinStartOfRight (newStr, right)
              }
            end
          else
            (* if start = prevIdx 
             * Need to remove the current node without deleting any further. *)
            {idx = prevIdx, left = tail, right = right}
        end

    | [] => {idx = curIdx, left = left, right = right}

  fun deleteFromLeftAndRight (start, finish, curIdx, left, right) =
    let val right = deleteRightFromHere (curIdx, finish, right)
    in deleteLeftFromHere (start, curIdx, left, right)
    end

  fun moveLeftAndDelete (start, finish, curIdx, left, right) =
    case left of
      hd :: tail =>
        let
          val prevIdx = curIdx - String.size hd
        in
          if prevIdx > finish then
            moveLeftAndDelete
              (start, finish, prevIdx, tail, joinStartOfRight (hd, right))
          else if prevIdx < finish then
            if prevIdx > start then
              (* Delete from start point of this string, 
               * and then call function to continue deleting leftward. *)
              let
                val hdStart = finish - prevIdx
                val newHd = String.substring
                  (hd, hdStart, String.size hd - hdStart)
                val right = joinStartOfRight (newHd, right)
              in
                deleteLeftFromHere (start, prevIdx, tail, right)
              end
            else if prevIdx < start then
              (* We want to delete in the middle of this current string. *)
              let
                val sub1Length = start - prevIdx
                val sub1 = String.substring (hd, 0, sub1Length)
                val sub2Start = finish - prevIdx
                val sub2 = String.substring
                  (hd, sub2Start, String.size hd - sub2Start)
              in
                { idx = prevIdx + sub1Length
                , left = joinEndOfLeft (sub1, tail)
                , right = joinStartOfRight (sub2, right)
                }
              end
            else
              (* prevIdx = start 
               * We want to delete from the start of this string and stop. *)
              let
                val strStart = finish - prevIdx
                val str = String.substring
                  (hd, strStart, String.size hd - strStart)
              in
                { idx = prevIdx
                , left = tail
                , right = joinStartOfRight (str, right)
                }
              end
          else
            (* prevIdx = finish *)
            deleteLeftFromHere
              (start, prevIdx, tail, joinStartOfRight (hd, right))
        end
    | [] => {idx = curIdx, left = left, right = right}

  fun del (start, finish, curIdx, left, right) : t =
    if start > curIdx then
      (* If start is greater than current index, 
       * then finish must be greater too. 
       * Move buffer rightwards until finish is reached, 
       * and delete along the way. *)
      moveRightAndDelete (start, finish, curIdx, left, right)
    else if start < curIdx then
      (* If start is less than current index,
       * then finish could be either less than or equal/greater 
       * than the current index. 
       * We can treat equal/greater than as one case. *)
      if finish <= curIdx then
        (* Move leftward and delete along the way. *)
        moveLeftAndDelete (start, finish, curIdx, left, right)
      else
        (* Delete rightward up to finish index,
         * and then delete leftward until start index.*)
        deleteFromLeftAndRight (start, finish, curIdx, left, right)
    else
      (* If start is equal to the current index, 
       * then only examine the right list. 
       * Just need to delete until reaching the finish index. *)
      { idx = curIdx
      , left = left
      , right = deleteRightFromHere (curIdx, finish, right)
      }

  fun delete (start, length, buffer: t) =
    if length > 0 then
      del (start, start + length, #idx buffer, #left buffer, #right buffer)
    else
      buffer
end