id	summary	reporter	owner	description	type	status	priority	milestone	component	version	resolution	keywords	cc	difficulty
1355	define strips hygiene from defined identifiers at top-level	Alex Shinn		"The following program with tests passes in chibi and scheme48, but fails in chicken.  The expander handles inserted ""tmp"" identifiers and disambiguates correctly for readers and predicates, but it appears define-record-type treats all the setters the same.

{{{
(cond-expand
 (chibi (import (scheme base) (chibi test)))
 (chicken (use test)))

;; other (,open srfi-9 srfi-23 in scheme48)
;; (define (read-string k in)
;;   (let lp ((i k) (res '()))
;;     (if (zero? i)
;;         (list->string (reverse res))
;;         (lp (- i 1) (cons (read-char in) res)))))
;; (define (test-begin) #f) (define (test-end) #f)
;; (define (test e x)
;;   (if (not (equal? e x))
;;       (error ""test failed"" e '!= x)))

;; utility primitive type consisting of a predicate, reader and writer

(define-syntax define-binary-type
  (syntax-rules ()
    ((define-binary-type name pred reader writer)
     (define-syntax name
       (syntax-rules (pred: read: write:)
         ((name pred: args) (pred args))
         ((name read: args) (reader args))
         ((name write: args) (writer args)))))))

;; a fixed-length string

(define-binary-type fixed-string
  (lambda (args)
    (let ((len (car args)))
      (lambda (x) (and (string? x) (= (string-length x) len)))))
  (lambda (args)
    (let ((len (car args)))
      (lambda (in)
        (read-string len in))))
  (lambda (args)
    (lambda (str out)
      (write-string str out))))

;; wrapper around define-record-type to provide type checking and
;; (de)serialization

(define-syntax defrec
  (syntax-rules ()
    ;; all fields processed: expand record, reader and setters
    ((defrec name (make . make-fields) pred reader ()
       (field (type . args) read-field get %set set) ...)
     (begin
       (define-record-type name (make . make-fields) pred
         (field get %set) ...)
       (define set
         (let ((field? (type pred: 'args)))
           (lambda (x val)
             (if (not (field? val))
                 (error ""invalid field"" '(type . args) val))
             (%set x val))))
       ...
       (define reader
         (let ((read-field (type read: 'args)) ...)
           (lambda (in)
             (let ((field (read-field in)) ...)
               (make . make-fields)))))))
    ;; step: insert read-field and %set bindings
    ((defrec name make pred reader
       ((field (type . args) get set) . rest)
       fields ...)
     (defrec name make pred reader rest fields ...
       (field (type . args) read-field get %set set)))))

(define-syntax define-binary-record-type
  (syntax-rules ()
    ((define-binary-record-type name make pred reader . fields)
     (defrec name make pred reader fields))))

;; example

(define-binary-record-type stuff (make-stuff foo bar) stuff?
  read-stuff
  (foo (fixed-string 2) stuff-foo stuff-foo-set!)
  (bar (fixed-string 3) stuff-bar stuff-bar-set!))

(test-begin)
(let ((x (make-stuff ""ab"" ""bar"")))
  (test ""ab"" (stuff-foo x))
  (test ""bar"" (stuff-bar x))
  (stuff-foo-set! x ""xy"")    ;; <----- this checks the right field type
                             ;;        but uses the sets the wrong %set
  (test ""xy"" (stuff-foo x))
  (test ""bar"" (stuff-bar x)))
(test-end)
}}}
"	defect	new	major	6.0.0	expander	4.12.0		hygiene		hard