Changeset 37656 in project for release/5/mailbox/trunk/mailbox.scm


Ignore:
Timestamp:
06/07/19 07:11:37 (7 weeks ago)
Author:
kon
Message:

#1581, add arg chks

File:
1 edited

Legend:

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

    r37559 r37656  
    2525;; - Probably should be rewritten to use a mutex & condition-variable rather than
    2626;; disabling interrupts and having own thread waiting queue.
     27;;
     28;; -
    2729
    2830(declare
     
    8890;;record-variants, Jim Ursett
    8991
     92;the identifier needs to be defined by somebody
     93(define queue)
     94(define mailbox)
     95(define mailbox-cursor)
     96
    9097(define-syntax define-record-type-variant
    9198  (er-macro-transformer
     
    101108            (name (if (pair? name-spec) (car name-spec) name-spec))
    102109            (t (if (pair? name-spec) (cadr name-spec) name-spec))
    103             ;FIXME (current-module) is #f
    104             (module-name 'mailbox)
    105             (struct-name
    106               (string->symbol
    107                 (string-append (symbol->string module-name) "#" (symbol->string t))))
    108110            (variant? (lambda (type) (any (lambda (x) (c x (r type)))
    109111                                          (caddr form))))
     
    132134              `(,%define ,conser
    133135                         (##sys#make-structure
    134                           ',struct-name
     136                          ,t
    135137                          ,@(map (lambda (sname)
    136138                                   (if (memq sname vars)
     
    139141                                 slotnames)))
    140142              `(,%begin))
    141          (,%define (,pred ,x) (##sys#structure? ,x ',struct-name))
     143         (,%define (,pred ,x) (##sys#structure? ,x ,t))
    142144         ,(if checker
    143145              `(,%define (,checker ,x)
    144                          (##core#check (##sys#check-structure ,x ',struct-name)))
     146                         (##core#check (##sys#check-structure ,x ,t)))
    145147              `(,%begin))
    146148         ,@(let loop ([slots slots] [i 1])
     
    154156                                              `(,%begin)
    155157                                              `(##core#check
    156                                                 (##sys#check-structure ,x ',struct-name)))
     158                                                (##sys#check-structure ,x ,t)))
    157159                                         ,(if unsafe?
    158160                                              `(##sys#slot ,x ,i)
     
    163165                                            `(,%begin)
    164166                                            `(##core#check
    165                                               (##sys#check-structure ,x ',struct-name)))
     167                                              (##sys#check-structure ,x ,t)))
    166168                                       ,(if unsafe?
    167169                                            `(##sys#setslot ,x ,i ,y)
Note: See TracChangeset for help on using the changeset viewer.