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

SCM Repository

[smlnj] View of /sml/trunk/src/cm/util/autodir.sml
ViewVC logotype

View of /sml/trunk/src/cm/util/autodir.sml

Parent Directory Parent Directory | Revision Log Revision Log

Revision 537 - (download) (annotate)
Fri Feb 18 17:20:16 2000 UTC (21 years, 2 months ago) by blume
File size: 1562 byte(s)
CM changes: standalone builds, better CMB.make/deliver, general improvements
 * Opening files for output while automagically creating any
 * necessary directories.
 * Copyright (c) 1999 by Lucent Technologies, Bell Laboratories
 * Author: Matthias Blume (blume@cs.princeton.edu)
structure AutoDir :> sig
    val openBinOut : string -> BinIO.outstream
    val openTextOut : string -> TextIO.outstream
end = struct

    structure P = OS.Path
    structure F = OS.FileSys

    fun fileExists n = F.access (n, []) handle _ => false

    fun openOut fileopener p = let
	fun fileopener' n =
	    (if fileExists n then (F.remove n handle _ => ()) else ();
	     fileopener n)
	fun mkDir d =
	    F.mkDir d handle exn => (if fileExists d then () else raise exn)
	fun generic (maker, pmaker, p) =
	    maker p
	    handle exn => let
		val dir = P.dir p
		(* If the parent dir exists, then we must consider
		 * these cases:
		 *   - non-parallel: we should signal an error
		 *   - parallel: somebody else may have made this dir
		 *      in the meantime, so we should try again
		 * Both cases can be handled by simply calling maker
		 * again.  (It will fail in the non-parallel case, but
		 * that's actually what we want.) *)
		if dir = "" orelse fileExists dir then maker p
		else (pmaker dir; maker p)
	fun makedirs dir = generic (mkDir, makedirs, dir)
	fun advertisemakedirs dir =
	    (Say.vsay ["[creating directory ", dir, " ...]\n"];
	     makedirs dir)
	generic (fileopener', advertisemakedirs, p)

    val openTextOut = openOut TextIO.openOut
    val openBinOut = openOut BinIO.openOut

ViewVC Help
Powered by ViewVC 1.0.0