functional stacker

funstacker/funstacker-test.rkt

@@ -0,0 +1,6 @@
+#lang reader "funstacker.rkt"
+4
+8
++
+3
+*

funstacker/funstacker-test.rkt~

@@ -0,0 +1,6 @@
+#lang reader "stacker.rkt"
+4
+8
++
+3
+*

funstacker/funstacker.rkt

@@ -0,0 +1,29 @@
+#lang br/quicklang
+
+(define (read-syntax path port)
+  (define src-lines (port->lines port))
+  (define src-datums (format-datums '~a src-lines))
+  (define module-datum `(module stacker-mod "funstacker.rkt"
+                      (handle-args ,@src-datums)))
+  (datum->syntax #f module-datum))
+
+(provide read-syntax)
+
+(define-macro (stacker-module-begin HANDLE-ARGS-EXPR)
+  #'(#%module-begin
+     (display (first HANDLE-ARGS-EXPR))))
+
+(provide (rename-out [stacker-module-begin #%module-begin]))
+
+(define (handle-args . args)
+  (for/fold ([stack-acc empty])
+            ([arg (in-list args)]
+             #:unless (void? arg))
+    (cond
+      [(number? arg) (cons arg stack-acc)]
+      [(or (equal? * arg) (equal? + arg))
+       (define op-result
+         (arg (first stack-acc) (second stack-acc)))
+       (cons op-result (drop stack-acc 2))])))
+(provide handle-args)
+(provide + *)

funstacker/funstacker.rkt~

@@ -0,0 +1,37 @@
+#lang br/quicklang
+
+(define (read-syntax path port)
+  (define src-lines (port->lines port))
+  (define src-datums (format-datums '(handle ~a) src-lines))
+  (define module-datum `(module stacker-mod "stacker.rkt"
+                      ,@src-datums))
+  (datum->syntax #f module-datum))
+
+(provide read-syntax)
+
+(define-macro (stacker-module-begin HANDLE-EXPR ...)
+  #'(#%module-begin
+     HANDLE-EXPR ...
+     (display (first stack))))
+
+(provide (rename-out [stacker-module-begin #%module-begin]))
+
+(define stack empty)
+
+(define (pop-stack!)
+  (define arg (first stack))
+  (set! stack (rest stack))
+  arg)
+
+(define (push-stack! arg)
+  (set! stack (cons arg stack)))
+
+(define (handle [arg #f])
+  (cond
+    [(number? arg) (push-stack! arg)]
+    [(or (equal? + arg) (equal? * arg))
+     (define op-result (arg (pop-stack!) (pop-stack!)))
+     (push-stack! op-result)]))
+
+(provide handle)
+(provide + *)