Hijacking quasiquotation to construct contracts

quasicontracts.rkt

#lang racket

(require syntax/parse/define)

;; Let's define a quasiquoter that generates contracts.
(define-for-syntax quasiquote-contract
  (syntax-parser
    #:literals (unquote unquote-splicing)
    [(_ name:id) #''name]
    [(_ ,x:expr) #'x]
    [(_ ,@x:expr) (error "uh-oh, that's a weird place to put an unquote-splicing")]
    [(_ (x ... ,@tail)) #'(list*/c (quasiquote/c x) ... tail)]
    [(_ (x ...)) #'(list/c (quasiquote/c x) ...)]))

(define-syntax quasiquote/c quasiquote-contract)

;; Makes quasiquote invoke quasiquote/c.
(define-simple-macro (pixie-dust contract-expr)
  #:with quasiquote (datum->syntax #'contract-expr 'quasiquote)
  (let-syntax ([quasiquote quasiquote-contract]) contract-expr))

;; For example:
(pixie-dust `(+ ,number? ,number?))
; ==> (list/c '+ number? number?)

;; A simple macro for defining flat contracts, where quasiquotation uses
;; quasiquote/c.
(define-syntax-rule (define-flat-contracts [name contract ...] ...)
  (define-values (name ...)
    (flat-murec-contract ([name (pixie-dust contract) ...] ...)
     (values name ...))))

(define-syntax-rule (define-flat-contract name contract ...)
  (define-flat-contracts [name contract ...]))

;; For example, here's the syntax for the lambda calculus subset of Scheme:
(define-flat-contract term?
  symbol?
  `(lambda (,symbol?) ,term?)
  `(,term? ,term?))

;; ;; Without these macros, we'd need to write:
;; (define term?
;;   (flat-rec-contract term?
;;     symbol?
;;     (list/c 'lambda (list/c symbol?) term?)
;;     (list/c term? term?)))