(load "types.scm")
(load "test-framework.scm")

(display "Testing type ADTs\n")

(define typevar make-type-variable)
(define is-typevar? type-variable?)

(define num make-number-type)
(define is-num? number-type?)
(define str make-string-type)
(define is-str? string-type?)
(define sym make-symbol-type)
(define is-sym? symbol-type?)
(define bool make-boolean-type)
(define is-bool? boolean-type?)
(define null make-null-type)
(define is-null? null-type?)
(define wd make-word-type)
(define is-wd? word-type?)
(define any make-any-type)
(define is-any? any-type?)
(define undef make-undefined-type)
(define is-undef? undefined-type?)
(define pair make-pair-type)
(define is-pair? pair-type?)
(define vec make-vector-type)
(define is-vec? vector-type?)
(define union make-union-type)
(define is-union? union-type?)
(define func make-function-type)
(define is-func? function-type?)
(define is-normalfunc? normal-function-type?)
(define varfunc make-variable-function-type)
(define is-varfunc? variable-function-type?)

(define (type-test expr . expected)
  (apply general-test "Type constructors and selectors test" expr expected))

(type-test '(determined? (make-determined-type (union (num) (func (num))))) #t)
(type-test '(undetermined? (make-undetermined-type (bool))) #t)
(type-test '(is-typevar? (typevar)) #t)
(type-test '(is-typevar? (typevar (wd))) #t)

(type-test '(determined? (make-undetermined-type (bool))) #f)
(type-test '(undetermined? (make-determined-type (null))) #f)
(type-test '(is-typevar? (make-determined-type (pair (any) (str)))) #f)

(type-test '(number? (type-variable-id (typevar))) #t)
(type-test '(number? (type-variable-id (typevar (pair (any) (any))))) #t)

(type-test '(is-num? (num)) #t)
(type-test '(is-str? (str)) #t)
(type-test '(is-sym? (sym)) #t)
(type-test '(is-bool? (bool)) #t)
(type-test '(is-null? (null)) #t)
(type-test '(is-wd? (wd)) #t)
(type-test '(is-any? (any)) #t)
(type-test '(is-undef? (undef)) #t)
(type-test '(is-pair? (pair (num) (num))) #t)
(type-test '(is-vec? (vec (num))) #t)
(type-test '(is-union? (union (num) (bool))) #t)
(type-test '(is-func? (func (num) (num))) #t)
(type-test '(is-normalfunc? (func (num) (num))) #t)
(type-test '(is-func? (varfunc (num) (num))) #t)
(type-test '(is-varfunc? (varfunc (num) (num))) #t)

(type-test '(is-num? (any)) #f)
(type-test '(is-any? (num)) #f)
(type-test '(is-num? (pair (num) (num))) #f)
(type-test '(is-pair? (undef)) #f)
(type-test '(is-sym? (bool)) #f)
(type-test '(is-bool? (num)) #f)
(type-test '(is-wd? (sym)) #f)
(type-test '(is-str? (wd)) #f)
(type-test '(is-null? (union (null) (pair (num) (num)))) #f)
(type-test '(is-undef? (func (num) (num))) #f)
(type-test '(is-vec? (pair (bool) (bool))) #f)
(type-test '(is-union? (wd)) #f)
(type-test '(is-func? (union (num) (null))) #f)
(type-test '(is-normalfunc? (varfunc (num) (num))) #f)
(type-test '(is-normalfunc? (pair (num) (num))) #f)
(type-test '(is-varfunc? (func (num) (num))) #f)
(type-test '(is-varfunc? (undef)) #f)


(type-test '(range-type (func (sym) (bool) (num)))
	   (num))
(type-test '(domain-types (func (sym) (bool) (num)))
	   (list (sym) (bool)))
(type-test '(domain-types (func (num)))
	   '())

(type-test '(range-type (varfunc (sym) (bool) (num)))
	   (num))
(type-test '(normal-domain-types (varfunc (sym) (bool) (num)))
	   (list (sym)))
(type-test '(extra-domain-type (varfunc (sym) (bool) (num)))
	   (bool))
(type-test '(normal-domain-types (varfunc (bool) (num)))
	   '())

(type-test '(union-types (union (bool) (null)))
	   (list (bool) (null))
	   (list (null) (bool)))

(type-test '(first-pair-type (pair (bool) (any)))
	   (bool))
(type-test '(second-pair-type (pair (bool) (any)))
	   (any))

(type-test '(vector-base-type (vec (wd)))
	   (wd))

; End of tests of constructors and selectors

(end-of-tests)
