[原创]LISP定义可选参数函数的调用

redcat

狂刀所说bug已修复

1. ;;Lisp-可选参数调用
   
2. (defun xxcall (funclst / funs args ret tmp)
   
3.   (setq  funs (car funclst)
   
4.   tmp  (cdr funclst)
   
5.   )
   
6.   (if (= (type (eval funs)) 'SUBR)
   
7.     (setq ret (eval funclst))
   
8.     (while
   
9.       (and (vl-catch-all-error-p
   
10.        (setq ret (vl-catch-all-apply funs args))
    
11.      )
    
12.      (not  (wcmatch
    
13.       (vl-catch-all-error-message ret)
    
14.       "参数类型错误:*"
    
15.     )
    
16.      )
    
17.       )
    
18.        (setq args (reverse (cons (car tmp) (reverse args)))
    
19.        tmp  (cdr tmp)
    
20.        )
    
21.     )
    
22.   )
    
23.   ret
    
24. )
    
25. 
    
26. ;;;工程实例
    
27. (defun tt (a b c)
    
28.   (apply '+ (list a b c))
    
29. )
    
30. (defun go (a b c)
    
31.   (list (if a
    
32.    a
    
33. )
    
34. (if b
    
35.    51
    
36.    b
    
37. )
    
38. (if c
    
39.    c
    
40.    93
    
41. )
    
42.   )
    
43. )
    
44. (defun tt1 (a b c)
    
45.   (mapcar 'princ (list a b c))
    
46. )
    
47. (xxcall '(go nil 2))
    
48. (xxcall '(tt 1 2 3 4))
    
49. (xxcall '(tt 1 2))
    
50. (xxcall '(tt1 1 2))
    
51. (xxcall '(+ 2000 4 8))
    
52. (xxcall '(print 2000))
    
53. (xxcall '(princ 2000 we))
    

;;Lisp-可选参数调用<br /> (defun xxcall (funclst / funs args ret tmp)<br />   (setq  funs (car funclst)<br />   tmp  (cdr funclst)<br />   )<br />   (if (= (type (eval funs)) 'SUBR)<br />     (setq ret (eval funclst))<br />     (while<br />       (and (vl-catch-all-error-p<br />        (setq ret (vl-catch-all-apply funs args))<br />      )<br />      (not  (wcmatch<br />       (vl-catch-all-error-message ret)<br />       "参数类型错误:*"<br />     )<br />      )<br />       )<br />        (setq args (reverse (cons (car tmp) (reverse args)))<br />        tmp  (cdr tmp)<br />        )<br />     )<br />   )<br />   ret<br /> )<br /> <br /> ;;;工程实例<br /> (defun tt (a b c)<br />   (apply '+ (list a b c))<br /> )<br /> (defun go (a b c)<br />   (list (if a<br />    a<br /> )<br /> (if b<br />    51<br />    b<br /> )<br /> (if c<br />    c<br />    93<br /> )<br />   )<br /> )<br /> (defun tt1 (a b c)<br />   (mapcar 'princ (list a b c))<br /> )<br /> (xxcall '(go nil 2))<br /> (xxcall '(tt 1 2 3 4))<br /> (xxcall '(tt 1 2))<br /> (xxcall '(tt1 1 2))<br /> (xxcall '(+ 2000 4 8))<br /> (xxcall '(print 2000))<br /> (xxcall '(princ 2000 we))<br />

wangph

一样不完美，(xxcall '(tt 1 2))就是死循环

我爱lisp

这个帖子很多年了，其实很好的思路，作为其他功能借鉴参考

guankuiwu

很好很好！学习一下

moshouhot

函数名: xxCall

功能:
这个函数是一个通用的函数调用包装器，它可以灵活地尝试用不同数量的参数
调用给定的函数，直到找到一个成功的调用或达到最大尝试次数。

特点:
1. 灵活性: 能够处理无参数、参数不足、参数过多等各种情况
2. 错误处理: 使用 vl-catch-all-apply 捕获并处理可能的错误
3. 调试信息: 提供详细的执行过程信息，有助于理解函数的运行情况
4. 参数使用跟踪: 报告哪些参数未被使用
5. 安全性: 设置最大尝试次数，防止无限循环

参数:
funclst: 一个列表，其中第一个元素是要调用的函数名，后续元素是传递给该函数的参数
         例如: '(myfunction arg1 arg2 arg3)

返回值:
- 如果函数调用成功，返回函数的执行结果
- 如果所有尝试都失败，返回 nil

使用示例:
(xxCall '(myfunction 1 2 3))
(xxCall '(+ 1 2 3 4))

注意:
此函数会打印详细的执行过程信息。在生产环境中使用时，可能需要注释掉一些 princ 语句。