src/Pure/POLY.ML
author paulson
Thu, 22 May 1997 15:10:37 +0200
changeset 3298 5f0ed3caa991
parent 2724 ddc6cf6b62e9
child 3406 131262e21ada
permissions -rw-r--r--
Now uses type option instead of Fail/Subst
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     1
(*  Title:      Pure/POLY
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     2
    ID:         $Id$
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     3
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     4
    Copyright   1991  University of Cambridge
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     5
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     6
Compatibility file for Poly/ML (AHL release 1.88)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     7
*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     8
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     9
open PolyML ExtendedIO;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    10
2242
fa8c6c695a97 Basis library emulation, especially of I/O operations
paulson
parents: 2141
diff changeset
    11
use"basis.ML";
2141
c2aedd8169cd Now defines structure Int
paulson
parents: 1480
diff changeset
    12
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    13
(*A conditional timing function: applies f to () and, if the flag is true,
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    14
  prints its runtime.*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    15
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    16
fun cond_timeit flag f =
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    17
  if flag then
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    18
    let val before = System.processtime()
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    19
        val result = f()
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    20
        val both = real(System.processtime() - before) / 10.0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    21
    in  output(std_out, "Process time (incl GC): "^
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    22
                         makestring both ^ " secs\n");
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    23
        result
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    24
    end
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    25
  else f();
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    26
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    27
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    28
(*Save function: in Poly/ML, ignores filename and commits to present file*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    29
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    30
fun xML filename banner = commit();
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    31
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    32
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    33
(*Interface for toplevel pretty printers, see also Pure/install_pp.ML*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    34
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    35
fun make_pp _ pprint (str, blk, brk, en) obj =
19
929ad32d63fc Pure/ROOT.ML
wenzelm
parents: 0
diff changeset
    36
  pprint obj (str, fn ind => blk (ind, false), fn wd => brk (wd, 0),
929ad32d63fc Pure/ROOT.ML
wenzelm
parents: 0
diff changeset
    37
    fn () => brk (99999, 0), en);
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    38
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    39
66
1b14cd923772 /NJ,POLY/delete_file: new
lcp
parents: 58
diff changeset
    40
(*** File handling ***)
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    41
100
e95b98536b3d fixed a bug in POLY.ML: delete_file didn't close streams;
clasohm
parents: 73
diff changeset
    42
local
e95b98536b3d fixed a bug in POLY.ML: delete_file didn't close streams;
clasohm
parents: 73
diff changeset
    43
e95b98536b3d fixed a bug in POLY.ML: delete_file didn't close streams;
clasohm
parents: 73
diff changeset
    44
(*These are functions from library.ML *)
e95b98536b3d fixed a bug in POLY.ML: delete_file didn't close streams;
clasohm
parents: 73
diff changeset
    45
fun take_suffix _ [] = ([], [])
e95b98536b3d fixed a bug in POLY.ML: delete_file didn't close streams;
clasohm
parents: 73
diff changeset
    46
  | take_suffix pred (x :: xs) =
e95b98536b3d fixed a bug in POLY.ML: delete_file didn't close streams;
clasohm
parents: 73
diff changeset
    47
      (case take_suffix pred xs of
e95b98536b3d fixed a bug in POLY.ML: delete_file didn't close streams;
clasohm
parents: 73
diff changeset
    48
         ([], sffx) => if pred x then ([], x :: sffx)
e95b98536b3d fixed a bug in POLY.ML: delete_file didn't close streams;
clasohm
parents: 73
diff changeset
    49
                                 else ([x], sffx)
e95b98536b3d fixed a bug in POLY.ML: delete_file didn't close streams;
clasohm
parents: 73
diff changeset
    50
       | (prfx, sffx) => (x :: prfx, sffx));
e95b98536b3d fixed a bug in POLY.ML: delete_file didn't close streams;
clasohm
parents: 73
diff changeset
    51
e95b98536b3d fixed a bug in POLY.ML: delete_file didn't close streams;
clasohm
parents: 73
diff changeset
    52
fun apr (f,y) x = f(x,y);
e95b98536b3d fixed a bug in POLY.ML: delete_file didn't close streams;
clasohm
parents: 73
diff changeset
    53
396
18c9c28d0f7e changed use_string's type to string list -> unit because POLY can only
clasohm
parents: 378
diff changeset
    54
fun seq (proc: 'a -> unit) : 'a list -> unit =
18c9c28d0f7e changed use_string's type to string list -> unit because POLY can only
clasohm
parents: 378
diff changeset
    55
  let fun seqf [] = ()
18c9c28d0f7e changed use_string's type to string list -> unit because POLY can only
clasohm
parents: 378
diff changeset
    56
        | seqf (x :: xs) = (proc x; seqf xs)
18c9c28d0f7e changed use_string's type to string list -> unit because POLY can only
clasohm
parents: 378
diff changeset
    57
  in seqf end;
18c9c28d0f7e changed use_string's type to string list -> unit because POLY can only
clasohm
parents: 378
diff changeset
    58
1437
2ebbc23d49fa beautified file_info a bit
clasohm
parents: 1436
diff changeset
    59
fun radixpand num : int list =
2ebbc23d49fa beautified file_info a bit
clasohm
parents: 1436
diff changeset
    60
  let fun radix (n, tail) =
2ebbc23d49fa beautified file_info a bit
clasohm
parents: 1436
diff changeset
    61
    if n < 10 then n :: tail else radix (n div 10, (n mod 10) :: tail)
2ebbc23d49fa beautified file_info a bit
clasohm
parents: 1436
diff changeset
    62
  in radix (num, []) end;
2ebbc23d49fa beautified file_info a bit
clasohm
parents: 1436
diff changeset
    63
2ebbc23d49fa beautified file_info a bit
clasohm
parents: 1436
diff changeset
    64
fun radixstring num =
2ebbc23d49fa beautified file_info a bit
clasohm
parents: 1436
diff changeset
    65
  let fun chrof n = chr (ord "0" + n);
2ebbc23d49fa beautified file_info a bit
clasohm
parents: 1436
diff changeset
    66
  in implode (map chrof (radixpand num)) end;
2ebbc23d49fa beautified file_info a bit
clasohm
parents: 1436
diff changeset
    67
100
e95b98536b3d fixed a bug in POLY.ML: delete_file didn't close streams;
clasohm
parents: 73
diff changeset
    68
in
e95b98536b3d fixed a bug in POLY.ML: delete_file didn't close streams;
clasohm
parents: 73
diff changeset
    69
1480
85ecd3439e01 made Isabelle compatible with SML/NJ 1.09
clasohm
parents: 1437
diff changeset
    70
(*Get time of last modification; if file doesn't exist return an empty string*)
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
    71
fun file_info "" = ""
1480
85ecd3439e01 made Isabelle compatible with SML/NJ 1.09
clasohm
parents: 1437
diff changeset
    72
  | file_info name = radixstring (System.filedate name)  handle _ => "";
66
1b14cd923772 /NJ,POLY/delete_file: new
lcp
parents: 58
diff changeset
    73
2242
fa8c6c695a97 Basis library emulation, especially of I/O operations
paulson
parents: 2141
diff changeset
    74
fa8c6c695a97 Basis library emulation, especially of I/O operations
paulson
parents: 2141
diff changeset
    75
structure OS =
fa8c6c695a97 Basis library emulation, especially of I/O operations
paulson
parents: 2141
diff changeset
    76
  struct
fa8c6c695a97 Basis library emulation, especially of I/O operations
paulson
parents: 2141
diff changeset
    77
  structure FileSys =
fa8c6c695a97 Basis library emulation, especially of I/O operations
paulson
parents: 2141
diff changeset
    78
    struct
fa8c6c695a97 Basis library emulation, especially of I/O operations
paulson
parents: 2141
diff changeset
    79
    val chDir = PolyML.cd
fa8c6c695a97 Basis library emulation, especially of I/O operations
paulson
parents: 2141
diff changeset
    80
fa8c6c695a97 Basis library emulation, especially of I/O operations
paulson
parents: 2141
diff changeset
    81
    fun remove name =    (*Delete a file *)
fa8c6c695a97 Basis library emulation, especially of I/O operations
paulson
parents: 2141
diff changeset
    82
      let val (is, os) = ExtendedIO.execute ("rm " ^ name)
fa8c6c695a97 Basis library emulation, especially of I/O operations
paulson
parents: 2141
diff changeset
    83
      in close_in is; close_out os end;
fa8c6c695a97 Basis library emulation, especially of I/O operations
paulson
parents: 2141
diff changeset
    84
fa8c6c695a97 Basis library emulation, especially of I/O operations
paulson
parents: 2141
diff changeset
    85
    (*Get pathname of current working directory *)
fa8c6c695a97 Basis library emulation, especially of I/O operations
paulson
parents: 2141
diff changeset
    86
    fun getDir () =
fa8c6c695a97 Basis library emulation, especially of I/O operations
paulson
parents: 2141
diff changeset
    87
      let val (is, os) = ExtendedIO.execute ("pwd")
fa8c6c695a97 Basis library emulation, especially of I/O operations
paulson
parents: 2141
diff changeset
    88
	  val (path, _) = take_suffix (apr(op=,"\n")) (*remove newline*)
fa8c6c695a97 Basis library emulation, especially of I/O operations
paulson
parents: 2141
diff changeset
    89
			   (explode (ExtendedIO.input_line is)) 
fa8c6c695a97 Basis library emulation, especially of I/O operations
paulson
parents: 2141
diff changeset
    90
      in close_in is; close_out os; implode path end;
fa8c6c695a97 Basis library emulation, especially of I/O operations
paulson
parents: 2141
diff changeset
    91
fa8c6c695a97 Basis library emulation, especially of I/O operations
paulson
parents: 2141
diff changeset
    92
    end
100
e95b98536b3d fixed a bug in POLY.ML: delete_file didn't close streams;
clasohm
parents: 73
diff changeset
    93
  end;
e95b98536b3d fixed a bug in POLY.ML: delete_file didn't close streams;
clasohm
parents: 73
diff changeset
    94
e95b98536b3d fixed a bug in POLY.ML: delete_file didn't close streams;
clasohm
parents: 73
diff changeset
    95
378
85ff48546a05 added use_string: string -> unit to execute ML commands passed in a string
clasohm
parents: 100
diff changeset
    96
85ff48546a05 added use_string: string -> unit to execute ML commands passed in a string
clasohm
parents: 100
diff changeset
    97
(*** ML command execution ***)
85ff48546a05 added use_string: string -> unit to execute ML commands passed in a string
clasohm
parents: 100
diff changeset
    98
396
18c9c28d0f7e changed use_string's type to string list -> unit because POLY can only
clasohm
parents: 378
diff changeset
    99
val use_string =
18c9c28d0f7e changed use_string's type to string list -> unit because POLY can only
clasohm
parents: 378
diff changeset
   100
  let fun exec command =
18c9c28d0f7e changed use_string's type to string list -> unit because POLY can only
clasohm
parents: 378
diff changeset
   101
    let val firstLine = ref true;
18c9c28d0f7e changed use_string's type to string list -> unit because POLY can only
clasohm
parents: 378
diff changeset
   102
18c9c28d0f7e changed use_string's type to string list -> unit because POLY can only
clasohm
parents: 378
diff changeset
   103
        fun getLine () =
18c9c28d0f7e changed use_string's type to string list -> unit because POLY can only
clasohm
parents: 378
diff changeset
   104
          if !firstLine
18c9c28d0f7e changed use_string's type to string list -> unit because POLY can only
clasohm
parents: 378
diff changeset
   105
          then (firstLine := false; command)
18c9c28d0f7e changed use_string's type to string list -> unit because POLY can only
clasohm
parents: 378
diff changeset
   106
          else raise Io "use_string: buffer exhausted"
18c9c28d0f7e changed use_string's type to string list -> unit because POLY can only
clasohm
parents: 378
diff changeset
   107
    in PolyML.compiler (getLine, fn s => output (std_out, s)) () end
18c9c28d0f7e changed use_string's type to string list -> unit because POLY can only
clasohm
parents: 378
diff changeset
   108
  in seq exec end;
18c9c28d0f7e changed use_string's type to string list -> unit because POLY can only
clasohm
parents: 378
diff changeset
   109
18c9c28d0f7e changed use_string's type to string list -> unit because POLY can only
clasohm
parents: 378
diff changeset
   110
end;
1289
2edd7a39d92a added "execute"
clasohm
parents: 396
diff changeset
   111
2edd7a39d92a added "execute"
clasohm
parents: 396
diff changeset
   112
2edd7a39d92a added "execute"
clasohm
parents: 396
diff changeset
   113
(*** System command execution ***)
2edd7a39d92a added "execute"
clasohm
parents: 396
diff changeset
   114
2edd7a39d92a added "execute"
clasohm
parents: 396
diff changeset
   115
(*Execute an Unix command which doesn't take any input from stdin and
2edd7a39d92a added "execute"
clasohm
parents: 396
diff changeset
   116
  sends its output to stdout.*)
2edd7a39d92a added "execute"
clasohm
parents: 396
diff changeset
   117
fun execute command =
2edd7a39d92a added "execute"
clasohm
parents: 396
diff changeset
   118
  let val (is, os) =  ExtendedIO.execute command;
2edd7a39d92a added "execute"
clasohm
parents: 396
diff changeset
   119
      val result = input (is, 999999);
2edd7a39d92a added "execute"
clasohm
parents: 396
diff changeset
   120
  in close_out os;
2edd7a39d92a added "execute"
clasohm
parents: 396
diff changeset
   121
     close_in is;
2edd7a39d92a added "execute"
clasohm
parents: 396
diff changeset
   122
     result
2edd7a39d92a added "execute"
clasohm
parents: 396
diff changeset
   123
  end;
2408
acddf41dbbf7 added needs_filtered_use;
wenzelm
parents: 2242
diff changeset
   124
acddf41dbbf7 added needs_filtered_use;
wenzelm
parents: 2242
diff changeset
   125
2724
ddc6cf6b62e9 Added comment
paulson
parents: 2408
diff changeset
   126
(*Non-printing and 8-bit chars are forbidden in string constants*)
2408
acddf41dbbf7 added needs_filtered_use;
wenzelm
parents: 2242
diff changeset
   127
val needs_filtered_use = true;