Changeset 39702 in project


Ignore:
Timestamp:
03/14/21 17:08:10 (3 months ago)
Author:
Kon Lovett
Message:

doesn't require record-variants (regression)

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

Legend:

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

    r39700 r39702  
    55((synopsis "Thread-safe queues with timeout")
    66 (category hell)
    7  (version "3.3.7")
     7 (version "3.3.8")
    88 (author "[[felix winkelman]] and [[kon lovett]]")
    99 (license "BSD")
    10  (dependencies srfi-1 srfi-18 record-variants)
     10 (dependencies srfi-1 srfi-18)
    1111 (test-dependencies test)
    1212 (components
  • release/5/mailbox/trunk/mailbox.scm

    r39700 r39702  
    7272    current-thread
    7373    thread-signal! thread-sleep!
    74     thread-suspend! thread-resume!)
    75   record-variants)
     74    thread-suspend! thread-resume!))
    7675
    7776;;; Support
     77
     78;;record-variants
     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;;miscmacros
     
    109191
    110192;;
    111 
    112 (define-inline (%delq! x ls0)
    113   ;(assert (proper-list? ls0))
    114   (let find-elm ((ls ls0) (ppr #f))
    115     (cond ((null? ls)
    116            ls0 )
    117           ((eq? x (car ls))
    118            (cond (ppr
    119                   (set-cdr! ppr (cdr ls))
    120                   ls0 )
    121                  (else
    122                   (cdr ls) ) ) )
    123           (else
    124            (find-elm (cdr ls) ls) ) ) ) )
    125193
    126194(define-inline (%thread-blocked? th) (eq? 'blocked (##sys#slot th 3)))
     
    238306
    239307(define-inline (%mailbox-waiters-delete! mb th)
    240   (%mailbox-waiters-set! mb (%delq! th (%mailbox-waiters mb))) )
     308  (%mailbox-waiters-set! mb (delete! th (%mailbox-waiters mb))) )
    241309
    242310(define-inline (%mailbox-waiters-pop! mb)
Note: See TracChangeset for help on using the changeset viewer.