Changeset 13692 in project


Ignore:
Timestamp:
03/12/09 06:36:37 (11 years ago)
Author:
Kon Lovett
Message:

Use of core immutable.

Location:
release/4/stack
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/stack/tags/2.0.0/stack.scm

    r13654 r13692  
    2929;;; Stack Support
    3030
    31 (define-inline (%make-stack)
    32   (%make-structure 'stack '() 0) )
     31(define-inline (%make-stack) (%make-structure 'stack '() 0))
    3332
    3433(define-inline (%stack? obj)
    35   (%structure-instance? obj 'stack) )
     34  (and (%structure-instance? obj 'stack) (%fx= 3 (%structure-length obj))))
    3635
    3736;; Stack List
    3837
    39 (define-inline (%stack-list stk)
    40   (%structure-ref stk 1) )
    41 
    42 (define-inline (%stack-list-set! stk ls)
    43   (%structure-set!/maybe-immediate stk 1 ls) )
    44 
    45 (define-inline (%stack-list-empty? stk)
    46   (%null? (%stack-list stk)) )
    47 
    48 (define-inline (%stack-list-empty! stk)
    49   (%structure-set!/immediate stk 1 '()) )
     38(define-inline (%stack-list stk) (%structure-ref stk 1))
     39
     40(define-inline (%stack-list-empty? stk) (%null? (%stack-list stk)))
     41
     42(define-inline (%stack-list-set! stk ls) (%structure-set! stk 1 ls))
     43
     44(define-inline (%stack-list-empty! stk) (%structure-set!/immediate stk 1 '()))
    5045
    5146;; Stack Count
    5247
    53 (define-inline (%stack-count stk)
    54   (%structure-ref stk 2) )
    55 
    56 (define-inline (%stack-count-set! stk cnt)
    57   (%structure-set!/immediate stk 2 cnt) )
    58 
    59 (define-inline (%stack-count-inc! stk cnt)
    60   (%stack-count-set! stk (%fx+ (%stack-count stk) cnt)) )
    61 
    62 (define-inline (%stack-count-dec! stk cnt)
    63   (%stack-count-set! stk (%fx- (%stack-count stk) cnt)) )
     48(define-inline (%stack-count stk) (%structure-ref stk 2))
     49
     50(define-inline (%stack-count-set! stk cnt) (%structure-set!/immediate stk 2 cnt))
     51
     52(define-inline (%stack-count-inc! stk cnt) (%stack-count-set! stk (%fx+ (%stack-count stk) cnt)))
     53
     54(define-inline (%stack-count-dec! stk cnt) (%stack-count-set! stk (%fx- (%stack-count stk) cnt)))
    6455
    6556;; Stack Operations
    6657
    67 (define-inline (%stack-empty? stk)
    68   (%stack-list-empty? stk) )
     58(define-inline (%stack-empty? stk) (%stack-list-empty? stk))
    6959
    7060(define-inline (%stack-empty! stk)
     
    8878(define-inline (%stack-node-ref loc stk idx)
    8979  (let ((pr (%list-pair-ref (%stack-list stk) idx)))
    90                 (if (not (%null? pr)) pr
    91                           (##sys#signal-hook #:bounds-error loc "out of range" idx 0 (%stack-count stk)) ) ) )
     80                (if (%pair? pr) pr
     81                          (##sys#signal-hook #:bounds-error loc (##core#immutable '"out of range") idx 0 (%stack-count stk)) ) ) )
    9282
    9383
    9484;;; Helpers
    9585
    96 (define-inline (%check-index loc obj from to)
    97         (##sys#check-range obj from to loc) )
     86(define-inline (%check-index loc obj from to) (##sys#check-range obj from to loc))
    9887
    9988(define-inline (%check-stack loc obj)
    10089        (unless (%stack? obj)
    101           (##sys#signal-hook #:type-error loc "bad argument type - not a stack" obj) ) )
    102 
    103 (define-inline (%check-list loc obj)
    104   (##sys#check-list obj loc) )
     90          (##sys#signal-hook #:type-error loc (##core#immutable '"bad argument type - not a stack") obj) ) )
     91
     92(define-inline (%check-list loc obj) (##sys#check-list obj loc))
    10593
    10694(define-inline (%check-stack-underflow loc stk)
    10795        (when (%stack-empty? stk)
    108           (##sys#signal-hook #:limit-error loc "stack underflow" stk) ) )
    109 
    110 (define-inline (%check-exact loc obj)
    111   (##sys#check-exact obj loc) )
     96          (##sys#signal-hook #:limit-error loc (##core#immutable '"stack underflow") stk) ) )
     97
     98(define-inline (%check-exact loc obj) (##sys#check-exact obj loc))
    11299
    113100
     
    141128    with-output-to-port) )
    142129
    143 (define (make-stack)
    144         (%make-stack) )
     130(define (make-stack) (%make-stack))
    145131
    146132(define (list->stack ls)
     
    151137    stk ) )
    152138
    153 (define (stack? obj)
    154         (%stack? obj) )
     139(define (stack? obj) (%stack? obj))
    155140
    156141(define (stack-empty? stk)
     
    172157(define (stack-poke! stk obj #!optional (idx 0))
    173158  (%check-stack 'stack-poke! stk)
    174         (%set-car!/maybe-immediate (%stack-node-ref 'stack-poke! stk idx) obj) )
     159        (%set-car!/mutate (%stack-node-ref 'stack-poke! stk idx) obj) )
    175160
    176161(define (stack-push! stk #!rest ls)
     
    199184               (epr (%list-pair-ref spr cnt))
    200185               (ls (%cdr spr)))
    201           (%set-cdr!/maybe-immediate spr (%cdr epr))
     186          (%set-cdr!/mutate spr (%cdr epr))
    202187          (%set-cdr!/immediate epr '())
    203188          ls ) ) ) )
  • release/4/stack/trunk/stack.scm

    r13665 r13692  
    7979  (let ((pr (%list-pair-ref (%stack-list stk) idx)))
    8080                (if (%pair? pr) pr
    81                           (##sys#signal-hook #:bounds-error loc "out of range" idx 0 (%stack-count stk)) ) ) )
     81                          (##sys#signal-hook #:bounds-error loc (##core#immutable '"out of range") idx 0 (%stack-count stk)) ) ) )
    8282
    8383
     
    8888(define-inline (%check-stack loc obj)
    8989        (unless (%stack? obj)
    90           (##sys#signal-hook #:type-error loc "bad argument type - not a stack" obj) ) )
     90          (##sys#signal-hook #:type-error loc (##core#immutable '"bad argument type - not a stack") obj) ) )
    9191
    9292(define-inline (%check-list loc obj) (##sys#check-list obj loc))
     
    9494(define-inline (%check-stack-underflow loc stk)
    9595        (when (%stack-empty? stk)
    96           (##sys#signal-hook #:limit-error loc "stack underflow" stk) ) )
     96          (##sys#signal-hook #:limit-error loc (##core#immutable '"stack underflow") stk) ) )
    9797
    9898(define-inline (%check-exact loc obj) (##sys#check-exact obj loc))
Note: See TracChangeset for help on using the changeset viewer.