src/Pure/RAW/compiler_polyml.ML
author wenzelm
Wed, 23 Dec 2015 23:09:13 +0100
changeset 61925 ab52f183f020
parent 60956 src/Pure/ML-Systems/compiler_polyml.ML@10d463883dc2
child 62354 fdd6989cc8a0
permissions -rw-r--r--
clarified directory structure;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
61925
ab52f183f020 clarified directory structure;
wenzelm
parents: 60956
diff changeset
     1
(*  Title:      Pure/RAW/compiler_polyml.ML
31312
1c00e4ff3c99 more modular setup of runtime compilation;
wenzelm
parents:
diff changeset
     2
50910
54f06ba192ef tuned comments;
wenzelm
parents: 47980
diff changeset
     3
Basic runtime compilation for Poly/ML (cf. Pure/ML/ml_compiler_polyml.ML).
31312
1c00e4ff3c99 more modular setup of runtime compilation;
wenzelm
parents:
diff changeset
     4
*)
1c00e4ff3c99 more modular setup of runtime compilation;
wenzelm
parents:
diff changeset
     5
1c00e4ff3c99 more modular setup of runtime compilation;
wenzelm
parents:
diff changeset
     6
local
1c00e4ff3c99 more modular setup of runtime compilation;
wenzelm
parents:
diff changeset
     7
1c00e4ff3c99 more modular setup of runtime compilation;
wenzelm
parents:
diff changeset
     8
fun drop_newline s =
1c00e4ff3c99 more modular setup of runtime compilation;
wenzelm
parents:
diff changeset
     9
  if String.isSuffix "\n" s then String.substring (s, 0, size s - 1)
1c00e4ff3c99 more modular setup of runtime compilation;
wenzelm
parents:
diff changeset
    10
  else s;
1c00e4ff3c99 more modular setup of runtime compilation;
wenzelm
parents:
diff changeset
    11
1c00e4ff3c99 more modular setup of runtime compilation;
wenzelm
parents:
diff changeset
    12
in
1c00e4ff3c99 more modular setup of runtime compilation;
wenzelm
parents:
diff changeset
    13
1c00e4ff3c99 more modular setup of runtime compilation;
wenzelm
parents:
diff changeset
    14
fun use_text ({tune_source, name_space, str_of_pos, print, error, ...}: use_context)
60956
10d463883dc2 explicit debug flag for ML compiler;
wenzelm
parents: 60955
diff changeset
    15
    {line, file, verbose, debug} text =
31312
1c00e4ff3c99 more modular setup of runtime compilation;
wenzelm
parents:
diff changeset
    16
  let
60955
wenzelm
parents: 56435
diff changeset
    17
    val current_line = Unsynchronized.ref line;
56435
28b34e8e4a80 approximate ML antiquotation @{here} for Isabelle/Pure bootstrap;
wenzelm
parents: 50910
diff changeset
    18
    val in_buffer =
60956
10d463883dc2 explicit debug flag for ML compiler;
wenzelm
parents: 60955
diff changeset
    19
      Unsynchronized.ref (String.explode (tune_source (ml_positions line file text)));
32738
15bb09ca0378 explicit indication of Unsynchronized.ref;
wenzelm
parents: 31480
diff changeset
    20
    val out_buffer = Unsynchronized.ref ([]: string list);
31312
1c00e4ff3c99 more modular setup of runtime compilation;
wenzelm
parents:
diff changeset
    21
    fun output () = drop_newline (implode (rev (! out_buffer)));
1c00e4ff3c99 more modular setup of runtime compilation;
wenzelm
parents:
diff changeset
    22
1c00e4ff3c99 more modular setup of runtime compilation;
wenzelm
parents:
diff changeset
    23
    fun get () =
1c00e4ff3c99 more modular setup of runtime compilation;
wenzelm
parents:
diff changeset
    24
      (case ! in_buffer of
1c00e4ff3c99 more modular setup of runtime compilation;
wenzelm
parents:
diff changeset
    25
        [] => NONE
60955
wenzelm
parents: 56435
diff changeset
    26
      | c :: cs =>
wenzelm
parents: 56435
diff changeset
    27
          (in_buffer := cs; if c = #"\n" then current_line := ! current_line + 1 else (); SOME c));
31312
1c00e4ff3c99 more modular setup of runtime compilation;
wenzelm
parents:
diff changeset
    28
    fun put s = out_buffer := s :: ! out_buffer;
60955
wenzelm
parents: 56435
diff changeset
    29
    fun put_message {message = msg1, hard, location = {startLine = message_line, ...}, context} =
31312
1c00e4ff3c99 more modular setup of runtime compilation;
wenzelm
parents:
diff changeset
    30
     (put (if hard then "Error: " else "Warning: ");
1c00e4ff3c99 more modular setup of runtime compilation;
wenzelm
parents:
diff changeset
    31
      PolyML.prettyPrint (put, 76) msg1;
1c00e4ff3c99 more modular setup of runtime compilation;
wenzelm
parents:
diff changeset
    32
      (case context of NONE => () | SOME msg2 => PolyML.prettyPrint (put, 76) msg2);
60955
wenzelm
parents: 56435
diff changeset
    33
      put ("At" ^ str_of_pos message_line file ^ "\n"));
31312
1c00e4ff3c99 more modular setup of runtime compilation;
wenzelm
parents:
diff changeset
    34
1c00e4ff3c99 more modular setup of runtime compilation;
wenzelm
parents:
diff changeset
    35
    val parameters =
1c00e4ff3c99 more modular setup of runtime compilation;
wenzelm
parents:
diff changeset
    36
     [PolyML.Compiler.CPOutStream put,
31471
e3987b32e401 use_text: pass file name to compiler, tuned;
wenzelm
parents: 31433
diff changeset
    37
      PolyML.Compiler.CPNameSpace name_space,
31312
1c00e4ff3c99 more modular setup of runtime compilation;
wenzelm
parents:
diff changeset
    38
      PolyML.Compiler.CPErrorMessageProc put_message,
60955
wenzelm
parents: 56435
diff changeset
    39
      PolyML.Compiler.CPLineNo (fn () => ! current_line),
wenzelm
parents: 56435
diff changeset
    40
      PolyML.Compiler.CPFileName file,
60956
10d463883dc2 explicit debug flag for ML compiler;
wenzelm
parents: 60955
diff changeset
    41
      PolyML.Compiler.CPPrintInAlphabeticalOrder false] @
10d463883dc2 explicit debug flag for ML compiler;
wenzelm
parents: 60955
diff changeset
    42
      ML_Compiler_Parameters.debug debug;
31312
1c00e4ff3c99 more modular setup of runtime compilation;
wenzelm
parents:
diff changeset
    43
    val _ =
1c00e4ff3c99 more modular setup of runtime compilation;
wenzelm
parents:
diff changeset
    44
      (while not (List.null (! in_buffer)) do
1c00e4ff3c99 more modular setup of runtime compilation;
wenzelm
parents:
diff changeset
    45
        PolyML.compiler (get, parameters) ())
1c00e4ff3c99 more modular setup of runtime compilation;
wenzelm
parents:
diff changeset
    46
      handle exn =>
39242
28d3809ff91f primitive use_text: let interrupts pass unhindered;
wenzelm
parents: 38470
diff changeset
    47
        if Exn.is_interrupt exn then reraise exn
28d3809ff91f primitive use_text: let interrupts pass unhindered;
wenzelm
parents: 38470
diff changeset
    48
        else
28d3809ff91f primitive use_text: let interrupts pass unhindered;
wenzelm
parents: 38470
diff changeset
    49
         (put ("Exception- " ^ General.exnMessage exn ^ " raised");
28d3809ff91f primitive use_text: let interrupts pass unhindered;
wenzelm
parents: 38470
diff changeset
    50
          error (output ()); reraise exn);
31312
1c00e4ff3c99 more modular setup of runtime compilation;
wenzelm
parents:
diff changeset
    51
  in if verbose then print (output ()) else () end;
1c00e4ff3c99 more modular setup of runtime compilation;
wenzelm
parents:
diff changeset
    52
60956
10d463883dc2 explicit debug flag for ML compiler;
wenzelm
parents: 60955
diff changeset
    53
fun use_file context {verbose, debug} file =
31312
1c00e4ff3c99 more modular setup of runtime compilation;
wenzelm
parents:
diff changeset
    54
  let
60955
wenzelm
parents: 56435
diff changeset
    55
    val instream = TextIO.openIn file;
60956
10d463883dc2 explicit debug flag for ML compiler;
wenzelm
parents: 60955
diff changeset
    56
    val text = Exn.release (Exn.capture TextIO.inputAll instream before TextIO.closeIn instream);
10d463883dc2 explicit debug flag for ML compiler;
wenzelm
parents: 60955
diff changeset
    57
  in use_text context {line = 1, file = file, verbose = verbose, debug = debug} text end;
31312
1c00e4ff3c99 more modular setup of runtime compilation;
wenzelm
parents:
diff changeset
    58
1c00e4ff3c99 more modular setup of runtime compilation;
wenzelm
parents:
diff changeset
    59
end;