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


; *** Built-in definitions ***


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


(define (add-builtin-def! var name)
 (begin (add-symbol! global-builtins-symtbl name var) 0))

 
(add-builtin-def! tc-object '<object>)
(add-builtin-def! tc-class '<class>)
(add-builtin-def! tc-logical-type '<logical-type>)
(add-builtin-def! tc-boolean '<boolean>)
(add-builtin-def! tc-nil '<null>)
(add-builtin-def! tc-real '<real>)
(add-builtin-def! tc-integer '<integer>)
(add-builtin-def! tc-char '<character>)
(add-builtin-def! tc-symbol '<symbol>)
(add-builtin-def! tc-string '<string>)


(add-builtin-def! tc-type-variable '<type-variable>)
(add-builtin-def! tc-field '<field>)

(add-builtin-def! tt-none '<none>)

(add-builtin-def! tt-type '<type>)


(add-builtin-def! t-param-class '<param-class>)
(add-builtin-def! tmt-union ':union)
(add-builtin-def! tc-procedure '<procedure>)
(add-builtin-def! tmt-procedure ':procedure)
(add-builtin-def! tpc-simple-proc ':simple-proc)
(add-builtin-def! tmc-gen-proc ':gen-proc)
(add-builtin-def! tpc-pair ':pair)
(add-builtin-def! tpc-param-proc ':param-proc)
(add-builtin-def! tpc-vector ':vector)
(add-builtin-def! tpc-mutable-vector ':mutable-vector)
(add-builtin-def! tpc-value-vector ':value-vector)
(add-builtin-def! tpc-mutable-value-vector ':mutable-value-vector)
(add-builtin-def! t-param-logical-type '<param-logical-type>)
(add-builtin-def! tplt-uniform-list ':uniform-list)
(add-builtin-def! tc-signature '<signature>)
(add-builtin-def! t-param-signature '<param-signature>)

(add-builtin-def! tc-type-loop '<type-loop>)
(add-builtin-def! tc-type-join '<type-join>)
(add-builtin-def! tc-type-list '<type-list>)
(add-builtin-def! tc-splice '<splice>)
(add-builtin-def! tc-rest '<rest>)


(add-symbol! global-builtins-symtbl 'null
	     (make-target-object
	      tc-nil
	      #t #t
	      (alloc-builtin-loc 'nil)
	      #t #f
	      '() '()))


(add-symbol! global-builtins-symtbl 'this
	     to-this)


(define (make-t-gen-proc t-name)
  (make-new-gen-proc (alloc-builtin-loc t-name) #f))


(add-symbol! global-builtins-symtbl 'equal-values? tp-equal-values)


(add-symbol! global-builtins-symtbl 'equal-objects? tp-equal-objects)


(add-symbol! global-builtins-symtbl 'equal-contents? tp-equal-contents)


(add-symbol! global-builtins-symtbl 'field-ref tp-field-ref)


(add-symbol! global-builtins-symtbl 'field-set! tp-field-set)


(add-symbol! global-builtins-symtbl 'class-of tp-class-of)


(add-symbol! global-builtins-symtbl 'is-subtype? tp-is-subtype)


(add-symbol! global-builtins-symtbl 'is-instance? tp-is-instance)


(add-symbol! global-builtins-symtbl 'tuple-ref tp-tuple-ref)


(add-symbol! global-builtins-symtbl 'apply tp-apply)


(add-symbol! global-builtins-symtbl 'apply-nonpure tp-apply-nonpure)


(add-symbol! global-builtins-symtbl
	     'tuple-type-with-tail
	     tp-tuple-type-with-tail)


(add-symbol! global-builtins-symtbl 'make-vector
	     tp-make-vector)


(add-symbol! global-builtins-symtbl 'make-mutable-vector
	     tp-make-mutable-vector)


(add-symbol! global-builtins-symtbl 'make-value-vector
	     tp-make-value-vector)


(add-symbol! global-builtins-symtbl 'make-mutable-value-vector
	     tp-make-mutable-value-vector)


(add-symbol! global-builtins-symtbl 'vector
	     tp-vector)


(add-symbol! global-builtins-symtbl 'mutable-vector
	     tp-mutable-vector)


(add-symbol! global-builtins-symtbl 'value-vector
	     tp-value-vector)


(add-symbol! global-builtins-symtbl 'mutable-value-vector
	     tp-mutable-value-vector)


(add-symbol! global-builtins-symtbl 'cast-vector
	     tp-cast-vector)


(add-symbol! global-builtins-symtbl 'cast-mutable-vector
	     tp-cast-mutable-vector)


(add-symbol! global-builtins-symtbl 'cast-value-vector
	     tp-cast-value-vector)


(add-symbol! global-builtins-symtbl 'cast-mutable-value-vector
	     tp-cast-mutable-value-vector)


(add-symbol! global-builtins-symtbl 'cast-vector-metaclass
	     tp-cast-vector-metaclass)


(add-symbol! global-builtins-symtbl 'cast-mutable-vector-metaclass
	     tp-cast-mutable-vector-metaclass)


(add-symbol! global-builtins-symtbl 'cast-value-vector-metaclass
	     tp-cast-value-vector-metaclass)


(add-symbol! global-builtins-symtbl 'cast-mutable-value-vector-metaclass
	     tp-cast-mutable-value-vector-metaclass)

