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

File define-record-type-specializations.patch, 1.0 KB (added by megane, 8 years ago)
  • typed-records.scm

     
    135135                                        ctor))))
    136136                         (cdr ctor))
    137137                   (##sys#make-structure
    138                     ',name
    139                     ,@(map (lambda (a/m/t)
    140                              (cond ((memq (first a/m/t) (cdr ctor)) (first a/m/t))
     138                    ',name
     139                    ,@(let lp [(names (map first accs/mods/types))
     140                               (l '())]
     141                        (if (null? names)
     142                            (begin
     143                              (reverse l))
     144                            (cond ((list-index (cute eq? <> (first names)) (cdr ctor)) =>
     145                                   (lambda (ctor-idx) (lp (cdr names) (cons (vector (add1 ctor-idx)) l))))
     146                                  (else
    141147                                   ;; XXX this indicates a problem: the initial value
    142148                                   ;;     of the slot is not necessarily of type
    143149                                   ;;     undefined - should be make this an error?
    144                                    (else '(##core#undefined))))
    145                            accs/mods/types))))
     150                                   (lp (cdr names) (cons '(##core#undefined) l)))))))))
    146151         (,%colon ,pred (* -> boolean : (struct ,name)))
    147152         ,@(append-map
    148153            (lambda (a/m/t i)