Changeset 38630 in project for release

Timestamp:

04/18/20 19:31:06 (9 months ago)

Author:

Kon Lovett

Message:

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

Location:

release/5/stack/trunk

Files:

• stack.egg (modified) (2 diffs)
• stack.scm (modified) (10 diffs)
• tests/run.scm (modified) (1 diff)

release/5/stack/trunk/stack.egg

@@ -3 +3 @@
 
 ((synopsis "Provides LIFO queue (stack) operations")
- (version "3.0.3")
+ (version "3.0.4")
  (category data)
  (author "[[kon lovett]]")
@@ -13 +13 @@
   (extension stack
     (types-file)
-    (csc-options "-O3" "-d1" "-local" "-no-procedure-checks" "-no-bound-checks") ) ) )
+    (csc-options "-O3" "-d1" "-strict-types" "-no-procedure-checks" "-no-bound-checks") ) ) )

release/5/stack/trunk/stack.scm

@@ -17 +17 @@
 
 (;export
-  ;stack
   make-stack
   list->stack
@@ -66 +65 @@
 
 (define-constant stack 'stack#stack)
-;(define stack 'stack#stack)
-
-;; Stack Support
-
-(define-inline (%make-stack)
-        (%make-structure stack '() 0) )
-
-(define-inline (%stack? obj)
-        (%structure-instance? obj stack) )
-
-(define-inline (%valid-stack? obj)
+
+(define stack)
+
+;; Stack List
+
+(define-inline (%stack-list stk)          (%structure-ref stk 1))
+(define-inline (%stack-list-empty? stk)   (%null? (%stack-list stk)))
+(define-inline (%stack-list-set! stk ls)  (%structure-set! stk 1 ls))
+(define-inline (%stack-list-empty! stk)   (%structure-set!/immediate stk 1 '()))
+
+;; Stack Count
+
+(define-inline (%stack-count stk)           (%structure-ref stk 2))
+(define-inline (%stack-count-set! stk cnt)  (%structure-set!/immediate stk 2 cnt))
+(define-inline (%stack-count-inc! stk cnt)  (%stack-count-set! stk (%fx+ (%stack-count stk) cnt)))
+(define-inline (%stack-count-dec! stk cnt)  (%stack-count-set! stk (%fx- (%stack-count stk) cnt)))
+
+;; Stack Object
+
+(define-inline (%make-stack) (%make-structure stack '() 0))
+
+(define-inline (%stack? obj) (%structure-instance? obj stack))
+
+(define-inline (%valid-as-stack? obj)
   (and
-    #;(%stack? obj)
     (%fx= 3 (%structure-length obj))
     (%list? (%stack-list obj)) ) )
 
-;; Stack List
-
-(define-inline (%stack-list stk)
-  (%structure-ref stk 1) )
-
-(define-inline (%stack-list-empty? stk)
-        (%null? (%stack-list stk)) )
-
-(define-inline (%stack-list-set! stk ls)
-        (%structure-set! stk 1 ls) )
-
-(define-inline (%stack-list-empty! stk)
-        (%structure-set!/immediate stk 1 '()) )
-
-;; Stack Count
-
-(define-inline (%stack-count stk)
-        (%structure-ref stk 2) )
-
-(define-inline (%stack-count-set! stk cnt)
-        (%structure-set!/immediate stk 2 cnt) )
-
-(define-inline (%stack-count-inc! stk cnt)
-        (%stack-count-set! stk (%fx+ (%stack-count stk) cnt)) )
-
-(define-inline (%stack-count-dec! stk cnt)
-        (%stack-count-set! stk (%fx- (%stack-count stk) cnt)) )
-
 ;; Stack Operations
 
-(define-inline (%stack-empty? stk)
-        (%stack-list-empty? stk))
+(define-inline (%stack-empty? stk) (%stack-list-empty? stk))
 
 (define-inline (%stack-empty! stk)
@@ -144 +126 @@
 (define-inline (%check-stack loc obj)
   (unless (%stack? obj) (error-stack loc obj))
-  (unless (%valid-stack? obj) (error-corrupted-stack loc obj))
+  (unless (%valid-as-stack? obj) (error-corrupted-stack loc obj))
   obj )
 
@@ -153 +135 @@
 (define-inline (%check-fixnum-index loc lfx fx hfx)
   (unless (%fxclosed-left? lfx fx hfx) (error-outside-range loc fx lfx hfx))
+  ;cannot return useful value (singular)
   (void) )
 
@@ -159 +142 @@
 (define-error-type stack)
 
-(define (error-corrupted-stack loc obj)
-  (##sys#signal-hook #:runtime-error loc "stack corrupted" obj) )
-
-(define (error-stack-underflow loc stk)
-  (##sys#signal-hook #:limit-error loc "stack underflow" stk) )
-
-(define (error-outside-range loc obj low high)
-  (##sys#signal-hook #:bounds-error loc "out of range" obj low high) )
+(define (error-corrupted-stack loc obj)         (##sys#signal-hook #:runtime-error loc "stack corrupted" obj))
+(define (error-stack-underflow loc stk)         (##sys#signal-hook #:limit-error loc "stack underflow" stk))
+(define (error-outside-range loc obj low high)  (##sys#signal-hook #:bounds-error loc "out of range" obj low high))
 
 ;;;
 
-(define stack )
-
 (: make-stack (-> stack))
 ;
-(define (make-stack)
-  (%make-stack) )
+(define (make-stack) (%make-stack))
 
 (: list->stack (list -> stack))
@@ -192 +167 @@
 (: stack-empty? (stack -> boolean))
 ;
-(define (stack-empty? stk)
-        (%stack-empty? (%check-stack 'stack-empty? stk)) )
+(define (stack-empty? stk) (%stack-empty? (%check-stack 'stack-empty? stk)))
 
 (: stack-count (stack -> fixnum))
 ;
-(define (stack-count stk)
-        (%stack-count (%check-stack 'stack-count stk)) )
+(define (stack-count stk) (%stack-count (%check-stack 'stack-count stk)))
 
 (: stack-peek (stack #!optional fixnum -> *))
 ;
-(define (stack-peek stk #!optional (idx 0))
-        (%car (%stack-node-ref 'stack-peek (%check-stack 'stack-peek stk) idx)) )
+(define (stack-peek stk #!optional (idx 0)) (%car (%stack-node-ref 'stack-peek (%check-stack 'stack-peek stk) idx)))
 
 (: stack-empty! (stack -> void))
 ;
-(define (stack-empty! stk)
-        (%stack-empty! (%check-stack 'stack-empty! stk)) )
+(define (stack-empty! stk) (%stack-empty! (%check-stack 'stack-empty! stk)))
 
 (: stack-poke! (stack * #!optional fixnum -> void))
 ;
-(define (stack-poke! stk obj #!optional (idx 0))
-        (%set-car!/mutate (%stack-node-ref 'stack-poke! (%check-stack 'stack-poke! stk) idx) obj) )
+(define (stack-poke! stk obj #!optional (idx 0)) (%set-car!/mutate (%stack-node-ref 'stack-poke! (%check-stack 'stack-poke! stk) idx) obj))
 
 (: stack-push! (stack #!rest * -> void))
 ;
-(define (stack-push! stk #!rest ls)
-        (unless (%null? ls) (%stack-push! (%check-stack 'stack-push! stk) ls)) )
+(define (stack-push! stk #!rest ls) (unless (%null? ls) (%stack-push! (%check-stack 'stack-push! stk) ls)))
 
 (: stack-cut! (stack fixnum #!optional fixnum -> list))
@@ -233 +202 @@
     (if (%fx= 0 start)
       ;then removing leading elements
-      (let* ((spr (%stack-list stk))
-             (epr (%list-pair-ref spr (%fx- cnt 1)))
-             (ls spr))
+      (let* (
+        (spr (%stack-list stk))
+        (epr (%list-pair-ref spr (%fx- cnt 1)))
+        (ls spr) )
         (%stack-list-set! stk (%cdr epr))
         (%set-cdr!/immediate epr '())
         ls )
       ;else removing interior elements
-      (let* ((spr (%stack-node-ref 'stack-cut! stk (%fx- start 1)))
-             (epr (%list-pair-ref spr cnt))
-             (ls (%cdr spr)))
+      (let* (
+        (spr (%stack-node-ref 'stack-cut! stk (%fx- start 1)))
+        (epr (%list-pair-ref spr cnt))
+        (ls (%cdr spr)) )
         (%set-cdr!/mutate spr (%cdr epr))
         (%set-cdr!/immediate epr '())
@@ -256 +227 @@
 (: stack->list (stack -> list))
 ;
-(define (stack->list stk)
-        (%list-copy (%stack-list (%check-stack 'stack->list stk))) )
+(define (stack->list stk) (%list-copy (%stack-list (%check-stack 'stack->list stk))))
 
 (: stack-fold (stack procedure * -> *))
 ;
-(define (stack-fold stk func init)
-        (%list-fold/1 func init (%stack-list (%check-stack 'stack-fold stk))) )
+(define (stack-fold stk func init) (%list-fold/1 func init (%stack-list (%check-stack 'stack-fold stk))))
 
 (: stack-map (stack procedure -> list))
 ;
-(define (stack-map stk func)
-        (%list-map/1 func (%stack-list (%check-stack 'stack-map stk))) )
+(define (stack-map stk func) (%list-map/1 func (%stack-list (%check-stack 'stack-map stk))))
 
 (: stack-for-each (stack procedure -> void))
 ;
-(define (stack-for-each stk proc)
-        (%list-for-each/1 proc (%stack-list (%check-stack 'stack-for-each stk))) )
+(define (stack-for-each stk proc) (%list-for-each/1 proc (%stack-list (%check-stack 'stack-for-each stk))))
 
 ;;; Read/Print Syntax
 
-(define-record-printer (stack stk out)
-  (format out (stack-literal-format) (%stack-list stk)) )
+(define-record-printer (stack stk out) (format out (stack-literal-format) (%stack-list stk)))
 
 (define-reader-ctor 'stack list->stack)
@@ -285 +251 @@
     (lambda (x)
       (case x
-        ((SRFI-10 srfi-10)
-          'srfi-10 )
-        ((UNREAD unread)
-          'unread )
+        ((SRFI-10 srfi-10)  'srfi-10 )
+        ((UNREAD unread)    'unread )
         (else
           (warning 'stack-literal-format "invalid form symbol; 'srfi-10 or 'unread" x)
@@ -298 +262 @@
 (define (stack-literal-format)
   (case (stack-literal-form)
-    ((srfi-10)
-      SRFI-10-FORMAT )
-    (else
-      UNREAD-FORMAT ) ) )
+    ((srfi-10)  SRFI-10-FORMAT )
+    (else       UNREAD-FORMAT ) ) )
 
 ) ;module stack

release/5/stack/trunk/tests/run.scm

@@ -32 +32 @@
 (define *csc-options* "-inline-global -local -inline \
   -specialize -optimize-leaf-routines -clustering -lfa2 \
-  -no-trace -unsafe")
+  -no-trace -unsafe \
+  -strict-types")
 
 (define *test-files-rx* (irregex '(: (+ graph) #\- "test" #\. "scm")))