Remove dependency on unstable/struct
.
This commit is contained in:
parent
3d9dfe7948
commit
d76396e362
|
@ -1,7 +1,7 @@
|
||||||
#lang racket/base
|
#lang racket/base
|
||||||
(require racket/match
|
(require racket/match
|
||||||
macro-debugger/model/deriv
|
macro-debugger/model/deriv
|
||||||
unstable/struct
|
racket/struct
|
||||||
"util.rkt")
|
"util.rkt")
|
||||||
(provide deriv->refs)
|
(provide deriv->refs)
|
||||||
|
|
||||||
|
|
|
@ -1,7 +1,6 @@
|
||||||
#lang racket/base
|
#lang racket/base
|
||||||
(require (for-syntax racket/base)
|
(require (for-syntax racket/base racket/struct-info)
|
||||||
racket/match
|
racket/match
|
||||||
unstable/struct
|
|
||||||
"deriv.rkt")
|
"deriv.rkt")
|
||||||
|
|
||||||
(provide make
|
(provide make
|
||||||
|
@ -66,3 +65,42 @@
|
||||||
(define (wderivlist-es2 xs)
|
(define (wderivlist-es2 xs)
|
||||||
(let ([es2 (map wderiv-e2 xs)])
|
(let ([es2 (map wderiv-e2 xs)])
|
||||||
(and (andmap syntax? es2) es2)))
|
(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)))]))
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
#lang racket/base
|
#lang racket/base
|
||||||
(require racket/pretty
|
(require racket/pretty
|
||||||
racket/class/iop
|
racket/class/iop
|
||||||
unstable/struct
|
racket/struct
|
||||||
"interfaces.rkt"
|
"interfaces.rkt"
|
||||||
"../model/stx-util.rkt")
|
"../model/stx-util.rkt")
|
||||||
(provide (all-defined-out))
|
(provide (all-defined-out))
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
#lang racket/base
|
#lang racket/base
|
||||||
(require racket/contract/base
|
(require racket/contract/base
|
||||||
unstable/struct)
|
racket/struct)
|
||||||
|
|
||||||
(provide/contract
|
(provide/contract
|
||||||
[find
|
[find
|
||||||
|
|
Loading…
Reference in New Issue
Block a user