gistfile1.ml

let map_collect_by_name tbl list =
  let rec loop = function
    | [] -> ()
    | D _::elts -> loop elts
    | E (((_, name), attrs) as tag, children)::elts ->
       try (Hashtbl.find tbl name) attrs children
       with Not_found ->
         failwith (Printf.sprintf "bad tag: %s" (fmt_tag tag)) in
  loop list

let define_op tbl (name:string) f =
  let cell = ref [] in
  Hashtbl.add tbl name
              (fun attrs children ->
                 cell := f attrs children::!cell);
  cell

let parse_domain_children list =
  let ops = Hashtbl.create 2 in
  let rules = define_op ops "rule" parse_rule in
  let assertions = define_op ops "assert" parse_assertion in
  map_collect_by_name ops list;
  !rules, !assertions