Решение упражнения 2.82 из SICP
Сначала приведем обобщенную реализацию apply-generic, которая реализует приведение типов для операций с любым количеством аргументов, а не только для бинарных операций. При вызове apply-generic для некоторого набора аргументов будем пытаться найти процедуру, работающую с данными типами аргументов. Если же такой процедуры нет в таблице типов, будем последовательно приводить все аргументы к типу первого, затем к типу второго и т.д. и пытаться найти процедуру, работающую с такими типами. Если нам это удается, то вызываем эту процедуру с приведенными аргументами.
Реализация этой идеи в виде процедур приводится ниже:
(define (coerce arg type)
(if (eq? (type-tag arg) type)
arg
(let ((arg->type (get-coercion (type-tag arg) type)))
(if arg->type
(arg->type arg)
false))))
(define (coerce-all args type)
(if (null? args)
'()
(let ((first (coerce (car args) type))
(rest (coerce-all (cdr args) type)))
(if (and first rest)
(cons first rest)
false))))
(define (apply-with-coercion op args types)
(if (null? types)
(error "Нет метода для этих типов"
(list op types))
(let ((type (car types)))
(let ((coerced-args (coerce-all args type)))
(if coerced-args
(apply apply-generic (cons op coerced-args))
(apply-with-coercion op args (cdr types)))))))
(define (apply-generic op . args)
(let ((type-tags (map type-tag args)))
(let ((proc (get op type-tags)))
(if proc
(apply proc (map contents args))
(apply-with-coercion op args type-tags)))))
Процедура apply-generic использует процедуру apply-with-coercion, которая пытается найти подходящую операцию для аргументов, приведенных к одному типу из набора. Та в свою очередь использует coerce-all, которая приводит все аргументы к заданному типу (либо возвращает ложь, если это невозможно). coerce-all использует процедуру coerce для приведения одного аргумента к заданному типу.
Однако и разработанная обобщенная процедура приведения типов не всесильна. Если у нас в системе возможны операции со смешанными типами, то мы можем не найти подходящий набор приведений, хотя он и существует. Рассмотрим пример с целыми числами, рациональными и комплексными. Предположим, что операция возведения в степень задана для комплексного и рационального числа (то есть мы умеем возводить комплексное число в рациональную степень). Мы также умеем приводить целые числа к рациональным, а рациональные к комплексным. Тем не менее, если мы вызовем обобщенную операцию возведения в степень для комплексного числа и целого, мы не получим ожидаемого результата.
Почему так происходит? Потому что apply-generic сначала попытается найти процедуру возведения в степень, заданную для комплексного и целого аргументов. Такой операции в таблице типов нет, поэтому будут предприняты попытки приведения типов. Сначала попытаемся привести тип второго аргумента к типу первого. Предположим, это удается, так как целое в принципе можно привести к комплексному. Однако операции возведения в степень для двух комплексных чисел у нас в системе нет. Теперь попытаемся привести первый аргумент к типу второго. Это не получается, так как комплексное число в общем случае не приводится к целому.
В то же время, мы могли бы привести второй целочисленный аргумент к рациональному типу и найти имеющуюся операцию.
Comments
Comment from Sergey Khenkin
Date: February 29, 2008, 11:12 pm
Даже если рассматривать только операции над аргументами одного типа, возможны случаи, когда обобщенная операция определена на типе, к которому можно привести типы каждого из передаваемых аргументов, однако не определена для любых комбинаций типов аргументов.
Например, представим себе, что сложение определено только для комплексных чисел, а вызывается для целого и рационального аргументов.
В этом случае имеющиеся процедуры также не смогут найти и использовать правильный вариант приведения типов.
Comment from gorilych
Date: August 17, 2008, 11:14 am
(if (null? types)
(error "Нет метода для этих типов"
(list op types))
список типов всегда пуст в ошибке. ошибка в выведении ошибки….
Comment from thror
Date: May 1, 2009, 10:05 pm
уважаемый горилыч:) ошибка к сожалению не только в выводе ошибки. Дело в том, что данная реализация apply-generic так же подвержена проблеме из упражнения 2.81. Когда типы аргументов одинаковы, но операция для этих типов не определена-программа войдет в бесконечный цикл. В то же время ее легко исправить, чтоб такого не происходило. Вот код.
Comment from thror
Date: May 3, 2009, 11:12 am
(define (coercion arg type)
(if (eq? (type-tag arg) type)
(cons 'skip arg)
(let ((arg->type (get-coercion (type-tag arg) type)))
ç(if arg->type
ç (cons 'done (arg->type arg))
ç (cons 'fail '())))))
(define (coercion-all args type)
(if (null? args)
(cons 'skip '())
(let ((hd (coercion (car args) type))
ç (tl (coercion-all (cdr args) type)))
ç(let ((hd-stat (car hd))
ç (hd-info (cdr hd))
ç (tl-stat (car tl))
ç (tl-info (cdr tl)))
ç (cond ((and (eq? hd-stat 'skip) (eq? tl-stat 'skip))
çç (cons 'skip (cons hd-info tl-info)))
çç((or (eq? hd-stat 'fail) (eq? tl-stat 'fail))
çç (cons 'fail '()))
çç(else (cons 'done (cons hd-info tl-info))))))))
(define (apply-with-coercion op args types)
(if (null? types)
(error "No method for these types -- APPLY-WITH-COERCION"
ç (list op (map type-tag args)))
(let ((coerced-args (coercion-all args (car types))))
ç(if (eq? (car coerced-args) 'done)
ç (apply apply-generic (cons op (cdr coerced-args)))
ç (apply-with-coercion op args (cdr types))))))
(define (apply-generic op . args)
(let ((type-tags (map type-tag args)))
(let ((proc (get op type-tags)))
(if proc
ç (apply proc (map contents args))
ç (apply-with-coercion op args type-tags)))))
Comment from thror
Date: May 3, 2009, 11:25 am
И кроме того, каждый кто читал книгу, обращал внимание на сноску 51:) ответ-да, нам не страшно внести в нашу систему требуемый уровень изощренности. Приведу определение новой функции search-coercion производящей поиск по “графу” зависимости типов (граф задается таблицей приведения типов, выполняющей роль матрицы смежности. К таблице добавляется функция get-coercion-row, возвращающая строку таблицы как список пар , реализовать которую вы можете самостоятельно, или смотрите пост ниже)
;;; SICP: ch2-generic/coercion-search/search/problem
(define (make-step action result)
(cons action result))
(define (step-action step)
(car step))
(define (step-result step)
(cdr step))
;;
(define (make-problem initial-state successor-fn goal-test step-cost)
(cons (cons '() '())
ç(cons (cons initial-state successor-fn)
ç (cons goal-test step-cost))))
(define (problem-state=? problem)
(caar problem))
(define (problem-state<? problem)
(cdar problem))
(define (problem-initial-state problem)
(caadr problem))
(define (problem-successor-fn problem)
(cdadr problem))
(define (problem-goal-test problem)
(caddr problem))
(define (problem-step-cost problem)
(cdddr problem))
(define (set-problem-state=? problem state=?)
(set-car! (car problem) state=?))
(define (set-problem-state<? problem state<?)
(set-cdr! (car problem) statetype (search-coercion (type-tag arg) type)))
ç(if arg->type
ç (cons 'done (arg->type arg))
ç (cons 'fail '())))))
(define (coercion-all args type)
(if (null? args)
(cons 'skip '())
(let ((hd (coercion (car args) type))
ç (tl (coercion-all (cdr args) type)))
ç(let ((hd-stat (car hd))
ç (hd-info (cdr hd))
ç (tl-stat (car tl))
ç (tl-info (cdr tl)))
ç (cond ((and (eq? hd-stat 'skip) (eq? tl-stat 'skip))
çç (cons 'skip (cons hd-info tl-info)))
çç((or (eq? hd-stat 'fail) (eq? tl-stat 'fail))
çç (cons 'fail '()))
çç(else (cons 'done (cons hd-info tl-info))))))))
(define (apply-with-coercion op args types)
(if (null? types)
(error "No method for these types -- APPLY-WITH-COERCION"
ç (list op (map type-tag args)))
(let ((coerced-args (coercion-all args (car types))))
ç(if (eq? (car coerced-args) 'done)
ç (apply apply-generic (cons op (cdr coerced-args)))
ç (apply-with-coercion op args (cdr types))))))
(define (apply-generic op . args)
(let ((type-tags (map type-tag args)))
(let ((proc (get op type-tags)))
(if proc
ç (apply proc (map contents args))
ç (apply-with-coercion op args type-tags)))))
Comment from thror
Date: May 3, 2009, 11:29 am
ррр… Че то обрезалось все. Ладно, все равно-полный код всей системы, а так же кучу всего нового дополнительно к списку упражнений сикп вы можете найти но адресу http://www.uic.nnov.ru/~kuaa29
Comment from thror
Date: May 4, 2009, 5:00 pm
в частности для данного упражнения:
- реализация автоматического поиска по графу зависимости типов и автоматическое формирование функции приведения
- улучшенная стратегия для apply-generic позволяющая в некотором смысле оптимально и главное гарантированно, если это возможно, привести типы аргументов функции к таким, для которых функция определена
- и многое многое другое (список расширений стандартного набора упражнений будет опубликован на странице)
Comment from thror
Date: May 4, 2009, 5:01 pm
а этот прожект в целом слишком слабый и поверхностный на мой взгляд
Comment from anonymous
Date: December 14, 2010, 11:49 am
Однако этот прожект всё ещё онлайн, а http://www.uic.nnov.ru/~kuaa29 уже нет…
Comment from anonymous
Date: December 14, 2010, 12:27 pm
(define (apply-generic op . args)
(let*([type-tags (map type-tag args)]
[proc (get op type-tags)])
(cond [proc
(apply proc (map contents args))]
[else
(define (exhaustion rest)
(if (null? rest)
(error "Нет метода для этих типов"
(list op type-tags))
(let*([this-type (type-tag (car rest))]
[this-proc (get op this-type)])
(if this-proc
(let ([newargs (coercion2type this-type args type-tags)])
(if newargs
(apply this-proc (map contents newargs))
(exhaustion (cdr rest))))
(exhaustion (cdr rest))))))
(exhaustion args)])))
(define (coercion2type type args args-types)
(if (null? args)
null
(let*([t (car args-types)]
[coercion-proc
(if (eq? t type)
(λ(a)a)
(get-coercion t type))])
(if coercion-proc
(let ([rest-args (coercion2type type (cdr args) (cdr args-types))])
(if rest-args
(cons (coercion-proc (car args)) rest-args)
#f))
#f))))
Write a comment