Oops, again...

Oops, again...

[Jonathan T Bryant]

[-- Attachment #1: Type: text/plain, Size: 287 bytes --]

I apparently forgot (as well) that you have to attach things to an 
email for them to actually be attached to the email.  It doesn't just 
happen because you think about it... :)

-----------------------
--Jonathan Bryant
  jtbryant@valdosta.edu
  AIM: JonBoy3182

  OAS AAS LLS
  ZG214

[-- Attachment #2: multiSort.ml --]
[-- Type: application/octet-stream, Size: 5675 bytes --]

module Dataset :
  sig
    type 'a t
    val create : unit -> 'a t
    val add : 'a t -> 'a -> int
    val remove : 'a t -> int -> 'a
    val inspect : 'a t -> int -> 'a
    val clear : 'a t -> unit
    val register_add_observer : 'a t -> (int -> 'a -> unit) -> unit
    val unregister_add_observer : 'a t -> (int -> 'a -> unit) -> unit
    val register_remove_observer : 'a t -> (int -> 'a -> unit) -> unit
    val unregister_remove_observer : 'a t -> (int -> 'a -> unit) -> unit
  end = struct
    type 'a t = {
      mutable data : (int, 'a) Hashtbl.t;
      mutable free_list : int list;
      mutable add_observers : (int -> 'a -> unit) list;
      mutable remove_observers : (int -> 'a -> unit) list
    }
    let create () = {
      data = Hashtbl.create 29;
      free_list = [];
      add_observers = [];
      remove_observers = []
    }
    let add ds e =
      let idx = match ds.free_list with
      | [] -> (Hashtbl.length ds.data) + 1
      | h::t -> ds.free_list <- t; h
      in
      Hashtbl.add ds.data idx e;
      List.iter (fun f -> f idx e) ds.add_observers;
      idx
    let remove ds idx =
      let e = Hashtbl.find ds.data idx in
      Hashtbl.remove ds.data idx;
      if idx <> Hashtbl.length ds.data then ds.free_list <- (idx::ds.free_list);
      List.iter (fun f -> f idx e) ds.remove_observers;
      e
    let inspect ds idx = Hashtbl.find ds.data idx
    let clear ds =
      Hashtbl.iter (fun idx -> fun e ->
        List.iter (fun f -> f idx e) ds.remove_observers;
        Hashtbl.remove ds.data idx
      ) ds.data
    let register_add_observer ds f =
      ds.add_observers <- (f::ds.add_observers)
    let unregister_add_observer ds f =
      ds.add_observers <- List.filter (fun o ->
        if f = o
        then false
        else true) ds.add_observers
    let register_remove_observer ds f =
      ds.remove_observers <- (f::ds.remove_observers)
    let unregister_remove_observer ds f =
      ds.remove_observers <- List.filter (fun o ->
        if f = o
        then false
        else true) ds.remove_observers
  end

module DSList :
  sig
    type 'a t
    val create : 'a Dataset.t -> 'a t
    val cons : 'a t -> 'a -> unit
    val hd : 'a t -> 'a
    val nth : 'a t -> int -> 'a
    val rev : 'a t -> unit
    val iter : ('a -> unit) -> 'a t -> unit
    val destroy : 'a t -> unit
  end = struct
    type 'a t = {
      data : 'a Dataset.t;
      mutable repr : int list
    }
    let add_listener l idx e =
      l.repr <- (idx::l.repr)
    let remove_listener l idx e =
      l.repr <- (List.filter (fun x -> if x = idx then false else true) l.repr)
    let create ds =
      let self = { data = ds; repr = [] } in
      Dataset.register_add_observer ds (add_listener self);
      Dataset.register_remove_observer ds (remove_listener self);
      self
    let cons l e = let _ = Dataset.add l.data e in ()
    let hd l = Dataset.inspect l.data (List.hd l.repr)
    let nth l idx = Dataset.inspect l.data (List.nth l.repr idx)
    let rev l = l.repr <- (List.rev l.repr)
    let iter f l = List.iter (fun idx -> f (Dataset.inspect l.data idx)) l.repr
    let destroy l =
      l.repr <- [];
      Dataset.unregister_add_observer l.data (add_listener l);
      Dataset.unregister_remove_observer l.data (remove_listener l)
  end

module DSSortedList :
  sig
    type 'a t
    val create : 'a Dataset.t -> 'a t
    val cons : 'a t -> 'a -> unit
    val hd : 'a t -> 'a
    val nth : 'a t -> int -> 'a
    val iter : ('a -> unit) -> 'a t -> unit
    val destroy : 'a t -> unit
  end = struct
    type 'a t = {
      data : 'a Dataset.t;
      mutable repr : int list
    }
    let add_listener l idx e =
      l.repr <- (List.sort (fun x -> fun y ->
        compare (Dataset.inspect l.data x) (Dataset.inspect l.data y)
      ) (idx::l.repr))
    let remove_listener l idx e =
      l.repr <- (List.filter (fun x -> if x = idx then false else true) l.repr)
    let create ds =
      let self = { data = ds; repr = [] } in
      Dataset.register_add_observer ds (add_listener self);
      Dataset.register_remove_observer ds (remove_listener self);
      self
    let cons l e = let _ = Dataset.add l.data e in ()
    let hd l = Dataset.inspect l.data (List.hd l.repr)
    let nth l idx = Dataset.inspect l.data (List.nth l.repr idx)
    let iter f l = List.iter (fun idx -> f (Dataset.inspect l.data idx)) l.repr
    let destroy l =
      l.repr <- [];
      Dataset.unregister_add_observer l.data (add_listener l);
      Dataset.unregister_remove_observer l.data (remove_listener l)
  end


let print_ds_list l =
  Printf.printf "[ ";
  DSList.iter (fun x -> Printf.printf "%s; " x) l;
  Printf.printf "]\n"

let print_ds_sorted_list l =
  Printf.printf "[ ";
  DSSortedList.iter (fun x -> Printf.printf "%s; " x) l;
  Printf.printf "]\n"

let test_text = ["four"; "score"; "and"; "seven"; "years"; "ago"; "our";
"fathers"; "brought"; "forth"; "upon"; "this"; "continent"; "a"; "new";
"nation"; "concieved"; "in"; "liberty"; "and"; "dedicated"; "to"; "the";
"proposition"; "that"; "all"; "men"; "are"; "created"; "equal"; "we"; "are";
"now"; "engaged"; "in"; "a"; "great"; "civil"; "war"; "testing"; "whether";
"that"; "nation"; "or"; "any"; "nation"; "so"; "concieved"; "can"; "survive";
"we"; "are"; "met"; "on"; "a"; "great"; "battlefield"; "of"; "that"; "war"]

let () =
  let ds = Dataset.create () in
  let dsl1 = DSList.create ds in
  let dsl2 = DSSortedList.create ds in
  Printf.printf "Empty Lists:\n";
  print_ds_list dsl1;
  print_ds_sorted_list dsl2;
  List.iter (fun w ->
    DSList.cons dsl1 w;
    Printf.printf "Added word \"%s\":\n" w;
    print_ds_list dsl1;
    print_ds_sorted_list dsl2
  ) test_text;