src/Pure/NJ.ML
author clasohm
Tue, 24 Oct 1995 13:40:06 +0100
changeset 1289 2edd7a39d92a
parent 907 61fcac0e50fc
child 1480 85ecd3439e01
permissions -rw-r--r--
added "execute"
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     1
(*  Title:      Pure/NJ
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     2
    ID:         $Id$
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     3
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     4
    Copyright   1993  University of Cambridge
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     5
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     6
Compatibility file for Standard ML of New Jersey.
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     7
*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     8
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     9
(*** Poly/ML emulation ***)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    10
907
61fcac0e50fc exit: new, for use in Makefiles
lcp
parents: 396
diff changeset
    11
(*To exit the system with an exit code -- an alternative to ^D *)
61fcac0e50fc exit: new, for use in Makefiles
lcp
parents: 396
diff changeset
    12
val exit = System.Unsafe.CInterface.exit;
61fcac0e50fc exit: new, for use in Makefiles
lcp
parents: 396
diff changeset
    13
fun quit () = exit 0;
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    14
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    15
(*To change the current directory*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    16
val cd = System.Directory.cd;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    17
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    18
(*To limit the printing depth [divided by 2 for comparibility with Poly/ML]*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    19
fun print_depth n = (System.Control.Print.printDepth := n div 2;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    20
                     System.Control.Print.printLength := n);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    21
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    22
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    23
(*Interface for toplevel pretty printers, see also Pure/install_pp.ML*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    24
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    25
fun make_pp path pprint =
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    26
  let
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    27
    open System.PrettyPrint;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    28
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    29
    fun pp pps obj =
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    30
      pprint obj
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    31
        (add_string pps, begin_block pps INCONSISTENT,
19
929ad32d63fc Pure/ROOT.ML
wenzelm
parents: 0
diff changeset
    32
          fn wd => add_break pps (wd, 0), fn () => add_newline pps,
929ad32d63fc Pure/ROOT.ML
wenzelm
parents: 0
diff changeset
    33
          fn () => end_block pps);
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    34
  in
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    35
    (path, pp)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    36
  end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    37
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    38
fun install_pp (path, pp) = System.PrettyPrint.install_pp path pp;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    39
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    40
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    41
(*** New Jersey ML parameters ***)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    42
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    43
(* Suppresses Garbage Collection messages;  default was 2 *)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    44
System.Control.Runtime.gcmessages := 0;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    45
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    46
(*redefine to flush its output immediately -- temporary patch suggested
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    47
  by Kim Dam Petersen*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    48
val output = fn(s, t) => (output(s, t); flush_out s);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    49
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    50
(*Dummy version of the Poly/ML function*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    51
fun commit() = ();
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    52
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    53
(*For use in Makefiles -- saves space*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    54
fun xML filename banner = (exportML filename;  print(banner^"\n"));
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    55
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    56
(*** Timing functions ***)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    57
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    58
(*Print microseconds, suppressing trailing zeroes*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    59
fun umakestring 0 = ""
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    60
  | umakestring n = chr(ord"0" + n div 100000) ^
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    61
                    umakestring(10 * (n mod 100000));
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    62
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    63
(*A conditional timing function: applies f to () and, if the flag is true,
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    64
  prints its runtime. *)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    65
fun cond_timeit flag f =
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    66
  if flag then
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    67
    let fun string_of_time (System.Timer.TIME {sec, usec}) =
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    68
            makestring sec ^ "." ^ (if usec=0 then "0" else umakestring usec)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    69
        open System.Timer;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    70
        val start = start_timer()
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    71
        val result = f();
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    72
        val nongc = check_timer(start)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    73
        and gc = check_timer_gc(start);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    74
        val both = add_time(nongc, gc)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    75
    in  print("Non GC " ^ string_of_time nongc ^
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    76
               "   GC " ^ string_of_time gc ^
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    77
               "  both "^ string_of_time both ^ " secs\n");
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    78
        result
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    79
    end
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    80
  else f();
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    81
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    82
66
1b14cd923772 /NJ,POLY/delete_file: new
lcp
parents: 19
diff changeset
    83
(*** File handling ***)
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    84
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    85
(*Get time of last modification.*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    86
local
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    87
    open System.Timer;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    88
    open System.Unsafe.SysIO;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    89
in
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    90
  fun file_info "" = ""
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    91
    | file_info name = makestring (mtime (PATH name));
220
e50ea2471e06 used unlink for delete_files instead of calling rm
clasohm
parents: 100
diff changeset
    92
e50ea2471e06 used unlink for delete_files instead of calling rm
clasohm
parents: 100
diff changeset
    93
  val delete_file = unlink;
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    94
end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    95
100
e95b98536b3d fixed a bug in POLY.ML: delete_file didn't close streams;
clasohm
parents: 73
diff changeset
    96
(*Get pathname of current working directory *)
e95b98536b3d fixed a bug in POLY.ML: delete_file didn't close streams;
clasohm
parents: 73
diff changeset
    97
fun pwd () = System.Directory.getWD ();
378
85ff48546a05 added use_string: string -> unit to execute ML commands passed in a string
clasohm
parents: 220
diff changeset
    98
85ff48546a05 added use_string: string -> unit to execute ML commands passed in a string
clasohm
parents: 220
diff changeset
    99
85ff48546a05 added use_string: string -> unit to execute ML commands passed in a string
clasohm
parents: 220
diff changeset
   100
(*** ML command execution ***)
85ff48546a05 added use_string: string -> unit to execute ML commands passed in a string
clasohm
parents: 220
diff changeset
   101
396
18c9c28d0f7e changed use_string's type to string list -> unit because POLY can only
clasohm
parents: 378
diff changeset
   102
fun use_string commands = 
18c9c28d0f7e changed use_string's type to string list -> unit because POLY can only
clasohm
parents: 378
diff changeset
   103
  System.Compile.use_stream (open_string (implode commands));
378
85ff48546a05 added use_string: string -> unit to execute ML commands passed in a string
clasohm
parents: 220
diff changeset
   104
1289
2edd7a39d92a added "execute"
clasohm
parents: 907
diff changeset
   105
2edd7a39d92a added "execute"
clasohm
parents: 907
diff changeset
   106
(*** System command execution ***)
2edd7a39d92a added "execute"
clasohm
parents: 907
diff changeset
   107
2edd7a39d92a added "execute"
clasohm
parents: 907
diff changeset
   108
(*Execute an Unix command which doesn't take any input from stdin and
2edd7a39d92a added "execute"
clasohm
parents: 907
diff changeset
   109
  sends its output to stdout.
2edd7a39d92a added "execute"
clasohm
parents: 907
diff changeset
   110
  This could be done more easily by IO.execute, but that function
2edd7a39d92a added "execute"
clasohm
parents: 907
diff changeset
   111
  seems to be buggy in SML/NJ 0.93.*)
2edd7a39d92a added "execute"
clasohm
parents: 907
diff changeset
   112
fun execute command =
2edd7a39d92a added "execute"
clasohm
parents: 907
diff changeset
   113
  let val tmp_name = "isa_converted.tmp"
2edd7a39d92a added "execute"
clasohm
parents: 907
diff changeset
   114
      val is = (System.system (command ^ " > " ^ tmp_name);
2edd7a39d92a added "execute"
clasohm
parents: 907
diff changeset
   115
                open_in tmp_name);
2edd7a39d92a added "execute"
clasohm
parents: 907
diff changeset
   116
      val result = input (is, 999999);
2edd7a39d92a added "execute"
clasohm
parents: 907
diff changeset
   117
  in close_in is;
2edd7a39d92a added "execute"
clasohm
parents: 907
diff changeset
   118
     delete_file tmp_name;
2edd7a39d92a added "execute"
clasohm
parents: 907
diff changeset
   119
     result
2edd7a39d92a added "execute"
clasohm
parents: 907
diff changeset
   120
  end;