| author | kleing | 
| Thu, 03 Nov 2011 18:10:13 +1100 | |
| changeset 45323 | df7554ebe024 | 
| parent 41717 | 8a1ab91df301 | 
| permissions | -rw-r--r-- | 
| 31312 | 1 | (* Title: Pure/ML-Systems/compiler_polyml-5.2.ML | 
| 2 | ||
| 41717 | 3 | Runtime compilation for Poly/ML 5.2.x. | 
| 31312 | 4 | *) | 
| 5 | ||
| 6 | local | |
| 7 | ||
| 8 | fun drop_newline s = | |
| 9 | if String.isSuffix "\n" s then String.substring (s, 0, size s - 1) | |
| 10 | else s; | |
| 11 | ||
| 12 | in | |
| 13 | ||
| 14 | fun use_text ({tune_source, name_space, str_of_pos, print, error, ...}: use_context)
 | |
| 15 | (start_line, name) verbose txt = | |
| 16 | let | |
| 32738 | 17 | val current_line = Unsynchronized.ref start_line; | 
| 18 | val in_buffer = Unsynchronized.ref (String.explode (tune_source txt)); | |
| 19 | val out_buffer = Unsynchronized.ref ([]: string list); | |
| 31312 | 20 | fun output () = drop_newline (implode (rev (! out_buffer))); | 
| 21 | ||
| 22 | fun get () = | |
| 23 | (case ! in_buffer of | |
| 24 | [] => NONE | |
| 25 | | c :: cs => | |
| 26 | (in_buffer := cs; if c = #"\n" then current_line := ! current_line + 1 else (); SOME c)); | |
| 27 | fun put s = out_buffer := s :: ! out_buffer; | |
| 28 | fun message (msg, is_err, line) = | |
| 29 | (if is_err then "Error: " else "Warning: ") ^ drop_newline msg ^ str_of_pos line name ^ "\n"; | |
| 30 | ||
| 31 | val parameters = | |
| 32 | [PolyML.Compiler.CPOutStream put, | |
| 33 | PolyML.Compiler.CPLineNo (fn () => ! current_line), | |
| 34 | PolyML.Compiler.CPErrorMessageProc (put o message), | |
| 35 | PolyML.Compiler.CPNameSpace name_space]; | |
| 36 | val _ = | |
| 37 | (while not (List.null (! in_buffer)) do | |
| 38 | PolyML.compiler (get, parameters) ()) | |
| 39 | handle exn => | |
| 39242 
28d3809ff91f
primitive use_text: let interrupts pass unhindered;
 wenzelm parents: 
32738diff
changeset | 40 | if Exn.is_interrupt exn then reraise exn | 
| 
28d3809ff91f
primitive use_text: let interrupts pass unhindered;
 wenzelm parents: 
32738diff
changeset | 41 | else | 
| 
28d3809ff91f
primitive use_text: let interrupts pass unhindered;
 wenzelm parents: 
32738diff
changeset | 42 |          (put ("Exception- " ^ General.exnMessage exn ^ " raised");
 | 
| 
28d3809ff91f
primitive use_text: let interrupts pass unhindered;
 wenzelm parents: 
32738diff
changeset | 43 | error (output ()); reraise exn); | 
| 31312 | 44 | in if verbose then print (output ()) else () end; | 
| 45 | ||
| 46 | fun use_file context verbose name = | |
| 47 | let | |
| 48 | val instream = TextIO.openIn name; | |
| 49 | val txt = Exn.release (Exn.capture TextIO.inputAll instream before TextIO.closeIn instream); | |
| 50 | in use_text context (1, name) verbose txt end; | |
| 51 | ||
| 52 | end; | |
| 53 |