src/Pure/ML-Systems/mosml.ML
author wenzelm
Tue, 17 Jul 2007 22:48:40 +0200
changeset 23836 c6094fe98dfd
parent 23826 463903573934
child 23921 947152add153
permissions -rw-r--r--
adapted TextIO.inputLine;
wenzelm@9254
     1
(*  Title:      Pure/ML-Systems/mosml.ML
wenzelm@9254
     2
    ID:         $Id$
wenzelm@9254
     3
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
wenzelm@9254
     4
    Copyright   1999  University of Cambridge
wenzelm@9254
     5
wenzelm@17491
     6
Compatibility file for Moscow ML 2.01
wenzelm@9254
     7
wenzelm@17491
     8
NOTE: saving images does not work; may run it interactively as follows:
wenzelm@9254
     9
wenzelm@23826
    10
$ cd Isabelle/src/Pure
wenzelm@9254
    11
$ isabelle RAW_ML_SYSTEM
wenzelm@9254
    12
> val ml_system = "mosml";
wenzelm@9254
    13
> use "ML-Systems/mosml.ML";
wenzelm@9254
    14
> use "ROOT.ML";
wenzelm@16470
    15
> Session.finish ();
wenzelm@23836
    16
> cd "../FOL";
wenzelm@16470
    17
> use "ROOT.ML";
wenzelm@9254
    18
*)
wenzelm@9254
    19
wenzelm@9254
    20
(** ML system related **)
wenzelm@9254
    21
wenzelm@16517
    22
load "Obj";
wenzelm@9254
    23
load "Bool";
wenzelm@9254
    24
load "Int";
wenzelm@9254
    25
load "Real";
wenzelm@9254
    26
load "ListPair";
wenzelm@9254
    27
load "OS";
wenzelm@9254
    28
load "Process";
wenzelm@9254
    29
load "FileSys";
wenzelm@21298
    30
load "IO";
wenzelm@9254
    31
wenzelm@16517
    32
(*low-level pointer equality*)
wenzelm@16517
    33
local val cast : 'a -> int = Obj.magic
wenzelm@16517
    34
in fun pointer_eq (x:'a, y:'a) = (cast x = cast y) end;
wenzelm@16517
    35
wenzelm@16469
    36
(*proper implementation available?*)
wenzelm@16469
    37
structure IntInf =
wenzelm@16469
    38
struct
wenzelm@16469
    39
  open Int;
wenzelm@16469
    40
end;
wenzelm@16469
    41
wenzelm@16469
    42
structure Real =
wenzelm@16469
    43
struct
wenzelm@16469
    44
  open Real;
wenzelm@16469
    45
  val realFloor = real o floor;
wenzelm@16469
    46
end;
wenzelm@16469
    47
wenzelm@17491
    48
structure String =
wenzelm@17491
    49
struct
wenzelm@17491
    50
  fun isSuffix s1 s2 =
wenzelm@17491
    51
    let val n1 = size s1 and n2 = size s2
wenzelm@17491
    52
    in if n1 = n2 then s1 = s2 else n1 <= n2 andalso String.substring (s2, n2 - n1, n1) = s1 end;
wenzelm@17491
    53
  open String;
wenzelm@17491
    54
end;
wenzelm@17491
    55
wenzelm@16469
    56
structure Time =
wenzelm@16469
    57
struct
wenzelm@16469
    58
  open Time;
wenzelm@16469
    59
  fun toString t = Time.toString t
wenzelm@16469
    60
    handle Overflow => Real.toString (Time.toReal t);   (*workaround Y2004 bug*)
wenzelm@16469
    61
end;
wenzelm@16469
    62
wenzelm@9254
    63
structure OS =
wenzelm@16469
    64
struct
wenzelm@9254
    65
  open OS
wenzelm@9254
    66
  structure Process = Process
wenzelm@9254
    67
  structure FileSys = FileSys
wenzelm@16469
    68
end;
wenzelm@16993
    69
wenzelm@22252
    70
exception Option = Option.Option;
wenzelm@22252
    71
wenzelm@22252
    72
wenzelm@9254
    73
(*limit the printing depth*)
wenzelm@9254
    74
fun print_depth n =
wenzelm@9254
    75
 (Meta.printDepth := n div 2;
wenzelm@9254
    76
  Meta.printLength := n);
wenzelm@9254
    77
wenzelm@9254
    78
(*interface for toplevel pretty printers, see also Pure/install_pp.ML*)
wenzelm@9254
    79
(*the documentation refers to an installPP but I couldn't fine it!*)
wenzelm@9254
    80
fun make_pp path pprint = ();
wenzelm@9254
    81
fun install_pp _ = ();
wenzelm@9254
    82
wenzelm@16681
    83
(*dummy implementation*)
wenzelm@16681
    84
fun ml_prompts p1 p2 = ();
wenzelm@16681
    85
wenzelm@16681
    86
(*dummy implementation*)
wenzelm@16660
    87
fun profile (n: int) f x = f x;
wenzelm@16660
    88
haftmann@18384
    89
(*dummy implementation*)
wenzelm@16681
    90
fun exception_trace f = f ();
wenzelm@9254
    91
haftmann@18384
    92
(*dummy implementation*)
haftmann@18384
    93
fun print x = x;
haftmann@18384
    94
wenzelm@9254
    95
wenzelm@9254
    96
(** Compiler-independent timing functions **)
wenzelm@9254
    97
wenzelm@9254
    98
load "Timer";
wenzelm@9254
    99
wenzelm@21298
   100
fun start_timing () =
wenzelm@21298
   101
  let val CPUtimer = Timer.startCPUTimer();
wenzelm@21298
   102
      val time = Timer.checkCPUTimer(CPUtimer)
wenzelm@21298
   103
  in  (CPUtimer,time)  end;
wenzelm@21298
   104
wenzelm@21298
   105
fun end_timing (CPUtimer, {gc,sys,usr}) =
wenzelm@21298
   106
  let open Time  (*...for Time.toString, Time.+ and Time.- *)
wenzelm@21298
   107
      val {gc=gc2,sys=sys2,usr=usr2} = Timer.checkCPUTimer(CPUtimer)
wenzelm@21298
   108
  in  "User " ^ toString (usr2-usr) ^
wenzelm@21298
   109
      "  GC " ^ toString (gc2-gc) ^
wenzelm@21298
   110
      "  All "^ toString (sys2-sys + usr2-usr + gc2-gc) ^
wenzelm@21298
   111
      " secs"
wenzelm@21298
   112
      handle Time => ""
wenzelm@21298
   113
  end;
wenzelm@21298
   114
wenzelm@21298
   115
fun check_timer timer =
wenzelm@21298
   116
  let val {sys, usr, gc} = Timer.checkCPUTimer timer
wenzelm@21298
   117
  in (sys, usr, gc) end;
wenzelm@21298
   118
wenzelm@21298
   119
wenzelm@21298
   120
(* SML basis library fixes *)
wenzelm@21298
   121
wenzelm@21298
   122
structure TextIO =
wenzelm@21298
   123
struct
wenzelm@21298
   124
  fun canInput _ = raise IO.Io {cause = Fail "undefined", function = "canInput", name = ""};
wenzelm@21298
   125
  open TextIO;
wenzelm@23836
   126
  fun inputLine is =
wenzelm@23836
   127
    let val s = TextIO.inputLine is
wenzelm@23836
   128
    in if s = "" then NONE else SOME s end;
wenzelm@21298
   129
end;
wenzelm@21298
   130
wenzelm@9254
   131
webertj@14851
   132
(* bounded time execution *)
webertj@14851
   133
wenzelm@21280
   134
(*dummy implementation*)
webertj@18760
   135
fun interrupt_timeout time f x =
webertj@18760
   136
  f x;
wenzelm@16517
   137
wenzelm@21280
   138
wenzelm@9254
   139
(* ML command execution *)
wenzelm@9254
   140
wenzelm@9254
   141
(*Can one redirect 'use' directly to an instream?*)
wenzelm@22144
   142
fun use_text _ _ _ txt =
wenzelm@9254
   143
  let
wenzelm@9254
   144
    val tmp_name = FileSys.tmpName ();
wenzelm@9254
   145
    val tmp_file = TextIO.openOut tmp_name;
wenzelm@9254
   146
  in
wenzelm@9254
   147
    TextIO.output (tmp_file, txt);
wenzelm@9254
   148
    TextIO.closeOut tmp_file;
wenzelm@9254
   149
    use tmp_name;
wenzelm@9254
   150
    FileSys.remove tmp_name
wenzelm@9254
   151
  end;
wenzelm@9254
   152
wenzelm@22252
   153
fun use_file _ _ name = use name;
wenzelm@21770
   154
wenzelm@9254
   155
wenzelm@9254
   156
wenzelm@16993
   157
(** interrupts **)      (*Note: may get into race conditions*)
wenzelm@9254
   158
wenzelm@9254
   159
(* FIXME proper implementation available? *)
wenzelm@9254
   160
wenzelm@9254
   161
exception Interrupt;
wenzelm@9254
   162
wenzelm@16993
   163
fun ignore_interrupt f x = f x;
wenzelm@12988
   164
fun raise_interrupt f x = f x;
wenzelm@9254
   165
wenzelm@9254
   166
wenzelm@9254
   167
wenzelm@9254
   168
(** OS related **)
wenzelm@9254
   169
wenzelm@23826
   170
(* current directory *)
wenzelm@23826
   171
wenzelm@23826
   172
val cd = OS.FileSys.chDir;
wenzelm@23826
   173
val pwd = OS.FileSys.getDir;
wenzelm@23826
   174
wenzelm@23826
   175
wenzelm@9254
   176
(* system command execution *)
wenzelm@9254
   177
wenzelm@9254
   178
(*execute Unix command which doesn't take any input from stdin and
wenzelm@9254
   179
  sends its output to stdout; could be done more easily by Unix.execute,
wenzelm@9254
   180
  but that function doesn't use the PATH*)
wenzelm@9254
   181
fun execute command =
wenzelm@9254
   182
  let
wenzelm@9254
   183
    val tmp_name = FileSys.tmpName ();
wenzelm@16993
   184
    val is = (Process.system (command ^ " > " ^ tmp_name); TextIO.openIn tmp_name);
wenzelm@9254
   185
    val result = TextIO.inputAll is;
wenzelm@9254
   186
  in
wenzelm@9254
   187
    TextIO.closeIn is;
wenzelm@9254
   188
    FileSys.remove tmp_name;
wenzelm@9254
   189
    result
wenzelm@9254
   190
  end;
wenzelm@9254
   191
wenzelm@9254
   192
(*plain version; with return code*)
wenzelm@9254
   193
fun system cmd =
wenzelm@9254
   194
  if Process.system cmd = Process.success then 0 else 1;
wenzelm@9254
   195
wenzelm@9254
   196
wenzelm@17824
   197
val string_of_pid = Int.toString;
wenzelm@17824
   198
wenzelm@17824
   199
wenzelm@9254
   200
(* getenv *)
wenzelm@9254
   201
wenzelm@9254
   202
fun getenv var =
wenzelm@9254
   203
  (case Process.getEnv var of
wenzelm@9254
   204
    NONE => ""
wenzelm@9254
   205
  | SOME txt => txt);