diff -r ef1da1abee46 -r 1fb8d62c88a0 ProgTutorial/antiquote_setup.ML --- a/ProgTutorial/antiquote_setup.ML Sat May 30 11:12:46 2009 +0200 +++ b/ProgTutorial/antiquote_setup.ML Sat May 30 17:40:20 2009 +0200 @@ -1,10 +1,12 @@ (* Auxiliary antiquotations for the tutorial. *) -structure AntiquoteSetup: sig end = +structure AntiquoteSetup = struct +open OutputTutorial + (* functions for generating appropriate expressions *) -fun ml_val_open (ys, xs) txt = +fun ml_val_open ys xs txt = let fun ml_val_open_aux ys txt = "fn " ^ (case ys of [] => "_" | _ => enclose "(" ")" (commas ys)) ^ " => (" ^ txt ^ ")"; in @@ -13,7 +15,7 @@ | _ => ml_val_open_aux ys ("let open " ^ (space_implode " " xs) ^ " in " ^ txt ^ " end")) end; -fun ml_val txt = ml_val_open ([],[]) txt; +fun ml_val txt = ml_val_open [] [] txt; fun ml_pat (lhs, pat) = let @@ -28,8 +30,8 @@ ML_Context.eval_in (SOME ctxt) false Position.none exp (* string functions *) -fun string_explode str txt = - map (fn s => str ^ s) (space_explode "\n" txt) +fun string_explode prefix_str txt = + map (fn s => prefix_str ^ s) (split_lines txt) val transform_cmts_str = Source.of_string @@ -37,45 +39,49 @@ #> Source.exhaust #> Chunks.transform_cmts #> implode - #> string_explode ""; - -(* output function *) -fun output_fn txt = OutputFN.output txt + #> string_explode "" (* checks and prints open expressions *) -fun output_ml {context = ctxt, ...} (txt, ovars) = - (eval_fn ctxt (ml_val_open ovars txt); - output_fn (transform_cmts_str txt)) +fun output_ml {context = ctxt, ...} (txt, (ovars, structs)) = + (eval_fn ctxt (ml_val_open ovars structs txt); + if structs = [] + then output_indexed (transform_cmts_str txt) {main = Code txt, minor = ""} + else output_indexed (transform_cmts_str txt) + {main = Code txt, minor = ("in {\\tt\\slshape{}" ^ (implode structs) ^ "}")}) val parser_ml = Scan.lift (Args.name -- (Scan.optional (Args.$$$ "for" |-- OuterParse.!!! (Scan.repeat1 Args.name)) [] -- Scan.optional (Args.$$$ "in" |-- OuterParse.!!! (Scan.repeat1 Args.name)) [])) (* checks and prints types and structures *) -fun output_exp ml {context = ctxt, ...} txt = - (eval_fn ctxt (ml txt); - output_fn (string_explode "" txt)) +fun output_struct {context = ctxt, ...} txt = + (eval_fn ctxt (ml_struct txt); + output_indexed (string_explode "" txt) {main = Code txt, minor = "structure"}) + +fun output_type {context = ctxt, ...} txt = + (eval_fn ctxt (ml_type txt); + output_indexed (string_explode "" txt) {main = Code txt, minor = "type"}) (* checks and expression agains a result pattern *) fun output_response {context = ctxt, ...} (lhs, pat) = (eval_fn ctxt (ml_pat (lhs, pat)); - output_fn ((string_explode "" lhs) @ (string_explode "> " pat))) + output ((string_explode "" lhs) @ (string_explode "> " pat))) (* checks the expressions, but does not check it against a result pattern *) fun output_response_fake {context = ctxt, ...} (lhs, pat) = (eval_fn ctxt (ml_val lhs); - output_fn ((string_explode "" lhs) @ (string_explode "> " pat))) + output ((string_explode "" lhs) @ (string_explode "> " pat))) (* checks the expressions, but does not check it against a result pattern *) fun ouput_response_fake_both _ (lhs, pat) = - output_fn ((string_explode "" lhs) @ (string_explode "> " pat)) + output ((string_explode "" lhs) @ (string_explode "> " pat)) val single_arg = Scan.lift (Args.name) val two_args = Scan.lift (Args.name -- Args.name) val _ = ThyOutput.antiquotation "ML" parser_ml output_ml -val _ = ThyOutput.antiquotation "ML_type" single_arg (output_exp ml_type) -val _ = ThyOutput.antiquotation "ML_struct" single_arg (output_exp ml_struct) +val _ = ThyOutput.antiquotation "ML_type" single_arg output_type +val _ = ThyOutput.antiquotation "ML_struct" single_arg output_struct val _ = ThyOutput.antiquotation "ML_response" two_args output_response val _ = ThyOutput.antiquotation "ML_response_fake" two_args output_response_fake val _ = ThyOutput.antiquotation "ML_response_fake_both" two_args ouput_response_fake_both @@ -91,7 +97,7 @@ (* checks whether a file exists in the Isabelle distribution *) fun check_file_exists _ txt = (if File.exists (Path.append (Path.explode ("~~/src")) (Path.explode txt)) - then output_fn [href_link txt] + then output [href_link txt] else error ("Source file " ^ (quote txt) ^ " does not exist.")) val _ = ThyOutput.antiquotation "ML_file" single_arg check_file_exists