mal/impls/scheme/step3_env.scm

(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 env)
    (let ((dbgeval (env-get env 'DEBUG-EVAL)))
      (when (and (mal-object? dbgeval)
                 (not (memq (mal-type dbgeval) '(false nil))))
        (display (str "EVAL: " (pr-str ast #t) "\n"))))
    (case (and (mal-object? ast) (mal-type ast))
      ((symbol)
       (let ((key (mal-value ast)))
         (or (env-get env key) (error (str "'" key "' not found")))))
      ((vector)
       (mal-vector (vector-map (lambda (item) (EVAL item env))
                               (mal-value ast))))
      ((map)
       (mal-map (alist-map (lambda (key value) (cons key (EVAL value env)))
                           (mal-value ast))))
      ((list)
        (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 ((op (EVAL (car items) env))
                       (ops (map (lambda (item) (EVAL item env)) (cdr items))))
                   (apply op ops)))))))
      (else ast)))

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