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.
This commit is contained in:
Mike Sperber 2011-12-15 20:57:36 +01:00
parent 6742c308d9
commit c080940d02
2 changed files with 10 additions and 9 deletions

View File

@ -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)))

View File

@ -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