Changeset 13531 in project


Ignore:
Timestamp:
03/06/09 07:15:29 (11 years ago)
Author:
Kon Lovett
Message:

Save.

Location:
release/4/stack/trunk
Files:
2 edited

Legend:

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

    r13527 r13531  
    1818  (no-bound-checks)
    1919  (bound-to-procedure
    20     ##sys#error-hook
    2120    ##sys#signal-hook
    2221    ##sys#check-range
     
    3433  (%make-structure 'stack '() 0) )
    3534
     35(define-inline (%stack? obj)
     36  (%structure-instance? obj 'stack) )
     37
    3638;; Stack List
    3739
     
    5456
    5557(define-inline (%stack-count-set! stk cnt)
    56   (%structure-set!/immediate stk 2 ls) )
     58  (%structure-set!/immediate stk 2 cnt) )
    5759
    5860(define-inline (%stack-count-inc! stk cnt)
     
    8284
    8385(define-inline (%stack-push! stk ls)
    84   (if (%null (%cdr ls)) (%stack-push-1! stk (%car ls))
     86  (if (%null? (%cdr ls)) (%stack-push-1! stk (%car ls))
    8587            (%list-for-each-1 (lambda (x) (%stack-push-1! stk x)) ls) ) )
    8688
    8789(define-inline (%list-stack-node-ref loc ls idx)
    8890  (let ([pr (%list-pair-ref ls idx)])
    89                 (if (not (%null pr)) pr
    90                           (##sys#error-hook
    91                            (foreign-value "C_OUT_OF_RANGE_ERROR" int) loc
    92                            idx 0 (%stack-count stk)) ) ) )
     91                (if (not (%null? pr)) pr
     92                          (##sys#signal-hook #:bounds-error loc "out of range" idx 0 (%stack-count stk)) ) ) )
    9393
    9494(define-inline (%stack-node-ref loc stk idx)
     
    108108  (##sys#check-list obj loc) )
    109109
    110 (define-inline (%check-non-empty-stack loc stk)
     110(define-inline (%check-stack-underflow loc stk)
    111111        (when (%stack-empty? stk)
    112112          (##sys#signal-hook #:limit-error loc "stack underflow" stk) ) )
     
    121121        make-stack
    122122        list->stack
     123        stack?
    123124        stack-empty?
    124125        stack-count
     
    154155    stk ) )
    155156
     157(define (stack? obj)
     158        (%stack? obj) )
     159
    156160(define (stack-empty? stk)
    157161  (%check-stack 'stack-empty? stk)
     
    176180(define (stack-push! stk !#rest ls)
    177181  (%check-stack 'stack-push! stk)
    178         (unless (%null ls) (%stack-push! stk ls)) )
     182        (unless (%null? ls) (%stack-push! stk ls)) )
    179183
    180184(define (stack-cut! stk start #!optional (end (%stack-count stk)))
     
    193197               [ls spr])
    194198          (%stack-list-set! stk (%cdr epr))
    195           (%set-cdr!/immediate! epr '())
     199          (%set-cdr!/immediate epr '())
    196200          ls )
    197201        ;else removing interior elements
     
    200204               [ls (%cdr spr)])
    201205          (%set-cdr!/maybe-immediate spr (%cdr epr))
    202           (%set-cdr!/immediate! epr '())
     206          (%set-cdr!/immediate epr '())
    203207          ls ) ) ) )
    204208
    205209(define (stack-pop! stk)
    206210  (%check-stack 'stack-pop! stk)
    207         (%check-non-empty-stack 'stack-pop! stk)
    208         (stack-pop*! stk) )
     211        (%check-stack-underflow 'stack-pop! stk)
     212        (%stack-pop! stk) )
    209213
    210214(define (stack->list stk)
  • release/4/stack/trunk/tests/run.scm

    r13527 r13531  
    1515
    1616(test-group "Push/Pop/Peek/Poke"
    17   (let ([stk #f])
    18     (expect-set! stk (make-stack))
    19     (expect-success (stack-push! stk 1))
    20     (expect-success (stack-push! stk 2 3))
     17  (let ([stk (make-stack)])
     18    (stack-push! stk 1)
     19    (stack-push! stk 2 3)
    2120    (test 3 (stack-count stk))
    2221    (test 3 (stack-pop! stk))
     
    2423    (test 1 (stack-pop! stk))
    2524    (test-assert (stack-empty? stk))
    26     (expect-failure (stack-pop! stk))
    27     (expect-success (stack-push! stk 1 2 3))
     25    (test-error (stack-pop! stk))
     26    (stack-push! stk 1 2 3)
    2827    (test 2 (stack-peek stk 1))
    29     (expect-success (stack-poke! stk 4 1))
     28    (stack-poke! stk 4 1)
    3029    (test 3 (stack-pop! stk))
    3130    (test 4 (stack-pop! stk))
     
    3534(test-group "Cut"
    3635  (let ([stk (make-stack)])
    37     (expect-success (stack-push! stk 1 2 3))
    38     (expect-equal '(2) (stack-cut! stk 1))
     36    (stack-push! stk 1 2 3)
     37    (test '(2) (stack-cut! stk 1))
    3938    (test 2 (stack-count stk))
    40     (expect-success (stack-push! stk 4 5))
    41     (expect-equal '(4 3 1) (stack-cut! stk 1 3))
     39    (stack-push! stk 4 5)
     40    (test '(4 3 1) (stack-cut! stk 1 3))
    4241    (test 1 (stack-count stk)) )
    4342)
     
    4544(test-group "Aux"
    4645  (let ([stk (make-stack)]
    47         [stk1 #f])
    48     (expect-success (stack-push! stk 1 2 3))
    49     (expect-equal '(3 2 1) (stack->list stk))
    50     (expect-set! stk1 (list->stack '(1 2 3)))
     46        [stk1 (list->stack '(1 2 3))])
     47    (stack-push! stk 1 2 3)
     48    (test '(3 2 1) (stack->list stk))
    5149    (test-assert (stack? stk1))
    5250    (test 3 (stack-count stk1))
Note: See TracChangeset for help on using the changeset viewer.