Changeset 38630 in project


Ignore:
Timestamp:
04/18/20 19:31:06 (6 months ago)
Author:
Kon Lovett
Message:

remove redundant local, add -strict-types, reflow for wide

Location:
release/5/stack/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/5/stack/trunk/stack.egg

    r38501 r38630  
    33
    44((synopsis "Provides LIFO queue (stack) operations")
    5  (version "3.0.3")
     5 (version "3.0.4")
    66 (category data)
    77 (author "[[kon lovett]]")
     
    1313  (extension stack
    1414    (types-file)
    15     (csc-options "-O3" "-d1" "-local" "-no-procedure-checks" "-no-bound-checks") ) ) )
     15    (csc-options "-O3" "-d1" "-strict-types" "-no-procedure-checks" "-no-bound-checks") ) ) )
  • release/5/stack/trunk/stack.scm

    r38501 r38630  
    1717
    1818(;export
    19   ;stack
    2019  make-stack
    2120  list->stack
     
    6665
    6766(define-constant stack 'stack#stack)
    68 ;(define stack 'stack#stack)
    69 
    70 ;; Stack Support
    71 
    72 (define-inline (%make-stack)
    73         (%make-structure stack '() 0) )
    74 
    75 (define-inline (%stack? obj)
    76         (%structure-instance? obj stack) )
    77 
    78 (define-inline (%valid-stack? obj)
     67
     68(define stack)
     69
     70;; Stack List
     71
     72(define-inline (%stack-list stk)          (%structure-ref stk 1))
     73(define-inline (%stack-list-empty? stk)   (%null? (%stack-list stk)))
     74(define-inline (%stack-list-set! stk ls)  (%structure-set! stk 1 ls))
     75(define-inline (%stack-list-empty! stk)   (%structure-set!/immediate stk 1 '()))
     76
     77;; Stack Count
     78
     79(define-inline (%stack-count stk)           (%structure-ref stk 2))
     80(define-inline (%stack-count-set! stk cnt)  (%structure-set!/immediate stk 2 cnt))
     81(define-inline (%stack-count-inc! stk cnt)  (%stack-count-set! stk (%fx+ (%stack-count stk) cnt)))
     82(define-inline (%stack-count-dec! stk cnt)  (%stack-count-set! stk (%fx- (%stack-count stk) cnt)))
     83
     84;; Stack Object
     85
     86(define-inline (%make-stack) (%make-structure stack '() 0))
     87
     88(define-inline (%stack? obj) (%structure-instance? obj stack))
     89
     90(define-inline (%valid-as-stack? obj)
    7991  (and
    80     #;(%stack? obj)
    8192    (%fx= 3 (%structure-length obj))
    8293    (%list? (%stack-list obj)) ) )
    8394
    84 ;; Stack List
    85 
    86 (define-inline (%stack-list stk)
    87   (%structure-ref stk 1) )
    88 
    89 (define-inline (%stack-list-empty? stk)
    90         (%null? (%stack-list stk)) )
    91 
    92 (define-inline (%stack-list-set! stk ls)
    93         (%structure-set! stk 1 ls) )
    94 
    95 (define-inline (%stack-list-empty! stk)
    96         (%structure-set!/immediate stk 1 '()) )
    97 
    98 ;; Stack Count
    99 
    100 (define-inline (%stack-count stk)
    101         (%structure-ref stk 2) )
    102 
    103 (define-inline (%stack-count-set! stk cnt)
    104         (%structure-set!/immediate stk 2 cnt) )
    105 
    106 (define-inline (%stack-count-inc! stk cnt)
    107         (%stack-count-set! stk (%fx+ (%stack-count stk) cnt)) )
    108 
    109 (define-inline (%stack-count-dec! stk cnt)
    110         (%stack-count-set! stk (%fx- (%stack-count stk) cnt)) )
    111 
    11295;; Stack Operations
    11396
    114 (define-inline (%stack-empty? stk)
    115         (%stack-list-empty? stk))
     97(define-inline (%stack-empty? stk) (%stack-list-empty? stk))
    11698
    11799(define-inline (%stack-empty! stk)
     
    144126(define-inline (%check-stack loc obj)
    145127  (unless (%stack? obj) (error-stack loc obj))
    146   (unless (%valid-stack? obj) (error-corrupted-stack loc obj))
     128  (unless (%valid-as-stack? obj) (error-corrupted-stack loc obj))
    147129  obj )
    148130
     
    153135(define-inline (%check-fixnum-index loc lfx fx hfx)
    154136  (unless (%fxclosed-left? lfx fx hfx) (error-outside-range loc fx lfx hfx))
     137  ;cannot return useful value (singular)
    155138  (void) )
    156139
     
    159142(define-error-type stack)
    160143
    161 (define (error-corrupted-stack loc obj)
    162   (##sys#signal-hook #:runtime-error loc "stack corrupted" obj) )
    163 
    164 (define (error-stack-underflow loc stk)
    165   (##sys#signal-hook #:limit-error loc "stack underflow" stk) )
    166 
    167 (define (error-outside-range loc obj low high)
    168   (##sys#signal-hook #:bounds-error loc "out of range" obj low high) )
     144(define (error-corrupted-stack loc obj)         (##sys#signal-hook #:runtime-error loc "stack corrupted" obj))
     145(define (error-stack-underflow loc stk)         (##sys#signal-hook #:limit-error loc "stack underflow" stk))
     146(define (error-outside-range loc obj low high)  (##sys#signal-hook #:bounds-error loc "out of range" obj low high))
    169147
    170148;;;
    171149
    172 (define stack )
    173 
    174150(: make-stack (-> stack))
    175151;
    176 (define (make-stack)
    177   (%make-stack) )
     152(define (make-stack) (%make-stack))
    178153
    179154(: list->stack (list -> stack))
     
    192167(: stack-empty? (stack -> boolean))
    193168;
    194 (define (stack-empty? stk)
    195         (%stack-empty? (%check-stack 'stack-empty? stk)) )
     169(define (stack-empty? stk) (%stack-empty? (%check-stack 'stack-empty? stk)))
    196170
    197171(: stack-count (stack -> fixnum))
    198172;
    199 (define (stack-count stk)
    200         (%stack-count (%check-stack 'stack-count stk)) )
     173(define (stack-count stk) (%stack-count (%check-stack 'stack-count stk)))
    201174
    202175(: stack-peek (stack #!optional fixnum -> *))
    203176;
    204 (define (stack-peek stk #!optional (idx 0))
    205         (%car (%stack-node-ref 'stack-peek (%check-stack 'stack-peek stk) idx)) )
     177(define (stack-peek stk #!optional (idx 0)) (%car (%stack-node-ref 'stack-peek (%check-stack 'stack-peek stk) idx)))
    206178
    207179(: stack-empty! (stack -> void))
    208180;
    209 (define (stack-empty! stk)
    210         (%stack-empty! (%check-stack 'stack-empty! stk)) )
     181(define (stack-empty! stk) (%stack-empty! (%check-stack 'stack-empty! stk)))
    211182
    212183(: stack-poke! (stack * #!optional fixnum -> void))
    213184;
    214 (define (stack-poke! stk obj #!optional (idx 0))
    215         (%set-car!/mutate (%stack-node-ref 'stack-poke! (%check-stack 'stack-poke! stk) idx) obj) )
     185(define (stack-poke! stk obj #!optional (idx 0)) (%set-car!/mutate (%stack-node-ref 'stack-poke! (%check-stack 'stack-poke! stk) idx) obj))
    216186
    217187(: stack-push! (stack #!rest * -> void))
    218188;
    219 (define (stack-push! stk #!rest ls)
    220         (unless (%null? ls) (%stack-push! (%check-stack 'stack-push! stk) ls)) )
     189(define (stack-push! stk #!rest ls) (unless (%null? ls) (%stack-push! (%check-stack 'stack-push! stk) ls)))
    221190
    222191(: stack-cut! (stack fixnum #!optional fixnum -> list))
     
    233202    (if (%fx= 0 start)
    234203      ;then removing leading elements
    235       (let* ((spr (%stack-list stk))
    236              (epr (%list-pair-ref spr (%fx- cnt 1)))
    237              (ls spr))
     204      (let* (
     205        (spr (%stack-list stk))
     206        (epr (%list-pair-ref spr (%fx- cnt 1)))
     207        (ls spr) )
    238208        (%stack-list-set! stk (%cdr epr))
    239209        (%set-cdr!/immediate epr '())
    240210        ls )
    241211      ;else removing interior elements
    242       (let* ((spr (%stack-node-ref 'stack-cut! stk (%fx- start 1)))
    243              (epr (%list-pair-ref spr cnt))
    244              (ls (%cdr spr)))
     212      (let* (
     213        (spr (%stack-node-ref 'stack-cut! stk (%fx- start 1)))
     214        (epr (%list-pair-ref spr cnt))
     215        (ls (%cdr spr)) )
    245216        (%set-cdr!/mutate spr (%cdr epr))
    246217        (%set-cdr!/immediate epr '())
     
    256227(: stack->list (stack -> list))
    257228;
    258 (define (stack->list stk)
    259         (%list-copy (%stack-list (%check-stack 'stack->list stk))) )
     229(define (stack->list stk) (%list-copy (%stack-list (%check-stack 'stack->list stk))))
    260230
    261231(: stack-fold (stack procedure * -> *))
    262232;
    263 (define (stack-fold stk func init)
    264         (%list-fold/1 func init (%stack-list (%check-stack 'stack-fold stk))) )
     233(define (stack-fold stk func init) (%list-fold/1 func init (%stack-list (%check-stack 'stack-fold stk))))
    265234
    266235(: stack-map (stack procedure -> list))
    267236;
    268 (define (stack-map stk func)
    269         (%list-map/1 func (%stack-list (%check-stack 'stack-map stk))) )
     237(define (stack-map stk func) (%list-map/1 func (%stack-list (%check-stack 'stack-map stk))))
    270238
    271239(: stack-for-each (stack procedure -> void))
    272240;
    273 (define (stack-for-each stk proc)
    274         (%list-for-each/1 proc (%stack-list (%check-stack 'stack-for-each stk))) )
     241(define (stack-for-each stk proc) (%list-for-each/1 proc (%stack-list (%check-stack 'stack-for-each stk))))
    275242
    276243;;; Read/Print Syntax
    277244
    278 (define-record-printer (stack stk out)
    279   (format out (stack-literal-format) (%stack-list stk)) )
     245(define-record-printer (stack stk out) (format out (stack-literal-format) (%stack-list stk)))
    280246
    281247(define-reader-ctor 'stack list->stack)
     
    285251    (lambda (x)
    286252      (case x
    287         ((SRFI-10 srfi-10)
    288           'srfi-10 )
    289         ((UNREAD unread)
    290           'unread )
     253        ((SRFI-10 srfi-10)  'srfi-10 )
     254        ((UNREAD unread)    'unread )
    291255        (else
    292256          (warning 'stack-literal-format "invalid form symbol; 'srfi-10 or 'unread" x)
     
    298262(define (stack-literal-format)
    299263  (case (stack-literal-form)
    300     ((srfi-10)
    301       SRFI-10-FORMAT )
    302     (else
    303       UNREAD-FORMAT ) ) )
     264    ((srfi-10)  SRFI-10-FORMAT )
     265    (else       UNREAD-FORMAT ) ) )
    304266
    305267) ;module stack
  • release/5/stack/trunk/tests/run.scm

    r38501 r38630  
    3232(define *csc-options* "-inline-global -local -inline \
    3333  -specialize -optimize-leaf-routines -clustering -lfa2 \
    34   -no-trace -unsafe")
     34  -no-trace -unsafe \
     35  -strict-types")
    3536
    3637(define *test-files-rx* (irregex '(: (+ graph) #\- "test" #\. "scm")))
Note: See TracChangeset for help on using the changeset viewer.