src/Pure/ML-Systems/polyml.ML
author wenzelm
Mon, 19 Jan 2009 19:38:03 +0100
changeset 29564 f8b933a62151
parent 28796 56cb4130177a
child 29638 1f8f3d26a2cf
permissions -rw-r--r--
removed Ids;
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
25023
52eb78ebb370 PolyML.Compiler.maxInlineSize := 80;
wenzelm
parents: 24851
diff changeset
    15
26390
99d4cbb1f941 moved multithreaded "profile" to multithreading_polyml.ML;
wenzelm
parents: 26385
diff changeset
    16
(* runtime compilation *)
3588
e487bf0ed6c4 cleaned up;
wenzelm
parents: 2408
diff changeset
    17
28268
ac8431ecd57e use_text/use_file now depend on explicit ML name space;
wenzelm
parents: 28255
diff changeset
    18
structure ML_NameSpace =
ac8431ecd57e use_text/use_file now depend on explicit ML name space;
wenzelm
parents: 28255
diff changeset
    19
struct
ac8431ecd57e use_text/use_file now depend on explicit ML name space;
wenzelm
parents: 28255
diff changeset
    20
  open PolyML.NameSpace;
ac8431ecd57e use_text/use_file now depend on explicit ML name space;
wenzelm
parents: 28255
diff changeset
    21
  val global = PolyML.globalNameSpace;
ac8431ecd57e use_text/use_file now depend on explicit ML name space;
wenzelm
parents: 28255
diff changeset
    22
end;
ac8431ecd57e use_text/use_file now depend on explicit ML name space;
wenzelm
parents: 28255
diff changeset
    23
26883
ae6ae88f9240 use_text/file: proper position output;
wenzelm
parents: 26879
diff changeset
    24
local
ae6ae88f9240 use_text/file: proper position output;
wenzelm
parents: 26879
diff changeset
    25
ae6ae88f9240 use_text/file: proper position output;
wenzelm
parents: 26879
diff changeset
    26
fun drop_newline s =
ae6ae88f9240 use_text/file: proper position output;
wenzelm
parents: 26879
diff changeset
    27
  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
    28
  else s;
ae6ae88f9240 use_text/file: proper position output;
wenzelm
parents: 26879
diff changeset
    29
ae6ae88f9240 use_text/file: proper position output;
wenzelm
parents: 26879
diff changeset
    30
in
ae6ae88f9240 use_text/file: proper position output;
wenzelm
parents: 26879
diff changeset
    31
28268
ac8431ecd57e use_text/use_file now depend on explicit ML name space;
wenzelm
parents: 28255
diff changeset
    32
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
    33
    name_space (start_line, name) (print, err) verbose txt =
3588
e487bf0ed6c4 cleaned up;
wenzelm
parents: 2408
diff changeset
    34
  let
26883
ae6ae88f9240 use_text/file: proper position output;
wenzelm
parents: 26879
diff changeset
    35
    val current_line = ref start_line;
26379
a01a05cdd3b8 updated use_text/file for 5.2;
wenzelm
parents: 26215
diff changeset
    36
    val in_buffer = ref (String.explode (tune txt));
5090
75ac9b451ae0 use_text: verbose flag;
wenzelm
parents: 5038
diff changeset
    37
    val out_buffer = ref ([]: string list);
26883
ae6ae88f9240 use_text/file: proper position output;
wenzelm
parents: 26879
diff changeset
    38
    fun output () = drop_newline (implode (rev (! out_buffer)));
5090
75ac9b451ae0 use_text: verbose flag;
wenzelm
parents: 5038
diff changeset
    39
5038
301c37df931d use_text replaces use_strings;
wenzelm
parents: 4984
diff changeset
    40
    fun get () =
5090
75ac9b451ae0 use_text: verbose flag;
wenzelm
parents: 5038
diff changeset
    41
      (case ! in_buffer of
26379
a01a05cdd3b8 updated use_text/file for 5.2;
wenzelm
parents: 26215
diff changeset
    42
        [] => NONE
26385
ae7564661e76 ML runtime compilation: pass position, tuned signature;
wenzelm
parents: 26379
diff changeset
    43
      | c :: cs =>
ae7564661e76 ML runtime compilation: pass position, tuned signature;
wenzelm
parents: 26379
diff changeset
    44
          (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
    45
    fun put s = out_buffer := s :: ! out_buffer;
26883
ae6ae88f9240 use_text/file: proper position output;
wenzelm
parents: 26879
diff changeset
    46
    fun message (msg, is_err, line) =
ae6ae88f9240 use_text/file: proper position output;
wenzelm
parents: 26879
diff changeset
    47
      (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
    48
26879
4fc89bfc4b0c adapted PolyML.compiler to latest change of basis/FinalPolyML.sml (2008-04-21);
wenzelm
parents: 26625
diff changeset
    49
    val parameters =
4fc89bfc4b0c adapted PolyML.compiler to latest change of basis/FinalPolyML.sml (2008-04-21);
wenzelm
parents: 26625
diff changeset
    50
     [PolyML.Compiler.CPOutStream put,
4fc89bfc4b0c adapted PolyML.compiler to latest change of basis/FinalPolyML.sml (2008-04-21);
wenzelm
parents: 26625
diff changeset
    51
      PolyML.Compiler.CPLineNo (fn () => ! current_line),
28268
ac8431ecd57e use_text/use_file now depend on explicit ML name space;
wenzelm
parents: 28255
diff changeset
    52
      PolyML.Compiler.CPErrorMessageProc (put o message),
ac8431ecd57e use_text/use_file now depend on explicit ML name space;
wenzelm
parents: 28255
diff changeset
    53
      PolyML.Compiler.CPNameSpace name_space];
26379
a01a05cdd3b8 updated use_text/file for 5.2;
wenzelm
parents: 26215
diff changeset
    54
    val _ =
a01a05cdd3b8 updated use_text/file for 5.2;
wenzelm
parents: 26215
diff changeset
    55
      (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
    56
        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
    57
      handle exn =>
e0cc4169626e use_text: explicitly print exception, which is no longer done by the new PolyML.compiler setup;
wenzelm
parents: 26504
diff changeset
    58
       (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
    59
        err (output ()); raise exn);
26883
ae6ae88f9240 use_text/file: proper position output;
wenzelm
parents: 26879
diff changeset
    60
  in if verbose then print (output ()) else () end;
3588
e487bf0ed6c4 cleaned up;
wenzelm
parents: 2408
diff changeset
    61
28268
ac8431ecd57e use_text/use_file now depend on explicit ML name space;
wenzelm
parents: 28255
diff changeset
    62
fun use_file tune str_of_pos name_space output verbose name =
24598
44a1c0c68e21 added ml_system_fix_ints;
wenzelm
parents: 24329
diff changeset
    63
  let
44a1c0c68e21 added ml_system_fix_ints;
wenzelm
parents: 24329
diff changeset
    64
    val instream = TextIO.openIn name;
26504
6e87c0a60104 before close: Exn.capture/release;
wenzelm
parents: 26390
diff changeset
    65
    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
    66
  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
    67
26883
ae6ae88f9240 use_text/file: proper position output;
wenzelm
parents: 26879
diff changeset
    68
end;