;;;; check-errors.builtins.scm  -*- Scheme -*-

(declare
  (bound-to-procedure
    ##sys#check-list ##sys#check-pair ##sys#check-vector ##sys#check-boolean
    ##sys#check-char ##sys#check-exact ##sys#check-inexact ##sys#check-number
    ##sys#check-integer ##sys#check-real ##sys#check-fixnum ##sys#check-string
    ##sys#check-symbol ##sys#check-keyword ##sys#check-output-port
    ##sys#check-input-port ##sys#check-locative ##sys#check-closure
    ##sys#check-byte-vector ##sys#check-blob ##sys#check-structure
    ##sys#check-exact-integer ##sys#check-exact-uinteger
    ##sys#check-range))

(module (check-errors sys)

(;export
  ;
  check-list check-pair check-vector check-boolean check-char check-exact
  check-inexact check-number check-integer check-real check-fixnum
  check-string check-symbol check-keyword check-output-port check-input-port
  check-locative check-closure check-procedure check-byte-vector check-blob
  check-structure
  ;
  check-exact-integer check-exact-unsigned-integer
  check-fixnum-in-range)

(import scheme
  (chicken base)
  (chicken type))

(define-type real (or integer ratnum float))

(: check-list ((or false symbol) * -> list))
(: check-pair ((or false symbol) * -> pair))
(: check-vector ((or false symbol) * -> vector))
(: check-boolean ((or false symbol) * -> boolean))
(: check-char ((or false symbol) * -> char))
(: check-exact ((or false symbol) * -> number))
(: check-inexact ((or false symbol) * -> number))
(: check-number ((or false symbol) * -> number))
(: check-integer ((or false symbol) * -> integer))
(: check-real ((or false symbol) * -> real))
(: check-fixnum ((or false symbol) * -> fixnum))
(: check-string ((or false symbol) * -> string))
(: check-symbol ((or false symbol) * -> symbol))
(: check-keyword ((or false symbol) * -> keyword))
(: check-output-port ((or false symbol) * -> output-port))
(: check-input-port ((or false symbol) * -> input-port))
(: check-locative ((or false symbol) * -> locative))
(: check-closure ((or false symbol) * -> procedure))
(: check-procedure ((or false symbol) * -> procedure))
(: check-byte-vector ((or false symbol) * -> blob))
(: check-blob ((or false symbol) * -> blob))

(: check-structure ((or false symbol) 'a * -> 'a))

(: check-exact-integer ((or false symbol) * -> integer))
(: check-exact-unsigned-integer ((or false symbol) * -> integer))

(: check-fixnum-in-range ((or false symbol) * fixnum fixnum -> fixnum))

(define (check-list loc obj) (##sys#check-list obj loc) obj)
(define (check-pair loc obj) (##sys#check-pair obj loc) obj)
(define (check-vector loc obj) (##sys#check-vector obj loc) obj)
(define (check-boolean loc obj) (##sys#check-boolean obj loc) obj)
(define (check-char loc obj) (##sys#check-char obj loc) obj)
(define (check-exact loc obj) (##sys#check-exact obj loc) obj)
(define (check-inexact loc obj) (##sys#check-inexact obj loc) obj)
(define (check-number loc obj) (##sys#check-number obj loc) obj)
(define (check-integer loc obj) (##sys#check-integer obj loc) obj)
(define (check-real loc obj) (##sys#check-real obj loc) obj)
(define (check-fixnum loc obj) (##sys#check-fixnum obj loc) obj)
(define (check-string loc obj) (##sys#check-string obj loc) obj)
(define (check-symbol loc obj) (##sys#check-symbol obj loc) obj)
(define (check-keyword loc obj) (##sys#check-keyword obj loc) obj)
(define (check-output-port loc obj) (##sys#check-output-port obj loc) obj)
(define (check-input-port loc obj) (##sys#check-input-port obj loc) obj)
(define (check-locative loc obj) (##sys#check-locative obj loc) obj)
(define (check-closure loc obj) (##sys#check-closure obj loc) obj)
(define check-procedure check-closure)
(define (check-byte-vector loc obj) (##sys#check-byte-vector obj loc) obj)
(define (check-blob loc obj) (##sys#check-blob obj loc) obj)

;NOTE the module must export the tag as a binding, not all do!
(define (check-structure loc obj tag) (##sys#check-structure obj tag loc) obj)

(define (check-exact-integer loc obj) (##sys#check-exact-integer obj loc) obj)
(define (check-exact-unsigned-integer loc obj) (##sys#check-exact-uinteger obj loc) obj)

(define (check-fixnum-in-range loc obj from to) (##sys#check-range obj from to loc) obj)

) ;module (check-errors sys)