Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] View of /tests/trunk/bugs/tests.obsolete/bug285.files
ViewVC logotype

View of /tests/trunk/bugs/tests.obsolete/bug285.files

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2460 - (download) (annotate)
Sat Apr 28 20:18:10 2007 UTC (12 years, 2 months ago) by gkuan
File size: 20480 byte(s)
Aliases.sig.sml100600  14405  14400        1446  4667221004  13561 037777777deutschlaemesch 1  0 signature Aliases =
sig
    datatype Accessor =
	NamedAcc of string
      | IntAcc of int;

    type Path;
    type Aliases;

    val DisplayAccessor : Accessor printer
    val MakeStringAcc: Accessor -> string
    val NewPath : Accessor list -> Path
    val PathNth : Path * int -> Accessor
    val PathDrop : Path * int -> Path
    val PathLength : Path -> int;
    val ++ : Path * Accessor -> Path
    val DisplayPath : Path printer
    val MakeStringPath : Path -> string
    val Add : (Path * Path) -> Aliases transformer
    val Adds : (Path list * Path list) -> Aliases transformer
    val SetVariable : (Path * Path) -> Aliases transformer
    val Remove : (Path list) -> Aliases transformer
    val Aliases : (Path * Aliases) -> Path list
    val Aliased : (Path * Path) -> (Aliases -> bool)
end;
Extensions.sml100600  14405  14400         116  4667221007  10755 037777777777  1  0 type 'a printer = (outstream * 'a) -> unit;
type 'a transformer = ('a -> 'a);
Map.sml100600  14405  14400        6337  4667221010   7360 037777777777  1  0 functor Map(structure Keys: OrderedSet
	    structure Values: Object):
	    sig type T
		type key
		type value
		val New : unit -> T
		val Update : key * value * T -> T
		val Lookup : key * T -> value option
		val Display : T printer
		val Map: ((key * value) -> 'a) -> T -> ('a list)
		val Max: T -> key
	    end =
struct
 type key = Keys.T;
 type value = Values.T;
 type key' = (key * value);
 fun fst(x,y) = x
 fun snd(x,y) = y
 fun kv < kv' =  Keys.<(fst(kv),fst(kv'))

 datatype color = RED | BLACK
 datatype tree = empty | tree of key' * color * tree * tree
 type T = tree;

 fun New() = empty;

 fun Update (key,value,t) =
  let val key = (key,value)
      fun f empty = tree(key,RED,empty,empty)
        | f (tree(k,BLACK,l,r)) =
	    if key<k
	    then case f r
		 of r as tree(rk,RED, rl as tree(rlk,RED,rll,rlr),rr) =>
			(case l
			 of tree(lk,RED,ll,lr) =>
				tree(k,RED,tree(lk,BLACK,ll,lr),
					   tree(rk,BLACK,rl,rr))
			  | _ => tree(rlk,BLACK,tree(k,RED,l,rll),
						tree(rk,RED,rlr,rr)))
		  | r as tree(rk,RED,rl, rr as tree(rrk,RED,rrl,rrr)) =>
			(case l
			 of tree(lk,RED,ll,lr) =>
				tree(k,RED,tree(lk,BLACK,ll,lr),
					   tree(rk,BLACK,rl,rr))
			  | _ => tree(rk,BLACK,tree(k,RED,l,rl),rr))
	          | r => tree(k,BLACK,l,r)
	    else if k<key
	    then case f l
	         of l as tree(lk,RED,ll, lr as tree(lrk,RED,lrl,lrr)) =>
			(case r
			 of tree(rk,RED,rl,rr) =>
				tree(k,RED,tree(lk,BLACK,ll,lr),
					   tree(rk,BLACK,rl,rr))
			  | _ => tree(lrk,BLACK,tree(lk,RED,ll,lrl),
						tree(k,RED,lrr,r)))
		  | l as tree(lk,RED, ll as tree(llk,RED,lll,llr), lr) =>
			(case r
			 of tree(rk,RED,rl,rr) =>
				tree(k,RED,tree(lk,BLACK,ll,lr),
					   tree(rk,BLACK,rl,rr))
			  | _ => tree(lk,BLACK,ll,tree(k,RED,lr,r)))
	          | l => tree(k,BLACK,l,r)
	    else tree(key,BLACK,l,r)
        | f (tree(k,RED,l,r)) =
	    if key<k then tree(k,RED,l, f r)
	    else if k<key then tree(k,RED, f l, r)
	    else tree(key,RED,l,r)
   in case f t
      of tree(k,RED, l as tree(_,RED,_,_), r) => tree(k,BLACK,l,r)
       | tree(k,RED, l, r as tree(_,RED,_,_)) => tree(k,BLACK,l,r)
       | t => t
  end

 fun Lookup (key,t) =
  let fun look empty = NONE
	| look (tree(k,_,l,r)) =
	  if Keys.<(fst(k),key) then look l
	  else if Keys.<(key,fst(k)) then look r
	       else SOME(snd(k))
  in
      look t
  end;

 fun Display (fd,t) =
     let val separator_needed = ref(false)

	 fun write(string) = output(fd, string)

	 fun DisplaySeparator() =
	     if !separator_needed then
		 (write(","); ())
	     else
		 separator_needed := true

	 fun Display(t) =
	     case t of
		 empty => ()
	       | tree((k,v),_,l,r) =>
		     (Display(r);
		      DisplaySeparator();
		      Keys.Display(fd,k);
		      write(" -> ");
		      Values.Display(fd,v);
		      Display(l))
     in
	 write("{");
	 Display(t);
	 write("}");
	 ()

     end; (* fun Display *)

 fun Map procedure t =
     let fun map(t, result) =
	     case t of
		 empty => result
	       | tree(pair, _, left_subtree, right_subtree) => 
		     map(left_subtree,
			 procedure(pair)::map(right_subtree, result))
     in
	 map(t, [])
     end

 fun Max t =
     case t of
	 tree((key,_),_,empty,_) => key
       | tree((key,_),_,nonempty_subtree,_) => Max(nonempty_subtree);

end; (* functor Map *)
Object.sig.sml100600  14405  14400         105  4667221011  10576 037777777777  1  0 signature Object = 
sig
    type T;
    val Display: T printer;
end;
OrderedSet.sig.sml100600  14405  14400         146  4667221012  11436 037777777777  1  0 signature OrderedSet = 
sig
    type T;
    val < : (T * T) -> bool;
    val Display: T printer;
end;
Strings.sig.sml100600  14405  14400         253  4667221312  11031 037777777777  1  0 signature Strings =
    sig
	type T;
	val < : (T * T) -> bool;
	val Display : T printer
	val Hash : T -> int;
	val MakeString: T -> string;
	val New: string -> T
    end;
Utilities.sig.sml100600  14405  14400        1504  4667221536  11403 037777777777  1  0 signature Utilities =
sig
	val assoc : (''a * (''a * 'b) list) -> 'b option
	val update_alist : (''a * 'b * (''a * 'b) list) -> (''a * 'b) list
	val butlast : ('a list) -> ('a list)
	val cartesian_product : (('a list) * ('b list)) -> (('a * 'b) list)
	val error : (string * string) -> 'a
	val is_prefix : ((''a list) * (''a list)) -> bool
	val member : (''a * (''a list)) -> bool
	val replace_prefix : (((''a list) * (''a list)) * (''a list)) -> (''a list)
	val display_list: (string * string * string * ('a printer)) ->
		               ('a list printer)
	val makestring_list: (string * string * string * ('a -> string)) ->
		                ('a list -> string)

	val display_pair: (string * string * string * ('a printer) * ('b printer)) -> (('a * 'b) printer)
end; (* structure Utilities *)

(*
Local Variables:
tab-width: 4
End:
*)
 Path
    val PathLength : Path -> int;
    val ++ : Path * Accessor -> Path
    val DisplayPath : Path printer
    val MakeStringPath : Path -> string
    val Add : (Path * Path) -> Aliasbug.sml100644  14405  14400         234  4667221472   7412 037777777777  1  0 use "Extensions.sml";
use "Utilities.sig.sml";
use "Strings.sig.sml";
use "Aliases.sig.sml";
use "Object.sig.sml";
use "OrderedSet.sig.sml";
use "Map.sml";
037777777777  1  0 e tree = empty | tree of key' * color * tree * tree
 type T = tree;

 fun New() = empty;

 fun Update (key,value,t) =
  let val key = (key,value)
      fun f empty = tree(key,RED,empty,empty)
        | f (tree(k,BLACK,l,r)) =
	    if key<k
	    then case f r
		 of r as tree(rk,RED, rl as tree(rlk,RED,rll,rlr),rr) =>
			(case l
			 of tree(lk,RED,ll,lr) =>
				tree(k,RED,tree(lk,BLACK,ll,lr),
					   tree(rk,BLACK,rl,rr))
			  | _ => tree(rlk,BLACK,tree(k,RED,l,rll),
						tree(rk,RED,rlr,rr)))
		  | r as tree(rk,RED,rl, rr as tree(rrk,RED,rrl,rrr)) =>
			(case l
			 of tree(lk,RED,ll,lr) =>
				tree(k,RED,tree(lk,BLACK,ll,lr),
					   tree(rk,BLACK,rl,rr))
			  | _ => tree(rk,BLACK,tree(k,RED,l,rl),rr))
	          | r => tree(k,BLACK,l,r)
	    else if k<key
	    then case f l
	         of l as tree(lk,RED,ll, lr as tree(lrk,RED,lrl,lrr)) =>
			(case r
			 of tree(rk,RED,rl,rr) =>
				tree(k,RED,tree(lk,BLACK,ll,lr),
					   tree(rk,BLACK,rl,rr))
			  | _ => tree(lrk,BLACK,tree(lk,RED,ll,lrl),
						tree(k,RED,lrr,r)))
		  | l as tree(lk,RED, ll as tree(llk,RED,lll,llr), lr) =>
			(case r
			 of tree(rk,RED,rl,rr) =>
				tree(k,RED,tree(lk,BLACK,ll,lr),
					   tree(rk,BLACK,rl,rr))
			  | _ => tree(lk,BLACK,ll,tree(k,RED,lr,r)))
	          | l => tree(k,BLACK,l,r)
	    else tree(key,BLACK,l,r)
        | f (tree(k,RED,l,r)) =
	    if key<k then tree(k,RED,l, f r)
	    else if k<key then tree(k,RED, f l, r)
	    else tree(key,RED,l,r)
   in case f t
      of tree(k,RED, l as tree(_,RED,_,_), r) => tree(k,BLACK,l,r)
       | tree(k,RED, l, r as tree(_,RED,_,_)) => tree(k,BLACK,l,r)
       | t => t
  end

 fun Lookup (key,t) =
  let fun look empty = NONE
	| look (tree(k,_,l,r)) =
	  if Keys.<(fst(k),key) then look l
	  else if Keys.<(key,fst(k)) then look r
	       else SOME(snd(k))
  in
      look t
  end;

 fun Display (fd,t) =
     let val separator_needed = ref(false)

	 fun write(string) = output(fd, string)

	 fun DisplaySeparator() =
	     if !separator_needed then
		 (write(","); ())
	     else
		 separator_needed := true

	 fun Display(t) =
	     case t of
		 empty => ()
	       | tree((k,v),_,l,r) =>
		     (Display(r);
		      DisplaySeparator();
		      Keys.Display(fd,k);
		      write(" -> ");
		      Values.Display(fd,v);
		      Display(l))
     in
	 write("{");
	 Display(t);
	 write("}");
	 ()

     end; (* fun Display *)

 fun Map procedure t =
     let fun map(t, result) =
	     case t of
		 empty => result
	       | tree(pair, _, left_subtree, right_subtree) => 
		     map(left_subtree,
			 procedure(pair)::map(right_subtree, result))
     in
	 map(t, [])
     end

 fun Max t =
     case t of
	 tree((key,_),_,empty,_) => key
       | tree((key,_),_,nonempty_subtree,_) => Max(nonempty_subtree);

end; (* functor Map *)
Object.sig.sml100600  14405  14400         105  4667221011  10576 037777777777  1  0 signature Object = 
sig
    type T;
    val Display: T printer;
end;
OrderedSet.sig.sml100600  14405  14400         146  4667221012  11436 037777777777  1  0 signature OrderedSet = 
sig
    type T;
    val < : (T * T) -> bool;
    val Display: T printer;
end;
Strings.sig.sml100600  14405  14400         253  4667221312  11031 037777777777  1  0 signature Strings =
    sig
	type T;
	val < : (T * T) -> bool;
	val Display : T printer
	val Hash : T -> int;
	val MakeString: T -> string;
	val New: string -> T
    end;
Utilities.sig.sml100600  14405  14400        1504  4667221536  11403 037777777777  1  0 

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0