
(* smarter optimization; tries to find
   <t1><...><ti><...><tn>text1</tn></...></ti></...></t1>
   immediately followed by
   <s1><...><ti><...><sm>text2</sm></...></ti></...></t1>
   where <s1><...> commute with ti, and
         <t1><...> commute with ti,
   
   then it produces:
   <ti><t1><...><...><tn>text1</tn></...></t1>
   <s1><...><...><sm>text2</sm></...></...></s1></ti>

   Improving Il.commutes would help this optimization.
   Making it context-sensitive might be a win, too.
        - Tom 7
*)

structure Hoist :> sig 
  val optimize : Il.exp -> Il.exp
end =
struct

  open Token
  open Il

  fun fusion (t1, e1, t2, e2) = 
    let
      fun lookleft (_, nil) = [Tag (t1, e1), Tag (t2, e2)]
        | lookleft (beforeit, tag::rest) =
        (* ok, found a tag on the left.
           beforeit : tag list holds the tags that came before it.
           check that the tag commutes with everything in beforeit.
         *)
        let val com = Il.commutes tag
        in
        if List.all com beforeit then
          let 
            (* it does! See if it has a counterpart in the right tag. *)
            fun lookright (bfi, t::r) =
              if t = tag then
                (* found! does it commute out, too? *)
                if List.all com bfi then
                  (* yes! *)
                  [Tag([tag], Seq [Tag(List.revAppend (beforeit, rest), e1),
                                   Tag(List.revAppend (bfi, r), e2)])]
                else lookright (t::bfi, r)
              else lookright (t::bfi, r)
              | lookright (_, nil) = lookleft (tag :: beforeit, rest)
          in
            lookright (nil, t2)
          end

        (* XXX short-circuit if we put a non-commuting tag in beforeit *)
        else lookleft (tag :: beforeit, rest)
        end
    in
        lookleft (nil, t1)
    end

  (* assumes nested tags are in tag list. *)
  fun crawl (Seq (Tag(t1, e1) :: Tag(t2, e2) :: rest)) =
      mkseq (fusion (t1, e1, t2, e2) @ [crawl (Seq rest)])
    | crawl (Seq (h::t)) = mkseq (h :: [crawl (Seq t)])
    | crawl (Tag (t, e)) = mktag (t, crawl e)
    | crawl other = other

  val optimize = crawl

end
