~ chicken-core (chicken-5) 90dd06cb5930974f1b8532bdbbe63f6bbbd01e75

commit 90dd06cb5930974f1b8532bdbbe63f6bbbd01e75
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Sat Mar 19 20:40:59 2011 +0100
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Sat Mar 19 20:40:59 2011 +0100

    scrutiny/specialization bugfixes

diff --git a/chicken-syntax.scm b/chicken-syntax.scm
index a32478bf..5e8879d7 100644
--- a/chicken-syntax.scm
+++ b/chicken-syntax.scm
@@ -1117,16 +1117,17 @@
  (##sys#er-transformer
   (lambda (x r c)
     (##sys#check-syntax ': x '(_ symbol _ . _))
-    (let* ((name (##sys#globalize (cadr x)))
-	   (type1 (##sys#strip-syntax (caddr x)))
-	   (name1 (##sys#strip-syntax (cadr x)))
-	   (type (validate-type type1 name1)))
-      (cond ((not type)
-	     (syntax-error ': "invalid type syntax" name1 type1))
-	    ((memq #:csi ##sys#features) '(##core#undefined))
-	    (else
-	     `(##core#declare 
-	       (type (,name ,type ,@(cdddr x))))))))))
+    (if (memq #:csi ##sys#features) 
+	'(##core#undefined)
+	(let* ((name (cadr x))
+	       (type1 (##sys#strip-syntax (caddr x)))
+	       (name1 (##sys#strip-syntax (cadr x)))
+	       (type (##compiler#validate-type type1 name1)))
+	  (cond ((not type)
+		 (syntax-error ': "invalid type syntax" name1 type1))
+		(else
+		 `(##core#declare 
+		   (type (,name ,type ,@(cdddr x)))))))))))
 
 
 (##sys#macro-subset me0 ##sys#default-macro-environment)))
diff --git a/compiler-namespace.scm b/compiler-namespace.scm
index 718a7876..6246570f 100644
--- a/compiler-namespace.scm
+++ b/compiler-namespace.scm
@@ -289,10 +289,10 @@
  update-line-number-database
  update-line-number-database!
  used-units
- validate-type
  valid-c-identifier?
  valid-compiler-options
  valid-compiler-options-with-argument
+ validate-type
  variable-mark
  variable-visible?
  varnode
diff --git a/compiler.scm b/compiler.scm
index b7245a3e..593026dc 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -1470,7 +1470,7 @@
 			 (>= 2 (length spec))
 			 (symbol? (car spec))))
 	       (warning "illegal type declaration" (##sys#strip-syntax spec))
-	       (let ((name (##sys#globalize (car spec)))
+	       (let ((name (##sys#globalize (car spec) se))
 		     (type (##sys#strip-syntax (cadr spec))))
 		 (cond ((validate-type type name)
 			(mark-variable name '##core#type type)
diff --git a/scrutinizer.scm b/scrutinizer.scm
index 3907ddd5..357507c2 100755
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -794,21 +794,19 @@
 		       (let ((ts (validate-llist (car t2))))
 			 (and ts
 			      (every identity ts)
-			      (let ((rt (if (eq? '* (cddr t2))
-					    (cddr t2)
-					    (and (list? (cddr t2))
-						 (let ((rts
-							(map
-							 validate
-							 (cddr t2))))
-						   (and (every identity rts)
-							rts))))))
+			      (let* ((rt2 (cdr t2))
+				     (rt (if (eq? '* rt2) 
+					     rt2
+					     (and (list? rt2)
+						  (let ((rts (map validate rt2)))
+						    (and (every identity rts)
+							 rts))))))
 				(and rt
 				     `(procedure 
 				       ,@(if name (list name) '())
 				       ,ts
 				       ,@rt)))))))))
-	  ((and (pair? (cdr t)) (memq '-> (cadr t))) =>
+	  ((and (pair? (cdr t)) (memq '-> (cdr t))) =>
 	   (lambda (p)
 	     (validate
 	      `(procedure ,(upto t p) ,@(cdr p)))))