X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fextensions.lisp;h=6d25386567c8a6793ce74f94c7d45c76bb1c508d;hb=c8218514d751c4d777892b79bbf1ca6597f731c0;hp=4c6c4e20220a9d980fcda439a900e67f6b6aff25;hpb=dfa55a883f94470267b626dae77ce7e7dfac3df6;p=sbcl.git

diff --git a/src/code/extensions.lisp b/src/code/extensions.lisp
index 4c6c4e2..6d25386 100644
--- a/src/code/extensions.lisp
+++ b/src/code/extensions.lisp
@@ -42,6 +42,12 @@
 ;;; bound because ANSI specifies it as an exclusive bound.)
 (def!type index () `(integer 0 (,sb!xc:array-dimension-limit)))
 
+;;; like INDEX, but augmented with -1 (useful when using the index
+;;; to count downwards to 0, e.g. LOOP FOR I FROM N DOWNTO 0, with
+;;; an implementation which terminates the loop by testing for the
+;;; index leaving the loop range)
+(def!type index-or-minus-1 () `(integer -1 (,sb!xc:array-dimension-limit)))
+
 ;;; the default value used for initializing character data. The ANSI
 ;;; spec says this is arbitrary. CMU CL used #\NULL, which we avoid
 ;;; because it's not in the ANSI table of portable characters.
@@ -98,7 +104,7 @@
 	 (do ((y x (safe-cddr y))
 	      (started-p nil t)
 	      (z x (cdr z)))
-	     ((or (not z) (not y)) nil)
+	     ((not (and (consp z) (consp y))) nil)
 	   (when (and started-p (eq y z))
 	     (return t))))))
 
@@ -538,6 +544,13 @@
 	(t
 	 (error "not legal as a function name: ~S" function-name))))
 
+(defun looks-like-name-of-special-var-p (x)
+  (and (symbolp x)
+       (let ((name (symbol-name x)))
+	 (and (> (length name) 2) ; to exclude '* and '**
+	      (char= #\* (aref name 0))
+	      (char= #\* (aref name (1- (length name))))))))
+
 ;;; ANSI guarantees that some symbols are self-evaluating. This
 ;;; function is to be called just before a change which would affect
 ;;; that. (We don't absolutely have to call this function before such
@@ -625,7 +638,7 @@
 (defmacro enforce-type (value type)
   (once-only ((value value))
     `(unless (typep ,value ',type)
-       (%failed-aver-type ,value ',type))))
+       (%failed-enforce-type ,value ',type))))
 (defun %failed-enforce-type (value type)
   (error 'simple-type-error
 	 :value value
@@ -854,6 +867,14 @@
 	 (print-unreadable-object (structure ,stream :type t)
 	   ,@(nreverse reversed-prints))))))
 
+;;;; etc.
+
+;;; Given a pathname, return a corresponding physical pathname.
+(defun physicalize-pathname (possibly-logical-pathname)
+  (if (typep possibly-logical-pathname 'logical-pathname)
+      (translate-logical-pathname possibly-logical-pathname)
+      possibly-logical-pathname))
+
 #|
 ;;; REMOVEME when done testing byte cross-compiler
 (defun byte-compiled-foo (x y)