ProgTutorial/antiquote_setup.ML
changeset 256 1fb8d62c88a0
parent 255 ef1da1abee46
child 258 03145998190b
--- 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