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

updates

Browse Source
This commit is contained in:
Matthew Butterick 2016-08-10 21:31:19 -07:00
parent f5078fb50b
commit adda7adb88
3 changed files with 9 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
beautiful-racket-lib/br/define.rkt
View File

@ -9,7 +9,7 @@
syntax/define syntax/define
racket/string)) racket/string))
(provide (all-defined-out) (provide (all-defined-out)
(for-syntax with-shared-id with-calling-site-id)) (for-syntax with-shared-id))
(module+ test (module+ test
(require rackunit)) (require rackunit))
@ -116,9 +116,10 @@
(begin-for-syntax (begin-for-syntax
(define-syntax-rule (with-shared-id (id ...) . body) (define-syntax-rule (with-shared-id (id ...) . body)
(with-syntax ([id (shared-syntax 'id)] ...) (with-syntax ([id (datum->syntax caller-stx (if (syntax? id)
. body)) (syntax-e id)
(define-syntax with-calling-site-id (make-rename-transformer #'with-shared-id))) id))] ...)
. body)))
;; `syntax-parse` classes shared by `define-macro` and `define-macro-cases` ;; `syntax-parse` classes shared by `define-macro` and `define-macro-cases`
@ -172,8 +173,8 @@
(define result (define result
(syntax-parameterize ([caller-stx (make-rename-transformer #'stx)]) (syntax-parameterize ([caller-stx (make-rename-transformer #'stx)])
(syntax-case stx LITERALS (syntax-case stx LITERALS
[pat . result-exprs] ... [pat . result-exprs] ...
else-clause))) else-clause)))
(if (syntax? result) (if (syntax? result)
result result
(datum->syntax #'id result)))))] (datum->syntax #'id result)))))]

9
beautiful-racket-lib/br/main.rkt
View File

@ -6,17 +6,10 @@
(all-from-out racket/list racket/string racket/format racket/match racket/port (all-from-out racket/list racket/string racket/format racket/match racket/port
br/syntax br/datum br/debug br/cond racket/function br/define) br/syntax br/datum br/debug br/cond racket/function br/define)
(for-syntax (all-from-out racket/base racket/syntax br/syntax br/debug)) (for-syntax (all-from-out racket/base racket/syntax br/syntax br/debug))
(for-syntax caller-stx with-shared-id with-calling-site-id)) ; from br/define (for-syntax caller-stx with-shared-id)) ; from br/define
;; todo: activate at-exp reader by default ;; todo: activate at-exp reader by default
(define (remove-blank-lines strs)
(filter (λ(str) (regexp-match #px"\\S" str)) strs))
(provide remove-blank-lines)
(module reader syntax/module-reader (module reader syntax/module-reader
#:language 'br #:language 'br
#:info br-get-info #:info br-get-info

2
beautiful-racket/br/demo/bf/bf-expander.rkt
View File

@ -6,7 +6,7 @@
#'(begin OP-OR-LOOP ...)) #'(begin OP-OR-LOOP ...))
(provide bf-program) (provide bf-program)
(define-macro op (define-macro-cases op
[(op ">") #'(move-pointer 1)] [(op ">") #'(move-pointer 1)]
[(op "<") #'(move-pointer -1)] [(op "<") #'(move-pointer -1)]
[(op "+") #'(set-current-byte! (add1 (get-current-byte)))] [(op "+") #'(set-current-byte! (add1 (get-current-byte)))]