From 5c0cb55ca78c313cfde7969c7f6a198234c035c7 Mon Sep 17 00:00:00 2001 From: Nic Ferrier Date: Fri, 22 Aug 2014 13:37:11 +0100 Subject: a lisp-1 experiment --- noflet.el | 35 +++++++++++++++++++++++++++++++++++ 1 file changed, 35 insertions(+) diff --git a/noflet.el b/noflet.el index 49986d9..11c0bf1 100644 --- a/noflet.el +++ b/noflet.el @@ -151,6 +151,41 @@ maintainers refuse to add the correct indentation spec to (indent noflet-indent-func)) `(cl-flet ,bindings ,@body)) + +(defmacro nic-lisp1 (bindings &rest body) + "This makes lisp-1 functions. + +For example: + + (destructuring-bind (value func) + (nic-lisp1 ((a (x) + (* x 7))) + (list (a 10) a)) + (funcall func 6)) + +the nic-lisp1 form returns the value of (a 10) as well as the +original function." + (declare (debug ((&rest (cl-defun)) cl-declarations body)) + (indent ((&whole 4 &rest (&whole 1 &lambda &body)) &body))) + (let (newenv lambdas) + (dolist (binding bindings) + (let* ((bind-var (car binding)) + (ldef `(cl-function (lambda . ,(cdr binding)))) + (alias-def `(lambda (&rest cl-labels-args) + (cl-list* 'funcall ',bind-var + cl-labels-args)))) + (push (cons bind-var alias-def) newenv) + (push (cons bind-var (list ldef)) lambdas))) + `(let ,lambdas + ,@(macroexp-unprogn + (macroexpand-all + `(progn ,@body) + (if (assq 'function newenv) + newenv + (cons + (cons 'function #'cl--labels-convert) + newenv))))))) + (provide 'noflet) ;;; noflet.el ends here -- cgit v1.2.3