pull/2/head
Matthew Butterick 9 years ago
parent cdda2224da
commit e3b7495a7a

@ -8,36 +8,54 @@
(define-scope green (blue yellow)) (define-scope green (blue yellow))
(define-scope purple (blue red))) (define-scope purple (blue red)))
(define #'(define-blue _id _val) (define #'(def-blue-x)
(with-blue-binding-form ([x '_id]) (with-blue-binding-form (x)
#'(define x _val))) #'(define x (+ 42 42))))
#;(define-blue x (+ 42 42))
(define #'(def-x) (define #'(print-blue-x)
(with-blue-binding-form ([x 'x]) (with-purple-identifiers (x)
#'(define x (+ 42 42)))) #'x))
(define #'(def-x-2)
(with-yellow-binding-form ([x 'x])
#'(define x (+ 42))))
(define #'(print-x) (define #'(define-blue _id _expr)
(with-yellow-syntax ([x 'x]) (with-syntax ([_id (blue-binding-form #'_id)])
#'(println (+ x x)))) #'(define _id _expr)))
(define #'(print-x-2)
(with-purple-syntax ([x 'x])
#'(println (+ x x x))))
(scopes (syntax-find (expand-once #'(def-x)) 'x)) (define #'(print-blue-y)
(def-x) (with-blue-identifiers (y)
(def-x-2) #'y))
(scopes (syntax-find (expand-once #'(def-blue-x)) 'x))
(def-blue-x)
(scopes (syntax-find (expand-once #'(print-blue-x)) 'x))
(print-blue-x)
(let ()
(scopes (syntax-find (expand-once #'(print-blue-x)) 'x))
#;(print-blue-x)) ;; error why?
(define-blue y (+ 42 42))
(print-blue-y)
#|
(define #'(def-y)
(with-yellow-binding-form (y)
#'(define y (+ 42))))
#;(scopes (syntax-find (expand-once #'(def-x)) 'x))
#;(def-x)
(def-y)
(scopes (syntax-find (expand-once #'(print-x)) 'x)) (scopes (syntax-find (expand-once #'(print-x)) 'x))
(print-x) (print-x)
(scopes (syntax-find (expand-once #'(print-x-2)) 'x)) (scopes (syntax-find (expand-once #'(print-y)) 'y))
(print-x-2) (print-y)
#;(let-syntax ([x (λ(stx) (syntax-case stx () [_ #'42]))]) #;(let-syntax ([x (λ(stx) (syntax-case stx () [_ #'42]))])
(* x 4)) (* x 4))
|#

@ -67,9 +67,9 @@
[else (raise-argument-error 'syntax-find "not given syntax or datum as second argument" stx-or-datum)])) [else (raise-argument-error 'syntax-find "not given syntax or datum as second argument" stx-or-datum)]))
(let/ec exit (let/ec exit
(let loop ([so stx]) (let loop ([so stx])
(cond (cond
[(eq? (syntax->datum so) datum) (exit so)] [(eq? (syntax->datum so) datum) (exit so)]
[(syntax->list so) => (curry map loop)])))) [(syntax->list so) => (curry map loop)]))))
(define (->syntax x) (define (->syntax x)
@ -85,7 +85,8 @@
[add-id (format-id #'id "add-~a" #'id)] [add-id (format-id #'id "add-~a" #'id)]
[flip-id (format-id #'id "flip-~a" #'id)] [flip-id (format-id #'id "flip-~a" #'id)]
[id-binding-form (format-id #'id "~a-binding-form" #'id)] [id-binding-form (format-id #'id "~a-binding-form" #'id)]
[with-id-syntax (format-id #'id "with-~a-syntax" #'id)] [define-id (format-id #'id "define-~a" #'id)]
[with-id-identifiers (format-id #'id "with-~a-identifiers" #'id)]
[let-id-syntax (format-id #'id "let-~a-syntax" #'id)] [let-id-syntax (format-id #'id "let-~a-syntax" #'id)]
[with-id-binding-form (format-id #'id "with-~a-binding-form" #'id)] [with-id-binding-form (format-id #'id "with-~a-binding-form" #'id)]
[remove-id (format-id #'id "remove-~a" #'id)] [remove-id (format-id #'id "remove-~a" #'id)]
@ -113,10 +114,10 @@
(member (car (context (add-id (datum->syntax #f '_)))) (member (car (context (add-id (datum->syntax #f '_))))
(context (->syntax x))) (context (->syntax x)))
#t)) #t))
(define-syntax-rule (with-id-syntax ([pat val] (... ...)) . body) (define-syntax-rule (with-id-identifiers (name (... ...)) . body)
(with-syntax ([pat (id* val)] (... ...)) . body)) (with-syntax ([name (id* 'name)] (... ...)) . body))
(define-syntax-rule (with-id-binding-form ([pat val] (... ...)) . body) (define-syntax-rule (with-id-binding-form (name (... ...)) . body)
(with-syntax ([pat (id-binding-form val)] (... ...)) . body)) (with-syntax ([name (id-binding-form 'name)] (... ...)) . body))
(define-syntax-rule (let-id-syntax ([pat val] (... ...)) . body) (define-syntax-rule (let-id-syntax ([pat val] (... ...)) . body)
(let-syntax ([pat (id* val)] (... ...)) . body))))])) (let-syntax ([pat (id* val)] (... ...)) . body))))]))

Loading…
Cancel
Save