Name is already always supplied, no need to add it
This commit is contained in:
parent
4ed8fd2c92
commit
163e338ce5
|
@ -6,7 +6,7 @@
|
||||||
(require (only-in racket/list check-duplicates))
|
(require (only-in racket/list check-duplicates))
|
||||||
(require preserves/order)
|
(require preserves/order)
|
||||||
|
|
||||||
(require (only-in "type.rkt" unwrap add-name-if-absent))
|
(require (only-in "type.rkt" unwrap))
|
||||||
(require "gen/schema.rkt")
|
(require "gen/schema.rkt")
|
||||||
|
|
||||||
(define (schema-check-problems schema)
|
(define (schema-check-problems schema)
|
||||||
|
@ -36,7 +36,7 @@
|
||||||
(check-named-pattern (cons "tail" context) scope v)]
|
(check-named-pattern (cons "tail" context) scope v)]
|
||||||
[(CompoundPattern-dict entries)
|
[(CompoundPattern-dict entries)
|
||||||
(for [(entry (in-list (sorted-dict-entries entries)))]
|
(for [(entry (in-list (sorted-dict-entries entries)))]
|
||||||
(check-named-pattern (cons (car entry) context) scope (add-name-if-absent entry)))]))
|
(check-named-pattern (cons (car entry) context) scope (cdr entry)))]))
|
||||||
|
|
||||||
(define (check-named-pattern context scope p)
|
(define (check-named-pattern context scope p)
|
||||||
(match (unwrap p)
|
(match (unwrap p)
|
||||||
|
|
|
@ -97,7 +97,7 @@
|
||||||
(maybe-dest dest-pat-stx
|
(maybe-dest dest-pat-stx
|
||||||
`(hash-table ,@(map (lambda (entry)
|
`(hash-table ,@(map (lambda (entry)
|
||||||
`(,(literal->pattern (car entry))
|
`(,(literal->pattern (car entry))
|
||||||
,(pattern->match-pattern (add-name-if-absent entry) '_)))
|
,(pattern->match-pattern (cdr entry) '_)))
|
||||||
(sorted-dict-entries entries))
|
(sorted-dict-entries entries))
|
||||||
(_ _) ...))]))
|
(_ _) ...))]))
|
||||||
|
|
||||||
|
|
|
@ -10,7 +10,7 @@
|
||||||
|
|
||||||
definition-ty
|
definition-ty
|
||||||
unwrap
|
unwrap
|
||||||
add-name-if-absent
|
namelike
|
||||||
escape)
|
escape)
|
||||||
|
|
||||||
(require preserves/record)
|
(require preserves/record)
|
||||||
|
@ -70,7 +70,7 @@
|
||||||
[(CompoundPattern-tuple* fixed-named-pats variable-named-pat)
|
[(CompoundPattern-tuple* fixed-named-pats variable-named-pat)
|
||||||
(gather-fields* fixed-named-pats (gather-fields variable-named-pat acc))]
|
(gather-fields* fixed-named-pats (gather-fields variable-named-pat acc))]
|
||||||
[(CompoundPattern-dict entries)
|
[(CompoundPattern-dict entries)
|
||||||
(gather-fields* (map add-name-if-absent (sorted-dict-entries entries)) acc)]))
|
(gather-fields* (map cdr (sorted-dict-entries entries)) acc)]))
|
||||||
|
|
||||||
(define (pattern-ty p)
|
(define (pattern-ty p)
|
||||||
(match (unwrap p)
|
(match (unwrap p)
|
||||||
|
@ -84,15 +84,6 @@
|
||||||
[(SimplePattern-Ref _r) (ty-value)]
|
[(SimplePattern-Ref _r) (ty-value)]
|
||||||
[(? CompoundPattern?) (product-ty (list p))]))
|
[(? CompoundPattern?) (product-ty (list p))]))
|
||||||
|
|
||||||
(define (add-name-if-absent entry)
|
|
||||||
(match-define (cons k p) entry)
|
|
||||||
(match p
|
|
||||||
[(NamedSimplePattern-named _) p]
|
|
||||||
[(NamedSimplePattern-anonymous _)
|
|
||||||
(match (namelike k)
|
|
||||||
[#f p]
|
|
||||||
[s (NamedSimplePattern-named (NamedSimplePattern_ s p))])]))
|
|
||||||
|
|
||||||
(define (namelike v)
|
(define (namelike v)
|
||||||
(match v
|
(match v
|
||||||
[(? string? s) (string->symbol s)]
|
[(? string? s) (string->symbol s)]
|
||||||
|
|
|
@ -79,5 +79,5 @@
|
||||||
[(CompoundPattern-dict entries)
|
[(CompoundPattern-dict entries)
|
||||||
`(hash ,@(append-map (lambda (entry)
|
`(hash ,@(append-map (lambda (entry)
|
||||||
(list `',(car entry)
|
(list `',(car entry)
|
||||||
(pattern->unparser (add-name-if-absent entry) src-stx)))
|
(pattern->unparser (cdr entry) src-stx)))
|
||||||
(sorted-dict-entries entries)))]))
|
(sorted-dict-entries entries)))]))
|
||||||
|
|
Loading…
Reference in New Issue