From ac462be47cd7c87985f5c76ff20e9524e23437d0 Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Wed, 19 Aug 2015 14:02:48 -0500 Subject: [PATCH] Fix uses of `unstable/struct`. --- racket/collects/racket/private/serialize.rkt | 2 +- racket/collects/syntax/parse/private/make.rkt | 43 +++++++++++++++++++ .../syntax/parse/private/minimatch.rkt | 4 +- .../collects/syntax/parse/private/parse.rkt | 2 +- .../syntax/parse/private/rep-attrs.rkt | 2 +- .../syntax/parse/private/rep-data.rkt | 2 +- .../syntax/parse/private/rep-patterns.rkt | 2 +- racket/collects/syntax/parse/private/rep.rkt | 3 +- .../syntax/parse/private/runtime-report.rkt | 2 +- .../syntax/private/template-runtime.rkt | 2 +- racket/collects/syntax/strip-context.rkt | 2 +- racket/collects/syntax/template.rkt | 2 +- 12 files changed, 56 insertions(+), 12 deletions(-) create mode 100644 racket/collects/syntax/parse/private/make.rkt diff --git a/racket/collects/racket/private/serialize.rkt b/racket/collects/racket/private/serialize.rkt index 7855eece0b..0c18f2b8da 100644 --- a/racket/collects/racket/private/serialize.rkt +++ b/racket/collects/racket/private/serialize.rkt @@ -1,6 +1,6 @@ (module serialize racket/base (require syntax/modcollapse - unstable/struct + racket/struct racket/list racket/flonum racket/fixnum diff --git a/racket/collects/syntax/parse/private/make.rkt b/racket/collects/syntax/parse/private/make.rkt new file mode 100644 index 0000000000..8a4f744852 --- /dev/null +++ b/racket/collects/syntax/parse/private/make.rkt @@ -0,0 +1,43 @@ +#lang racket/base +(require (for-syntax racket/base + racket/struct-info)) +(provide make) + +;; get-struct-info : identifier stx -> struct-info-list +(define-for-syntax (get-struct-info id ctx) + (define (bad-struct-name x) + (raise-syntax-error #f "expected struct name" ctx x)) + (unless (identifier? id) + (bad-struct-name id)) + (let ([value (syntax-local-value id (lambda () #f))]) + (unless (struct-info? value) + (bad-struct-name id)) + (extract-struct-info value))) + +;; (make struct-name field-expr ...) +;; Checks that correct number of fields given. +(define-syntax (make stx) + (syntax-case stx () + [(make S expr ...) + (let () + (define info (get-struct-info #'S stx)) + (define constructor (list-ref info 1)) + (define accessors (list-ref info 3)) + (unless (identifier? #'constructor) + (raise-syntax-error #f "constructor not available for struct" stx #'S)) + (unless (andmap identifier? accessors) + (raise-syntax-error #f "incomplete info for struct type" stx #'S)) + (let ([num-slots (length accessors)] + [num-provided (length (syntax->list #'(expr ...)))]) + (unless (= num-provided num-slots) + (raise-syntax-error + #f + (format "wrong number of arguments for struct ~s (expected ~s, got ~s)" + (syntax-e #'S) + num-slots + num-provided) + stx))) + (with-syntax ([constructor constructor]) + (syntax-property #'(constructor expr ...) + 'disappeared-use + #'S)))])) diff --git a/racket/collects/syntax/parse/private/minimatch.rkt b/racket/collects/syntax/parse/private/minimatch.rkt index 2e0dc63f7a..d92eb40d22 100644 --- a/racket/collects/syntax/parse/private/minimatch.rkt +++ b/racket/collects/syntax/parse/private/minimatch.rkt @@ -1,6 +1,6 @@ #lang racket/base -(require unstable/struct - (for-syntax racket/base racket/struct-info unstable/struct)) +(require racket/struct + (for-syntax racket/base racket/struct-info racket/struct)) (provide match ?) (define-syntax (match stx) diff --git a/racket/collects/syntax/parse/private/parse.rkt b/racket/collects/syntax/parse/private/parse.rkt index aaf92f3102..807a670856 100644 --- a/racket/collects/syntax/parse/private/parse.rkt +++ b/racket/collects/syntax/parse/private/parse.rkt @@ -16,7 +16,7 @@ racket/syntax racket/stxparam syntax/stx - unstable/struct + racket/struct syntax/parse/private/residual ;; keep abs. path syntax/parse/private/runtime ;; keep abs.path syntax/parse/private/runtime-reflect) ;; keep abs. path diff --git a/racket/collects/syntax/parse/private/rep-attrs.rkt b/racket/collects/syntax/parse/private/rep-attrs.rkt index 746b340198..7996314eaa 100644 --- a/racket/collects/syntax/parse/private/rep-attrs.rkt +++ b/racket/collects/syntax/parse/private/rep-attrs.rkt @@ -3,7 +3,7 @@ racket/contract/base syntax/private/id-table racket/syntax - unstable/struct) + "make.rkt") #| An IAttr is (make-attr identifier number boolean) diff --git a/racket/collects/syntax/parse/private/rep-data.rkt b/racket/collects/syntax/parse/private/rep-data.rkt index 977cc57bf5..8e309c1997 100644 --- a/racket/collects/syntax/parse/private/rep-data.rkt +++ b/racket/collects/syntax/parse/private/rep-data.rkt @@ -5,7 +5,7 @@ syntax/private/id-table racket/syntax syntax/parse/private/residual-ct ;; keep abs. path - unstable/struct + "make.rkt" "minimatch.rkt" "kws.rkt" "rep-attrs.rkt" diff --git a/racket/collects/syntax/parse/private/rep-patterns.rkt b/racket/collects/syntax/parse/private/rep-patterns.rkt index 06f71564dd..2fecadf19c 100644 --- a/racket/collects/syntax/parse/private/rep-patterns.rkt +++ b/racket/collects/syntax/parse/private/rep-patterns.rkt @@ -2,7 +2,7 @@ (require syntax/parse/private/residual-ct ;; keep abs. path "rep-attrs.rkt" "kws.rkt" - unstable/struct + "make.rkt" (for-syntax racket/base syntax/stx racket/syntax)) diff --git a/racket/collects/syntax/parse/private/rep.rkt b/racket/collects/syntax/parse/private/rep.rkt index a1aaf36230..35d9277b5b 100644 --- a/racket/collects/syntax/parse/private/rep.rkt +++ b/racket/collects/syntax/parse/private/rep.rkt @@ -6,12 +6,13 @@ syntax/parse/private/runtime) racket/list racket/contract/base + "make.rkt" "minimatch.rkt" syntax/private/id-table syntax/stx syntax/keyword racket/syntax - unstable/struct + racket/struct "txlift.rkt" "rep-attrs.rkt" "rep-data.rkt" diff --git a/racket/collects/syntax/parse/private/runtime-report.rkt b/racket/collects/syntax/parse/private/runtime-report.rkt index ac7078d7fd..22007719eb 100644 --- a/racket/collects/syntax/parse/private/runtime-report.rkt +++ b/racket/collects/syntax/parse/private/runtime-report.rkt @@ -2,7 +2,7 @@ (require racket/list racket/format syntax/stx - unstable/struct + racket/struct unstable/error syntax/srcloc "minimatch.rkt" diff --git a/racket/collects/syntax/private/template-runtime.rkt b/racket/collects/syntax/private/template-runtime.rkt index 344a3a25b9..227ca249db 100644 --- a/racket/collects/syntax/private/template-runtime.rkt +++ b/racket/collects/syntax/private/template-runtime.rkt @@ -1,6 +1,6 @@ #lang racket/base (require "../stx.rkt" - unstable/struct) + racket/struct) (provide template-map-apply) diff --git a/racket/collects/syntax/strip-context.rkt b/racket/collects/syntax/strip-context.rkt index a316cad8b3..6e2f2f4de7 100644 --- a/racket/collects/syntax/strip-context.rkt +++ b/racket/collects/syntax/strip-context.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require unstable/struct) +(require racket/struct) (provide strip-context replace-context) diff --git a/racket/collects/syntax/template.rkt b/racket/collects/syntax/template.rkt index 3351e30302..c4bac0e72a 100644 --- a/racket/collects/syntax/template.rkt +++ b/racket/collects/syntax/template.rkt @@ -1,6 +1,6 @@ #lang racket/base (require "stx.rkt" - unstable/struct + racket/struct (for-template racket/base "private/template-runtime.rkt"))