diff --git a/beautiful-racket/br/demo/stacker-test.rkt b/beautiful-racket/br/demo/stacker-test.rkt index e02fe09..791955c 100644 --- a/beautiful-racket/br/demo/stacker-test.rkt +++ b/beautiful-racket/br/demo/stacker-test.rkt @@ -1,6 +1,6 @@ #lang reader br/demo/stacker -push 4 -push 8 +4 +8 + -push 3 +3 * \ No newline at end of file diff --git a/beautiful-racket/br/demo/stacker.rkt b/beautiful-racket/br/demo/stacker.rkt index 1b6ae9d..4024496 100644 --- a/beautiful-racket/br/demo/stacker.rkt +++ b/beautiful-racket/br/demo/stacker.rkt @@ -1,32 +1,30 @@ -#lang br +#lang br/quicklang (define (read-syntax src-path in-port) - (define lines (remove-blank-lines (port->lines in-port))) - (define (make-exec-datum line) (format-datum '(exec ~a) line)) - (define exec-exprs (map make-exec-datum lines)) - (strip-context (with-pattern ([(EXEC-EXPR ...) exec-exprs]) + (define stack-args (port->list read in-port)) + (strip-context (with-pattern ([(STACK-ARG ...) stack-args]) #'(module stacker-mod br/demo/stacker - EXEC-EXPR ...)))) + (push STACK-ARG) ...)))) (provide read-syntax) -(define-macro (stacker-module-begin SRC-LINE ...) +(define-macro (stacker-module-begin PUSH-STACK-ARG ...) #'(#%module-begin - SRC-LINE ... + PUSH-STACK-ARG ... (display (first stack)))) (provide (rename-out [stacker-module-begin #%module-begin])) (define stack empty) -(define (push num) (set! stack (cons num stack))) -(provide push) -(define-cases exec - [(_ func num) (func num)] - [(_ op) (define result (op (first stack) (second stack))) - (set! stack (cons result (drop stack 2)))]) -(provide exec) +(define (push arg) + (cond + [(number? arg) (set! stack (cons arg stack))] + [else + (define result (arg (first stack) (second stack))) + (set! stack (cons result (drop stack 2)))])) +(provide push) -(provide + * #%app #%datum #%top-interaction) +(provide + *) -(module+ test +#;(module+ test (require rackunit) (check-equal? (with-output-to-string (λ () (dynamic-require "stacker-test.rkt" #f))) "36")) \ No newline at end of file diff --git a/beautiful-racket/br/demo/stacker2-test.rkt b/beautiful-racket/br/demo/stacker2-test.rkt new file mode 100644 index 0000000..8498812 --- /dev/null +++ b/beautiful-racket/br/demo/stacker2-test.rkt @@ -0,0 +1,8 @@ +#lang reader br/demo/stacker2 +4 +8 + ++ +3 + +* \ No newline at end of file diff --git a/beautiful-racket/br/demo/stacker2.rkt b/beautiful-racket/br/demo/stacker2.rkt new file mode 100644 index 0000000..6d3adb3 --- /dev/null +++ b/beautiful-racket/br/demo/stacker2.rkt @@ -0,0 +1,32 @@ +#lang br/quicklang + + +(define (read-syntax src-path in-port) + (define stack-args (port->list read in-port)) + (strip-context + (with-pattern ([(STACK-ARG ...) stack-args]) + #'(module stacker2-mod br/demo/stacker2 + STACK-ARG ...)))) +(provide read-syntax) + +(define-macro (stacker-module-begin STACK-ARG ...) + #'(#%module-begin + (define stack-result + (for/fold ([stack null]) + ([arg (in-list (list STACK-ARG ...))]) + (push arg stack))) + (display (first stack-result)))) +(provide (rename-out [stacker-module-begin #%module-begin])) + +(define (push arg stack) + (if (number? arg) + (cons arg stack) + (let* ([op arg] + [result (op (first stack) (second stack))]) + (cons result (drop stack 2))))) + +(provide + * #%app #%datum #%top-interaction) + +(module+ test + (require rackunit) + (check-equal? (with-output-to-string (λ () (dynamic-require "stacker2-test.rkt" #f))) "36")) \ No newline at end of file