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

improve expansion of some unit forms to limit expansion size

Browse Source 
Merge to 5.0

original commit: c3fdf47cc7052a617913f45153f6b75fbe1ce6da
This commit is contained in:
Matthew Flatt 2010-06-03 11:07:44 -06:00
commit 7ad10fe4d0
2 changed files with 41 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/mzlib/date.rkt
View File

@ -8,7 +8,7 @@
(provide/contract (provide/contract
[current-date (-> date?)] [current-date (-> date?)]
[date->seconds (date? . -> . exact-integer?)] [date->seconds (date? . -> . exact-integer?)]
[date->string ((date?) (boolean?) . ->* . string?)] [date->string ((date?) (any/c) . ->* . string?)]
[date-display-format (parameter/c (symbols 'american 'chinese 'german 'indian 'irish 'julian 'iso-8601 'rfc2822))] [date-display-format (parameter/c (symbols 'american 'chinese 'german 'indian 'irish 'julian 'iso-8601 'rfc2822))]
[find-seconds ((integer-in 0 61) [find-seconds ((integer-in 0 61)
(integer-in 0 59) (integer-in 0 59)

60
collects/mzlib/unit.rkt
View File

@ -546,22 +546,30 @@
;; build-val+macro-defs : sig -> (list syntax-object^3) ;; build-val+macro-defs : sig -> (list syntax-object^3)
(define-for-syntax (build-val+macro-defs sig) (define-for-syntax (build-val+macro-defs sig)
(with-syntax ([(((int-ivar . ext-ivar) ...) (if (and (null? (cadr sig))
((((int-vid . ext-vid) ...) . vbody) ...) (null? (caddr sig)))
((((int-sid . ext-sid) ...) . sbody) ...) ;; No renames needed; this shortcut avoids
_ ;; an explosion of renamings, especially with chains
_) ;; of `open':
(map-sig (lambda (x) x) (list #'(() (values)) #'() #'())
(make-syntax-introducer) ;; Renames and macros needes:
sig)]) (with-syntax ([(((int-ivar . ext-ivar) ...)
(list ((((int-vid . ext-vid) ...) . vbody) ...)
#'((ext-ivar ... ext-vid ... ... ext-sid ... ...) ((((int-sid . ext-sid) ...) . sbody) ...)
(values _
(make-rename-transformer (quote-syntax int-ivar)) ... _)
(make-rename-transformer (quote-syntax int-vid)) ... ... (map-sig (lambda (x) x)
(make-rename-transformer (quote-syntax int-sid)) ... ...)) (make-syntax-introducer)
#'(((int-sid ...) sbody) ...) sig)])
#'(((int-vid ...) vbody) ...)))) (list
#'((ext-ivar ... ext-vid ... ... ext-sid ... ...)
(make-rename-transformers
(quote-syntax
(int-ivar ...
int-vid ... ...
int-sid ... ...))))
#'(((int-sid ...) sbody) ...)
#'(((int-vid ...) vbody) ...)))))
;; build-post-val-defs : sig -> (list syntax-object) ;; build-post-val-defs : sig -> (list syntax-object)
(define-for-syntax (build-post-val-defs sig) (define-for-syntax (build-post-val-defs sig)
@ -575,12 +583,24 @@
sig)]) sig)])
(list (list
#'((ext-ivar ... ext-vid ... ... ext-sid ... ...) #'((ext-ivar ... ext-vid ... ... ext-sid ... ...)
(values (make-rename-transformers
(make-rename-transformer (quote-syntax int-ivar)) ... (quote-syntax
(make-rename-transformer (quote-syntax int-vid)) ... ... (int-ivar ...
(make-rename-transformer (quote-syntax int-sid)) ... ...)) int-vid ... ...
int-sid ... ...))))
#'(post-rhs ...)))) #'(post-rhs ...))))
;; Using `make-rename-transformers' helps improve sharing in
;; a syntax-quoted list of identifiers, although it risks
;; losting certificates as the list is broken apart; since the
;; identifiers are bound at the same point that the rename
;; transformer is introduced, certificate loss should be ok.
(define-for-syntax (make-rename-transformers ids)
(apply values
(map
make-rename-transformer
(syntax->list ids))))
(define-signature-form (open stx) (define-signature-form (open stx)
(define (build-sig-elems sig) (define (build-sig-elems sig)
(map (λ (p c) (map (λ (p c)