(binding) added by im in way over my head with this macro on Thu Nov 24 18:54:03 2011

(use test)

(define-syntax binding
  (syntax-rules ()
    ((binding ((key val) ...) code more-code ...)
     (let ((triplets (list (list 'key key val) ...)))
       (for-each (lambda (triplet)
                   (set! (car triplet) (caddr triplet)) ; of course this wont work
                   )
                 triplets)
       (let ((retval ((lambda () code more-code ...))))
         (for-each (lambda (triplet)
                     (set! (car triplet) (cadr triplet)) ; because its not like CL's (set)
                     )
                   triplets)
         retval
         )
       )
     )))

; but this doesnt work either, because "oldval" isnt bound per-"key" in the enumeration.
; is it possible to do that somehow?

;(define-syntax binding
;  (syntax-rules ()
;    ((binding ((key val) ...) code more-code ...)
;     (let ((oldvals '(key ...)))
;       (set! key val) ...
;       (let ((retval ((lambda ()
;                        code more-code ...))))
;         (for-each (lambda (oldval)
;                     )
;                   oldvals)
;         (set! key oldval) ...
;         retval)))))

(define (do-print-stuff)
  (print "hello world"))

(test-group "can rebind symbols temporarily"
  (test 42
        (binding ((list (lambda args 42)))
          (list 1 2 3)))
  (test 23
        (binding ((list (lambda args 23))
                  (car (lambda args 7)))
          (list 1 2 3)))
  (test 7
        (binding ((list (lambda args 42))
                  (car (lambda args 7)))
          (car '(55))))
  (test 4
        (binding ((print (lambda args (list 1 2 3))))
          (do-print-stuff))))

(test-group "can execute multiple bodies in thunk"
  (let* ((i 0)
         (string-val (binding ((list (lambda args "foo"))
                               (car (lambda args "bar")))
                       (print 42)
                       (string-append (list 1 2 3) (car '(4 5 6)))))
         )
    (test "foobar" string-val)
    ))

(test-group "resets symbols after (outside of) binding"
  (test '(1 2 3) (list 1 2 3))
  (test 9 (car (list 9 8 7))))

(test-exit)