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)