suzanne.soy/macrotypes
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

split out a define-binding-type from define-type-constructor

Browse Source 
- document #:arg-variances and variances; #:arr
- fixes #36
- start to split type constructor macro into (not working yet)
  - ty-: expands to expanded type representation
  - ty: performs kindchecking and expands to ty-
  - this makes it easier for programmers to implement their own kind
    system, but still get some turnstile conveniences like pat expanders
This commit is contained in:
Stephen Chang 2016-10-13 15:20:30 -04:00
parent 8a7d487e14
commit 1c0fa751d6
18 changed files with 338 additions and 108 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
macrotypes/examples/exist.rkt
View File

@ -11,7 +11,7 @@
(provide ∃ pack open)
(define-type-constructor ∃ #:bvs = 1)
(define-binding-type ∃ #:bvs = 1)
(define-typed-syntax pack
[(_ (τ:type e) as ∃τ:type)

2
macrotypes/examples/fomega.rkt
View File

@ -53,7 +53,7 @@
(define-kind-constructor ⇒ #:arity >= 1)
(define-kind-constructor ∀★ #:arity >= 0)
(define-type-constructor ∀ #:bvs >= 0 #:arr ∀★)
(define-binding-type ∀ #:bvs >= 0 #:arr ∀★)
;; alternative: normalize before type=?
; but then also need to normalize in current-promote

2
macrotypes/examples/fomega2.rkt
View File

@ -44,7 +44,7 @@
(define-base-kind ★)
(define-kind-constructor ∀★ #:arity >= 0)
(define-type-constructor ∀ #:bvs >= 0 #:arr ∀★)
(define-binding-type ∀ #:bvs >= 0 #:arr ∀★)
;; alternative: normalize before type=?
; but then also need to normalize in current-promote

2
macrotypes/examples/stlc+rec-iso.rkt
View File

@ -14,7 +14,7 @@
(provide μ unfld fld)
(define-type-constructor μ #:bvs = 1)
(define-binding-type μ #:bvs = 1)
(define-typed-syntax unfld
[(_ τ:type-ann e)

2
macrotypes/examples/sysf.rkt
View File

@ -11,7 +11,7 @@
(provide (type-out ∀) Λ inst)
(define-type-constructor ∀ #:bvs >= 0)
(define-binding-type ∀)
(define-typed-syntax Λ
[(_ (tv:id ...) e)

36
macrotypes/examples/tests/general-tests.rkt Normal file
View File

@ -0,0 +1,36 @@
#lang racket
(module+ test
(require "../../typecheck.rkt"
"rackunit-typechecking.rkt")
;; check ordering of type constructor args
(check-stx-err
(define-type-constructor #:a)
#:with-msg "expected identifier")
(check-stx-err
(define-type-constructor name #:a)
#:with-msg "expected one of these literals")
(define-type-constructor -> #:arity > 0)
(define-binding-type mu #:arity = 1 #:bvs = 1)
(define-binding-type forall #:bvs = 1 #:arity = 1)
(define-binding-type exist #:no-attach-kind #:bvs = 1 #:arity = 1)
(define-binding-type exist2 #:bvs = 1 #:arity = 1 #:no-attach-kind)
(define-binding-type exist3 #:bvs = 1 #:no-attach-kind #:arity = 1)
(check-stx-err
(define-binding-type exist4 #:bvs = 1 #:no-attach- #:arity = 1)
#:with-msg "expected one of these literals")
(define-type-constructor exist5)
(define-binding-type exist7)
(check-stx-err
(define-binding-type exist6 #:bvs 1)
#:with-msg "expected more terms")
(check-stx-err
(define-binding-type exist6 #:bvs = 1 #:bvs = 1)
#:with-msg "bad syntax") ; TODO: how to improve this?
)

3
macrotypes/examples/tests/run-all-tests.rkt
View File

@ -1,5 +1,8 @@
#lang racket
;; gen
(require "general-tests.rkt")
;; stlc and extensions
(require "stlc-tests.rkt")
(require "stlc+lit-tests.rkt")

1
macrotypes/examples/tests/stlc+lit-tests.rkt
View File

@ -59,4 +59,3 @@
(typecheck-fail (λ ([x : 1]) x) #:with-msg "not a valid type")
(typecheck-fail (λ ([x : (+ 1 2)]) x) #:with-msg "not a valid type")
(typecheck-fail (λ ([x : (λ ([y : Int]) y)]) x) #:with-msg "not a valid type")

303
macrotypes/typecheck.rkt
View File

@ -61,7 +61,9 @@
(begin-for-syntax
(define (mk-? id) (format-id id "~a?" id))
(define (mk-- id) (format-id id "~a-" id))
(define (mk-~ id) (format-id id "~~~a" id))
(define (mk-#% id) (format-id id "#%~a" id))
(define-for-syntax (mk-? id) (format-id id "~a?" id))
(define-for-syntax (mk-~ id) (format-id id "~~~a" id))
;; drop-file-ext : String -> String
@ -597,95 +599,199 @@
(define-syntax define-basic-checked-id-stx
(syntax-parser #:datum-literals (:)
[(_ τ:id : kind)
#:with #%tag (format-id #'kind "#%~a" #'kind)
#:with τ? (mk-? #'τ)
#:with τ-internal (generate-temporary #'τ)
#:with τ-expander (mk-~ #'τ)
#:with τ-internal (generate-temporary #'τ)
#`(begin
(begin-for-syntax
(define (τ? t)
(syntax-parse t
[((~literal #%plain-app) (~literal τ-internal)) #t][_ #f]))
(define (inferτ+erase e)
(syntax-parse (infer+erase e) #:context e
[(e- e_τ)
#:fail-unless (τ? #'e_τ)
(format
"~a (~a:~a): Expected expression ~v to have type ~a, got: ~a"
(syntax-source e) (syntax-line e) (syntax-column e)
(syntax->datum e) (type->str #'τ) (type->str #'e_τ))
#'e-]))
[((~literal #%plain-app) (~literal τ-internal)) #t]
[_ #f]))
(define-syntax τ-expander
(pattern-expander
(syntax-parser
[ty:id #'((~literal #%plain-app) (~literal τ-internal))]
[(_ . rst) #'(((~literal #%plain-app) (~literal τ-internal)) . rst)]))))
[:id #'((~literal #%plain-app) (~literal τ-internal))]
; - this case used by ⇑, TODO: remove this case?
; - but it's also needed when matching a list of types,
; e.g., in stlc+sub (~Nat τ)
[(_ . rst)
#'(((~literal #%plain-app) (~literal τ-internal)) . rst)]))))
(define τ-internal
(λ () (raise (exn:fail:type:runtime
(format "~a: Cannot use ~a at run time" 'τ 'kind)
(current-continuation-marks)))))
(define-syntax τ
(syntax-parser
[(~var _ id)
[:id
(add-orig
(assign-type
(syntax/loc this-syntax (τ-internal)) #'#%tag) #'τ)])))]))
(syntax/loc this-syntax (τ-internal))
#'kind)
#'τ)])))]))
; I use identifiers "τ" and "kind" but this form is not restricted to them.
; E.g., τ can be #'★ and kind can be #'#%kind (★'s type)
;; The def uses pattern vars "τ" and "kind" but this form is not restricted to
;; only types and kinds, eg, τ can be #'★ and kind can be #'#%kind (★'s type)
(define-syntax (define-basic-checked-stx stx)
(syntax-parse stx #:datum-literals (:)
[(_ τ:id : kind
(~optional
(~seq #:arity op n:exact-nonnegative-integer)
#:defaults ([op #'=] [n #'1]))
(~optional (~seq #:bvs (~and (~parse has-bvs? #'#t) bvs-op)
bvs-n:exact-nonnegative-integer)
#:defaults ([bvs-op #'=][bvs-n #'0]))
(~optional (~seq #:arr (~and (~parse has-annotations? #'#t) tycon))
#:defaults ([tycon #'void]))
(~optional (~seq #:arg-variances arg-variances-stx:expr)
#:defaults ([arg-variances-stx
#`(λ (stx-id) (for/list ([arg (in-list (stx->list (stx-cdr stx-id)))])
invariant))]))
(~optional (~seq #:extra-info extra-info)
#:defaults ([extra-info #'void])))
#:with #%kind (format-id #'kind "#%~a" #'kind)
#:with τ-internal (generate-temporary #'τ)
(~or
(~optional (~and #:no-attach-kind (~parse no-attach-kind? #'#t)))
(~optional
(~seq #:arity op n:exact-nonnegative-integer)
#:defaults ([op #'=] [n #'1]))
(~optional (~seq #:arg-variances arg-variances-stx:expr)
#:defaults ([arg-variances-stx
#`(λ (stx-id)
(for/list ([arg (in-list (stx->list (stx-cdr stx-id)))])
invariant))]))
(~optional (~seq #:extra-info extra-info)
#:defaults ([extra-info #'void]))) ...)
#:with #%kind (mk-#% #'kind)
#:with τ? (mk-? #'τ)
#:with τ- (mk-- #'τ)
#:with τ-expander (mk-~ #'τ)
#:with τ-internal (generate-temporary #'τ)
#`(begin
(begin-for-syntax
(define-syntax τ-expander
(pattern-expander
(syntax-parser
[(_ . pat)
#:with expanded-τ (generate-temporary)
#'(~and expanded-τ
(~Any
(~literal/else τ-internal
(format "Expected ~a type, got: ~a"
'τ (type->str #'expanded-τ))
#'expanded-τ)
. pat))])))
(define arg-variances arg-variances-stx)
(define (τ? t)
(syntax-parse t
[(~Any (~literal τ-internal) . _) #t]
[_ #f])))
(define τ-internal
(λ _ (raise (exn:fail:type:runtime
(format "~a: Cannot use ~a at run time" 'τ 'kind)
(current-continuation-marks)))))
; τ- is an internal constructor:
; - it does not validate inputs and does not attach a kind,
; ie, it won't be recognized as a valid type unless a kind
; system is implemented on top
; - the τ constructor implements a default kind system but τ-
; is available if the programmer wants to implement their own
(define-syntax (τ- stx)
(syntax-parse stx
[(_ . args)
#:with τ-internal* (add-arg-variances #'τ-internal (arg-variances #'(τ . args)))
(syntax/loc stx
(τ-internal* (λ () (#%expression extra-info) . args)))]))
; this is the actual constructor
(define-syntax (τ stx)
(syntax-parse stx
[(_ . args)
#:fail-unless (op (stx-length #'args) n)
(format "wrong number of arguments, expected ~a ~a"
'op 'n)
#:with ([arg- _] (... ...)) (infers+erase #'args)
;; the args are validated on the next line, rather than above
;; to ensure enough stx-parse progress so we get a proper err msg,
;; ie, "invalid type" instead of "improper tycon usage"
#:with (~! (~var _ kind) (... ...)) #'(arg- (... ...))
(add-orig
(assign-type #'(τ- arg- (... ...)) #'#%kind)
stx)]
[_ ;; else fail with err msg
(type-error
#:src stx
#:msg
(string-append
"Improper usage of type constructor ~a: ~a, expected ~a ~a arguments")
#'τ stx #'op #'n)])))]))
;; Form for defining *binding* types, kinds, etc.
;; The def uses pattern vars "τ" and "kind" but this form is not restricted to
;; only types and kinds, eg, τ can be #'★ and kind can be #'#%kind (★'s type)
(define-syntax (define-binding-checked-stx stx)
(syntax-parse stx #:datum-literals (:)
[(_ τ:id : kind
(~or
(~optional (~and #:no-attach-kind (~parse no-attach-kind? #'#t)))
(~optional
(~seq #:arity op n:exact-nonnegative-integer)
#:defaults ([op #'=] [n #'1]))
(~optional
(~seq #:bvs bvs-op bvs-n:exact-nonnegative-integer)
#:defaults ([bvs-op #'>=][bvs-n #'0]))
(~optional
(~seq #:arr (~and kindcon (~parse has-annotations? #'#t)))
#:defaults ([kindcon #'void])) ; default kindcon should never be used
(~optional
(~seq #:arg-variances arg-variances-stx:expr)
#:defaults ([arg-variances-stx
#`(λ (stx-id)
(for/list ([arg (in-list (stx->list (stx-cdr stx-id)))])
invariant))]))
(~optional
(~seq #:extra-info extra-info)
#:defaults ([extra-info #'void]))) ...)
#:with #%kind (mk-#% #'kind)
#:with τ? (mk-? #'τ)
#:with τ- (mk-- #'τ)
#:with τ-expander (mk-~ #'τ)
#:with τ-internal (generate-temporary #'τ)
#`(begin
(begin-for-syntax
(define-syntax τ-expander
(pattern-expander
(syntax-parser
; this case used by ⇑, TODO: remove this case?
;; if has-annotations?
;; - type has surface shape
;; (τ ([tv : k] ...) body ...)
;; - this case parses to pattern
;; [([tv k] ...) (body ...)]
;; if not has-annotations?
;; - type has surface shape
;; (τ (tv ...) body ...)
;; - this case parses to pattern
;; [(tv ...) (body ...)]
[(_ . pat:id)
#:with expanded-τ (generate-temporary)
#:with tycon-expander (mk-~ #'tycon)
#:with kindcon-expander (mk-~ #'kindcon)
#'(~and expanded-τ
(~Any/bvs (~literal/else τ-internal
(format "Expected ~a type, got: ~a"
'τ (type->str #'expanded-τ))
#'expanded-τ)
(~and bvs (tv (... (... ...))))
. rst)
#,(if (attribute has-bvs?)
(if (attribute has-annotations?)
#'(~and (~parse (tycon-expander k (... (... ...))) (typeof #'expanded-τ))
(~parse pat #'(([tv k] (... (... ...))) rst)))
#'(~parse pat #'(bvs rst)))
#'(~parse pat #'rst)))]
(~Any/bvs
(~literal/else τ-internal
(format "Expected ~a type, got: ~a"
'τ (type->str #'expanded-τ))
#'expanded-τ)
(~and bvs (tv (... (... ...))))
. rst)
#,(if (attribute has-annotations?)
#'(~and
(~parse (kindcon-expander k (... (... ...)))
(typeof #'expanded-τ))
(~parse pat
#'[([tv k] (... (... ...))) rst]))
#'(~parse
pat
#'[bvs rst]))
)]
;; TODO: fix this to handle has-annotations?
[(_ (~optional (~and (~fail #:unless #,(attribute has-bvs?)) bvs-pat)
#:defaults ([bvs-pat #'()])) . pat)
;; the difference with the first case is that here
;; the body is ungrouped, ie,
;; parses to pattern[(tv ...) . (body ...)]
[(_ bvs-pat . pat)
#:with expanded-τ (generate-temporary)
#'(~and expanded-τ
(~Any/bvs (~literal/else τ-internal
(format "Expected ~a type, got: ~a"
'τ (type->str #'expanded-τ))
#'expanded-τ)
bvs-pat
. pat))])))
(~Any/bvs
(~literal/else τ-internal
(format "Expected ~a type, got: ~a"
'τ (type->str #'expanded-τ))
#'expanded-τ)
bvs-pat
. pat))])))
(define arg-variances arg-variances-stx)
(define (τ? t)
(syntax-parse t
@ -696,35 +802,45 @@
(λ _ (raise (exn:fail:type:runtime
(format "~a: Cannot use ~a at run time" 'τ 'kind)
(current-continuation-marks)))))
;; ; this is the actual constructor
; τ- is an internal constructor:
; - it does not validate inputs and does not attach a kind,
; ie, it won't be recognized as a valid type unless a kind
; system is implemented on top
; - the τ constructor implements a default kind system but τ-
; is available if the programmer wants to implement their own
(define-syntax (τ- stx)
(syntax-parse stx
[(_ bvs . args)
#:with τ-internal* (add-arg-variances
#'τ-internal
(arg-variances #'(τ- . args))) ; drop bvs
(syntax/loc stx
(τ-internal* (λ bvs (#%expression extra-info) . args)))]))
; this is the actual constructor
(define-syntax (τ stx)
(syntax-parse stx
[(_ (~optional (~and (~fail #:unless #,(attribute has-bvs?))
(~or (bv:id (... ...))
(~and (~fail #:unless #,(attribute has-annotations?))
bvs+ann)))
#:defaults ([(bv 1) null])) . args)
#:with bvs (if #,(attribute has-annotations?)
#'bvs+ann
#'([bv : #%kind] (... ...)))
;#:declare bvs ctx ; can't assume kind-ctx is defined
#:fail-unless (bvs-op (stx-length #'bvs) bvs-n)
(format "wrong number of type vars, expected ~a ~a" 'bvs-op 'bvs-n)
[(_ (~or (bv:id (... ...))
(~and (~fail #:unless #,(attribute has-annotations?))
bvs+ann))
. args)
#:with bvs+ks (if #,(attribute has-annotations?)
#'bvs+ann
#'([bv : #%kind] (... ...)))
#:fail-unless (bvs-op (stx-length #'bvs+ks) bvs-n)
(format "wrong number of type vars, expected ~a ~a"
'bvs-op 'bvs-n)
#:fail-unless (op (stx-length #'args) n)
(format "wrong number of arguments, expected ~a ~a" 'op 'n)
#:with (bvs- τs- _) (infers/ctx+erase #'bvs #'args)
#:with (~! (~var _ kind) (... ...)) #'τs-
#:with ([tv (~datum :) k_arg] (... ...)) #'bvs
#:with k_result (if #,(attribute has-annotations?)
#'(tycon k_arg (... ...))
#'#%kind)
#:with τ-internal* (add-arg-variances #'τ-internal (arg-variances stx))
(add-orig
(assign-type
(syntax/loc stx
(τ-internal* (λ bvs- (#%expression extra-info) . τs-)))
#'k_result)
#'(τ . args))]
(format "wrong number of arguments, expected ~a ~a"
'op 'n)
#:with (bvs- τs- _) (infers/ctx+erase #'bvs+ks #'args)
#:with (~! (~var _ kind) (... ...)) #'τs-
#:with ([tv (~datum :) k_arg] (... ...)) #'bvs+ks
#:with k_result (if #,(attribute has-annotations?)
#'(kindcon k_arg (... ...))
#'#%kind)
; #:with ty-out (expand/df #'(τ- bvs- . τs-))
#:with ty-out #'(τ- bvs- . τs-)
(add-orig (assign-type #'ty-out #'k_result) stx)]
;; else fail with err msg
[_
(type-error #:src stx
@ -749,6 +865,8 @@
#:with define-base-name (format-id #'name "define-base-~a" #'name)
#:with define-base-names (format-id #'name "define-base-~as" #'name)
#:with define-name-cons (format-id #'name "define-~a-constructor" #'name)
#:with define-binding-name (format-id #'name "define-binding-~a" #'name)
#:with define-internal-name-cons (format-id #'name "define-internal-~a-constructor" #'name)
#:with name-ann (format-id #'name "~a-ann" #'name)
#:with name=? (format-id #'name "~a=?" #'name)
#:with names=? (format-id #'names "~a=?" #'names)
@ -841,13 +959,26 @@
modes)]))))
(define-syntax define-base-name
(syntax-parser
[(_ (~var x id) . rst) #'(define-basic-checked-id-stx x : name . rst)]))
[(_ (~var x id) (~datum :) k)
#'(define-basic-checked-id-stx x : k)]
[(_ (~var x id))
#'(define-basic-checked-id-stx x : #%tag)]))
(define-syntax define-base-names
(syntax-parser
[(_ (~var x id) (... ...)) #'(begin (define-base-name x) (... ...))]))
[(_ (~var x id) (... ...))
#'(begin (define-base-name x) (... ...))]))
(define-syntax define-internal-name-cons
(syntax-parser
[(_ (~var x id) . rst)
#'(define-basic-checked-stx x : name #:no-attach-kind . rst)]))
(define-syntax define-name-cons
(syntax-parser
[(_ (~var x id) . rst) #'(define-basic-checked-stx x : name . rst)])))]))
[(_ (~var x id) . rst)
#'(define-basic-checked-stx x : name . rst)]))
(define-syntax define-binding-name
(syntax-parser
[(_ (~var x id) . rst)
#'(define-binding-checked-stx x : name . rst)])))]))
;; pre-declare all type-related functions and forms
(define-syntax-category type)
@ -894,8 +1025,8 @@
(define-syntax ~Any
(pattern-expander
(syntax-parser
[(_ tycons x ...)
#'(~Any/bvs tycons _ x ...)])))
[(_ tycons . rst)
#'(~Any/bvs tycons _ . rst)])))
(define-syntax ~literal/else
(pattern-expander
(syntax-parser

2
turnstile/examples/exist.rkt
View File

@ -11,7 +11,7 @@
(provide ∃ pack open)
(define-type-constructor ∃ #:bvs = 1)
(define-binding-type ∃ #:bvs = 1)
(define-typed-syntax (pack (τ:type e) as ∃τ:type) ≫
#:with (~∃ (τ_abstract) τ_body) #'∃τ.norm

2
turnstile/examples/fomega.rkt
View File

@ -53,7 +53,7 @@
(define-kind-constructor ⇒ #:arity >= 1)
(define-kind-constructor ∀★ #:arity >= 0)
(define-type-constructor ∀ #:bvs >= 0 #:arr ∀★)
(define-binding-type ∀ #:arr ∀★)
;; alternative: normalize before type=?
; but then also need to normalize in current-promote

2
turnstile/examples/fomega2.rkt
View File

@ -44,7 +44,7 @@
(define-base-kind ★)
(define-kind-constructor ∀★ #:arity >= 0)
(define-type-constructor ∀ #:bvs >= 0 #:arr ∀★)
(define-binding-type ∀ #:arr ∀★)
;; alternative: normalize before type=?
; but then also need to normalize in current-promote

2
turnstile/examples/infer.rkt
View File

@ -12,7 +12,7 @@
(provide → ∀ define define/rec λ #%app)
;; (Some [X ...] τ_body (Constraints (Constraint τ_1 τ_2) ...))
(define-type-constructor Some #:arity = 2 #:bvs >= 0)
(define-binding-type Some #:arity = 2)
(define-type-constructor Constraint #:arity = 2)
(define-type-constructor Constraints #:arity >= 0)
(define-syntax Cs

2
turnstile/examples/stlc+rec-iso.rkt
View File

@ -14,7 +14,7 @@
(provide μ unfld fld)
(define-type-constructor μ #:bvs = 1)
(define-binding-type μ #:bvs = 1)
(define-typed-syntax (unfld τ:type-ann e) ≫
#:with (~μ (tv) τ_body) #'τ.norm

2
turnstile/examples/sysf.rkt
View File

@ -11,7 +11,7 @@
(provide (type-out ∀) Λ inst)
(define-type-constructor ∀ #:bvs >= 0)
(define-binding-type ∀)
(define-typed-syntax (Λ (tv:id ...) e) ≫
[([tv ≫ tv- : #%type] ...) () ⊢ e ≫ e- ⇒ τ]

3
turnstile/examples/tests/rackunit-typechecking.rkt
View File

@ -1,7 +1,8 @@
#lang racket/base
(require (for-syntax rackunit syntax/srcloc) rackunit macrotypes/typecheck)
(provide check-type typecheck-fail check-not-type check-props check-runtime-exn
check-equal/rand)
check-equal/rand
(rename-out [typecheck-fail check-stx-err]))
(begin-for-syntax
(define (add-esc s) (string-append "\\" s))

3
turnstile/examples/tests/rosette/run-all-rosette-tests.rkt
View File

@ -1,5 +1,8 @@
#lang racket/base
(require "rosette-tests.rkt")
(require "rosette2-tests.rkt")
(require "rosette-guide-sec2-tests.rkt")
(require "rosette-guide-sec3-tests.rkt")
(require "bv-tests.rkt")
;(require "bv-ref-tests.rkt")
; visit but dont instantiate, o.w. will get unsat

75
turnstile/scribblings/reference.scrbl
View File

@ -145,28 +145,68 @@ Turnstile pre-declares @racket[(define-syntax-category type)], which in turn
@defform[(define-type-constructor name-id option ...)
#:grammar
([option (code:line #:arity op n)
(code:line #:bvs op n)
(code:line #:arr tycon)
(code:line #:arg-variances expr)
(code:line #:extra-info stx)])]{
Defines a type constructor. Defining a type constructor @racket[τ] defines:
Defines a type constructor that does not bind type variables.
Defining a type constructor @racket[τ] defines:
@itemlist[@item{@racket[τ], a macro for constructing an instance of type
@racket[τ], with the specified arity.}
@item{@racket[τ?], a phase 1 predicate recognizing type @racket[τ].}
@item{@racket[~τ], a phase 1 @tech:pat-expander recognizing type @racket[τ].}]
The @racket[#:arity] and @racket[#:bvs] arguments specify the valid shapes
The @racket[#:arity] argument specifies the valid shapes
for the type. For example
@racket[(define-type-constructor → #:arity >= 1)] defines an arrow type and
@racket[(define-type-constructor Pair #:arity = 2)] defines a pair type.
The default arity is @racket[= 1].
Use the @racket[#:bvs] argument to define binding types, e.g.,
@racket[(define-type-constructor ∀ #:arity = 1 #:bvs = 1)] defines a type
with shape @racket[(∀ (X) τ)], where @racket[τ] may reference @racket[X].
The @racket[#:arg-variances] argument is a transformer converting a syntax
object of the type to a list of variances for the arguments to the type
constructor.
The possible variances are @racket[invariant], @racket[contravariant],
@racket[covariant], and @racket[irrelevant].
If @racket[#:arg-variances] is not specified, @racket[invariant] is used for
all positions.
Example:
@racketblock0[(define-type-constructor → #:arity >= 1
#:arg-variances
(λ (stx)
(syntax-parse stx
[(_ τ_in ... τ_out)
(append
(make-list (stx-length #'[τ_in ...]) contravariant)
(list covariant))])))]
The @racket[#:extra-info] argument is useful for attaching additional
metainformation to types, for example to implement pattern matching.}}
@item{
@defform[(define-binding-type name-id option ...)
#:grammar
([option (code:line #:arity op n)
(code:line #:bvs op n)
(code:line #:arr kindcon)
(code:line #:arg-variances expr)
(code:line #:extra-info stx)])]{
Similar to @racket[define-type-constructor], except
@racket[define-binding-type] defines a type that binds type variables.
Defining a type constructor @racket[τ] defines:
The @racket[#:arity] and @racket[#:bvs] arguments specify the valid shapes
for the type. For example
@racket[(define-binding-type ∀ #:arity = 1 #:bvs = 1)] defines a type
with shape @racket[(∀ (X) τ)], where @racket[τ] may reference @racket[X].
The default @racket[#:arity] is @racket[= 1]
and the default @racket[#:bvs] is @racket[>= 0].
Use the @racket[#:arr] argument to define a type with kind annotations
on the type variables. The @racket[#:arr] argument is an "arrow" that "saves"
the annotations after a type is expanded and annotations are erased,
analogous to how → "saves" the type annotations on a lambda.}}
@item{
@defform[(type-out ty-id)]{
A @racket[provide]-spec that, given @racket[ty-id], provides @racket[ty-id],
@ -182,7 +222,7 @@ equality, but includes alpha-equivalence.
(begin-for-syntax (displayln (type=? #'Int #'Int)))
(begin-for-syntax (displayln (type=? #'Int #'String)))
(define-type-constructor → #:arity > 0)
(define-type-constructor ∀ #:arity = 1 #:bvs = 1)
(define-binding-type ∀ #:arity = 1 #:bvs = 1)
(begin-for-syntax
(displayln
(type=? ((current-type-eval) #'(∀ (X) X))
@ -327,6 +367,23 @@ Phase 1 function folding @racket[subst] over the given @racket[τs] and @racket[
@defform[(type-error #:src srx-stx #:msg msg args ...)]{
Phase 1 form that throws a type error using the specified information. @racket[msg] is a format string that references @racket[args].}
@section{Subtyping}
WARNING: very experimental
Types defined with @racket[define-type-constructor] and
@racket[define-binding-type] may specify variance information and subtyping
languages may use this information to help compute the subtype relation.
The possible variances are:
@defthing[covariant variance?]
@defthing[contravariant variance?]
@defthing[invariant variance?]
@defthing[irrelevant variance?]
@defproc[(variance? [v any/c]) boolean/c]{
Predicate that recognizes the variance values.}
@section{Miscellaneous Syntax Object Functions}
These are all phase 1 functions.