more accurate treatment of index syntax constants, for proper entity references in concrete notation (e.g. infix "\<oplus>\<index>");
authorwenzelm
Wed, 24 Aug 2011 23:00:53 +0200
changeset 44470 6c6c31ef6bb2
parent 44469 266dfd7f4e82
child 44471 3c2b2c4a7c1c
more accurate treatment of index syntax constants, for proper entity references in concrete notation (e.g. infix "\<oplus>\<index>");
src/Pure/Syntax/syntax_ext.ML
--- a/src/Pure/Syntax/syntax_ext.ML	Wed Aug 24 09:23:26 2011 -0700
+++ b/src/Pure/Syntax/syntax_ext.ML	Wed Aug 24 23:00:53 2011 +0200
@@ -231,8 +231,8 @@
 
     val raw_symbs = read_mfix sy handle ERROR msg => err_in_mfix msg mfix;
     val args = filter (fn Argument _ => true | _ => false) raw_symbs;
-    val (const', typ', parse_rules) =
-      if not (exists is_index args) then (const, typ, [])
+    val (const', typ', syntax_consts, parse_rules) =
+      if not (exists is_index args) then (const, typ, NONE, NONE)
       else
         let
           val indexed_const =
@@ -247,7 +247,7 @@
           val lhs = Ast.mk_appl (Ast.Constant indexed_const)
             (xs1 @ [Ast.mk_appl (Ast.Constant "_index") [i]] @ xs2);
           val rhs = Ast.mk_appl (Ast.Constant const) (i :: xs);
-        in (indexed_const, rangeT, [(lhs, rhs)]) end;
+        in (indexed_const, rangeT, SOME (indexed_const, const), SOME (lhs, rhs)) end;
 
     val (symbs, lhs) = add_args raw_symbs typ' pris;
 
@@ -273,7 +273,7 @@
       else if exists is_terminal symbs' then xprod
       else XProd (lhs', map rem_pri symbs', "", chain_pri);
 
-  in (xprod', parse_rules) end;
+  in (xprod', syntax_consts, parse_rules) end;
 
 
 
@@ -298,13 +298,15 @@
     val (parse_ast_translation, parse_translation, print_translation,
       print_ast_translation) = trfuns;
 
-    val (xprods, parse_rules') = map (mfix_to_xprod is_logtype) mfixes
-      |> split_list |> apsnd (rev o flat);
+    val xprod_results = map (mfix_to_xprod is_logtype) mfixes;
+    val xprods = map #1 xprod_results;
+    val consts' = map_filter #2 xprod_results;
+    val parse_rules' = rev (map_filter #3 xprod_results);
     val mfix_consts = map (fn Mfix x => (#3 x, "")) mfixes @ map (fn XProd x => (#3 x, "")) xprods;
   in
     Syn_Ext {
       xprods = xprods,
-      consts = mfix_consts @ consts,
+      consts = mfix_consts @ consts' @ consts,
       parse_ast_translation = parse_ast_translation,
       parse_rules = parse_rules' @ parse_rules,
       parse_translation = parse_translation,