From 86ceb297e66e64574a0c752d6773434184cdeb7e Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 3 Aug 2016 10:44:47 -0700 Subject: [PATCH] funstacker --- beautiful-racket/br/demo/funstacker.rkt | 37 +++++++++++++------------ 1 file changed, 20 insertions(+), 17 deletions(-) diff --git a/beautiful-racket/br/demo/funstacker.rkt b/beautiful-racket/br/demo/funstacker.rkt index a672243..ce286cf 100644 --- a/beautiful-racket/br/demo/funstacker.rkt +++ b/beautiful-racket/br/demo/funstacker.rkt @@ -1,26 +1,29 @@ #lang br/quicklang -(provide read-syntax - (rename-out [stacker-module-begin #%module-begin]) - + *) -(define (read-syntax src-path in-port) - (define args (port->list read in-port)) - (define module-datum `(module funstacker-mod br/demo/funstacker - ,@args)) +(define (read-syntax path port) + (define args (port->lines port)) + (define arg-datums (format-datums '~a args)) + (define module-datum `(module stacker-mod br/demo/funstacker + (handle-args ,@arg-datums))) (datum->syntax #f module-datum)) +(provide read-syntax) -(define-macro (stacker-module-begin ARG ...) +(define-macro (stacker-module-begin HANDLE-ARGS-EXPR) #'(#%module-begin - (define stack-result - (for/fold ([stack empty]) - ([arg (in-list (list ARG ...))]) - (push arg stack))) - (display (first stack-result)))) + (display (first HANDLE-ARGS-EXPR)))) +(provide (rename-out [stacker-module-begin #%module-begin])) -(define (push arg stack) - (if (number? arg) - (cons arg stack) - (cons (arg (first stack) (second stack)) (drop stack 2)))) +(define (handle-args . args) + (for/fold ([stack empty]) + ([arg (in-list (filter-not void? args))]) + (cond + [(number? arg) (cons arg stack)] + [(or (equal? * arg) (equal? + arg)) + (define op-result (arg (first stack) (second stack))) + (cons op-result (drop stack 2))]))) +(provide handle-args) + +(provide + *) (module+ test (require rackunit)