27 parse_rules: (Ast.ast * Ast.ast) list, |
27 parse_rules: (Ast.ast * Ast.ast) list, |
28 parse_translation: (string * ((Proof.context -> term list -> term) * stamp)) list, |
28 parse_translation: (string * ((Proof.context -> term list -> term) * stamp)) list, |
29 print_translation: (string * ((Proof.context -> typ -> term list -> term) * stamp)) list, |
29 print_translation: (string * ((Proof.context -> typ -> term list -> term) * stamp)) list, |
30 print_rules: (Ast.ast * Ast.ast) list, |
30 print_rules: (Ast.ast * Ast.ast) list, |
31 print_ast_translation: (string * ((Proof.context -> Ast.ast list -> Ast.ast) * stamp)) list} |
31 print_ast_translation: (string * ((Proof.context -> Ast.ast list -> Ast.ast) * stamp)) list} |
32 val make_notation: {kind: string, name: string} -> string |
32 val block_annotation: int -> Markup.T -> string -> string |
33 val mfix_name: Proof.context -> Symbol_Pos.T list -> string |
33 val mfix_name: Proof.context -> Symbol_Pos.T list -> string |
34 val mfix_args: Proof.context -> Symbol_Pos.T list -> int |
34 val mfix_args: Proof.context -> Symbol_Pos.T list -> int |
35 val mixfix_args: Proof.context -> Input.source -> int |
35 val mixfix_args: Proof.context -> Input.source -> int |
36 val escape: string -> string |
36 val escape: string -> string |
37 val syn_ext: Proof.context -> string list -> mfix list -> |
37 val syn_ext: Proof.context -> string list -> mfix list -> |
121 datatype mfix = Mfix of Symbol_Pos.T list * typ * string * int list * int * Position.T; |
121 datatype mfix = Mfix of Symbol_Pos.T list * typ * string * int list * int * Position.T; |
122 |
122 |
123 |
123 |
124 (* properties *) |
124 (* properties *) |
125 |
125 |
126 fun make_notation {kind, name} = |
126 fun block_annotation indent notation_markup notation_name = |
127 Properties.print_eq (Markup.notationN, cartouche (implode_space (remove (op =) "" [kind, name]))); |
127 let |
|
128 val (elem, props) = notation_markup |> notation_name <> "" ? Markup.name notation_name; |
|
129 val kind = Properties.get props Markup.kindN; |
|
130 val name = Properties.get props Markup.nameN; |
|
131 val s1 = if indent = 0 then [] else ["indent=" ^ Value.print_int indent]; |
|
132 val s2 = |
|
133 if elem = Markup.notationN then |
|
134 [Properties.print_eq (elem, cartouche (implode_space (the_list kind @ the_list name)))] |
|
135 else raise Fail ("Bad markup element for notatio: " ^ quote elem) |
|
136 in cartouche (implode_space (s1 @ s2)) end; |
128 |
137 |
129 fun show_names names = |
138 fun show_names names = |
130 commas_quote (map (fn (name, pos) => Markup.markup (Position.markup pos) name) names); |
139 commas_quote (map (fn (name, pos) => Markup.markup (Position.markup pos) name) names); |
131 |
140 |
132 local |
141 local |
155 | SOME (_, NONE) => default1 |
164 | SOME (_, NONE) => default1 |
156 | SOME ((_, pos1), SOME (b, pos2)) => |
165 | SOME ((_, pos1), SOME (b, pos2)) => |
157 (parse (b, pos2) handle Fail msg => |
166 (parse (b, pos2) handle Fail msg => |
158 error (msg ^ " for property " ^ quote name ^ Position.here_list [pos1, pos2]))); |
167 error (msg ^ " for property " ^ quote name ^ Position.here_list [pos1, pos2]))); |
159 |
168 |
160 fun parse_notation (s, pos) = |
169 fun parse_notation ctxt (s, pos) = |
161 let |
170 let |
162 val (kind, name) = |
171 val (kind, name) = |
163 (case Symbol.explode_words s of |
172 (case Symbol.explode_words s of |
164 [] => ("", "") |
173 [] => ("", "") |
165 | a :: bs => (a, space_implode " " bs)); |
174 | a :: bs => (a, space_implode " " bs)); |
166 in |
175 val markup = |
167 if kind = "" orelse member (op =) Markup.notations kind then |
176 (case try (fn () => Markup_Kind.check_notation ctxt (kind, Position.none)) () of |
168 Markup.notation {kind = kind, name = name} |
177 SOME m => m |
169 else |
178 | NONE => |
170 error ("Bad notation kind " ^ quote kind ^ Position.here pos ^ |
179 error ("Bad notation kind " ^ quote kind ^ Position.here pos ^ |
171 ", expected: " ^ commas_quote Markup.notations) |
180 ", expected: " ^ commas_quote (Markup_Kind.get_notation_kinds ctxt))); |
172 end; |
181 in markup |> Markup.properties (Markup.name_proper name) end; |
173 |
182 |
174 in |
183 in |
175 |
184 |
176 fun read_properties ss = |
185 fun read_properties ss = |
177 let |
186 let |
188 |
197 |
189 val get_string = get_property "" "" #1; |
198 val get_string = get_property "" "" #1; |
190 val get_bool = get_property false true (Value.parse_bool o #1); |
199 val get_bool = get_property false true (Value.parse_bool o #1); |
191 val get_nat = get_property 0 1 (Value.parse_nat o #1); |
200 val get_nat = get_property 0 1 (Value.parse_nat o #1); |
192 |
201 |
193 val get_notation_markup = |
202 fun get_notation_markup ctxt = |
194 get_property NONE (SOME Markup.notation0) (SOME o parse_notation) Markup.notationN; |
203 get_property NONE (SOME Markup.notation0) (SOME o parse_notation ctxt) Markup.notationN; |
195 |
204 |
196 fun get_expression_markup ctxt = |
205 fun get_expression_markup ctxt = |
197 get_property NONE (SOME Markup.expression0) (SOME o Markup_Kind.check_expression ctxt) |
206 get_property NONE (SOME Markup.expression0) (SOME o Markup_Kind.check_expression ctxt) |
198 Markup.expressionN; |
207 Markup.expressionN; |
199 |
208 |
240 fun read_block_properties ctxt ss = |
249 fun read_block_properties ctxt ss = |
241 let |
250 let |
242 val props = read_properties ss; |
251 val props = read_properties ss; |
243 |
252 |
244 val more_markups = |
253 val more_markups = |
245 the_list (get_notation_markup props) @ |
254 the_list (get_notation_markup ctxt props) @ |
246 the_list (get_expression_markup ctxt props); |
255 the_list (get_expression_markup ctxt props); |
247 |
256 |
248 val markup_name = get_string Markup.markupN props; |
257 val markup_name = get_string Markup.markupN props; |
249 val markup_props = props |> map_filter (fn (a, opt_b) => |
258 val markup_props = props |> map_filter (fn (a, opt_b) => |
250 if member (op =) Markup.block_properties (#1 a) then NONE |
259 if member (op =) Markup.block_properties (#1 a) then NONE |