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

Fixed a comment inconsistency about double quotation.

Browse Source
This commit is contained in:
James Ian Johnson 2011-08-18 14:48:31 -04:00 committed by Sam Tobin-Hochstadt
parent 06edc3153f
commit def3834aa2
1 changed files with 13 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
collects/typed-scheme/rep/rep-utils.rkt
View File

@ -82,15 +82,13 @@
#:transparent #:transparent
#:attributes (e proc) #:attributes (e proc)
(pattern #:base (pattern #:base
#:with e fold-target
#:with proc #`(procedure-rename #:with proc #`(procedure-rename
(lambda () #,fold-target) (lambda () #,fold-target)
'#,fold-name)) '#,fold-name))
(pattern match-expander:expr (pattern match-expander:expr
;; Doubly quoted. First unquote at (*1). Second at (*2)
#:with e #'#'match-expander
#:with proc #`(procedure-rename #:with proc #`(procedure-rename
;; still doubly quoted. ;; double quote expander. First unquote below
;; Second unquote at expansion.
(lambda () #'match-expander) (lambda () #'match-expander)
'#,fold-name))) '#,fold-name)))
@ -135,8 +133,6 @@
;; This tricky beast is for defining the type/filter/etc.'s ;; This tricky beast is for defining the type/filter/etc.'s
;; part of the fold. The make-prim-type's given ;; part of the fold. The make-prim-type's given
;; rec-ids are bound in this expression's context. ;; rec-ids are bound in this expression's context.
;; The defining primitive's fields' names are bound as
;; the fields' values.
(~optional [#:fold-rhs (~var fold-rhs (fold-pat #'name.fold))] (~optional [#:fold-rhs (~var fold-rhs (fold-pat #'name.fold))]
#:defaults ;; defaults to folding down all fields. #:defaults ;; defaults to folding down all fields.
([fold-rhs.proc ([fold-rhs.proc
@ -148,6 +144,7 @@
#'(procedure-rename #'(procedure-rename
(lambda () (lambda ()
#`(name.*maker (#,type-rec-id flds.i) ...)) #`(name.*maker (#,type-rec-id flds.i) ...))
;; rename to fold name for better error messages
'name.fold)])) 'name.fold)]))
;; how do we contract a value of this type? ;; how do we contract a value of this type?
(~optional [#:contract contract:expr] (~optional [#:contract contract:expr]
@ -183,7 +180,13 @@
;; set the type's keyword in the hashtable to its ;; set the type's keyword in the hashtable to its
;; match expander, fields and fold-rhs's for further construction. ;; match expander, fields and fold-rhs's for further construction.
(begin-for-syntax (begin-for-syntax
(hash-set! #,ht-stx 'name.kw (list #'name.match-expander #'flds.fields fold-rhs.proc #f))) (hash-set! #,ht-stx
'name.kw
(list #'name.match-expander
#'flds.fields
;; first unquote for match-expander
fold-rhs.proc
#f)))
#,(quasisyntax/loc stx #,(quasisyntax/loc stx
(with-cond-contract name ([name.*maker contract]) (with-cond-contract name ([name.*maker contract])
#,(quasisyntax/loc #'name #,(quasisyntax/loc #'name
@ -233,7 +236,9 @@
;; makes [(Match-name all-patterns ...) body] ;; makes [(Match-name all-patterns ...) body]
(define pat (quasisyntax/loc (or src stx) (define pat (quasisyntax/loc (or src stx)
(#,match-expander . #,pats))) (#,match-expander . #,pats)))
(quasisyntax/loc (or src stx) (#,pat #,(body-f)))])) (quasisyntax/loc (or src stx) (#,pat
;; evaluate thunk containing rhs syntax
#,(body-f)))]))
(define (no-duplicates? lst) (define (no-duplicates? lst)
(cond [(empty? lst) #t] (cond [(empty? lst) #t]