~ chicken-core (chicken-5) 1939cbb960ab5105c8c93b188939ce424c3e7549


commit 1939cbb960ab5105c8c93b188939ce424c3e7549
Author:     Evan Hanson <evhan@foldling.org>
AuthorDate: Tue Feb 16 09:29:11 2016 +1300
Commit:     Peter Bex <peter@more-magic.net>
CommitDate: Sat Feb 20 13:56:02 2016 +0100

    Allow compatible types, not just subtypes, in (the ...) declarations
    
    Add "the" declaration to parameterize to allow compilation
    with -strict-types (thanks to Joerg Wittenberger)
    
    Signed-off-by: Peter Bex <peter@more-magic.net>

diff --git a/chicken-syntax.scm b/chicken-syntax.scm
index 0ccf0c48..79251957 100644
--- a/chicken-syntax.scm
+++ b/chicken-syntax.scm
@@ -279,6 +279,8 @@
     (##sys#check-syntax 'parameterize form '#(_ 2))
     (let* ((bindings (cadr form))
 	   (body (cddr form))
+	   (the (r 'the))
+	   (boolean (r 'boolean))
 	   (convert? (r 'convert?))
 	   (params (##sys#map car bindings))
 	   (vals (##sys#map cadr bindings))
@@ -290,7 +292,7 @@
 	(##core#let
 	 ,(map ##sys#list saveds vals)
 	 (##core#let
-	  ((,convert? #t)) ; Convert only first time extent is entered!
+	  ((,convert? (,the ,boolean #t))) ; Convert only first time extent is entered!
 	  (##sys#dynamic-wind
 	   (##core#lambda ()
 	    (##core#let
diff --git a/scrutinizer.scm b/scrutinizer.scm
index 228d7235..da897658 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -811,11 +811,11 @@
 			      "expression returns ~a values but is declared to have \
 			       a single result" (length rt)))
 			   (when (and (second params)
-				      (not (type<=? t (first rt))))
+				      (not (compatible-types? t (first rt))))
 			     ((if strict-variable-types report-error report-notice)
 			      loc
 			      "expression returns a result of type `~a' but is \
-			       declared to return `~a', which is not a subtype"
+			       declared to return `~a', which is not compatible"
 			      (first rt) t))))
 		    (list t)))
 		 ((##core#typecase)
diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected
index e7b28cb2..6811bee3 100644
--- a/tests/scrutiny.expected
+++ b/tests/scrutiny.expected
@@ -76,7 +76,7 @@ Warning: in toplevel procedure `foo10':
   (scrutiny-tests.scm:105) in procedure call to `+', expected argument #1 of type `number' but was given an argument of type `string'
 
 Note: in toplevel procedure `foo10':
-  expression returns a result of type `string' but is declared to return `pair', which is not a subtype
+  expression returns a result of type `string' but is declared to return `pair', which is not compatible
 
 Warning: in toplevel procedure `foo10':
   (scrutiny-tests.scm:109) in procedure call to `string-append', expected argument #1 of type `string' but was given an argument of type `pair'
@@ -84,9 +84,6 @@ Warning: in toplevel procedure `foo10':
 Warning: in toplevel procedure `foo10':
   expression returns 2 values but is declared to have a single result
 
-Note: in toplevel procedure `foo10':
-  expression returns a result of type `fixnum' but is declared to return `*', which is not a subtype
-
 Warning: in toplevel procedure `foo10':
   expression returns zero values but is declared to have a single result of type `*'
 
Trap