sicp-solutions/exercise-2.73-preparation-02/tagged-data.scm

(library (tagged-data)
  (export type-tag
          contents
          attach-tag)
  (import (except (rnrs base)
                  error
                  map)
          (only (guile)
                lambda* λ
                simple-format)
          (ice-9 exceptions)
          (custom-exceptions))

  ;;; data abstraction layer over tagged data

  ;;; ACCESSORS for type tag
  (define type-tag
    (λ (datum)
      (if (pair? datum)
          (car datum)
          (raise-exception
           (make-exception
            (make-inappropriate-value-exception datum)
            (make-exception-with-message "datum must be a tagged datum, a pair")
            (make-exception-with-irritants (list datum))
            (make-exception-with-origin 'type-tag))))))

  (define contents
    (λ (datum)
      (simple-format #t "in contents: datum: ~a\n" datum)
      (if (pair? datum)
          (cdr datum)
          (raise-exception
           (make-exception
            (make-inappropriate-value-exception datum)
            (make-exception-with-message "datum must be a pair of tag and content")
            (make-exception-with-irritants (list datum))
            (make-exception-with-origin 'contents))))))

  ;;; SETTER for type tag
  (define attach-tag
    (λ (tag contents)
      (cons tag contents))))