#lang typed-scheme

(require (for-syntax scheme)
         (for-syntax syntax/struct))
(provide define-constant define-datatype)

(define-syntax (define-constant stx)
  (syntax-case stx (:)
    [(_ [value : Type])
     (with-syntax ([Private (syntax-local-introduce #'Type)])
       (with-syntax ([(struct:Private make-Private Private?)
                      (build-struct-names #'Private '() #t #t #'Type)]
                     [(struct:Type make-Type Type?)
                      (build-struct-names #'Type '() #t #t #'Type)])
         #'(begin
             (define-struct: Private ())
             (define-type-alias Type Private)
             (: value Type)
             (define value (make-Private))
             (: Type? (Any -> Boolean))
             (define Type? Private?))))]
    [(_ clause1 clauses ...)
     #'(begin
         (define-constant clause1)
         (define-constant clauses ...))]))

(define-syntax (define-datatype stx)
  (syntax-case stx ()
    [(_ Type [Variant Variant-clause ...] ...)
     #'(begin
         (define-variant Variant Variant-clause ...) ...
         (define-type-alias Type (U Variant ...)))]))

(define-syntax define-variant
  (syntax-rules ()
    [(_ Variant #:constant constant)
     (define-constant [constant : Variant])]
    [(_ Variant (fields ...))
     (define-struct: Variant (fields ...))]))