From: Stefano Zacchiroli <zack@upsilon.cc>
Date: Fri, 24 Feb 2006 00:18:04 +0000 (+0000)
Subject: Use reference counting to keep track of camlp4 extensions so that the same
X-Git-Tag: 0.4.95@7852~1621
X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=commitdiff_plain;h=cfd7bb0b9b4648a0e6b6e791f8800cd329a777a8;p=helm.git

Use reference counting to keep track of camlp4 extensions so that the same
grammar rules are not added several times. (closes: #147)
---

diff --git a/components/lexicon/cicNotation.ml b/components/lexicon/cicNotation.ml
index 1d18691ff..d514c0273 100644
--- a/components/lexicon/cicNotation.ml
+++ b/components/lexicon/cicNotation.ml
@@ -32,17 +32,26 @@ type notation_id =
   | InterpretationId of TermAcicContent.interpretation_id
   | PrettyPrinterId of TermContentPres.pretty_printer_id
 
+let parser_ref_counter = RefCounter.create ()
+let rule_ids_to_items = Hashtbl.create 113
+
 let process_notation st =
   match st with
   | Notation (loc, dir, l1, associativity, precedence, l2) ->
-      let rule_id =
+      let item = (l1, precedence, associativity, l2) in
+      let rule_id = ref [] in
+      let _ =
         if dir <> Some `RightToLeft then
-          [ RuleId (CicNotationParser.extend l1 ?precedence ?associativity
-              (fun env loc ->
-                CicNotationPt.AttributedTerm
-                 (`Loc loc,TermContentPres.instantiate_level2 env l2))) ]
-        else
-          []
+          let create_cb (l1, precedence, associativity, l2) =
+            let id =
+              CicNotationParser.extend l1 ?precedence ?associativity
+                (fun env loc ->
+                  CicNotationPt.AttributedTerm
+                   (`Loc loc,TermContentPres.instantiate_level2 env l2)) in
+            rule_id := [ RuleId id ];
+            Hashtbl.add rule_ids_to_items id item
+          in
+          RefCounter.incr ~create_cb parser_ref_counter item
       in
       let pp_id =
         if dir <> Some `LeftToRight then
@@ -52,14 +61,20 @@ let process_notation st =
         else
           []
       in
-       rule_id @ pp_id
+      !rule_id @ pp_id
   | Interpretation (loc, dsc, l2, l3) ->
       let interp_id = TermAcicContent.add_interpretation dsc l2 l3 in
        [InterpretationId interp_id]
   | st -> []
 
 let remove_notation = function
-  | RuleId id -> CicNotationParser.delete id
+  | RuleId id ->
+      let item =
+        try
+          Hashtbl.find rule_ids_to_items id
+        with Not_found -> assert false in
+      RefCounter.decr ~delete_cb:(fun _ -> CicNotationParser.delete id)
+        parser_ref_counter item
   | PrettyPrinterId id -> TermContentPres.remove_pretty_printer id
   | InterpretationId id -> TermAcicContent.remove_interpretation id