ML runtime compilation: pass position, tuned signature;
authorwenzelm
Mon Mar 24 23:34:24 2008 +0100 (2008-03-24)
changeset 26385ae7564661e76
parent 26384 0aed2ba71388
child 26386 9c806de22a6a
ML runtime compilation: pass position, tuned signature;
doc-src/antiquote_setup.ML
src/Pure/General/secure.ML
src/Pure/Isar/isar_cmd.ML
src/Pure/Isar/isar_syn.ML
src/Pure/Isar/method.ML
src/Pure/ML-Systems/alice.ML
src/Pure/ML-Systems/polyml.ML
src/Pure/ML-Systems/polyml_old_compiler4.ML
src/Pure/ML-Systems/polyml_old_compiler5.ML
src/Pure/ML-Systems/smlnj.ML
src/Pure/ML/ml_context.ML
src/Pure/Thy/thy_output.ML
src/Pure/codegen.ML
src/Tools/Compute_Oracle/am_compiler.ML
src/Tools/Compute_Oracle/am_sml.ML
src/Tools/code/code_target.ML
     1.1 --- a/doc-src/antiquote_setup.ML	Mon Mar 24 18:44:21 2008 +0100
     1.2 +++ b/doc-src/antiquote_setup.ML	Mon Mar 24 23:34:24 2008 +0100
     1.3 @@ -36,7 +36,7 @@
     1.4        else txt1 ^ ": " ^ txt2;
     1.5      val txt' = if kind = "" then txt else kind ^ " " ^ txt;
     1.6      val _ = writeln (ml (txt1, txt2));
     1.7 -    val _ = ML_Context.use_mltext (ml (txt1, txt2)) false (SOME (Context.Proof ctxt));
     1.8 +    val _ = ML_Context.use_mltext false Position.none (ml (txt1, txt2)) (SOME (Context.Proof ctxt));
     1.9    in
    1.10      "\\indexml" ^ kind ^ enclose "{" "}"
    1.11        (translate_string (fn "_" => "-" | ">" => "$>$" | "#" => "\\#" | c => c) txt1) ^
     2.1 --- a/src/Pure/General/secure.ML	Mon Mar 24 18:44:21 2008 +0100
     2.2 +++ b/src/Pure/General/secure.ML	Mon Mar 24 23:34:24 2008 +0100
     2.3 @@ -10,7 +10,7 @@
     2.4    val set_secure: unit -> unit
     2.5    val is_secure: unit -> bool
     2.6    val deny_secure: string -> unit
     2.7 -  val use_text: string -> (string -> unit) * (string -> 'a) -> bool -> string -> unit
     2.8 +  val use_text: int * string -> (string -> unit) * (string -> 'a) -> bool -> string -> unit
     2.9    val use_file: (string -> unit) * (string -> 'a) -> bool -> string -> unit
    2.10    val use: string -> unit
    2.11    val commit: unit -> unit
    2.12 @@ -41,8 +41,8 @@
    2.13  fun orig_use_text x = use_text ML_Parse.fix_ints x;
    2.14  fun orig_use_file x = use_file ML_Parse.fix_ints x;
    2.15  
    2.16 -fun use_text name pr verbose txt =
    2.17 -  (secure_mltext (); orig_use_text name pr verbose txt);
    2.18 +fun use_text pos pr verbose txt =
    2.19 +  (secure_mltext (); orig_use_text pos pr verbose txt);
    2.20  
    2.21  fun use_file pr verbose name =
    2.22    (secure_mltext (); orig_use_file pr verbose name);
    2.23 @@ -50,7 +50,7 @@
    2.24  fun use name = use_file Output.ml_output true name;
    2.25  
    2.26  (*commit is dynamically bound!*)
    2.27 -fun commit () = orig_use_text "" Output.ml_output false "commit();";
    2.28 +fun commit () = orig_use_text (0, "") Output.ml_output false "commit();";
    2.29  
    2.30  
    2.31  (* shell commands *)
     3.1 --- a/src/Pure/Isar/isar_cmd.ML	Mon Mar 24 18:44:21 2008 +0100
     3.2 +++ b/src/Pure/Isar/isar_cmd.ML	Mon Mar 24 23:34:24 2008 +0100
     3.3 @@ -7,20 +7,21 @@
     3.4  
     3.5  signature ISAR_CMD =
     3.6  sig
     3.7 -  val generic_setup: string option -> theory -> theory
     3.8 -  val parse_ast_translation: bool * string -> theory -> theory
     3.9 -  val parse_translation: bool * string -> theory -> theory
    3.10 -  val print_translation: bool * string -> theory -> theory
    3.11 -  val typed_print_translation: bool * string -> theory -> theory
    3.12 -  val print_ast_translation: bool * string -> theory -> theory
    3.13 -  val token_translation: string -> theory -> theory
    3.14 -  val oracle: bstring -> string -> string -> theory -> theory
    3.15 +  val generic_setup: (string * Position.T) option -> theory -> theory
    3.16 +  val parse_ast_translation: bool * (string * Position.T) -> theory -> theory
    3.17 +  val parse_translation: bool * (string * Position.T) -> theory -> theory
    3.18 +  val print_translation: bool * (string * Position.T) -> theory -> theory
    3.19 +  val typed_print_translation: bool * (string * Position.T) -> theory -> theory
    3.20 +  val print_ast_translation: bool * (string * Position.T) -> theory -> theory
    3.21 +  val token_translation: string * Position.T -> theory -> theory
    3.22 +  val oracle: bstring -> string -> string * Position.T -> theory -> theory
    3.23    val add_axioms: ((bstring * string) * Attrib.src list) list -> theory -> theory
    3.24    val add_defs: (bool * bool) * ((bstring * string) * Attrib.src list) list -> theory -> theory
    3.25    val apply_theorems: (Facts.ref * Attrib.src list) list -> theory -> thm list * theory
    3.26    val apply_theorems_i: (thm list * attribute list) list -> theory -> thm list * theory
    3.27 -  val declaration: string -> local_theory -> local_theory
    3.28 -  val simproc_setup: string -> string list -> string -> string list -> local_theory -> local_theory
    3.29 +  val declaration: string * Position.T -> local_theory -> local_theory
    3.30 +  val simproc_setup: string -> string list -> string * Position.T -> string list ->
    3.31 +    local_theory -> local_theory
    3.32    val have: ((string * Attrib.src list) * (string * string list) list) list ->
    3.33      bool -> Proof.state -> Proof.state
    3.34    val hence: ((string * Attrib.src list) * (string * string list) list) list ->
    3.35 @@ -62,8 +63,8 @@
    3.36    val kill: Toplevel.transition -> Toplevel.transition
    3.37    val back: Toplevel.transition -> Toplevel.transition
    3.38    val use: Path.T -> Toplevel.transition -> Toplevel.transition
    3.39 -  val use_mltext_theory: string -> Toplevel.transition -> Toplevel.transition
    3.40 -  val use_mltext: bool -> string -> Toplevel.transition -> Toplevel.transition
    3.41 +  val use_mltext_theory: string * Position.T -> Toplevel.transition -> Toplevel.transition
    3.42 +  val use_mltext: bool -> string * Position.T -> Toplevel.transition -> Toplevel.transition
    3.43    val use_commit: Toplevel.transition -> Toplevel.transition
    3.44    val nested_command: Markup.property list -> string * Position.T -> Toplevel.transition
    3.45    val cd: Path.T -> Toplevel.transition -> Toplevel.transition
    3.46 @@ -135,8 +136,8 @@
    3.47  (* generic_setup *)
    3.48  
    3.49  fun generic_setup NONE = (fn thy => thy |> Context.setup ())
    3.50 -  | generic_setup (SOME txt) =
    3.51 -      ML_Context.use_let "val setup: theory -> theory" "Context.map_theory setup" txt
    3.52 +  | generic_setup (SOME (txt, pos)) =
    3.53 +      ML_Context.use_let pos "val setup: theory -> theory" "Context.map_theory setup" txt
    3.54        |> Context.theory_map;
    3.55  
    3.56  
    3.57 @@ -152,50 +153,51 @@
    3.58  
    3.59  in
    3.60  
    3.61 -fun parse_ast_translation (a, txt) =
    3.62 -  txt |> ML_Context.use_let ("val parse_ast_translation: (string * (" ^ advancedT a ^
    3.63 +fun parse_ast_translation (a, (txt, pos)) =
    3.64 +  txt |> ML_Context.use_let pos ("val parse_ast_translation: (string * (" ^ advancedT a ^
    3.65        "Syntax.ast list -> Syntax.ast)) list")
    3.66      ("Context.map_theory (Sign.add_" ^ advancedN a ^ "trfuns (parse_ast_translation, [], [], []))")
    3.67    |> Context.theory_map;
    3.68  
    3.69 -fun parse_translation (a, txt) =
    3.70 -  txt |> ML_Context.use_let ("val parse_translation: (string * (" ^ advancedT a ^
    3.71 +fun parse_translation (a, (txt, pos)) =
    3.72 +  txt |> ML_Context.use_let pos ("val parse_translation: (string * (" ^ advancedT a ^
    3.73        "term list -> term)) list")
    3.74      ("Context.map_theory (Sign.add_" ^ advancedN a ^ "trfuns ([], parse_translation, [], []))")
    3.75    |> Context.theory_map;
    3.76  
    3.77 -fun print_translation (a, txt) =
    3.78 -  txt |> ML_Context.use_let ("val print_translation: (string * (" ^ advancedT a ^
    3.79 +fun print_translation (a, (txt, pos)) =
    3.80 +  txt |> ML_Context.use_let pos ("val print_translation: (string * (" ^ advancedT a ^
    3.81        "term list -> term)) list")
    3.82      ("Context.map_theory (Sign.add_" ^ advancedN a ^ "trfuns ([], [], print_translation, []))")
    3.83    |> Context.theory_map;
    3.84  
    3.85 -fun print_ast_translation (a, txt) =
    3.86 -  txt |> ML_Context.use_let ("val print_ast_translation: (string * (" ^ advancedT a ^
    3.87 +fun print_ast_translation (a, (txt, pos)) =
    3.88 +  txt |> ML_Context.use_let pos ("val print_ast_translation: (string * (" ^ advancedT a ^
    3.89        "Syntax.ast list -> Syntax.ast)) list")
    3.90      ("Context.map_theory (Sign.add_" ^ advancedN a ^ "trfuns ([], [], [], print_ast_translation))")
    3.91    |> Context.theory_map;
    3.92  
    3.93 -fun typed_print_translation (a, txt) =
    3.94 -  txt |> ML_Context.use_let ("val typed_print_translation: (string * (" ^ advancedT a ^
    3.95 +fun typed_print_translation (a, (txt, pos)) =
    3.96 +  txt |> ML_Context.use_let pos ("val typed_print_translation: (string * (" ^ advancedT a ^
    3.97        "bool -> typ -> term list -> term)) list")
    3.98      ("Context.map_theory (Sign.add_" ^ advancedN a ^ "trfunsT typed_print_translation)")
    3.99    |> Context.theory_map;
   3.100  
   3.101 -val token_translation =
   3.102 -  ML_Context.use_let "val token_translation: (string * string * (string -> output * int)) list"
   3.103 -    "Context.map_theory (Sign.add_tokentrfuns token_translation)"
   3.104 -  #> Context.theory_map;
   3.105 +fun token_translation (txt, pos) =
   3.106 +  txt |> ML_Context.use_let pos
   3.107 +    "val token_translation: (string * string * (string -> output * int)) list"
   3.108 +      "Context.map_theory (Sign.add_tokentrfuns token_translation)"
   3.109 +  |> Context.theory_map;
   3.110  
   3.111  end;
   3.112  
   3.113  
   3.114  (* oracles *)
   3.115  
   3.116 -fun oracle name typ oracle =
   3.117 +fun oracle name typ (oracle, pos) =
   3.118    let val txt =
   3.119 -    "local\n\
   3.120 -    \  type T = " ^ typ ^ ";\n\
   3.121 +    "local\
   3.122 +    \  type T = " ^ typ ^ ";\
   3.123      \  val oracle: theory -> T -> term = " ^ oracle ^ ";\n\
   3.124      \  val name = " ^ quote name ^ ";\n\
   3.125      \  exception Arg of T;\n\
   3.126 @@ -205,7 +207,7 @@
   3.127      \in\n\
   3.128      \  fun " ^ name ^ " thy x = invoke_" ^ name ^ " (thy, Arg x);\n\
   3.129      \end;\n";
   3.130 -  in ML_Context.use_mltext_update txt false end
   3.131 +  in ML_Context.use_mltext_update false pos txt end
   3.132    |> Context.theory_map;
   3.133  
   3.134  
   3.135 @@ -232,16 +234,16 @@
   3.136  
   3.137  (* declarations *)
   3.138  
   3.139 -val declaration =
   3.140 -  ML_Context.use_let "val declaration: Morphism.declaration"
   3.141 +fun declaration (txt, pos) =
   3.142 +  txt |> ML_Context.use_let pos "val declaration: Morphism.declaration"
   3.143      "Context.map_proof (LocalTheory.declaration declaration)"
   3.144 -  #> Context.proof_map;
   3.145 +  |> Context.proof_map;
   3.146  
   3.147  
   3.148  (* simprocs *)
   3.149  
   3.150 -fun simproc_setup name lhss proc identifier =
   3.151 -  ML_Context.use_let
   3.152 +fun simproc_setup name lhss (proc, pos) identifier =
   3.153 +  ML_Context.use_let pos
   3.154      "val proc: Morphism.morphism -> Simplifier.simpset -> cterm -> thm option"
   3.155    ("Context.map_proof (Simplifier.def_simproc {name = " ^ ML_Syntax.print_string name ^ ", \
   3.156      \lhss = " ^ ML_Syntax.print_strings lhss ^ ", proc = proc, \
   3.157 @@ -382,11 +384,12 @@
   3.158    ML_Context.setmp (try Toplevel.generic_theory_of state) (ThyInfo.load_file false) path);
   3.159  
   3.160  (*passes changes of theory context*)
   3.161 -val use_mltext_theory = Toplevel.theory' o (Context.theory_map oo ML_Context.use_mltext_update);
   3.162 +fun use_mltext_theory (txt, pos) =
   3.163 +  Toplevel.theory' (fn int => Context.theory_map (ML_Context.use_mltext_update int pos txt));
   3.164  
   3.165  (*ignore result theory context*)
   3.166 -fun use_mltext verbose txt = Toplevel.keep' (fn int => fn state =>
   3.167 -  (ML_Context.use_mltext txt (verbose andalso int) (try Toplevel.generic_theory_of state)));
   3.168 +fun use_mltext verbose (txt, pos) = Toplevel.keep' (fn int => fn state =>
   3.169 +  (ML_Context.use_mltext (verbose andalso int) pos txt (try Toplevel.generic_theory_of state)));
   3.170  
   3.171  val use_commit = Toplevel.imperative Secure.commit;
   3.172  
     4.1 --- a/src/Pure/Isar/isar_syn.ML	Mon Mar 24 18:44:21 2008 +0100
     4.2 +++ b/src/Pure/Isar/isar_syn.ML	Mon Mar 24 23:34:24 2008 +0100
     4.3 @@ -307,41 +307,41 @@
     4.4  
     4.5  val _ =
     4.6    OuterSyntax.command "ML" "eval ML text (diagnostic)" (K.tag_ml K.diag)
     4.7 -    (P.text >> IsarCmd.use_mltext true);
     4.8 +    (P.position P.text >> IsarCmd.use_mltext true);
     4.9  
    4.10  val _ =
    4.11    OuterSyntax.command "ML_command" "eval ML text" (K.tag_ml K.diag)
    4.12 -    (P.text >> (Toplevel.no_timing oo IsarCmd.use_mltext false));
    4.13 +    (P.position P.text >> (Toplevel.no_timing oo IsarCmd.use_mltext false));
    4.14  
    4.15  val _ =
    4.16    OuterSyntax.command "ML_setup" "eval ML text (may change theory)" (K.tag_ml K.thy_decl)
    4.17 -    (P.text >> IsarCmd.use_mltext_theory);
    4.18 +    (P.position P.text >> IsarCmd.use_mltext_theory);
    4.19  
    4.20  val _ =
    4.21    OuterSyntax.command "setup" "apply ML theory setup" (K.tag_ml K.thy_decl)
    4.22 -    (Scan.option P.text >> (Toplevel.theory o IsarCmd.generic_setup));
    4.23 +    (Scan.option (P.position P.text) >> (Toplevel.theory o IsarCmd.generic_setup));
    4.24  
    4.25  val _ =
    4.26    OuterSyntax.command "method_setup" "define proof method in ML" (K.tag_ml K.thy_decl)
    4.27 -    (((P.name -- P.!!! (P.$$$ "=" |-- P.text -- P.text) >> P.triple2))
    4.28 -      >> (Toplevel.theory o Method.method_setup));
    4.29 +    (P.name -- P.!!! (P.$$$ "=" |-- P.position P.text -- P.text)
    4.30 +    >> (fn (name, (txt, cmt)) => Toplevel.theory (Method.method_setup name txt cmt)));
    4.31  
    4.32  val _ =
    4.33    OuterSyntax.command "declaration" "generic ML declaration" (K.tag_ml K.thy_decl)
    4.34 -    (P.opt_target -- P.text
    4.35 +    (P.opt_target -- P.position P.text
    4.36      >> (fn (loc, txt) => Toplevel.local_theory loc (IsarCmd.declaration txt)));
    4.37  
    4.38  val _ =
    4.39    OuterSyntax.command "simproc_setup" "define simproc in ML" (K.tag_ml K.thy_decl)
    4.40      (P.opt_target --
    4.41 -      P.name -- (P.$$$ "(" |-- P.enum1 "|" P.term --| P.$$$ ")" --| P.$$$ "=") -- P.text --
    4.42 -      Scan.optional (P.$$$ "identifier" |-- Scan.repeat1 P.xname) []
    4.43 +      P.name -- (P.$$$ "(" |-- P.enum1 "|" P.term --| P.$$$ ")" --| P.$$$ "=") --
    4.44 +      P.position P.text -- Scan.optional (P.$$$ "identifier" |-- Scan.repeat1 P.xname) []
    4.45      >> (fn ((((loc, a), b), c), d) => Toplevel.local_theory loc (IsarCmd.simproc_setup a b c d)));
    4.46  
    4.47  
    4.48  (* translation functions *)
    4.49  
    4.50 -val trfun = P.opt_keyword "advanced" -- P.text;
    4.51 +val trfun = P.opt_keyword "advanced" -- P.position P.text;
    4.52  
    4.53  val _ =
    4.54    OuterSyntax.command "parse_ast_translation" "install parse ast translation functions"
    4.55 @@ -371,7 +371,7 @@
    4.56  val _ =
    4.57    OuterSyntax.command "token_translation" "install token translation functions"
    4.58      (K.tag_ml K.thy_decl)
    4.59 -    (P.text >> (Toplevel.theory o IsarCmd.token_translation));
    4.60 +    (P.position P.text >> (Toplevel.theory o IsarCmd.token_translation));
    4.61  
    4.62  
    4.63  (* oracles *)
    4.64 @@ -379,7 +379,7 @@
    4.65  val _ =
    4.66    OuterSyntax.command "oracle" "declare oracle" (K.tag_ml K.thy_decl)
    4.67      (P.name -- (P.$$$ "(" |-- P.text --| P.$$$ ")" --| P.$$$ "=")
    4.68 -      -- P.text >> (fn ((x, y), z) => Toplevel.theory (IsarCmd.oracle x y z)));
    4.69 +      -- P.position P.text >> (fn ((x, y), z) => Toplevel.theory (IsarCmd.oracle x y z)));
    4.70  
    4.71  
    4.72  (* local theories *)
     5.1 --- a/src/Pure/Isar/method.ML	Mon Mar 24 18:44:21 2008 +0100
     5.2 +++ b/src/Pure/Isar/method.ML	Mon Mar 24 23:34:24 2008 +0100
     5.3 @@ -52,7 +52,7 @@
     5.4    val frule: int -> thm list -> method
     5.5    val iprover_tac: Proof.context -> int option -> int -> tactic
     5.6    val set_tactic: (Proof.context -> thm list -> tactic) -> unit
     5.7 -  val tactic: string -> Proof.context -> method
     5.8 +  val tactic: string * Position.T -> Proof.context -> method
     5.9    type src
    5.10    datatype text =
    5.11      Basic of (Proof.context -> method) * Position.T |
    5.12 @@ -76,7 +76,7 @@
    5.13      -> theory -> theory
    5.14    val add_method: bstring * (src -> Proof.context -> method) * string
    5.15      -> theory -> theory
    5.16 -  val method_setup: bstring * string * string -> theory -> theory
    5.17 +  val method_setup: bstring -> string * Position.T -> string -> theory -> theory
    5.18    val syntax: (Context.generic * Args.T list -> 'a * (Context.generic * Args.T list))
    5.19      -> src -> Proof.context -> 'a * Proof.context
    5.20    val simple_args: (Args.T list -> 'a * Args.T list)
    5.21 @@ -353,10 +353,10 @@
    5.22  val tactic_ref = ref ((fn _ => raise Match): Proof.context -> thm list -> tactic);
    5.23  fun set_tactic f = tactic_ref := f;
    5.24  
    5.25 -fun ml_tactic txt ctxt = NAMED_CRITICAL "ML" (fn () =>
    5.26 -  (ML_Context.use_mltext
    5.27 +fun ml_tactic (txt, pos) ctxt = NAMED_CRITICAL "ML" (fn () =>
    5.28 +  (ML_Context.use_mltext false pos
    5.29      ("let fun tactic (ctxt: Proof.context) (facts: thm list) : tactic =\n"
    5.30 -      ^ txt ^ "\nin Method.set_tactic tactic end") false (SOME (Context.Proof ctxt));
    5.31 +      ^ txt ^ "\nin Method.set_tactic tactic end") (SOME (Context.Proof ctxt));
    5.32      ML_Context.setmp (SOME (Context.Proof ctxt)) (! tactic_ref ctxt)));
    5.33  
    5.34  fun tactic txt ctxt = METHOD (ml_tactic txt ctxt);
    5.35 @@ -446,8 +446,8 @@
    5.36  
    5.37  (* method_setup *)
    5.38  
    5.39 -fun method_setup (name, txt, cmt) =
    5.40 -  ML_Context.use_let
    5.41 +fun method_setup name (txt, pos) cmt =
    5.42 +  ML_Context.use_let pos
    5.43      "val method: bstring * (Method.src -> Proof.context -> Proof.method) * string"
    5.44      "Context.map_theory (Method.add_method method)"
    5.45      ("(" ^ quote name ^ ", " ^ txt ^ ", " ^ quote cmt ^ ")")
    5.46 @@ -577,8 +577,8 @@
    5.47      "rename parameters of goal"),
    5.48    ("rotate_tac", goal_args (Scan.optional Args.int 1) Tactic.rotate_tac,
    5.49      "rotate assumptions of goal"),
    5.50 -  ("tactic", simple_args Args.name tactic, "ML tactic as proof method"),
    5.51 -  ("raw_tactic", simple_args Args.name raw_tactic, "ML tactic as raw proof method")]);
    5.52 +  ("tactic", simple_args (Args.position Args.name) tactic, "ML tactic as proof method"),
    5.53 +  ("raw_tactic", simple_args (Args.position Args.name) raw_tactic, "ML tactic as raw proof method")]);
    5.54  
    5.55  
    5.56  (* outer parser *)
     6.1 --- a/src/Pure/ML-Systems/alice.ML	Mon Mar 24 18:44:21 2008 +0100
     6.2 +++ b/src/Pure/ML-Systems/alice.ML	Mon Mar 24 23:34:24 2008 +0100
     6.3 @@ -117,9 +117,8 @@
     6.4  
     6.5  (* ML command execution *)
     6.6  
     6.7 -fun use_text tune name (print, err) verbose txt = (Compiler.eval txt; ());
     6.8 -
     6.9 -fun use_file tune output verbose name = use name;
    6.10 +fun use_text _ _ _ _ txt = (Compiler.eval txt; ());
    6.11 +fun use_file _ _ _ name = use name;
    6.12  
    6.13  
    6.14  
     7.1 --- a/src/Pure/ML-Systems/polyml.ML	Mon Mar 24 18:44:21 2008 +0100
     7.2 +++ b/src/Pure/ML-Systems/polyml.ML	Mon Mar 24 23:34:24 2008 +0100
     7.3 @@ -22,24 +22,24 @@
     7.4  
     7.5  (* improved versions of use_text/file *)
     7.6  
     7.7 -fun use_text (tune: string -> string) name (print, err) verbose txt =
     7.8 +fun use_text (tune: string -> string) (line, name) (print, err) verbose txt =
     7.9    let
    7.10      val in_buffer = ref (String.explode (tune txt));
    7.11      val out_buffer = ref ([]: string list);
    7.12      fun output () = implode (rev (case ! out_buffer of "\n" :: cs => cs | cs => cs));
    7.13  
    7.14 -    val line_no = ref 1;
    7.15 -    fun line () = ! line_no;
    7.16 +    val current_line = ref line;
    7.17      fun get () =
    7.18        (case ! in_buffer of
    7.19          [] => NONE
    7.20 -      | c :: cs => (in_buffer := cs; if c = #"\n" then line_no := ! line_no + 1 else (); SOME c));
    7.21 +      | c :: cs =>
    7.22 +          (in_buffer := cs; if c = #"\n" then current_line := ! current_line + 1 else (); SOME c));
    7.23      fun put s = out_buffer := s :: ! out_buffer;
    7.24  
    7.25      val _ =
    7.26        (while not (List.null (! in_buffer)) do
    7.27          PolyML.compiler
    7.28 -          {getChar = get, putString = put, lineNumber = line, fileName = name,
    7.29 +          {getChar = get, putString = put, lineNumber = fn () => ! current_line, fileName = name,
    7.30              nameSpace = PolyML.globalNameSpace} ())
    7.31        handle exn => (err (output ()); raise exn);
    7.32    in
    7.33 @@ -50,5 +50,5 @@
    7.34    let
    7.35      val instream = TextIO.openIn name;
    7.36      val txt = TextIO.inputAll instream before TextIO.closeIn instream;
    7.37 -  in use_text tune name output verbose txt end;
    7.38 +  in use_text tune (1, name) output verbose txt end;
    7.39  
     8.1 --- a/src/Pure/ML-Systems/polyml_old_compiler4.ML	Mon Mar 24 18:44:21 2008 +0100
     8.2 +++ b/src/Pure/ML-Systems/polyml_old_compiler4.ML	Mon Mar 24 23:34:24 2008 +0100
     8.3 @@ -1,10 +1,10 @@
     8.4  (*  Title:      Pure/ML-Systems/polyml_old_compiler4.ML
     8.5      ID:         $Id$
     8.6  
     8.7 -Runtime compilation -- for old version of PolyML.compiler (version 4.x).
     8.8 +Runtime compilation -- for old PolyML.compiler (version 4.x).
     8.9  *)
    8.10  
    8.11 -fun use_text (tune: string -> string) name (print, err) verbose txt =
    8.12 +fun use_text (tune: string -> string) (line: int, name) (print, err) verbose txt =
    8.13    let
    8.14      val in_buffer = ref (explode (tune txt));
    8.15      val out_buffer = ref ([]: string list);
    8.16 @@ -30,5 +30,5 @@
    8.17    let
    8.18      val instream = TextIO.openIn name;
    8.19      val txt = TextIO.inputAll instream before TextIO.closeIn instream;
    8.20 -  in use_text tune name output verbose txt end;
    8.21 +  in use_text tune (1, name) output verbose txt end;
    8.22  
     9.1 --- a/src/Pure/ML-Systems/polyml_old_compiler5.ML	Mon Mar 24 18:44:21 2008 +0100
     9.2 +++ b/src/Pure/ML-Systems/polyml_old_compiler5.ML	Mon Mar 24 23:34:24 2008 +0100
     9.3 @@ -1,27 +1,26 @@
     9.4  (*  Title:      Pure/ML-Systems/polyml_old_compiler5.ML
     9.5      ID:         $Id$
     9.6  
     9.7 -Runtime compilation -- for old version of PolyML.compilerEx (version 5.0, 5.1).
     9.8 +Runtime compilation -- for old PolyML.compilerEx (version 5.0, 5.1).
     9.9  *)
    9.10  
    9.11 -fun use_text (tune: string -> string) name (print, err) verbose txt =
    9.12 +fun use_text (tune: string -> string) (line, name) (print, err) verbose txt =
    9.13    let
    9.14      val in_buffer = ref (explode (tune txt));
    9.15      val out_buffer = ref ([]: string list);
    9.16      fun output () = implode (rev (case ! out_buffer of "\n" :: cs => cs | cs => cs));
    9.17  
    9.18 -    val line_no = ref 1;
    9.19 -    fun line () = ! line_no;
    9.20 +    val current_line = ref line;
    9.21      fun get () =
    9.22        (case ! in_buffer of
    9.23          [] => ""
    9.24 -      | c :: cs => (in_buffer := cs; if c = "\n" then line_no := ! line_no + 1 else (); c));
    9.25 +      | c :: cs => (in_buffer := cs; if c = "\n" then current_line := ! current_line + 1 else (); c));
    9.26      fun put s = out_buffer := s :: ! out_buffer;
    9.27  
    9.28      fun exec () =
    9.29        (case ! in_buffer of
    9.30          [] => ()
    9.31 -      | _ => (PolyML.compilerEx (get, put, line, name) (); exec ()));
    9.32 +      | _ => (PolyML.compilerEx (get, put, fn () => ! current_line, name) (); exec ()));
    9.33    in
    9.34      exec () handle exn => (err (output ()); raise exn);
    9.35      if verbose then print (output ()) else ()
    9.36 @@ -31,5 +30,5 @@
    9.37    let
    9.38      val instream = TextIO.openIn name;
    9.39      val txt = TextIO.inputAll instream before TextIO.closeIn instream;
    9.40 -  in use_text tune name output verbose txt end;
    9.41 +  in use_text tune (1, name) output verbose txt end;
    9.42  
    10.1 --- a/src/Pure/ML-Systems/smlnj.ML	Mon Mar 24 18:44:21 2008 +0100
    10.2 +++ b/src/Pure/ML-Systems/smlnj.ML	Mon Mar 24 23:34:24 2008 +0100
    10.3 @@ -110,7 +110,7 @@
    10.4  
    10.5  (* ML command execution *)
    10.6  
    10.7 -fun use_text (tune: string -> string) name (print, err) verbose txt =
    10.8 +fun use_text (tune: string -> string) (line: int, name) (print, err) verbose txt =
    10.9    let
   10.10      val ref out_orig = Control.Print.out;
   10.11  
   10.12 @@ -132,7 +132,7 @@
   10.13    let
   10.14      val instream = TextIO.openIn name;
   10.15      val txt = TextIO.inputAll instream before TextIO.closeIn instream;
   10.16 -  in use_text tune name output verbose txt end;
   10.17 +  in use_text tune (1, name) output verbose txt end;
   10.18  
   10.19  
   10.20  
    11.1 --- a/src/Pure/ML/ml_context.ML	Mon Mar 24 18:44:21 2008 +0100
    11.2 +++ b/src/Pure/ML/ml_context.ML	Mon Mar 24 23:34:24 2008 +0100
    11.3 @@ -31,11 +31,11 @@
    11.4      (Context.generic * Args.T list -> (string * string) * (Context.generic * Args.T list)) -> unit
    11.5    val proj_value_antiq: string -> (Context.generic * Args.T list ->
    11.6        (string * string * string) * (Context.generic * Args.T list)) -> unit
    11.7 -  val eval_antiquotes_fn: (string -> string * string) ref  (* FIXME tmp *)
    11.8 +  val eval_antiquotes_fn: (string * Position.T -> string * string) ref  (* FIXME tmp *)
    11.9    val trace: bool ref
   11.10 -  val use_mltext: string -> bool -> Context.generic option -> unit
   11.11 -  val use_mltext_update: string -> bool -> Context.generic -> Context.generic
   11.12 -  val use_let: string -> string -> string -> Context.generic -> Context.generic
   11.13 +  val use_mltext: bool -> Position.T -> string -> Context.generic option -> unit
   11.14 +  val use_mltext_update: bool -> Position.T -> string -> Context.generic -> Context.generic
   11.15 +  val use_let: Position.T -> string -> string -> string -> Context.generic -> Context.generic
   11.16    val use: Path.T -> unit
   11.17    val evaluate: (string -> unit) * (string -> 'b) -> bool ->
   11.18      string * (unit -> 'a) option ref -> string -> 'a
   11.19 @@ -141,9 +141,9 @@
   11.20  val isabelle_struct = enclose "structure Isabelle =\nstruct\n" "end;";
   11.21  val isabelle_struct0 = isabelle_struct "";
   11.22  
   11.23 -fun eval_antiquotes txt =
   11.24 +fun eval_antiquotes txt_pos =
   11.25    let
   11.26 -    val ants = Antiquote.scan_antiquotes (txt, Position.line 1);
   11.27 +    val ants = Antiquote.scan_antiquotes txt_pos;
   11.28  
   11.29      fun expand (Antiquote.Text s) names = (("", Symbol.escape s), names)
   11.30        | expand (Antiquote.Antiq x) names =
   11.31 @@ -170,49 +170,50 @@
   11.32  
   11.33  val trace = ref false;
   11.34  
   11.35 -fun eval_wrapper name pr verbose txt =
   11.36 +fun eval_wrapper pr verbose pos txt =
   11.37    let
   11.38 -    val (txt1, txt2) = ! eval_antiquotes_fn txt;  (* FIXME tmp hook *)
   11.39 +    val (txt1, txt2) = ! eval_antiquotes_fn (txt, pos);  (* FIXME tmp hook *)
   11.40      val _ = if ! trace then tracing (cat_lines [txt1, txt2]) else ();
   11.41 -    fun eval nm = use_text nm pr;
   11.42 +    fun eval p =
   11.43 +      use_text (the_default 1 (Position.line_of p), the_default "ML" (Position.file_of p)) pr;
   11.44    in
   11.45      NAMED_CRITICAL "ML" (fn () =>
   11.46 -      (eval "" false txt1; eval name verbose txt2; eval "" false isabelle_struct0))
   11.47 +     (eval Position.none false txt1;
   11.48 +      eval pos verbose txt2;
   11.49 +      eval Position.none false isabelle_struct0))
   11.50    end;
   11.51  
   11.52 -fun ML_wrapper pr = eval_wrapper "ML" pr;
   11.53 -
   11.54  end;
   11.55  
   11.56  
   11.57  (* ML evaluation *)
   11.58  
   11.59 -fun use_mltext txt verbose opt_context =
   11.60 -  setmp opt_context (fn () => ML_wrapper Output.ml_output verbose txt) ();
   11.61 +fun use_mltext verbose pos txt opt_context =
   11.62 +  setmp opt_context (fn () => eval_wrapper Output.ml_output verbose pos txt) ();
   11.63  
   11.64 -fun use_mltext_update txt verbose context =
   11.65 -  #2 (pass_context context (fn () => ML_wrapper Output.ml_output verbose txt) ());
   11.66 +fun use_mltext_update verbose pos txt context =
   11.67 +  #2 (pass_context context (fn () => eval_wrapper Output.ml_output verbose pos txt) ());
   11.68  
   11.69 -fun use_context txt = use_mltext_update
   11.70 -  ("ML_Context.set_context (SOME ((" ^ txt ^ ") (ML_Context.the_generic_context ())));") false;
   11.71 +fun use_let pos bind body txt =
   11.72 +  use_mltext_update false pos
   11.73 +    ("ML_Context.set_context (SOME (let " ^ bind ^ " = " ^ txt ^ " in " ^ body ^
   11.74 +      " end (ML_Context.the_generic_context ())));");
   11.75  
   11.76 -fun use_let bind body txt =
   11.77 -  use_context ("let " ^ bind ^ " = " ^ txt ^ " in\n" ^ body ^ " end");
   11.78 -
   11.79 -fun use path = eval_wrapper (Path.implode path) Output.ml_output true (File.read path);
   11.80 +fun use path = eval_wrapper Output.ml_output true (Position.path path) (File.read path);
   11.81  
   11.82  fun evaluate pr verbose (ref_name, r) txt = NAMED_CRITICAL "ML" (fn () =>
   11.83    let
   11.84      val _ = r := NONE;
   11.85 -    val _ = ML_wrapper pr verbose ("val _ = (" ^ ref_name ^ " := SOME (fn () => " ^ txt ^ "))");
   11.86 +    val _ = eval_wrapper pr verbose Position.none
   11.87 +      ("val _ = (" ^ ref_name ^ " := SOME (fn () => " ^ txt ^ "))");
   11.88    in (case ! r of NONE => error ("Bad evaluation for " ^ ref_name) | SOME e => e) end) ();
   11.89  
   11.90  
   11.91  (* basic antiquotations *)
   11.92  
   11.93 -local
   11.94 +fun context x = (Scan.state >> Context.proof_of) x;
   11.95  
   11.96 -fun context x = (Scan.state >> Context.proof_of) x;
   11.97 +local
   11.98  
   11.99  val _ = value_antiq "context" (Scan.succeed ("context", "ML_Context.the_local_context ()"));
  11.100  
  11.101 @@ -243,7 +244,7 @@
  11.102  val _ = inline_antiq "type_name" (type_ false);
  11.103  val _ = inline_antiq "type_syntax" (type_ true);
  11.104  
  11.105 -fun const syn = (Scan.state >> Context.proof_of) -- Scan.lift Args.name >> (fn (ctxt, c) =>
  11.106 +fun const syn = context -- Scan.lift Args.name >> (fn (ctxt, c) =>
  11.107    #1 (Term.dest_Const (ProofContext.read_const_proper ctxt c))
  11.108    |> syn ? ProofContext.const_syntax_name ctxt
  11.109    |> ML_Syntax.print_string);
  11.110 @@ -252,7 +253,7 @@
  11.111  val _ = inline_antiq "const_syntax" (const true);
  11.112  
  11.113  val _ = inline_antiq "const"
  11.114 -  ((Scan.state >> Context.proof_of) -- Scan.lift Args.name --
  11.115 +  (context -- Scan.lift Args.name --
  11.116      Scan.optional (Scan.lift (Args.$$$ "(") |-- Args.enum1 "," Args.typ --| Scan.lift (Args.$$$ ")")) []
  11.117      >> (fn ((ctxt, c), Ts) =>
  11.118        let
  11.119 @@ -276,8 +277,7 @@
  11.120    | print_interval (Facts.Single i) = "Facts.Single " ^ ML_Syntax.print_int i;
  11.121  
  11.122  fun thm_antiq kind get get_name = value_antiq kind
  11.123 -  ((Scan.state >> Context.proof_of) --
  11.124 -    Scan.lift (Args.position Args.name -- Scan.option Args.thm_sel)
  11.125 +  (context -- Scan.lift (Args.position Args.name -- Scan.option Args.thm_sel)
  11.126    >> (fn (ctxt, ((name, pos), sel)) =>
  11.127        let
  11.128          val _ = get ctxt (Facts.Named ((name, pos), sel));
    12.1 --- a/src/Pure/Thy/thy_output.ML	Mon Mar 24 18:44:21 2008 +0100
    12.2 +++ b/src/Pure/Thy/thy_output.ML	Mon Mar 24 23:34:24 2008 +0100
    12.3 @@ -501,8 +501,8 @@
    12.4  fun ml_type txt = "val _ = NONE : (" ^ txt ^ ") option;";
    12.5  fun ml_struct txt = "functor DUMMY_FUNCTOR() = struct structure DUMMY = " ^ txt ^ " end;"
    12.6  
    12.7 -fun output_ml ml src ctxt txt =
    12.8 - (ML_Context.use_mltext (ml txt) false (SOME (Context.Proof ctxt));
    12.9 +fun output_ml ml src ctxt (txt, pos) =
   12.10 + (ML_Context.use_mltext false pos (ml txt) (SOME (Context.Proof ctxt));
   12.11    (if ! source then str_of_source src else txt)
   12.12    |> (if ! quotes then quote else I)
   12.13    |> (if ! display then enclose "\\begin{verbatim}\n" "\n\\end{verbatim}"
   12.14 @@ -531,8 +531,8 @@
   12.15    ("prf", args Attrib.thms (output (pretty_prf false))),
   12.16    ("full_prf", args Attrib.thms (output (pretty_prf true))),
   12.17    ("theory", args (Scan.lift Args.name) (output pretty_theory)),
   12.18 -  ("ML", args (Scan.lift Args.name) (output_ml ml_val)),
   12.19 -  ("ML_type", args (Scan.lift Args.name) (output_ml ml_type)),
   12.20 -  ("ML_struct", args (Scan.lift Args.name) (output_ml ml_struct))];
   12.21 +  ("ML", args (Scan.lift (Args.position Args.name)) (output_ml ml_val)),
   12.22 +  ("ML_type", args (Scan.lift (Args.position Args.name)) (output_ml ml_type)),
   12.23 +  ("ML_struct", args (Scan.lift (Args.position Args.name)) (output_ml ml_struct))];
   12.24  
   12.25  end;
    13.1 --- a/src/Pure/codegen.ML	Mon Mar 24 18:44:21 2008 +0100
    13.2 +++ b/src/Pure/codegen.ML	Mon Mar 24 23:34:24 2008 +0100
    13.3 @@ -963,7 +963,7 @@
    13.4                    [Pretty.str "]"])]]),
    13.5            Pretty.str ");"]) ^
    13.6        "\n\nend;\n") ();
    13.7 -    val _ = ML_Context.use_mltext s false (SOME (Context.Theory thy));
    13.8 +    val _ = ML_Context.use_mltext false Position.none s (SOME (Context.Theory thy));
    13.9      fun iter f k = if k > i then NONE
   13.10        else (case (f () handle Match =>
   13.11            (if quiet then ()
   13.12 @@ -1053,7 +1053,7 @@
   13.13                [Pretty.str "(result ())"],
   13.14              Pretty.str ");"]) ^
   13.15          "\n\nend;\n";
   13.16 -      val _ = ML_Context.use_mltext s false (SOME (Context.Theory thy))
   13.17 +      val _ = ML_Context.use_mltext false Position.none s (SOME (Context.Theory thy));
   13.18      in !eval_result end) ();
   13.19    in e () end;
   13.20  
   13.21 @@ -1148,8 +1148,8 @@
   13.22         val mode'' = (if lib then insert (op =) "library" else I) (remove (op =) "library" mode');
   13.23         val (code, gr) = setmp mode mode'' (generate_code thy modules module) xs
   13.24       in ((case opt_fname of
   13.25 -         NONE => ML_Context.use_mltext (space_implode "\n" (map snd code))
   13.26 -           false (SOME (Context.Theory thy))
   13.27 +         NONE => ML_Context.use_mltext false Position.none (space_implode "\n" (map snd code))
   13.28 +           (SOME (Context.Theory thy))
   13.29         | SOME fname =>
   13.30             if lib then
   13.31               app (fn (name, s) => File.write
    14.1 --- a/src/Tools/Compute_Oracle/am_compiler.ML	Mon Mar 24 18:44:21 2008 +0100
    14.2 +++ b/src/Tools/Compute_Oracle/am_compiler.ML	Mon Mar 24 23:34:24 2008 +0100
    14.3 @@ -186,7 +186,7 @@
    14.4  
    14.5      in
    14.6  	compiled_rewriter := NONE;	
    14.7 -	use_text "" Output.ml_output false (!buffer);
    14.8 +	use_text (1, "") Output.ml_output false (!buffer);
    14.9  	case !compiled_rewriter of 
   14.10  	    NONE => raise (Compile "cannot communicate with compiled function")
   14.11  	  | SOME r => (compiled_rewriter := NONE; r)
    15.1 --- a/src/Tools/Compute_Oracle/am_sml.ML	Mon Mar 24 18:44:21 2008 +0100
    15.2 +++ b/src/Tools/Compute_Oracle/am_sml.ML	Mon Mar 24 23:34:24 2008 +0100
    15.3 @@ -493,7 +493,7 @@
    15.4  
    15.5  fun writeTextFile name s = File.write (Path.explode name) s
    15.6  
    15.7 -fun use_source src = use_text "" Output.ml_output false src
    15.8 +fun use_source src = use_text (1, "") Output.ml_output false src
    15.9      
   15.10  fun compile cache_patterns const_arity eqs = 
   15.11      let
    16.1 --- a/src/Tools/code/code_target.ML	Mon Mar 24 18:44:21 2008 +0100
    16.2 +++ b/src/Tools/code/code_target.ML	Mon Mar 24 23:34:24 2008 +0100
    16.3 @@ -1093,7 +1093,7 @@
    16.4  fun isar_seri_sml module file =
    16.5    let
    16.6      val output = case file
    16.7 -     of NONE => use_text "generated code" Output.ml_output false o code_output
    16.8 +     of NONE => use_text (1, "generated code") Output.ml_output false o code_output
    16.9        | SOME "-" => PrintMode.setmp [] writeln o code_output
   16.10        | SOME file => File.write (Path.explode file) o code_output;
   16.11    in