[prev in list] [next in list] [prev in thread] [next in thread] 

List:       sbcl-commits
Subject:    [Sbcl-commits] master: New type PATHNAME-COMPONENT-CASE
From:       Jan Moringen via Sbcl-commits <sbcl-commits () lists ! sourceforge ! net>
Date:       2017-12-29 21:19:05
Message-ID: 1514582345.550096.16902 () sfp-scm-6 ! v30 ! ch3 ! sourceforge ! com
[Download RAW message or body]

The branch "master" has been updated in SBCL:
       via  70e622bc3e7c9e39889b797c1b573271b0eae876 (commit)
      from  f250c77544578d4f8be38258ffc38689b2474f49 (commit)

- Log -----------------------------------------------------------------
commit 70e622bc3e7c9e39889b797c1b573271b0eae876
Author: Jan Moringen <jmoringe@techfak.uni-bielefeld.de>
Date:   Fri Dec 29 20:14:04 2017 +0100

    New type PATHNAME-COMPONENT-CASE
---
 package-data-list.lisp-expr       |  3 ++-
 src/code/deftypes-for-target.lisp |  2 ++
 src/code/target-pathname.lisp     |  2 +-
 src/compiler/fndb.lisp            | 12 ++++++------
 4 files changed, 11 insertions(+), 8 deletions(-)

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index b496d15..cc5b050 100644
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -1891,7 +1891,8 @@ is a good idea, but see SB-SYS re. blurring of boundaries."
                "PACKAGE-HASHTABLE-SIZE" "PACKAGE-HASHTABLE-FREE"
                "PACKAGE-INTERNAL-SYMBOLS" "PACKAGE-EXTERNAL-SYMBOLS"
                "PARSE-UNKNOWN-TYPE"
-               "PARSE-UNKNOWN-TYPE-SPECIFIER" "PATHNAME-DESIGNATOR"
+               "PARSE-UNKNOWN-TYPE-SPECIFIER"
+               "PATHNAME-DESIGNATOR" "PATHNAME-COMPONENT-CASE"
                "POINTER-HASH"
                #!+(or x86 x86-64) "*PSEUDO-ATOMIC-BITS*"
                "PUNT-PRINT-IF-TOO-LONG"
diff --git a/src/code/deftypes-for-target.lisp b/src/code/deftypes-for-target.lisp
index 26fab33..298c666 100644
--- a/src/code/deftypes-for-target.lisp
+++ b/src/code/deftypes-for-target.lisp
@@ -168,6 +168,8 @@
   '(or string pathname #+sb-xc-host stream #-sb-xc-host synonym-stream #-sb-xc-host file-stream))
 (sb!xc:deftype logical-host-designator ()
   '(or host string))
+(sb!xc:deftype pathname-component-case ()
+  '(member :local :common))
 
 (sb!xc:deftype package-designator () '(or string-designator package))
 ;;; a designator for a list of symbols
diff --git a/src/code/target-pathname.lisp b/src/code/target-pathname.lisp
index 1430123..ab92f88 100644
--- a/src/code/target-pathname.lisp
+++ b/src/code/target-pathname.lisp
@@ -627,7 +627,7 @@ a host-structure or string."
            (type (or integer pathname-component-tokens (member :newest))
                  version)
            (type (or pathname-designator null) defaults)
-           (type (member :common :local) case))
+           (type pathname-component-case case))
   (let* ((defaults (when defaults
                      (with-pathname (defaults defaults) defaults)))
          (default-host (if defaults
diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp
index c2f0d89..aea2d25 100644
--- a/src/compiler/fndb.lisp
+++ b/src/compiler/fndb.lisp
@@ -1482,25 +1482,25 @@
        (:directory (or pathname-directory string (member :wild)))
        (:name (or pathname-name string (member :wild)))
        (:type (or pathname-type string (member :wild)))
-       (:version pathname-version) (:case (member :local :common)))
+       (:version pathname-version) (:case pathname-component-case))
   pathname (unsafely-flushable))
 
 (defknown pathnamep (t) boolean (movable flushable))
 
 (defknown pathname-host (pathname-designator
-                         &key (:case (member :local :common)))
+                         &key (:case pathname-component-case))
   pathname-host (flushable))
 (defknown pathname-device (pathname-designator
-                           &key (:case (member :local :common)))
+                           &key (:case pathname-component-case))
   pathname-device (flushable))
 (defknown pathname-directory (pathname-designator
-                              &key (:case (member :local :common)))
+                              &key (:case pathname-component-case))
   pathname-directory (flushable))
 (defknown pathname-name (pathname-designator
-                         &key (:case (member :local :common)))
+                         &key (:case pathname-component-case))
   pathname-name (flushable))
 (defknown pathname-type (pathname-designator
-                         &key (:case (member :local :common)))
+                         &key (:case pathname-component-case))
   pathname-type (flushable))
 (defknown pathname-version (pathname-designator)
   pathname-version (flushable))

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL

------------------------------------------------------------------------------
Check out the vibrant tech community on one of the world's most
engaging tech sites, Slashdot.org! http://sdm.link/slashdot
_______________________________________________
Sbcl-commits mailing list
Sbcl-commits@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/sbcl-commits
[prev in list] [next in list] [prev in thread] [next in thread]