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