[plt-scheme] Problem with macro generated provide/contract
The approach works nicely. I have a small problem
blaming the right module though.
Here is a small example with stacks.
(module macro-utilities mzscheme
(provide with-captures)
(define-syntax (with-captures stx)
(syntax-case stx ()
[(_ so (name ...) body)
#'(with-syntax
([name (datum->syntax-object so 'name)]
...)
body)])))
(module stack-signature mzscheme
(require-for-syntax "macro-utilities.scm")
(provide provide-stack)
(define-syntax (provide-stack stx)
(syntax-case stx ()
[(_)
(with-captures stx (empty head pop push stack?)
(syntax/loc stx
(begin
(require (lib "contract.ss"))
(define stack/c
(flat-named-contract 'stack stack?))
(define boolean/c
(flat-named-contract 'boolean boolean?))
; this didn't work
(provide/contract
(empty stack/c)
(head (-> stack/c any/c))
(push (-> any/c stack/c stack/c))
(pop (-> stack/c any/c))
(stack? (-> any/c boolean/c))))))])))
(module simple-stack mzscheme
(require stack-signature)
(define empty '())
(define (stack? o)
(or (null? o) (pair? o)))
(define push cons)
(define pop cdr)
(define head car)
(provide-stack)
)
(require simple-stack)
(push 42 empty)
(module better-stack mzscheme
(require stack-signature
(prefix simple: simple-stack))
(define-struct stack (simple-stack) (make-inspector))
(define empty (make-stack simple:empty))
(define (head s)
(simple:head (stack-simple-stack s)))
(define (push x s)
(make-stack (simple:push x (stack-simple-stack s))))
(define (pop s)
(simple:pop (stack-simple-stack s)))
(provide-stack))
(print-struct #t)
(require better-stack)
(push 42 empty)
(module super-stack mzscheme
(require stack-signature
(prefix better: better-stack))
(define-struct stack (size better-stack) (make-inspector))
(define empty (make-stack 0 better:empty))
(define (head s)
(better:head (stack-better-stack s)))
(define (push x s)
(make-stack (add1 (size s))
(better:push x (stack-better-stack s))))
(define (pop s)
(make-stack (sub1 (size s))
(better:pop (stack-better-stack s))))
(define (size s)
(stack-size s))
(provide-stack)
(provide size))
(require super-stack)
(require (prefix better: better-stack))
(push 42 43)
The last line breaks the contract on push.
The error message is:
87:2: top-level broke the contract (-> any/c stack stack) it had with
stack-signature on push; expected <stack>, given: 43
Is there a way to get the provide/contract in the definition of
provide-stack to know, where the (provide-set) is used? I.e. to
get an error message mentioning super-stack in stead of stack-signature.
--
Jens Axel Søgaard