4
\$\begingroup\$

My first attempt at Scheme (Chicken Scheme) - a simple RPN calculator. Please comment on exception handling as well as the general coding style. Here is the code:

(use stack)
(use srfi-69)
(use simple-exceptions)

(define prompt "> ")

(define stack (make-stack))
(define words (make-hash-table))

(define (init-words)
  (hash-table-set! words "bye" '(quit))
  (hash-table-set! words ".s" '(stack-print))
  (hash-table-set! words "+" '(add))
  (hash-table-set! words "-" '(subtract))
  (hash-table-set! words "*" '(multiply))
  (hash-table-set! words "/" '(divide))
  (hash-table-set! words "." '(pop-print))
  (hash-table-set! words "dup" '(dup))
  (hash-table-set! words "drop" '(drop))
  (hash-table-set! words "swap" '(swap)))


(define (stack-print)
  (display (stack->list stack))
  (newline))


(define (pop-print)
  (display (stack-pop! stack))
  (newline))


(define (add)
  (stack-push! stack
           (+ (stack-pop! stack)
          (stack-pop! stack))))


(define (subtract)
  (swap)
  (stack-push! stack
           (- (stack-pop! stack)
                  (stack-pop! stack)))) 


(define (multiply)
  (stack-push! stack
           (* (stack-pop! stack)
          (stack-pop! stack))))


(define (divide)
  (swap)
  (stack-push! stack
           (/ (stack-pop! stack)
          (stack-pop! stack))))


(define (dup)
  (let ((first (stack-pop! stack)))
    (stack-push! stack first)
    (stack-push! stack first)))


(define (drop)
  (stack-pop! stack))


(define (swap)
  (let ((first (stack-pop! stack))
    (second (stack-pop! stack)))
    (stack-push! stack first)
    (stack-push! stack second)))


(define (f-read)
  (display prompt)
  (flush-output)
  (read-line))


(define (f-parse line)
  (string-split line))


(define (process word)
  (cond
   ((hash-table-exists? words word)
    (eval (hash-table-ref words word)))
   ((string->number word)
    (stack-push! stack (string->number word)))))


(define (f-eval words)
  (cond
   ((null? words) "")
   (else (process (car words))
     (f-eval (cdr words)))))


(define (f-print line)
  (display line))

;; user-interrupt ?

(define (repl)
  (guard
   (exn (((exception-of? 'user-interrupt) exn)
     (quit))
    ((exception? exn)
     (display (message exn))
     (newline)
     (repl))
    (else
     (display (arguments exn))
     (newline)
     (repl)))
   (init-words)
   (f-print (f-eval (f-parse (f-read))))
   (repl)))
\$\endgroup\$
3
\$\begingroup\$

You've actually run into a big gotcha here. Scheme doesn't actually specify the order to evaluate operands. This can be a problem for code with side effects, especially if you aren't careful to encapsulate the order you expect explicitly. Any time you see an exclamation mark at the end of the function, pay attention to ensure a correct and defined semantic order.

(define (pop-print)
  (display (stack-pop! stack))
  (newline))

Something like this is fine, as (define ...) creates an implicit begin in the syntax. (define (x a) (zig a) (zag b)) gets transformed into something closer to (let ((x (lambda (a) (begin (zig a) (zig b)). cond has a similar effect.

However ...

(define (add)
  (stack-push! stack
           (+ (stack-pop! stack)
          (stack-pop! stack))))

is also fine, because order doesn't matter, but we aren't sure which pop will get its number first. Divide and subtract may randomly behave incorrectly, especially on different Scheme implementations.

Your swap is so close though, but to be right it would have needed to use a begin and a let* instead of the normal let. The Star version behaves as if you explicitly nested each sequential binding, whereas let is allowed to make bindings in any order. begin likewise forces text-order sequential evaluation.

(define (swap)
  (let* ((first (stack-pop! stack))
         (second (stack-pop! stack)))
    (begin (stack-push! stack first)
           (stack-push! stack second))))

Here's a method of forcing order via nested lambda notation, as every time you invoke a function, you're creating a new binding environment.

(define (two-args f) ;takes a function as an argument
 (lambda () ;explicitly return a function of zero arguments
   ((lambda (x) 
            ((lambda (y) 
                     (stack-push! stack (f y x))) 
                                  ; the deeper term has priority
             (stack-pop! stack))
    (stack-pop! stack))

And then define the functions in terms of above

(define add      (two-args +))
(define subtract (two-args -))
(define multiply (two-args *))
(define divide   (two-args /))

And a little trickier

(define swap     
  (two-args (lambda (y x)(begin (stack-push! stack x)
                                y))

Why are you initializing the words hash table every time though the repl? You could initialize it at creation like so...

(define words 
  (let ((temp (make-hash-table))
    (begin  
      (hash-table-set! temp "bye" '(quit))
      ...
      temp)))

As for the exception handler, I can't comment as I don't know that much about them in Scheme.

| improve this answer | |
\$\endgroup\$
  • \$\begingroup\$ Thank you Toby. Proofreading is not my strong suit. \$\endgroup\$ – WorBlux Jan 23 at 15:53
  • \$\begingroup\$ Oh wow. Thanks! \$\endgroup\$ – Anonimista Feb 1 at 18:47

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.