
(* print a tree structure - Tom 7 *)
structure Print =
struct

    local open Il
    in
      fun treetostring (Text s) = s
        | treetostring (Tag (h::t, e)) =
            Token.otagtostring h ^ treetostring (Tag (t,e)) ^ 
            Token.ctagtostring h
        | treetostring (Tag (nil, e)) = treetostring e
        | treetostring (Seq nil) = ""
        | treetostring (Seq (h::t)) = treetostring h ^ treetostring (Seq t)

      fun treeoutput (Text s) = print s
        | treeoutput (Tag (h::t, e)) =
           let in
             print (Token.otagtostring h);
             treeoutput (Tag (t, e));
             print (Token.ctagtostring h)
           end
        | treeoutput (Tag (nil, e)) = treeoutput e
        | treeoutput (Seq nil) = ()
        | treeoutput (Seq (h::t)) =
           let in
             treeoutput h;
             treeoutput (Seq t)
           end

      fun pws #"\n" = "\\n"
        | pws #"\r" = "\\r"
        | pws #"\\" = "\\\\"
        | pws #"\t" = "\\t"
        | pws #"\"" = "\\\""
        | pws c = str c

      fun treestructure (Text s) = "(Text \"" ^ String.translate pws s ^ "\")"
        | treestructure (Tag (tl, e)) = "Tag([" ^ 
                         StringUtil.delimit "," (map Token.ttsmls tl) ^ "], " ^
                         treestructure e ^ ")"
        | treestructure (Seq el) = "Seq([" ^ 
                         StringUtil.delimit "," (map treestructure el) ^ "])"

      (* XXX this is actually time-critical, so
         a tail recursive version would probably be worthwhile. *)
      fun sizet (Text s) = size s
        | sizet (Tag (h::t,e)) = 
              (2 * Token.tagsize h) + 1 + sizet (Tag (t, e))
        | sizet (Tag (nil, e)) = sizet e
        | sizet (Seq nil) = 0
        | sizet (Seq (h::t)) = sizet h + sizet (Seq t)
    end

    local open Token Lil
    in
        fun lineartostring (Text s :: rest) = s ^ lineartostring rest
          | lineartostring (Tag t :: rest) =
                Token.otagtostring t ^ lineartostring rest
          | lineartostring (Closetag t :: rest) =
                Token.ctagtostring t ^ lineartostring rest
          | lineartostring nil = ""

        fun linearoutput (Text s :: rest) =
            let in
                print s;
                linearoutput rest
            end
          | linearoutput (Tag t :: rest) =
            let in
                print (Token.otagtostring t);
                linearoutput rest
            end
          | linearoutput (Closetag t :: rest) =
            let in
                print (Token.ctagtostring t);
                linearoutput rest
            end
          | linearoutput nil = ()

        fun liststructure nil = "nil"
          | liststructure (Text s :: rest) = 
              "\"" ^ String.translate pws s ^ "\" :: " ^ liststructure rest
          | liststructure (Tag t :: rest) =
              Token.otagtostring t ^ " :: " ^ liststructure rest
          | liststructure (Closetag t :: rest) =
              Token.ctagtostring t ^ " :: " ^ liststructure rest

        fun sizel_ a (Text s :: rest) = sizel_ (size s + a) rest
          | sizel_ a (Tag t :: rest) = sizel_ (Token.tagsize t + a) rest
          | sizel_ a (Closetag t :: rest) = 
                 sizel_ (Token.tagsize t + 1 + a) rest
          | sizel_ a nil = a
          
        fun sizel s = sizel_ 0 s
    end
end
