Make more code use the Listener module

src/datatype/Datatype.sig

@@ -34,7 +34,8 @@ sig
  (* into their tyinfo to do inequality resolution.                            *)
  (*---------------------------------------------------------------------------*)
 
- val typecheck_listener : (string Symtab.table -> ParseDatatype.pretype -> hol_type -> unit) ref
+ val typecheck_listener :
+     (string Symtab.table * ParseDatatype.pretype * hol_type) Listener.t
  val build_tyinfos : typeBase
                          -> {induction:thm, recursion:thm}
                            -> tyinfo list

src/datatype/Datatype.sml

@@ -179,7 +179,8 @@ fun ast_tyvar_strings (dAQ ty) = map dest_vartype $ type_vars ty
   | ast_tyvar_strings (dTyop {Args, ...}) =
       List.concat (map ast_tyvar_strings Args)
 
-val typecheck_listener = ref (fn _: string Symtab.table => fn _: pretype => fn _:hol_type => ())
+val typecheck_listener : (string Symtab.table * pretype * hol_type) Listener.t =
+    Listener.new_listener()
 
 local
   fun strvariant avoids s = if mem s avoids then strvariant avoids (s ^ "a")
@@ -223,7 +224,7 @@ fun to_tyspecs ASTs =
                                        Args = map (mk_hol_ty d) Args}
      fun mk_hol_type d pty = let
        val ty = mk_hol_ty d pty
-       val _ = !typecheck_listener d pty ty
+       val _ = Listener.call_listener typecheck_listener (d, pty, ty)
      in
        if Theory.uptodate_type ty then ty
        else let val tyname = #1 (dest_type ty)

src/parse/ParseDatatype.sig

@@ -41,6 +41,6 @@ val hparse : type_grammar.grammar -> Type.hol_type Portable.quotation ->
   or a type-constant of arity 0, or one of the types being defined.
 *)
 
-val parse_listener : (AST list -> unit) ref
+val parse_listener : (AST list) Listener.t
 
 end

src/parse/ParseDatatype.sml

@@ -350,13 +350,13 @@ end
 fun hide_tynames q G0 =
   List.foldl (uncurry type_grammar.hide_tyop) G0 (extract_tynames q)
 
-val parse_listener = ref (fn _: (string * datatypeForm) list => ())
+val parse_listener : AST list Listener.t = Listener.new_listener ()
 
 fun core_parse G0 phrase_p q = let
   val G = hide_tynames q G0
   val qb = qbuf.new_buffer q
   val result = termsepby1 ";" base_tokens.BT_EOI (parse_g G phrase_p) qb
-  val _ = !parse_listener result
+  val _ = Listener.call_listener parse_listener result
 in
   case qbuf.current qb of
       (base_tokens.BT_EOI,_) => result

src/parse/Preterm.sig

@@ -70,7 +70,7 @@ sig
     ((term -> string) * (hol_type -> string)) option -> preterm -> term errM
   val typecheckS : preterm -> term seqM
 
-  val typecheck_listener : (preterm -> Pretype.Env.t -> unit) ref
+  val typecheck_listener : (preterm * Pretype.Env.t) Listener.t
   val last_tcerror : (tcheck_error * locn.locn) option ref
 
 end

src/parse/Preterm.sml

@@ -858,7 +858,8 @@ fun remove_case_magic tm =
     else tm
 
 val post_process_term = ref (I : term -> term);
-val typecheck_listener = ref (fn _:preterm => fn _:Pretype.Env.t => ());
+val typecheck_listener : (preterm * Pretype.Env.t) Listener.t =
+    Listener.new_listener()
 
 fun typecheck pfns ptm0 =
   let
@@ -869,7 +870,7 @@ fun typecheck pfns ptm0 =
           overloading_resolution ptm0 >-                     (fn (ptm,b) =>
           (report_ovl_ambiguity b >> to_term ptm) >-         (fn t =>
          fn e => (
-          !typecheck_listener ptm e;
+          ignore (Listener.call_listener typecheck_listener (ptm, e));
           errormonad.Some(e, !post_process_term t)))))
   end
 
@@ -881,7 +882,7 @@ fun typecheckS ptm =
     lift (!post_process_term o remove_case_magic)
          (fromErr TC' >> overloading_resolutionS ptm >-
           (fn ptm' => fromErr (errormonad.bind (to_term ptm', fn t => fn e => (
-            !typecheck_listener ptm' e;
+            ignore (Listener.call_listener typecheck_listener (ptm', e));
             errormonad.Some(e, t))))))
   end
 

src/tfl/src/Defn.sml

@@ -1779,7 +1779,7 @@ fun defn_absyn_to_term a = let
       overloading_resolution ptm >- (fn (pt,b) =>
       report_ovl_ambiguity b     >>
       to_term pt                 >- (fn t => fn e => (
-      !Preterm.typecheck_listener pt e;
+      ignore (Listener.call_listener Preterm.typecheck_listener (pt, e));
       return (t |> remove_case_magic |> !post_process_term) e)))
     end
   val M =