revise
This commit is contained in:
parent
fc1b5659ee
commit
bc47acd4d4
|
@ -2,10 +2,21 @@
|
||||||
(provide (except-out (all-from-out br) #%module-begin)
|
(provide (except-out (all-from-out br) #%module-begin)
|
||||||
(rename-out [quicklang-mb #%module-begin]))
|
(rename-out [quicklang-mb #%module-begin]))
|
||||||
|
|
||||||
(define-syntax-rule (quicklang-mb . lines)
|
(define-macro (quicklang-mb . exprs)
|
||||||
(#%module-begin
|
(define-values
|
||||||
(provide #%top #%app #%datum #%top-interaction)
|
(kw-pairs other-exprs)
|
||||||
. lines))
|
(let loop ([kw-pairs null][exprs (syntax->list #'exprs)])
|
||||||
|
(if (and (pair? exprs) (keyword? (syntax-e (car exprs))) (symbol? (syntax-e (cadr exprs))))
|
||||||
|
(loop (cons (list (string->symbol (keyword->string (syntax-e (car exprs))))
|
||||||
|
(cadr exprs)) ; leave val in stx form so local binding is preserved
|
||||||
|
kw-pairs)
|
||||||
|
(cddr exprs))
|
||||||
|
(values kw-pairs exprs))))
|
||||||
|
(with-pattern ([((KW VAL) ...) kw-pairs])
|
||||||
|
#`(#%module-begin
|
||||||
|
(provide (rename-out [VAL KW]) ...)
|
||||||
|
(provide #%top #%app #%datum #%top-interaction)
|
||||||
|
. #,(datum->syntax #'exprs other-exprs #'exprs))))
|
||||||
|
|
||||||
|
|
||||||
(module reader syntax/module-reader
|
(module reader syntax/module-reader
|
||||||
|
|
|
@ -1,17 +1,18 @@
|
||||||
#lang br/quicklang
|
#lang br/quicklang
|
||||||
|
#:read-syntax stacker-read-syntax
|
||||||
|
#:#%module-begin stacker-module-begin
|
||||||
|
|
||||||
(define (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])
|
(strip-context
|
||||||
#'(module stacker-mod br/demo/stacker
|
(with-pattern ([(STACK-ARG ...) stack-args])
|
||||||
(push STACK-ARG) ...))))
|
#'(module stacker-mod br/demo/stacker
|
||||||
(provide read-syntax)
|
(push STACK-ARG) ...))))
|
||||||
|
|
||||||
(define-macro (stacker-module-begin PUSH-STACK-ARG ...)
|
(define-macro (stacker-module-begin PUSH-STACK-ARG ...)
|
||||||
#'(#%module-begin
|
#'(#%module-begin
|
||||||
PUSH-STACK-ARG ...
|
PUSH-STACK-ARG ...
|
||||||
(display (first stack))))
|
(display (first stack))))
|
||||||
(provide (rename-out [stacker-module-begin #%module-begin]))
|
|
||||||
|
|
||||||
(define stack empty)
|
(define stack empty)
|
||||||
|
|
||||||
|
@ -25,6 +26,6 @@
|
||||||
|
|
||||||
(provide + *)
|
(provide + *)
|
||||||
|
|
||||||
#;(module+ test
|
(module+ test
|
||||||
(require rackunit)
|
(require rackunit)
|
||||||
(check-equal? (with-output-to-string (λ () (dynamic-require "stacker-test.rkt" #f))) "36"))
|
(check-equal? (with-output-to-string (λ () (dynamic-require "stacker-test.rkt" #f))) "36"))
|
|
@ -1,13 +1,13 @@
|
||||||
#lang br/quicklang
|
#lang br/quicklang
|
||||||
|
#:read-syntax stacker-read-syntax
|
||||||
|
#:#%module-begin stacker-module-begin
|
||||||
|
|
||||||
|
(define (stacker-read-syntax src-path in-port)
|
||||||
(define (read-syntax src-path in-port)
|
|
||||||
(define stack-args (port->list read in-port))
|
(define stack-args (port->list read in-port))
|
||||||
(strip-context
|
(strip-context
|
||||||
(with-pattern ([(STACK-ARG ...) stack-args])
|
(with-pattern ([(STACK-ARG ...) stack-args])
|
||||||
#'(module stacker2-mod br/demo/stacker2
|
#'(module stacker2-mod br/demo/stacker2
|
||||||
STACK-ARG ...))))
|
STACK-ARG ...))))
|
||||||
(provide read-syntax)
|
|
||||||
|
|
||||||
(define-macro (stacker-module-begin STACK-ARG ...)
|
(define-macro (stacker-module-begin STACK-ARG ...)
|
||||||
#'(#%module-begin
|
#'(#%module-begin
|
||||||
|
@ -16,16 +16,15 @@
|
||||||
([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))))
|
||||||
(provide (rename-out [stacker-module-begin #%module-begin]))
|
|
||||||
|
|
||||||
(define (push arg stack)
|
(define (push arg stack)
|
||||||
(if (number? arg)
|
(cond
|
||||||
(cons arg stack)
|
[(number? arg) (cons arg stack)]
|
||||||
(let* ([op arg]
|
[else
|
||||||
[result (op (first stack) (second stack))])
|
(define result (arg (first stack) (second stack)))
|
||||||
(cons result (drop stack 2)))))
|
(cons result (drop stack 2))]))
|
||||||
|
|
||||||
(provide + * #%app #%datum #%top-interaction)
|
(provide + *)
|
||||||
|
|
||||||
(module+ test
|
(module+ test
|
||||||
(require rackunit)
|
(require rackunit)
|
||||||
|
|
8
beautiful-racket/br/demo/stacker3-test.rkt
Normal file
8
beautiful-racket/br/demo/stacker3-test.rkt
Normal file
|
@ -0,0 +1,8 @@
|
||||||
|
#lang reader br/demo/stacker3
|
||||||
|
4
|
||||||
|
8
|
||||||
|
|
||||||
|
+
|
||||||
|
3
|
||||||
|
|
||||||
|
*
|
24
beautiful-racket/br/demo/stacker3.rkt
Normal file
24
beautiful-racket/br/demo/stacker3.rkt
Normal file
|
@ -0,0 +1,24 @@
|
||||||
|
#lang br/quicklang
|
||||||
|
#:read-syntax stacker-read-syntax
|
||||||
|
#:#%module-begin stacker-module-begin
|
||||||
|
|
||||||
|
(define (stacker-read-syntax src-path in-port)
|
||||||
|
(strip-context
|
||||||
|
#`(module stacker3-mod br/demo/stacker3
|
||||||
|
#,@(port->list read in-port))))
|
||||||
|
|
||||||
|
(define-macro (stacker-module-begin STACK-ARG ...)
|
||||||
|
#'(#%module-begin
|
||||||
|
(display
|
||||||
|
(first
|
||||||
|
(foldl (λ(arg stack)
|
||||||
|
(if (number? arg)
|
||||||
|
(cons arg stack)
|
||||||
|
(cons (arg (car stack) (cadr stack)) (cddr stack))))
|
||||||
|
null (list STACK-ARG ...))))))
|
||||||
|
|
||||||
|
(provide + *)
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(require rackunit)
|
||||||
|
(check-equal? (with-output-to-string (λ () (dynamic-require "stacker2-test.rkt" #f))) "36"))
|
Loading…
Reference in New Issue
Block a user