Implement step 3

scm/Makefile

@@ -1,7 +1,7 @@
 SOURCES_BASE = lib/reader.sld lib/printer.sld lib/types.sld
 SOURCES_LISP = lib/env.sld lib/func.sld lib/core.sld stepA_mal.scm
 SOURCES = $(SOURCES_BASE) $(SOURCES_LISP)
-BINS = step0_repl step1_read_print step2_eval
+BINS = step0_repl step1_read_print step2_eval step3_env
 
 SYMLINK = ln -sfr
 RM = rm -f
@@ -23,24 +23,30 @@ symlinks:
 	$(SYMLINK) lib/reader.sld lib.reader.scm
 	$(SYMLINK) lib/printer.sld lib/printer.scm
 	$(SYMLINK) lib/printer.sld lib.printer.scm
+	$(SYMLINK) lib/env.sld lib/env.scm
+	$(SYMLINK) lib/env.sld lib.env.scm
 
 chicken:
 	$(CSCSO) lib.util.scm
 	$(CSCSO) lib.types.scm
 	$(CSCSO) lib.reader.scm
 	$(CSCSO) lib.printer.scm
+	$(CSCSO) lib.env.scm
 	$(CSC) step0_repl.scm
 	$(CSC) step1_read_print.scm
 	$(CSC) step2_eval.scm
+	$(CSC) step3_env.scm
 
 cyclone:
 	$(CYCLONE) lib/util.sld
 	$(CYCLONE) lib/types.sld
 	$(CYCLONE) lib/reader.sld
 	$(CYCLONE) lib/printer.sld
+	$(CYCLONE) lib/env.sld
 	$(CYCLONE) step0_repl.scm
 	$(CYCLONE) step1_read_print.scm
 	$(CYCLONE) step2_eval.scm
+	$(CYCLONE) step3_env.scm
 
 clean:
 	$(RM) lib/*.scm lib/*.so lib/*.c lib/*.o lib/*.meta

scm/lib/env.sld

@@ -0,0 +1,44 @@
+(define-library (lib env)
+
+(export make-env env-set env-find env-get)
+
+(import (scheme base))
+
+(import (lib util))
+
+(begin
+
+(define-record-type env
+  (%make-env outer data)
+  env?
+  (outer env-outer)
+  (data env-data env-data-set!))
+
+(define (make-env outer . rest)
+  (let ((env (%make-env outer '())))
+    (when (pair? rest)
+      (let ((binds (car rest))
+            (exprs (cadr rest)))
+        (for-each (lambda (bind expr) (env-set env bind expr))
+                  binds
+                  exprs)))
+    env))
+
+(define (env-set env key value)
+  (env-data-set! env (cons (cons key value) (env-data env))))
+
+(define (env-find env key)
+  (cond
+   ((alist-ref key (env-data env)) env)
+   ((env-outer env) => (lambda (outer) (env-find outer key)))
+   (else #f)))
+
+(define (env-get env key)
+  (let ((env (env-find env key)))
+    (if env
+        (alist-ref key (env-data env))
+        (error (str "'" key "' not found")))))
+
+)
+
+)

scm/lib/printer.sld

@@ -11,6 +11,8 @@
 (begin
 
 (define (pr-str ast print-readably)
+  (if (procedure? ast)
+      "#<fn>"
       (let* ((type (and (mal-object? ast) (mal-type ast)))
              (value (and type (mal-value ast))))
         (case type
@@ -28,7 +30,7 @@
           ((list) (pr-list value "(" ")" print-readably))
           ((vector) (pr-list (vector->list value) "[" "]" print-readably))
           ((map) (pr-list (alist->list value) "{" "}" print-readably))
-      (else (error "unknown type")))))
+          (else (error "unknown type"))))))
 
 (define (pr-list items starter ender print-readably)
   (call-with-output-string

scm/step3_env.scm

@@ -0,0 +1,91 @@
+(import (scheme base))
+(import (scheme write))
+
+(import (lib util))
+(import (lib reader))
+(import (lib printer))
+(import (lib types))
+(import (lib env))
+
+(define (READ input)
+  (read-str input))
+
+(define (eval-ast ast env)
+  (let ((type (and (mal-object? ast) (mal-type ast)))
+        (value (and (mal-object? ast) (mal-value ast))))
+    (case type
+      ((symbol) (env-get env value))
+      ((list) (mal-list (map (lambda (item) (EVAL item env)) value)))
+      ((vector) (mal-vector (vector-map (lambda (item) (EVAL item env)) value)))
+      ((map) (mal-map (alist-map (lambda (key value) (cons key (EVAL value env))) value)))
+      (else ast))))
+
+(define (EVAL ast env)
+  (let ((type (and (mal-object? ast) (mal-type ast))))
+    (if (not (eq? type 'list))
+        (eval-ast ast env)
+        (let ((items (mal-value ast)))
+          (if (null? items)
+              ast
+              (case (mal-value (car items))
+                ((def!)
+                 (let ((symbol (mal-value (cadr items)))
+                       (value (EVAL (list-ref items 2) env)))
+                   (env-set env symbol value)
+                   value))
+                ((let*)
+                 (let* ((env* (make-env env))
+                        (binds (mal-value (cadr items)))
+                        (binds (if (vector? binds) (vector->list binds) binds))
+                        (form (list-ref items 2)))
+                   (let loop ((binds binds))
+                     (when (pair? binds)
+                       (let ((key (mal-value (car binds))))
+                         (when (null? (cdr binds))
+                           (error "unbalanced list"))
+                         (let ((value (EVAL (cadr binds) env*)))
+                           (env-set env* key value)
+                           (loop (cddr binds))))))
+                   (EVAL form env*)))
+                (else
+                 (let* ((items (mal-value (eval-ast ast env)))
+                        (op (car items))
+                        (ops (cdr items)))
+                   (apply op ops)))))))))
+
+(define (PRINT ast)
+  (pr-str ast #t))
+
+(define repl-env (make-env #f))
+(env-set repl-env '+ (lambda (a b) (mal-number (+ (mal-value a) (mal-value b)))))
+(env-set repl-env '- (lambda (a b) (mal-number (- (mal-value a) (mal-value b)))))
+(env-set repl-env '* (lambda (a b) (mal-number (* (mal-value a) (mal-value b)))))
+(env-set repl-env '/ (lambda (a b) (mal-number (/ (mal-value a) (mal-value b)))))
+
+(define (rep input)
+  (PRINT (EVAL (READ input) repl-env)))
+
+(define (readline prompt)
+  (display prompt)
+  (flush-output-port)
+  (let ((input (read-line)))
+    (if (eof-object? input)
+        #f
+        input)))
+
+(define (main)
+  (let loop ()
+    (let ((input (readline "user> ")))
+      (when input
+        (guard
+         (ex ((error-object? ex)
+              (when (not (memv 'empty-input (error-object-irritants ex)))
+                (display "[error] ")
+                (display (error-object-message ex))
+                (newline))))
+         (display (rep input))
+         (newline))
+        (loop))))
+  (newline))
+
+(main)