Initial revision
[sbcl.git] / src / code / pathname.lisp
1 ;;;; the known-to-the-cross-compiler part of PATHNAME logic
2
3 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; more information.
5 ;;;;
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
11
12 (in-package "SB!IMPL")
13
14 (file-comment
15   "$Header$")
16 \f
17 ;;;; data types used by pathnames
18
19 ;;; The HOST structure holds the functions that both parse the
20 ;;; pathname information into structure slot entries, and after
21 ;;; translation the inverse (unparse) functions.
22 (sb!xc:defstruct (host (:constructor nil))
23   (parse (required-argument) :type function)
24   (unparse (required-argument) :type function)
25   (unparse-host (required-argument) :type function)
26   (unparse-directory (required-argument) :type function)
27   (unparse-file (required-argument) :type function)
28   (unparse-enough (required-argument) :type function)
29   (customary-case (required-argument) :type (member :upper :lower)))
30
31 (sb!xc:defstruct (logical-host
32                   (:include host
33                             (:parse #'parse-logical-namestring)
34                             (:unparse #'unparse-logical-namestring)
35                             (:unparse-host
36                              (lambda (x)
37                                (logical-host-name (%pathname-host x))))
38                             (:unparse-directory #'unparse-logical-directory)
39                             (:unparse-file #'unparse-unix-file)
40                             (:unparse-enough #'identity)
41                             (:customary-case :upper)))
42   (name "" :type simple-base-string)
43   (translations nil :type list)
44   (canon-transls nil :type list))
45
46 ;;; A PATTERN is a list of entries and wildcards used for pattern
47 ;;; matches of translations.
48 (sb!xc:defstruct (pattern (:constructor make-pattern (pieces)))
49   (pieces nil :type list))
50 \f
51 ;;;; PATHNAME structures
52
53 ;;; the various magic tokens that are allowed to appear in pretty much
54 ;;; all pathname components
55 (sb!xc:deftype component-tokens () ; FIXME: rename to PATHNAME-COMPONENT-TOKENS
56   '(member nil :unspecific :wild))
57
58 (sb!xc:defstruct (pathname (:conc-name %pathname-)
59                            (:constructor %make-pathname (host
60                                                          device
61                                                          directory
62                                                          name
63                                                          type
64                                                          version))
65                            (:predicate pathnamep))
66   ;; the host (at present either a UNIX or logical host)
67   (host nil :type (or host null))
68   ;; the name of a logical or physical device holding files
69   (device nil :type (or simple-string component-tokens))
70   ;; a list of strings that are the component subdirectory components
71   (directory nil :type list)
72   ;; the filename
73   (name nil :type (or simple-string pattern component-tokens))
74   ;; the type extension of the file
75   (type nil :type (or simple-string pattern component-tokens))
76   ;; the version number of the file, a positive integer (not supported
77   ;; on standard Unix filesystems)
78   (version nil :type (or integer component-tokens (member :newest))))
79
80 ;;; Logical pathnames have the following format:
81 ;;;
82 ;;; logical-namestring ::=
83 ;;;      [host ":"] [";"] {directory ";"}* [name] ["." type ["." version]]
84 ;;;
85 ;;; host ::= word
86 ;;; directory ::= word | wildcard-word | **
87 ;;; name ::= word | wildcard-word
88 ;;; type ::= word | wildcard-word
89 ;;; version ::= pos-int | newest | NEWEST | *
90 ;;; word ::= {uppercase-letter | digit | -}+
91 ;;; wildcard-word ::= [word] '* {word '*}* [word]
92 ;;; pos-int ::= integer > 0
93 ;;;
94 ;;; Physical pathnames include all these slots and a device slot.
95
96 ;;; Logical pathnames are a subclass of pathname. Their class
97 ;;; relations are mimicked using structures for efficency.
98 (sb!xc:defstruct (logical-pathname (:conc-name %logical-pathname-)
99                                    (:include pathname)
100                                    (:constructor %make-logical-pathname
101                                                  (host
102                                                   device
103                                                   directory
104                                                   name
105                                                   type
106                                                   version))))
107 \f
108 (defmacro-mundanely enumerate-search-list ((var pathname &optional result)
109                                            &body body)
110   #!+sb-doc
111   "Execute BODY with VAR bound to each successive possible expansion for
112    PATHNAME and then return RESULT. Note: if PATHNAME does not contain a
113    search-list, then BODY is executed exactly once. Everything is wrapped
114    in a block named NIL, so RETURN can be used to terminate early. Note:
115    VAR is *not* bound inside of RESULT."
116   (let ((body-name (gensym)))
117     `(block nil
118        (flet ((,body-name (,var)
119                 ,@body))
120          (%enumerate-search-list ,pathname #',body-name)
121          ,result))))
122