Plaster

text
(defmacro =lambda (parameters &body body) `#'(lambda (*cont* ,@parameters) ,@body)) (defmacro =defun (name parameters &body body) (let ((f (intern (concatenate 'string "=" (symbol-name name))))) `(progn (defmacro ,name ,parameters `(,',f *cont* ,,@parameters)) (defun ,f (*cont* ,@parameters) ,@body)))) (defmacro =bind (parameters expression &body body) `(let ((*cont* #'(lambda ,parameters ,@body))) ,expression)) (defmacro =values (&rest return-values) `(funcall *cont* ,@return-values)) (defmacro =funcall (fn &rest args) `(funcall ,fn *cont* ,@args)) (defmacro =apply (fn &rest args) `(apply ,fn *cont* ,@args)) (defun dft (tree) (cond ((null tree) nil) ((atom tree) (princ tree)) (t (dft (car tree)) (dft (cdr tree))))) (setq *saved* nil) (=defun dft-node (tree) (cond ((null tree) (restart1)) ((atom tree) (=values tree)) (t (push #'(lambda () (dft-node (cdr tree))) *saved*) (dft-node (car tree))))) (=defun restart1 () (if *saved* (funcall (pop *saved*)) (=values 'done))) (=defun dt2 (tree) (setq *saved* nil) (=bind (node) (dft-node tree) (cond ((eq node 'done) (=values nil)) (t (princ node) (restart1))))) (setq t1 '(a (b (d h)) (c e (f i) g))) (setq t2 '(1 (2 (3 6 7) 4 5))) ;; Run the following then keep running (restart1) (=bind (node1) (dft-node t1) (if (eq node1 'done) 'done (=bind (node2) (dft-node t2) (list node1 node2))))