From ddf719390c5714ca4d92fb861d7caf1c971d4647 Mon Sep 17 00:00:00 2001
From: Matthias Benkard <code@mail.matthias.benkard.de>
Date: Thu, 12 Jul 2007 17:30:10 +0200
Subject: Fix COLLECT-LAMBDA-ARGS.

darcs-hash:e4ca18c09830d4f37787ba97f66580885e2b15e8
---
 lambda.lisp   | 56 ++++++++++++++++++++++----------------------------------
 mulkutils.asd |  4 ++--
 tests.lisp    |  7 +++++--
 3 files changed, 29 insertions(+), 38 deletions(-)

diff --git a/lambda.lisp b/lambda.lisp
index 840b60d..e6c60dd 100644
--- a/lambda.lisp
+++ b/lambda.lisp
@@ -29,9 +29,11 @@
  | ================================
  |
  | (funcall (fn (fn () _)))              ;=> #<LAMBDA ...>
- | (funcall (efn (efn () _)))            ;=> error
+ | (funcall (efn (efn () _)))            ;=> #<LAMBDA ...>  ; new!
  | (funcall (fn1 (fn1 _)))               ;=> #<LAMBDA ...>
- | (funcall (efn1 (efn1 _)))             ;=> error
+ | (funcall (efn1 (efn1 _)))             ;=> #<LAMBDA ...>  ; new!
+ | (funcall (fn1 _3) 1 2 3 4 5)          ;=> 4
+ | (funcall (efn1 _3) 1 2 3 4 5)         ;=> error
  |#
 
 
@@ -41,16 +43,22 @@
 (in-package #:mulk.lambda)
 
 
-(defun collect-lambda-args (clause)
-  (typecase clause
-    (list   (mapcan #'collect-lambda-args clause))
-    (symbol (let ((name (symbol-name clause)))
-              (if (or (string= "_" name)
-                      (and (char= #\_ (char name 0))
-                           (ignore-errors
-                             (parse-integer (subseq name 1)))))
-                  (list clause)
-                  nil)))))
+(defun collect-lambda-args (form)
+  (let ((lambda-args (list)))
+    (handler-bind
+        ((arnesi:undefined-variable-reference
+          #'(lambda (c)
+              (with-accessors ((symbol arnesi:name)) c
+                (let ((name (symbol-name symbol)))
+                  (when (or (string= "_" name)
+                            (and (char= #\_ (char name 0))
+                                 (ignore-errors
+                                   (parse-integer (subseq name 1)))))
+                    (push symbol lambda-args))))
+              (invoke-restart 'muffle-warning))))
+      (let ((arnesi:*warn-undefined* t))
+        (arnesi:walk-form form)
+        (nreverse lambda-args)))))
 
 
 (defun find-lambda-args (clause)
@@ -95,25 +103,7 @@ removed symbol (if found)."
   "A convenience wrapper for LAMBDA.
 
 Positional arguments are numbered from 0 and follow the pattern given by the
-format string \"_~D\".  _ can be used as an abbreviation for _0.
-
-FN can be used recursively, but this has to be done with care, for the
-macro will inevitably get confused about the number of arguments it
-should use if a subform uses more lambda arguments than its enclosing FN
-form.  For instance, the following will work:
-
- (funcall (efn (efn () 10) _) 'foo)
-
-But the following will not, because the inner _ is detected by the outer
-FN as an argument, making the latter expect an argument where none is
-given:
-
- (funcall (efn (efn () _)))
-
-NOTE: RELYING ON THE ERRONEOUS BEHAVIOUR OF THIS MACRO IN ORDER TO WRITE
-SLOPPY FUNCTION DEFINITIONS IS NOT GUARANTEED TO WORK IN FUTURE VERSIONS
-OF THE SYSTEM.  IF YOU NEED TO IGNORE VARIABLE ARGUMENT LISTS, USE THE
-FN MACRO INSTEAD.  YOU HAVE BEEN WARNED."
+format string \"_~D\".  _ can be used as an abbreviation for _0."
   (cond ((or (not (listp function-or-form))
              (eq 'function (first function-or-form)))
          `(efn (funcall ,function-or-form ,@args)))
@@ -136,9 +126,7 @@ FN MACRO INSTEAD.  YOU HAVE BEEN WARNED."
   "A less safe but recursively callable variant of EFN.
 
 This macro is like EFN save the fact that the anonymous functions it
-produces do not check the number of their arguments, thereby
-circumventing lambda argument misidentification errors in
-COLLECT-LAMBDA-ARGS."
+produces do not check the number of their arguments."
   (cond ((or (not (listp function-or-form))
              (eq 'function (first function-or-form)))
          `(fn (funcall ,function-or-form ,@args)))
diff --git a/mulkutils.asd b/mulkutils.asd
index 696584f..767a0d9 100644
--- a/mulkutils.asd
+++ b/mulkutils.asd
@@ -1,8 +1,8 @@
 (defsystem "mulkutils"
   :description "Random utilities by Matthias Benkard."
-  :version "0.0.2"
+  :version "0.1.0"
   :author "Matthias Benkard <matthias@benkard.de>"
   :licence "GNU General Public License, version 2 or higher"
-  :depends-on ()
+  :depends-on (:arnesi)
   :components ((:file "lambda"))
   :serial t)
diff --git a/tests.lisp b/tests.lisp
index b0f8ed6..d405c51 100644
--- a/tests.lisp
+++ b/tests.lisp
@@ -45,9 +45,12 @@
   ()
   (:tests
    ((ensure (functionp (funcall (fn (fn () _))))))
-   ((ensure-error (funcall (efn (efn () _)))))
+   ((ensure (functionp (funcall (efn (efn () _))))))
    ((ensure (functionp (funcall (fn1 (fn1 _))))))
-   ((ensure-error (funcall (efn1 (efn1 _)))))))
+   ((ensure (functionp (funcall (efn1 (efn1 _))))))
+   ((ensure-same (funcall (fn1 _3) 1 2 3 4 5)
+                  4))
+   ((ensure-error (funcall (efn1 _3) 1 2 3 4 5)))))
 
 
 (deftestsuite mulk-lambda-fn* (mulk-lambda)
-- 
cgit v1.2.3