(module type-def-structs mzscheme
(require (lib "unit.ss") (lib "struct.ss") "signatures.ss")
(provide (all-defined))
(define-syntax defstructs/sig/unit
(syntax-rules (define-struct/properties)
[(_ signame unitname (imps ...)
def
(define-struct/properties nm1 (flds1 ...) props #f)
(define-struct/properties (nm par) (flds ...) () #f) ...)
(begin
(define-signature signame
((struct nm1 (flds1 ...))
(struct nm (flds ...)) ...))
(define-unit unitname
(import imps ...)
(export signame)
def
(define-struct/properties nm1 (flds1 ...) props #f)
(define-struct (nm par) (flds ...) #f) ...))]))
(defstructs/sig/unit type-structs^ type-structs@
(type-printer^)
(define (print-type* a b c) (print-type a b c))
(define-struct/properties type ()
([prop:custom-write print-type*])
#f)
(define-struct/properties (pair-ty type) (car cdr) () #f)
(define-struct/properties (base-type type) (name)
([prop:custom-write (lambda (c port write?)
(fprintf port "~a" (base-type-name c)))])
#f)
(define-struct/properties (struct-ty type) (name parent flds tvars)
([prop:custom-write (lambda (c port write?)
(fprintf port "#<struct:~a>" (struct-ty-name c)))])
#f)
(define-struct/properties (pred-ty type) (type)
([prop:custom-write (lambda (c port write?)
(fprintf port "(pred ~a)" (pred-ty-type c)))])
#f)
(define-struct/properties (arr type) (dom rng rest)
([prop:custom-write (lambda (c port write?)
(fprintf port "(")
(for-each (lambda (t) (fprintf port "~a " t)) (append (arr-dom c) (arr-rest c)))
(fprintf port "-> ~a)" (arr-rng c)))])
#f)
(define-struct/properties (funty type) (arities)
([prop:custom-write (lambda (c port write?)
(let ([arities (funty-arities c)])
(if (= 1 (length arities))
(fprintf port "~a" (car arities))
(fprintf port "#<case-lambda:~a>"
(funty-arities c)))))])
#f)
(define-struct/properties (value type) (v)
([prop:custom-write (lambda (c port write?)
(fprintf port "~a" (value-v c)))])
#f)
(define-struct/properties (lst type) (elem)
([prop:custom-write (lambda (c port write?)
(fprintf port "[~a]" (lst-elem c)))])
#f)
(define-struct/properties (vec type) (elem)
([prop:custom-write (lambda (c port write?)
(fprintf port "#[~a]" (vec-elem c)))])
#f)
(define-struct/properties (lst/elements type) (car cdr)
([prop:custom-write (lambda (c port write?)
(fprintf port "(cons ~a ~a)" (lst/elements-car c) (lst/elements-cdr c)))])
#f)
(define-struct/properties (union type) (elems)
([prop:custom-write (lambda (c port write?)
(fprintf port "~a" (cons 'Un (set:elements (union-elems c)))))])
#f)
(define-struct/properties (univ type) ()
([prop:custom-write (lambda (c port write?)
(fprintf port "Univ"))])
#f)
(define-struct/properties (dynamic type) ()
([prop:custom-write (lambda (c port write?)
(fprintf port "*"))])
#f)
(define-struct/properties (tvar type) (name)
([prop:custom-write (lambda (c port write?)
(fprintf port "<~a>" (tvar-name c)))])
#f)
(define-struct/properties (poly type) (var type)
([prop:custom-write (lambda (c port write?)
(fprintf port "ALL ~a. ~a" (poly-var c) (poly-type c)))])
#f)
(define-struct/properties (mu type) (var type)
([prop:custom-write (lambda (c port write?)
(fprintf port "u~a.~a" (mu-var c) (mu-type c)))])
#f)
(define-struct/properties (values-ty type) (types)
()
#f))
)