[functional-tests] add indirect-lambda/set-lambda! to (utils)
This commit is contained in:
parent
52ab4c4958
commit
e5ca0bc5e1
@ -4,7 +4,11 @@
|
|||||||
dec!
|
dec!
|
||||||
swap!
|
swap!
|
||||||
slurp-file
|
slurp-file
|
||||||
chomp)
|
chomp
|
||||||
|
hotpatch-sym
|
||||||
|
indirect-lambda
|
||||||
|
set-lambda!)
|
||||||
|
|
||||||
(import (chezscheme)
|
(import (chezscheme)
|
||||||
(only (srfi s1 lists) drop-while))
|
(only (srfi s1 lists) drop-while))
|
||||||
|
|
||||||
@ -40,4 +44,19 @@
|
|||||||
(drop-while char-whitespace?
|
(drop-while char-whitespace?
|
||||||
(reverse (string->list line))))))
|
(reverse (string->list line))))))
|
||||||
|
|
||||||
|
(define hotpatch-sym (gensym))
|
||||||
|
|
||||||
|
(define-syntax indirect-lambda
|
||||||
|
(syntax-rules ()
|
||||||
|
((_ params b1 b2 ...)
|
||||||
|
(let ((this (lambda params b1 b2 ...)))
|
||||||
|
(lambda args
|
||||||
|
(if (and (= (length args) 2)
|
||||||
|
(eq? (car args) hotpatch-sym))
|
||||||
|
(set! this (cadr args))
|
||||||
|
(apply this args)))))))
|
||||||
|
|
||||||
|
(define (set-lambda! fn new-fn)
|
||||||
|
(fn hotpatch-sym new-fn))
|
||||||
|
|
||||||
)
|
)
|
||||||
|
Loading…
Reference in New Issue
Block a user