;;; $Id: ex3-7-expressed-value.txt,v 1.4 2006/03/07 02:53:17 leavens Exp $

;;; The following replaces the Expressed-Value section in ch3-1.scm,
;;; to add lists to the domain of Expresed-Value.  (See exercise 3.7.)

;;;;;;;;; Expressed-Value ;;;;;;;;;;;;;;;;;;;;;;;;;

;; upcasts
(deftype number->expressed (-> (number) Expressed-Value))
(deftype list->expressed (-> ((list-of Expressed-Value)) Expressed-Value))

;; downcasts
(deftype expressed->number (-> (Expressed-Value) number))
(deftype expressed->list (-> (Expressed-Value) (list-of Expressed-Value)))

;; debugging
(deftype expressed->printable (-> (Expressed-Value) datum))

;; tests
(deftype number->expressed? (-> (Expressed-Value) boolean))
(deftype list->expressed? (-> (Expressed-Value) boolean))

(define-datatype Expressed-Value expval?
  (number->expressed (num number?))
  (list->expressed (lst (list-of expval?))))

(define expressed->number
  (lambda (ev)
    (cases Expressed-Value ev
      (number->expressed (num) num)
      (else (error "expressed->number passed non-number argument: " ev)))))

(define expressed->list
  (lambda (ev)
    (cases Expressed-Value ev
      (list->expressed (lst) lst)
      (else (error "expressed->list passed non-list argument: " ev)))))

(define expressed->printable
  (lambda (ev)
    (cases Expressed-Value ev
      (number->expressed (num) (has-type datum num))
      (list->expressed (lst)
         (has-type datum (map expressed->printable lst))))))

(define number->expressed?
  (lambda (ev)
    (cases Expressed-Value ev
      (number->expressed (num) #t)
      (else #f))))

(define list->expressed?
  (lambda (ev)
    (cases Expressed-Value ev
      (list->expressed (lst) #t)
      (else #f))))