add `strip-identifier-bindings`

pull/2/head
Matthew Butterick 8 years ago
parent bc47acd4d4
commit 6a1b143f3f

@ -1,7 +1,8 @@
#lang racket/base #lang racket/base
(require (for-syntax racket/base syntax/parse racket/syntax syntax/strip-context) (require (for-syntax racket/base syntax/parse racket/syntax syntax/strip-context)
syntax/strip-context racket/function racket/list racket/syntax br/to-string) syntax/strip-context racket/function racket/list racket/syntax br/to-string)
(provide (all-defined-out) (all-from-out syntax/strip-context)) (provide (all-defined-out) (all-from-out syntax/strip-context)
(rename-out [strip-context strip-identifier-bindings]))
(module+ test (module+ test
(require rackunit)) (require rackunit))

@ -4,14 +4,14 @@
(define (stacker-read-syntax src-path in-port) (define (stacker-read-syntax src-path in-port)
(define stack-args (port->list read in-port)) (define stack-args (port->list read in-port))
(strip-context (with-pattern ([(STACK-ARG ...) stack-args])
(with-pattern ([(STACK-ARG ...) stack-args]) (strip-identifier-bindings
#'(module stacker-mod br/demo/stacker #'(module stacker-mod br/demo/stacker
(push STACK-ARG) ...)))) (push STACK-ARG) ...))))
(define-macro (stacker-module-begin PUSH-STACK-ARG ...) (define-macro (stacker-module-begin PUSH-EXPR ...)
#'(#%module-begin #'(#%module-begin
PUSH-STACK-ARG ... PUSH-EXPR ...
(display (first stack)))) (display (first stack))))
(define stack empty) (define stack empty)

@ -4,15 +4,15 @@
(define (stacker-read-syntax src-path in-port) (define (stacker-read-syntax src-path in-port)
(define stack-args (port->list read in-port)) (define stack-args (port->list read in-port))
(strip-context (with-pattern ([(STACK-ARG ...) stack-args])
(with-pattern ([(STACK-ARG ...) stack-args]) (strip-identifier-bindings
#'(module stacker2-mod br/demo/stacker2 #'(module stacker2-mod br/demo/stacker2
STACK-ARG ...)))) STACK-ARG ...))))
(define-macro (stacker-module-begin STACK-ARG ...) (define-macro (stacker-module-begin STACK-ARG ...)
#'(#%module-begin #'(#%module-begin
(define stack-result (define stack-result
(for/fold ([stack null]) (for/fold ([stack empty])
([arg (in-list (list STACK-ARG ...))]) ([arg (in-list (list STACK-ARG ...))])
(push arg stack))) (push arg stack)))
(display (first stack-result)))) (display (first stack-result))))

Loading…
Cancel
Save