
(* Tree-based intermediate language - Tom 7 *)
structure Il =
struct

  type tag = Token.tag

    datatype exp =
	Tag of tag list * exp
      | Seq of exp list
      | Text of string

    fun fixseq (Text ""::t) = fixseq t
      | fixseq (Text s1::Text s2::r) = fixseq (Text (s1 ^ s2) :: r)
      | fixseq (Seq l :: r) = fixseq (l @ r)
      | fixseq (h::t) = h :: fixseq t
      | fixseq nil = nil

    fun mkseq r = 
      case (fixseq r) of
        [single] => single
      | many => Seq many

    fun mktag (nil, e) = e
      | mktag (t, Tag (tt, e)) = mktag (t @ tt, e)
      | mktag (t, Seq nil) = Seq nil
      | mktag (t, Text "") = Seq nil
      | mktag (t, e) = Tag (t, e)

    local open Token in
    fun coms (Att _) = true
      | coms U = true
      | coms EM = true
      | coms S = true
      | coms TT = true
      | coms (Clr _) = true
      | coms (Num _) = true
      | coms _ = false

    (* XXX make smarter. TT commutes with something, right? *)
    fun commutes EM S = false
      | commutes S EM = false
      | commutes PL (Clr _) = true
      | commutes (Clr _) PL = true
      | commutes PL (Num _) = true
      | commutes (Num _) (Clr _) = true
      | commutes (Clr a) (Clr b) = a = b
      | commutes (Num a) (Num b) = a = b
      | commutes t1 t2 =
           eqtag (t1, t2) orelse
           (coms t1) andalso (coms t2)
    end
      
end