src/Pure/ML-Systems/polyml.ML
author wenzelm
Sat, 21 Mar 2009 19:58:44 +0100
changeset 30623 9ed1122d6cd2
parent 29638 1f8f3d26a2cf
child 30627 fb9e73c01603
permissions -rw-r--r--
simplified datatype ML_Pretty.pretty: model Isabelle not Poly/ML;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
2341
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
     1
(*  Title:      Pure/ML-Systems/polyml.ML
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
     2
28255
6faea8ad8559 tuned comments;
wenzelm
parents: 28153
diff changeset
     3
Compatibility wrapper for Poly/ML 5.2 or later.
2341
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
     4
*)
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
     5
28152
c1277547d59f *** empty log message ***
wenzelm
parents: 28125
diff changeset
     6
open Thread;
26215
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents: 26084
diff changeset
     7
use "ML-Systems/polyml_common.ML";
28676
78688a5fafc2 multithreading support only for polyml-5.2.1 or later;
wenzelm
parents: 28268
diff changeset
     8
28796
56cb4130177a multithreading support for polyml-5.2 actually disabled -- as advertized;
wenzelm
parents: 28676
diff changeset
     9
if ml_system = "polyml-5.2"
56cb4130177a multithreading support for polyml-5.2 actually disabled -- as advertized;
wenzelm
parents: 28676
diff changeset
    10
then use "ML-Systems/thread_dummy.ML"
28676
78688a5fafc2 multithreading support only for polyml-5.2.1 or later;
wenzelm
parents: 28268
diff changeset
    11
else use "ML-Systems/multithreading_polyml.ML";
26215
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents: 26084
diff changeset
    12
94d32a7cd0fb rearrangements to make latest Poly/ML the default, not old 4.x;
wenzelm
parents: 26084
diff changeset
    13
val pointer_eq = PolyML.pointerEq;
23921
947152add153 added compatibility file for ML systems without multithreading;
wenzelm
parents: 23826
diff changeset
    14
29638
1f8f3d26a2cf added share_common_data -- reduces heap space, but takes long;
wenzelm
parents: 29564
diff changeset
    15
fun share_common_data () = PolyML.shareCommonData PolyML.rootFunction;
1f8f3d26a2cf added share_common_data -- reduces heap space, but takes long;
wenzelm
parents: 29564
diff changeset
    16
25023
52eb78ebb370 PolyML.Compiler.maxInlineSize := 80;
wenzelm
parents: 24851
diff changeset
    17
26390
99d4cbb1f941 moved multithreaded "profile" to multithreading_polyml.ML;
wenzelm
parents: 26385
diff changeset
    18
(* runtime compilation *)
3588
e487bf0ed6c4 cleaned up;
wenzelm
parents: 2408
diff changeset
    19
28268
ac8431ecd57e use_text/use_file now depend on explicit ML name space;
wenzelm
parents: 28255
diff changeset
    20
structure ML_NameSpace =
ac8431ecd57e use_text/use_file now depend on explicit ML name space;
wenzelm
parents: 28255
diff changeset
    21
struct
ac8431ecd57e use_text/use_file now depend on explicit ML name space;
wenzelm
parents: 28255
diff changeset
    22
  open PolyML.NameSpace;
ac8431ecd57e use_text/use_file now depend on explicit ML name space;
wenzelm
parents: 28255
diff changeset
    23
  val global = PolyML.globalNameSpace;
ac8431ecd57e use_text/use_file now depend on explicit ML name space;
wenzelm
parents: 28255
diff changeset
    24
end;
ac8431ecd57e use_text/use_file now depend on explicit ML name space;
wenzelm
parents: 28255
diff changeset
    25
26883
ae6ae88f9240 use_text/file: proper position output;
wenzelm
parents: 26879
diff changeset
    26
local
ae6ae88f9240 use_text/file: proper position output;
wenzelm
parents: 26879
diff changeset
    27
ae6ae88f9240 use_text/file: proper position output;
wenzelm
parents: 26879
diff changeset
    28
fun drop_newline s =
ae6ae88f9240 use_text/file: proper position output;
wenzelm
parents: 26879
diff changeset
    29
  if String.isSuffix "\n" s then String.substring (s, 0, size s - 1)
ae6ae88f9240 use_text/file: proper position output;
wenzelm
parents: 26879
diff changeset
    30
  else s;
ae6ae88f9240 use_text/file: proper position output;
wenzelm
parents: 26879
diff changeset
    31
ae6ae88f9240 use_text/file: proper position output;
wenzelm
parents: 26879
diff changeset
    32
in
ae6ae88f9240 use_text/file: proper position output;
wenzelm
parents: 26879
diff changeset
    33
28268
ac8431ecd57e use_text/use_file now depend on explicit ML name space;
wenzelm
parents: 28255
diff changeset
    34
fun use_text (tune: string -> string) str_of_pos
ac8431ecd57e use_text/use_file now depend on explicit ML name space;
wenzelm
parents: 28255
diff changeset
    35
    name_space (start_line, name) (print, err) verbose txt =
3588
e487bf0ed6c4 cleaned up;
wenzelm
parents: 2408
diff changeset
    36
  let
26883
ae6ae88f9240 use_text/file: proper position output;
wenzelm
parents: 26879
diff changeset
    37
    val current_line = ref start_line;
26379
a01a05cdd3b8 updated use_text/file for 5.2;
wenzelm
parents: 26215
diff changeset
    38
    val in_buffer = ref (String.explode (tune txt));
5090
75ac9b451ae0 use_text: verbose flag;
wenzelm
parents: 5038
diff changeset
    39
    val out_buffer = ref ([]: string list);
26883
ae6ae88f9240 use_text/file: proper position output;
wenzelm
parents: 26879
diff changeset
    40
    fun output () = drop_newline (implode (rev (! out_buffer)));
5090
75ac9b451ae0 use_text: verbose flag;
wenzelm
parents: 5038
diff changeset
    41
5038
301c37df931d use_text replaces use_strings;
wenzelm
parents: 4984
diff changeset
    42
    fun get () =
5090
75ac9b451ae0 use_text: verbose flag;
wenzelm
parents: 5038
diff changeset
    43
      (case ! in_buffer of
26379
a01a05cdd3b8 updated use_text/file for 5.2;
wenzelm
parents: 26215
diff changeset
    44
        [] => NONE
26385
ae7564661e76 ML runtime compilation: pass position, tuned signature;
wenzelm
parents: 26379
diff changeset
    45
      | c :: cs =>
ae7564661e76 ML runtime compilation: pass position, tuned signature;
wenzelm
parents: 26379
diff changeset
    46
          (in_buffer := cs; if c = #"\n" then current_line := ! current_line + 1 else (); SOME c));
5090
75ac9b451ae0 use_text: verbose flag;
wenzelm
parents: 5038
diff changeset
    47
    fun put s = out_buffer := s :: ! out_buffer;
26883
ae6ae88f9240 use_text/file: proper position output;
wenzelm
parents: 26879
diff changeset
    48
    fun message (msg, is_err, line) =
ae6ae88f9240 use_text/file: proper position output;
wenzelm
parents: 26879
diff changeset
    49
      (if is_err then "Error: " else "Warning: ") ^ drop_newline msg ^ str_of_pos line name ^ "\n";
5090
75ac9b451ae0 use_text: verbose flag;
wenzelm
parents: 5038
diff changeset
    50
26879
4fc89bfc4b0c adapted PolyML.compiler to latest change of basis/FinalPolyML.sml (2008-04-21);
wenzelm
parents: 26625
diff changeset
    51
    val parameters =
4fc89bfc4b0c adapted PolyML.compiler to latest change of basis/FinalPolyML.sml (2008-04-21);
wenzelm
parents: 26625
diff changeset
    52
     [PolyML.Compiler.CPOutStream put,
4fc89bfc4b0c adapted PolyML.compiler to latest change of basis/FinalPolyML.sml (2008-04-21);
wenzelm
parents: 26625
diff changeset
    53
      PolyML.Compiler.CPLineNo (fn () => ! current_line),
28268
ac8431ecd57e use_text/use_file now depend on explicit ML name space;
wenzelm
parents: 28255
diff changeset
    54
      PolyML.Compiler.CPErrorMessageProc (put o message),
ac8431ecd57e use_text/use_file now depend on explicit ML name space;
wenzelm
parents: 28255
diff changeset
    55
      PolyML.Compiler.CPNameSpace name_space];
26379
a01a05cdd3b8 updated use_text/file for 5.2;
wenzelm
parents: 26215
diff changeset
    56
    val _ =
a01a05cdd3b8 updated use_text/file for 5.2;
wenzelm
parents: 26215
diff changeset
    57
      (while not (List.null (! in_buffer)) do
26879
4fc89bfc4b0c adapted PolyML.compiler to latest change of basis/FinalPolyML.sml (2008-04-21);
wenzelm
parents: 26625
diff changeset
    58
        PolyML.compiler (get, parameters) ())
26625
e0cc4169626e use_text: explicitly print exception, which is no longer done by the new PolyML.compiler setup;
wenzelm
parents: 26504
diff changeset
    59
      handle exn =>
e0cc4169626e use_text: explicitly print exception, which is no longer done by the new PolyML.compiler setup;
wenzelm
parents: 26504
diff changeset
    60
       (put ("Exception- " ^ General.exnMessage exn ^ " raised");
e0cc4169626e use_text: explicitly print exception, which is no longer done by the new PolyML.compiler setup;
wenzelm
parents: 26504
diff changeset
    61
        err (output ()); raise exn);
26883
ae6ae88f9240 use_text/file: proper position output;
wenzelm
parents: 26879
diff changeset
    62
  in if verbose then print (output ()) else () end;
3588
e487bf0ed6c4 cleaned up;
wenzelm
parents: 2408
diff changeset
    63
28268
ac8431ecd57e use_text/use_file now depend on explicit ML name space;
wenzelm
parents: 28255
diff changeset
    64
fun use_file tune str_of_pos name_space output verbose name =
24598
44a1c0c68e21 added ml_system_fix_ints;
wenzelm
parents: 24329
diff changeset
    65
  let
44a1c0c68e21 added ml_system_fix_ints;
wenzelm
parents: 24329
diff changeset
    66
    val instream = TextIO.openIn name;
26504
6e87c0a60104 before close: Exn.capture/release;
wenzelm
parents: 26390
diff changeset
    67
    val txt = Exn.release (Exn.capture TextIO.inputAll instream before TextIO.closeIn instream);
28268
ac8431ecd57e use_text/use_file now depend on explicit ML name space;
wenzelm
parents: 28255
diff changeset
    68
  in use_text tune str_of_pos name_space (1, name) output verbose txt end;
26379
a01a05cdd3b8 updated use_text/file for 5.2;
wenzelm
parents: 26215
diff changeset
    69
26883
ae6ae88f9240 use_text/file: proper position output;
wenzelm
parents: 26879
diff changeset
    70
end;