sicp-ex-2.84

  
  
  
 ;; assuming that the types are arranged in a simple tower shape. 
 (define (apply-generic op . args) 
   ;; raise s into t, if success, return s; else return #f 
   (define (raise-into s t) 
         (let ((s-type (type-tag s)) 
               (t-type (type-tag t))) 
           (cond ((equal? s-type t-type) s) 
                 ((get 'raise (list s-type))  
                  (raise-into ((get 'raise (list s-type)) (contents s)) t)) 
                 (else #f)))) 
  
   (let ((type-tags (map type-tag args))) 
         (let ((proc (get op type-tags))) 
           (if proc 
             (apply proc (map contents args)) 
             (if (= (length args) 2) 
               (let ((a1 (car args)) 
                    (a2 (cadr args))) 
                 (cond  
                   ((raise-into a1 a2) 
                    (apply-generic op (raise-into a1 a2) a2)) 
                   ((raise-into a2 a1) 
                    (apply-generic op a1 (raise-into a2 a1))) 
                   (else (error "No method for these types" 
                         (list op type-tags))))) 
            (error "No method for these types" 
                   (list op type-tags))))))) 

  
  
  
 ;; This solution is for an apply-generic that works with arbitrary arguments 
 ;; by raising all to the highest type. 
 ;; New types can be added to the tower easily. Only the procedure "level" has 
 ;; to be modified. 
  
 (define (level type) 
   (cond ((eq? type 'integer) 0) 
         ((eq? type 'rational) 1) 
         ((eq? type 'real) 2) 
         ((eq? type 'complex) 3) 
         (else (error "Invalid type: LEVEL" type)))) 
  
 (define (apply-generic op . args) 
   (let ((type-tags (map type-tag args))) 
     (define (no-method) 
       (error "No method for these types" (list op type-tags))) 
     (let ((proc (get op type-tags))) 
       (if proc 
           (apply proc (map contents args)) 
           (if (not (null? (cdr args))) ; length of args > 1 
               (let ((raised-args (raise-to-common args))) 
                 (if raised-args 
                     (let ((proc (get op (map type-tag raised-args)))) 
                       (if proc 
                           (apply proc (map contents raised-args)) 
                           (no-method))) 
                     (no-method))) 
               (no-method)))))) 
  
 (define (raise-to-common args) 
   (let ((raised-args 
          (map (lambda (x) (raise-to-type (highest-type args) x)) 
               args))) 
     (if (all-true? raised-args) 
         raised-args 
         false))) 
  
 (define (all-true? lst) 
   (cond ((null? lst) true) 
         ((car lst) (all-true? (cdr lst))) 
         (else false))) 
  
 (define (raise-to-type type item) 
   (let ((item-type (type-tag item))) 
     (if (eq? item-type type) 
         item 
         (let ((raise-fn (get 'raise item-type))) 
           (if raise-fn 
               (raise-to-type type (raise-fn item)) 
               false))))) 
  
 (define (highest-type args) 
   (if (null? (cdr args)) 
       (type-tag (car args)) 
       (let ((t1 (type-tag (car args))) 
             (t2 (highest-type (cdr args)))) 
         (let ((l1 (level t1)) (l2 (level t2))) 
           (if (> l1 l2) t1 t2))))) 
  

  
 ; This is very similar to gws' answer, but, I have added the levels to the  
 ; table, so new levels can be added to the table in the new types' package 
 ; using "put" 
  
  (define (apply-generic op . args) 
  (define (higher-type types) 
   (define (iter x types) 
     (cond ((null? types) x) 
           ((> (level x) (level (car types))) 
            (iter x (cdr types))) 
           (else  
            (iter (car types) (cdr types))))) 
   (if (null? (cdr types)) (car types) (iter (car types) (cdr types)))) 
   (define (raise-args args level-high-type) 
     (define (iter-raise arg level-high-type) 
       (if (< (level (type-tag arg)) level-high-type) 
           (iter-raise (raise arg) level-high-type) 
           arg)) 
     (map (lambda (arg) (iter-raise arg level-high-type)) args)) 
 (define (not-all-same-type? lst) 
   (define (loop lst) 
     (cond ((null? lst) #f) 
           ((eq? #f (car lst)) #t) 
           (else (loop (cdr lst))))) 
   (loop (map (lambda (x) (eq? (car lst) x)) 
      (cdr lst)))) 
  
   (let ((type-tags (map type-tag args))) 
     (let ((proc (get op type-tags))) 
       (if proc                   
           (apply proc (map contents args)) 
           (if (not-all-same-type? type-tags)    ; only raise if the args are not 
 ;; all of the same type, if they are, then there is not "op" for them.  
               (let ((high-type (higher-type type-tags))) 
                 (let ((raised-args (raise-args args (level high-type)))) 
                   (apply apply-generic (cons op raised-args)))) 
               (error  
                "No Method for these types -- APPLY-GENERIC" 
                (list op type-tags))))))) 
  
  
 ; The level procedure. 
  
 (define (level type) 
   (get 'level type)) 
  
 ; The package of the levels. Each of these statements, can be placed in the  
 ; package of the number type it belongs to. I have done it here for the  
 ; exercise. Also I have a polar and rectangular level just in case level gets 
 ; called with a complex number without the 'complex tag.  
  
 (define (install-level-package) 
   (put 'level 'scheme-number 1) 
   (put 'level 'rational 2) 
   (put 'level 'real 3) 
   (put 'level 'complex 4) 
   (put 'level 'rectangular 4) 
   (put 'level 'polar 4) 
   'done) 
  
 (install-level-package) 

  
 ;Hello here I'd like to introduce my own view on this task. No additional level tags, everything done with respect to the additive style of system construction and inside the operation-and-type-table and coercion-table boundaries. Also pay attention to the type-tag selectors/constructors and keep in mind that type constructors are globally announced, also the numer/denom from now are generic operations since we would need them for reals also to push down real to rational. 
  
 ;operation-and-type table 
 (define mt (make-hash)) 
 ;put procedure 
 (define (put op type proc) (hash-set! mt (cons op type) proc)) 
 ;get procedure 
 (define (get op type) 
   (let ((pick-item (hash-ref mt (cons op type) '()))) 
       (if (null? pick-item) 
           #f 
           pick-item))) 
  
 ;type-tag operations 
 (define (contents datum) 
   (cond ((number? datum) datum) 
         ((pair? datum) (cdr datum)) 
         (else (error "Bad data")))) 
 (define (type-tag datum) 
   (cond ((number? datum) (if (exact? datum) 'integer 'real)) 
         ((pair? datum) (car datum)) 
         (else (error "Bad data")))) 
 (define (attach-tag type-tag contents) 
   (if (number? contents) 
       contents 
       (cons type-tag contents))) 
  
 ;global numer denom selectors 
 (define (numer x) 
   (apply-generic 'numer x)) 
 (define (denom x) 
   (apply-generic 'denom x)) 
  
 ;coercion table 
 (define ct (make-hash)) 
  
 ;put-coercion procedure 
 (define (put-coercion type1 type2 proc) (hash-set! ct (cons type1 type2) proc)) 
  
 ;get-coercion procedure 
 (define (get-coercion type1 type2) 
   (let ((pick-item (hash-ref ct (cons type1 type2) '()))) 
       (if (null? pick-item) 
           #f 
           pick-item))) 
  
 ;basic coercions (global procedures). trick here is that rationals and reals have the "hidden" tag plus numer/denom are now generic and they will cut our rational in pieces and strip off the tag, so it's no more necessary to strip off the tag at the 'raising' step. 
   (define (integer->rational x) 
     (make-rational x 1)) 
   (define (rational->real x) 
     (make-real (/ (numer x) (denom x)))) 
   (define (real->complex x) 
     (make-complex-from-real-imag x 0)) 
  
 (define (install-coercions) 
   (put-coercion 'integer 'rational (lambda (x) (integer->rational x))) 
   (put-coercion 'rational 'real (lambda (x) (rational->real x))) 
   (put-coercion 'real 'complex (lambda (x) (real->complex x)))) 
 (install-coercions) 
  
 ;raising (basically it will return its input value in case the type is 'complex, at this point of the book, i found it more convenient to do it this way rather than just return false, reason was to simplify the level-test) 
 (define (raise obj) 
   (let ((type-tag (type-tag obj))) 
     (let ((supertype (get 'raise type-tag))) 
       (if supertype 
           ((get-coercion type-tag supertype) obj) 
           obj)))) 
  
 ;raising to the prespecified type (the issue is known that it will go into an infinite loop in case the type is lower than argument's. but still it works fine as a part of apply-generic procedure) 
 (define (raise-to arg type) 
   (let ((this-tag (type-tag arg))) 
     (if (eq? this-tag type) 
         arg 
         (raise-to (raise arg) type)))) 
  
 ;testing 2 arguments which has the highest type 
 (define (pick-higher arg1 arg2) 
   (define (find-iter arg1 arg2 result) 
     (let ((tag1 (type-tag arg1)) 
           (tag2 (type-tag arg2)) 
           (move-a1 (raise arg1))) 
       (let ((next-tag1 (type-tag move-a1))) 
         (cond ((eq? tag1 tag2) arg2) 
               ((eq? tag1 next-tag1) result) 
               (else (find-iter move-a1 arg2 result)))))) 
     (find-iter arg1 arg2 arg1)) 
  
 ;picking the highest type argument from the list 
 (define (find-highest args) 
   (if (null? (cdr args)) 
       (car args) 
       (let ((this (car args)) 
             (next (cadr args)) 
             (rest (cddr args))) 
         (let ((t1 (type-tag this)) 
               (t2 (type-tag next))) 
           (if (eq? t1 t2) 
               (find-highest (cdr args)) 
               (find-highest (cons (pick-higher this next) 
                                   rest))))))) 
  
 ;raising the entire argument list to the type 
 (define (raise-all-to-highest args type) 
   (if (null? args) 
       null 
       (let ((a1 (car args)) 
             (rest (cdr args))) 
         (cons (raise-to a1 type) 
               (raise-all-to-highest rest type))))) 
 ;special procedure to partition our argument list in pieces of two, since our packages arithmetic procedures were specified for maximum of 2 arguments, we'll do it this way: 
 (define (partition-and-apply op args) 
   (if (null? (cdr args)) 
       (car args) 
       (let ((a1 (car args)) 
             (a2 (cadr args)) 
             (rest-args (cddr args))) 
         (partition-and-apply op (cons (apply-generic op a1 a2) rest-args))))) 
  
 ;here we just construct the whole procedure. and it works properly for 1,2 or more arguments and thanks god returns "Bad data" error in case the argument list is null. i confess it could be written in a more 'generic' manner but if you find anything useful for yourself out here i would be glad. 
 (define (apply-generic1 op . args) 
   (let ((type-tags (map type-tag args))) 
     (let ((proc (get op type-tags))) 
       (if proc 
           (apply proc (map contents args)) 
           (if (> (length args) 1) 
               (let ((t1 (car type-tags)) 
                     (t2 (cadr type-tags)) 
                     (rest-args (cddr args))) 
                 (if (and (null? rest-args) (eq? t1 t2)) 
                     (error "No procedure specified for these types" op) 
                     (let ((highest-type (type-tag (find-highest args)))) 
                       (let ((raised-args (raise-all-to-highest args highest-type))) 
                         (partition-and-apply op raised-args))))) 
               (error "No procedure specified for this type" op)))))) 

I think implementing a hierarchical management module alone simplifies the problem and can be easily applied to any number of parameters.

  
  
  
  
 ;; Making a Hierarchical Manager 
 (define (make-rank-manager) 
     ;; Type of hierarchical tower 
     ;; The higher the level, the larger the coding. 
     (define type-tower (list)) 
      
     ;; Create hierarchical objects 
     (define (make-floor type hierarchy) 
         (cons type hierarchy)) 
      
     ;; Get the hierarchy of hierarchical objects 
     (define (get-hierarchy f) (cdr f)) 
      
     ;; Get the type of hierarchical object 
     (define (get-type f) (car f)) 
      
     ;; Find the hierarchy of the type 
     (define (find-hierarchy type) 
         (let ((this (filter 
                         (lambda (f) 
                             (eq? type (get-type f))) 
                         type-tower))) 
             (if (null? this) 
                 (error "Non-existent type--" type) 
                 (get-hierarchy (car this))))) 
      
     ;; Find the hierarchy of the type 
     (define (find-type hierarchy) 
         (let ((this (filter 
                         (lambda (f) 
                             (eq? hierarchy (get-hierarchy f))) 
                         type-tower))) 
             (if (null? this) 
                 (error "Non-existent hierarchy --" hierarchy) 
                 (get-type (car this))))) 
      
     ;; Add level 
     (define (append-floor! type hierarchy) 
         (let ((same (filter 
                         (lambda (t) (eq? type t)) 
                         (map get-type type-tower)))) 
             (if (null? same) 
                 (set! 
                     type-tower 
                     (cons (make-floor type hierarchy) type-tower)) 
                 (error "existent type--" type)))) 
      
     ;; selecting operation 
     (define (operation op) 
         (cond ((eq? op 'find-hierarchy) find-hierarchy) 
             ((eq? op 'find-type) find-type) 
             ((eq? op 'append-floor!) append-floor!) 
             (else (error "Non-existent operation--" op)))) 
      
     operation) 
      
 ;; Operation interface 
 (define rank-manager (make-rank-manager)) 
 (define get-rank (rank-manager 'find-hierarchy)) 
 (define get-type (rank-manager 'find-type)) 
 (define put-rank (rank-manager 'append-floor!)) 
  
 ;; Create a Set Type Tower 
 ;; Layer hierarchy is controlled by a basic numerical value 
 ;; The larger the value, the higher the level. 
 (define (make-number-tower) 
     (put-rank 'scheme-number 1) 
     (put-rank 'rational 3) 
     (put-rank 'real 5) 
     (put-rank 'complex 7) 
     'done) 
  
 ;; Promote data to a given type hierarchy 
 (define (raise-it data hierarchy) 
     (let ((rank (get-rank (type-tag data)))) 
         (if (= hierarchy rank) 
             data 
             (raise-it (raise data) hierarchy)))) 
  
  
 (define (apply-generic op . args) 
      
     (define (no-method-error tags) 
         (error 
             "No method for these types" 
             (list op tags))) 
  
     (let ((type-tags (map type-tag args))) 
         (let ((proc (get op type-tags))) 
             (if proc 
                 (apply proc (map contents args)) 
                 (let ((type-top 
                             (apply max (map get-rank type-tags)))) 
                     (let ((new-args 
                                 (map (lambda (x) (raise-it x type-top)) args))) 
                         (let ((new-type-tags (map type-tag new-args))) 
                             (if (equal? new-type-tags type-tags) 
                                 (no-method-error type-tags) 
                                 (apply apply-generic (cons op new-args)))))))))) 
  

This solution should be able to supply an apply-generic procedure that takes in multiple arguments and raises each of the arguments to a type in which they can all be raised to. Performs the same operations as is seen, most likely, on a solution for Exercise 2.82.

Additivity of types seems to still work, but the problem with this implementation is that it cannot support additions of differently named types that are on the same "level" as other types..

  
 ;; Type heights are based on the index of the type in this list. '(complex)es 
 ;; are "higher" in the tree than '(integers) because they are index 3 and 
 ;; '(integers) are index 0. 
  
 (define type-height-relationships '(integer rational real complex)) 
  
 ;; Get the numerical index of item in list. 
 (define (index item itemlist) 
         (define (index-loop count items) 
                 (cond ((null? items) #f) 
                           ((and (list? (car items)) 
                                    (index item (car items))) count) 
                           ((eq? item (car items)) count) 
                           (else (index-loop (+ count 1) (cdr items))))) 
         (index-loop 0 itemlist)) 
  
  
 ;; Compares two type heights in the tower 
 ;; Returns -1 if a < b 
 ;; Returns 0 if a == b 
 ;; Returns 1 if a > b 
 (define (type-compare a b) 
         (let ((height-a (index (type-tag a) (type-height-relationships))) 
                   (height-b (index (type-tag b) (type-height-relationships)))) 
                         (if (or (not height-a) (not height-b)) 
                                 (error "ERROR: Unknown type in type-height-relationships given -- TYPE-COMPARE\nCheck your \"type-height-relationships\"" "Type A --> " (type-tag a) " Height A: " height-a "\n" "Type B --> " (type-tag b) " Height B: " height-b) 
                                 (cond ((< height-a height-b) -1) 
                                           ((= height-a height-b) 0) 
                                           ((> height-a height-b) 1))))) 
  
  
  
 ;; Single parameter function that returns a single parameter lambda function. 
 ;; We raise the secondary parameter (typed-to-coerce) up to the 
 ;; level of the primary parameter (typed) through iterative recursion. 
 ;; 
 ;; If we cannot raise the secondary param then we return it and try to force 
 ;; our apply-generic procedure to give us an operation that works. 
 (define (coerce-from-typed typed) 
   (define (coerce-typed typed-to-coerce) 
         (let ((typed-comparison (type-compare (type-tag typed)  
                                               (type-tag typed-to-coerce)))) 
           (cond 
             ;; Just return our typed-to-coerce and try to force a "good" 
             ;; operation find. Ideally we'd like to "lower" the 
             ;; "typed-to-coerce" here but we will assume that is not 
             ;; available. 
             ((< typed-comparison 0) typed-to-coerce) 
             ;; Preferable exit method of our function. 
             ((= typed-comparison 0) typed-to-coerce) 
             ;; Recursing point of the function. 
             ;; Raise our typed-to-coerce one more level and 
             ;; do another test 
             ((> typed-comparison 0) (coerce-typed (raise typed-to-coerce)))))) 
   (lambda (type) (coerce-typed type))) 
  
 ;; Customized apply-generic procedure. 
 (define (apply-generic op . args) 
   (define (apply-generic-loop op refs args) 
         (if (null? refs) 
                 (error "No operation available for these types: " 
                            (map type-tag args) 
                            "\n" 
                            "Operation: " op) 
                 (let ((convert-to (coerce-from-typed (car refs)))) 
                   (let ((converted (map convert-to args))) 
                         (let ((proc (get op (map type-tag converted)))) 
                           (if proc 
                                   (apply proc (map contents converted)) 
                                   (apply-generic-loop op (cdr refs) args))))))) 
   (apply-generic-loop op args args)) 
  

  
 ;; any null in the list? 
 (define (has-null? seq) 
   (memq '() seq)) 
  
 ;; does the list have any #f? 
 (define (has-false? seq) 
   (memq #f seq))  
  
 ;; are all elements of the list the same? 
 (define (all-same? seq) 
   (cond ((null? seq) true) 
         (else 
           (let ((first (car seq))) 
             (has-false? 
               (map (lambda (somearg) 
                      (eq? somearg first)))))))) 
  
 ;; tower procedures 
 (define (superiors x) 
   (cdr (memq x (find-tower x)))) ; I'm assuming find-tower exists 
  
 (define (above? a-type b-type) 
   (memq b-type (find-tower a-type))) 
  
 (define (next-type type) 
   (car (superiors type))) 
  
 ;; be aware that raise takes a datum as input, not a tag 
 (define (raise datum) 
   (let ((tag (type-tag datum))) 
     ((get-coercion tag (next-type tag)) datum))) 
  
 ;; successivly rises one arguement until it reaches the desired type 
 (define (successive-rise datum newtype) 
   (if (eq? (type-tag datum) newtype) datum 
       (successive-rise (rise datum) newtype))) 
  
 ; find the highest tag in a list 
 (define (highest-type tag-list) 
   (define (helper remaining) 
     (cond ((null? remaining (error "Bad tags" tag-list))) 
           (else 
             (let ((master-tag (car remaining)) 
                   (all-true? (lambda (x) (not (has-false? x))))) 
               (if (all-true?  (map (lambda (sometag) (above? master-tag sometag) 
                                      tag-list))) 
                 master-tag 
                 (helper (cdr remaining))))))) ; try again 
   (helper tag-list)) 
  
 ;; If types are not the same, and the procedure does not exist, then run 
 ;; apply-generic on the coerced version of the args, which are obtained by 
 ;; mapping successive-raise on each arguements till they reach the highest-type 
 ;; in tag-list 
 (define (apply-generic op . args) 
   (let ((type-tags (map type-tag args))) 
     (let ((proc (get op type-tags))) 
       (cond (proc (apply proc (map contents args))) 
             ((all-same? type-tags) 
              (error "No method for these types" (list op type-tags))) 
             (else 
               (let ((master-type (highest-type type-tags))) 
                 (let ((coerced-args (map (lambda (somearg) 
                                            (successive-rise somearg master-type)) 
                                          args-list))) 
                   (apply-generic op coerced-args)))))))) 
  
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
  
 ;; Bonus! I have noticed that both the `coerce` procedure of 2.82 and the 
 ;; `highest-type` procedure of 2.84 look simillar, which means that they could 
 ;; both be defined in terms of a common abstraction barrier. 
  
 ;; By examing their from we can see that they accpet a list as an arguement, and 
 ;; then run map with a procedure that involves the car on the whole list. 
 ;; Finally it runs a predicate, on the resulting map list, and if it satisfies 
 ;; it, we return the car, if not, we try again with the cdr. 
  
 (define (find-master seq map-op predicate?) 
   (define (find-master-helper remaining) 
     (if (null? remaining) (error "Fail") 
       (let ((master (car remaining))) 
         (let ((mapped-seq (map (lambda (somearg) (map-op master somearg)) 
                                seq))) 
           (if (predicate? mapped-seq) 
             master 
             (find-master-helper (cdr remaining))))))) 
     (find-master-helper seq)) 
  
 ;; Now we can define coerce and highest-type in terms of find-master 
  
 ;; Could be faster if we don't use abstraction, but not as elegent. This is 
 ;; mainly due to the fact that there's no clean to obtain the the master type of 
 ;; a list of arguements without a some sort of tower data structure. This proves 
 ;; the book's point that the `successive-raise` procedure makes apply-generic 
 ;; sipmler. Another point is the fact that coerce args is not an "atmoic" 
 ;; procedure, for it tries to find the master-type AND coerce all the 
 ;; arguements. Unlike `successive-raise` which is atmoic. This means that 
 ;; coerce is not as flexible, nor does it satisfy the unix philosophy. 
  
 (define (coerce args-list) 
   (let ((master-type (find-master  
                        (map type-tag args-list) 
                        (lambda (x y) 
                          (if (eq? x y) (lambda (a) a) 
                            (get-coercion y x))) 
                        has-null?))) 
     (map (lambda (somearg) (get-coercion (type-tag somearg) master-type)) 
          arg-list))) 
  
 (define (highest-type type-list) 
   (find-master type-list 
                (lambda (x y) (above? x y)) 
                (lambda (x) (not (has-false? x))))) 
  
 ;; Since abstraciton is so magical, we can use for other things as well. For 
 ;; instance to find the highest number in a list. 
 (define (highest-number numbers) 
   (find-master numbers 
                (lambda (master somearg) (>= master somearg)) 
                (lambda (x) (not (has-false? x))))) 
  
 ;; This impelentaion of find-master is not as efficient as it could be, because 
 ;; it runs the map-op on each element in the sequence, regardless of the 
 ;; preceding sequence is any valid. However, since all other procedures we have 
 ;; defined are sepereted by the find-master abstraction barrier, we can modify 
 ;; find-master and everything will work out just fine. 
  

  
  
 ;; 修改了meteorgan的程序，当两个数一样时，应该升级其中一个数 
 ;; 以适应父级算法满 足子集，直到没法再升级，也可以避免循环调用 
 ;; assuming that the types are arranged in a simple tower shape. 
 (define (apply-generic op . args) 
   ;; raise s into t, if success, return s; else return #f 
   (define (raise-into s t) 
         (let ((s-type (type-tag s)) 
               (t-type (type-tag t))) 
           (cond ((equal? s-type t-type) ( 
                    (if (get 'raise (list s-type)) 
                      ((get 'raise (list s-type)) (contents s)) 
                       #f 
                    ) 
                  )) 
                 ((get 'raise (list s-type))  
                  (raise-into ((get 'raise (list s-type)) (contents s)) t)) 
                 (else #f)))) 
  
   (let ((type-tags (map type-tag args))) 
         (let ((proc (get op type-tags))) 
           (if proc 
             (apply proc (map contents args)) 
             (if (= (length args) 2) 
               (let ((a1 (car args)) 
                    (a2 (cadr args))) 
                 (cond  
                   ((raise-into a1 a2) 
                    (apply-generic op (raise-into a1 a2) a2)) 
                   ((raise-into a2 a1) 
                    (apply-generic op a1 (raise-into a2 a1))) 
                   (else (error "No method for these types" 
                         (list op type-tags))))) 
            (error "No method for these types" 
                   (list op type-tags))))))) 

One of the problems or limitations of this level (or priority) table solution is that if we are going to add hundreds of different types and if we are to add one type in the midst of the tower, then the table maybe need to be updated to a large extent to accommodate this addition (imagine insert an element in an array, you have to move all elements after it one position to the right).

To maintain the additive principle of our modular design, one possible way is to make the table generated by itself.

Whenever we add a new type and its corresponding `raise` procedure to its direct supertype, we add to the table the result of comparison between this new type and all its supertypes. In this way, to add a new type, the only modification needed to existing modules is to change the `raise` procedure of this new type's direct subtype (it has to be changed anyway) and all the relations of comparison are established automatically and we don't have to worry about running out of level/priority numbers.