misc tuning;
authorwenzelm
Mon, 30 Sep 2024 10:50:33 +0200
changeset 81015 ddbfb398d892
parent 81014 3a7138442fc4
child 81016 8e2114e6205b
misc tuning;
src/Pure/Syntax/parser.ML
--- a/src/Pure/Syntax/parser.ML	Mon Sep 30 10:46:26 2024 +0200
+++ b/src/Pure/Syntax/parser.ML	Mon Sep 30 10:50:33 2024 +0200
@@ -542,6 +542,15 @@
         | SOME end_pos => Position.range (pos, end_pos)))
   end;
 
+fun pretty_tree (Markup (_, ts)) = maps pretty_tree ts
+  | pretty_tree (Node ({const = c, ...}, ts)) =
+      [Pretty.enclose "(" ")" (Pretty.breaks (Pretty.quote (Pretty.str c) :: maps pretty_tree ts))]
+  | pretty_tree (Tip tok) =
+      if Lexicon.valued_token tok then [Pretty.str (Lexicon.str_of_token tok)] else [];
+
+
+(* tree_op: bottom-up construction of markup *)
+
 datatype tree_op =
   Markup_Push |
   Markup_Pop of Markup.T list |
@@ -599,12 +608,6 @@
       | [] => if null stack then body else raise Fail "Pending markup blocks");
   in make_node {nonterm = root, const = ""} (make [] [] tree_ops) end;
 
-fun pretty_tree (Markup (_, ts)) = maps pretty_tree ts
-  | pretty_tree (Node ({const = c, ...}, ts)) =
-      [Pretty.enclose "(" ")" (Pretty.breaks (Pretty.quote (Pretty.str c) :: maps pretty_tree ts))]
-  | pretty_tree (Tip tok) =
-      if Lexicon.valued_token tok then [Pretty.str (Lexicon.str_of_token tok)] else [];
-
 
 (* output *)
 
@@ -614,7 +617,6 @@
 val empty_output = Output (0, []);
 
 fun token_output tok (Output (n, ts)) = Output (n + 1, Tip_Op tok :: ts);
-
 fun node_output id (Output (n, ts)) = Output (n, [Node_Op (id, ts)]);
 
 fun push_output (Output (n, ts)) = Output (n, Markup_Push :: ts);
@@ -622,8 +624,9 @@
 
 fun append_output (Output (m, ss)) (Output (n, ts)) = Output (m + n, ss @ ts);
 
-val output_ord = pointer_eq_ord (fn (Output (m, ss), Output (n, tt)) =>
-  (case int_ord (m, n) of EQUAL => tree_ops_ord (ss, tt) | ord => ord));
+val output_ord =
+  pointer_eq_ord (fn (Output (m, ss), Output (n, tt)) =>
+    (case int_ord (m, n) of EQUAL => tree_ops_ord (ss, tt) | ord => ord));
 
 fun output_tree names root (Output (_, ts)) = make_tree names root ts;
 
@@ -632,8 +635,7 @@
 structure Output = Table(type key = output val ord = output_ord);
 
 
-
-(* parser state *)
+(* parse *)
 
 type state =
   (nt * int *       (*identification and production precedence*)
@@ -758,12 +760,12 @@
 
 in
 
-fun parse (gram as Gram {tags, names, ...}) root toks =
+fun parse (gram as Gram {tags, names, ...}) root_name toks =
   let
-    val root_tag =
-      (case tags_lookup tags root of
+    val root =
+      (case tags_lookup tags root_name of
         SOME tag => tag
-      | NONE => error ("Inner syntax: bad grammar root symbol " ^ quote root));
+      | NONE => error ("Inner syntax: bad grammar root symbol " ^ quote root_name));
 
     val end_pos =
       (case try List.last toks of
@@ -771,14 +773,13 @@
       | SOME tok => Lexicon.end_pos_of_token tok);
     val input = toks @ [Lexicon.mk_eof end_pos];
 
-    val S0: state =
-      ((~1, 0, "", 0), [Nonterminal (root_tag, 0), Terminal Lexicon.eof], empty_output);
+    val S0: state = ((~1, 0, "", 0), [Nonterminal (root, 0), Terminal Lexicon.eof], empty_output);
     val stateset = Array.array (length input + 1, []);
     val _ = Array.upd stateset 0 [S0];
 
     val result =
       produce gram stateset 0 Lexicon.dummy input
-      |> map (output_tree names root_tag o #3);
+      |> map (output_tree names root o #3);
   in if null result then raise Fail "Inner syntax: no parse trees" else result end;
 
 end;