src/Pure/NJ1xx.ML
author paulson
Fri May 30 15:14:59 1997 +0200 (1997-05-30)
changeset 3365 86c0d1988622
parent 3084 9844abe1de72
permissions -rw-r--r--
flushOut ensures that no recent error message are lost (not certain this is
necessary)
     1 (*  Title:      Pure/NJ1xx.ML
     2     ID:         $Id$
     3     Author:     Carsten Clasohm, TU Muenchen
     4     Copyright   1996  TU Muenchen
     5 
     6 Compatibility file for Standard ML of New Jersey version 1.xx.
     7 *)
     8 
     9 (*** Poly/ML emulation ***)
    10 
    11 
    12 (*To exit the system with an exit code -- an alternative to ^D *)
    13 fun exit 0 = OS.Process.exit OS.Process.success
    14   | exit _ = OS.Process.exit OS.Process.failure;
    15 fun quit () = exit 0;
    16 
    17 (*To limit the printing depth [divided by 2 for comparibility with Poly/ML]*)
    18 fun print_depth n = (Compiler.Control.Print.printDepth := n div 2;
    19                      Compiler.Control.Print.printLength := n);
    20 
    21 (*Interface for toplevel pretty printers, see also Pure/install_pp.ML*)
    22 
    23 fun make_pp path pprint =
    24   let
    25     open Compiler.PrettyPrint;
    26 
    27     fun pp pps obj =
    28       pprint obj
    29         (add_string pps, begin_block pps INCONSISTENT,
    30           fn wd => add_break pps (wd, 0), fn () => add_newline pps,
    31           fn () => end_block pps);
    32   in
    33     (path, pp)
    34   end;
    35 
    36 fun install_pp (path, pp) = Compiler.PPTable.install_pp path pp;
    37 
    38 
    39 (*** New Jersey ML parameters ***)
    40 
    41 (* Suppresses Garbage Collection messages; doesn't work yet *)
    42 (*System.Runtime.gc 0;*)
    43 
    44 val _ = (Compiler.Control.Print.printLength := 1000;
    45          Compiler.Control.Print.printDepth := 350;
    46          Compiler.Control.Print.stringDepth := 250;
    47          Compiler.Control.Print.signatures := 2);
    48 
    49 (*** Character/string functions which are compatible with 0.93 and Poly/ML ***)
    50 
    51 fun ord s = Char.ord (String.sub(s,0));
    52 val chr = str o Char.chr;
    53 val explode = (map str) o String.explode;
    54 val implode = String.concat;
    55 
    56 
    57 (*** Timing functions ***)
    58 
    59 (*A conditional timing function: applies f to () and, if the flag is true,
    60   prints its runtime. *)
    61 fun cond_timeit flag f =
    62   if flag then
    63     let open Time  (*...for Time.toString, Time.+ and Time.- *)
    64 	val CPUtimer = Timer.startCPUTimer();
    65         val {gc=gct1,sys=syst1,usr=usrt1} = Timer.checkCPUTimer(CPUtimer);
    66         val result = f();
    67         val {gc=gct2,sys=syst2,usr=usrt2} = Timer.checkCPUTimer(CPUtimer)
    68     in  print("User " ^ toString (usrt2-usrt1) ^
    69               "  GC " ^ toString (gct2-gct1) ^
    70               "  All "^ toString (syst2-syst1 + usrt2-usrt1 + gct2-gct1) ^
    71               " secs\n")
    72 	  handle Time => ();
    73         result
    74     end
    75   else f();
    76 
    77 
    78 (*** File handling ***)
    79 
    80 (*Get time of last modification; if file doesn't exist return an empty string*)
    81 fun file_info "" = ""
    82   | file_info name = Time.toString (OS.FileSys.modTime name) handle _ =>"";
    83 
    84 
    85 
    86 (*** ML command execution ***)
    87 
    88 
    89 (*For version 109.21 and later:*)
    90 val use_string = Compiler.Interact.useStream o TextIO.openString o implode;
    91 
    92 (*For versions prior to 109.21:*****
    93 fun use_string commands = 
    94    Compiler.Interact.use_stream (open_string (implode commands));
    95 *)
    96 
    97 (*** System command execution ***)
    98 
    99 (*Execute an Unix command which doesn't take any input from stdin and
   100   sends its output to stdout.
   101   This could be done more easily by Unix.execute, but that function
   102   doesn't use the PATH.*)
   103 fun execute command =
   104   let val tmp_name = "isa_converted.tmp"
   105       val is = (OS.Process.system (command ^ " > " ^ tmp_name);
   106                 TextIO.openIn tmp_name);
   107       val result = TextIO.inputAll is;
   108   in TextIO.closeIn is;
   109      OS.FileSys.remove tmp_name;
   110      result
   111   end;
   112 
   113 (*For exporting images.  The short name saves space in Makefiles*)
   114 fun xML filename banner =
   115   let open SMLofNJ
   116       val runtime = hd (SMLofNJ.getAllArgs())
   117       and exec_file = TextIO.openOut filename
   118   in 
   119      TextIO.output  (*Write a shell script to invoke the actual image*)
   120        (exec_file,
   121 	String.concat
   122 	["#!/bin/sh\n", runtime, 
   123 	 " @SMLdebug=/dev/null",  (*suppresses GC messages*)
   124 	 " @SMLload=", filename, ".heap\n"]);
   125      TextIO.closeOut exec_file;
   126      OS.Process.system ("chmod a+x " ^ filename);
   127      exportML (filename^".heap");
   128      print(banner^"\n")
   129   end;
   130 
   131 
   132 val needs_filtered_use = false;