(* List utility routines for ocaml
   Copyright (C) 2003,2004 Shawn Wagner <shawnw@speakeasy.org>

   This library is free software; you can redistribute it and/or
   modify it under the terms of the GNU Lesser General Public
   License as published by the Free Software Foundation; either
   version 2.1 of the License, or (at your option) any later version.
	 
   This library is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
   Lesser General Public License for more details.
	 
   You should have received a copy of the GNU Lesser General Public
   License along with this library; if not, write to the Free Software
   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
*)


let genmunge sort cmp f lst =
  let keys = List.map f lst in
  let pairs = List.combine keys lst in
  let sorted = sort (fun x y -> cmp (fst x) (fst y)) pairs in
  snd (List.split sorted)

let munge ~cmp ~f lst = genmunge List.sort cmp f lst
let stable_munge ~cmp ~f lst = genmunge List.stable_sort cmp f lst
let fast_munge ~cmp ~f lst = genmunge List.fast_sort cmp f lst

let index item lst =
  let rec do_index lst pos =
    match lst with
      | car :: _ when car = item -> pos
      | _ :: cdr -> do_index cdr (pos + 1)
      | [] -> raise Not_found in
 do_index lst 0

let indexq item lst =
  let rec do_indexq lst pos =
    match lst with
      | car :: _ when car == item -> pos
      | _ :: cdr -> do_indexq cdr (pos + 1)
      | [] -> raise Not_found in
 do_indexq lst 0

module type ComparableType = sig
  type t
  val compare: t -> t -> int
end

module type S = sig
  type t 
  val index: t -> t list -> int
  val mem: t -> t list -> bool
  val assoc: t -> (t * 'a) list -> 'a
  val mem_assoc: t -> (t * 'a) list -> bool
  val remove_assoc: t -> (t * 'a) list -> (t * 'a) list
end

module Make (Comp: ComparableType) = struct
  type t = Comp.t

  let eq a b = (Comp.compare a b) = 0

  let index item lst =
    let rec do_index lst pos =
      match lst with
	| car :: _ when eq car item -> pos
	| _ :: cdr -> do_index cdr (pos + 1)
	| [] -> raise Not_found in
      do_index lst 0

  let rec mem item lst =
    match lst with
      | car :: _ when eq car item -> true
      | _ :: cdr -> mem item cdr
      | [] -> false

  let rec assoc key lst = 
    match lst with
      | (key1, arg) :: _ when eq key key1 -> arg
      | _ :: cdr -> assoc key cdr
      | [] -> raise Not_found

  let rec mem_assoc key lst =
    match lst with
      | (key1, _) :: _ when eq key key1 -> true
      | _ :: cdr -> mem_assoc key cdr
      | [] -> false

  let remove_assoc key lst =
    let rec do_remove lst build =
      match lst with
	| (key1, _) as car :: cdr ->
	    if eq key key1 then
	      do_remove cdr build
	    else
	      do_remove cdr (car :: build)
	| [] -> build in
      List.rev (do_remove lst [])
end


let car = function
  | car :: _ -> car
  | [] -> raise (Failure "ListExtras.car")

let cdr = function
  | _ :: cdr -> cdr
  | [] -> raise (Failure "ListExtras.cdr")

let cadr = function
  | _ :: cadr :: _ -> cadr
  | _ -> raise (Failure "ListExtras.cadr")
      
let cddr = function
  | _ :: _ :: cddr -> cddr
  | _ -> raise (Failure "ListExtras.cddr")

let caddr lst = car (cddr lst)

let cdddr lst = cdr (cddr lst)

let cadddr lst = car (cdddr lst)

let cddddr lst = cdr (cdddr lst)

let rec tail lst n =
  if n = 0 then 
    lst
  else 
    match lst with
      | _ :: cdr -> tail cdr (n - 1)
      | [] -> raise (Failure "ListExtras.tail")