From 163e338ce5ed9577ffb2d39154fa4b7558cf233d Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Tue, 25 May 2021 11:04:29 +0200 Subject: [PATCH] Name is already always supplied, no need to add it --- .../racket/preserves/preserves-schema/checker.rkt | 4 ++-- .../racket/preserves/preserves-schema/parser.rkt | 2 +- .../racket/preserves/preserves-schema/type.rkt | 13 ++----------- .../racket/preserves/preserves-schema/unparser.rkt | 2 +- 4 files changed, 6 insertions(+), 15 deletions(-) diff --git a/implementations/racket/preserves/preserves-schema/checker.rkt b/implementations/racket/preserves/preserves-schema/checker.rkt index 9ce4a33..5c92bd5 100644 --- a/implementations/racket/preserves/preserves-schema/checker.rkt +++ b/implementations/racket/preserves/preserves-schema/checker.rkt @@ -6,7 +6,7 @@ (require (only-in racket/list check-duplicates)) (require preserves/order) -(require (only-in "type.rkt" unwrap add-name-if-absent)) +(require (only-in "type.rkt" unwrap)) (require "gen/schema.rkt") (define (schema-check-problems schema) @@ -36,7 +36,7 @@ (check-named-pattern (cons "tail" context) scope v)] [(CompoundPattern-dict 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) (match (unwrap p) diff --git a/implementations/racket/preserves/preserves-schema/parser.rkt b/implementations/racket/preserves/preserves-schema/parser.rkt index 67db6d5..4cb03f8 100644 --- a/implementations/racket/preserves/preserves-schema/parser.rkt +++ b/implementations/racket/preserves/preserves-schema/parser.rkt @@ -97,7 +97,7 @@ (maybe-dest dest-pat-stx `(hash-table ,@(map (lambda (entry) `(,(literal->pattern (car entry)) - ,(pattern->match-pattern (add-name-if-absent entry) '_))) + ,(pattern->match-pattern (cdr entry) '_))) (sorted-dict-entries entries)) (_ _) ...))])) diff --git a/implementations/racket/preserves/preserves-schema/type.rkt b/implementations/racket/preserves/preserves-schema/type.rkt index 9b8b74c..38f8273 100644 --- a/implementations/racket/preserves/preserves-schema/type.rkt +++ b/implementations/racket/preserves/preserves-schema/type.rkt @@ -10,7 +10,7 @@ definition-ty unwrap - add-name-if-absent + namelike escape) (require preserves/record) @@ -70,7 +70,7 @@ [(CompoundPattern-tuple* fixed-named-pats variable-named-pat) (gather-fields* fixed-named-pats (gather-fields variable-named-pat acc))] [(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) (match (unwrap p) @@ -84,15 +84,6 @@ [(SimplePattern-Ref _r) (ty-value)] [(? 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) (match v [(? string? s) (string->symbol s)] diff --git a/implementations/racket/preserves/preserves-schema/unparser.rkt b/implementations/racket/preserves/preserves-schema/unparser.rkt index c8147ab..4c41d70 100644 --- a/implementations/racket/preserves/preserves-schema/unparser.rkt +++ b/implementations/racket/preserves/preserves-schema/unparser.rkt @@ -79,5 +79,5 @@ [(CompoundPattern-dict entries) `(hash ,@(append-map (lambda (entry) (list `',(car entry) - (pattern->unparser (add-name-if-absent entry) src-stx))) + (pattern->unparser (cdr entry) src-stx))) (sorted-dict-entries entries)))]))