(* Copyright (C) 2011, HELM Team.
 * 
 * This file is part of HELM, an Hypertextual, Electronic
 * Library of Mathematics, developed at the Computer Science
 * Department, University of Bologna, Italy.
 * 
 * HELM is free software; you can redistribute it and/or
 * modify it under the terms of the GNU General Public License
 * as published by the Free Software Foundation; either version 2
 * of the License, or (at your option) any later version.
 * 
 * HELM 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 General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with HELM; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
 * MA  02111-1307, USA.
 * 
 * For details, see the HELM World-Wide-Web page,
 * http://helm.cs.unibo.it/
 *)

module Domain =
  struct
    type t = Stdpp.location * string (* location, name *)
    let compare = Pervasives.compare
  end

module Table = Map.Make (Domain)

module Ast = NotationPt

let populate =
  let rec aux lastloc acc = function
   | Ast.AttributedTerm (`Loc l,u) -> aux l acc u
   | Ast.Appl tl -> 
       List.fold_left (aux lastloc) acc tl
   | Ast.Binder (k,ty,body) ->
       let acc' = aux_var lastloc acc ty in
       aux lastloc acc' body
   | Ast.Case (t,ity,oty,pl) -> 
       (* FIXME: ity contains interpretation info
        * but we don't have the location for it
        * this must be rethought
        *)
       let acc = aux lastloc acc t in
       let acc = match oty with
       | None -> acc
       | Some oty' -> aux lastloc acc oty'
       in
       List.fold_left (aux_pattern lastloc) acc pl
   | Ast.Cast (u,v) -> 
       aux lastloc (aux lastloc acc v) u
   | Ast.LetIn (ty,u,v) ->
       let acc = aux_var lastloc acc ty in 
       let acc = aux lastloc acc u in 
       aux lastloc acc v
   | Ast.LetRec (ik,l,t) ->
       let acc = aux lastloc acc t in 
       List.fold_left (aux_letrec lastloc) acc l 
   | Ast.Ident (id,`Uri u) -> Table.add (lastloc,id) u acc
   | _ -> acc
 and aux_pattern lastloc acc = function
   | Ast.Pattern (_,_,tys),t ->
     (* FIXME: patterns may contain disambiguation info
      * for constructors *)
     let acc = aux lastloc acc t in
     List.fold_left (aux_var lastloc) acc tys
   | _,t -> aux lastloc acc t
 and aux_letrec lastloc acc (args,ty,body,_) =
   let acc = aux lastloc acc body in
   let acc = List.fold_left (aux_var lastloc) acc args
   in
   aux_var lastloc acc ty 
 and aux_var lastloc acc (_,ty) =
   match ty with
   | None -> acc
   | Some ty' -> aux lastloc acc ty'

 in aux Stdpp.dummy_loc (Table.empty)
;;