| author | berghofe | 
| Fri, 24 Feb 2006 09:00:21 +0100 | |
| changeset 19133 | 7e84a1a3741c | 
| parent 18715 | f809deffdd8f | 
| child 19473 | d87a8838afa4 | 
| permissions | -rw-r--r-- | 
| 6118 | 1 | (* Title: Pure/General/file.ML | 
| 5009 | 2 | ID: $Id$ | 
| 3 | Author: Markus Wenzel, TU Muenchen | |
| 4 | ||
| 5 | File system operations. | |
| 6 | *) | |
| 7 | ||
| 8 | signature FILE = | |
| 9 | sig | |
| 16261 | 10 | val unpack_platform_path_fn: (string -> Path.T) ref | 
| 11 | val unpack_platform_path: string -> Path.T | |
| 12 | val platform_path_fn: (Path.T -> string) ref | |
| 13 | val platform_path: Path.T -> string | |
| 14 | val shell_path_fn: (Path.T -> string) ref | |
| 15 | val shell_path: Path.T -> string | |
| 6224 | 16 | val cd: Path.T -> unit | 
| 17 | val pwd: unit -> Path.T | |
| 18 | val full_path: Path.T -> Path.T | |
| 6182 | 19 | val tmp_path: Path.T -> Path.T | 
| 16261 | 20 | val isatool: string -> int | 
| 21 | val system_command: string -> unit | |
| 17826 | 22 | eqtype info | 
| 23 | val info: Path.T -> info option | |
| 24 | val exists: Path.T -> bool | |
| 25 | val assert: Path.T -> unit | |
| 26 | val rm: Path.T -> unit | |
| 27 | val mkdir: Path.T -> unit | |
| 6182 | 28 | val read: Path.T -> string | 
| 29 | val write: Path.T -> string -> unit | |
| 30 | val append: Path.T -> string -> unit | |
| 16713 | 31 | val write_list: Path.T -> string list -> unit | 
| 32 | val append_list: Path.T -> string list -> unit | |
| 16603 | 33 | val eq: Path.T * Path.T -> bool | 
| 6182 | 34 | val copy: Path.T -> Path.T -> unit | 
| 16261 | 35 | val copy_dir: Path.T -> Path.T -> unit | 
| 12116 | 36 | val use: Path.T -> unit | 
| 5009 | 37 | end; | 
| 38 | ||
| 39 | structure File: FILE = | |
| 40 | struct | |
| 41 | ||
| 16261 | 42 | (* platform specific path representations *) | 
| 6224 | 43 | |
| 16261 | 44 | val unpack_platform_path_fn = ref Path.unpack; | 
| 45 | fun unpack_platform_path s = ! unpack_platform_path_fn s; | |
| 6224 | 46 | |
| 16261 | 47 | val platform_path_fn = ref (Path.pack o Path.expand); | 
| 48 | fun platform_path path = ! platform_path_fn path; | |
| 6224 | 49 | |
| 16261 | 50 | val shell_path_fn = ref (enclose "'" "'" o Path.pack o Path.expand); | 
| 51 | fun shell_path path = ! shell_path_fn path; | |
| 6224 | 52 | |
| 53 | ||
| 54 | (* current path *) | |
| 55 | ||
| 16261 | 56 | val cd = Library.cd o platform_path; | 
| 57 | val pwd = unpack_platform_path o Library.pwd; | |
| 6224 | 58 | |
| 15155 
6cdd6a8da9b9
Added function for "normalizing" absolute paths (i.e. dereferencing of
 berghofe parents: 
14981diff
changeset | 59 | fun norm_absolute p = | 
| 
6cdd6a8da9b9
Added function for "normalizing" absolute paths (i.e. dereferencing of
 berghofe parents: 
14981diff
changeset | 60 | let | 
| 
6cdd6a8da9b9
Added function for "normalizing" absolute paths (i.e. dereferencing of
 berghofe parents: 
14981diff
changeset | 61 | val p' = pwd (); | 
| 
6cdd6a8da9b9
Added function for "normalizing" absolute paths (i.e. dereferencing of
 berghofe parents: 
14981diff
changeset | 62 | fun norm p = if can cd p then pwd () | 
| 
6cdd6a8da9b9
Added function for "normalizing" absolute paths (i.e. dereferencing of
 berghofe parents: 
14981diff
changeset | 63 | else Path.append (norm (Path.dir p)) (Path.base p); | 
| 16261 | 64 | val p'' = norm p; | 
| 15155 
6cdd6a8da9b9
Added function for "normalizing" absolute paths (i.e. dereferencing of
 berghofe parents: 
14981diff
changeset | 65 | in (cd p'; p'') end | 
| 
6cdd6a8da9b9
Added function for "normalizing" absolute paths (i.e. dereferencing of
 berghofe parents: 
14981diff
changeset | 66 | |
| 16261 | 67 | fun full_path path = | 
| 15155 
6cdd6a8da9b9
Added function for "normalizing" absolute paths (i.e. dereferencing of
 berghofe parents: 
14981diff
changeset | 68 | (if Path.is_absolute path then path | 
| 16261 | 69 | else Path.append (pwd ()) path) | 
| 70 | |> norm_absolute; | |
| 5009 | 71 | |
| 6182 | 72 | |
| 73 | (* tmp_path *) | |
| 74 | ||
| 75 | fun tmp_path path = | |
| 76 | Path.append (Path.variable "ISABELLE_TMP") (Path.base path); | |
| 5009 | 77 | |
| 78 | ||
| 16261 | 79 | (* system commands *) | 
| 80 | ||
| 81 | fun isatool cmd = system ("\"$ISATOOL\" " ^ cmd);
 | |
| 82 | ||
| 83 | fun system_command cmd = | |
| 84 |   if system cmd <> 0 then error ("System command failed: " ^ cmd)
 | |
| 85 | else (); | |
| 86 | ||
| 87 | ||
| 88 | (* directory entries *) | |
| 89 | ||
| 90 | datatype info = Info of string; | |
| 91 | ||
| 92 | fun info path = | |
| 93 | Option.map (Info o Time.toString) (try OS.FileSys.modTime (platform_path path)); | |
| 94 | ||
| 95 | val exists = is_some o info; | |
| 96 | ||
| 17826 | 97 | fun assert path = | 
| 98 | if exists path then () | |
| 99 |   else error ("No such file or directory: " ^ quote (Path.pack path));
 | |
| 100 | ||
| 16261 | 101 | val rm = OS.FileSys.remove o platform_path; | 
| 102 | ||
| 103 | fun mkdir path = system_command ("mkdir -p " ^ shell_path path);
 | |
| 104 | ||
| 105 | fun is_dir path = | |
| 106 | if_none (try OS.FileSys.isDir (platform_path path)) false; | |
| 107 | ||
| 108 | ||
| 6224 | 109 | (* read / write files *) | 
| 110 | ||
| 16261 | 111 | local | 
| 112 | ||
| 6224 | 113 | fun fail_safe f g x = | 
| 114 | let val y = f x handle exn => (g x; raise exn) | |
| 115 | in g x; y end; | |
| 116 | ||
| 16713 | 117 | fun output txts stream = List.app (fn txt => TextIO.output (stream, txt)) txts; | 
| 6182 | 118 | |
| 16261 | 119 | in | 
| 6218 | 120 | |
| 16261 | 121 | fun read path = | 
| 122 | fail_safe TextIO.inputAll TextIO.closeIn (TextIO.openIn (platform_path path)); | |
| 6224 | 123 | |
| 16713 | 124 | fun write_list path txts = | 
| 125 | fail_safe (output txts) TextIO.closeOut (TextIO.openOut (platform_path path)); | |
| 5009 | 126 | |
| 16713 | 127 | fun append_list path txts = | 
| 128 | fail_safe (output txts) TextIO.closeOut (TextIO.openAppend (platform_path path)); | |
| 129 | ||
| 130 | fun write path txt = write_list path [txt]; | |
| 131 | fun append path txt = append_list path [txt]; | |
| 6182 | 132 | |
| 16261 | 133 | end; | 
| 5009 | 134 | |
| 16603 | 135 | fun eq paths = | 
| 136 | (case try (pairself (OS.FileSys.fileId o platform_path)) paths of | |
| 137 | SOME ids => OS.FileSys.compare ids = EQUAL | |
| 138 | | NONE => false); | |
| 139 | ||
| 140 | fun copy from to = conditional (not (eq (from, to))) (fn () => | |
| 16261 | 141 | let val target = if is_dir to then Path.append to (Path.base from) else to | 
| 16603 | 142 | in write target (read from) end); | 
| 6318 | 143 | |
| 16603 | 144 | fun copy_dir from to = conditional (not (eq (from, to))) (fn () => | 
| 145 |   (system_command ("cp -r " ^ shell_path from ^ "/. " ^ shell_path to); ()))
 | |
| 6640 | 146 | |
| 147 | ||
| 12116 | 148 | (* use ML files *) | 
| 6640 | 149 | |
| 18715 | 150 | val use = Output.ML_errors use o platform_path; | 
| 6640 | 151 | |
| 5009 | 152 | end; |