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 (defstruct (host (:constructor nil)
  20                  (:copier nil)
  21                  (:print-object
  22                   (lambda (host stream)
  23                     (print-unreadable-object (host stream :type t :identity t)))))
  24   (parse (missing-arg) :type function :read-only t)
  25   (parse-native (missing-arg) :type function :read-only t)
  26   (unparse (missing-arg) :type function :read-only t)
  27   (unparse-native (missing-arg) :type function :read-only t)
  28   (unparse-host (missing-arg) :type function :read-only t)
  29   (unparse-directory (missing-arg) :type function :read-only t)
  30   (unparse-file (missing-arg) :type function :read-only t)
  31   (unparse-enough (missing-arg) :type function :read-only t)
  32   (unparse-directory-separator (missing-arg) :type simple-string :read-only t)
  33   (simplify-namestring (missing-arg) :type function :read-only t)
  34   (customary-case (missing-arg) :type (member :upper :lower) :read-only t))
  35
  36 ;;; A PATTERN is a list of entries and wildcards used for pattern
  37 ;;; matches of translations.
  38 (defstruct (pattern (:constructor %make-pattern (hash pieces))
  39                     (:copier nil))
  40   (hash 0 :type fixnum :read-only t)
  41   (pieces nil :type list :read-only t))
  42 \f
  43 ;;;; PATHNAME structures
  44
  45 ;;; the various magic tokens that are allowed to appear in pretty much
  46 ;;; all pathname components
  47 (deftype pathname-component-tokens ()
  48   '(member nil :unspecific :wild :unc))
  49
  50 ;;; This definition relies on compiler magic to turn the metclass
  51 ;;; into BUILT-IN-CLASSOID. Same for LOGICAL-PATHNAME.
  52 (defstruct (pathname (:conc-name %pathname-)
  53                      (:copier nil)
  54                      (:constructor !allocate-pathname
  55                          (host device dir+hash name type version))
  56                      (:predicate pathnamep))
  57   (namestring nil) ; computed on demand
  58   ;; the host (at present either a UNIX or logical host)
  59   ;; Host and device could be reduced to small integers and packed in one slot
  60   ;; by keeping tables of the observed values.
  61   (host nil :type %pathname-host :read-only t)
  62   ;; the name of a logical or physical device holding files
  63   (device nil :type (or simple-string pathname-component-tokens) :read-only t)
  64   ;; an interned list of strings headed by :ABSOLUTE or :RELATIVE
  65   ;; comprising the path, or NIL.
  66   ;; if the list is non-NIL, it's a cons of the list and a numeric hash.
  67   (dir+hash nil :type list :read-only t)
  68   ;; the filename
  69   (name nil :type (or simple-string pattern pathname-component-tokens) :read-only t)
  70   ;; the type extension of the file
  71   (type nil :type (or simple-string pattern pathname-component-tokens) :read-only t)
  72   ;; the version number of the file, a positive integer (not supported
  73   ;; on standard Unix filesystems)
  74   (version nil :type %pathname-version :read-only t))
  75
  76 (let ((to (find-layout 'logical-pathname))
  77       (from (find-layout 'pathname)))
  78   (setf (layout-info to) (layout-info from)
  79         (layout-slot-table to) (layout-slot-table from)))
  80 (declaim (inline logical-pathname-p))
  81 (defun logical-pathname-p (x) (typep x 'logical-pathname))