www

commit d76396e362207124c2805fa79153dcd88ccfee5f
parent 3d9dfe794812d9fdee2bbf2a29496ecffd9ff016
Author: Vincent St-Amour <stamourv@racket-lang.org>
Date:   Wed, 19 Aug 2015 14:13:42 -0500

Remove dependency on `unstable/struct`.

Diffstat:
M
macro-debugger-text-lib/macro-debugger/analysis/private/get-references.rkt
 | 
2
+-
M
macro-debugger-text-lib/macro-debugger/model/deriv-util.rkt
 | 
42
++++++++++++++++++++++++++++++++++++++++--
M
macro-debugger-text-lib/macro-debugger/syntax-browser/pretty-helper.rkt
 | 
2
+-
M
macro-debugger/macro-debugger/view/find.rkt
 | 
2
+-

4 files changed, 43 insertions(+), 5 deletions(-)
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
@@ -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
@@ -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
@@ -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
@@ -1,6 +1,6 @@
 #lang racket/base
 (require racket/contract/base
-         unstable/struct)
+         racket/struct)
 
 (provide/contract
  [find