Changeset 8948 in project


Ignore:
Timestamp:
02/25/08 17:39:15 (11 years ago)
Author:
Kon Lovett
Message:

Rel 1.5

Location:
release/3/stack
Files:
1 deleted
6 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/3/stack/tags/1.5/stack-eggdoc.scm

    r8946 r8948  
    3131                (description (p "Provides LIFO queue (stack) operations."))
    3232                (author (url "mailto:klovett@pacbell.net" "Kon Lovett"))
    33                 (history
    34                         (version "1.4" "Bug fix for make-stack")
    35                         (version "1.3" "Exports")
    36                         (version "1.2" "Added clear-stack")
    37                         (version "1.1" "Doc fix [thanks to Toby Butzon], rename of stack-pop-1!, bug fix")
    38                         (version "1.0" "Initial release"))
    3933
    4034                (usage)
     
    122116                        )
    123117                )
     118
     119                (history
     120                        (version "1.5" "Error message change.")
     121                        (version "1.4" "Bug fix for make-stack")
     122                        (version "1.3" "Exports")
     123                        (version "1.2" "Added clear-stack")
     124                        (version "1.1" "Doc fix [thanks to Toby Butzon], rename of stack-pop-1!, bug fix")
     125                        (version "1.0" "Initial release"))
     126
    124127                (section "License" (pre ,license))
    125128        )
  • release/3/stack/tags/1.5/stack-support.scm

    r8946 r8948  
    77                (fixnum)
    88                (inline)
     9    (no-procedure-checks)
     10    (no-bound-checks)
    911                (export
    1012                        s-u$node-ref
    1113                        stack-cut!
    12                         stack-pop!)
    13         )
     14                        stack-pop! ) ) )
    1415
    15         (cond-expand
    16                 [paranoia]
    17                 [else
    18                         (declare
    19                                 (no-procedure-checks)
    20                                 #;(no-argc-checks)
    21                                 (no-bound-checks))]
    22         )
    23 )
     16;;;
    2417
    2518(include "stack")
    2619
    27 ;; Helpers
     20;;; Helpers
    2821
    2922(define (s-u$node-ref loc s n)
    30         (when (negative? n)
    31                 (error loc "negative stack index" n))
     23        (when (or (not (integer? n)) (negative? n))
     24                (error loc "invalid stack index; must be non-negative integer" n))
    3225        (let loop ([ns s] [nn n])
    33                 (when (stack-empty? ns)
    34                         (error loc "stack index too large" n))
    35                 (let ([sn (cdr ns)])
    36                         (if (zero? nn)
    37                                 sn
    38                                 (loop sn (sub1 nn))))))
     26                (if (stack-empty? ns)
     27                          (error loc "empty stack; stack index too large" n)
     28        (let ([sn (cdr ns)])
     29          (if (zero? nn)
     30              sn
     31              (loop sn (sub1 nn)) ) ) ) ) )
     32
     33;;;
    3934
    4035;; STACK-CUT! Stack Start-Depth !#optional End-Depth
     
    5146(define (stack-cut! s sd . r)
    5247        (let ([ed (:optional r sd)])
    53                 (cond
    54                         [(negative? sd)
    55                                 (error 'stack-cut! "start depth must be >= 0" sd)]
    56                         [(negative? ed)
    57                                 (error 'stack-cut! "end depth must be >= 0" ed)]
    58                         [(< ed sd)
    59                                 (error 'stack-cut! "start depth must be <= to the end depth" sd ed)])
     48                (cond [(or (not (integer? sd)) (negative? sd))
     49            (error 'stack-cut! "invalid start depth; must be non-negative integer" sd)]
     50          [(or (not (integer? sd)) (negative? ed))
     51            (error 'stack-cut! "invalid end depth; must be non-negative integer" ed)]
     52          [(< ed sd)
     53            (error 'stack-cut! "invalid interval" sd ed)])
    6054                (let* ([ds (sub1 sd)]
    6155                                         [sn (if (negative? ds) s (s-u$node-ref 'stack-cut! s ds))]
     
    6458                        (set-cdr! sn (cdr en))
    6559                        (set-cdr! en '())
    66                         ls)))
     60                        ls ) ) )
    6761
    6862;; STACK-POP! Stack
     
    7569        (when (stack-empty? stk)
    7670                (error 'stack-pop! "empty stack"))
    77         (stack-pop*! stk))
     71        (stack-pop*! stk) )
  • release/3/stack/tags/1.5/stack.scm

    r8946 r8948  
    77;; Helpers
    88
    9 (define-macro (stack-unit:stack-pusher S X)
     9(define-macro (s-u$stack-pusher S X)
    1010        `(set-cdr! ,S (cons ,X (cdr ,S))) )
    1111
     
    101101
    102102(define-macro (stack-push! S . VS)
    103         (cond
    104                 [(null? VS)
    105                         S]
    106                 [(null? (cdr VS))
    107                         `(let ([stk ,S])
    108                                 (stack-unit:stack-pusher stk ,(car VS))
    109                                 stk )]
    110                 [else
    111                         `(let ([stk ,S])
    112                                 (for-each (lambda (x) (stack-unit:stack-pusher stk x)) (list ,@VS))
    113                                 stk )]) )
     103        (cond [(null? VS)
     104          S]
     105        [(null? (cdr VS))
     106          `(let ([stk ,S])
     107            (s-u$stack-pusher stk ,(car VS))
     108            stk )]
     109        [else
     110          `(let ([stk ,S])
     111            (for-each (lambda (x) (s-u$stack-pusher stk x)) (list ,@VS))
     112            stk )]) )
    114113
    115114;; STACK-POP*! Stack
     
    121120(define-macro (stack-pop*! S)
    122121        `(let* ([stk ,S]
    123                                  [x (cadr stk)])
     122                                  [x (cadr stk)])
    124123                (set-cdr! stk (cddr stk))
    125124                x) )
  • release/3/stack/trunk/stack-eggdoc.scm

    r8946 r8948  
    3131                (description (p "Provides LIFO queue (stack) operations."))
    3232                (author (url "mailto:klovett@pacbell.net" "Kon Lovett"))
    33                 (history
    34                         (version "1.4" "Bug fix for make-stack")
    35                         (version "1.3" "Exports")
    36                         (version "1.2" "Added clear-stack")
    37                         (version "1.1" "Doc fix [thanks to Toby Butzon], rename of stack-pop-1!, bug fix")
    38                         (version "1.0" "Initial release"))
    3933
    4034                (usage)
     
    122116                        )
    123117                )
     118
     119                (history
     120                        (version "1.5" "Error message change.")
     121                        (version "1.4" "Bug fix for make-stack")
     122                        (version "1.3" "Exports")
     123                        (version "1.2" "Added clear-stack")
     124                        (version "1.1" "Doc fix [thanks to Toby Butzon], rename of stack-pop-1!, bug fix")
     125                        (version "1.0" "Initial release"))
     126
    124127                (section "License" (pre ,license))
    125128        )
  • release/3/stack/trunk/stack-support.scm

    r8946 r8948  
    77                (fixnum)
    88                (inline)
     9    (no-procedure-checks)
     10    (no-bound-checks)
    911                (export
    1012                        s-u$node-ref
    1113                        stack-cut!
    12                         stack-pop!)
    13         )
     14                        stack-pop! ) ) )
    1415
    15         (cond-expand
    16                 [paranoia]
    17                 [else
    18                         (declare
    19                                 (no-procedure-checks)
    20                                 #;(no-argc-checks)
    21                                 (no-bound-checks))]
    22         )
    23 )
     16;;;
    2417
    2518(include "stack")
    2619
    27 ;; Helpers
     20;;; Helpers
    2821
    2922(define (s-u$node-ref loc s n)
    30         (when (negative? n)
    31                 (error loc "negative stack index" n))
     23        (when (or (not (integer? n)) (negative? n))
     24                (error loc "invalid stack index; must be non-negative integer" n))
    3225        (let loop ([ns s] [nn n])
    33                 (when (stack-empty? ns)
    34                         (error loc "stack index too large" n))
    35                 (let ([sn (cdr ns)])
    36                         (if (zero? nn)
    37                                 sn
    38                                 (loop sn (sub1 nn))))))
     26                (if (stack-empty? ns)
     27                          (error loc "empty stack; stack index too large" n)
     28        (let ([sn (cdr ns)])
     29          (if (zero? nn)
     30              sn
     31              (loop sn (sub1 nn)) ) ) ) ) )
     32
     33;;;
    3934
    4035;; STACK-CUT! Stack Start-Depth !#optional End-Depth
     
    5146(define (stack-cut! s sd . r)
    5247        (let ([ed (:optional r sd)])
    53                 (cond
    54                         [(negative? sd)
    55                                 (error 'stack-cut! "start depth must be >= 0" sd)]
    56                         [(negative? ed)
    57                                 (error 'stack-cut! "end depth must be >= 0" ed)]
    58                         [(< ed sd)
    59                                 (error 'stack-cut! "start depth must be <= to the end depth" sd ed)])
     48                (cond [(or (not (integer? sd)) (negative? sd))
     49            (error 'stack-cut! "invalid start depth; must be non-negative integer" sd)]
     50          [(or (not (integer? sd)) (negative? ed))
     51            (error 'stack-cut! "invalid end depth; must be non-negative integer" ed)]
     52          [(< ed sd)
     53            (error 'stack-cut! "invalid interval" sd ed)])
    6054                (let* ([ds (sub1 sd)]
    6155                                         [sn (if (negative? ds) s (s-u$node-ref 'stack-cut! s ds))]
     
    6458                        (set-cdr! sn (cdr en))
    6559                        (set-cdr! en '())
    66                         ls)))
     60                        ls ) ) )
    6761
    6862;; STACK-POP! Stack
     
    7569        (when (stack-empty? stk)
    7670                (error 'stack-pop! "empty stack"))
    77         (stack-pop*! stk))
     71        (stack-pop*! stk) )
  • release/3/stack/trunk/stack.scm

    r8946 r8948  
    77;; Helpers
    88
    9 (define-macro (stack-unit:stack-pusher S X)
     9(define-macro (s-u$stack-pusher S X)
    1010        `(set-cdr! ,S (cons ,X (cdr ,S))) )
    1111
     
    101101
    102102(define-macro (stack-push! S . VS)
    103         (cond
    104                 [(null? VS)
    105                         S]
    106                 [(null? (cdr VS))
    107                         `(let ([stk ,S])
    108                                 (stack-unit:stack-pusher stk ,(car VS))
    109                                 stk )]
    110                 [else
    111                         `(let ([stk ,S])
    112                                 (for-each (lambda (x) (stack-unit:stack-pusher stk x)) (list ,@VS))
    113                                 stk )]) )
     103        (cond [(null? VS)
     104          S]
     105        [(null? (cdr VS))
     106          `(let ([stk ,S])
     107            (s-u$stack-pusher stk ,(car VS))
     108            stk )]
     109        [else
     110          `(let ([stk ,S])
     111            (for-each (lambda (x) (s-u$stack-pusher stk x)) (list ,@VS))
     112            stk )]) )
    114113
    115114;; STACK-POP*! Stack
     
    121120(define-macro (stack-pop*! S)
    122121        `(let* ([stk ,S]
    123                                  [x (cadr stk)])
     122                                  [x (cadr stk)])
    124123                (set-cdr! stk (cddr stk))
    125124                x) )
Note: See TracChangeset for help on using the changeset viewer.