~ chicken-core (chicken-5) 9d1495e09d6decd57119872bb47b2976d4896642

commit 9d1495e09d6decd57119872bb47b2976d4896642
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Fri Jun 24 14:23:20 2011 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Fri Jun 24 14:23:20 2011 +0200

    rest-list access in speciialization-templates; fixed specialization-syntax specification; show walk-depth in debug output

diff --git a/scrutinizer.scm b/scrutinizer.scm
index 72a3e77b..6ce2190b 100755
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -41,7 +41,7 @@
 
 (define (d fstr . args)
   (when (##sys#fudge 13)
-    (printf "[debug] ~a~?~%" (make-string d-depth #\space) fstr args)) )
+    (printf "[debug|~a] ~a~?~%" d-depth (make-string d-depth #\space) fstr args)) )
 
 (define dd d)
 
@@ -78,9 +78,11 @@
 ;
 ; specialization specifiers:
 ;
-;   SPECIALIZATION = ((MVAL ... [#!rest MVAL]) TEMPLATE)
+;   SPECIALIZATION = ((MVAL ... [#!rest MVAL]) [RESULTS] TEMPLATE)
 ;   MVAL = VAL | (not VAL) | (or VAL ...) | (and VAL ...)
-;   TEMPLATE = #(INDEX [...])
+;   TEMPLATE = #(INDEX)
+;            | #(-INDEX)
+;            | #(SYMBOL)
 ;            | INTEGER | SYMBOL | STRING
 ;            | (quote CONSTANT)
 ;            | (TEMPLATE . TEMPLATE)
@@ -1161,7 +1163,10 @@
       (cond ((and (vector? x)
 		  (= 1 (vector-length x)) )
 	     (let ((y (vector-ref x 0)))
-	       (cond ((integer? y) (list-ref args (sub1 y)))
+	       (cond ((integer? y)
+		      (if (negative? y)
+			  (list-tail args (sub1 (- y)))
+			  (list-ref args (sub1 y))))
 		     ((symbol? y)
 		      (cond ((assq y env) => cdr)
 			    (else
diff --git a/types.db b/types.db
index 5041696e..7c6d1179 100644
--- a/types.db
+++ b/types.db
@@ -96,7 +96,6 @@
 (set-cdr! (procedure! set-cdr! (pair *) undefined) ((pair *) (##sys#setslot #(1) '1 #(2))))
 
 (null? (procedure? null null? (*) boolean))
-
 (list? (procedure? list list? (*) boolean))
 
 (list (procedure list (#!rest) list))
@@ -158,10 +157,6 @@
      ((float float) (##core#inline "C_i_flonum_min" #(1) #(2))))
 
 (+ (procedure! + (#!rest number) number)
-;XXX add these, also for other multi-arity, possibly fast operations:
-;
-;   ((* * * *) (+ (+ (+ #(1) #(2)) #(3)) #(4)))
-;   ((* * *) (+ (+ #(1) #(2)) #(3)))
    ((fixnum) (fixnum) #(1))
    ((float) (float) #(1))
    ((number) #(1))