blob: edb8e445f210c88f394530b19b90b70374a44c9c (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
|
#lang racket
(require "../../shared/lists.rkt")
;; a. Number and variable are primitives that return a boolean.
;; But what you want is a type assertion that has the same signature as the rest.
;; The operator procedure for example returns the symbol that indicates whether the expression is a sum or product.
;; Get fetches a procedure from the dispatch table that defines how to take the derivative of the expression. But that is not a problem because you can define
;; the derivatives of a number or variable as procedures. This is one step that needs to be done first.
;;
;; The get and put procedures on the dispatch table just need to support the type-tag of the expression, which is not supported for booleans. (i think?)
;; So you might type tag variables and expressions. But this changes the underlying representation of the expression. Which we are not interested in right now.
;; b.
(define (variable? x) (symbol? x))
(define (same-variable? x y) (and (variable? x) (variable? y) (eq? x y)))
(define dispatch-table '())
(define (attach-tag type-tag contents)
(cons type-tag contents))
(define (type-tag datum)
(if (pair? datum)
(car datum)
(error "Bad tagged datum -- TYPE-TAG" datum)))
(define (contents datum)
(if (pair? datum)
(cdr datum)
(error "Bad tagged datum -- CONTENTS" datum)))
(define (make-eq-type? type)
(lambda (d)
(eq? (type-tag d) type)))
(define (get op type)
(let ((op-entry (find-first (make-eq-type? op)
dispatch-table)))
(if (pair? op-entry)
(let ((installed-types (cdr op-entry)))
(let ((dispatch-proc-entry (find-first (make-eq-type? type)
installed-types)))
(if (pair? dispatch-proc-entry)
(cdr dispatch-proc-entry)
(error "Bad op or op not defined for type -- GET" op type dispatch-proc-entry))))
(error "Not found or bad entry -- GET" op type op-entry))))
(define (put op type item)
(if (find-first (make-eq-type? op) dispatch-table)
(set! dispatch-table (map (lambda (op-entry) ;;just copy the table for now, don't want to mutate yet
(if (not (eq? (type-tag op-entry) op))
op-entry
(cons (attach-tag op
(let ((installed-types (cdr op-entry)))
(map (lambda (type-entry)
(if (not (eq? (type-tag type-entry) type))
type-entry
(attach-tag type item)))
installed-types))))))
dispatch-table))
(set! dispatch-table (cons (attach-tag op (list (attach-tag type item)))
dispatch-table))))
;; prefix combination notation of expression? (+ a b)
(define (operator ex)
(car ex))
(define (operands ex)
(cdr ex))
(define (deriv ex var)
(cond ((number? ex) 0)
((variable? ex) (if (same-variable? ex var) 1 0))
(else ((get 'deriv (operator ex)) (operands ex) var))))
|
