;; (require "srfi-137")

(test "Type payload"
      'reia
      (let-values
	  (((reia-payload
	     make-reia reia?
	     reia-ref
	     make-reia-subtype)
	    (make-type 'reia)))
	(reia-payload)))

(test "Disjoint procedures"
      #t
      (let-values
	  (((reia-payload1 . reia1*)
	    (make-type 'reia))
	   ((reia-payload2 . reia2*)
	    (make-type 'reia)))
	(not (eq? reia-payload1 reia-payload2))))

;; "Type predicates and subtypes"
      
(let*-values
    (((reia-payload
       make-reia
       reia?
       reia-ref
       make-reia-subtype)
      (make-type 'reia))
     ((daughter-payload
       make-daughter
       daughter?
       daughter-ref
       make-daughter-subtype)
      (make-reia-subtype 'daughter))
     ((son-payload
       make-son
       son?
       son-ref
       make-son-subtype)
      (make-reia-subtype 'son))
     ((grand-daughter-payload
       make-grand-daughter
       grand-daughter?
       grand-daughter-ref
       make-grand-daughter-subtype)
      (make-daughter-subtype 'grand-daughter)))

  (test "Instance fulfills predicate"
        #t
	(reia? (make-reia #f)))
  
  (test "Instance of subtype fulfills predicate"
        #t
	(reia? (make-daughter #f)))
  
  (test "Instance of supertype does not fulfill predicate"
        #t
	(not (daughter? (make-reia #f))))
  
  (test "Instance of peertype does not fulfill predicate"
        #t
	(not (son? (make-daughter #f))))
  
  (test "Instance of indirect subtype fulfills predicate"
        #t
	(reia? (make-grand-daughter #f))))
	   

(test "Instance payload"
      'payload
      (let-values
	  (((reia-payload
	     make-reia
	     reia?
	     reia-ref
	     make-reia-subtype)
	    (make-type 'reia)))
	(reia-ref (make-reia 'payload))))
