Changeset 27291 in project for release/4/typed-records/trunk/typed-records.scm

Timestamp:

08/24/12 16:28:36 (9 years ago)

Author:

felix winkelmann

Message:

typed-records 0.3: appled fix for #899 (by megane)

File:

• release/4/typed-records/trunk/typed-records.scm (modified) (1 diff)

release/4/typed-records/trunk/typed-records.scm

@@ -136 +136 @@
                          (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