@lisp Editor ext:probe-fun

用法

建议

(defun ext:probe-fun (fun / args iter iter-depth)
  "探测函数的参数个数(最小)及参数类型。"
  "expr or nil"
  "(ext:probe-fun 'boole)"
  (setq args (quote nil))
  (setq iter-depth 0)
  (setq str "string"
    intnum (fix 5)
    num 3.14 ent (entity:make-circle (quote (0 0 0))
      100)
    vlaobj (e2o ent)
    ss (ssadd ent)
    pt (quote (1 1 0)))
  (defun get-type (x)
    (cond ((listp x)
        (cond ((equal x (quote (1 1 0)))
            (quote point))
          (t (quote lst))))
      (t (type x))))
  (defun iter nil (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 (quote (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))))
            (iter))
          ((wcmatch errmsg "no function definition*")
            (setq args (subst (quote princ)
                (read (caddr typeerr))
                args))
            (iter))
          (t (princ errmsg)
            (princ "
               near completed \n")
            (cons fun (mapcar (quote get-type)
                (reverse args))))))
      (progn (princ "probe completed!\n")
        (cons fun (mapcar (quote get-type)
            (reverse args))))))
  (iter))

统计信息

上传记录

统计信息

上传记录 刷新

上传记录