summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--noflet.el35
1 files changed, 35 insertions, 0 deletions
diff --git a/noflet.el b/noflet.el
index 26e9399..e4db529 100644
--- a/noflet.el
+++ b/noflet.el
@@ -152,6 +152,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