diff --git a/implementations/racket/preserves/preserves-schema/checker.rkt b/implementations/racket/preserves/preserves-schema/checker.rkt index f693084..9ce4a33 100644 --- a/implementations/racket/preserves/preserves-schema/checker.rkt +++ b/implementations/racket/preserves/preserves-schema/checker.rkt @@ -4,6 +4,7 @@ (require racket/match) (require (only-in racket/list check-duplicates)) +(require preserves/order) (require (only-in "type.rkt" unwrap add-name-if-absent)) (require "gen/schema.rkt") @@ -34,8 +35,8 @@ (for [(p (in-list ps)) (i (in-naturals))] (check-named-pattern (cons i context) scope p)) (check-named-pattern (cons "tail" context) scope v)] [(CompoundPattern-dict entries) - (for [((k v) (in-hash entries))] - (check-named-pattern (cons k context) scope (add-name-if-absent k v)))])) + (for [(entry (in-list (sorted-dict-entries entries)))] + (check-named-pattern (cons (car entry) context) scope (add-name-if-absent entry)))])) (define (check-named-pattern context scope p) (match (unwrap p) diff --git a/implementations/racket/preserves/preserves-schema/gen/schema.rkt b/implementations/racket/preserves/preserves-schema/gen/schema.rkt index 7b6f5e9..a6c784f 100644 --- a/implementations/racket/preserves/preserves-schema/gen/schema.rkt +++ b/implementations/racket/preserves/preserves-schema/gen/schema.rkt @@ -27,7 +27,7 @@ (struct SimplePattern-dictof (key value) #:prefab) (struct SimplePattern-Ref (value) #:prefab) (struct NamedAlternative (variantLabel pattern) #:prefab) - (struct Schema (version embeddedType definitions) #:prefab) + (struct Schema (definitions embeddedType version) #:prefab) (define (Pattern? p) (or (Pattern-SimplePattern? p) (Pattern-CompoundPattern? p))) (struct Pattern-SimplePattern (value) #:prefab) @@ -141,14 +141,14 @@ 'schema (list (hash-table - ('version (app parse-Version (and $version (not (== eof))))) - ('embeddedType - (app parse-EmbeddedTypeName (and $embeddedType (not (== eof))))) ('definitions (app parse-Definitions (and $definitions (not (== eof))))) + ('embeddedType + (app parse-EmbeddedTypeName (and $embeddedType (not (== eof))))) + ('version (app parse-Version (and $version (not (== eof))))) (_ _) ...)))) - (Schema $version $embeddedType $definitions)) + (Schema $definitions $embeddedType $version)) (_ eof))) (define (parse-Pattern input) (match @@ -342,17 +342,17 @@ (define (Schema->preserves input) (match input - ((Schema $version $embeddedType $definitions) + ((Schema $definitions $embeddedType $version) (record 'schema (list (hash - 'version - (Version->preserves $version) + 'definitions + (Definitions->preserves $definitions) 'embeddedType (EmbeddedTypeName->preserves $embeddedType) - 'definitions - (Definitions->preserves $definitions))))))) + 'version + (Version->preserves $version))))))) (define (Pattern->preserves input) (match input diff --git a/implementations/racket/preserves/preserves-schema/parser.rkt b/implementations/racket/preserves/preserves-schema/parser.rkt index 9b61758..67db6d5 100644 --- a/implementations/racket/preserves/preserves-schema/parser.rkt +++ b/implementations/racket/preserves/preserves-schema/parser.rkt @@ -93,12 +93,12 @@ (pattern->match-pattern variable-named-pat '_) `(list* ,@(map (lambda (p) (pattern->match-pattern p '_)) fixed-named-pats) ,(pattern->match-pattern variable-named-pat '_))))] - [(CompoundPattern-dict (hash-table (keys pats) ...)) + [(CompoundPattern-dict entries) (maybe-dest dest-pat-stx - `(hash-table ,@(for/list [(key (in-list keys)) - (pat (in-list pats))] - `(,(literal->pattern key) - ,(pattern->match-pattern (add-name-if-absent key pat) '_))) + `(hash-table ,@(map (lambda (entry) + `(,(literal->pattern (car entry)) + ,(pattern->match-pattern (add-name-if-absent entry) '_))) + (sorted-dict-entries entries)) (_ _) ...))])) (define (literal->pattern v) diff --git a/implementations/racket/preserves/preserves-schema/type.rkt b/implementations/racket/preserves/preserves-schema/type.rkt index b4dafd4..9b8b74c 100644 --- a/implementations/racket/preserves/preserves-schema/type.rkt +++ b/implementations/racket/preserves/preserves-schema/type.rkt @@ -14,6 +14,7 @@ escape) (require preserves/record) +(require preserves/order) (require racket/match) (require (only-in racket/syntax format-symbol)) @@ -68,8 +69,8 @@ (gather-fields* named-pats acc)] [(CompoundPattern-tuple* fixed-named-pats variable-named-pat) (gather-fields* fixed-named-pats (gather-fields variable-named-pat acc))] - [(CompoundPattern-dict (hash-table (keys pats) ...)) - (gather-fields* (map add-name-if-absent keys pats) acc)])) + [(CompoundPattern-dict entries) + (gather-fields* (map add-name-if-absent (sorted-dict-entries entries)) acc)])) (define (pattern-ty p) (match (unwrap p) @@ -83,7 +84,8 @@ [(SimplePattern-Ref _r) (ty-value)] [(? CompoundPattern?) (product-ty (list p))])) -(define (add-name-if-absent k p) +(define (add-name-if-absent entry) + (match-define (cons k p) entry) (match p [(NamedSimplePattern-named _) p] [(NamedSimplePattern-anonymous _) diff --git a/implementations/racket/preserves/preserves-schema/unparser.rkt b/implementations/racket/preserves/preserves-schema/unparser.rkt index c7be00c..c8147ab 100644 --- a/implementations/racket/preserves/preserves-schema/unparser.rkt +++ b/implementations/racket/preserves/preserves-schema/unparser.rkt @@ -76,7 +76,8 @@ [(CompoundPattern-tuple* fixed-named-pats variable-named-pat) `(list* ,@(for/list [(p (in-list fixed-named-pats))] (pattern->unparser p src-stx)) ,(pattern->unparser variable-named-pat src-stx))] - [(CompoundPattern-dict (hash-table (keys pats) ...)) - `(hash ,@(append-map (lambda (key pat) - (list `',key (pattern->unparser (add-name-if-absent key pat) src-stx))) - keys pats))])) + [(CompoundPattern-dict entries) + `(hash ,@(append-map (lambda (entry) + (list `',(car entry) + (pattern->unparser (add-name-if-absent entry) src-stx))) + (sorted-dict-entries entries)))]))