-#+ignore
-(defmacro def-base64-stream-to-* (output-type)
- `(defun ,(intern (concatenate 'string (symbol-name :base64-stream-to-)
- (symbol-name output-type)))
- (input &key (uri nil)
- ,@(when (eq output-type :stream)
- '(stream)))
- ,(concatenate 'string "Decode base64 stream to " (string-downcase
- (symbol-name output-type)))
- (declare (stream input)
- (optimize (speed 3) (space 0) (safety 0)))
- (let ((pad (if uri *uri-pad-char* *pad-char*))
- (decode-table (if uri *uri-decode-table* *decode-table*)))
- (declare (type decode-table decode-table)
- (type character pad))
- (let (,@(case output-type
- (:string
- '((result (make-string (* 3 (truncate (length string) 4))))))
+(deftype array-index (&optional (length array-dimension-limit))
+ `(integer 0 (,length)))
+
+(deftype array-length (&optional (length array-dimension-limit))
+ `(integer 0 ,length))
+
+(deftype character-code ()
+ `(integer 0 (,char-code-limit)))
+
+(defmacro etypecase/unroll ((var &rest types) &body body)
+ #+sbcl `(etypecase ,var
+ ,@(loop for type in types
+ collect `(,type ,@body)))
+ #-sbcl `(locally
+ (declare (type (or ,@types) ,var))
+ ,@body))
+
+(defmacro let/typed ((&rest vars) &body body)
+ `(let ,(loop for (var value) in vars
+ collect (list var value))
+ (declare ,@(loop for (var nil type) in vars
+ when type
+ collect (list 'type type var)))
+ ,@body))
+
+(defmacro define-base64-decoder (hose sink)
+ `(defun ,(intern (format nil "~A-~A-~A-~A" '#:base64 hose '#:to sink))
+ (input &key (table +decode-table+)
+ (uri nil)
+ ,@(when (eq sink :stream) `(stream))
+ (whitespace :ignore))
+ ,(format nil "~
+Decode Base64 ~(~A~) to ~(~A~).
+
+TABLE is the decode table to use. Two decode tables are provided:
++DECODE-TABLE+ (used by default) and +URI-DECODE-TABLE+. See
+MAKE-DECODE-TABLE.
+
+For backwards-compatibility the URI parameter is supported. If it is
+true, then +URI-DECODE-TABLE+ is used, and the value for TABLE
+parameter is ignored.
+
+WHITESPACE can be one of:
+
+ :ignore - Whitespace characters are ignored (default).
+ :signal - Signal a BAD-BASE64-CHARACTER condition using SIGNAL.
+ :error - Signal a BAD-BASE64-CHARACTER condition using ERROR."
+ hose sink)
+ (declare (optimize (speed 3) (safety 1))
+ (type decode-table table)
+ (type ,(ecase hose
+ (:stream 'stream)
+ (:string 'string))
+ input))
+ (let/typed ((decode-table (if uri +uri-decode-table+ table)
+ decode-table)
+ ,@(ecase sink
+ (:stream)