【@lisp】函数探测器，用于探测未知函数用法的函数。
本帖最后由 vitalgg 于 2022-8-29 12:53 编辑当前代码暂时支持 字符串，实数 整数 ，图元，图元对象，选择集等。
原理说明：根据错误提示，用 arg0 arg1 ..逐步增加参数，直到参数个数满足函数要求。
再根据错误提示，参数修改参数类型。
最终通过探测时，返回函数及参数类型。
需要更多错误提示信息，以进行改进。期待您的提交。
持续更新中 最终源码见: https://gitee.com/atlisp/atlisp- ... c/ext/probe-fun.lsp
也欢迎到上面的源码网址回复 提交错误信息，我可以更快看到。
说明：本代码所调用的函数均在 @lisp函数库中，请自行查找。
也可以安装@lisp核心，可以自动调用需要的函数。
TODO: 成功后还可以尝试多加个参数进行可变参数的测试。
(defun ext:probe-fun (fun / *error* args iter iter-depth)
"探测函数的参数个数(最小)及参数类型。"
"expr or nil"
"(ext:probe-fun 'boole)"
(setq args '())
(setq iter-depth 0)
(setq str "string"
intnum (fix 5)
num 3.14
ent (entity:make-circle '(0 0 0) 100)
vlaobj (e2o ent)
ss (ssadd ent)
pt '(1 1 0)
)
(defun get-type (x)
(cond
((listp x)
(cond
((equal x '(1 1 0))
'point)
(t 'lst)))
(t (type x))
))
(defun iter ()
;;(princ args)
(setq iter-depth (1+ iter-depth))
(if (and
(vl-catch-all-error-p
(setq errobj
(vl-catch-all-apply
fun
(reverse args))))
(setq errmsg (vl-catch-all-error-message errobj)))
(if (< iter-depth 100)
(cond
((wcmatch errmsg "*参数太少*")
(setq args(cons (read (strcat "arg" (itoa (length args)))) args))
(iter))
((wcmatch errmsg "参数类型错误*")
(@:log "INFO" errmsg)
(setq typeerr (string:to-list errmsg " "))
(@:log "INFO" (vl-prin1-to-string typeerr))
(cond
((wcmatch (cadr typeerr) "stringp*")
(setq args (subst str (read (last typeerr)) args)))
((wcmatch (cadr typeerr) "listp*")
(setq args (subst '(L I S T) (read (last typeerr)) args)))
((wcmatch (cadr typeerr) "numberp*")
(setq args (subst num (read (last typeerr)) args)))
((wcmatch (cadr typeerr) "fixnump*")
(setq args (subst intnum (read (last typeerr)) args)))
((wcmatch (cadr typeerr) "lselsetp*")
(setq args (subst ss (read (last typeerr)) args)))
((wcmatch (cadr typeerr) "lentity*")
(setq args (subst ent (read (last typeerr)) args)))
((wcmatch (cadr typeerr) "VLA-OBJECT*")
(setq args (subst vlaobj (read (last typeerr)) args)))
((wcmatch (cadr typeerr) "二维/三维点*")
(setq args (subst pt (read (last typeerr)) args)))
;; TODO 参数类型错误扩展
)
(iter))
((wcmatch errmsg "no function definition*")
(setq args (subst 'princ (read (caddr typeerr)) args))
(iter))
(t
(princ errmsg)
(princ "near completed \n")
(cons fun (mapcar 'get-type (reverse args)))
)))
(progn
(princ "probe completed!\n")
(cons fun (mapcar 'get-type (reverse args)))
)
)
)
(iter)
)
一楼支持，感谢分享 感谢张大分享，有了参数，内部函数才有用武之地 tigcat 发表于 2022-8-29 13:31
感谢张大分享，有了参数，内部函数才有用武之地
只是一个框架及简单实现，细节部分还需要再扩展。
需要更多的错误信息分析。
页:
[1]