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

I believe this fixes PR12117. The teaching languages rely on syntax/struct. (I have run the teaching language tests, but do not other uses of syntax/struct.) It appears that syntax/struct has been incorrectly creating this information for some time. The problem is that it would end the static info with a #f if the selectors or setters were omitted, but reading the documentation implies that there should be a final #f in either case. I've therefore changed the boolean to an or over the flags

Browse Source
This commit is contained in:
Jay McCarthy 2011-08-19 11:30:19 -06:00
parent 292feaad43
commit 3cd6be5931
2 changed files with 53 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

88
collects/syntax/struct.rkt
View File

@ -182,47 +182,53 @@
(define build-struct-expand-info*
(lambda (names name-stx fields omit-sel? omit-set? base-name base-getters base-setters)
(let* ([flds (cdddr names)]
[every-other (lambda (l)
(let loop ([l l])
(cond
[(null? l) null]
[(null? (cdr l)) (list (car l))]
[else (cons (car l) (loop (cddr l)))])))]
[add-#f (lambda (omit? base)
(if omit?
(if (let loop ([l base])
(cond
[(null? l) #t]
[(not (car l)) #f]
[else (loop (cdr l))]))
(append base '(#f))
base)
base))]
[qs (lambda (x) (if (eq? x #t)
x
(and x `(quote-syntax ,x))))]
[self-sels (reverse (if omit-sel?
null
(map qs (if omit-set? flds (every-other flds)))))]
[self-sets (reverse (if omit-sel?
null
(if omit-set?
(map (lambda (sel) #f) self-sels)
(map qs (every-other (if (null? flds)
null
(cdr flds)))))))])
`(let ()
(list
,(qs (car names))
,(qs (cadr names))
,(qs (caddr names))
(list
,@self-sels
,@(map qs (add-#f omit-sel? base-getters)))
(list
,@self-sets
,@(map qs (add-#f omit-set? base-setters)))
,(qs base-name))))))
[every-other (lambda (l)
(let loop ([l l])
(cond
[(null? l) null]
[(null? (cdr l)) (list (car l))]
[else (cons (car l) (loop (cddr l)))])))]
[add-#f (lambda (omit? base)
(if omit?
(if (let loop ([l base])
(cond
[(null? l) #t]
[(not (car l)) #f]
[else (loop (cdr l))]))
(append base '(#f))
base)
base))]
[qs (lambda (x) (if (eq? x #t)
x
(and x `(quote-syntax ,x))))]
[self-sels (reverse (if omit-sel?
null
(map qs (if omit-set? flds (every-other flds)))))]
[self-sets (reverse (if omit-sel?
null
(if omit-set?
(map (lambda (sel) #f) self-sels)
(map qs (every-other (if (null? flds)
null
(cdr flds)))))))]
[all-sels
`(list
,@self-sels
,@(map qs (add-#f (or omit-sel? omit-set?) base-getters)))]
[all-sets
`(list
,@self-sets
,@(map qs (add-#f (or omit-sel? omit-set?) base-setters)))]
[ans
`(let ()
(list
,(qs (car names))
,(qs (cadr names))
,(qs (caddr names))
,all-sels
,all-sets
,(qs base-name)))])
ans)))
(define (struct-declaration-info? x)

6
collects/tests/htdp-lang/pr/12117.rkt Normal file
View File

@ -0,0 +1,6 @@
#lang htdp/bsl
(require racket/match)
(define-struct a (b))
(match (make-a 1)
[(struct a (b)) b]
[#f 3])