72 lines
2.5 KiB
Scheme
72 lines
2.5 KiB
Scheme
#lang scheme
|
|
|
|
(require scribble/basic
|
|
(for-syntax scheme/port)
|
|
scheme/include
|
|
(except-in scribble/manual link))
|
|
|
|
(provide ctc-section
|
|
ctc-link
|
|
exercise
|
|
solution
|
|
external-file)
|
|
|
|
(define (ctc-section #:tag [tag #f] . rest)
|
|
(keyword-apply section
|
|
'(#:tag)
|
|
(list (and tag (str->tag tag)))
|
|
rest))
|
|
|
|
(define (ctc-link tag . rest) (apply seclink (str->tag tag) rest))
|
|
|
|
(define (str->tag tag) (format "contracts-~a" tag))
|
|
|
|
(define exercise-number 0)
|
|
(define (exercise)
|
|
(set! exercise-number (+ exercise-number 1))
|
|
(bold (format "Exercise ~a" exercise-number)))
|
|
|
|
(define (solution)
|
|
(bold (format "Solution to exercise ~a" exercise-number)))
|
|
|
|
#;
|
|
(define-syntax (external-file stx)
|
|
(syntax-case stx ()
|
|
[(_ filename)
|
|
(call-with-input-file (build-path "contracts-examples" (format "~a.ss" (syntax-e #'filename)))
|
|
(λ (port)
|
|
(define prefix "#reader scribble/comment-reader\n[schememod\nscheme\n")
|
|
(define suffix "]")
|
|
(with-syntax ([s (parameterize ([read-accept-reader #t])
|
|
(read-syntax 'contract-examples
|
|
(input-port-append #f
|
|
(open-input-string prefix)
|
|
port
|
|
(open-input-string suffix))))])
|
|
#'s)))]))
|
|
|
|
(require (for-syntax (only-in scribble/comment-reader [read-syntax comment-reader])))
|
|
(define-for-syntax (comment-schememod-reader path port)
|
|
(let ([pb (peek-byte port)])
|
|
(if (eof-object? pb)
|
|
pb
|
|
(let ([m (regexp-match #rx"^#lang " port)])
|
|
(unless m
|
|
(raise-syntax-error 'comment-scheme-reader "expected a #lang to begin file ~s" path))
|
|
(let ([np (let-values ([(line col pos) (port-next-location port)])
|
|
(relocate-input-port port line 0 pos))])
|
|
(port-count-lines! np)
|
|
(let loop ([objects '()])
|
|
(let ([next (comment-reader path np)])
|
|
(cond
|
|
[(eof-object? next)
|
|
#`(schememod #,@(reverse objects))]
|
|
[else
|
|
(loop (cons next objects))]))))))))
|
|
|
|
(define-syntax (external-file stx)
|
|
(syntax-case stx ()
|
|
[(_ filename)
|
|
#`(include/reader #,(format "contracts-examples/~a.ss" (syntax-e #'filename))
|
|
comment-schememod-reader)]))
|