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

reduce code generated by in-X-set sequence constructors

Browse Source
This commit is contained in:
Stephen Chang 2019-07-26 13:32:04 -04:00
parent 69d748a95e
commit e22abfb8a4
1 changed files with 21 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
racket/collects/racket/private/set-types.rkt
View File

@ -591,7 +591,17 @@
;; creates an new id with the given id and format str ;; creates an new id with the given id and format str
(define-for-syntax (mk-id id fmt-str) (define-for-syntax (mk-id id fmt-str)
(datum->syntax id (string->symbol (format fmt-str (syntax->datum id))))) (datum->syntax id (string->symbol (format fmt-str (syntax->datum id)))))
;; raise-custom-set-exn : Any Symbol -> Exn
;; Raises exception reporting that `s` is not a custom-set of type `expected-set-type`
(define (raise-custom-set-exn s expected-set-type)
(raise
(exn:fail:contract
(if (custom-set? s)
(format "wrong kind of hash set, expected ~a, got: ~a\n" expected-set-type s)
(format "not a hash set: ~a" s))
(current-continuation-marks))))
(define-syntax (define-in-set-sequence-syntax stx) (define-syntax (define-in-set-sequence-syntax stx)
(syntax-case stx (set-type:) (syntax-case stx (set-type:)
[(_ set-type: SETTYPE) [(_ set-type: SETTYPE)
@ -610,24 +620,17 @@
#'[(id) #'[(id)
(:do-in (:do-in
;;outer bindings ;;outer bindings
([(HT fn) (let ([xs set-expr]) ([(xs HT fn) (let ([xs set-expr])
(if (and (custom-set? xs) (-test? xs)) (if (and (custom-set? xs) (-test? xs))
(values (values
(custom-set-table xs) #f
(if (custom-set-spec xs) (custom-set-table xs)
custom-elem-contents (if (custom-set-spec xs)
(lambda (x) x))) custom-elem-contents
(values #f #f)))]) (lambda (x) x)))
(values xs #f #f)))])
;; outer check ;; outer check
(unless HT (unless HT (raise-custom-set-exn xs 'SETTYPE))
(define s set-expr)
(if (custom-set? s)
(raise (exn:fail:contract
(format "wrong kind of hash set, expected ~a, got: ~a\n" 'SETTYPE s)
(current-continuation-marks)))
(raise (exn:fail:contract
(format "not a hash set: ~a" s)
(current-continuation-marks)))))
;; loop bindings ;; loop bindings
([i (-first HT)]) ([i (-first HT)])
;; pos check ;; pos check