make non-mutating `stacker`
parent
e0b5855e3e
commit
fc1b5659ee
@ -1,6 +1,6 @@
|
||||
#lang reader br/demo/stacker
|
||||
push 4
|
||||
push 8
|
||||
4
|
||||
8
|
||||
+
|
||||
push 3
|
||||
3
|
||||
*
|
@ -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"))
|
@ -0,0 +1,8 @@
|
||||
#lang reader br/demo/stacker2
|
||||
4
|
||||
8
|
||||
|
||||
+
|
||||
3
|
||||
|
||||
*
|
@ -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"))
|
Loading…
Reference in New Issue