open Format
open Str

module Error = struct

exception Exit of int

type info = FI of string * int * int | UNKNOWN
type 'a withinfo = {i: info; v: 'a}

let dummyinfo = UNKNOWN
let createInfo f l c = FI(f, l, c)

let errf f = 
  print_flush(); 
  open_vbox 0; 
  open_hvbox 0; f(); print_cut(); close_box(); print_newline();
  raise (Exit 1)

let sprintInfo =
  (* In the text of the book, file positions in error messages are replaced
     with the string "Error:" *)
  function
    FI(f,l,c) ->
      Printf.sprintf "%s:%d:" f l
  | UNKNOWN ->
      "<Unknown file and line>: "


let printInfo =
  (* In the text of the book, file positions in error messages are replaced
     with the string "Error:" *)
  function
    FI(f,l,c) ->
      print_string f; 
      print_string ":"; 
      print_int l; 
      (* print_string "."; print_int c; *)
      print_string ":"
  | UNKNOWN ->
      print_string "<Unknown file and line>: "

let errfAt fi f = errf(fun()-> printInfo fi; print_space(); f())

let err s = errf (fun()-> print_string "Error: "; print_string s; print_newline())

let error fi s = errfAt fi (fun()-> print_string s; print_newline())

let warning s =
  print_string "Warning: "; print_string s;
  print_newline()

let warningAt fi s =
  printInfo fi; print_string " Warning: ";
  print_string s; print_newline()

end

(* ---------------------------------------------------------------------- *)

module Pervasive = struct

type info = Error.info

let pr = Format.print_string

let opt f d x =
  match x with 
    None -> d
  | Some v -> f v

module StringEq = struct type t = string let eq = (=) end
module StringSet = List_set.Set(StringEq)

module IntEq = struct type t = int let eq = (=) end
module IntSet = List_set.Set(IntEq)

type 'a alist = (string * 'a) list
let alist_dom als = StringSet.uniquify (List.map fst als)

let int_alist_dom als = IntSet.uniquify (List.map fst als)

let unique_id = ref 0
let make_id () = unique_id := !unique_id + 1; !unique_id


let ununiquify_name n = 
  let l = split (regexp "@") n in
    (match l with
       [] -> n
    | [n] -> n
    | [n;ext] -> n (*sprintf "%s_%s" n ext*)
    | _ -> Error.error Error.UNKNOWN "ununiquify, to many parts")

let split_name n = 
  let l = split (regexp "@") n in
    (match l with
       [] -> Error.error Error.UNKNOWN "ununiquify"
    | [n] -> n
    | [n;ext] -> n
    | _ -> Error.error Error.UNKNOWN "ununiquify, to many parts")

let flatten_name n = 
  let l = split (regexp "@") n in
    String.concat "_" l
      
let uniquify_name n = 
  let n = split_name n in
    Printf.sprintf "%s@%d" n (make_id ())


let clear_id () = unique_id := 0

let map = List.map
let map2 = List.map2
let assoc = List.assoc
let concat = List.concat
let append = List.append
let length = List.length
let hd = List.hd
let tl = List.tl

let opt o f =
  match o with
    Some x -> Some (f x)
  | None -> None

let iota n = 
  let rec iota_r n ls =
    if (n = 0) then
      0::ls
    else
      iota_r (n - 1) (n::ls) in
  if (n = 0) then []
  else iota_r (n - 1) []

let rec filter_map f ls =
  (match ls with
      [] -> []
    | x::ls ->
	(match f x with
	    None -> filter_map f ls
	  | Some y -> y::(filter_map f ls)))

let rec map_option f ls1 ls2 =
  (match ls1 with
       [] -> Some []
     | x::ls1 ->
	 (match ls2 with
	      [] -> None
	    | y::ls2 ->
		(match (map_option f ls1 ls2) with
		     None -> None
		   | Some rs ->
		       (match f x y with
			    None -> None
			  | Some z -> Some (z::rs)))))

let rec distinct ls =
  (match ls with
       [] -> true
     | x::ls ->
	 if (List.mem x ls) then
	   false
	 else
	   distinct ls)

end (* module pervasive *)