src/Pure/ML-Systems/polyml.ML
author wenzelm
Mon, 16 Dec 1996 10:04:45 +0100
changeset 2408 acddf41dbbf7
parent 2341 e154da40ef00
child 3588 e487bf0ed6c4
permissions -rw-r--r--
added needs_filtered_use;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
2341
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
     1
(*  Title:      Pure/ML-Systems/polyml.ML
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
     2
    ID:         $Id$
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
     3
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
     4
    Copyright   1991  University of Cambridge
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
     5
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
     6
Compatibility file for Poly/ML (versions 2.x, 3.x).
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
     7
*)
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
     8
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
     9
open PolyML ExtendedIO;
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    10
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    11
use"basis.ML";
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    12
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    13
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    14
(*A conditional timing function: applies f to () and, if the flag is true,
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    15
  prints its runtime.*)
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    16
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    17
fun cond_timeit flag f =
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    18
  if flag then
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    19
    let val before = System.processtime()
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    20
        val result = f()
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    21
        val both = real(System.processtime() - before) / 10.0
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    22
    in  output(std_out, "Process time (incl GC): "^
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    23
                         makestring both ^ " secs\n");
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    24
        result
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    25
    end
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    26
  else f();
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    27
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    28
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    29
(*Interface for toplevel pretty printers, see also Pure/install_pp.ML*)
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    30
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    31
fun make_pp _ pprint (str, blk, brk, en) obj =
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    32
  pprint obj (str, fn ind => blk (ind, false), fn wd => brk (wd, 0),
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    33
    fn () => brk (99999, 0), en);
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    34
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    35
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    36
(*** File handling ***)
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    37
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    38
local
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    39
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    40
(*These are functions from library.ML *)
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    41
fun take_suffix _ [] = ([], [])
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    42
  | take_suffix pred (x :: xs) =
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    43
      (case take_suffix pred xs of
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    44
         ([], sffx) => if pred x then ([], x :: sffx)
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    45
                                 else ([x], sffx)
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    46
       | (prfx, sffx) => (x :: prfx, sffx));
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    47
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    48
fun apr (f,y) x = f(x,y);
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    49
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    50
fun seq (proc: 'a -> unit) : 'a list -> unit =
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    51
  let fun seqf [] = ()
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    52
        | seqf (x :: xs) = (proc x; seqf xs)
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    53
  in seqf end;
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    54
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    55
fun radixpand num : int list =
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    56
  let fun radix (n, tail) =
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    57
    if n < 10 then n :: tail else radix (n div 10, (n mod 10) :: tail)
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    58
  in radix (num, []) end;
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    59
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    60
fun radixstring num =
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    61
  let fun chrof n = chr (ord "0" + n);
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    62
  in implode (map chrof (radixpand num)) end;
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    63
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    64
in
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    65
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    66
(*Get time of last modification; if file doesn't exist return an empty string*)
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    67
fun file_info "" = ""
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    68
  | file_info name = radixstring (System.filedate name)  handle _ => "";
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    69
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    70
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    71
structure OS =
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    72
  struct
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    73
  structure FileSys =
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    74
    struct
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    75
    val chDir = PolyML.cd
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    76
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    77
    fun remove name =    (*Delete a file *)
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    78
      let val (is, os) = ExtendedIO.execute ("rm " ^ name)
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    79
      in close_in is; close_out os end;
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    80
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    81
    (*Get pathname of current working directory *)
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    82
    fun getDir () =
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    83
      let val (is, os) = ExtendedIO.execute ("pwd")
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    84
	  val (path, _) = take_suffix (apr(op=,"\n")) (*remove newline*)
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    85
			   (explode (ExtendedIO.input_line is)) 
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    86
      in close_in is; close_out os; implode path end;
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    87
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    88
    end
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    89
  end;
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    90
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    91
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    92
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    93
(*** ML command execution ***)
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    94
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    95
val use_string =
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    96
  let fun exec command =
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    97
    let val firstLine = ref true;
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    98
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
    99
        fun getLine () =
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
   100
          if !firstLine
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
   101
          then (firstLine := false; command)
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
   102
          else raise Io "use_string: buffer exhausted"
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
   103
    in PolyML.compiler (getLine, fn s => output (std_out, s)) () end
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
   104
  in seq exec end;
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
   105
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
   106
end;
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
   107
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
   108
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
   109
(*** System command execution ***)
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
   110
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
   111
(*Execute an Unix command which doesn't take any input from stdin and
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
   112
  sends its output to stdout.*)
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
   113
fun execute command =
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
   114
  let val (is, os) =  ExtendedIO.execute command;
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
   115
      val result = input (is, 999999);
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
   116
  in close_out os;
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
   117
     close_in is;
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
   118
     result
e154da40ef00 Compatibility file for Poly/ML (versions 2.x, 3.x).
wenzelm
parents:
diff changeset
   119
  end;
2408
acddf41dbbf7 added needs_filtered_use;
wenzelm
parents: 2341
diff changeset
   120
acddf41dbbf7 added needs_filtered_use;
wenzelm
parents: 2341
diff changeset
   121
acddf41dbbf7 added needs_filtered_use;
wenzelm
parents: 2341
diff changeset
   122
(* symbol input *)
acddf41dbbf7 added needs_filtered_use;
wenzelm
parents: 2341
diff changeset
   123
acddf41dbbf7 added needs_filtered_use;
wenzelm
parents: 2341
diff changeset
   124
val needs_filtered_use =
acddf41dbbf7 added needs_filtered_use;
wenzelm
parents: 2341
diff changeset
   125
  (case explode ml_system of
acddf41dbbf7 added needs_filtered_use;
wenzelm
parents: 2341
diff changeset
   126
    "p" :: "o" :: "l" :: "y" :: "m" :: "l" :: "-" :: "3" :: _ => true
acddf41dbbf7 added needs_filtered_use;
wenzelm
parents: 2341
diff changeset
   127
  | _ => false);