Remove dependency on unstable/struct.

This commit is contained in:
Vincent St-Amour 2015-08-19 14:13:42 -05:00
parent 3d9dfe7948
commit d76396e362
4 changed files with 43 additions and 5 deletions

View File

@ -1,7 +1,7 @@
#lang racket/base
(require racket/match
macro-debugger/model/deriv
unstable/struct
racket/struct
"util.rkt")
(provide deriv->refs)

View File

@ -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)))]))

View File

@ -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))

View File

@ -1,6 +1,6 @@
#lang racket/base
(require racket/contract/base
unstable/struct)
racket/struct)
(provide/contract
[find