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

(* Assumes that whitespace compression has already been performed. *)
(* Finds lonely spaces (i.e. (Token.Text " ")) and pushes them as far *)
(* as possible until they meet either a tag boundary they can't cross or *)
(* another Text element they can hook up to.                             *)
(* Makes two passes, first pushing to the right and then pushing to the  *)
(* left. *)

signature PUSHSPACES = 
  sig
    val optimize : Lil.exp -> Lil.exp
  end

structure PushSpaces :> PUSHSPACES =
  struct

    structure M = Meaning
    structure T = Token

    type context = M.property Stack.stack
    val initial = Stack.push (M.null,Stack.empty)

    datatype direction = Forward | Backward
    
    val allwhite = StringUtil.all (StringUtil.charspec " \n\r\t")

    fun enter_tag (ctx,t) = Stack.push(M.addTags(Stack.top ctx,[t]),ctx)
    fun leave_tag (ctx,_) = Stack.drop ctx

    fun join_strings (Forward,s1,s2) = s1 ^ s2
      | join_strings (Backward,s1,s2) = s2 ^ s1

    fun enter_or_leave (Forward,ctx,T.Tag t) = enter_tag (ctx,t)
      | enter_or_leave (Forward,ctx,T.Closetag t) = leave_tag (ctx,t)
      | enter_or_leave (Backward,ctx,T.Tag t) = leave_tag (ctx,t)
      | enter_or_leave (Backward,ctx,T.Closetag t) = enter_tag (ctx,t)
      | enter_or_leave _ = raise Fail "Expected a tag or close tag"

    fun same_space_prop (ctx1,ctx2) =
      M.propertyEqual (M.prop2SpaceProp (Stack.top ctx1),
		       M.prop2SpaceProp (Stack.top ctx2))

    fun opt_tokens (Backward,ctx:context,[],acc) = acc
      | opt_tokens (Forward,ctx,[],acc) = opt_tokens (Backward,ctx,acc,[])
      | opt_tokens (dir,ctx,(T.Text s1)::(T.Text s2)::toks,acc) =
      opt_tokens (dir,ctx,(T.Text (join_strings (dir,s1,s2)))::toks,acc)
      | opt_tokens (dir,ctx,(T.Text s)::other::toks,acc) =
      let val ctx' = enter_or_leave (dir,ctx,other)
      in
	if allwhite s then
	  if same_space_prop (ctx,ctx') then
	    opt_tokens (dir,ctx',(T.Text s)::toks,other::acc)
	  else
	    opt_tokens (dir,ctx',toks,other::(T.Text s)::acc)
	else
	  opt_tokens (dir,ctx',toks,other::(T.Text s)::acc)
      end
      | opt_tokens (dir,ctx,(T.Text s)::toks,acc) =
      opt_tokens (dir,ctx,toks,(T.Text s)::acc)
      | opt_tokens (dir,ctx,other::toks,acc) =
      opt_tokens (dir,enter_or_leave (dir,ctx,other),toks,other::acc)

    fun optimize e = opt_tokens (Forward,initial,e,[])

  end