diff --git a/macro-debugger-text-lib/macro-debugger/analysis/private/get-references.rkt b/macro-debugger-text-lib/macro-debugger/analysis/private/get-references.rkt index 48f6dae..5cd0ad6 100644 --- a/macro-debugger-text-lib/macro-debugger/analysis/private/get-references.rkt +++ b/macro-debugger-text-lib/macro-debugger/analysis/private/get-references.rkt @@ -1,7 +1,7 @@ #lang racket/base (require racket/match macro-debugger/model/deriv - unstable/struct + racket/struct "util.rkt") (provide deriv->refs) diff --git a/macro-debugger-text-lib/macro-debugger/model/deriv-util.rkt b/macro-debugger-text-lib/macro-debugger/model/deriv-util.rkt index 953ead9..fbf07d6 100644 --- a/macro-debugger-text-lib/macro-debugger/model/deriv-util.rkt +++ b/macro-debugger-text-lib/macro-debugger/model/deriv-util.rkt @@ -1,7 +1,6 @@ #lang racket/base -(require (for-syntax racket/base) +(require (for-syntax racket/base racket/struct-info) racket/match - unstable/struct "deriv.rkt") (provide make @@ -66,3 +65,42 @@ (define (wderivlist-es2 xs) (let ([es2 (map wderiv-e2 xs)]) (and (andmap syntax? es2) es2))) + +;; 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/macro-debugger-text-lib/macro-debugger/syntax-browser/pretty-helper.rkt b/macro-debugger-text-lib/macro-debugger/syntax-browser/pretty-helper.rkt index dee3dc8..aa24cd2 100644 --- a/macro-debugger-text-lib/macro-debugger/syntax-browser/pretty-helper.rkt +++ b/macro-debugger-text-lib/macro-debugger/syntax-browser/pretty-helper.rkt @@ -1,7 +1,7 @@ #lang racket/base (require racket/pretty racket/class/iop - unstable/struct + racket/struct "interfaces.rkt" "../model/stx-util.rkt") (provide (all-defined-out)) diff --git a/macro-debugger/macro-debugger/view/find.rkt b/macro-debugger/macro-debugger/view/find.rkt index f7e401e..ff8e069 100644 --- a/macro-debugger/macro-debugger/view/find.rkt +++ b/macro-debugger/macro-debugger/view/find.rkt @@ -1,6 +1,6 @@ #lang racket/base (require racket/contract/base - unstable/struct) + racket/struct) (provide/contract [find