(*
  Hashtbl creation

      (* create an hashtbl of with (initial size = magic_size) *)
    let tbl = {}

      (* create an hashtbl of initial size 12 *)
    let tbl = {}|12|

      (* create an hashbbl of size 3, with bindings specified in an
      associative-list-like manner. If a key occurs more than once the first one
      appearing in the list will be the more recent one. Every expression
      returning an associative list could be used inside braces *)
    let tbl = {["foo", 1; "bar", 2; "quux", 3]}

      (* as above, with initial size 17 *)
    let tbl = {["foo", 1; "bar", 2; "quux", 3]}|17|

  Hashtbl lookup

    tbl{"foo"}            (* Hashtbl.find tbl "foo" *)
    tbl{["foo"]}          (* Hashtbl.find_all tbl "foo" *)
    tbl{?"foo"}           (* Hashtbl.mem tbl "foo" *)

  Hashtbl insertion

    tbl{"foo"} <- 1       (* Hashtbl.replace tbl "foo" 1 *)
    tbl{"foo"} <= 1       (* Hashtbl.add tbl "foo" 1 *)

  Hashtbl deletion

    tbl{"foo"} ->         (* Hashtbl.remove tbl "foo" *)

  Perl-like operators

    keys tbl              (* list all keys in tbl *)
    values tbl            (* list all values in tbl, multiple binding are
                          reported more than once *)

  Usage (assuming that the .cmo is in a directory that is in the camlp4 path,
        otherwise you need to add -I to camlp4{o,r} as needed):

    ocaml{c,opt} -pp "camlp4{o,r} hashtbl_ext.cmo" <source.ml>
*)

open Pcaml

let magic_size = 1024

let hashtbl_find loc tbl k = <:expr< Hashtbl.find $tbl$ $k$ >>
let hashtbl_find_all loc tbl k = <:expr< Hashtbl.find_all $tbl$ $k$ >>
let hashtbl_mem loc tbl k = <:expr< Hashtbl.mem $tbl$ $k$ >>
let hashtbl_add loc tbl k v = <:expr< Hashtbl.add $tbl$ $k$ $v$ >>
let hashtbl_replace loc tbl k v = <:expr< Hashtbl.replace $tbl$ $k$ $v$ >>
let hashtbl_remove loc tbl k = <:expr< Hashtbl.remove $tbl$ $k$ >>

let hashtbl_keys loc tbl =
  <:expr< Hashtbl.fold (fun k _ acc -> [k :: acc]) $tbl$ [] >>
let hashtbl_values loc tbl =
  <:expr< Hashtbl.fold (fun _ v acc -> [v :: acc]) $tbl$ [] >>

let magic_size = string_of_int magic_size
let hashtbl_create loc size content =
  <:expr<
    let size =
      match $int:size$ with
      [ 0 ->
          match $content$ with
          [ [] -> $int:magic_size$
          | _ -> List.length $content$ ]
      | v -> v ]
    in
    let table = Hashtbl.create size in
    do {
      List.iter (fun (k,v) -> Hashtbl.add table k v) $content$;
      table
    }
  >>

EXTEND

  expr: LEVEL "expr1"
    [
      [ e = expr LEVEL "simple" -> e
      | table = expr LEVEL "simple"; "{"; key = expr LEVEL "simple"; "}" ->
          hashtbl_find loc table key
      | table = expr LEVEL "simple";
        "{"; "["; key = expr LEVEL "simple"; "]"; "}" ->
          hashtbl_find_all loc table key
      | table = expr LEVEL "simple"; "{"; "?"; key = expr LEVEL "simple"; "}" ->
          hashtbl_mem loc table key
      | table = expr LEVEL "simple"; "{"; key = expr LEVEL "simple"; "}";
        "<-"; value = expr LEVEL "simple" ->
          hashtbl_replace loc table key value
      | table = expr LEVEL "simple"; "{"; key = expr LEVEL "simple"; "}";
        "<="; value = expr LEVEL "simple" ->
          hashtbl_add loc table key value
      | table = expr LEVEL "simple"; "{"; key = expr LEVEL "simple"; "}";
        "->" ->
          hashtbl_remove loc table key
      ]
    ];

  expr: LEVEL "simple"
    [
      [ "keys"; e = SELF -> hashtbl_keys loc e
      | "values"; e = SELF -> hashtbl_values loc e
      ]
    ];

  let_binding: FIRST
    [
      [ id = [ id = LIDENT -> id | "_" -> "" ]; "=";
        "{"; content = OPT [ e = expr LEVEL "simple" -> e ]; "}";
        size = OPT [ "|"; size = INT; "|" -> size ] ->
          let size = match size with None -> "0" | Some v -> v in
          let content =
            match content with None -> <:expr< [] >> | Some c -> c
          in
          ((match id with "" -> <:patt< _ >> | id -> <:patt< $lid:id$ >>),
           hashtbl_create loc size content)
      ]
    ];

END