From 7b2a24d0beee17b61281a5c64fca5cf7388479d3 Mon Sep 17 00:00:00 2001
From: herbelin <herbelin@85f007b7-540e-0410-9357-904b9bb8a0f7>
Date: Fri, 18 Feb 2005 22:17:50 +0000
Subject: Moving centralised discharge into dispatched discharge_function;
 required to delay some computation from before to after caching time +
 various simplifications and uniformisations

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@6748 85f007b7-540e-0410-9357-904b9bb8a0f7
---
 library/libobject.ml | 12 ++++++++++++
 1 file changed, 12 insertions(+)

(limited to 'library/libobject.ml')

diff --git a/library/libobject.ml b/library/libobject.ml
index 25d5a329f..d84e0bc26 100644
--- a/library/libobject.ml
+++ b/library/libobject.ml
@@ -36,6 +36,7 @@ type 'a object_declaration = {
   open_function : int -> object_name * 'a -> unit;
   classify_function : object_name * 'a -> 'a substitutivity;
   subst_function : object_name * substitution * 'a -> 'a;
+  discharge_function : object_name * 'a -> 'a option;
   export_function : 'a -> 'a option }
 
 let yell s = anomaly s
@@ -48,6 +49,7 @@ let default_object s = {
   subst_function = (fun _ -> 
     yell ("The object "^s^" does not know how to substitute!"));
   classify_function = (fun (_,obj) -> Keep obj);
+  discharge_function = (fun _ -> None);
   export_function = (fun _ -> None)} 
 
 
@@ -72,6 +74,7 @@ type dynamic_object_declaration = {
   dyn_open_function : int -> object_name * obj -> unit;
   dyn_subst_function : object_name * substitution * obj -> obj;
   dyn_classify_function : object_name * obj -> obj substitutivity;
+  dyn_discharge_function : object_name * obj -> obj option;
   dyn_export_function : obj -> obj option }
 
 let object_tag lobj = Dyn.tag lobj
@@ -104,6 +107,11 @@ let declare_object odecl =
 	| Anticipate (obj) -> Anticipate (infun obj)
     else 
       anomaly "somehow we got the wrong dynamic object in the classifyfun"
+  and discharge (oname,lobj) = 
+    if Dyn.tag lobj = na then 
+      option_app infun (odecl.discharge_function (oname,outfun lobj))
+    else 
+      anomaly "somehow we got the wrong dynamic object in the dischargefun"
   and exporter lobj = 
     if Dyn.tag lobj = na then 
       option_app infun (odecl.export_function (outfun lobj))
@@ -116,6 +124,7 @@ let declare_object odecl =
                              dyn_open_function = opener;
 			     dyn_subst_function = substituter;
 			     dyn_classify_function = classifier;
+			     dyn_discharge_function = discharge;
                              dyn_export_function = exporter };
   (infun,outfun)
 
@@ -154,5 +163,8 @@ let subst_object ((_,_,lobj) as node) =
 let classify_object ((_,lobj) as node) = 
   apply_dyn_fun Dispose (fun d -> d.dyn_classify_function node) lobj
 
+let discharge_object ((_,lobj) as node) = 
+  apply_dyn_fun None (fun d -> d.dyn_discharge_function node) lobj
+
 let export_object lobj =
   apply_dyn_fun None (fun d -> d.dyn_export_function lobj) lobj
-- 
cgit v1.2.3