summaryrefslogtreecommitdiff
path: root/util.lisp
blob: 9f80adbdc0a8c046a5294ca1b216b7b5ac0e343c (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
(in-package :cl-forth)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defmacro eval-always (&body body)
    `(eval-when (:compile-toplevel :load-toplevel :execute)
       ,@body)))

(eval-always 
 (defmacro with-gensyms (syms &body body)
   `(let ,(mapcar (lambda (sym) `(,sym (gensym ,(string sym)))) syms)
      ,@body)))

(defmacro init-hash (&body body)
  (with-gensyms (table)
    `(let ((,table (make-hash-table)))
       ,@(iter (for (k v) in body)
               (collect `(setf (gethash ',k ,table) ,v)))
       ,table)))

(defun mklist (form)
  (if (listp form) form (list form)))

(defun run (args &rest options &key &allow-other-keys)
  (unless (eq t (getf options :silence))
    (format t "~{~a~^ ~}~%" args))
  (apply #'uiop:run-program args options))

(defun from-root (path)
  (merge-pathnames path (asdf:system-source-directory :cl-forth)))

;; ,(file-namestring
;;   (make-pathname :name (pathname-name path)
;;                  :type "o"))

;; (defparameter *test-program*
;;   '((push 34)
;;     (push 35)
;;     (plus)
;;     (dump)
;;     (push 500)
;;     (push 80)
;;     (minus)
;;     (dump)))