Ticket #899: define-record-type-specializations.patch

typed-records.scm

@@ -135 +135 @@
                                         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)