Merge pull request #16 from jbouwman/housekeeping-a

Merge character stream types; remove obscure uri types; remove decls

epsilon.lisp

@@ -21,13 +21,15 @@
 (defun load-file (file)
   (let ((in (format nil "~{~A~^/~}.lisp" file))
         (out (format nil "~{~A~^/~}.fasl" file)))
-    (compile-file in)
+    (compile-file in :verbose nil :print nil)
     (load out)))
 
+(defun load-files (files)
+  (dolist (file files)
+    (load-file file)))
+
 (defun load-epsilon ()
-  (mapc #'load-file
-        (read-order "src" "epsilon.sexp")))
+  (load-files (read-order "src" "epsilon.sexp")))
 
 (defun load-epsilon-tests ()
-  (mapc #'load-file
-        (read-order "tests" "tests.sexp")))
+  (load-files (read-order "tests" "tests.sexp")))

src/epsilon.sexp

@@ -127,8 +127,7 @@
         ("http" "chunked-stream"
                 "parser"
                 "encoding"
-               "connection-cache"
-                "decoding-stream"
+                "connection-cache"
                 "keep-alive-stream"
                 "util"
                 "body"

src/lib/char/encoding/encoding.lisp

@@ -202,9 +202,9 @@ a CHARACTER-ENCONDING object, it is returned unmodified."
 ;;; object.
 (defmacro instantiate-concrete-mappings
     (&key (encodings (hash-table-keys *abstract-mappings*))
-       (optimize '((speed 3) (debug 0) (compilation-speed 0)))
-       octet-seq-getter octet-seq-setter octet-seq-type
-       code-point-seq-getter code-point-seq-setter code-point-seq-type
+     (optimize '((speed 3) (debug 0) (compilation-speed 0)))
+     octet-seq-getter octet-seq-setter octet-seq-type
+     code-point-seq-getter code-point-seq-setter code-point-seq-type
      (instantiate-decoders t))
   `(let ((ht (make-hash-table :test 'eq)))
      (declare (optimize ,@optimize)

src/lib/char/string.lisp

@@ -59,8 +59,8 @@ are less than UNICODE-CHAR-CODE-LIMIT."
                  bom-vector))
 
 (defun u8-to-string (vector &key (start 0) end
-                         (errorp (not *suppress-character-coding-errors*))
-                         (encoding *default-character-encoding*))
+                              (errorp (not *suppress-character-coding-errors*))
+                              (encoding *default-character-encoding*))
   (check-type vector (vector u8))
   (with-checked-bounds ((vector vector) (start start) (end end))
     (declare (type ->u8 vector))

src/lib/checksum/adler-32.lisp

@@ -21,8 +21,7 @@
     (+ (ash high 16) low)))
 
 (defmethod update ((checksum adler-32) buffer start count)
-  (declare (optimize speed)
-           (type ->u8 buffer)
+  (declare (type ->u8 buffer)
            (type array-index start count))
   (with-slots (high low) checksum
     (declare (type u32 high low))

src/lib/checksum/crc-32.lisp

@@ -30,8 +30,7 @@
 
 (defmethod update ((checksum crc-32) buffer start count)
   (declare (type ->u8 buffer)
-           (type array-index start count)
-           (optimize speed))
+           (type array-index start count))
   (with-slots (high low) checksum
     (declare (type u16 high low))
       (loop :with table := (the (->u16 512) *crc-32-table*)

src/lib/codec/bitstream.lisp

@@ -9,8 +9,7 @@
            (type (integer 0 32) size)
            (type bitstream-buffer-bit-count bits)
            (type bitstream-buffer buffer)
-           (type function callback)
-           (optimize speed))
+           (type function callback))
   ;; BITS represents how many bits have been added to BUFFER so far,
   ;; so the FLOOR of it by 8 will give both the buffer byte index and
   ;; the bit index within that byte to where new bits should be
@@ -51,8 +50,7 @@
   (declare (type u8 octet)
            (type bitstream-buffer buffer)
            (type bitstream-buffer-bit-count bits)
-           (type function callback)
-           (optimize speed))
+           (type function callback))
   (let ((offset (ceiling bits 8)))
     ;; End of the buffer beforehand
     (when (= offset #.+bitstream-buffer-size+)

src/lib/codec/bzip.lisp

@@ -192,7 +192,6 @@
                    (aref base i))))))
 
 (defun undo-rle-obuf-to-output (state)
-  (declare (optimize speed))
   (cond
     ((bzip2-state-block-randomized-p state)
      (error 'bzip2-randomized-blocks-unimplemented))

src/lib/codec/compress.lisp

@@ -12,8 +12,7 @@
 INPUT; END is a sentinel position that ends the match length
 check if reached."
   (declare (type input-index p1 p2 end)
-           (type input-buffer input)
-           (optimize speed))
+           (type input-buffer input))
   (let ((length 0))
     (loop
      (when (or (/= (aref input p1) (aref input p2))
@@ -28,8 +27,7 @@ check if reached."
   (declare (type input-index p1 end)
            (type input-buffer input)
            (type chains-buffer chains)
-           (type (integer 0 32) max-tests)
-           (optimize speed))
+           (type (integer 0 32) max-tests))
   (let ((match-length 0)
         (p2 (aref chains p1))
         (test-count 0)
@@ -58,8 +56,7 @@ check if reached."
   (declare (type input-buffer input)
            (type chains-buffer chains)
            (type input-index start end)
-           (type function literal-fun length-fun distance-fun)
-           (optimize speed))
+           (type function literal-fun length-fun distance-fun))
   (let ((p start))
     (loop
      (when (= p end)
@@ -288,8 +285,7 @@ with OUTPUT, a starting offset, and the count of pending data."
            (type hashes-buffer hashes)
            (type chains-buffer chains)
            (type input-index start)
-           (type (integer 0 32768) count)
-           (optimize speed))
+           (type (integer 0 32768) count))
   (when (< count 3)
     (return-from update-chains))
   (let* ((hash (hash-value input start))

src/lib/digest/common.lisp

@@ -7,15 +7,13 @@
   (:export
    #:%add-with-carry
    #:%subtract-with-borrow
-   #:burn-baby-burn
    #:copy-block
    #:copy-to-buffer
    #:defconst
    #:fill-block-u8-be
    #:fill-block-u8-be/64
    #:fill-block-u8-le
    #:fill-block-u8-le/64
-   #:hold-me-back
    #:mod32*
    #:mod32+
    #:mod32-
@@ -37,24 +35,12 @@
 
 (in-package #:lib.digest.common)
 
-(defmacro defconst (name value)
+(defmacro defconst (name value)         ; FIXME dedup
   `(defconstant ,name
     (if (boundp ',name)
         (symbol-value ',name)
         ,value)))
 
-;;; a global specification of optimization settings
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-(defun burn-baby-burn ()
-  '(optimize (speed 3) (safety 0) (space 0)
-    (debug 0) (compilation-speed 0)))
-
-(defun hold-me-back ()
-  '(declare (optimize (speed 3) (space 0) (compilation-speed 0)
-             (safety 1) (debug 1))))
-) ; EVAL-WHEN
-
 ;;; extracting individual bytes from integers
 
 ;;; We used to declare these functions with much stricter types (e.g.
@@ -333,8 +319,7 @@ starting at buffer-offset."
   (declare (type array-index from-offset)
            (type (integer 0 127) count buffer-offset)
            (type ->u8 from)
-           (type ->u8 buffer)
-           #.(burn-baby-burn))
+           (type ->u8 buffer))
   (sb-kernel:ub8-bash-copy from from-offset buffer buffer-offset count))
 
 (defun fill-block-u8-le (block buffer offset)
@@ -383,8 +368,7 @@ function without subsequently calling EXPAND-BLOCK results in undefined
 behavior."
   (declare (type (array-index #.(- array-dimension-limit 64)) offset)
            (type ->u64 block)
-           (type ->u8 buffer)
-           #.(burn-baby-burn))
+           (type ->u8 buffer))
   ;; convert to 64-bit words
   #+(and :cmu :little-endian :64-bit)
   (kernel:bit-bash-copy
@@ -408,8 +392,7 @@ function without subsequently calling EXPAND-BLOCK results in undefined
 behavior."
   (declare (type (array-index #.(- array-dimension-limit 128)) offset)
            (type ->u64 block)
-           (type ->u8 buffer)
-           #.(burn-baby-burn))
+           (type ->u8 buffer))
   ;; convert to 64-bit words
   #+(and :cmu :big-endian :64-bit)
   (kernel:bit-bash-copy
@@ -428,8 +411,7 @@ behavior."
 
 (defun xor-block (block-length input-block1 input-block1-start input-block2 input-block2-start output-block output-block-start)
   (declare (type ->u8 input-block1 input-block2 output-block)
-           (type array-index block-length input-block1-start input-block2-start output-block-start)
-           #.(burn-baby-burn))
+           (type array-index block-length input-block1-start input-block2-start output-block-start))
   (macrolet ((xor-bytes (size xor-form)
                `(loop until (< block-length ,size) do
                   ,xor-form
@@ -494,8 +476,7 @@ behavior."
 
 (defun copy-block (block-length input-block input-block-start output-block output-block-start)
   (declare (type ->u8 input-block output-block)
-           (type array-index block-length input-block-start output-block-start)
-           #.(burn-baby-burn))
+           (type array-index block-length input-block-start output-block-start))
   (macrolet ((copy-bytes (size copy-form)
                `(loop until (< block-length ,size) do
                       ,copy-form

src/lib/digest/generic.lisp

@@ -133,8 +133,7 @@ An error will be signaled if there is insufficient room in DIGEST."))
        (defun ,digest-fun (regs buffer start)
          (declare (type ,struct-name regs)
                   (type ->u8 buffer)
-                  (type (integer 0 ,(- array-dimension-limit digest-size)) start)
-                  ,(burn-baby-burn))
+                  (type (integer 0 ,(- array-dimension-limit digest-size)) start))
          ,(let ((inlined-unpacking
                   `(setf ,@(loop for (reg value) in registers
                                  for index from 0 below digest-size by size
@@ -160,7 +159,6 @@ An error will be signaled if there is insufficient room in DIGEST."))
     `(defmethod update-digest ((state ,digest-name) (sequence vector) &key (start 0) (end (length sequence)))
        ,@(when (stringp maybe-doc-string)
                `(,maybe-doc-string))
-       ,(hold-me-back)
        (check-type sequence ->u8)
        (check-type start array-index)
        (check-type end array-index)

src/lib/digest/sha-2.lisp

@@ -53,8 +53,7 @@
 
 (defun update-sha256-block (regs block)
   (declare (type sha256-regs regs))
-  (declare (type (->u32 64) block)
-           #.(burn-baby-burn))
+  (declare (type (->u32 64) block))
   (let ((a (sha256-regs-a regs)) (b (sha256-regs-b regs))
         (c (sha256-regs-c regs)) (d (sha256-regs-d regs))
         (e (sha256-regs-e regs)) (f (sha256-regs-f regs))
@@ -94,8 +93,7 @@
         regs))))
 
 (defun sha256-expand-block (block)
-  (declare (type (->u32 64) block)
-           #.(burn-baby-burn))
+  (declare (type (->u32 64) block))
   (flet ((sigma0 (x)
            (declare (type (unsigned-byte 32) x))
            (logxor (rol32 x 25) (rol32 x 14) (mod32ash x -3)))

src/lib/list.lisp

@@ -333,7 +333,6 @@ not destructively modified. Keys are compared using EQ."
 (defun delete-from-plist (plist &rest keys)
   "Just like REMOVE-FROM-PLIST, but this version may destructively modify the
 provided PLIST."
-  (declare (optimize speed))
   (loop with head = plist
         with tail = nil   ; a nil tail means an empty result so far
         for (key . rest) on plist by #'cddr

src/lib/seq/extended-sequence.lisp

@@ -16,8 +16,7 @@
                 split-extended-sequence-from-start split-extended-sequence-from-end))
 
 (defun split-extended-sequence-from-end (position-fn sequence start end count remove-empty-subseqs)
-  (declare (optimize (speed 3) (debug 0))
-           (type (function (extended-sequence fixnum) (or null fixnum)) position-fn))
+  (declare (type (function (extended-sequence fixnum) (or null fixnum)) position-fn))
   (loop
     :with length = (length sequence)
     :with end = (or end length)
@@ -34,8 +33,7 @@
     :finally (return (values (nreverse subseqs) (1+ left)))))
 
 (defun split-extended-sequence-from-start (position-fn sequence start end count remove-empty-subseqs)
-  (declare (optimize (speed 3) (debug 0))
-           (type (function (extended-sequence fixnum) (or null fixnum)) position-fn))
+  (declare (type (function (extended-sequence fixnum) (or null fixnum)) position-fn))
   (loop
     :with length = (length sequence)
     :with end = (or end length)

src/lib/sequence.lisp

@@ -42,8 +42,7 @@
   "Return true if SEQUENCE is a sequence of length LENGTH. Signals an error if
 SEQUENCE is not a sequence. Returns FALSE for circular lists."
   (declare (type array-index length)
-           #-lispworks (inline length)
-           (optimize speed))
+           (inline length))
   (etypecase sequence
     (null
      (zerop length))