;; Copyright (C) 2008-2013 Tommi Höynälänmaa
;; Distributed under GNU General Public License version 3,
;; see file doc/GPL-3.



;; *** Finalization of builtin types ***


(import (rnrs exceptions)
	(srfi srfi-1)
	(th-scheme-utilities stdutils)
	(th-scheme-utilities hrecord))


(define tt-type-list (make-tt-uniform-list tt-type))
(define tt-tvar-list
  (make-tt-uniform-list tc-type-variable))
(define tt-gen-type (make-union-expression0
		     (list tt-type tc-type-variable)))
(define tt-gen-type-list
  (make-tt-uniform-list tt-gen-type))
(define tt-module-name (make-union-expression0
			(list
			 (make-tt-uniform-list tc-symbol)
			 tc-symbol)))
(define tt-signature-member
  (make-tpci-pair tc-object tt-type))
(define tt-signature-member-list
  (make-tt-uniform-list tt-signature-member))
(define tt-field-list (make-tt-uniform-list tc-field))
(define tt-maybe-type (make-union-expression0
		       (list tt-type tc-nil)))
(define tt-maybe-procedure (make-union-expression0
			    (list tc-procedure tc-nil)))
(define tt-maybe-symbol (make-union-expression0
			 (list tc-symbol tc-nil)))


(set-field-desc-type! tc-class-fields 'l-fields tt-field-list)
(set-field-desc-type! tc-class-fields 'l-all-fields tt-field-list)
(set-field-desc-type! tc-class-fields 'type-constructor tt-maybe-type)
(set-field-desc-type! tc-class-fields 'proc-constructor tt-maybe-procedure)
(set-field-desc-type! tc-class-fields 'module tt-module-name)
(set-field-desc-type! t-param-class-fields 'l-tvars tt-tvar-list)
(set-field-desc-type! t-param-class-fields 'l-instance-fields tt-field-list)
(set-field-desc-type! t-param-class-fields 'l-instance-all-fields tt-field-list)
(set-field-desc-type! t-param-class-fields 'proc-instance-zero
		      tt-maybe-procedure)
(set-field-desc-type! t-param-logical-type-fields 'l-tvars tt-tvar-list)
(set-field-desc-type! t-param-logical-type-fields 'x-value-expr tt-gen-type)
(set-field-desc-type! tpc-param-proc-fields 'l-tvars tt-tvar-list)
(set-field-desc-type! tpc-param-proc-fields 'type-contents tt-gen-type)
(set-field-desc-type! t-param-proc-fields 's-name tt-maybe-symbol)
(set-field-desc-type! param-class-inst-fields 'l-tvar-values tt-gen-type-list)
(set-field-desc-type! param-logical-type-inst-fields 'l-tvar-values
		      tt-gen-type-list)
(set-field-desc-type! union-fields 'l-member-types tt-gen-type-list)
(set-field-desc-type! tmt-procedure-class-fields 'type-arglist tt-gen-type)
(set-field-desc-type! tmt-procedure-class-fields 'type-result tt-gen-type)
(set-field-desc-type! tpc-simple-proc-class-fields 'type-arglist tt-gen-type)
(set-field-desc-type! tpc-simple-proc-class-fields 'type-result tt-gen-type)
(set-field-desc-type! tc-signature-fields 'l-members tt-signature-member-list)


