Splay Ropes

--------------rope.lua------------
 --
 -- Splay ropes
 -- Implemented by Rici Lake; released into the public domain, April 2004.
 --
 -- The splay implementation was inspired by Chris Okasaki, and splay trees themselves
 -- were invented by Daniel Sleator and Robert Tarjan.
 
 -- I don't think the application to interval maps is original either,
 -- but I thought it was interesting.
 
 -- This is not an industrial strength implementation: splay is recursive and
 -- the stack can overflow; moreover, a realistic implementation would probably
 -- attempt to ensure a minimum node size, in part to avoid that problem.
 
 local version = "0.2"
 
 local slen, ssub = string.len, string.sub
 
 return function()
   local rope = {}
 
   -- splay(rope, pivot)
   -- returns r1, str, idx, r2 such that:
   --   either pivot is in str (starting at pivot - idx - 1) (yes, that is negative)
   --   or pivot > idx and r2 is nil
   -- This function will fail without warning if idx < 1; it is not intended for
   -- public consumption.
   local function splay(r, pivot)
     local a, s, x, b = r()
     if pivot <= x - slen(s) then
       local a1, t, y, a2 = a()
       if pivot <= y - slen(t) then
         local small, u, z, big = splay(a1, pivot)
         return small, u, z, tuple(big, t, y - z, tuple(a2, s, x - y, b))
        elseif pivot <= y then
         return a1, t, y, tuple(a2, s, x - y, b)
        else
         local small, u, z, big = splay(a2, pivot - y)
         return tuple(a1, t, y, small), u, y + z, tuple(big, s, x - y - z, b)
       end
      elseif pivot <= x or not b then return a, s, x, b
      else
       pivot = pivot - x
       local b1, t, y, b2 = b()
       if pivot <= y - slen(t) then
         local small, u, z, big = splay(b1, pivot)
         return tuple(a, s, x, small), u, x + z, tuple(big, t, y - z, b2)
        elseif pivot <= y or not b2 then
         return tuple(a, s, x, b1), t, x + y, b2
        else
         local small, u, z, big = splay(b2, pivot - y)
         return tuple(tuple(a, s, x, b1), t, x + y, small), u, x + y + z, big
       end
     end
   end
   
   local function len(r)
     local accum = 0
     while r do
       local _, _, x, b = r()
       r, accum = b, accum + x
     end
     return accum
   end
   
   local function new(s) 
     if s ~= "" then return tuple(nil, s, slen(s), nil) end
   end
   
   local function rr(a, b)
     if a and b then
       local b1, s, x, b2 = splay(b, 1)
       return tuple(a, s, x + len(a), b2)
      else
       return a or b
     end
   end
 
   local function rsr(a, s, b)
     if s == "" then return rr(a, b)
                else return tuple(a, s, len(a) + slen(s), b)
     end
   end
   
   local function upto(r, j)
     if r and j then
       if j <= 0 then return nil end
       local a, s, x, b = splay(r, j)
       if j <= x then r = tuple(a, ssub(s, 1, j - x - 1), j, nil) end
     end
     return r
   end
 
   local function from(r, i)
     if r and i and i > 0 then
       local a, s, x, b = splay(r, i)
       r = i <= x and tuple(nil, ssub(s, i - x - 1), x - i + 1, b) 
     end
     return r
   end
 
   local function sub(r, i, j)
     if i and j then
       if i <= j then return from(upto(r, j), i) end
      else return upto(r, i)
     end
   end
 
   local function replace(r, i, j, s)
     r = r and tuple(splay(r, i or 1))
     if type(s) == "string" then
       return rsr(upto(r, i - 1), s, from(r, j + 1))
      else
       return rr(upto(r, i - 1), rr(s, from(r, j + 1)))
     end
   end
   
   -- This is just like table.concat; the table is a table of strings,
   -- and sep is also a string.
   local function concat(t, sep, st, fi)
     st, fi = st or 1, fi or table.getn(t)
     if st <= fi then
       local rv = new(t[fi])
       if sep and sep ~= "" then
         local lsep = slen(sep)
         for i = fi - 1, st, -1 do
           rv = tuple(new(t[i]), sep, lsep + slen(t[i]), rv)
         end
        else
         for i = fi - 1, st, -1 do
           rv = tuple(nil, t[i], slen(t[i]), rv)
         end
       end
       return rv
     end
   end
 
   -- This is just like string.rep; but it attempts to maximise node
   -- sharing, demonstrating a curious feature of functional splays
   local function rep(s, n)
     local rv
     if n > 0 then
       local lens = slen(s)
       local k, l, prev = 1, lens
       while k < n do
         prev = tuple(prev, s, l, prev)
         l, k = 2 * l, 2 * k + 1
       end
       rv = prev
       local lenr = (n + 1) * lens - l
       while lenr > 0 do
         repeat
           local a, s, x, b = prev()
           prev, l = a, x
         until l <= lenr
         lenr = lenr - l
         rv = tuple(prev, s, l, rv)
       end
     end
     return rv
   end
 
   local function nextseg(_, r)
     if r then
       local a, s, x, b = splay(r, 1)
       return b or false, s
     end
   end
 
   -- segs(r) returns an internal key and successive string segments of r;
   -- the key return should be ignored (it will be false on the last segment,
   -- but I am not going to guarantee that just yet.)
   
   -- If you can arrange for the argument to not be stored in a local variable,
   -- the iteration will not hold onto any reference to the rope, so gradual garbage
   -- collection would be possible. However, the only way I know of to do this is
   -- for the argument to segs to be returned from some function. 
   local function segs(r) return nextseg, nil, r end
 
   -- Unfortunately, tuples don't have metamethods. But this will flatten the
   -- rope. For outputting, for example, it is probably better to pass
   -- successive segments to an output function.
   local function tostring(r)
     local t = {n=0}
     for _, s in segs(r) do table.insert(t, s) end
     return table.concat(t)
   end
 
   -- debug
   local function view(r)
     if r then
       local a, s, x, b = r()
       return string.format("(%s %q:%d %s)", view(a), s, x, view(b))
      else
       return "-"
     end
   end
 
   local rope = {
     __VERSION = version,
     new = new,
     len = len,
     from = from,
     upto = upto,
     sub = sub,
     tconcat = concat,
     concat = function(...) return concat(arg) end,
     rep = rep,
     replace = replace,
     segs = segs,
     tostring = tostring,
     -- debug
     splay = splay,
     upto = upto,
     from = from,
     view = view
   }
 
   return rope
 end