bkyk8rc3zvpnsf5inmcqq4n3k98cv6hj-my-site-hyper-literate-git.test.suzanne.soy-0.0.1

Unnamed repository; edit this file 'description' to name the repository.
Log | Files | Refs | README | LICENSE

manual-unit.rkt (2121B)

      1 #lang scheme/base
      2 (require "../decode.rkt"
      3          "../struct.rkt"
      4          "manual-vars.rkt"
      5          "manual-bind.rkt"
      6          "manual-ex.rkt"
      7          "manual-proc.rkt"
      8          racket/contract/base
      9          (for-syntax scheme/base)
     10          (for-label scheme/base))
     11 
     12 (provide defsignature
     13          defsignature/splice
     14          sigelem)
     15 
     16 (define-syntax-rule (defsignature name (super ...) body ...)
     17   (with-togetherable-racket-variables
     18    ()
     19    ()
     20    (*defsignature (quote-syntax name)
     21                   (list (quote-syntax super) ...)
     22                   (lambda () (list body ...))
     23                   #t)))
     24 
     25 (define-syntax-rule (defsignature/splice name (super ...) body ...)
     26   (with-togetherable-racket-variables
     27    ()
     28    ()
     29    (*defsignature (quote-syntax name)
     30                   (list (quote-syntax super) ...)
     31                   (lambda () (list body ...))
     32                   #f)))
     33 
     34 (define-struct sig-desc (in))
     35 (define (signature-desc . l)
     36   (make-sig-desc l))
     37 
     38 (provide/contract
     39  [signature-desc (() () #:rest (listof pre-flow?) . ->* . sig-desc?)])
     40 
     41 (define (*defsignature stx-id supers body-thunk indent?)
     42   (*defthing
     43    "signature"
     44    #t
     45    (list stx-id)
     46    (list (syntax-e stx-id))
     47    #t
     48    (list (make-element #f '("signature")))
     49    (lambda ()
     50      (define in
     51        (parameterize ([current-signature (make-sig stx-id)]) (body-thunk)))
     52      (if indent?
     53        (let-values ([(pre-body post-body)
     54                      (let loop ([in in][pre-accum null])
     55                        (cond [(null? in) (values (reverse pre-accum) null)]
     56                              [(whitespace? (car in))
     57                               (loop (cdr in) (cons (car in) pre-accum))]
     58                              [(sig-desc? (car in))
     59                               (loop (cdr in)
     60                                     (append (reverse (sig-desc-in (car in)))
     61                                             pre-accum))]
     62                              [else (values (reverse pre-accum) in)]))])
     63          `(,@pre-body
     64            ,(make-blockquote
     65              "leftindent"
     66              (flow-paragraphs (decode-flow post-body)))))
     67        in))))