Changeset 16026 in project


Ignore:
Timestamp:
09/22/09 04:16:43 (10 years ago)
Author:
Kon Lovett
Message:

Ehh, keep all one module.

Location:
release/4/synch/trunk
Files:
1 deleted
4 edited

Legend:

Unmodified
Added
Removed
  • release/4/synch/trunk/synch.meta

    r16025 r16026  
    1010 (files
    1111  "synch.scm"
    12   "synch-object.scm"
    1312  "synch.setup"
    1413  "tests") )
  • release/4/synch/trunk/synch.scm

    r16025 r16026  
    3636  %record/synch
    3737  %record-synch/lock
    38   %record-synch/unlock)
     38  %record-synch/unlock
     39  ;;
     40  make-object/synch
     41  object?/synch
     42  ;;
     43  define-constructor/synch
     44  define-predicate/synch
     45  (define-operation/synch check-mutex+object))
    3946
    4047  (import scheme
    41           (only chicken define-for-syntax optional
    42                         void unless warning gensym dynamic-wind)
    43           (only data-structures conc)
    44           (only srfi-18 thread? mutex-specific mutex-specific-set!
    45                         mutex-lock! mutex-unlock! mutex-state) )
    46 
    47   (require-library data-structures srfi-18)
     48          (only chicken
     49                define-for-syntax optional
     50                void unless warning gensym dynamic-wind)
     51          (only data-structures conc any?)
     52          (only srfi-18
     53                thread?
     54                make-mutex mutex?
     55                mutex-specific mutex-specific-set!
     56                mutex-lock! mutex-unlock!
     57                mutex-state)
     58          (only type-checks define-check+error-type) )
     59
     60  (require-library data-structures srfi-18 type-checks)
    4861
    4962;;;
    5063
    5164(define-for-syntax (recmuxnam nam) (string->symbol (conc nam #\- 'mutex)))
     65
    5266
    5367;;; Protected
     
    241255      (let ((?sym (cadr frm)) (?rec (caddr frm)) (?body (cdddr frm)))
    242256        `(,_synch/unlock (,(recmuxnam ?sym) ,?rec) ,@?body) ) ) ) )
     257
    243258
    244259;;; Unprotected
     
    416431        `(,_%synch/unlock (,(recmuxnam ?sym) ,?rec) ,@?body) ) ) ) )
    417432
     433
     434;;; Synch Object
     435
     436(define (mutex+object? obj) (and (mutex? obj) (not (eq? (void) (mutex-specific obj)))))
     437
     438(define-check+error-type mutex+object)
     439
     440;;
     441
     442(define (make-object/synch obj #!optional (name '(object/synch:)))
     443  (let ((mutex (make-mutex (if (pair? name) (gensym (car name)) name))))
     444    (mutex-specific-set! mutex obj)
     445    mutex) )
     446
     447(define (object?/synch obj #!optional (pred any?))
     448  (and (mutex+object? obj)
     449       (pred (mutex-specific obj))) )
     450
     451;;
     452
     453(define-for-syntax (synchsym sym) (string->symbol (string-append (symbol->string sym) "/synch")))
     454 
     455;;
     456
     457(define-syntax define-constructor/synch
     458  (lambda (frm rnm cmp)
     459    (let ((_define (rnm 'define))
     460          (_apply (rnm 'apply))
     461          (_make-object/synch (rnm 'make-object/synch)) )
     462      (let* ((prcnam (cadr frm))
     463             (id (if (not (null? (cddr frm))) `('(,(caddr frm))) '()))
     464             (newnam (synchsym prcnam)) )
     465        `(,_define (,newnam . args)
     466           (,_make-object/synch (,_apply ,prcnam args) ,@id)) ) ) ) )
     467 
     468;;
     469
     470(define-syntax define-predicate/synch
     471  (lambda (frm rnm cmp)
     472    (let ((_define (rnm 'define))
     473          (_object?/synch (rnm 'object?/synch)) )
     474      (let* ((prcnam (cadr frm))
     475             (newnam (synchsym prcnam)) )
     476        `(,_define (,newnam obj) (,_object?/synch obj ,prcnam)) ) ) ) )
     477
     478;;
     479
     480;operant must be the 1st argument
     481
     482(define-syntax define-operation/synch
     483  (lambda (frm rnm cmp)
     484    (let ((_define (rnm 'define))
     485          (_apply (rnm 'apply))
     486          (_let (rnm 'let))
     487          (_car (rnm 'car))
     488          (_cdr (rnm 'cdr))
     489          (_if (rnm 'if))
     490          (_pair? (rnm 'pair?))
     491          (_synch-with (rnm 'synch-with))
     492          (_check-mutex+object (rnm 'check-mutex+object)) )
     493      (let* ((prcnam (cadr frm))
     494             (newnam (synchsym prcnam)) )
     495        `(,_define (,newnam mtx+obj . args)
     496           (,_let ((mtx (,_if (,_pair? mtx+obj) (,_car mtx+obj) mtx+obj)))
     497             (,_check-mutex+object ',newnam mtx 'object/synch)
     498             (,_synch-with mtx+obj obj (,_apply ,prcnam obj args)))) ) ) ) )
     499
    418500) ;module synch
  • release/4/synch/trunk/synch.setup

    r16025 r16026  
    55(verify-extension-name 'synch)
    66
    7 (setup-shared-extension-module 'synch (extension-version "2.0.0"))
    8 
    9 (setup-shared-extension-module 'synch-object (extension-version "2.0.0")
     7(setup-shared-extension-module 'synch (extension-version "2.1.0")
    108  #:compile-options '(-fixnum-arithmetic
    119                      -optimize-level 3
  • release/4/synch/trunk/tests/run.scm

    r16025 r16026  
    1 (use srfi-18 srfi-69 synch synch-object miscmacros)
     1(use srfi-18 srfi-69 synch miscmacros)
    22
    33(define-record-type foo
Note: See TracChangeset for help on using the changeset viewer.