elisp/step2_eval.el

   1 (defun load-relative (file)
   2   (let* ((current-file (or load-file-name buffer-file-name))
   3          (current-file-directory (file-name-directory current-file)))
   4     (load (expand-file-name file current-file-directory) nil t)))
   5
   6 (load-relative "types.el")
   7 (load-relative "reader.el")
   8 (load-relative "printer.el")
   9
  10 (defvar repl-env (make-hash-table :test 'eq))
  11 (puthash '+ (lambda (a b) (mal-number (+ (mal-value a) (mal-value b)))) repl-env)
  12 (puthash '- (lambda (a b) (mal-number (- (mal-value a) (mal-value b)))) repl-env)
  13 (puthash '* (lambda (a b) (mal-number (* (mal-value a) (mal-value b)))) repl-env)
  14 (puthash '/ (lambda (a b) (mal-number (/ (mal-value a) (mal-value b)))) repl-env)
  15
  16 (defun READ (input)
  17   (read-str input))
  18
  19 (defun EVAL (ast env)
  20   (if (and (mal-list-p ast) (mal-value ast))
  21       (let* ((ast* (mal-value (eval-ast ast env)))
  22              (fn (car ast*))
  23              (args (cdr ast*)))
  24         (apply fn args))
  25     (eval-ast ast env)))
  26
  27 (defun eval-ast (ast env)
  28   (let ((type (mal-type ast))
  29         (value (mal-value ast)))
  30     (cond
  31      ((eq type 'symbol)
  32       (let ((definition (gethash value env)))
  33         (or definition (error "Definition not found"))))
  34      ((eq type 'list)
  35       (mal-list (mapcar (lambda (item) (EVAL item env)) value)))
  36      ((eq type 'vector)
  37       (mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) value))))
  38      ((eq type 'map)
  39       (let ((map (copy-hash-table value)))
  40         (maphash (lambda (key value)
  41                    (puthash key (EVAL value env) map))
  42                  map)
  43         (mal-map map)))
  44      (t
  45       ;; return as is
  46       ast))))
  47
  48 (defun PRINT (input)
  49   (pr-str input t))
  50
  51 (defun rep (input)
  52   (PRINT (EVAL (READ input) repl-env)))
  53
  54 (defun readln (prompt)
  55   ;; C-d throws an error
  56   (ignore-errors (read-from-minibuffer prompt)))
  57
  58 (defun println (format-string &rest args)
  59   (if (not args)
  60       (princ format-string)
  61     (princ (apply 'format format-string args)))
  62   (terpri))
  63
  64 (defun main ()
  65   (let (eof)
  66     (while (not eof)
  67       (let ((input (readln "user> ")))
  68         (if input
  69             (condition-case err
  70                 (println (rep input))
  71               (end-of-token-stream
  72                ;; empty input, carry on
  73                )
  74               (unterminated-sequence
  75                (let* ((type (cadr err))
  76                       (end
  77                        (cond
  78                         ((eq type 'string) ?\")
  79                         ((eq type 'list) ?\))
  80                         ((eq type 'vector) ?\])
  81                         ((eq type 'map) ?}))))
  82                  (princ (format "Expected '%c', got EOF\n" end))))
  83               (error ; catch-all
  84                (println (error-message-string err))
  85                (backtrace)))
  86           (setq eof t)
  87           ;; print final newline
  88           (terpri))))))
  89
  90 (main)