RE: Multi-index Container

[Jonathan T Bryant <jtbryant@valdosta.edu>]

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

How about something like the attached code?  Completing the data 
structures is left as an exercise for the reader... :)


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

  OAS AAS LLS
  ZG214

[-- Attachment #2: multiSort.ml --]
[-- Type: application/octet-stream, Size: 5415 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 add_observers : (int -> 'a -> unit) list;
      mutable remove_observers : (int -> 'a -> unit) list
    }
    let create () = {
      data = Hashtbl.create 29;
      add_observers = [];
      remove_observers = []
    }
    let add ds e =
      let idx = (Hashtbl.length ds.data) + 1 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;
      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 =
      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 =
      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;