问题[lisp](coding)

我有一个类，希望在创建对象时将某些槽位设置为 nil，但这些槽位只能由特定类型的对象设置。例如：

(defclass Something ()
  ((foo :initarg :foo
        :type (or character 'nil)
        :initform nil
        :accessor something-foo)))

如果我说只是:type character，或:type (or character nil)，那么 SBCL 会抱怨它NIL不属于断言的字符类型。如果我说:type (or character 'nil)，那么它似乎接受字符和符号类型，因为任何符号似乎都适用：

CL-USER> (defvar *foo* (make-instance 'Something))
*FOO*
CL-USER> (setf (something-foo *foo*) 'test)
TEST
CL-USER> (something-foo *foo*)
TEST

有没有办法断言一个 slot 是 nil 还是具有给定的类型？或者我应该省略类型说明符，然后在访问器或写入器方法中断言类型？

编辑：

再三考虑之后，也许习惯用法是说:type character但保持其不受约束，然后检查插槽是否被绑定，而不是检查是否为零和非零？

假设我设置了一个这样的变量：

(setq var '((:item1 "stringA") (:item2 "stringB")))

（这有效）

现在我希望“stringA”是一个条件，如下所示：

(setq var '((:item1 (if (> 6 (string-to-number (format-time-string "%u")))
                     "stringA"
                     "stringC"))
            (:item2 "stringB") ))

这行不通，可能是因为引用运算符（或者函数？）的问题。应该怎么写才能让它正常工作？

我以前从未使用过 LISP，我正在使用 AI 尝试为 autocad 创建简单的自动化程序，以便加快进程。一切都运行正常，我有一个 let 表达式，它将变量列表作为初始化的参数，但第二个变量被误认为是一个函数，因此当我尝试在 AutoCad 中运行脚本时，我收到以下错误：

Command: CASING
Enter offset value: 18
Do you want the offset vertical lines to span from the bottom line to the top line of the rectangle? (Y/N): y
Do you want the offset horizontal lines to span from the left line to the right line of the rectangle? (Y/N): y
Getting selection set
Filtering rectangles
Adding entity: <Entity name: 2889a984ea0>
Vertices: ((39.7611 42.9035) (174.28 42.9035) (174.28 220.962) (39.7611 220.962))
In the if ; error: no function definition: BOTTOM-RIGHT

这是我的 lisp 脚本：

(defun c:casing (/ ss rectangles i ent entData coords all-vertices offset vertical-span horizontal-span)
  ;; Load Visual LISP extension functions
  (vl-load-com)

  ;; Function to count vertices of a polyline
  (defun get-vertex-count (ent)
    (cond
      ((= (cdr (assoc 0 ent)) "LWPOLYLINE")
       (length (vl-remove-if-not '(lambda (x) (= (car x) 10)) ent)))
      ((= (cdr (assoc 0 ent)) "POLYLINE")
       (let ((count 0) (vertex (entnext ent)))
         (while (and vertex (= (cdr (assoc 0 (entget vertex))) "VERTEX"))
           (setq count (1+ count))
           (setq vertex (entnext vertex)))
         count))
      (t 0)))

  ;; Function to sort vertices in a consistent order
  (defun sort-vertices (vertices)
    ;; Sort vertices by y-coordinate, then by x-coordinate
    (setq vertices (vl-sort vertices (function (lambda (a b)
                                                 (if (/= (cadr a) (cadr b))
                                                     (< (cadr a) (cadr b))
                                                   (< (car a) (car b)))))))
    ;; Ensure the order is bottom-left, bottom-right, top-right, top-left
    (if (> (car (nth 1 vertices)) (car (nth 0 vertices)))
        (setq vertices (list (nth 0 vertices) (nth 1 vertices) (nth 3 vertices) (nth 2 vertices)))
      (setq vertices (list (nth 1 vertices) (nth 0 vertices) (nth 2 vertices) (nth 3 vertices))))
    vertices)

  ;; Prompt for offset value
  (setq offset (getreal "\nEnter offset value: "))

  ;; Prompt for vertical span
  (setq vertical-span (getstring "\nDo you want the offset vertical lines to span from the bottom line to the top line of the rectangle? (Y/N): "))

  ;; Prompt for horizontal span
  (setq horizontal-span (getstring "\nDo you want the offset horizontal lines to span from the left line to the right line of the rectangle? (Y/N): "))

  ;; Get pre-selected objects or prompt for selection
  (princ "\nGetting selection set")
  (setq ss (ssget "_I"))
  (if (null ss)
    (setq ss (ssget)))
  (if (null ss)
    (progn
      (alert "No objects selected! Select rectangles before running the command.")
      (exit)))

  ;; Filter rectangles
  (princ "\nFiltering rectangles")
  (setq rectangles '())
  (setq all-vertices '())
  (setq i 0)
  (while (< i (sslength ss))
    (setq ent (ssname ss i))
    (setq entData (entget ent))
    (if (and (= (cdr (assoc 0 entData)) "LWPOLYLINE")
             (= (cdr (assoc 70 entData)) 1)
             (= (get-vertex-count entData) 4))
      (progn
        (princ "\nAdding entity: ") (princ ent)
        (setq rectangles (cons ent rectangles))
        (setq coords (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) entData)))
        (setq coords (sort-vertices coords))
        (setq all-vertices (cons coords all-vertices))))
    (setq i (1+ i)))

  (if (null rectangles)
    (progn
      (alert "No rectangles selected!")
      (exit)))

  ;; Create offset lines
  (foreach vertices all-vertices
    (princ "\nVertices: ") (princ vertices)
    (if (= (length vertices) 4)
      (progn
        (princ "\nIn the if ")
        (let ((bottom-left (nth 0 vertices))
              (bottom-right (nth 1 vertices))
              (top-right (nth 2 vertices))
              (top-left (nth 3 vertices)))
          (princ "\nAfter foreach")
          (princ "\nBottom-left: ") (princ bottom-left)
          (princ "\nBottom-right: ") (princ bottom-right)
          (princ "\nTop-right: ") (princ top-right)
          (princ "\nTop-left: ") (princ top-left)
          ;; Create offset vertical lines
          (if (equal vertical-span "Y" t)
            (progn
              (princ "\nBefore first line")
              (command "LINE" (list (+ (car bottom-left) offset) (cadr bottom-left)) (list (+ (car top-left) offset) (cadr top-left)) "")
              (princ "\nBefore second line")
              (command "LINE" (list (- (car bottom-right) offset) (cadr bottom-right)) (list (- (car top-right) offset) (cadr top-right)) ""))
            (progn
              (command "LINE" (list (+ (car bottom-left) offset) (cadr bottom-left)) (list (+ (car bottom-left) offset) (cadr top-left)) "")
              (command "LINE" (list (- (car bottom-right) offset) (cadr bottom-right)) (list (- (car bottom-right) offset) (cadr top-right)) "")))
          ;; Create offset horizontal lines
          (if (equal horizontal-span "Y" t)
            (progn
              (command "LINE" (list (car bottom-left) (+ (cadr bottom-left) offset)) (list (car bottom-right) (+ (cadr bottom-right) offset)) "")
              (command "LINE" (list (car top-left) (- (cadr top-left) offset)) (list (car top-right) (- (cadr top-right) offset)) ""))
            (progn
              (command "LINE" (list (car bottom-left) (+ (cadr bottom-left) offset)) (list (car bottom-right) (+ (cadr bottom-left) offset)) "")
              (command "LINE" (list (car top-left) (- (cadr top-left) offset)) (list (car top-right) (- (cadr top-left) offset)) "")))))
      (princ "\nError: Vertices list does not contain exactly 4 elements.")))

  ;; Output the vertices coordinates
  (princ "\nVertices coordinates of selected rectangles: ")
  (foreach vertices all-vertices
    (princ "\nRectangle vertices: ") (princ vertices))

  (princ "\nDone processing")
  (princ))

问题似乎出现在第 81 行：(bottom-right (nth 1 vertices))

我多次检查语法。我检查了括号，但一切似乎都很好。使用了 3 种不同的 AI 来找到问题，但没有成功。除了这部分之外，其他一切都按预期工作，我似乎无法弄清楚原因。我检查了流算法流程和语法。甚至熟悉了语法，并了解了一点 lisp 及其工作原理。

正如标题所说，我如何（以编程方式）以可移植的方式（如果可能）检查一个符号是否代表一个符号宏？

CL-USER> (define-symbol-macro some-macro some)
SOME-MACRO
CL-USER> (macro-function 'some-macro)
NIL
CL-USER> (fboundp 'some-macro)
NIL

SBCL 有 sb-impl::info：

CL-USER> (describe 'sb-impl::info)
SB-INT:INFO
  [symbol]

INFO names a compiled function:
  Lambda-list: (CATEGORY KIND NAME)
  Declared type: (FUNCTION (T T T) (VALUES T T &OPTIONAL))
  Source file: SYS:SRC;COMPILER;GLOBALDB.LISP

INFO has a compiler-macro:
  Source file: SYS:SRC;COMPILER;EARLY-GLOBALDB.LISP

(SETF INFO) names a compiled function:
  Lambda-list: (NEW-VALUE CATEGORY KIND NAME)
  Declared type: (FUNCTION (T T T T) (VALUES T &OPTIONAL))
  Source file: SYS:SRC;COMPILER;GLOBALDB.LISP

(SETF INFO) has a compiler-macro:
  Source file: SYS:SRC;COMPILER;EARLY-GLOBALDB.LISP

似乎有效：

CL-USER> (sb-impl::info :variable :kind 'some-macro)
:MACRO
T

这就是他们在“描述”函数的源代码中所使用的内容（我通过查看那里发现了这一点）。

在此之前，我一直在研究 clhs，但一无所获。是我错过了还是没有标准方法？是否有一些可移植/“简单”的库可以做到这一点？

编辑：

在得到有用的答案之后，我找到了cltl2 的“简单”包装器。它似乎也在 quicklisp 中，因此除了内置的 'special-operator-p'之外，我们还可以拥有：

(defun special-variable-p (symbol)
    (multiple-value-bind (info ignore1 ignore2)
        (variable-information symbol)
      (declare (ignore ignore1 ignore2))
      (eq :special info)))

(defun symbol-macro-p (symbol)
    (multiple-value-bind (info ignore1 ignore2)
        (variable-information symbol)
      (declare (ignore ignore1 ignore2))
      (eq :symbol-macro info)))

我实际上更喜欢广义布尔值，看起来更有用，所以我使用这个：

(defun symbol-macro-p (symbol)
  "Return if SYMBOL stands for a symbol macro."
    (multiple-value-bind (info ignore1 ignore2)
        (variable-information symbol)
      (declare (ignore ignore1 ignore2))
      (when (eq :symbol-macro info)
        (multiple-value-bind (expansion ignored)
            (macroexpand symbol)
          (declare (ignore ignored))
          expansion))))

CL-USER> (symbol-macro-p 'some-macro)
SOME

这是我的问题：

1. 我在长字符串数组上使用格式，并且显然默认情况下使用 ~s 指令时，它会添加换行符和两个缩进空格。
2. 当然，这对于人类读者来说确实很棒，但在这种情况下，我不想添加任何这些东西。
3. 谁能提供一些指导，告诉我如何指导格式不这样做？此外，我很想听听您最喜欢的格式指令文档链接：我很害怕。

附加背景：

1. 在本例中，我的应用程序是通过 Hunchentoot 返回文本的系统的一部分，即我的代码是一个处理程序，用于格式化数组，然后通过 HTTP 将其提供给用户。格式在 Hunchentoot 文档和其他用户中使用，但请告诉我这是否是错误的方法。
2. 这是一个演示：

(let ((value #("a800150c-fed9-4c2a-9de4-c34dbe5b9f83"
               "a99c023a-5d29-40cc-ad49-1745d3e2bfe4"
               "f65dff1f-3719-41f5-9735-6ef77c5816b8"
               "c463d1a3-f17b-4e8a-a246-a0cc1805c8cf")))
   (format nil "~s" value))

产量：

"#(\"a800150c-fed9-4c2a-9de4-c34dbe5b9f83\" \"a99c023a-5d29-40cc-ad49-1745d3e2bfe4\"
  \"f65dff1f-3719-41f5-9735-6ef77c5816b8\" \"c463d1a3-f17b-4e8a-a246-a0cc1805c8cf\")"

请注意换行符和两个缩进空格。

如果您有疑问，请告诉我！感谢您的帮助！

尽管我已经在 Linux 上使用 Common Lisp 一段时间了，但我在 Mac 上使用 SBCL 的经验仍然几乎为零。

我刚刚使用自制程序在 Mac (Sonoma 14.2.1) 上安装了 SBCL。

我现在有：SBCL 2.4.1

我在以下测试中遇到了一个问题。

这是测试程序：

me % cat test.lisp
#!/opt/homebrew/bin/sbcl --script

(with-input-from-string (strm (car *args*)) (setf ArgOne (read strm)))
(with-input-from-string (strm (cadr *args*)) (setf ArgTwo (read strm)))

(format "Argument One = ~a~%" ArgOne)
(format "Argument Two = ~a~%" ArgTwo)
me % 

当这个相同的程序（除了第一行）在 debian 上的 clisp 下运行时，如下所示：

me % ./test.lisp 11 23

它会产生：

Argument One = 11
Argument Two = 23

正如我所料。

但是当在 mac 上的 sbcl 下运行时，如下所示：

me % ./test.lisp 11 23

它产生了这个意想不到的输出：

; file: /...././test.lisp
; in: WITH-INPUT-FROM-STRING (STRM (CAR *ARGS*))
;     (CAR *ARGS*)
; 
; caught WARNING:
;   undefined variable: COMMON-LISP-USER::*ARGS*

;     (SETF ARGONE (READ STRM))
; 
; caught WARNING:
;   undefined variable: COMMON-LISP-USER::ARGONE
; 
; compilation unit finished
;   Undefined variables:
;     *ARGS* ARGONE
;   caught 2 WARNING conditions
Unhandled UNBOUND-VARIABLE in thread #<SB-THREAD:THREAD "main thread" RUNNING
                                        {7005550003}>:
  The variable *ARGS* is unbound.

Backtrace for: #<SB-THREAD:THREAD "main thread" RUNNING {7005550003}>
0: ((LAMBDA NIL :IN "/..../test.lisp"))
1: (SB-INT:SIMPLE-EVAL-IN-LEXENV (WITH-INPUT-FROM-STRING (STRM (CAR *ARGS*)) (SETF ARGONE (READ STRM)))     #<NULL-LEXENV>)
2: (EVAL-TLF (WITH-INPUT-FROM-STRING (STRM (CAR *ARGS*)) (SETF ARGONE (READ STRM))) 0 NIL)
3: ((LABELS SB-FASL::EVAL-FORM :IN SB-INT:LOAD-AS-SOURCE) (WITH-INPUT-FROM-STRING (STRM (CAR *ARGS*))     (SETF ARGONE (READ STRM))) 0)
4: ((LAMBDA (SB-KERNEL:FORM &KEY :CURRENT-INDEX &ALLOW-OTHER-KEYS) :IN SB-INT:LOAD-AS-SOURCE)     (WITH-INPUT-FROM-STRING (STRM (CAR *ARGS*)) (SETF ARGONE (READ STRM))) :CURRENT-INDEX 0)
5: (SB-C::%DO-FORMS-FROM-INFO #<FUNCTION (LAMBDA (SB-KERNEL:FORM &KEY :CURRENT-INDEX &ALLOW-OTHER-KEYS)     :IN SB-INT:LOAD-AS-SOURCE) {1005F0E1B}> #<SB-C::SOURCE-INFO {70055166F3}> SB-C::INPUT-ERROR-IN-LOAD)
6: (SB-INT:LOAD-AS-SOURCE #<SB-SYS:FD-STREAM for "file /...././test.lisp" {7005510D73}> :VERBOSE NIL    :PRINT NIL :CONTEXT "loading")
7: ((LABELS SB-FASL::LOAD-STREAM-1 :IN LOAD) #<SB-SYS:FD-STREAM for "file /...././test.lisp" {7005510D73}   > NIL)
8: (SB-FASL::CALL-WITH-LOAD-BINDINGS #<FUNCTION (LABELS SB-FASL::LOAD-STREAM-1 :IN LOAD) {1005F09EB}>     #<SB-SYS:FD-STREAM for "file /...././test.lisp" {7005510D73}> NIL #<SB-SYS:FD-STREAM for "file /...././   test.lisp" {7005510D73}>)
9: (LOAD #<SB-SYS:FD-STREAM for "file /...././test.lisp" {7005510D73}> :VERBOSE NIL :PRINT NIL    :IF-DOES-NOT-EXIST :ERROR :EXTERNAL-FORMAT :DEFAULT)
10: ((FLET SB-IMPL::LOAD-SCRIPT :IN SB-IMPL::PROCESS-SCRIPT) #<SB-SYS:FD-STREAM for "file /...././test.   lisp" {7005510D73}>)
11: ((FLET SB-UNIX::BODY :IN SB-IMPL::PROCESS-SCRIPT))
12: ((FLET "WITHOUT-INTERRUPTS-BODY-11" :IN SB-IMPL::PROCESS-SCRIPT))
13: (SB-IMPL::PROCESS-SCRIPT "./test.lisp")
14: (SB-IMPL::TOPLEVEL-INIT)
15: ((FLET SB-UNIX::BODY :IN SB-IMPL::START-LISP))
16: ((FLET "WITHOUT-INTERRUPTS-BODY-3" :IN SB-IMPL::START-LISP))
17: (SB-IMPL::%START-LISP)

unhandled condition in --disable-debugger mode, quitting
me % 

显然存在一些我不知道的与我应该如何使用 SBCL 相关的问题。

任何 lisp 专家或具有 SBCL 知识的更好的人都将非常感激告诉我应该如何做事情。

我正在创建一个 lisp 程序来查找无向图中的非循环路径，并将该路径返回给用户。该路径不一定需要是最短路径。我的完整代码如下：

(defvar graph '((A B C)
                  (B A C)
                  (C A B D)
                  (D C)
                  ))

(defun getneighbours (graph node) ;Gets neighbors of the given node.
    (if (assoc node graph)
        (cdr (assoc node graph))
        '()
    )
)

(defun acyclicpath (graph start goal) 
    (setq visited '()) ;Reset the returnpath and visited variables for the next search.
    (setq returnpath '())
    (if (dfswithpath graph start goal) ;Path found reverse path and return.
        (reverse 'returnpath)
    )
    nil
)

(defun dfswithpath (graph node goal)
    (if (equal node goal) ;Goal reached return true.
        (push node returnpath)
        t
    )

    (push node visited) ;Update visited list.

    (dolist (neighbour (getneighbours graph node)) ;Call dfs on each neighbour of node if not already visited.
        (if (not (member neighbour visited))
            (if (dfswithpath graph neighbour goal)
                (push node returnpath)
                t
            )
        )
    )
    nil ;No path found
)

(print (acyclicpath graph 'A 'C))

运行此代码会导致 dfswithpath 函数始终返回 nil 值。我已将问题范围缩小到 dolist 函数中的递归 dfswithpath 调用。看起来它永远不会解析为 t，因此嵌套的推送函数永远不会被调用。但是，我不明白为什么会这样。

在 SBCL REPL 中，为什么输入的'(nil . nil)计算结果为(nil)而不仅仅是nil？

如果空列表是 cons 单元的两个“元素”所在的列表nil，为什么它们不一样？

我对此的假设是 SBCL 做出以下评估：

(car '()) => nil
(cdr '()) => nil
(car '(nil . nil)) => nil
(cdr '(nil . nil)) => nil

但是：

'() => nil
'(nil . nil) => (nil)

我有以下 lisp 代码

(defun sum (vec)
  "Summiert alle Elemente eines Vektors."
  (apply '+ vec))

(defun square (item)
  "Hilfsfunktion zum Quadrieren eines Elements."
  (* item item))

(defun calcVarianz (vec)
  "Berechnet die Varianz eines Vektors."
  (loop with len = (length vec)
        with mean = (/ (sum vec) len)
        with some_func = (lambda (x) (* x x))
        ; causes the error
        for item in vec
        collecting (square (- item mean)) into squared
        collecting (some_func item) into some_vector
        ; some_func cannot be found
        finally (return (/ (sum squared) (- len 1)))))

效果很好（即计算向量的方差）。
现在，我想知道是否可以在构造中将sum和square函数定义为 lambda loop，但一路上陷入困境。这可以用例如

with sum = (lambda (x) ...)

出现错误

The function COMMON-LISP-USER::SOME_FUNC is undefined.
   [Condition of type UNDEFINED-FUNCTION]

我在这里缺少什么？