Cfrtjryk

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)))