X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fparamodulation%2Fdiscrimination_tree.ml;h=d73eb9c3a2bac8f9cab0c8dfa767309c26c76981;hb=97c2d258a5c524eb5c4b85208899d80751a2c82f;hp=b5a2d727472799c4991a9a50702047ad9e37dcc0;hpb=04fcadbd9e194847138d97a0a9892a475bc21c88;p=helm.git diff --git a/helm/ocaml/paramodulation/discrimination_tree.ml b/helm/ocaml/paramodulation/discrimination_tree.ml index b5a2d7274..d73eb9c3a 100644 --- a/helm/ocaml/paramodulation/discrimination_tree.ml +++ b/helm/ocaml/paramodulation/discrimination_tree.ml @@ -1,3 +1,28 @@ +(* Copyright (C) 2005, 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://cs.unibo.it/helm/. + *) + type path_string_elem = Cic.term;; type path_string = path_string_elem list;; @@ -39,58 +64,7 @@ end module PosEqSet = Set.Make(OrderedPosEquality);; -(* module DiscriminationTree = Trie.Make(PSMap);; *) - - -module DiscriminationTree = struct - type key = path_string - type t = Node of PosEqSet.t option * (t PSMap.t) - - let empty = Node (None, PSMap.empty) - - let rec find l t = - match (l, t) with - | [], Node (None, _) -> raise Not_found - | [], Node (Some v, _) -> v - | x::r, Node (_, m) -> find r (PSMap.find x m) - - let rec mem l t = - match (l, t) with - | [], Node (None, _) -> false - | [], Node (Some _, _) -> true - | x::r, Node (_, m) -> try mem r (PSMap.find x m) with Not_found -> false - - let add l v t = - let rec ins = function - | [], Node (_, m) -> Node (Some v, m) - | x::r, Node (v, m) -> - let t' = try PSMap.find x m with Not_found -> empty in - let t'' = ins (r, t') in - Node (v, PSMap.add x t'' m) - in - ins (l, t) - - let rec remove l t = - match (l, t) with - | [], Node (_, m) -> Node (None, m) - | x::r, Node (v, m) -> - try - let t' = remove r (PSMap.find x m) in - let m' = if t' = empty then PSMap.remove x m else PSMap.add x t' m in - Node (v, m') - with Not_found -> - t - - let rec fold f t acc = - let rec traverse revp t acc = match t with - | Node (None, m) -> - PSMap.fold (fun x -> traverse (x::revp)) m acc - | Node (Some v, m) -> - f (List.rev revp) v (PSMap.fold (fun x -> traverse (x::revp)) m acc) - in - traverse [] t acc - -end +module DiscriminationTree = Trie.Make(PSMap);; let string_of_discrimination_tree tree = @@ -124,7 +98,7 @@ let string_of_discrimination_tree tree = let index tree equality = - let _, (_, l, r, ordering), _, _ = equality in + let _, _, (_, l, r, ordering), _, _ = equality in let psl = path_string_of_term l and psr = path_string_of_term r in let index pos tree ps = @@ -144,7 +118,7 @@ let index tree equality = let remove_index tree equality = - let _, (_, l, r, ordering), _, _ = equality in + let _, _, (_, l, r, ordering), _, _ = equality in let psl = path_string_of_term l and psr = path_string_of_term r in let remove_index pos tree ps = @@ -168,7 +142,7 @@ let remove_index tree equality = let in_index tree equality = - let _, (_, l, r, ordering), _, _ = equality in + let _, _, (_, l, r, ordering), _, _ = equality in let psl = path_string_of_term l and psr = path_string_of_term r in let meta_convertibility = Inference.meta_convertibility_eq equality in @@ -185,7 +159,6 @@ let in_index tree equality = let head_of_term = function | Cic.Appl (hd::tl) -> hd -(* | Cic.Meta _ -> Cic.Implicit None *) | term -> term ;; @@ -196,7 +169,8 @@ let rec subterm_at_pos pos term = | index::pos -> match term with | Cic.Appl l -> - (try subterm_at_pos pos (List.nth l index) with _ -> raise Not_found) + (try subterm_at_pos pos (List.nth l index) + with Failure _ -> raise Not_found) | _ -> raise Not_found ;; @@ -249,7 +223,7 @@ let retrieve_generalizations tree term = in try let n = PSMap.find (Cic.Implicit None) map in - let newpos = try after_t pos term with _ -> [-1] in + let newpos = try after_t pos term with Not_found -> [-1] in if newpos = [-1] then match n with | DiscriminationTree.Node (Some s, _) -> PosEqSet.union s res @@ -315,7 +289,7 @@ let retrieve_unifiables tree term = in try let n = PSMap.find (Cic.Implicit None) map in - let newpos = try after_t pos term with _ -> [-1] in + let newpos = try after_t pos term with Not_found -> [-1] in if newpos = [-1] then match n with | DiscriminationTree.Node (Some s, _) -> PosEqSet.union s res