Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/trunk/src/cm/paths/abspath.sml
ViewVC logotype

Diff of /sml/trunk/src/cm/paths/abspath.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 353, Thu Jun 24 09:43:28 1999 UTC revision 354, Fri Jun 25 08:36:12 1999 UTC
# Line 17  Line 17 
17      val cwdContext: unit -> context      val cwdContext: unit -> context
18      val sameDirContext: t -> context      val sameDirContext: t -> context
19    
20      val name : t -> string      val osstring : t -> string
21        val descr : t -> string
22      val compare : t * t -> order      val compare : t * t -> order
23      val contextOf : t -> context      val contextOf : t -> context
24      val specOf : t -> string      val specOf : t -> string
# Line 25  Line 26 
26    
27      (* Replace the anchor context in the path argument with the      (* Replace the anchor context in the path argument with the
28       * given context. Returns NONE if there was no anchor context. *)       * given context. Returns NONE if there was no anchor context. *)
29      val reAnchor : t * string -> t option      val reAnchoredName : t * string -> string option
30    
31      val native : { context: context, spec: string } -> t      val native : { context: context, spec: string } -> t
32      val standard : PathConfig.mode -> { context: context, spec: string } -> t      val standard : PathConfig.mode -> { context: context, spec: string } -> t
# Line 35  Line 36 
36      val pickle : (bool -> unit) -> t * t -> string list      val pickle : (bool -> unit) -> t * t -> string list
37      val unpickle : PathConfig.mode -> string list * t -> t option      val unpickle : PathConfig.mode -> string list * t -> t option
38    
     val joinDirFile : { dir: t, file: string } -> t  
     val splitDirFile : t -> { dir: t, file: string }  
     val dir : t -> t  
     val file : t -> string  
   
     val exists : t -> bool  
39      val tstamp : t -> TStamp.t      val tstamp : t -> TStamp.t
     val setTime : t * TStamp.t -> unit  
     val delete : t -> unit  
40    
     (* The open?Out functions automagically create any necessary directories  
      * and announce this activity. *)  
41      val openTextIn : t -> TextIO.instream      val openTextIn : t -> TextIO.instream
     val openTextOut : t -> TextIO.outstream  
     val openBinIn : t -> BinIO.instream  
     val openBinOut : t -> BinIO.outstream  
42  end  end
43    
44  structure AbsPath :> ABSPATH = struct  structure AbsPath :> ABSPATH = struct
# Line 199  Line 187 
187          end          end
188    
189          (* get the name as a string (calls elab, so don't cache externally!) *)          (* get the name as a string (calls elab, so don't cache externally!) *)
190          fun name p = #name (elab p)          fun osstring p = #name (elab p)
191    
192          (* get the context back *)          (* get the context back *)
193          fun contextOf (PATH { context = c, ... }) = c          fun contextOf (PATH { context = c, ... }) = c
# Line 289  Line 277 
277              u_p l              u_p l
278          end          end
279    
280          (* . and .. are not permitted as file parameter *)          fun tstamp p = TStamp.fmodTime (osstring p)
         fun joinDirFile { dir = PATH { context, spec, ... }, file } =  
             if file = P.currentArc orelse file = P.parentArc then  
                 impossible "AbsPath.joinDirFile: . or .."  
             else fresh (context, P.joinDirFile { dir = spec, file = file })  
   
         (* splitDirFile never walks past a context.  
          * Moreover, it is an error to split something that ends in "..". *)  
         fun splitDirFile (PATH { context, spec, ... }) = let  
             fun loop "" =  
                 impossible "AbsPath.splitDirFile: tried to split a context"  
               | loop spec = let  
                     val { dir, file } = P.splitDirFile spec  
                 in  
                     if file = P.currentArc then loop dir  
                     else if file = P.parentArc then  
                         impossible "AbsPath.splitDirFile: <path>/.."  
                     else (dir, file)  
                 end  
             val (dir, file) = loop spec  
             val dir = if dir = "" then P.currentArc else dir  
         in  
             { dir = fresh (context, dir), file = file }  
         end  
   
         val dir = #dir o splitDirFile  
         val file = #file o splitDirFile  
   
         fun fileExists n = F.access (n, []) handle _ => false  
         fun fileModTime n = F.modTime n handle _ => Time.zeroTime  
281    
282          val exists = fileExists o name          val openTextIn = TextIO.openIn o osstring
283    
284          fun tstamp p = let          fun descr (PATH { spec, context, ... }) = let
285              val n = name p              fun dir (x, l) =
286                    case OS.Path.dir x of
287                        "" => l
288                      | d => d :: "/" :: l
289                fun d_c (CONFIG_ANCHOR { config_name = n, ... }, l) =
290                    "$" :: n :: "/" :: l
291                  | d_c (DIR_OF (PATH { spec, context, ... }), l) =
292                    d_c (context, dir (spec, l))
293                  | d_c (THEN_CWD _, l) = "./" :: l
294                  | d_c (ROOT, l) = "/" :: l
295          in          in
296              if fileExists n then TStamp.TSTAMP (fileModTime n)              concat (d_c (context, [spec]))
             else TStamp.NOTSTAMP  
297          end          end
298    
299          fun setTime (p, TStamp.NOTSTAMP) = ()          fun reAnchoredName (p, dirstring) = let
           | setTime (p, TStamp.TSTAMP t) = F.setTime (name p, SOME t)  
   
         fun delete p = F.remove (name p) handle _ => ()  
   
         fun openOut fileopener ap = let  
             val p = name ap  
             fun generic (maker, pmaker, p) =  
                 maker p  
                 handle exn => let  
                     val { dir, ... } = P.splitDirFile p  
                 in  
                     if dir = "" orelse fileExists dir then raise exn  
                     else (pmaker dir; maker p)  
                 end  
             fun makedirs dir = generic (F.mkDir, makedirs, dir)  
             fun advertisemakedirs dir =  
                 (Say.vsay ["[creating directory ", dir, " ...]\n"];  
                  makedirs dir)  
         in  
             generic (fileopener, advertisemakedirs, p)  
         end  
   
         val openTextIn = TextIO.openIn o name  
         val openBinIn = BinIO.openIn o name  
         val openTextOut = openOut TextIO.openOut  
         val openBinOut = openOut BinIO.openOut  
     end  
   
     fun reAnchor (p, dirstring) = let  
300          fun path (PATH { context, spec, ... }) = let          fun path (PATH { context, spec, ... }) = let
301              fun mk c = PATH { context = c, spec = spec, cache = ref NONE }                  fun mk c = P.concat (c, spec)
302          in          in
303              Option.map mk (ctxt context)              Option.map mk (ctxt context)
304          end          end
305          and ctxt (CONFIG_ANCHOR { config_name = n, ... }) =          and ctxt (CONFIG_ANCHOR { config_name = n, ... }) =
306              SOME (CONFIG_ANCHOR { config_name = n,                  SOME (P.concat (dirstring, n))
307                                    fetch = fn () => P.concat (dirstring, n),                | ctxt (DIR_OF p) = Option.map P.dir (path p)
308                                    cache = ref NONE })                | ctxt (THEN_CWD _) = (Say.say ["."]; NONE)
309            | ctxt (DIR_OF p) = Option.map DIR_OF (path p)                | ctxt ROOT = (Say.say ["/"]; NONE)
           | ctxt (THEN_CWD _) = NONE  
           | ctxt ROOT = NONE  
310      in      in
311          path p              Option.map P.mkCanonical (path p)
312            end
313      end      end
314  end  end

Legend:
Removed from v.353  
changed lines
  Added in v.354

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0