(**************************************************************************)
(*                                                                        *)
(*  Copyright (C) Johannes Kanig, Stephane Lescuyer                       *)
(*  Jean-Christophe Filliatre, Romain Bardou and Francois Bobot           *)
(*                                                                        *)
(*  This software is free software; you can redistribute it and/or        *)
(*  modify it under the terms of the GNU Library General Public           *)
(*  License version 2.1, with the special exception on linking            *)
(*  described in file LICENSE.                                            *)
(*                                                                        *)
(*  This software 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.                  *)
(*                                                                        *)
(**************************************************************************)

open Types
open Hashcons


(* A duplicate analysis - find out the number of times a node is used *)


module MetaPath =
struct
  type t = metapath_node hash_consed
  let equal = (==)
  let hash x = x.hkey
end

module Path =
struct
  type t = path_node hash_consed
  let equal = (==)
  let hash x = x.hkey
end

module Picture =
struct
  type t = picture_node hash_consed
  let equal = (==)
  let hash x = x.hkey
end

module MPthM = Hashtbl.Make (MetaPath)
module PthM = Hashtbl.Make (Path)
module PicM = Hashtbl.Make (Picture)

let path_map = PthM.create 257
let picture_map = PicM.create 257

let test_and_incr_path n =
  try incr (PthM.find path_map n); true
  with Not_found -> PthM.add path_map n (ref 1); false

let test_and_incr_pic n =
  try incr (PicM.find picture_map n); true
  with Not_found -> PicM.add picture_map n (ref 1); false

let option_count f = function
  | None -> ()
  | Some x -> f x

let rec metapath p =
  match p.Hashcons.node with
  | MPAConcat (k,j,p) -> metapath p
  | MPAAppend (p1,j,p2) -> metapath p1; metapath p2
  | MPAKnot k -> ()
  | MPAofPA p -> path p

and path' = function
  | PAofMPA p -> metapath p
  | MPACycle (_,_,p) -> metapath p
  | PATransformed (p,_) -> path p
  | PACutAfter (p1,p2)
  | PACutBefore (p1,p2) -> path p1; path p2
  | PABuildCycle pl -> List.iter path pl
  | PASub (f1, f2, p) ->  path p
  | PABBox p -> commandpic p
  | PAUnitSquare | PAQuarterCircle | PAHalfCircle | PAFullCircle -> ()
and path p =
(*   Format.printf "%a@." Print.path p; *)
  if test_and_incr_path p then () else path' p.node

and picture' = function
    | PITransformed (p,_) -> commandpic p
    | PITex s -> ()
    | PIClip (pic,pth) -> commandpic pic; path pth
and picture p =
  if test_and_incr_pic p then () else picture' p.node

and command c =
  match c.node with
  | CDraw (p, b) ->
      path p; brush b
  | CFill (p, c) -> path p
  | CDotLabel (pic, _, _) -> commandpic pic
  | CLabel (pic, _ ,_) -> commandpic pic
  | CExternalImage _ -> ()
and brush b =
  let b = b.Hashcons.node in
  option_count pen b.pen; option_count dash b.dash
and pen p =
  match p.Hashcons.node with
  | PenCircle | PenSquare -> ()
  | PenFromPath p -> path p
  | PenTransformed (p, _) -> pen p

and dash d =
  match d.Hashcons.node with
  | DEvenly | DWithdots -> ()
  | DScaled (f, d) -> dash d
  | DShifted (_, d) -> dash d
  | DPattern l -> List.iter dash_pattern l

and dash_pattern _ = ()

and commandpic p =
  match p.node with
  | Picture p -> picture p
  | Command c -> command c
  | Seq l -> List.iter commandpic l

