Revert "Create arbitraties off parametric struct/record signature constructors."

This reverts commit 7df9a22a67.

It was broken in several ways.  New attempt later.
This commit is contained in:
Mike Sperber 2010-10-09 17:48:58 +02:00
parent a0e4eb990d
commit f706b0d7a7
6 changed files with 22 additions and 49 deletions

View File

@ -12,8 +12,7 @@
mzlib/pretty mzlib/pretty
deinprogramm/signature/signature deinprogramm/signature/signature
deinprogramm/signature/signature-german deinprogramm/signature/signature-german
deinprogramm/signature/signature-syntax deinprogramm/signature/signature-syntax)
(only-in deinprogramm/quickcheck/quickcheck arbitrary-record))
(require (for-syntax scheme/base) (require (for-syntax scheme/base)
(for-syntax deinprogramm/syntax-checkers) (for-syntax deinprogramm/syntax-checkers)

View File

@ -183,17 +183,10 @@
component-signature ...))) component-signature ...)))
;; lazy signatures ;; lazy signatures
#'(define (?signature-constructor-name ?param ...) #'(define (?signature-constructor-name ?param ...)
(let* ((sigs (list ?param ...))
(sig
(make-lazy-wrap-signature '?type-name #t (make-lazy-wrap-signature '?type-name #t
type-descriptor raw-predicate type-descriptor raw-predicate
sigs (list ?param ...)
#'?type-name))) #'?type-name)))
(let ((arbs (map signature-arbitrary sigs)))
(when (andmap values arbs)
(set-signature-arbitrary! sig
(apply arbitrary-record ?constructor arbs))))
sig)))
'stepper-skip-completely 'stepper-skip-completely
#t))) #t)))
#'(begin #'(begin

View File

@ -12,7 +12,6 @@
arbitrary-mixed arbitrary-one-of arbitrary-mixed arbitrary-one-of
arbitrary-pair arbitrary-pair
arbitrary-list arbitrary-list
arbitrary-tuple arbitrary-record
arbitrary-vector arbitrary-vector
arbitrary-string arbitrary-string
arbitrary-ascii-string arbitrary-printable-ascii-string arbitrary-ascii-string arbitrary-printable-ascii-string

View File

@ -312,7 +312,11 @@
(coarbitrary arbitrary-cdr (coarbitrary arbitrary-cdr
(cdr p) gen))))) (cdr p) gen)))))
(define (make-tuple-transformer arbitrary-els) ; a tuple is just a non-uniform list
(define (arbitrary-tuple . arbitrary-els)
(make-arbitrary (apply lift->generator
list
(map arbitrary-generator arbitrary-els))
(lambda (lis gen) (lambda (lis gen)
(let recur ((arbitrary-els arbitrary-els) (let recur ((arbitrary-els arbitrary-els)
(lis lis)) (lis lis))
@ -321,21 +325,7 @@
((arbitrary-transformer (car arbitrary-els)) ((arbitrary-transformer (car arbitrary-els))
(car lis) (car lis)
(recur (cdr arbitrary-els) (recur (cdr arbitrary-els)
(cdr lis))))))) (cdr lis))))))))
; a tuple is just a non-uniform list
(define (arbitrary-tuple . arbitrary-els)
(make-arbitrary (apply lift->generator
list
(map arbitrary-generator arbitrary-els))
(make-tuple-transformer arbitrary-els)))
; like a tuple, just with a different constructor
(define (arbitrary-record make . arbitrary-els)
(make-arbitrary (apply lift->generator
make
(map arbitrary-generator arbitrary-els))
(make-tuple-transformer arbitrary-els)))
(define (arbitrary-sequence choose-sequence sequence->list arbitrary-el) (define (arbitrary-sequence choose-sequence sequence->list arbitrary-el)
(make-arbitrary (sized (make-arbitrary (sized

View File

@ -291,10 +291,9 @@ Dieser Testfall überprüft experimentell, ob die @tech{Eigenschaft}
@emph{Wichtig:} @scheme[check-property] funktioniert nur für @emph{Wichtig:} @scheme[check-property] funktioniert nur für
Eigenschaften, bei denen aus den Signaturen sinnvoll Werte generiert Eigenschaften, bei denen aus den Signaturen sinnvoll Werte generiert
werden können. Dies ist für die meisten eingebauten Signaturen der werden können. Dies ist für die meisten eingebauten Signaturen der
Fall, aber nicht für Signaturvariablen und Signaturen, die mit @scheme[predicate] Fall, aber nicht für Signaturvariablen und Signaturen, die mit @scheme[predicate],
oder @scheme[define-record-procedures] definiert @scheme[property] oder @scheme[define-record-procedures] definiert
wurden - wohl aber für Signaturen, die mit dem durch @scheme[define-record-procedures-parametric] definierten wurden. In diesen Fällen erzeugt @scheme[check-property] eine Fehlermeldung.
Signaturkonstruktor erzeugt wurden.
} }
@section{Parametrische Record-Typ-Definitionen} @section{Parametrische Record-Typ-Definitionen}

View File

@ -894,18 +894,11 @@
(combined (at name_ (predicate raw-predicate)) (combined (at name_ (predicate raw-predicate))
(at field_ (signature:property getter-name field_/no-loc)) ...))) (at field_ (signature:property getter-name field_/no-loc)) ...)))
#`(define (#,parametric-signature-name field_ ...) #`(define (#,parametric-signature-name field_ ...)
(let* ((sigs (list field_/no-loc ...))
(sig
(make-lazy-wrap-signature 'name_ #t (make-lazy-wrap-signature 'name_ #t
type-descriptor type-descriptor
raw-predicate raw-predicate
sigs (list field_/no-loc ...)
#'name_))) #'name_)))
(let ((arbs (map signature-arbitrary sigs)))
(when (andmap values arbs)
(set-signature-arbitrary! sig
(apply arbitrary-record #,constructor-name arbs))))
sig)))
(values #,signature-name #,parametric-signature-name proc-name ...))) (values #,signature-name #,parametric-signature-name proc-name ...)))
'stepper-define-struct-hint 'stepper-define-struct-hint