2
\$\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\$

Your Answer

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

Browse other questions tagged or ask your own question.