Fix eval test

[jackhill/mal.git] / scheme / step2_eval.scm

(import (scheme base))
(import (scheme write))

(import (lib util))
(import (lib reader))
(import (lib printer))
(import (lib types))

(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) (or (alist-ref value env)
                    (error (str "'" value "' not found"))))
      ((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
            (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
  `((+ . ,(lambda (a b) (mal-number (+ (mal-value a) (mal-value b)))))
    (- . ,(lambda (a b) (mal-number (- (mal-value a) (mal-value b)))))
    (* . ,(lambda (a b) (mal-number (* (mal-value a) (mal-value b)))))
    (/ . ,(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)