# HG changeset patch
# User wenzelm
# Date 1729681429 -7200
# Node ID 47b95e6af3c88da3fe972c063f6717d53b7543db
# Parent  41a39fa0cae0d8e6723868a9dd7f86cbf8198a5d
misc tuning and clarification;

diff -r 41a39fa0cae0 -r 47b95e6af3c8 src/Pure/Syntax/ast.ML
--- a/src/Pure/Syntax/ast.ML	Tue Oct 22 23:56:48 2024 +0200
+++ b/src/Pure/Syntax/ast.ML	Wed Oct 23 13:03:49 2024 +0200
@@ -219,6 +219,9 @@
 fun message head body =
   Pretty.string_of (Pretty.block [Pretty.str head, Pretty.brk 1, body]);
 
+fun tracing_if false _ = ()
+  | tracing_if true msg = tracing (msg ());
+
 in
 
 (*the normalizer works yoyo-like: top-down, bottom-up, top-down, ...*)
@@ -227,63 +230,52 @@
     val trace = Config.get ctxt trace;
     val stats = Config.get ctxt stats;
 
+    val matches_failed = Unsynchronized.ref 0;
+    val changes = Unsynchronized.ref 0;
     val passes = Unsynchronized.ref 0;
-    val failed_matches = Unsynchronized.ref 0;
-    val changes = Unsynchronized.ref 0;
 
-    fun rewrite1 ((lhs, rhs) :: pats) ast =
-          (case match p ast lhs of
-            SOME (env, args) =>
-              (Unsynchronized.inc changes; SOME (mk_appl (subst env rhs) args))
-          | NONE => (Unsynchronized.inc failed_matches; rewrite1 pats ast))
-      | rewrite1 [] _ = NONE;
+    fun rewrite1 ast (lhs, rhs) =
+      (case match p ast lhs of
+        NONE => (Unsynchronized.inc matches_failed; NONE)
+      | SOME (env, args) => (Unsynchronized.inc changes; SOME (mk_appl (subst env rhs) args)));
 
     fun rewrite2 a ast =
-      (case rewrite1 (get_rules a) ast of
+      (case get_first (rewrite1 ast) (get_rules a) of
         NONE => if a = "" then NONE else rewrite2 "" ast
       | some => some);
 
-    fun rewrite ast = rewrite2 (head_name ast) ast;
-
-    fun rewrote old_ast new_ast =
-      if trace then tracing (message "rewrote:" (pretty_rule (old_ast, new_ast)))
-      else ();
+    fun rewrote rule = tracing_if trace (fn () => message "rewrote:" (pretty_rule rule));
 
     fun norm1 ast =
-      (case rewrite ast of
-        SOME new_ast => (rewrote ast new_ast; norm1 new_ast)
+      (case rewrite2 (head_name ast) ast of
+        SOME ast' => (rewrote (ast, ast'); norm1 ast')
       | NONE => ast);
 
     fun norm2 ast =
       (case norm1 ast of
-        Appl sub_asts =>
+        Appl subs =>
           let
             val old_changes = ! changes;
-            val new_ast = Appl (map norm2 sub_asts);
-          in
-            if old_changes = ! changes then new_ast else norm1 new_ast
-          end
-      | atomic_ast => atomic_ast);
+            val ast' = Appl (map norm2 subs);
+          in if old_changes = ! changes then ast' else norm1 ast' end
+      | atomic => atomic);
 
     fun norm ast =
       let
         val old_changes = ! changes;
-        val new_ast = norm2 ast;
-      in
-        Unsynchronized.inc passes;
-        if old_changes = ! changes then new_ast else norm new_ast
-      end;
+        val ast' = norm2 ast;
+        val _ = Unsynchronized.inc passes;
+      in if old_changes = ! changes then ast' else norm ast' end;
 
 
-    val _ = if trace then tracing (message "pre:" (pretty_ast pre_ast)) else ();
+    val _ = tracing_if trace (fn () => message "pre:" (pretty_ast pre_ast));
     val post_ast = norm pre_ast;
     val _ =
-      if trace orelse stats then
-        tracing (message "post:" (pretty_ast post_ast) ^ "\nnormalize: " ^
-          string_of_int (! passes) ^ " passes, " ^
-          string_of_int (! changes) ^ " changes, " ^
-          string_of_int (! failed_matches) ^ " matches failed")
-      else ();
+      tracing_if (trace orelse stats) (fn () =>
+        message "post:" (pretty_ast post_ast) ^ "\nnormalize: " ^
+        string_of_int (! passes) ^ " passes, " ^
+        string_of_int (! changes) ^ " changes, " ^
+        string_of_int (! matches_failed) ^ " matches failed");
   in post_ast end;
 
 end;