Здравствуйте.
Пытаюсь реализовать задачу распознавания списков с использованием переменных из "Мир Лиспа" том 2, стр. 58.
Механически переписав программу, получил:
(defun COMPARE1
(m h &optional (pair nil))
(cond
((null m)
(if (null h) (if pair pair t) nil))
((null h) nil)
((equal (car m) (car h))
(COMPARE1 (cdr m) (cdr h) pair))
((atom (car m))
(if (get (car m) 'matcher)) ; вроде здесь одна закрывающаяся скобка лишняя
(funcall
(get (car m) 'matcher)
m h pair)
nil))
(t (funcall
(get (first (car m)) 'matcher)
m
h
(second (car m))
pair))))
(defmacro defmatcher (symb param body)
`(setf (get ',symb 'matcher) (lambda ,param ,body)))
(defmatcher ? (m h pair)
(COMPARE1 (cdr m) (cdr h) pair))
(defmatcher + (m h pair)
(or (COMPARE1 (cdr m) (cdr h) pair)
(COMPARE1 m (cdr h) pair)))
(defmatcher * (m h pair)
(or (COMPARE1 (cdr m) (cdr h) pair)
(COMPARE1 (cdr m) h pair)
(COMPARE1 m (cdr h) pair)))
(defmatcher - (m h)
(or (COMPARE1 (cdr m) (cdr h) pair)
(COMPARE1 (cdr m) h pair)))
(defmatcher ?> (m h v pair)
(COMPARE1 (cdr m) (cdr h)
(acons v (car h) pair)))
(defmatcher +> (m h pair)
(or (COMPARE1 (cdr m) (cdr h)
(addto v (car h) pair))
(COMPARE1 m (cdr h)
(addto v (car h) pair))))
(defmatcher *> (m h v pair)
(or (COMPARE1 (cdr m) (cdr h)
(addto v (car h) pair))
(COMPARE1 m (cdr h)
(addto v (car h) pair))
(COMPARE1 (cdr m) h pair)))
;;;ADDTO function
(defun addto (named val pair)
(cond
((null pair)
(acons named val nil))
((eql named (caar pair) ;мб -1 открывающаяся скобка здесь, но в этом случае EQL принимается за переменную
(if (atom (cdar pair))
(acons named
(list (cdar pair) val)
(cdr pair))
(acons named
(append (cdar pair)
(list val))
(cdr pair))))
(t (cons (car pair)
(addto named val (cdr pair))))))
(defmatcher < (m h v pair)
(COMPARE1 (cons (val v pair)
(cdr m)) h pair))
(defun val (named pair)
(cdr (assoc named pair)))
Посмотрите комментарии - верны ли возможные исправления? По ходу нет, т.к. внося их, запускаю:
CL-USER 8 >
(defmatcher +> (m h pair)
(or (COMPARE1 (cdr m) (cdr h)
(addto v (car h) pair))
(COMPARE1 m (cdr h)
(addto v (car h) pair))))
Warning: Syntactic warning for form V:
V assumed special.
#'(LAMBDA (M H PAIR) (OR (COMPARE1 (CDR M) (CDR H) (ADDTO V (CAR H) PAIR)) (COMPARE1 M (CDR H) (ADDTO V (CAR H) PAIR))))
CL-USER 9 >
(defmatcher *> (m h v pair)
(or (COMPARE1 (cdr m) (cdr h)
(addto v (car h) pair))
(COMPARE1 m (cdr h)
(addto v (car h) pair))
(COMPARE1 (cdr m) h pair)))
#'(LAMBDA (M H V PAIR) (OR (COMPARE1 (CDR M) (CDR H) (ADDTO V (CAR H) PAIR)) (COMPARE1 M (CDR H) (ADDTO V (CAR H) PAIR)) (COMPARE1 (CDR M) H PAIR)))
CL-USER 10 >
(defun addto (named val pair)
(cond
((null pair)
(acons named val nil))
(eql named (caar pair)
(if (atom (cdar pair))
(acons named
(list (cdar pair) val)
(cdr pair))
(acons named
(append (cdar pair)
(list val))
(cdr pair))))
(t (cons (car pair)
(addto named val (cdr pair))))))
Warning: Syntactic warning for form EQL:
EQL assumed special.
ADDTO
CL-USER 11 >
(defmatcher < (m h v pair)
(COMPARE1 (cons (val v pair)
(cdr m)) h pair))
#'(LAMBDA (M H V PAIR) (COMPARE1 (CONS (VAL V PAIR) (CDR M)) H PAIR))
CL-USER 12 > (defun val (named pair)
(cdr (assoc named pair)))
VAL
CL-USER 13 > COMPARE1 '(X) '(X)
T
CL-USER 14 > COMPARE1 '((?> x) ARA (+> y)) '(WER ARA SDF HJIK)
Error: Call ((LAMBDA (#:M #:H #:PAIR) (DECLARE (SPECIAL:SOURCE #)) (OR (COMPARE1 # # #) (COMPARE1 #:M # #))) ((+> Y)) (SDF HJIK) Y ((X . WER))) has the wrong number of arguments.
Может я её просто не верно запускаю? И что с assumed special?