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