restart lib
original commit: 140a263d37f62dd231a8ba3a1c3a5a86d6d2c8d2
This commit is contained in:
commit
ebe3ed0e6c
|
@ -197,22 +197,29 @@
|
|||
[(f init l) (fold-one f init l)]
|
||||
[(f init l . ls) (fold-n f init (cons l ls))]))))
|
||||
|
||||
(define make-find
|
||||
(lambda (name whole-list?)
|
||||
(polymorphic
|
||||
(lambda (f list)
|
||||
(unless (and (procedure? f)
|
||||
(procedure-arity-includes? f 1))
|
||||
(raise-type-error name "procedure (arity 1)" f))
|
||||
(let loop ([l list])
|
||||
(cond
|
||||
[(null? l) #f]
|
||||
[(not (pair? l))
|
||||
(raise (make-exn:application:list
|
||||
(format "~a: second argument must be a (proper) list; given ~e" name list)
|
||||
((debug-info-handler))
|
||||
list))]
|
||||
[(f (car l)) (if whole-list? l (car l))]
|
||||
[else (loop (cdr l))]))))))
|
||||
|
||||
(define assf
|
||||
(polymorphic
|
||||
(lambda (f list)
|
||||
(unless (and (procedure? f)
|
||||
(procedure-arity-includes? f 1))
|
||||
(raise-type-error 'assf "procedure (arity 1)" f))
|
||||
(let loop ([l list])
|
||||
(cond
|
||||
[(null? l) #f]
|
||||
[(not (pair? l))
|
||||
(raise (make-exn:application:list
|
||||
(format "assf: second argument must be a (proper) list; given ~e" list)
|
||||
((debug-info-handler))
|
||||
list))]
|
||||
[(f (car l)) (car l)]
|
||||
[else (loop (cdr l))])))))
|
||||
(make-find 'assf #f))
|
||||
|
||||
(define memf
|
||||
(make-find 'memf #t))
|
||||
|
||||
(define filter
|
||||
(polymorphic
|
||||
|
|
|
@ -1,43 +1,2 @@
|
|||
|
||||
(let ([load (current-load)]
|
||||
[load-extension (current-load-extension)]
|
||||
[tab ""])
|
||||
(let ([mk-chain
|
||||
(lambda (load)
|
||||
(lambda (filename)
|
||||
(fprintf (current-error-port)
|
||||
"~aloading ~a at ~a~n"
|
||||
tab filename (current-process-milliseconds))
|
||||
(begin0
|
||||
(let ([s tab])
|
||||
(dynamic-wind
|
||||
(lambda () (set! tab (string-append " " tab)))
|
||||
(lambda ()
|
||||
(if (regexp-match "_loader" filename)
|
||||
(let ([f (load filename)])
|
||||
(lambda (sym)
|
||||
(fprintf (current-error-port)
|
||||
"~atrying ~a~n" tab sym)
|
||||
(let ([loader (f sym)])
|
||||
(and loader
|
||||
(lambda ()
|
||||
(fprintf (current-error-port)
|
||||
"~astarting ~a at ~a~n" tab sym
|
||||
(current-process-milliseconds))
|
||||
(let ([s tab])
|
||||
(begin0
|
||||
(dynamic-wind
|
||||
(lambda () (set! tab (string-append " " tab)))
|
||||
(lambda () (loader))
|
||||
(lambda () (set! tab s)))
|
||||
(fprintf (current-error-port)
|
||||
"~adone ~a at ~a~n"
|
||||
tab sym
|
||||
(current-process-milliseconds)))))))))
|
||||
(load filename)))
|
||||
(lambda () (set! tab s))))
|
||||
(fprintf (current-error-port)
|
||||
"~adone ~a at ~a~n"
|
||||
tab filename (current-process-milliseconds)))))])
|
||||
(current-load (mk-chain load))
|
||||
(current-load-extension (mk-chain load-extension))))
|
||||
(invoke-unit/sig (require-relative-library "traceldr.ss"))
|
||||
|
|
Loading…
Reference in New Issue
Block a user