[plt-scheme] Problem with macro generated provide/contract

From: Jens Axel Søgaard (jensaxel at soegaard.net)
Date: Sun Nov 6 12:09:38 EST 2005

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




Posted on the users mailing list.