1 ;;;; the known-to-the-cross-compiler part of PATHNAME logic
3 ;;;; This software is part of the SBCL system. See the README file for
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.
12 (in-package "SB!IMPL")
14 ;;;; data types used by pathnames
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 (unparse (missing-arg) :type function
)
22 (unparse-host (missing-arg) :type function
)
23 (unparse-directory (missing-arg) :type function
)
24 (unparse-file (missing-arg) :type function
)
25 (unparse-enough (missing-arg) :type function
)
26 (customary-case (missing-arg) :type
(member :upper
:lower
)))
28 (def!method print-object
((host host
) stream
)
29 (print-unreadable-object (host stream
:type t
:identity t
)))
31 (def!struct
(logical-host
32 (:make-load-form-fun make-logical-host-load-form-fun
)
34 (parse #'parse-logical-namestring
)
35 (unparse #'unparse-logical-namestring
)
38 (logical-host-name (%pathname-host x
))))
39 (unparse-directory #'unparse-logical-directory
)
40 (unparse-file #'unparse-logical-file
)
41 (unparse-enough #'unparse-enough-namestring
)
42 (customary-case :upper
)))
43 (name "" :type simple-base-string
)
44 (translations nil
:type list
)
45 (canon-transls nil
:type list
))
47 (def!method print-object
((logical-host logical-host
) stream
)
48 (print-unreadable-object (logical-host stream
:type t
)
49 (prin1 (logical-host-name logical-host
) stream
)))
51 (defun make-logical-host-load-form-fun (logical-host)
52 (values `(find-logical-host ',(logical-host-name logical-host
))
55 ;;; A PATTERN is a list of entries and wildcards used for pattern
56 ;;; matches of translations.
57 (def!struct
(pattern (:constructor make-pattern
(pieces)))
58 (pieces nil
:type list
))
60 ;;;; PATHNAME structures
62 ;;; the various magic tokens that are allowed to appear in pretty much
63 ;;; all pathname components
64 (eval-when (#-sb-xc
:compile-toplevel
:load-toplevel
:execute
)
65 (def!type pathname-component-tokens
()
66 '(member nil
:unspecific
:wild
)))
68 (sb!xc
:defstruct
(pathname (:conc-name %pathname-
)
69 (:constructor %make-pathname
(host
75 (:predicate pathnamep
))
76 ;; the host (at present either a UNIX or logical host)
77 (host nil
:type
(or host null
))
78 ;; the name of a logical or physical device holding files
79 (device nil
:type
(or simple-string pathname-component-tokens
))
80 ;; a list of strings that are the component subdirectory components
81 (directory nil
:type list
)
83 (name nil
:type
(or simple-string pattern pathname-component-tokens
))
84 ;; the type extension of the file
85 (type nil
:type
(or simple-string pattern pathname-component-tokens
))
86 ;; the version number of the file, a positive integer (not supported
87 ;; on standard Unix filesystems)
88 (version nil
:type
(or integer pathname-component-tokens
(member :newest
))))
90 ;;; Logical pathnames have the following format:
92 ;;; logical-namestring ::=
93 ;;; [host ":"] [";"] {directory ";"}* [name] ["." type ["." version]]
96 ;;; directory ::= word | wildcard-word | **
97 ;;; name ::= word | wildcard-word
98 ;;; type ::= word | wildcard-word
99 ;;; version ::= pos-int | newest | NEWEST | *
100 ;;; word ::= {uppercase-letter | digit | -}+
101 ;;; wildcard-word ::= [word] '* {word '*}* [word]
102 ;;; pos-int ::= integer > 0
104 ;;; Physical pathnames include all these slots and a device slot.
106 ;;; Logical pathnames are a subclass of PATHNAME. Their class
107 ;;; relations are mimicked using structures for efficiency.
108 (sb!xc
:defstruct
(logical-pathname (:conc-name %logical-pathname-
)
110 (:constructor %make-logical-pathname