Changeset 34402 in project


Ignore:
Timestamp:
08/27/17 04:10:51 (3 months ago)
Author:
kon
Message:

re-flow

File:
1 edited

Legend:

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

    r34151 r34402  
    88;;
    99;; - Note that 'procedure-data' returns #f for anything other than an extended-procedure.
    10 
    11 ;;; Module box
    1210
    1311(module box
     
    4038(require-library ports lolevel)
    4139
    42 (import
    43   (only type-errors
    44     define-error-type) )
     40(import (only type-errors define-error-type) )
    4541(require-library type-errors)
    4642
     
    4945    ##sys#signal-hook
    5046    ##sys#procedure->string ) )
     47
     48;;;
    5149
    5250(define-type box-struct (or (struct box) (struct box!)))
     
    8987;;; Box Structure Support
    9088
    91 (define-inline (%make-box tag init) (%make-structure tag init))
    92 
    93 (define-inline (%box-structure-mutable? obj) (%structure-instance? obj 'box!))
    94 (define-inline (%box-structure-immutable? obj) (%structure-instance? obj 'box))
     89(define-inline (%make-box tag init)
     90  (%make-structure tag init) )
     91
     92(define-inline (%box-structure-mutable? obj)
     93  (%structure-instance? obj 'box!) )
     94
     95(define-inline (%box-structure-immutable? obj)
     96  (%structure-instance? obj 'box) )
    9597
    9698(define-inline (%box-structure? obj)
     
    98100       (%fx= 2 (%structure-length obj)) ) )
    99101
    100 (define-inline (%box-structure-tag obj) (and (%box-structure? obj) (%structure-tag obj)))
    101 
    102 (define-inline (%box-structure-ref box) (%structure-ref box 1))
    103 (define-inline (%box-structure-set! box obj) (%structure-set! box 1 obj))
     102(define-inline (%box-structure-tag obj)
     103  (and (%box-structure? obj) (%structure-tag obj)) )
     104
     105(define-inline (%box-structure-ref box)
     106  (%structure-ref box 1) )
     107
     108(define-inline (%box-structure-set! box obj)
     109  (%structure-set! box 1 obj) )
    104110
    105111;;; Box Procedure Support
     
    107113;; Box Variable
    108114
    109 (define-inline (%box-variable-immutable-tag? obj) (%eq? 'boxvar obj))
    110 (define-inline (%box-variable-mutable-tag? obj) (%eq? 'boxvar! obj))
     115(define-inline (%box-variable-immutable-tag? obj)
     116  (%eq? 'boxvar obj) )
     117
     118(define-inline (%box-variable-mutable-tag? obj)
     119  (%eq? 'boxvar! obj) )
    111120
    112121(define-inline (%box-variable-tag? obj)
     
    119128;; Box Location
    120129
    121 (define-inline (%box-location-immutable-tag? obj) (%eq? 'boxloc obj))
    122 (define-inline (%box-location-mutable-tag? obj) (%eq? 'boxloc! obj))
     130(define-inline (%box-location-immutable-tag? obj)
     131  (%eq? 'boxloc obj) )
     132
     133(define-inline (%box-location-mutable-tag? obj)
     134  (%eq? 'boxloc! obj) )
    123135
    124136(define-inline (%box-location-tag? obj)
     
    131143;; Box Procedure
    132144
    133 (define-inline (%box-closure-tag? obj) (or (%box-variable-tag? obj) (%box-location-tag? obj)))
     145(define-inline (%box-closure-tag? obj)
     146  (or (%box-variable-tag? obj) (%box-location-tag? obj)) )
    134147
    135148(define-inline (%box-closure-tag obj)
     
    138151    dat ) )
    139152
    140 (define-inline (%box-closure? obj) (%->boolean (%box-closure-tag obj)))
     153(define-inline (%box-closure? obj)
     154  (%->boolean (%box-closure-tag obj)) )
    141155
    142156(define-inline (%box-closure-immutable? obj)
     
    150164;; Box Procedure Operations
    151165
    152 (define-inline (%box-closure-ref box) (box (lambda (ref set loc) (ref))))
    153 (define-inline (%box-closure-set! box obj) (box (lambda (ref set loc) (set obj))))
    154 (define-inline (%box-closure-location box) (box (lambda (ref set loc) (loc))))
     166(define-inline (%box-closure-ref box)
     167  (box (lambda (ref set loc) (ref))) )
     168
     169(define-inline (%box-closure-set! box obj)
     170  (box (lambda (ref set loc) (set obj))) )
     171
     172(define-inline (%box-closure-location box)
     173  (box (lambda (ref set loc) (loc))) )
    155174
    156175;;
    157176
    158 (define-inline (%box? obj) (or (%box-structure? obj) (%box-closure? obj)))
     177(define-inline (%box? obj)
     178  (or (%box-structure? obj) (%box-closure? obj)) )
    159179
    160180;; Errors
     
    179199
    180200(define ($finvar tag ref set)
    181   (extend-procedure (lambda (proc) (proc ref set (lambda () (location (ref))))) tag))
     201  (extend-procedure
     202    (lambda (proc)
     203      (proc ref set (lambda () (location (ref)))) )
     204    tag) )
    182205
    183206(define ($finloc tag ref set loc)
    184   (extend-procedure (lambda (proc) (proc ref set loc)) tag))
     207  (extend-procedure
     208    (lambda (proc) (proc ref set loc) )
     209    tag) )
    185210
    186211;;; Box
     
    189214;; For use by high-performance routines (such as core routine replacements)
    190215
    191 (define (*box-structure? obj) (%box-structure? obj))
    192 (define (*box-structure-ref box) (%box-structure-ref box))
    193 (define (*box-structure-set! box val) (%box-structure-set! box val))
    194 
    195 (define (*box-procedure? obj) (%box-closure? obj))
    196 (define (*box-procedure-ref box) (%box-closure-ref box))
    197 (define (*box-procedure-set! box val) (%box-closure-set! box val))
     216(define (*box-structure? obj)
     217  (%box-structure? obj) )
     218
     219(define (*box-structure-ref box)
     220  (%box-structure-ref box) )
     221
     222(define (*box-structure-set! box val)
     223  (%box-structure-set! box val) )
     224
     225(define (*box-procedure? obj)
     226  (%box-closure? obj) )
     227
     228(define (*box-procedure-ref box)
     229  (%box-closure-ref box) )
     230
     231(define (*box-procedure-set! box val)
     232  (%box-closure-set! box val) )
    198233
    199234(define (*box-ref box)
     
    237272;; Predicates
    238273
    239 (define (box? obj) (%box? obj))
    240 
    241 (define (box-variable? obj) (%box-variable? obj))
    242 
    243 (define (box-location? obj) (%box-location? obj))
     274(define (box? obj)
     275  (%box? obj) )
     276
     277(define (box-variable? obj)
     278  (%box-variable? obj) )
     279
     280(define (box-location? obj)
     281  (%box-location? obj) )
    244282
    245283(define (box-immutable? obj)
     
    254292  (case (%box-structure-tag box)
    255293    ((box!)
    256       (%box-structure-set! box val))
     294      (%box-structure-set! box val) )
    257295    ((box)
    258       (error-box-mutable 'box-set! box))
     296      (error-box-mutable 'box-set! box) )
    259297    (else
    260298      (case (%box-closure-tag box)
    261299        ((boxvar! boxloc!)
    262           (%box-closure-set! box val))
     300          (%box-closure-set! box val) )
    263301        ((boxvar boxloc)
    264           (error-box-mutable 'box-set! box))
     302          (error-box-mutable 'box-set! box) )
    265303        (else
    266304          (error-box 'box-set! box) ) ) ) ) )
     
    268306#; ;Inline version below
    269307(define (box-swap! box func . args)
    270   (let* ((oval (*box-ref box))
    271          (nval (apply func oval args)) )
     308  (let* ((oval (*box-ref box) )
     309         (nval (apply func oval args) ) )
    272310    (box-set! box nval)
    273311    nval ) )
     
    280318        (case btag
    281319          ((box!)
    282             (%box-structure-ref box))
     320            (%box-structure-ref box) )
    283321          ((box)
    284             (error-box-mutable 'box-swap! box))
     322            (error-box-mutable 'box-swap! box) )
    285323          (else
    286324            (case (%box-closure-tag box)
    287325              ((boxvar! boxloc!)
    288                 (%box-closure-ref box))
     326                (%box-closure-ref box) )
    289327              ((boxvar boxloc)
    290                 (error-box-mutable 'box-swap! box))
     328                (error-box-mutable 'box-swap! box) )
    291329              (else
    292330                (error-box 'box-swap! box) ) ) ) ) )
     
    295333    (case btag
    296334      ((box!)
    297         (%box-structure-set! box nval))
     335        (%box-structure-set! box nval) )
    298336      (else
    299337        (%box-closure-set! box nval) ) )
     
    333371;;; Read/Print Syntax
    334372
    335 (set-sharp-read-syntax! #\& (lambda (p) (make-box (read p))))
     373(set-sharp-read-syntax! #\&
     374  (lambda (p)
     375    (make-box (read p))))
    336376
    337377(define-reader-ctor 'box make-box)
Note: See TracChangeset for help on using the changeset viewer.