src/sicp/ex2_78.rkt

   1 #lang racket
   2
   3 ;; modify type-tag, contents, and attach-tag so that primitive numbers need not
   4 ;; be tagged.
   5
   6 (define (type-tag datum)
   7   (cond
   8     [(pair? datum) (car datum)]
   9     [(number? datum) 'scheme-number]
  10     [else
  11      (error "Bad tagged datum -- TYPE-TAG" datum)]))
  12
  13 (define (contents datum)
  14   (cond
  15     [(pair? datum) (cdr datum)]
  16     [(number? datum) datum]
  17     [else
  18      (error "Bad tagged datum -- CONTENTS" datum)]))
  19
  20 (define (attach-tag type-tag contents)
  21   (if (number? contents)
  22       contents
  23       (cons type-tag contents)))