> 1 <

Автор Сообщение

nickel-j

Members


Статус

23 сообщений

Где: Russia
Род занятий:
Возраст:

#3741   2010-12-21 02:59 GMT+3 часа(ов)      
Здравствуйте.
Пытаюсь реализовать задачу распознавания списков с использованием переменных из "Мир Лиспа" том 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?

nickel-j

Members


Статус

23 сообщений

Где: Russia
Род занятий:
Возраст:

#3751   2010-12-21 17:57 GMT+3 часа(ов)      
Я ещё немного помучался - вроде бы всё не так страшно - функция работает, например:
(COMPARE1 '((?> x) или (+> y)) '(до или после полудня))

 

Error: Call ((LAMBDA (#:M #:H #:PAIR) (DECLARE (SPECIAL:SOURCE #)) (OR (COMPARE1 # # #) (COMPARE1 #:M # #))) ((+> Y)) (после полудня) Y ((X . до))) has the wrong number of arguments.

Т. е. результаты она вывела, но происходит ошибка из-за того, что я не указываю аргумент pair, хотя он имеет в определении параметр optional и в примере не указан:
(COMPARE1 '((?> x) или (+> y)) '(до или после полудня) (pair nil))

 

Error: Undefined function PAIR called with arguments (NIL).

Как думаете, в чём проблема?

nickel-j

Members


Статус

23 сообщений

Где: Russia
Род занятий:
Возраст:

#3756   2010-12-22 16:33 GMT+3 часа(ов)      
Правильный вариант:
(defun COMPARE1                              ;2.0

       (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 pair) 

     (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 v 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)))

 

 

(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))))))

 

(defmatcher < (m h v pair)

   (COMPARE1 (cons (val v pair)

                           (cdr m)) h pair))

(defun val (named pair)

    (cdr (assoc named pair)))

 

(defmatcher p? (m h pred pair)

    (if (funcall pred (car h))

        (COMPARE1 (cdr m) (cdr h) pair)

        nil))

Тема закрыта
> 1 <


Онлайн :

0 пользователь(ей), 33 гость(ей) :