Changeset 38569 in project


Ignore:
Timestamp:
04/06/20 02:32:23 (13 months ago)
Author:
Kon Lovett
Message:

add types include, fix predicate types, reflow

Location:
release/5/box/trunk
Files:
1 added
3 edited

Legend:

Unmodified
Added
Removed
  • release/5/box/trunk/box-core.scm

    r38548 r38569  
    1717
    1818(;export
    19   make-box
    20   make-box-mutable
    21   make-box-immutable
    22   make-box-variable
    23   make-box-location
    24   box?
    25   box-variable?
    26   box-location?
    27   box-mutable?
    28   box-immutable?
    29   box-set!
    30   box-ref
     19  make-box make-box-mutable make-box-immutable make-box-variable make-box-location
     20  box? box-structure? box-variable? box-location?
     21  box-mutable? box-immutable?
     22  box-set! box-ref
     23  box-location
    3124  box-swap!
    32   box-location
    33   make-box-variable-closure
    34   make-box-location-closure
     25  make-box-variable-closure make-box-location-closure
    3526  ;
    36   *box-structure?
    37   *box-structure-ref
    38   *box-structure-set!
    39   *box-procedure?
    40   *box-procedure-ref
    41   *box-procedure-set!)
     27  *box-structure? *box-structure-ref *box-structure-set!
     28  *box-procedure? *box-procedure-ref *box-procedure-set!)
    4229
    4330(import scheme)
     
    5643;;
    5744
    58 (define-type box-struct (or (struct box) (struct box!)))
    59 (define-type box-closure ((* * * -> *) -> *))
    60 (define-type box (or box-struct box-closure))
     45(include "box.types")
    6146
    6247;;; Prelude
     
    7964
    8065(define-inline (%box-structure? obj)
    81   (or
    82     (box-structure-mutable? obj)
    83     (box-structure-immutable? obj)) )
     66  (or (box-structure-mutable? obj) (box-structure-immutable? obj)) )
    8467
    8568(define-inline (%box-structure-ref box)
    8669  (cond
    87     ((box-structure-mutable? box) (box-structure-mutable-value box))
     70    ((box-structure-mutable? box)   (box-structure-mutable-value box))
    8871    ((box-structure-immutable? box) (box-structure-immutable-value box)) ) )
    8972
    9073(define-inline (%box-structure-set! box val)
    9174  (cond
    92     ((box-structure-mutable? box) (box-structure-mutable-value-set! box val))
     75    ((box-structure-mutable? box)   (box-structure-mutable-value-set! box val))
    9376    ((box-structure-immutable? box) (box-structure-immutable-value-set! box val)) ) )
    9477
     
    9780;; Box Variable
    9881
    99 (define-inline (%box-variable-immutable-tag? obj)
    100   (eq? 'boxvar obj) )
    101 
    102 (define-inline (%box-variable-mutable-tag? obj)
    103   (eq? 'boxvar! obj) )
     82(define-inline (%box-variable-immutable-tag? obj) (eq? 'boxvar obj))
     83(define-inline (%box-variable-mutable-tag? obj)   (eq? 'boxvar! obj))
    10484
    10585(define-inline (%box-variable-tag? obj)
    106   (or
    107     (%box-variable-mutable-tag? obj)
    108     (%box-variable-immutable-tag? obj) ) )
     86  (or (%box-variable-mutable-tag? obj) (%box-variable-immutable-tag? obj)) )
    10987
    11088(define-inline (%box-variable? obj)
     
    11593;; Box Location
    11694
    117 (define-inline (%box-location-immutable-tag? obj)
    118   (eq? 'boxloc obj) )
    119 
    120 (define-inline (%box-location-mutable-tag? obj)
    121   (eq? 'boxloc! obj) )
     95(define-inline (%box-location-immutable-tag? obj) (eq? 'boxloc obj))
     96(define-inline (%box-location-mutable-tag? obj)   (eq? 'boxloc! obj))
    12297
    12398(define-inline (%box-location-tag? obj)
    124   (or
    125     (%box-location-mutable-tag? obj)
    126     (%box-location-immutable-tag? obj) ) )
     99  (or (%box-location-mutable-tag? obj) (%box-location-immutable-tag? obj)) )
    127100
    128101(define-inline (%box-location? obj)
     
    161134;; Box Procedure Operations
    162135
    163 (define-inline (%box-closure-ref box)
    164   (box (lambda (ref set loc) (ref))) )
    165 
    166 (define-inline (%box-closure-set! box obj)
    167   (box (lambda (ref set loc) (set obj))) )
    168 
    169 (define-inline (%box-closure-location box)
    170   (box (lambda (ref set loc) (loc))) )
     136(define-inline (%box-closure-ref box)       (box (lambda (ref set loc) (ref))))
     137(define-inline (%box-closure-set! box obj)  (box (lambda (ref set loc) (set obj))))
     138(define-inline (%box-closure-location box)  (box (lambda (ref set loc) (loc))))
    171139
    172140;;
    173141
    174 (define-inline (%box? obj)
    175   (or
    176     (%box-structure? obj)
    177     (%box-closure? obj)) )
     142(define-inline (%box? obj) (or (%box-structure? obj) (%box-closure? obj)))
    178143
    179144;; Errors
     
    185150
    186151(: make-box-variable-closure (boolean (-> *) (* -> void) -> box-closure))
    187 ;
     152(: make-box-location-closure (boolean (-> *) (* -> void) (-> locative) -> box-closure))
     153
    188154(define (make-box-variable-closure immutable? ref set)
    189155  (let (
    190156    (tag (if immutable? 'boxvar 'boxvar!)) )
    191157    (extend-procedure
    192       (lambda (proc)
    193         (proc ref set (lambda () (location (ref)))) )
     158      (lambda (proc) (proc ref set (lambda () (location (ref)))))
    194159      tag) ) )
    195160
    196 (: make-box-location-closure (boolean (-> *) (* -> void) (-> locative) -> box-closure))
    197 ;
    198161(define (make-box-location-closure immutable? ref set refloc)
    199162  (let (
     
    208171;; For use by high-performance routines (such as core routine replacements)
    209172
    210 (: *box-structure? (* -> boolean : box-struct))
    211 ;
    212 (define (*box-structure? obj)
    213   (%box-structure? obj) )
    214 
    215 (: *box-structure-ref (box-struct -> *))
    216 ;
    217 (define (*box-structure-ref box)
    218   (%box-structure-ref box) )
    219 
    220 (: *box-structure-set! (box-struct * -> void))
    221 ;
    222 (define (*box-structure-set! box val)
    223   (%box-structure-set! box val) )
    224 
    225 (: *box-procedure? (* -> boolean : box-closure))
    226 ;
    227 (define (*box-procedure? obj)
    228   (%box-closure? obj) )
    229 
    230 (: box-procedure-ref (box-closure -> *))
    231 ;
    232 (define (*box-procedure-ref box)
    233   (%box-closure-ref box) )
    234 
    235 (: *box-procedure-set! (box-closure * -> void))
    236 ;
    237 (define (*box-procedure-set! box val)
    238   (%box-closure-set! box val) )
    239 
    240 (: *box-ref (box -> *))
    241 ;
     173(: *box-structure?      (* -> boolean : box-struct))
     174(: *box-structure-ref   (box-struct -> *))
     175(: *box-structure-set!  (box-struct * -> void))
     176(: *box-procedure?      (* -> boolean : box-closure))
     177(: *box-procedure-ref   (box-closure -> *))
     178(: *box-procedure-set!  (box-closure * -> void))
     179(: *box-ref             (box -> *))
     180
     181(define (*box-structure? obj)           (%box-structure? obj))
     182(define (*box-structure-ref box)        (%box-structure-ref box))
     183(define (*box-structure-set! box val)   (%box-structure-set! box val))
     184(define (*box-procedure? obj)           (%box-closure? obj))
     185(define (*box-procedure-ref box)        (%box-closure-ref box))
     186(define (*box-procedure-set! box val)   (%box-closure-set! box val))
     187
    242188(define (*box-ref box)
    243189  (cond
     
    278224
    279225(: make-box (#!optional * boolean -> box-struct))
    280 ;
     226(: make-box-immutable (#!optional * -> box-struct))
     227(: make-box-mutable (#!optional * -> box-struct))
     228
    281229(define (make-box #!optional init immutable?)
    282230  (if immutable?
     
    284232    (make-box-structure-mutable init) ) )
    285233
    286 (: make-box-immutable (#!optional * -> box-struct))
    287 ;
    288 (define (make-box-immutable #!optional init)
    289   (make-box-structure-immutable init) )
    290 
    291 (: make-box-mutable (#!optional * -> box-struct))
    292 ;
    293 (define (make-box-mutable #!optional init)
    294   (make-box-structure-mutable init) )
     234(define (make-box-immutable #!optional init)  (make-box-structure-immutable init))
     235(define (make-box-mutable #!optional init)    (make-box-structure-mutable init))
    295236
    296237;; Predicates
    297238
    298 (: box? (* -> boolean : box))
    299 ;
    300 (define (box? obj)
    301   (%box? obj) )
    302 
    303 ;NOTE these are trait predicates, not type predicates, so not a (DOM -> RNG : TYPE)!
    304 
    305 (: box-variable? (* -> boolean))
    306 ;
    307 (define (box-variable? obj)
    308   (%box-variable? obj) )
    309 
    310 (: box-location? (* -> boolean))
    311 ;
    312 (define (box-location? obj)
    313   (%box-location? obj) )
    314 
    315 (: box-immutable? (* -> boolean))
    316 ;
    317 (define (box-immutable? obj)
    318   (or (box-structure-immutable? obj) (%box-closure-immutable? obj)) )
    319 
    320 (: box-mutable? (* -> boolean))
    321 ;
    322 (define (box-mutable? obj)
    323   (or (box-structure-mutable? obj) (%box-closure-mutable? obj)) )
    324 
    325 ;; Mutators
    326 
    327 
    328 (: box-set! (box * -> void))
    329 ;
     239(: box?           (* -> boolean : box))
     240(: box-structure? (* -> boolean : box-struct))
     241(: box-variable?  (* -> boolean : box-closure))
     242(: box-location?  (* -> boolean : box-closure))
     243(: box-immutable? (* -> boolean : box))
     244(: box-mutable?   (* -> boolean : box))
     245
     246(define (box? obj)            (%box? obj))
     247(define (box-structure? obj)  (%box-structure? obj))
     248(define (box-variable? obj)   (%box-variable? obj))
     249(define (box-location? obj)   (%box-location? obj))
     250(define (box-immutable? obj)  (or (box-structure-immutable? obj) (%box-closure-immutable? obj)))
     251(define (box-mutable? obj)    (or (box-structure-mutable? obj) (%box-closure-mutable? obj)))
     252
     253;; Accessors
     254
     255(: box-set!       (box * -> void))
     256(: box-ref        (box -> *))
     257(: box-location   (box #!optional boolean -> locative))
     258
    330259(define (box-set! box val)
    331260  (cond
     
    341270          (error-box 'box-set! box) ) ) ) ) )
    342271
    343 #; ;inlined version below
     272(define box-ref (getter-with-setter *box-ref box-set!))
     273
     274(define (box-location box #!optional (weak? #f))
     275  (cond
     276    ((%box-structure? box)
     277      ((if weak? make-weak-locative make-locative) box 1))
     278    ((%box-closure? box)
     279      (box (lambda (ref set loc) (loc))))
     280    (else
     281      (error-box 'box-location box)) ) )
     282
     283;; Operations
     284
     285(: box-swap! (box (* #!rest -> *) #!rest -> *))
     286
    344287(define (box-swap! box func . args)
    345   (let* (
    346     (oval (*box-ref box))
    347     (nval (apply func oval args)) )
     288  #; ;inlined version below
     289  (let ((nval (apply func (*box-ref box) args)))
    348290    (box-set! box nval)
    349     nval ) )
    350 
    351 (: box-swap! (box (* #!rest * -> *) #!rest * -> *))
    352 ;
    353 (define (box-swap! box func . args)
     291    nval )
    354292  (let* (
    355293    (oval
     
    372310    nval ) )
    373311
    374 ;; Assessors
    375 
    376 (: box-ref (box -> *))
    377 ;
    378 (define box-ref
    379   (getter-with-setter *box-ref box-set!))
    380 
    381 (: box-location (box #!optional boolean -> locative))
    382 ;
    383 (define (box-location box #!optional (weak? #f))
    384   (cond
    385     ((%box-structure? box)
    386       ((if weak? make-weak-locative make-locative) box 1))
    387     ((%box-closure? box)
    388       (box (lambda (ref set loc) (loc))))
    389     (else
    390       (error-box 'box-location box)) ) )
    391 
    392 ;;; Read/Print Syntax
     312;; Read/Print Syntax
     313
     314(: box-print (* output-port -> void))
    393315
    394316(define (box-print box port)
     
    402324          (display "#&" port) (write val port) ) )
    403325
    404 (set-sharp-read-syntax! #\&
    405   (lambda (p)
    406     (make-box-mutable (read p))))
     326(set-sharp-read-syntax! #\& (lambda (p) (make-box-mutable (read p))))
    407327
    408328(define-reader-ctor 'box make-box)
  • release/5/box/trunk/box.egg

    r38550 r38569  
    33
    44((synopsis "Boxing")
    5  (version "3.2.2")
     5 (version "3.2.3")
    66 (category data)
    77 (license "BSD")
     
    1010 (test-dependencies test)
    1111(components
     12  (scheme-include types.incl
     13   (files "box.types.scm"))
    1214  (extension box-core
    1315    (types-file)
    14     ;no -strict-types"; has generic returns; ex: make-box
     16    ;no -strict-types ; has generic returns; ex: make-box
    1517    (csc-options
    1618      "-O3" "-d1" "-local" "-no-procedure-checks-for-toplevel-bindings") )
  • release/5/box/trunk/tests/box-test.scm

    r38550 r38569  
    11;;;; box-test.scm  -*- Scheme -*-
     2;;;; Kon Lovett, Apr '20
    23;;;; Kon Lovett, Jul '18
    34
     
    1213(import (only (chicken port) with-output-to-string))
    1314(import (only (chicken memory representation) procedure-data))
     15
     16;should be there
     17(include "box.types")
    1418
    1519;;
Note: See TracChangeset for help on using the changeset viewer.