;;;; type-errors-structured.scm  -*- Scheme -*-
;;;; Kon Lovett, Jul '18

(module type-errors-structured ()

(import (chicken module))

(export
  error-procedure error-closure
  error-input-port
  error-output-port
  error-list
  error-plist
  error-alist
  error-pair
  error-blob
  error-vector
  error-structure
  error-record
  error-record-type
  error-string)

(import scheme)
(import (chicken base))			; for `include'
(import (chicken type))
(import type-errors-basic)

(: error-procedure (* * #!optional * -> noreturn))
(: error-closure (* * #!optional * -> noreturn))
(: error-input-port (* * #!optional * -> noreturn))
(: error-output-port (* * #!optional * -> noreturn))
(: error-list (* * #!optional * -> noreturn))
(: error-plist (* * #!optional * -> noreturn))
(: error-alist (* * #!optional * -> noreturn))
(: error-pair (* * #!optional * -> noreturn))
(: error-blob (* * #!optional * -> noreturn))
(: error-vector (* * #!optional * -> noreturn))
(: error-string (* * #!optional * -> noreturn))
(: error-structure (* * * #!optional * -> noreturn))
(: error-record (* * * #!optional * -> noreturn))
(: error-record-type (* * * #!optional * -> noreturn))

(define-error-type procedure)
(define error-closure error-procedure)
(define-error-type input-port)
(define-error-type output-port)
(define-error-type list)
(define-error-type plist "property-list")
(define-error-type alist "association-list")
(define-error-type pair)
(define-error-type blob)
(define-error-type vector)
(define-error-type string)

(define (error-structure loc obj tag #!optional argnam)
	(error-argument-type loc obj (make-tagged-kind-message 'structure tag) argnam) )

(define (error-record loc obj tag #!optional argnam)
	(error-argument-type loc obj (make-tagged-kind-message 'record tag) argnam) )

(define (error-record-type loc obj tag #!optional argnam)
	(error-argument-type loc obj (make-tagged-kind-message 'record-type tag) argnam) )

) ;module type-errors-structured