diff --git a/implementations/racket/preserves/preserves-schema/compiler.rkt b/implementations/racket/preserves/preserves-schema/compiler.rkt index d5c1a32..696f9e7 100644 --- a/implementations/racket/preserves/preserves-schema/compiler.rkt +++ b/implementations/racket/preserves/preserves-schema/compiler.rkt @@ -106,7 +106,7 @@ (match-define (list variant-name variant-ty) variant) (match variant-ty [(ty-record fields) - (cons (struct-stx (list name variant-name) (map car fields)) acc)] + (cons (struct-stx (list name variant-name) (map ty-field-name fields)) acc)] [(ty-unit) (cons (struct-stx (list name variant-name) '()) acc)] [_ @@ -114,7 +114,7 @@ [(ty-unit) (cons (struct-stx (list name) '()) acc)] [(ty-record fields) - (cons (struct-stx (list name) (map car fields)) acc)] + (cons (struct-stx (list name) (map ty-field-name fields)) acc)] [_ acc])) '() diff --git a/implementations/racket/preserves/preserves-schema/parser.rkt b/implementations/racket/preserves/preserves-schema/parser.rkt index b76f410..f58ae88 100644 --- a/implementations/racket/preserves/preserves-schema/parser.rkt +++ b/implementations/racket/preserves/preserves-schema/parser.rkt @@ -41,7 +41,7 @@ (define (construct name wrap? ty) (match ty - [(ty-record fields) `(,name ,@(map escape (map car fields)))] + [(ty-record fields) `(,name ,@(map escape (map ty-field-name fields)))] [(ty-unit) `(,name)] [_ (if wrap? `(,name dest) 'dest)])) diff --git a/implementations/racket/preserves/preserves-schema/type.rkt b/implementations/racket/preserves/preserves-schema/type.rkt index 7643860..65a0f0a 100644 --- a/implementations/racket/preserves/preserves-schema/type.rkt +++ b/implementations/racket/preserves/preserves-schema/type.rkt @@ -8,6 +8,8 @@ (struct-out ty-set) (struct-out ty-dictionary) + (struct-out ty-field) + definition-ty unwrap namelike @@ -30,6 +32,8 @@ (struct ty-set (type) #:transparent) (struct ty-dictionary (key-type value-type) #:transparent) +(struct ty-field (name type pattern) #:transparent) + (define (definition-ty d) (match d [(Definition-or p0 p1 pN) @@ -63,7 +67,7 @@ [(NamedSimplePattern_ n p) (match (pattern-ty p) [(ty-unit) acc] - [ty (cons (list n ty) acc)])] + [ty (cons (ty-field n ty p) acc)])] [(? SimplePattern?) acc] [(CompoundPattern-rec label-named-pat fields-named-pat) (gather-fields label-named-pat (gather-fields fields-named-pat acc))] diff --git a/implementations/racket/preserves/preserves-schema/unparser.rkt b/implementations/racket/preserves/preserves-schema/unparser.rkt index c2a1829..71c4c1f 100644 --- a/implementations/racket/preserves/preserves-schema/unparser.rkt +++ b/implementations/racket/preserves/preserves-schema/unparser.rkt @@ -39,7 +39,7 @@ (define (deconstruct name wrap? ty) (match ty - [(ty-record fields) `(,name ,@(map escape (map car fields)))] + [(ty-record fields) `(,name ,@(map escape (map ty-field-name fields)))] [(ty-unit) `(,name)] [_ (if wrap? `(,name src) 'src)]))