Changeset 13463 in project


Ignore:
Timestamp:
03/03/09 05:32:31 (11 years ago)
Author:
Kon Lovett
Message:

Save

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/box/trunk/box.scm

    r13461 r13463  
    88  ; ##sys#procedure->string is redefined!
    99  (disable-warning redef)
    10   (import
     10  (bound-to-procedure
    1111    ##sys#signal-hook
    1212    ##sys#procedure->string)
    13   (bound-to-procedure
    14     ##sys#signal-hook
    15     ##sys#procedure->string) )
    16 
    17 (cond-expand
    18   (paranoia)
    19   (else
    20     (declare
    21       (no-procedure-checks)
    22       (no-bound-checks) ) ) )
     13  (no-procedure-checks)
     14  (no-bound-checks) )
    2315
    2416;;;
    2517
    26 (require-library lolevel)
    27 
    28 (module box ()
    29 
    30 (export
    31   make-box (make-box-variable ##box#finvar) (make-box-location ##box#finloc)
     18(require-library ports lolevel)
     19
     20(module box (
     21  make-box (make-box-variable finvar) (make-box-location finloc)
    3222  box? box-variable? box-location?
    3323  box-mutable? box-immutable?
     
    3929(import
    4030  scheme
    41   (only chicken set-sharp-read-syntax!)
     31  (only chicken
     32    and-let*
     33    getter-with-setter
     34    void
     35    set-sharp-read-syntax!
     36    ##sys#signal-hook
     37    ##sys#procedure->string)
     38  (only ports
     39    with-output-to-string)
    4240  (only lolevel
    4341    extend-procedure procedure-data
     
    5654;;
    5755
    58 (define (##box#finvar ref set)
     56(define (finvar ref set)
    5957  (extend-procedure
    6058        (lambda (proc)
     
    6260        'box-variable) )
    6361
    64 (define (##box#finloc ref set loc)
     62(define (finloc ref set loc)
    6563  (extend-procedure
    6664        (lambda (proc)
     
    7977
    8078(define (box-setter box)
    81   (obj (lambda (ref set loc) set)) )
     79  (box (lambda (ref set loc) set)) )
    8280
    8381(define (box-immutable-setter? setter)
     
    9492    ( (_ ?var #:immutable #f)
    9593      #;(identifier? ?var)
    96       (##box#finvar
     94      (finvar
    9795        (lambda () ?var)
    9896        (lambda (value) (set! ?var value))) )
    9997    ( (_ ?var #:immutable #t)
    10098      #;(identifier? ?var)
    101       (##box#finvar
     99      (finvar
    102100        (lambda () ?var)
    103101        (void)) ) ) )
     
    112110      #;(identifier? ?typ)
    113111      (let-location ( (var ?typ ?val) )
    114         (##box#finloc
     112        (finloc
    115113          (lambda () var)
    116114          (lambda (value) (set! var value))
     
    119117      #;(identifier? ?typ)
    120118      (let-location ( (var ?typ ?val) )
    121         (##box#finloc
     119        (finloc
    122120          (lambda () var)
    123121          (void)
     
    166164
    167165(define (box-mutable? obj)
    168         (not (box-immutable obj)) )
     166        (not (box-immutable? obj)) )
    169167
    170168;;
     
    173171  (cond
    174172    ( (record-instance? box)
    175       (case (block-ref obj 0)
     173      (case (block-ref box 0)
    176174        ( (box)
    177175          (set! (block-ref box 1) value) )
     
    203201  (cond
    204202    ( (box-structure? box)
    205       ((if weak make-weak-locative make-locative) box 1)
     203      ((if weak make-weak-locative make-locative) box 1) )
    206204    ( (box-procedure? box)
    207205      (box (lambda (ref set loc) (loc))) )
     
    227225                                        (##sys#procedure->string x) ) ) ) )
    228226
    229 )
     227) ;box
Note: See TracChangeset for help on using the changeset viewer.