src/Pure/ML-Systems/mosml.ML
author wenzelm
Sun, 19 Jun 2005 00:07:41 +0200
changeset 16470 051db5bb21b5
parent 16469 7e27422c603e
child 16502 5a56e59526a5
permissions -rw-r--r--
improved comment;
     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.00
     7 
     8 NOTE: saving images does not work (yet!?), may run it interactively as follows:
     9 
    10 $ cd ~~/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 "../HOL";
    17 > use "ROOT.ML";
    18 *)
    19 
    20 (** ML system related **)
    21 
    22 (* Poly/ML emulation *)
    23 
    24 load "Bool";
    25 load "Int";
    26 load "Real";
    27 load "ListPair";
    28 load "OS";
    29 load "Process";
    30 load "FileSys";
    31 
    32 (*proper implementation available?*)
    33 structure IntInf =
    34 struct
    35   open Int;
    36 end;
    37 
    38 structure Real =
    39 struct
    40   open Real;
    41   val realFloor = real o floor;
    42 end;
    43 
    44 structure Time =
    45 struct
    46   open Time;
    47   fun toString t = Time.toString t
    48     handle Overflow => Real.toString (Time.toReal t);   (*workaround Y2004 bug*)
    49 end;
    50 
    51 structure OS =
    52 struct
    53   open OS
    54   structure Process = Process
    55   structure FileSys = FileSys
    56 end;
    57  
    58 (*limit the printing depth*)
    59 fun print_depth n =
    60  (Meta.printDepth := n div 2;
    61   Meta.printLength := n);
    62 
    63 (*interface for toplevel pretty printers, see also Pure/install_pp.ML*)
    64 (*the documentation refers to an installPP but I couldn't fine it!*)
    65 fun make_pp path pprint = ();
    66 fun install_pp _ = ();
    67 
    68 (*prompts*)
    69 (*n.a.??*)
    70 fun ml_prompts p1 p2 = ();
    71 
    72 
    73 (** Compiler-independent timing functions **)
    74 
    75 load "Timer";
    76 
    77 use "ML-Systems/cpu-timer-gc.ML";
    78 
    79 (* bounded time execution *)
    80 
    81 (* FIXME proper implementation available? *)
    82 
    83 structure TimeLimit : sig
    84    exception TimeOut
    85    val timeLimit : Time.time -> ('a -> 'b) -> 'a -> 'b
    86 end = struct
    87    exception TimeOut
    88    fun timeLimit t f x =
    89       f x;
    90 end;
    91 
    92 (* ML command execution *)
    93 
    94 (*Can one redirect 'use' directly to an instream?*)
    95 fun use_text _ _ txt =
    96   let
    97     val tmp_name = FileSys.tmpName ();
    98     val tmp_file = TextIO.openOut tmp_name;
    99   in
   100     TextIO.output (tmp_file, txt);
   101     TextIO.closeOut tmp_file;
   102     use tmp_name;
   103     FileSys.remove tmp_name
   104   end;
   105 
   106 
   107 
   108 (** interrupts **)	(*Note: may get into race conditions*)
   109 
   110 (* FIXME proper implementation available? *)
   111 
   112 exception Interrupt;
   113 
   114 fun ignore_interrupt f x = f x;           
   115 fun raise_interrupt f x = f x;
   116 
   117 
   118 
   119 (** OS related **)
   120 
   121 (* system command execution *)
   122 
   123 (*execute Unix command which doesn't take any input from stdin and
   124   sends its output to stdout; could be done more easily by Unix.execute,
   125   but that function doesn't use the PATH*)
   126 fun execute command =
   127   let
   128     val tmp_name = FileSys.tmpName ();
   129     val is = (Process.system (command ^ " > " ^ tmp_name); TextIO.openIn 
   130 tmp_name);
   131     val result = TextIO.inputAll is;
   132   in
   133     TextIO.closeIn is;
   134     FileSys.remove tmp_name;
   135     result
   136   end;
   137 
   138 (*plain version; with return code*)
   139 fun system cmd =
   140   if Process.system cmd = Process.success then 0 else 1;
   141 
   142 
   143 (* getenv *)
   144 
   145 fun getenv var =
   146   (case Process.getEnv var of
   147     NONE => ""
   148   | SOME txt => txt);