From 7d8d34eab3ec2acef7623970dd4a6d4cc29b4fc6 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 17 Apr 2016 21:20:12 -0700 Subject: [PATCH] add stacker to demo --- beautiful-racket/br/demo/stacker.rkt | 33 ++++++++++++++++++++++++++++ 1 file changed, 33 insertions(+) create mode 100644 beautiful-racket/br/demo/stacker.rkt diff --git a/beautiful-racket/br/demo/stacker.rkt b/beautiful-racket/br/demo/stacker.rkt new file mode 100644 index 0000000..c1aea6d --- /dev/null +++ b/beautiful-racket/br/demo/stacker.rkt @@ -0,0 +1,33 @@ +#lang br +(define (read-syntax source-path input-port) + (define src-strs (remove-blank-lines (port->lines input-port))) + (define (make-datum str) (format-datum '(dispatch ~a) str)) + (define src-exprs (map make-datum src-strs)) + (strip-context + (inject-syntax ([#'(SRC-EXPR ...) src-exprs]) + #'(module stacker-mod br/demo/stacker + SRC-EXPR ...)))) +(provide read-syntax) + +(define #'(stacker-module-begin READER-LINE ...) + #'(#%module-begin + READER-LINE ... + (display (first stack)))) +(provide (rename-out [stacker-module-begin #%module-begin])) +(provide #%top-interaction) + +(define stack empty) +(define (push num) (set! stack (cons num stack))) +(provide push) + +(define (dispatch arg-1 [arg-2 #f]) + (cond + [(number? arg-2) (push arg-2)] + [else + (define op arg-1) + (define op-result (op (first stack) (second stack))) + (set! stack (cons op-result (drop stack 2)))])) +(provide dispatch) + +(provide + *) +(provide #%app #%datum) \ No newline at end of file