1(* 2 Title: Modified version of the "use" function which saves state 3 Author: David Matthews 4 Copyright David Matthews 2009 5 6 This library is free software; you can redistribute it and/or 7 modify it under the terms of the GNU Lesser General Public 8 License as published by the Free Software Foundation; either 9 version 2.1 of the License, or (at your option) any later version. 10 11 This library is distributed in the hope that it will be useful, 12 but WITHOUT ANY WARRANTY; without even the implied warranty of 13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 14 Lesser General Public License for more details. 15 16 You should have received a copy of the GNU Lesser General Public 17 License along with this library; if not, write to the Free Software 18 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 19*) 20 21(* 22 This is an example version of the "use" function that the IDE may call 23 in the prelude before a build. It takes a directory name and returns a "use" 24 function that saves the state and dependencies in ".save" and ".deps" files 25 within that directory. It should be called as e.g. 26 val use = ideUse ".polysave" 27 to define a version of "use" for the rest of the compilation. 28*) 29 30fun ideUse saveDirName = 31let 32 (* If we are building under the IDE we need to record the dependencies 33 and also save the state before each file we "use". *) 34 val saveDirectory: string option ref = ref NONE 35 val dependencies: string list ref = ref [] 36 37 open OS.Path 38 (* Get the root directory and save directory (typically .polysave). Do this once 39 when this function is called and convert them to absolute paths using the 40 current directory when this is called. 41 Assume that the root directory is the parent of the save directory. 42 N.B. Because the directory may not yet exist we can't use OS.FileSys.fullPath. *) 43 val saveDirPath = mkAbsolute { path = saveDirName, relativeTo = OS.FileSys.getDir() } 44 (* The root directory is the directory that is assumed to be the root of the project. 45 For each source file within this directory with path a/b/c.ML there will be a 46 corresponding saved state file .polysave/a/b/c.ML . 47 If "use" is called on a file that is not within the root directory no information 48 will be saved for that file. *) 49 val { dir = rootPath, ...} = splitDirFile saveDirPath 50 51 fun preUse fileName = 52 let 53 open OS.Path 54 (* Create a directory hierarchy. *) 55 fun createDirs path = 56 if path = "" orelse (OS.FileSys.isDir path handle OS.SysErr _ => false) 57 then () 58 else 59 ( 60 createDirs (OS.Path.dir path); 61 OS.FileSys.mkDir path 62 ); 63 (* Compute the full path to the actual file taking account of any 64 change of directory then make it relative to the root. *) 65 val filePathRelativeToRoot = 66 let 67 val fullFileName = OS.FileSys.fullPath fileName 68 val pathFromRoot = mkRelative { path = fullFileName, relativeTo = rootPath } 69 (* Is the file in the root directory or a sub-directory or is it in 70 some other directory? *) 71 val { arcs, ...} = fromString pathFromRoot 72 in 73 case arcs of 74 topArc :: _ => 75 (* If the first part of the path is ".." then it's in some other directory. *) 76 if topArc = parentArc then NONE else SOME pathFromRoot 77 | _ => NONE (* No path at all? *) 78 end handle Path => NONE (* Different volumes: can't make relative path. *) 79 | OS.SysErr _ => NONE (* If fileName doesn't actually exist. *) 80 in 81 case filePathRelativeToRoot of 82 NONE => () (* Do nothing: we can't save it. *) 83 | SOME fileName => 84 let 85 local 86 val baseName = concat(saveDirPath, fileName) 87 in 88 val saveFile = 89 mkCanonical (joinBaseExt{ base = baseName, ext = SOME "save"}) 90 val depFile = 91 mkCanonical (joinBaseExt{ base = baseName, ext = SOME "deps"}) 92 end 93 (* Reset the save directory before we save so that it isn't set in the saved 94 state. That means that "use" won't save the state unless it's explicitly 95 asked to. *) 96 val saveSave = ! saveDirectory 97 in 98 (* Create any containing directories. *) 99 createDirs(OS.Path.dir saveFile); 100 saveDirectory := NONE; 101 102 (* Save the state. *) 103 PolyML.SaveState.saveChild (saveFile, List.length(PolyML.SaveState.showHierarchy())); 104 (* Restore the ref. *) 105 saveDirectory := saveSave; 106 107 (* Write out the dependencies. *) 108 let 109 open TextIO 110 val f = openOut depFile 111 in 112 List.app(fn s => output(f, s ^ "\n")) (!dependencies); 113 closeOut f 114 end; 115 (* Add this file to the dependency list. *) 116 dependencies := ! dependencies @ [fileName] 117 end handle (ex as OS.SysErr args) => 118 (print (String.concat["Exception SysErr(", PolyML.makestring args, ") raised for ", fileName, "\n"]); raise ex) 119 end 120in 121 fn originalName => 122 let 123 (* Find the actual file name by following the suffixes. This mirrors what "use" will do. *) 124 (* use "f" first tries to open "f" but if that fails it tries "f.ML", "f.sml" etc. *) 125 fun trySuffixes [] = 126 (* Not found - attempt to open the original and pass back the 127 exception. *) 128 (TextIO.openIn originalName, originalName) 129 | trySuffixes (s::l) = 130 (TextIO.openIn (originalName ^ s), originalName ^ s) 131 handle IO.Io _ => trySuffixes l 132 (* First in list is the name with no suffix. *) 133 val (inStream, fileName) = trySuffixes("" :: ! PolyML.suffixes) 134 135 val () = preUse fileName 136 in 137 PolyML.use fileName (* Now call the underlying use to do the work. *) 138 end 139end; 140 141 142