a lisp-1 experiment

1 files changed, 35 insertions, 0 deletions

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