Changeset 27291 in project


Ignore:
Timestamp:
08/24/12 16:28:36 (9 years ago)
Author:
felix winkelmann
Message:

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

Location:
release/4/typed-records
Files:
6 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/typed-records/tags/0.3/tests/t.scm

    r25652 r27291  
    5353
    5454  )
     55
     56;;; test by megane (#899):
     57
     58(define-record-type foo
     59  (make-foo bar)
     60  foo?
     61  (bar foo-bar foo-bar-set!))
     62
     63(display (make-foo 1))
     64(newline)
  • release/4/typed-records/tags/0.3/typed-records.scm

    r25652 r27291  
    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
  • release/4/typed-records/tags/0.3/typed-records.setup

    r25652 r27291  
    11;;;; typed-records.setup
    22
    3 (standard-extension 'typed-records 0.2)
     3(standard-extension 'typed-records 0.3)
  • release/4/typed-records/trunk/tests/t.scm

    r25652 r27291  
    5353
    5454  )
     55
     56;;; test by megane (#899):
     57
     58(define-record-type foo
     59  (make-foo bar)
     60  foo?
     61  (bar foo-bar foo-bar-set!))
     62
     63(display (make-foo 1))
     64(newline)
  • release/4/typed-records/trunk/typed-records.scm

    r25652 r27291  
    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
  • release/4/typed-records/trunk/typed-records.setup

    r25652 r27291  
    11;;;; typed-records.setup
    22
    3 (standard-extension 'typed-records 0.2)
     3(standard-extension 'typed-records 0.3)
Note: See TracChangeset for help on using the changeset viewer.