Changeset 37658 in project


Ignore:
Timestamp:
06/07/19 07:15:43 (6 months ago)
Author:
Kon Lovett
Message:

add dep

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

Legend:

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

    r37656 r37658  
    44((synopsis "Thread-safe queues with timeout")
    55 (category hell)
    6  (version "3.3.3")
     6 (version "3.3.4")
    77 (author "[[felix winkelman]] and [[kon lovett]]")
    88 (license "BSD")
    99 (dependencies
    1010        (srfi-1 "0.2")
    11         (srfi-18 "0.1"))
     11        (srfi-18 "0.1")
     12        (record-variants "1.1"))
    1213 (test-dependencies test)
    1314 (components
  • release/5/mailbox/trunk/mailbox.scm

    r37656 r37658  
    7474    current-thread
    7575    thread-signal! thread-sleep!
    76     thread-suspend! thread-resume!))
     76    thread-suspend! thread-resume!)
     77  record-variants)
    7778
    7879;;; Support
     
    8889        (lambda (k) e0 e1 ...)))))
    8990
    90 ;;record-variants, Jim Ursett
     91;;record-variants
    9192
    9293;the identifier needs to be defined by somebody
     
    9495(define mailbox)
    9596(define mailbox-cursor)
    96 
    97 (define-syntax define-record-type-variant
    98   (er-macro-transformer
    99    (lambda (form r c)
    100      (define (any p L)
    101        (and (pair? L)
    102             (or (p (car L))
    103                 (any p (cdr L)))))
    104      (##sys#check-syntax 'define-record-type-variant form
    105                          '(_ _ #(variable 0)
    106                              #(variable 1) _ . _))
    107      (let* ((name-spec (cadr form))
    108             (name (if (pair? name-spec) (car name-spec) name-spec))
    109             (t (if (pair? name-spec) (cadr name-spec) name-spec))
    110             (variant? (lambda (type) (any (lambda (x) (c x (r type)))
    111                                           (caddr form))))
    112             (unsafe? (variant? 'unsafe))
    113             (unchecked? (variant? 'unchecked))
    114             (inline? (variant? 'inline))
    115             (constructor? (eq? name t))
    116 
    117             (conser (cadddr form))
    118             (predspec (car (cddddr form)))
    119             (pred (if (pair? predspec) (car predspec) predspec))
    120             (checker (if (and (pair? predspec)
    121                               (pair? (cdr predspec)))
    122                          (cadr predspec) #f))
    123             (slots (cdr (cddddr form)))
    124             (%begin (r 'begin))
    125             (%lambda (r 'lambda))
    126             (%define (if inline? (r 'define-inline) (r 'define)))
    127             (vars (cdr conser))
    128             (x (r 'x))
    129             (y (r 'y))
    130             (%getter-with-setter (r 'getter-with-setter))
    131             (slotnames (map car slots)))
    132        `(,%begin
    133          ,(if constructor?
    134               `(,%define ,conser
    135                          (##sys#make-structure
    136                           ,t
    137                           ,@(map (lambda (sname)
    138                                    (if (memq sname vars)
    139                                        sname
    140                                        '(##core#undefined)))
    141                                  slotnames)))
    142               `(,%begin))
    143          (,%define (,pred ,x) (##sys#structure? ,x ,t))
    144          ,(if checker
    145               `(,%define (,checker ,x)
    146                          (##core#check (##sys#check-structure ,x ,t)))
    147               `(,%begin))
    148          ,@(let loop ([slots slots] [i 1])
    149              (if (null? slots)
    150                  '()
    151                  (let* ([slot (car slots)]
    152                         (setters (memq #:record-setters ##sys#features))
    153                         (setr? (pair? (cddr slot)))
    154                         (getr `(,%lambda (,x)
    155                                          ,(if unchecked?
    156                                               `(,%begin)
    157                                               `(##core#check
    158                                                 (##sys#check-structure ,x ,t)))
    159                                          ,(if unsafe?
    160                                               `(##sys#slot ,x ,i)
    161                                               `(##sys#block-ref ,x ,i)))))
    162                    `(,@(if setr?
    163                            `((,%define (,(caddr slot) ,x ,y)
    164                                        ,(if unchecked?
    165                                             `(,%begin)
    166                                             `(##core#check
    167                                               (##sys#check-structure ,x ,t)))
    168                                        ,(if unsafe?
    169                                             `(##sys#setslot ,x ,i ,y)
    170                                             `(##sys#block-set! ,x ,i ,y))))
    171                            '())
    172                      (,%define ,(cadr slot)
    173                                ,(if (and setr? setters)
    174                                     `(,%getter-with-setter ,getr ,(caddr slot))
    175                                     getr) )
    176                      ,@(loop (cdr slots) (add1 i)))))))))))
    17797
    17898;;
Note: See TracChangeset for help on using the changeset viewer.