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