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