542aa094c93018cfb734120b40c98f006f246ad5
[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 \f
14 ;;;; data types used by pathnames
15
16 ;;; The HOST structure holds the functions that both parse the
17 ;;; pathname information into structure slot entries, and after
18 ;;; translation the inverse (unparse) functions.
19 (def!struct (host (:constructor nil))
20   (parse (missing-arg) :type function)
21   (parse-native (missing-arg) :type function)
22   (unparse (missing-arg) :type function)
23   (unparse-native (missing-arg) :type function)
24   (unparse-host (missing-arg) :type function)
25   (unparse-directory (missing-arg) :type function)
26   (unparse-file (missing-arg) :type function)
27   (unparse-enough (missing-arg) :type function)
28   (unparse-directory-separator (missing-arg) :type simple-string)
29   (simplify-namestring (missing-arg) :type function)
30   (customary-case (missing-arg) :type (member :upper :lower)))
31
32 (def!method print-object ((host host) stream)
33   (print-unreadable-object (host stream :type t :identity t)))
34
35 (def!struct (logical-host
36              (:make-load-form-fun make-logical-host-load-form-fun)
37              (:include host
38                        (parse #'parse-logical-namestring)
39                        (parse-native
40                         (lambda (x)
41                           (error "called PARSE-NATIVE-NAMESTRING using a ~
42                                   logical host: ~S" x)))
43                        (unparse #'unparse-logical-namestring)
44                        (unparse-native
45                         (lambda (x)
46                           (error "called NATIVE-NAMESTRING using a ~
47                                   logical host: ~S" x)))
48                        (unparse-host
49                         (lambda (x)
50                           (logical-host-name (%pathname-host x))))
51                        (unparse-directory #'unparse-logical-directory)
52                        (unparse-file #'unparse-logical-file)
53                        (unparse-enough #'unparse-enough-namestring)
54                        (unparse-directory-separator ";")
55                        (simplify-namestring #'identity)
56                        (customary-case :upper)))
57   (name "" :type simple-string)
58   (translations nil :type list)
59   (canon-transls nil :type list))
60
61 (def!method print-object ((logical-host logical-host) stream)
62   (print-unreadable-object (logical-host stream :type t)
63     (prin1 (logical-host-name logical-host) stream)))
64
65 (defun make-logical-host-load-form-fun (logical-host)
66   (values `(find-logical-host ',(logical-host-name logical-host))
67           nil))
68
69 ;;; A PATTERN is a list of entries and wildcards used for pattern
70 ;;; matches of translations.
71 (def!struct (pattern (:constructor make-pattern (pieces)))
72   (pieces nil :type list))
73 \f
74 ;;;; PATHNAME structures
75
76 ;;; the various magic tokens that are allowed to appear in pretty much
77 ;;; all pathname components
78 (eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
79   (def!type pathname-component-tokens ()
80     '(member nil :unspecific :wild)))
81
82 (sb!xc:defstruct (pathname (:conc-name %pathname-)
83                            (:constructor %make-pathname (host
84                                                          device
85                                                          directory
86                                                          name
87                                                          type
88                                                          version))
89                            (:predicate pathnamep))
90   ;; the host (at present either a UNIX or logical host)
91   (host nil :type (or host null))
92   ;; the name of a logical or physical device holding files
93   (device nil :type (or simple-string pathname-component-tokens))
94   ;; a list of strings that are the component subdirectory components
95   (directory nil :type list)
96   ;; the filename
97   (name nil :type (or simple-string pattern pathname-component-tokens))
98   ;; the type extension of the file
99   (type nil :type (or simple-string pattern pathname-component-tokens))
100   ;; the version number of the file, a positive integer (not supported
101   ;; on standard Unix filesystems)
102   (version nil :type (or integer pathname-component-tokens (member :newest))))
103
104 ;;; Logical pathnames have the following format:
105 ;;;
106 ;;; logical-namestring ::=
107 ;;;      [host ":"] [";"] {directory ";"}* [name] ["." type ["." version]]
108 ;;;
109 ;;; host ::= word
110 ;;; directory ::= word | wildcard-word | **
111 ;;; name ::= word | wildcard-word
112 ;;; type ::= word | wildcard-word
113 ;;; version ::= pos-int | newest | NEWEST | *
114 ;;; word ::= {uppercase-letter | digit | -}+
115 ;;; wildcard-word ::= [word] '* {word '*}* [word]
116 ;;; pos-int ::= integer > 0
117 ;;;
118 ;;; Physical pathnames include all these slots and a device slot.
119
120 ;;; Logical pathnames are a subclass of PATHNAME. Their class
121 ;;; relations are mimicked using structures for efficiency.
122 (sb!xc:defstruct (logical-pathname (:conc-name %logical-pathname-)
123                                    (:include pathname)
124                                    (:constructor %make-logical-pathname
125                                                  (host
126                                                   device
127                                                   directory
128                                                   name
129                                                   type
130                                                   version))))