;;; $Id: phone-number-mod.scm,v 1.2 2006/01/05 22:24:09 leavens Exp $
;;;
;;; <phone-number> ::=
;;;     (<exchange> . <subscriber>)     "phone-number (exchange subscriber)"
;;; <exchange> ::= <number>             "exchange (number)"
;;; <subscriber> ::= <number>           "subscriber (number)"

(module phone-number-mod (lib "typedscm.ss" "typedscm")

(provide phone-number? exchange? subscriber? phone-number exchange subscriber
         phone-number->exchange phone-number->subscriber exchange->number 
         subscriber->number parse-phone-number parse-exchange parse-subscriber)

;; type predicate
(deftype phone-number? (type-predicate-for phone-number))
(deftype exchange? (type-predicate-for exchange))
(deftype subscriber? (type-predicate-for subscriber))

;; constructors
(deftype phone-number (-> (exchange subscriber) phone-number))
(deftype exchange (-> (number) exchange))
(deftype subscriber (-> (number) subscriber))

;; observers
(deftype phone-number->exchange (-> (phone-number) exchange))
(deftype phone-number->subscriber (-> (phone-number) subscriber))
(deftype exchange->number (-> (exchange) number))
(deftype subscriber->number (-> (subscriber) number))

;; parsing/bless input correctness
(deftype parse-phone-number (-> (datum) phone-number))
(deftype parse-exchange (-> (datum) exchange))
(deftype parse-subscriber (-> (datum) subscriber))

(defrep (phone-number (pair-of number number))
        (exchange number)
        (subscriber number))

(define phone-number?
  (lambda (d)
    (and (pair? d)
         (exchange? (car d))
         (subscriber? (has-type datum (cdr d))))))

(define exchange?
  (lambda (d)
    (and (number? d) (<= 0 d) (<= d 1000))))

(define subscriber?
  (lambda (d)
    (and (number? d) (<= 0 d) (<= d 10000))))

(define phone-number
    (has-type (-> (number number) (pair-of number number))
              cons))

(define exchange
  (lambda (n)
    (if (exchange? n)
        n
        (error "exchange: bad number: " n))))

(define subscriber
  (lambda (n)
    (if (subscriber? n)
        n
        (error "subscriber: bad number: " n))))

(define phone-number->exchange
  car)

(define phone-number->subscriber
  cdr)

(define exchange->number
  (lambda (ex)
    ex))

(define subscriber->number
  (lambda (sub)
    sub))

(define parse-phone-number
  (lambda (d)
    (test-type
     (pair-of number? number?)
     (cond
       ((pair? d) (phone-number
                   (parse-exchange (car d))
                   (parse-subscriber (cdr d))))
       (else (error "parse-phone-number: bad syntax:" d))))))

(define parse-exchange
  (lambda (d)
    (test-type
     number?
     (cond
       ((exchange? d) d)
       (else (error "parse-exchange: bad syntax:" d))))))

(define parse-subscriber
  (lambda (d)
    (test-type
      number?
      (cond
       ((subscriber? d) d)
       (else (error "parse-subscriber: bad syntax:" d))))))

) ; end module