82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
|
`((: ,name (#!rest (or symbol ,@(uniq types)) --> ,name ))
(define (,name . args)
(define (safe-vector-ref v i) (if (null? v) (error "all struct fields need to be specified unless functional record update syntax is in use")
(vector-ref v i)))
(let* ([basis (if (,(symsuf name "?") (car args)) (cdar args) '())]
[spec (if (null? basis) args (cdr args))])
(cons (quote ,typesym)
(vector ,@(reduce-flds 0 fields)
))))))
(let* ([name (car body)]
[fields (cdr body)]
[typesym (gensym)]
[types (map extract-type fields)])
(append (emit-pred name typesym)
(emit-def name types)
(emit-gen name types typesym fields)
(reduce-fields name 0 fields))))
|
|
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
|
`((: ,name (#!rest (or symbol ,@(uniq types)) --> ,name ))
(define (,name . args)
(define (safe-vector-ref v i) (if (null? v) (error "all struct fields need to be specified unless functional record update syntax is in use")
(vector-ref v i)))
(let* ([basis (if (,(symsuf name "?") (car args)) (cdar args) '())]
[spec (if (null? basis) args (cdr args))])
(cons (quote ,typesym)
(vector ,@(reduce-flds 0 fields)))))))
(let* ([name (car body)]
[fields (cdr body)]
[typesym (gensym)]
[types (map extract-type fields)])
(append (emit-pred name typesym)
(emit-def name types)
(emit-gen name types typesym fields)
(reduce-fields name 0 fields))))
|