source: project/release/4/lookup-table/trunk/chicken-primitive-srfi-9.scm @ 14484

Last change on this file since 14484 was 14484, checked in by Kon Lovett, 11 years ago

Save.

File size: 1.4 KB
Line 
1;;;; chicken-primitive-srfi-9.scm.scm
2;;;; Kon Lovett, Apr '09
3
4;needs (include "chicken-primitive-object-inlines")
5
6;; SRFI-9 workalike w/o record type checking, immediate reference, and inline procedures.
7
8(define-syntax define-record-type/unsafe-inline-unchecked
9  (lambda (form rename compare)
10    (let ((_begin (rename 'begin))
11          (_define-inline (rename 'define-inline)) )
12      (let ((tag (cadr form))
13            (conser (caddr form))
14            (pred (cadddr form))
15            (slots (cddddr form)) )
16        (let ((vars (cdr conser)))
17          `(,_begin
18             (,_define-inline ,conser
19               (%make-structure ',tag ,@(map (lambda (sname)
20                                               (if (memq (car sname) vars) (car sname)
21                                                   '(%undefined-value)) )
22                                           slots) ) )
23             (,_define-inline (,pred x) (%structure-instance? x ',tag))
24             ,@(let loop ((slots slots) (i 1))
25                 (if (null? slots) '()
26                     (let ((slot (car slots)))
27                       `(,@(if (null? (cddr slot)) '()
28                               `((define-inline (,(caddr slot) x y) (%structure-set! x ,i y))))
29                         (,_define-inline (,(cadr slot) x) (%structure-ref x ,i) )
30                         ,@(loop (cdr slots) (add1 i)) ) ) ) ) ) ) ) ) ) )
Note: See TracBrowser for help on using the repository browser.