diff --git a/pitfall/pitfall/embedded.rkt b/pitfall/pitfall/embedded.rkt index 8144bd08..aa75bbfe 100644 --- a/pitfall/pitfall/embedded.rkt +++ b/pitfall/pitfall/embedded.rkt @@ -77,11 +77,8 @@ https://github.com/mbutterick/pdfkit/blob/master/lib/font/embedded.coffee (when isCFF (hash-set! (· fontFile payload) 'Subtype "CIDFontType0C")) - - ;; todo: address spooky behavior - ;; `(send p dump)` throws an exn:fail:object, but it gets swallowed by an intervening · operator - (define p (send (· this subset) encode-to-port)) - (send fontFile end (get-output-bytes p)) + + (send fontFile end (get-output-bytes (· this subset encode-to-port))) (define familyClass (let ([val (if (send (· this font) has-table? 'OS/2) (· this font OS/2 sFamilyClass) diff --git a/pitfall/sugar/js.rkt b/pitfall/sugar/js.rkt index 1827ea76..93c3b7fb 100644 --- a/pitfall/sugar/js.rkt +++ b/pitfall/sugar/js.rkt @@ -40,25 +40,22 @@ (check-equal? (number -4) "-4")) -(define-syntax-rule (send-or-false X REF) - (with-handlers ([exn:fail:object? (λ (exn) #f)]) - (send X REF))) - -(define-syntax-rule (get-or-false X REF) - (with-handlers ([exn:fail:object? (λ (exn) #f)]) - (get-field REF X))) - -(require sugar/debug) -(define-macro-cases · - [(_ X REF) - (syntax/loc caller-stx (let loop ([x X]) - (cond - ;; dict first, to catch objects that implement gen:dict - [(dict? x) (dict-ref x 'REF #f)] - ;; give `send` precedence (presence of method => wants runtime resolution of value) - [(object? x) (or (send-or-false x REF) (get-or-false x REF))] - [else (raise-argument-error '· (format "~a must be object or dict" 'X) x)])))] - [(_ X REF0 . REFS) #'(· (· X REF0) . REFS)]) +(define ·-helper + (procedure-rename + (λ (x . refs) + (for/fold ([x x]) + ([ref (in-list refs)]) + (cond + ;; dict first, to catch objects that implement gen:dict + [(dict? x) (dict-ref x ref #f)] + ;; give `send` precedence (presence of method => wants runtime resolution of value) + [(object? x) (cond + [(memq ref (interface->method-names (object-interface x))) (dynamic-send x ref)] + [(memq ref (field-names x)) (dynamic-get-field ref x)] + [else #f])] + [else (raise-argument-error '· "object or dict" x)]))) '·)) + +(define-macro (· X REF ...) #'(·-helper X 'REF ...)) #;(module+ test (define c (class object%