Common Lisp代码编译报错求助：VALIDATE-ARN-DATA函数语法排查

问题说明 #

我编写的VALIDATE-ARN-DATA函数编译时出现错误，无法定位问题根源，请求帮忙排查错误原因。

原代码 #

(defun validate-arn-data (tokens)
   (declare (special *rule-loading*))
   (when (typep tokens 'rel-errors)
      (setq tokens (rel-errors-correct-tokens tokens)))
   (if (and tokens (not *rule-loading*))
      (let ((arn-num nil)
            (rtn-msg nil)
            (processed-rtn-msg nil)
            (start nil)
            (end nil)
            (transaction-id nil)
            (transac-id-length nil)
            (pon-tokens nil)
            (pon-value nil)
            (pon-length nil)
            (rtn nil)
            (errors (make-rel-errors))
           )
         (dolist (to tokens)
            (setq arn-num (so-token-value to))
            (if (numeric-string? arn-num)
               (when arn-num
                  (setq rtn-msg (call-dispatch-services arn-num))
                  (setq processed-rtn-msg (process-dispatch-services-reply rtn-msg))
                  (when processed-rtn-msg
                     (when (setq start (search "appointmentOrderId" rtn-msg))
                        (setq end (search "," (subseq rtn-msg start)))
                        (setq transaction-id (subseq rtn-msg (+ start 23) (+ start (- end 1))))
                        (setq rtn t)
                     (cond ((or (equal *so-entry-appl* " ")
                                (equal *so-entry-appl* "B")
                                (equal *so-entry-appl* "L")
                                (equal *so-entry-appl* "U")
                                (equal *so-entry-appl* "V"))
                               (setq transac-id-length (length transaction-id))
                               (setq pon-tokens (find-matching-tokens "PON"))
                (cond ((not (equal pon-tokens nil))
                     (dolist (to-pon pon-tokens)
                                       (setq pon-value (so-token-value to-pon))
                                       (setq pon-length (length pon-value))
                                       (if (<= (+ pon-length 1) (length transaction-id))
                                          (unless (equal pon-value (subseq transaction-id 1 (+ pon-length 1)))
                                                 (if (>= transac-id-length 8)
                                                   (progn
                                                     (setq transaction-id (subseq transaction-id (- transac-id-length 8) transac-id-length))
                                              (unless (equal transaction-id *so-order-number*)
                                                 (setq rtn nil)))
                                                  (setq rtn nil))
                                      (unless rtn
                                           (setq *more-long-error-msg* (concatenate 'simple-string
                                                "ORDER ID MISMATCH ")))))))
                                (t nil))
                           ((equal *so-entry-appl* "F")
                              (setq pon-tokens (find-matching-tokens "PON"))
                              (dolist (to-pon pon-tokens)
                                 (setq pon-value (so-token-value to-pon))
                                 (setq pon-length (length pon-value))
                                 (if (<= (+ pon-length 1) (length transaction-id))
                                    (unless (equal pon-value (subseq transaction-id 1 (+ pon-length 1)))
                                       (setq rtn nil))
                                       (setq rtn nil))
                                 (unless rtn
                                    (setq *more-long-error-msg* (concatenate 'simple-string
                                                "ORDER ID MISMATCH ")))))
                           (t
                              (setq rtn t)))))
                  (if rtn
                     (push to (rel-errors-correct-tokens errors))
                     (push to (rel-errors-error-tokens errors))))
               (push to (rel-errors-error-tokens errors))))
         errors)
      t)))

编译错误信息 #

(load (compile-file "/home/raymond-arn.lisp"))
;;; Compiling file /home/ac86208/raymond-arn.lisp ...
;;; Safety = 3, Speed = 1, Space = 1, Float = 1, Interruptible = 1
;;; Compilation speed = 1, Debug = 2, Fixnum safety = 3
;;; Source level debugging is on
;;; Source file recording is  on
;;; Cross referencing is on
; (TOP-LEVEL-FORM 0)

**++++ Error in VALIDATE-ARN-DATA:
  Illegal car (EQUAL *SO-ENTRY-APPL* "F") in compound form ((EQUAL *SO-ENTRY-APPL* "F") (SETQ PON-TOKENS (FIND-MATCHING-TOKENS "PON")) (DOLIST (TO-PON PON-TOKENS) (SETQ PON-VALUE (SO-TOKEN-VALUE TO-PON)) (SETQ PON-LENGTH (LENGTH PON-VALUE)) (IF (<= (+ PON-LENGTH 1) (LENGTH TRANSACTION-ID)) (UNLESS (EQUAL PON-VALUE (SUBSEQ TRANSACTION-ID 1 (+ PON-LENGTH 1))) (SETQ RTN NIL)) (SETQ RTN NIL)) (UNLESS RTN (SETQ *MORE-LONG-ERROR-MSG* (CONCATENATE (QUOTE SIMPLE-STRING) "ORDER ID MISMATCH WITH FTS-ICADS ORDER "))))).
;; Processing Cross Reference Information
; *** 1 error detected, no fasl file produced.


!!!!!Wrote error log to /home/logs/LispWorks/lispworks-8-0-0-amd64-linux-log at 2023/06/05 08:29:37

Error: Argument NIL is not of type PATHNAME, STRING, or FILE-STREAM.

错误原因分析 #

编译错误提示Illegal car (EQUAL *SO-ENTRY-APPL* "F")，核心问题是语法结构混乱：

1. 括号不匹配：外层cond的第一个分支内嵌套了另一个cond，但内部cond未正确闭合括号，导致后续的((EQUAL *SO-ENTRY-APPL* "F") ...)被错误解析为复合形式的函数名（car位置），而非外层cond的第二个分支。
2. 缩进混乱：代码缩进未对齐，进一步掩盖了括号缺失问题，使开发者难以快速发现结构错误。

修复后的代码 #

(defun validate-arn-data (tokens)
  (declare (special *rule-loading*))
  (when (typep tokens 'rel-errors)
    (setq tokens (rel-errors-correct-tokens tokens)))
  (if (and tokens (not *rule-loading*))
      (let ((arn-num nil)
            (rtn-msg nil)
            (processed-rtn-msg nil)
            (start nil)
            (end nil)
            (transaction-id nil)
            (transac-id-length nil)
            (pon-tokens nil)
            (pon-value nil)
            (pon-length nil)
            (rtn nil)
            (errors (make-rel-errors)))
        (dolist (to tokens)
          (setq arn-num (so-token-value to))
          (if (numeric-string? arn-num)
              (when arn-num
                (setq rtn-msg (call-dispatch-services arn-num))
                (setq processed-rtn-msg (process-dispatch-services-reply rtn-msg))
                (when processed-rtn-msg
                  (when (setq start (search "appointmentOrderId" rtn-msg))
                    (setq end (search "," (subseq rtn-msg start)))
                    (setq transaction-id (subseq rtn-msg (+ start 23) (+ start (- end 1))))
                    (setq rtn t))
                  (cond ((or (equal *so-entry-appl* " ")
                             (equal *so-entry-appl* "B")
                             (equal *so-entry-appl* "L")
                             (equal *so-entry-appl* "U")
                             (equal *so-entry-appl* "V"))
                         (setq transac-id-length (length transaction-id))
                         (setq pon-tokens (find-matching-tokens "PON"))
                         (cond ((not (equal pon-tokens nil))
                                (dolist (to-pon pon-tokens)
                                  (setq pon-value (so-token-value to-pon))
                                  (setq pon-length (length pon-value))
                                  (if (<= (+ pon-length 1) (length transaction-id))
                                      (unless (equal pon-value (subseq transaction-id 1 (+ pon-length 1)))
                                        (if (>= transac-id-length 8)
                                            (progn
                                              (setq transaction-id (subseq transaction-id (- transac-id-length 8) transac-id-length))
                                              (unless (equal transaction-id *so-order-number*)
                                                (setq rtn nil)))
                                            (setq rtn nil)))
                                      (setq rtn nil))
                                  (unless rtn
                                    (setq *more-long-error-msg* (concatenate 'simple-string
                                                                              "ORDER ID MISMATCH ")))))
                               (t nil)))
                        ((equal *so-entry-appl* "F")
                         (setq pon-tokens (find-matching-tokens "PON"))
                         (dolist (to-pon pon-tokens)
                           (setq pon-value (so-token-value to-pon))
                           (setq pon-length (length pon-value))
                           (if (<= (+ pon-length 1) (length transaction-id))
                               (unless (equal pon-value (subseq transaction-id 1 (+ pon-length 1)))
                                 (setq rtn nil))
                               (setq rtn nil))
                           (unless rtn
                             (setq *more-long-error-msg* (concatenate 'simple-string
                                                                       "ORDER ID MISMATCH ")))))
                        (t
                         (setq rtn t))))
                (if rtn
                    (push to (rel-errors-correct-tokens errors))
                    (push to (rel-errors-error-tokens errors))))
              (push to (rel-errors-error-tokens errors))))
        errors)
      t))

修复要点：

• 补全内部cond缺失的闭合括号，确保外层cond的每个分支结构合法。
• 统一代码缩进格式，使结构层级清晰，便于后续维护和问题排查。

内容的提问来源于stack exchange，提问作者Raymond Indwar