tracer for multiple values is added

This commit is contained in:
Abdulaziz Ghuloum 2006-12-05 15:08:00 -05:00
parent c5e1221ace
commit 276f317885
5 changed files with 74 additions and 31 deletions

View File

@ -94,11 +94,41 @@ setlocal nowinfixwidth
setlocal wrap
setlocal wrapmargin=0
silent! normal! zE
let s:l = 3 - ((2 * winheight(0) + 15) / 31)
2,22fold
24,234fold
236,390fold
392,493fold
495,593fold
595,672fold
674,691fold
693,708fold
710,727fold
729,744fold
2
normal zc
24
normal zc
236
normal zc
392
normal zc
495
normal zc
595
normal zc
674
normal zc
693
normal zc
710
normal zc
729
normal zc
let s:l = 1 - ((0 * winheight(0) + 16) / 32)
if s:l < 1 | let s:l = 1 | endif
exe s:l
normal! zt
3
1
normal! 0
let &so = s:so_save | let &siso = s:siso_save
doautoall SessionLoadPost

View File

@ -1,5 +1,6 @@
let s:so_save = &so | let s:siso_save = &siso | set so=0 siso=0
argglobal
setlocal noarabic
setlocal autoindent
setlocal autoread
setlocal nobinary
@ -48,6 +49,7 @@ setlocal indentexpr=
setlocal indentkeys=0{,0},:,0#,!^F,o,O,e
setlocal noinfercase
setlocal iskeyword=33,35-39,42-58,60-90,94,95,97-122,126,_
setlocal keymap=
setlocal keywordprg=
setlocal nolinebreak
setlocal lisp
@ -65,6 +67,8 @@ setlocal nopreserveindent
setlocal nopreviewwindow
setlocal quoteescape=\\
setlocal noreadonly
setlocal norightleft
setlocal rightleftcmd=search
setlocal noscrollbind
setlocal shiftwidth=2
setlocal noshortname
@ -179,11 +183,11 @@ normal zc
normal zc
3951
normal zc
let s:l = 1 - ((0 * winheight(0) + 10) / 20)
let s:l = 16 - ((15 * winheight(0) + 15) / 31)
if s:l < 1 | let s:l = 1 | endif
exe s:l
normal! zt
1
16
normal! 0
let &so = s:so_save | let &siso = s:siso_save
doautoall SessionLoadPost

Binary file not shown.

View File

@ -29,14 +29,25 @@
(dynamic-wind
(lambda () (set! k* (cons f k*)))
(lambda ()
(let ([v
(call/cf
(lambda (nf)
(set! f nf)
(set-car! k* nf)
(apply proc args)))])
(display-trace k* v)
v))
(call-with-values
(lambda ()
(call/cf
(lambda (nf)
(set! f nf)
(set-car! k* nf)
(apply proc args))))
(lambda v*
(display-prefix k* #t)
(unless (null? v*)
(write (car v*))
(let f ([v* (cdr v*)])
(cond
[(null? v*) (newline)]
[else
(write-char #\space)
(write (car v*))
(f (cdr v*))])))
(apply values v*))))
(lambda () (set! k* (cdr k*))))]))))))
(define traced-symbols '())

View File

@ -3,25 +3,23 @@
(lambda (x)
(define (enumerate fld* i)
(syntax-case fld* ()
[() #'()]
[(x . x*)
(with-syntax ([i i] [i* (enumerate #'x* (fx+ i 1))])
#'(i . i*))]))
[() #'()]
[(x . x*)
(with-syntax ([i i] [i* (enumerate #'x* (fx+ i 1))])
#'(i . i*))]))
(define (generate-body ctxt cls*)
(syntax-case cls* (else)
[() (with-syntax ([x x]) #'(error #f "unmatched ~s in ~s" v #'x))]
[([else b b* ...]) #'(begin b b* ...)]
[([(rec-name rec-field* ...) b b* ...] . rest) (identifier? #'rec-name)
(with-syntax ([altern (generate-body ctxt #'rest)]
[(id* ...) (enumerate #'(rec-field* ...) 0)]
[rtd #'(type-descriptor rec-name)])
#'(if ($record/rtd? v rtd)
;((record-predicate rtd) v)
(let ([rec-field* ($record-ref v id*)] ...)
; ((record-field-accessor rtd id*) v)] ...)
b b* ...)
altern))]))
[() (with-syntax ([x x]) #'(error #f "unmatched ~s in ~s" v #'x))]
[([else b b* ...]) #'(begin b b* ...)]
[([(rec-name rec-field* ...) b b* ...] . rest) (identifier? #'rec-name)
(with-syntax ([altern (generate-body ctxt #'rest)]
[(id* ...) (enumerate #'(rec-field* ...) 0)]
[rtd #'(type-descriptor rec-name)])
#'(if ($record/rtd? v rtd)
(let ([rec-field* ($record-ref v id*)] ...)
b b* ...)
altern))]))
(syntax-case x ()
[(_ expr cls* ...)
(with-syntax ([body (generate-body #'_ #'(cls* ...))])
#'(let ([v expr]) body))])))
[(_ expr cls* ...)
(with-syntax ([body (generate-body #'_ #'(cls* ...))])
#'(let ([v expr]) body))])))