2.78

练习 2.78 包 scheme-number 里的内部过程几乎什么也没做,只不过是去调用基本过程 +、- 等等。直接使用语言的基本过程当然是不可能的,因为我们的类型标志系统要求每个数据对象都附加一个类型。然而,事实上所有Lisp实现都有自己的类型系统,使用在系统实现的内部,基本谓词 symbol?number? 等用于确定某个数据对象是否具有特定的类型。请修改2.4.2节中type-tag、contents和attach-tag的定义,使我们的通用算术系统可以利用Scheme的内部类型系统。这也就是说,修改后的系统应该像原来一样工作,除了其中常规的数直接采用Scheme的数形式,而不是表示为一个car部分是符号scheme-number的序对。


先看一下原本的效果,以 add 为例:

 
(define helper (js-eval "const table = {}; function get (op, type) {console.log('getting ', op, type);    return table[op][JSON.stringify(type)];} function put (op,type, proc) {    table[op] = table[op] || {};    table[op][JSON.stringify(type)] = proc; } const exports = {get, put, table}; exports;"))
(define JSON (js-eval "JSON"))
x
 
#<undef>
 
(define (get op type)
  (js-invoke helper 'get op type)
  )
(define (put op type proc)
  (js-invoke helper 'put op type proc)
  )
 
#<undef>
 
(define (error msg v)
  msg
  )
 
#<undef>
 
(define (attach-tag type-tag contents)
  (cons type-tag contents)
  )
(define (type-tag datum)
  (if (pair? datum)
      (car datum)
      (error (string-append "Bad tagged datum -- TYPE-TAG" datum))
      )
  )
(define (contents datum)
  (if (pair? datum)
      (cdr datum)
      (error "Bad tagged datum -- CONTENTS" datum)
      )
  )
(define (rectangular? z)
  (eq? (type-tag z) 'rectangular)
  )
(define (polar? z)
  (eq? (type-tag z) 'polar)
  )
(define (apply-generic op . args)
  (let ((type-tags (map type-tag args)))
    (let ((proc (get op '(scheme-number, scheme-number))))
      (if proc
          (apply proc (map contents args))
          (error
           "No method for these types -- APPLY-GENERIC"
           (list op type-tags)
           )
          )
      )
    )
  )
(define (add x y) (apply-generic 'add x y))
(define (install-scheme-number-package)
  (define (tag x) (attach-tag 'scheme-number x))
  (put 'add '(scheme-number, scheme-number) (lambda (x y) (tag (+ x y))))
  (put 'make 'scheme-number (lambda (x) (tag x)))
  'done
  )
(install-scheme-number-package)
 
'done
 
(define (make-scheme-number n)
  ((get 'make 'scheme-number) n)
  )
(define a (make-scheme-number 1))
(define b (make-scheme-number 2))
(add a b)
 
('scheme-number . 3)

现在希望支持直接的数形式,也就是希望如下结果是 3。

 
(add 1 2)
 
Error: string-append: string required, but got 1 [add, apply-generic, map, (anon), string-append]true

然而却报错了,这是由于 type-tag 的定义导致的,它只能处理序对,而不能处理数。改写 type-tag 为:

 
(define (attach-tag type-tag contents)
  (cons type-tag contents)
  )
(define (type-tag datum)
  (if (pair? datum)
      (car datum)
      'scheme-number
      )
  )
(define (contents datum)
  (if (pair? datum)
      (cdr datum)
      datum
      )
  )
 
#<undef>

再来计算:

 
(add 1 2)
 
('scheme-number . 3)

同时,它也支持 scheme-number:

 
(add a b)
 
('scheme-number . 3)

results matching ""

    No results matching ""