~ chicken-core (chicken-5) be77b972f9e691cb7ae1ea1dfbc9a8bda6d9c21e

commit be77b972f9e691cb7ae1ea1dfbc9a8bda6d9c21e
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Fri May 27 11:25:46 2011 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Fri May 27 11:25:46 2011 +0200

    respect enforcement and predicate status for emitted types

diff --git a/support.scm b/support.scm
index 0b26d606..af765114 100644
--- a/support.scm
+++ b/support.scm
@@ -749,8 +749,17 @@
 	 (when (variable-visible? sym)
 	   (when (variable-mark sym '##compiler#declared-type)
 	     (let ((specs
-		    (or (variable-mark sym '##compiler#specializations) '())))
-	       (pp (cons* sym (variable-mark sym '##compiler#type) specs))))))
+		    (or (variable-mark sym '##compiler#specializations) '()))
+		   (type (variable-mark sym '##compiler#type)))
+	       (pp (cons*
+		    sym
+		    (if (and (pair? type) (eq? 'procedure (car type))
+			     (variable-mark sym '##compiler#enforce))
+			`(procedure! ,@(cdr type))
+			type)
+		    specs))
+	       (and-let* ((ptype (variable-mark sym '##compiler#predicate)))
+		 (pp `(#%predicate ,sym ,ptype)))))))
        db)
       (print "; END OF FILE"))))