我写了下面的代码（INFIX-LINKING-LEAFS - 最后一个函数 - 是第一个带有
loop这显然是一种麻烦的方法。但我需要它来理解问题的单个步骤。我的第一次尝试将所有内容都包含在一个函数中，但我迷失了方向。现在我打算以单独的小步骤让它变得非常麻烦。
所以此刻，我不是在寻找抽象，而是在寻找原因，为什么我的内部循环没有启动。这将是一个明显的错误，但我的想法此时已锁定。 （顺便说一下，我故意避免
caar正如您可能所看到的，我认为无论如何，内部循环都会重复我的指令。我意识到，正如您可以看到的那样，我指示
loopdolist非常感谢！
这是一个示例输入：
((⊂ "print" ⊂ "minus" < "logo-quote" "\"3\"" > ⊃ (PRODUCT . 400) < "logo-quote"
"\"4\"" > (SUM . 300) < "logo-quote" "\"5\"" > (PRODUCT . 400) < "logo-quote"
"\"9\"" > (SUM . 300) ⊂ "minus" < "logo-quote" "\"2\"" > (QUOTIENT . 400) <
"logo-quote" "\"4\"" > (POWER . 500) < "logo-quote" "\"8\"" > (SUM . 300) <
"logo-quote" "\"1\"" >))
如果这个“徽标前线”太混乱，也许起始数据作为信息很有帮助：
(defparameter *infix-case-4* "print - 3 * 4 + 5 * 9 - 2 / 4 ^ 8 + 1")
这是代码：
(defun infix-pos (lines-lst)
"Takes a list of pre-Logo lines as input and returns a nested list
with a sublist of dotted pairs for each line with (<position> . <weight>),
sorted by <weight>."
(let ((loop-ctr -1)
(infix-pos-weight-lst '())
(interim '())
(out '()))
(loop for line in lines-lst do
(loop for el in line
do (incf loop-ctr)
if (consp el)
do (progn
(push (cons loop-ctr (rest el))
infix-pos-weight-lst)))
(push (nreverse infix-pos-weight-lst) interim)
(setf infix-pos-weight-lst '()) )
;;interim))
(loop for lst in interim do
(push (sort lst
#'(lambda (x y)
(> (rest x) (rest y))))
out))
out))
(let ((new-line '())
(pos-lst '()))
;; pos-s: start, pos-o: operator, pos-e: end
(defun splice-in-new-line (pos-s pos-o pos-e)
"Concatenates the first part of NEW-LINE with the 'new part' and
the last part of NEW-LINE. The 'new part' is the prefixed Logo expression."
(setf new-line (append
(subseq new-line 0 pos-s) ;; first part of NEW-LINE
(list '⊂ ;; new part for NEW-LINE
(string
(first (nth (first (first pos-lst))
new-line))))
(subseq new-line pos-s pos-o)
(subseq new-line (1+ pos-o) pos-e)
'(⊃)
(subseq new-line pos-e)));) ;; Last part of NEW-LINE
(terpri) (princ "splice-in...: ") (print new-line) (terpri))
(defun determine-case ()
"Returns the name of the context of the infix operator.
Simply an intermediate step for me, to be more easy on my eyes."
(cond (;; (case 1:) Operator connects two plain words
(and (eq '< (nth (- (first (first pos-lst)) 4) new-line))
(eq '> (nth (+ (first (first pos-lst)) 4) new-line)))
'plain-plain)
(;; (case 2:) Operator connects a plain word and a thing or (- number)
(and (eq '< (nth (- (first (first pos-lst)) 4) new-line))
(eq '⊃ (nth (+ (first (first pos-lst)) 7) new-line)))
'plain-thing)
(;; (case 3:) Op. connects a thing or (- number) and a plain word
(and (eq '⊂ (nth (- (first (first pos-lst)) 7) new-line))
(eq '> (nth (+ (first (first pos-lst)) 4) new-line)))
'thing-plain)
(;; (case 4:) Operator connects two things or (- numbers)
(and (eq '⊂ (nth (- (first (first pos-lst)) 7) new-line))
(eq '⊃ (nth (+ (first (first pos-lst)) 7) new-line)))
'thing-thing)
(;; (fallback:) Do nothing in different contexts.
t nil)))
(defun handle-case (branch)
"Calls SPLICE-IN-NEW-LINE with the relevant crop marks."
(case branch
((plain-plain) (format t "~%handle case 1")
(splice-in-new-line
(- (first (first pos-lst)) 4)
(first (first pos-lst))
(+ (first (first pos-lst)) 5)))
((plain-thing) (format t "~%handle case 2")
(splice-in-new-line
(- (first (first pos-lst)) 4)
(first (first pos-lst))
(+ (first (first pos-lst)) 8)))
((thing-plain) (format t "~%handle case 3")
(splice-in-new-line
(- (first (first pos-lst)) 7)
(first (first pos-lst))
(+ (first (first pos-lst)) 5)))
((thing-thing) (format t "~%handle case 4")
(splice-in-new-line
(- (first (first pos-lst)) 7)
(first (first pos-lst))
(+ (first (first pos-lst)) 8)))
(otherwise (format t "~%otherwise")
nil))
(setf pos-lst (rest pos-lst));)
(format t "~%pos-lst: ~a" pos-lst))
(defun infix-linking-leafs (lines-lst)
"Takes a list of pre-Logo lines as input. Any infix operator that links
two plain numeric words, negated numeric words or 'thinged' words will
be identified. From highest to lowest weight, these partial infix expressions
will be reformulated as prefixed expressions spliced into the original line.
If words are bound by one operator they are lost for the next operator in
the weight order."
(let ((infix-pos-lst (infix-pos lines-lst))
(out '())
(ct-outer 0)
(ct-inner 0))
(loop for line in lines-lst do
(progn
(setf new-line line)
(format t "outer: ~d~%NEW-LINE: ~a~%" (incf ct-outer) new-line)
(loop for subl in infix-pos-lst do
(progn
(format t "inner: ~d~%SUBL: ~a~%" (incf ct-inner) subl)
(when (= ct-inner 1)
(setf pos-lst subl))
(format t "POS-LST: ~a~%" pos-lst)
(handle-case (determine-case))) ) ; end inner LOOP
(format t "~%outer: ~d~%NEW-LINE: ~a~%" ct-outer new-line)
(push new-line out)
(setf new-line '()) )) ; end outer PROGN, outer LOOP
(nreverse out))))
示例输出：
outer: 1
NEW-LINE: (⊂ print ⊂ minus < logo-quote "3" > ⊃ (PRODUCT . 400) < logo-quote
"4" > (SUM . 300) < logo-quote "5" > (PRODUCT . 400) < logo-quote
"9" > (SUM . 300) ⊂ minus < logo-quote "2" > (QUOTIENT . 400) <
logo-quote "4" > (POWER . 500) < logo-quote "8" > (SUM . 300) <
logo-quote "1" >)
inner: 1
SUBL: ((36 . 500) (9 . 400) (19 . 400) (31 . 400) (14 . 300) (24 . 300)
(41 . 300))
POS-LST: ((36 . 500) (9 . 400) (19 . 400) (31 . 400) (14 . 300) (24 . 300)
(41 . 300))
handle case 1
splice-in...:
(⊂ "print" ⊂ "minus" < "logo-quote" "\"3\"" > ⊃ (PRODUCT . 400) < "logo-quote"
"\"4\"" > (SUM . 300) < "logo-quote" "\"5\"" > (PRODUCT . 400) < "logo-quote"
"\"9\"" > (SUM . 300) ⊂ "minus" < "logo-quote" "\"2\"" > (QUOTIENT . 400) ⊂
"POWER" < "logo-quote" "\"4\"" > < "logo-quote" "\"8\"" > ⊃ (SUM . 300) <
"logo-quote" "\"1\"" >)
pos-lst: ((9 . 400) (19 . 400) (31 . 400) (14 . 300) (24 . 300) (41 . 300))
outer: 1
NEW-LINE: (⊂ print ⊂ minus < logo-quote "3" > ⊃ (PRODUCT . 400) < logo-quote
"4" > (SUM . 300) < logo-quote "5" > (PRODUCT . 400) < logo-quote
"9" > (SUM . 300) ⊂ minus < logo-quote "2" > (QUOTIENT . 400) ⊂
POWER < logo-quote "4" > < logo-quote "8" > ⊃ (SUM . 300) <
logo-quote "1" >)
((⊂ "print" ⊂ "minus" < "logo-quote" "\"3\"" > ⊃ (PRODUCT . 400) < "logo-quote"
"\"4\"" > (SUM . 300) < "logo-quote" "\"5\"" > (PRODUCT . 400) < "logo-quote"
"\"9\"" > (SUM . 300) ⊂ "minus" < "logo-quote" "\"2\"" > (QUOTIENT . 400) ⊂
"POWER" < "logo-quote" "\"4\"" > < "logo-quote" "\"8\"" > ⊃ (SUM . 300) <
"logo-quote" "\"1\"" >))
一些反馈：
您的代码中有很多不需要的变量。例如，我会这样写 INFIX-POS：
(defun infix-pos (lines-list)
"Takes a list of pre-Logo lines as input and returns a nested list
with a sublist of dotted pairs for each line with (<position> . <weight>),
sorted by <weight>."
(loop for line in lines-list
collect (sort (loop for el in line and loop-ctr from 0
when (consp el)
collect (cons loop-ctr (cdr el)))
#'> :key #'cdr)))
上面的代码去掉了一个循环和很多局部变量。
我也会在没有顶层 LET 的情况下编写其余的代码。带有局部 DEFUN 的全局 LET 是错误的来源。