Add struct ty-field for better structure in ty-records
This commit is contained in:
parent
30bcc1a50b
commit
0bcb4e64ec
|
@ -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]))
|
||||
'()
|
||||
|
|
|
@ -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)]))
|
||||
|
||||
|
|
|
@ -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))]
|
||||
|
|
|
@ -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)]))
|
||||
|
||||
|
|
Loading…
Reference in New Issue