[racket] possibility of defining recontract-all-from-out

From: Matthias Felleisen (matthias at ccs.neu.edu)
Date: Fri Sep 12 10:47:20 EDT 2014

Does this sketch help: 

#lang racket

;; define a header file language 
(module L racket
  ;; specification
  (provide export)
  ;; ----------------------------------------------
  ;; implementation 
  (define-syntax (export stx)
    (syntax-case stx ()
      [(_ file name ctc)
       #'(define-syntax (file stx)
           (syntax-case stx ()
             [(_) 
              ;; let's break hygiene here: 
              (let* ([x '(provide (contract-out (name ctc)))]
                     [y (datum->syntax stx x)])
                y)]))])))

;; -------------------------------------------------------
(module header-file racket
  (require (submod ".." L))
  (provide provide-stack)
  ;; -----------------------------------------------------
  (export provide-stack make (-> empty?)))

(module good-server racket 
  (require (submod ".." header-file))
  (provide-stack)
  ;; -----------------------------------------------------
  (define (make)
    '()))

(module bad-server racket 
  (require (submod ".." header-file))
  (provide-stack)
  ;; -----------------------------------------------------
  (define (make)
    "the empty stack"))

(module client racket 
  (provide
   (contract-out
    (test (-> (values string? string?)))))
  ;; -----------------------------------------------------
  (require (prefix-in good: (submod ".." good-server))
           (prefix-in bad: (submod ".." bad-server)))
  
  (define (test)
    (values 
     (with-handlers ((exn:fail:contract? (lambda (_) "passed")))
       (bad:make)
       "failed")
     (begin (good:make) "passed"))))

;; RUN BABY RUN 
(require 'client)
(test)
  
    
                
 

Posted on the users mailing list.