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

further

Browse Source
pull/2/head
Matthew Butterick 9 years ago
parent 32a14d78af
commit 3af79f911f
2 changed files with 25 additions and 24 deletions
Show Stats Download Patch File Download Diff File

30
beautiful-racket-lib/br/subscope.rkt
Unescape Escape View File

@ -2,18 +2,18 @@
(provide (all-defined-out)) (provide (all-defined-out))
(define #'(introduce-scope _color . _parents) (define #'(introduce-scope _color . _parents)
(replace-context #'_color (with-syntax ([color #'_color]
(with-syntax ([color #'_color] [color-string (format "~a" (syntax->datum #'_color))]
[color-string (format "~a" (syntax->datum #'_color))] [color:define (format-id #f "~a:define" #'_color)]
[define:color (format-id #f "define:~a" #'_color)] [color:id (format-id #f "~a:id" #'_color)]
[id:color (format-id #f "id:~a" #'_color)] [color-binding-id (format-id #f "~a-binding-id" #'_color)]
[color-binding-id (format-id #f "~a-binding-id" #'_color)] [color-binding-form (format-id #f "~a-binding-form" #'_color)]
[color-binding-form (format-id #f "~a-binding-form" #'_color)] [color-id (format-id #f "~a-id" #'_color)]
[color-id (format-id #f "~a-id" #'_color)] [module-name (generate-temporary)]
[module-name (generate-temporary)] [parents (if (pair? (syntax->list #'_parents))
[parents (if (pair? (syntax->list #'_parents)) (car (syntax->list #'_parents))
(car (syntax->list #'_parents)) (syntax->list #'_parents))])
(syntax->list #'_parents))]) (replace-context #'_color
#'(begin #'(begin
(module module-name br (module module-name br
(require (for-syntax br/datum br/syntax)) (require (for-syntax br/datum br/syntax))
@ -22,13 +22,13 @@
(begin-for-syntax (begin-for-syntax
(define-scope color parents)) (define-scope color parents))
(define #'(define:color _id-in _expr) (define #'(color:define _id-in _expr)
(with-syntax* ([id:color (shared-syntax (format-datum "~a:~a" #'_id-in color-string))] (with-syntax* ([color:id (shared-syntax (format-datum "~a:~a" color-string #'_id-in))]
[color-binding-id (color-binding-form #'_id-in)] [color-binding-id (color-binding-form #'_id-in)]
[color-id (color #'color-binding-id)]) [color-id (color #'color-binding-id)])
#'(begin #'(begin
(define color-binding-id _expr) (define color-binding-id _expr)
(define-syntax id:color (define-syntax color:id
(syntax-id-rules () (syntax-id-rules ()
[_ color-id])))))) [_ color-id]))))))
(require 'module-name))))) (require 'module-name)))))

17
beautiful-racket-lib/br/syntax-scopes-test-3.rkt
Unescape Escape View File

@ -4,18 +4,19 @@
(introduce-scope blue) (introduce-scope blue)
(introduce-scope red) (introduce-scope red)
#;(introduce-scope purple (red blue))
(define #'(double-x) (define #'(double-x)
(with-blue-identifiers (x) (with-blue-identifiers (x)
#'(+ x x))) #'(set! x (+ x x))))
(define #'(display-x)
(with-blue-identifiers (x)
#'(displayln x)))
(define:blue x 50)
x:blue
(define:red x 42) (blue:define x 42)
x:red
blue:x
(double-x) (double-x)
(display-x)
Write Preview
Loading…
Cancel
Save