From c080940d02494df79f3dd1574ce5dbd0c4e2c8a0 Mon Sep 17 00:00:00 2001
From: Mike Sperber <sperber@deinprogramm.de>
Date: Thu, 15 Dec 2011 20:57:36 +0100
Subject: [PATCH] Fix infinite recursive signatures.

Such as this, submitted by Torsten Grust:

(define-record-procedures-parametric stream_ stream-of
  make-stream
  stream?
  (stream-head stream-tail))

(define stream
  (lambda (t)
    (signature (stream-of t (-> (stream t))))))

(: from (number -> (stream number)))
(define from
  (lambda (n)
    (make-stream n (lambda () (from (+ n 1))))))

(: foo (stream number))
(define foo (from 1))

The problem was that the arbitaries got evaluated too eagerly.
---
 .../deinprogramm/define-record-procedures.scm   | 17 +++++++++--------
 collects/deinprogramm/signature/signature.rkt   |  2 +-
 2 files changed, 10 insertions(+), 9 deletions(-)

diff --git a/collects/deinprogramm/define-record-procedures.scm b/collects/deinprogramm/define-record-procedures.scm
index 2693ab6252..24864a4c74 100644
--- a/collects/deinprogramm/define-record-procedures.scm
+++ b/collects/deinprogramm/define-record-procedures.scm
@@ -189,14 +189,15 @@
 										 type-descriptor raw-predicate
 										 sigs
 										 #'?type-name)))
-						 (let ((arbs (map signature-arbitrary sigs)))
-						   (when (andmap values arbs)
-						     (set-signature-arbitrary! 
-						      sig
-						      (apply arbitrary-record
-							     ?constructor
-							     (list raw-accessor-proc ...)
-							     arbs))))
+						 (set-signature-arbitrary-promise! 
+						  sig
+						  (delay
+						    (let ((arbs (map signature-arbitrary sigs)))
+						      (when (andmap values arbs)
+							(apply arbitrary-record
+							       ?constructor
+							       (list raw-accessor-proc ...)
+							       arbs)))))
 						 sig)))
 				       'stepper-skip-completely
 				       #t)))
diff --git a/collects/deinprogramm/signature/signature.rkt b/collects/deinprogramm/signature/signature.rkt
index 0f37ad17f3..24f57af199 100644
--- a/collects/deinprogramm/signature/signature.rkt
+++ b/collects/deinprogramm/signature/signature.rkt
@@ -4,7 +4,7 @@
 	 signature-name signature-syntax signature-enforcer
 	 signature-arbitrary-promise
 	 signature-<=?-proc signature-=?-proc
-	 signature-arbitrary set-signature-arbitrary!
+	 signature-arbitrary set-signature-arbitrary! set-signature-arbitrary-promise!
 	 signature-info-promise
 	 signature-violation
 	 signature-violation-proc call-with-signature-violation-proc