define-record-type patch start... pasted by megane on Fri Aug 17 22:40:49 2012
Index: typed-records.scm =================================================================== --- typed-records.scm (revision 27258) +++ typed-records.scm (working copy) @@ -136,13 +136,15 @@ (cdr ctor)) (##sys#make-structure ',name - ,@(map (lambda (a/m/t) - (cond ((memq (first a/m/t) (cdr ctor)) (first a/m/t)) + ,@(map (lambda (a/m/t i) + (cond ((memq (first a/m/t) (cdr ctor)) + (vector (add1 i))) ;; XXX this indicates a problem: the initial value ;; of the slot is not necessarily of type ;; undefined - should be make this an error? (else '(##core#undefined)))) - accs/mods/types)))) + accs/mods/types + (iota (length accs/mods/types)))))) (,%colon ,pred (* -> boolean : (struct ,name))) ,@(append-map (lambda (a/m/t i)
define-record-type 2nd try added by megane on Sat Aug 18 10:47:07 2012
Index: typed-records.scm =================================================================== --- typed-records.scm (revision 27258) +++ typed-records.scm (working copy) @@ -135,14 +135,19 @@ ctor)))) (cdr ctor)) (##sys#make-structure - ',name - ,@(map (lambda (a/m/t) - (cond ((memq (first a/m/t) (cdr ctor)) (first a/m/t)) + ',name + ,@(let lp [(names (map first accs/mods/types)) + (l '())] + (if (null? names) + (begin + (reverse l)) + (cond ((list-index (cute eq? <> (first names)) (cdr ctor)) => + (lambda (ctor-idx) (lp (cdr names) (cons (vector (add1 ctor-idx)) l)))) + (else ;; XXX this indicates a problem: the initial value ;; of the slot is not necessarily of type ;; undefined - should be make this an error? - (else '(##core#undefined)))) - accs/mods/types)))) + (lp (cdr names) (cons '(##core#undefined) l))))))))) (,%colon ,pred (* -> boolean : (struct ,name))) ,@(append-map (lambda (a/m/t i)