X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fpathname.lisp;h=61195bdf399b356d1bf0cfa651ac2c1b4d0621a7;hb=c7de1989d006e0b3a4f26143b7a81c9bdb754101;hp=a430f429a6783d52f2225dcef7f2461197bed2ec;hpb=4f7211e1d005696dcd29d8322fa531992ea8fed4;p=sbcl.git diff --git a/src/code/pathname.lisp b/src/code/pathname.lisp index a430f42..61195bd 100644 --- a/src/code/pathname.lisp +++ b/src/code/pathname.lisp @@ -17,13 +17,13 @@ ;;; pathname information into structure slot entries, and after ;;; translation the inverse (unparse) functions. (def!struct (host (:constructor nil)) - (parse (required-argument) :type function) - (unparse (required-argument) :type function) - (unparse-host (required-argument) :type function) - (unparse-directory (required-argument) :type function) - (unparse-file (required-argument) :type function) - (unparse-enough (required-argument) :type function) - (customary-case (required-argument) :type (member :upper :lower))) + (parse (missing-arg) :type function) + (unparse (missing-arg) :type function) + (unparse-host (missing-arg) :type function) + (unparse-directory (missing-arg) :type function) + (unparse-file (missing-arg) :type function) + (unparse-enough (missing-arg) :type function) + (customary-case (missing-arg) :type (member :upper :lower))) (def!method print-object ((host host) stream) (print-unreadable-object (host stream :type t :identity t))) @@ -31,15 +31,15 @@ (def!struct (logical-host (:make-load-form-fun make-logical-host-load-form-fun) (:include host - (:parse #'parse-logical-namestring) - (:unparse #'unparse-logical-namestring) - (:unparse-host + (parse #'parse-logical-namestring) + (unparse #'unparse-logical-namestring) + (unparse-host (lambda (x) (logical-host-name (%pathname-host x)))) - (:unparse-directory #'unparse-logical-directory) - (:unparse-file #'unparse-unix-file) - (:unparse-enough #'unparse-enough-namestring) - (:customary-case :upper))) + (unparse-directory #'unparse-logical-directory) + (unparse-file #'unparse-unix-file) + (unparse-enough #'unparse-enough-namestring) + (customary-case :upper))) (name "" :type simple-base-string) (translations nil :type list) (canon-transls nil :type list)) @@ -48,23 +48,22 @@ (print-unreadable-object (logical-host stream :type t) (prin1 (logical-host-name logical-host) stream))) -;;; What would it mean to dump a logical host and reload it into -;;; another Lisp image? It's not clear, so we don't support it. (defun make-logical-host-load-form-fun (logical-host) - (error "~@" - logical-host)) + (values `(find-logical-host ',(logical-host-name logical-host)) + nil)) ;;; A PATTERN is a list of entries and wildcards used for pattern ;;; matches of translations. -(sb!xc:defstruct (pattern (:constructor make-pattern (pieces))) +(def!struct (pattern (:constructor make-pattern (pieces))) (pieces nil :type list)) ;;;; PATHNAME structures ;;; the various magic tokens that are allowed to appear in pretty much ;;; all pathname components -(sb!xc:deftype pathname-component-tokens () - '(member nil :unspecific :wild)) +(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute) + (def!type pathname-component-tokens () + '(member nil :unspecific :wild))) (sb!xc:defstruct (pathname (:conc-name %pathname-) (:constructor %make-pathname (host