helm/software/components/ng_paramodulation/index.ml

   1 (*
   2     ||M||  This file is part of HELM, an Hypertextual, Electronic
   3     ||A||  Library of Mathematics, developed at the Computer Science
   4     ||T||  Department, University of Bologna, Italy.
   5     ||I||
   6     ||T||  HELM is free software; you can redistribute it and/or
   7     ||A||  modify it under the terms of the GNU General Public License
   8     \   /  version 2 or (at your option) any later version.
   9      \ /   This software is distributed as is, NO WARRANTY.
  10       V_______________________________________________________________ *)
  11
  12 (* $Id$ *)
  13
  14 module Index(B : Orderings.Blob) = struct
  15   module U = FoUtils.Utils(B)
  16   module Clauses = Clauses.Clauses(B)
  17
  18   module ClauseOT =
  19     struct
  20       type t = Terms.direction * (* direction if it is an equality *)
  21           bool *                 (* true if indexed literal is positive *)
  22           int *                  (* position of literal in clause *)
  23           B.t Terms.clause
  24
  25       let compare (d1,p1,pos1,uc1) (d2,p2,pos2,uc2) =
  26         let c = Pervasives.compare (d1,p1,pos1) (d2,p2,pos2) in
  27         if c <> 0 then c else Clauses.compare_clause uc1 uc2
  28       ;;
  29     end
  30
  31   module ClauseSet :
  32     Set.S with type elt = Terms.direction * (* direction if it is an equality *)
  33                           bool *       (* true if indexed literal is positive *)
  34                           int *        (* position of literal in clause *)
  35                           B.t Terms.clause
  36     = Set.Make(ClauseOT)
  37
  38   open Discrimination_tree
  39
  40   module FotermIndexable : Indexable with
  41     type constant_name = B.t and
  42     type input = B.t Terms.foterm
  43   =
  44     struct
  45
  46       type input = B.t Terms.foterm
  47       type constant_name = B.t
  48
  49       let path_string_of =
  50         let rec aux arity = function
  51           | Terms.Leaf a -> [Constant (a, arity)]
  52           | Terms.Var i -> assert (arity = 0); [Variable]
  53           | Terms.Node (Terms.Var _::_) ->
  54               (* FIXME : should this be allowed or not ? *)
  55               assert false
  56           | Terms.Node ([] | [ _ ] ) -> assert false
  57           | Terms.Node (Terms.Node _::_) -> assert false
  58           | Terms.Node (hd::tl) ->
  59               aux (List.length tl) hd @ List.flatten (List.map (aux 0) tl)
  60         in
  61           aux 0
  62       ;;
  63
  64       let compare e1 e2 =
  65         match e1,e2 with
  66         | Constant (a1,ar1), Constant (a2,ar2) ->
  67             let c = B.compare a1 a2 in
  68             if c <> 0 then c else Pervasives.compare ar1 ar2
  69         | Variable, Variable -> 0
  70         | Constant _, Variable -> ~-1
  71         | Variable, Constant _ -> 1
  72         | Proposition, _ | _, Proposition
  73         | Datatype, _ | _, Datatype
  74         | Dead, _ | _, Dead
  75         | Bound _, _ | _, Bound _ -> assert false
  76       ;;
  77
  78       let string_of_path l = String.concat "." (List.map (fun _ -> "*") l) ;;
  79
  80     end
  81
  82     module DT : DiscriminationTree with
  83       type constant_name = B.t and
  84       type input = B.t Terms.foterm and
  85       type data = ClauseSet.elt and
  86       type dataset = ClauseSet.t
  87     = Make(FotermIndexable)(ClauseSet)
  88
  89   let index_literal t c is_pos pos = function
  90     | Terms.Equation (l,_,_,Terms.Invertible)
  91     | Terms.Equation (l,_,_,Terms.Gt) ->
  92           DT.index t l (Terms.Left2Right,is_pos,pos,c)
  93     | Terms.Equation (_,r,_,Terms.Lt) ->
  94           DT.index t r (Terms.Right2Left,is_pos,pos,c)
  95     | Terms.Equation (l,r,_,Terms.Incomparable) ->
  96           DT.index
  97            (DT.index t l (Terms.Left2Right,is_pos,pos,c))
  98            r (Terms.Right2Left,is_pos,pos,c)
  99     | Terms.Equation (_,_,_,Terms.Eq) -> assert false
 100     | Terms.Predicate p ->
 101           DT.index t p (Terms.Nodir,is_pos,pos,c)
 102   ;;
 103
 104   let index_clause t (_,nlit,plit,_,_ as c) =
 105     let index_iter is_pos  (t,pos) (lit,sel) =
 106       if sel then index_literal t c is_pos pos lit,pos+1 else t,pos+1
 107     in
 108     let (res,_) = List.fold_left (index_iter false) (t,0) nlit in
 109       fst (List.fold_left (index_iter true) (res,0) plit)
 110   ;;
 111
 112   type active_set = B.t Terms.clause list * DT.t
 113
 114 end