> 1 <

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

nickel-j

Members


Статус

23 сообщений

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

#3312   2010-11-01 16:13 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) ; 1.)
(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))) ; 2.)
 
 
 
(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) ; 3.)
(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))))))
 


1.) В оригинале строка выглядит
(if (get (car m) 'matcher))
,
но в таком случае количество скобок не совпадает - верно ли исправление?
2.) Макрос matcher я переписал без изменений из предыдущего примера, гда переменные не использовались - он будет работать в таком виде?
3.) Количество скобок не сходится (открытых на 1 больше) - где её следует исправить?

nickel-j

Members


Статус

23 сообщений

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

#3754   2010-12-22 16:31 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 пользователь(ей), 37 гость(ей) :