src/Pure/ML-Systems/polyml.ML
author wenzelm
Wed, 20 Oct 1999 15:22:56 +0200
changeset 7890 0aa16bc2abdb
parent 7855 092a6435afad
child 8830 3e95f3a90875
permissions -rw-r--r--
use_text: remove last char from output;
     1 (*  Title:      Pure/ML-Systems/polyml.ML
     2     ID:         $Id$
     3     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     4     Copyright   1991  University of Cambridge
     5 
     6 Compatibility file for Poly/ML (versions 2.x and 3.x).
     7 *)
     8 
     9 open PolyML ExtendedIO;
    10 
    11 (*needs the Basis Library emulation*)
    12 use "basis.ML";
    13 
    14 
    15 structure String =
    16 struct
    17   fun substring (s,i,j) = StringBuiltIns.substring (s, i+1, j)
    18                           handle Substring => raise Subscript
    19   fun isPrefix s1 s2 = (s1 = substring(s2,0, size s1))
    20                        handle Subscript => false
    21 end;
    22 
    23 
    24 (** ML system related **)
    25 
    26 (** Compiler-independent timing functions **)
    27 
    28 (*Note start point for timing*)
    29 fun startTiming() = System.processtime ();
    30 
    31 (*Finish timing and return string*)
    32 fun endTiming before =
    33   "User + GC: " ^
    34   makestring (real (System.processtime () - before) / 10.0) ^
    35   " secs";
    36 
    37 
    38 (* prompts *)
    39 
    40 fun ml_prompts p1 p2 = (PolyML.Compiler.prompt1 := p1; PolyML.Compiler.prompt2 := p2);
    41 
    42 
    43 (* toplevel pretty printing (see also Pure/install_pp.ML) *)
    44 
    45 fun make_pp _ pprint (str, blk, brk, en) obj =
    46   pprint obj (str, fn ind => blk (ind, false), fn wd => brk (wd, 0),
    47     fn () => brk (99999, 0), en);
    48 
    49 
    50 (* ML command execution -- 'eval' *)
    51 
    52 local
    53 
    54 fun drop_last [] = []
    55   | drop_last [x] = []
    56   | drop_last (x :: xs) = x :: drop_last xs;
    57 
    58 val drop_last_char = implode o drop_last o explode;
    59 
    60 in
    61 
    62 fun use_text print verbose txt =
    63   let
    64     val in_buffer = ref (explode txt);
    65     val out_buffer = ref ([]: string list);
    66 
    67     fun get () =
    68       (case ! in_buffer of
    69         [] => ""
    70       | c :: cs => (in_buffer := cs; c));
    71     fun put s = out_buffer := s :: ! out_buffer;
    72 
    73     fun exec () =
    74       (case ! in_buffer of
    75         [] => ()
    76       | _ => (PolyML.compiler (get, put) (); exec ()));
    77 
    78     fun show_output () = print (drop_last_char (implode (rev (! out_buffer))));
    79   in
    80     exec () handle exn => (show_output (); raise exn);
    81     if verbose then show_output () else ()
    82   end;
    83 
    84 
    85 
    86 (** interrupts **)      (*Note: may get into race conditions*)
    87 
    88 fun mask_interrupt f x = f x;
    89 fun unmask_interrupt f x = f x;
    90 fun exhibit_interrupt f x = f x;
    91 
    92 
    93 
    94 (** OS related **)
    95 
    96 (* system command execution *)
    97 
    98 (*execute Unix command which doesn't take any input from stdin and
    99   sends its output to stdout*)
   100 fun execute command =
   101   let
   102     val (is, os) =  ExtendedIO.execute command;
   103     val _ = close_out os;
   104     val result = input (is, 999999);
   105   in close_in is; result end;
   106 
   107 fun system cmd = (print (execute cmd); 0);	(* FIXME rc not available *)
   108 
   109 
   110 (* file handling *)
   111 
   112 (*get time of last modification*)
   113 fun file_info name = Int.toString (System.filedate name) handle _ => "";
   114 
   115 structure OS =
   116 struct
   117   structure FileSys =
   118   struct
   119     val chDir = PolyML.cd;
   120     fun remove name = (execute ("rm " ^ name); ());
   121     fun getDir () = drop_last_char (execute "pwd");
   122   end;
   123 end;
   124 
   125 
   126 (* getenv *)
   127 
   128 fun getenv var = drop_last_char
   129   (execute ("env | grep '^" ^ var ^ "=' | sed -e 's/" ^ var ^ "=//'"));
   130 
   131 
   132 end;
   133 
   134 
   135 (* non-ASCII input (see also Thy/use.ML) *)
   136 
   137 val needs_filtered_use =
   138   (case explode ml_system of
   139     "p" :: "o" :: "l" :: "y" :: "m" :: "l" :: "-" :: "3" :: _ => true
   140   | _ => false);