with-slots probably dumb pasted by C-Keen on Thu Oct 2 15:39:07 2014

(define-syntax
  let-slots
  (ir-macro-transformer
   (lambda (e i c)
     (let* ((slots (caadr e))
            (struct-name (car (cadadr e)))
            (struct (cadr (cadadr e)))
            (body (cddr e)))
       `(let ,(map (lambda (s)
                     `(,(i s) (,(symbol-append (i struct-name) '- (i s)) ,struct)))
                    slots)
          ,@(i body))))))

What's the problem with this? pasted by C-Keen on Thu Oct 9 21:10:08 2014


(define-syntax with-state/copy
  (syntax-rules ()
    ((_ state body ...)
     (lambda (state)
       (let ((state (object-copy state)))
         body ...
         state)))))

(define-syntax
  let-slots
  (ir-macro-transformer
   (lambda (e i c)
     (let* ((slots (caadr e))
            (struct-name (cadadr e))
            (struct (car (cddadr e)))
            (body (cddr e)))
       `(let ,(map (lambda (s)
                     `(,(i s) (,(symbol-append (i struct-name) '- (i s)) ,struct)))
                    slots)
          ,@(i body))))))



Used like 

(define-record s foo bar baz)
(define s2 (make-s 1 2 3))

((with-state/copy s
 (let-slots ((foo bar) s s2)
    (print "~a ~a" foo bar))) s2)



without module declaration this compiles... added by C-Keen on Fri Oct 10 23:26:53 2014

(module foo ()
        (import chicken scheme)
        (use lolevel)

        (define-syntax
          let-slots
          (ir-macro-transformer
           (lambda (e i c)
             (let* ((slots (caadr e))
                    (struct-name (cadadr e))
                    (struct (car (cddadr e)))
                    (body (cddr e)))
               `(let ,(map (lambda (s)
                             `(,(i s) (,(symbol-append (i struct-name) '- (i s)) ,struct)))
                           slots)
                  ,@(i body))))))

        (define-record state prompt in out offset line pos return cols max-row)


        (define (prompt-loop ps)
          (let-slots ((pos line in out return) state ps)
                     ps)))