(* ScopedElim *)
(* --- Perry --- *)

(* This pass performs redundancy elimination and EM elimintation in one pass. *)

structure ScopedElim :> SCOPEDELIM = 
  struct
      open Il
      structure M = Meaning

      type ctxt = M.property list  (* A stack of meanings *)
      exception Error of string

      (* Given the current ctxt, reduce unncessary tags in the ordered list of tags.
         Return the new tags and context extended with the new tags *)
      fun reduceTags (ctxt, tags) = 
	let datatype control = Keep | Discard 
	                     | Special of Token.tag list * M.property
	    fun loop ([],kept,prop) = (rev kept, prop)
	      | loop (t::rest,kept,prop) = 
		let 
		    val control = 
			(case t of
			     Token.EM => if (M.isSetAttribute(prop, M.S))
					     then Discard
					 else (case rest of
						   Token.EM::rest => 
						       Special(loop(rest, kept, prop))
						 | _ => Keep)
			   | Token.Att Token.B => if (M.isSetAttribute(prop, M.B))
					    then Discard else Keep
			   | Token.Att Token.I => if (M.isSetAttribute(prop, M.I))
					    then Discard else Keep
			   | Token.S => if (M.isSetAttribute(prop, M.S))
					    then Discard else Keep
			   | Token.TT => if (M.isSetAttribute(prop, M.Tt))
					     then Discard else Keep
			   | Token.PL => if (M.isPlain prop)
					     then Discard else Keep
			   | Token.U => if (M.isMaxUnderline prop)
					    then Discard else Keep
			   | _ => Keep)
		in  case control of
		    Keep => loop (rest, t::kept, M.addTags(prop, [t]))
		  | Discard => loop (rest, kept, prop)
		  | Special answer => answer
		end  
	in  (case ctxt of
		 [] => raise (Error "Internal scopedElim error")
	       | prop::_ => let val (newTags, newProp) = loop (tags, [], prop)
			    in  (newProp::ctxt, newTags)
			    end)
	end


      fun opt ctxt (Seq el) = mkseq (map (opt ctxt) el)
	| opt ctxt (e as (Text _)) = e
	| opt ctxt (Tag (tags, e)) = 
		   let val (ctxt, tags) = reduceTags (ctxt, tags)
		   in  Tag(tags, opt ctxt e)
		   end

      val optimize = opt [M.null]

      fun flatten ((Seq el)) = mkseq (map flatten el)
	| flatten (e as (Text _)) = e
        | flatten (Tag (t1, Tag (t2, e))) = flatten (Tag (t1 @ t2, e))
        | flatten (Tag (t, e)) = Tag (t, flatten e)
  end
