*

1 files changed, 29 insertions, 0 deletions

diff --git a/js/games/nluqo.github.io/~bh/61a-pages/Lib/calc.scm b/js/games/nluqo.github.io/~bh/61a-pages/Lib/calc.scm
new file mode 100644
index 0000000..7d667dd
--- /dev/null
+++ b/js/games/nluqo.github.io/~bh/61a-pages/Lib/calc.scm
@@ -0,0 +1,29 @@
+;; Scheme calculator -- evaluate simple expressions
+
+; The read-eval-print loop:
+
+(define (calc)
+  (display "calc: ")
+  (flush)
+  (print (calc-eval (read)))
+  (calc))
+
+; Evaluate an expression:
+
+(define (calc-eval exp)
+  (cond ((number? exp) exp)
+	((list? exp) (calc-apply (car exp) (map calc-eval (cdr exp))))
+	(else (error "Calc: bad expression:" exp))))
+
+; Apply a function to arguments:
+
+(define (calc-apply fn args)
+  (cond ((eq? fn '+) (accumulate + 0 args))
+	((eq? fn '-) (cond ((null? args) (error "Calc: no args to -"))
+			   ((= (length args) 1) (- (car args)))
+			   (else (- (car args) (accumulate + 0 (cdr args))))))
+	((eq? fn '*) (accumulate * 1 args))
+	((eq? fn '/) (cond ((null? args) (error "Calc: no args to /"))
+			   ((= (length args) 1) (/ (car args)))
+			   (else (/ (car args) (accumulate * 1 (cdr args))))))
+	(else (error "Calc: bad operator:" fn))))