src/Pure/ML-Systems/MLWorks.ML
author paulson
Thu, 11 Sep 1997 12:24:28 +0200
changeset 3668 a39baf59ea47
parent 3631 88a279998f90
child 4234 59af75feccc4
permissions -rw-r--r--
Split base cases from "msg" to "atomic" in order to reduce the number of freeness theorems
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
3493
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
     1
(*  Title:      Pure/MLWorks.ML
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
     2
    ID:         $Id$
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
     3
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
     4
    Copyright   1996  University of Cambridge
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
     5
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
     6
Compatibility file for MLWorks (??)
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
     7
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
     8
NB: There is still no easy way of building Isabelle under MLWorks.  This file
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
     9
    is just a start towards compatibility.  One problem is the peculiar
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    10
    behaviour of "use" in MLWorks.  Strange errors occur when loading theories,
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    11
    and ROOT.ML files on subdirectories are loaded incorrectly.
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    12
*)
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    13
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    14
(*** Poly/ML emulation ***)
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    15
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    16
(**
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    17
Shell.File.loadSource "system.__os";
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    18
Shell.File.loadSource "basis.__timer";
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    19
Shell.File.loadSource "system.__time";
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    20
Shell.File.loadSource "unix.__os_file_sys";
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    21
Shell.File.loadSource "basis.__list";
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    22
Shell.File.loadSource "basis.__char";
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    23
Shell.File.loadSource "basis.__string";
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    24
Shell.File.loadSource "basis.__text_io";
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    25
**)
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    26
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    27
3539
d4443afc8d28 Option is a synonym for General because MLWorks does not yet provide
paulson
parents: 3493
diff changeset
    28
structure Option = General;
d4443afc8d28 Option is a synonym for General because MLWorks does not yet provide
paulson
parents: 3493
diff changeset
    29
3493
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    30
(*To exit the system with an exit code -- an alternative to ^D *)
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    31
fun exit 0 = OS.Process.exit OS.Process.success
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    32
  | exit _ = OS.Process.exit OS.Process.failure;
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    33
fun quit () = exit 0;
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    34
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    35
(*To limit the printing depth [divided by 2 for comparibility with Poly/ML]*)
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    36
fun print_depth n = ();
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    37
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    38
(*Interface for toplevel pretty printers, see also Pure/install_pp.ML
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    39
  CURRENTLY UNAVAILABLE*)
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    40
fun make_pp path pprint = ();
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    41
fun install_pp _ = ();
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    42
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    43
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    44
(*** New Jersey ML parameters ***)
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    45
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    46
(*** Character/string functions which are compatible with 0.93 and Poly/ML ***)
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    47
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    48
fun ord s = Char.ord (String.sub(s,0));
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    49
val chr = str o Char.chr;
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    50
val explode = (map str) o String.explode;
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    51
val implode = String.concat;
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    52
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    53
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    54
(*** Timing functions ***)
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    55
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    56
(*A conditional timing function: applies f to () and, if the flag is true,
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    57
  prints its runtime. *)
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    58
fun cond_timeit flag f =
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    59
  if flag then
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    60
    let open Time  (*...for Time.toString, Time.+ and Time.- *)
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    61
	val CPUtimer = Timer.startCPUTimer();
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    62
        val {gc=gct1,sys=syst1,usr=usrt1} = Timer.checkCPUTimer(CPUtimer);
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    63
        val result = f();
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    64
        val {gc=gct2,sys=syst2,usr=usrt2} = Timer.checkCPUTimer(CPUtimer)
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    65
    in  print("User " ^ toString (usrt2-usrt1) ^
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    66
              "  GC " ^ toString (gct2-gct1) ^
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    67
              "  All "^ toString (syst2-syst1 + usrt2-usrt1 + gct2-gct1) ^
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    68
              " secs\n")
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    69
	  handle Time => ();
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    70
        result
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    71
    end
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    72
  else f();
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    73
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    74
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    75
(*** File handling ***)
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    76
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    77
(*Get time of last modification; if file doesn't exist return an empty string*)
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    78
fun file_info "" = ""
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    79
  | file_info name = Time.toString (OS.FileSys.modTime name) handle _ =>"";
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    80
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    81
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    82
(*** ML command execution ***)
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    83
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    84
val tmpName = OS.FileSys.tmpName();
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    85
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    86
(*Can one redirect 'use' directly to an instream?*)
3631
88a279998f90 renamed use_string to use_strings;
wenzelm
parents: 3597
diff changeset
    87
fun use_strings slist =
3493
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    88
  let val tmpFile = TextIO.openOut tmpName
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    89
  in app (fn s => TextIO.output (tmpFile, s)) slist;
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    90
     TextIO.closeOut tmpFile;
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    91
     use tmpName
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    92
  end;
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    93
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    94
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    95
(*** System command execution ***)
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    96
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    97
(*Execute an Unix command which doesn't take any input from stdin and
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    98
  sends its output to stdout.
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
    99
  This could be done more easily by Unix.execute, but that function
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
   100
  doesn't use the PATH.*)
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
   101
fun execute command =
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
   102
  let val is = (OS.Process.system (command ^ " > " ^ tmpName);
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
   103
                TextIO.openIn tmpName);
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
   104
      val result = TextIO.inputAll is;
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
   105
  in TextIO.closeIn is;
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
   106
     OS.FileSys.remove tmpName;
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
   107
     result
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
   108
  end;
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
   109
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
   110
3597
3ac6d6bcae42 added getenv;
wenzelm
parents: 3587
diff changeset
   111
(* getenv *)
3ac6d6bcae42 added getenv;
wenzelm
parents: 3587
diff changeset
   112
3ac6d6bcae42 added getenv;
wenzelm
parents: 3587
diff changeset
   113
local
3ac6d6bcae42 added getenv;
wenzelm
parents: 3587
diff changeset
   114
  fun drop_last [] = []
3ac6d6bcae42 added getenv;
wenzelm
parents: 3587
diff changeset
   115
    | drop_last [x] = []
3ac6d6bcae42 added getenv;
wenzelm
parents: 3587
diff changeset
   116
    | drop_last (x :: xs) = x :: drop_last xs;
3ac6d6bcae42 added getenv;
wenzelm
parents: 3587
diff changeset
   117
3ac6d6bcae42 added getenv;
wenzelm
parents: 3587
diff changeset
   118
  val drop_last_char = implode o drop_last o explode;
3ac6d6bcae42 added getenv;
wenzelm
parents: 3587
diff changeset
   119
in
3ac6d6bcae42 added getenv;
wenzelm
parents: 3587
diff changeset
   120
  fun getenv var = drop_last_char
3ac6d6bcae42 added getenv;
wenzelm
parents: 3587
diff changeset
   121
    (execute ("env | grep '^" ^ var ^ "=' | sed -e 's/" ^ var ^ "=//'"));
3ac6d6bcae42 added getenv;
wenzelm
parents: 3587
diff changeset
   122
end;
3493
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
   123
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
   124
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
   125
(*Non-printing and 8-bit chars are forbidden in string constants*)
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
   126
val needs_filtered_use = true;
124103119f1c Moved MLWorks.ML to its proper place, directory ML-Systems.
paulson
parents:
diff changeset
   127