2024-08-26 14:28:46 +03:00
|
|
|
;; -*- lexical-binding: t; -*-
|
|
|
|
|
|
|
|
(require 'cl-lib)
|
2019-02-25 18:37:24 +03:00
|
|
|
(require 'mal/types)
|
|
|
|
(require 'mal/reader)
|
|
|
|
(require 'mal/printer)
|
2016-02-28 23:22:03 +03:00
|
|
|
|
|
|
|
|
|
|
|
(defun READ (input)
|
|
|
|
(read-str input))
|
|
|
|
|
|
|
|
(defun EVAL (ast env)
|
2024-08-26 14:28:46 +03:00
|
|
|
(let (a)
|
|
|
|
|
|
|
|
;; (println "EVAL: %s\n" (PRINT ast))
|
|
|
|
|
|
|
|
(cond
|
|
|
|
|
|
|
|
((setq a (mal-list-value ast))
|
|
|
|
(let ((fn* (mal-fn-core-value (EVAL (car a) env)))
|
|
|
|
(args (mapcar (lambda (x) (EVAL x env)) (cdr a))))
|
|
|
|
(apply fn* args)))
|
|
|
|
((setq a (mal-symbol-value ast))
|
|
|
|
(or (gethash a env) (error "'%s' not found" a)))
|
|
|
|
((setq a (mal-vector-value ast))
|
|
|
|
(mal-vector (vconcat (mapcar (lambda (item) (EVAL item env)) a))))
|
|
|
|
((setq a (mal-map-value ast))
|
|
|
|
(let ((map (copy-hash-table a)))
|
2020-07-21 19:01:48 +03:00
|
|
|
(maphash (lambda (key val)
|
|
|
|
(puthash key (EVAL val env) map))
|
2016-02-28 23:22:03 +03:00
|
|
|
map)
|
|
|
|
(mal-map map)))
|
|
|
|
(t
|
|
|
|
;; return as is
|
2024-08-26 14:28:46 +03:00
|
|
|
ast))))
|
2016-02-28 23:22:03 +03:00
|
|
|
|
|
|
|
(defun PRINT (input)
|
|
|
|
(pr-str input t))
|
|
|
|
|
2024-08-26 14:28:46 +03:00
|
|
|
(defun rep (input repl-env)
|
2016-02-28 23:22:03 +03:00
|
|
|
(PRINT (EVAL (READ input) repl-env)))
|
|
|
|
|
|
|
|
(defun readln (prompt)
|
|
|
|
;; C-d throws an error
|
|
|
|
(ignore-errors (read-from-minibuffer prompt)))
|
|
|
|
|
|
|
|
(defun println (format-string &rest args)
|
2024-08-26 14:28:46 +03:00
|
|
|
(princ (if args
|
|
|
|
(apply 'format format-string args)
|
|
|
|
format-string))
|
2016-02-28 23:22:03 +03:00
|
|
|
(terpri))
|
|
|
|
|
2024-08-26 14:28:46 +03:00
|
|
|
(defmacro with-error-handling (&rest body)
|
|
|
|
`(condition-case err
|
|
|
|
(progn ,@body)
|
|
|
|
(end-of-token-stream
|
|
|
|
;; empty input, carry on
|
|
|
|
)
|
|
|
|
(unterminated-sequence
|
|
|
|
(princ (format "Expected '%c', got EOF\n"
|
|
|
|
(cl-case (cadr err)
|
|
|
|
(string ?\")
|
|
|
|
(list ?\))
|
|
|
|
(vector ?\])
|
|
|
|
(map ?})))))
|
|
|
|
(error ; catch-all
|
|
|
|
(println (error-message-string err)))))
|
|
|
|
|
2016-02-28 23:22:03 +03:00
|
|
|
(defun main ()
|
2024-08-26 14:28:46 +03:00
|
|
|
(defvar repl-env (make-hash-table :test 'eq))
|
|
|
|
|
|
|
|
(dolist (binding
|
|
|
|
'((+ . (lambda (a b) (mal-number (+ (mal-number-value a) (mal-number-value b)))))
|
|
|
|
(- . (lambda (a b) (mal-number (- (mal-number-value a) (mal-number-value b)))))
|
|
|
|
(* . (lambda (a b) (mal-number (* (mal-number-value a) (mal-number-value b)))))
|
|
|
|
(/ . (lambda (a b) (mal-number (/ (mal-number-value a) (mal-number-value b)))))))
|
|
|
|
(let ((symbol (car binding))
|
|
|
|
(fn (cdr binding)))
|
|
|
|
(puthash symbol (mal-fn-core fn) repl-env)))
|
|
|
|
|
|
|
|
(let (input)
|
|
|
|
(while (setq input (readln "user> "))
|
|
|
|
(with-error-handling
|
|
|
|
(println (rep input repl-env))))
|
|
|
|
;; print final newline
|
|
|
|
(terpri)))
|
2016-02-28 23:22:03 +03:00
|
|
|
|
|
|
|
(main)
|