71 (** abstract nonsense **) |
71 (** abstract nonsense **) |
72 |
72 |
73 datatype destination = Export of Path.T option | Produce | Present of string list; |
73 datatype destination = Export of Path.T option | Produce | Present of string list; |
74 type serialization = int -> destination -> (string * (string -> string option)) option; |
74 type serialization = int -> destination -> (string * (string -> string option)) option; |
75 |
75 |
76 fun using_plain_output f x = Print_Mode.setmp [] f x; |
|
77 |
|
78 fun serialization output _ content width (Export some_path) = |
76 fun serialization output _ content width (Export some_path) = |
79 (using_plain_output (output width some_path) content; NONE) |
77 (output width some_path content; NONE) |
80 | serialization _ string content width Produce = |
78 | serialization _ string content width Produce = |
81 SOME (using_plain_output (string [] width) content) |
79 string [] width content |> SOME |
82 | serialization _ string content width (Present stmt_names) = |
80 | serialization _ string content width (Present stmt_names) = |
83 SOME (using_plain_output (string stmt_names width) content); |
81 string stmt_names width content |
84 |
82 |> apfst (Pretty.output (SOME width) o Pretty.str) |
85 fun export some_path serializer naming program names = |
83 |> SOME; |
86 (using_plain_output (serializer naming program) names (Export some_path); ()); |
84 |
87 fun produce serializer naming program names = |
85 fun export some_path f = (f (Export some_path); ()); |
88 the (using_plain_output (serializer naming program) names Produce); |
86 fun produce f = the (f Produce); |
89 fun present stmt_names serializer naming program names = |
87 fun present stmt_names f = fst (the (f (Present stmt_names))); |
90 fst (the (using_plain_output (serializer naming program) names (Present stmt_names))); |
|
91 |
88 |
92 |
89 |
93 (** theory data **) |
90 (** theory data **) |
94 |
91 |
95 datatype symbol_syntax_data = Symbol_Syntax_Data of { |
92 datatype symbol_syntax_data = Symbol_Syntax_Data of { |
357 | assert_module_name module_name = module_name; |
354 | assert_module_name module_name = module_name; |
358 |
355 |
359 in |
356 in |
360 |
357 |
361 fun export_code_for thy some_path target some_width module_name args = |
358 fun export_code_for thy some_path target some_width module_name args = |
362 export some_path (mount_serializer thy target some_width module_name args); |
359 export some_path ooo mount_serializer thy target some_width module_name args; |
363 |
360 |
364 fun produce_code_for thy target some_width module_name args = |
361 fun produce_code_for thy target some_width module_name args = |
365 let |
362 let |
366 val serializer = mount_serializer thy target some_width (assert_module_name module_name) args; |
363 val serializer = mount_serializer thy target some_width (assert_module_name module_name) args; |
367 in fn naming => fn program => fn names => |
364 in fn naming => fn program => fn names => |
368 produce serializer naming program names |> apsnd (fn deresolve => map deresolve names) |
365 produce (serializer naming program names) |> apsnd (fn deresolve => map deresolve names) |
369 end; |
366 end; |
370 |
367 |
371 fun present_code_for thy target some_width module_name args = |
368 fun present_code_for thy target some_width module_name args = |
372 let |
369 let |
373 val serializer = mount_serializer thy target some_width (assert_module_name module_name) args; |
370 val serializer = mount_serializer thy target some_width (assert_module_name module_name) args; |
374 in fn naming => fn program => fn (names, selects) => |
371 in fn naming => fn program => fn (names, selects) => |
375 present selects serializer naming program names |
372 present selects (serializer naming program names) |
376 end; |
373 end; |
377 |
374 |
378 fun check_code_for thy target strict args naming program names_cs = |
375 fun check_code_for thy target strict args naming program names_cs = |
379 let |
376 let |
380 val module_name = "Code"; |
377 val module_name = "Code"; |
383 val env_param = getenv env_var; |
380 val env_param = getenv env_var; |
384 fun ext_check env_param p = |
381 fun ext_check env_param p = |
385 let |
382 let |
386 val destination = make_destination p; |
383 val destination = make_destination p; |
387 val _ = export (SOME destination) (mount_serializer thy target (SOME 80) |
384 val _ = export (SOME destination) (mount_serializer thy target (SOME 80) |
388 module_name args) naming program names_cs; |
385 module_name args naming program names_cs); |
389 val cmd = make_command env_param module_name; |
386 val cmd = make_command env_param module_name; |
390 in if bash ("cd " ^ File.shell_path p ^ " && " ^ cmd ^ " 2>&1") <> 0 |
387 in if bash ("cd " ^ File.shell_path p ^ " && " ^ cmd ^ " 2>&1") <> 0 |
391 then error ("Code check failed for " ^ target ^ ": " ^ cmd) |
388 then error ("Code check failed for " ^ target ^ ": " ^ cmd) |
392 else () |
389 else () |
393 end; |
390 end; |
481 (fn {context = ctxt, ...} => fn ((mk_cs, mk_stmtss), (target, some_width)) => |
478 (fn {context = ctxt, ...} => fn ((mk_cs, mk_stmtss), (target, some_width)) => |
482 let val thy = ProofContext.theory_of ctxt in |
479 let val thy = ProofContext.theory_of ctxt in |
483 present_code thy (mk_cs thy) |
480 present_code thy (mk_cs thy) |
484 (fn naming => maps (fn f => f thy naming) mk_stmtss) |
481 (fn naming => maps (fn f => f thy naming) mk_stmtss) |
485 target some_width "Example" [] |
482 target some_width "Example" [] |
486 |> Latex.output_typewriter |
483 (*|> Latex.output_typewriter*) |
487 end); |
484 end); |
488 |
485 |
489 end; |
486 end; |
490 |
487 |
491 |
488 |