val RCSversion = ref "";
fun RCS version = RCSversion := (!RCSversion)^version^"\n";
RCS "$Id: common.ml,v 1.17 1998/08/13 11:31:01 pxs Exp $";

(* A general purpose exception for things which I'm so sure can't    *)
(* happen that it isn't worth tracking them more precisely -- famous *)
(* last words... *)
exception Panic
exception PanicNoisily of string			(* nuff said *)
(* for when you'd call UI.error except that that doesn't type-check. *)
exception Error of string
exception Parse of string
exception QuitCWB of string

(* Let's define a few more natural pervasives *)
fun inc i = i := (!i) + 1;		(* not in 110?? *)
fun dec i = i := (!i) - 1;		(* not in 110?? *)
    
fun fst (x,_) = x

fun snd (_,x) = x

fun forall p l = let fun fall [] = true
                       | fall (h::t) = (p h) andalso (fall t)
                  in fall l
                 end

fun flatten [] = []
  | flatten (h::t) = h@(flatten t)

(* keep things if p DOES hold of them *)
fun filter p =
    let fun filt [] = []
          | filt (h::t) = let val ftail = filt t
                           in if p h then h::ftail else ftail
                          end
     in filt
    end

(* keep things if p does NOT hold of them *)
fun filterNot p =
  let fun filt [] = []
	| filt (h::t) = let val ftail = filt t
			in if p h then ftail else h::ftail
			end
  in filt
  end

fun noOp _ = ()
fun id x = x

structure Lib =
struct
   fun member eq (a,l) = List.exists (fn x => eq(x,a)) l

   fun rm eq (a,l) =
       let fun rma [] = []
             | rma (h::t) = if eq(h,a) then rma t else h::(rma t)
        in rma l
       end

   fun eq elt_eq =
       let fun equal ([],[]) = true
             | equal (a::s,b::t) = elt_eq(a,b) andalso equal(s,t)
             | equal _ = false
        in equal
       end

   fun le elt_le =
       let fun leq ([],_)        = true
             | leq (_,[])        = false
             | leq (h::t,h'::t') = elt_le(h,h') andalso
                                   (not (elt_le(h',h)) orelse leq(t,t'))
        in leq
       end

   fun del_dups eq =
       let fun dd m [] = m
             | dd m (h::t) = if member eq (h,m) then dd m t else dd (m@[h]) t
        in dd []
       end
(* Equiv to map prod on the list of all possible pairs (a1 in l1, a2 in l2)*)
(* In ptic, like a good multiplication, null iff one of its args is. *)
   fun multiply prod [] l = []
     | multiply prod l [] = [] (* unnecessary, but avoids walking down l *)
     | multiply prod (h::t) l =
       let (* m l equiv (map prod) on list of all pairs (h,h' in l)  *)
	 fun m [] = []
	   | m (h'::t') = prod(h,h')::(m t')
       in (m l)@(multiply prod t l)
       end

(* Given a predicate and a list, return first elt on lists satisfying pred *)
   exception First
   fun first p l = let fun f [] = raise First
			 | f (h::t) = if p h then h else f t
		   in f l
		   end

   fun mkstr mkstrelt sep []     = ""

     | mkstr mkstrelt sep [a]    = mkstrelt a
     | mkstr mkstrelt sep (h::t) = (mkstrelt h)^sep^(mkstr mkstrelt sep t)

   val ran = ref 123
   fun random ub = (ran := (1005 * !ran + 7473) mod 8192;
                    (!ran) div (8192 div ub + 1))

(* return a line minus any leading or trailing whitespace  *)
   fun get_line infile =
       let fun strip (#" "::t) = strip t
             | strip (#"\t"::t) = strip t
             | strip (#"\n"::t) = strip t
             | strip l = l
           val revline = strip(rev(strip(explode(TextIO.inputLine infile))))
        in implode(rev revline)
       end

   fun startsWithCapital string = 
     (if (ord string) >= (ord #"A") andalso
       (ord string) <= (ord #"Z") then true
     else false) handle Ord => false

   fun lexicographicLe (le1, le2) ((a1,a2),(b1,b2)) =
     if le1 (a1, b1) then
       if le1 (b1, a1) then le2 (a2, b2) else true
     else false

(* is_term_in, is_term_out copied from SML Top-level Comparison, bell labs. *)
   fun is_term_in (instream : TextIO.instream) =
     let val (rd as TextPrimIO.RD{ioDesc,...}, buf) =
       TextIO.StreamIO.getReader(TextIO.getInstream instream)
     in TextIO.setInstream
       (instream, TextIO.StreamIO.mkInstream(rd, SOME buf));
       case ioDesc of
	 NONE => false
       | SOME desc => (OS.IO.kind desc = OS.IO.Kind.tty)
     end

   fun is_term_out (outstream: TextIO.outstream) =
     let val (wr as TextPrimIO.WR{ioDesc,...},buf) =
       TextIO.StreamIO.getWriter(TextIO.getOutstream outstream)
     in TextIO.setOutstream (outstream, TextIO.StreamIO.mkOutstream(wr,buf));
       case ioDesc
	 of NONE => false
       | SOME desc => (OS.IO.kind desc = OS.IO.Kind.tty)
     end
end