mbutterick
/
beautiful-racket
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

adjust

Browse Source
pull/2/head
Matthew Butterick 9 years ago
parent 086c0aa359
commit d9a33c7948
1 changed files with 3 additions and 6 deletions
Show Stats Download Patch File Download Diff File

9
beautiful-racket-lib/br/syntax.rkt
Unescape Escape View File

@ -61,9 +61,6 @@
(define (->syntax x) (define (->syntax x)
(if (syntax? x) x (datum->syntax #f x))) (if (syntax? x) x (datum->syntax #f x)))
(define first car)
(define second cadr)
(define third caddr)
(define-syntax (define-scope stx) (define-syntax (define-scope stx)
(syntax-case stx () (syntax-case stx ()
@ -87,9 +84,9 @@
(list (procedure-rename (curryr si 'add) 'add-id) (list (procedure-rename (curryr si 'add) 'add-id)
(procedure-rename (curryr si 'flip) 'flip-id) (procedure-rename (curryr si 'flip) 'flip-id)
(procedure-rename (curryr si 'remove) 'remove-id))))))) (procedure-rename (curryr si 'remove) 'remove-id)))))))
(define add-id (λ(x) ((apply compose1 (map first id-sis)) (->syntax x)))) (define add-id (λ(x) ((apply compose1 (map car id-sis)) (->syntax x))))
(define flip-id (λ(x) ((apply compose1 (map second id-sis)) (->syntax x)))) (define flip-id (λ(x) ((apply compose1 (map cadr id-sis)) (->syntax x))))
(define remove-id (λ(x) ((apply compose1 (map third id-sis)) (->syntax x)))) (define remove-id (λ(x) ((apply compose1 (map caddr id-sis)) (->syntax x))))
(define (id x) (add-id (datum->syntax #f (syntax-e (->syntax x))))) (define (id x) (add-id (datum->syntax #f (syntax-e (->syntax x)))))
(define (id* x) (replace-context (add-id (datum->syntax #f '_)) (->syntax x))) (define (id* x) (replace-context (add-id (datum->syntax #f '_)) (->syntax x)))
(define (id? x) (define (id? x)

Write Preview
Loading…
Cancel
Save