Permalink
Browse files

Fix -struct to use the right number of arguments to make-Struct.

  • Loading branch information...
1 parent 78b445f commit c9764667cc56e9c75c4ff96998f8cbc74345ec6d @endobson committed Sep 2, 2012
@@ -118,13 +118,12 @@
[(-poly (b) ((Un (make-Base 'foo #'dummy values #'values #f)
(-struct #'bar #f
- (list (make-fld -Number #'values #f) (make-fld b #'values #f))
- #'values))
+ (list (make-fld -Number #'values #f) (make-fld b #'values #f))))
. -> . (-lst b)))
- ((Un (make-Base 'foo #'dummy values #'values #f) (-struct #'bar #f (list (make-fld -Number #'values #f) (make-fld (-pair -Number (-v a)) #'values #f)) #'values))
+ ((Un (make-Base 'foo #'dummy values #'values #f) (-struct #'bar #f (list (make-fld -Number #'values #f) (make-fld (-pair -Number (-v a)) #'values #f))))
. -> . (-lst (-pair -Number (-v a))))]
- [(-poly (b) ((-struct #'bar #f (list (make-fld -Number #'values #f) (make-fld b #'values #f)) #'values) . -> . (-lst b)))
- ((-struct #'bar #f (list (make-fld -Number #'values #f) (make-fld (-pair -Number (-v a)) #'values #f)) #'values) . -> . (-lst (-pair -Number (-v a))))]
+ [(-poly (b) ((-struct #'bar #f (list (make-fld -Number #'values #f) (make-fld b #'values #f))) . -> . (-lst b)))
+ ((-struct #'bar #f (list (make-fld -Number #'values #f) (make-fld (-pair -Number (-v a)) #'values #f))) . -> . (-lst (-pair -Number (-v a))))]
[(-poly (a) (a . -> . (make-Listof a))) ((-v b) . -> . (make-Listof (-v b)))]
[(-poly (a) (a . -> . (make-Listof a))) ((-pair -Number (-v b)) . -> . (make-Listof (-pair -Number (-v b))))]
@@ -136,9 +135,9 @@
(FAIL (-> Univ) (null Univ . ->* . Univ))
[(cl->* (-Number . -> . -String) (-Boolean . -> . -String)) ((Un -Boolean -Number) . -> . -String)]
- [(-struct #'a #f null #'values) (-struct #'a #f null #'values)]
- [(-struct #'a #f (list (make-fld -String #'values #f)) #'values) (-struct #'a #f (list (make-fld -String #'values #f)) #'values)]
- [(-struct #'a #f (list (make-fld -String #'values #f)) #'values) (-struct #'a #f (list (make-fld Univ #'values #f)) #'values)]
+ [(-struct #'a #f null) (-struct #'a #f null)]
+ [(-struct #'a #f (list (make-fld -String #'values #f))) (-struct #'a #f (list (make-fld -String #'values #f)))]
+ [(-struct #'a #f (list (make-fld -String #'values #f))) (-struct #'a #f (list (make-fld Univ #'values #f)))]
))
(define-go
@@ -40,12 +40,11 @@
;; found bug
[FAIL (Un (-mu heap-node
(-struct #'heap-node #f
- (map fld* (list (-base 'comparator) -Number (-v a) (Un heap-node (-base 'heap-empty))))
- #'values))
+ (map fld* (list (-base 'comparator) -Number (-v a) (Un heap-node (-base 'heap-empty))))))
(-base 'heap-empty))
(Un (-mu heap-node
(-struct #'heap-node #f
- (map fld* (list (-base 'comparator) -Number (-pair -Number -Number) (Un heap-node (-base 'heap-empty)))) #'values))
+ (map fld* (list (-base 'comparator) -Number (-pair -Number -Number) (Un heap-node (-base 'heap-empty))))))
(-base 'heap-empty))]))
(define-go
@@ -418,8 +418,8 @@
(define (make-arr-dots dom rng dty dbound)
(make-arr* dom rng #:drest (cons dty dbound)))
-(define (-struct name parent flds constructor [proc #f] [poly #f] [pred #'dummy] [cert values])
- (make-Struct name parent flds proc poly pred cert constructor))
+(define (-struct name parent flds [proc #f] [poly #f] [pred #'dummy])
+ (make-Struct name parent flds proc poly pred))
(define/cond-contract (-filter t i [p null])
(c:->* (Type/c name-ref/c) ((listof PathElem?)) Filter/c)

0 comments on commit c976466

Please sign in to comment.