(* buildmeaning.sml *)
(* Initially by joev *)

(* Intent: allow the validators to build meanings by writing into arrays, *)
(* rather than by building lists.  This should be more space-efficient.   *)

signature BUILDMEANING = 
  sig

    type decorated = Meaning.decorated
    type meaning = Meaning.meaning
    type buffer

    val buffer2meaning : buffer -> meaning

    val bufferEqual : buffer * buffer -> bool

    (* The equivalent of [] : decorated list *)
    val newbuf : unit -> buffer

    (* Adds the decorated to the end of the buffer.                 *)
    (* The equivalent of (fn (l,d) => l @ [d]) for decorated lists. *)
    val cons : buffer * decorated -> buffer

  end


structure BuildMeaning :> BUILDMEANING =
  struct

    structure M = Meaning

    type decorated = M.decorated
    type meaning = M.meaning

    type buffer = {data : decorated array,
		   cursor : int ref,
		   mysize : int}

    val blank = M.injectDecorated (M.null,#"\000")

    fun buffer2meaning {data,mysize,cursor} =
      let
	val m = Array.array (mysize,blank)
	val _ = Array.copy {src=data,si=0,len=SOME mysize,dst=m,di=0}
      in m
      end

    fun bufferEqual ({data=data1,cursor=cursor1,mysize=mysize1},
		     {data=data2,cursor=cursor2,mysize=mysize2}) =
      let
	fun loop (~1) = true
	  | loop i = 
	  (M.decoratedEqual (Array.sub (data1,i),Array.sub (data2,i)))
	  andalso loop (i-1)
      in (mysize1 = mysize2) andalso (loop (mysize1-1))
      end

    fun newbuf _ =
      let
	val data = Array.array (4000,blank)
	val cursor = ref 0
	val mysize = 0
      in {data=data,cursor=cursor,mysize=mysize}
      end

    fun cons ({data,cursor,mysize}:buffer,d) =
      if !cursor = mysize andalso mysize < (Array.length data) then 
	(* Safe to just write into data *)
	(Array.update (data,mysize,d);
	 cursor := mysize + 1;
	 {data=data,cursor=cursor,mysize=mysize+1})
      else 
	(* Someone else is using the array, or it's too small. *)
	(* Either way, we have to make a new one.              *)
	let
	  val data' = Array.array (2*mysize,blank)
	  val _ = Array.copy {src=data,si=0,len=SOME mysize,dst=data',di=0}
	  val _ = Array.update (data',mysize,d)
	  val cursor' = ref (mysize+1)
	in {data=data',cursor=cursor',mysize=mysize+1}
	end

  end


structure BuildApproxMeaning :> BUILDMEANING =
  struct

    structure M = Meaning

    type decorated = M.decorated
    type meaning = M.meaning

    type buffer = {data : decorated array,
		   cursor : int ref,
		   mysize : int}

    val blank = M.injectDecorated (M.null,#"\000")

    fun buffer2meaning {data,mysize,cursor} =
      let
	val m = Array.array (mysize,blank)
	val _ = Array.copy {src=data,si=0,len=SOME mysize,dst=m,di=0}
      in m
      end

    fun bufferEqual ({data=data1,cursor=cursor1,mysize=mysize1},
		     {data=data2,cursor=cursor2,mysize=mysize2}) =
      let
	fun loop (~1) = true
	  | loop i = 
	  (M.decoratedEqual (Array.sub (data1,i),Array.sub (data2,i)))
	  andalso loop (i-1)
      in (mysize1 = mysize2) andalso (loop (mysize1-1))
      end

    fun newbuf _ =
      let
	val data = Array.array (100,blank)
	val cursor = ref 0
	val mysize = 0
      in {data=data,cursor=cursor,mysize=mysize}
      end

    (* cons' really performs a cons, once we're sure we want to do it. *)
    fun cons' ({data,cursor,mysize}:buffer,d) =
      if !cursor = mysize andalso mysize < (Array.length data) then 
	(* Safe to just write into data *)
	(Array.update (data,mysize,d);
	 cursor := mysize + 1;
	 {data=data,cursor=cursor,mysize=mysize+1})
      else 
	(* Someone else is using the array, or it's too small. *)
	(* Either way, we have to make a new one.              *)
	let
	  val data' = Array.array (2*mysize,blank)
	  val _ = Array.copy {src=data,si=0,len=SOME mysize,dst=data',di=0}
	  val _ = Array.update (data',mysize,d)
	  val cursor' = ref (mysize+1)
	in {data=data',cursor=cursor',mysize=mysize+1}
	end

    fun cons (b as {data,cursor,mysize=0},d) = cons' (b,d)
      | cons (b as {data,cursor,mysize},d) =
      let
	val last = Array.sub (data,mysize-1)
	val (lastctx,lastch) = M.projectDecorated last
	val (thisctx,thisch) = M.projectDecorated d
      in
	if (M.propertyEqual (lastctx,thisctx)) andalso 
	  (lastch = #" " andalso thisch = #" ") then
	  (* Approximate by collapsing last and d into one. *)
	  b
	else
	  cons' (b,d)
      end

  end
