impls/elisp/step3_env.el

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