Return to filepaths.sml CVS log

Up to [Research Unix] / researchv10no / cmd / sml / src / sepcomp

Annotation of researchv10no/cmd/sml/src/sepcomp/filepaths.sml, revision 1.1

1.1     ! root        1: (* Copyright 1989 by AT&T Bell Laboratories *)
        !             2: (* FILEPATHS: maintain default paths (file prefixes, essentially) when
        !             3:              opening nested imported files. *)
        !             4: 
        !             5: (* Trivial FILEPATHS example:
        !             6: 
        !             7: functor TrivPaths(): FILEPATHS =
        !             8: struct
        !             9:   type Filepath = unit
        !            10:   val defaultPath = ()
        !            11:   exception ImpliedPath
        !            12:   fun impliedPath(_, filename) = {validName=filename, newPath=()}
        !            13: end
        !            14: *)
        !            15: (* UNIX version: Any filename which starts with "/" is assumed to be
        !            16:                 absolute, and implies that entire directory. 
        !            17:                 Any filename which starts with "./" causes a search from
        !            18:                 the current working directory into the subdirectories.
        !            19:                 Any other filename (xxx/yyy/...) is relative to the
        !            20:                 current path.
        !            21:  *)
        !            22: 
        !            23: functor UnixPaths(): FILEPATHS =
        !            24: struct
        !            25: 
        !            26:   val DEBUG = false
        !            27:   val debug = 
        !            28:       if DEBUG then fn str => output std_out ("<" ^ str ^ ">\n")
        !            29:       else fn _ => ()
        !            30: 
        !            31:   type Filepath = string               (* Yes, I know, pretty trivial,
        !            32:                                         but I'd like to keep it abstract,
        !            33:                                         all the same. *)
        !            34:   exception ImpliedPath
        !            35: 
        !            36:   val defaultPath = ""
        !            37: 
        !            38:   (* divideSlash: divide a full filename into path and name. Keep the "/"
        !            39:      on the path. *)
        !            40: 
        !            41:   fun divideSlash filename =
        !            42:       let val revChars = rev(explode filename)
        !            43:          fun stripSlash(nil, name) = (nil, name)
        !            44:            | stripSlash(p as "/" :: rest, name) = (rev p, name)
        !            45:            | stripSlash(ch :: rest, name) = stripSlash(rest, ch :: name)
        !            46:        in stripSlash(revChars, nil)
        !            47:       end
        !            48: 
        !            49:   fun impliedPath(oldPath, oldName) =
        !            50:       let val (pathchs, namechs) = divideSlash oldName
        !            51:          val path = implode pathchs
        !            52:          val name =  implode namechs
        !            53:        in case pathchs
        !            54:            of "/" :: _ => {validName=path^name, newPath=path}
        !            55:             | "." :: "/" :: _ => {validName=path^name, newPath=path}
        !            56:             | _ => {validName=oldPath^path^name, newPath=oldPath^path}
        !            57:       end
        !            58: 
        !            59:   val impliedPath =
        !            60:       if DEBUG then
        !            61:        fn (oldPath, oldName) =>
        !            62:          let val {validName, newPath} = impliedPath(oldPath, oldName)
        !            63:           in debug("impliedPath(oldPath=" ^ oldPath ^ ", oldName=" ^ oldName
        !            64:                    ^ ") -> (" ^ validName ^ ", " ^ newPath ^ ")");
        !            65:              {validName=validName, newPath=newPath}
        !            66:          end
        !            67:       else impliedPath
        !            68: 
        !            69: end (* functor UnixPaths *)

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.