Changeset 36579 in project


Ignore:
Timestamp:
09/10/18 00:31:46 (2 months ago)
Author:
kon
Message:

remove record-variants dependency

Location:
release/5/mailbox/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/5/mailbox/trunk/mailbox.egg

    r36562 r36579  
    44((synopsis "Thread-safe queues with timeout")
    55 (category hell)
    6  (version "3.2.0")
     6 (version "3.3.0")
    77 (author "[[felix winkelman]] and [[kon lovett]]")
    88 (license "BSD")
    99 (dependencies
    1010        (srfi-1 "0.2")
    11         (srfi-18 "0.1")
    12         (record-variants "1.0"))
     11        (srfi-18 "0.1"))
    1312 (test-dependencies test)
    1413 (components
  • release/5/mailbox/trunk/mailbox.scm

    r36571 r36579  
    7272    current-thread
    7373    thread-signal! thread-sleep!
    74     thread-suspend! thread-resume!)
    75   (only record-variants define-record-type-variant))
     74    thread-suspend! thread-resume!))
    7675
    7776;;; Support
     77
     78;;record-variants, Jim Ursett
     79
     80(define-syntax define-record-type-variant
     81  (er-macro-transformer
     82   (lambda (form r c)
     83     (define (any p L)
     84       (and (pair? L)
     85            (or (p (car L))
     86                (any p (cdr L)))))
     87     (##sys#check-syntax 'define-record-type-variant form
     88                         '(_ _ #(variable 0)
     89                             #(variable 1) _ . _))
     90     (let* ((name-spec (cadr form))
     91            (name (if (pair? name-spec) (car name-spec) name-spec))
     92            (t (if (pair? name-spec) (cadr name-spec) name-spec))
     93            (variant? (lambda (type) (any (lambda (x) (c x (r type)))
     94                                          (caddr form))))
     95            (unsafe? (variant? 'unsafe))
     96            (unchecked? (variant? 'unchecked))
     97            (inline? (variant? 'inline))
     98            (constructor? (eq? name t))
     99
     100            (conser (cadddr form))
     101            (predspec (car (cddddr form)))
     102            (pred (if (pair? predspec) (car predspec) predspec))
     103            (checker (if (and (pair? predspec)
     104                              (pair? (cdr predspec)))
     105                         (cadr predspec) #f))
     106            (slots (cdr (cddddr form)))
     107            (%begin (r 'begin))
     108            (%lambda (r 'lambda))
     109            (%define (if inline? (r 'define-inline) (r 'define)))
     110            (vars (cdr conser))
     111            (x (r 'x))
     112            (y (r 'y))
     113            (%getter-with-setter (r 'getter-with-setter))
     114            (slotnames (map car slots)))
     115       `(,%begin
     116         ,(if constructor?
     117              `(,%define ,conser
     118                         (##sys#make-structure
     119                          ',t
     120                          ,@(map (lambda (sname)
     121                                   (if (memq sname vars)
     122                                       sname
     123                                       '(##core#undefined)))
     124                                 slotnames)))
     125              `(,%begin))
     126         (,%define (,pred ,x) (##sys#structure? ,x ',t))
     127         ,(if checker
     128              `(,%define (,checker ,x)
     129                         (##core#check (##sys#check-structure ,x ',t)))
     130              `(,%begin))
     131         ,@(let loop ([slots slots] [i 1])
     132             (if (null? slots)
     133                 '()
     134                 (let* ([slot (car slots)]
     135                        (setters (memq #:record-setters ##sys#features))
     136                        (setr? (pair? (cddr slot)))
     137                        (getr `(,%lambda (,x)
     138                                         ,(if unchecked?
     139                                              `(,%begin)
     140                                              `(##core#check
     141                                                (##sys#check-structure ,x ',t)))
     142                                         ,(if unsafe?
     143                                              `(##sys#slot ,x ,i)
     144                                              `(##sys#block-ref ,x ,i)))))
     145                   `(,@(if setr?
     146                           `((,%define (,(caddr slot) ,x ,y)
     147                                       ,(if unchecked?
     148                                            `(,%begin)
     149                                            `(##core#check
     150                                              (##sys#check-structure ,x ',t)))
     151                                       ,(if unsafe?
     152                                            `(##sys#setslot ,x ,i ,y)
     153                                            `(##sys#block-set! ,x ,i ,y))))
     154                           '())
     155                     (,%define ,(cadr slot)
     156                               ,(if (and setr? setters)
     157                                    `(,%getter-with-setter ,getr ,(caddr slot))
     158                                    getr) )
     159                     ,@(loop (cdr slots) (add1 i)))))))))))
    78160
    79161;;
Note: See TracChangeset for help on using the changeset viewer.