suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/deinprogramm/define-record-procedures.rkt
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)

15
collects/deinprogramm/define-record-procedures.scm
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 ...)) (make-lazy-wrap-signature '?type-name #t
(sig type-descriptor raw-predicate
(make-lazy-wrap-signature '?type-name #t (list ?param ...)
type-descriptor raw-predicate #'?type-name)))
sigs
#'?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

1
collects/deinprogramm/quickcheck/quickcheck.rkt
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

28
collects/deinprogramm/quickcheck/quickcheck.scm
View File

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

7
collects/deinprogramm/scribblings/DMdA-beginner.scrbl
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}

17
collects/lang/private/teach.rkt
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 ...)) (make-lazy-wrap-signature 'name_ #t
(sig type-descriptor
(make-lazy-wrap-signature 'name_ #t raw-predicate
type-descriptor (list field_/no-loc ...)
raw-predicate #'name_)))
sigs
#'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