(module type-annotation mzscheme
(require "types.ss" "parse-type.ss" "tc-utils.ss")
(provide (all-defined))
(define type-label-symbol 'type-label)
(define type-ascrip-symbol 'type-ascription)
(define (type-annotation stx)
(cond [(syntax-property stx type-label-symbol) => (lambda (prop) (parse-type prop))]
[(syntax-property stx type-ascrip-symbol) => (lambda (prop) (parse-type prop))]
[else #f]))
(define (get-type stx)
(parameterize
([current-orig-stx stx])
(cond
[(type-annotation stx) => (lambda (x) x)]
[(not (syntax-original? stx))
(tc-error "untyped var: ~a~n" (syntax-e stx))]
[else
(tc-error "no type information on variable ~a" (syntax-e stx))])))
(define (get-type/infer stxs e-type)
(let/ec exit
(map (lambda (stx)
(cond
[(type-annotation stx)]
[else (exit (if (values-ty? e-type) (values-ty-types e-type) (list e-type)))]))
stxs)))
)