src/Pure/ML-Systems/polyml.ML
author wenzelm
Thu, 31 Jul 2014 22:02:21 +0200
changeset 57834 0d295e339f52
parent 57832 5b48f2047c24
child 59055 5a7157b8e870
permissions -rw-r--r--
prefer dynamic ML_print_depth if context happens to be available;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
33538
edf497b5b5d2 setup for official Poly/ML 5.3.0, which is now the default;
wenzelm
parents: 32778
diff changeset
     1
(*  Title:      Pure/ML-Systems/polyml.ML
47980
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
     2
    Author:     Makarius
29714
6cef6700c841 Compatibility wrapper for experimental versions of Poly/ML after 5.2.1.
wenzelm
parents:
diff changeset
     3
50910
54f06ba192ef tuned comments;
wenzelm
parents: 50909
diff changeset
     4
Compatibility wrapper for Poly/ML.
29714
6cef6700c841 Compatibility wrapper for experimental versions of Poly/ML after 5.2.1.
wenzelm
parents:
diff changeset
     5
*)
6cef6700c841 Compatibility wrapper for experimental versions of Poly/ML after 5.2.1.
wenzelm
parents:
diff changeset
     6
56275
600f432ab556 added command 'SML_file' for Standard ML without Isabelle/ML add-ons;
wenzelm
parents: 54723
diff changeset
     7
(* ML name space *)
600f432ab556 added command 'SML_file' for Standard ML without Isabelle/ML add-ons;
wenzelm
parents: 54723
diff changeset
     8
600f432ab556 added command 'SML_file' for Standard ML without Isabelle/ML add-ons;
wenzelm
parents: 54723
diff changeset
     9
structure ML_Name_Space =
600f432ab556 added command 'SML_file' for Standard ML without Isabelle/ML add-ons;
wenzelm
parents: 54723
diff changeset
    10
struct
600f432ab556 added command 'SML_file' for Standard ML without Isabelle/ML add-ons;
wenzelm
parents: 54723
diff changeset
    11
  open PolyML.NameSpace;
600f432ab556 added command 'SML_file' for Standard ML without Isabelle/ML add-ons;
wenzelm
parents: 54723
diff changeset
    12
  type T = PolyML.NameSpace.nameSpace;
600f432ab556 added command 'SML_file' for Standard ML without Isabelle/ML add-ons;
wenzelm
parents: 54723
diff changeset
    13
  val global = PolyML.globalNameSpace;
600f432ab556 added command 'SML_file' for Standard ML without Isabelle/ML add-ons;
wenzelm
parents: 54723
diff changeset
    14
  val initial_val =
600f432ab556 added command 'SML_file' for Standard ML without Isabelle/ML add-ons;
wenzelm
parents: 54723
diff changeset
    15
    List.filter (fn (a, _) => a <> "use" andalso a <> "exit" andalso a <> "commit")
600f432ab556 added command 'SML_file' for Standard ML without Isabelle/ML add-ons;
wenzelm
parents: 54723
diff changeset
    16
      (#allVal global ());
600f432ab556 added command 'SML_file' for Standard ML without Isabelle/ML add-ons;
wenzelm
parents: 54723
diff changeset
    17
  val initial_type = #allType global ();
600f432ab556 added command 'SML_file' for Standard ML without Isabelle/ML add-ons;
wenzelm
parents: 54723
diff changeset
    18
  val initial_fixity = #allFix global ();
600f432ab556 added command 'SML_file' for Standard ML without Isabelle/ML add-ons;
wenzelm
parents: 54723
diff changeset
    19
  val initial_structure = #allStruct global ();
600f432ab556 added command 'SML_file' for Standard ML without Isabelle/ML add-ons;
wenzelm
parents: 54723
diff changeset
    20
  val initial_signature = #allSig global ();
600f432ab556 added command 'SML_file' for Standard ML without Isabelle/ML add-ons;
wenzelm
parents: 54723
diff changeset
    21
  val initial_functor = #allFunct global ();
600f432ab556 added command 'SML_file' for Standard ML without Isabelle/ML add-ons;
wenzelm
parents: 54723
diff changeset
    22
end;
600f432ab556 added command 'SML_file' for Standard ML without Isabelle/ML add-ons;
wenzelm
parents: 54723
diff changeset
    23
600f432ab556 added command 'SML_file' for Standard ML without Isabelle/ML add-ons;
wenzelm
parents: 54723
diff changeset
    24
54717
42c209a6c225 support for polml-5.5.2;
wenzelm
parents: 54342
diff changeset
    25
(* ML system operations *)
42c209a6c225 support for polml-5.5.2;
wenzelm
parents: 54342
diff changeset
    26
42c209a6c225 support for polml-5.5.2;
wenzelm
parents: 54342
diff changeset
    27
use "ML-Systems/ml_system.ML";
42c209a6c225 support for polml-5.5.2;
wenzelm
parents: 54342
diff changeset
    28
42c209a6c225 support for polml-5.5.2;
wenzelm
parents: 54342
diff changeset
    29
if ML_System.name = "polyml-5.3.0"
42c209a6c225 support for polml-5.5.2;
wenzelm
parents: 54342
diff changeset
    30
then use "ML-Systems/share_common_data_polyml-5.3.0.ML"
42c209a6c225 support for polml-5.5.2;
wenzelm
parents: 54342
diff changeset
    31
else ();
42c209a6c225 support for polml-5.5.2;
wenzelm
parents: 54342
diff changeset
    32
42c209a6c225 support for polml-5.5.2;
wenzelm
parents: 54342
diff changeset
    33
structure ML_System =
42c209a6c225 support for polml-5.5.2;
wenzelm
parents: 54342
diff changeset
    34
struct
42c209a6c225 support for polml-5.5.2;
wenzelm
parents: 54342
diff changeset
    35
42c209a6c225 support for polml-5.5.2;
wenzelm
parents: 54342
diff changeset
    36
open ML_System;
42c209a6c225 support for polml-5.5.2;
wenzelm
parents: 54342
diff changeset
    37
42c209a6c225 support for polml-5.5.2;
wenzelm
parents: 54342
diff changeset
    38
fun share_common_data () = PolyML.shareCommonData PolyML.rootFunction;
42c209a6c225 support for polml-5.5.2;
wenzelm
parents: 54342
diff changeset
    39
val save_state = PolyML.SaveState.saveState;
42c209a6c225 support for polml-5.5.2;
wenzelm
parents: 54342
diff changeset
    40
42c209a6c225 support for polml-5.5.2;
wenzelm
parents: 54342
diff changeset
    41
end;
42c209a6c225 support for polml-5.5.2;
wenzelm
parents: 54342
diff changeset
    42
42c209a6c225 support for polml-5.5.2;
wenzelm
parents: 54342
diff changeset
    43
47980
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    44
(* exceptions *)
30673
60568c168040 more systematic type use_context;
wenzelm
parents: 30638
diff changeset
    45
31427
5a07cc86675d reraise exceptions to preserve original position (ML system specific);
wenzelm
parents: 31318
diff changeset
    46
fun reraise exn =
5a07cc86675d reraise exceptions to preserve original position (ML system specific);
wenzelm
parents: 31318
diff changeset
    47
  (case PolyML.exceptionLocation exn of
5a07cc86675d reraise exceptions to preserve original position (ML system specific);
wenzelm
parents: 31318
diff changeset
    48
    NONE => raise exn
5a07cc86675d reraise exceptions to preserve original position (ML system specific);
wenzelm
parents: 31318
diff changeset
    49
  | SOME location => PolyML.raiseWithLocation (exn, location));
5a07cc86675d reraise exceptions to preserve original position (ML system specific);
wenzelm
parents: 31318
diff changeset
    50
47980
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    51
exception Interrupt = SML90.Interrupt;
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    52
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    53
use "General/exn.ML";
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    54
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    55
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    56
(* multithreading *)
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    57
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    58
val seconds = Time.fromReal;
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    59
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    60
if List.exists (fn s => s = "SingleAssignment") (PolyML.Compiler.structureNames ())
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    61
then ()
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    62
else use "ML-Systems/single_assignment_polyml.ML";
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    63
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    64
open Thread;
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    65
use "ML-Systems/multithreading.ML";
29714
6cef6700c841 Compatibility wrapper for experimental versions of Poly/ML after 5.2.1.
wenzelm
parents:
diff changeset
    66
use "ML-Systems/multithreading_polyml.ML";
47980
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    67
39616
8052101883c3 renamed setmp_noncritical to Unsynchronized.setmp to emphasize its meaning;
wenzelm
parents: 38470
diff changeset
    68
use "ML-Systems/unsynchronized.ML";
8052101883c3 renamed setmp_noncritical to Unsynchronized.setmp to emphasize its meaning;
wenzelm
parents: 38470
diff changeset
    69
val _ = PolyML.Compiler.forgetValue "ref";
8052101883c3 renamed setmp_noncritical to Unsynchronized.setmp to emphasize its meaning;
wenzelm
parents: 38470
diff changeset
    70
val _ = PolyML.Compiler.forgetType "ref";
29714
6cef6700c841 Compatibility wrapper for experimental versions of Poly/ML after 5.2.1.
wenzelm
parents:
diff changeset
    71
47980
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    72
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    73
(* pervasive environment *)
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    74
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    75
val _ = PolyML.Compiler.forgetValue "isSome";
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    76
val _ = PolyML.Compiler.forgetValue "getOpt";
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    77
val _ = PolyML.Compiler.forgetValue "valOf";
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    78
val _ = PolyML.Compiler.forgetValue "foldl";
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    79
val _ = PolyML.Compiler.forgetValue "foldr";
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    80
val _ = PolyML.Compiler.forgetValue "print";
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    81
val _ = PolyML.Compiler.forgetValue "explode";
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    82
val _ = PolyML.Compiler.forgetValue "concat";
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    83
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    84
val ord = SML90.ord;
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    85
val chr = SML90.chr;
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    86
val raw_explode = SML90.explode;
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    87
val implode = SML90.implode;
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    88
54342
fbcaa9f08879 avoid non-portable int constant -- make SML/NJ happy;
wenzelm
parents: 53709
diff changeset
    89
val io_buffer_size = 4096;
fbcaa9f08879 avoid non-portable int constant -- make SML/NJ happy;
wenzelm
parents: 53709
diff changeset
    90
47980
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    91
fun quit () = exit 0;
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    92
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    93
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    94
(* ML runtime system *)
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    95
53709
84522727f9d3 improved printing of exception trace in Poly/ML 5.5.1;
wenzelm
parents: 52837
diff changeset
    96
fun print_exception_trace (_: exn -> string) = PolyML.exception_trace;
47980
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    97
val timing = PolyML.timing;
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    98
val profiling = PolyML.profiling;
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
    99
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
   100
fun profile 0 f x = f x
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
   101
  | profile n f x =
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
   102
      let
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
   103
        val _ = RunCall.run_call1 RuntimeCalls.POLY_SYS_profiler n;
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
   104
        val res = Exn.capture f x;
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
   105
        val _ = RunCall.run_call1 RuntimeCalls.POLY_SYS_profiler 0;
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
   106
      in Exn.release res end;
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
   107
29714
6cef6700c841 Compatibility wrapper for experimental versions of Poly/ML after 5.2.1.
wenzelm
parents:
diff changeset
   108
val pointer_eq = PolyML.pointerEq;
6cef6700c841 Compatibility wrapper for experimental versions of Poly/ML after 5.2.1.
wenzelm
parents:
diff changeset
   109
47980
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
   110
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
   111
(* ML compiler *)
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
   112
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
   113
use "ML-Systems/use_context.ML";
56435
28b34e8e4a80 approximate ML antiquotation @{here} for Isabelle/Pure bootstrap;
wenzelm
parents: 56303
diff changeset
   114
use "ML-Systems/ml_positions.ML";
47980
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
   115
use "ML-Systems/compiler_polyml.ML";
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
   116
32778
a92a18253f1e report unreferenced ids;
wenzelm
parents: 32776
diff changeset
   117
PolyML.Compiler.reportUnreferencedIds := true;
47980
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
   118
PolyML.Compiler.printInAlphabeticalOrder := false;
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
   119
PolyML.Compiler.maxInlineSize := 80;
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
   120
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
   121
fun ml_prompts p1 p2 = (PolyML.Compiler.prompt1 := p1; PolyML.Compiler.prompt2 := p2);
30626
248de8dd839e adapted toplevel_pp to ML_Pretty.pretty;
wenzelm
parents: 30619
diff changeset
   122
248de8dd839e adapted toplevel_pp to ML_Pretty.pretty;
wenzelm
parents: 30619
diff changeset
   123
47980
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
   124
(* ML toplevel pretty printing *)
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
   125
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
   126
use "ML-Systems/ml_pretty.ML";
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
   127
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
   128
local
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
   129
  val depth = Unsynchronized.ref 10;
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
   130
in
56281
03c3d1a7c3b8 proper configuration option "ML_print_depth";
wenzelm
parents: 56275
diff changeset
   131
  fun get_default_print_depth () = ! depth;
56285
wenzelm
parents: 56283
diff changeset
   132
  fun default_print_depth n = (depth := n; PolyML.print_depth n);
wenzelm
parents: 56283
diff changeset
   133
  val _ = default_print_depth 10;
47980
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
   134
end;
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
   135
c81801f881b3 simplified Poly/ML setup -- 5.3.0 is now the common base-line;
wenzelm
parents: 44249
diff changeset
   136
val error_depth = PolyML.error_depth;
30626
248de8dd839e adapted toplevel_pp to ML_Pretty.pretty;
wenzelm
parents: 30619
diff changeset
   137
30676
edca392a2abb pretty_ml/ml_pretty: proper handling of markup and string length;
wenzelm
parents: 30673
diff changeset
   138
val pretty_ml =
edca392a2abb pretty_ml/ml_pretty: proper handling of markup and string length;
wenzelm
parents: 30673
diff changeset
   139
  let
51638
1275716f395b more defensive representation of forced break within PolyML.PrettyBreak -- avoid accidental blowup if low-level operations are used, notably PolyML.makestring or its variant General.exnMessage;
wenzelm
parents: 50911
diff changeset
   140
    fun convert _ (PolyML.PrettyBreak (wd, _)) = ML_Pretty.Break (false, wd)
54718
8c5221d698cd tuned patterns;
wenzelm
parents: 54717
diff changeset
   141
      | convert _ (PolyML.PrettyBlock (_, _,
51638
1275716f395b more defensive representation of forced break within PolyML.PrettyBreak -- avoid accidental blowup if low-level operations are used, notably PolyML.makestring or its variant General.exnMessage;
wenzelm
parents: 50911
diff changeset
   142
            [PolyML.ContextProperty ("fbrk", _)], [PolyML.PrettyString " "])) =
1275716f395b more defensive representation of forced break within PolyML.PrettyBreak -- avoid accidental blowup if low-level operations are used, notably PolyML.makestring or its variant General.exnMessage;
wenzelm
parents: 50911
diff changeset
   143
          ML_Pretty.Break (true, 1)
1275716f395b more defensive representation of forced break within PolyML.PrettyBreak -- avoid accidental blowup if low-level operations are used, notably PolyML.makestring or its variant General.exnMessage;
wenzelm
parents: 50911
diff changeset
   144
      | convert len (PolyML.PrettyBlock (ind, _, context, prts)) =
30676
edca392a2abb pretty_ml/ml_pretty: proper handling of markup and string length;
wenzelm
parents: 30673
diff changeset
   145
          let
edca392a2abb pretty_ml/ml_pretty: proper handling of markup and string length;
wenzelm
parents: 30673
diff changeset
   146
            fun property name default =
31318
133d1cfd6ae7 explicit PolyML qualification;
wenzelm
parents: 31312
diff changeset
   147
              (case List.find (fn PolyML.ContextProperty (a, _) => name = a | _ => false) context of
133d1cfd6ae7 explicit PolyML qualification;
wenzelm
parents: 31312
diff changeset
   148
                SOME (PolyML.ContextProperty (_, b)) => b
54718
8c5221d698cd tuned patterns;
wenzelm
parents: 54717
diff changeset
   149
              | _ => default);
30676
edca392a2abb pretty_ml/ml_pretty: proper handling of markup and string length;
wenzelm
parents: 30673
diff changeset
   150
            val bg = property "begin" "";
edca392a2abb pretty_ml/ml_pretty: proper handling of markup and string length;
wenzelm
parents: 30673
diff changeset
   151
            val en = property "end" "";
edca392a2abb pretty_ml/ml_pretty: proper handling of markup and string length;
wenzelm
parents: 30673
diff changeset
   152
            val len' = property "length" len;
edca392a2abb pretty_ml/ml_pretty: proper handling of markup and string length;
wenzelm
parents: 30673
diff changeset
   153
          in ML_Pretty.Block ((bg, en), map (convert len') prts, ind) end
31318
133d1cfd6ae7 explicit PolyML qualification;
wenzelm
parents: 31312
diff changeset
   154
      | convert len (PolyML.PrettyString s) =
30676
edca392a2abb pretty_ml/ml_pretty: proper handling of markup and string length;
wenzelm
parents: 30673
diff changeset
   155
          ML_Pretty.String (s, case Int.fromString len of SOME i => i | NONE => size s)
edca392a2abb pretty_ml/ml_pretty: proper handling of markup and string length;
wenzelm
parents: 30673
diff changeset
   156
  in convert "" end;
30638
15cc4ad0e6e9 added pretty_ml;
wenzelm
parents: 30626
diff changeset
   157
51638
1275716f395b more defensive representation of forced break within PolyML.PrettyBreak -- avoid accidental blowup if low-level operations are used, notably PolyML.makestring or its variant General.exnMessage;
wenzelm
parents: 50911
diff changeset
   158
fun ml_pretty (ML_Pretty.Break (false, wd)) = PolyML.PrettyBreak (wd, 0)
1275716f395b more defensive representation of forced break within PolyML.PrettyBreak -- avoid accidental blowup if low-level operations are used, notably PolyML.makestring or its variant General.exnMessage;
wenzelm
parents: 50911
diff changeset
   159
  | ml_pretty (ML_Pretty.Break (true, _)) =
1275716f395b more defensive representation of forced break within PolyML.PrettyBreak -- avoid accidental blowup if low-level operations are used, notably PolyML.makestring or its variant General.exnMessage;
wenzelm
parents: 50911
diff changeset
   160
      PolyML.PrettyBlock (0, false, [PolyML.ContextProperty ("fbrk", "")],
1275716f395b more defensive representation of forced break within PolyML.PrettyBreak -- avoid accidental blowup if low-level operations are used, notably PolyML.makestring or its variant General.exnMessage;
wenzelm
parents: 50911
diff changeset
   161
        [PolyML.PrettyString " "])
1275716f395b more defensive representation of forced break within PolyML.PrettyBreak -- avoid accidental blowup if low-level operations are used, notably PolyML.makestring or its variant General.exnMessage;
wenzelm
parents: 50911
diff changeset
   162
  | ml_pretty (ML_Pretty.Block ((bg, en), prts, ind)) =
30679
wenzelm
parents: 30676
diff changeset
   163
      let val context =
31318
133d1cfd6ae7 explicit PolyML qualification;
wenzelm
parents: 31312
diff changeset
   164
        (if bg = "" then [] else [PolyML.ContextProperty ("begin", bg)]) @
133d1cfd6ae7 explicit PolyML qualification;
wenzelm
parents: 31312
diff changeset
   165
        (if en = "" then [] else [PolyML.ContextProperty ("end", en)])
133d1cfd6ae7 explicit PolyML qualification;
wenzelm
parents: 31312
diff changeset
   166
      in PolyML.PrettyBlock (ind, false, context, map ml_pretty prts) end
30676
edca392a2abb pretty_ml/ml_pretty: proper handling of markup and string length;
wenzelm
parents: 30673
diff changeset
   167
  | ml_pretty (ML_Pretty.String (s, len)) =
31318
133d1cfd6ae7 explicit PolyML qualification;
wenzelm
parents: 31312
diff changeset
   168
      if len = size s then PolyML.PrettyString s
133d1cfd6ae7 explicit PolyML qualification;
wenzelm
parents: 31312
diff changeset
   169
      else PolyML.PrettyBlock
51638
1275716f395b more defensive representation of forced break within PolyML.PrettyBreak -- avoid accidental blowup if low-level operations are used, notably PolyML.makestring or its variant General.exnMessage;
wenzelm
parents: 50911
diff changeset
   170
        (0, false, [PolyML.ContextProperty ("length", Int.toString len)], [PolyML.PrettyString s]);
30626
248de8dd839e adapted toplevel_pp to ML_Pretty.pretty;
wenzelm
parents: 30619
diff changeset
   171
30673
60568c168040 more systematic type use_context;
wenzelm
parents: 30638
diff changeset
   172
fun toplevel_pp context (_: string list) pp =
60568c168040 more systematic type use_context;
wenzelm
parents: 30638
diff changeset
   173
  use_text context (1, "pp") false
31318
133d1cfd6ae7 explicit PolyML qualification;
wenzelm
parents: 31312
diff changeset
   174
    ("PolyML.addPrettyPrinter (fn _ => fn _ => ml_pretty o Pretty.to_ML o (" ^ pp ^ "))");
30626
248de8dd839e adapted toplevel_pp to ML_Pretty.pretty;
wenzelm
parents: 30619
diff changeset
   175
36162
0bd034a80a9a added ML antiquotation @{make_string}, which produces proper pretty printed version in Poly/ML 5.3.0 or later;
wenzelm
parents: 33543
diff changeset
   176
val ml_make_string =
57834
0d295e339f52 prefer dynamic ML_print_depth if context happens to be available;
wenzelm
parents: 57832
diff changeset
   177
  "(fn x => Pretty.string_of (Pretty.from_ML (pretty_ml (PolyML.prettyRepresentation (x, Isabelle.ML_print_depth ())))))";
36162
0bd034a80a9a added ML antiquotation @{make_string}, which produces proper pretty printed version in Poly/ML 5.3.0 or later;
wenzelm
parents: 33543
diff changeset
   178