[原创]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

很好很好！学习一下