# HG changeset patch # User wenzelm # Date 1621717090 -7200 # Node ID ebaed09ce06e32ebd9fcbbefaefdd26fbb08047f # Parent 35d8132633c65250e15c7ac080969500fc22db35 more uniform document antiquotations for ML: consolidate former setup for manuals; diff -r 35d8132633c6 -r ebaed09ce06e src/Doc/Implementation/Logic.thy --- a/src/Doc/Implementation/Logic.thy Sat May 22 21:52:13 2021 +0200 +++ b/src/Doc/Implementation/Logic.thy Sat May 22 22:58:10 2021 +0200 @@ -624,7 +624,7 @@ \<^descr> \<^ML>\Thm.apply\, \<^ML>\Thm.lambda\, \<^ML>\Thm.all\, \<^ML>\Drule.mk_implies\ etc.\ compose certified terms (or propositions) incrementally. This is - equivalent to \<^ML>\Thm.cterm_of\ after unchecked \<^ML_op>\$\, \<^ML>\lambda\, + equivalent to \<^ML>\Thm.cterm_of\ after unchecked \<^ML_infix>\$\, \<^ML>\lambda\, \<^ML>\Logic.all\, \<^ML>\Logic.mk_implies\ etc., but there can be a big difference in performance when large existing entities are composed by a few extra constructions on top. There are separate operations to decompose diff -r 35d8132633c6 -r ebaed09ce06e src/Doc/Implementation/ML.thy --- a/src/Doc/Implementation/ML.thy Sat May 22 21:52:13 2021 +0200 +++ b/src/Doc/Implementation/ML.thy Sat May 22 22:58:10 2021 +0200 @@ -1608,7 +1608,7 @@ The unwieldy name of \<^ML>\Unsynchronized.ref\ for the constructor for references in Isabelle/ML emphasizes the inconveniences caused by - mutability. Existing operations \<^ML>\!\ and \<^ML_op>\:=\ are unchanged, + mutability. Existing operations \<^ML>\!\ and \<^ML_infix>\:=\ are unchanged, but should be used with special precautions, say in a strictly local situation that is guaranteed to be restricted to sequential evaluation --- now and in the future. diff -r 35d8132633c6 -r ebaed09ce06e src/Doc/Implementation/Tactic.thy --- a/src/Doc/Implementation/Tactic.thy Sat May 22 21:52:13 2021 +0200 +++ b/src/Doc/Implementation/Tactic.thy Sat May 22 22:58:10 2021 +0200 @@ -494,9 +494,9 @@ text \ Sequential composition and alternative choices are the most basic ways to combine tactics, similarly to ``\<^verbatim>\,\'' and ``\<^verbatim>\|\'' in Isar method notation. - This corresponds to \<^ML_op>\THEN\ and \<^ML_op>\ORELSE\ in ML, but there + This corresponds to \<^ML_infix>\THEN\ and \<^ML_infix>\ORELSE\ in ML, but there are further possibilities for fine-tuning alternation of tactics such as - \<^ML_op>\APPEND\. Further details become visible in ML due to explicit + \<^ML_infix>\APPEND\. Further details become visible in ML due to explicit subgoal addressing. \ @@ -515,32 +515,32 @@ @{define_ML "FIRST'": "('a -> tactic) list -> 'a -> tactic"} \\ \end{mldecls} - \<^descr> \tac\<^sub>1\~\<^ML_op>\THEN\~\tac\<^sub>2\ is the sequential composition of \tac\<^sub>1\ and + \<^descr> \tac\<^sub>1\~\<^ML_infix>\THEN\~\tac\<^sub>2\ is the sequential composition of \tac\<^sub>1\ and \tac\<^sub>2\. Applied to a goal state, it returns all states reachable in two steps by applying \tac\<^sub>1\ followed by \tac\<^sub>2\. First, it applies \tac\<^sub>1\ to the goal state, getting a sequence of possible next states; then, it applies \tac\<^sub>2\ to each of these and concatenates the results to produce again one flat sequence of states. - \<^descr> \tac\<^sub>1\~\<^ML_op>\ORELSE\~\tac\<^sub>2\ makes a choice between \tac\<^sub>1\ and + \<^descr> \tac\<^sub>1\~\<^ML_infix>\ORELSE\~\tac\<^sub>2\ makes a choice between \tac\<^sub>1\ and \tac\<^sub>2\. Applied to a state, it tries \tac\<^sub>1\ and returns the result if non-empty; if \tac\<^sub>1\ fails then it uses \tac\<^sub>2\. This is a deterministic choice: if \tac\<^sub>1\ succeeds then \tac\<^sub>2\ is excluded from the result. - \<^descr> \tac\<^sub>1\~\<^ML_op>\APPEND\~\tac\<^sub>2\ concatenates the possible results of - \tac\<^sub>1\ and \tac\<^sub>2\. Unlike \<^ML_op>\ORELSE\ there is \<^emph>\no commitment\ to - either tactic, so \<^ML_op>\APPEND\ helps to avoid incompleteness during + \<^descr> \tac\<^sub>1\~\<^ML_infix>\APPEND\~\tac\<^sub>2\ concatenates the possible results of + \tac\<^sub>1\ and \tac\<^sub>2\. Unlike \<^ML_infix>\ORELSE\ there is \<^emph>\no commitment\ to + either tactic, so \<^ML_infix>\APPEND\ helps to avoid incompleteness during search, at the cost of potential inefficiencies. - \<^descr> \<^ML>\EVERY\~\[tac\<^sub>1, \, tac\<^sub>n]\ abbreviates \tac\<^sub>1\~\<^ML_op>\THEN\~\\\~\<^ML_op>\THEN\~\tac\<^sub>n\. Note that \<^ML>\EVERY []\ is the same as + \<^descr> \<^ML>\EVERY\~\[tac\<^sub>1, \, tac\<^sub>n]\ abbreviates \tac\<^sub>1\~\<^ML_infix>\THEN\~\\\~\<^ML_infix>\THEN\~\tac\<^sub>n\. Note that \<^ML>\EVERY []\ is the same as \<^ML>\all_tac\: it always succeeds. - \<^descr> \<^ML>\FIRST\~\[tac\<^sub>1, \, tac\<^sub>n]\ abbreviates \tac\<^sub>1\~\<^ML_op>\ORELSE\~\\\~\<^ML_op>\ORELSE\~\tac\<^sub>n\. Note that \<^ML>\FIRST []\ is the + \<^descr> \<^ML>\FIRST\~\[tac\<^sub>1, \, tac\<^sub>n]\ abbreviates \tac\<^sub>1\~\<^ML_infix>\ORELSE\~\\\~\<^ML_infix>\ORELSE\~\tac\<^sub>n\. Note that \<^ML>\FIRST []\ is the same as \<^ML>\no_tac\: it always fails. - \<^descr> \<^ML_op>\THEN'\ is the lifted version of \<^ML_op>\THEN\, for tactics - with explicit subgoal addressing. So \(tac\<^sub>1\~\<^ML_op>\THEN'\~\tac\<^sub>2) i\ is - the same as \(tac\<^sub>1 i\~\<^ML_op>\THEN\~\tac\<^sub>2 i)\. + \<^descr> \<^ML_infix>\THEN'\ is the lifted version of \<^ML_infix>\THEN\, for tactics + with explicit subgoal addressing. So \(tac\<^sub>1\~\<^ML_infix>\THEN'\~\tac\<^sub>2) i\ is + the same as \(tac\<^sub>1 i\~\<^ML_infix>\THEN\~\tac\<^sub>2 i)\. The other primed tacticals work analogously. \ @@ -567,7 +567,7 @@ applies \tac\ at most once. Note that for tactics with subgoal addressing, the combinator can be applied - via functional composition: \<^ML>\TRY\~\<^ML_op>\o\~\tac\. There is no need + via functional composition: \<^ML>\TRY\~\<^ML_infix>\o\~\tac\. There is no need for \<^verbatim>\TRY'\. \<^descr> \<^ML>\REPEAT\~\tac\ applies \tac\ to the goal state and, recursively, to @@ -592,10 +592,10 @@ text %mlex \ The basic tactics and tacticals considered above follow some algebraic laws: - \<^item> \<^ML>\all_tac\ is the identity element of the tactical \<^ML_op>\THEN\. + \<^item> \<^ML>\all_tac\ is the identity element of the tactical \<^ML_infix>\THEN\. - \<^item> \<^ML>\no_tac\ is the identity element of \<^ML_op>\ORELSE\ and \<^ML_op>\APPEND\. Also, it is a zero element for \<^ML_op>\THEN\, which means that - \tac\~\<^ML_op>\THEN\~\<^ML>\no_tac\ is equivalent to \<^ML>\no_tac\. + \<^item> \<^ML>\no_tac\ is the identity element of \<^ML_infix>\ORELSE\ and \<^ML_infix>\APPEND\. Also, it is a zero element for \<^ML_infix>\THEN\, which means that + \tac\~\<^ML_infix>\THEN\~\<^ML>\no_tac\ is equivalent to \<^ML>\no_tac\. \<^item> \<^ML>\TRY\ and \<^ML>\REPEAT\ can be expressed as (recursive) functions over more basic combinators (ignoring some internal implementation tricks): @@ -607,7 +607,7 @@ \ text \ - If \tac\ can return multiple outcomes then so can \<^ML>\REPEAT\~\tac\. \<^ML>\REPEAT\ uses \<^ML_op>\ORELSE\ and not \<^ML_op>\APPEND\, it applies \tac\ + If \tac\ can return multiple outcomes then so can \<^ML>\REPEAT\~\tac\. \<^ML>\REPEAT\ uses \<^ML_infix>\ORELSE\ and not \<^ML_infix>\APPEND\, it applies \tac\ as many times as possible in each outcome. \begin{warn} @@ -650,11 +650,11 @@ @{define_ML RANGE: "(int -> tactic) list -> int -> tactic"} \\ \end{mldecls} - \<^descr> \<^ML>\ALLGOALS\~\tac\ is equivalent to \tac n\~\<^ML_op>\THEN\~\\\~\<^ML_op>\THEN\~\tac 1\. It applies the \tac\ to all the subgoals, counting downwards. + \<^descr> \<^ML>\ALLGOALS\~\tac\ is equivalent to \tac n\~\<^ML_infix>\THEN\~\\\~\<^ML_infix>\THEN\~\tac 1\. It applies the \tac\ to all the subgoals, counting downwards. - \<^descr> \<^ML>\SOMEGOAL\~\tac\ is equivalent to \tac n\~\<^ML_op>\ORELSE\~\\\~\<^ML_op>\ORELSE\~\tac 1\. It applies \tac\ to one subgoal, counting downwards. + \<^descr> \<^ML>\SOMEGOAL\~\tac\ is equivalent to \tac n\~\<^ML_infix>\ORELSE\~\\\~\<^ML_infix>\ORELSE\~\tac 1\. It applies \tac\ to one subgoal, counting downwards. - \<^descr> \<^ML>\FIRSTGOAL\~\tac\ is equivalent to \tac 1\~\<^ML_op>\ORELSE\~\\\~\<^ML_op>\ORELSE\~\tac n\. It applies \tac\ to one subgoal, counting upwards. + \<^descr> \<^ML>\FIRSTGOAL\~\tac\ is equivalent to \tac 1\~\<^ML_infix>\ORELSE\~\\\~\<^ML_infix>\ORELSE\~\tac n\. It applies \tac\ to one subgoal, counting upwards. \<^descr> \<^ML>\HEADGOAL\~\tac\ is equivalent to \tac 1\. It applies \tac\ unconditionally to the first subgoal. @@ -666,7 +666,7 @@ upwards. \<^descr> \<^ML>\RANGE\~\[tac\<^sub>1, \, tac\<^sub>k] i\ is equivalent to \tac\<^sub>k (i + k - - 1)\~\<^ML_op>\THEN\~\\\~\<^ML_op>\THEN\~\tac\<^sub>1 i\. It applies the given list of + 1)\~\<^ML_infix>\THEN\~\\\~\<^ML_infix>\THEN\~\tac\<^sub>1 i\. It applies the given list of tactics to the corresponding range of subgoals, counting downwards. \ @@ -714,7 +714,7 @@ \<^descr> \<^ML>\DEPTH_FIRST\~\sat tac\ returns the goal state if \sat\ returns true. Otherwise it applies \tac\, then recursively searches from each element of the resulting sequence. The code uses a stack for efficiency, in effect - applying \tac\~\<^ML_op>\THEN\~\<^ML>\DEPTH_FIRST\~\sat tac\ to the state. + applying \tac\~\<^ML_infix>\THEN\~\<^ML>\DEPTH_FIRST\~\sat tac\ to the state. \<^descr> \<^ML>\DEPTH_SOLVE\\tac\ uses \<^ML>\DEPTH_FIRST\ to search for states having no subgoals. diff -r 35d8132633c6 -r ebaed09ce06e src/Doc/Isar_Ref/Document_Preparation.thy --- a/src/Doc/Isar_Ref/Document_Preparation.thy Sat May 22 21:52:13 2021 +0200 +++ b/src/Doc/Isar_Ref/Document_Preparation.thy Sat May 22 22:58:10 2021 +0200 @@ -100,11 +100,22 @@ @{antiquotation_def subgoals} & : & \antiquotation\ \\ @{antiquotation_def prf} & : & \antiquotation\ \\ @{antiquotation_def full_prf} & : & \antiquotation\ \\ + @{antiquotation_def ML_text} & : & \antiquotation\ \\ @{antiquotation_def ML} & : & \antiquotation\ \\ - @{antiquotation_def ML_op} & : & \antiquotation\ \\ + @{antiquotation_def ML_def} & : & \antiquotation\ \\ + @{antiquotation_def ML_ref} & : & \antiquotation\ \\ + @{antiquotation_def ML_infix} & : & \antiquotation\ \\ + @{antiquotation_def ML_infix_def} & : & \antiquotation\ \\ + @{antiquotation_def ML_infix_ref} & : & \antiquotation\ \\ @{antiquotation_def ML_type} & : & \antiquotation\ \\ + @{antiquotation_def ML_type_def} & : & \antiquotation\ \\ + @{antiquotation_def ML_type_ref} & : & \antiquotation\ \\ @{antiquotation_def ML_structure} & : & \antiquotation\ \\ + @{antiquotation_def ML_structure_def} & : & \antiquotation\ \\ + @{antiquotation_def ML_structure_ref} & : & \antiquotation\ \\ @{antiquotation_def ML_functor} & : & \antiquotation\ \\ + @{antiquotation_def ML_functor_def} & : & \antiquotation\ \\ + @{antiquotation_def ML_functor_ref} & : & \antiquotation\ \\ @{antiquotation_def emph} & : & \antiquotation\ \\ @{antiquotation_def bold} & : & \antiquotation\ \\ @{antiquotation_def verbatim} & : & \antiquotation\ \\ @@ -192,8 +203,9 @@ @@{antiquotation subgoals} options | @@{antiquotation prf} options @{syntax thms} | @@{antiquotation full_prf} options @{syntax thms} | + @@{antiquotation ML_text} options @{syntax text} | @@{antiquotation ML} options @{syntax text} | - @@{antiquotation ML_op} options @{syntax text} | + @@{antiquotation ML_infix} options @{syntax text} | @@{antiquotation ML_type} options @{syntax text} | @@{antiquotation ML_structure} options @{syntax text} | @@{antiquotation ML_functor} options @{syntax text} | @@ -280,10 +292,16 @@ \<^descr> \@{full_prf a\<^sub>1 \ a\<^sub>n}\ is like \@{prf a\<^sub>1 \ a\<^sub>n}\, but prints the full proof terms, i.e.\ also displays information omitted in the compact proof term, which is denoted by ``\_\'' placeholders there. - - \<^descr> \@{ML s}\, \@{ML_op s}\, \@{ML_type s}\, \@{ML_structure s}\, and + + \<^descr> \@{ML_text s}\ prints ML text verbatim: only the token language is + checked. + + \<^descr> \@{ML s}\, \@{ML_infix s}\, \@{ML_type s}\, \@{ML_structure s}\, and \@{ML_functor s}\ check text \s\ as ML value, infix operator, type, - structure, and functor respectively. The source is printed verbatim. + exception, structure, and functor respectively. The source is printed + verbatim. The variants \@{ML_def s}\ and \@{ML_ref s}\ etc. maintain the + document index: ``def'' means to make a bold entry, ``ref'' means to make a + regular entry. \<^descr> \@{emph s}\ prints document source recursively, with {\LaTeX} markup \<^verbatim>\\emph{\\\\\<^verbatim>\}\. diff -r 35d8132633c6 -r ebaed09ce06e src/Doc/Isar_Ref/Generic.thy --- a/src/Doc/Isar_Ref/Generic.thy Sat May 22 21:52:13 2021 +0200 +++ b/src/Doc/Isar_Ref/Generic.thy Sat May 22 22:58:10 2021 +0200 @@ -153,7 +153,7 @@ \<^descr> @{attribute THEN}~\a\ composes rules by resolution; it resolves with the first premise of \a\ (an alternative position may be also specified). See - also \<^ML_op>\RS\ in @{cite "isabelle-implementation"}. + also \<^ML_infix>\RS\ in @{cite "isabelle-implementation"}. \<^descr> @{attribute unfolded}~\a\<^sub>1 \ a\<^sub>n\ and @{attribute folded}~\a\<^sub>1 \ a\<^sub>n\ expand and fold back again the given definitions throughout a rule. diff -r 35d8132633c6 -r ebaed09ce06e src/Doc/Isar_Ref/Proof.thy --- a/src/Doc/Isar_Ref/Proof.thy Sat May 22 21:52:13 2021 +0200 +++ b/src/Doc/Isar_Ref/Proof.thy Sat May 22 22:58:10 2021 +0200 @@ -626,7 +626,7 @@ Structural composition ``\m\<^sub>1\\<^verbatim>\;\~\m\<^sub>2\'' means that method \m\<^sub>1\ is applied with restriction to the first subgoal, then \m\<^sub>2\ is applied consecutively with restriction to each subgoal that has newly emerged due to - \m\<^sub>1\. This is analogous to the tactic combinator \<^ML_op>\THEN_ALL_NEW\ in + \m\<^sub>1\. This is analogous to the tactic combinator \<^ML_infix>\THEN_ALL_NEW\ in Isabelle/ML, see also @{cite "isabelle-implementation"}. For example, \(rule r; blast)\ applies rule \r\ and then solves all new subgoals by \blast\. diff -r 35d8132633c6 -r ebaed09ce06e src/Doc/antiquote_setup.ML --- a/src/Doc/antiquote_setup.ML Sat May 22 21:52:13 2021 +0200 +++ b/src/Doc/antiquote_setup.ML Sat May 22 22:58:10 2021 +0200 @@ -33,94 +33,6 @@ | clean_name s = s |> translate (fn "_" => "-" | "\" => "-" | c => c); -(* ML text *) - -local - -fun test_val (ml1, []) = ML_Lex.read "fn _ => (" @ ml1 @ ML_Lex.read ");" - | test_val (ml1, ml2) = ML_Lex.read "fn _ => (" @ ml1 @ ML_Lex.read " : " @ ml2 @ ML_Lex.read ");"; - -fun test_op (ml1, ml2) = test_val (ML_Lex.read "op " @ ml1, ml2); - -fun test_type (ml1, []) = ML_Lex.read "val _ = NONE : (" @ ml1 @ ML_Lex.read ") option;" - | test_type (ml1, ml2) = - ML_Lex.read "val _ = [NONE : (" @ ml1 @ ML_Lex.read ") option, NONE : (" @ - ml2 @ ML_Lex.read ") option];"; - -fun text_exn (ml1, []) = ML_Lex.read "fn _ => (" @ ml1 @ ML_Lex.read " : exn);" - | text_exn (ml1, ml2) = - ML_Lex.read "fn _ => (" @ ml1 @ ML_Lex.read " : " @ ml2 @ ML_Lex.read " -> exn);"; - -fun test_struct (ml, _) = - ML_Lex.read "functor XXX() = struct structure XX = " @ ml @ ML_Lex.read " end;"; - -fun test_functor (Antiquote.Text tok :: _, _) = - ML_Lex.read "ML_Env.check_functor " @ - ML_Lex.read (ML_Syntax.print_string (ML_Lex.content_of tok)) - | test_functor _ = raise Fail "Bad ML functor specification"; - -val is_name = - ML_Lex.kind_of #> (fn kind => kind = ML_Lex.Ident orelse kind = ML_Lex.Long_Ident); - -fun is_ml_identifier ants = - forall Antiquote.is_text ants andalso - (case filter is_name (map (Antiquote.the_text "") ants) of - toks as [_] => Symbol_Pos.is_identifier (Long_Name.base_name (ML_Lex.flatten toks)) - | _ => false); - -val parse_ml = Args.text_input -- Scan.optional (Args.colon |-- Args.text_input) Input.empty; -val parse_type = Args.text_input -- Scan.optional (Args.$$$ "=" |-- Args.text_input) Input.empty; -val parse_exn = Args.text_input -- Scan.optional (Args.$$$ "of" |-- Args.text_input) Input.empty; -val parse_struct = Args.text_input >> rpair Input.empty; - -fun antiquotation_ml parse test kind show_kind binding index = - Document_Output.antiquotation_raw binding (Scan.lift parse) - (fn ctxt => fn (source1, source2) => - let - val (ml1, ml2) = apply2 ML_Lex.read_source (source1, source2); - val pos = Input.pos_of source1; - val _ = - ML_Context.eval_in (SOME ctxt) ML_Compiler.flags pos (test (ml1, ml2)) - handle ERROR msg => error (msg ^ Position.here pos); - - val (txt1, txt2) = apply2 (#1 o Input.source_content) (source1, source2); - val sep = if kind = "type" then "=" else if kind = "exception" then "of" else ":"; - val txt = - if txt2 = "" then txt1 - else if sep = ":" andalso is_ml_identifier ml1 then txt1 ^ ": " ^ txt2 - else txt1 ^ " " ^ sep ^ " " ^ txt2; - - val main_text = - Document_Output.verbatim ctxt - (if kind = "" orelse not show_kind then txt else kind ^ " " ^ txt); - - val index_text = - index |> Option.map (fn def => - let - val ctxt' = Config.put Document_Antiquotation.thy_output_display false ctxt; - val kind' = if kind = "" then " (ML)" else " (ML " ^ kind ^ ")"; - val txt' = Latex.block [Document_Output.verbatim ctxt' txt1, Latex.string kind']; - val like = Document_Antiquotation.approx_content ctxt source1; - in Latex.index_entry {items = [{text = txt', like = like}], def = def} end); - in Latex.block (the_list index_text @ [main_text]) end); - -fun antiquotation_ml' parse test kind binding = - antiquotation_ml parse test kind true binding (SOME true); - -in - -val _ = - Theory.setup - (antiquotation_ml' parse_ml test_val "" \<^binding>\define_ML\ #> - antiquotation_ml' parse_ml test_op "infix" \<^binding>\define_ML_infix\ #> - antiquotation_ml' parse_type test_type "type" \<^binding>\define_ML_type\ #> - antiquotation_ml' parse_exn text_exn "exception" \<^binding>\define_ML_exception\ #> - antiquotation_ml' parse_struct test_struct "structure" \<^binding>\define_ML_structure\ #> - antiquotation_ml' parse_struct test_functor "functor" \<^binding>\define_ML_functor\); - -end; - - (* named theorems *) val _ = diff -r 35d8132633c6 -r ebaed09ce06e src/Pure/Thy/document_antiquotations.ML --- a/src/Pure/Thy/document_antiquotations.ML Sat May 22 21:52:13 2021 +0200 +++ b/src/Pure/Thy/document_antiquotations.ML Sat May 22 22:58:10 2021 +0200 @@ -305,30 +305,97 @@ local -fun ml_text name ml = - Document_Output.antiquotation_verbatim_embedded name (Scan.lift Args.text_input) - (fn ctxt => fn text => - let val _ = ML_Context.eval_in (SOME ctxt) ML_Compiler.flags (Input.pos_of text) (ml text) - in #1 (Input.source_content text) end); +fun test_val (ml1, []) = ML_Lex.read "fn _ => (" @ ml1 @ ML_Lex.read ");" + | test_val (ml1, ml2) = ML_Lex.read "fn _ => (" @ ml1 @ ML_Lex.read " : " @ ml2 @ ML_Lex.read ");"; + +fun test_op (ml1, ml2) = test_val (ML_Lex.read "op " @ ml1, ml2); + +fun test_type (ml1, []) = ML_Lex.read "val _ = NONE : (" @ ml1 @ ML_Lex.read ") option;" + | test_type (ml1, ml2) = + ML_Lex.read "val _ = [NONE : (" @ ml1 @ ML_Lex.read ") option, NONE : (" @ + ml2 @ ML_Lex.read ") option];"; + +fun test_exn (ml1, []) = ML_Lex.read "fn _ => (" @ ml1 @ ML_Lex.read " : exn);" + | test_exn (ml1, ml2) = + ML_Lex.read "fn _ => (" @ ml1 @ ML_Lex.read " : " @ ml2 @ ML_Lex.read " -> exn);"; + +fun test_struct (ml, _) = + ML_Lex.read "functor XXX() = struct structure XX = " @ ml @ ML_Lex.read " end;"; + +fun test_functor (Antiquote.Text tok :: _, _) = + ML_Lex.read "ML_Env.check_functor " @ + ML_Lex.read (ML_Syntax.print_string (ML_Lex.content_of tok)) + | test_functor _ = raise Fail "Bad ML functor specification"; -fun ml_enclose bg en source = - ML_Lex.read bg @ ML_Lex.read_source source @ ML_Lex.read en; +val is_name = + ML_Lex.kind_of #> (fn kind => kind = ML_Lex.Ident orelse kind = ML_Lex.Long_Ident); + +fun is_ml_identifier ants = + forall Antiquote.is_text ants andalso + (case filter is_name (map (Antiquote.the_text "") ants) of + toks as [_] => Symbol_Pos.is_identifier (Long_Name.base_name (ML_Lex.flatten toks)) + | _ => false); + +val parse_ml0 = Args.text_input >> rpair Input.empty; +val parse_ml = Args.text_input -- Scan.optional (Args.colon |-- Args.text_input) Input.empty; +val parse_type = Args.text_input -- Scan.optional (Args.$$$ "=" |-- Args.text_input) Input.empty; +val parse_exn = Args.text_input -- Scan.optional (Args.$$$ "of" |-- Args.text_input) Input.empty; + +fun antiquotation_ml parse test kind show_kind binding index = + Document_Output.antiquotation_raw binding (Scan.lift parse) + (fn ctxt => fn (source1, source2) => + let + val (ml1, ml2) = apply2 ML_Lex.read_source (source1, source2); + val pos = Input.pos_of source1; + val _ = + ML_Context.eval_in (SOME ctxt) ML_Compiler.flags pos (test (ml1, ml2)) + handle ERROR msg => error (msg ^ Position.here pos); -val _ = Theory.setup - (ml_text \<^binding>\ML\ (ml_enclose "fn _ => (" ");") #> - ml_text \<^binding>\ML_op\ (ml_enclose "fn _ => (op " ");") #> - ml_text \<^binding>\ML_type\ (ml_enclose "val _ = NONE : (" ") option;") #> - ml_text \<^binding>\ML_structure\ - (ml_enclose "functor XXX() = struct structure XX = " " end;") #> + val (txt1, txt2) = apply2 (#1 o Input.source_content) (source1, source2); + val sep = if kind = "type" then "=" else if kind = "exception" then "of" else ":"; + val txt = + if txt2 = "" then txt1 + else if sep = ":" andalso is_ml_identifier ml1 then txt1 ^ ": " ^ txt2 + else txt1 ^ " " ^ sep ^ " " ^ txt2; + + val main_text = + Document_Output.verbatim ctxt + (if kind = "" orelse not show_kind then txt else kind ^ " " ^ txt); + + val index_text = + index |> Option.map (fn def => + let + val ctxt' = Config.put Document_Antiquotation.thy_output_display false ctxt; + val kind' = if kind = "" then " (ML)" else " (ML " ^ kind ^ ")"; + val txt' = Latex.block [Document_Output.verbatim ctxt' txt1, Latex.string kind']; + val like = Document_Antiquotation.approx_content ctxt source1; + in Latex.index_entry {items = [{text = txt', like = like}], def = def} end); + in Latex.block (the_list index_text @ [main_text]) end); - ml_text \<^binding>\ML_functor\ (* FIXME formal treatment of functor name (!?) *) - (fn source => - ML_Lex.read ("ML_Env.check_functor " ^ - ML_Syntax.print_string (#1 (Input.source_content source)))) #> +fun antiquotation_ml0 test kind = + antiquotation_ml parse_ml0 test kind false; + +fun antiquotation_ml1 parse test kind binding = + antiquotation_ml parse test kind true binding (SOME true); + +in - ml_text \<^binding>\ML_text\ (K [])); +val _ = + Theory.setup + (Latex.index_variants (antiquotation_ml0 test_val "") \<^binding>\ML\ #> + Latex.index_variants (antiquotation_ml0 test_op "infix") \<^binding>\ML_infix\ #> + Latex.index_variants (antiquotation_ml0 test_type "type") \<^binding>\ML_type\ #> + Latex.index_variants (antiquotation_ml0 test_struct "structure") \<^binding>\ML_structure\ #> + Latex.index_variants (antiquotation_ml0 test_functor "functor") \<^binding>\ML_functor\ #> + antiquotation_ml0 (K []) "text" \<^binding>\ML_text\ NONE #> + antiquotation_ml1 parse_ml test_val "" \<^binding>\define_ML\ #> + antiquotation_ml1 parse_ml test_op "infix" \<^binding>\define_ML_infix\ #> + antiquotation_ml1 parse_type test_type "type" \<^binding>\define_ML_type\ #> + antiquotation_ml1 parse_exn test_exn "exception" \<^binding>\define_ML_exception\ #> + antiquotation_ml1 parse_ml0 test_struct "structure" \<^binding>\define_ML_structure\ #> + antiquotation_ml1 parse_ml0 test_functor "functor" \<^binding>\define_ML_functor\); -in end; +end; (* URLs *)