thin-provisioning-tools/functional-tests/utils.scm

71 lines
1.6 KiB
Scheme
Raw Normal View History

2017-08-21 14:29:45 +05:30
(library
(utils)
(export inc!
dec!
swap!
slurp-file
chomp
hotpatch-sym
indirect-lambda
set-lambda!
dlambda)
(import (chezscheme)
(only (srfi s1 lists) drop-while))
2017-08-21 14:29:45 +05:30
(define-syntax inc!
(syntax-rules ()
((_ v) (set! v (+ 1 v)))
((_ v n) (set! v (+ n v)))))
(define-syntax dec!
(syntax-rules ()
((_ v) (set! v (- v 1)))
((_ v n) (set! v (- v n)))))
(define-syntax swap!
(syntax-rules ()
((_ x y)
(let ((tmp x))
(set! x y)
(set! y tmp)))))
(define (slurp-file path)
(define (slurp)
(let ((output (get-string-all (current-input-port))))
(if (eof-object? output)
output
(chomp output))))
(with-input-from-file path slurp))
(define (chomp line)
(list->string
(reverse
(drop-while char-whitespace?
(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))
(define-syntax dlambda
(syntax-rules ()
((_ (name params b1 b2 ...) ...)
(lambda (m . args)
(apply (case m
[(name) (lambda params b1 b2 ...)] ...)
args)))))
2017-08-21 14:29:45 +05:30
)