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

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.