50 lines
1.6 KiB
Scheme
50 lines
1.6 KiB
Scheme
(module mrflow mzscheme
|
|
(require (lib "pretty.ss")
|
|
(lib "contract.ss")
|
|
(lib "mred.ss" "mred"))
|
|
|
|
(provide (all-from mzscheme)
|
|
;(all-from-except mzscheme vector-ref)
|
|
;(rename dbg-vector-ref vector-ref)
|
|
|
|
(all-from-except (lib "contract.ss") provide/contract define/contract)
|
|
; one or the other
|
|
provide/contract define/contract
|
|
;(rename dbg-provide/contract provide/contract)(rename dbg-define-contract define/contract)
|
|
|
|
non-negative-exact-integer?
|
|
text%?
|
|
style-delta%?
|
|
)
|
|
|
|
(define-syntax (dbg-provide/contract stx)
|
|
(syntax-case stx (struct)
|
|
[(_) #'(provide)]
|
|
[(_ (id contract) other ...)
|
|
#'(begin (provide id) (dbg-provide/contract other ...))]
|
|
[(_ (struct id ((field contract) ...)) other ...)
|
|
#'(begin (provide (struct id (field ...))) (dbg-provide/contract other ...))])
|
|
)
|
|
|
|
(define-syntax (dbg-define/contract stx)
|
|
(syntax-case stx ()
|
|
[(_ name contract body) #'(define name body)]))
|
|
|
|
(define-syntax dbg-vector-ref
|
|
(lambda (stx)
|
|
(syntax-case stx ()
|
|
[(_ args ...)
|
|
#`(begin
|
|
(printf "~a ~a ~a ~a~n"
|
|
#,(syntax-source stx)
|
|
#,(syntax-line stx)
|
|
#,(syntax-column stx)
|
|
#,(syntax-original? stx))
|
|
(#,#'vector-ref args ...))])))
|
|
|
|
(define non-negative-exact-integer? (and/c integer? exact? (>=/c 0)))
|
|
(define text%? (is-a?/c text%))
|
|
(define style-delta%? (is-a?/c style-delta%))
|
|
|
|
)
|