CL-USER> (setf *default-pathname-defaults* #p"/home/death/quicklisp/third-party/")
#P"/home/death/quicklisp/third-party/"
CL-USER> (defun form-some (function tree)
           (let ((stack (list tree))
                 (visited (make-hash-table)))
             (loop until (null stack)
                   do (let ((x (pop stack)))
                        (setf (gethash x visited) t)
                        (if (funcall function x)
                            (return-from form-some t)
                            (when (consp x)
                              (unless (gethash (car x) visited)
                                (push (car x) stack))
                              (unless (gethash (cdr x) visited)
                                (push (cdr x) stack))))))))
FORM-SOME
CL-USER> (defun print-match (match)
           (format t "~&[~A:~D]~%  ~S~2%"
                   (enough-namestring (formgrep:match-filename match))
                   (formgrep:match-line match)
                   (formgrep:match-form match)))
PRINT-MATCH
CL-USER> (handler-bind ((error (lambda (condition)
                                 (let ((restart (or (find-restart 'formgrep:skip-form condition)
                                                    (find-restart 'formgrep:skip-file condition))))
                                   (when restart
                                     (invoke-restart restart))))))
           (formgrep:do-form-matches (match :operator-regex "" :file-type "lisp")
             (when (form-some (lambda (x) (and (consp x) (eq (car x) 'safety))) (formgrep:match-form match))
               (print-match match))))
[3bz/checksums.lisp:18]
  (DEFUN ADLER32/UB64 (BUF END S1 S2)
    (DECLARE (TYPE OCTET-VECTOR BUF)
             (TYPE (UNSIGNED-BYTE 16) S1 S2)
             (TYPE FIXNUM END)
             (OPTIMIZE SPEED))
    (LET* ((UNROLL NIL)
           (CHUNK-SIZE (* UNROLL (FLOOR 380368439 UNROLL)))
           (S1 S1)
           (S2 S2))
      (DECLARE (TYPE (UNSIGNED-BYTE 64) S1 S2)
               (FIXNUM CHUNK-SIZE))
      (ASSERT (<= END (LENGTH BUF)))
      (MACROLET ((A (I)
                   (ECLECTOR.READER:QUASIQUOTE
                    (PROGN
                     (SETF S1
                             (UB64+ S1
                              (LOCALLY
                               (DECLARE (OPTIMIZE (SAFETY 0)))
                               (AREF BUF
                                     (THE FIXNUM
                                          (ECLECTOR.READER:UNQUOTE I))))))
                     (SETF S2 (UB64+ S2 S1)))))
                 (UNROLL (N)
                   (ECLECTOR.READER:QUASIQUOTE
                    (PROGN
                     (ECLECTOR.READER:UNQUOTE-SPLICING
                      (LOOP FOR X BELOW N
                            COLLECT (ECLECTOR.READER:QUASIQUOTE
                                     (A
                                      (FIXNUM+ I
                                       (ECLECTOR.READER:UNQUOTE X))))))))))
        (LOOP WITH I OF-TYPE FIXNUM = 0
              FOR REM FIXNUM = (THE FIXNUM (- END I))
              FOR C FIXNUM = (FIXNUM+ I
                              (MIN (* NIL (FLOOR REM NIL)) CHUNK-SIZE))
              WHILE (> REM NIL)
              DO (LOOP WHILE (< I C)
                       DO (UNROLL NIL) (LOCALLY
                                        (DECLARE (OPTIMIZE (SAFETY 0)))
                                        (SETF I (FIXNUM+ I NIL)))) (SETF S1
                                                                           (MOD
                                                                            S1
                                                                            +ADLER32-PRIME+)
                                                                         S2
                                                                           (MOD
                                                                            S2
                                                                            +ADLER32-PRIME+))
              FINALLY (PROGN
                       (ASSERT (<= I END))
                       (LOOP FOR I FIXNUM FROM I BELOW
                             END
                             DO (A I))))
        (SETF S1 (MOD S1 +ADLER32-PRIME+)
              S2 (MOD S2 +ADLER32-PRIME+)))
      (LOCALLY (DECLARE (TYPE (UNSIGNED-BYTE 16) S1 S2)) (VALUES S1 S2))))

[3bz/checksums.lisp:64]
  (PROGN
   (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
     (DEFCONSTANT +ACCUMULATE-COUNT+
       (LET ((MAX MOST-POSITIVE-FIXNUM))
         (FLET ((S (N)
                  (+ (* (1+ N) 65520) (* (/ (* N (1+ N)) 2) 255))))
           (LOOP WITH N1 = 0
                 WITH N = (/ MAX 2)
                 WITH N2 = MAX
                 WHEN (>= (S N) MAX)
                 DO (PSETF N (FLOOR (+ N N1) 2)
                           N2 N) ELSE
                 DO (PSETF N (FLOOR (+ N N2) 2)
                           N1 N)
                 UNTIL (< (- N2 N1) 2)
                 FINALLY (RETURN N1))))))
   (ASSERT (> +ACCUMULATE-COUNT+ 100))
   (DEFUN ADLER32/FIXNUM (BUF END S1 S2)
     (DECLARE (TYPE OCTET-VECTOR BUF)
              (TYPE (UNSIGNED-BYTE 16) S1 S2)
              (TYPE NON-NEGATIVE-FIXNUM END)
              (OPTIMIZE SPEED))
     (LET* ((UNROLL NIL)
            (CHUNK-SIZE (* UNROLL (FLOOR +ACCUMULATE-COUNT+ UNROLL)))
            (S1 S1)
            (S2 S2))
       (DECLARE (TYPE NON-NEGATIVE-FIXNUM S1 S2 CHUNK-SIZE))
       (ASSERT (<= END (LENGTH BUF)))
       (MACROLET ((A (I)
                    (ECLECTOR.READER:QUASIQUOTE
                     (PROGN
                      (SETF S1
                              (THE FIXNUM
                                   (+ S1
                                      (THE OCTET
                                           (AREF BUF
                                                 (THE FIXNUM
                                                      (ECLECTOR.READER:UNQUOTE
                                                       I)))))))
                      (SETF S2 (THE FIXNUM (+ S2 S1))))))
                  (UNROLL (N)
                    (ECLECTOR.READER:QUASIQUOTE
                     (PROGN
                      (ECLECTOR.READER:UNQUOTE-SPLICING
                       (LOOP FOR X BELOW N
                             COLLECT (ECLECTOR.READER:QUASIQUOTE
                                      (A
                                       (+ I (ECLECTOR.READER:UNQUOTE X))))))))))
         (LOOP WITH I OF-TYPE NON-NEGATIVE-FIXNUM = 0
               FOR REM FIXNUM = (THE FIXNUM (- END I))
               FOR C FIXNUM = (THE FIXNUM
                                   (+ I
                                      (THE FIXNUM
                                           (MIN (* NIL (FLOOR REM NIL))
                                                CHUNK-SIZE))))
               WHILE (> REM NIL)
               DO (LOOP WHILE (< I C)
                        DO (UNROLL NIL) (LOCALLY
                                         (DECLARE (OPTIMIZE (SAFETY 0)))
                                         (SETF I
                                                 (THE FIXNUM
                                                      (+ I NIL))))) (SETF S1
                                                                            (MOD
                                                                             S1
                                                                             +ADLER32-PRIME+)
                                                                          S2
                                                                            (MOD
                                                                             S2
                                                                             +ADLER32-PRIME+))
               FINALLY (PROGN
                        (ASSERT (<= I END))
                        (LOOP FOR I FIXNUM FROM I BELOW
                              END
                              DO (A I))))
         (SETF S1 (MOD S1 +ADLER32-PRIME+)
               S2 (MOD S2 +ADLER32-PRIME+)))
       (LOCALLY (DECLARE (TYPE (UNSIGNED-BYTE 16) S1 S2)) (VALUES S1 S2)))))

[3bz/checksums.lisp:127]
  (DEFUN ADLER32/UB32 (BUF END S1 S2)
    (DECLARE (TYPE OCTET-VECTOR BUF)
             (TYPE (UNSIGNED-BYTE 16) S1 S2)
             (TYPE FIXNUM END)
             (OPTIMIZE SPEED))
    (LET* ((UNROLL NIL)
           (CHUNK-SIZE (* UNROLL (FLOOR 5552 UNROLL)))
           (S1 S1)
           (S2 S2))
      (DECLARE (TYPE (UNSIGNED-BYTE 32) S1 S2))
      (ASSERT (<= END (LENGTH BUF)))
      (MACROLET ((A (I)
                   (ECLECTOR.READER:QUASIQUOTE
                    (PROGN
                     (SETF S1
                             (THE (UNSIGNED-BYTE 32)
                                  (+ S1
                                     (AREF BUF (ECLECTOR.READER:UNQUOTE I)))))
                     (SETF S2 (THE (UNSIGNED-BYTE 32) (+ S2 S1))))))
                 (UNROLL (N)
                   (ECLECTOR.READER:QUASIQUOTE
                    (PROGN
                     (ECLECTOR.READER:UNQUOTE-SPLICING
                      (LOOP FOR X BELOW N
                            COLLECT (ECLECTOR.READER:QUASIQUOTE
                                     (A
                                      (+ I (ECLECTOR.READER:UNQUOTE X))))))))))
        (LOOP WITH I FIXNUM = 0
              WHILE (> (- END I) NIL)
              FOR C FIXNUM = (+ I
                                (MIN (* NIL (FLOOR (- END I) NIL)) CHUNK-SIZE))
              DO (LOOP WHILE (< I C)
                       DO (UNROLL NIL) (LOCALLY
                                        (DECLARE (OPTIMIZE (SAFETY 0)))
                                        (INCF I NIL))) (SETF S1
                                                               (MOD S1
                                                                    +ADLER32-PRIME+)
                                                             S2
                                                               (MOD S2
                                                                    +ADLER32-PRIME+))
              FINALLY (PROGN
                       (ASSERT (<= I END))
                       (LOOP FOR I FROM I BELOW
                             END
                             DO (A I))))
        (SETF S1 (MOD S1 +ADLER32-PRIME+)
              S2 (MOD S2 +ADLER32-PRIME+)))
      (LOCALLY (DECLARE (TYPE (UNSIGNED-BYTE 16) S1 S2)) (VALUES S1 S2))))

[3bz/util.lisp:49]
  (DEFMACRO WRAP-FIXNUM (X)
    (ECLECTOR.READER:QUASIQUOTE
     (LOCALLY
      (DECLARE (OPTIMIZE SPEED (SAFETY 0)))
      (THE FIXNUM (ECLECTOR.READER:UNQUOTE X)))))

[3bz/util.lisp:73]
  (DEFMACRO UB64+ (A B)
    (ECLECTOR.READER:QUASIQUOTE
     (LOCALLY
      (DECLARE (OPTIMIZE SPEED (SAFETY 0)))
      (THE (UNSIGNED-BYTE 64)
           (+ (ECLECTOR.READER:UNQUOTE A) (ECLECTOR.READER:UNQUOTE B)))))
    (ECLECTOR.READER:QUASIQUOTE
     (LDB (BYTE 64 0)
          (+ (ECLECTOR.READER:UNQUOTE A) (ECLECTOR.READER:UNQUOTE B)))))

[3bz/util.lisp:82]
  (DEFMACRO FIXNUM+ (A B)
    (ECLECTOR.READER:QUASIQUOTE
     (LOCALLY
      (DECLARE (OPTIMIZE SPEED (SAFETY 0)))
      (THE (FIXNUM)
           (+ (ECLECTOR.READER:UNQUOTE A) (ECLECTOR.READER:UNQUOTE B)))))
    (ECLECTOR.READER:QUASIQUOTE
     (+ (ECLECTOR.READER:UNQUOTE A) (ECLECTOR.READER:UNQUOTE B))))

[3d-matrices/ops.lisp:832]
  (DEFUN %MROTATION (ARR V ANGLE)
    (DECLARE (TYPE (SIMPLE-ARRAY FLOAT-TYPE (16)) ARR))
    (DECLARE (OPTIMIZE SPEED (SAFETY 0)))
    (LET* ((ANGLE (ENSURE-FLOAT ANGLE)) (C (COS ANGLE)) (S (SIN ANGLE)))
      (MACROLET ((%MAT (&REST ELS)
                   (ECLECTOR.READER:QUASIQUOTE
                    (PROGN
                     (ECLECTOR.READER:UNQUOTE-SPLICING
                      (LOOP FOR EL IN ELS
                            FOR I FROM 0
                            COLLECT (ECLECTOR.READER:QUASIQUOTE
                                     (SETF (AREF ARR
                                                 (ECLECTOR.READER:UNQUOTE I))
                                             (ENSURE-FLOAT
                                              (ECLECTOR.READER:UNQUOTE
                                               EL))))))))))
        (COND ((V= +VX+ V) (%MAT 1 0 0 0 0 C (- S) 0 0 S C 0 0 0 0 1))
              ((V= +VY+ V) (%MAT C 0 S 0 0 1 0 0 (- S) 0 C 0 0 0 0 1))
              ((V= +VZ+ V) (%MAT C (- S) 0 0 S C 0 0 0 0 1 0 0 0 0 1))
              (T
               (WITH-VEC3 (X Y Z) V
                (LET* ((|1-C| (- 1 C))
                       (U2 (EXPT X 2))
                       (V2 (EXPT Y 2))
                       (W2 (EXPT Z 2))
                       (L (+ U2 V2 W2))
                       (SQRTL (SQRT L)))
                  (%MAT (/ (+ U2 (* (+ V2 W2) C)) L)
                   (/ (- (* X Y |1-C|) (* Z SQRTL S)) L)
                   (/ (+ (* X Z |1-C|) (* Y SQRTL S)) L) 0
                   (/ (+ (* X Y |1-C|) (* Z SQRTL S)) L)
                   (/ (+ V2 (* (+ U2 W2) C)) L)
                   (/ (- (* Y Z |1-C|) (* X SQRTL S)) L) 0
                   (/ (- (* X Z |1-C|) (* Y SQRTL S)) L)
                   (/ (+ (* Y Z |1-C|) (* X SQRTL S)) L)
                   (/ (+ W2 (* (+ U2 V2) C)) L) 0 0 0 0 1))))))))

[3d-vectors/toolkit.lisp:31]
  (DEFMACRO DEFINE-OFUN (NAME ARGS &BODY BODY)
    (ECLECTOR.READER:QUASIQUOTE
     (PROGN
      (DECLAIM (MAYBE-INLINE (ECLECTOR.READER:UNQUOTE NAME)))
      (DEFUN (ECLECTOR.READER:UNQUOTE NAME) (ECLECTOR.READER:UNQUOTE ARGS)
        (DECLARE (OPTIMIZE (COMPILATION-SPEED 0) (DEBUG 1) (SAFETY 1) SPEED))
        (ECLECTOR.READER:UNQUOTE-SPLICING BODY)))))

[Mezzano/applications/mandelbrot.lisp:9]
  (DEFUN HUE-TO-RGB (H)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE SINGLE-FLOAT H))
    (LET* ((H* H)
           (H^
            (*
             (THE SINGLE-FLOAT
                  (IF (>= H* 1.0)
                      (- H* 1.0)
                      H*))
             6.0))
           (INDEX (TRUNCATE H^))
           (F (- H^ (FLOAT INDEX 0.0)))
           (Q (- 1.0 F)))
      (DECLARE (TYPE SINGLE-FLOAT H* H^)
               (TYPE FIXNUM INDEX))
      (CASE INDEX
        (0 (VALUES 1.0 F 0.0))
        (1 (VALUES Q 1.0 0.0))
        (2 (VALUES 0.0 1.0 F))
        (3 (VALUES 0.0 Q 1.0))
        (4 (VALUES F 0.0 1.0))
        (5 (VALUES 1.0 0.0 Q)))))

[Mezzano/applications/mandelbrot.lisp:32]
  (DEFUN M (CR CI ZR ZI ITERATIONS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE SINGLE-FLOAT CR CI ZR ZI)
             (TYPE FIXNUM ITERATIONS))
    (DOTIMES (I ITERATIONS NIL)
      (DECLARE (TYPE FIXNUM I))
      (LET ((ZR2 (* ZR ZR)) (ZI2 (* ZI ZI)))
        (DECLARE (TYPE SINGLE-FLOAT ZR2 ZI2))
        (PSETF ZR (+ CR (- ZR2 ZI2))
               ZI (+ CI (* ZI ZR) (* ZR ZI)))
        (WHEN (> (+ ZR2 ZI2) 4.0)
          (RETURN (/ (FLOAT I 0.0) (FLOAT ITERATIONS 0.0)))))))

[Mezzano/applications/mandelbrot.lisp:46]
  (DEFUN RENDER-MANDELBROT (X Y WIDTH HEIGHT HUE-OFFSET JULIA)
    "Render one pixel."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE SINGLE-FLOAT X Y WIDTH HEIGHT HUE-OFFSET))
    (LET* ((SCALE (/ 4.0 WIDTH))
           (X^ (- X (/ WIDTH 2.0)))
           (Y^ (- Y (/ HEIGHT 2.0)))
           (R 0.0)
           (G 0.0)
           (B 0.0))
      (DECLARE (TYPE SINGLE-FLOAT SCALE X^ Y^ R G B))
      (FLET ((FRAG (X Y)
               (DECLARE (TYPE SINGLE-FLOAT X Y))
               (LET ((HUE
                      (IF JULIA
                          (M -0.4 0.6 (* SCALE X) (* SCALE Y) 250)
                          (M (- (* SCALE X) 0.5) (* SCALE Y) 0.0 0.0 25))))
                 (WHEN HUE
                   (LET ((FINAL-HUE (+ (THE SINGLE-FLOAT HUE) HUE-OFFSET)))
                     (DECLARE (TYPE SINGLE-FLOAT FINAL-HUE))
                     (WHEN (>= FINAL-HUE 1.0) (DECF FINAL-HUE 1.0))
                     (MULTIPLE-VALUE-BIND (R* G* B*)
                         (HUE-TO-RGB FINAL-HUE)
                       (DECLARE (TYPE SINGLE-FLOAT R* G* B*))
                       (INCF R R*)
                       (INCF G G*)
                       (INCF B B*)))))))
        (FRAG X^ Y^)
        (FRAG (+ X^ 0.5) Y^)
        (FRAG X^ (+ Y^ 0.5))
        (FRAG (+ X^ 0.5) (+ Y^ 0.5))
        (#S(FORMGREP:SYMREF :NAME "MAKE-COLOUR" :QUALIFIER "MEZZANO.GUI")
         (/ R 4.0) (/ G 4.0) (/ B 4.0)))))

[Mezzano/compiler/compiler.lisp:18]
  (DEFVAR *OPTIMIZE-POLICY* '(SAFETY 3 DEBUG 3 SPEED 1))

[Mezzano/compiler/environment.lisp:43]
  (DEFUN EXTEND-ENVIRONMENT
         (ENVIRONMENT &KEY VARIABLES FUNCTIONS BLOCKS GO-TAGS DECLARATIONS)
    (ASSERT (EVERY (LAMBDA (V) (SYMBOLP (FIRST V))) VARIABLES))
    (ASSERT (EVERY (LAMBDA (V) (FUNCTION-NAME-P (FIRST V))) FUNCTIONS))
    (ASSERT (EVERY (LAMBDA (V) (SYMBOLP (FIRST V))) BLOCKS))
    (ASSERT
     (EVERY (LAMBDA (V) (OR (SYMBOLP (FIRST V)) (INTEGERP (FIRST V))))
            GO-TAGS))
    (CHECK-TYPE ENVIRONMENT (OR NULL LEXICAL-ENVIRONMENT))
    (WHEN
        (AND (ENDP VARIABLES) (ENDP FUNCTIONS) (ENDP BLOCKS) (ENDP GO-TAGS)
             (ENDP DECLARATIONS))
      (RETURN-FROM EXTEND-ENVIRONMENT ENVIRONMENT))
    (WHEN (NULL ENVIRONMENT)
      (SETF ENVIRONMENT (MAKE-INSTANCE 'LEXICAL-ENVIRONMENT)))
    (LET ((SUB (MAKE-INSTANCE 'LEXICAL-ENVIRONMENT)))
      (SETF (SLOT-VALUE SUB '%VARIABLES)
              (APPEND VARIABLES
                      (LOOP FOR (WHAT . NAMES) IN DECLARATIONS
                            WHEN (EQL WHAT 'SPECIAL)
                            APPEND (MAPCAR
                                    (LAMBDA (X)
                                      (LIST X
                                            (MAKE-INSTANCE 'SPECIAL-VARIABLE
                                                           :NAME X)))
                                    (REMOVE-IF
                                     (LAMBDA (X)
                                       (MEMBER X VARIABLES :KEY #'FIRST))
                                     NAMES)))
                      (SLOT-VALUE ENVIRONMENT '%VARIABLES)))
      (SETF (SLOT-VALUE SUB '%FUNCTIONS)
              (APPEND FUNCTIONS (SLOT-VALUE ENVIRONMENT '%FUNCTIONS)))
      (SETF (SLOT-VALUE SUB '%BLOCKS)
              (APPEND BLOCKS (SLOT-VALUE ENVIRONMENT '%BLOCKS)))
      (SETF (SLOT-VALUE SUB '%GO-TAGS)
              (APPEND GO-TAGS (SLOT-VALUE ENVIRONMENT '%GO-TAGS)))
      (LET ((NEW-DECLS 'NIL))
        (FLET ((ADD-DECL (NAME WHAT)
                 (LET ((EXISTING (ASSOC NAME NEW-DECLS :TEST #'EQUAL)))
                   (COND
                    (EXISTING
                     (WHEN (NOT (EQL (SECOND EXISTING) WHAT))
                       (ERROR
                        "~S ~S declaration conflicts with ~S declaration." WHAT
                        NAME (SECOND EXISTING))))
                    (T (PUSH (LIST NAME WHAT) NEW-DECLS))))))
          (LOOP FOR (WHAT . NAMES) IN DECLARATIONS
                WHEN (MEMBER WHAT '(INLINE NOTINLINE))
                DO (LOOP FOR NAME IN NAMES
                         DO (ADD-DECL NAME WHAT))))
        (DOLIST (FUNC FUNCTIONS)
          (WHEN (NOT (ASSOC (FIRST FUNC) NEW-DECLS :TEST #'EQUAL))
            (PUSH (LIST (FIRST FUNC) NIL) NEW-DECLS)))
        (SETF (SLOT-VALUE SUB '%INLINE-DECLS)
                (APPEND NEW-DECLS
                        (SET-DIFFERENCE (SLOT-VALUE ENVIRONMENT '%INLINE-DECLS)
                                        NEW-DECLS :TEST #'EQUAL :KEY
                                        #'FIRST))))
      (LET ((NEW-DECLS 'NIL))
        (FLET ((ADD-DECL (NAME TYPE)
                 (LET* ((NEW-VAR (ASSOC NAME VARIABLES))
                        (ACTUAL-VAR
                         (OR (AND NEW-VAR (SECOND NEW-VAR))
                             (LOOKUP-VARIABLE-IN-ENVIRONMENT NAME
                              ENVIRONMENT)))
                        (REAL-TYPE
                         (ETYPECASE ACTUAL-VAR
                           ((OR LEXICAL-VARIABLE SYMBOL-MACRO)
                            (IF NEW-VAR
                                TYPE
                                (MERGE-THE-TYPES
                                 (LOOKUP-VARIABLE-DECLARED-TYPE-IN-ENVIRONMENT
                                  NAME ENVIRONMENT)
                                 TYPE)))
                           (SPECIAL-VARIABLE
                            (MERGE-THE-TYPES
                             (#S(FORMGREP:SYMREF
                                 :NAME "SYMBOL-TYPE"
                                 :QUALIFIER "MEZZANO.RUNTIME")
                              NAME)
                             TYPE)))))
                   (LET ((EXISTING (ASSOC NAME NEW-DECLS :KEY #'NAME)))
                     (WHEN EXISTING
                       (WARN
                        '#S(FORMGREP:SYMREF
                            :NAME "SIMPLE-STYLE-WARNING"
                            :QUALIFIER "SYS.INT")
                        :FORMAT-CONTROL
                        "Multiple type declarations at same scope for ~S."
                        :FORMAT-ARGUMENTS (LIST NAME))
                       (UNLESS
                           (COMPILER-TYPE-EQUAL-P REAL-TYPE (SECOND EXISTING))
                         (SETF (SECOND EXISTING)
                                 (MERGE-THE-TYPES (SECOND EXISTING)
                                  REAL-TYPE)))))
                   (PUSH (LIST ACTUAL-VAR REAL-TYPE) NEW-DECLS))))
          (LOOP FOR (WHAT TYPE . NAMES) IN DECLARATIONS
                WHEN (EQL WHAT 'TYPE)
                DO (LOOP FOR NAME IN NAMES
                         DO (ADD-DECL NAME TYPE)))
          (LOOP FOR (WHAT . NAMES) IN DECLARATIONS
                WHEN (NON-TYPE-TYPE-DECLARATION-P WHAT)
                DO (LOOP FOR NAME IN NAMES
                         DO (ADD-DECL NAME WHAT)))
          (LOOP FOR (NAME VAR) IN VARIABLES
                WHEN (AND (TYPEP VAR 'LEXICAL-VARIABLE)
                          (NOT (ASSOC VAR NEW-DECLS)))
                DO (PUSH (LIST VAR 'T) NEW-DECLS))
          (LOOP FOR (VAR TYPE) IN (SLOT-VALUE ENVIRONMENT
                                              '%VARIABLE-TYPE-DECLS)
                WHEN (NOT (ASSOC VAR NEW-DECLS))
                DO (PUSH (LIST VAR TYPE) NEW-DECLS))
          (SETF (SLOT-VALUE SUB '%VARIABLE-TYPE-DECLS) NEW-DECLS)))
      (LET ((OPTIMIZE-SETTINGS (OPTIMIZE-QUALITIES-IN-ENVIRONMENT ENVIRONMENT)))
        (LOOP FOR (WHAT . QUALITIES) IN DECLARATIONS
              WHEN (EQL WHAT 'OPTIMIZE)
              DO (DOLIST (QUALITY QUALITIES)
                   (DESTRUCTURING-BIND
                       (QUALITY VALUE)
                       (IF (SYMBOLP QUALITY)
                           (ECLECTOR.READER:QUASIQUOTE
                            ((ECLECTOR.READER:UNQUOTE QUALITY) 3))
                           QUALITY)
                     (CHECK-TYPE QUALITY
                                 (MEMBER COMPILATION-SPEED DEBUG SAFETY SPACE
                                         SPEED))
                     (CHECK-TYPE VALUE (MEMBER 0 1 2 3))
                     (LET ((CURRENT (GETF OPTIMIZE-SETTINGS QUALITY 0)))
                       (SETF (GETF OPTIMIZE-SETTINGS QUALITY)
                               (MAX VALUE CURRENT))))))
        (SETF (SLOT-VALUE SUB '%OPTIMIZE) OPTIMIZE-SETTINGS))
      SUB))

[Mezzano/compiler/simplify-arguments.lisp:78]
  (DEFUN WRAP-TYPE-CHECK (VARIABLE VALUE)
    "Wrap a type check around VALUE, based on VARIABLE's type."
    (COND
     ((OR (EQL (OPTIMIZE-QUALITY VALUE 'SAFETY) 0)
          (LEXICAL-VARIABLE-P VARIABLE)
          (EQL
           (#S(FORMGREP:SYMREF
               :NAME "SYMBOL-TYPE"
               :QUALIFIER "MEZZANO.RUNTIME")
            (NAME VARIABLE))
           'T))
      VALUE)
     (T
      (AST
       (ECLECTOR.READER:QUASIQUOTE
        (LET ((VAL (ECLECTOR.READER:UNQUOTE VALUE)))
          (IF (SOURCE-FRAGMENT
               (TYPEP VAL
                      '(ECLECTOR.READER:UNQUOTE
                        (SIMPLIFY-COMPLICATED-FUNCTION-TYPE
                         (#S(FORMGREP:SYMREF
                             :NAME "SYMBOL-TYPE"
                             :QUALIFIER "MEZZANO.RUNTIME")
                          (NAME VARIABLE))))))
              VAL
              (PROGN
               (CALL RAISE-BINDING-TYPE-ERROR
                '(ECLECTOR.READER:UNQUOTE (NAME VARIABLE))
                '(ECLECTOR.READER:UNQUOTE
                  (#S(FORMGREP:SYMREF
                      :NAME "SYMBOL-TYPE"
                      :QUALIFIER "MEZZANO.RUNTIME")
                   (NAME VARIABLE)))
                VAL)
               (CALL
                #S(FORMGREP:SYMREF
                   :NAME "%%UNREACHABLE"
                   :QUALIFIER "SYS.INT"))))))
       VALUE))))

[Mezzano/compiler/simplify.lisp:171]
  (DEFUN PURE-P (FORM)
    (LET ((UNWRAPPED (UNWRAP-THE FORM)))
      (OR (LAMBDA-INFORMATION-P UNWRAPPED) (TYPEP UNWRAPPED 'AST-QUOTE)
          (TYPEP UNWRAPPED 'AST-FUNCTION)
          (AND (LEXICAL-VARIABLE-P UNWRAPPED) (LOCALP UNWRAPPED)
               (EQL (LEXICAL-VARIABLE-WRITE-COUNT UNWRAPPED) 0))
          (AND (TYPEP UNWRAPPED 'AST-CALL)
               (OR (MEMBER (AST-NAME UNWRAPPED) *PURE-FUNCTIONS* :TEST #'EQUAL)
                   (AND (MATCH-OPTIMIZE-SETTINGS UNWRAPPED '((= SAFETY 0)))
                        (MEMBER (AST-NAME UNWRAPPED)
                                *PURE-FUNCTIONS-AT-LOW-SAFETY* :TEST #'EQUAL)))
               (EVERY #'PURE-P (AST-ARGUMENTS UNWRAPPED))))))

[Mezzano/compiler/simplify.lisp:778]
  (DEFUN SIMP-ASH (FORM)
    (COND
     ((AND (EQL (LIST-LENGTH (ARGUMENTS FORM)) 2)
           (OR
            (AND (TYPEP (SECOND (ARGUMENTS FORM)) 'AST-THE)
                 (MATCH-OPTIMIZE-SETTINGS FORM '((= SAFETY 0) (= SPEED 3)))
                 (COMPILER-VALID-TYPE-EQUAL-P
                  (AST-THE-TYPE (SECOND (ARGUMENTS FORM))) '(EQL 0)))
            (AND (QUOTED-FORM-P (SECOND (ARGUMENTS FORM)))
                 (EQL (VALUE (SECOND (ARGUMENTS FORM))) 0))))
      (CHANGE-MADE)
      (RETURN-FROM SIMP-ASH
        (IF (MATCH-OPTIMIZE-SETTINGS FORM '((= SAFETY 0) (= SPEED 3)))
            (AST
             (ECLECTOR.READER:QUASIQUOTE
              (LET ((VALUE (ECLECTOR.READER:UNQUOTE (FIRST (ARGUMENTS FORM)))))
                (PROGN
                 (ECLECTOR.READER:UNQUOTE (SECOND (ARGUMENTS FORM)))
                 VALUE)))
             FORM)
            (AST
             (ECLECTOR.READER:QUASIQUOTE
              (LET ((VALUE (ECLECTOR.READER:UNQUOTE (FIRST (ARGUMENTS FORM)))))
                (PROGN
                 (ECLECTOR.READER:UNQUOTE (SECOND (ARGUMENTS FORM)))
                 (IF (CALL INTEGERP VALUE)
                     VALUE
                     (CALL
                      #S(FORMGREP:SYMREF
                         :NAME "RAISE-TYPE-ERROR"
                         :QUALIFIER "SYS.INT")
                      VALUE 'INTEGER)))))
             FORM))))
     ((AND (EQL (LIST-LENGTH (ARGUMENTS FORM)) 2)
           (QUOTED-FORM-P (SECOND (ARGUMENTS FORM)))
           (INTEGERP (VALUE (SECOND (ARGUMENTS FORM)))))
      (CHANGE-MADE)
      (COND
       ((PLUSP (VALUE (SECOND (ARGUMENTS FORM))))
        (SETF (NAME FORM)
                '#S(FORMGREP:SYMREF
                    :NAME "LEFT-SHIFT"
                    :QUALIFIER "MEZZANO.RUNTIME")))
       (T
        (SETF (NAME FORM)
                '#S(FORMGREP:SYMREF
                    :NAME "RIGHT-SHIFT"
                    :QUALIFIER "MEZZANO.RUNTIME")
              (ARGUMENTS FORM)
                (LIST (FIRST (ARGUMENTS FORM))
                      (MAKE-INSTANCE 'AST-QUOTE :INHERIT FORM :VALUE
                                     (-
                                      (VALUE (SECOND (ARGUMENTS FORM))))))))))
     ((AND (EQL (LIST-LENGTH (ARGUMENTS FORM)) 2)
           (MATCH-OPTIMIZE-SETTINGS FORM '((= SAFETY 0) (= SPEED 3)))
           (TYPEP (SECOND (ARGUMENTS FORM)) 'AST-THE)
           (COMPILER-VALID-SUBTYPEP (AST-THE-TYPE (SECOND (ARGUMENTS FORM)))
            '(INTEGER 0)))
      (CHANGE-MADE)
      (SETF (NAME FORM)
              '#S(FORMGREP:SYMREF
                  :NAME "LEFT-SHIFT"
                  :QUALIFIER "MEZZANO.RUNTIME")))
     ((AND (EQL (LIST-LENGTH (ARGUMENTS FORM)) 2)
           (MATCH-OPTIMIZE-SETTINGS FORM '((= SAFETY 0) (= SPEED 3)))
           (TYPEP (SECOND (ARGUMENTS FORM)) 'AST-THE)
           (COMPILER-VALID-SUBTYPEP (AST-THE-TYPE (SECOND (ARGUMENTS FORM)))
            '(INTEGER * 0)))
      (CHANGE-MADE)
      (SETF (NAME FORM)
              '#S(FORMGREP:SYMREF
                  :NAME "RIGHT-SHIFT"
                  :QUALIFIER "MEZZANO.RUNTIME")
            (ARGUMENTS FORM)
              (LIST (FIRST (ARGUMENTS FORM))
                    (AST
                     (ECLECTOR.READER:QUASIQUOTE
                      (CALL
                       #S(FORMGREP:SYMREF
                          :NAME "BINARY--"
                          :QUALIFIER "SYS.INT")
                       '0 (ECLECTOR.READER:UNQUOTE (SECOND (ARGUMENTS FORM)))))
                     FORM)))))
    FORM)

[Mezzano/compiler/simplify.lisp:1113]
  (DEFUN SIMPLIFY-STRUCT-SLOT (FORM)
    (CHANGE-MADE)
    (DESTRUCTURING-BIND
        (OBJECT STRUCTURE-NAME SLOT-NAME)
        (ARGUMENTS FORM)
      (LET ((SLOT-DEF (FIND-STRUCT-SLOT STRUCTURE-NAME SLOT-NAME))
            (STRUCT
             (#S(FORMGREP:SYMREF
                 :NAME "GET-STRUCTURE-TYPE"
                 :QUALIFIER "SYS.INT")
              (AST-VALUE STRUCTURE-NAME))))
        (COND
         ((MATCH-OPTIMIZE-SETTINGS FORM '((= SAFETY 0) (= SPEED 3)))
          (AST (STRUCT-SLOT-ACCESS-FORM SLOT-DEF OBJECT NIL) FORM))
         (T
          (AST
           (ECLECTOR.READER:QUASIQUOTE
            (LET ((OBJ (ECLECTOR.READER:UNQUOTE OBJECT)))
              (IF (ECLECTOR.READER:UNQUOTE (STRUCT-TYPE-TEST-FORM 'OBJ STRUCT))
                  (ECLECTOR.READER:UNQUOTE
                   (STRUCT-SLOT-ACCESS-FORM SLOT-DEF 'OBJ NIL))
                  (NOTINLINE-CALL
                   #S(FORMGREP:SYMREF
                      :NAME "%STRUCT-SLOT"
                      :QUALIFIER "SYS.INT")
                   OBJ '(ECLECTOR.READER:UNQUOTE (AST-VALUE STRUCTURE-NAME))
                   '(ECLECTOR.READER:UNQUOTE (AST-VALUE SLOT-NAME))))))
           FORM))))))

[Mezzano/compiler/simplify.lisp:1132]
  (DEFUN SIMPLIFY-SETF-STRUCT-SLOT (FORM)
    (CHANGE-MADE)
    (DESTRUCTURING-BIND
        (VALUE OBJECT STRUCTURE-NAME SLOT-NAME)
        (ARGUMENTS FORM)
      (LET ((SLOT-DEF (FIND-STRUCT-SLOT STRUCTURE-NAME SLOT-NAME))
            (STRUCT
             (#S(FORMGREP:SYMREF
                 :NAME "GET-STRUCTURE-TYPE"
                 :QUALIFIER "SYS.INT")
              (AST-VALUE STRUCTURE-NAME))))
        (COND
         ((MATCH-OPTIMIZE-SETTINGS FORM '((= SAFETY 0) (= SPEED 3)))
          (AST (STRUCT-SLOT-ACCESS-FORM SLOT-DEF OBJECT 'SETF VALUE) FORM))
         (T
          (AST
           (ECLECTOR.READER:QUASIQUOTE
            (LET ((VAL (ECLECTOR.READER:UNQUOTE VALUE))
                  (OBJ (ECLECTOR.READER:UNQUOTE OBJECT)))
              (IF (ECLECTOR.READER:UNQUOTE (STRUCT-TYPE-TEST-FORM 'OBJ STRUCT))
                  (PROGN
                   (IF (SOURCE-FRAGMENT
                        (TYPEP VAL
                               '(ECLECTOR.READER:UNQUOTE
                                 (#S(FORMGREP:SYMREF
                                     :NAME "SLOT-DEFINITION-TYPE"
                                     :QUALIFIER "MEZZANO.CLOS")
                                  SLOT-DEF))))
                       'NIL
                       (PROGN
                        (CALL
                         #S(FORMGREP:SYMREF
                            :NAME "RAISE-TYPE-ERROR"
                            :QUALIFIER "SYS.INT")
                         VAL
                         '(ECLECTOR.READER:UNQUOTE
                           (#S(FORMGREP:SYMREF
                               :NAME "SLOT-DEFINITION-TYPE"
                               :QUALIFIER "MEZZANO.CLOS")
                            SLOT-DEF)))
                        (CALL
                         #S(FORMGREP:SYMREF
                            :NAME "%%UNREACHABLE"
                            :QUALIFIER "SYS.INT"))))
                   (ECLECTOR.READER:UNQUOTE
                    (STRUCT-SLOT-ACCESS-FORM SLOT-DEF 'OBJ 'SETF 'VAL)))
                  (NOTINLINE-CALL
                   (SETF #S(FORMGREP:SYMREF
                            :NAME "%STRUCT-SLOT"
                            :QUALIFIER "SYS.INT"))
                   VAL OBJ
                   '(ECLECTOR.READER:UNQUOTE (AST-VALUE STRUCTURE-NAME))
                   '(ECLECTOR.READER:UNQUOTE (AST-VALUE SLOT-NAME))))))
           FORM))))))

[Mezzano/compiler/simplify.lisp:1159]
  (DEFUN SIMPLIFY-CAS-STRUCT-SLOT (FORM)
    (CHANGE-MADE)
    (DESTRUCTURING-BIND
        (OLD NEW OBJECT STRUCTURE-NAME SLOT-NAME)
        (ARGUMENTS FORM)
      (LET ((SLOT-DEF (FIND-STRUCT-SLOT STRUCTURE-NAME SLOT-NAME))
            (STRUCT
             (#S(FORMGREP:SYMREF
                 :NAME "GET-STRUCTURE-TYPE"
                 :QUALIFIER "SYS.INT")
              (AST-VALUE STRUCTURE-NAME))))
        (COND
         ((MATCH-OPTIMIZE-SETTINGS FORM '((= SAFETY 0) (= SPEED 3)))
          (AST
           (ECLECTOR.READER:QUASIQUOTE
            (LET ((OLD (ECLECTOR.READER:UNQUOTE OLD))
                  (NEW (ECLECTOR.READER:UNQUOTE NEW))
                  (OBJ (ECLECTOR.READER:UNQUOTE OBJECT)))
              (ECLECTOR.READER:UNQUOTE
               (STRUCT-SLOT-ACCESS-FORM SLOT-DEF 'OBJ
                '#S(FORMGREP:SYMREF :NAME "CAS" :QUALIFIER "SYS.INT") 'OLD
                'NEW))))
           FORM))
         (T
          (AST
           (ECLECTOR.READER:QUASIQUOTE
            (LET ((OLD (ECLECTOR.READER:UNQUOTE OLD))
                  (NEW (ECLECTOR.READER:UNQUOTE NEW))
                  (OBJ (ECLECTOR.READER:UNQUOTE OBJECT)))
              (IF (ECLECTOR.READER:UNQUOTE (STRUCT-TYPE-TEST-FORM 'OBJ STRUCT))
                  (PROGN
                   (IF (SOURCE-FRAGMENT
                        (TYPEP OLD
                               '(ECLECTOR.READER:UNQUOTE
                                 (#S(FORMGREP:SYMREF
                                     :NAME "SLOT-DEFINITION-TYPE"
                                     :QUALIFIER "MEZZANO.CLOS")
                                  SLOT-DEF))))
                       'NIL
                       (PROGN
                        (CALL
                         #S(FORMGREP:SYMREF
                            :NAME "RAISE-TYPE-ERROR"
                            :QUALIFIER "SYS.INT")
                         OLD
                         '(ECLECTOR.READER:UNQUOTE
                           (#S(FORMGREP:SYMREF
                               :NAME "SLOT-DEFINITION-TYPE"
                               :QUALIFIER "MEZZANO.CLOS")
                            SLOT-DEF)))
                        (CALL
                         #S(FORMGREP:SYMREF
                            :NAME "%%UNREACHABLE"
                            :QUALIFIER "SYS.INT"))))
                   (IF (SOURCE-FRAGMENT
                        (TYPEP NEW
                               '(ECLECTOR.READER:UNQUOTE
                                 (#S(FORMGREP:SYMREF
                                     :NAME "SLOT-DEFINITION-TYPE"
                                     :QUALIFIER "MEZZANO.CLOS")
                                  SLOT-DEF))))
                       'NIL
                       (PROGN
                        (CALL
                         #S(FORMGREP:SYMREF
                            :NAME "RAISE-TYPE-ERROR"
                            :QUALIFIER "SYS.INT")
                         NEW
                         '(ECLECTOR.READER:UNQUOTE
                           (#S(FORMGREP:SYMREF
                               :NAME "SLOT-DEFINITION-TYPE"
                               :QUALIFIER "MEZZANO.CLOS")
                            SLOT-DEF)))
                        (CALL
                         #S(FORMGREP:SYMREF
                            :NAME "%%UNREACHABLE"
                            :QUALIFIER "SYS.INT"))))
                   (ECLECTOR.READER:UNQUOTE
                    (STRUCT-SLOT-ACCESS-FORM SLOT-DEF 'OBJ
                     '#S(FORMGREP:SYMREF :NAME "CAS" :QUALIFIER "SYS.INT") 'OLD
                     'NEW)))
                  (NOTINLINE-CALL
                   (#S(FORMGREP:SYMREF :NAME "CAS" :QUALIFIER "SYS.INT")
                    #S(FORMGREP:SYMREF
                       :NAME "%STRUCT-SLOT"
                       :QUALIFIER "SYS.INT"))
                   OLD NEW OBJ
                   '(ECLECTOR.READER:UNQUOTE (AST-VALUE STRUCTURE-NAME))
                   '(ECLECTOR.READER:UNQUOTE (AST-VALUE SLOT-NAME))))))
           FORM))))))

[Mezzano/compiler/simplify.lisp:1221]
  (DEFUN SIMPLIFY-ATOMIC-FIXNUM-OP-STRUCT-SLOT (FORM)
    (CHANGE-MADE)
    (DESTRUCTURING-BIND
        (OBJECT STRUCTURE-NAME SLOT-NAME VALUE)
        (ARGUMENTS FORM)
      (LET ((SLOT-DEF (FIND-STRUCT-SLOT STRUCTURE-NAME SLOT-NAME))
            (STRUCT
             (#S(FORMGREP:SYMREF
                 :NAME "GET-STRUCTURE-TYPE"
                 :QUALIFIER "SYS.INT")
              (AST-VALUE STRUCTURE-NAME)))
            (OP (ATOMIC-OP-FOR-ATOMIC-STRUCT-SLOT-OP (NAME FORM))))
        (COND
         ((MATCH-OPTIMIZE-SETTINGS FORM '((= SAFETY 0) (= SPEED 3)))
          (AST
           (ECLECTOR.READER:QUASIQUOTE
            (LET ((OBJ (ECLECTOR.READER:UNQUOTE OBJECT))
                  (VALUE (ECLECTOR.READER:UNQUOTE VALUE)))
              (CALL (ECLECTOR.READER:UNQUOTE OP) OBJ
               '(ECLECTOR.READER:UNQUOTE (STRUCT-SLOT-ACCESSOR-INDEX SLOT-DEF))
               VALUE)))
           FORM))
         (T
          (AST
           (ECLECTOR.READER:QUASIQUOTE
            (LET ((OBJ (ECLECTOR.READER:UNQUOTE OBJECT))
                  (VALUE (ECLECTOR.READER:UNQUOTE VALUE)))
              (IF (ECLECTOR.READER:UNQUOTE (STRUCT-TYPE-TEST-FORM 'OBJ STRUCT))
                  (PROGN
                   (IF (SOURCE-FRAGMENT (TYPEP VALUE 'FIXNUM))
                       'NIL
                       (PROGN
                        (CALL
                         #S(FORMGREP:SYMREF
                            :NAME "RAISE-TYPE-ERROR"
                            :QUALIFIER "SYS.INT")
                         VALUE 'FIXNUM)
                        (CALL
                         #S(FORMGREP:SYMREF
                            :NAME "%%UNREACHABLE"
                            :QUALIFIER "SYS.INT"))))
                   (CALL (ECLECTOR.READER:UNQUOTE OP) OBJ
                    '(ECLECTOR.READER:UNQUOTE
                      (STRUCT-SLOT-ACCESSOR-INDEX SLOT-DEF))
                    VALUE))
                  (NOTINLINE-CALL (ECLECTOR.READER:UNQUOTE (NAME FORM)) OBJ
                   '(ECLECTOR.READER:UNQUOTE (AST-VALUE STRUCTURE-NAME))
                   '(ECLECTOR.READER:UNQUOTE (AST-VALUE SLOT-NAME)) VALUE))))
           FORM))))))

[Mezzano/compiler/simplify.lisp:1262]
  (DEFUN SIMPLIFY-ATOMIC-SWAP-STRUCT-SLOT (FORM)
    (CHANGE-MADE)
    (DESTRUCTURING-BIND
        (OBJECT STRUCTURE-NAME SLOT-NAME VALUE)
        (ARGUMENTS FORM)
      (LET ((SLOT-DEF (FIND-STRUCT-SLOT STRUCTURE-NAME SLOT-NAME))
            (STRUCT
             (#S(FORMGREP:SYMREF
                 :NAME "GET-STRUCTURE-TYPE"
                 :QUALIFIER "SYS.INT")
              (AST-VALUE STRUCTURE-NAME))))
        (COND
         ((MATCH-OPTIMIZE-SETTINGS FORM '((= SAFETY 0) (= SPEED 3)))
          (AST
           (ECLECTOR.READER:QUASIQUOTE
            (LET ((OBJ (ECLECTOR.READER:UNQUOTE OBJECT))
                  (VALUE (ECLECTOR.READER:UNQUOTE VALUE)))
              (CALL
               #S(FORMGREP:SYMREF :NAME "%XCHG-OBJECT" :QUALIFIER "SYS.INT")
               OBJ
               '(ECLECTOR.READER:UNQUOTE (STRUCT-SLOT-ACCESSOR-INDEX SLOT-DEF))
               VALUE)))
           FORM))
         (T
          (AST
           (ECLECTOR.READER:QUASIQUOTE
            (LET ((OBJ (ECLECTOR.READER:UNQUOTE OBJECT))
                  (VALUE (ECLECTOR.READER:UNQUOTE VALUE)))
              (IF (ECLECTOR.READER:UNQUOTE (STRUCT-TYPE-TEST-FORM 'OBJ STRUCT))
                  (PROGN
                   (IF (SOURCE-FRAGMENT
                        (TYPEP VALUE
                               '(ECLECTOR.READER:UNQUOTE
                                 (#S(FORMGREP:SYMREF
                                     :NAME "SLOT-DEFINITION-TYPE"
                                     :QUALIFIER "MEZZANO.CLOS")
                                  SLOT-DEF))))
                       'NIL
                       (PROGN
                        (CALL
                         #S(FORMGREP:SYMREF
                            :NAME "RAISE-TYPE-ERROR"
                            :QUALIFIER "SYS.INT")
                         VALUE
                         '(ECLECTOR.READER:UNQUOTE
                           (#S(FORMGREP:SYMREF
                               :NAME "SLOT-DEFINITION-TYPE"
                               :QUALIFIER "MEZZANO.CLOS")
                            SLOT-DEF)))
                        (CALL
                         #S(FORMGREP:SYMREF
                            :NAME "%%UNREACHABLE"
                            :QUALIFIER "SYS.INT"))))
                   (CALL
                    #S(FORMGREP:SYMREF
                       :NAME "%XCHG-OBJECT"
                       :QUALIFIER "SYS.INT")
                    OBJ
                    '(ECLECTOR.READER:UNQUOTE
                      (STRUCT-SLOT-ACCESSOR-INDEX SLOT-DEF))
                    VALUE))
                  (NOTINLINE-CALL (ECLECTOR.READER:UNQUOTE (NAME FORM)) OBJ
                   '(ECLECTOR.READER:UNQUOTE (AST-VALUE STRUCTURE-NAME))
                   '(ECLECTOR.READER:UNQUOTE (AST-VALUE SLOT-NAME)) VALUE))))
           FORM))))))

[Mezzano/compiler/simplify.lisp:1347]
  (DEFUN SIMPLIFY-DCAS-STRUCT-SLOT (FORM)
    (CHANGE-MADE)
    (DESTRUCTURING-BIND
        (OBJECT STRUCTURE-NAME-1 SLOT-NAME-1 STRUCTURE-NAME-2 SLOT-NAME-2 OLD-1
         OLD-2 NEW-1 NEW-2)
        (ARGUMENTS FORM)
      (LET* ((SLOT-DEF-1 (FIND-STRUCT-SLOT STRUCTURE-NAME-1 SLOT-NAME-1))
             (SLOT-DEF-2 (FIND-STRUCT-SLOT STRUCTURE-NAME-2 SLOT-NAME-2))
             (STRUCT-1
              (#S(FORMGREP:SYMREF
                  :NAME "GET-STRUCTURE-TYPE"
                  :QUALIFIER "SYS.INT")
               (AST-VALUE STRUCTURE-NAME-1)))
             (STRUCT-2
              (#S(FORMGREP:SYMREF
                  :NAME "GET-STRUCTURE-TYPE"
                  :QUALIFIER "SYS.INT")
               (AST-VALUE STRUCTURE-NAME-2)))
             (STRUCT
              (IF (MEMBER STRUCT-2
                          (#S(FORMGREP:SYMREF
                              :NAME "CLASS-PRECEDENCE-LIST"
                              :QUALIFIER "MEZZANO.CLOS")
                           STRUCT-1))
                  STRUCT-2
                  STRUCT-1)))
        (COND
         ((MATCH-OPTIMIZE-SETTINGS FORM '((= SAFETY 0) (= SPEED 3)))
          (AST
           (ECLECTOR.READER:QUASIQUOTE
            (LET ((OLD-1 (ECLECTOR.READER:UNQUOTE OLD-1))
                  (OLD-2 (ECLECTOR.READER:UNQUOTE OLD-2))
                  (NEW-1 (ECLECTOR.READER:UNQUOTE NEW-1))
                  (NEW-2 (ECLECTOR.READER:UNQUOTE NEW-2))
                  (OBJ (ECLECTOR.READER:UNQUOTE OBJECT)))
              (ECLECTOR.READER:UNQUOTE
               (GENERATE-DCAS-FORM SLOT-DEF-1 SLOT-DEF-2 'OBJ 'OLD-1 'OLD-2
                'NEW-1 'NEW-2))))
           FORM))
         (T
          (AST
           (ECLECTOR.READER:QUASIQUOTE
            (LET ((OLD-1 (ECLECTOR.READER:UNQUOTE OLD-1))
                  (OLD-2 (ECLECTOR.READER:UNQUOTE OLD-2))
                  (NEW-1 (ECLECTOR.READER:UNQUOTE NEW-1))
                  (NEW-2 (ECLECTOR.READER:UNQUOTE NEW-2))
                  (OBJ (ECLECTOR.READER:UNQUOTE OBJECT)))
              (IF (ECLECTOR.READER:UNQUOTE (STRUCT-TYPE-TEST-FORM 'OBJ STRUCT))
                  (PROGN
                   (IF (SOURCE-FRAGMENT
                        (TYPEP OLD-1
                               '(ECLECTOR.READER:UNQUOTE
                                 (#S(FORMGREP:SYMREF
                                     :NAME "SLOT-DEFINITION-TYPE"
                                     :QUALIFIER "MEZZANO.CLOS")
                                  SLOT-DEF-1))))
                       'NIL
                       (PROGN
                        (CALL
                         #S(FORMGREP:SYMREF
                            :NAME "RAISE-TYPE-ERROR"
                            :QUALIFIER "SYS.INT")
                         OLD-1
                         '(ECLECTOR.READER:UNQUOTE
                           (#S(FORMGREP:SYMREF
                               :NAME "SLOT-DEFINITION-TYPE"
                               :QUALIFIER "MEZZANO.CLOS")
                            SLOT-DEF-1)))
                        (CALL
                         #S(FORMGREP:SYMREF
                            :NAME "%%UNREACHABLE"
                            :QUALIFIER "SYS.INT"))))
                   (IF (SOURCE-FRAGMENT
                        (TYPEP OLD-2
                               '(ECLECTOR.READER:UNQUOTE
                                 (#S(FORMGREP:SYMREF
                                     :NAME "SLOT-DEFINITION-TYPE"
                                     :QUALIFIER "MEZZANO.CLOS")
                                  SLOT-DEF-2))))
                       'NIL
                       (PROGN
                        (CALL
                         #S(FORMGREP:SYMREF
                            :NAME "RAISE-TYPE-ERROR"
                            :QUALIFIER "SYS.INT")
                         OLD-2
                         '(ECLECTOR.READER:UNQUOTE
                           (#S(FORMGREP:SYMREF
                               :NAME "SLOT-DEFINITION-TYPE"
                               :QUALIFIER "MEZZANO.CLOS")
                            SLOT-DEF-2)))
                        (CALL
                         #S(FORMGREP:SYMREF
                            :NAME "%%UNREACHABLE"
                            :QUALIFIER "SYS.INT"))))
                   (IF (SOURCE-FRAGMENT
                        (TYPEP NEW-1
                               '(ECLECTOR.READER:UNQUOTE
                                 (#S(FORMGREP:SYMREF
                                     :NAME "SLOT-DEFINITION-TYPE"
                                     :QUALIFIER "MEZZANO.CLOS")
                                  SLOT-DEF-1))))
                       'NIL
                       (PROGN
                        (CALL
                         #S(FORMGREP:SYMREF
                            :NAME "RAISE-TYPE-ERROR"
                            :QUALIFIER "SYS.INT")
                         NEW-1
                         '(ECLECTOR.READER:UNQUOTE
                           (#S(FORMGREP:SYMREF
                               :NAME "SLOT-DEFINITION-TYPE"
                               :QUALIFIER "MEZZANO.CLOS")
                            SLOT-DEF-1)))
                        (CALL
                         #S(FORMGREP:SYMREF
                            :NAME "%%UNREACHABLE"
                            :QUALIFIER "SYS.INT"))))
                   (IF (SOURCE-FRAGMENT
                        (TYPEP NEW-2
                               '(ECLECTOR.READER:UNQUOTE
                                 (#S(FORMGREP:SYMREF
                                     :NAME "SLOT-DEFINITION-TYPE"
                                     :QUALIFIER "MEZZANO.CLOS")
                                  SLOT-DEF-2))))
                       'NIL
                       (PROGN
                        (CALL
                         #S(FORMGREP:SYMREF
                            :NAME "RAISE-TYPE-ERROR"
                            :QUALIFIER "SYS.INT")
                         NEW-2
                         '(ECLECTOR.READER:UNQUOTE
                           (#S(FORMGREP:SYMREF
                               :NAME "SLOT-DEFINITION-TYPE"
                               :QUALIFIER "MEZZANO.CLOS")
                            SLOT-DEF-2)))
                        (CALL
                         #S(FORMGREP:SYMREF
                            :NAME "%%UNREACHABLE"
                            :QUALIFIER "SYS.INT"))))
                   (ECLECTOR.READER:UNQUOTE
                    (GENERATE-DCAS-FORM SLOT-DEF-1 SLOT-DEF-2 'OBJ 'OLD-1
                     'OLD-2 'NEW-1 'NEW-2)))
                  (NOTINLINE-CALL
                   #S(FORMGREP:SYMREF
                      :NAME "%DCAS-STRUCT-SLOT"
                      :QUALIFIER "SYS.INT")
                   OBJ '(ECLECTOR.READER:UNQUOTE (AST-VALUE STRUCTURE-NAME-1))
                   '(ECLECTOR.READER:UNQUOTE (AST-VALUE SLOT-NAME-1))
                   '(ECLECTOR.READER:UNQUOTE (AST-VALUE STRUCTURE-NAME-2))
                   '(ECLECTOR.READER:UNQUOTE (AST-VALUE SLOT-NAME-2)) OLD-1
                   OLD-2 NEW-1 NEW-2))))
           FORM))))))

[Mezzano/compiler/simplify.lisp:1444]
  (DEFUN SIMPLIFY-STRUCT-VECTOR-SLOT (FORM)
    (CHANGE-MADE)
    (DESTRUCTURING-BIND
        (OBJECT STRUCTURE-NAME SLOT-NAME INDEX)
        (ARGUMENTS FORM)
      (LET ((SLOT-DEF (FIND-STRUCT-SLOT STRUCTURE-NAME SLOT-NAME))
            (STRUCT
             (#S(FORMGREP:SYMREF
                 :NAME "GET-STRUCTURE-TYPE"
                 :QUALIFIER "SYS.INT")
              (AST-VALUE STRUCTURE-NAME))))
        (COND
         ((MATCH-OPTIMIZE-SETTINGS FORM '((= SAFETY 0) (= SPEED 3)))
          (AST (STRUCT-VECTOR-SLOT-ACCESS-FORM SLOT-DEF OBJECT NIL INDEX T)
           FORM))
         (T
          (AST
           (ECLECTOR.READER:QUASIQUOTE
            (LET ((OBJ (ECLECTOR.READER:UNQUOTE OBJECT))
                  (IND (ECLECTOR.READER:UNQUOTE INDEX)))
              (PROGN
               (ECLECTOR.READER:UNQUOTE
                (SIMPLIFY-STRUCT-VECTOR-SLOT-CHECK-BOUNDS 'IND SLOT-DEF))
               (IF (ECLECTOR.READER:UNQUOTE
                    (STRUCT-TYPE-TEST-FORM 'OBJ STRUCT))
                   (ECLECTOR.READER:UNQUOTE
                    (STRUCT-VECTOR-SLOT-ACCESS-FORM SLOT-DEF 'OBJ NIL 'IND
                     NIL))
                   (NOTINLINE-CALL
                    #S(FORMGREP:SYMREF
                       :NAME "%STRUCT-VECTOR-SLOT"
                       :QUALIFIER "SYS.INT")
                    OBJ '(ECLECTOR.READER:UNQUOTE (AST-VALUE STRUCTURE-NAME))
                    '(ECLECTOR.READER:UNQUOTE (AST-VALUE SLOT-NAME)) IND)))))
           FORM))))))

[Mezzano/compiler/simplify.lisp:1467]
  (DEFUN SIMPLIFY-SETF-STRUCT-VECTOR-SLOT (FORM)
    (CHANGE-MADE)
    (DESTRUCTURING-BIND
        (VALUE OBJECT STRUCTURE-NAME SLOT-NAME INDEX)
        (ARGUMENTS FORM)
      (LET ((SLOT-DEF (FIND-STRUCT-SLOT STRUCTURE-NAME SLOT-NAME))
            (STRUCT
             (#S(FORMGREP:SYMREF
                 :NAME "GET-STRUCTURE-TYPE"
                 :QUALIFIER "SYS.INT")
              (AST-VALUE STRUCTURE-NAME))))
        (COND
         ((MATCH-OPTIMIZE-SETTINGS FORM '((= SAFETY 0) (= SPEED 3)))
          (AST
           (STRUCT-VECTOR-SLOT-ACCESS-FORM SLOT-DEF OBJECT 'SETF INDEX T VALUE)
           FORM))
         (T
          (AST
           (ECLECTOR.READER:QUASIQUOTE
            (LET ((VAL (ECLECTOR.READER:UNQUOTE VALUE))
                  (OBJ (ECLECTOR.READER:UNQUOTE OBJECT))
                  (IND (ECLECTOR.READER:UNQUOTE INDEX)))
              (PROGN
               (ECLECTOR.READER:UNQUOTE
                (SIMPLIFY-STRUCT-VECTOR-SLOT-CHECK-BOUNDS 'IND SLOT-DEF))
               (IF (ECLECTOR.READER:UNQUOTE
                    (STRUCT-TYPE-TEST-FORM 'OBJ STRUCT))
                   (PROGN
                    (IF (SOURCE-FRAGMENT
                         (TYPEP VAL
                                '(ECLECTOR.READER:UNQUOTE
                                  (#S(FORMGREP:SYMREF
                                      :NAME "SLOT-DEFINITION-TYPE"
                                      :QUALIFIER "MEZZANO.CLOS")
                                   SLOT-DEF))))
                        'NIL
                        (PROGN
                         (CALL
                          #S(FORMGREP:SYMREF
                             :NAME "RAISE-TYPE-ERROR"
                             :QUALIFIER "SYS.INT")
                          VAL
                          '(ECLECTOR.READER:UNQUOTE
                            (#S(FORMGREP:SYMREF
                                :NAME "SLOT-DEFINITION-TYPE"
                                :QUALIFIER "MEZZANO.CLOS")
                             SLOT-DEF)))
                         (CALL
                          #S(FORMGREP:SYMREF
                             :NAME "%%UNREACHABLE"
                             :QUALIFIER "SYS.INT"))))
                    (ECLECTOR.READER:UNQUOTE
                     (STRUCT-VECTOR-SLOT-ACCESS-FORM SLOT-DEF 'OBJ 'SETF 'IND
                      NIL 'VAL)))
                   (NOTINLINE-CALL
                    (SETF #S(FORMGREP:SYMREF
                             :NAME "%STRUCT-VECTOR-SLOT"
                             :QUALIFIER "SYS.INT"))
                    VAL OBJ
                    '(ECLECTOR.READER:UNQUOTE (AST-VALUE STRUCTURE-NAME))
                    '(ECLECTOR.READER:UNQUOTE (AST-VALUE SLOT-NAME)) IND)))))
           FORM))))))

[Mezzano/compiler/simplify.lisp:1498]
  (DEFUN SIMPLIFY-CAS-STRUCT-VECTOR-SLOT (FORM)
    (CHANGE-MADE)
    (DESTRUCTURING-BIND
        (OLD NEW OBJECT STRUCTURE-NAME SLOT-NAME INDEX)
        (ARGUMENTS FORM)
      (LET ((SLOT-DEF (FIND-STRUCT-SLOT STRUCTURE-NAME SLOT-NAME))
            (STRUCT
             (#S(FORMGREP:SYMREF
                 :NAME "GET-STRUCTURE-TYPE"
                 :QUALIFIER "SYS.INT")
              (AST-VALUE STRUCTURE-NAME))))
        (COND
         ((MATCH-OPTIMIZE-SETTINGS FORM '((= SAFETY 0) (= SPEED 3)))
          (AST
           (ECLECTOR.READER:QUASIQUOTE
            (LET ((OLD (ECLECTOR.READER:UNQUOTE OLD))
                  (NEW (ECLECTOR.READER:UNQUOTE NEW))
                  (OBJ (ECLECTOR.READER:UNQUOTE OBJECT))
                  (IND (ECLECTOR.READER:UNQUOTE INDEX)))
              (ECLECTOR.READER:UNQUOTE
               (STRUCT-VECTOR-SLOT-ACCESS-FORM SLOT-DEF 'OBJ
                '#S(FORMGREP:SYMREF :NAME "CAS" :QUALIFIER "SYS.INT") 'IND T
                'OLD 'NEW))))
           FORM))
         (T
          (AST
           (ECLECTOR.READER:QUASIQUOTE
            (LET ((OLD (ECLECTOR.READER:UNQUOTE OLD))
                  (NEW (ECLECTOR.READER:UNQUOTE NEW))
                  (OBJ (ECLECTOR.READER:UNQUOTE OBJECT))
                  (IND (ECLECTOR.READER:UNQUOTE INDEX)))
              (PROGN
               (ECLECTOR.READER:UNQUOTE
                (SIMPLIFY-STRUCT-VECTOR-SLOT-CHECK-BOUNDS 'IND SLOT-DEF))
               (IF (ECLECTOR.READER:UNQUOTE
                    (STRUCT-TYPE-TEST-FORM 'OBJ STRUCT))
                   (PROGN
                    (IF (SOURCE-FRAGMENT
                         (TYPEP OLD
                                '(ECLECTOR.READER:UNQUOTE
                                  (#S(FORMGREP:SYMREF
                                      :NAME "SLOT-DEFINITION-TYPE"
                                      :QUALIFIER "MEZZANO.CLOS")
                                   SLOT-DEF))))
                        'NIL
                        (PROGN
                         (CALL
                          #S(FORMGREP:SYMREF
                             :NAME "RAISE-TYPE-ERROR"
                             :QUALIFIER "SYS.INT")
                          NEW
                          '(ECLECTOR.READER:UNQUOTE
                            (#S(FORMGREP:SYMREF
                                :NAME "SLOT-DEFINITION-TYPE"
                                :QUALIFIER "MEZZANO.CLOS")
                             SLOT-DEF)))
                         (CALL
                          #S(FORMGREP:SYMREF
                             :NAME "%%UNREACHABLE"
                             :QUALIFIER "SYS.INT"))))
                    (IF (SOURCE-FRAGMENT
                         (TYPEP NEW
                                '(ECLECTOR.READER:UNQUOTE
                                  (#S(FORMGREP:SYMREF
                                      :NAME "SLOT-DEFINITION-TYPE"
                                      :QUALIFIER "MEZZANO.CLOS")
                                   SLOT-DEF))))
                        'NIL
                        (PROGN
                         (CALL
                          #S(FORMGREP:SYMREF
                             :NAME "RAISE-TYPE-ERROR"
                             :QUALIFIER "SYS.INT")
                          NEW
                          '(ECLECTOR.READER:UNQUOTE
                            (#S(FORMGREP:SYMREF
                                :NAME "SLOT-DEFINITION-TYPE"
                                :QUALIFIER "MEZZANO.CLOS")
                             SLOT-DEF)))
                         (CALL
                          #S(FORMGREP:SYMREF
                             :NAME "%%UNREACHABLE"
                             :QUALIFIER "SYS.INT"))))
                    (ECLECTOR.READER:UNQUOTE
                     (STRUCT-VECTOR-SLOT-ACCESS-FORM SLOT-DEF 'OBJ
                      '#S(FORMGREP:SYMREF :NAME "CAS" :QUALIFIER "SYS.INT")
                      'IND NIL 'OLD 'NEW)))
                   (NOTINLINE-CALL
                    (#S(FORMGREP:SYMREF :NAME "CAS" :QUALIFIER "SYS.INT")
                     #S(FORMGREP:SYMREF
                        :NAME "%STRUCT-VECTOR-SLOT"
                        :QUALIFIER "SYS.INT"))
                    OLD NEW OBJ
                    '(ECLECTOR.READER:UNQUOTE (AST-VALUE STRUCTURE-NAME))
                    '(ECLECTOR.READER:UNQUOTE (AST-VALUE SLOT-NAME)) IND)))))
           FORM))))))

[Mezzano/compiler/simplify.lisp:1659]
  (DEFMETHOD SIMP-FORM ((FORM AST-CALL))
    (DO ((I (ARGUMENTS FORM) (CDR I)))
        ((ENDP I))
      (SETF (CAR I) (SIMP-FORM (HOIST-THE-FORM-TO-EDGE (CAR I)))))
    (COND ((EQL (NAME FORM) 'EQL) (SIMP-EQL FORM))
          ((AND (EQL (NAME FORM) 'EQ) (EQL (LENGTH (ARGUMENTS FORM)) 2)
                (EQL (FIRST (ARGUMENTS FORM)) (SECOND (ARGUMENTS FORM))))
           (CHANGE-MADE) (AST ''T FORM))
          ((EQL (NAME FORM) 'ASH) (SIMP-ASH FORM))
          ((AND (EQL (NAME FORM) 'EQ)
                (MATCH-OPTIMIZE-SETTINGS FORM '((= SAFETY 0) (= SPEED 3)))
                (EQL (LENGTH (ARGUMENTS FORM)) 2)
                (TYPEP (FIRST (ARGUMENTS FORM)) 'AST-THE)
                (COMPILER-TYPE-EQUAL-P (AST-THE-TYPE (FIRST (ARGUMENTS FORM)))
                 '(UNSIGNED-BYTE 64))
                (QUOTED-FORM-P (SECOND (ARGUMENTS FORM)))
                (INTEGERP (VALUE (SECOND (ARGUMENTS FORM)))))
           (CHANGE-MADE)
           (AST
            (ECLECTOR.READER:QUASIQUOTE
             (CALL
              #S(FORMGREP:SYMREF :NAME "%UB64-=" :QUALIFIER "MEZZANO.RUNTIME")
              (ECLECTOR.READER:UNQUOTE (FIRST (ARGUMENTS FORM)))
              (ECLECTOR.READER:UNQUOTE (SECOND (ARGUMENTS FORM)))))
            FORM))
          ((AND (EQL (NAME FORM) 'ARRAY-RANK) (EQL (LENGTH (ARGUMENTS FORM)) 1)
                (MATCH-OPTIMIZE-SETTINGS FORM '((= SAFETY 0) (= SPEED 3))))
           (SIMP-ARRAY-RANK FORM))
          ((AND (EQL (NAME FORM) 'ARRAY-DIMENSION)
                (EQL (LENGTH (ARGUMENTS FORM)) 2)
                (MATCH-OPTIMIZE-SETTINGS FORM '((= SAFETY 0) (= SPEED 3))))
           (SIMP-ARRAY-DIMENSION FORM))
          ((AND
            (MEMBER (NAME FORM)
                    '(#S(FORMGREP:SYMREF
                         :NAME "BINARY-LOGAND"
                         :QUALIFIER "SYS.INT")
                      %FAST-FIXNUM-LOGAND))
            (EQL (LENGTH (ARGUMENTS FORM)) 2)
            (MATCH-OPTIMIZE-SETTINGS FORM '((= SAFETY 0) (= SPEED 3))))
           (SIMP-LOGAND FORM))
          ((AND
            (EQL (NAME FORM)
                 '#S(FORMGREP:SYMREF
                     :NAME "%COERCE-TO-CALLABLE"
                     :QUALIFIER "SYS.INT"))
            (EQL (LENGTH (ARGUMENTS FORM)) 1)
            (TYPEP (UNWRAP-THE (FIRST (ARGUMENTS FORM))) 'AST-QUOTE)
            (SYMBOLP (VALUE (UNWRAP-THE (FIRST (ARGUMENTS FORM))))))
           (CHANGE-MADE)
           (AST
            (ECLECTOR.READER:QUASIQUOTE
             #'(ECLECTOR.READER:UNQUOTE
                (VALUE (UNWRAP-THE (FIRST (ARGUMENTS FORM))))))
            FORM))
          ((AND
            (EQL (NAME FORM)
                 '#S(FORMGREP:SYMREF
                     :NAME "%COERCE-TO-CALLABLE"
                     :QUALIFIER "SYS.INT"))
            (EQL (LENGTH (ARGUMENTS FORM)) 1)
            (TYPEP (UNWRAP-THE (FIRST (ARGUMENTS FORM))) 'AST-FUNCTION))
           (CHANGE-MADE) (FIRST (ARGUMENTS FORM)))
          ((AND
            (EQL (NAME FORM)
                 '#S(FORMGREP:SYMREF
                     :NAME "%COERCE-TO-CALLABLE"
                     :QUALIFIER "SYS.INT"))
            (EQL (LENGTH (ARGUMENTS FORM)) 1)
            (TYPEP (UNWRAP-THE (FIRST (ARGUMENTS FORM))) 'LAMBDA-INFORMATION))
           (CHANGE-MADE) (FIRST (ARGUMENTS FORM)))
          ((AND
            (EQL (NAME FORM)
                 '#S(FORMGREP:SYMREF
                     :NAME "%COERCE-TO-CALLABLE"
                     :QUALIFIER "SYS.INT"))
            (EQL (LENGTH (ARGUMENTS FORM)) 1)
            (TYPEP (UNWRAP-THE (FIRST (ARGUMENTS FORM))) 'AST-QUOTE)
            (FUNCTIONP (AST-VALUE (UNWRAP-THE (FIRST (ARGUMENTS FORM))))))
           (CHANGE-MADE) (FIRST (ARGUMENTS FORM)))
          ((AND
            (EQL (NAME FORM)
                 '#S(FORMGREP:SYMREF
                     :NAME "%APPLY"
                     :QUALIFIER "MEZZANO.RUNTIME"))
            (EQL (LENGTH (ARGUMENTS FORM)) 2))
           (SIMP-%APPLY FORM))
          ((AND
            (EQL (NAME FORM)
                 '#S(FORMGREP:SYMREF
                     :NAME "%FUNCALL"
                     :QUALIFIER "MEZZANO.RUNTIME"))
            (TYPEP (UNWRAP-THE (FIRST (ARGUMENTS FORM))) 'AST-FUNCTION))
           (CHANGE-MADE)
           (AST
            (ECLECTOR.READER:QUASIQUOTE
             (CALL
              (ECLECTOR.READER:UNQUOTE
               (NAME (UNWRAP-THE (FIRST (ARGUMENTS FORM)))))
              (ECLECTOR.READER:UNQUOTE-SPLICING (REST (ARGUMENTS FORM)))))
            FORM))
          ((AND (EQL (NAME FORM) 'FUNCALL) (CONSP (ARGUMENTS FORM)))
           (CHANGE-MADE)
           (AST
            (ECLECTOR.READER:QUASIQUOTE
             (CALL
              #S(FORMGREP:SYMREF :NAME "%FUNCALL" :QUALIFIER "MEZZANO.RUNTIME")
              (CALL
               #S(FORMGREP:SYMREF
                  :NAME "%COERCE-TO-CALLABLE"
                  :QUALIFIER "SYS.INT")
               (ECLECTOR.READER:UNQUOTE (FIRST (ARGUMENTS FORM))))
              (ECLECTOR.READER:UNQUOTE-SPLICING (REST (ARGUMENTS FORM)))))
            FORM))
          ((EQL (NAME FORM) 'LIST) (CHANGE-MADE)
           (LET ((INNER (AST (ECLECTOR.READER:QUASIQUOTE 'NIL) FORM)))
             (LOOP FOR ARG IN (REVERSE (ARGUMENTS FORM))
                   DO (SETF INNER
                              (AST
                               (ECLECTOR.READER:QUASIQUOTE
                                (CALL CONS (ECLECTOR.READER:UNQUOTE ARG)
                                 (ECLECTOR.READER:UNQUOTE INNER)))
                               FORM)))
             INNER))
          ((AND (EQL (NAME FORM) 'LIST*) (ARGUMENTS FORM)) (CHANGE-MADE)
           (LET ((INNER (FIRST (LAST (ARGUMENTS FORM)))))
             (LOOP FOR ARG IN (REVERSE (BUTLAST (ARGUMENTS FORM)))
                   DO (SETF INNER
                              (AST
                               (ECLECTOR.READER:QUASIQUOTE
                                (CALL CONS (ECLECTOR.READER:UNQUOTE ARG)
                                 (ECLECTOR.READER:UNQUOTE INNER)))
                               FORM)))
             INNER))
          ((AND
            (EQL (NAME FORM)
                 '#S(FORMGREP:SYMREF
                     :NAME "%STRUCT-SLOT"
                     :QUALIFIER "SYS.INT"))
            (LOCAL-INLINING-PERMITTED-P FORM) (= (LENGTH (ARGUMENTS FORM)) 3)
            (FIND-STRUCT-SLOT (SECOND (ARGUMENTS FORM))
             (THIRD (ARGUMENTS FORM))))
           (SIMPLIFY-STRUCT-SLOT FORM))
          ((AND
            (EQUAL (NAME FORM)
                   '(SETF #S(FORMGREP:SYMREF
                             :NAME "%STRUCT-SLOT"
                             :QUALIFIER "SYS.INT")))
            (LOCAL-INLINING-PERMITTED-P FORM) (= (LENGTH (ARGUMENTS FORM)) 4)
            (FIND-STRUCT-SLOT (THIRD (ARGUMENTS FORM))
             (FOURTH (ARGUMENTS FORM))))
           (SIMPLIFY-SETF-STRUCT-SLOT FORM))
          ((AND
            (EQUAL (NAME FORM)
                   '(#S(FORMGREP:SYMREF :NAME "CAS" :QUALIFIER "SYS.INT")
                     #S(FORMGREP:SYMREF
                        :NAME "%STRUCT-SLOT"
                        :QUALIFIER "SYS.INT")))
            (LOCAL-INLINING-PERMITTED-P FORM) (= (LENGTH (ARGUMENTS FORM)) 5)
            (FIND-STRUCT-SLOT (FOURTH (ARGUMENTS FORM))
             (FIFTH (ARGUMENTS FORM))))
           (SIMPLIFY-CAS-STRUCT-SLOT FORM))
          ((AND
            (MEMBER (NAME FORM)
                    '(#S(FORMGREP:SYMREF
                         :NAME "%ATOMIC-FIXNUM-ADD-STRUCT-SLOT"
                         :QUALIFIER "SYS.INT")
                      #S(FORMGREP:SYMREF
                         :NAME "%ATOMIC-FIXNUM-LOGAND-STRUCT-SLOT"
                         :QUALIFIER "SYS.INT")
                      #S(FORMGREP:SYMREF
                         :NAME "%ATOMIC-FIXNUM-LOGIOR-STRUCT-SLOT"
                         :QUALIFIER "SYS.INT")
                      #S(FORMGREP:SYMREF
                         :NAME "%ATOMIC-FIXNUM-LOGXOR-STRUCT-SLOT"
                         :QUALIFIER "SYS.INT")))
            (LOCAL-INLINING-PERMITTED-P FORM) (= (LENGTH (ARGUMENTS FORM)) 4)
            (TEST-ATOMIC-FIXNUM-OP-STRUCT-SLOT-TRANSFORM-VIABILITY FORM))
           (SIMPLIFY-ATOMIC-FIXNUM-OP-STRUCT-SLOT FORM))
          ((AND
            (EQL (NAME FORM)
                 '#S(FORMGREP:SYMREF
                     :NAME "%ATOMIC-SWAP-STRUCT-SLOT"
                     :QUALIFIER "SYS.INT"))
            (LOCAL-INLINING-PERMITTED-P FORM) (= (LENGTH (ARGUMENTS FORM)) 4)
            (TEST-ATOMIC-SWAP-STRUCT-SLOT-TRANSFORM-VIABILITY FORM))
           (SIMPLIFY-ATOMIC-SWAP-STRUCT-SLOT FORM))
          ((AND
            (EQUAL (NAME FORM)
                   '#S(FORMGREP:SYMREF
                       :NAME "%DCAS-STRUCT-SLOT"
                       :QUALIFIER "SYS.INT"))
            (LOCAL-INLINING-PERMITTED-P FORM) (= (LENGTH (ARGUMENTS FORM)) 9)
            (TEST-DCAS-STRUCT-SLOT-TRANSFORM-VIABILITY
             (SECOND (ARGUMENTS FORM)) (THIRD (ARGUMENTS FORM))
             (FOURTH (ARGUMENTS FORM)) (FIFTH (ARGUMENTS FORM))))
           (SIMPLIFY-DCAS-STRUCT-SLOT FORM))
          ((AND
            (EQL (NAME FORM)
                 '#S(FORMGREP:SYMREF
                     :NAME "%STRUCT-VECTOR-SLOT"
                     :QUALIFIER "SYS.INT"))
            (LOCAL-INLINING-PERMITTED-P FORM) (= (LENGTH (ARGUMENTS FORM)) 4)
            (FIND-STRUCT-SLOT (SECOND (ARGUMENTS FORM))
             (THIRD (ARGUMENTS FORM))))
           (SIMPLIFY-STRUCT-VECTOR-SLOT FORM))
          ((AND
            (EQUAL (NAME FORM)
                   '(SETF #S(FORMGREP:SYMREF
                             :NAME "%STRUCT-VECTOR-SLOT"
                             :QUALIFIER "SYS.INT")))
            (LOCAL-INLINING-PERMITTED-P FORM) (= (LENGTH (ARGUMENTS FORM)) 5)
            (FIND-STRUCT-SLOT (THIRD (ARGUMENTS FORM))
             (FOURTH (ARGUMENTS FORM))))
           (SIMPLIFY-SETF-STRUCT-VECTOR-SLOT FORM))
          ((AND
            (EQUAL (NAME FORM)
                   '(#S(FORMGREP:SYMREF :NAME "CAS" :QUALIFIER "SYS.INT")
                     #S(FORMGREP:SYMREF
                        :NAME "%STRUCT-VECTOR-SLOT"
                        :QUALIFIER "SYS.INT")))
            (LOCAL-INLINING-PERMITTED-P FORM) (= (LENGTH (ARGUMENTS FORM)) 6)
            (FIND-STRUCT-SLOT (FOURTH (ARGUMENTS FORM))
             (FIFTH (ARGUMENTS FORM))))
           (SIMPLIFY-CAS-STRUCT-VECTOR-SLOT FORM))
          ((AND
            (EQL (NAME FORM)
                 '#S(FORMGREP:SYMREF
                     :NAME "%ALLOCATE-STRUCT"
                     :QUALIFIER "SYS.INT"))
            (LOCAL-INLINING-PERMITTED-P FORM) (= (LENGTH (ARGUMENTS FORM)) 1)
            (TYPEP (FIRST (ARGUMENTS FORM)) 'AST-QUOTE)
            (SYMBOLP (AST-VALUE (FIRST (ARGUMENTS FORM))))
            (#S(FORMGREP:SYMREF
                :NAME "GET-STRUCTURE-TYPE"
                :QUALIFIER "SYS.INT")
             (AST-VALUE (FIRST (ARGUMENTS FORM))) NIL))
           (CHANGE-MADE)
           (AST
            (ECLECTOR.READER:QUASIQUOTE
             (CALL
              #S(FORMGREP:SYMREF :NAME "%ALLOCATE-STRUCT" :QUALIFIER "SYS.INT")
              '(ECLECTOR.READER:UNQUOTE
                (#S(FORMGREP:SYMREF
                    :NAME "GET-STRUCTURE-TYPE"
                    :QUALIFIER "SYS.INT")
                 (AST-VALUE (FIRST (ARGUMENTS FORM)))))))
            FORM))
          ((AND
            (EQL (NAME FORM)
                 '#S(FORMGREP:SYMREF
                     :NAME "%FIXNUM-<"
                     :QUALIFIER "MEZZANO.RUNTIME"))
            (LOCAL-INLINING-PERMITTED-P FORM) (= (LENGTH (ARGUMENTS FORM)) 2)
            (MATCH-OPTIMIZE-SETTINGS FORM '((= SAFETY 0) (= SPEED 3)))
            (FOLD-FIXNUM-< FORM)))
          ((AND (EQL (NAME FORM) 'BYTE-SIZE) (EQL (LENGTH (ARGUMENTS FORM)) 1)
                (TYPEP (FIRST (ARGUMENTS FORM)) 'AST-CALL)
                (EQL (AST-NAME (FIRST (ARGUMENTS FORM))) 'BYTE)
                (EQL (LENGTH (ARGUMENTS (FIRST (ARGUMENTS FORM)))) 2))
           (CHANGE-MADE)
           (AST
            (ECLECTOR.READER:QUASIQUOTE
             (LET ((SIZE
                    (ECLECTOR.READER:UNQUOTE
                     (FIRST (ARGUMENTS (FIRST (ARGUMENTS FORM)))))))
               (PROGN
                (ECLECTOR.READER:UNQUOTE
                 (SECOND (ARGUMENTS (FIRST (ARGUMENTS FORM)))))
                SIZE)))
            FORM))
          ((AND (EQL (NAME FORM) 'BYTE-POSITION)
                (EQL (LENGTH (ARGUMENTS FORM)) 1)
                (TYPEP (FIRST (ARGUMENTS FORM)) 'AST-CALL)
                (EQL (AST-NAME (FIRST (ARGUMENTS FORM))) 'BYTE)
                (EQL (LENGTH (ARGUMENTS (FIRST (ARGUMENTS FORM)))) 2))
           (CHANGE-MADE)
           (AST
            (ECLECTOR.READER:QUASIQUOTE
             (PROGN
              (ECLECTOR.READER:UNQUOTE
               (FIRST (ARGUMENTS (FIRST (ARGUMENTS FORM)))))
              (ECLECTOR.READER:UNQUOTE
               (SECOND (ARGUMENTS (FIRST (ARGUMENTS FORM)))))))
            FORM))
          (T
           (LOOP FOR ARG-POSITION FROM 0
                 FOR ARG IN (ARGUMENTS FORM)
                 FOR TYPE = (UNWRAPPED-THE-TYPE ARG)
                 FOR UNWRAPPED-ARG = (UNWRAP-THE ARG)
                 WHEN (TYPEP UNWRAPPED-ARG 'AST-PROGN)
                 DO (CHANGE-MADE) (RETURN-FROM SIMP-FORM
                                    (SIMP-FORM
                                     (AST
                                      (ECLECTOR.READER:QUASIQUOTE
                                       (PROGN
                                        (ECLECTOR.READER:UNQUOTE-SPLICING
                                         (BUTLAST (AST-FORMS UNWRAPPED-ARG)))
                                        (CALL
                                         (ECLECTOR.READER:UNQUOTE
                                          (AST-NAME FORM))
                                         (ECLECTOR.READER:UNQUOTE-SPLICING
                                          (SUBSEQ (ARGUMENTS FORM) 0
                                                  ARG-POSITION))
                                         (THE (ECLECTOR.READER:UNQUOTE TYPE)
                                              (ECLECTOR.READER:UNQUOTE
                                               (FIRST
                                                (LAST
                                                 (AST-FORMS UNWRAPPED-ARG)))))
                                         (ECLECTOR.READER:UNQUOTE-SPLICING
                                          (SUBSEQ (ARGUMENTS FORM)
                                                  (1+ ARG-POSITION))))))
                                      FORM)))
                 WHEN (AND (TYPEP UNWRAPPED-ARG 'AST-LET)
                           (NOT (LET-BINDS-SPECIAL-VARIABLE-P UNWRAPPED-ARG)))
                 DO (CHANGE-MADE) (RETURN-FROM SIMP-FORM
                                    (SIMP-FORM
                                     (AST
                                      (ECLECTOR.READER:QUASIQUOTE
                                       (LET (ECLECTOR.READER:UNQUOTE
                                             (AST-BINDINGS UNWRAPPED-ARG))
                                         (CALL
                                          (ECLECTOR.READER:UNQUOTE
                                           (AST-NAME FORM))
                                          (ECLECTOR.READER:UNQUOTE-SPLICING
                                           (SUBSEQ (ARGUMENTS FORM) 0
                                                   ARG-POSITION))
                                          (THE (ECLECTOR.READER:UNQUOTE TYPE)
                                               (ECLECTOR.READER:UNQUOTE
                                                (AST-BODY UNWRAPPED-ARG)))
                                          (ECLECTOR.READER:UNQUOTE-SPLICING
                                           (SUBSEQ (ARGUMENTS FORM)
                                                   (1+ ARG-POSITION))))))
                                      FORM)))
                 WHEN (NOT (PURE-P UNWRAPPED-ARG))
                 DO (RETURN))
           FORM)))

[Mezzano/compiler/transforms.lisp:291]
  (DEFMACRO DEFINE-FAST-UB64-TRANSFORM-ARITH-TWO-ARG
            (BINARY-FN FAST-FN &KEY (RESULT '(UNSIGNED-BYTE 64)))
    (ECLECTOR.READER:QUASIQUOTE
     (DEFINE-TRANSFORM (ECLECTOR.READER:UNQUOTE BINARY-FN)
      ((LHS (UNSIGNED-BYTE 64)) (RHS (UNSIGNED-BYTE 64)))
      ((:RESULT-TYPE (ECLECTOR.READER:UNQUOTE RESULT))
       (:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
      (ECLECTOR.READER:QUASIQUOTE
       (THE (UNSIGNED-BYTE 64)
            (CALL (ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE FAST-FN))
             (ECLECTOR.READER:UNQUOTE LHS) (ECLECTOR.READER:UNQUOTE RHS)))))))

[Mezzano/compiler/transforms.lisp:307]
  (DEFINE-TRANSFORM
   #S(FORMGREP:SYMREF :NAME "RIGHT-SHIFT" :QUALIFIER "MEZZANO.RUNTIME")
   ((INTEGER (UNSIGNED-BYTE 64)) (COUNT (UNSIGNED-BYTE 6)))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (THE (UNSIGNED-BYTE 64)
         (CALL
          #S(FORMGREP:SYMREF
             :NAME "%UB64-RIGHT-SHIFT-IN-LIMITS"
             :QUALIFIER "MEZZANO.RUNTIME")
          (ECLECTOR.READER:UNQUOTE INTEGER) (ECLECTOR.READER:UNQUOTE COUNT)))))

[Mezzano/compiler/transforms.lisp:314]
  (DEFINE-TRANSFORM EQL ((LHS (UNSIGNED-BYTE 64)) (RHS (UNSIGNED-BYTE 64)))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (CALL #S(FORMGREP:SYMREF :NAME "%UB64-=" :QUALIFIER "MEZZANO.RUNTIME")
     (ECLECTOR.READER:UNQUOTE LHS) (ECLECTOR.READER:UNQUOTE RHS))))

[Mezzano/compiler/transforms.lisp:318]
  (DEFINE-TRANSFORM #S(FORMGREP:SYMREF :NAME "BINARY-=" :QUALIFIER "SYS.INT")
   ((LHS (UNSIGNED-BYTE 64)) (RHS (UNSIGNED-BYTE 64)))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (CALL #S(FORMGREP:SYMREF :NAME "%UB64-=" :QUALIFIER "MEZZANO.RUNTIME")
     (ECLECTOR.READER:UNQUOTE LHS) (ECLECTOR.READER:UNQUOTE RHS))))

[Mezzano/compiler/transforms.lisp:322]
  (DEFINE-TRANSFORM #S(FORMGREP:SYMREF :NAME "BINARY-<" :QUALIFIER "SYS.INT")
   ((LHS (UNSIGNED-BYTE 64)) (RHS (UNSIGNED-BYTE 64)))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (CALL #S(FORMGREP:SYMREF :NAME "%UB64-<" :QUALIFIER "MEZZANO.RUNTIME")
     (ECLECTOR.READER:UNQUOTE LHS) (ECLECTOR.READER:UNQUOTE RHS))))

[Mezzano/compiler/transforms.lisp:326]
  (DEFINE-TRANSFORM #S(FORMGREP:SYMREF :NAME "BINARY->=" :QUALIFIER "SYS.INT")
   ((LHS (UNSIGNED-BYTE 64)) (RHS (UNSIGNED-BYTE 64)))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (CALL NOT
     (CALL #S(FORMGREP:SYMREF :NAME "%UB64-<" :QUALIFIER "MEZZANO.RUNTIME")
      (ECLECTOR.READER:UNQUOTE LHS) (ECLECTOR.READER:UNQUOTE RHS)))))

[Mezzano/compiler/transforms.lisp:330]
  (DEFINE-TRANSFORM #S(FORMGREP:SYMREF :NAME "BINARY->" :QUALIFIER "SYS.INT")
   ((LHS (UNSIGNED-BYTE 64)) (RHS (UNSIGNED-BYTE 64)))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (CALL #S(FORMGREP:SYMREF :NAME "%UB64-<" :QUALIFIER "MEZZANO.RUNTIME")
     (ECLECTOR.READER:UNQUOTE RHS) (ECLECTOR.READER:UNQUOTE LHS))))

[Mezzano/compiler/transforms.lisp:334]
  (DEFINE-TRANSFORM #S(FORMGREP:SYMREF :NAME "BINARY-<=" :QUALIFIER "SYS.INT")
   ((LHS (UNSIGNED-BYTE 64)) (RHS (UNSIGNED-BYTE 64)))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (CALL NOT
     (CALL #S(FORMGREP:SYMREF :NAME "%UB64-<" :QUALIFIER "MEZZANO.RUNTIME")
      (ECLECTOR.READER:UNQUOTE RHS) (ECLECTOR.READER:UNQUOTE LHS)))))

[Mezzano/compiler/transforms.lisp:342]
  (DEFMACRO DEFINE-FAST-SB64-TRANSFORM-ARITH-TWO-ARG
            (BINARY-FN FAST-FN &KEY (RESULT '(SIGNED-BYTE 64)))
    (ECLECTOR.READER:QUASIQUOTE
     (DEFINE-TRANSFORM (ECLECTOR.READER:UNQUOTE BINARY-FN)
      ((LHS (SIGNED-BYTE 64)) (RHS (SIGNED-BYTE 64)))
      ((:RESULT-TYPE (ECLECTOR.READER:UNQUOTE RESULT))
       (:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
      (ECLECTOR.READER:QUASIQUOTE
       (THE (SIGNED-BYTE 64)
            (CALL (ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE FAST-FN))
             (ECLECTOR.READER:UNQUOTE LHS) (ECLECTOR.READER:UNQUOTE RHS)))))))

[Mezzano/compiler/transforms.lisp:358]
  (DEFINE-TRANSFORM #S(FORMGREP:SYMREF :NAME "BINARY-=" :QUALIFIER "SYS.INT")
   ((LHS (SIGNED-BYTE 64)) (RHS (SIGNED-BYTE 64)))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (CALL #S(FORMGREP:SYMREF :NAME "%SB64-=" :QUALIFIER "MEZZANO.RUNTIME")
     (ECLECTOR.READER:UNQUOTE LHS) (ECLECTOR.READER:UNQUOTE RHS))))

[Mezzano/compiler/transforms.lisp:362]
  (DEFINE-TRANSFORM #S(FORMGREP:SYMREF :NAME "BINARY-<" :QUALIFIER "SYS.INT")
   ((LHS (SIGNED-BYTE 64)) (RHS (SIGNED-BYTE 64)))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (CALL #S(FORMGREP:SYMREF :NAME "%SB64-<" :QUALIFIER "MEZZANO.RUNTIME")
     (ECLECTOR.READER:UNQUOTE LHS) (ECLECTOR.READER:UNQUOTE RHS))))

[Mezzano/compiler/transforms.lisp:366]
  (DEFINE-TRANSFORM #S(FORMGREP:SYMREF :NAME "BINARY->=" :QUALIFIER "SYS.INT")
   ((LHS (SIGNED-BYTE 64)) (RHS (SIGNED-BYTE 64)))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (CALL NOT
     (CALL #S(FORMGREP:SYMREF :NAME "%SB64-<" :QUALIFIER "MEZZANO.RUNTIME")
      (ECLECTOR.READER:UNQUOTE LHS) (ECLECTOR.READER:UNQUOTE RHS)))))

[Mezzano/compiler/transforms.lisp:370]
  (DEFINE-TRANSFORM #S(FORMGREP:SYMREF :NAME "BINARY->" :QUALIFIER "SYS.INT")
   ((LHS (SIGNED-BYTE 64)) (RHS (SIGNED-BYTE 64)))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (CALL #S(FORMGREP:SYMREF :NAME "%SB64-<" :QUALIFIER "MEZZANO.RUNTIME")
     (ECLECTOR.READER:UNQUOTE RHS) (ECLECTOR.READER:UNQUOTE LHS))))

[Mezzano/compiler/transforms.lisp:374]
  (DEFINE-TRANSFORM #S(FORMGREP:SYMREF :NAME "BINARY-<=" :QUALIFIER "SYS.INT")
   ((LHS (SIGNED-BYTE 64)) (RHS (SIGNED-BYTE 64)))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (CALL NOT
     (CALL #S(FORMGREP:SYMREF :NAME "%SB64-<" :QUALIFIER "MEZZANO.RUNTIME")
      (ECLECTOR.READER:UNQUOTE RHS) (ECLECTOR.READER:UNQUOTE LHS)))))

[Mezzano/compiler/transforms.lisp:383]
  (DEFMACRO DEFINE-FAST-FIXNUM-TRANSFORM-ARITH-TWO-ARG
            (BINARY-FN FAST-FN &KEY (RESULT 'FIXNUM))
    (ECLECTOR.READER:QUASIQUOTE
     (DEFINE-TRANSFORM (ECLECTOR.READER:UNQUOTE BINARY-FN)
      ((LHS FIXNUM) (RHS FIXNUM))
      ((:RESULT-TYPE (ECLECTOR.READER:UNQUOTE RESULT))
       (:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
      (ECLECTOR.READER:QUASIQUOTE
       (THE FIXNUM
            (CALL (ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE FAST-FN))
             (ECLECTOR.READER:UNQUOTE LHS) (ECLECTOR.READER:UNQUOTE RHS)))))))

[Mezzano/compiler/transforms.lisp:402]
  (DEFINE-TRANSFORM
   #S(FORMGREP:SYMREF :NAME "%FIXNUM-RIGHT-SHIFT" :QUALIFIER "MEZZANO.RUNTIME")
   (LHS (RHS (EQL 0))) ((:OPTIMIZE (= SAFETY 0) (= SPEED 3))) LHS)

[Mezzano/compiler/transforms.lisp:406]
  (DEFINE-TRANSFORM
   #S(FORMGREP:SYMREF :NAME "GENERIC-RIGHT-SHIFT" :QUALIFIER "MEZZANO.RUNTIME")
   (LHS (RHS (EQL 0))) ((:OPTIMIZE (= SAFETY 0) (= SPEED 3))) LHS)

[Mezzano/compiler/transforms.lisp:420]
  (DEFINE-TRANSFORM EQL ((LHS FIXNUM) (RHS FIXNUM))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (CALL EQ (ECLECTOR.READER:UNQUOTE LHS) (ECLECTOR.READER:UNQUOTE RHS))))

[Mezzano/compiler/transforms.lisp:424]
  (DEFINE-TRANSFORM #S(FORMGREP:SYMREF :NAME "BINARY-=" :QUALIFIER "SYS.INT")
   ((LHS FIXNUM) (RHS FIXNUM)) ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (CALL EQ (ECLECTOR.READER:UNQUOTE LHS) (ECLECTOR.READER:UNQUOTE RHS))))

[Mezzano/compiler/transforms.lisp:428]
  (DEFINE-TRANSFORM #S(FORMGREP:SYMREF :NAME "BINARY-<" :QUALIFIER "SYS.INT")
   ((LHS FIXNUM) (RHS FIXNUM)) ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (CALL #S(FORMGREP:SYMREF :NAME "%FIXNUM-<" :QUALIFIER "MEZZANO.RUNTIME")
     (ECLECTOR.READER:UNQUOTE LHS) (ECLECTOR.READER:UNQUOTE RHS))))

[Mezzano/compiler/transforms.lisp:432]
  (DEFINE-TRANSFORM #S(FORMGREP:SYMREF :NAME "BINARY->=" :QUALIFIER "SYS.INT")
   ((LHS FIXNUM) (RHS FIXNUM)) ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (CALL NOT
     (CALL #S(FORMGREP:SYMREF :NAME "%FIXNUM-<" :QUALIFIER "MEZZANO.RUNTIME")
      (ECLECTOR.READER:UNQUOTE LHS) (ECLECTOR.READER:UNQUOTE RHS)))))

[Mezzano/compiler/transforms.lisp:436]
  (DEFINE-TRANSFORM #S(FORMGREP:SYMREF :NAME "BINARY->" :QUALIFIER "SYS.INT")
   ((LHS FIXNUM) (RHS FIXNUM)) ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (CALL #S(FORMGREP:SYMREF :NAME "%FIXNUM-<" :QUALIFIER "MEZZANO.RUNTIME")
     (ECLECTOR.READER:UNQUOTE RHS) (ECLECTOR.READER:UNQUOTE LHS))))

[Mezzano/compiler/transforms.lisp:440]
  (DEFINE-TRANSFORM #S(FORMGREP:SYMREF :NAME "BINARY-<=" :QUALIFIER "SYS.INT")
   ((LHS FIXNUM) (RHS FIXNUM)) ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (CALL NOT
     (CALL #S(FORMGREP:SYMREF :NAME "%FIXNUM-<" :QUALIFIER "MEZZANO.RUNTIME")
      (ECLECTOR.READER:UNQUOTE RHS) (ECLECTOR.READER:UNQUOTE LHS)))))

[Mezzano/compiler/transforms.lisp:446]
  (DEFMACRO DEFINE-FAST-SINGLE-FLOAT-TRANSFORM-ARITH-TWO-ARG
            (BINARY-FN GENERIC-FN FAST-FN)
    (ECLECTOR.READER:QUASIQUOTE
     (PROGN
      (DEFINE-TRANSFORM (ECLECTOR.READER:UNQUOTE BINARY-FN)
       ((LHS SINGLE-FLOAT) (RHS SINGLE-FLOAT))
       ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
       (ECLECTOR.READER:QUASIQUOTE
        (THE SINGLE-FLOAT
             (CALL (ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE FAST-FN))
              (ECLECTOR.READER:UNQUOTE LHS) (ECLECTOR.READER:UNQUOTE RHS)))))
      (DEFINE-TRANSFORM (ECLECTOR.READER:UNQUOTE GENERIC-FN)
       ((LHS SINGLE-FLOAT) (RHS SINGLE-FLOAT))
       ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
       (ECLECTOR.READER:QUASIQUOTE
        (THE SINGLE-FLOAT
             (CALL (ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE FAST-FN))
              (ECLECTOR.READER:UNQUOTE LHS) (ECLECTOR.READER:UNQUOTE RHS))))))))

[Mezzano/compiler/transforms.lisp:460]
  (DEFINE-TRANSFORM FLOAT ((NUMBER FIXNUM) (PROTOTYPE SINGLE-FLOAT))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (THE SINGLE-FLOAT
         (CALL
          #S(FORMGREP:SYMREF
             :NAME "%%COERCE-FIXNUM-TO-SINGLE-FLOAT"
             :QUALIFIER "MEZZANO.RUNTIME")
          (ECLECTOR.READER:UNQUOTE NUMBER)))))

[Mezzano/compiler/transforms.lisp:465]
  (DEFINE-TRANSFORM FLOAT ((NUMBER SINGLE-FLOAT) (PROTOTYPE SINGLE-FLOAT))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3))) NUMBER)

[Mezzano/compiler/transforms.lisp:469]
  (DEFINE-TRANSFORM FLOAT ((NUMBER DOUBLE-FLOAT) (PROTOTYPE SINGLE-FLOAT))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (THE SINGLE-FLOAT
         (CALL
          #S(FORMGREP:SYMREF
             :NAME "%%COERCE-DOUBLE-FLOAT-TO-SINGLE-FLOAT"
             :QUALIFIER "MEZZANO.RUNTIME")
          (ECLECTOR.READER:UNQUOTE NUMBER)))))

[Mezzano/compiler/transforms.lisp:474]
  (DEFINE-TRANSFORM FLOAT ((NUMBER FIXNUM))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (THE SINGLE-FLOAT
         (CALL
          #S(FORMGREP:SYMREF
             :NAME "%%COERCE-FIXNUM-TO-SINGLE-FLOAT"
             :QUALIFIER "MEZZANO.RUNTIME")
          (ECLECTOR.READER:UNQUOTE NUMBER)))))

[Mezzano/compiler/transforms.lisp:478]
  (DEFINE-TRANSFORM #S(FORMGREP:SYMREF :NAME "%TRUNCATE" :QUALIFIER "SYS.INT")
   ((NUMBER SINGLE-FLOAT) (DIVISOR (EQL 1)))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)) (:RESULT-TYPE FIXNUM))
   (ECLECTOR.READER:QUASIQUOTE
    (CALL
     #S(FORMGREP:SYMREF :NAME "%%TRUNCATE-SINGLE-FLOAT" :QUALIFIER "SYS.INT")
     (ECLECTOR.READER:UNQUOTE NUMBER))))

[Mezzano/compiler/transforms.lisp:483]
  (DEFINE-TRANSFORM
   #S(FORMGREP:SYMREF :NAME "GENERIC-TRUNCATE" :QUALIFIER "SYS.INT")
   ((NUMBER SINGLE-FLOAT) (DIVISOR (EQL 1)))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)) (:RESULT-TYPE FIXNUM))
   (ECLECTOR.READER:QUASIQUOTE
    (CALL
     #S(FORMGREP:SYMREF :NAME "%%TRUNCATE-SINGLE-FLOAT" :QUALIFIER "SYS.INT")
     (ECLECTOR.READER:UNQUOTE NUMBER))))

[Mezzano/compiler/transforms.lisp:488]
  (DEFINE-TRANSFORM
   #S(FORMGREP:SYMREF :NAME "%ONE-ARG-ROUND" :QUALIFIER "SYS.INT")
   ((NUMBER SINGLE-FLOAT))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)) (:RESULT-TYPE FIXNUM))
   (ECLECTOR.READER:QUASIQUOTE
    (CALL #S(FORMGREP:SYMREF :NAME "%%ROUND-SINGLE-FLOAT" :QUALIFIER "SYS.INT")
     (ECLECTOR.READER:UNQUOTE NUMBER))))

[Mezzano/compiler/transforms.lisp:493]
  (DEFINE-TRANSFORM ABS ((NUMBER SINGLE-FLOAT))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (THE SINGLE-FLOAT
         (CALL
          #S(FORMGREP:SYMREF :NAME "%%SINGLE-FLOAT-ABS" :QUALIFIER "SYS.INT")
          (ECLECTOR.READER:UNQUOTE NUMBER)))))

[Mezzano/compiler/transforms.lisp:498]
  (DEFINE-TRANSFORM #S(FORMGREP:SYMREF :NAME "BINARY-=" :QUALIFIER "SYS.INT")
   ((LHS SINGLE-FLOAT) (RHS SINGLE-FLOAT))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (CALL #S(FORMGREP:SYMREF :NAME "%%SINGLE-FLOAT-=" :QUALIFIER "SYS.INT")
     (ECLECTOR.READER:UNQUOTE LHS) (ECLECTOR.READER:UNQUOTE RHS))))

[Mezzano/compiler/transforms.lisp:502]
  (DEFINE-TRANSFORM #S(FORMGREP:SYMREF :NAME "BINARY-<" :QUALIFIER "SYS.INT")
   ((LHS SINGLE-FLOAT) (RHS SINGLE-FLOAT))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (CALL #S(FORMGREP:SYMREF :NAME "%%SINGLE-FLOAT-<" :QUALIFIER "SYS.INT")
     (ECLECTOR.READER:UNQUOTE LHS) (ECLECTOR.READER:UNQUOTE RHS))))

[Mezzano/compiler/transforms.lisp:506]
  (DEFINE-TRANSFORM #S(FORMGREP:SYMREF :NAME "BINARY->=" :QUALIFIER "SYS.INT")
   ((LHS SINGLE-FLOAT) (RHS SINGLE-FLOAT))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (CALL NOT
     (CALL #S(FORMGREP:SYMREF :NAME "%%SINGLE-FLOAT-<" :QUALIFIER "SYS.INT")
      (ECLECTOR.READER:UNQUOTE LHS) (ECLECTOR.READER:UNQUOTE RHS)))))

[Mezzano/compiler/transforms.lisp:510]
  (DEFINE-TRANSFORM #S(FORMGREP:SYMREF :NAME "BINARY->" :QUALIFIER "SYS.INT")
   ((LHS SINGLE-FLOAT) (RHS SINGLE-FLOAT))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (CALL #S(FORMGREP:SYMREF :NAME "%%SINGLE-FLOAT-<" :QUALIFIER "SYS.INT")
     (ECLECTOR.READER:UNQUOTE RHS) (ECLECTOR.READER:UNQUOTE LHS))))

[Mezzano/compiler/transforms.lisp:514]
  (DEFINE-TRANSFORM #S(FORMGREP:SYMREF :NAME "BINARY-<=" :QUALIFIER "SYS.INT")
   ((LHS SINGLE-FLOAT) (RHS SINGLE-FLOAT))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (CALL NOT
     (CALL #S(FORMGREP:SYMREF :NAME "%%SINGLE-FLOAT-<" :QUALIFIER "SYS.INT")
      (ECLECTOR.READER:UNQUOTE RHS) (ECLECTOR.READER:UNQUOTE LHS)))))

[Mezzano/compiler/transforms.lisp:518]
  (DEFINE-TRANSFORM #S(FORMGREP:SYMREF :NAME "GENERIC-=" :QUALIFIER "SYS.INT")
   ((LHS SINGLE-FLOAT) (RHS SINGLE-FLOAT))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (CALL #S(FORMGREP:SYMREF :NAME "%%SINGLE-FLOAT-=" :QUALIFIER "SYS.INT")
     (ECLECTOR.READER:UNQUOTE LHS) (ECLECTOR.READER:UNQUOTE RHS))))

[Mezzano/compiler/transforms.lisp:522]
  (DEFINE-TRANSFORM #S(FORMGREP:SYMREF :NAME "GENERIC-<" :QUALIFIER "SYS.INT")
   ((LHS SINGLE-FLOAT) (RHS SINGLE-FLOAT))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (CALL #S(FORMGREP:SYMREF :NAME "%%SINGLE-FLOAT-<" :QUALIFIER "SYS.INT")
     (ECLECTOR.READER:UNQUOTE LHS) (ECLECTOR.READER:UNQUOTE RHS))))

[Mezzano/compiler/transforms.lisp:526]
  (DEFINE-TRANSFORM #S(FORMGREP:SYMREF :NAME "GENERIC->=" :QUALIFIER "SYS.INT")
   ((LHS SINGLE-FLOAT) (RHS SINGLE-FLOAT))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (CALL NOT
     (CALL #S(FORMGREP:SYMREF :NAME "%%SINGLE-FLOAT-<" :QUALIFIER "SYS.INT")
      (ECLECTOR.READER:UNQUOTE LHS) (ECLECTOR.READER:UNQUOTE RHS)))))

[Mezzano/compiler/transforms.lisp:530]
  (DEFINE-TRANSFORM #S(FORMGREP:SYMREF :NAME "GENERIC->" :QUALIFIER "SYS.INT")
   ((LHS SINGLE-FLOAT) (RHS SINGLE-FLOAT))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (CALL #S(FORMGREP:SYMREF :NAME "%%SINGLE-FLOAT-<" :QUALIFIER "SYS.INT")
     (ECLECTOR.READER:UNQUOTE RHS) (ECLECTOR.READER:UNQUOTE LHS))))

[Mezzano/compiler/transforms.lisp:534]
  (DEFINE-TRANSFORM #S(FORMGREP:SYMREF :NAME "GENERIC-<=" :QUALIFIER "SYS.INT")
   ((LHS SINGLE-FLOAT) (RHS SINGLE-FLOAT))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (CALL NOT
     (CALL #S(FORMGREP:SYMREF :NAME "%%SINGLE-FLOAT-<" :QUALIFIER "SYS.INT")
      (ECLECTOR.READER:UNQUOTE RHS) (ECLECTOR.READER:UNQUOTE LHS)))))

[Mezzano/compiler/transforms.lisp:540]
  (DEFMACRO DEFINE-FAST-DOUBLE-FLOAT-TRANSFORM-ARITH-TWO-ARG
            (BINARY-FN GENERIC-FN FAST-FN)
    (ECLECTOR.READER:QUASIQUOTE
     (PROGN
      (DEFINE-TRANSFORM (ECLECTOR.READER:UNQUOTE BINARY-FN)
       ((LHS DOUBLE-FLOAT) (RHS DOUBLE-FLOAT))
       ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
       (ECLECTOR.READER:QUASIQUOTE
        (THE DOUBLE-FLOAT
             (CALL (ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE FAST-FN))
              (ECLECTOR.READER:UNQUOTE LHS) (ECLECTOR.READER:UNQUOTE RHS)))))
      (DEFINE-TRANSFORM (ECLECTOR.READER:UNQUOTE GENERIC-FN)
       ((LHS DOUBLE-FLOAT) (RHS DOUBLE-FLOAT))
       ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
       (ECLECTOR.READER:QUASIQUOTE
        (THE DOUBLE-FLOAT
             (CALL (ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE FAST-FN))
              (ECLECTOR.READER:UNQUOTE LHS) (ECLECTOR.READER:UNQUOTE RHS))))))))

[Mezzano/compiler/transforms.lisp:554]
  (DEFINE-TRANSFORM FLOAT ((NUMBER FIXNUM) (PROTOTYPE DOUBLE-FLOAT))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (THE DOUBLE-FLOAT
         (CALL
          #S(FORMGREP:SYMREF
             :NAME "%%COERCE-FIXNUM-TO-DOUBLE-FLOAT"
             :QUALIFIER "MEZZANO.RUNTIME")
          (ECLECTOR.READER:UNQUOTE NUMBER)))))

[Mezzano/compiler/transforms.lisp:559]
  (DEFINE-TRANSFORM FLOAT ((NUMBER SINGLE-FLOAT) (PROTOTYPE DOUBLE-FLOAT))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (THE SINGLE-FLOAT
         (CALL
          #S(FORMGREP:SYMREF
             :NAME "%%COERCE-SINGLE-FLOAT-TO-DOUBLE-FLOAT"
             :QUALIFIER "MEZZANO.RUNTIME")
          (ECLECTOR.READER:UNQUOTE NUMBER)))))

[Mezzano/compiler/transforms.lisp:564]
  (DEFINE-TRANSFORM FLOAT ((NUMBER DOUBLE-FLOAT) (PROTOTYPE DOUBLE-FLOAT))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3))) NUMBER)

[Mezzano/compiler/transforms.lisp:568]
  (DEFINE-TRANSFORM #S(FORMGREP:SYMREF :NAME "%TRUNCATE" :QUALIFIER "SYS.INT")
   ((NUMBER DOUBLE-FLOAT) (DIVISOR (EQL 1)))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)) (:RESULT-TYPE FIXNUM))
   (ECLECTOR.READER:QUASIQUOTE
    (CALL
     #S(FORMGREP:SYMREF :NAME "%%TRUNCATE-DOUBLE-FLOAT" :QUALIFIER "SYS.INT")
     (ECLECTOR.READER:UNQUOTE NUMBER))))

[Mezzano/compiler/transforms.lisp:573]
  (DEFINE-TRANSFORM
   #S(FORMGREP:SYMREF :NAME "GENERIC-TRUNCATE" :QUALIFIER "SYS.INT")
   ((NUMBER DOUBLE-FLOAT) (DIVISOR (EQL 1)))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)) (:RESULT-TYPE FIXNUM))
   (ECLECTOR.READER:QUASIQUOTE
    (CALL
     #S(FORMGREP:SYMREF :NAME "%%TRUNCATE-DOUBLE-FLOAT" :QUALIFIER "SYS.INT")
     (ECLECTOR.READER:UNQUOTE NUMBER))))

[Mezzano/compiler/transforms.lisp:578]
  (DEFINE-TRANSFORM
   #S(FORMGREP:SYMREF :NAME "%ONE-ARG-ROUND" :QUALIFIER "SYS.INT")
   ((NUMBER DOUBLE-FLOAT))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)) (:RESULT-TYPE FIXNUM))
   (ECLECTOR.READER:QUASIQUOTE
    (CALL #S(FORMGREP:SYMREF :NAME "%%ROUND-DOUBLE-FLOAT" :QUALIFIER "SYS.INT")
     (ECLECTOR.READER:UNQUOTE NUMBER))))

[Mezzano/compiler/transforms.lisp:583]
  (DEFINE-TRANSFORM ABS ((NUMBER DOUBLE-FLOAT))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (THE DOUBLE-FLOAT
         (CALL
          #S(FORMGREP:SYMREF :NAME "%%DOUBLE-FLOAT-ABS" :QUALIFIER "SYS.INT")
          (ECLECTOR.READER:UNQUOTE NUMBER)))))

[Mezzano/compiler/transforms.lisp:588]
  (DEFINE-TRANSFORM #S(FORMGREP:SYMREF :NAME "BINARY-=" :QUALIFIER "SYS.INT")
   ((LHS DOUBLE-FLOAT) (RHS DOUBLE-FLOAT))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (CALL #S(FORMGREP:SYMREF :NAME "%%DOUBLE-FLOAT-=" :QUALIFIER "SYS.INT")
     (ECLECTOR.READER:UNQUOTE LHS) (ECLECTOR.READER:UNQUOTE RHS))))

[Mezzano/compiler/transforms.lisp:592]
  (DEFINE-TRANSFORM #S(FORMGREP:SYMREF :NAME "BINARY-<" :QUALIFIER "SYS.INT")
   ((LHS DOUBLE-FLOAT) (RHS DOUBLE-FLOAT))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (CALL #S(FORMGREP:SYMREF :NAME "%%DOUBLE-FLOAT-<" :QUALIFIER "SYS.INT")
     (ECLECTOR.READER:UNQUOTE LHS) (ECLECTOR.READER:UNQUOTE RHS))))

[Mezzano/compiler/transforms.lisp:596]
  (DEFINE-TRANSFORM #S(FORMGREP:SYMREF :NAME "BINARY->=" :QUALIFIER "SYS.INT")
   ((LHS DOUBLE-FLOAT) (RHS DOUBLE-FLOAT))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (CALL NOT
     (CALL #S(FORMGREP:SYMREF :NAME "%%DOUBLE-FLOAT-<" :QUALIFIER "SYS.INT")
      (ECLECTOR.READER:UNQUOTE LHS) (ECLECTOR.READER:UNQUOTE RHS)))))

[Mezzano/compiler/transforms.lisp:600]
  (DEFINE-TRANSFORM #S(FORMGREP:SYMREF :NAME "BINARY->" :QUALIFIER "SYS.INT")
   ((LHS DOUBLE-FLOAT) (RHS DOUBLE-FLOAT))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (CALL #S(FORMGREP:SYMREF :NAME "%%DOUBLE-FLOAT-<" :QUALIFIER "SYS.INT")
     (ECLECTOR.READER:UNQUOTE RHS) (ECLECTOR.READER:UNQUOTE LHS))))

[Mezzano/compiler/transforms.lisp:604]
  (DEFINE-TRANSFORM #S(FORMGREP:SYMREF :NAME "BINARY-<=" :QUALIFIER "SYS.INT")
   ((LHS DOUBLE-FLOAT) (RHS DOUBLE-FLOAT))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (CALL NOT
     (CALL #S(FORMGREP:SYMREF :NAME "%%DOUBLE-FLOAT-<" :QUALIFIER "SYS.INT")
      (ECLECTOR.READER:UNQUOTE RHS) (ECLECTOR.READER:UNQUOTE LHS)))))

[Mezzano/compiler/transforms.lisp:637]
  (DEFMACRO DEFINE-FAST-ARRAY-TRANSFORM (TYPE ACCESSOR)
    (ECLECTOR.READER:QUASIQUOTE
     (PROGN
      (DEFINE-TRANSFORM ROW-MAJOR-AREF
       ((ARRAY
         (AND (SIMPLE-ARRAY (ECLECTOR.READER:UNQUOTE TYPE) *)
              (NOT (SIMPLE-ARRAY (ECLECTOR.READER:UNQUOTE TYPE) (*)))))
        (INDEX FIXNUM))
       ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
       (ECLECTOR.READER:QUASIQUOTE
        (LET ((STORAGE
               (CALL
                #S(FORMGREP:SYMREF :NAME "%OBJECT-REF-T" :QUALIFIER "SYS.INT")
                (ECLECTOR.READER:UNQUOTE ARRAY)
                '(ECLECTOR.READER:UNQUOTE
                  #S(FORMGREP:SYMREF
                     :NAME "+COMPLEX-ARRAY-STORAGE+"
                     :QUALIFIER "SYS.INT")))))
          (PROGN
           (CALL #S(FORMGREP:SYMREF :NAME "%BOUNDS-CHECK" :QUALIFIER "SYS.INT")
            STORAGE (ECLECTOR.READER:UNQUOTE INDEX))
           (THE (ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE TYPE))
                (CALL
                 (ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE ACCESSOR))
                 STORAGE (ECLECTOR.READER:UNQUOTE INDEX)))))))
      (DEFINE-TRANSFORM (SETF ROW-MAJOR-AREF)
       (VALUE
        (ARRAY
         (AND (SIMPLE-ARRAY (ECLECTOR.READER:UNQUOTE TYPE) *)
              (NOT (SIMPLE-ARRAY (ECLECTOR.READER:UNQUOTE TYPE) (*)))))
        (INDEX FIXNUM))
       ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
       (ECLECTOR.READER:QUASIQUOTE
        (LET ((STORAGE
               (CALL
                #S(FORMGREP:SYMREF :NAME "%OBJECT-REF-T" :QUALIFIER "SYS.INT")
                (ECLECTOR.READER:UNQUOTE ARRAY)
                '(ECLECTOR.READER:UNQUOTE
                  #S(FORMGREP:SYMREF
                     :NAME "+COMPLEX-ARRAY-STORAGE+"
                     :QUALIFIER "SYS.INT")))))
          (PROGN
           (CALL #S(FORMGREP:SYMREF :NAME "%BOUNDS-CHECK" :QUALIFIER "SYS.INT")
            STORAGE (ECLECTOR.READER:UNQUOTE INDEX))
           (THE (ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE TYPE))
                (CALL
                 (SETF (ECLECTOR.READER:UNQUOTE
                        '(ECLECTOR.READER:UNQUOTE ACCESSOR)))
                 (ECLECTOR.READER:UNQUOTE VALUE) STORAGE
                 (ECLECTOR.READER:UNQUOTE INDEX)))))))
      (DEFINE-TRANSFORM ROW-MAJOR-AREF
       ((ARRAY
         (AND (SIMPLE-ARRAY (ECLECTOR.READER:UNQUOTE TYPE) *)
              (NOT (SIMPLE-ARRAY (ECLECTOR.READER:UNQUOTE TYPE) (*)))))
        (INDEX FIXNUM))
       ((:OPTIMIZE (/= SAFETY 0) (= SPEED 3)))
       (ECLECTOR.READER:QUASIQUOTE
        (PROGN
         (IF (CALL
              #S(FORMGREP:SYMREF
                 :NAME "%OBJECT-OF-TYPE-P"
                 :QUALIFIER "SYS.INT")
              (ECLECTOR.READER:UNQUOTE ARRAY)
              '(ECLECTOR.READER:UNQUOTE
                #S(FORMGREP:SYMREF
                   :NAME "+OBJECT-TAG-SIMPLE-ARRAY+"
                   :QUALIFIER "SYS.INT")))
             'NIL
             (PROGN
              (CALL
               #S(FORMGREP:SYMREF
                  :NAME "RAISE-TYPE-ERROR"
                  :QUALIFIER "SYS.INT")
               (ECLECTOR.READER:UNQUOTE ARRAY)
               '(AND
                 (SIMPLE-ARRAY
                  (ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE TYPE)) *)
                 (NOT
                  (SIMPLE-ARRAY
                   (ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE TYPE))
                   (*)))))
              (CALL
               #S(FORMGREP:SYMREF
                  :NAME "%%UNREACHABLE"
                  :QUALIFIER "SYS.INT"))))
         (LET ((STORAGE
                (CALL
                 #S(FORMGREP:SYMREF :NAME "%OBJECT-REF-T" :QUALIFIER "SYS.INT")
                 (ECLECTOR.READER:UNQUOTE ARRAY)
                 '(ECLECTOR.READER:UNQUOTE
                   #S(FORMGREP:SYMREF
                      :NAME "+COMPLEX-ARRAY-STORAGE+"
                      :QUALIFIER "SYS.INT")))))
           (PROGN
            (IF (SOURCE-FRAGMENT
                 (TYPEP STORAGE
                        '(SIMPLE-ARRAY
                          (ECLECTOR.READER:UNQUOTE
                           '(ECLECTOR.READER:UNQUOTE TYPE))
                          (*))))
                'NIL
                (PROGN
                 (CALL
                  #S(FORMGREP:SYMREF
                     :NAME "RAISE-TYPE-ERROR"
                     :QUALIFIER "SYS.INT")
                  (ECLECTOR.READER:UNQUOTE ARRAY)
                  '(AND
                    (SIMPLE-ARRAY
                     (ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE TYPE))
                     *)
                    (NOT
                     (SIMPLE-ARRAY
                      (ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE TYPE))
                      (*)))))
                 (CALL
                  #S(FORMGREP:SYMREF
                     :NAME "%%UNREACHABLE"
                     :QUALIFIER "SYS.INT"))))
            (CALL
             #S(FORMGREP:SYMREF :NAME "%BOUNDS-CHECK" :QUALIFIER "SYS.INT")
             STORAGE (ECLECTOR.READER:UNQUOTE INDEX))
            (THE (ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE TYPE))
                 (CALL
                  (ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE ACCESSOR))
                  STORAGE (ECLECTOR.READER:UNQUOTE INDEX))))))))
      (DEFINE-TRANSFORM (SETF ROW-MAJOR-AREF)
       (VALUE
        (ARRAY
         (AND (SIMPLE-ARRAY (ECLECTOR.READER:UNQUOTE TYPE) *)
              (NOT (SIMPLE-ARRAY (ECLECTOR.READER:UNQUOTE TYPE) (*)))))
        (INDEX FIXNUM))
       ((:OPTIMIZE (/= SAFETY 0) (= SPEED 3)))
       (ECLECTOR.READER:QUASIQUOTE
        (PROGN
         (ECLECTOR.READER:UNQUOTE
          (INSERT-TYPE-CHECK VALUE '(ECLECTOR.READER:UNQUOTE TYPE)))
         (IF (CALL
              #S(FORMGREP:SYMREF
                 :NAME "%OBJECT-OF-TYPE-P"
                 :QUALIFIER "SYS.INT")
              (ECLECTOR.READER:UNQUOTE ARRAY)
              '(ECLECTOR.READER:UNQUOTE
                #S(FORMGREP:SYMREF
                   :NAME "+OBJECT-TAG-SIMPLE-ARRAY+"
                   :QUALIFIER "SYS.INT")))
             'NIL
             (PROGN
              (CALL
               #S(FORMGREP:SYMREF
                  :NAME "RAISE-TYPE-ERROR"
                  :QUALIFIER "SYS.INT")
               (ECLECTOR.READER:UNQUOTE ARRAY)
               '(AND
                 (SIMPLE-ARRAY
                  (ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE TYPE)) *)
                 (NOT
                  (SIMPLE-ARRAY
                   (ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE TYPE))
                   (*)))))
              (CALL
               #S(FORMGREP:SYMREF
                  :NAME "%%UNREACHABLE"
                  :QUALIFIER "SYS.INT"))))
         (LET ((STORAGE
                (CALL
                 #S(FORMGREP:SYMREF :NAME "%OBJECT-REF-T" :QUALIFIER "SYS.INT")
                 (ECLECTOR.READER:UNQUOTE ARRAY)
                 '(ECLECTOR.READER:UNQUOTE
                   #S(FORMGREP:SYMREF
                      :NAME "+COMPLEX-ARRAY-STORAGE+"
                      :QUALIFIER "SYS.INT")))))
           (PROGN
            (IF (SOURCE-FRAGMENT
                 (TYPEP STORAGE
                        '(SIMPLE-ARRAY
                          (ECLECTOR.READER:UNQUOTE
                           '(ECLECTOR.READER:UNQUOTE TYPE))
                          (*))))
                'NIL
                (PROGN
                 (CALL
                  #S(FORMGREP:SYMREF
                     :NAME "RAISE-TYPE-ERROR"
                     :QUALIFIER "SYS.INT")
                  (ECLECTOR.READER:UNQUOTE ARRAY)
                  '(AND
                    (SIMPLE-ARRAY
                     (ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE TYPE))
                     *)
                    (NOT
                     (SIMPLE-ARRAY
                      (ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE TYPE))
                      (*)))))
                 (CALL
                  #S(FORMGREP:SYMREF
                     :NAME "%%UNREACHABLE"
                     :QUALIFIER "SYS.INT"))))
            (CALL
             #S(FORMGREP:SYMREF :NAME "%BOUNDS-CHECK" :QUALIFIER "SYS.INT")
             STORAGE (ECLECTOR.READER:UNQUOTE INDEX))
            (THE (ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE TYPE))
                 (CALL
                  (SETF (ECLECTOR.READER:UNQUOTE
                         '(ECLECTOR.READER:UNQUOTE ACCESSOR)))
                  (ECLECTOR.READER:UNQUOTE VALUE) STORAGE
                  (ECLECTOR.READER:UNQUOTE INDEX))))))))
      (DEFINE-TRANSFORM ROW-MAJOR-AREF
       ((ARRAY (SIMPLE-ARRAY (ECLECTOR.READER:UNQUOTE TYPE) (*)) ARRAY-TYPE)
        (INDEX FIXNUM INDEX-TYPE))
       ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
       (ECLECTOR.READER:QUASIQUOTE
        (PROGN
         (ECLECTOR.READER:UNQUOTE
          (INSERT-BOUNDS-CHECK ARRAY ARRAY-TYPE INDEX INDEX-TYPE))
         (THE (ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE TYPE))
              (CALL
               (ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE ACCESSOR))
               (ECLECTOR.READER:UNQUOTE ARRAY)
               (ECLECTOR.READER:UNQUOTE INDEX))))))
      (DEFINE-TRANSFORM (SETF ROW-MAJOR-AREF)
       (VALUE
        (ARRAY (SIMPLE-ARRAY (ECLECTOR.READER:UNQUOTE TYPE) (*)) ARRAY-TYPE)
        (INDEX FIXNUM INDEX-TYPE))
       ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
       (ECLECTOR.READER:QUASIQUOTE
        (PROGN
         (ECLECTOR.READER:UNQUOTE
          (INSERT-BOUNDS-CHECK ARRAY ARRAY-TYPE INDEX INDEX-TYPE))
         (THE (ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE TYPE))
              (CALL
               (SETF (ECLECTOR.READER:UNQUOTE
                      '(ECLECTOR.READER:UNQUOTE ACCESSOR)))
               (ECLECTOR.READER:UNQUOTE VALUE) (ECLECTOR.READER:UNQUOTE ARRAY)
               (ECLECTOR.READER:UNQUOTE INDEX))))))
      (DEFINE-TRANSFORM ROW-MAJOR-AREF
       ((ARRAY (SIMPLE-ARRAY (ECLECTOR.READER:UNQUOTE TYPE) (*)) ARRAY-TYPE)
        (INDEX FIXNUM INDEX-TYPE))
       ((:OPTIMIZE (/= SAFETY 0) (= SPEED 3)))
       (ECLECTOR.READER:QUASIQUOTE
        (PROGN
         (ECLECTOR.READER:UNQUOTE
          (INSERT-TYPE-CHECK ARRAY
           (ECLECTOR.READER:QUASIQUOTE
            (SIMPLE-ARRAY
             (ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE TYPE)) (*)))))
         (ECLECTOR.READER:UNQUOTE
          (INSERT-BOUNDS-CHECK ARRAY ARRAY-TYPE INDEX INDEX-TYPE :FORCE T))
         (THE (ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE TYPE))
              (CALL
               (ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE ACCESSOR))
               (ECLECTOR.READER:UNQUOTE ARRAY)
               (ECLECTOR.READER:UNQUOTE INDEX))))))
      (DEFINE-TRANSFORM (SETF ROW-MAJOR-AREF)
       (VALUE
        (ARRAY (SIMPLE-ARRAY (ECLECTOR.READER:UNQUOTE TYPE) (*)) ARRAY-TYPE)
        (INDEX FIXNUM INDEX-TYPE))
       ((:OPTIMIZE (/= SAFETY 0) (= SPEED 3)))
       (ECLECTOR.READER:QUASIQUOTE
        (PROGN
         (ECLECTOR.READER:UNQUOTE
          (INSERT-TYPE-CHECK VALUE '(ECLECTOR.READER:UNQUOTE TYPE)))
         (ECLECTOR.READER:UNQUOTE
          (INSERT-TYPE-CHECK ARRAY
           (ECLECTOR.READER:QUASIQUOTE
            (SIMPLE-ARRAY
             (ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE TYPE)) (*)))))
         (ECLECTOR.READER:UNQUOTE
          (INSERT-BOUNDS-CHECK ARRAY ARRAY-TYPE INDEX INDEX-TYPE :FORCE T))
         (THE (ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE TYPE))
              (CALL
               (SETF (ECLECTOR.READER:UNQUOTE
                      '(ECLECTOR.READER:UNQUOTE ACCESSOR)))
               (ECLECTOR.READER:UNQUOTE VALUE) (ECLECTOR.READER:UNQUOTE ARRAY)
               (ECLECTOR.READER:UNQUOTE INDEX)))))))))

[Mezzano/compiler/transforms.lisp:776]
  (MACROLET ((DEF (N)
               (LET ((INDICES
                      (LOOP REPEAT N
                            COLLECT (GENSYM "INDEX"))))
                 (ECLECTOR.READER:QUASIQUOTE
                  (PROGN
                   (DEFINE-TRANSFORM ARRAY-ROW-MAJOR-INDEX
                    ((ARRAY
                      (ARRAY *
                       (ECLECTOR.READER:UNQUOTE
                        (MAKE-LIST N :INITIAL-ELEMENT '*))))
                     (ECLECTOR.READER:UNQUOTE-SPLICING
                      (LOOP FOR INDEX IN INDICES
                            COLLECT (LIST INDEX 'FIXNUM))))
                    ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
                    (ECLECTOR.READER:UNQUOTE
                     (IF (ZEROP N)
                         '''0
                         (LOOP WITH CURRENT = (FIRST INDICES)
                               FOR DIM FROM 1
                               FOR INDEX IN (REST INDICES)
                               DO (SETF CURRENT
                                          (ECLECTOR.READER:QUASIQUOTE
                                           (ECLECTOR.READER:QUASIQUOTE
                                            (THE FIXNUM
                                                 (CALL %FAST-FIXNUM-+
                                                  (THE FIXNUM
                                                       (CALL %FAST-FIXNUM-*
                                                        (ECLECTOR.READER:UNQUOTE
                                                         (ECLECTOR.READER:UNQUOTE
                                                          CURRENT))
                                                        (CALL ARRAY-DIMENSION
                                                         (ECLECTOR.READER:UNQUOTE
                                                          ARRAY)
                                                         '(ECLECTOR.READER:UNQUOTE
                                                           '(ECLECTOR.READER:UNQUOTE
                                                             DIM)))))
                                                  (ECLECTOR.READER:UNQUOTE
                                                   (ECLECTOR.READER:UNQUOTE
                                                    INDEX)))))))
                               FINALLY (RETURN CURRENT)))))
                   (DEFINE-TRANSFORM ARRAY-ROW-MAJOR-INDEX
                    ((ARRAY
                      (SIMPLE-ARRAY *
                       (ECLECTOR.READER:UNQUOTE
                        (MAKE-LIST N :INITIAL-ELEMENT '*)))
                      ARRAY-TYPE)
                     (ECLECTOR.READER:UNQUOTE-SPLICING
                      (LOOP FOR INDEX IN INDICES
                            COLLECT (LIST INDEX 'FIXNUM))))
                    ((:OPTIMIZE (/= SAFETY 0) (= SPEED 3)))
                    (ECLECTOR.READER:QUASIQUOTE
                     (PROGN
                      (ECLECTOR.READER:UNQUOTE
                       (INSERT-TYPE-CHECK ARRAY ARRAY-TYPE
                        (ECLECTOR.READER:QUASIQUOTE
                         (SIMPLE-ARRAY *
                          (ECLECTOR.READER:UNQUOTE
                           '(ECLECTOR.READER:UNQUOTE
                             (MAKE-LIST N :INITIAL-ELEMENT '*)))))))
                      (ECLECTOR.READER:UNQUOTE
                       (ECLECTOR.READER:UNQUOTE
                        (IF (ZEROP N)
                            '''NIL
                            (ECLECTOR.READER:QUASIQUOTE
                             (ECLECTOR.READER:QUASIQUOTE
                              (CALL
                               #S(FORMGREP:SYMREF
                                  :NAME "%COMPLEX-BOUNDS-CHECK"
                                  :QUALIFIER "SYS.INT")
                               (ECLECTOR.READER:UNQUOTE ARRAY)
                               (ECLECTOR.READER:UNQUOTE
                                (ECLECTOR.READER:UNQUOTE (FIRST INDICES)))
                               (CALL-OPTIMIZE ARRAY-DIMENSION
                                (SPEED 3 SAFETY 0)
                                (ECLECTOR.READER:UNQUOTE ARRAY) '0)
                               '0))))))
                      (ECLECTOR.READER:UNQUOTE
                       (ECLECTOR.READER:UNQUOTE
                        (IF (ZEROP N)
                            '''0
                            (LOOP WITH CURRENT = (FIRST INDICES)
                                  FOR DIM FROM 1
                                  FOR INDEX IN (REST INDICES)
                                  DO (SETF CURRENT
                                             (ECLECTOR.READER:QUASIQUOTE
                                              (ECLECTOR.READER:QUASIQUOTE
                                               (THE FIXNUM
                                                    (CALL %FAST-FIXNUM-+
                                                     (THE FIXNUM
                                                          (CALL %FAST-FIXNUM-*
                                                           (ECLECTOR.READER:UNQUOTE
                                                            (ECLECTOR.READER:UNQUOTE
                                                             CURRENT))
                                                           (LET ((DIM
                                                                  (CALL-OPTIMIZE
                                                                   ARRAY-DIMENSION
                                                                   (SPEED 3
                                                                    SAFETY 0)
                                                                   (ECLECTOR.READER:UNQUOTE
                                                                    ARRAY)
                                                                   '(ECLECTOR.READER:UNQUOTE
                                                                     '(ECLECTOR.READER:UNQUOTE
                                                                       DIM)))))
                                                             (PROGN
                                                              (CALL
                                                               #S(FORMGREP:SYMREF
                                                                  :NAME "%COMPLEX-BOUNDS-CHECK"
                                                                  :QUALIFIER "SYS.INT")
                                                               (ECLECTOR.READER:UNQUOTE
                                                                ARRAY)
                                                               (ECLECTOR.READER:UNQUOTE
                                                                (ECLECTOR.READER:UNQUOTE
                                                                 INDEX))
                                                               DIM
                                                               '(ECLECTOR.READER:UNQUOTE
                                                                 '(ECLECTOR.READER:UNQUOTE
                                                                   DIM)))
                                                              DIM))))
                                                     (ECLECTOR.READER:UNQUOTE
                                                      (ECLECTOR.READER:UNQUOTE
                                                       INDEX)))))))
                                  FINALLY (RETURN CURRENT))))))))
                   (DEFINE-TRANSFORM ARRAY-ROW-MAJOR-INDEX
                    ((ARRAY
                      (AND
                       (ARRAY *
                        (ECLECTOR.READER:UNQUOTE
                         (MAKE-LIST N :INITIAL-ELEMENT '*)))
                       (NOT SIMPLE-ARRAY))
                      ARRAY-TYPE)
                     (ECLECTOR.READER:UNQUOTE-SPLICING
                      (LOOP FOR INDEX IN INDICES
                            COLLECT (LIST INDEX 'FIXNUM))))
                    ((:OPTIMIZE (/= SAFETY 0) (= SPEED 3)))
                    (ECLECTOR.READER:QUASIQUOTE
                     (PROGN
                      (ECLECTOR.READER:UNQUOTE
                       (INSERT-TYPE-CHECK ARRAY ARRAY-TYPE
                        (ECLECTOR.READER:QUASIQUOTE
                         (ARRAY *
                          (ECLECTOR.READER:UNQUOTE
                           '(ECLECTOR.READER:UNQUOTE
                             (MAKE-LIST N :INITIAL-ELEMENT '*)))))))
                      (ECLECTOR.READER:UNQUOTE
                       (ECLECTOR.READER:UNQUOTE
                        (IF (ZEROP N)
                            '''NIL
                            (ECLECTOR.READER:QUASIQUOTE
                             (ECLECTOR.READER:QUASIQUOTE
                              (CALL
                               #S(FORMGREP:SYMREF
                                  :NAME "%COMPLEX-BOUNDS-CHECK"
                                  :QUALIFIER "SYS.INT")
                               (ECLECTOR.READER:UNQUOTE ARRAY)
                               (ECLECTOR.READER:UNQUOTE
                                (ECLECTOR.READER:UNQUOTE (FIRST INDICES)))
                               (CALL-OPTIMIZE ARRAY-DIMENSION
                                (SPEED 3 SAFETY 0)
                                (ECLECTOR.READER:UNQUOTE ARRAY) '0)
                               '0))))))
                      (ECLECTOR.READER:UNQUOTE
                       (ECLECTOR.READER:UNQUOTE
                        (IF (ZEROP N)
                            '''0
                            (LOOP WITH CURRENT = (FIRST INDICES)
                                  FOR DIM FROM 1
                                  FOR INDEX IN (REST INDICES)
                                  DO (SETF CURRENT
                                             (ECLECTOR.READER:QUASIQUOTE
                                              (ECLECTOR.READER:QUASIQUOTE
                                               (THE FIXNUM
                                                    (CALL %FAST-FIXNUM-+
                                                     (THE FIXNUM
                                                          (CALL %FAST-FIXNUM-*
                                                           (ECLECTOR.READER:UNQUOTE
                                                            (ECLECTOR.READER:UNQUOTE
                                                             CURRENT))
                                                           (LET ((DIM
                                                                  (CALL-OPTIMIZE
                                                                   ARRAY-DIMENSION
                                                                   (SPEED 3
                                                                    SAFETY 0)
                                                                   (ECLECTOR.READER:UNQUOTE
                                                                    ARRAY)
                                                                   '(ECLECTOR.READER:UNQUOTE
                                                                     '(ECLECTOR.READER:UNQUOTE
                                                                       DIM)))))
                                                             (PROGN
                                                              (CALL
                                                               #S(FORMGREP:SYMREF
                                                                  :NAME "%COMPLEX-BOUNDS-CHECK"
                                                                  :QUALIFIER "SYS.INT")
                                                               (ECLECTOR.READER:UNQUOTE
                                                                ARRAY)
                                                               (ECLECTOR.READER:UNQUOTE
                                                                (ECLECTOR.READER:UNQUOTE
                                                                 INDEX))
                                                               DIM
                                                               '(ECLECTOR.READER:UNQUOTE
                                                                 '(ECLECTOR.READER:UNQUOTE
                                                                   DIM)))
                                                              DIM))))
                                                     (ECLECTOR.READER:UNQUOTE
                                                      (ECLECTOR.READER:UNQUOTE
                                                       INDEX)))))))
                                  FINALLY (RETURN CURRENT)))))))))))))
    (DEF 0)
    (DEF 1)
    (DEF 2)
    (DEF 3)
    (DEF 4))

[Mezzano/compiler/transforms.lisp:878]
  (MACROLET ((DEF (N)
               (ECLECTOR.READER:QUASIQUOTE
                (PROGN
                 (DEFINE-TRANSFORM ARRAY-TOTAL-SIZE
                  ((ARRAY
                    (ARRAY *
                     (ECLECTOR.READER:UNQUOTE
                      (MAKE-LIST N :INITIAL-ELEMENT '*)))))
                  ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
                  (ECLECTOR.READER:UNQUOTE
                   (IF (ZEROP N)
                       '''1
                       (LOOP WITH CURRENT = (ECLECTOR.READER:QUASIQUOTE
                                             (ECLECTOR.READER:QUASIQUOTE
                                              (CALL ARRAY-DIMENSION
                                               (ECLECTOR.READER:UNQUOTE ARRAY)
                                               '0)))
                             FOR DIM FROM 1 BELOW N
                             DO (SETF CURRENT
                                        (ECLECTOR.READER:QUASIQUOTE
                                         (ECLECTOR.READER:QUASIQUOTE
                                          (THE FIXNUM
                                               (CALL %FAST-FIXNUM-*
                                                (ECLECTOR.READER:UNQUOTE
                                                 (ECLECTOR.READER:UNQUOTE
                                                  CURRENT))
                                                (CALL ARRAY-DIMENSION
                                                 (ECLECTOR.READER:UNQUOTE
                                                  ARRAY)
                                                 '(ECLECTOR.READER:UNQUOTE
                                                   '(ECLECTOR.READER:UNQUOTE
                                                     DIM))))))))
                             FINALLY (RETURN CURRENT)))))
                 (DEFINE-TRANSFORM ARRAY-TOTAL-SIZE
                  ((ARRAY
                    (SIMPLE-ARRAY *
                     (ECLECTOR.READER:UNQUOTE
                      (MAKE-LIST N :INITIAL-ELEMENT '*)))
                    ARRAY-TYPE))
                  ((:OPTIMIZE (/= SAFETY 0) (= SPEED 3)))
                  (ECLECTOR.READER:QUASIQUOTE
                   (PROGN
                    (ECLECTOR.READER:UNQUOTE
                     (INSERT-TYPE-CHECK ARRAY ARRAY-TYPE
                      (ECLECTOR.READER:QUASIQUOTE
                       (SIMPLE-ARRAY *
                        (ECLECTOR.READER:UNQUOTE
                         '(ECLECTOR.READER:UNQUOTE
                           (MAKE-LIST N :INITIAL-ELEMENT '*)))))))
                    (ECLECTOR.READER:UNQUOTE
                     (ECLECTOR.READER:UNQUOTE
                      (IF (ZEROP N)
                          '''1
                          (LOOP WITH CURRENT = (ECLECTOR.READER:QUASIQUOTE
                                                (ECLECTOR.READER:QUASIQUOTE
                                                 (CALL-OPTIMIZE ARRAY-DIMENSION
                                                  (SPEED 3 SAFETY 0)
                                                  (ECLECTOR.READER:UNQUOTE
                                                   ARRAY)
                                                  '0)))
                                FOR DIM FROM 1 BELOW N
                                DO (SETF CURRENT
                                           (ECLECTOR.READER:QUASIQUOTE
                                            (ECLECTOR.READER:QUASIQUOTE
                                             (THE FIXNUM
                                                  (CALL %FAST-FIXNUM-*
                                                   (ECLECTOR.READER:UNQUOTE
                                                    (ECLECTOR.READER:UNQUOTE
                                                     CURRENT))
                                                   (CALL-OPTIMIZE
                                                    ARRAY-DIMENSION
                                                    (SPEED 3 SAFETY 0)
                                                    (ECLECTOR.READER:UNQUOTE
                                                     ARRAY)
                                                    '(ECLECTOR.READER:UNQUOTE
                                                      '(ECLECTOR.READER:UNQUOTE
                                                        DIM))))))))
                                FINALLY (RETURN CURRENT))))))))
                 (DEFINE-TRANSFORM ARRAY-TOTAL-SIZE
                  ((ARRAY
                    (AND
                     (ARRAY *
                      (ECLECTOR.READER:UNQUOTE
                       (MAKE-LIST N :INITIAL-ELEMENT '*)))
                     (NOT SIMPLE-ARRAY))
                    ARRAY-TYPE))
                  ((:OPTIMIZE (/= SAFETY 0) (= SPEED 3)))
                  (ECLECTOR.READER:QUASIQUOTE
                   (PROGN
                    (ECLECTOR.READER:UNQUOTE
                     (INSERT-TYPE-CHECK ARRAY ARRAY-TYPE
                      (ECLECTOR.READER:QUASIQUOTE
                       (ARRAY *
                        (ECLECTOR.READER:UNQUOTE
                         '(ECLECTOR.READER:UNQUOTE
                           (MAKE-LIST N :INITIAL-ELEMENT '*)))))))
                    (ECLECTOR.READER:UNQUOTE
                     (ECLECTOR.READER:UNQUOTE
                      (IF (ZEROP N)
                          '''1
                          (LOOP WITH CURRENT = (ECLECTOR.READER:QUASIQUOTE
                                                (ECLECTOR.READER:QUASIQUOTE
                                                 (CALL-OPTIMIZE ARRAY-DIMENSION
                                                  (SPEED 3 SAFETY 0)
                                                  (ECLECTOR.READER:UNQUOTE
                                                   ARRAY)
                                                  '0)))
                                FOR DIM FROM 1 BELOW N
                                DO (SETF CURRENT
                                           (ECLECTOR.READER:QUASIQUOTE
                                            (ECLECTOR.READER:QUASIQUOTE
                                             (THE FIXNUM
                                                  (CALL %FAST-FIXNUM-*
                                                   (ECLECTOR.READER:UNQUOTE
                                                    (ECLECTOR.READER:UNQUOTE
                                                     CURRENT))
                                                   (CALL-OPTIMIZE
                                                    ARRAY-DIMENSION
                                                    (SPEED 3 SAFETY 0)
                                                    (ECLECTOR.READER:UNQUOTE
                                                     ARRAY)
                                                    '(ECLECTOR.READER:UNQUOTE
                                                      '(ECLECTOR.READER:UNQUOTE
                                                        DIM))))))))
                                FINALLY (RETURN CURRENT))))))))))))
    (DEF 0)
    (DEF 1)
    (DEF 2)
    (DEF 3)
    (DEF 4))

[Mezzano/compiler/transforms.lisp:937]
  (DEFINE-TRANSFORM LENGTH
   ((SEQUENCE (AND (SIMPLE-ARRAY * (*)) (NOT (SIMPLE-ARRAY CHARACTER (*))))))
   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE
    (THE (INTEGER 0 (ECLECTOR.READER:UNQUOTE ARRAY-DIMENSION-LIMIT))
         (CALL
          #S(FORMGREP:SYMREF :NAME "%OBJECT-HEADER-DATA" :QUALIFIER "SYS.INT")
          (ECLECTOR.READER:UNQUOTE SEQUENCE)))))

[Mezzano/compiler/transforms.lisp:944]
  (DEFMACRO DEFINE-TYPE-PREDICATE-TRANSFORM (PREDICATE TYPE)
    (ECLECTOR.READER:QUASIQUOTE
     (PROGN
      (DEFINE-TRANSFORM (ECLECTOR.READER:UNQUOTE PREDICATE)
       ((OBJECT (ECLECTOR.READER:UNQUOTE TYPE)))
       ((:OPTIMIZE (= SAFETY 0) (= SPEED 3))) (ECLECTOR.READER:QUASIQUOTE 'T))
      (DEFINE-TRANSFORM (ECLECTOR.READER:UNQUOTE PREDICATE)
       ((OBJECT (NOT (ECLECTOR.READER:UNQUOTE TYPE))))
       ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
       (ECLECTOR.READER:QUASIQUOTE 'NIL)))))

[Mezzano/compiler/transforms.lisp:956]
  (DEFINE-TRANSFORM
   #S(FORMGREP:SYMREF :NAME "UNSIGNED-BYTE-64-P" :QUALIFIER "SYS.INT")
   ((OBJECT (UNSIGNED-BYTE 64))) ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE 'T))

[Mezzano/compiler/transforms.lisp:960]
  (DEFINE-TRANSFORM #S(FORMGREP:SYMREF :NAME "FIXNUMP" :QUALIFIER "SYS.INT")
   ((OBJECT FIXNUM)) ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE 'T))

[Mezzano/compiler/transforms.lisp:963]
  (DEFINE-TRANSFORM #S(FORMGREP:SYMREF :NAME "FIXNUMP" :QUALIFIER "SYS.INT")
   ((OBJECT (NOT INTEGER))) ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
   (ECLECTOR.READER:QUASIQUOTE 'NIL))

[Mezzano/compiler/transforms.lisp:967]
  (DEFINE-TRANSFORM
   #S(FORMGREP:SYMREF :NAME "%COERCE-TO-CALLABLE" :QUALIFIER "SYS.INT")
   ((OBJECT FUNCTION)) ((:OPTIMIZE (= SAFETY 0) (= SPEED 3))) OBJECT)

[Mezzano/compiler/type-check.lisp:177]
  (DEFMETHOD INSERT-TYPE-CHECKS-1 ((FORM AST-THE) VALUE-CONTEXT)
    (MULTIPLE-VALUE-BIND (REQUIRED-TYPESPECS OPTIONAL-TYPESPECS REST-TYPESPEC)
        (PARSE-VALUES-TYPE (AST-THE-TYPE FORM))
      (SETF (VALUE FORM)
              (COND
               ((OR (NOT (EQL (OPTIMIZE-QUALITY FORM 'SAFETY) 3))
                    (AND (ENDP REQUIRED-TYPESPECS)
                         (EVERY (LAMBDA (X) (EQL X 'T)) OPTIONAL-TYPESPECS)
                         (EQL REST-TYPESPEC 'T)))
                (INSERT-TYPE-CHECKS-1 (VALUE FORM) VALUE-CONTEXT))
               ((AND (ENDP REQUIRED-TYPESPECS)
                     (EQL (LENGTH OPTIONAL-TYPESPECS) 1) (EQL REST-TYPESPEC 'T)
                     (OR (MEMBER VALUE-CONTEXT '(:EFFECT :SINGLE))
                         (TYPEP (UNWRAP-THE (VALUE FORM)) 'LEXICAL-VARIABLE)))
                (AST
                 (ECLECTOR.READER:QUASIQUOTE
                  (LET ((VAL
                         (ECLECTOR.READER:UNQUOTE
                          (INSERT-TYPE-CHECKS-1 (VALUE FORM) :SINGLE))))
                    (PROGN
                     (IF (SOURCE-FRAGMENT
                          (TYPEP VAL
                                 '(ECLECTOR.READER:UNQUOTE
                                   (SIMPLIFY-COMPLICATED-FUNCTION-TYPE
                                    (FIRST OPTIONAL-TYPESPECS)))))
                         'NIL
                         (PROGN
                          (CALL
                           #S(FORMGREP:SYMREF
                              :NAME "RAISE-TYPE-ERROR"
                              :QUALIFIER "SYS.INT")
                           VAL '(ECLECTOR.READER:UNQUOTE (AST-THE-TYPE FORM)))
                          (CALL
                           #S(FORMGREP:SYMREF
                              :NAME "%%UNREACHABLE"
                              :QUALIFIER "SYS.INT"))))
                     VAL)))
                 FORM))
               (T
                (LET ((REQ-VALUES
                       (LOOP FOR TY IN REQUIRED-TYPESPECS
                             COLLECT (GENSYM)))
                      (OPT-VALUES
                       (LOOP FOR TY IN OPTIONAL-TYPESPECS
                             COLLECT (GENSYM)))
                      (REST-VALUE (GENSYM)))
                  (INSERT-TYPE-CHECKS-1
                   (AST
                    (ECLECTOR.READER:QUASIQUOTE
                     (MULTIPLE-VALUE-CALL
                         (SOURCE-FRAGMENT
                          (LAMBDA
                              ((ECLECTOR.READER:UNQUOTE-SPLICING REQ-VALUES)
                               &OPTIONAL
                               (ECLECTOR.READER:UNQUOTE-SPLICING OPT-VALUES)
                               &REST (ECLECTOR.READER:UNQUOTE REST-VALUE)
                               #S(FORMGREP:SYMREF
                                  :NAME "&COUNT"
                                  :QUALIFIER "SYS.INT")
                               N-VALUES)
                            (DECLARE
                             (DYNAMIC-EXTENT
                              (ECLECTOR.READER:UNQUOTE REST-VALUE))
                             (#S(FORMGREP:SYMREF
                                 :NAME "LAMBDA-NAME"
                                 :QUALIFIER "SYS.INT")
                              (THE
                               (ECLECTOR.READER:UNQUOTE (AST-THE-TYPE FORM)))))
                            (ECLECTOR.READER:UNQUOTE-SPLICING
                             (LOOP FOR TY IN REQUIRED-TYPESPECS
                                   FOR VAR IN REQ-VALUES
                                   COLLECT (ECLECTOR.READER:QUASIQUOTE
                                            (THE (ECLECTOR.READER:UNQUOTE TY)
                                                 (ECLECTOR.READER:UNQUOTE
                                                  VAR)))))
                            (ECLECTOR.READER:UNQUOTE-SPLICING
                             (LOOP FOR TY IN OPTIONAL-TYPESPECS
                                   FOR VAR IN OPT-VALUES
                                   COLLECT (ECLECTOR.READER:QUASIQUOTE
                                            (THE (ECLECTOR.READER:UNQUOTE TY)
                                                 (ECLECTOR.READER:UNQUOTE
                                                  VAR)))))
                            (THE (ECLECTOR.READER:UNQUOTE REST-TYPESPEC)
                                 (ECLECTOR.READER:UNQUOTE REST-VALUE))
                            (LET* ((OPT-LIST
                                    (LIST*
                                     (ECLECTOR.READER:UNQUOTE-SPLICING
                                      OPT-VALUES)
                                     (ECLECTOR.READER:UNQUOTE REST-VALUE)))
                                   (REQ-LIST
                                    (LIST*
                                     (ECLECTOR.READER:UNQUOTE-SPLICING
                                      REQ-VALUES)
                                     OPT-LIST)))
                              (DECLARE (DYNAMIC-EXTENT OPT-LIST REQ-LIST))
                              (ECLECTOR.READER:UNQUOTE-SPLICING
                               (WHEN OPT-VALUES
                                 (ECLECTOR.READER:QUASIQUOTE
                                  ((WHEN
                                       (< N-VALUES
                                          (ECLECTOR.READER:UNQUOTE
                                           (+ (LENGTH REQ-VALUES)
                                              (LENGTH OPT-VALUES))))
                                     (LET* ((SCRATCH (CONS NIL REQ-LIST))
                                            (LAST (NTHCDR N-VALUES SCRATCH)))
                                       (DECLARE (DYNAMIC-EXTENT SCRATCH))
                                       (SETF (CDR LAST) NIL
                                             REQ-LIST (CDR SCRATCH))))))))
                              (VALUES-LIST REQ-LIST))))
                       (ECLECTOR.READER:UNQUOTE (VALUE FORM))))
                    FORM)
                   VALUE-CONTEXT))))))
    FORM)

[Mezzano/drivers/intel-hda.lisp:1046]
  (DEFMETHOD #S(FORMGREP:SYMREF
                :NAME "SOUND-CARD-RUN"
                :QUALIFIER "MEZZANO.DRIVER.SOUND")
             ((HDA HDA) BUFFER-FILL-CALLBACK)
    (HANDLER-CASE
     (LET* ((BUFFER (HDA-DMA-BUFFER-PHYS HDA))
            (BUF-LEN 8192)
            (HALF-BUF-LEN (TRUNCATE BUF-LEN 2))
            (N-SAMPLES (TRUNCATE HALF-BUF-LEN 2))
            (FLOAT-SAMPLE-BUFFER
             (MAKE-ARRAY N-SAMPLES :ELEMENT-TYPE 'SINGLE-FLOAT))
            (OUTPUT-PIN (DEFAULT-OUTPUT-PIN HDA))
            (OUTPUT-STREAM (FIRST-OUTPUT-STREAM HDA))
            (BUFFER-OFFSET 0)
            (STOP-COUNTDOWN NIL))
       (LABELS ((STORE-SAMPLE (SAMPLE OFFSET)
                  (LET* ((SAMPLE-CLAMPED (MAX (MIN SAMPLE 1.0) -1.0))
                         (SAMPLE-RESCALED
                          (IF (< SAMPLE-CLAMPED 0.0)
                              (* SAMPLE-CLAMPED 32768.0)
                              (* SAMPLE-CLAMPED 32767.0)))
                         (SAMPLE-16BIT (TRUNCATE SAMPLE-RESCALED)))
                    (DECLARE (OPTIMIZE SPEED (SAFETY 0))
                             (TYPE SINGLE-FLOAT SAMPLE-CLAMPED SAMPLE-RESCALED)
                             (TYPE FIXNUM SAMPLE-16BIT))
                    (SETF (#S(FORMGREP:SYMREF
                              :NAME "PHYSICAL-MEMREF-UNSIGNED-BYTE-8"
                              :QUALIFIER "MEZZANO.SUPERVISOR")
                           BUFFER (+ BUFFER-OFFSET OFFSET OFFSET))
                            (LDB (BYTE 8 0) SAMPLE-16BIT)
                          (#S(FORMGREP:SYMREF
                              :NAME "PHYSICAL-MEMREF-UNSIGNED-BYTE-8"
                              :QUALIFIER "MEZZANO.SUPERVISOR")
                           BUFFER (+ BUFFER-OFFSET OFFSET OFFSET 1))
                            (LDB (BYTE 8 8) SAMPLE-16BIT))))
                (REFILL-FIFO ()
                  (WITH-HDA-ACCESS (HDA)
                   (LOCALLY
                    (DECLARE (OPTIMIZE SPEED (SAFETY 0))
                             (TYPE (SIMPLE-ARRAY SINGLE-FLOAT (*))
                              FLOAT-SAMPLE-BUFFER)
                             (TYPE FIXNUM N-SAMPLES))
                    (DOTIMES (I N-SAMPLES)
                      (STORE-SAMPLE (AREF FLOAT-SAMPLE-BUFFER I) I))))
                  (COND
                   ((EQL BUFFER-OFFSET 0) (SETF BUFFER-OFFSET HALF-BUF-LEN))
                   (T (SETF BUFFER-OFFSET 0)))
                  (COND
                   ((FUNCALL BUFFER-FILL-CALLBACK FLOAT-SAMPLE-BUFFER 0
                             N-SAMPLES)
                    (SETF STOP-COUNTDOWN NIL))
                   ((NOT STOP-COUNTDOWN) (SETF STOP-COUNTDOWN 4)))))
         (FUNCALL BUFFER-FILL-CALLBACK FLOAT-SAMPLE-BUFFER 0 N-SAMPLES)
         (WITH-HDA-ACCESS (HDA)
          (DOTIMES (I BUF-LEN)
            (SETF (#S(FORMGREP:SYMREF
                      :NAME "PHYSICAL-MEMREF-UNSIGNED-BYTE-8"
                      :QUALIFIER "MEZZANO.SUPERVISOR")
                   BUFFER I)
                    0))
          (CLEAR-PENDING-INTERRUPT HDA OUTPUT-STREAM)
          (#S(FORMGREP:SYMREF
              :NAME "SIMPLE-IRQ-UNMASK"
              :QUALIFIER "MEZZANO.SUPERVISOR")
           (HDA-IRQ HDA)))
         (MULTIPLE-VALUE-BIND (CONVERTER MIXER)
             (OUTPUT-PATH OUTPUT-PIN)
           (START-PLAYBACK HDA BUFFER BUF-LEN (CAD OUTPUT-PIN) (NID CONVERTER)
            (NID OUTPUT-PIN) (AND MIXER (NID MIXER))))
         (UNWIND-PROTECT
             (LOOP
              (LET* ((DMAP (DMA-POSITION HDA OUTPUT-STREAM))
                     (CURRENT-OFFSET (TRUNCATE DMAP HALF-BUF-LEN)))
                (WHEN
                    (NOT
                     (EQL CURRENT-OFFSET
                          (TRUNCATE BUFFER-OFFSET HALF-BUF-LEN)))
                  (WHEN STOP-COUNTDOWN
                    (WHEN (ZEROP STOP-COUNTDOWN) (RETURN))
                    (DECF STOP-COUNTDOWN))
                  (REFILL-FIFO)))
              (WAIT-FOR-BUFFER-INTERRUPT HDA))
           (WITH-HDA-ACCESS (HDA) (STREAM-RESET HDA (FIRST-OUTPUT-STREAM HDA))
            (#S(FORMGREP:SYMREF
                :NAME "SIMPLE-IRQ-MASK"
                :QUALIFIER "MEZZANO.SUPERVISOR")
             (HDA-IRQ HDA))))))
     (DEVICE-DISCONNECT NIL (FORMAT T "HDA ~S disconnected.~%" HDA)
      (THROW
          '#S(FORMGREP:SYMREF
              :NAME "TERMINATE-THREAD"
              :QUALIFIER "MEZZANO.SUPERVISOR")
        NIL))))

[Mezzano/drivers/sound.lisp:58]
  (DEFUN MIX (DEST SOURCE VOLUME &KEY (START1 0) END1 (START2 0) END2)
    (UNLESS END1 (SETF END1 (LENGTH DEST)))
    (UNLESS END2 (SETF END2 (LENGTH SOURCE)))
    (WHEN (EQL DEST SOURCE)
      (SETF SOURCE (SUBSEQ SOURCE START2 END2)
            END2 (- END2 START2)
            START2 0))
    (ASSERT (<= 0 START1 END1 (LENGTH DEST)))
    (ASSERT (<= 0 START2 END2 (LENGTH SOURCE)))
    (CHECK-TYPE DEST (SIMPLE-ARRAY SINGLE-FLOAT (*)))
    (CHECK-TYPE SOURCE (SIMPLE-ARRAY SINGLE-FLOAT (*)))
    (CHECK-TYPE VOLUME SINGLE-FLOAT)
    (LOCALLY
     (DECLARE (OPTIMIZE SPEED (SAFETY 0))
              (TYPE (SIMPLE-ARRAY SINGLE-FLOAT (*)) DEST SOURCE)
              (TYPE FIXNUM START1 END1 START2 END2)
              (TYPE SINGLE-FLOAT VOLUME))
     (LOOP FOR I FIXNUM FROM START1 BELOW END1
           FOR J FIXNUM FROM START2 BELOW END2
           DO (INCF (AREF DEST I) (* (AREF SOURCE J) VOLUME))))
    DEST)

[Mezzano/drivers/sound.lisp:125]
  (DEFUN REFILL-SOUND-OUTPUT-BUFFER (BUFFER START END)
    (CHECK-TYPE BUFFER (SIMPLE-ARRAY SINGLE-FLOAT (*)))
    (ASSERT (<= 0 START END (LENGTH BUFFER)))
    (LOCALLY
     (DECLARE (OPTIMIZE SPEED (SAFETY 0))
              (TYPE (SIMPLE-ARRAY SINGLE-FLOAT (*)) BUFFER)
              (TYPE FIXNUM START END))
     (FILL BUFFER 0.0 :START START :END END))
    (PROG1
        (#S(FORMGREP:SYMREF :NAME "WITH-MUTEX" :QUALIFIER "MEZZANO.SUPERVISOR")
         (*SINK-LOCK*)
         (COND ((ENDP *SINKS*) NIL)
               (T
                (DOLIST (SINK *SINKS*) (MIX-OUT-OF-SINK SINK BUFFER START END))
                (SETF *SINKS*
                        (DELETE-IF (LAMBDA (SINK) (BUFFER-EMPTY SINK))
                                   *SINKS*))
                (WHEN (ENDP *SINKS*)
                  (SETF (#S(FORMGREP:SYMREF
                            :NAME "EVENT-STATE"
                            :QUALIFIER "SUP")
                         *SINKS-PRESENT-EVENT*)
                          NIL))
                (#S(FORMGREP:SYMREF
                    :NAME "CONDITION-NOTIFY"
                    :QUALIFIER "MEZZANO.SUPERVISOR")
                 *SINK-CVAR* T)
                T)))))

[Mezzano/gui/blit-generic.lisp:7]
  (DEFUN %BITBLT-LINE (BLENDER TO TO-OFFSET NCOLS FROM FROM-OFFSET)
    (DECLARE
     (TYPE
      (SIMPLE-ARRAY #S(FORMGREP:SYMREF :NAME "COLOUR" :QUALIFIER "MEZZANO.GUI")
       (*))
      TO FROM)
     (TYPE FIXNUM NCOLS TO-OFFSET FROM-OFFSET)
     (TYPE FUNCTION BLENDER)
     (OPTIMIZE SPEED (SAFETY 0)))
    (LOOP FOR I FIXNUM BELOW NCOLS
          FOR TO-OFS FIXNUM FROM TO-OFFSET
          FOR FROM-OFS FIXNUM FROM FROM-OFFSET
          DO (FUNCALL BLENDER (AREF FROM FROM-OFS) TO TO-OFS)))

[Mezzano/gui/blit-generic.lisp:18]
  (DEFUN %BITSET-LINE (BLENDER TO TO-OFFSET NCOLS COLOUR)
    (DECLARE
     (TYPE
      (SIMPLE-ARRAY #S(FORMGREP:SYMREF :NAME "COLOUR" :QUALIFIER "MEZZANO.GUI")
       (*))
      TO)
     (TYPE #S(FORMGREP:SYMREF :NAME "COLOUR" :QUALIFIER "MEZZANO.GUI") COLOUR)
     (TYPE FIXNUM NCOLS TO-OFFSET)
     (TYPE FUNCTION BLENDER)
     (OPTIMIZE SPEED (SAFETY 0)))
    (LOOP FOR I FIXNUM BELOW NCOLS
          FOR TO-OFS FIXNUM FROM TO-OFFSET
          DO (FUNCALL BLENDER COLOUR TO TO-OFS)))

[Mezzano/gui/blit-generic.lisp:29]
  (DEFUN %BITSET-MASK-1-LINE
         (BLENDER TO TO-OFFSET NCOLS MASK MASK-OFFSET COLOUR)
    (DECLARE
     (TYPE
      (SIMPLE-ARRAY #S(FORMGREP:SYMREF :NAME "COLOUR" :QUALIFIER "MEZZANO.GUI")
       (*))
      TO)
     (TYPE (SIMPLE-ARRAY BIT (*)) MASK)
     (TYPE #S(FORMGREP:SYMREF :NAME "COLOUR" :QUALIFIER "MEZZANO.GUI") COLOUR)
     (TYPE FIXNUM NCOLS TO-OFFSET MASK-OFFSET)
     (TYPE FUNCTION BLENDER)
     (OPTIMIZE SPEED (SAFETY 0)))
    (LOOP FOR I FIXNUM BELOW NCOLS
          FOR TO-OFS FIXNUM FROM TO-OFFSET
          FOR MASK-OFS FIXNUM FROM MASK-OFFSET
          DO (LET ((BIT (AREF MASK MASK-OFS)))
               (WHEN (EQL BIT 1) (FUNCALL BLENDER COLOUR TO TO-OFS)))))

[Mezzano/gui/blit-generic.lisp:45]
  (DEFUN COMPONENT-* (COLOUR ALPHA-OCTET)
    (DECLARE
     (TYPE #S(FORMGREP:SYMREF :NAME "COLOUR" :QUALIFIER "MEZZANO.GUI") COLOUR)
     (TYPE (UNSIGNED-BYTE 8) ALPHA-OCTET)
     (OPTIMIZE SPEED (SAFETY 0)))
    (COND ((EQL ALPHA-OCTET 0) 0) ((EQL ALPHA-OCTET 255) COLOUR)
          (T
           (LET ((ALPHA (/ ALPHA-OCTET 255.0)))
             (MAKE-COLOUR (* (COLOUR-RED COLOUR) ALPHA)
              (* (COLOUR-GREEN COLOUR) ALPHA) (* (COLOUR-BLUE COLOUR) ALPHA)
              (* (COLOUR-ALPHA COLOUR) ALPHA) T)))))

[Mezzano/gui/blit-generic.lisp:69]
  (DEFUN %BITSET-MASK-8-LINE
         (BLENDER TO TO-OFFSET NCOLS MASK MASK-OFFSET COLOUR)
    (DECLARE
     (TYPE
      (SIMPLE-ARRAY #S(FORMGREP:SYMREF :NAME "COLOUR" :QUALIFIER "MEZZANO.GUI")
       (*))
      TO)
     (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) MASK)
     (TYPE #S(FORMGREP:SYMREF :NAME "COLOUR" :QUALIFIER "MEZZANO.GUI") COLOUR)
     (TYPE FIXNUM NCOLS TO-OFFSET MASK-OFFSET)
     (TYPE FUNCTION BLENDER)
     (OPTIMIZE SPEED (SAFETY 0)))
    (LOOP FOR I FIXNUM BELOW NCOLS
          FOR TO-OFS FIXNUM FROM TO-OFFSET
          FOR MASK-OFS FIXNUM FROM MASK-OFFSET
          DO (FUNCALL BLENDER (COMPONENT-* COLOUR (AREF MASK MASK-OFS)) TO
                      TO-OFS)))

[Mezzano/gui/blit-generic.lisp:86]
  (DEFUN %%SET-ONE-ARGB8888-ARGB8888 (COLOUR TO TO-OFFSET)
    (DECLARE
     (TYPE
      (SIMPLE-ARRAY #S(FORMGREP:SYMREF :NAME "COLOUR" :QUALIFIER "MEZZANO.GUI")
       (*))
      TO)
     (TYPE #S(FORMGREP:SYMREF :NAME "COLOUR" :QUALIFIER "MEZZANO.GUI") COLOUR)
     (TYPE FIXNUM TO-OFFSET)
     (OPTIMIZE SPEED (SAFETY 0)))
    (SETF (AREF TO TO-OFFSET) COLOUR))

[Mezzano/gui/blit-generic.lisp:93]
  (DEFUN %%XOR-ONE-ARGB8888-ARGB8888 (COLOUR TO TO-OFFSET)
    (DECLARE
     (TYPE
      (SIMPLE-ARRAY #S(FORMGREP:SYMREF :NAME "COLOUR" :QUALIFIER "MEZZANO.GUI")
       (*))
      TO)
     (TYPE #S(FORMGREP:SYMREF :NAME "COLOUR" :QUALIFIER "MEZZANO.GUI") COLOUR)
     (TYPE FIXNUM TO-OFFSET)
     (OPTIMIZE SPEED (SAFETY 0)))
    (SETF (AREF TO TO-OFFSET) (LOGXOR (AREF TO TO-OFFSET) COLOUR)))

[Mezzano/gui/blit-generic.lisp:104]
  (DEFUN %%ALPHA-BLEND-ONE-ARGB8888-ARGB8888 (COLOUR TO TO-OFFSET)
    (DECLARE
     (TYPE
      (SIMPLE-ARRAY #S(FORMGREP:SYMREF :NAME "COLOUR" :QUALIFIER "MEZZANO.GUI")
       (*))
      TO)
     (TYPE #S(FORMGREP:SYMREF :NAME "COLOUR" :QUALIFIER "MEZZANO.GUI") COLOUR)
     (TYPE FIXNUM TO-OFFSET)
     (OPTIMIZE SPEED (SAFETY 0)))
    (LET* ((SOURCE-ALPHA (COLOUR-ALPHA-AS-OCTET COLOUR)))
      (COND ((EQL SOURCE-ALPHA 0) NIL)
            ((EQL SOURCE-ALPHA 255) (SETF (AREF TO TO-OFFSET) COLOUR))
            (T
             (LET* ((INVERSE-ALPHA (- 255 SOURCE-ALPHA))
                    (DEST (AREF TO TO-OFFSET))
                    (DEST-BLENDED (COMPONENT-* DEST INVERSE-ALPHA))
                    (RESULT (COMPONENT-+ DEST-BLENDED COLOUR)))
               (SETF (AREF TO TO-OFFSET) RESULT))))))

[Mezzano/gui/blit-x86-64-simd.lisp:7]
  (DEFUN %BITBLT-LINE (BLENDER TO TO-OFFSET NCOLS FROM FROM-OFFSET)
    (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 1))
             (TYPE FUNCTION BLENDER)
             (TYPE FIXNUM TO-OFFSET NCOLS FROM-OFFSET)
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 32) (*)) TO FROM))
    (LOOP FOR I FIXNUM BELOW NCOLS
          DO (FUNCALL BLENDER (AREF FROM FROM-OFFSET) TO TO-OFFSET) (INCF
                                                                     TO-OFFSET) (INCF
                                                                                 FROM-OFFSET)))

[Mezzano/gui/blit-x86-64-simd.lisp:17]
  (DEFUN %BITSET-LINE (BLENDER TO TO-OFFSET NCOLS COLOUR)
    (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 1))
             (TYPE FUNCTION BLENDER)
             (TYPE FIXNUM TO-OFFSET NCOLS)
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 32) (*)) TO)
             (TYPE (UNSIGNED-BYTE 32) COLOUR))
    (LOOP FOR I FIXNUM BELOW NCOLS
          DO (FUNCALL BLENDER COLOUR TO TO-OFFSET) (INCF TO-OFFSET)))

[Mezzano/gui/blit-x86-64-simd.lisp:27]
  (DEFUN %BITSET-MASK-1-LINE
         (BLENDER TO TO-OFFSET NCOLS MASK MASK-OFFSET COLOUR)
    (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 1))
             (TYPE FUNCTION BLENDER)
             (TYPE FIXNUM TO-OFFSET NCOLS MASK-OFFSET)
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 32) (*)) TO)
             (TYPE (SIMPLE-ARRAY BIT (*)) MASK)
             (TYPE (UNSIGNED-BYTE 32) COLOUR))
    (LOOP FOR I FIXNUM BELOW NCOLS
          DO (WHEN (NOT (EQL (AREF MASK MASK-OFFSET) 0))
               (FUNCALL BLENDER COLOUR TO TO-OFFSET)) (INCF TO-OFFSET) (INCF
                                                                        MASK-OFFSET)))

[Mezzano/gui/blit-x86-64-simd.lisp:40]
  (DEFUN %BITSET-MASK-8-LINE
         (BLENDER TO TO-OFFSET NCOLS MASK MASK-OFFSET COLOUR)
    (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 1))
             (TYPE FUNCTION BLENDER)
             (TYPE FIXNUM TO-OFFSET NCOLS MASK-OFFSET)
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 32) (*)) TO)
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) MASK)
             (TYPE (UNSIGNED-BYTE 32) COLOUR))
    (LOOP FOR I FIXNUM BELOW NCOLS
          DO (LET ((MASK-BYTE (AREF MASK MASK-OFFSET)))
               (COND ((EQL MASK-BYTE 0) NIL)
                     ((EQL MASK-BYTE 255)
                      (FUNCALL BLENDER COLOUR TO TO-OFFSET))
                     (T
                      (LET* ((VEC-COLOUR
                              (#S(FORMGREP:SYMREF
                                  :NAME "MAKE-MMX-VECTOR"
                                  :QUALIFIER "MEZZANO.SIMD")
                               COLOUR))
                             (VEC-MASK
                              (#S(FORMGREP:SYMREF
                                  :NAME "MAKE-MMX-VECTOR"
                                  :QUALIFIER "MEZZANO.SIMD")
                               MASK-BYTE))
                             (VEC-ZERO
                              (#S(FORMGREP:SYMREF
                                  :NAME "MAKE-MMX-VECTOR"
                                  :QUALIFIER "MEZZANO.SIMD")
                               0))
                             (UNPACKED-MASK
                              (#S(FORMGREP:SYMREF
                                  :NAME "PUNPCKLBW"
                                  :QUALIFIER "MEZZANO.SIMD")
                               (#S(FORMGREP:SYMREF
                                   :NAME "PMULUDQ"
                                   :QUALIFIER "MEZZANO.SIMD")
                                VEC-MASK
                                (#S(FORMGREP:SYMREF
                                    :NAME "MAKE-MMX-VECTOR"
                                    :QUALIFIER "MEZZANO.SIMD")
                                 16843009))
                               VEC-ZERO))
                             (UNPACKED-COLOUR
                              (#S(FORMGREP:SYMREF
                                  :NAME "PUNPCKLBW"
                                  :QUALIFIER "MEZZANO.SIMD")
                               VEC-COLOUR VEC-ZERO))
                             (ADJUSTED-COLOUR
                              (#S(FORMGREP:SYMREF
                                  :NAME "PMULHUW"
                                  :QUALIFIER "MEZZANO.SIMD")
                               (#S(FORMGREP:SYMREF
                                   :NAME "PADDUSW"
                                   :QUALIFIER "MEZZANO.SIMD")
                                (#S(FORMGREP:SYMREF
                                    :NAME "PMULLW"
                                    :QUALIFIER "MEZZANO.SIMD")
                                 UNPACKED-COLOUR UNPACKED-MASK)
                                (#S(FORMGREP:SYMREF
                                    :NAME "MAKE-MMX-VECTOR"
                                    :QUALIFIER "MEZZANO.SIMD")
                                 36029346783166592))
                               (#S(FORMGREP:SYMREF
                                   :NAME "MAKE-MMX-VECTOR"
                                   :QUALIFIER "MEZZANO.SIMD")
                                72340172838076673)))
                             (FINAL-COLOUR
                              (LDB (BYTE 32 0)
                                   (#S(FORMGREP:SYMREF
                                       :NAME "MMX-VECTOR-VALUE"
                                       :QUALIFIER "MEZZANO.SIMD")
                                    (#S(FORMGREP:SYMREF
                                        :NAME "PACKUSWB"
                                        :QUALIFIER "MEZZANO.SIMD")
                                     ADJUSTED-COLOUR VEC-ZERO)))))
                        (FUNCALL BLENDER FINAL-COLOUR TO TO-OFFSET))))) (INCF
                                                                         TO-OFFSET) (INCF
                                                                                     MASK-OFFSET)))

[Mezzano/gui/blit-x86-64-simd.lisp:80]
  (DEFUN %%SET-ONE-ARGB8888-ARGB8888 (SOURCE TO TO-OFFSET)
    (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 1))
             (TYPE (UNSIGNED-BYTE 32) SOURCE)
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 32) (*)) TO)
             (TYPE FIXNUM TO-OFFSET))
    (SETF (AREF TO TO-OFFSET) SOURCE))

[Mezzano/gui/blit-x86-64-simd.lisp:87]
  (DEFUN %%XOR-ONE-ARGB8888-ARGB8888 (SOURCE TO TO-OFFSET)
    (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 1))
             (TYPE (UNSIGNED-BYTE 32) SOURCE)
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 32) (*)) TO)
             (TYPE FIXNUM TO-OFFSET))
    (SETF (AREF TO TO-OFFSET) (LOGXOR SOURCE (AREF TO TO-OFFSET))))

[Mezzano/gui/blit-x86-64-simd.lisp:98]
  (DEFUN %%ALPHA-BLEND-ONE-ARGB8888-ARGB8888 (SOURCE TO TO-OFFSET)
    (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 1))
             (TYPE (UNSIGNED-BYTE 32) SOURCE)
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 32) (*)) TO)
             (TYPE FIXNUM TO-OFFSET))
    (LET ((SOURCE-ALPHA (LOGAND SOURCE 4278190080)))
      (COND ((EQL SOURCE-ALPHA 0) NIL)
            ((EQL SOURCE-ALPHA 4278190080) (SETF (AREF TO TO-OFFSET) SOURCE))
            (T
             (LET* ((VEC-SOURCE
                     (#S(FORMGREP:SYMREF
                         :NAME "MAKE-MMX-VECTOR"
                         :QUALIFIER "MEZZANO.SIMD")
                      SOURCE))
                    (VEC-ALPHA
                     (#S(FORMGREP:SYMREF
                         :NAME "MAKE-MMX-VECTOR"
                         :QUALIFIER "MEZZANO.SIMD")
                      (THE (UNSIGNED-BYTE 8) (ASH SOURCE-ALPHA -24))))
                    (VEC-DEST
                     (#S(FORMGREP:SYMREF
                         :NAME "MAKE-MMX-VECTOR"
                         :QUALIFIER "MEZZANO.SIMD")
                      (AREF TO TO-OFFSET)))
                    (VEC-ZERO
                     (#S(FORMGREP:SYMREF
                         :NAME "MAKE-MMX-VECTOR"
                         :QUALIFIER "MEZZANO.SIMD")
                      0))
                    (EXPLODED-ALPHA
                     (#S(FORMGREP:SYMREF
                         :NAME "PUNPCKLBW"
                         :QUALIFIER "MEZZANO.SIMD")
                      (#S(FORMGREP:SYMREF
                          :NAME "PMULUDQ"
                          :QUALIFIER "MEZZANO.SIMD")
                       VEC-ALPHA
                       (#S(FORMGREP:SYMREF
                           :NAME "MAKE-MMX-VECTOR"
                           :QUALIFIER "MEZZANO.SIMD")
                        16843009))
                      VEC-ZERO))
                    (INVERSE-ALPHA
                     (#S(FORMGREP:SYMREF
                         :NAME "PSUBB"
                         :QUALIFIER "MEZZANO.SIMD")
                      (#S(FORMGREP:SYMREF
                          :NAME "MAKE-MMX-VECTOR"
                          :QUALIFIER "MEZZANO.SIMD")
                       71777214294589695)
                      EXPLODED-ALPHA))
                    (UNPACKED-SOURCE
                     (#S(FORMGREP:SYMREF
                         :NAME "PUNPCKLBW"
                         :QUALIFIER "MEZZANO.SIMD")
                      VEC-SOURCE VEC-ZERO))
                    (UNPACKED-DEST
                     (#S(FORMGREP:SYMREF
                         :NAME "PUNPCKLBW"
                         :QUALIFIER "MEZZANO.SIMD")
                      VEC-DEST VEC-ZERO))
                    (ADJUSTED-DEST
                     (#S(FORMGREP:SYMREF
                         :NAME "PMULHUW"
                         :QUALIFIER "MEZZANO.SIMD")
                      (#S(FORMGREP:SYMREF
                          :NAME "PADDUSW"
                          :QUALIFIER "MEZZANO.SIMD")
                       (#S(FORMGREP:SYMREF
                           :NAME "PMULLW"
                           :QUALIFIER "MEZZANO.SIMD")
                        UNPACKED-DEST INVERSE-ALPHA)
                       (#S(FORMGREP:SYMREF
                           :NAME "MAKE-MMX-VECTOR"
                           :QUALIFIER "MEZZANO.SIMD")
                        36029346783166592))
                      (#S(FORMGREP:SYMREF
                          :NAME "MAKE-MMX-VECTOR"
                          :QUALIFIER "MEZZANO.SIMD")
                       72340172838076673)))
                    (BLENDED
                     (#S(FORMGREP:SYMREF
                         :NAME "PADDUSW"
                         :QUALIFIER "MEZZANO.SIMD")
                      UNPACKED-SOURCE ADJUSTED-DEST))
                    (FINAL
                     (LDB (BYTE 32 0)
                          (#S(FORMGREP:SYMREF
                              :NAME "MMX-VECTOR-VALUE"
                              :QUALIFIER "MEZZANO.SIMD")
                           (#S(FORMGREP:SYMREF
                               :NAME "PACKUSWB"
                               :QUALIFIER "MEZZANO.SIMD")
                            BLENDED VEC-ZERO)))))
               (SETF (AREF TO TO-OFFSET) FINAL))))))

[Mezzano/gui/blit.lisp:164]
  (DEFUN %2D-ARRAY-BITBLT-MATRIX-INNER
         (MATRIX NCOLS FROM FROM-OFFSET TO TO-OFFSET)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0))
             (TYPE MATRIX4 MATRIX)
             (TYPE FIXNUM NCOLS FROM-OFFSET TO-OFFSET)
             (TYPE (SIMPLE-ARRAY COLOUR (*)) FROM TO))
    (LOOP FOR X FIXNUM BELOW NCOLS
          DO (SETF (AREF TO TO-OFFSET)
                     (%COLOUR-MATRIX-MULTIPLY MATRIX
                      (AREF FROM FROM-OFFSET))) (INCF FROM-OFFSET) (INCF
                                                                    TO-OFFSET)))

[Mezzano/gui/blit.lisp:177]
  (DEFUN %2D-ARRAY-BITBLT-MATRIX
         (MATRIX NROWS NCOLS FROM FROM-OFFSET FROM-STRIDE TO TO-OFFSET
          TO-STRIDE)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0))
             (TYPE MATRIX4 MATRIX)
             (TYPE FIXNUM NROWS NCOLS FROM-OFFSET FROM-STRIDE TO-OFFSET
              TO-STRIDE)
             (TYPE (SIMPLE-ARRAY COLOUR (*)) FROM TO))
    (LOOP FOR Y FIXNUM BELOW NROWS
          DO (%2D-ARRAY-BITBLT-MATRIX-INNER MATRIX NCOLS FROM FROM-OFFSET TO
              TO-OFFSET) (INCF FROM-OFFSET FROM-STRIDE) (INCF TO-OFFSET
                                                              TO-STRIDE)))

[Mezzano/gui/colour.lisp:125]
  (PROGN
   (DEFTYPE SIMD-COLOUR ()
     '#S(FORMGREP:SYMREF :NAME "SSE-VECTOR" :QUALIFIER "MEZZANO.SIMD"))
   (DECLAIM (INLINE MAKE-SIMD-COLOUR))
   (DEFUN MAKE-SIMD-COLOUR
          (&OPTIONAL (RED 0.0) (GREEN 0.0) (BLUE 0.0) (ALPHA 1.0))
     (DECLARE (TYPE SINGLE-FLOAT RED GREEN BLUE ALPHA))
     (#S(FORMGREP:SYMREF
         :NAME "MAKE-SSE-VECTOR-SINGLE-FLOAT"
         :QUALIFIER "MEZZANO.SIMD")
      ALPHA RED GREEN BLUE))
   (DECLAIM (INLINE SIMD-COLOUR-ELEMENTS))
   (DEFUN SIMD-COLOUR-ELEMENTS (SIMD-COLOUR)
     "Return the red, green, blue, and alpha channels of SIMD-COLOUR as values."
     (DECLARE (TYPE SIMD-COLOUR-VECTOR SIMD-COLOUR))
     (VALUES
      (#S(FORMGREP:SYMREF
          :NAME "SSE-VECTOR-SINGLE-FLOAT-ELEMENT"
          :QUALIFIER "MEZZANO.SIMD")
       SIMD-COLOUR 1)
      (#S(FORMGREP:SYMREF
          :NAME "SSE-VECTOR-SINGLE-FLOAT-ELEMENT"
          :QUALIFIER "MEZZANO.SIMD")
       SIMD-COLOUR 2)
      (#S(FORMGREP:SYMREF
          :NAME "SSE-VECTOR-SINGLE-FLOAT-ELEMENT"
          :QUALIFIER "MEZZANO.SIMD")
       SIMD-COLOUR 3)
      (#S(FORMGREP:SYMREF
          :NAME "SSE-VECTOR-SINGLE-FLOAT-ELEMENT"
          :QUALIFIER "MEZZANO.SIMD")
       SIMD-COLOUR 0)))
   (DECLAIM (INLINE SIMD-COLOUR-TO-FLOATS))
   (DEFUN SIMD-COLOUR-TO-FLOATS (COLOUR)
     "Unpack 4 bytes in a UB32 to 4 floats."
     (DECLARE (TYPE COLOUR COLOUR))
     (LET* ((COLOUR-VEC
             (#S(FORMGREP:SYMREF
                 :NAME "MAKE-SSE-VECTOR"
                 :QUALIFIER "MEZZANO.SIMD")
              COLOUR))
            (ZERO-VEC
             (#S(FORMGREP:SYMREF
                 :NAME "MAKE-SSE-VECTOR"
                 :QUALIFIER "MEZZANO.SIMD")
              0))
            (UNPACKED-COLOUR
             (#S(FORMGREP:SYMREF :NAME "PUNPCKLWD" :QUALIFIER "MEZZANO.SIMD")
              (#S(FORMGREP:SYMREF :NAME "PUNPCKLBW" :QUALIFIER "MEZZANO.SIMD")
               COLOUR-VEC ZERO-VEC)
              ZERO-VEC))
            (FLOAT-COLOUR
             (#S(FORMGREP:SYMREF :NAME "CVTDQ2PS" :QUALIFIER "MEZZANO.SIMD")
              UNPACKED-COLOUR)))
       FLOAT-COLOUR))
   (DECLAIM (INLINE SIMD-FLOATS-TO-COLOUR))
   (DEFUN SIMD-FLOATS-TO-COLOUR (VEC)
     "Pack 4 floats to 4 bytes in a UB32."
     (DECLARE
      (TYPE #S(FORMGREP:SYMREF :NAME "SSE-VECTOR" :QUALIFIER "MEZZANO.SIMD")
       VEC))
     (LET* ((UNPACKED
             (#S(FORMGREP:SYMREF :NAME "CVTPS2DQ" :QUALIFIER "MEZZANO.SIMD")
              VEC))
            (HALF-PACK
             (#S(FORMGREP:SYMREF :NAME "PACKSSDW" :QUALIFIER "MEZZANO.SIMD")
              UNPACKED UNPACKED))
            (RESULT
             (#S(FORMGREP:SYMREF :NAME "PACKUSWB" :QUALIFIER "MEZZANO.SIMD")
              HALF-PACK HALF-PACK)))
       (LDB (BYTE 32 0)
            (#S(FORMGREP:SYMREF
                :NAME "SSE-VECTOR-VALUE"
                :QUALIFIER "MEZZANO.SIMD")
             RESULT))))
   (DECLAIM (INLINE SIMD-UNPACK-COLOUR))
   (DEFUN SIMD-UNPACK-COLOUR (COLOUR)
     "Convert a COLOUR to a SIMD-COLOUR."
     (DECLARE (TYPE COLOUR COLOUR))
     (LET* ((COLOUR-VEC (SIMD-COLOUR-TO-FLOATS COLOUR))
            (COLOURS01
             (#S(FORMGREP:SYMREF :NAME "MULPS" :QUALIFIER "MEZZANO.SIMD")
              COLOUR-VEC
              (#S(FORMGREP:SYMREF
                  :NAME "MAKE-SSE-VECTOR-SINGLE-FLOAT"
                  :QUALIFIER "MEZZANO.SIMD")
               (/ 255.0) (/ 255.0) (/ 255.0) (/ 255.0))))
            (ALPHA
             (#S(FORMGREP:SYMREF :NAME "MAXPS" :QUALIFIER "MEZZANO.SIMD")
              (#S(FORMGREP:SYMREF :NAME "SHUFPS" :QUALIFIER "MEZZANO.SIMD")
               COLOURS01 COLOURS01 255)
              (#S(FORMGREP:SYMREF
                  :NAME "MAKE-SSE-VECTOR-SINGLE-FLOAT"
                  :QUALIFIER "MEZZANO.SIMD")
               SINGLE-FLOAT-EPSILON SINGLE-FLOAT-EPSILON SINGLE-FLOAT-EPSILON
               1.0)))
            (BGRA
             (#S(FORMGREP:SYMREF :NAME "DIVPS" :QUALIFIER "MEZZANO.SIMD")
              COLOURS01 ALPHA))
            (RESULT
             (#S(FORMGREP:SYMREF :NAME "SHUFPS" :QUALIFIER "MEZZANO.SIMD") BGRA
              BGRA 27)))
       RESULT))
   (DECLAIM (INLINE SIMD-PACK-COLOUR))
   (DEFUN SIMD-PACK-COLOUR (SIMD-COLOUR)
     "Convert SIMD-COLOUR to a COLOUR. Channel values are clamped to 0-1."
     (DECLARE (TYPE SIMD-COLOUR SIMD-COLOUR))
     (LET* ((ARGB01
             (#S(FORMGREP:SYMREF :NAME "MAXPS" :QUALIFIER "MEZZANO.SIMD")
              (#S(FORMGREP:SYMREF :NAME "MINPS" :QUALIFIER "MEZZANO.SIMD")
               SIMD-COLOUR
               (#S(FORMGREP:SYMREF
                   :NAME "MAKE-SSE-VECTOR-SINGLE-FLOAT"
                   :QUALIFIER "MEZZANO.SIMD")
                1.0 1.0 1.0 1.0))
              (#S(FORMGREP:SYMREF
                  :NAME "MAKE-SSE-VECTOR-SINGLE-FLOAT"
                  :QUALIFIER "MEZZANO.SIMD")
               0.0 0.0 0.0 0.0)))
            (ALPHA-SCALE
             (#S(FORMGREP:SYMREF :NAME "MOVSS" :QUALIFIER "MEZZANO.SIMD")
              (#S(FORMGREP:SYMREF :NAME "SHUFPS" :QUALIFIER "MEZZANO.SIMD")
               ARGB01 ARGB01 0)
              (#S(FORMGREP:SYMREF
                  :NAME "MAKE-SSE-VECTOR-SINGLE-FLOAT"
                  :QUALIFIER "MEZZANO.SIMD")
               1.0)))
            (ARGB01-PREMULT
             (#S(FORMGREP:SYMREF :NAME "MULPS" :QUALIFIER "MEZZANO.SIMD")
              ARGB01 ALPHA-SCALE))
            (ARGB-SCALED
             (#S(FORMGREP:SYMREF :NAME "MULPS" :QUALIFIER "MEZZANO.SIMD")
              ARGB01-PREMULT
              (#S(FORMGREP:SYMREF
                  :NAME "MAKE-SSE-VECTOR-SINGLE-FLOAT"
                  :QUALIFIER "MEZZANO.SIMD")
               255.0 255.0 255.0 255.0)))
            (BGRA-SCALED
             (#S(FORMGREP:SYMREF :NAME "SHUFPS" :QUALIFIER "MEZZANO.SIMD")
              ARGB-SCALED ARGB-SCALED 27)))
       (SIMD-FLOATS-TO-COLOUR BGRA-SCALED)))
   (DEFUN %COLOUR-LERP (C1 C2 A)
     (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0))
              (TYPE COLOUR C1 C2)
              (TYPE SINGLE-FLOAT A))
     (LET* ((C1-VEC (SIMD-COLOUR-TO-FLOATS C1))
            (C2-VEC (SIMD-COLOUR-TO-FLOATS C2))
            (A-TMP
             (#S(FORMGREP:SYMREF
                 :NAME "MAKE-SSE-VECTOR-SINGLE-FLOAT"
                 :QUALIFIER "MEZZANO.SIMD")
              A))
            (A-VEC
             (#S(FORMGREP:SYMREF :NAME "SHUFPS" :QUALIFIER "MEZZANO.SIMD")
              A-TMP A-TMP 0))
            (1-A-VEC
             (#S(FORMGREP:SYMREF :NAME "SUBPS" :QUALIFIER "MEZZANO.SIMD")
              (#S(FORMGREP:SYMREF
                  :NAME "MAKE-SSE-VECTOR-SINGLE-FLOAT"
                  :QUALIFIER "MEZZANO.SIMD")
               1.0 1.0 1.0 1.0)
              A-VEC))
            (C
             (#S(FORMGREP:SYMREF :NAME "ADDPS" :QUALIFIER "MEZZANO.SIMD")
              (#S(FORMGREP:SYMREF :NAME "MULPS" :QUALIFIER "MEZZANO.SIMD")
               1-A-VEC C1-VEC)
              (#S(FORMGREP:SYMREF :NAME "MULPS" :QUALIFIER "MEZZANO.SIMD")
               A-VEC C2-VEC))))
       (SIMD-FLOATS-TO-COLOUR C)))
   (DEFUN COLOUR-LERP (C1 C2 A)
     "Lerp between C1 and C2 based on A"
     (ASSERT (TYPEP A 'SINGLE-FLOAT))
     (ASSERT (TYPEP C1 'COLOUR))
     (ASSERT (TYPEP C2 'COLOUR))
     (%COLOUR-LERP C1 C2 A))
   (DEFTYPE MATRIX4 () '(SIMPLE-ARRAY SINGLE-FLOAT (16)))
   (DECLAIM (INLINE MATRIX4-COLUMN (SETF MATRIX4-COLUMN)))
   (DEFUN MATRIX4-COLUMN (MAT COL)
     (#S(FORMGREP:SYMREF
         :NAME "SSE-VECTOR-SINGLE-FLOAT-REF"
         :QUALIFIER "MEZZANO.SIMD")
      MAT 4 (* COL 4)))
   (DEFUN (SETF MATRIX4-COLUMN) (VEC MAT COL)
     (SETF (#S(FORMGREP:SYMREF
               :NAME "SSE-VECTOR-SINGLE-FLOAT-REF"
               :QUALIFIER "MEZZANO.SIMD")
            MAT 4 (* COL 4))
             VEC))
   (DECLAIM (INLINE MATRIX4-VECTOR4-MULTIPLY))
   (DEFUN MATRIX4-VECTOR4-MULTIPLY (MAT VEC)
     (DECLARE
      (TYPE #S(FORMGREP:SYMREF :NAME "SSE-VECTOR" :QUALIFIER "MEZZANO.SIMD")
       VEC)
      (TYPE MATRIX4 MAT))
     (LET* ((C0 (MATRIX4-COLUMN MAT 0))
            (C1 (MATRIX4-COLUMN MAT 1))
            (C2 (MATRIX4-COLUMN MAT 2))
            (C3 (MATRIX4-COLUMN MAT 3))
            (XV
             (#S(FORMGREP:SYMREF :NAME "SHUFPS" :QUALIFIER "MEZZANO.SIMD") VEC
              VEC 0))
            (YV
             (#S(FORMGREP:SYMREF :NAME "SHUFPS" :QUALIFIER "MEZZANO.SIMD") VEC
              VEC 85))
            (ZV
             (#S(FORMGREP:SYMREF :NAME "SHUFPS" :QUALIFIER "MEZZANO.SIMD") VEC
              VEC 170))
            (WV
             (#S(FORMGREP:SYMREF :NAME "SHUFPS" :QUALIFIER "MEZZANO.SIMD") VEC
              VEC 255))
            (T0
             (#S(FORMGREP:SYMREF :NAME "MULPS" :QUALIFIER "MEZZANO.SIMD") C0
              XV))
            (T1
             (#S(FORMGREP:SYMREF :NAME "MULPS" :QUALIFIER "MEZZANO.SIMD") C1
              YV))
            (T2
             (#S(FORMGREP:SYMREF :NAME "MULPS" :QUALIFIER "MEZZANO.SIMD") C2
              ZV))
            (T3
             (#S(FORMGREP:SYMREF :NAME "MULPS" :QUALIFIER "MEZZANO.SIMD") C3
              WV)))
       (#S(FORMGREP:SYMREF :NAME "ADDPS" :QUALIFIER "MEZZANO.SIMD")
        (#S(FORMGREP:SYMREF :NAME "ADDPS" :QUALIFIER "MEZZANO.SIMD") T0 T1)
        (#S(FORMGREP:SYMREF :NAME "ADDPS" :QUALIFIER "MEZZANO.SIMD") T2 T3))))
   (DEFUN MATRIX4-MULTIPLY (RESULT MA MB)
     (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0))
              (TYPE MATRIX4 RESULT MA MB))
     (LET* ((MAC0 (MATRIX4-COLUMN MA 0))
            (MAC1 (MATRIX4-COLUMN MA 1))
            (MAC2 (MATRIX4-COLUMN MA 2))
            (MAC3 (MATRIX4-COLUMN MA 3))
            (MBC0 (MATRIX4-COLUMN MB 0))
            (MBC1 (MATRIX4-COLUMN MB 1))
            (MBC2 (MATRIX4-COLUMN MB 2))
            (MBC3 (MATRIX4-COLUMN MB 3)))
       (FLET ((FROB (B-COLUMN)
                (#S(FORMGREP:SYMREF :NAME "ADDPS" :QUALIFIER "MEZZANO.SIMD")
                 (#S(FORMGREP:SYMREF :NAME "ADDPS" :QUALIFIER "MEZZANO.SIMD")
                  (#S(FORMGREP:SYMREF :NAME "MULPS" :QUALIFIER "MEZZANO.SIMD")
                   MAC0
                   (#S(FORMGREP:SYMREF
                       :NAME "SHUFPS"
                       :QUALIFIER "MEZZANO.SIMD")
                    B-COLUMN B-COLUMN 0))
                  (#S(FORMGREP:SYMREF :NAME "MULPS" :QUALIFIER "MEZZANO.SIMD")
                   MAC1
                   (#S(FORMGREP:SYMREF
                       :NAME "SHUFPS"
                       :QUALIFIER "MEZZANO.SIMD")
                    B-COLUMN B-COLUMN 85)))
                 (#S(FORMGREP:SYMREF :NAME "ADDPS" :QUALIFIER "MEZZANO.SIMD")
                  (#S(FORMGREP:SYMREF :NAME "MULPS" :QUALIFIER "MEZZANO.SIMD")
                   MAC2
                   (#S(FORMGREP:SYMREF
                       :NAME "SHUFPS"
                       :QUALIFIER "MEZZANO.SIMD")
                    B-COLUMN B-COLUMN 170))
                  (#S(FORMGREP:SYMREF :NAME "MULPS" :QUALIFIER "MEZZANO.SIMD")
                   MAC3
                   (#S(FORMGREP:SYMREF
                       :NAME "SHUFPS"
                       :QUALIFIER "MEZZANO.SIMD")
                    B-COLUMN B-COLUMN 255))))))
         (SETF (MATRIX4-COLUMN RESULT 0) (FROB MBC0)
               (MATRIX4-COLUMN RESULT 1) (FROB MBC1)
               (MATRIX4-COLUMN RESULT 2) (FROB MBC2)
               (MATRIX4-COLUMN RESULT 3) (FROB MBC3))))
     RESULT)
   (DEFUN COLOUR-MATRIX-MATRIX-MULTIPLY (MA MB)
     "Multiply two colour matrices together, returning the result as a new matrix."
     (ASSERT (COLOUR-MATRIX-P MA))
     (ASSERT (COLOUR-MATRIX-P MB))
     (LET ((MR (MAKE-ARRAY 16 :ELEMENT-TYPE 'SINGLE-FLOAT)))
       (MATRIX4-MULTIPLY MR (COLOUR-MATRIX-ELEMENTS MA)
        (COLOUR-MATRIX-ELEMENTS MB))
       (%MAKE-COLOUR-MATRIX :ELEMENTS MR)))
   (DECLAIM (INLINE %COLOUR-MATRIX-MULTIPLY))
   (DEFUN %COLOUR-MATRIX-MULTIPLY (MATRIX COLOUR)
     (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0))
              (TYPE MATRIX4 MATRIX)
              (TYPE COLOUR COLOUR))
     (LET* ((SIMD-COLOUR (SIMD-UNPACK-COLOUR COLOUR))
            (ORIGINAL-RGB
             (#S(FORMGREP:SYMREF :NAME "MOVSS" :QUALIFIER "MEZZANO.SIMD")
              SIMD-COLOUR
              (#S(FORMGREP:SYMREF
                  :NAME "MAKE-SSE-VECTOR-SINGLE-FLOAT"
                  :QUALIFIER "MEZZANO.SIMD")
               1.0)))
            (NEW-RGB
             (MATRIX4-VECTOR4-MULTIPLY MATRIX
              (#S(FORMGREP:SYMREF :NAME "SHUFPS" :QUALIFIER "MEZZANO.SIMD")
               ORIGINAL-RGB ORIGINAL-RGB 57)))
            (NEW-COLOUR
             (#S(FORMGREP:SYMREF :NAME "MOVSS" :QUALIFIER "MEZZANO.SIMD")
              (#S(FORMGREP:SYMREF :NAME "SHUFPS" :QUALIFIER "MEZZANO.SIMD")
               NEW-RGB NEW-RGB 147)
              SIMD-COLOUR)))
       (SIMD-PACK-COLOUR NEW-COLOUR)))
   (DEFUN COLOUR-MATRIX-MULTIPLY (COLOUR-MATRIX COLOUR)
     "Multiply the RGB elements of COLOUR with COLOUR-MATRIX."
     (DECLARE (NOTINLINE %COLOUR-MATRIX-MULTIPLY))
     (ASSERT (COLOUR-MATRIX-P COLOUR-MATRIX))
     (ASSERT (TYPEP COLOUR 'COLOUR))
     (%COLOUR-MATRIX-MULTIPLY (COLOUR-MATRIX-ELEMENTS COLOUR-MATRIX) COLOUR)))

[Mezzano/gui/colour.lisp:216]
  (DEFUN %COLOUR-LERP (C1 C2 A)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0))
             (TYPE COLOUR C1 C2)
             (TYPE SINGLE-FLOAT A))
    (LET* ((C1-VEC (SIMD-COLOUR-TO-FLOATS C1))
           (C2-VEC (SIMD-COLOUR-TO-FLOATS C2))
           (A-TMP
            (#S(FORMGREP:SYMREF
                :NAME "MAKE-SSE-VECTOR-SINGLE-FLOAT"
                :QUALIFIER "MEZZANO.SIMD")
             A))
           (A-VEC
            (#S(FORMGREP:SYMREF :NAME "SHUFPS" :QUALIFIER "MEZZANO.SIMD") A-TMP
             A-TMP 0))
           (1-A-VEC
            (#S(FORMGREP:SYMREF :NAME "SUBPS" :QUALIFIER "MEZZANO.SIMD")
             (#S(FORMGREP:SYMREF
                 :NAME "MAKE-SSE-VECTOR-SINGLE-FLOAT"
                 :QUALIFIER "MEZZANO.SIMD")
              1.0 1.0 1.0 1.0)
             A-VEC))
           (C
            (#S(FORMGREP:SYMREF :NAME "ADDPS" :QUALIFIER "MEZZANO.SIMD")
             (#S(FORMGREP:SYMREF :NAME "MULPS" :QUALIFIER "MEZZANO.SIMD")
              1-A-VEC C1-VEC)
             (#S(FORMGREP:SYMREF :NAME "MULPS" :QUALIFIER "MEZZANO.SIMD") A-VEC
              C2-VEC))))
      (SIMD-FLOATS-TO-COLOUR C)))

[Mezzano/gui/colour.lisp:268]
  (DEFUN MATRIX4-MULTIPLY (RESULT MA MB)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0))
             (TYPE MATRIX4 RESULT MA MB))
    (LET* ((MAC0 (MATRIX4-COLUMN MA 0))
           (MAC1 (MATRIX4-COLUMN MA 1))
           (MAC2 (MATRIX4-COLUMN MA 2))
           (MAC3 (MATRIX4-COLUMN MA 3))
           (MBC0 (MATRIX4-COLUMN MB 0))
           (MBC1 (MATRIX4-COLUMN MB 1))
           (MBC2 (MATRIX4-COLUMN MB 2))
           (MBC3 (MATRIX4-COLUMN MB 3)))
      (FLET ((FROB (B-COLUMN)
               (#S(FORMGREP:SYMREF :NAME "ADDPS" :QUALIFIER "MEZZANO.SIMD")
                (#S(FORMGREP:SYMREF :NAME "ADDPS" :QUALIFIER "MEZZANO.SIMD")
                 (#S(FORMGREP:SYMREF :NAME "MULPS" :QUALIFIER "MEZZANO.SIMD")
                  MAC0
                  (#S(FORMGREP:SYMREF :NAME "SHUFPS" :QUALIFIER "MEZZANO.SIMD")
                   B-COLUMN B-COLUMN 0))
                 (#S(FORMGREP:SYMREF :NAME "MULPS" :QUALIFIER "MEZZANO.SIMD")
                  MAC1
                  (#S(FORMGREP:SYMREF :NAME "SHUFPS" :QUALIFIER "MEZZANO.SIMD")
                   B-COLUMN B-COLUMN 85)))
                (#S(FORMGREP:SYMREF :NAME "ADDPS" :QUALIFIER "MEZZANO.SIMD")
                 (#S(FORMGREP:SYMREF :NAME "MULPS" :QUALIFIER "MEZZANO.SIMD")
                  MAC2
                  (#S(FORMGREP:SYMREF :NAME "SHUFPS" :QUALIFIER "MEZZANO.SIMD")
                   B-COLUMN B-COLUMN 170))
                 (#S(FORMGREP:SYMREF :NAME "MULPS" :QUALIFIER "MEZZANO.SIMD")
                  MAC3
                  (#S(FORMGREP:SYMREF :NAME "SHUFPS" :QUALIFIER "MEZZANO.SIMD")
                   B-COLUMN B-COLUMN 255))))))
        (SETF (MATRIX4-COLUMN RESULT 0) (FROB MBC0)
              (MATRIX4-COLUMN RESULT 1) (FROB MBC1)
              (MATRIX4-COLUMN RESULT 2) (FROB MBC2)
              (MATRIX4-COLUMN RESULT 3) (FROB MBC3))))
    RESULT)

[Mezzano/gui/colour.lisp:304]
  (DEFUN %COLOUR-MATRIX-MULTIPLY (MATRIX COLOUR)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0))
             (TYPE MATRIX4 MATRIX)
             (TYPE COLOUR COLOUR))
    (LET* ((SIMD-COLOUR (SIMD-UNPACK-COLOUR COLOUR))
           (ORIGINAL-RGB
            (#S(FORMGREP:SYMREF :NAME "MOVSS" :QUALIFIER "MEZZANO.SIMD")
             SIMD-COLOUR
             (#S(FORMGREP:SYMREF
                 :NAME "MAKE-SSE-VECTOR-SINGLE-FLOAT"
                 :QUALIFIER "MEZZANO.SIMD")
              1.0)))
           (NEW-RGB
            (MATRIX4-VECTOR4-MULTIPLY MATRIX
             (#S(FORMGREP:SYMREF :NAME "SHUFPS" :QUALIFIER "MEZZANO.SIMD")
              ORIGINAL-RGB ORIGINAL-RGB 57)))
           (NEW-COLOUR
            (#S(FORMGREP:SYMREF :NAME "MOVSS" :QUALIFIER "MEZZANO.SIMD")
             (#S(FORMGREP:SYMREF :NAME "SHUFPS" :QUALIFIER "MEZZANO.SIMD")
              NEW-RGB NEW-RGB 147)
             SIMD-COLOUR)))
      (SIMD-PACK-COLOUR NEW-COLOUR)))

[Mezzano/gui/image.lisp:22]
  (DEFUN TRANSCODE-CL-JPEG-BUFFER
         (DESTINATION-SURFACE X-OFFSET Y-OFFSET DATA WIDTH HEIGHT CHANNELS)
    (WHEN (NOT (EQL CHANNELS 3))
      (ERROR "Unsupported JPEG image, too many or too few channels."))
    (WHEN
        (NOT
         (EQL
          (#S(FORMGREP:SYMREF :NAME "SURFACE-FORMAT" :QUALIFIER "MEZZANO.GUI")
           DESTINATION-SURFACE)
          :ARGB32))
      (ERROR "Unsupported destination surface format ~S."
             (#S(FORMGREP:SYMREF
                 :NAME "SURFACE-FORMAT"
                 :QUALIFIER "MEZZANO.GUI")
              DESTINATION-SURFACE)))
    (LET* ((DEST-ARRAY
            (#S(FORMGREP:SYMREF
                :NAME "SURFACE-PIXELS"
                :QUALIFIER "MEZZANO.GUI")
             DESTINATION-SURFACE))
           (DEST-WIDTH
            (#S(FORMGREP:SYMREF :NAME "SURFACE-WIDTH" :QUALIFIER "MEZZANO.GUI")
             DESTINATION-SURFACE))
           (DEST-HEIGHT
            (#S(FORMGREP:SYMREF
                :NAME "SURFACE-HEIGHT"
                :QUALIFIER "MEZZANO.GUI")
             DESTINATION-SURFACE)))
      (CHECK-TYPE DEST-ARRAY (SIMPLE-ARRAY (UNSIGNED-BYTE 32) (* *)))
      (CHECK-TYPE DATA (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)))
      (ASSERT (<= 0 X-OFFSET (+ X-OFFSET WIDTH) DEST-WIDTH))
      (ASSERT (<= 0 Y-OFFSET (+ Y-OFFSET HEIGHT) DEST-HEIGHT))
      (LOCALLY
       (DECLARE (TYPE FIXNUM DEST-WIDTH DEST-HEIGHT)
                (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 32) (* *)) DEST-ARRAY)
                (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) DATA)
                (OPTIMIZE SPEED (SAFETY 0)))
       (LOOP FOR Y FIXNUM BELOW HEIGHT
             DO (LOOP FOR X FIXNUM BELOW WIDTH
                      FOR SRC-IDX FIXNUM = (*
                                            (THE FIXNUM
                                                 (+ (THE FIXNUM (* Y WIDTH))
                                                    X))
                                            3)
                      FOR DST-IDX FIXNUM = (+
                                            (THE FIXNUM
                                                 (* (THE FIXNUM (+ Y-OFFSET Y))
                                                    DEST-WIDTH))
                                            (THE FIXNUM (+ X-OFFSET X)))
                      DO (SETF (ROW-MAJOR-AREF DEST-ARRAY DST-IDX)
                                 (THE FIXNUM
                                      (LOGIOR 4278190080
                                              (THE FIXNUM
                                                   (ASH
                                                    (AREF DATA
                                                          (THE FIXNUM
                                                               (+ SRC-IDX 2)))
                                                    16))
                                              (THE FIXNUM
                                                   (ASH
                                                    (AREF DATA
                                                          (THE FIXNUM
                                                               (+ SRC-IDX 1)))
                                                    8))
                                              (AREF DATA SRC-IDX)))))))
      DESTINATION-SURFACE))

[Mezzano/gui/virgl/virgl.lisp:1466]
  (DEFUN %BITBLT-LINE (TO TO-OFFSET NCOLS FROM-ADDRESS FROM-OFFSET)
    (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 1))
             (TYPE FIXNUM TO-OFFSET NCOLS FROM-OFFSET)
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 32) (*)) TO))
    (LOOP FOR I FIXNUM BELOW NCOLS
          DO (SETF (AREF TO TO-OFFSET)
                     (#S(FORMGREP:SYMREF
                         :NAME "MEMREF-UNSIGNED-BYTE-32"
                         :QUALIFIER "MEZZANO.INTERNALS")
                      FROM-ADDRESS FROM-OFFSET)) (INCF TO-OFFSET) (INCF
                                                                   FROM-OFFSET)))

[Mezzano/net/ip.lisp:165]
  (DEFUN COMPUTE-IP-PARTIAL-CHECKSUM
         (BUFFER &OPTIONAL (START 0) END (INITIAL 0))
    (CHECK-TYPE BUFFER (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)))
    (CHECK-TYPE INITIAL (UNSIGNED-BYTE 32))
    (CHECK-TYPE START FIXNUM)
    (CHECK-TYPE END (OR NULL FIXNUM))
    (LET ((TOTAL INITIAL))
      (DECLARE (TYPE (UNSIGNED-BYTE 32) TOTAL)
               (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) BUFFER)
               (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
      (LET ((TRUE-END (OR END (LENGTH BUFFER))))
        (DECLARE (TYPE FIXNUM START TRUE-END))
        (WHEN (ODDP (THE FIXNUM (- TRUE-END START)))
          (DECF TRUE-END)
          (INCF TOTAL
                (THE (UNSIGNED-BYTE 16)
                     (ASH (THE (UNSIGNED-BYTE 8) (AREF BUFFER TRUE-END)) 8))))
        (DO ((I START (+ I 2)))
            ((>= I TRUE-END))
          (DECLARE (TYPE FIXNUM I))
          (INCF TOTAL
                (#S(FORMGREP:SYMREF
                    :NAME "UB16REF/BE"
                    :QUALIFIER "MEZZANO.EXTENSIONS")
                 BUFFER I))))
      TOTAL))

[Mezzano/net/ip.lisp:189]
  (DEFUN FINALIZE-IP-CHECKSUM (CHECKSUM)
    (CHECK-TYPE CHECKSUM (UNSIGNED-BYTE 32))
    (LET ((TOTAL CHECKSUM))
      (DECLARE (TYPE (UNSIGNED-BYTE 32) TOTAL)
               (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
      (DO ()
          ((NOT (LOGTEST TOTAL 4294901760)))
        (SETF TOTAL
                (+ (THE (UNSIGNED-BYTE 16) (LOGAND TOTAL 65535))
                   (THE (UNSIGNED-BYTE 16) (ASH TOTAL -16)))))
      (LOGAND (THE (SIGNED-BYTE 32) (LOGNOT TOTAL)) 65535)))

[Mezzano/runtime/numbers.lisp:832]
  (DEFUN %FIXNUM-INTEGER-LENGTH (INTEGER)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0))
             (TYPE FIXNUM INTEGER))
    (DO ((LEN 0 (1+ LEN)))
        ((OR (EQ INTEGER 0) (EQ INTEGER -1)) LEN)
      (DECLARE (TYPE FIXNUM LEN))
      (SETF INTEGER (ASH INTEGER -1))))

[Mezzano/runtime/simd.lisp:26]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
     MAKE-MMX-VECTOR ((VALUE (UNSIGNED-BYTE 64)))
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE MMX-VECTOR
           (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C") %MAKE-MMX-VECTOR
            (ECLECTOR.READER:UNQUOTE VALUE)))))
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
     MAKE-MMX-VECTOR ((VALUE (AND FIXNUM (INTEGER 0))))
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE MMX-VECTOR
           (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
            %MAKE-MMX-VECTOR/FIXNUM (ECLECTOR.READER:UNQUOTE VALUE)))))
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     'MAKE-MMX-VECTOR)
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     '%MAKE-MMX-VECTOR)
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     '%MAKE-MMX-VECTOR/FIXNUM))

[Mezzano/runtime/simd.lisp:77]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
     MMX-VECTOR-VALUE ((VALUE MMX-VECTOR))
     ((:RESULT-TYPE (UNSIGNED-BYTE 64)) (:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE (UNSIGNED-BYTE 64)
           (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C") %MMX-VECTOR-VALUE
            (ECLECTOR.READER:UNQUOTE VALUE)))))
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
     MMX-VECTOR-VALUE ((VALUE MMX-VECTOR))
     ((:RESULT-TYPE FIXNUM) (:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE (AND FIXNUM (INTEGER 0))
           (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
            %MMX-VECTOR-VALUE/FIXNUM (ECLECTOR.READER:UNQUOTE VALUE)))))
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     'MMX-VECTOR-VALUE)
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     '%MMX-VECTOR-VALUE)
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     '%MMX-VECTOR-VALUE/FIXNUM))

[Mezzano/runtime/simd.lisp:117]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (EXPORT 'PSHUFW)
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C") PSHUFW
     ((A MMX-VECTOR) (B MMX-VECTOR) (CONTROL (UNSIGNED-BYTE 8)))
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE MMX-VECTOR
           (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C") %PSHUFW/MMX
            (ECLECTOR.READER:UNQUOTE A) (ECLECTOR.READER:UNQUOTE B)
            (ECLECTOR.READER:UNQUOTE CONTROL)))))
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     'PSHUFW)
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     '%PSHUFW/MMX))

[Mezzano/runtime/simd.lisp:155]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
     MAKE-SSE-VECTOR ((VALUE (UNSIGNED-BYTE 128)))
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE SSE-VECTOR
           (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C") %MAKE-SSE-VECTOR
            (ECLECTOR.READER:UNQUOTE VALUE)))))
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
     MAKE-SSE-VECTOR ((VALUE (UNSIGNED-BYTE 64)))
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE SSE-VECTOR
           (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
            %MAKE-SSE-VECTOR/UB64 (ECLECTOR.READER:UNQUOTE VALUE)))))
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
     MAKE-SSE-VECTOR ((VALUE (AND FIXNUM (INTEGER 0))))
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE SSE-VECTOR
           (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
            %MAKE-SSE-VECTOR/FIXNUM (ECLECTOR.READER:UNQUOTE VALUE)))))
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     'MAKE-SSE-VECTOR)
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     '%MAKE-SSE-VECTOR)
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     '%MAKE-SSE-VECTOR/UB64)
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     '%MAKE-SSE-VECTOR/FIXNUM))

[Mezzano/runtime/simd.lisp:215]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
     SSE-VECTOR-VALUE ((VALUE SSE-VECTOR))
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C") %SSE-VECTOR-VALUE
       (ECLECTOR.READER:UNQUOTE VALUE))))
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
     %SSE-VECTOR-VALUE ((VALUE SSE-VECTOR))
     ((:RESULT-TYPE (UNSIGNED-BYTE 64)) (:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C") %SSE-VECTOR-VALUE/UB64
       (ECLECTOR.READER:UNQUOTE VALUE))))
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
     %SSE-VECTOR-VALUE ((VALUE SSE-VECTOR))
     ((:RESULT-TYPE FIXNUM) (:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE (AND FIXNUM (INTEGER 0))
           (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
            %SSE-VECTOR-VALUE/FIXNUM (ECLECTOR.READER:UNQUOTE VALUE)))))
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     'SSE-VECTOR-VALUE)
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     '%SSE-VECTOR-VALUE)
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     '%SSE-VECTOR-VALUE/UB64)
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     '%SSE-VECTOR-VALUE/FIXNUM))

[Mezzano/runtime/simd.lisp:280]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (MACROLET ((DEF (WIDTH SIGNEDP)
                 (ECLECTOR.READER:QUASIQUOTE
                  (PROGN
                   (ECLECTOR.READER:UNQUOTE-SPLICING
                    (LOOP FOR N-LANES = 1 THEN (+ N-LANES N-LANES)
                          FOR ACCESS-WIDTH = (* N-LANES WIDTH)
                          REPEAT 128
                          WHEN (<= 8 ACCESS-WIDTH 128)
                          COLLECT (ECLECTOR.READER:QUASIQUOTE
                                   (DEF* (ECLECTOR.READER:UNQUOTE WIDTH)
                                    (ECLECTOR.READER:UNQUOTE SIGNEDP)
                                    (ECLECTOR.READER:UNQUOTE N-LANES)
                                    (ECLECTOR.READER:UNQUOTE
                                     ACCESS-WIDTH))))))))
               (DEF* (WIDTH SIGNEDP N-LANES ACCESS-WIDTH)
                 (LET ((TYPE
                        (ECLECTOR.READER:QUASIQUOTE
                         (SIMPLE-ARRAY
                          ((ECLECTOR.READER:UNQUOTE
                            (IF SIGNEDP
                                'SIGNED-BYTE
                                'UNSIGNED-BYTE))
                           (ECLECTOR.READER:UNQUOTE WIDTH))
                          (*))))
                       (ACCESS-FN
                        (ECASE ACCESS-WIDTH
                          (8 '%%OBJECT-REF-SSE-VECTOR/8-UNSCALED)
                          (16 '%%OBJECT-REF-SSE-VECTOR/16-UNSCALED)
                          (32 '%%OBJECT-REF-SSE-VECTOR/32-UNSCALED)
                          (64 '%%OBJECT-REF-SSE-VECTOR/64-UNSCALED)
                          (128 '%%OBJECT-REF-SSE-VECTOR/128-UNSCALED))))
                   (ECLECTOR.READER:QUASIQUOTE
                    (PROGN
                     (#S(FORMGREP:SYMREF
                         :NAME "DEFINE-TRANSFORM"
                         :QUALIFIER "C")
                      SSE-VECTOR-REF
                      ((VECTOR (ECLECTOR.READER:UNQUOTE TYPE) ARRAY-TYPE)
                       (N-LANES (EQL (ECLECTOR.READER:UNQUOTE N-LANES)))
                       (INDEX FIXNUM INDEX-TYPE))
                      ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
                      (ECLECTOR.READER:QUASIQUOTE
                       (THE SSE-VECTOR
                            (PROGN
                             (ECLECTOR.READER:UNQUOTE
                              (#S(FORMGREP:SYMREF
                                  :NAME "INSERT-BOUNDS-CHECK"
                                  :QUALIFIER "C")
                               VECTOR ARRAY-TYPE INDEX INDEX-TYPE :ADJUST
                               (1- (ECLECTOR.READER:UNQUOTE N-LANES))))
                             (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
                              (ECLECTOR.READER:UNQUOTE
                               '(ECLECTOR.READER:UNQUOTE ACCESS-FN))
                              (ECLECTOR.READER:UNQUOTE VECTOR)
                              (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
                               #S(FORMGREP:SYMREF
                                  :NAME "%FAST-FIXNUM-*"
                                  :QUALIFIER "C")
                               (ECLECTOR.READER:UNQUOTE INDEX)
                               '(ECLECTOR.READER:UNQUOTE
                                 '(ECLECTOR.READER:UNQUOTE (/ WIDTH 8)))))))))
                     (#S(FORMGREP:SYMREF
                         :NAME "DEFINE-TRANSFORM"
                         :QUALIFIER "C")
                      (SETF SSE-VECTOR-REF)
                      ((SSE-VECTOR SSE-VECTOR)
                       (VECTOR (ECLECTOR.READER:UNQUOTE TYPE) ARRAY-TYPE)
                       (N-LANES (EQL (ECLECTOR.READER:UNQUOTE N-LANES)))
                       (INDEX FIXNUM INDEX-TYPE))
                      ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
                      (ECLECTOR.READER:QUASIQUOTE
                       (THE SSE-VECTOR
                            (PROGN
                             (ECLECTOR.READER:UNQUOTE
                              (#S(FORMGREP:SYMREF
                                  :NAME "INSERT-BOUNDS-CHECK"
                                  :QUALIFIER "C")
                               VECTOR ARRAY-TYPE INDEX INDEX-TYPE :ADJUST
                               (1- (ECLECTOR.READER:UNQUOTE N-LANES))))
                             (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
                              (ECLECTOR.READER:UNQUOTE
                               '(ECLECTOR.READER:UNQUOTE ACCESS-FN))
                              (ECLECTOR.READER:UNQUOTE SSE-VECTOR)
                              (ECLECTOR.READER:UNQUOTE VECTOR)
                              (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
                               #S(FORMGREP:SYMREF
                                  :NAME "%FAST-FIXNUM-*"
                                  :QUALIFIER "C")
                               (ECLECTOR.READER:UNQUOTE INDEX)
                               '(ECLECTOR.READER:UNQUOTE
                                 '(ECLECTOR.READER:UNQUOTE
                                   (/ WIDTH 8))))))))))))))
      (DEF 8 NIL)
      (DEF 16 NIL)
      (DEF 32 NIL)
      (DEF 64 NIL)
      (DEF 8 T)
      (DEF 16 T)
      (DEF 32 T)
      (DEF 64 T)))

[Mezzano/runtime/simd.lisp:340]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
     %MAKE-SSE-VECTOR-SINGLE-FLOAT
     ((A SINGLE-FLOAT) (B SINGLE-FLOAT) (C SINGLE-FLOAT) (D SINGLE-FLOAT))
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE SSE-VECTOR
           (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C") %UNPCKLPS/SSE
            (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C") %UNPCKLPS/SSE
             (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
              %SINGLE-FLOAT-TO-SSE-VECTOR (ECLECTOR.READER:UNQUOTE A))
             (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
              %SINGLE-FLOAT-TO-SSE-VECTOR (ECLECTOR.READER:UNQUOTE C)))
            (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C") %UNPCKLPS/SSE
             (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
              %SINGLE-FLOAT-TO-SSE-VECTOR (ECLECTOR.READER:UNQUOTE B))
             (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
              %SINGLE-FLOAT-TO-SSE-VECTOR (ECLECTOR.READER:UNQUOTE D)))))))
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
     %MAKE-SSE-VECTOR-SINGLE-FLOAT
     ((A SINGLE-FLOAT) (B SINGLE-FLOAT) (C (EQL 0.0)) (D (EQL 0.0)))
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE SSE-VECTOR
           (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C") %MOVLHPS/SSE
            (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C") %UNPCKLPS/SSE
             (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
              %SINGLE-FLOAT-TO-SSE-VECTOR (ECLECTOR.READER:UNQUOTE A))
             (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
              %SINGLE-FLOAT-TO-SSE-VECTOR (ECLECTOR.READER:UNQUOTE B)))
            (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
             %MAKE-SSE-VECTOR/FIXNUM '0)))))
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
     %MAKE-SSE-VECTOR-SINGLE-FLOAT
     ((A SINGLE-FLOAT) (B (EQL 0.0)) (C (EQL 0.0)) (D (EQL 0.0)))
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE SSE-VECTOR
           (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C") %MOVSS/SSE
            (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
             %MAKE-SSE-VECTOR/FIXNUM '0)
            (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
             %SINGLE-FLOAT-TO-SSE-VECTOR (ECLECTOR.READER:UNQUOTE A)))))))

[Mezzano/runtime/simd.lisp:373]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
     SSE-VECTOR-SINGLE-FLOAT-ELEMENT ((VECTOR SSE-VECTOR) INDEX)
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
       %SSE-VECTOR-SINGLE-FLOAT-ELEMENT (ECLECTOR.READER:UNQUOTE VECTOR)
       (ECLECTOR.READER:UNQUOTE INDEX)))))

[Mezzano/runtime/simd.lisp:416]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
     SSE-VECTOR-SINGLE-FLOAT-1-REF
     ((VECTOR (SIMPLE-ARRAY SINGLE-FLOAT (*)) ARRAY-TYPE)
      (INDEX FIXNUM INDEX-TYPE))
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE SSE-VECTOR
           (PROGN
            (ECLECTOR.READER:UNQUOTE
             (#S(FORMGREP:SYMREF :NAME "INSERT-BOUNDS-CHECK" :QUALIFIER "C")
              VECTOR ARRAY-TYPE INDEX INDEX-TYPE))
            (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
             %%OBJECT-REF-SSE-VECTOR/32-UNSCALED
             (ECLECTOR.READER:UNQUOTE VECTOR)
             (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
              #S(FORMGREP:SYMREF :NAME "%FAST-FIXNUM-*" :QUALIFIER "C")
              (ECLECTOR.READER:UNQUOTE INDEX) '4))))))
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
     (SETF SSE-VECTOR-SINGLE-FLOAT-1-REF)
     ((SSE-VECTOR SSE-VECTOR)
      (VECTOR (SIMPLE-ARRAY SINGLE-FLOAT (*)) ARRAY-TYPE)
      (INDEX FIXNUM INDEX-TYPE))
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE SSE-VECTOR
           (PROGN
            (ECLECTOR.READER:UNQUOTE
             (#S(FORMGREP:SYMREF :NAME "INSERT-BOUNDS-CHECK" :QUALIFIER "C")
              VECTOR ARRAY-TYPE INDEX INDEX-TYPE))
            (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
             (SETF %%OBJECT-REF-SSE-VECTOR/32-UNSCALED)
             (ECLECTOR.READER:UNQUOTE SSE-VECTOR)
             (ECLECTOR.READER:UNQUOTE VECTOR)
             (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
              #S(FORMGREP:SYMREF :NAME "%FAST-FIXNUM-*" :QUALIFIER "C")
              (ECLECTOR.READER:UNQUOTE INDEX) '4)))))))

[Mezzano/runtime/simd.lisp:442]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
     SSE-VECTOR-SINGLE-FLOAT-2-REF
     ((VECTOR (SIMPLE-ARRAY SINGLE-FLOAT (*)) ARRAY-TYPE)
      (INDEX FIXNUM INDEX-TYPE))
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE SSE-VECTOR
           (PROGN
            (ECLECTOR.READER:UNQUOTE
             (#S(FORMGREP:SYMREF :NAME "INSERT-BOUNDS-CHECK" :QUALIFIER "C")
              VECTOR ARRAY-TYPE INDEX INDEX-TYPE :ADJUST 1))
            (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
             %%OBJECT-REF-SSE-VECTOR/64-UNSCALED
             (ECLECTOR.READER:UNQUOTE VECTOR)
             (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
              #S(FORMGREP:SYMREF :NAME "%FAST-FIXNUM-*" :QUALIFIER "C")
              (ECLECTOR.READER:UNQUOTE INDEX) '4))))))
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
     (SETF SSE-VECTOR-SINGLE-FLOAT-2-REF)
     ((SSE-VECTOR SSE-VECTOR)
      (VECTOR (SIMPLE-ARRAY SINGLE-FLOAT (*)) ARRAY-TYPE)
      (INDEX FIXNUM INDEX-TYPE))
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE SSE-VECTOR
           (PROGN
            (ECLECTOR.READER:UNQUOTE
             (#S(FORMGREP:SYMREF :NAME "INSERT-BOUNDS-CHECK" :QUALIFIER "C")
              VECTOR ARRAY-TYPE INDEX INDEX-TYPE :ADJUST 1))
            (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
             (SETF %%OBJECT-REF-SSE-VECTOR/64-UNSCALED)
             (ECLECTOR.READER:UNQUOTE SSE-VECTOR)
             (ECLECTOR.READER:UNQUOTE VECTOR)
             (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
              #S(FORMGREP:SYMREF :NAME "%FAST-FIXNUM-*" :QUALIFIER "C")
              (ECLECTOR.READER:UNQUOTE INDEX) '4)))))))

[Mezzano/runtime/simd.lisp:472]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
     SSE-VECTOR-SINGLE-FLOAT-4-REF
     ((VECTOR (SIMPLE-ARRAY SINGLE-FLOAT (*)) ARRAY-TYPE)
      (INDEX FIXNUM INDEX-TYPE))
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE SSE-VECTOR
           (PROGN
            (ECLECTOR.READER:UNQUOTE
             (#S(FORMGREP:SYMREF :NAME "INSERT-BOUNDS-CHECK" :QUALIFIER "C")
              VECTOR ARRAY-TYPE INDEX INDEX-TYPE :ADJUST 3))
            (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
             %%OBJECT-REF-SSE-VECTOR/128-UNSCALED
             (ECLECTOR.READER:UNQUOTE VECTOR)
             (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
              #S(FORMGREP:SYMREF :NAME "%FAST-FIXNUM-*" :QUALIFIER "C")
              (ECLECTOR.READER:UNQUOTE INDEX) '4))))))
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
     (SETF SSE-VECTOR-SINGLE-FLOAT-4-REF)
     ((SSE-VECTOR SSE-VECTOR)
      (VECTOR (SIMPLE-ARRAY SINGLE-FLOAT (*)) ARRAY-TYPE)
      (INDEX FIXNUM INDEX-TYPE))
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE SSE-VECTOR
           (PROGN
            (ECLECTOR.READER:UNQUOTE
             (#S(FORMGREP:SYMREF :NAME "INSERT-BOUNDS-CHECK" :QUALIFIER "C")
              VECTOR ARRAY-TYPE INDEX INDEX-TYPE :ADJUST 3))
            (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
             (SETF %%OBJECT-REF-SSE-VECTOR/128-UNSCALED)
             (ECLECTOR.READER:UNQUOTE SSE-VECTOR)
             (ECLECTOR.READER:UNQUOTE VECTOR)
             (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
              #S(FORMGREP:SYMREF :NAME "%FAST-FIXNUM-*" :QUALIFIER "C")
              (ECLECTOR.READER:UNQUOTE INDEX) '4)))))))

[Mezzano/runtime/simd.lisp:496]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
     SSE-VECTOR-SHORT-FLOAT-1-REF
     ((VECTOR (SIMPLE-ARRAY SHORT-FLOAT (*))) INDEX)
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE SSE-VECTOR
           (PROGN
            (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
             #S(FORMGREP:SYMREF :NAME "%BOUNDS-CHECK" :QUALIFIER "SYS.INT")
             (ECLECTOR.READER:UNQUOTE VECTOR) (ECLECTOR.READER:UNQUOTE INDEX))
            (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C") %MAKE-SSE-VECTOR
             (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
              #S(FORMGREP:SYMREF
                 :NAME "%%OBJECT-REF-UNSIGNED-BYTE-16-UNSCALED"
                 :QUALIFIER "SYS.INT")
              (ECLECTOR.READER:UNQUOTE VECTOR)
              (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
               #S(FORMGREP:SYMREF :NAME "%FAST-FIXNUM-*" :QUALIFIER "C")
               (ECLECTOR.READER:UNQUOTE INDEX) '2)))))))
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
     (SETF SSE-VECTOR-SHORT-FLOAT-1-REF)
     ((SSE-VECTOR SSE-VECTOR) (VECTOR (SIMPLE-ARRAY SHORT-FLOAT (*))) INDEX)
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE SSE-VECTOR
           (PROGN
            (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
             #S(FORMGREP:SYMREF :NAME "%BOUNDS-CHECK" :QUALIFIER "SYS.INT")
             (ECLECTOR.READER:UNQUOTE VECTOR) (ECLECTOR.READER:UNQUOTE INDEX))
            (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
             (SETF #S(FORMGREP:SYMREF
                      :NAME "%%OBJECT-REF-UNSIGNED-BYTE-16-UNSCALED"
                      :QUALIFIER "SYS.INT"))
             (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
              #S(FORMGREP:SYMREF :NAME "%FAST-FIXNUM-LOGAND" :QUALIFIER "C")
              (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
               %SSE-VECTOR-VALUE/FIXNUM (ECLECTOR.READER:UNQUOTE SSE-VECTOR))
              '65535)
             (ECLECTOR.READER:UNQUOTE VECTOR)
             (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
              #S(FORMGREP:SYMREF :NAME "%FAST-FIXNUM-*" :QUALIFIER "C")
              (ECLECTOR.READER:UNQUOTE INDEX) '2)))))))

[Mezzano/runtime/simd.lisp:527]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
     SSE-VECTOR-SHORT-FLOAT-2-REF
     ((VECTOR (SIMPLE-ARRAY SHORT-FLOAT (*))) INDEX)
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE SSE-VECTOR
           (PROGN
            (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
             #S(FORMGREP:SYMREF :NAME "%BOUNDS-CHECK" :QUALIFIER "SYS.INT")
             (ECLECTOR.READER:UNQUOTE VECTOR)
             (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
              #S(FORMGREP:SYMREF :NAME "%FAST-FIXNUM-+" :QUALIFIER "C")
              (ECLECTOR.READER:UNQUOTE INDEX) '1))
            (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
             %%OBJECT-REF-SSE-VECTOR/32-UNSCALED
             (ECLECTOR.READER:UNQUOTE VECTOR)
             (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
              #S(FORMGREP:SYMREF :NAME "%FAST-FIXNUM-*" :QUALIFIER "C")
              (ECLECTOR.READER:UNQUOTE INDEX) '2))))))
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
     (SETF SSE-VECTOR-SHORT-FLOAT-2-REF)
     ((SSE-VECTOR SSE-VECTOR) (VECTOR (SIMPLE-ARRAY SHORT-FLOAT (*))) INDEX)
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE SSE-VECTOR
           (PROGN
            (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
             #S(FORMGREP:SYMREF :NAME "%BOUNDS-CHECK" :QUALIFIER "SYS.INT")
             (ECLECTOR.READER:UNQUOTE VECTOR)
             (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
              #S(FORMGREP:SYMREF :NAME "%FAST-FIXNUM-+" :QUALIFIER "C")
              (ECLECTOR.READER:UNQUOTE INDEX) '1))
            (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
             (SETF %%OBJECT-REF-SSE-VECTOR/32-UNSCALED)
             (ECLECTOR.READER:UNQUOTE SSE-VECTOR)
             (ECLECTOR.READER:UNQUOTE VECTOR)
             (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
              #S(FORMGREP:SYMREF :NAME "%FAST-FIXNUM-*" :QUALIFIER "C")
              (ECLECTOR.READER:UNQUOTE INDEX) '2)))))))

[Mezzano/runtime/simd.lisp:557]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
     SSE-VECTOR-SHORT-FLOAT-4-REF
     ((VECTOR (SIMPLE-ARRAY SHORT-FLOAT (*))) INDEX)
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE SSE-VECTOR
           (PROGN
            (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
             #S(FORMGREP:SYMREF :NAME "%BOUNDS-CHECK" :QUALIFIER "SYS.INT")
             (ECLECTOR.READER:UNQUOTE VECTOR)
             (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
              #S(FORMGREP:SYMREF :NAME "%FAST-FIXNUM-+" :QUALIFIER "C")
              (ECLECTOR.READER:UNQUOTE INDEX) '3))
            (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
             %%OBJECT-REF-SSE-VECTOR/64-UNSCALED
             (ECLECTOR.READER:UNQUOTE VECTOR)
             (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
              #S(FORMGREP:SYMREF :NAME "%FAST-FIXNUM-*" :QUALIFIER "C")
              (ECLECTOR.READER:UNQUOTE INDEX) '2))))))
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
     (SETF SSE-VECTOR-SHORT-FLOAT-4-REF)
     ((SSE-VECTOR SSE-VECTOR) (VECTOR (SIMPLE-ARRAY SHORT-FLOAT (*))) INDEX)
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE SSE-VECTOR
           (PROGN
            (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
             #S(FORMGREP:SYMREF :NAME "%BOUNDS-CHECK" :QUALIFIER "SYS.INT")
             (ECLECTOR.READER:UNQUOTE VECTOR)
             (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
              #S(FORMGREP:SYMREF :NAME "%FAST-FIXNUM-+" :QUALIFIER "C")
              (ECLECTOR.READER:UNQUOTE INDEX) '3))
            (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
             (SETF %%OBJECT-REF-SSE-VECTOR/64-UNSCALED)
             (ECLECTOR.READER:UNQUOTE SSE-VECTOR)
             (ECLECTOR.READER:UNQUOTE VECTOR)
             (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
              #S(FORMGREP:SYMREF :NAME "%FAST-FIXNUM-*" :QUALIFIER "C")
              (ECLECTOR.READER:UNQUOTE INDEX) '2)))))))

[Mezzano/runtime/simd.lisp:595]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
     SSE-VECTOR-SHORT-FLOAT-8-REF
     ((VECTOR (SIMPLE-ARRAY SHORT-FLOAT (*))) INDEX)
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE SSE-VECTOR
           (PROGN
            (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
             #S(FORMGREP:SYMREF :NAME "%BOUNDS-CHECK" :QUALIFIER "SYS.INT")
             (ECLECTOR.READER:UNQUOTE VECTOR)
             (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
              #S(FORMGREP:SYMREF :NAME "%FAST-FIXNUM-+" :QUALIFIER "C")
              (ECLECTOR.READER:UNQUOTE INDEX) '7))
            (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
             %%OBJECT-REF-SSE-VECTOR/128-UNSCALED
             (ECLECTOR.READER:UNQUOTE VECTOR)
             (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
              #S(FORMGREP:SYMREF :NAME "%FAST-FIXNUM-*" :QUALIFIER "C")
              (ECLECTOR.READER:UNQUOTE INDEX) '2))))))
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
     (SETF SSE-VECTOR-SHORT-FLOAT-8-REF)
     ((SSE-VECTOR SSE-VECTOR) (VECTOR (SIMPLE-ARRAY SHORT-FLOAT (*))) INDEX)
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE SSE-VECTOR
           (PROGN
            (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
             #S(FORMGREP:SYMREF :NAME "%BOUNDS-CHECK" :QUALIFIER "SYS.INT")
             (ECLECTOR.READER:UNQUOTE VECTOR)
             (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
              #S(FORMGREP:SYMREF :NAME "%FAST-FIXNUM-+" :QUALIFIER "C")
              (ECLECTOR.READER:UNQUOTE INDEX) '7))
            (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
             (SETF %%OBJECT-REF-SSE-VECTOR/128-UNSCALED)
             (ECLECTOR.READER:UNQUOTE SSE-VECTOR)
             (ECLECTOR.READER:UNQUOTE VECTOR)
             (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
              #S(FORMGREP:SYMREF :NAME "%FAST-FIXNUM-*" :QUALIFIER "C")
              (ECLECTOR.READER:UNQUOTE INDEX) '2)))))))

[Mezzano/runtime/simd.lisp:625]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
     %MAKE-SSE-VECTOR-DOUBLE-FLOAT ((A DOUBLE-FLOAT) (B DOUBLE-FLOAT))
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE SSE-VECTOR
           (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C") %UNPCKLPD/SSE
            (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
             %DOUBLE-FLOAT-TO-SSE-VECTOR (ECLECTOR.READER:UNQUOTE A))
            (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
             %DOUBLE-FLOAT-TO-SSE-VECTOR (ECLECTOR.READER:UNQUOTE B))))))
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
     %MAKE-SSE-VECTOR-DOUBLE-FLOAT ((A DOUBLE-FLOAT) (B (EQL 0.0d0)))
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE SSE-VECTOR
           (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C") %MOVSD/SSE
            (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
             %MAKE-SSE-VECTOR/FIXNUM '0)
            (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
             %DOUBLE-FLOAT-TO-SSE-VECTOR (ECLECTOR.READER:UNQUOTE A)))))))

[Mezzano/runtime/simd.lisp:645]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
     SSE-VECTOR-DOUBLE-FLOAT-ELEMENT ((VECTOR SSE-VECTOR) INDEX)
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
       %SSE-VECTOR-DOUBLE-FLOAT-ELEMENT (ECLECTOR.READER:UNQUOTE VECTOR)
       (ECLECTOR.READER:UNQUOTE INDEX)))))

[Mezzano/runtime/simd.lisp:684]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
     SSE-VECTOR-DOUBLE-FLOAT-1-REF
     ((VECTOR (SIMPLE-ARRAY DOUBLE-FLOAT (*)) ARRAY-TYPE)
      (INDEX FIXNUM INDEX-TYPE))
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE SSE-VECTOR
           (PROGN
            (ECLECTOR.READER:UNQUOTE
             (#S(FORMGREP:SYMREF :NAME "INSERT-BOUNDS-CHECK" :QUALIFIER "C")
              VECTOR ARRAY-TYPE INDEX INDEX-TYPE))
            (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
             %%OBJECT-REF-SSE-VECTOR/64-UNSCALED
             (ECLECTOR.READER:UNQUOTE VECTOR)
             (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
              #S(FORMGREP:SYMREF :NAME "%FAST-FIXNUM-*" :QUALIFIER "C")
              (ECLECTOR.READER:UNQUOTE INDEX) '8))))))
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
     (SETF SSE-VECTOR-DOUBLE-FLOAT-1-REF)
     ((SSE-VECTOR SSE-VECTOR)
      (VECTOR (SIMPLE-ARRAY DOUBLE-FLOAT (*)) ARRAY-TYPE)
      (INDEX FIXNUM INDEX-TYPE))
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE SSE-VECTOR
           (PROGN
            (ECLECTOR.READER:UNQUOTE
             (#S(FORMGREP:SYMREF :NAME "INSERT-BOUNDS-CHECK" :QUALIFIER "C")
              VECTOR ARRAY-TYPE INDEX INDEX-TYPE))
            (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
             (SETF %%OBJECT-REF-SSE-VECTOR/64-UNSCALED)
             (ECLECTOR.READER:UNQUOTE SSE-VECTOR)
             (ECLECTOR.READER:UNQUOTE VECTOR)
             (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
              #S(FORMGREP:SYMREF :NAME "%FAST-FIXNUM-*" :QUALIFIER "C")
              (ECLECTOR.READER:UNQUOTE INDEX) '8)))))))

[Mezzano/runtime/simd.lisp:710]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
     SSE-VECTOR-DOUBLE-FLOAT-2-REF
     ((VECTOR (SIMPLE-ARRAY DOUBLE-FLOAT (*)) ARRAY-TYPE)
      (INDEX FIXNUM INDEX-TYPE))
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE SSE-VECTOR
           (PROGN
            (ECLECTOR.READER:UNQUOTE
             (#S(FORMGREP:SYMREF :NAME "INSERT-BOUNDS-CHECK" :QUALIFIER "C")
              VECTOR ARRAY-TYPE INDEX INDEX-TYPE :ADJUST 1))
            (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
             %%OBJECT-REF-SSE-VECTOR/128-UNSCALED
             (ECLECTOR.READER:UNQUOTE VECTOR)
             (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
              #S(FORMGREP:SYMREF :NAME "%FAST-FIXNUM-*" :QUALIFIER "C")
              (ECLECTOR.READER:UNQUOTE INDEX) '8))))))
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
     (SETF SSE-VECTOR-DOUBLE-FLOAT-2-REF)
     ((SSE-VECTOR SSE-VECTOR)
      (VECTOR (SIMPLE-ARRAY DOUBLE-FLOAT (*)) ARRAY-TYPE)
      (INDEX FIXNUM INDEX-TYPE))
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE SSE-VECTOR
           (PROGN
            (ECLECTOR.READER:UNQUOTE
             (#S(FORMGREP:SYMREF :NAME "INSERT-BOUNDS-CHECK" :QUALIFIER "C")
              VECTOR ARRAY-TYPE INDEX INDEX-TYPE :ADJUST 1))
            (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
             (SETF %%OBJECT-REF-SSE-VECTOR/128-UNSCALED)
             (ECLECTOR.READER:UNQUOTE SSE-VECTOR)
             (ECLECTOR.READER:UNQUOTE VECTOR)
             (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
              #S(FORMGREP:SYMREF :NAME "%FAST-FIXNUM-*" :QUALIFIER "C")
              (ECLECTOR.READER:UNQUOTE INDEX) '8)))))))

[Mezzano/runtime/simd.lisp:813]
  (DEFMACRO DEFINE-SIMD-INTEGER-OP (NAME MMX-FUNCTION SSE-FUNCTION)
    (ECLECTOR.READER:QUASIQUOTE
     (PROGN
      (DEFUN (ECLECTOR.READER:UNQUOTE NAME) (LHS RHS)
        (ETYPECASE LHS
          (MMX-VECTOR
           (CHECK-TYPE RHS MMX-VECTOR)
           ((ECLECTOR.READER:UNQUOTE MMX-FUNCTION) LHS RHS))
          (SSE-VECTOR
           (CHECK-TYPE RHS SSE-VECTOR)
           ((ECLECTOR.READER:UNQUOTE SSE-FUNCTION) LHS RHS))))
      (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
        (EXPORT '(ECLECTOR.READER:UNQUOTE NAME) :MEZZANO.SIMD)
        (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
         (ECLECTOR.READER:UNQUOTE NAME) ((LHS MMX-VECTOR) (RHS MMX-VECTOR))
         ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
         (ECLECTOR.READER:QUASIQUOTE
          (THE MMX-VECTOR
               (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
                (ECLECTOR.READER:UNQUOTE
                 '(ECLECTOR.READER:UNQUOTE MMX-FUNCTION))
                (ECLECTOR.READER:UNQUOTE LHS) (ECLECTOR.READER:UNQUOTE RHS)))))
        (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
         (ECLECTOR.READER:UNQUOTE NAME) ((LHS SSE-VECTOR) (RHS SSE-VECTOR))
         ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
         (ECLECTOR.READER:QUASIQUOTE
          (THE SSE-VECTOR
               (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
                (ECLECTOR.READER:UNQUOTE
                 '(ECLECTOR.READER:UNQUOTE SSE-FUNCTION))
                (ECLECTOR.READER:UNQUOTE LHS) (ECLECTOR.READER:UNQUOTE RHS)))))
        (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
         '(ECLECTOR.READER:UNQUOTE NAME))
        (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
         '(ECLECTOR.READER:UNQUOTE MMX-FUNCTION))
        (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
         '(ECLECTOR.READER:UNQUOTE SSE-FUNCTION)))
      '(ECLECTOR.READER:UNQUOTE NAME))))

[Mezzano/runtime/simd.lisp:836]
  (DEFMACRO DEFINE-SIMD-SHIFT-OP (NAME MMX-FUNCTION SSE-FUNCTION)
    (ECLECTOR.READER:QUASIQUOTE
     (PROGN
      (DEFUN (ECLECTOR.READER:UNQUOTE NAME) (LHS RHS)
        (IF (TYPEP RHS '(UNSIGNED-BYTE 8))
            (ETYPECASE LHS
              (MMX-VECTOR
               ((ECLECTOR.READER:UNQUOTE MMX-FUNCTION) LHS
                (MAKE-MMX-VECTOR RHS)))
              (SSE-VECTOR
               ((ECLECTOR.READER:UNQUOTE SSE-FUNCTION) LHS
                (MAKE-SSE-VECTOR RHS))))
            (ETYPECASE LHS
              (MMX-VECTOR
               (CHECK-TYPE RHS (OR MMX-VECTOR (UNSIGNED-BYTE 8)))
               ((ECLECTOR.READER:UNQUOTE MMX-FUNCTION) LHS RHS))
              (SSE-VECTOR
               (CHECK-TYPE RHS (OR SSE-VECTOR (UNSIGNED-BYTE 8)))
               ((ECLECTOR.READER:UNQUOTE SSE-FUNCTION) LHS RHS)))))
      (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
        (EXPORT '(ECLECTOR.READER:UNQUOTE NAME) :MEZZANO.SIMD)
        (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
         (ECLECTOR.READER:UNQUOTE NAME) ((LHS MMX-VECTOR) (RHS MMX-VECTOR))
         ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
         (ECLECTOR.READER:QUASIQUOTE
          (THE MMX-VECTOR
               (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
                (ECLECTOR.READER:UNQUOTE
                 '(ECLECTOR.READER:UNQUOTE MMX-FUNCTION))
                (ECLECTOR.READER:UNQUOTE LHS) (ECLECTOR.READER:UNQUOTE RHS)))))
        (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
         (ECLECTOR.READER:UNQUOTE NAME)
         ((LHS MMX-VECTOR) (RHS (UNSIGNED-BYTE 8)))
         ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
         (ECLECTOR.READER:QUASIQUOTE
          (THE MMX-VECTOR
               (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
                (ECLECTOR.READER:UNQUOTE
                 '(ECLECTOR.READER:UNQUOTE MMX-FUNCTION))
                (ECLECTOR.READER:UNQUOTE LHS) (ECLECTOR.READER:UNQUOTE RHS)))))
        (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
         (ECLECTOR.READER:UNQUOTE NAME) ((LHS SSE-VECTOR) (RHS SSE-VECTOR))
         ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
         (ECLECTOR.READER:QUASIQUOTE
          (THE SSE-VECTOR
               (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
                (ECLECTOR.READER:UNQUOTE
                 '(ECLECTOR.READER:UNQUOTE SSE-FUNCTION))
                (ECLECTOR.READER:UNQUOTE LHS) (ECLECTOR.READER:UNQUOTE RHS)))))
        (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
         (ECLECTOR.READER:UNQUOTE NAME)
         ((LHS SSE-VECTOR) (RHS (UNSIGNED-BYTE 8)))
         ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
         (ECLECTOR.READER:QUASIQUOTE
          (THE SSE-VECTOR
               (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
                (ECLECTOR.READER:UNQUOTE
                 '(ECLECTOR.READER:UNQUOTE SSE-FUNCTION))
                (ECLECTOR.READER:UNQUOTE LHS) (ECLECTOR.READER:UNQUOTE RHS)))))
        (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
         '(ECLECTOR.READER:UNQUOTE NAME))
        (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
         '(ECLECTOR.READER:UNQUOTE MMX-FUNCTION))
        (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
         '(ECLECTOR.READER:UNQUOTE SSE-FUNCTION)))
      '(ECLECTOR.READER:UNQUOTE NAME))))

[Mezzano/runtime/simd.lisp:871]
  (DEFMACRO DEFINE-SIMD-FLOAT-OP (NAME SSE-FUNCTION)
    (ECLECTOR.READER:QUASIQUOTE
     (PROGN
      (DEFUN (ECLECTOR.READER:UNQUOTE NAME) (LHS RHS)
        (ETYPECASE LHS
          (SSE-VECTOR
           (CHECK-TYPE RHS SSE-VECTOR)
           ((ECLECTOR.READER:UNQUOTE SSE-FUNCTION) LHS RHS))))
      (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
        (EXPORT '(ECLECTOR.READER:UNQUOTE NAME) :MEZZANO.SIMD)
        (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
         (ECLECTOR.READER:UNQUOTE NAME) ((LHS SSE-VECTOR) (RHS SSE-VECTOR))
         ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
         (ECLECTOR.READER:QUASIQUOTE
          (THE SSE-VECTOR
               (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
                (ECLECTOR.READER:UNQUOTE
                 '(ECLECTOR.READER:UNQUOTE SSE-FUNCTION))
                (ECLECTOR.READER:UNQUOTE LHS) (ECLECTOR.READER:UNQUOTE RHS)))))
        (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
         '(ECLECTOR.READER:UNQUOTE NAME))
        (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
         '(ECLECTOR.READER:UNQUOTE SSE-FUNCTION)))
      '(ECLECTOR.READER:UNQUOTE NAME))))

[Mezzano/runtime/simd.lisp:887]
  (DEFMACRO DEFINE-SIMD-FLOAT-OP-UNARY (NAME SSE-FUNCTION)
    (ECLECTOR.READER:QUASIQUOTE
     (PROGN
      (DEFUN (ECLECTOR.READER:UNQUOTE NAME) (VALUE)
        (ETYPECASE VALUE
          (SSE-VECTOR ((ECLECTOR.READER:UNQUOTE SSE-FUNCTION) VALUE))))
      (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
        (EXPORT '(ECLECTOR.READER:UNQUOTE NAME) :MEZZANO.SIMD)
        (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
         (ECLECTOR.READER:UNQUOTE NAME) ((VALUE SSE-VECTOR))
         ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
         (ECLECTOR.READER:QUASIQUOTE
          (THE SSE-VECTOR
               (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
                (ECLECTOR.READER:UNQUOTE
                 '(ECLECTOR.READER:UNQUOTE SSE-FUNCTION))
                (ECLECTOR.READER:UNQUOTE VALUE)))))
        (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
         '(ECLECTOR.READER:UNQUOTE NAME))
        (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
         '(ECLECTOR.READER:UNQUOTE SSE-FUNCTION)))
      '(ECLECTOR.READER:UNQUOTE NAME))))

[Mezzano/runtime/simd.lisp:902]
  (DEFMACRO DEFINE-SIMD-FLOAT-COM-OP (NAME SSE-FUNCTION)
    (ECLECTOR.READER:QUASIQUOTE
     (PROGN
      (DEFUN (ECLECTOR.READER:UNQUOTE NAME) (LHS RHS)
        (ETYPECASE LHS
          (SSE-VECTOR
           (CHECK-TYPE RHS SSE-VECTOR)
           ((ECLECTOR.READER:UNQUOTE SSE-FUNCTION) LHS RHS))))
      (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
        (EXPORT '(ECLECTOR.READER:UNQUOTE NAME) :MEZZANO.SIMD)
        (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C")
         (ECLECTOR.READER:UNQUOTE NAME) ((LHS SSE-VECTOR) (RHS SSE-VECTOR))
         ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
         (ECLECTOR.READER:QUASIQUOTE
          (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C")
           (ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE SSE-FUNCTION))
           (ECLECTOR.READER:UNQUOTE LHS) (ECLECTOR.READER:UNQUOTE RHS))))
        (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
         '(ECLECTOR.READER:UNQUOTE NAME))
        (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
         '(ECLECTOR.READER:UNQUOTE SSE-FUNCTION)))
      '(ECLECTOR.READER:UNQUOTE NAME))))

[Mezzano/runtime/simd.lisp:1114]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (EXPORT 'SHUFPS)
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C") SHUFPS
     ((A SSE-VECTOR) (B SSE-VECTOR) (CONTROL (UNSIGNED-BYTE 8)))
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE SSE-VECTOR
           (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C") %SHUFPS/SSE
            (ECLECTOR.READER:UNQUOTE A) (ECLECTOR.READER:UNQUOTE B)
            (ECLECTOR.READER:UNQUOTE CONTROL)))))
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     'SHUFPS)
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     '%SHUFPS/SSE))

[Mezzano/runtime/simd.lisp:1135]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (EXPORT 'SHUFPD)
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C") SHUFPD
     ((A SSE-VECTOR) (B SSE-VECTOR) (CONTROL (UNSIGNED-BYTE 8)))
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE SSE-VECTOR
           (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C") %SHUFPD/SSE
            (ECLECTOR.READER:UNQUOTE A) (ECLECTOR.READER:UNQUOTE B)
            (ECLECTOR.READER:UNQUOTE CONTROL))))
     (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
      'SHUFPD))
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     'SHUFPD)
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     '%SHUFPD/SSE))

[Mezzano/runtime/simd.lisp:1157]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (EXPORT 'PSHUFD)
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C") PSHUFD
     ((A SSE-VECTOR) (B SSE-VECTOR) (CONTROL (UNSIGNED-BYTE 8)))
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE SSE-VECTOR
           (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C") %PSHUFD/SSE
            (ECLECTOR.READER:UNQUOTE A) (ECLECTOR.READER:UNQUOTE B)
            (ECLECTOR.READER:UNQUOTE CONTROL)))))
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     'PSHUFD)
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     '%PSHUFD/SSE))

[Mezzano/runtime/simd.lisp:1178]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (EXPORT 'PSHUFHW)
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C") PSHUFHW
     ((A SSE-VECTOR) (B SSE-VECTOR) (CONTROL (UNSIGNED-BYTE 8)))
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE SSE-VECTOR
           (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C") %PSHUFHW/SSE
            (ECLECTOR.READER:UNQUOTE A) (ECLECTOR.READER:UNQUOTE B)
            (ECLECTOR.READER:UNQUOTE CONTROL)))))
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     'PSHUFHW)
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     '%PSHUFHW/SSE))

[Mezzano/runtime/simd.lisp:1199]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (EXPORT 'PSHUFLW)
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C") PSHUFLW
     ((A SSE-VECTOR) (B SSE-VECTOR) (CONTROL (UNSIGNED-BYTE 8)))
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE SSE-VECTOR
           (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C") %PSHUFLW/SSE
            (ECLECTOR.READER:UNQUOTE A) (ECLECTOR.READER:UNQUOTE B)
            (ECLECTOR.READER:UNQUOTE CONTROL)))))
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     'PSHUFLW)
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     '%PSHUFLW/SSE))

[Mezzano/runtime/simd.lisp:1219]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (EXPORT 'PSLLDQ)
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C") PSLLDQ
     ((VALUE SSE-VECTOR) (COUNT (UNSIGNED-BYTE 8)))
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE SSE-VECTOR
           (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C") %PSLLDQ/SSE
            (ECLECTOR.READER:UNQUOTE VALUE) (ECLECTOR.READER:UNQUOTE COUNT)))))
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     'PSLLDQ)
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     '%PSLLDQ/SSE))

[Mezzano/runtime/simd.lisp:1239]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (EXPORT 'PSRLDQ)
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C") PSRLDQ
     ((VALUE SSE-VECTOR) (COUNT (UNSIGNED-BYTE 8)))
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE SSE-VECTOR
           (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C") %PSRLDQ/SSE
            (ECLECTOR.READER:UNQUOTE VALUE) (ECLECTOR.READER:UNQUOTE COUNT)))))
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     'PSRLDQ)
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     '%PSRLDQ/SSE))

[Mezzano/runtime/simd.lisp:1258]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (EXPORT 'PMOVMSKB)
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C") PMOVMSKB
     ((VALUE MMX-VECTOR)) ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE (AND FIXNUM (INTEGER 0))
           (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C") %PMOVMSKB/MMX
            (ECLECTOR.READER:UNQUOTE VALUE)))))
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C") PMOVMSKB
     ((VALUE SSE-VECTOR)) ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE (AND FIXNUM (INTEGER 0))
           (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C") %PMOVMSKB/SSE
            (ECLECTOR.READER:UNQUOTE VALUE)))))
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     'PMOVMSKB)
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     '%PMOVMSKB/MMX)
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     '%PMOVMSKB/SSE))

[Mezzano/runtime/simd.lisp:1277]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (EXPORT 'MOVMSKPS)
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C") MOVMSKPS
     ((VALUE SSE-VECTOR)) ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE (AND FIXNUM (INTEGER 0))
           (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C") %MOVMSKPS/SSE
            (ECLECTOR.READER:UNQUOTE VALUE)))))
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     'MOVMSKPS)
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     '%MOVMSKPS/SSE))

[Mezzano/runtime/simd.lisp:1292]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (EXPORT 'MOVMSKPD)
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C") MOVMSKPD
     ((VALUE SSE-VECTOR)) ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE (AND FIXNUM (INTEGER 0))
           (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C") %MOVMSKPD/SSE
            (ECLECTOR.READER:UNQUOTE VALUE)))))
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     'MOVMSKPD)
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     '%MOVMSKPD/SSE))

[Mezzano/runtime/simd.lisp:1319]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (EXPORT 'PEXTRW)
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C") PEXTRW
     ((A MMX-VECTOR) (IMM (UNSIGNED-BYTE 8)))
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE (UNSIGNED-BYTE 16)
           (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C") %PEXTRW/MMX
            (ECLECTOR.READER:UNQUOTE A) (ECLECTOR.READER:UNQUOTE IMM)))))
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C") PEXTRW
     ((A MMX-VECTOR) (IMM (UNSIGNED-BYTE 8)))
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE (UNSIGNED-BYTE 16)
           (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C") %PEXTRW/SSE
            (ECLECTOR.READER:UNQUOTE A) (ECLECTOR.READER:UNQUOTE IMM)))))
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     'PEXTRW)
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     '%PEXTRW/MMX)
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     '%PEXTRW/SSE))

[Mezzano/runtime/simd.lisp:1351]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (EXPORT 'PINSRW)
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C") PINSRW
     ((A MMX-VECTOR) (B FIXNUM) (IMM (UNSIGNED-BYTE 8)))
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE MMX-VECTOR
           (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C") %PINSRW/MMX
            (ECLECTOR.READER:UNQUOTE A) (ECLECTOR.READER:UNQUOTE B)
            (ECLECTOR.READER:UNQUOTE IMM)))))
    (#S(FORMGREP:SYMREF :NAME "DEFINE-TRANSFORM" :QUALIFIER "C") PINSRW
     ((A MMX-VECTOR) (B FIXNUM) (IMM (UNSIGNED-BYTE 8)))
     ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
     (ECLECTOR.READER:QUASIQUOTE
      (THE SSE-VECTOR
           (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "C") %PINSRW/SSE
            (ECLECTOR.READER:UNQUOTE A) (ECLECTOR.READER:UNQUOTE B)
            (ECLECTOR.READER:UNQUOTE IMM)))))
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     'PINSRW)
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     '%PINSRW/MMX)
    (#S(FORMGREP:SYMREF :NAME "MARK-AS-CONSTANT-FOLDABLE" :QUALIFIER "C")
     '%PINSRW/SSE))

[Mezzano/supervisor/debug.lisp:96]
  (DEFUN DEBUG-WRITE-CHAR (CHAR &OPTIONAL BUF)
    (COND
     (BUF
      (LET ((BUF-DATA (CAR BUF)))
        (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) BUF-DATA)
                 (OPTIMIZE SPEED (SAFETY 0)))
        (LET ((LEN (LENGTH BUF-DATA)))
          (WITH-UTF-8-BYTES (CHAR BYTE)
           (LET ((CURRENT (CDR BUF)))
             (WHEN (>= CURRENT LEN) (DEBUG-FLUSH-BUFFER BUF) (SETF CURRENT 0))
             (SETF (AREF BUF-DATA (THE FIXNUM CURRENT)) BYTE)
             (SETF (CDR BUF) (1+ CURRENT)))))))
     (T (DEBUG-LOG-BUFFER-WRITE-CHAR CHAR)
      (CALL-DEBUG-PSEUDOSTREAM :WRITE-CHAR CHAR))))

[Mezzano/supervisor/debug.lisp:195]
  (DEFUN DEBUG-FLUSH-BUFFER (BUF)
    (LET ((BUF-DATA (CAR BUF)))
      (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) BUF-DATA)
               (OPTIMIZE SPEED (SAFETY 0)))
      (DOTIMES (I (CDR BUF))
        (DEBUG-LOG-BUFFER-WRITE-BYTE (AREF BUF-DATA (THE FIXNUM I)))))
    (CALL-DEBUG-PSEUDOSTREAM :FLUSH-BUFFER BUF))

[Mezzano/supervisor/serial.lisp:172]
  (DEFUN DEBUG-SERIAL-FLUSH-BUFFER (BUF)
    (SAFE-WITHOUT-INTERRUPTS (BUF)
     (WITH-SYMBOL-SPINLOCK (*DEBUG-SERIAL-LOCK*)
      (LET ((BUF-DATA (CAR BUF)))
        (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) BUF-DATA)
                 (OPTIMIZE SPEED (SAFETY 0)))
        (DOTIMES (I (CDR BUF))
          (LET ((BYTE (AREF BUF-DATA (THE FIXNUM I))))
            (COND
             ((EQL BYTE NIL) (SETF *SERIAL-AT-LINE-START* T)
              (DEBUG-SERIAL-WRITE-BYTE-1 13) (DEBUG-SERIAL-WRITE-BYTE-1 10))
             (T (SETF *SERIAL-AT-LINE-START* NIL)
              (DEBUG-SERIAL-WRITE-BYTE-1 BYTE)))))))))

[Mezzano/supervisor/uart.lisp:67]
  (DEFUN DEBUG-UART-FLUSH-BUFFER (BUF)
    (SAFE-WITHOUT-INTERRUPTS (BUF)
     (WITH-SYMBOL-SPINLOCK (*DEBUG-UART-LOCK*)
      (LET ((BUF-DATA (CAR BUF)))
        (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) BUF-DATA)
                 (OPTIMIZE SPEED (SAFETY 0)))
        (DOTIMES (I (CDR BUF))
          (LET ((BYTE (AREF BUF-DATA (THE FIXNUM I))))
            (COND
             ((EQL BYTE NIL) (SETF *UART-AT-LINE-START* T)
              (DEBUG-UART-WRITE-BYTE 13) (DEBUG-UART-WRITE-BYTE 10))
             (T (SETF *UART-AT-LINE-START* NIL)
              (DEBUG-UART-WRITE-BYTE BYTE)))))))))

[Mezzano/supervisor/video.lisp:434]
  (DEFUN DEBUG-VIDEO-FLUSH-BUFFER (BUF)
    (LET ((BUF-DATA (CAR BUF)))
      (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) BUF-DATA)
               (OPTIMIZE SPEED (SAFETY 0)))
      (DOTIMES (I (CDR BUF))
        (LET ((BYTE (AREF BUF-DATA (THE FIXNUM I))))
          (DEBUG-VIDEO-WRITE-CHAR (CODE-CHAR BYTE))))))

[Mezzano/system/ansi-loop.lisp:57]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (PROVIDE :LOOP)
    (CAR
     (PUSH "%Z% %M% %I% %E% %U%"
           #S(FORMGREP:SYMREF
              :NAME "*MODULE-IDENTIFICATIONS*"
              :QUALIFIER "SYSTEM")))
    (EVAL-WHEN (COMPILE LOAD EVAL) (PUSHNEW :LOOP-PREFER-POP *FEATURES*))
    (DEFMACRO LOOP-COPYLIST* (L)
      (ECLECTOR.READER:QUASIQUOTE
       (#S(FORMGREP:SYMREF :NAME "COPY-LIST" :QUALIFIER "LISP")
        (ECLECTOR.READER:UNQUOTE L) NIL T)))
    (DEFVAR *LOOP-GENTEMP* NIL)
    (DEFUN LOOP-GENTEMP (&OPTIONAL (PREF 'LOOPVAR-))
      (IF *LOOP-GENTEMP*
          (GENTEMP (STRING PREF))
          (GENSYM (STRING PREF))))
    (DEFVAR *LOOP-REAL-DATA-TYPE* 'T)
    (DEFVAR *LOOP-LIST-DATA-TYPE* 'T)
    (DEFUN LOOP-OPTIMIZATION-QUANTITIES (ENV)
      (DECLARE (VALUES SPEED SPACE SAFETY COMPILATION-SPEED DEBUG))
      (LET ((STUFF (DECLARATION-INFORMATION 'OPTIMIZE ENV)))
        (VALUES (OR (CDR (ASSOC 'SPEED STUFF)) 1)
                (OR (CDR (ASSOC 'SPACE STUFF)) 1)
                (OR (CDR (ASSOC 'SAFETY STUFF)) 1)
                (OR (CDR (ASSOC 'COMPILATION-SPEED STUFF)) 1)
                (OR (CDR (ASSOC 'DEBUG STUFF)) 1)))
      (VALUES #S(FORMGREP:SYMREF :NAME "TIME" :QUALIFIER "COMPILER")
              #S(FORMGREP:SYMREF :NAME "SPACE" :QUALIFIER "COMPILER")
              #S(FORMGREP:SYMREF :NAME "SAFETY" :QUALIFIER "COMPILER")
              #S(FORMGREP:SYMREF
                 :NAME "COMPILATION-SPEED"
                 :QUALIFIER "COMPILER")
              1))
    (DEFUN HIDE-VARIABLE-REFERENCES (VARIABLE-LIST FORM)
      (DECLARE)
      (IF VARIABLE-LIST
          (ECLECTOR.READER:QUASIQUOTE
           (#S(FORMGREP:SYMREF
               :NAME "INVISIBLE-REFERENCES"
               :QUALIFIER "COMPILER")
            (ECLECTOR.READER:UNQUOTE VARIABLE-LIST)
            (ECLECTOR.READER:UNQUOTE FORM)))
          FORM))
    (DEFUN HIDE-VARIABLE-REFERENCE (REALLY-HIDE VARIABLE FORM)
      (DECLARE)
      (IF (AND REALLY-HIDE VARIABLE (ATOM VARIABLE))
          (ECLECTOR.READER:QUASIQUOTE
           (#S(FORMGREP:SYMREF
               :NAME "INVISIBLE-REFERENCES"
               :QUALIFIER "COMPILER")
            ((ECLECTOR.READER:UNQUOTE VARIABLE))
            (ECLECTOR.READER:UNQUOTE FORM)))
          FORM))
    (DEFMACRO WITH-LOOP-LIST-COLLECTION-HEAD
              ((HEAD-VAR TAIL-VAR &OPTIONAL USER-HEAD-VAR) &BODY BODY)
      (LET ((HEAD-PLACE (OR USER-HEAD-VAR HEAD-VAR)))
        (ECLECTOR.READER:QUASIQUOTE
         (LET* (((ECLECTOR.READER:UNQUOTE HEAD-PLACE) NIL)
                ((ECLECTOR.READER:UNQUOTE TAIL-VAR)
                 (ECLECTOR.READER:UNQUOTE
                  (HIDE-VARIABLE-REFERENCE USER-HEAD-VAR USER-HEAD-VAR
                   (ECLECTOR.READER:QUASIQUOTE
                    (PROGN
                     (#S(FORMGREP:SYMREF :NAME "LOCF" :QUALIFIER "SCL")
                      (ECLECTOR.READER:UNQUOTE HEAD-PLACE))))))))
           (ECLECTOR.READER:UNQUOTE-SPLICING BODY)))))
    (DEFMACRO LOOP-COLLECT-RPLACD
              (&ENVIRONMENT ENV (HEAD-VAR TAIL-VAR &OPTIONAL USER-HEAD-VAR)
               FORM)
      (DECLARE (IGNORE HEAD-VAR USER-HEAD-VAR))
      (SETQ FORM
              (#S(FORMGREP:SYMREF :NAME "MACROEXPAND" :QUALIFIER "SYS.INT")
               FORM ENV))
      (FLET ((CDR-WRAP (FORM N)
               (DECLARE (TYPE FIXNUM N))
               (DO ()
                   ((<= N 4)
                    (SETQ FORM
                            (ECLECTOR.READER:QUASIQUOTE
                             ((ECLECTOR.READER:UNQUOTE
                               (CASE N
                                 (1 'CDR)
                                 (2 'CDDR)
                                 (3 'CDDDR)
                                 (4 'CDDDDR)))
                              (ECLECTOR.READER:UNQUOTE FORM)))))
                 (SETQ FORM
                         (ECLECTOR.READER:QUASIQUOTE
                          (CDDDDR (ECLECTOR.READER:UNQUOTE FORM)))
                       N (- N 4)))))
        (LET ((TAIL-FORM FORM) (NCDRS NIL))
          (WHEN (CONSP FORM)
            (COND
             ((EQ (CAR FORM) 'LIST) (SETQ NCDRS (1- (LENGTH (CDR FORM))))
              (SETQ TAIL-FORM
                      (ECLECTOR.READER:QUASIQUOTE
                       (LIST* (ECLECTOR.READER:UNQUOTE-SPLICING (CDR FORM))
                              NIL))))
             ((MEMBER (CAR FORM) '(LIST* CONS))
              (WHEN (AND (CDDR FORM) (MEMBER (CAR (LAST FORM)) '(NIL 'NIL)))
                (SETQ NCDRS (- (LENGTH (CDR FORM)) 2))))))
          (LET ((ANSWER
                 (COND
                  ((NULL NCDRS)
                   (ECLECTOR.READER:QUASIQUOTE
                    (WHEN
                        (SETF (CDR (ECLECTOR.READER:UNQUOTE TAIL-VAR))
                                (ECLECTOR.READER:UNQUOTE TAIL-FORM))
                      (SETQ (ECLECTOR.READER:UNQUOTE TAIL-VAR)
                              (LAST
                               (CDR (ECLECTOR.READER:UNQUOTE TAIL-VAR)))))))
                  ((< NCDRS 0) (RETURN-FROM LOOP-COLLECT-RPLACD NIL))
                  ((= NCDRS 0)
                   (ECLECTOR.READER:QUASIQUOTE
                    (RPLACD (ECLECTOR.READER:UNQUOTE TAIL-VAR)
                            (SETQ (ECLECTOR.READER:UNQUOTE TAIL-VAR)
                                    (ECLECTOR.READER:UNQUOTE TAIL-FORM)))))
                  (T
                   (ECLECTOR.READER:QUASIQUOTE
                    (SETQ (ECLECTOR.READER:UNQUOTE TAIL-VAR)
                            (ECLECTOR.READER:UNQUOTE
                             (CDR-WRAP
                              (ECLECTOR.READER:QUASIQUOTE
                               (SETF (CDR (ECLECTOR.READER:UNQUOTE TAIL-VAR))
                                       (ECLECTOR.READER:UNQUOTE TAIL-FORM)))
                              NCDRS))))))))
            ANSWER))))
    (DEFMACRO LOOP-COLLECT-ANSWER (HEAD-VAR &OPTIONAL USER-HEAD-VAR)
      (OR USER-HEAD-VAR (PROGN HEAD-VAR)))
    (DEFSTRUCT
        (LOOP-MINIMAX (:CONSTRUCTOR MAKE-LOOP-MINIMAX-INTERNAL) (:COPIER NIL)
         (:PREDICATE NIL))
      ANSWER-VARIABLE
      TYPE
      TEMP-VARIABLE
      FLAG-VARIABLE
      OPERATIONS
      INFINITY-DATA)
    (DEFVAR *LOOP-MINIMAX-TYPE-INFINITIES-ALIST*
      '((FIXNUM MOST-POSITIVE-FIXNUM MOST-NEGATIVE-FIXNUM)
        (SHORT-FLOAT
         #S(FORMGREP:SYMREF
            :NAME "SHORT-FLOAT-POSITIVE-INFINITY"
            :QUALIFIER "SYS.INT")
         #S(FORMGREP:SYMREF
            :NAME "SHORT-FLOAT-NEGATIVE-INFINITY"
            :QUALIFIER "SYS.INT"))
        (SINGLE-FLOAT
         #S(FORMGREP:SYMREF
            :NAME "SINGLE-FLOAT-POSITIVE-INFINITY"
            :QUALIFIER "SYS.INT")
         #S(FORMGREP:SYMREF
            :NAME "SINGLE-FLOAT-NEGATIVE-INFINITY"
            :QUALIFIER "SYS.INT"))
        (DOUBLE-FLOAT
         #S(FORMGREP:SYMREF
            :NAME "DOUBLE-FLOAT-POSITIVE-INFINITY"
            :QUALIFIER "SYS.INT")
         #S(FORMGREP:SYMREF
            :NAME "DOUBLE-FLOAT-NEGATIVE-INFINITY"
            :QUALIFIER "SYS.INT"))
        (LONG-FLOAT
         #S(FORMGREP:SYMREF
            :NAME "LONG-FLOAT-POSITIVE-INFINITY"
            :QUALIFIER "SYS.INT")
         #S(FORMGREP:SYMREF
            :NAME "LONG-FLOAT-NEGATIVE-INFINITY"
            :QUALIFIER "SYS.INT"))))
    (DEFUN MAKE-LOOP-MINIMAX (ANSWER-VARIABLE TYPE)
      (LET ((INFINITY-DATA
             (CDR
              (ASSOC TYPE *LOOP-MINIMAX-TYPE-INFINITIES-ALIST* :TEST
                     #'SUBTYPEP))))
        (MAKE-LOOP-MINIMAX-INTERNAL :ANSWER-VARIABLE ANSWER-VARIABLE :TYPE TYPE
         :TEMP-VARIABLE (LOOP-GENTEMP 'LOOP-MAXMIN-TEMP-) :FLAG-VARIABLE
         (AND (NOT INFINITY-DATA) (LOOP-GENTEMP 'LOOP-MAXMIN-FLAG-))
         :OPERATIONS NIL :INFINITY-DATA INFINITY-DATA)))
    (DEFUN LOOP-NOTE-MINIMAX-OPERATION (OPERATION MINIMAX)
      (PUSHNEW (THE SYMBOL OPERATION) (LOOP-MINIMAX-OPERATIONS MINIMAX))
      (WHEN
          (AND (CDR (LOOP-MINIMAX-OPERATIONS MINIMAX))
               (NOT (LOOP-MINIMAX-FLAG-VARIABLE MINIMAX)))
        (SETF (LOOP-MINIMAX-FLAG-VARIABLE MINIMAX)
                (LOOP-GENTEMP 'LOOP-MAXMIN-FLAG-)))
      OPERATION)
    (DEFMACRO WITH-MINIMAX-VALUE (LM &BODY BODY)
      (LET ((INIT (OR (LOOP-TYPED-INIT (LOOP-MINIMAX-TYPE LM)) 0))
            (WHICH (CAR (LOOP-MINIMAX-OPERATIONS LM)))
            (INFINITY-DATA (LOOP-MINIMAX-INFINITY-DATA LM))
            (ANSWER-VAR (LOOP-MINIMAX-ANSWER-VARIABLE LM))
            (TEMP-VAR (LOOP-MINIMAX-TEMP-VARIABLE LM))
            (FLAG-VAR (LOOP-MINIMAX-FLAG-VARIABLE LM))
            (TYPE (LOOP-MINIMAX-TYPE LM)))
        (IF FLAG-VAR
            (ECLECTOR.READER:QUASIQUOTE
             (LET (((ECLECTOR.READER:UNQUOTE ANSWER-VAR)
                    (ECLECTOR.READER:UNQUOTE INIT))
                   ((ECLECTOR.READER:UNQUOTE TEMP-VAR)
                    (ECLECTOR.READER:UNQUOTE INIT))
                   ((ECLECTOR.READER:UNQUOTE FLAG-VAR) NIL))
               (DECLARE
                (TYPE (ECLECTOR.READER:UNQUOTE TYPE)
                 (ECLECTOR.READER:UNQUOTE ANSWER-VAR)
                 (ECLECTOR.READER:UNQUOTE TEMP-VAR)))
               (ECLECTOR.READER:UNQUOTE-SPLICING BODY)))
            (ECLECTOR.READER:QUASIQUOTE
             (LET (((ECLECTOR.READER:UNQUOTE ANSWER-VAR)
                    (ECLECTOR.READER:UNQUOTE
                     (IF (EQ WHICH 'MIN)
                         (FIRST INFINITY-DATA)
                         (SECOND INFINITY-DATA))))
                   ((ECLECTOR.READER:UNQUOTE TEMP-VAR)
                    (ECLECTOR.READER:UNQUOTE INIT)))
               (DECLARE
                (TYPE (ECLECTOR.READER:UNQUOTE TYPE)
                 (ECLECTOR.READER:UNQUOTE ANSWER-VAR)
                 (ECLECTOR.READER:UNQUOTE TEMP-VAR)))
               (ECLECTOR.READER:UNQUOTE-SPLICING BODY))))))
    (DEFMACRO LOOP-ACCUMULATE-MINIMAX-VALUE (LM OPERATION FORM)
      (LET* ((ANSWER-VAR (LOOP-MINIMAX-ANSWER-VARIABLE LM))
             (TEMP-VAR (LOOP-MINIMAX-TEMP-VARIABLE LM))
             (FLAG-VAR (LOOP-MINIMAX-FLAG-VARIABLE LM))
             (TEST
              (HIDE-VARIABLE-REFERENCE T (LOOP-MINIMAX-ANSWER-VARIABLE LM)
               (ECLECTOR.READER:QUASIQUOTE
                ((ECLECTOR.READER:UNQUOTE (ECASE OPERATION (MIN '<) (MAX '>)))
                 (ECLECTOR.READER:UNQUOTE TEMP-VAR)
                 (ECLECTOR.READER:UNQUOTE ANSWER-VAR))))))
        (ECLECTOR.READER:QUASIQUOTE
         (PROGN
          (SETQ (ECLECTOR.READER:UNQUOTE TEMP-VAR)
                  (ECLECTOR.READER:UNQUOTE FORM))
          (WHEN
              (ECLECTOR.READER:UNQUOTE
               (IF FLAG-VAR
                   (ECLECTOR.READER:QUASIQUOTE
                    (OR (NOT (ECLECTOR.READER:UNQUOTE FLAG-VAR))
                        (ECLECTOR.READER:UNQUOTE TEST)))
                   TEST))
            (SETQ (ECLECTOR.READER:UNQUOTE-SPLICING
                   (AND FLAG-VAR
                        (ECLECTOR.READER:QUASIQUOTE
                         ((ECLECTOR.READER:UNQUOTE FLAG-VAR) T))))
                    (ECLECTOR.READER:UNQUOTE ANSWER-VAR)
                  (ECLECTOR.READER:UNQUOTE TEMP-VAR)))))))
    (DEFUN LOOP-TEQUAL (X1 X2) (AND (SYMBOLP X1) (STRING= X1 X2)))
    (DEFUN LOOP-TASSOC (KWD ALIST)
      (AND (SYMBOLP KWD) (ASSOC KWD ALIST :TEST #'STRING=)))
    (DEFUN LOOP-TMEMBER (KWD LIST)
      (AND (SYMBOLP KWD) (MEMBER KWD LIST :TEST #'STRING=)))
    (DEFUN LOOP-LOOKUP-KEYWORD (LOOP-TOKEN TABLE)
      (AND (SYMBOLP LOOP-TOKEN)
           (VALUES (GETHASH (SYMBOL-NAME LOOP-TOKEN) TABLE))))
    (DEFMACRO LOOP-STORE-TABLE-DATA (SYMBOL TABLE DATUM)
      (ECLECTOR.READER:QUASIQUOTE
       (SETF (GETHASH (SYMBOL-NAME (ECLECTOR.READER:UNQUOTE SYMBOL))
                      (ECLECTOR.READER:UNQUOTE TABLE))
               (ECLECTOR.READER:UNQUOTE DATUM))))
    (DEFSTRUCT
        (LOOP-UNIVERSE (:PRINT-FUNCTION PRINT-LOOP-UNIVERSE) (:COPIER NIL)
         (:PREDICATE NIL))
      KEYWORDS
      ITERATION-KEYWORDS
      FOR-KEYWORDS
      PATH-KEYWORDS
      TYPE-SYMBOLS
      TYPE-KEYWORDS
      ANSI
      IMPLICIT-FOR-REQUIRED)
    (DEFUN PRINT-LOOP-UNIVERSE (U STREAM LEVEL)
      (DECLARE (IGNORE LEVEL))
      (LET ((STR
             (CASE (LOOP-UNIVERSE-ANSI U)
               ((NIL) "Non-ANSI")
               ((T) "ANSI")
               (:EXTENDED "Extended-ANSI")
               (T (LOOP-UNIVERSE-ANSI U)))))
        (FORMAT STREAM "#<~S ~A ~X>" (TYPE-OF U) STR
                (#S(FORMGREP:SYMREF :NAME "ADDRESS-OF" :QUALIFIER "SYS") U))
        (PRINT-UNREADABLE-OBJECT (U STREAM :TYPE T :IDENTITY T)
          (PRINC STR STREAM))))
    (DEFVAR *LOOP-UNIVERSE*)
    (DEFUN MAKE-STANDARD-LOOP-UNIVERSE
           (
            &KEY KEYWORDS FOR-KEYWORDS ITERATION-KEYWORDS PATH-KEYWORDS
            TYPE-KEYWORDS TYPE-SYMBOLS ANSI)
      (FLET ((MAKETABLE (ENTRIES)
               (LET* ((SIZE (LENGTH ENTRIES))
                      (HT
                       (MAKE-HASH-TABLE :TEST #'EQUAL
                                        :ENFORCE-GC-INVARIANT-KEYS T)))
                 (DOLIST (X ENTRIES)
                   (SETF (GETHASH (SYMBOL-NAME (CAR X)) HT) (CADR X)))
                 HT)))
        (MAKE-LOOP-UNIVERSE :KEYWORDS (MAKETABLE KEYWORDS) :FOR-KEYWORDS
         (MAKETABLE FOR-KEYWORDS) :ITERATION-KEYWORDS
         (MAKETABLE ITERATION-KEYWORDS) :PATH-KEYWORDS
         (MAKETABLE PATH-KEYWORDS) :ANSI ANSI :IMPLICIT-FOR-REQUIRED
         (NOT (NULL ANSI)) :TYPE-KEYWORDS (MAKETABLE TYPE-KEYWORDS)
         :TYPE-SYMBOLS
         (LET* ((SIZE (LENGTH TYPE-SYMBOLS))
                (HT (MAKE-HASH-TABLE :TEST #'EQ :ENFORCE-GC-INVARIANT-KEYS T)))
           (DOLIST (X TYPE-SYMBOLS)
             (IF (ATOM X)
                 (SETF (GETHASH X HT) X)
                 (SETF (GETHASH (CAR X) HT) (CADR X))))
           HT))))
    (DEFVAR *LOOP-DESTRUCTURING-HOOKS*
      NIL
      "If not NIL, this must be a list of two things:
a LET-like macro, and a SETQ-like macro, which perform LOOP-style destructuring.")
    (DEFUN LOOP-MAKE-PSETQ (FROBS)
      (AND FROBS
           (LOOP-MAKE-DESETQ
            (LIST (CAR FROBS)
                  (IF (NULL (CDDR FROBS))
                      (CADR FROBS)
                      (ECLECTOR.READER:QUASIQUOTE
                       (PROG1 (ECLECTOR.READER:UNQUOTE (CADR FROBS))
                         (ECLECTOR.READER:UNQUOTE
                          (LOOP-MAKE-PSETQ (CDDR FROBS))))))))))
    (DEFUN LOOP-MAKE-DESETQ (VAR-VAL-PAIRS)
      (IF (NULL VAR-VAL-PAIRS)
          NIL
          (CONS
           (IF *LOOP-DESTRUCTURING-HOOKS*
               (CADR *LOOP-DESTRUCTURING-HOOKS*)
               'LOOP-REALLY-DESETQ)
           VAR-VAL-PAIRS)))
    (DEFVAR *LOOP-DESETQ-TEMPORARY* (MAKE-SYMBOL "LOOP-DESETQ-TEMP"))
    (DEFMACRO LOOP-REALLY-DESETQ (&ENVIRONMENT ENV &REST VAR-VAL-PAIRS)
      (LABELS ((FIND-NON-NULL (VAR)
                 (DO ((TAIL VAR))
                     ((NOT (CONSP TAIL)) TAIL)
                   (WHEN (FIND-NON-NULL (POP TAIL)) (RETURN T))))
               (LOOP-DESETQ-INTERNAL (VAR VAL &OPTIONAL TEMP)
                 (TYPECASE VAR
                   (NULL
                    (WHEN (CONSP VAL)
                      (IF (EQ (CAR VAL) 'PROG1)
                          (MAPCAN
                           #'(LAMBDA (X)
                               (AND (CONSP X)
                                    (OR (NOT (EQ (CAR X) 'CAR))
                                        (NOT (SYMBOLP (CADR X)))
                                        (NOT
                                         (SYMBOLP
                                          (SETQ X
                                                  (#S(FORMGREP:SYMREF
                                                      :NAME "MACROEXPAND"
                                                      :QUALIFIER "SYS.INT")
                                                   X ENV)))))
                                    (CONS X NIL)))
                           (CDR VAL))
                          (ECLECTOR.READER:QUASIQUOTE
                           ((ECLECTOR.READER:UNQUOTE VAL))))))
                   (CONS
                    (LET* ((CAR (CAR VAR))
                           (CDR (CDR VAR))
                           (CAR-NON-NULL (FIND-NON-NULL CAR))
                           (CDR-NON-NULL (FIND-NON-NULL CDR)))
                      (WHEN (OR CAR-NON-NULL CDR-NON-NULL)
                        (IF CDR-NON-NULL
                            (LET* ((TEMP-P TEMP)
                                   (TEMP (OR TEMP *LOOP-DESETQ-TEMPORARY*))
                                   (BODY
                                    (ECLECTOR.READER:QUASIQUOTE
                                     ((ECLECTOR.READER:UNQUOTE-SPLICING
                                       (LOOP-DESETQ-INTERNAL CAR
                                        (ECLECTOR.READER:QUASIQUOTE
                                         (PROG1
                                             (CAR
                                              (ECLECTOR.READER:UNQUOTE TEMP))
                                           (SETQ (ECLECTOR.READER:UNQUOTE TEMP)
                                                   (CDR
                                                    (ECLECTOR.READER:UNQUOTE
                                                     TEMP)))))))
                                      (ECLECTOR.READER:UNQUOTE-SPLICING
                                       (LOOP-DESETQ-INTERNAL CDR TEMP TEMP))))))
                              (IF TEMP-P
                                  (ECLECTOR.READER:QUASIQUOTE
                                   ((ECLECTOR.READER:UNQUOTE-SPLICING
                                     (UNLESS (EQ TEMP VAL)
                                       (ECLECTOR.READER:QUASIQUOTE
                                        ((SETQ (ECLECTOR.READER:UNQUOTE TEMP)
                                                 (ECLECTOR.READER:UNQUOTE
                                                  VAL))))))
                                    (ECLECTOR.READER:UNQUOTE-SPLICING BODY)))
                                  (ECLECTOR.READER:QUASIQUOTE
                                   ((LET (((ECLECTOR.READER:UNQUOTE TEMP)
                                           (ECLECTOR.READER:UNQUOTE VAL)))
                                      (ECLECTOR.READER:UNQUOTE-SPLICING
                                       BODY))))))
                            (LOOP-DESETQ-INTERNAL CAR
                             (ECLECTOR.READER:QUASIQUOTE
                              (CAR (ECLECTOR.READER:UNQUOTE VAL)))
                             TEMP)))))
                   (OTHERWISE
                    (UNLESS (EQ VAR VAL)
                      (ECLECTOR.READER:QUASIQUOTE
                       ((SETQ (ECLECTOR.READER:UNQUOTE VAR)
                                (ECLECTOR.READER:UNQUOTE VAL)))))))))
        (DO ((ACTIONS))
            ((NULL VAR-VAL-PAIRS)
             (IF (NULL (CDR ACTIONS))
                 (CAR ACTIONS)
                 (ECLECTOR.READER:QUASIQUOTE
                  (PROGN
                   (ECLECTOR.READER:UNQUOTE-SPLICING (NREVERSE ACTIONS))))))
          (SETQ ACTIONS
                  (REVAPPEND
                   (LOOP-DESETQ-INTERNAL (POP VAR-VAL-PAIRS)
                    (POP VAR-VAL-PAIRS))
                   ACTIONS)))))
    (DEFVAR *LOOP-SOURCE-CODE*)
    (DEFVAR *LOOP-ORIGINAL-SOURCE-CODE*)
    (DEFVAR *LOOP-SOURCE-CONTEXT*)
    (DEFVAR *LOOP-NAMES*)
    (DEFVAR *LOOP-MACRO-ENVIRONMENT*)
    (DEFVAR *LOOP-NAMED-VARIABLES*)
    (DEFVAR *LOOP-VARIABLES*)
    (DEFVAR *LOOP-DECLARATIONS*)
    (DEFVAR *LOOP-DESETQ-CROCKS*)
    (DEFVAR *LOOP-WRAPPERS*)
    (DEFVAR *LOOP-BIND-STACK*)
    (DEFVAR *LOOP-NODECLARE*)
    (DEFVAR *LOOP-ITERATION-VARIABLES*)
    (DEFVAR *LOOP-PROLOGUE*)
    (DEFVAR *LOOP-BEFORE-LOOP*)
    (DEFVAR *LOOP-BODY*)
    (DEFVAR *LOOP-AFTER-BODY*)
    (DEFVAR *LOOP-EMITTED-BODY*)
    (DEFVAR *LOOP-EPILOGUE*)
    (DEFVAR *LOOP-AFTER-EPILOGUE*)
    (DEFVAR *LOOP-FINAL-VALUE-CULPRIT*)
    (DEFVAR *LOOP-INSIDE-CONDITIONAL*)
    (DEFVAR *LOOP-WHEN-IT-VARIABLE*)
    (DEFVAR *LOOP-NEVER-STEPPED-VARIABLE*)
    (DEFVAR *LOOP-COLLECTION-CRUFT*)
    (DEFUN LOOP-CONSTANT-FOLD-IF-POSSIBLE (FORM &OPTIONAL EXPECTED-TYPE)
      (DECLARE (VALUES NEW-FORM CONSTANTP CONSTANT-VALUE))
      (LET ((NEW-FORM FORM) (CONSTANTP NIL) (CONSTANT-VALUE NIL))
        (SETQ NEW-FORM
                (#S(FORMGREP:SYMREF
                    :NAME "OPTIMIZE-FORM"
                    :QUALIFIER "COMPILER")
                 FORM *LOOP-MACRO-ENVIRONMENT* :REPEAT T :DO-MACRO-EXPANSION T
                 :DO-NAMED-CONSTANTS T :DO-INLINE-FORMS T :DO-OPTIMIZERS T
                 :DO-CONSTANT-FOLDING T :DO-FUNCTION-ARGS T)
              CONSTANTP (CONSTANTP NEW-FORM *LOOP-MACRO-ENVIRONMENT*)
              CONSTANT-VALUE
                (AND CONSTANTP
                     (#S(FORMGREP:SYMREF
                         :NAME "EVALUATE-CONSTANT"
                         :QUALIFIER "LT")
                      NEW-FORM *LOOP-MACRO-ENVIRONMENT*)))
        (WHEN (AND CONSTANTP EXPECTED-TYPE)
          (UNLESS (TYPEP CONSTANT-VALUE EXPECTED-TYPE)
            (LOOP-WARN
             "The form ~S evaluated to ~S, which was not of the anticipated type ~S."
             FORM CONSTANT-VALUE EXPECTED-TYPE)
            (SETQ CONSTANTP NIL
                  CONSTANT-VALUE NIL)))
        (VALUES NEW-FORM CONSTANTP CONSTANT-VALUE)))
    (DEFUN LOOP-CONSTANTP (FORM) (CONSTANTP FORM *LOOP-MACRO-ENVIRONMENT*))
    (DEFVAR *LOOP-DUPLICATE-CODE* NIL)
    (DEFVAR *LOOP-ITERATION-FLAG-VARIABLE* (MAKE-SYMBOL "LOOP-NOT-FIRST-TIME"))
    (DEFUN LOOP-CODE-DUPLICATION-THRESHOLD (ENV)
      (MULTIPLE-VALUE-BIND (SPEED SPACE)
          (LOOP-OPTIMIZATION-QUANTITIES ENV)
        (+ 40 (* (- SPEED SPACE) 10))))
    (DEFMACRO LOOP-BODY
              (&ENVIRONMENT ENV PROLOGUE BEFORE-LOOP MAIN-BODY AFTER-LOOP
               EPILOGUE
               &AUX RBEFORE RAFTER FLAGVAR)
      (UNLESS (= (LENGTH BEFORE-LOOP) (LENGTH AFTER-LOOP))
        (ERROR
         "LOOP-BODY called with non-synched before- and after-loop lists."))
      (SETQ RBEFORE (REVERSE BEFORE-LOOP)
            RAFTER (REVERSE AFTER-LOOP))
      (LABELS ((PSIMP (L)
                 (LET ((ANS NIL))
                   (DOLIST (X L)
                     (WHEN X
                       (PUSH X ANS)
                       (WHEN
                           (AND (CONSP X)
                                (MEMBER (CAR X) '(GO RETURN RETURN-FROM)))
                         (RETURN NIL))))
                   (NREVERSE ANS)))
               (PIFY (L)
                 (IF (NULL (CDR L))
                     (CAR L)
                     (ECLECTOR.READER:QUASIQUOTE
                      (PROGN (ECLECTOR.READER:UNQUOTE-SPLICING L)))))
               (MAKEBODY ()
                 (LET ((FORM
                        (ECLECTOR.READER:QUASIQUOTE
                         (TAGBODY
                           (ECLECTOR.READER:UNQUOTE-SPLICING
                            (PSIMP (APPEND PROLOGUE (NREVERSE RBEFORE))))
                          NEXT-LOOP
                           (ECLECTOR.READER:UNQUOTE-SPLICING
                            (PSIMP
                             (APPEND MAIN-BODY
                                     (NRECONC RAFTER
                                              (ECLECTOR.READER:QUASIQUOTE
                                               ((GO NEXT-LOOP)))))))
                          END-LOOP
                           (ECLECTOR.READER:UNQUOTE-SPLICING
                            (PSIMP EPILOGUE))))))
                   (IF FLAGVAR
                       (ECLECTOR.READER:QUASIQUOTE
                        (LET (((ECLECTOR.READER:UNQUOTE FLAGVAR) NIL))
                          (ECLECTOR.READER:UNQUOTE FORM)))
                       FORM))))
        (WHEN (OR *LOOP-DUPLICATE-CODE* (NOT RBEFORE))
          (RETURN-FROM LOOP-BODY (MAKEBODY)))
        (DO ((THRESHOLD (LOOP-CODE-DUPLICATION-THRESHOLD ENV)))
            (NIL)
          (DECLARE (TYPE FIXNUM THRESHOLD))
          (DO ()
              ((OR (NULL RBEFORE) (NOT (EQUAL (CAR RBEFORE) (CAR RAFTER)))))
            (PUSH (POP RBEFORE) MAIN-BODY)
            (POP RAFTER))
          (UNLESS RBEFORE (RETURN (MAKEBODY)))
          (DO ((BB RBEFORE (CDR BB))
               (AA RAFTER (CDR AA))
               (LASTDIFF NIL)
               (COUNT 0)
               (INC NIL))
              ((NULL BB) (RETURN-FROM LOOP-BODY (MAKEBODY)))
            (COND
             ((NOT (EQUAL (CAR BB) (CAR AA)))
              (SETQ LASTDIFF BB
                    COUNT 0))
             ((OR (NOT (SETQ INC (ESTIMATE-CODE-SIZE (CAR BB) ENV)))
                  (> (INCF COUNT INC) THRESHOLD))
              (LET ((THEN NIL) (ELSE NIL))
                (DO ()
                    (NIL)
                  (PUSH (POP RBEFORE) ELSE)
                  (PUSH (POP RAFTER) THEN)
                  (WHEN (EQ RBEFORE (CDR LASTDIFF)) (RETURN)))
                (UNLESS FLAGVAR
                  (PUSH
                   (ECLECTOR.READER:QUASIQUOTE
                    (SETQ (ECLECTOR.READER:UNQUOTE
                           (SETQ FLAGVAR *LOOP-ITERATION-FLAG-VARIABLE*))
                            T))
                   ELSE))
                (PUSH
                 (ECLECTOR.READER:QUASIQUOTE
                  (IF (ECLECTOR.READER:UNQUOTE FLAGVAR)
                      (ECLECTOR.READER:UNQUOTE (PIFY (PSIMP THEN)))
                      (ECLECTOR.READER:UNQUOTE (PIFY (PSIMP ELSE)))))
                 MAIN-BODY))
              (DO ()
                  (NIL)
                (POP RAFTER)
                (PUSH (POP RBEFORE) MAIN-BODY)
                (WHEN (EQ RBEFORE (CDR BB)) (RETURN)))
              (RETURN)))))))
    (DEFUN DUPLICATABLE-CODE-P (EXPR ENV)
      (IF (NULL EXPR)
          0
          (LET ((ANS (ESTIMATE-CODE-SIZE EXPR ENV)))
            (DECLARE (TYPE FIXNUM ANS))
            ANS)))
    (DEFVAR *SPECIAL-CODE-SIZES*
      '((RETURN 0) (PROGN 0) (NULL 1) (NOT 1) (EQ 1) (CAR 1) (CDR 1) (WHEN 1)
        (UNLESS 1) (IF 1) (CAAR 2) (CADR 2) (CDAR 2) (CDDR 2) (CAAAR 3)
        (CAADR 3) (CADAR 3) (CADDR 3) (CDAAR 3) (CDADR 3) (CDDAR 3) (CDDDR 3)
        (CAAAAR 4) (CAAADR 4) (CAADAR 4) (CAADDR 4) (CADAAR 4) (CADADR 4)
        (CADDAR 4) (CADDDR 4) (CDAAAR 4) (CDAADR 4) (CDADAR 4) (CDADDR 4)
        (CDDAAR 4) (CDDADR 4) (CDDDAR 4) (CDDDDR 4)))
    (DEFVAR *ESTIMATE-CODE-SIZE-PUNT*
      '(BLOCK DO
         DO*
         DOLIST
         FLET
         LABELS
         LAMBDA
         LET
         LET*
         LOCALLY
         MACROLET
         MULTIPLE-VALUE-BIND
         PROG
         PROG*
         SYMBOL-MACROLET
         TAGBODY
         UNWIND-PROTECT
         WITH-OPEN-FILE))
    (DEFUN DESTRUCTURING-SIZE (X)
      (DO ((X X (CDR X))
           (N 0 (+ (DESTRUCTURING-SIZE (CAR X)) N)))
          ((ATOM X)
           (+ N
              (IF (NULL X)
                  0
                  1)))))
    (DEFUN ESTIMATE-CODE-SIZE (X ENV)
      (CATCH 'ESTIMATE-CODE-SIZE (ESTIMATE-CODE-SIZE-1 X ENV)))
    (DEFUN ESTIMATE-CODE-SIZE-1 (X ENV)
      (FLET ((LIST-SIZE (L)
               (LET ((N 0))
                 (DECLARE (TYPE FIXNUM N))
                 (DOLIST (X L N) (INCF N (ESTIMATE-CODE-SIZE-1 X ENV))))))
        (COND ((CONSTANTP X ENV) 1)
              ((SYMBOLP X)
               (MULTIPLE-VALUE-BIND (NEW-FORM EXPANDED-P)
                   (#S(FORMGREP:SYMREF
                       :NAME "MACROEXPAND-1"
                       :QUALIFIER "SYS.INT")
                    X ENV)
                 (IF EXPANDED-P
                     (ESTIMATE-CODE-SIZE-1 NEW-FORM ENV)
                     1)))
              ((ATOM X) 1)
              ((SYMBOLP (CAR X))
               (LET ((FN (CAR X)) (TEM NIL) (N 0))
                 (DECLARE (TYPE SYMBOL FN)
                          (TYPE FIXNUM N))
                 (MACROLET ((F (OVERHEAD &OPTIONAL (ARGS NIL ARGS-P))
                              (ECLECTOR.READER:QUASIQUOTE
                               (THE FIXNUM
                                    (+
                                     (THE FIXNUM
                                          (ECLECTOR.READER:UNQUOTE OVERHEAD))
                                     (THE FIXNUM
                                          (LIST-SIZE
                                           (ECLECTOR.READER:UNQUOTE
                                            (IF ARGS-P
                                                ARGS
                                                '(CDR X))))))))))
                   (COND
                    ((SETQ TEM (GET FN 'ESTIMATE-CODE-SIZE))
                     (TYPECASE TEM (FIXNUM (F TEM)) (T (FUNCALL TEM X ENV))))
                    ((SETQ TEM (ASSOC FN *SPECIAL-CODE-SIZES*))
                     (F (SECOND TEM)))
                    ((EQ FN
                         '#S(FORMGREP:SYMREF
                             :NAME "INVISIBLE-REFERENCES"
                             :QUALIFIER "COMPILER"))
                     (LIST-SIZE (CDDR X)))
                    ((EQ FN 'COND)
                     (DOLIST (CLAUSE (CDR X) N)
                       (INCF N (LIST-SIZE CLAUSE))
                       (INCF N)))
                    ((EQ FN 'DESETQ)
                     (DO ((L (CDR X) (CDR L)))
                         ((NULL L) N)
                       (SETQ N
                               (+ N (DESTRUCTURING-SIZE (CAR L))
                                  (ESTIMATE-CODE-SIZE-1 (CADR L) ENV)))))
                    ((MEMBER FN '(SETQ PSETQ))
                     (DO ((L (CDR X) (CDR L)))
                         ((NULL L) N)
                       (SETQ N (+ N (ESTIMATE-CODE-SIZE-1 (CADR L) ENV) 1))))
                    ((EQ FN 'GO) 1)
                    ((EQ FN 'FUNCTION)
                     (IF (OR (SYMBOLP (CADR X))
                             (AND (CONSP (CADR X)) (EQ (CAADR X) 'SETF)))
                         1
                         (THROW 'DUPLICATABLE-CODE-P NIL)))
                    ((EQ FN 'MULTIPLE-VALUE-SETQ)
                     (F (LENGTH (SECOND X)) (CDDR X)))
                    ((EQ FN 'RETURN-FROM)
                     (1+ (ESTIMATE-CODE-SIZE-1 (THIRD X) ENV)))
                    ((OR (SPECIAL-OPERATOR-P FN)
                         (MEMBER FN *ESTIMATE-CODE-SIZE-PUNT*))
                     (THROW 'ESTIMATE-CODE-SIZE NIL))
                    (T
                     (MULTIPLE-VALUE-BIND (NEW-FORM EXPANDED-P)
                         (#S(FORMGREP:SYMREF
                             :NAME "MACROEXPAND-1"
                             :QUALIFIER "SYS.INT")
                          X ENV)
                       (IF EXPANDED-P
                           (ESTIMATE-CODE-SIZE-1 NEW-FORM ENV)
                           (F 3))))))))
              (T (THROW 'ESTIMATE-CODE-SIZE NIL)))))
    (DEFUN LOOP-CONTEXT ()
      (DO ((L *LOOP-SOURCE-CONTEXT* (CDR L))
           (NEW NIL (CONS (CAR L) NEW)))
          ((EQ L (CDR *LOOP-SOURCE-CODE*)) (NREVERSE NEW))))
    (DEFUN LOOP-ERROR (FORMAT-STRING &REST FORMAT-ARGS)
      (DECLARE (#S(FORMGREP:SYMREF :NAME "ERROR-REPORTER" :QUALIFIER "DBG")))
      (SETQ FORMAT-ARGS (COPY-LIST FORMAT-ARGS))
      (ERROR
       '#S(FORMGREP:SYMREF :NAME "SIMPLE-PROGRAM-ERROR" :QUALIFIER "SYS.INT")
       :FORMAT-CONTROL "~?~%Current LOOP context:~{ ~S~}." :FORMAT-ARGUMENTS
       (LIST FORMAT-STRING FORMAT-ARGS (LOOP-CONTEXT))))
    (DEFUN LOOP-WARN (FORMAT-STRING &REST FORMAT-ARGS)
      (WARN "~?~%Current LOOP context:~{ ~S~}." FORMAT-STRING FORMAT-ARGS
            (LOOP-CONTEXT)))
    (DEFUN LOOP-CHECK-DATA-TYPE
           (SPECIFIED-TYPE REQUIRED-TYPE
            &OPTIONAL (DEFAULT-TYPE REQUIRED-TYPE))
      (IF (NULL SPECIFIED-TYPE)
          DEFAULT-TYPE
          (MULTIPLE-VALUE-BIND (A B)
              (SUBTYPEP SPECIFIED-TYPE REQUIRED-TYPE)
            (COND
             ((NOT B)
              (LOOP-WARN
               "LOOP couldn't verify that ~S is a subtype of the required type ~S."
               SPECIFIED-TYPE REQUIRED-TYPE))
             ((NOT A)
              (LOOP-ERROR "Specified data type ~S is not a subtype of ~S."
               SPECIFIED-TYPE REQUIRED-TYPE)))
            SPECIFIED-TYPE)))
    (DEFMACRO LOOP-FINISH ()
      "Causes the iteration to terminate \"normally\", the same as implicit
termination by an iteration driving clause, or by use of WHILE or
UNTIL -- the epilogue code (if any) will be run, and any implicitly
collected result will be returned as the value of the LOOP."
      '(GO END-LOOP))
    (DEFUN LOOP-TRANSLATE
           (%LOOP-SOURCE-CODE %LOOP-MACRO-ENVIRONMENT %LOOP-UNIVERSE)
      (LET* ((*LOOP-SOURCE-CODE* %LOOP-SOURCE-CODE)
             (*LOOP-MACRO-ENVIRONMENT* %LOOP-MACRO-ENVIRONMENT)
             (*LOOP-UNIVERSE* %LOOP-UNIVERSE)
             (*LOOP-SOURCE-CONTEXT* NIL)
             (*LOOP-ITERATION-VARIABLES* NIL)
             (*LOOP-VARIABLES* NIL)
             (*LOOP-NODECLARE* NIL)
             (*LOOP-NAMED-VARIABLES* NIL)
             (*LOOP-DECLARATIONS* NIL)
             (*LOOP-DESETQ-CROCKS* NIL)
             (*LOOP-BIND-STACK* NIL)
             (*LOOP-PROLOGUE* NIL)
             (*LOOP-WRAPPERS* NIL)
             (*LOOP-BEFORE-LOOP* NIL)
             (*LOOP-BODY* NIL)
             (*LOOP-EMITTED-BODY* NIL)
             (*LOOP-AFTER-BODY* NIL)
             (*LOOP-EPILOGUE* NIL)
             (*LOOP-AFTER-EPILOGUE* NIL)
             (*LOOP-FINAL-VALUE-CULPRIT* NIL)
             (*LOOP-INSIDE-CONDITIONAL* NIL)
             (*LOOP-WHEN-IT-VARIABLE* NIL)
             (*LOOP-NEVER-STEPPED-VARIABLE* NIL)
             (*LOOP-NAMES* NIL)
             (*LOOP-COLLECTION-CRUFT* NIL))
        (LOOP-ITERATION-DRIVER)
        (LOOP-BIND-BLOCK)
        (LET ((ANSWER
               (ECLECTOR.READER:QUASIQUOTE
                (LOOP-BODY (ECLECTOR.READER:UNQUOTE (NREVERSE *LOOP-PROLOGUE*))
                 (ECLECTOR.READER:UNQUOTE (NREVERSE *LOOP-BEFORE-LOOP*))
                 (ECLECTOR.READER:UNQUOTE (NREVERSE *LOOP-BODY*))
                 (ECLECTOR.READER:UNQUOTE (NREVERSE *LOOP-AFTER-BODY*))
                 (ECLECTOR.READER:UNQUOTE
                  (NRECONC *LOOP-EPILOGUE*
                           (NREVERSE *LOOP-AFTER-EPILOGUE*)))))))
          (DOLIST (ENTRY *LOOP-BIND-STACK*)
            (LET ((VARS (FIRST ENTRY))
                  (DCLS (SECOND ENTRY))
                  (CROCKS (THIRD ENTRY))
                  (WRAPPERS (FOURTH ENTRY)))
              (DOLIST (W WRAPPERS) (SETQ ANSWER (APPEND W (LIST ANSWER))))
              (WHEN (OR VARS DCLS CROCKS)
                (LET ((FORMS (LIST ANSWER)))
                  (WHEN DCLS
                    (PUSH
                     (ECLECTOR.READER:QUASIQUOTE
                      (DECLARE (ECLECTOR.READER:UNQUOTE-SPLICING DCLS)))
                     FORMS))
                  (SETQ ANSWER
                          (ECLECTOR.READER:QUASIQUOTE
                           ((ECLECTOR.READER:UNQUOTE
                             (COND ((NOT VARS) 'LOCALLY)
                                   (*LOOP-DESTRUCTURING-HOOKS*
                                    (FIRST *LOOP-DESTRUCTURING-HOOKS*))
                                   (T 'LET)))
                            (ECLECTOR.READER:UNQUOTE VARS)
                            (ECLECTOR.READER:UNQUOTE-SPLICING
                             (IF CROCKS
                                 (ECLECTOR.READER:QUASIQUOTE
                                  ((DESTRUCTURING-BIND
                                       (ECLECTOR.READER:UNQUOTE-SPLICING
                                        CROCKS)
                                       (ECLECTOR.READER:UNQUOTE-SPLICING
                                        FORMS))))
                                 FORMS)))))))))
          (SETF ANSWER
                  (ECLECTOR.READER:QUASIQUOTE
                   (BLOCK (ECLECTOR.READER:UNQUOTE (FIRST *LOOP-NAMES*))
                     (ECLECTOR.READER:UNQUOTE ANSWER))))
          ANSWER)))
    (DEFUN LOOP-ITERATION-DRIVER ()
      (DO ()
          ((NULL *LOOP-SOURCE-CODE*))
        (LET ((KEYWORD (CAR *LOOP-SOURCE-CODE*)) (TEM NIL))
          (COND
           ((NOT (SYMBOLP KEYWORD))
            (LOOP-ERROR "~S found where LOOP keyword expected." KEYWORD))
           (T (SETQ *LOOP-SOURCE-CONTEXT* *LOOP-SOURCE-CODE*) (LOOP-POP-SOURCE)
            (COND
             ((SETQ TEM
                      (LOOP-LOOKUP-KEYWORD KEYWORD
                       (LOOP-UNIVERSE-KEYWORDS *LOOP-UNIVERSE*)))
              (APPLY (SYMBOL-FUNCTION (FIRST TEM)) (REST TEM)))
             ((SETQ TEM
                      (LOOP-LOOKUP-KEYWORD KEYWORD
                       (LOOP-UNIVERSE-ITERATION-KEYWORDS *LOOP-UNIVERSE*)))
              (LOOP-HACK-ITERATION TEM))
             ((LOOP-TMEMBER KEYWORD '(AND ELSE))
              (LOOP-ERROR
               "Secondary clause misplaced at top level in LOOP macro: ~S ~S ~S ..."
               KEYWORD (CAR *LOOP-SOURCE-CODE*) (CADR *LOOP-SOURCE-CODE*)))
             (T
              (LOOP-ERROR "~S is an unknown keyword in LOOP macro."
               KEYWORD))))))))
    (DEFUN LOOP-POP-SOURCE ()
      (IF *LOOP-SOURCE-CODE*
          (POP *LOOP-SOURCE-CODE*)
          (LOOP-ERROR
           "LOOP source code ran out when another token was expected.")))
    (DEFUN LOOP-GET-PROGN ()
      (DO ((FORMS (LIST (LOOP-POP-SOURCE)) (CONS (LOOP-POP-SOURCE) FORMS))
           (NEXTFORM (CAR *LOOP-SOURCE-CODE*) (CAR *LOOP-SOURCE-CODE*)))
          ((ATOM NEXTFORM)
           (IF (NULL (CDR FORMS))
               (CAR FORMS)
               (CONS 'PROGN (NREVERSE FORMS))))))
    (DEFUN LOOP-GET-FORM ()
      (IF *LOOP-SOURCE-CODE*
          (LOOP-POP-SOURCE)
          (LOOP-ERROR "LOOP code ran out where a form was expected.")))
    (DEFUN LOOP-CONSTRUCT-RETURN (FORM)
      (ECLECTOR.READER:QUASIQUOTE
       (RETURN-FROM (ECLECTOR.READER:UNQUOTE (CAR *LOOP-NAMES*))
         (ECLECTOR.READER:UNQUOTE FORM))))
    (DEFUN LOOP-PSEUDO-BODY (FORM)
      (COND
       ((OR *LOOP-EMITTED-BODY* *LOOP-INSIDE-CONDITIONAL*)
        (PUSH FORM *LOOP-BODY*))
       (T (PUSH FORM *LOOP-BEFORE-LOOP*) (PUSH FORM *LOOP-AFTER-BODY*))))
    (DEFUN LOOP-EMIT-BODY (FORM)
      (SETQ *LOOP-EMITTED-BODY* T)
      (LOOP-PSEUDO-BODY FORM))
    (DEFUN LOOP-EMIT-FINAL-VALUE (FORM)
      (PUSH (LOOP-CONSTRUCT-RETURN FORM) *LOOP-AFTER-EPILOGUE*)
      (WHEN *LOOP-FINAL-VALUE-CULPRIT*
        (LOOP-WARN "LOOP clause is providing a value for the iteration,~@
	        however one was already established by a ~S clause."
         *LOOP-FINAL-VALUE-CULPRIT*))
      (SETQ *LOOP-FINAL-VALUE-CULPRIT* (CAR *LOOP-SOURCE-CONTEXT*)))
    (DEFUN LOOP-DISALLOW-CONDITIONAL (&OPTIONAL KWD)
      (DECLARE (#S(FORMGREP:SYMREF :NAME "ERROR-REPORTER" :QUALIFIER "DBG")))
      (WHEN *LOOP-INSIDE-CONDITIONAL*
        (LOOP-ERROR
         "~:[This LOOP~;The LOOP ~:*~S~] clause is not permitted inside a conditional."
         KWD)))
    (DEFUN LOOP-TYPED-INIT (DATA-TYPE)
      (WHEN DATA-TYPE
        (LET ((EXPANDED-TYPE
               (#S(FORMGREP:SYMREF :NAME "TYPEEXPAND" :QUALIFIER "SYS.INT")
                DATA-TYPE)))
          (COND
           ((OR (SUBTYPEP EXPANDED-TYPE 'FLOAT)
                (SUBTYPEP EXPANDED-TYPE '(COMPLEX FLOAT)))
            (COERCE 0 DATA-TYPE))
           ((SUBTYPEP EXPANDED-TYPE 'NUMBER) 0)
           ((SUBTYPEP EXPANDED-TYPE 'VECTOR) (COERCE NIL EXPANDED-TYPE))
           (T NIL)))))
    (DEFUN LOOP-OPTIONAL-TYPE (&OPTIONAL VARIABLE)
      (AND *LOOP-SOURCE-CODE*
           (LET ((Z (CAR *LOOP-SOURCE-CODE*)))
             (COND
              ((LOOP-TEQUAL Z 'OF-TYPE) (LOOP-POP-SOURCE) (LOOP-POP-SOURCE))
              ((SYMBOLP Z)
               (LET ((TYPE-SPEC
                      (OR
                       (GETHASH Z (LOOP-UNIVERSE-TYPE-SYMBOLS *LOOP-UNIVERSE*))
                       (GETHASH (SYMBOL-NAME Z)
                                (LOOP-UNIVERSE-TYPE-KEYWORDS
                                 *LOOP-UNIVERSE*)))))
                 (WHEN TYPE-SPEC (LOOP-POP-SOURCE) TYPE-SPEC)))
              (T
               (IF (CONSP VARIABLE)
                   (UNLESS (CONSP Z)
                     (LOOP-ERROR
                      "~S found where a LOOP keyword, LOOP type keyword, or LOOP type pattern expected."
                      Z))
                   (LOOP-ERROR
                    "~S found where a LOOP keyword or LOOP type keyword expected."
                    Z))
               (LOOP-POP-SOURCE)
               (LABELS ((TRANSLATE (K V)
                          (COND ((NULL K) NIL)
                                ((ATOM K)
                                 (REPLICATE
                                  (OR
                                   (GETHASH K
                                            (LOOP-UNIVERSE-TYPE-SYMBOLS
                                             *LOOP-UNIVERSE*))
                                   (GETHASH (SYMBOL-NAME K)
                                            (LOOP-UNIVERSE-TYPE-KEYWORDS
                                             *LOOP-UNIVERSE*))
                                   (LOOP-ERROR
                                    "Destructuring type pattern ~S contains unrecognized type keyword ~S."
                                    Z K))
                                  V))
                                ((ATOM V)
                                 (LOOP-ERROR
                                  "Destructuring type pattern ~S doesn't match variable pattern ~S."
                                  Z VARIABLE))
                                (T
                                 (CONS (TRANSLATE (CAR K) (CAR V))
                                       (TRANSLATE (CDR K) (CDR V))))))
                        (REPLICATE (TYP V)
                          (IF (ATOM V)
                              TYP
                              (CONS (REPLICATE TYP (CAR V))
                                    (REPLICATE TYP (CDR V))))))
                 (TRANSLATE Z VARIABLE)))))))
    (DEFUN LOOP-BIND-BLOCK ()
      (WHEN (OR *LOOP-VARIABLES* *LOOP-DECLARATIONS* *LOOP-WRAPPERS*)
        (PUSH
         (LIST (NREVERSE *LOOP-VARIABLES*) *LOOP-DECLARATIONS*
               *LOOP-DESETQ-CROCKS* *LOOP-WRAPPERS*)
         *LOOP-BIND-STACK*)
        (SETQ *LOOP-VARIABLES* NIL
              *LOOP-DECLARATIONS* NIL
              *LOOP-DESETQ-CROCKS* NIL
              *LOOP-WRAPPERS* NIL)))
    (DEFUN LOOP-MAKE-VARIABLE
           (NAME INITIALIZATION DTYPE &OPTIONAL ITERATION-VARIABLE-P)
      (COND
       ((NULL NAME)
        (COND
         ((NOT (NULL INITIALIZATION))
          (PUSH (LIST (SETQ NAME (LOOP-GENTEMP 'LOOP-IGNORE-)) INITIALIZATION)
                *LOOP-VARIABLES*)
          (PUSH
           (ECLECTOR.READER:QUASIQUOTE (IGNORE (ECLECTOR.READER:UNQUOTE NAME)))
           *LOOP-DECLARATIONS*))))
       ((ATOM NAME)
        (COND
         (ITERATION-VARIABLE-P
          (IF (MEMBER NAME *LOOP-ITERATION-VARIABLES*)
              (LOOP-ERROR "Duplicated LOOP iteration variable ~S." NAME)
              (PUSH NAME *LOOP-ITERATION-VARIABLES*)))
         ((ASSOC NAME *LOOP-VARIABLES*)
          (LOOP-ERROR "Duplicated variable ~S in LOOP parallel binding."
           NAME)))
        (UNLESS (SYMBOLP NAME)
          (LOOP-ERROR "Bad variable ~S somewhere in LOOP." NAME))
        (LOOP-DECLARE-VARIABLE NAME DTYPE)
        (PUSH (LIST NAME (OR INITIALIZATION (LOOP-TYPED-INIT DTYPE)))
              *LOOP-VARIABLES*))
       (INITIALIZATION
        (COND
         (*LOOP-DESTRUCTURING-HOOKS* (LOOP-DECLARE-VARIABLE NAME DTYPE)
          (PUSH (LIST NAME INITIALIZATION) *LOOP-VARIABLES*))
         (T
          (LET ((NEWVAR (LOOP-GENTEMP 'LOOP-DESTRUCTURE-)))
            (PUSH (LIST NEWVAR INITIALIZATION) *LOOP-VARIABLES*)
            (SETQ *LOOP-DESETQ-CROCKS*
                    (LIST* NAME NEWVAR *LOOP-DESETQ-CROCKS*))
            (LOOP-MAKE-VARIABLE NAME NIL DTYPE ITERATION-VARIABLE-P)))))
       (T
        (LET ((TCAR NIL) (TCDR NIL))
          (IF (ATOM DTYPE)
              (SETQ TCAR (SETQ TCDR DTYPE))
              (SETQ TCAR (CAR DTYPE)
                    TCDR (CDR DTYPE)))
          (LOOP-MAKE-VARIABLE (CAR NAME) NIL TCAR ITERATION-VARIABLE-P)
          (LOOP-MAKE-VARIABLE (CDR NAME) NIL TCDR ITERATION-VARIABLE-P))))
      NAME)
    (DEFUN LOOP-MAKE-ITERATION-VARIABLE (NAME INITIALIZATION DTYPE)
      (LOOP-MAKE-VARIABLE NAME INITIALIZATION DTYPE T))
    (DEFUN LOOP-DECLARE-VARIABLE (NAME DTYPE)
      (COND ((OR (NULL NAME) (NULL DTYPE) (EQ DTYPE T)) NIL)
            ((SYMBOLP NAME)
             (UNLESS
                 (OR (EQ DTYPE T) (MEMBER (THE SYMBOL NAME) *LOOP-NODECLARE*))
               (PUSH
                (ECLECTOR.READER:QUASIQUOTE
                 (TYPE (ECLECTOR.READER:UNQUOTE DTYPE)
                  (ECLECTOR.READER:UNQUOTE NAME)))
                *LOOP-DECLARATIONS*)))
            ((CONSP NAME)
             (COND
              ((CONSP DTYPE) (LOOP-DECLARE-VARIABLE (CAR NAME) (CAR DTYPE))
               (LOOP-DECLARE-VARIABLE (CDR NAME) (CDR DTYPE)))
              (T (LOOP-DECLARE-VARIABLE (CAR NAME) DTYPE)
               (LOOP-DECLARE-VARIABLE (CDR NAME) DTYPE))))
            (T (ERROR "Invalid LOOP variable passed in: ~S." NAME))))
    (DEFUN LOOP-MAYBE-BIND-FORM (FORM DATA-TYPE)
      (IF (LOOP-CONSTANTP FORM)
          FORM
          (LOOP-MAKE-VARIABLE (LOOP-GENTEMP 'LOOP-BIND-) FORM DATA-TYPE)))
    (DEFUN LOOP-DO-IF (FOR NEGATEP)
      (LET ((FORM (LOOP-GET-FORM)) (*LOOP-INSIDE-CONDITIONAL* T) (IT-P NIL))
        (FLET ((GET-CLAUSE (FOR)
                 (DO ((BODY NIL))
                     (NIL)
                   (LET ((KEY (CAR *LOOP-SOURCE-CODE*)) (*LOOP-BODY* NIL) DATA)
                     (COND
                      ((NOT (SYMBOLP KEY))
                       (LOOP-ERROR
                        "~S found where keyword expected getting LOOP clause after ~S."
                        KEY FOR))
                      (T (SETQ *LOOP-SOURCE-CONTEXT* *LOOP-SOURCE-CODE*)
                       (LOOP-POP-SOURCE)
                       (WHEN (LOOP-TEQUAL (CAR *LOOP-SOURCE-CODE*) 'IT)
                         (SETQ *LOOP-SOURCE-CODE*
                                 (CONS
                                  (OR IT-P (SETQ IT-P (LOOP-WHEN-IT-VARIABLE)))
                                  (CDR *LOOP-SOURCE-CODE*))))
                       (COND
                        ((OR
                          (NOT
                           (SETQ DATA
                                   (LOOP-LOOKUP-KEYWORD KEY
                                    (LOOP-UNIVERSE-KEYWORDS *LOOP-UNIVERSE*))))
                          (PROGN
                           (APPLY (SYMBOL-FUNCTION (CAR DATA)) (CDR DATA))
                           (NULL *LOOP-BODY*)))
                         (LOOP-ERROR
                          "~S does not introduce a LOOP clause that can follow ~S."
                          KEY FOR))
                        (T (SETQ BODY (NRECONC *LOOP-BODY* BODY)))))))
                   (IF (LOOP-TEQUAL (CAR *LOOP-SOURCE-CODE*) :AND)
                       (LOOP-POP-SOURCE)
                       (RETURN
                        (IF (CDR BODY)
                            (ECLECTOR.READER:QUASIQUOTE
                             (PROGN
                              (ECLECTOR.READER:UNQUOTE-SPLICING
                               (NREVERSE BODY))))
                            (CAR BODY)))))))
          (LET ((THEN (GET-CLAUSE FOR))
                (ELSE
                 (WHEN (LOOP-TEQUAL (CAR *LOOP-SOURCE-CODE*) :ELSE)
                   (LOOP-POP-SOURCE)
                   (LIST (GET-CLAUSE :ELSE)))))
            (WHEN (LOOP-TEQUAL (CAR *LOOP-SOURCE-CODE*) :END)
              (LOOP-POP-SOURCE))
            (WHEN IT-P
              (SETQ FORM
                      (ECLECTOR.READER:QUASIQUOTE
                       (SETQ (ECLECTOR.READER:UNQUOTE IT-P)
                               (ECLECTOR.READER:UNQUOTE FORM)))))
            (LOOP-PSEUDO-BODY
             (ECLECTOR.READER:QUASIQUOTE
              (IF (ECLECTOR.READER:UNQUOTE
                   (IF NEGATEP
                       (ECLECTOR.READER:QUASIQUOTE
                        (NOT (ECLECTOR.READER:UNQUOTE FORM)))
                       FORM))
                  (ECLECTOR.READER:UNQUOTE THEN)
                  (ECLECTOR.READER:UNQUOTE-SPLICING ELSE))))))))
    (DEFUN LOOP-DO-INITIALLY ()
      (LOOP-DISALLOW-CONDITIONAL :INITIALLY)
      (PUSH (LOOP-GET-PROGN) *LOOP-PROLOGUE*))
    (DEFUN LOOP-DO-FINALLY ()
      (LOOP-DISALLOW-CONDITIONAL :FINALLY)
      (PUSH (LOOP-GET-PROGN) *LOOP-EPILOGUE*))
    (DEFUN LOOP-DO-DO () (LOOP-EMIT-BODY (LOOP-GET-PROGN)))
    (DEFUN LOOP-DO-NAMED ()
      (LET ((NAME (LOOP-POP-SOURCE)))
        (UNLESS (SYMBOLP NAME)
          (LOOP-ERROR "~S is an invalid name for your LOOP." NAME))
        (WHEN
            (OR *LOOP-BEFORE-LOOP* *LOOP-BODY* *LOOP-AFTER-EPILOGUE*
                *LOOP-INSIDE-CONDITIONAL*)
          (LOOP-ERROR "The NAMED ~S clause occurs too late." NAME))
        (WHEN *LOOP-NAMES*
          (LOOP-ERROR
           "You may only use one NAMED clause in your loop: NAMED ~S ... NAMED ~S."
           (CAR *LOOP-NAMES*) NAME))
        (SETQ *LOOP-NAMES* (LIST NAME))))
    (DEFUN LOOP-DO-RETURN ()
      (LOOP-PSEUDO-BODY (LOOP-CONSTRUCT-RETURN (LOOP-GET-FORM))))
    (DEFSTRUCT (LOOP-COLLECTOR (:COPIER NIL) (:PREDICATE NIL))
      NAME
      CLASS
      (HISTORY NIL)
      (TEMPVARS NIL)
      DTYPE
      (DATA NIL))
    (DEFUN LOOP-GET-COLLECTION-INFO (COLLECTOR CLASS DEFAULT-TYPE)
      (LET ((FORM (LOOP-GET-FORM))
            (DTYPE
             (AND (NOT (LOOP-UNIVERSE-ANSI *LOOP-UNIVERSE*))
                  (LOOP-OPTIONAL-TYPE)))
            (NAME
             (WHEN (LOOP-TEQUAL (CAR *LOOP-SOURCE-CODE*) 'INTO)
               (LOOP-POP-SOURCE)
               (LOOP-POP-SOURCE))))
        (WHEN (NOT (SYMBOLP NAME))
          (LOOP-ERROR "Value accumulation recipient name, ~S, is not a symbol."
           NAME))
        (UNLESS DTYPE (SETQ DTYPE (OR (LOOP-OPTIONAL-TYPE) DEFAULT-TYPE)))
        (LET ((CRUFT
               (FIND (THE SYMBOL NAME) *LOOP-COLLECTION-CRUFT* :KEY
                     #'LOOP-COLLECTOR-NAME)))
          (COND
           ((NOT CRUFT)
            (PUSH
             (SETQ CRUFT
                     (MAKE-LOOP-COLLECTOR :NAME NAME :CLASS CLASS :HISTORY
                      (LIST COLLECTOR) :DTYPE DTYPE))
             *LOOP-COLLECTION-CRUFT*))
           (T
            (UNLESS (EQ (LOOP-COLLECTOR-CLASS CRUFT) CLASS)
              (LOOP-ERROR
               "Incompatible kinds of LOOP value accumulation specified for collecting~@
		    ~:[as the value of the LOOP~;~:*INTO ~S~]: ~S and ~S."
               NAME (CAR (LOOP-COLLECTOR-HISTORY CRUFT)) COLLECTOR))
            (UNLESS (EQUAL DTYPE (LOOP-COLLECTOR-DTYPE CRUFT))
              (LOOP-WARN
               "Unequal datatypes specified in different LOOP value accumulations~@
		   into ~S: ~S and ~S."
               NAME DTYPE (LOOP-COLLECTOR-DTYPE CRUFT))
              (WHEN (EQ (LOOP-COLLECTOR-DTYPE CRUFT) T)
                (SETF (LOOP-COLLECTOR-DTYPE CRUFT) DTYPE)))
            (PUSH COLLECTOR (LOOP-COLLECTOR-HISTORY CRUFT))))
          (VALUES CRUFT FORM))))
    (DEFUN LOOP-LIST-COLLECTION (SPECIFICALLY)
      (MULTIPLE-VALUE-BIND (LC FORM)
          (LOOP-GET-COLLECTION-INFO SPECIFICALLY 'LIST 'LIST)
        (LET ((TEMPVARS (LOOP-COLLECTOR-TEMPVARS LC)))
          (UNLESS TEMPVARS
            (SETF (LOOP-COLLECTOR-TEMPVARS LC)
                    (SETQ TEMPVARS
                            (LIST* (LOOP-GENTEMP 'LOOP-LIST-HEAD-)
                                   (LOOP-GENTEMP 'LOOP-LIST-TAIL-)
                                   (AND (LOOP-COLLECTOR-NAME LC)
                                        (LIST (LOOP-COLLECTOR-NAME LC))))))
            (PUSH
             (ECLECTOR.READER:QUASIQUOTE
              (WITH-LOOP-LIST-COLLECTION-HEAD
               (ECLECTOR.READER:UNQUOTE TEMPVARS)))
             *LOOP-WRAPPERS*)
            (UNLESS (LOOP-COLLECTOR-NAME LC)
              (LOOP-EMIT-FINAL-VALUE
               (ECLECTOR.READER:QUASIQUOTE
                (LOOP-COLLECT-ANSWER (ECLECTOR.READER:UNQUOTE (CAR TEMPVARS))
                 (ECLECTOR.READER:UNQUOTE-SPLICING (CDDR TEMPVARS)))))))
          (ECASE SPECIFICALLY
            (LIST
             (SETQ FORM
                     (ECLECTOR.READER:QUASIQUOTE
                      (LIST (ECLECTOR.READER:UNQUOTE FORM)))))
            (NCONC NIL)
            (APPEND
             (UNLESS (AND (CONSP FORM) (EQ (CAR FORM) 'LIST))
               (SETQ FORM
                       (ECLECTOR.READER:QUASIQUOTE
                        (LOOP-COPYLIST* (ECLECTOR.READER:UNQUOTE FORM)))))))
          (LOOP-EMIT-BODY
           (ECLECTOR.READER:QUASIQUOTE
            (LOOP-COLLECT-RPLACD (ECLECTOR.READER:UNQUOTE TEMPVARS)
             (ECLECTOR.READER:UNQUOTE FORM)))))))
    (DEFUN LOOP-SUM-COLLECTION (SPECIFICALLY REQUIRED-TYPE DEFAULT-TYPE)
      (MULTIPLE-VALUE-BIND (LC FORM)
          (LOOP-GET-COLLECTION-INFO SPECIFICALLY 'SUM DEFAULT-TYPE)
        (LOOP-CHECK-DATA-TYPE (LOOP-COLLECTOR-DTYPE LC) REQUIRED-TYPE)
        (LET ((TEMPVARS (LOOP-COLLECTOR-TEMPVARS LC)))
          (UNLESS TEMPVARS
            (SETF (LOOP-COLLECTOR-TEMPVARS LC)
                    (SETQ TEMPVARS
                            (LIST
                             (LOOP-MAKE-VARIABLE
                              (OR (LOOP-COLLECTOR-NAME LC)
                                  (LOOP-GENTEMP 'LOOP-SUM-))
                              NIL (LOOP-COLLECTOR-DTYPE LC)))))
            (UNLESS (LOOP-COLLECTOR-NAME LC)
              (LOOP-EMIT-FINAL-VALUE (CAR (LOOP-COLLECTOR-TEMPVARS LC)))))
          (LOOP-EMIT-BODY
           (IF (EQ SPECIFICALLY 'COUNT)
               (ECLECTOR.READER:QUASIQUOTE
                (WHEN (ECLECTOR.READER:UNQUOTE FORM)
                  (SETQ (ECLECTOR.READER:UNQUOTE (CAR TEMPVARS))
                          (ECLECTOR.READER:UNQUOTE
                           (HIDE-VARIABLE-REFERENCE T (CAR TEMPVARS)
                            (ECLECTOR.READER:QUASIQUOTE
                             (1+
                              (ECLECTOR.READER:UNQUOTE (CAR TEMPVARS)))))))))
               (ECLECTOR.READER:QUASIQUOTE
                (SETQ (ECLECTOR.READER:UNQUOTE (CAR TEMPVARS))
                        (+
                         (ECLECTOR.READER:UNQUOTE
                          (HIDE-VARIABLE-REFERENCE T (CAR TEMPVARS)
                           (CAR TEMPVARS)))
                         (ECLECTOR.READER:UNQUOTE FORM)))))))))
    (DEFUN LOOP-MAXMIN-COLLECTION (SPECIFICALLY)
      (MULTIPLE-VALUE-BIND (LC FORM)
          (LOOP-GET-COLLECTION-INFO SPECIFICALLY 'MAXMIN *LOOP-REAL-DATA-TYPE*)
        (LOOP-CHECK-DATA-TYPE (LOOP-COLLECTOR-DTYPE LC) *LOOP-REAL-DATA-TYPE*)
        (LET ((DATA (LOOP-COLLECTOR-DATA LC)))
          (UNLESS DATA
            (SETF (LOOP-COLLECTOR-DATA LC)
                    (SETQ DATA
                            (MAKE-LOOP-MINIMAX
                             (OR (LOOP-COLLECTOR-NAME LC)
                                 (LOOP-GENTEMP 'LOOP-MAXMIN-))
                             (LOOP-COLLECTOR-DTYPE LC))))
            (UNLESS (LOOP-COLLECTOR-NAME LC)
              (LOOP-EMIT-FINAL-VALUE (LOOP-MINIMAX-ANSWER-VARIABLE DATA))))
          (LOOP-NOTE-MINIMAX-OPERATION SPECIFICALLY DATA)
          (PUSH
           (ECLECTOR.READER:QUASIQUOTE
            (WITH-MINIMAX-VALUE (ECLECTOR.READER:UNQUOTE DATA)))
           *LOOP-WRAPPERS*)
          (LOOP-EMIT-BODY
           (ECLECTOR.READER:QUASIQUOTE
            (LOOP-ACCUMULATE-MINIMAX-VALUE (ECLECTOR.READER:UNQUOTE DATA)
             (ECLECTOR.READER:UNQUOTE SPECIFICALLY)
             (ECLECTOR.READER:UNQUOTE FORM)))))))
    (DEFUN LOOP-DO-ALWAYS (RESTRICTIVE NEGATE)
      (LET ((FORM (LOOP-GET-FORM)))
        (WHEN RESTRICTIVE (LOOP-DISALLOW-CONDITIONAL))
        (LOOP-EMIT-BODY
         (ECLECTOR.READER:QUASIQUOTE
          ((ECLECTOR.READER:UNQUOTE
            (IF NEGATE
                'WHEN
                'UNLESS))
           (ECLECTOR.READER:UNQUOTE FORM)
           (ECLECTOR.READER:UNQUOTE (LOOP-CONSTRUCT-RETURN NIL)))))
        (LOOP-EMIT-FINAL-VALUE T)))
    (DEFUN LOOP-DO-THEREIS (RESTRICTIVE)
      (WHEN RESTRICTIVE (LOOP-DISALLOW-CONDITIONAL))
      (LOOP-EMIT-BODY
       (ECLECTOR.READER:QUASIQUOTE
        (WHEN
            (SETQ (ECLECTOR.READER:UNQUOTE (LOOP-WHEN-IT-VARIABLE))
                    (ECLECTOR.READER:UNQUOTE (LOOP-GET-FORM)))
          (ECLECTOR.READER:UNQUOTE
           (LOOP-CONSTRUCT-RETURN *LOOP-WHEN-IT-VARIABLE*))))))
    (DEFUN LOOP-DO-WHILE (NEGATE KWD &AUX (FORM (LOOP-GET-FORM)))
      (LOOP-DISALLOW-CONDITIONAL KWD)
      (LOOP-PSEUDO-BODY
       (ECLECTOR.READER:QUASIQUOTE
        ((ECLECTOR.READER:UNQUOTE
          (IF NEGATE
              'WHEN
              'UNLESS))
         (ECLECTOR.READER:UNQUOTE FORM) (GO END-LOOP)))))
    (DEFUN LOOP-DO-WITH ()
      (LOOP-DISALLOW-CONDITIONAL :WITH)
      (DO ((VAR)
           (VAL)
           (DTYPE))
          (NIL)
        (SETQ VAR (LOOP-POP-SOURCE)
              DTYPE (LOOP-OPTIONAL-TYPE VAR)
              VAL
                (COND
                 ((LOOP-TEQUAL (CAR *LOOP-SOURCE-CODE*) :=) (LOOP-POP-SOURCE)
                  (LOOP-GET-FORM))
                 (T NIL)))
        (LOOP-MAKE-VARIABLE VAR VAL DTYPE)
        (IF (LOOP-TEQUAL (CAR *LOOP-SOURCE-CODE*) :AND)
            (LOOP-POP-SOURCE)
            (RETURN (LOOP-BIND-BLOCK)))))
    (DEFUN LOOP-HACK-ITERATION (ENTRY)
      (FLET ((MAKE-ENDTEST (LIST-OF-FORMS)
               (COND ((NULL LIST-OF-FORMS) NIL)
                     ((MEMBER T LIST-OF-FORMS) '(GO END-LOOP))
                     (T
                      (ECLECTOR.READER:QUASIQUOTE
                       (WHEN
                           (ECLECTOR.READER:UNQUOTE
                            (IF (NULL
                                 (CDR
                                  (SETQ LIST-OF-FORMS
                                          (NREVERSE LIST-OF-FORMS))))
                                (CAR LIST-OF-FORMS)
                                (CONS 'OR LIST-OF-FORMS)))
                         (GO END-LOOP)))))))
        (DO ((PRE-STEP-TESTS NIL)
             (STEPS NIL)
             (POST-STEP-TESTS NIL)
             (PSEUDO-STEPS NIL)
             (PRE-LOOP-PRE-STEP-TESTS NIL)
             (PRE-LOOP-STEPS NIL)
             (PRE-LOOP-POST-STEP-TESTS NIL)
             (PRE-LOOP-PSEUDO-STEPS NIL)
             (TEM)
             (DATA))
            (NIL)
          (SETQ TEM
                  (SETQ DATA
                          (APPLY (SYMBOL-FUNCTION (FIRST ENTRY))
                                 (REST ENTRY))))
          (AND (CAR TEM) (PUSH (CAR TEM) PRE-STEP-TESTS))
          (SETQ STEPS
                  (NCONC STEPS (LOOP-COPYLIST* (CAR (SETQ TEM (CDR TEM))))))
          (AND (CAR (SETQ TEM (CDR TEM))) (PUSH (CAR TEM) POST-STEP-TESTS))
          (SETQ PSEUDO-STEPS
                  (NCONC PSEUDO-STEPS
                         (LOOP-COPYLIST* (CAR (SETQ TEM (CDR TEM))))))
          (SETQ TEM (CDR TEM))
          (WHEN *LOOP-EMITTED-BODY*
            (WARN "Iteration in LOOP follows body code."))
          (UNLESS TEM (SETQ TEM DATA))
          (WHEN (CAR TEM) (PUSH (CAR TEM) PRE-LOOP-PRE-STEP-TESTS))
          (SETQ PRE-LOOP-STEPS
                  (NCONC PRE-LOOP-STEPS
                         (LOOP-COPYLIST* (CAR (SETQ TEM (CDR TEM))))))
          (WHEN (CAR (SETQ TEM (CDR TEM)))
            (PUSH (CAR TEM) PRE-LOOP-POST-STEP-TESTS))
          (SETQ PRE-LOOP-PSEUDO-STEPS
                  (NCONC PRE-LOOP-PSEUDO-STEPS (LOOP-COPYLIST* (CADR TEM))))
          (UNLESS (LOOP-TEQUAL (CAR *LOOP-SOURCE-CODE*) :AND)
            (SETQ *LOOP-BEFORE-LOOP*
                    (LIST* (LOOP-MAKE-DESETQ PRE-LOOP-PSEUDO-STEPS)
                           (MAKE-ENDTEST PRE-LOOP-POST-STEP-TESTS)
                           (LOOP-MAKE-PSETQ PRE-LOOP-STEPS)
                           (MAKE-ENDTEST PRE-LOOP-PRE-STEP-TESTS)
                           *LOOP-BEFORE-LOOP*)
                  *LOOP-AFTER-BODY*
                    (LIST* (LOOP-MAKE-DESETQ PSEUDO-STEPS)
                           (MAKE-ENDTEST POST-STEP-TESTS)
                           (LOOP-MAKE-PSETQ STEPS)
                           (MAKE-ENDTEST PRE-STEP-TESTS) *LOOP-AFTER-BODY*))
            (LOOP-BIND-BLOCK)
            (RETURN NIL))
          (LOOP-POP-SOURCE)
          (WHEN
              (AND (NOT (LOOP-UNIVERSE-IMPLICIT-FOR-REQUIRED *LOOP-UNIVERSE*))
                   (SETQ TEM
                           (LOOP-LOOKUP-KEYWORD (CAR *LOOP-SOURCE-CODE*)
                            (LOOP-UNIVERSE-ITERATION-KEYWORDS
                             *LOOP-UNIVERSE*))))
            (LOOP-POP-SOURCE)
            (SETQ ENTRY TEM)))))
    (DEFUN LOOP-DO-FOR ()
      (LET* ((VAR (LOOP-POP-SOURCE))
             (DATA-TYPE (LOOP-OPTIONAL-TYPE VAR))
             (KEYWORD (LOOP-POP-SOURCE))
             (FIRST-ARG NIL)
             (TEM NIL))
        (SETQ FIRST-ARG (LOOP-GET-FORM))
        (UNLESS
            (AND (SYMBOLP KEYWORD)
                 (SETQ TEM
                         (LOOP-LOOKUP-KEYWORD KEYWORD
                          (LOOP-UNIVERSE-FOR-KEYWORDS *LOOP-UNIVERSE*))))
          (LOOP-ERROR "~S is an unknown keyword in FOR or AS clause in LOOP."
           KEYWORD))
        (APPLY (CAR TEM) VAR FIRST-ARG DATA-TYPE (CDR TEM))))
    (DEFUN LOOP-DO-REPEAT ()
      (LET ((FORM (LOOP-GET-FORM))
            (TYPE
             (LOOP-CHECK-DATA-TYPE (LOOP-OPTIONAL-TYPE) *LOOP-REAL-DATA-TYPE*)))
        (WHEN
            (AND (CONSP FORM) (EQ (CAR FORM) 'THE)
                 (SUBTYPEP (SECOND FORM) TYPE))
          (SETQ TYPE (SECOND FORM)))
        (MULTIPLE-VALUE-BIND (NUMBER CONSTANTP VALUE)
            (LOOP-CONSTANT-FOLD-IF-POSSIBLE FORM TYPE)
          (COND
           ((AND CONSTANTP (<= VALUE 1))
            (ECLECTOR.READER:QUASIQUOTE
             (T NIL NIL NIL (ECLECTOR.READER:UNQUOTE (<= VALUE 0)) NIL NIL
              NIL)))
           (T
            (LET ((VAR
                   (LOOP-MAKE-VARIABLE (LOOP-GENTEMP 'LOOP-REPEAT-) NUMBER
                    TYPE)))
              (IF CONSTANTP
                  (ECLECTOR.READER:QUASIQUOTE
                   ((NOT
                     (PLUSP
                      (SETQ (ECLECTOR.READER:UNQUOTE VAR)
                              (1- (ECLECTOR.READER:UNQUOTE VAR)))))
                    NIL NIL NIL NIL NIL NIL NIL))
                  (ECLECTOR.READER:QUASIQUOTE
                   ((MINUSP
                     (SETQ (ECLECTOR.READER:UNQUOTE VAR)
                             (1- (ECLECTOR.READER:UNQUOTE VAR))))
                    NIL NIL NIL)))))))))
    (DEFUN LOOP-WHEN-IT-VARIABLE ()
      (OR *LOOP-WHEN-IT-VARIABLE*
          (SETQ *LOOP-WHEN-IT-VARIABLE*
                  (LOOP-MAKE-VARIABLE (LOOP-GENTEMP 'LOOP-IT-) NIL NIL))))
    (DEFUN LOOP-ANSI-FOR-EQUALS (VAR VAL DATA-TYPE)
      (LOOP-MAKE-ITERATION-VARIABLE VAR NIL DATA-TYPE)
      (COND
       ((LOOP-TEQUAL (CAR *LOOP-SOURCE-CODE*) :THEN) (LOOP-POP-SOURCE)
        (ECLECTOR.READER:QUASIQUOTE
         (NIL
          ((ECLECTOR.READER:UNQUOTE VAR)
           (ECLECTOR.READER:UNQUOTE (LOOP-GET-FORM)))
          NIL NIL NIL
          ((ECLECTOR.READER:UNQUOTE VAR) (ECLECTOR.READER:UNQUOTE VAL)) NIL
          NIL)))
       (T
        (ECLECTOR.READER:QUASIQUOTE
         (NIL ((ECLECTOR.READER:UNQUOTE VAR) (ECLECTOR.READER:UNQUOTE VAL)) NIL
          NIL)))))
    (DEFUN LOOP-FOR-ACROSS (VAR VAL DATA-TYPE)
      (LOOP-MAKE-ITERATION-VARIABLE VAR NIL DATA-TYPE)
      (LET ((VECTOR-VAR (LOOP-GENTEMP 'LOOP-ACROSS-VECTOR-))
            (INDEX-VAR (LOOP-GENTEMP 'LOOP-ACROSS-INDEX-)))
        (MULTIPLE-VALUE-BIND (VECTOR-FORM CONSTANTP VECTOR-VALUE)
            (LOOP-CONSTANT-FOLD-IF-POSSIBLE VAL 'VECTOR)
          (LOOP-MAKE-VARIABLE VECTOR-VAR VECTOR-FORM
           (IF (AND (CONSP VECTOR-FORM) (EQ (CAR VECTOR-FORM) 'THE))
               (CADR VECTOR-FORM)
               'VECTOR))
          (PUSH
           (ECLECTOR.READER:QUASIQUOTE
            (#S(FORMGREP:SYMREF :NAME "ARRAY-REGISTER" :QUALIFIER "SYSTEM")
             (ECLECTOR.READER:UNQUOTE VECTOR-VAR)))
           *LOOP-DECLARATIONS*)
          (LOOP-MAKE-VARIABLE INDEX-VAR 0 'FIXNUM)
          (LET* ((LENGTH 0)
                 (LENGTH-FORM
                  (COND
                   ((NOT CONSTANTP)
                    (LET ((V (LOOP-GENTEMP 'LOOP-ACROSS-LIMIT-)))
                      (PUSH
                       (ECLECTOR.READER:QUASIQUOTE
                        (SETQ (ECLECTOR.READER:UNQUOTE V)
                                (LENGTH (ECLECTOR.READER:UNQUOTE VECTOR-VAR))))
                       *LOOP-PROLOGUE*)
                      (LOOP-MAKE-VARIABLE V 0 'FIXNUM)))
                   (T (SETQ LENGTH (LENGTH VECTOR-VALUE)))))
                 (FIRST-TEST
                  (ECLECTOR.READER:QUASIQUOTE
                   (>= (ECLECTOR.READER:UNQUOTE INDEX-VAR)
                       (ECLECTOR.READER:UNQUOTE LENGTH-FORM))))
                 (OTHER-TEST FIRST-TEST)
                 (STEP
                  (ECLECTOR.READER:QUASIQUOTE
                   ((ECLECTOR.READER:UNQUOTE VAR)
                    (AREF (ECLECTOR.READER:UNQUOTE VECTOR-VAR)
                          (ECLECTOR.READER:UNQUOTE INDEX-VAR)))))
                 (PSTEP
                  (ECLECTOR.READER:QUASIQUOTE
                   ((ECLECTOR.READER:UNQUOTE INDEX-VAR)
                    (1+ (ECLECTOR.READER:UNQUOTE INDEX-VAR))))))
            (DECLARE (TYPE FIXNUM LENGTH))
            (WHEN CONSTANTP
              (SETQ FIRST-TEST (= LENGTH 0))
              (WHEN (<= LENGTH 1) (SETQ OTHER-TEST T)))
            (ECLECTOR.READER:QUASIQUOTE
             ((ECLECTOR.READER:UNQUOTE OTHER-TEST)
              (ECLECTOR.READER:UNQUOTE STEP) NIL
              (ECLECTOR.READER:UNQUOTE PSTEP)
              (ECLECTOR.READER:UNQUOTE-SPLICING
               (AND (NOT (EQ FIRST-TEST OTHER-TEST))
                    (ECLECTOR.READER:QUASIQUOTE
                     ((ECLECTOR.READER:UNQUOTE FIRST-TEST)
                      (ECLECTOR.READER:UNQUOTE STEP) NIL
                      (ECLECTOR.READER:UNQUOTE PSTEP)))))))))))
    (DEFUN LOOP-LIST-STEP (LISTVAR)
      (LET ((STEPPER
             (COND
              ((LOOP-TEQUAL (CAR *LOOP-SOURCE-CODE*) :BY) (LOOP-POP-SOURCE)
               (LOOP-GET-FORM))
              (T '#'CDR))))
        (COND
         ((AND (CONSP STEPPER) (EQ (CAR STEPPER) 'QUOTE))
          (LOOP-WARN
           "Use of QUOTE around stepping function in LOOP will be left verbatim.")
          (VALUES
           (ECLECTOR.READER:QUASIQUOTE
            (FUNCALL (ECLECTOR.READER:UNQUOTE STEPPER)
                     (ECLECTOR.READER:UNQUOTE LISTVAR)))
           NIL))
         ((AND (CONSP STEPPER) (EQ (CAR STEPPER) 'FUNCTION))
          (VALUES (LIST (CADR STEPPER) LISTVAR) (CADR STEPPER)))
         (T
          (VALUES
           (ECLECTOR.READER:QUASIQUOTE
            (FUNCALL
             (ECLECTOR.READER:UNQUOTE
              (LOOP-MAKE-VARIABLE (LOOP-GENTEMP 'LOOP-FN-) STEPPER 'FUNCTION))
             (ECLECTOR.READER:UNQUOTE LISTVAR)))
           NIL)))))
    (DEFUN LOOP-FOR-ON (VAR VAL DATA-TYPE)
      (MULTIPLE-VALUE-BIND (LIST CONSTANTP LIST-VALUE)
          (LOOP-CONSTANT-FOLD-IF-POSSIBLE VAL)
        (LET ((LISTVAR VAR))
          (COND
           ((AND VAR (SYMBOLP VAR))
            (LOOP-MAKE-ITERATION-VARIABLE VAR LIST DATA-TYPE))
           (T
            (LOOP-MAKE-VARIABLE (SETQ LISTVAR (LOOP-GENTEMP)) LIST
             *LOOP-LIST-DATA-TYPE*)
            (LOOP-MAKE-ITERATION-VARIABLE VAR NIL DATA-TYPE)))
          (MULTIPLE-VALUE-BIND (LIST-STEP STEP-FUNCTION)
              (LOOP-LIST-STEP LISTVAR)
            (DECLARE (IGNORE STEP-FUNCTION))
            (LET* ((FIRST-ENDTEST
                    (HIDE-VARIABLE-REFERENCE (EQ VAR LISTVAR) LISTVAR
                     (ECLECTOR.READER:QUASIQUOTE
                      (ATOM (ECLECTOR.READER:UNQUOTE LISTVAR)))))
                   (OTHER-ENDTEST FIRST-ENDTEST))
              (WHEN (AND CONSTANTP (LISTP LIST-VALUE))
                (SETQ FIRST-ENDTEST (NULL LIST-VALUE)))
              (COND
               ((EQ VAR LISTVAR)
                (ECLECTOR.READER:QUASIQUOTE
                 (NIL
                  ((ECLECTOR.READER:UNQUOTE LISTVAR)
                   (ECLECTOR.READER:UNQUOTE
                    (HIDE-VARIABLE-REFERENCE T LISTVAR LIST-STEP)))
                  (ECLECTOR.READER:UNQUOTE OTHER-ENDTEST) NIL NIL NIL
                  (ECLECTOR.READER:UNQUOTE FIRST-ENDTEST) NIL)))
               ((AND STEP-FUNCTION
                     (LET ((N
                            (CDR
                             (ASSOC STEP-FUNCTION
                                    '((CDR . 1) (CDDR . 2) (CDDDR . 3)
                                      (CDDDDR . 4))))))
                       (AND N
                            (DO ((L VAR (CDR L))
                                 (I 0 (1+ I)))
                                ((ATOM L) (AND (NULL L) (= I N)))
                              (DECLARE (FIXNUM I))))))
                (LET ((STEP
                       (MAPCAN
                        #'(LAMBDA (X)
                            (LIST X
                                  (ECLECTOR.READER:QUASIQUOTE
                                   (POP (ECLECTOR.READER:UNQUOTE LISTVAR)))))
                        VAR)))
                  (ECLECTOR.READER:QUASIQUOTE
                   ((ECLECTOR.READER:UNQUOTE OTHER-ENDTEST) NIL NIL
                    (ECLECTOR.READER:UNQUOTE STEP)
                    (ECLECTOR.READER:UNQUOTE FIRST-ENDTEST) NIL NIL
                    (ECLECTOR.READER:UNQUOTE STEP)))))
               (T
                (LET ((STEP
                       (ECLECTOR.READER:QUASIQUOTE
                        ((ECLECTOR.READER:UNQUOTE VAR)
                         (ECLECTOR.READER:UNQUOTE LISTVAR))))
                      (PSEUDO
                       (ECLECTOR.READER:QUASIQUOTE
                        ((ECLECTOR.READER:UNQUOTE LISTVAR)
                         (ECLECTOR.READER:UNQUOTE LIST-STEP)))))
                  (ECLECTOR.READER:QUASIQUOTE
                   ((ECLECTOR.READER:UNQUOTE OTHER-ENDTEST)
                    (ECLECTOR.READER:UNQUOTE STEP) NIL
                    (ECLECTOR.READER:UNQUOTE PSEUDO)
                    (ECLECTOR.READER:UNQUOTE-SPLICING
                     (AND (NOT (EQ FIRST-ENDTEST OTHER-ENDTEST))
                          (ECLECTOR.READER:QUASIQUOTE
                           ((ECLECTOR.READER:UNQUOTE FIRST-ENDTEST)
                            (ECLECTOR.READER:UNQUOTE STEP) NIL
                            (ECLECTOR.READER:UNQUOTE PSEUDO)))))))))))))))
    (DEFUN LOOP-FOR-IN (VAR VAL DATA-TYPE)
      (MULTIPLE-VALUE-BIND (LIST CONSTANTP LIST-VALUE)
          (LOOP-CONSTANT-FOLD-IF-POSSIBLE VAL)
        (LET ((LISTVAR (LOOP-GENTEMP 'LOOP-LIST-)))
          (LOOP-MAKE-ITERATION-VARIABLE VAR NIL DATA-TYPE)
          (LOOP-MAKE-VARIABLE LISTVAR LIST *LOOP-LIST-DATA-TYPE*)
          (MULTIPLE-VALUE-BIND (LIST-STEP STEP-FUNCTION)
              (LOOP-LIST-STEP LISTVAR)
            (LET* ((FIRST-ENDTEST
                    (ECLECTOR.READER:QUASIQUOTE
                     (ENDP (ECLECTOR.READER:UNQUOTE LISTVAR))))
                   (OTHER-ENDTEST FIRST-ENDTEST)
                   (STEP
                    (ECLECTOR.READER:QUASIQUOTE
                     ((ECLECTOR.READER:UNQUOTE VAR)
                      (CAR (ECLECTOR.READER:UNQUOTE LISTVAR)))))
                   (PSEUDO-STEP
                    (ECLECTOR.READER:QUASIQUOTE
                     ((ECLECTOR.READER:UNQUOTE LISTVAR)
                      (ECLECTOR.READER:UNQUOTE LIST-STEP)))))
              (WHEN (AND CONSTANTP (LISTP LIST-VALUE))
                (SETQ FIRST-ENDTEST (NULL LIST-VALUE)))
              (WHEN (EQ STEP-FUNCTION 'CDR)
                (SETQ STEP
                        (ECLECTOR.READER:QUASIQUOTE
                         ((ECLECTOR.READER:UNQUOTE VAR)
                          (POP (ECLECTOR.READER:UNQUOTE LISTVAR))))
                      PSEUDO-STEP NIL))
              (ECLECTOR.READER:QUASIQUOTE
               ((ECLECTOR.READER:UNQUOTE OTHER-ENDTEST)
                (ECLECTOR.READER:UNQUOTE STEP) NIL
                (ECLECTOR.READER:UNQUOTE PSEUDO-STEP)
                (ECLECTOR.READER:UNQUOTE-SPLICING
                 (AND (NOT (EQ FIRST-ENDTEST OTHER-ENDTEST))
                      (ECLECTOR.READER:QUASIQUOTE
                       ((ECLECTOR.READER:UNQUOTE FIRST-ENDTEST)
                        (ECLECTOR.READER:UNQUOTE STEP) NIL
                        (ECLECTOR.READER:UNQUOTE PSEUDO-STEP))))))))))))
    (DEFSTRUCT (LOOP-PATH (:COPIER NIL) (:PREDICATE NIL))
      NAMES
      PREPOSITION-GROUPS
      INCLUSIVE-PERMITTED
      FUNCTION
      USER-DATA)
    (DEFUN ADD-LOOP-PATH
           (NAMES FUNCTION UNIVERSE
            &KEY PREPOSITION-GROUPS INCLUSIVE-PERMITTED USER-DATA)
      (UNLESS (LISTP NAMES) (SETQ NAMES (LIST NAMES)))
      (LET ((HT (LOOP-UNIVERSE-PATH-KEYWORDS UNIVERSE))
            (LP
             (MAKE-LOOP-PATH :NAMES (MAPCAR #'SYMBOL-NAME NAMES) :FUNCTION
              FUNCTION :USER-DATA USER-DATA :PREPOSITION-GROUPS
              (MAPCAR
               #'(LAMBDA (X)
                   (IF (LISTP X)
                       X
                       (LIST X)))
               PREPOSITION-GROUPS)
              :INCLUSIVE-PERMITTED INCLUSIVE-PERMITTED)))
        (DOLIST (NAME NAMES) (SETF (GETHASH (SYMBOL-NAME NAME) HT) LP))
        LP))
    (DEFUN LOOP-FOR-BEING (VAR VAL DATA-TYPE)
      (LET ((PATH NIL)
            (DATA NIL)
            (INCLUSIVE NIL)
            (STUFF NIL)
            (INITIAL-PREPOSITIONS NIL))
        (COND ((LOOP-TMEMBER VAL '(:EACH :THE)) (SETQ PATH (LOOP-POP-SOURCE)))
              ((LOOP-TEQUAL (CAR *LOOP-SOURCE-CODE*) :AND) (LOOP-POP-SOURCE)
               (SETQ INCLUSIVE T)
               (UNLESS
                   (LOOP-TMEMBER (CAR *LOOP-SOURCE-CODE*)
                    '(:ITS :EACH :HIS :HER))
                 (LOOP-ERROR
                  "~S found where ITS or EACH expected in LOOP iteration path syntax."
                  (CAR *LOOP-SOURCE-CODE*)))
               (LOOP-POP-SOURCE) (SETQ PATH (LOOP-POP-SOURCE))
               (SETQ INITIAL-PREPOSITIONS
                       (ECLECTOR.READER:QUASIQUOTE
                        ((:IN (ECLECTOR.READER:UNQUOTE VAL))))))
              (T
               (LOOP-ERROR
                "Unrecognizable LOOP iteration path syntax.  Missing EACH or THE?")))
        (COND
         ((NOT (SYMBOLP PATH))
          (LOOP-ERROR "~S found where a LOOP iteration path name was expected."
           PATH))
         ((NOT
           (SETQ DATA
                   (LOOP-LOOKUP-KEYWORD PATH
                    (LOOP-UNIVERSE-PATH-KEYWORDS *LOOP-UNIVERSE*))))
          (LOOP-ERROR "~S is not the name of a LOOP iteration path." PATH))
         ((AND INCLUSIVE (NOT (LOOP-PATH-INCLUSIVE-PERMITTED DATA)))
          (LOOP-ERROR
           "\"Inclusive\" iteration is not possible with the ~S LOOP iteration path."
           PATH)))
        (LET ((FUN (LOOP-PATH-FUNCTION DATA))
              (PREPS
               (NCONC INITIAL-PREPOSITIONS
                      (LOOP-COLLECT-PREPOSITIONAL-PHRASES
                       (LOOP-PATH-PREPOSITION-GROUPS DATA) T)))
              (USER-DATA (LOOP-PATH-USER-DATA DATA)))
          (WHEN (SYMBOLP FUN) (SETQ FUN (SYMBOL-FUNCTION FUN)))
          (SETQ STUFF
                  (IF INCLUSIVE
                      (APPLY FUN VAR DATA-TYPE PREPS :INCLUSIVE T USER-DATA)
                      (APPLY FUN VAR DATA-TYPE PREPS USER-DATA))))
        (WHEN *LOOP-NAMED-VARIABLES*
          (LOOP-ERROR "Unused USING variables: ~S." *LOOP-NAMED-VARIABLES*))
        (UNLESS (MEMBER (LENGTH STUFF) '(6 10))
          (LOOP-ERROR
           "Value passed back by LOOP iteration path function for path ~S has invalid length."
           PATH))
        (DO ((L (CAR STUFF) (CDR L))
             (X))
            ((NULL L))
          (IF (ATOM (SETQ X (CAR L)))
              (LOOP-MAKE-ITERATION-VARIABLE X NIL NIL)
              (LOOP-MAKE-ITERATION-VARIABLE (CAR X) (CADR X) (CADDR X))))
        (SETQ *LOOP-PROLOGUE* (NCONC (REVERSE (CADR STUFF)) *LOOP-PROLOGUE*))
        (CDDR STUFF)))
    (DEFUN NAMED-VARIABLE (NAME)
      (LET ((TEM (LOOP-TASSOC NAME *LOOP-NAMED-VARIABLES*)))
        (DECLARE (TYPE LIST TEM))
        (COND ((NULL TEM) (VALUES (LOOP-GENTEMP) NIL))
              (T
               (SETQ *LOOP-NAMED-VARIABLES*
                       (DELETE TEM *LOOP-NAMED-VARIABLES*))
               (VALUES (CDR TEM) T)))))
    (DEFUN LOOP-COLLECT-PREPOSITIONAL-PHRASES
           (PREPOSITION-GROUPS &OPTIONAL USING-ALLOWED INITIAL-PHRASES)
      (FLET ((IN-GROUP-P (X GROUP)
               (CAR (LOOP-TMEMBER X GROUP))))
        (DO ((TOKEN NIL)
             (PREPOSITIONAL-PHRASES INITIAL-PHRASES)
             (THIS-GROUP NIL NIL)
             (THIS-PREP NIL NIL)
             (DISALLOWED-PREPOSITIONS (MAPCAN
                                       #'(LAMBDA (X)
                                           (LOOP-COPYLIST*
                                            (FIND (CAR X) PREPOSITION-GROUPS
                                                  :TEST #'IN-GROUP-P)))
                                       INITIAL-PHRASES))
             (USED-PREPOSITIONS (MAPCAR #'CAR INITIAL-PHRASES)))
            ((NULL *LOOP-SOURCE-CODE*) (NREVERSE PREPOSITIONAL-PHRASES))
          (DECLARE (TYPE SYMBOL THIS-PREP))
          (SETQ TOKEN (CAR *LOOP-SOURCE-CODE*))
          (DOLIST (GROUP PREPOSITION-GROUPS)
            (WHEN (SETQ THIS-PREP (IN-GROUP-P TOKEN GROUP))
              (RETURN (SETQ THIS-GROUP GROUP))))
          (COND
           (THIS-GROUP
            (WHEN (MEMBER THIS-PREP DISALLOWED-PREPOSITIONS)
              (LOOP-ERROR
               (IF (MEMBER THIS-PREP USED-PREPOSITIONS)
                   "A ~S prepositional phrase occurs multiply for some LOOP clause."
                   "Preposition ~S used when some other preposition has subsumed it.")
               TOKEN))
            (SETQ USED-PREPOSITIONS
                    (IF (LISTP THIS-GROUP)
                        (APPEND THIS-GROUP USED-PREPOSITIONS)
                        (CONS THIS-GROUP USED-PREPOSITIONS)))
            (LOOP-POP-SOURCE)
            (PUSH (LIST THIS-PREP (LOOP-GET-FORM)) PREPOSITIONAL-PHRASES))
           ((AND USING-ALLOWED (LOOP-TEQUAL TOKEN 'USING)) (LOOP-POP-SOURCE)
            (DO ((Z (LOOP-POP-SOURCE) (LOOP-POP-SOURCE))
                 (TEM))
                (NIL)
              (WHEN
                  (OR (ATOM Z) (ATOM (CDR Z)) (NOT (NULL (CDDR Z)))
                      (NOT (SYMBOLP (CAR Z)))
                      (AND (CADR Z) (NOT (SYMBOLP (CADR Z)))))
                (LOOP-ERROR "~S bad variable pair in path USING phrase." Z))
              (WHEN (CADR Z)
                (IF (SETQ TEM (LOOP-TASSOC (CAR Z) *LOOP-NAMED-VARIABLES*))
                    (LOOP-ERROR
                     "The variable substitution for ~S occurs twice in a USING phrase,~@
		        with ~S and ~S."
                     (CAR Z) (CADR Z) (CADR TEM))
                    (PUSH (CONS (CAR Z) (CADR Z)) *LOOP-NAMED-VARIABLES*)))
              (WHEN
                  (OR (NULL *LOOP-SOURCE-CODE*)
                      (SYMBOLP (CAR *LOOP-SOURCE-CODE*)))
                (RETURN NIL))))
           (T (RETURN (NREVERSE PREPOSITIONAL-PHRASES)))))))
    (DEFUN LOOP-SEQUENCER
           (INDEXV INDEXV-TYPE INDEXV-USER-SPECIFIED-P VARIABLE VARIABLE-TYPE
            SEQUENCE-VARIABLE SEQUENCE-TYPE STEP-HACK DEFAULT-TOP PREP-PHRASES)
      (LET ((ENDFORM NIL)
            (SEQUENCEP NIL)
            (TESTFN NIL)
            (TEST NIL)
            (STEPBY (1+ (OR (LOOP-TYPED-INIT INDEXV-TYPE) 0)))
            (STEPBY-CONSTANTP T)
            (STEP NIL)
            (DIR NIL)
            (INCLUSIVE-ITERATION NIL)
            (START-GIVEN NIL)
            (START-VALUE NIL)
            (START-CONSTANTP NIL)
            (LIMIT-GIVEN NIL)
            (LIMIT-CONSTANTP NIL)
            (LIMIT-VALUE NIL))
        (WHEN VARIABLE
          (LOOP-MAKE-ITERATION-VARIABLE VARIABLE NIL VARIABLE-TYPE))
        (DO ((L PREP-PHRASES (CDR L))
             (PREP)
             (FORM)
             (ODIR))
            ((NULL L))
          (SETQ PREP (CAAR L)
                FORM (CADAR L))
          (CASE PREP
            ((:OF :IN)
             (SETQ SEQUENCEP T)
             (LOOP-MAKE-VARIABLE SEQUENCE-VARIABLE FORM SEQUENCE-TYPE))
            ((:FROM :DOWNFROM :UPFROM)
             (SETQ START-GIVEN T)
             (COND ((EQ PREP :DOWNFROM) (SETQ DIR ':DOWN))
                   ((EQ PREP :UPFROM) (SETQ DIR ':UP)))
             (MULTIPLE-VALUE-SETQ (FORM START-CONSTANTP START-VALUE)
               (LOOP-CONSTANT-FOLD-IF-POSSIBLE FORM INDEXV-TYPE))
             (LOOP-MAKE-ITERATION-VARIABLE INDEXV FORM INDEXV-TYPE))
            ((:UPTO :TO :DOWNTO :ABOVE :BELOW)
             (COND
              ((LOOP-TEQUAL PREP :UPTO)
               (SETQ INCLUSIVE-ITERATION (SETQ DIR ':UP)))
              ((LOOP-TEQUAL PREP :TO) (SETQ INCLUSIVE-ITERATION T))
              ((LOOP-TEQUAL PREP :DOWNTO)
               (SETQ INCLUSIVE-ITERATION (SETQ DIR ':DOWN)))
              ((LOOP-TEQUAL PREP :ABOVE) (SETQ DIR ':DOWN))
              ((LOOP-TEQUAL PREP :BELOW) (SETQ DIR ':UP)))
             (SETQ LIMIT-GIVEN T)
             (MULTIPLE-VALUE-SETQ (FORM LIMIT-CONSTANTP LIMIT-VALUE)
               (LOOP-CONSTANT-FOLD-IF-POSSIBLE FORM INDEXV-TYPE))
             (SETQ ENDFORM
                     (IF LIMIT-CONSTANTP
                         (ECLECTOR.READER:QUASIQUOTE
                          '(ECLECTOR.READER:UNQUOTE LIMIT-VALUE))
                         (LOOP-MAKE-VARIABLE (LOOP-GENTEMP 'LOOP-LIMIT-) FORM
                          INDEXV-TYPE))))
            (:BY
             (MULTIPLE-VALUE-SETQ (FORM STEPBY-CONSTANTP STEPBY)
               (LOOP-CONSTANT-FOLD-IF-POSSIBLE FORM INDEXV-TYPE))
             (UNLESS STEPBY-CONSTANTP
               (LOOP-MAKE-VARIABLE (SETQ STEPBY (LOOP-GENTEMP 'LOOP-STEP-BY-))
                FORM INDEXV-TYPE)))
            (T
             (LOOP-ERROR
              "~S invalid preposition in sequencing or sequence path.~@
	       Invalid prepositions specified in iteration path descriptor or something?"
              PREP)))
          (WHEN (AND ODIR DIR (NOT (EQ DIR ODIR)))
            (LOOP-ERROR
             "Conflicting stepping directions in LOOP sequencing path"))
          (SETQ ODIR DIR))
        (WHEN (AND SEQUENCE-VARIABLE (NOT SEQUENCEP))
          (LOOP-ERROR "Missing OF or IN phrase in sequence path"))
        (UNLESS START-GIVEN
          (LOOP-MAKE-ITERATION-VARIABLE INDEXV
           (SETQ START-CONSTANTP T
                 START-VALUE (OR (LOOP-TYPED-INIT INDEXV-TYPE) 0))
           INDEXV-TYPE))
        (COND
         ((MEMBER DIR '(NIL :UP))
          (WHEN (OR LIMIT-GIVEN DEFAULT-TOP)
            (UNLESS LIMIT-GIVEN
              (LOOP-MAKE-VARIABLE
               (SETQ ENDFORM (LOOP-GENTEMP 'LOOP-SEQ-LIMIT-)) NIL INDEXV-TYPE)
              (PUSH
               (ECLECTOR.READER:QUASIQUOTE
                (SETQ (ECLECTOR.READER:UNQUOTE ENDFORM)
                        (ECLECTOR.READER:UNQUOTE DEFAULT-TOP)))
               *LOOP-PROLOGUE*))
            (SETQ TESTFN
                    (IF INCLUSIVE-ITERATION
                        '>
                        '>=)))
          (SETQ STEP
                  (IF (EQL STEPBY 1)
                      (ECLECTOR.READER:QUASIQUOTE
                       (1+ (ECLECTOR.READER:UNQUOTE INDEXV)))
                      (ECLECTOR.READER:QUASIQUOTE
                       (+ (ECLECTOR.READER:UNQUOTE INDEXV)
                          (ECLECTOR.READER:UNQUOTE STEPBY))))))
         (T
          (UNLESS START-GIVEN
            (UNLESS DEFAULT-TOP
              (LOOP-ERROR "Don't know where to start stepping."))
            (PUSH
             (ECLECTOR.READER:QUASIQUOTE
              (SETQ (ECLECTOR.READER:UNQUOTE INDEXV)
                      (1- (ECLECTOR.READER:UNQUOTE DEFAULT-TOP))))
             *LOOP-PROLOGUE*))
          (WHEN (AND DEFAULT-TOP (NOT ENDFORM))
            (SETQ ENDFORM (LOOP-TYPED-INIT INDEXV-TYPE)
                  INCLUSIVE-ITERATION T))
          (WHEN ENDFORM
            (SETQ TESTFN
                    (IF INCLUSIVE-ITERATION
                        '<
                        '<=)))
          (SETQ STEP
                  (IF (EQL STEPBY 1)
                      (ECLECTOR.READER:QUASIQUOTE
                       (1- (ECLECTOR.READER:UNQUOTE INDEXV)))
                      (ECLECTOR.READER:QUASIQUOTE
                       (- (ECLECTOR.READER:UNQUOTE INDEXV)
                          (ECLECTOR.READER:UNQUOTE STEPBY)))))))
        (WHEN TESTFN
          (SETQ TEST
                  (HIDE-VARIABLE-REFERENCE T INDEXV
                   (ECLECTOR.READER:QUASIQUOTE
                    ((ECLECTOR.READER:UNQUOTE TESTFN)
                     (ECLECTOR.READER:UNQUOTE INDEXV)
                     (ECLECTOR.READER:UNQUOTE ENDFORM))))))
        (WHEN STEP-HACK
          (SETQ STEP-HACK
                  (ECLECTOR.READER:QUASIQUOTE
                   ((ECLECTOR.READER:UNQUOTE VARIABLE)
                    (ECLECTOR.READER:UNQUOTE
                     (HIDE-VARIABLE-REFERENCE INDEXV-USER-SPECIFIED-P INDEXV
                      STEP-HACK))))))
        (LET ((FIRST-TEST TEST) (REMAINING-TESTS TEST))
          (WHEN (AND STEPBY-CONSTANTP START-CONSTANTP LIMIT-CONSTANTP)
            (WHEN
                (SETQ FIRST-TEST
                        (FUNCALL (SYMBOL-FUNCTION TESTFN) START-VALUE
                                 LIMIT-VALUE))
              (SETQ REMAINING-TESTS T)))
          (ECLECTOR.READER:QUASIQUOTE
           (NIL
            ((ECLECTOR.READER:UNQUOTE INDEXV)
             (ECLECTOR.READER:UNQUOTE (HIDE-VARIABLE-REFERENCE T INDEXV STEP)))
            (ECLECTOR.READER:UNQUOTE REMAINING-TESTS)
            (ECLECTOR.READER:UNQUOTE STEP-HACK) NIL NIL
            (ECLECTOR.READER:UNQUOTE FIRST-TEST)
            (ECLECTOR.READER:UNQUOTE STEP-HACK))))))
    (DEFUN LOOP-FOR-ARITHMETIC (VAR VAL DATA-TYPE KWD)
      (LOOP-SEQUENCER VAR
       (LOOP-CHECK-DATA-TYPE DATA-TYPE *LOOP-REAL-DATA-TYPE*) T NIL NIL NIL NIL
       NIL NIL
       (LOOP-COLLECT-PREPOSITIONAL-PHRASES
        '((:FROM :UPFROM :DOWNFROM) (:TO :UPTO :DOWNTO :ABOVE :BELOW) (:BY))
        NIL (LIST (LIST KWD VAL)))))
    (DEFUN LOOP-SEQUENCE-ELEMENTS-PATH
           (VARIABLE DATA-TYPE PREP-PHRASES
            &KEY FETCH-FUNCTION SIZE-FUNCTION SEQUENCE-TYPE ELEMENT-TYPE)
      (MULTIPLE-VALUE-BIND (INDEXV INDEXV-USER-SPECIFIED-P)
          (NAMED-VARIABLE 'INDEX)
        (LET ((SEQUENCEV (NAMED-VARIABLE 'SEQUENCE)))
          (WHEN
              (AND SEQUENCEV (SYMBOLP SEQUENCEV) SEQUENCE-TYPE
                   (SUBTYPEP SEQUENCE-TYPE 'VECTOR)
                   (NOT (MEMBER (THE SYMBOL SEQUENCEV) *LOOP-NODECLARE*)))
            (PUSH
             (ECLECTOR.READER:QUASIQUOTE
              (#S(FORMGREP:SYMREF :NAME "ARRAY-REGISTER" :QUALIFIER "SYS")
               (ECLECTOR.READER:UNQUOTE SEQUENCEV)))
             *LOOP-DECLARATIONS*))
          (LIST* NIL NIL
                 (LOOP-SEQUENCER INDEXV 'FIXNUM INDEXV-USER-SPECIFIED-P
                  VARIABLE (OR DATA-TYPE ELEMENT-TYPE) SEQUENCEV SEQUENCE-TYPE
                  (ECLECTOR.READER:QUASIQUOTE
                   ((ECLECTOR.READER:UNQUOTE FETCH-FUNCTION)
                    (ECLECTOR.READER:UNQUOTE SEQUENCEV)
                    (ECLECTOR.READER:UNQUOTE INDEXV)))
                  (ECLECTOR.READER:QUASIQUOTE
                   ((ECLECTOR.READER:UNQUOTE SIZE-FUNCTION)
                    (ECLECTOR.READER:UNQUOTE SEQUENCEV)))
                  PREP-PHRASES)))))
    (DEFUN LOOP-HASH-TABLE-ITERATION-PATH
           (VARIABLE DATA-TYPE PREP-PHRASES &KEY WHICH)
      (CHECK-TYPE WHICH (MEMBER HASH-KEY HASH-VALUE))
      (COND
       ((OR (CDR PREP-PHRASES) (NOT (MEMBER (CAAR PREP-PHRASES) '(:IN :OF))))
        (LOOP-ERROR "Too many prepositions!"))
       ((NULL PREP-PHRASES)
        (LOOP-ERROR "Missing OF or IN in ~S iteration path.")))
      (LET ((HT-VAR (LOOP-GENTEMP 'LOOP-HASHTAB-))
            (NEXT-FN (LOOP-GENTEMP 'LOOP-HASHTAB-NEXT-))
            (DUMMY-PREDICATE-VAR NIL)
            (POST-STEPS NIL))
        (MULTIPLE-VALUE-BIND (OTHER-VAR OTHER-P)
            (NAMED-VARIABLE
             (IF (EQ WHICH 'HASH-KEY)
                 'HASH-VALUE
                 'HASH-KEY))
          (LET ((KEY-VAR NIL)
                (VAL-VAR NIL)
                (BINDINGS
                 (ECLECTOR.READER:QUASIQUOTE
                  (((ECLECTOR.READER:UNQUOTE VARIABLE) NIL
                    (ECLECTOR.READER:UNQUOTE DATA-TYPE))
                   ((ECLECTOR.READER:UNQUOTE HT-VAR)
                    (ECLECTOR.READER:UNQUOTE (CADAR PREP-PHRASES)))
                   (ECLECTOR.READER:UNQUOTE-SPLICING
                    (AND OTHER-P OTHER-VAR
                         (ECLECTOR.READER:QUASIQUOTE
                          (((ECLECTOR.READER:UNQUOTE OTHER-VAR) NIL)))))))))
            (IF (EQ WHICH 'HASH-KEY)
                (SETQ KEY-VAR VARIABLE
                      VAL-VAR (AND OTHER-P OTHER-VAR))
                (SETQ KEY-VAR (AND OTHER-P OTHER-VAR)
                      VAL-VAR VARIABLE))
            (PUSH
             (ECLECTOR.READER:QUASIQUOTE
              (WITH-HASH-TABLE-ITERATOR
                  ((ECLECTOR.READER:UNQUOTE NEXT-FN)
                   (ECLECTOR.READER:UNQUOTE HT-VAR))))
             *LOOP-WRAPPERS*)
            (WHEN (CONSP KEY-VAR)
              (SETQ POST-STEPS
                      (ECLECTOR.READER:QUASIQUOTE
                       ((ECLECTOR.READER:UNQUOTE KEY-VAR)
                        (ECLECTOR.READER:UNQUOTE
                         (SETQ KEY-VAR (LOOP-GENTEMP 'LOOP-HASH-KEY-TEMP-)))
                        (ECLECTOR.READER:UNQUOTE-SPLICING POST-STEPS))))
              (PUSH
               (ECLECTOR.READER:QUASIQUOTE
                ((ECLECTOR.READER:UNQUOTE KEY-VAR) NIL))
               BINDINGS))
            (WHEN (CONSP VAL-VAR)
              (SETQ POST-STEPS
                      (ECLECTOR.READER:QUASIQUOTE
                       ((ECLECTOR.READER:UNQUOTE VAL-VAR)
                        (ECLECTOR.READER:UNQUOTE
                         (SETQ VAL-VAR (LOOP-GENTEMP 'LOOP-HASH-VAL-TEMP-)))
                        (ECLECTOR.READER:UNQUOTE-SPLICING POST-STEPS))))
              (PUSH
               (ECLECTOR.READER:QUASIQUOTE
                ((ECLECTOR.READER:UNQUOTE VAL-VAR) NIL))
               BINDINGS))
            (ECLECTOR.READER:QUASIQUOTE
             ((ECLECTOR.READER:UNQUOTE BINDINGS) NIL NIL NIL
              (NOT
               (MULTIPLE-VALUE-SETQ
                   ((ECLECTOR.READER:UNQUOTE DUMMY-PREDICATE-VAR)
                    (ECLECTOR.READER:UNQUOTE KEY-VAR)
                    (ECLECTOR.READER:UNQUOTE VAL-VAR))
                 ((ECLECTOR.READER:UNQUOTE NEXT-FN))))
              (ECLECTOR.READER:UNQUOTE POST-STEPS)))))))
    (DEFUN LOOP-PACKAGE-SYMBOLS-ITERATION-PATH
           (VARIABLE DATA-TYPE PREP-PHRASES &KEY SYMBOL-TYPES)
      (COND
       ((OR (CDR PREP-PHRASES) (NOT (MEMBER (CAAR PREP-PHRASES) '(:IN :OF))))
        (LOOP-ERROR "Too many prepositions!"))
       ((NULL PREP-PHRASES)
        (LOOP-ERROR "Missing OF or IN in ~S iteration path.")))
      (UNLESS (SYMBOLP VARIABLE)
        (LOOP-ERROR
         "Destructuring is not valid for package symbol iteration."))
      (LET ((PKG-VAR (LOOP-GENTEMP 'LOOP-PKGSYM-))
            (NEXT-FN (LOOP-GENTEMP 'LOOP-PKGSYM-NEXT-)))
        (PUSH
         (ECLECTOR.READER:QUASIQUOTE
          (WITH-PACKAGE-ITERATOR
              ((ECLECTOR.READER:UNQUOTE NEXT-FN)
               (ECLECTOR.READER:UNQUOTE PKG-VAR)
               (ECLECTOR.READER:UNQUOTE-SPLICING SYMBOL-TYPES))))
         *LOOP-WRAPPERS*)
        (ECLECTOR.READER:QUASIQUOTE
         ((((ECLECTOR.READER:UNQUOTE VARIABLE) NIL
            (ECLECTOR.READER:UNQUOTE DATA-TYPE))
           ((ECLECTOR.READER:UNQUOTE PKG-VAR)
            (ECLECTOR.READER:UNQUOTE (CADAR PREP-PHRASES))))
          NIL NIL NIL
          (NOT
           (MULTIPLE-VALUE-SETQ
               ((ECLECTOR.READER:UNQUOTE (PROGN NIL))
                (ECLECTOR.READER:UNQUOTE VARIABLE))
             ((ECLECTOR.READER:UNQUOTE NEXT-FN))))
          NIL))))
    (DEFUN MAKE-ANSI-LOOP-UNIVERSE (EXTENDED-P)
      (LET ((W
             (MAKE-STANDARD-LOOP-UNIVERSE :KEYWORDS
              (ECLECTOR.READER:QUASIQUOTE
               ((NAMED (LOOP-DO-NAMED)) (INITIALLY (LOOP-DO-INITIALLY))
                (FINALLY (LOOP-DO-FINALLY)) (DO (LOOP-DO-DO))
                (DOING (LOOP-DO-DO)) (RETURN (LOOP-DO-RETURN))
                (COLLECT (LOOP-LIST-COLLECTION LIST))
                (COLLECTING (LOOP-LIST-COLLECTION LIST))
                (APPEND (LOOP-LIST-COLLECTION APPEND))
                (APPENDING (LOOP-LIST-COLLECTION APPEND))
                (NCONC (LOOP-LIST-COLLECTION NCONC))
                (NCONCING (LOOP-LIST-COLLECTION NCONC))
                (COUNT
                 (LOOP-SUM-COLLECTION COUNT
                  (ECLECTOR.READER:UNQUOTE *LOOP-REAL-DATA-TYPE*) FIXNUM))
                (COUNTING
                 (LOOP-SUM-COLLECTION COUNT
                  (ECLECTOR.READER:UNQUOTE *LOOP-REAL-DATA-TYPE*) FIXNUM))
                (SUM (LOOP-SUM-COLLECTION SUM NUMBER NUMBER))
                (SUMMING (LOOP-SUM-COLLECTION SUM NUMBER NUMBER))
                (MAXIMIZE (LOOP-MAXMIN-COLLECTION MAX))
                (MINIMIZE (LOOP-MAXMIN-COLLECTION MIN))
                (MAXIMIZING (LOOP-MAXMIN-COLLECTION MAX))
                (MINIMIZING (LOOP-MAXMIN-COLLECTION MIN))
                (ALWAYS (LOOP-DO-ALWAYS T NIL)) (NEVER (LOOP-DO-ALWAYS T T))
                (THEREIS (LOOP-DO-THEREIS T))
                (WHILE (LOOP-DO-WHILE NIL :WHILE))
                (UNTIL (LOOP-DO-WHILE T :UNTIL)) (WHEN (LOOP-DO-IF WHEN NIL))
                (IF (LOOP-DO-IF IF NIL)) (UNLESS (LOOP-DO-IF UNLESS T))
                (WITH (LOOP-DO-WITH))))
              :FOR-KEYWORDS
              '((= (LOOP-ANSI-FOR-EQUALS)) (ACROSS (LOOP-FOR-ACROSS))
                (IN (LOOP-FOR-IN)) (ON (LOOP-FOR-ON))
                (FROM (LOOP-FOR-ARITHMETIC :FROM))
                (DOWNFROM (LOOP-FOR-ARITHMETIC :DOWNFROM))
                (UPFROM (LOOP-FOR-ARITHMETIC :UPFROM))
                (BELOW (LOOP-FOR-ARITHMETIC :BELOW))
                (TO (LOOP-FOR-ARITHMETIC :TO))
                (UPTO (LOOP-FOR-ARITHMETIC :UPTO))
                (ABOVE (LOOP-FOR-ARITHMETIC :ABOVE))
                (DOWNTO (LOOP-FOR-ARITHMETIC :DOWNTO))
                (BY (LOOP-FOR-ARITHMETIC :BY)) (BEING (LOOP-FOR-BEING)))
              :ITERATION-KEYWORDS
              '((FOR (LOOP-DO-FOR)) (AS (LOOP-DO-FOR))
                (REPEAT (LOOP-DO-REPEAT)))
              :TYPE-SYMBOLS
              '(ARRAY ATOM BIGNUM BIT BIT-VECTOR CHARACTER COMPILED-FUNCTION
                COMPLEX CONS DOUBLE-FLOAT FIXNUM FLOAT FUNCTION HASH-TABLE
                INTEGER KEYWORD LIST LONG-FLOAT NIL NULL NUMBER PACKAGE
                PATHNAME RANDOM-STATE RATIO RATIONAL READTABLE SEQUENCE
                SHORT-FLOAT SIMPLE-ARRAY SIMPLE-BIT-VECTOR SIMPLE-STRING
                SIMPLE-VECTOR SINGLE-FLOAT STANDARD-CHAR STREAM STRING
                STRING-CHAR SYMBOL T VECTOR)
              :TYPE-KEYWORDS NIL :ANSI
              (IF EXTENDED-P
                  :EXTENDED
                  T))))
        (ADD-LOOP-PATH '(HASH-KEY HASH-KEYS) 'LOOP-HASH-TABLE-ITERATION-PATH W
         :PREPOSITION-GROUPS '((:OF :IN)) :INCLUSIVE-PERMITTED NIL :USER-DATA
         '(:WHICH HASH-KEY))
        (ADD-LOOP-PATH '(HASH-VALUE HASH-VALUES)
         'LOOP-HASH-TABLE-ITERATION-PATH W :PREPOSITION-GROUPS '((:OF :IN))
         :INCLUSIVE-PERMITTED NIL :USER-DATA '(:WHICH HASH-VALUE))
        (ADD-LOOP-PATH '(SYMBOL SYMBOLS) 'LOOP-PACKAGE-SYMBOLS-ITERATION-PATH W
         :PREPOSITION-GROUPS '((:OF :IN)) :INCLUSIVE-PERMITTED NIL :USER-DATA
         '(:SYMBOL-TYPES (:INTERNAL :EXTERNAL :INHERITED)))
        (ADD-LOOP-PATH '(EXTERNAL-SYMBOL EXTERNAL-SYMBOLS)
         'LOOP-PACKAGE-SYMBOLS-ITERATION-PATH W :PREPOSITION-GROUPS
         '((:OF :IN)) :INCLUSIVE-PERMITTED NIL :USER-DATA
         '(:SYMBOL-TYPES (:EXTERNAL)))
        (ADD-LOOP-PATH '(PRESENT-SYMBOL PRESENT-SYMBOLS)
         'LOOP-PACKAGE-SYMBOLS-ITERATION-PATH W :PREPOSITION-GROUPS
         '((:OF :IN)) :INCLUSIVE-PERMITTED NIL :USER-DATA
         '(:SYMBOL-TYPES (:INTERNAL)))
        W))
    (DEFPARAMETER *LOOP-ANSI-UNIVERSE* (MAKE-ANSI-LOOP-UNIVERSE NIL))
    (DEFUN LOOP-STANDARD-EXPANSION (KEYWORDS-AND-FORMS ENVIRONMENT UNIVERSE)
      (IF (AND KEYWORDS-AND-FORMS (SYMBOLP (CAR KEYWORDS-AND-FORMS)))
          (LOOP-TRANSLATE KEYWORDS-AND-FORMS ENVIRONMENT UNIVERSE)
          (LET ((TAG (GENSYM)))
            (ECLECTOR.READER:QUASIQUOTE
             (BLOCK NIL
               (TAGBODY
                 (ECLECTOR.READER:UNQUOTE TAG)
                 (PROGN (ECLECTOR.READER:UNQUOTE-SPLICING KEYWORDS-AND-FORMS))
                 (GO (ECLECTOR.READER:UNQUOTE TAG))))))))
    (DEFMACRO LOOP (&ENVIRONMENT ENV &REST KEYWORDS-AND-FORMS)
      (DECLARE
       (#S(FORMGREP:SYMREF
           :NAME "DO-NOT-RECORD-MACROEXPANSIONS"
           :QUALIFIER "COMPILER"))
       (#S(FORMGREP:SYMREF :NAME "INDENTATION" :QUALIFIER "ZWEI")
        . #S(FORMGREP:SYMREF :NAME "INDENT-LOOP" :QUALIFIER "ZWEI")))
      (LOOP-STANDARD-EXPANSION KEYWORDS-AND-FORMS ENV *LOOP-ANSI-UNIVERSE*))
    (DEFUN #S(FORMGREP:SYMREF :NAME "COMPLEX-LOOP-EXPANDER" :QUALIFIER "EXCL")
           (BODY ENV)
      (LOOP-STANDARD-EXPANSION BODY ENV *LOOP-ANSI-UNIVERSE*)))

[Mezzano/system/ansi-loop.lisp:155]
  (DEFUN LOOP-OPTIMIZATION-QUANTITIES (ENV)
    (DECLARE (VALUES SPEED SPACE SAFETY COMPILATION-SPEED DEBUG))
    (LET ((STUFF (DECLARATION-INFORMATION 'OPTIMIZE ENV)))
      (VALUES (OR (CDR (ASSOC 'SPEED STUFF)) 1)
              (OR (CDR (ASSOC 'SPACE STUFF)) 1)
              (OR (CDR (ASSOC 'SAFETY STUFF)) 1)
              (OR (CDR (ASSOC 'COMPILATION-SPEED STUFF)) 1)
              (OR (CDR (ASSOC 'DEBUG STUFF)) 1)))
    (VALUES #S(FORMGREP:SYMREF :NAME "TIME" :QUALIFIER "COMPILER")
            #S(FORMGREP:SYMREF :NAME "SPACE" :QUALIFIER "COMPILER")
            #S(FORMGREP:SYMREF :NAME "SAFETY" :QUALIFIER "COMPILER")
            #S(FORMGREP:SYMREF :NAME "COMPILATION-SPEED" :QUALIFIER "COMPILER")
            1))

[Mezzano/system/clos/fast-class-hash-table.lisp:25]
  (DEFUN FAST-CLASS-HASH-TABLE-ENTRY (TABLE CLASS)
    (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 1))
             (TYPE FAST-CLASS-HASH-TABLE TABLE))
    (LET ((STORAGE (FAST-CLASS-HASH-TABLE-TABLE TABLE)))
      (COND
       ((#S(FORMGREP:SYMREF
            :NAME "WEAK-POINTER-P"
            :QUALIFIER "MEZZANO.EXTENSIONS")
         STORAGE)
        (IF (EQ CLASS
                (#S(FORMGREP:SYMREF
                    :NAME "%WEAK-POINTER-KEY"
                    :QUALIFIER "SYS.INT")
                 (THE
                  #S(FORMGREP:SYMREF
                     :NAME "WEAK-POINTER"
                     :QUALIFIER "MEZZANO.EXTENSIONS")
                  STORAGE)))
            (#S(FORMGREP:SYMREF
                :NAME "%WEAK-POINTER-VALUE"
                :QUALIFIER "SYS.INT")
             (THE
              #S(FORMGREP:SYMREF
                 :NAME "WEAK-POINTER"
                 :QUALIFIER "MEZZANO.EXTENSIONS")
              STORAGE))
            NIL))
       ((NOT STORAGE) NIL)
       (T
        (LOCALLY
         (DECLARE (TYPE SIMPLE-VECTOR STORAGE))
         (DO* ((HASH (SAFE-CLASS-HASH CLASS))
               (SIZE (LENGTH STORAGE))
               (MASK (1- SIZE))
               (SLOT (LOGAND HASH 4294967295)
                     (LOGAND 4294967295
                             (THE FIXNUM
                                  (+
                                   (THE FIXNUM
                                        (+ (THE FIXNUM (* SLOT 5)) PERTURB))
                                   1))))
               (PERTURB HASH (ASH PERTURB -5)))
              (NIL)
           (DECLARE (TYPE FIXNUM HASH SIZE MASK SLOT PERTURB))
           (LET* ((OFFSET (LOGAND SLOT MASK)) (SLOT (AREF STORAGE OFFSET)))
             (DECLARE (TYPE FIXNUM OFFSET))
             (WHEN (EQ SLOT NIL) (RETURN NIL))
             (WHEN
                 (AND (NOT (EQ SLOT T))
                      (EQ CLASS
                          (#S(FORMGREP:SYMREF
                              :NAME "%WEAK-POINTER-KEY"
                              :QUALIFIER "SYS.INT")
                           (THE
                            #S(FORMGREP:SYMREF
                               :NAME "WEAK-POINTER"
                               :QUALIFIER "MEZZANO.EXTENSIONS")
                            SLOT))))
               (RETURN
                (#S(FORMGREP:SYMREF
                    :NAME "%WEAK-POINTER-VALUE"
                    :QUALIFIER "SYS.INT")
                 (THE
                  #S(FORMGREP:SYMREF
                     :NAME "WEAK-POINTER"
                     :QUALIFIER "MEZZANO.EXTENSIONS")
                  SLOT)))))))))))

[Mezzano/system/numbers/nibbles.lisp:25]
  (MACROLET ((DEF (WIDTH)
               (ECLECTOR.READER:QUASIQUOTE
                (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
                  (#S(FORMGREP:SYMREF
                      :NAME "DEFINE-TRANSFORM"
                      :QUALIFIER "MEZZANO.COMPILER")
                   %SWAP-ENDIAN-UNSIGNED
                   ((VALUE INTEGER)
                    (WIDTH (EQL (ECLECTOR.READER:UNQUOTE WIDTH))))
                   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
                   (ECLECTOR.READER:QUASIQUOTE
                    (THE
                     (UNSIGNED-BYTE
                      (ECLECTOR.READER:UNQUOTE
                       '(ECLECTOR.READER:UNQUOTE WIDTH)))
                     (#S(FORMGREP:SYMREF
                         :NAME "CALL"
                         :QUALIFIER "MEZZANO.COMPILER")
                      %%SWAP-ENDIAN-UNSIGNED (ECLECTOR.READER:UNQUOTE VALUE)
                      '(ECLECTOR.READER:UNQUOTE
                        '(ECLECTOR.READER:UNQUOTE WIDTH))))))
                  (#S(FORMGREP:SYMREF
                      :NAME "DEFINE-TRANSFORM"
                      :QUALIFIER "MEZZANO.COMPILER")
                   %SWAP-ENDIAN-UNSIGNED
                   ((VALUE INTEGER)
                    (WIDTH (EQL (ECLECTOR.READER:UNQUOTE WIDTH))))
                   ((:OPTIMIZE (/= SAFETY 0) (= SPEED 3)))
                   (ECLECTOR.READER:QUASIQUOTE
                    (PROGN
                     (ECLECTOR.READER:UNQUOTE
                      (#S(FORMGREP:SYMREF
                          :NAME "INSERT-TYPE-CHECK"
                          :QUALIFIER "MEZZANO.COMPILER")
                       VALUE 'INTEGER))
                     (THE
                      (UNSIGNED-BYTE
                       (ECLECTOR.READER:UNQUOTE
                        '(ECLECTOR.READER:UNQUOTE WIDTH)))
                      (#S(FORMGREP:SYMREF
                          :NAME "CALL"
                          :QUALIFIER "MEZZANO.COMPILER")
                       %%SWAP-ENDIAN-UNSIGNED (ECLECTOR.READER:UNQUOTE VALUE)
                       '(ECLECTOR.READER:UNQUOTE
                         '(ECLECTOR.READER:UNQUOTE WIDTH)))))))
                  (#S(FORMGREP:SYMREF
                      :NAME "DEFINE-TRANSFORM"
                      :QUALIFIER "MEZZANO.COMPILER")
                   %SWAP-ENDIAN-SIGNED
                   ((VALUE INTEGER)
                    (WIDTH (EQL (ECLECTOR.READER:UNQUOTE WIDTH))))
                   ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
                   (ECLECTOR.READER:QUASIQUOTE
                    (THE
                     (SIGNED-BYTE
                      (ECLECTOR.READER:UNQUOTE
                       '(ECLECTOR.READER:UNQUOTE WIDTH)))
                     (#S(FORMGREP:SYMREF
                         :NAME "CALL"
                         :QUALIFIER "MEZZANO.COMPILER")
                      %%SWAP-ENDIAN-SIGNED (ECLECTOR.READER:UNQUOTE VALUE)
                      '(ECLECTOR.READER:UNQUOTE
                        '(ECLECTOR.READER:UNQUOTE WIDTH))))))
                  (#S(FORMGREP:SYMREF
                      :NAME "DEFINE-TRANSFORM"
                      :QUALIFIER "MEZZANO.COMPILER")
                   %SWAP-ENDIAN-SIGNED
                   ((VALUE INTEGER)
                    (WIDTH (EQL (ECLECTOR.READER:UNQUOTE WIDTH))))
                   ((:OPTIMIZE (/= SAFETY 0) (= SPEED 3)))
                   (ECLECTOR.READER:QUASIQUOTE
                    (PROGN
                     (ECLECTOR.READER:UNQUOTE
                      (#S(FORMGREP:SYMREF
                          :NAME "INSERT-TYPE-CHECK"
                          :QUALIFIER "MEZZANO.COMPILER")
                       VALUE 'INTEGER))
                     (THE
                      (SIGNED-BYTE
                       (ECLECTOR.READER:UNQUOTE
                        '(ECLECTOR.READER:UNQUOTE WIDTH)))
                      (#S(FORMGREP:SYMREF
                          :NAME "CALL"
                          :QUALIFIER "MEZZANO.COMPILER")
                       %%SWAP-ENDIAN-SIGNED (ECLECTOR.READER:UNQUOTE VALUE)
                       '(ECLECTOR.READER:UNQUOTE
                         '(ECLECTOR.READER:UNQUOTE WIDTH)))))))
                  (#S(FORMGREP:SYMREF
                      :NAME "MARK-AS-CONSTANT-FOLDABLE"
                      :QUALIFIER "MEZZANO.COMPILER")
                   '%SWAP-ENDIAN-UNSIGNED)
                  (#S(FORMGREP:SYMREF
                      :NAME "MARK-AS-CONSTANT-FOLDABLE"
                      :QUALIFIER "MEZZANO.COMPILER")
                   '%%SWAP-ENDIAN-UNSIGNED)
                  (#S(FORMGREP:SYMREF
                      :NAME "MARK-AS-CONSTANT-FOLDABLE"
                      :QUALIFIER "MEZZANO.COMPILER")
                   '%SWAP-ENDIAN-SIGNED)
                  (#S(FORMGREP:SYMREF
                      :NAME "MARK-AS-CONSTANT-FOLDABLE"
                      :QUALIFIER "MEZZANO.COMPILER")
                   '%%SWAP-ENDIAN-SIGNED)))))
    (DEF 16)
    (DEF 32)
    (DEF 64))

[Mezzano/system/numbers/nibbles.lisp:76]
  (DEFMACRO DEFINE-NIBBLES-ACCESSOR (NAME WIDTH ENDIAN SIGNED FAST-ACCESSOR)
    (FLET ((MAYBE-SIGN-EXTEND (INNER)
             (IF SIGNED
                 (ECLECTOR.READER:QUASIQUOTE
                  (SIGN-EXTEND (ECLECTOR.READER:UNQUOTE INNER)
                   (ECLECTOR.READER:UNQUOTE WIDTH)))
                 INNER)))
      (LET ((VALUE-TYPE
             (LIST
              (IF SIGNED
                  'SIGNED-BYTE
                  'UNSIGNED-BYTE)
              WIDTH)))
        (ECLECTOR.READER:QUASIQUOTE
         (PROGN
          (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
            (#S(FORMGREP:SYMREF
                :NAME "DEFINE-TRANSFORM"
                :QUALIFIER "MEZZANO.COMPILER")
             (ECLECTOR.READER:UNQUOTE NAME)
             ((VECTOR (SIMPLE-ARRAY (UNSIGNED-BYTE 8)) ARRAY-TYPE)
              (INDEX FIXNUM INDEX-TYPE))
             ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
             (ECLECTOR.READER:QUASIQUOTE
              (PROGN
               (ECLECTOR.READER:UNQUOTE
                (#S(FORMGREP:SYMREF
                    :NAME "INSERT-BOUNDS-CHECK"
                    :QUALIFIER "MEZZANO.COMPILER")
                 VECTOR ARRAY-TYPE INDEX INDEX-TYPE :ADJUST
                 (ECLECTOR.READER:UNQUOTE (1- (TRUNCATE WIDTH 8)))))
               (THE
                (ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE VALUE-TYPE))
                (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "MEZZANO.COMPILER")
                 %NIBBLE-FIXUP
                 (THE
                  (ECLECTOR.READER:UNQUOTE
                   '(ECLECTOR.READER:UNQUOTE VALUE-TYPE))
                  (#S(FORMGREP:SYMREF
                      :NAME "CALL"
                      :QUALIFIER "MEZZANO.COMPILER")
                   (ECLECTOR.READER:UNQUOTE
                    '(ECLECTOR.READER:UNQUOTE FAST-ACCESSOR))
                   (ECLECTOR.READER:UNQUOTE VECTOR)
                   (ECLECTOR.READER:UNQUOTE INDEX)))
                 '(ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE WIDTH))
                 '(ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE ENDIAN))
                 '(ECLECTOR.READER:UNQUOTE
                   '(ECLECTOR.READER:UNQUOTE SIGNED)))))))
            (#S(FORMGREP:SYMREF
                :NAME "DEFINE-TRANSFORM"
                :QUALIFIER "MEZZANO.COMPILER")
             (ECLECTOR.READER:UNQUOTE NAME)
             ((VECTOR (SIMPLE-ARRAY (UNSIGNED-BYTE 8)) ARRAY-TYPE)
              (INDEX FIXNUM INDEX-TYPE))
             ((:OPTIMIZE (/= SAFETY 0) (= SPEED 3)))
             (ECLECTOR.READER:QUASIQUOTE
              (PROGN
               (ECLECTOR.READER:UNQUOTE
                (#S(FORMGREP:SYMREF
                    :NAME "INSERT-TYPE-CHECK"
                    :QUALIFIER "MEZZANO.COMPILER")
                 VECTOR
                 (ECLECTOR.READER:QUASIQUOTE
                  (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)))))
               (ECLECTOR.READER:UNQUOTE
                (#S(FORMGREP:SYMREF
                    :NAME "INSERT-BOUNDS-CHECK"
                    :QUALIFIER "MEZZANO.COMPILER")
                 VECTOR ARRAY-TYPE INDEX INDEX-TYPE :ADJUST
                 (ECLECTOR.READER:UNQUOTE (1- (TRUNCATE WIDTH 8)))))
               (THE
                (ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE VALUE-TYPE))
                (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "MEZZANO.COMPILER")
                 %NIBBLE-FIXUP
                 (THE
                  (ECLECTOR.READER:UNQUOTE
                   '(ECLECTOR.READER:UNQUOTE VALUE-TYPE))
                  (#S(FORMGREP:SYMREF
                      :NAME "CALL"
                      :QUALIFIER "MEZZANO.COMPILER")
                   (ECLECTOR.READER:UNQUOTE
                    '(ECLECTOR.READER:UNQUOTE FAST-ACCESSOR))
                   (ECLECTOR.READER:UNQUOTE VECTOR)
                   (ECLECTOR.READER:UNQUOTE INDEX)))
                 '(ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE WIDTH))
                 '(ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE ENDIAN))
                 '(ECLECTOR.READER:UNQUOTE
                   '(ECLECTOR.READER:UNQUOTE SIGNED)))))))
            (#S(FORMGREP:SYMREF
                :NAME "DEFINE-TRANSFORM"
                :QUALIFIER "MEZZANO.COMPILER")
             (SETF (ECLECTOR.READER:UNQUOTE NAME))
             (VALUE (VECTOR (SIMPLE-ARRAY (UNSIGNED-BYTE 8)) ARRAY-TYPE)
              (INDEX FIXNUM INDEX-TYPE))
             ((:OPTIMIZE (= SAFETY 0) (= SPEED 3)))
             (ECLECTOR.READER:QUASIQUOTE
              (PROGN
               (ECLECTOR.READER:UNQUOTE
                (#S(FORMGREP:SYMREF
                    :NAME "INSERT-BOUNDS-CHECK"
                    :QUALIFIER "MEZZANO.COMPILER")
                 VECTOR ARRAY-TYPE INDEX INDEX-TYPE :ADJUST
                 (ECLECTOR.READER:UNQUOTE (1- (TRUNCATE WIDTH 8)))))
               (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "MEZZANO.COMPILER")
                (SETF (ECLECTOR.READER:UNQUOTE
                       '(ECLECTOR.READER:UNQUOTE FAST-ACCESSOR)))
                (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "MEZZANO.COMPILER")
                 %NIBBLE-FIXUP (ECLECTOR.READER:UNQUOTE VALUE)
                 '(ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE WIDTH))
                 '(ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE ENDIAN))
                 'NIL)
                (ECLECTOR.READER:UNQUOTE VECTOR)
                (ECLECTOR.READER:UNQUOTE INDEX))
               (ECLECTOR.READER:UNQUOTE VALUE))))
            (#S(FORMGREP:SYMREF
                :NAME "DEFINE-TRANSFORM"
                :QUALIFIER "MEZZANO.COMPILER")
             (SETF (ECLECTOR.READER:UNQUOTE NAME))
             (VALUE (VECTOR (SIMPLE-ARRAY (UNSIGNED-BYTE 8)) ARRAY-TYPE)
              (INDEX FIXNUM INDEX-TYPE))
             ((:OPTIMIZE (/= SAFETY 0) (= SPEED 3)))
             (ECLECTOR.READER:QUASIQUOTE
              (PROGN
               (ECLECTOR.READER:UNQUOTE
                (#S(FORMGREP:SYMREF
                    :NAME "INSERT-TYPE-CHECK"
                    :QUALIFIER "MEZZANO.COMPILER")
                 VALUE '(ECLECTOR.READER:UNQUOTE VALUE-TYPE)))
               (ECLECTOR.READER:UNQUOTE
                (#S(FORMGREP:SYMREF
                    :NAME "INSERT-TYPE-CHECK"
                    :QUALIFIER "MEZZANO.COMPILER")
                 VECTOR
                 (ECLECTOR.READER:QUASIQUOTE
                  (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)))))
               (ECLECTOR.READER:UNQUOTE
                (#S(FORMGREP:SYMREF
                    :NAME "INSERT-BOUNDS-CHECK"
                    :QUALIFIER "MEZZANO.COMPILER")
                 VECTOR ARRAY-TYPE INDEX INDEX-TYPE :ADJUST
                 (ECLECTOR.READER:UNQUOTE (1- (TRUNCATE WIDTH 8)))))
               (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "MEZZANO.COMPILER")
                (SETF (ECLECTOR.READER:UNQUOTE
                       '(ECLECTOR.READER:UNQUOTE FAST-ACCESSOR)))
                (#S(FORMGREP:SYMREF :NAME "CALL" :QUALIFIER "MEZZANO.COMPILER")
                 %NIBBLE-FIXUP (ECLECTOR.READER:UNQUOTE VALUE)
                 '(ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE WIDTH))
                 '(ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE ENDIAN))
                 'NIL)
                (ECLECTOR.READER:UNQUOTE VECTOR)
                (ECLECTOR.READER:UNQUOTE INDEX))
               (ECLECTOR.READER:UNQUOTE VALUE))))
            (#S(FORMGREP:SYMREF
                :NAME "MARK-AS-CONSTANT-FOLDABLE"
                :QUALIFIER "MEZZANO.COMPILER")
             '(ECLECTOR.READER:UNQUOTE NAME))
            (#S(FORMGREP:SYMREF
                :NAME "MARK-AS-CONSTANT-FOLDABLE"
                :QUALIFIER "MEZZANO.COMPILER")
             '(SETF (ECLECTOR.READER:UNQUOTE NAME))))
          (DEFUN (ECLECTOR.READER:UNQUOTE NAME) (VECTOR INDEX)
            (DECLARE (OPTIMIZE SPEED))
            (COND
             ((AND (FIXNUMP INDEX)
                   (TYPEP VECTOR '(SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*))))
              ((ECLECTOR.READER:UNQUOTE NAME)
               (THE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) VECTOR)
               (THE FIXNUM INDEX)))
             (T (CHECK-TYPE VECTOR (ARRAY (UNSIGNED-BYTE 8) (*)))
              (ECLECTOR.READER:UNQUOTE
               (MAYBE-SIGN-EXTEND
                (ECLECTOR.READER:QUASIQUOTE
                 (LOGIOR
                  (ECLECTOR.READER:UNQUOTE-SPLICING
                   (ECASE ENDIAN
                     (:LITTLE
                      (LOOP FOR I BELOW (TRUNCATE WIDTH 8)
                            COLLECT (ECLECTOR.READER:QUASIQUOTE
                                     (ASH
                                      (AREF VECTOR
                                            (+ INDEX
                                               (ECLECTOR.READER:UNQUOTE I)))
                                      (ECLECTOR.READER:UNQUOTE (* I 8))))))
                     (:BIG
                      (LOOP FOR I BELOW (TRUNCATE WIDTH 8)
                            COLLECT (ECLECTOR.READER:QUASIQUOTE
                                     (ASH
                                      (AREF VECTOR
                                            (+ INDEX
                                               (ECLECTOR.READER:UNQUOTE I)))
                                      (ECLECTOR.READER:UNQUOTE
                                       (* (- (TRUNCATE WIDTH 8) I 1)
                                          8)))))))))))))))
          (DEFUN (SETF (ECLECTOR.READER:UNQUOTE NAME)) (VALUE VECTOR INDEX)
            (DECLARE (OPTIMIZE SPEED))
            (COND
             ((AND (FIXNUMP INDEX)
                   (TYPEP VECTOR '(SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*))))
              (SETF ((ECLECTOR.READER:UNQUOTE NAME)
                     (THE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) VECTOR)
                     (THE FIXNUM INDEX))
                      VALUE))
             (T (CHECK-TYPE VALUE (ECLECTOR.READER:UNQUOTE VALUE-TYPE))
              (CHECK-TYPE VECTOR (ARRAY (UNSIGNED-BYTE 8) (*)))
              (ECLECTOR.READER:UNQUOTE-SPLICING
               (ECASE ENDIAN
                 (:LITTLE
                  (LOOP FOR I BELOW (TRUNCATE WIDTH 8)
                        COLLECT (ECLECTOR.READER:QUASIQUOTE
                                 (SETF (AREF VECTOR
                                             (+ INDEX
                                                (ECLECTOR.READER:UNQUOTE I)))
                                         (LDB
                                          (BYTE 8
                                                (ECLECTOR.READER:UNQUOTE
                                                 (* I 8)))
                                          VALUE)))))
                 (:BIG
                  (LOOP FOR I BELOW (TRUNCATE WIDTH 8)
                        COLLECT (ECLECTOR.READER:QUASIQUOTE
                                 (SETF (AREF VECTOR
                                             (+ INDEX
                                                (ECLECTOR.READER:UNQUOTE I)))
                                         (LDB
                                          (BYTE 8
                                                (ECLECTOR.READER:UNQUOTE
                                                 (* (- (TRUNCATE WIDTH 8) I 1)
                                                    8)))
                                          VALUE)))))))
              VALUE))))))))

[Mezzano/system/numbers/transcendental.lisp:128]
  (DEFUN SIN-SINGLE-FLOAT (D)
    (DECLARE (TYPE SINGLE-FLOAT D)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (LET* ((Q (SLEEF-RINTF (* D (/ (FLOAT PI 0.0))))) (Q-FLOAT (FLOAT Q 0.0)))
      (DECLARE (TYPE FIXNUM Q)
               (TYPE SINGLE-FLOAT Q-FLOAT))
      (SETF D (SLEEF-MLAF Q-FLOAT (* +SLEEF-PI4-AF+ -4) D))
      (SETF D (SLEEF-MLAF Q-FLOAT (* +SLEEF-PI4-BF+ -4) D))
      (SETF D (SLEEF-MLAF Q-FLOAT (* +SLEEF-PI4-CF+ -4) D))
      (SETF D (SLEEF-MLAF Q-FLOAT (* +SLEEF-PI4-DF+ -4) D))
      (LET ((S (* D D)))
        (DECLARE (TYPE SINGLE-FLOAT S))
        (WHEN (LOGTEST Q 1) (SETF D (- 0.0 D)))
        (FINISH-SINCOS-SINGLE-FLOAT S D))))

[Mezzano/system/numbers/transcendental.lisp:145]
  (DEFUN COS-SINGLE-FLOAT (D)
    (DECLARE (TYPE SINGLE-FLOAT D)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (LET* ((Q (+ 1 (* 2 (SLEEF-RINTF (- (* D (/ (FLOAT PI 0.0))) 0.5)))))
           (Q-FLOAT (FLOAT Q 0.0)))
      (DECLARE (TYPE FIXNUM Q)
               (TYPE SINGLE-FLOAT Q-FLOAT))
      (SETF D (SLEEF-MLAF Q-FLOAT (* +SLEEF-PI4-AF+ -2) D))
      (SETF D (SLEEF-MLAF Q-FLOAT (* +SLEEF-PI4-BF+ -2) D))
      (SETF D (SLEEF-MLAF Q-FLOAT (* +SLEEF-PI4-CF+ -2) D))
      (SETF D (SLEEF-MLAF Q-FLOAT (* +SLEEF-PI4-DF+ -2) D))
      (LET ((S (* D D)))
        (DECLARE (TYPE SINGLE-FLOAT S))
        (WHEN (NOT (LOGTEST Q 2)) (SETF D (- 0.0 D)))
        (FINISH-SINCOS-SINGLE-FLOAT S D))))

[Mezzano/system/numbers/transcendental.lisp:178]
  (DEFUN SIN-DOUBLE-FLOAT (D)
    (DECLARE (TYPE DOUBLE-FLOAT D)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (LET* ((Q (SLEEF-RINT (* D (/ (FLOAT PI 0.0d0)))))
           (Q-FLOAT (FLOAT Q 0.0d0)))
      (DECLARE (TYPE FIXNUM Q)
               (TYPE DOUBLE-FLOAT Q-FLOAT))
      (SETF D (SLEEF-MLA Q-FLOAT (* +SLEEF-PI4-A+ -4) D))
      (SETF D (SLEEF-MLA Q-FLOAT (* +SLEEF-PI4-B+ -4) D))
      (SETF D (SLEEF-MLA Q-FLOAT (* +SLEEF-PI4-C+ -4) D))
      (SETF D (SLEEF-MLA Q-FLOAT (* +SLEEF-PI4-D+ -4) D))
      (LET ((S (* D D)))
        (DECLARE (TYPE DOUBLE-FLOAT S))
        (WHEN (LOGTEST Q 1) (SETF D (- 0.0d0 D)))
        (FINISH-SINCOS-DOUBLE-FLOAT S D))))

[Mezzano/system/numbers/transcendental.lisp:195]
  (DEFUN COS-DOUBLE-FLOAT (D)
    (DECLARE (TYPE DOUBLE-FLOAT D)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (LET* ((Q (+ 1 (* 2 (SLEEF-RINT (- (* D (/ (FLOAT PI 0.0d0))) 0.5d0)))))
           (Q-FLOAT (FLOAT Q 0.0d0)))
      (DECLARE (TYPE FIXNUM Q)
               (TYPE DOUBLE-FLOAT Q-FLOAT))
      (SETF D (SLEEF-MLA Q-FLOAT (* +SLEEF-PI4-A+ -2) D))
      (SETF D (SLEEF-MLA Q-FLOAT (* +SLEEF-PI4-B+ -2) D))
      (SETF D (SLEEF-MLA Q-FLOAT (* +SLEEF-PI4-C+ -2) D))
      (SETF D (SLEEF-MLA Q-FLOAT (* +SLEEF-PI4-D+ -2) D))
      (LET ((S (* D D)))
        (DECLARE (TYPE DOUBLE-FLOAT S))
        (WHEN (NOT (LOGTEST Q 2)) (SETF D (- 0.0d0 D)))
        (FINISH-SINCOS-DOUBLE-FLOAT S D))))

[Mezzano/system/runtime-support.lisp:58]
  (DEFUN PROCLAIM (DECLARATION-SPECIFIER)
    (CASE (FIRST DECLARATION-SPECIFIER)
      (SPECIAL
       (DOLIST (VAR (REST DECLARATION-SPECIFIER))
         (PROCLAIM-SYMBOL-MODE VAR :SPECIAL)))
      (CONSTANT
       (DOLIST (VAR (REST DECLARATION-SPECIFIER))
         (PROCLAIM-SYMBOL-MODE VAR :CONSTANT)))
      (GLOBAL
       (DOLIST (VAR (REST DECLARATION-SPECIFIER))
         (PROCLAIM-SYMBOL-MODE VAR :GLOBAL)))
      (INLINE
       (DOLIST (NAME (REST DECLARATION-SPECIFIER))
         (SETF (FUNCTION-INFO-INLINE-MODE (FUNCTION-INFO-FOR NAME)) T)))
      (NOTINLINE
       (DOLIST (NAME (REST DECLARATION-SPECIFIER))
         (SETF (FUNCTION-INFO-INLINE-MODE (FUNCTION-INFO-FOR NAME)) NIL)))
      (MAYBE-INLINE
       (DOLIST (NAME (REST DECLARATION-SPECIFIER))
         (SETF (FUNCTION-INFO-INLINE-MODE (FUNCTION-INFO-FOR NAME)) :MAYBE)))
      (TYPE
       (DESTRUCTURING-BIND
           (TYPESPEC &REST VARS)
           (REST DECLARATION-SPECIFIER)
         (PROCLAIM-TYPE TYPESPEC VARS)))
      (FTYPE)
      (DECLARATION
       (DOLIST (NAME (REST DECLARATION-SPECIFIER))
         (CHECK-TYPE NAME SYMBOL)
         (PUSHNEW NAME *KNOWN-DECLARATIONS*)))
      (OPTIMIZE
       (DOLIST (QUALITY (REST DECLARATION-SPECIFIER))
         (DESTRUCTURING-BIND
             (QUALITY VALUE)
             (IF (SYMBOLP QUALITY)
                 (ECLECTOR.READER:QUASIQUOTE
                  ((ECLECTOR.READER:UNQUOTE QUALITY) 3))
                 QUALITY)
           (CHECK-TYPE QUALITY
                       (MEMBER COMPILATION-SPEED DEBUG SAFETY SPACE SPEED))
           (CHECK-TYPE VALUE (MEMBER 0 1 2 3))
           (SETF (GETF
                  #S(FORMGREP:SYMREF
                     :NAME "*OPTIMIZE-POLICY*"
                     :QUALIFIER "MEZZANO.COMPILER")
                  QUALITY)
                   VALUE))))
      (T
       (COND
        ((TYPE-SPECIFIER-P (FIRST DECLARATION-SPECIFIER))
         (PROCLAIM-TYPE (FIRST DECLARATION-SPECIFIER)
          (REST DECLARATION-SPECIFIER)))
        ((KNOWN-DECLARATION-P (FIRST DECLARATION-SPECIFIER))
         (WARN "Unknown declaration ~S" DECLARATION-SPECIFIER))))))

[Mezzano/system/sequence.lisp:606]
  (DEFUN REPLACE-KNOWN-ARGS (SEQUENCE-1 SEQUENCE-2 START1 END1 START2 END2)
    (UNLESS END1 (SETF END1 (LENGTH SEQUENCE-1)))
    (UNLESS END2 (SETF END2 (LENGTH SEQUENCE-2)))
    (ASSERT (<= 0 START1 END1 (LENGTH SEQUENCE-1)))
    (ASSERT (<= 0 START2 END2 (LENGTH SEQUENCE-2)))
    (LET* ((N1 (- END1 START1)) (N2 (- END2 START2)) (N (MIN N1 N2)))
      (SETF END1 (+ START1 N)
            END2 (+ START2 N)))
    (LET ((COPY-BACKWARDS NIL))
      (WHEN
          (AND (EQL SEQUENCE-1 SEQUENCE-2) (<= START2 START1)
               (OR (AND (<= START1 START2) (< START2 END1))
                   (AND (< START1 END2) (<= END2 END1))
                   (AND (<= START2 START1) (< START1 END2))
                   (AND (< START2 END1) (<= END1 END2))))
        (WHEN (EQL START1 START2) (RETURN-FROM REPLACE-KNOWN-ARGS SEQUENCE-1))
        (SETF COPY-BACKWARDS T))
      (MACROLET ((FAST-VECTOR (TYPE)
                   (ECLECTOR.READER:QUASIQUOTE
                    (IF (AND
                         (TYPEP SEQUENCE-1
                                '(ARRAY (ECLECTOR.READER:UNQUOTE TYPE) (*)))
                         (NOT (ARRAY-DISPLACEMENT SEQUENCE-1))
                         (TYPEP SEQUENCE-2
                                '(ARRAY (ECLECTOR.READER:UNQUOTE TYPE) (*)))
                         (NOT (ARRAY-DISPLACEMENT SEQUENCE-2)))
                        (LET ((SIMPLE-VECTOR-1
                               (IF (TYPEP SEQUENCE-1
                                          '(SIMPLE-ARRAY
                                            (ECLECTOR.READER:UNQUOTE TYPE)
                                            (*)))
                                   SEQUENCE-1
                                   (#S(FORMGREP:SYMREF
                                       :NAME "%COMPLEX-ARRAY-STORAGE"
                                       :QUALIFIER "SYS.INT")
                                    SEQUENCE-1)))
                              (SIMPLE-VECTOR-2
                               (IF (TYPEP SEQUENCE-2
                                          '(SIMPLE-ARRAY
                                            (ECLECTOR.READER:UNQUOTE TYPE)
                                            (*)))
                                   SEQUENCE-2
                                   (#S(FORMGREP:SYMREF
                                       :NAME "%COMPLEX-ARRAY-STORAGE"
                                       :QUALIFIER "SYS.INT")
                                    SEQUENCE-2))))
                          (DECLARE
                           (TYPE
                            (SIMPLE-ARRAY (ECLECTOR.READER:UNQUOTE TYPE) (*))
                            SIMPLE-VECTOR-1 SIMPLE-VECTOR-2)
                           (TYPE FIXNUM START1 END1 START2 END2)
                           (OPTIMIZE SPEED (SAFETY 0)))
                          (COND
                           (COPY-BACKWARDS
                            (LOOP WITH N = (MIN (THE FIXNUM (- END1 START1))
                                                (THE FIXNUM (- END2 START2)))
                                  WITH ORIGIN1 FIXNUM = (1- (+ START1 N))
                                  WITH ORIGIN2 FIXNUM = (1- (+ START2 N))
                                  FOR I FIXNUM BELOW N
                                  DO (SETF (AREF SIMPLE-VECTOR-1
                                                 (THE FIXNUM (- ORIGIN1 I)))
                                             (AREF SIMPLE-VECTOR-2
                                                   (THE FIXNUM
                                                        (- ORIGIN2 I))))))
                           (T
                            (LOOP FOR I FIXNUM BELOW (MIN
                                                      (THE FIXNUM
                                                           (- END1 START1))
                                                      (THE FIXNUM
                                                           (- END2 START2)))
                                  DO (SETF (AREF SIMPLE-VECTOR-1
                                                 (THE FIXNUM (+ START1 I)))
                                             (AREF SIMPLE-VECTOR-2
                                                   (THE FIXNUM
                                                        (+ START2 I)))))))
                          T)
                        NIL))))
        (COND ((FAST-VECTOR (UNSIGNED-BYTE 8)))
              ((FAST-VECTOR (UNSIGNED-BYTE 16)))
              ((FAST-VECTOR (UNSIGNED-BYTE 32)))
              ((FAST-VECTOR (UNSIGNED-BYTE 64)))
              ((FAST-VECTOR (SIGNED-BYTE 8))) ((FAST-VECTOR (SIGNED-BYTE 16)))
              ((FAST-VECTOR (SIGNED-BYTE 32))) ((FAST-VECTOR (SIGNED-BYTE 64)))
              ((FAST-VECTOR T)) ((FAST-VECTOR SHORT-FLOAT))
              ((FAST-VECTOR SINGLE-FLOAT)) ((FAST-VECTOR DOUBLE-FLOAT))
              ((AND (TYPEP SEQUENCE-1 'STRING)
                    (NOT (ARRAY-DISPLACEMENT SEQUENCE-1))
                    (TYPEP SEQUENCE-2 'STRING)
                    (NOT (ARRAY-DISPLACEMENT SEQUENCE-2)))
               (LET ((STORAGE-1
                      (#S(FORMGREP:SYMREF
                          :NAME "%COMPLEX-ARRAY-STORAGE"
                          :QUALIFIER "SYS.INT")
                       SEQUENCE-1))
                     (STORAGE-2
                      (#S(FORMGREP:SYMREF
                          :NAME "%COMPLEX-ARRAY-STORAGE"
                          :QUALIFIER "SYS.INT")
                       SEQUENCE-2)))
                 (WHEN
                     (NOT
                      (TYPEP STORAGE-2 '(SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*))))
                   (COND
                    ((TYPEP STORAGE-2 '(SIMPLE-ARRAY (UNSIGNED-BYTE 16) (*)))
                     (WHEN
                         (TYPEP STORAGE-1
                                '(SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)))
                       (SETF (#S(FORMGREP:SYMREF
                                 :NAME "%COMPLEX-ARRAY-STORAGE"
                                 :QUALIFIER "SYS.INT")
                              SEQUENCE-1)
                               (MAKE-ARRAY (LENGTH STORAGE-1) :ELEMENT-TYPE
                                           '(UNSIGNED-BYTE 16)
                                           :INITIAL-CONTENTS STORAGE-1))))
                    (T
                     (WHEN
                         (NOT
                          (TYPEP STORAGE-1
                                 '(SIMPLE-ARRAY (UNSIGNED-BYTE 32) (*))))
                       (SETF (#S(FORMGREP:SYMREF
                                 :NAME "%COMPLEX-ARRAY-STORAGE"
                                 :QUALIFIER "SYS.INT")
                              SEQUENCE-1)
                               (MAKE-ARRAY (LENGTH STORAGE-1) :ELEMENT-TYPE
                                           '(UNSIGNED-BYTE 32)
                                           :INITIAL-CONTENTS STORAGE-1)))))))
               (REPLACE
                (#S(FORMGREP:SYMREF
                    :NAME "%COMPLEX-ARRAY-STORAGE"
                    :QUALIFIER "SYS.INT")
                 SEQUENCE-1)
                (#S(FORMGREP:SYMREF
                    :NAME "%COMPLEX-ARRAY-STORAGE"
                    :QUALIFIER "SYS.INT")
                 SEQUENCE-2)
                :START1 START1 :END1 END1 :START2 START2 :END2 END2))
              (T
               (LET ((N (MIN (- END1 START1) (- END2 START2))))
                 (COND
                  (COPY-BACKWARDS
                   (DOTIMES (I N)
                     (SETF (ELT SEQUENCE-1 (- (+ START1 N) I 1))
                             (ELT SEQUENCE-2 (- (+ START2 N) I 1)))))
                  (T
                   (DOTIMES (I N)
                     (SETF (ELT SEQUENCE-1 (+ START1 I))
                             (ELT SEQUENCE-2 (+ START2 I)))))))))))
    SEQUENCE-1)

[Mezzano/system/sequence.lisp:749]
  (DEFUN FILL-KNOWN-ARGS (SEQUENCE ITEM START END)
    (CHECK-TYPE START (INTEGER 0))
    (PROG ((ORIGINAL-SEQUENCE SEQUENCE))
      (WHEN (NOT (%VALUE-HAS-TAG-P SEQUENCE +TAG-OBJECT+)) (GO NOT-OBJECT))
     RETRY-COMPLEX-ARRAY
      (MACROLET ((FAST-VECTOR-FILL (TYPE)
                   (ECLECTOR.READER:QUASIQUOTE
                    (PROGN
                     (CHECK-TYPE ITEM (ECLECTOR.READER:UNQUOTE TYPE))
                     (LOCALLY
                      (DECLARE
                       (TYPE (SIMPLE-ARRAY (ECLECTOR.READER:UNQUOTE TYPE) (*))
                        SEQUENCE)
                       (TYPE (ECLECTOR.READER:UNQUOTE TYPE) ITEM)
                       (OPTIMIZE SPEED (SAFETY 0) (DEBUG 1)))
                      (COND
                       (END (ASSERT (<= START END))
                        (ASSERT (<= END (LENGTH SEQUENCE))))
                       (T (ASSERT (<= START (LENGTH SEQUENCE)))
                        (SETF END (LENGTH SEQUENCE))))
                      (LOCALLY
                       (DECLARE (TYPE FIXNUM START END))
                       (LOOP FOR I FIXNUM BELOW (THE FIXNUM (- END START))
                             DO (SETF (AREF SEQUENCE (THE FIXNUM (+ START I)))
                                        ITEM))))))))
        (OBJECT-TYPE-DISPATCH SEQUENCE (NIL (FAST-VECTOR-FILL T))
         (NIL (FAST-VECTOR-FILL (UNSIGNED-BYTE 8)))
         (NIL (FAST-VECTOR-FILL (UNSIGNED-BYTE 16)))
         (NIL (FAST-VECTOR-FILL (UNSIGNED-BYTE 32)))
         (NIL (FAST-VECTOR-FILL (UNSIGNED-BYTE 64)))
         (NIL (FAST-VECTOR-FILL (SIGNED-BYTE 8)))
         (NIL (FAST-VECTOR-FILL (SIGNED-BYTE 16)))
         (NIL (FAST-VECTOR-FILL (SIGNED-BYTE 32)))
         (NIL (FAST-VECTOR-FILL (SIGNED-BYTE 64)))
         (NIL (FAST-VECTOR-FILL SHORT-FLOAT))
         (NIL (FAST-VECTOR-FILL SINGLE-FLOAT))
         (NIL (FAST-VECTOR-FILL DOUBLE-FLOAT))
         ((NIL NIL)
          (WHEN (NOT (EQL (ARRAY-RANK SEQUENCE) 1))
            (ERROR 'TYPE-ERROR :DATUM SEQUENCE :EXPECTED-TYPE 'SEQUENCE))
          (WHEN (ARRAY-DISPLACEMENT SEQUENCE) (GO GENERIC))
          (WHEN (ARRAY-HAS-FILL-POINTER-P SEQUENCE)
            (COND (END (ASSERT (<= END (FILL-POINTER SEQUENCE))))
                  (T (SETF END (FILL-POINTER SEQUENCE)))))
          (SETF SEQUENCE
                  (#S(FORMGREP:SYMREF
                      :NAME "%COMPLEX-ARRAY-STORAGE"
                      :QUALIFIER "SYS.INT")
                   SEQUENCE))
          (GO RETRY-COMPLEX-ARRAY))
         ((NIL NIL)
          (WHEN (NOT (EQL (ARRAY-RANK SEQUENCE) 1))
            (ERROR 'TYPE-ERROR :DATUM SEQUENCE :EXPECTED-TYPE 'SEQUENCE))
          (WHEN (ARRAY-DISPLACEMENT SEQUENCE) (GO GENERIC))
          (WHEN (ARRAY-HAS-FILL-POINTER-P SEQUENCE)
            (COND (END (ASSERT (<= END (FILL-POINTER SEQUENCE))))
                  (T (SETF END (FILL-POINTER SEQUENCE)))))
          (CHECK-TYPE ITEM CHARACTER)
          (#S(FORMGREP:SYMREF
              :NAME "ENSURE-STRING-WIDE-ENOUGH"
              :QUALIFIER "MEZZANO.RUNTIME")
           ITEM SEQUENCE)
          (SETF SEQUENCE
                  (#S(FORMGREP:SYMREF
                      :NAME "%COMPLEX-ARRAY-STORAGE"
                      :QUALIFIER "SYS.INT")
                   SEQUENCE)
                ITEM (CHAR-INT ITEM))
          (GO RETRY-COMPLEX-ARRAY))
         (T (GO GENERIC))))
      (RETURN ORIGINAL-SEQUENCE)
     NOT-OBJECT
      (WHEN (NOT (CONSP SEQUENCE))
        (ERROR 'TYPE-ERROR :DATUM SEQUENCE :EXPECTED-TYPE 'SEQUENCE))
     GENERIC
      (WHEN (NOT END) (SETF END (LENGTH SEQUENCE)))
      (ASSERT (<= 0 START END (LENGTH SEQUENCE)))
      (DOTIMES (I (- END START)) (SETF (ELT SEQUENCE (+ I START)) ITEM))
      (RETURN ORIGINAL-SEQUENCE)))

[Petalisp/code/ir/kernel-compiler.lisp:517]
  (DEFMACRO WITH-UNSAFE-OPTIMIZATIONS* (&BODY BODY)
    "Optimize the heck out of BODY. Use with caution!"
    (LET ((SETTINGS
           '((SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0) (COMPILATION-SPEED 0))))
      (ECLECTOR.READER:QUASIQUOTE
       (LOCALLY
        (DECLARE (OPTIMIZE (ECLECTOR.READER:UNQUOTE-SPLICING SETTINGS)))
        (ECLECTOR.READER:UNQUOTE-SPLICING BODY)))))

[Petalisp/code/test-suite/petalisp.type-inference.lisp:81]
  (DEFINE-TEST TYPE-INFERENCE-TEST
   (FLET ((TEST (FUNCTION &REST ARGS)
            (LET ((PREDICTED
                   (MAPCAR
                    #'#S(FORMGREP:SYMREF
                         :NAME "TYPE-SPECIFIER"
                         :QUALIFIER "PETALISP.TYPE-INFERENCE")
                    (MULTIPLE-VALUE-LIST
                     (#S(FORMGREP:SYMREF
                         :NAME "INFER-NTYPES"
                         :QUALIFIER "PETALISP.TYPE-INFERENCE")
                      FUNCTION
                      (MAPCAR
                       #'#S(FORMGREP:SYMREF
                            :NAME "NTYPE-OF"
                            :QUALIFIER "PETALISP.TYPE-INFERENCE")
                       ARGS)
                      (LAMBDA () (VALUES)))))))
              (HANDLER-CASE
               (LET ((VALUES
                      (MULTIPLE-VALUE-LIST
                       (LOCALLY
                        (DECLARE (OPTIMIZE (SAFETY 3)))
                        (APPLY FUNCTION ARGS)))))
                 (IS (<= (LENGTH PREDICTED) (LENGTH VALUES)))
                 (LOOP FOR VALUE IN VALUES
                       FOR TYPE IN PREDICTED
                       DO (IF (TYPEP TYPE '(CONS (EQL EQL) (CONS NUMBER NULL)))
                              (IS (= VALUE (SECOND TYPE)))
                              (IS (TYPEP VALUE TYPE)))))
               (ARITHMETIC-ERROR NIL)))))
     (TEST 'APPLY '+ '(7 8))
     (SIGNALS ERROR (TEST #'APPLY))
     (TEST #'APPLY #'+ 5 '(7 8))
     (TEST #'FDEFINITION '+)
     (SIGNALS ERROR (TEST #'FDEFINITION 25))
     (TEST #'FBOUNDP '+)
     (TEST #'FUNCALL #'+)
     (TEST #'FUNCALL #'+ 2 3)
     (TEST #'FUNCTION-LAMBDA-EXPRESSION #'+)
     (SIGNALS ERROR (TEST #'NOT))
     (TEST #'NOT 1)
     (SIGNALS ERROR (TEST #'NOT 1 2))
     (TEST #'EQ 1 2)
     (TEST #'SOME #'INTEGERP '(1 2 3))
     (SIGNALS ERROR (TEST #'SOME #'INTEGERP))
     (TEST #'VALUES 1 2 3 4.0)
     (TEST #'VALUES-LIST '(1 2 3))
     (SIGNALS ERROR (TEST #'VALUES-LIST 42))
     (LOOP FOR FN IN '(= /= + - * /)
           DO (LOOP FOR NUMBER-1 IN *TEST-NUMBERS*
                    DO (TEST FN NUMBER-1) (LOOP FOR NUMBER-2 IN *TEST-NUMBERS*
                                                DO (TEST FN NUMBER-1
                                                    NUMBER-2) (TEST FN NUMBER-1
                                                               NUMBER-2
                                                               NUMBER-1))))
     (LOOP FOR FN IN '(< > <= >= MIN MAX)
           DO (LOOP FOR NUMBER-1 IN *TEST-REALS*
                    DO (TEST FN NUMBER-1) (LOOP FOR NUMBER-2 IN *TEST-REALS*
                                                DO (TEST FN NUMBER-1
                                                    NUMBER-2) (TEST FN NUMBER-1
                                                               NUMBER-2
                                                               NUMBER-1))))
     (LOOP FOR FN IN '(FLOOR CEILING TRUNCATE ROUND FFLOOR FCEILING FTRUNCATE
                             FROUND)
           DO (LOOP FOR NUMBER-1 IN *TEST-REALS*
                    DO (TEST FN NUMBER-1) (LOOP FOR NUMBER-2 IN *TEST-REALS*
                                                DO (TEST FN NUMBER-1
                                                    NUMBER-2))))
     (LOOP FOR FN IN '(SIN COS TAN ASIN ACOS ATAN LOG EXP SQRT)
           DO (LOOP FOR NUMBER-1 IN *TEST-NUMBERS*
                    DO (TEST FN NUMBER-1)))))

[Petalisp/code/type-inference/ntype-2.lisp:52]
  (DEFMACRO WITH-NTYPE-CACHING (NTYPES &BODY BODY)
    (ASSERT (NULL (INTERSECTION NTYPES LAMBDA-LIST-KEYWORDS)))
    (ASSERT (EVERY #'SYMBOLP NTYPES))
    (LET* ((N (LENGTH NTYPES))
           (CACHE (GENSYM "CACHE"))
           (INDICES
            (LOOP REPEAT N
                  COLLECT (GENSYM "INDEX"))))
      (ECLECTOR.READER:QUASIQUOTE
       (LET (((ECLECTOR.READER:UNQUOTE CACHE)
              (LOAD-TIME-VALUE
               (MAKE-NTYPE-CACHE (ECLECTOR.READER:UNQUOTE N)
                (LAMBDA (ECLECTOR.READER:UNQUOTE NTYPES)
                  (ECLECTOR.READER:UNQUOTE-SPLICING BODY)))))
             (ECLECTOR.READER:UNQUOTE-SPLICING
              (LOOP FOR INDEX IN INDICES
                    FOR NTYPE IN NTYPES
                    COLLECT (ECLECTOR.READER:QUASIQUOTE
                             ((ECLECTOR.READER:UNQUOTE INDEX)
                              (%NTYPE-ID
                               (GENERALIZE-NTYPE
                                (ECLECTOR.READER:UNQUOTE NTYPE))))))))
         (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
                  (TYPE (NTYPE-CACHE (ECLECTOR.READER:UNQUOTE N))
                   (ECLECTOR.READER:UNQUOTE CACHE)))
         (AREF (ECLECTOR.READER:UNQUOTE CACHE)
               (ECLECTOR.READER:UNQUOTE-SPLICING INDICES))))))

[Petalisp/code/utilities/extended-euclid.lisp:15]
  (DEFUN EXTENDED-EUCLID (U V)
    "Given nonnegative integers u and v, returns the values u1 and u3 such
that u*u1 + v*u2 = u3 = gcd(u,v)."
    (DECLARE (ALEXANDRIA:NON-NEGATIVE-INTEGER U V))
    (LABELS ((FIXNUM-EUCLID (U1 U3 V1 V3)
               (DECLARE (SMALL-FIXNUM U1 V1)
                        (SMALL-NON-NEGATIVE-FIXNUM U3 V3)
                        (OPTIMIZE (SPEED 3) (SAFETY 0)))
               (IF (ZEROP V3)
                   (VALUES U1 U3)
                   (LET ((Q (FLOOR U3 V3)))
                     (DECLARE (SMALL-NON-NEGATIVE-FIXNUM Q))
                     (FIXNUM-EUCLID V1 V3 (- U1 (* Q V1)) (- U3 (* Q V3))))))
             (BIGNUM-EUCLID (U1 U3 V1 V3)
               (DECLARE (INTEGER U1 V1)
                        (ALEXANDRIA:NON-NEGATIVE-INTEGER U3 V3))
               (IF (ZEROP V3)
                   (VALUES U1 U3)
                   (LET ((Q (FLOOR U3 V3)))
                     (BIGNUM-EUCLID V1 V3 (- U1 (* Q V1)) (- U3 (* Q V3)))))))
      (IF (TYPEP (* U V) 'SMALL-NON-NEGATIVE-FIXNUM)
          (FIXNUM-EUCLID 1 U 0 V)
          (BIGNUM-EUCLID 1 U 0 V))))

[Racer/source/ccl-patches.lisp:41]
  (LET ((*WARN-IF-REDEFINE-KERNEL* NIL) (*WARN-IF-REDEFINE* NIL))
    (DEFUN WRITE-PNAME (NAME CASE STREAM)
      (DECLARE (TYPE SIMPLE-STRING NAME)
               (STREAM STREAM)
               (OPTIMIZE (SPEED 3) (SAFETY 0)))
      (LET* ((READTABLE *READTABLE*)
             (SYNTAX-READTABLE
              (IF *PRINT-READABLY*
                  %INITIAL-READTABLE%
                  READTABLE))
             (READCASE (READTABLE-CASE SYNTAX-READTABLE))
             (ATTRTAB (RDTAB.TTAB SYNTAX-READTABLE))
             (ESCAPE? (OR *PRINT-READABLY* *PRINT-ESCAPE*))
             (NEEDS-ESCAPE NIL))
        (FLET ((SLASHIFY? (CHAR)
                 (DECLARE (TYPE CHARACTER CHAR))
                 (AND ESCAPE?
                      (OR (AND (EQ READCASE :UPCASE) (LOWER-CASE-P CHAR))
                          (AND (EQ READCASE :DOWNCASE) (UPPER-CASE-P CHAR))
                          (EQL CHAR #\:)
                          (NOT
                           (EQL $CHT_CNST
                                (%CHARACTER-ATTRIBUTE CHAR ATTRTAB))))))
               (SINGLE-CASE-P (NAME)
                 (LET ((SOFAR NIL))
                   (DOTIMES (I (LENGTH NAME) SOFAR)
                     (DECLARE (TYPE FIXNUM I))
                     (DECLARE (TYPE SIMPLE-STRING NAME))
                     (LET* ((C (SCHAR NAME I))
                            (C-CASE
                             (IF (UPPER-CASE-P C)
                                 :UPCASE
                                 (IF (LOWER-CASE-P C)
                                     :DOWNCASE))))
                       (WHEN C-CASE
                         (IF SOFAR
                             (IF (NEQ SOFAR C-CASE)
                                 (RETURN NIL))
                             (SETQ SOFAR C-CASE))))))))
          (DECLARE
           (DYNAMIC-EXTENT (FUNCTION SLASHIFY?) (FUNCTION SINGLE-CASE-P)))
          (BLOCK ALICE
            (LET ((LEN (LENGTH NAME)) (SLASH-COUNT 0) (LAST-SLASH-POS 0))
              (DECLARE (TYPE FIXNUM LEN)
                       (TYPE FIXNUM SLASH-COUNT LAST-SLASH-POS))
              (WHEN ESCAPE?
                (WHEN
                    (OR (%IZEROP LEN)
                        (AND
                         (LET ((M (MAX (FLOOR LEN 4) 2)))
                           (DOTIMES (I (THE FIXNUM LEN) NIL)
                             (DECLARE (TYPE FIXNUM I))
                             (WHEN (SLASHIFY? (SCHAR NAME I))
                               (SETQ SLASH-COUNT (%I+ SLASH-COUNT 1)
                                     NEEDS-ESCAPE T)
                               (WHEN
                                   (OR *DO-NOT-SLASHIFY* (EQL SLASH-COUNT M)
                                       (EQ I (1+ LAST-SLASH-POS)))
                                 (RETURN T))
                               (SETQ LAST-SLASH-POS I)))))
                        (HANDLER-CASE
                         (%PARSE-NUMBER-TOKEN NAME 0 LEN *PRINT-BASE*)
                         (ARITHMETIC-ERROR (C) (DECLARE (IGNORE C))))
                        (DOTIMES (I LEN (SETQ NEEDS-ESCAPE T))
                          (DECLARE (FIXNUM I))
                          (UNLESS (EQL (SCHAR NAME I) #\.) (RETURN NIL))))
                  (RETURN-FROM ALICE (WRITE-ESCAPED-STRING NAME STREAM #\|))))
              (CASE READCASE
                (:PRESERVE
                 (RETURN-FROM ALICE
                   (IF NEEDS-ESCAPE
                       (WRITE-ESCAPED-STRING NAME STREAM #\|)
                       (WRITE-STRING NAME STREAM :START 0 :END LEN))))
                (:INVERT
                 (RETURN-FROM ALICE
                   (COND
                    ((SINGLE-CASE-P NAME)
                     (WRITE-PERVERTED-STRING NAME STREAM LEN :INVERT
                      (IF NEEDS-ESCAPE
                          #\|)))
                    (T
                     (IF NEEDS-ESCAPE
                         (WRITE-ESCAPED-STRING NAME STREAM #\|)
                         (WRITE-STRING NAME STREAM :START 0 :END LEN))))))
                (T
                 (WHEN (EQL SLASH-COUNT 0)
                   (RETURN-FROM ALICE
                     (COND
                      ((EQ READCASE CASE)
                       (WRITE-STRING NAME STREAM :START 0 :END LEN))
                      (T (WRITE-PERVERTED-STRING NAME STREAM LEN CASE)))))))
              (LET* ((OUTBUF-LEN (+ LEN LEN))
                     (OUTBUF-PTR -1)
                     (OUTBUF (MAKE-STRING OUTBUF-LEN)))
                (DECLARE (FIXNUM OUTBUF-PTR OUTBUF-LEN)
                         (DYNAMIC-EXTENT OUTBUF)
                         (SIMPLE-STRING OUTBUF))
                (DOTIMES (POS (THE FIXNUM LEN))
                  (DECLARE (TYPE FIXNUM POS))
                  (LET* ((CHAR (SCHAR NAME POS))
                         (SLASHIFY?
                          (COND ((EQL SLASH-COUNT 0) NIL)
                                ((EQL SLASH-COUNT 1) (EQL POS LAST-SLASH-POS))
                                (T (SLASHIFY? CHAR)))))
                    (DECLARE (TYPE CHARACTER CHAR))
                    (WHEN SLASHIFY?
                      (SETQ SLASH-COUNT (%I- SLASH-COUNT 1))
                      (SETF (SCHAR OUTBUF (INCF OUTBUF-PTR)) #\\))
                    (SETF (SCHAR OUTBUF (INCF OUTBUF-PTR)) CHAR)))
                (WRITE-STRING OUTBUF STREAM :START 0 :END
                              (1+ OUTBUF-PTR)))))))))

[Racer/source/gci-absorption.lisp:1367]
  (DEFUN TRANSFORM-GCI-WITH-INVERSE-ROLES (CONCEPT)
    (DECLARE (OPTIMIZE (SAFETY 1) (SPEED 1)))
    (LET ((TERM-LIST
           (IF (OR-CONCEPT-P CONCEPT)
               (CONCEPT-TERM CONCEPT)
               (LIST CONCEPT))))
      (MULTIPLE-VALUE-BIND (FOUNDP LEVEL TERM ALL-CONCEPT)
          (LOOP FOR ELEM IN TERM-LIST
                DO (MULTIPLE-VALUE-BIND (FOUNDP LLEVEL TERM)
                       (PROPER-INVERSE-ROLE-ALL-CONCEPT ELEM)
                     (WHEN FOUNDP
                       (ASSERT (NUMBERP LLEVEL))
                       (RETURN (VALUES T LLEVEL TERM ELEM)))))
        (WHEN FOUNDP
          (ASSERT (NUMBERP LEVEL))
          (LET* ((NEW-TERM-LIST (RACER-REMOVE ALL-CONCEPT TERM-LIST))
                 (ATOMIC-OR-OTHER-CONCEPT
                  (OR (FIND-IF #'ATOMIC-CONCEPT-P NEW-TERM-LIST)
                      (FIRST NEW-TERM-LIST)))
                 (NEW-CONCEPT
                  (IF ATOMIC-OR-OTHER-CONCEPT
                      (ENCODE-CONCEPT-TERM
                       (ECLECTOR.READER:QUASIQUOTE
                        (OR (ECLECTOR.READER:UNQUOTE TERM)
                            (ECLECTOR.READER:UNQUOTE
                             (MAKE-INVERSE-ROLE-ALL-CONCEPT ALL-CONCEPT LEVEL
                              (LET ((LENGTH (LENGTH NEW-TERM-LIST)))
                                (IF (> LENGTH 2)
                                    (ECLECTOR.READER:QUASIQUOTE
                                     (OR
                                      (ECLECTOR.READER:UNQUOTE
                                       ATOMIC-OR-OTHER-CONCEPT)
                                      ECLECTOR.READER:UNQUOTE
                                      (RACER-REMOVE ATOMIC-OR-OTHER-CONCEPT
                                       NEW-TERM-LIST)))
                                    (IF (EQL LENGTH 2)
                                        (ECLECTOR.READER:QUASIQUOTE
                                         (OR
                                          (ECLECTOR.READER:UNQUOTE-SPLICING
                                           NEW-TERM-LIST)))
                                        ATOMIC-OR-OTHER-CONCEPT))))))))
                      (WHEN
                          (AND (ALL-CONCEPT-P CONCEPT)
                               (INVERSE-ROLE-CONDITION-P
                                (CONCEPT-TERM CONCEPT)))
                        (ENCODE-CONCEPT-TERM
                         (ECLECTOR.READER:QUASIQUOTE
                          (OR (ECLECTOR.READER:UNQUOTE TERM)
                              (ECLECTOR.READER:UNQUOTE
                               (MAKE-INVERSE-ROLE-ALL-CONCEPT ALL-CONCEPT LEVEL
                                +BOTTOM-SYMBOL+)))))))))
            (WHEN NEW-CONCEPT
              (RACE-TRACE ("~&GCI ~S rewritten to ~S~%" CONCEPT NEW-CONCEPT))
              (VALUES T NEW-CONCEPT)))))))

[Racer/source/http.lisp:478]
  (DEFUN SUBSTRING (STRING START &OPTIONAL END DOWNCASEP)
    (DECLARE (TYPE STRING STRING)
             (TYPE FIXNUM START)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET* ((END (OR END (LENGTH STRING))) (RV (MAKE-STRING (- END START))))
      (DECLARE (TYPE FIXNUM END))
      (DO ((R-INDEX START (1+ R-INDEX))
           (W-INDEX 0 (1+ W-INDEX)))
          ((>= R-INDEX END) RV)
        (DECLARE (TYPE FIXNUM R-INDEX W-INDEX))
        (SETF (CHAR RV W-INDEX)
                (LET ((C (CHAR STRING R-INDEX)))
                  (IF DOWNCASEP
                      (CHAR-DOWNCASE C)
                      C))))))

[Racer/source/http.lisp:508]
  (DEFUN COLLECT-TO-CHAR (CHAR STRING &KEY (START 0) END DOWNCASEP)
    (DECLARE (TYPE STRING STRING)
             (TYPE FIXNUM START)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((END-INDEX
           (POSITION CHAR STRING :START START :END END :TEST #'CHAR=)))
      (WHEN END-INDEX
        (VALUES (SUBSTRING STRING START END-INDEX DOWNCASEP) END-INDEX))))

[Racer/source/racer-utilities.lisp:70]
  (DEFUN INTERNAL-CONCEPT-HASH (S-EXPR RECURSE)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (MACROLET ((CHOP (X)
                 (ECLECTOR.READER:QUASIQUOTE
                  (LOGAND (ECLECTOR.READER:UNQUOTE X) 4294967295)))
               (%1- (I)
                 (ECLECTOR.READER:QUASIQUOTE
                  (THE FIXNUM (1- (THE FIXNUM (ECLECTOR.READER:UNQUOTE I))))))
               (<^ (X A Y)
                 (ECLECTOR.READER:QUASIQUOTE
                  (CHOP
                   (LOGXOR
                    (ASH (ECLECTOR.READER:UNQUOTE X)
                         (ECLECTOR.READER:UNQUOTE A))
                    (ECLECTOR.READER:UNQUOTE Y)))))
               (<>^ (X A B Y)
                 (LET ((XX (GENSYM)))
                   (ECLECTOR.READER:QUASIQUOTE
                    (LET (((ECLECTOR.READER:UNQUOTE XX)
                           (ECLECTOR.READER:UNQUOTE X)))
                      (CHOP
                       (THE HASHCODE
                            (LOGXOR
                             (THE HASHCODE
                                  (LOGIOR
                                   (THE HASHCODE
                                        (ASH (ECLECTOR.READER:UNQUOTE XX)
                                             (ECLECTOR.READER:UNQUOTE A)))
                                   (THE HASHCODE
                                        (ASH (ECLECTOR.READER:UNQUOTE XX)
                                             (ECLECTOR.READER:UNQUOTE B)))))
                             (ECLECTOR.READER:UNQUOTE Y))))))))
               (SXHASH-CONS (SEQ LIM)
                 (ECLECTOR.READER:QUASIQUOTE
                  (IF* (EQL 0 (ECLECTOR.READER:UNQUOTE LIM)) THEN 13 ELSE
                   (SETQ (ECLECTOR.READER:UNQUOTE LIM)
                           (%1- (ECLECTOR.READER:UNQUOTE LIM)))
                   (LET ((INDEX 13) (HASH 2))
                     (DECLARE (FIXNUM INDEX)
                              (TYPE HASHCODE HASH))
                     (LOOP
                      (SETQ HASH
                              (<>^ HASH 5 -27
                               (INTERNAL-CONCEPT-HASH
                                (CAR (ECLECTOR.READER:UNQUOTE SEQ))
                                (ECLECTOR.READER:UNQUOTE LIM))))
                      (SETQ (ECLECTOR.READER:UNQUOTE SEQ)
                              (CDR (ECLECTOR.READER:UNQUOTE SEQ)))
                      (SETQ INDEX (%1- INDEX))
                      (IF* (ATOM (ECLECTOR.READER:UNQUOTE SEQ)) THEN
                       (RETURN
                        (<>^ HASH 5 -27
                         (INTERNAL-CONCEPT-HASH (ECLECTOR.READER:UNQUOTE SEQ)
                          (ECLECTOR.READER:UNQUOTE LIM))))
                       ELSEIF (EQL INDEX 0) THEN (RETURN HASH))))))))
      (COND ((CONSP S-EXPR) (SXHASH-CONS S-EXPR RECURSE))
            ((RACER-STRUCTURE-ID-P S-EXPR)
             (SXHASH (RACER-STRUCTURE-ID-HASH-ID S-EXPR)))
            (T (SXHASH S-EXPR)))))

[Racer/source/racer-utilities.lisp:150]
  (DEFUN CONCEPT-HASH (THING)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (COND
     ((RACER-STRUCTURE-ID-P THING) (SXHASH (RACER-STRUCTURE-ID-HASH-ID THING)))
     ((CONSP THING) (LIST-HASH THING 11)) (T (SXHASH THING))))

[SICL/Code/AST-evaluator/translate-code.lisp:3]
  (DEFUN TRANSLATE-TOP-LEVEL-AST (CLIENT AST)
    (LET* ((TABLE (MAKE-HASH-TABLE :TEST #'EQ))
           (LEXICAL-ENVIRONMENT (LIST TABLE))
           (FUNCTION-CELL-FINDER-VAR (GENSYM))
           (*RUN-TIME-ENVIRONMENT-NAME* (GENSYM))
           (*FUNCTION-CELLS* 'NIL)
           (CODE (TRANSLATE-AST CLIENT AST LEXICAL-ENVIRONMENT))
           (VARS
            (REMOVE-DUPLICATES
             (LOOP FOR NAME BEING EACH HASH-VALUE OF TABLE
                   COLLECT NAME))))
      (ECLECTOR.READER:QUASIQUOTE
       (LAMBDA ((ECLECTOR.READER:UNQUOTE *RUN-TIME-ENVIRONMENT-NAME*))
         (DECLARE
          (IGNORABLE (ECLECTOR.READER:UNQUOTE *RUN-TIME-ENVIRONMENT-NAME*)))
         (DECLARE
          (OPTIMIZE (SPEED 0) (COMPILATION-SPEED 3) (DEBUG 0) (SAFETY 3)
           (SPACE 0)))
         (DECLARE (MUFFLE-CONDITIONS COMPILER-NOTE))
         (LET* (((ECLECTOR.READER:UNQUOTE FUNCTION-CELL-FINDER-VAR)
                 (#S(FORMGREP:SYMREF :NAME "FDEFINITION" :QUALIFIER "ENV")
                  (#S(FORMGREP:SYMREF :NAME "CLIENT" :QUALIFIER "ENV")
                   (ECLECTOR.READER:UNQUOTE *RUN-TIME-ENVIRONMENT-NAME*))
                  (ECLECTOR.READER:UNQUOTE *RUN-TIME-ENVIRONMENT-NAME*)
                  '#S(FORMGREP:SYMREF
                      :NAME "FUNCTION-CELL"
                      :QUALIFIER "SICL-DATA-AND-CONTROL-FLOW")))
                (ECLECTOR.READER:UNQUOTE-SPLICING
                 (LOOP FOR (FUNCTION-NAME . VARIABLE-NAME) IN *FUNCTION-CELLS*
                       COLLECT (ECLECTOR.READER:QUASIQUOTE
                                ((ECLECTOR.READER:UNQUOTE VARIABLE-NAME)
                                 (FUNCALL
                                  (ECLECTOR.READER:UNQUOTE
                                   FUNCTION-CELL-FINDER-VAR)
                                  '(ECLECTOR.READER:UNQUOTE FUNCTION-NAME)))))))
           (DECLARE
            (IGNORABLE (ECLECTOR.READER:UNQUOTE FUNCTION-CELL-FINDER-VAR)))
           (LET (ECLECTOR.READER:UNQUOTE VARS)
             (DECLARE (IGNORABLE (ECLECTOR.READER:UNQUOTE-SPLICING VARS)))
             (ECLECTOR.READER:UNQUOTE CODE)))))))

[SICL/Code/Cleavir/CST-to-AST/environment-augmentation.lisp:139]
  (DEFUN AUGMENT-ENVIRONMENT-WITH-SINGLE-OPTIMIZE (CLIENT OPTIMIZE ENVIRONMENT)
    (LET ((QUALITY
           (IF (SYMBOLP OPTIMIZE)
               OPTIMIZE
               (FIRST OPTIMIZE)))
          (VALUE
           (IF (SYMBOLP OPTIMIZE)
               3
               (SECOND OPTIMIZE))))
      (ECASE QUALITY
        (SPEED
         (#S(FORMGREP:SYMREF :NAME "ADD-SPEED" :QUALIFIER "TRUCLER") CLIENT
          ENVIRONMENT VALUE))
        (COMPILATION-SPEED
         (#S(FORMGREP:SYMREF
             :NAME "ADD-COMPILATION-SPEED"
             :QUALIFIER "TRUCLER")
          CLIENT ENVIRONMENT VALUE))
        (SAFETY
         (#S(FORMGREP:SYMREF :NAME "ADD-SAFETY" :QUALIFIER "TRUCLER") CLIENT
          ENVIRONMENT VALUE))
        (SPACE
         (#S(FORMGREP:SYMREF :NAME "ADD-SPACE" :QUALIFIER "TRUCLER") CLIENT
          ENVIRONMENT VALUE))
        (DEBUG
         (#S(FORMGREP:SYMREF :NAME "ADD-DEBUG" :QUALIFIER "TRUCLER") CLIENT
          ENVIRONMENT VALUE)))))

[SICL/Code/Cleavir/CST-to-AST/utilities.lisp:57]
  (DEFUN PROPER-LIST-P (LIST)
    (DECLARE (OPTIMIZE (SAFETY 3)))
    (NUMBERP (IGNORE-ERRORS (LIST-LENGTH LIST))))

[SICL/Code/Hash-tables/Old/cliff-click.lisp:23]
  (DEFUN GETHASH (KEY HASH-TABLE)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (LOOP WITH INDEX = (ASH (LOGAND (SXHASH KEY) NIL) 1)
          WITH EMPTY = (EMPTY HASH-TABLE)
          WITH CONTENTS = (CONTENTS HASH-TABLE)
          FOR STORED-KEY = (SVREF CONTENTS INDEX)
          DO (COND
              ((EQ STORED-KEY EMPTY) (RETURN-FROM GETHASH (VALUES NIL NIL)))
              ((EQ STORED-KEY KEY)
               (LET ((STORED-VALUE (SVREF CONTENTS (1+ INDEX))))
                 (IF (EQ STORED-VALUE EMPTY)
                     (RETURN-FROM GETHASH (VALUES NIL NIL))
                     (RETURN-FROM GETHASH (VALUES STORED-VALUE T)))))
              (T (SETQ INDEX (LOGAND (+ INDEX 2) NIL))))))

[SICL/Code/Hash-tables/Old/cliff-click.lisp:39]
  (DEFUN (SETF GETHASH) (VALUE KEY HASH-TABLE)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (LOOP WITH INDEX = (ASH (LOGAND (SXHASH KEY) NIL) 1)
          WITH EMPTY = (EMPTY HASH-TABLE)
          WITH CONTENTS = (CONTENTS HASH-TABLE)
          FOR STORED-KEY = (SVREF CONTENTS INDEX)
          DO (COND
              ((EQ STORED-KEY EMPTY) (SETF (SVREF CONTENTS INDEX) KEY)
               (SETF (SVREF CONTENTS (1+ INDEX)) VALUE)
               (RETURN-FROM GETHASH VALUE))
              ((EQ STORED-KEY KEY) (SETF (SVREF CONTENTS (1+ INDEX)) VALUE)
               (RETURN-FROM GETHASH VALUE))
              (T (SETQ INDEX (LOGAND (+ INDEX 2) NIL))))))

[SICL/Code/Hash-tables/Old/cliff-click.lisp:55]
  (DEFUN REMHASH (KEY HASH-TABLE)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (LOOP WITH INDEX = (ASH (LOGAND (SXHASH KEY) NIL) 1)
          WITH EMPTY = (EMPTY HASH-TABLE)
          WITH CONTENTS = (CONTENTS HASH-TABLE)
          FOR STORED-KEY = (SVREF CONTENTS INDEX)
          DO (COND ((EQ STORED-KEY EMPTY) (RETURN-FROM REMHASH NIL))
                   ((EQ STORED-KEY KEY)
                    (IF (EQ (SVREF CONTENTS (1+ INDEX)) EMPTY)
                        (RETURN-FROM REMHASH NIL)
                        (PROGN
                         (SETF (SVREF CONTENTS (1+ INDEX)) EMPTY)
                         (RETURN-FROM REMHASH T))))
                   (T (SETQ INDEX (LOGAND (+ INDEX 2) NIL))))))

[SICL/Code/Package/find-cl-symbol.lisp:96]
  (DEFUN MAKE-DISPATCH-FUNCTION ()
    (COMPILE NIL
             (ECLECTOR.READER:QUASIQUOTE
              (LAMBDA (NAME)
                (DECLARE
                 (OPTIMIZE (SPEED 3) (COMPILATION-SPEED 0) (DEBUG 0) (SAFETY 0)
                  (SPACE 0)))
                (DECLARE (TYPE SIMPLE-STRING NAME))
                (LET ((LENGTH (LENGTH NAME)))
                  (DECLARE (TYPE FIXNUM LENGTH))
                  (ECLECTOR.READER:UNQUOTE
                   (MAKE-LENGTH-DISPATCH (MAKE-LENGTH-ALIST))))))))

[SICL/Code/Sequence/Test/auxiliary/ansi-aux-macros.lisp:8]
  (DECLAIM (OPTIMIZE (SAFETY 3)))

[SICL/Code/Sequence/Test/auxiliary/ansi-aux.lisp:8]
  (DECLAIM (OPTIMIZE (SAFETY 3)))

[SICL/Code/Sequence/Test/auxiliary/ansi-aux.lisp:225]
  (DEFUN SAFE (FN &REST ARGS)
    "Apply fn to args, trapping errors.  Convert type-errors to the
   symbol type-error."
    (DECLARE (OPTIMIZE (SAFETY 3)))
    (HANDLER-CASE (APPLY FN ARGS) (TYPE-ERROR NIL 'TYPE-ERROR) (ERROR (C) C)))

[SICL/Code/Sequence/Test/auxiliary/ansi-aux.lisp:237]
  (DEFMACRO CATCH-TYPE-ERROR (FORM)
    "Evaluate form in safe mode, returning its value if there is no error.
If an error does occur, return type-error on TYPE-ERRORs, or the error
condition itself on other errors."
    (ECLECTOR.READER:QUASIQUOTE
     (LOCALLY
      (DECLARE (OPTIMIZE (SAFETY 3)))
      (HANDLER-CASE (NORMALLY (ECLECTOR.READER:UNQUOTE FORM))
                    (TYPE-ERROR NIL 'TYPE-ERROR) (ERROR (C) C)))))

[SICL/Code/Sequence/Test/auxiliary/ansi-aux.lisp:246]
  (DEFMACRO CLASSIFY-ERROR* (FORM)
    "Evaluate form in safe mode, returning its value if there is no error.
If an error does occur, return a symbol classify the error, or allow
the condition to go uncaught if it cannot be classified."
    (ECLECTOR.READER:QUASIQUOTE
     (LOCALLY
      (DECLARE (OPTIMIZE (SAFETY 3)))
      (HANDLER-CASE (NORMALLY (ECLECTOR.READER:UNQUOTE FORM))
                    (UNDEFINED-FUNCTION NIL 'UNDEFINED-FUNCTION)
                    (PROGRAM-ERROR NIL 'PROGRAM-ERROR)
                    (PACKAGE-ERROR NIL 'PACKAGE-ERROR)
                    (TYPE-ERROR NIL 'TYPE-ERROR)
                    (CONTROL-ERROR NIL 'CONTROL-ERROR)
                    (PARSE-ERROR NIL 'PARSE-ERROR)
                    (STREAM-ERROR NIL 'STREAM-ERROR)
                    (READER-ERROR NIL 'READER-ERROR)
                    (FILE-ERROR NIL 'FILE-ERROR) (CELL-ERROR NIL 'CELL-ERROR)
                    (DIVISION-BY-ZERO NIL 'DIVISION-BY-ZERO)
                    (FLOATING-POINT-OVERFLOW NIL 'FLOATING-POINT-OVERFLOW)
                    (FLOATING-POINT-UNDERFLOW NIL 'FLOATING-POINT-UNDERFLOW)
                    (ARITHMETIC-ERROR NIL 'ARITHMETIC-ERROR)
                    (ERROR NIL 'ERROR)))))

[SICL/Code/Sequence/Test/auxiliary/ansi-aux.lisp:269]
  (DEFUN CLASSIFY-ERROR** (FORM)
    (HANDLER-BIND ((WARNING
                    #'(LAMBDA (C) (DECLARE (IGNORE C)) (MUFFLE-WARNING))))
      (PROCLAIM '(OPTIMIZE (SAFETY 3)))
      (CLASSIFY-ERROR*
       (IF #S(FORMGREP:SYMREF
              :NAME "*COMPILE-TESTS*"
              :QUALIFIER "REGRESSION-TEST")
           (FUNCALL
            (COMPILE NIL
                     (ECLECTOR.READER:QUASIQUOTE
                      (LAMBDA ()
                        (DECLARE (OPTIMIZE (SAFETY 3)))
                        (ECLECTOR.READER:UNQUOTE FORM)))))
           (EVAL FORM)))))

[SICL/Code/Sequence/Test/auxiliary/ansi-aux.lisp:287]
  (DEFMACRO SIGNALS-ERROR
            (FORM ERROR-NAME &KEY (SAFETY 3) (NAME NIL NAME-P) (INLINE NIL))
    (ECLECTOR.READER:QUASIQUOTE
     (HANDLER-BIND ((WARNING
                     #'(LAMBDA (C) (DECLARE (IGNORE C)) (MUFFLE-WARNING))))
       (PROCLAIM '(OPTIMIZE (SAFETY 3)))
       (HANDLER-CASE
        (APPLY #'VALUES NIL
               (MULTIPLE-VALUE-LIST
                (ECLECTOR.READER:UNQUOTE
                 (COND (INLINE FORM)
                       (#S(FORMGREP:SYMREF
                           :NAME "*COMPILE-TESTS*"
                           :QUALIFIER "REGRESSION-TEST")
                        (ECLECTOR.READER:QUASIQUOTE
                         (FUNCALL
                          (COMPILE NIL
                                   '(LAMBDA ()
                                      (DECLARE
                                       (OPTIMIZE
                                        (SAFETY
                                         (ECLECTOR.READER:UNQUOTE SAFETY))))
                                      (ECLECTOR.READER:UNQUOTE FORM))))))
                       (T
                        (ECLECTOR.READER:QUASIQUOTE
                         (EVAL '(ECLECTOR.READER:UNQUOTE FORM))))))))
        ((ECLECTOR.READER:UNQUOTE ERROR-NAME) (C)
         (COND
          (ECLECTOR.READER:UNQUOTE-SPLICING
           (CASE ERROR-NAME
             (TYPE-ERROR
              (ECLECTOR.READER:QUASIQUOTE
               (((TYPEP (TYPE-ERROR-DATUM C) (TYPE-ERROR-EXPECTED-TYPE C))
                 (VALUES NIL
                         (LIST
                          (LIST 'TYPEP (LIST 'QUOTE (TYPE-ERROR-DATUM C))
                                (LIST 'QUOTE (TYPE-ERROR-EXPECTED-TYPE C)))
                          "==> true"))))))
             ((UNDEFINED-FUNCTION UNBOUND-VARIABLE)
              (AND NAME-P
                   (ECLECTOR.READER:QUASIQUOTE
                    (((NOT
                       (EQ (CELL-ERROR-NAME C)
                           '(ECLECTOR.READER:UNQUOTE NAME)))
                      (VALUES NIL
                              (LIST 'CELL-ERROR-NAME "==>"
                                    (CELL-ERROR-NAME C))))))))
             ((STREAM-ERROR END-OF-FILE READER-ERROR)
              (ECLECTOR.READER:QUASIQUOTE
               (((NOT (STREAMP (STREAM-ERROR-STREAM C)))
                 (VALUES NIL
                         (LIST 'STREAM-ERROR-STREAM "==>"
                               (STREAM-ERROR-STREAM C)))))))
             (FILE-ERROR
              (ECLECTOR.READER:QUASIQUOTE
               (((NOT (PATHNAMEP (PATHNAME (FILE-ERROR-PATHNAME C))))
                 (VALUES NIL
                         (LIST 'FILE-ERROR-PATHNAME "==>"
                               (FILE-ERROR-PATHNAME C)))))))
             (T NIL)))
          (T (PRINTABLE-P C))))))))

[SICL/Code/Sequence/Test/auxiliary/ansi-aux.lisp:343]
  (DEFMACRO SIGNALS-TYPE-ERROR
            (VAR DATUM-FORM FORM &KEY (SAFETY 3) (INLINE NIL))
    (LET ((LAMBDA-FORM
           (ECLECTOR.READER:QUASIQUOTE
            (LAMBDA ((ECLECTOR.READER:UNQUOTE VAR))
              (DECLARE (OPTIMIZE (SAFETY (ECLECTOR.READER:UNQUOTE SAFETY))))
              (ECLECTOR.READER:UNQUOTE FORM)))))
      (ECLECTOR.READER:QUASIQUOTE
       (LET (((ECLECTOR.READER:UNQUOTE VAR)
              (ECLECTOR.READER:UNQUOTE DATUM-FORM)))
         (DECLARE (OPTIMIZE SAFETY))
         (HANDLER-BIND ((WARNING
                         #'(LAMBDA (C) (DECLARE (IGNORE C)) (MUFFLE-WARNING))))
           (HANDLER-CASE
            (APPLY #'VALUES NIL
                   (MULTIPLE-VALUE-LIST
                    (FUNCALL
                     (ECLECTOR.READER:UNQUOTE
                      (COND
                       (INLINE
                        (ECLECTOR.READER:QUASIQUOTE
                         #'(ECLECTOR.READER:UNQUOTE LAMBDA-FORM)))
                       (#S(FORMGREP:SYMREF
                           :NAME "*COMPILE-TESTS*"
                           :QUALIFIER "REGRESSION-TEST")
                        (ECLECTOR.READER:QUASIQUOTE
                         (COMPILE NIL '(ECLECTOR.READER:UNQUOTE LAMBDA-FORM))))
                       (T
                        (ECLECTOR.READER:QUASIQUOTE
                         (EVAL '(ECLECTOR.READER:UNQUOTE LAMBDA-FORM))))))
                     (ECLECTOR.READER:UNQUOTE VAR))))
            (TYPE-ERROR (C)
             (LET ((DATUM (TYPE-ERROR-DATUM C))
                   (EXPECTED-TYPE (TYPE-ERROR-EXPECTED-TYPE C)))
               (COND
                ((NOT (EQL (ECLECTOR.READER:UNQUOTE VAR) DATUM))
                 (LIST :DATUM-MISMATCH (ECLECTOR.READER:UNQUOTE VAR) DATUM))
                ((TYPEP DATUM EXPECTED-TYPE)
                 (LIST :IS-TYPEP DATUM EXPECTED-TYPE))
                (T (PRINTABLE-P C)))))))))))

[SICL/Code/Sequence/Test/auxiliary/ansi-aux.lisp:390]
  (DEFMACRO CHECK-TYPE-ERROR (&BODY ARGS)
    (ECLECTOR.READER:QUASIQUOTE
     (LOCALLY
      (DECLARE (OPTIMIZE SAFETY))
      (CHECK-TYPE-ERROR* (ECLECTOR.READER:UNQUOTE-SPLICING ARGS)))))

[SICL/Code/Sequence/Test/auxiliary/ansi-aux.lisp:393]
  (DEFUN PRINTABLE-P (OBJ)
    "Returns T iff obj can be printed to a string."
    (WITH-STANDARD-IO-SYNTAX
     (LET ((*PRINT-READABLY* NIL) (*PRINT-ESCAPE* NIL))
       (DECLARE (OPTIMIZE SAFETY))
       (HANDLER-CASE (AND (STRINGP (WRITE-TO-STRING OBJ)) T)
                     (CONDITION (C) (DECLARE (IGNORE C)) NIL)))))

[SICL/Code/Sequence/Test/auxiliary/ansi-aux.lisp:1162]
  (DEFUN PACKAGE-DESIGNATOR-P (X)
    "TRUE if x could be a package designator.  The package need not
   actually exist."
    (OR (PACKAGEP X)
        (HANDLER-CASE (AND (LOCALLY (DECLARE (OPTIMIZE SAFETY)) (STRING X)) T)
                      (TYPE-ERROR NIL NIL))))

[SICL/Code/Sequence/Test/auxiliary/ansi-aux.lisp:1171]
  (DEFMACRO DEF-FOLD-TEST (NAME FORM)
    "Create a test that FORM, which should produce a fresh value,
   does not improperly introduce sharing during constant folding."
    (ECLECTOR.READER:QUASIQUOTE
     (DEFTEST (ECLECTOR.READER:UNQUOTE NAME)
      (FLET ((%F ()
               (DECLARE
                (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (COMPILATION-SPEED 0)
                 (DEBUG 0)))
               (ECLECTOR.READER:UNQUOTE FORM)))
        (EQ (%F) (%F)))
      NIL)))

[SICL/Code/Sequence/Test/auxiliary/universe.lisp:42]
  (DEFPARAMETER *CONDITION-OBJECTS*
    (LOCALLY
     (DECLARE (OPTIMIZE SAFETY))
     (LOOP FOR TP IN *CONDITION-TYPES*
           APPEND (HANDLER-CASE (LIST (MAKE-CONDITION TP)) (ERROR NIL NIL)))))

[SICL/Code/Sequence/Test/auxiliary/universe.lisp:51]
  (DEFPARAMETER *PACKAGE-OBJECTS*
    (LOCALLY
     (DECLARE (OPTIMIZE SAFETY))
     (LOOP FOR PNAME IN *STANDARD-PACKAGE-NAMES*
           APPEND (HANDLER-CASE
                   (LET ((PKG (FIND-PACKAGE PNAME)))
                     (AND PKG (LIST PKG)))
                   (ERROR NIL NIL)))))

[SICL/Code/Sequence/Test/auxiliary/universe.lisp:159]
  (DEFUN TRY-TO-READ-CHARS (&REST NAMELIST)
    (DECLARE (OPTIMIZE SAFETY))
    (LOOP FOR NAME IN NAMELIST
          APPEND (HANDLER-CASE
                  (LIST (READ-FROM-STRING (CONCATENATE 'STRING "#\\" NAME)))
                  (ERROR NIL NIL))))

[SICL/Code/Sequence/Test/auxiliary/universe.lisp:276]
  (DEFPARAMETER *ARRAYS*
    (APPEND (LIST (MAKE-ARRAY '10)) (MAPCAR #'MAKE-ARRAY *ARRAY-DIMENSIONS*)
            (LOOP FOR TP IN '(FIXNUM FLOAT BIT CHARACTER BASE-CHAR
                              (SIGNED-BYTE 8) (UNSIGNED-BYTE 8))
                  FOR ELEMENT IN '(18 16.0 0 #\x #\y 127 200)
                  APPEND (LOOP FOR D IN *ARRAY-DIMENSIONS*
                               COLLECT (MAKE-ARRAY D :ELEMENT-TYPE TP
                                                   :INITIAL-ELEMENT ELEMENT)))
            (LOOP FOR I FROM 1 TO 64
                  APPEND (LIST
                          (MAKE-ARRAY 10 :ELEMENT-TYPE
                                      (ECLECTOR.READER:QUASIQUOTE
                                       (UNSIGNED-BYTE
                                        (ECLECTOR.READER:UNQUOTE I)))
                                      :INITIAL-ELEMENT 1)
                          (MAKE-ARRAY 10 :ELEMENT-TYPE
                                      (ECLECTOR.READER:QUASIQUOTE
                                       (SIGNED-BYTE
                                        (ECLECTOR.READER:UNQUOTE I)))
                                      :INITIAL-ELEMENT 0)))
            (LOOP FOR D IN *ARRAY-DIMENSIONS*
                  COLLECT (MAKE-ARRAY D :ADJUSTABLE T))
            (LOOP FOR D IN *ARRAY-DIMENSIONS*
                  FOR I FROM 1
                  COLLECT (MAKE-ARRAY D :DISPLACED-TO *DEFAULT-ARRAY-TARGET*
                                      :DISPLACED-INDEX-OFFSET I))
            (LIST #() #* #*00000 #*1010101010101101
                  (MAKE-ARRAY 10 :ELEMENT-TYPE 'BIT :INITIAL-CONTENTS
                              '(0 1 1 0 1 1 1 1 0 1) :FILL-POINTER 8)
                  (MAKE-ARRAY 5 :ELEMENT-TYPE 'BIT :DISPLACED-TO #*0111000110
                              :DISPLACED-INDEX-OFFSET 3)
                  (MAKE-ARRAY 10 :ELEMENT-TYPE 'BIT :INITIAL-CONTENTS
                              '(1 1 0 0 1 1 1 0 1 1) :ADJUSTABLE T))
            (LIST
             (MAKE-ARRAY '(10) :ELEMENT-TYPE '(INTEGER 0 (256))
                         :INITIAL-CONTENTS '(8 9 10 11 12 1 2 3 4 5))
             (MAKE-ARRAY '(10) :ELEMENT-TYPE '(INTEGER -128 (128))
                         :INITIAL-CONTENTS '(8 9 -10 11 -12 1 -2 -3 4 5))
             (MAKE-ARRAY '(6) :ELEMENT-TYPE '(INTEGER 0 (NIL))
                         :INITIAL-CONTENTS '(5 9 100 1312 23432 87))
             (MAKE-ARRAY '(4) :ELEMENT-TYPE '(INTEGER 0 (NIL))
                         :INITIAL-CONTENTS '(100000 231213 8123712 19))
             (MAKE-ARRAY '(4) :ELEMENT-TYPE '(INTEGER 0 (NIL))
                         :INITIAL-CONTENTS '(NIL 0 872312 10000000))
             (MAKE-ARRAY NIL :ELEMENT-TYPE '(INTEGER 0 (256)) :INITIAL-ELEMENT
                         14)
             (MAKE-ARRAY '(2 2) :ELEMENT-TYPE '(INTEGER 0 (256))
                         :INITIAL-CONTENTS '((34 98) (14 119))))
            (LIST
             (MAKE-ARRAY '(5) :ELEMENT-TYPE 'SHORT-FLOAT :INITIAL-CONTENTS
                         '(1.0 2.0 3.0 4.0 5.0))
             (MAKE-ARRAY '(5) :ELEMENT-TYPE 'SINGLE-FLOAT :INITIAL-CONTENTS
                         '(1.0 2.0 3.0 4.0 5.0))
             (MAKE-ARRAY '(5) :ELEMENT-TYPE 'DOUBLE-FLOAT :INITIAL-CONTENTS
                         '(1.0d0 2.0d0 3.0d0 4.0d0 5.0d0))
             (MAKE-ARRAY '(5) :ELEMENT-TYPE 'LONG-FLOAT :INITIAL-CONTENTS
                         '(1.0d0 2.0d0 3.0d0 4.0d0 5.0d0)))
            (LOCALLY
             (DECLARE (OPTIMIZE SAFETY))
             (HANDLER-CASE (LIST (MAKE-ARRAY '(0) :ELEMENT-TYPE NIL))
                           (ERROR NIL NIL)))))

[SICL/Code/Sequence/Test/auxiliary/universe.lisp:376]
  (DEFPARAMETER *PATHNAMES*
    (LOCALLY
     (DECLARE (OPTIMIZE SAFETY))
     (LOOP FOR FORM IN '((MAKE-PATHNAME :NAME "foo")
                         (MAKE-PATHNAME :NAME "FOO" :CASE :COMMON)
                         (MAKE-PATHNAME :NAME "bar")
                         (MAKE-PATHNAME :NAME "foo" :TYPE "txt")
                         (MAKE-PATHNAME :NAME "bar" :TYPE "txt")
                         (MAKE-PATHNAME :NAME "XYZ" :TYPE "TXT" :CASE :COMMON)
                         (MAKE-PATHNAME :NAME NIL) (MAKE-PATHNAME :NAME :WILD)
                         (MAKE-PATHNAME :NAME NIL :TYPE "txt")
                         (MAKE-PATHNAME :NAME :WILD :TYPE "txt")
                         (MAKE-PATHNAME :NAME :WILD :TYPE "TXT" :CASE :COMMON)
                         (MAKE-PATHNAME :NAME :WILD :TYPE "abc" :CASE :COMMON)
                         (MAKE-PATHNAME :DIRECTORY :WILD)
                         (MAKE-PATHNAME :TYPE :WILD)
                         (MAKE-PATHNAME :VERSION :WILD)
                         (MAKE-PATHNAME :VERSION :NEWEST))
           APPEND (IGNORE-ERRORS
                   (EVAL
                    (ECLECTOR.READER:QUASIQUOTE
                     (LIST (ECLECTOR.READER:UNQUOTE FORM))))))))

[SICL/Code/Sequence/Test/auxiliary/universe.lisp:397]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (LOCALLY
     (DECLARE (OPTIMIZE SAFETY))
     (IGNORE-ERRORS
      (SETF (LOGICAL-PATHNAME-TRANSLATIONS "CLTESTROOT")
              (ECLECTOR.READER:QUASIQUOTE
               (("**;*.*.*"
                 (ECLECTOR.READER:UNQUOTE
                  (MERGE-PATHNAMES "sandbox/"
                                   (MAKE-PATHNAME :DIRECTORY
                                                  '(:ABSOLUTE :WILD-INFERIORS)
                                                  :NAME :WILD :TYPE
                                                  :WILD))))))))
     (IGNORE-ERRORS
      (SETF (LOGICAL-PATHNAME-TRANSLATIONS "CLTEST")
              (ECLECTOR.READER:QUASIQUOTE
               (("**;*.*.*"
                 (ECLECTOR.READER:UNQUOTE
                  (MERGE-PATHNAMES "sandbox/"
                                   (MAKE-PATHNAME :DIRECTORY
                                                  (APPEND
                                                   (PATHNAME-DIRECTORY
                                                    (TRUENAME (MAKE-PATHNAME)))
                                                   '(:WILD-INFERIORS))
                                                  :NAME :WILD :TYPE
                                                  :WILD))))))))))

[SICL/Code/Sequence/Test/auxiliary/universe.lisp:418]
  (DEFPARAMETER *LOGICAL-PATHNAMES*
    (LOCALLY
     (DECLARE (OPTIMIZE SAFETY))
     (APPEND (IGNORE-ERRORS (LIST (LOGICAL-PATHNAME "CLTESTROOT:"))))))

[SICL/Code/Sequence/Test/elt.lisp:8]
  (DECLAIM (OPTIMIZE (SAFETY 3)))

[SICL/Code/Sequence/Test/map-into.lisp:464]
  (DEFTEST MAP-INTO.ERROR.2
   (AND
    (LOCALLY
     (DECLARE (OPTIMIZE (SAFETY 3)))
     (HANDLER-CASE (EVAL '(MAP-INTO NIL #'IDENTITY 'A)) (TYPE-ERROR NIL NIL)))
    :BAD)
   NIL)

[SICL/Code/Sequence/Test/merge.lisp:607]
  (DEFTEST MERGE.ERROR.1
   (HANDLER-CASE
    (EVAL
     '(LOCALLY
       (DECLARE (OPTIMIZE SAFETY))
       (MERGE 'SYMBOL (LIST 1 2 3) (LIST 4 5 6) #'<)))
    (ERROR NIL :CAUGHT))
   :CAUGHT)

[SICL/Code/Sequence/from-end.lisp:1]
  (DEFUN TT1 (LIST LENGTH)
    (DECLARE (TYPE FIXNUM LENGTH)
             (OPTIMIZE (SPEED 3) (COMPILATION-SPEED 0) (SAFETY 0)))
    (LET ((COUNT 0))
      (DECLARE (TYPE FIXNUM COUNT))
      (FLET ((PROCESS (ELEM)
               (WHEN (EQL ELEM 0) (INCF COUNT))))
        (LABELS ((TRAVERSE (REST LENGTH)
                   (DECLARE (TYPE FIXNUM LENGTH))
                   (WHEN (> LENGTH 0)
                     (WHEN (CONSP REST)
                       (TRAVERSE (CDR REST) (1- LENGTH))
                       (PROCESS (CAR REST))))))
          (TRAVERSE LIST LENGTH)))))

[SICL/Papers/Generic-dispatch/benchmark.lisp:9]
  (DEFUN F ()
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (DEBUG 0)))
    (LOOP WITH I = *I*
          REPEAT 10000
          DO (LOOP REPEAT 100000
                   DO (X I))))

[SICL/Papers/Generic-dispatch/test.lisp:5]
  (DEFUN F ()
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (DEBUG 0)))
    (LOOP WITH I = *I*
          REPEAT 1000000000
          DO (X I)))

[SICL/Papers/Generic-dispatch/test.lisp:19]
  (DEFUN Y1 (INSTANCE)
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (DEBUG 0)))
    (LET* ((RACK (S-RACK INSTANCE)) (STAMP (SVREF RACK 0)))
      (DECLARE (TYPE FIXNUM STAMP))
      (IF (= STAMP 10)
          (SVREF RACK 1)
          (ERROR "1"))))

[SICL/Papers/Generic-dispatch/test.lisp:30]
  (DEFUN G1 ()
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (DEBUG 0)))
    (LOOP WITH J = *J*
          REPEAT 1000000000
          DO (Y1 J)))

[SICL/Papers/Generic-dispatch/test.lisp:38]
  (DEFUN Y2 (INSTANCE)
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (DEBUG 0)))
    (LET* ((RACK (S-RACK INSTANCE)) (STAMP (SVREF RACK 0)))
      (DECLARE (TYPE FIXNUM STAMP))
      (COND ((> STAMP 1280) (ERROR "1")) ((> STAMP 640) (ERROR "2"))
            ((> STAMP 320) (ERROR "3")) ((> STAMP 160) (ERROR "4"))
            ((> STAMP 80) (ERROR "5")) ((> STAMP 40) (ERROR "6"))
            ((> STAMP 20) (ERROR "7")) ((> STAMP 10) (ERROR "8"))
            (T (SVREF RACK 1)))))

[SICL/Papers/Generic-dispatch/test.lisp:63]
  (DEFUN G2 ()
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (DEBUG 0)))
    (LOOP WITH J = *J*
          REPEAT 1000000000
          DO (Y2 J)))

[SICL/Papers/Generic-dispatch/test.lisp:71]
  (DEFUN Y3 (INSTANCE)
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (DEBUG 0)))
    (LET* ((RACK (S-RACK INSTANCE)) (STAMP (SVREF RACK 0)))
      (DECLARE (TYPE FIXNUM STAMP))
      (COND ((> STAMP 12800000) (ERROR "1")) ((> STAMP 6400000) (ERROR "2"))
            ((> STAMP 3200000) (ERROR "3")) ((> STAMP 1600000) (ERROR "4"))
            ((> STAMP 800000) (ERROR "5")) ((> STAMP 400000) (ERROR "6"))
            ((> STAMP 200000) (ERROR "7")) ((> STAMP 100000) (ERROR "8"))
            (T (SVREF RACK 1)))))

[SICL/Papers/Generic-dispatch/test.lisp:96]
  (DEFUN G3 ()
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (DEBUG 0)))
    (LOOP WITH J = *J*
          REPEAT 1000000000
          DO (Y3 J)))

[SICL/Papers/Generic-dispatch/test.lisp:104]
  (DEFUN Y4 (INSTANCE)
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (DEBUG 0)))
    (LET* ((RACK (S-RACK INSTANCE)) (STAMP (SVREF RACK 0)))
      (DECLARE (TYPE FIXNUM STAMP))
      (IF (< STAMP 2)
          (IF (< STAMP 1)
              (SVREF RACK 1)
              (SVREF RACK 2))
          (IF (< STAMP 3)
              (SVREF RACK 3)
              (SVREF RACK 4)))))

[SICL/Papers/Generic-dispatch/test.lisp:125]
  (DEFUN G4 ()
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (DEBUG 0)))
    (LOOP WITH J0 = (MAKE 0)
          WITH J1 = (MAKE 1)
          WITH J2 = (MAKE 2)
          WITH J3 = (MAKE 3)
          REPEAT 250000000
          DO (Y4 J0) (Y4 J2) (Y4 J1) (Y4 J3)))

[SICL/Papers/Generic-dispatch/test2.lisp:13]
  (DEFUN FF ()
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (DEBUG 0)))
    (LOOP WITH I1 = *I1*
          WITH I2 = *I2*
          WITH I3 = *I3*
          WITH I4 = *I4*
          WITH I5 = *I5*
          REPEAT 200000000
          DO (X I1) (X I2) (X I3) (X I4) (X I5)))

[SICL/Papers/Generic-dispatch/test2.lisp:35]
  (DEFUN Y (INSTANCE)
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (DEBUG 0)))
    (LET* ((RACK (S-RACK INSTANCE)) (STAMP (SVREF RACK 0)))
      (DECLARE (TYPE FIXNUM STAMP))
      (IF (= STAMP 10)
          (SVREF RACK 1)
          (ERROR "1"))))

[SICL/Papers/Generic-dispatch/test2.lisp:46]
  (DEFUN G ()
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (DEBUG 0)))
    (LOOP WITH J = *J*
          REPEAT 1000000000
          DO (Y J)))

[SICL/Papers/Generic-dispatch/test2.lisp:54]
  (DEFUN YY (INSTANCE)
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (DEBUG 0)))
    (LET* ((RACK (S-RACK INSTANCE)) (STAMP (SVREF RACK 0)))
      (DECLARE (TYPE FIXNUM STAMP))
      (COND ((> STAMP 1280) (ERROR "1")) ((> STAMP 640) (ERROR "2"))
            ((> STAMP 320) (ERROR "3")) ((> STAMP 160) (ERROR "4"))
            ((> STAMP 80) (ERROR "5")) ((> STAMP 40) (ERROR "6"))
            ((> STAMP 20) (ERROR "7")) ((> STAMP 10) (ERROR "8"))
            (T (SVREF RACK 1)))))

[SICL/Papers/Generic-dispatch/test2.lisp:79]
  (DEFUN GG ()
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (DEBUG 0)))
    (LOOP WITH J = *J*
          REPEAT 1000000000
          DO (YY J)))

[SICL/Papers/Generic-dispatch/test2.lisp:87]
  (DEFUN YYY (INSTANCE)
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (DEBUG 0)))
    (LET* ((RACK (S-RACK INSTANCE)) (STAMP (SVREF RACK 0)))
      (DECLARE (TYPE FIXNUM STAMP))
      (COND ((> STAMP 12800000) (ERROR "1")) ((> STAMP 6400000) (ERROR "2"))
            ((> STAMP 3200000) (ERROR "3")) ((> STAMP 1600000) (ERROR "4"))
            ((> STAMP 800000) (ERROR "5")) ((> STAMP 400000) (ERROR "6"))
            ((> STAMP 200000) (ERROR "7")) ((> STAMP 100000) (ERROR "8"))
            (T (SVREF RACK 1)))))

[SICL/Papers/Generic-dispatch/test2.lisp:112]
  (DEFUN GGG ()
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (DEBUG 0)))
    (LOOP WITH J = *J*
          REPEAT 1000000000
          DO (YYY J)))

[SICL/Papers/Reverse-order/Code/Count/1-count.lisp:1]
  (DEFUN REVERSE-COUNT-1 (X LIST)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0) (COMPILATION-SPEED 0)))
    (LOOP FOR E IN (REVERSE LIST)
          COUNT (EQ X E)))

[SICL/Papers/Reverse-order/Code/Count/10-count.lisp:3]
  (DEFUN COUNT-FROM-END-WITH-LENGTH-10 (X LIST LENGTH)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0) (COMPILATION-SPEED 0)))
    (DECLARE (TYPE FIXNUM LENGTH))
    (FLET ((COUNT-FROM-ARRAY (X LIST LEN)
             (DECLARE (TYPE FIXNUM LEN)
                      (OPTIMIZE (SPEED 3) (COMPILATION-SPEED 0)))
             (LET ((V (MAKE-ARRAY LEN)))
               (DECLARE (DYNAMIC-EXTENT V))
               (LOOP FOR E IN LIST
                     FOR I FROM (1- LEN) DOWNTO 0
                     DO (SETF (AREF V I) E))
               (LOOP FOR I FROM 0 BELOW LEN
                     WHEN (EQ X (AREF V I))
                     COUNT 1))))
      (MACROLET ((DIVIDE (X REST LEN K)
                   (LET* ((N (ASH 1 K))
                          (GENSYMS
                           (LOOP REPEAT N
                                 COLLECT (GENSYM)))
                          (F (GENSYM)))
                     (ECLECTOR.READER:QUASIQUOTE
                      (LET (((ECLECTOR.READER:UNQUOTE F)
                             (ASH LEN (- (ECLECTOR.READER:UNQUOTE K))))
                            ((ECLECTOR.READER:UNQUOTE (CAR GENSYMS))
                             (ECLECTOR.READER:UNQUOTE REST)))
                        (LET* (ECLECTOR.READER:UNQUOTE
                               (LOOP
                                FOR
                                GENSYM1
                                IN
                                GENSYMS
                                FOR
                                GENSYM2
                                IN
                                (CDR GENSYMS)
                                COLLECT
                                (ECLECTOR.READER:QUASIQUOTE
                                 ((ECLECTOR.READER:UNQUOTE GENSYM2)
                                  (NTHCDR (ECLECTOR.READER:UNQUOTE F)
                                          (ECLECTOR.READER:UNQUOTE GENSYM1))))))
                          (+
                           (TRAVERSE (ECLECTOR.READER:UNQUOTE X)
                            (NTHCDR (ECLECTOR.READER:UNQUOTE F)
                                    (ECLECTOR.READER:UNQUOTE
                                     (CAR (LAST GENSYMS))))
                            (- (ECLECTOR.READER:UNQUOTE LEN)
                               (ASH (ECLECTOR.READER:UNQUOTE F)
                                    (ECLECTOR.READER:UNQUOTE K))))
                           (ECLECTOR.READER:UNQUOTE-SPLICING
                            (LOOP FOR GENSYM IN (REVERSE GENSYMS)
                                  COLLECT (ECLECTOR.READER:QUASIQUOTE
                                           (TRAVERSE
                                            (ECLECTOR.READER:UNQUOTE X)
                                            (ECLECTOR.READER:UNQUOTE GENSYM)
                                            (ECLECTOR.READER:UNQUOTE
                                             F))))))))))))
        (LABELS ((TRAVERSE (X REST LEN)
                   (DECLARE (TYPE FIXNUM LEN))
                   (COND ((<= LEN 4096) (COUNT-FROM-ARRAY X REST LEN))
                         ((<= LEN 8192) (DIVIDE X REST LEN 1))
                         ((<= LEN 16384) (DIVIDE X REST LEN 2))
                         ((<= LEN 32768) (DIVIDE X REST LEN 3))
                         (T (DIVIDE X REST LEN 4)))))
          (TRAVERSE X LIST LENGTH)))))

[SICL/Papers/Reverse-order/Code/Count/11-count.lisp:3]
  (DEFUN COUNT-FROM-END-WITH-LENGTH-11 (X LIST LENGTH)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0) (COMPILATION-SPEED 0)))
    (DECLARE (TYPE FIXNUM LENGTH))
    (FLET ((COUNT-FROM-ARRAY (X LIST LEN)
             (DECLARE (TYPE FIXNUM LEN)
                      (OPTIMIZE (SPEED 3) (COMPILATION-SPEED 0)))
             (LET ((V (MAKE-ARRAY 4096)))
               (DECLARE (DYNAMIC-EXTENT V))
               (LOOP FOR E IN LIST
                     FOR I FROM (1- LEN) DOWNTO 0
                     DO (SETF (AREF V I) E))
               (LOOP FOR I FROM 0 BELOW LEN
                     WHEN (EQ X (AREF V I))
                     COUNT 1))))
      (MACROLET ((DIVIDE (X REST LEN K)
                   (LET* ((N (ASH 1 K))
                          (GENSYMS
                           (LOOP REPEAT N
                                 COLLECT (GENSYM)))
                          (F (GENSYM)))
                     (ECLECTOR.READER:QUASIQUOTE
                      (LET (((ECLECTOR.READER:UNQUOTE F)
                             (ASH LEN (- (ECLECTOR.READER:UNQUOTE K))))
                            ((ECLECTOR.READER:UNQUOTE (CAR GENSYMS))
                             (ECLECTOR.READER:UNQUOTE REST)))
                        (LET* (ECLECTOR.READER:UNQUOTE
                               (LOOP
                                FOR
                                GENSYM1
                                IN
                                GENSYMS
                                FOR
                                GENSYM2
                                IN
                                (CDR GENSYMS)
                                COLLECT
                                (ECLECTOR.READER:QUASIQUOTE
                                 ((ECLECTOR.READER:UNQUOTE GENSYM2)
                                  (NTHCDR (ECLECTOR.READER:UNQUOTE F)
                                          (ECLECTOR.READER:UNQUOTE GENSYM1))))))
                          (+
                           (TRAVERSE (ECLECTOR.READER:UNQUOTE X)
                            (NTHCDR (ECLECTOR.READER:UNQUOTE F)
                                    (ECLECTOR.READER:UNQUOTE
                                     (CAR (LAST GENSYMS))))
                            (- (ECLECTOR.READER:UNQUOTE LEN)
                               (ASH (ECLECTOR.READER:UNQUOTE F)
                                    (ECLECTOR.READER:UNQUOTE K))))
                           (ECLECTOR.READER:UNQUOTE-SPLICING
                            (LOOP FOR GENSYM IN (REVERSE GENSYMS)
                                  COLLECT (ECLECTOR.READER:QUASIQUOTE
                                           (TRAVERSE
                                            (ECLECTOR.READER:UNQUOTE X)
                                            (ECLECTOR.READER:UNQUOTE GENSYM)
                                            (ECLECTOR.READER:UNQUOTE
                                             F))))))))))))
        (LABELS ((TRAVERSE (X REST LEN)
                   (DECLARE (TYPE FIXNUM LEN))
                   (COND ((<= LEN 4096) (COUNT-FROM-ARRAY X REST LEN))
                         ((<= LEN 8192) (DIVIDE X REST LEN 1))
                         ((<= LEN 16384) (DIVIDE X REST LEN 2))
                         ((<= LEN 32768) (DIVIDE X REST LEN 3))
                         (T (DIVIDE X REST LEN 4)))))
          (TRAVERSE X LIST LENGTH)))))

[SICL/Papers/Reverse-order/Code/Count/2-count.lisp:2]
  (DEFUN COUNT-FROM-END-WITH-LENGTH-2 (X LIST LENGTH)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0) (COMPILATION-SPEED 0)))
    (DECLARE (TYPE FIXNUM LENGTH))
    (LET ((COUNT 0))
      (DECLARE (TYPE FIXNUM COUNT))
      (FLET ((PROCESS (ELEM)
               (WHEN (EQ ELEM X) (INCF COUNT))))
        (LABELS ((RECURSIVE-TRAVERSE (REST N)
                   (DECLARE (TYPE FIXNUM N))
                   (WHEN (> N 0)
                     (RECURSIVE-TRAVERSE (CDR REST) (1- N))
                     (PROCESS (CAR REST)))))
          (RECURSIVE-TRAVERSE LIST LENGTH)))
      COUNT))

[SICL/Papers/Reverse-order/Code/Count/3-count.lisp:2]
  (DEFUN COUNT-FROM-END-WITH-LENGTH-3 (X LIST LENGTH)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0) (COMPILATION-SPEED 0)))
    (DECLARE (TYPE FIXNUM LENGTH))
    (LET ((COUNT 0))
      (DECLARE (TYPE FIXNUM COUNT))
      (FLET ((PROCESS (ELEM)
               (WHEN (EQ ELEM X) (INCF COUNT))))
        (LABELS ((RECURSIVE-TRAVERSE (REST N)
                   (DECLARE (TYPE FIXNUM N))
                   (WHEN (> N 0)
                     (RECURSIVE-TRAVERSE (CDR REST) (1- N))
                     (PROCESS (CAR REST))))
                 (TRAVERSE (REST N)
                   (DECLARE (TYPE FIXNUM N))
                   (COND ((<= N 16384) (RECURSIVE-TRAVERSE REST N))
                         (T
                          (LET* ((N/2 (ASH N -1)) (HALF (NTHCDR N/2 LIST)))
                            (TRAVERSE HALF (- N N/2))
                            (TRAVERSE LIST N/2))))))
          (TRAVERSE LIST LENGTH)))
      COUNT))

[SICL/Papers/Reverse-order/Code/Count/3-count.lisp:27]
  (DEFUN COUNT-FROM-END-WITH-LENGTH-3-MACRO (X LIST LENGTH)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0) (COMPILATION-SPEED 0)))
    (DECLARE (TYPE FIXNUM LENGTH))
    (LET ((COUNT 0))
      (DECLARE (TYPE FIXNUM COUNT))
      (FLET ((PROCESS (ELEM)
               (WHEN (EQ ELEM X) (INCF COUNT))))
        (MACROLET ((DIVIDE (REST LENGTH K)
                     (LET* ((N (ASH 1 K))
                            (GENSYMS
                             (LOOP REPEAT N
                                   COLLECT (GENSYM)))
                            (F (GENSYM)))
                       (ECLECTOR.READER:QUASIQUOTE
                        (LET (((ECLECTOR.READER:UNQUOTE F)
                               (ASH LENGTH (- (ECLECTOR.READER:UNQUOTE K))))
                              ((ECLECTOR.READER:UNQUOTE (CAR GENSYMS))
                               (ECLECTOR.READER:UNQUOTE REST)))
                          (LET* (ECLECTOR.READER:UNQUOTE
                                 (LOOP
                                  FOR
                                  GENSYM1
                                  IN
                                  GENSYMS
                                  FOR
                                  GENSYM2
                                  IN
                                  (CDR GENSYMS)
                                  COLLECT
                                  (ECLECTOR.READER:QUASIQUOTE
                                   ((ECLECTOR.READER:UNQUOTE GENSYM2)
                                    (NTHCDR (ECLECTOR.READER:UNQUOTE F)
                                            (ECLECTOR.READER:UNQUOTE
                                             GENSYM1))))))
                            (TRAVERSE
                             (NTHCDR (ECLECTOR.READER:UNQUOTE F)
                                     (ECLECTOR.READER:UNQUOTE
                                      (CAR (LAST GENSYMS))))
                             (- (ECLECTOR.READER:UNQUOTE LENGTH)
                                (ASH (ECLECTOR.READER:UNQUOTE F)
                                     (ECLECTOR.READER:UNQUOTE K))))
                            (ECLECTOR.READER:UNQUOTE-SPLICING
                             (LOOP FOR GENSYM IN (REVERSE GENSYMS)
                                   COLLECT (ECLECTOR.READER:QUASIQUOTE
                                            (TRAVERSE
                                             (ECLECTOR.READER:UNQUOTE GENSYM)
                                             (ECLECTOR.READER:UNQUOTE
                                              F)))))))))))
          (LABELS ((RECURSIVE-TRAVERSE (REST N)
                     (DECLARE (TYPE FIXNUM N))
                     (WHEN (> N 0)
                       (RECURSIVE-TRAVERSE (CDR REST) (1- N))
                       (PROCESS (CAR REST))))
                   (TRAVERSE (REST N)
                     (DECLARE (TYPE FIXNUM N))
                     (COND ((< N 16384) (RECURSIVE-TRAVERSE REST N))
                           (T (DIVIDE REST LENGTH 1)))))
            (TRAVERSE LIST LENGTH))))
      COUNT))

[SICL/Papers/Reverse-order/Code/Count/4-count.lisp:3]
  (DEFUN COUNT-FROM-END-WITH-LENGTH-4 (X LIST LENGTH)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0) (COMPILATION-SPEED 0)))
    (DECLARE (TYPE FIXNUM LENGTH))
    (LET ((COUNT 0))
      (DECLARE (TYPE FIXNUM COUNT))
      (FLET ((PROCESS (ELEM)
               (WHEN (EQ ELEM X) (INCF COUNT))))
        (LABELS ((RECURSIVE-TRAVERSE (REST LENGTH)
                   (DECLARE (TYPE FIXNUM LENGTH))
                   (WHEN (> LENGTH 0)
                     (RECURSIVE-TRAVERSE (CDR REST) (1- LENGTH))
                     (PROCESS (CAR REST))))
                 (TRAVERSE (REST LENGTH)
                   (DECLARE (TYPE FIXNUM LENGTH))
                   (IF (< LENGTH 16384)
                       (RECURSIVE-TRAVERSE REST LENGTH)
                       (LET* ((F (ASH LENGTH -4))
                              (R0 REST)
                              (R1 (NTHCDR F R0))
                              (R2 (NTHCDR F R1))
                              (R3 (NTHCDR F R2))
                              (R4 (NTHCDR F R3))
                              (R5 (NTHCDR F R4))
                              (R6 (NTHCDR F R5))
                              (R7 (NTHCDR F R6))
                              (R8 (NTHCDR F R7))
                              (R9 (NTHCDR F R8))
                              (R10 (NTHCDR F R9))
                              (R11 (NTHCDR F R10))
                              (R12 (NTHCDR F R11))
                              (R13 (NTHCDR F R12))
                              (R14 (NTHCDR F R13))
                              (R15 (NTHCDR F R14)))
                         (TRAVERSE (NTHCDR F R15) (- LENGTH (ASH F 16)))
                         (TRAVERSE R15 F)
                         (TRAVERSE R14 F)
                         (TRAVERSE R13 F)
                         (TRAVERSE R12 F)
                         (TRAVERSE R11 F)
                         (TRAVERSE R10 F)
                         (TRAVERSE R9 F)
                         (TRAVERSE R8 F)
                         (TRAVERSE R7 F)
                         (TRAVERSE R6 F)
                         (TRAVERSE R5 F)
                         (TRAVERSE R4 F)
                         (TRAVERSE R3 F)
                         (TRAVERSE R2 F)
                         (TRAVERSE R1 F)
                         (TRAVERSE REST F)))))
          (TRAVERSE LIST LENGTH)
          COUNT))))

[SICL/Papers/Reverse-order/Code/Count/5-count.lisp:7]
  (DEFUN COUNT-FROM-END-WITH-LENGTH-5 (X LIST LENGTH)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0) (COMPILATION-SPEED 0)))
    (DECLARE (TYPE FIXNUM LENGTH))
    (LET ((COUNT 0))
      (DECLARE (TYPE FIXNUM COUNT))
      (FLET ((PROCESS (ELEM)
               (WHEN (EQ ELEM X) (INCF COUNT))))
        (LABELS ((RECURSIVE-TRAVERSE (REST LENGTH)
                   (DECLARE (TYPE FIXNUM LENGTH))
                   (WHEN (> LENGTH 0)
                     (RECURSIVE-TRAVERSE (CDR REST) (1- LENGTH))
                     (PROCESS (CAR REST))))
                 (TRAVERSE (REST LENGTH)
                   (DECLARE (TYPE FIXNUM LENGTH))
                   (IF (< LENGTH 16384)
                       (RECURSIVE-TRAVERSE REST LENGTH)
                       (LET* ((F (ASH LENGTH (- *LOG*)))
                              (R0 REST)
                              (R1 (NTHCDR F R0))
                              (R2 (NTHCDR F R1))
                              (R3 (NTHCDR F R2))
                              (R4 (NTHCDR F R3))
                              (R5 (NTHCDR F R4))
                              (R6 (NTHCDR F R5))
                              (R7 (NTHCDR F R6))
                              (R8 (NTHCDR F R7))
                              (R9 (NTHCDR F R8))
                              (R10 (NTHCDR F R9))
                              (R11 (NTHCDR F R10))
                              (R12 (NTHCDR F R11))
                              (R13 (NTHCDR F R12))
                              (R14 (NTHCDR F R13))
                              (R15 (NTHCDR F R14)))
                         (TRAVERSE (NTHCDR F R15) (- LENGTH (ASH F *K*)))
                         (TRAVERSE R15 F)
                         (TRAVERSE R14 F)
                         (TRAVERSE R13 F)
                         (TRAVERSE R12 F)
                         (TRAVERSE R11 F)
                         (TRAVERSE R10 F)
                         (TRAVERSE R9 F)
                         (TRAVERSE R8 F)
                         (TRAVERSE R7 F)
                         (TRAVERSE R6 F)
                         (TRAVERSE R5 F)
                         (TRAVERSE R4 F)
                         (TRAVERSE R3 F)
                         (TRAVERSE R2 F)
                         (TRAVERSE R1 F)
                         (TRAVERSE REST F)))))
          (TRAVERSE LIST LENGTH)
          COUNT))))

[SICL/Papers/Reverse-order/Code/Count/6-count.lisp:2]
  (DEFUN COUNT-FROM-END-WITH-LENGTH-6-MACRO (X LIST LENGTH)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0) (COMPILATION-SPEED 0)))
    (DECLARE (TYPE FIXNUM LENGTH))
    (LET ((COUNT 0))
      (DECLARE (TYPE FIXNUM COUNT))
      (FLET ((PROCESS (ELEM)
               (WHEN (EQ ELEM X) (INCF COUNT))))
        (MACROLET ((DIVIDE (REST LENGTH K)
                     (LET* ((N (ASH 1 K))
                            (GENSYMS
                             (LOOP REPEAT N
                                   COLLECT (GENSYM)))
                            (F (GENSYM)))
                       (ECLECTOR.READER:QUASIQUOTE
                        (LET (((ECLECTOR.READER:UNQUOTE F)
                               (ASH LENGTH (- (ECLECTOR.READER:UNQUOTE K))))
                              ((ECLECTOR.READER:UNQUOTE (CAR GENSYMS))
                               (ECLECTOR.READER:UNQUOTE REST)))
                          (LET* (ECLECTOR.READER:UNQUOTE
                                 (LOOP
                                  FOR
                                  GENSYM1
                                  IN
                                  GENSYMS
                                  FOR
                                  GENSYM2
                                  IN
                                  (CDR GENSYMS)
                                  COLLECT
                                  (ECLECTOR.READER:QUASIQUOTE
                                   ((ECLECTOR.READER:UNQUOTE GENSYM2)
                                    (NTHCDR (ECLECTOR.READER:UNQUOTE F)
                                            (ECLECTOR.READER:UNQUOTE
                                             GENSYM1))))))
                            (TRAVERSE
                             (NTHCDR (ECLECTOR.READER:UNQUOTE F)
                                     (ECLECTOR.READER:UNQUOTE
                                      (CAR (LAST GENSYMS))))
                             (- (ECLECTOR.READER:UNQUOTE LENGTH)
                                (ASH (ECLECTOR.READER:UNQUOTE F)
                                     (ECLECTOR.READER:UNQUOTE K))))
                            (ECLECTOR.READER:UNQUOTE-SPLICING
                             (LOOP FOR GENSYM IN (REVERSE GENSYMS)
                                   COLLECT (ECLECTOR.READER:QUASIQUOTE
                                            (TRAVERSE
                                             (ECLECTOR.READER:UNQUOTE GENSYM)
                                             (ECLECTOR.READER:UNQUOTE
                                              F)))))))))))
          (LABELS ((RECURSIVE-TRAVERSE (REST LENGTH)
                     (DECLARE (TYPE FIXNUM LENGTH))
                     (WHEN (> LENGTH 0)
                       (RECURSIVE-TRAVERSE (CDR REST) (1- LENGTH))
                       (PROCESS (CAR REST))))
                   (TRAVERSE (REST LENGTH)
                     (DECLARE (TYPE FIXNUM LENGTH))
                     (COND ((<= LENGTH 8192) (RECURSIVE-TRAVERSE REST LENGTH))
                           ((<= LENGTH 16384) (DIVIDE REST LENGTH 1))
                           ((<= LENGTH 32768) (DIVIDE REST LENGTH 2))
                           ((<= LENGTH 65536) (DIVIDE REST LENGTH 3))
                           (T (DIVIDE REST LENGTH 4)))))
            (TRAVERSE LIST LENGTH))))
      COUNT))

[SICL/Papers/Reverse-order/Code/Count/7-count.lisp:1]
  (DEFUN COUNT-FROM-END-WITH-LENGTH-7 (X LIST LENGTH)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0) (COMPILATION-SPEED 0)))
    (DECLARE (TYPE FIXNUM LENGTH))
    (LABELS ((AUX1 (X LIST LENGTH)
               (DECLARE (TYPE FIXNUM LENGTH))
               (IF (ZEROP LENGTH)
                   0
                   (+ (AUX1 X (CDR LIST) (1- LENGTH))
                      (IF (EQ X (CAR LIST))
                          1
                          0))))
             (AUX2 (X LIST LENGTH)
               (DECLARE (TYPE FIXNUM LENGTH))
               (IF (<= LENGTH 10000)
                   (AUX1 X LIST LENGTH)
                   (+ (AUX2 X (NTHCDR 10000 LIST) (- LENGTH 10000))
                      (AUX1 X LIST 10000))))
             (AUX3 (X LIST LENGTH)
               (DECLARE (TYPE FIXNUM LENGTH))
               (IF (< LENGTH 100000000)
                   (AUX2 X LIST LENGTH)
                   (LET* ((N (ASH LENGTH -1)) (MIDDLE (NTHCDR N LIST)))
                     (+ (AUX3 X MIDDLE (- LENGTH N)) (AUX3 X LIST N))))))
      (AUX3 X LIST LENGTH)))

[SICL/Papers/Reverse-order/Code/Count/9-count.lisp:3]
  (DEFUN COUNT-FROM-END-WITH-LENGTH-9 (X LIST LENGTH)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0) (COMPILATION-SPEED 0)))
    (DECLARE (TYPE FIXNUM LENGTH))
    (LABELS ((AUX1 (X LIST LENGTH)
               (DECLARE (TYPE FIXNUM LENGTH))
               (IF (ZEROP LENGTH)
                   0
                   (+ (AUX1 X (CDR LIST) (1- LENGTH))
                      (IF (EQ X (CAR LIST))
                          1
                          0)))))
      (MACROLET ((DIVIDE (X REST LENGTH K)
                   (LET* ((N (ASH 1 K))
                          (GENSYMS
                           (LOOP REPEAT N
                                 COLLECT (GENSYM)))
                          (F (GENSYM)))
                     (ECLECTOR.READER:QUASIQUOTE
                      (LET (((ECLECTOR.READER:UNQUOTE F)
                             (ASH LENGTH (- (ECLECTOR.READER:UNQUOTE K))))
                            ((ECLECTOR.READER:UNQUOTE (CAR GENSYMS))
                             (ECLECTOR.READER:UNQUOTE REST)))
                        (LET* (ECLECTOR.READER:UNQUOTE
                               (LOOP
                                FOR
                                GENSYM1
                                IN
                                GENSYMS
                                FOR
                                GENSYM2
                                IN
                                (CDR GENSYMS)
                                COLLECT
                                (ECLECTOR.READER:QUASIQUOTE
                                 ((ECLECTOR.READER:UNQUOTE GENSYM2)
                                  (NTHCDR (ECLECTOR.READER:UNQUOTE F)
                                          (ECLECTOR.READER:UNQUOTE GENSYM1))))))
                          (+
                           (TRAVERSE (ECLECTOR.READER:UNQUOTE X)
                            (NTHCDR (ECLECTOR.READER:UNQUOTE F)
                                    (ECLECTOR.READER:UNQUOTE
                                     (CAR (LAST GENSYMS))))
                            (- (ECLECTOR.READER:UNQUOTE LENGTH)
                               (ASH (ECLECTOR.READER:UNQUOTE F)
                                    (ECLECTOR.READER:UNQUOTE K))))
                           (ECLECTOR.READER:UNQUOTE-SPLICING
                            (LOOP FOR GENSYM IN (REVERSE GENSYMS)
                                  COLLECT (ECLECTOR.READER:QUASIQUOTE
                                           (TRAVERSE
                                            (ECLECTOR.READER:UNQUOTE X)
                                            (ECLECTOR.READER:UNQUOTE GENSYM)
                                            (ECLECTOR.READER:UNQUOTE
                                             F))))))))))))
        (LABELS ((TRAVERSE (X REST LENGTH)
                   (DECLARE (TYPE FIXNUM LENGTH))
                   (COND ((<= LENGTH 4096) (AUX1 X REST LENGTH))
                         ((<= LENGTH 8192) (DIVIDE X REST LENGTH 1))
                         ((<= LENGTH 16384) (DIVIDE X REST LENGTH 2))
                         ((<= LENGTH 32768) (DIVIDE X REST LENGTH 3))
                         (T (DIVIDE X REST LENGTH 4)))))
          (TRAVERSE X LIST LENGTH)))))

[SICL/Papers/Reverse-order/Code/Count/FFI/8-count.lisp:13]
  (DEFUN COUNT-FROM-END-WITH-LENGTH-8 (X LIST LENGTH)
    (DECLARE (TYPE FIXNUM LENGTH))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0) (COMPILATION-SPEED 0)))
    (LABELS ((AUX2 (X LIST LENGTH)
               (DECLARE (TYPE FIXNUM LENGTH))
               (IF (<= LENGTH 100000)
                   (RECURSIVE-COUNT X LIST LENGTH)
                   (+ (AUX2 X (NTHCDR 100000 LIST) (- LENGTH 100000))
                      (RECURSIVE-COUNT X LIST 100000))))
             (AUX3 (X LIST LENGTH)
               (DECLARE (TYPE FIXNUM LENGTH))
               (IF (< LENGTH 100000000)
                   (AUX2 X LIST LENGTH)
                   (LET* ((N (ASH LENGTH -1)) (MIDDLE (NTHCDR N LIST)))
                     (+ (AUX3 X MIDDLE (- LENGTH N)) (AUX3 X LIST N))))))
      (AUX3 X LIST LENGTH)))

[SICL/Papers/Reverse-order/Code/Count/test-reverse-count.lisp:51]
  (DEFUN COUNT-FROM-END-WITH-LENGTH-7 (X LIST LENGTH)
    (DECLARE (TYPE FIXNUM LENGTH))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0) (COMPILATION-SPEED 0)))
    (LABELS ((AUX1 (X LIST LENGTH)
               (DECLARE (TYPE FIXNUM LENGTH))
               (IF (ZEROP LENGTH)
                   0
                   (+ (AUX1 X (CDR LIST) (1- LENGTH))
                      (IF (EQ X (CAR LIST))
                          1
                          0))))
             (AUX2 (X LIST LENGTH)
               (DECLARE (TYPE FIXNUM LENGTH))
               (IF (<= LENGTH 10000)
                   (AUX1 X LIST LENGTH)
                   (+ (AUX2 X (NTHCDR 10000 LIST) (- LENGTH 10000))
                      (AUX1 X LIST 10000))))
             (AUX3 (X LIST LENGTH)
               (DECLARE (TYPE FIXNUM LENGTH))
               (IF (< LENGTH 100000000)
                   (AUX2 X LIST LENGTH)
                   (LET* ((N (ASH LENGTH -1)) (MIDDLE (NTHCDR N LIST)))
                     (+ (AUX3 X MIDDLE (- LENGTH N)) (AUX3 X LIST N))))))
      (AUX3 X LIST LENGTH)))

[SICL/Papers/Reverse-order/Code/Count/the-test.lisp:4]
  (DEFUN REVERSE-COUNT-1 (X LIST)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0) (COMPILATION-SPEED 0)))
    (LOOP FOR E IN (REVERSE LIST)
          COUNT (EQ X E)))

[SICL/Papers/Reverse-order/Code/Count/the-test.lisp:10]
  (DEFUN COUNT-FROM-END-WITH-LENGTH-7 (X LIST LENGTH)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0) (COMPILATION-SPEED 0)))
    (DECLARE (TYPE FIXNUM LENGTH))
    (LABELS ((AUX1 (X LIST LENGTH)
               (DECLARE (TYPE FIXNUM LENGTH))
               (IF (ZEROP LENGTH)
                   0
                   (+ (AUX1 X (CDR LIST) (1- LENGTH))
                      (IF (EQ X (CAR LIST))
                          1
                          0))))
             (AUX2 (X LIST LENGTH)
               (DECLARE (TYPE FIXNUM LENGTH))
               (IF (<= LENGTH 10000)
                   (AUX1 X LIST LENGTH)
                   (+ (AUX2 X (NTHCDR 10000 LIST) (- LENGTH 10000))
                      (AUX1 X LIST 10000))))
             (AUX3 (X LIST LENGTH)
               (DECLARE (TYPE FIXNUM LENGTH))
               (IF (< LENGTH 100000000)
                   (AUX2 X LIST LENGTH)
                   (LET* ((N (ASH LENGTH -1)) (MIDDLE (NTHCDR N LIST)))
                     (+ (AUX3 X MIDDLE (- LENGTH N)) (AUX3 X LIST N))))))
      (AUX3 X LIST LENGTH)))

[SICL/Papers/Reverse-order/nlbn.lisp:1]
  (DEFUN FIND-FROM-END (X LIST)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (DECLARE (TYPE LIST LIST))
    (LABELS ((AUX (X LIST N)
               (DECLARE (TYPE FIXNUM N))
               (IF (= N 1)
                   (WHEN (EQ X (CAR LIST)) (RETURN-FROM FIND-FROM-END X))
                   (LET* ((N/2 (ASH N -1)) (HALF (NTHCDR N/2 LIST)))
                     (AUX X HALF (- N N/2))
                     (AUX X LIST N/2)))))
      (AUX X LIST (LENGTH LIST))))

[SICL/Papers/Reverse-order/one-more.lisp:1]
  (DEFUN FIND-FROM-END-5 (X LIST N NN)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (DECLARE (TYPE LIST LIST))
    (LABELS ((RECURSIVE (X LIST N)
               (DECLARE (TYPE FIXNUM N))
               (IF (ZEROP N)
                   NIL
                   (PROGN
                    (RECURSIVE X (CDR LIST) (1- N))
                    (WHEN (EQ X (CAR LIST)) (RETURN-FROM FIND-FROM-END-5 X))))))
      (LABELS ((AUX (X LIST N)
                 (DECLARE (TYPE FIXNUM N))
                 (COND ((<= N NN) (RECURSIVE X LIST N))
                       ((<= N (* NN NN)) (AUX X (NTHCDR NN LIST) (- N NN))
                        (AUX X LIST NN))
                       (T
                        (LET* ((N/2 (ASH N -1)) (HALF (NTHCDR N/2 LIST)))
                          (AUX X HALF (- N N/2))
                          (AUX X LIST N/2))))))
        (AUX X LIST N))))

[SICL/Papers/Reverse-order/recursive-find.lisp:1]
  (DEFUN RECURSIVE-FIND (X LIST)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (IF (NULL LIST)
        NIL
        (PROGN
         (RECURSIVE-FIND X (CDR LIST))
         (WHEN (EQ (CAR LIST) X) (RETURN-FROM RECURSIVE-FIND X)))))

[SICL/Papers/Reverse-order/sixteenth.lisp:1]
  (DEFUN FIND-FROM-END-4 (X LIST)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (DECLARE (TYPE LIST LIST))
    (LABELS ((RECURSIVE (X LIST N)
               (DECLARE (TYPE FIXNUM N))
               (IF (ZEROP N)
                   NIL
                   (PROGN
                    (RECURSIVE X (CDR LIST) (1- N))
                    (WHEN (EQ X (CAR LIST)) (RETURN-FROM FIND-FROM-END-4 X))))))
      (LABELS ((AUX (X LIST N)
                 (DECLARE (TYPE FIXNUM N))
                 (IF (< N 10000)
                     (RECURSIVE X LIST N)
                     (LET* ((M (ASH N -4)) (SUBLIST (NTHCDR M LIST)))
                       (AUX X SUBLIST (- N M))
                       (AUX X LIST M)))))
        (AUX X LIST (LENGTH LIST)))))

[SICL/Papers/Reverse-order/stack.lisp:1]
  (DEFUN FIND-FROM-END-2 (X LIST)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (DECLARE (TYPE LIST LIST))
    (LABELS ((RECURSIVE (X LIST N)
               (DECLARE (TYPE FIXNUM N))
               (IF (ZEROP N)
                   NIL
                   (PROGN
                    (RECURSIVE X (CDR LIST) (1- N))
                    (WHEN (EQ X (CAR LIST)) (RETURN-FROM FIND-FROM-END-2 X))))))
      (LABELS ((AUX (X LIST N)
                 (DECLARE (TYPE FIXNUM N))
                 (IF (< N 10000)
                     (RECURSIVE X LIST N)
                     (LET* ((N/2 (ASH N -1)) (HALF (NTHCDR N/2 LIST)))
                       (AUX X HALF (- N N/2))
                       (AUX X LIST N/2)))))
        (AUX X LIST (LENGTH LIST)))))

[SICL/Papers/Sequence-functions/special-case.lisp:9]
  (DEFUN FIND-VECTOR-1 (ITEM VECTOR)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (LOOP FOR INDEX FROM 0 BELOW (LENGTH VECTOR)
          FOR ELEMENT = (AREF VECTOR INDEX)
          WHEN (EQL ITEM ELEMENT) RETURN ELEMENT))

[SICL/Papers/Sequence-functions/special-case.lisp:19]
  (DEFUN FIND-VECTOR-2 (ITEM VECTOR)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (LOOP FOR INDEX FROM 0 BELOW (LENGTH VECTOR)
          FOR ELEMENT = (IF (TYPEP VECTOR '(SIMPLE-ARRAY (UNSIGNED-BYTE 8)))
                            (LOCALLY
                             (DECLARE
                              (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8)) VECTOR))
                             (AREF VECTOR INDEX))
                            (AREF VECTOR INDEX))
          WHEN (EQL ITEM ELEMENT) RETURN ELEMENT))

[SICL/Papers/Sequence-functions/special-case.lisp:38]
  (DEFUN FIND-VECTOR-3 (ITEM VECTOR)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (IF (TYPEP VECTOR '(SIMPLE-ARRAY (UNSIGNED-BYTE 8)))
        (LOOP FOR INDEX FROM 0 BELOW (LENGTH VECTOR)
              FOR ELEMENT = (AREF VECTOR INDEX)
              WHEN (EQL ITEM ELEMENT) RETURN ELEMENT)
        (LOOP FOR INDEX FROM 0 BELOW (LENGTH VECTOR)
              FOR ELEMENT = (AREF VECTOR INDEX)
              WHEN (EQL ITEM ELEMENT) RETURN ELEMENT)))

[SICL/Papers/Sequence-functions/special-case.lisp:61]
  (DEFUN FIND-VECTOR-4 (ITEM VECTOR)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (WITH-VECTOR-TYPE VECTOR
     (LOOP FOR INDEX FROM 0 BELOW (LENGTH VECTOR)
           FOR ELEMENT = (AREF VECTOR INDEX)
           WHEN (EQL ITEM ELEMENT) RETURN ELEMENT)))

[SICL/Papers/Sequence-functions/special-case.lisp:69]
  (DEFUN GENERAL-FIND (ITEM LIST EXTRA)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (LOOP FOR ELEMENT IN LIST
          DO (COND
              ((AND (EQ EXTRA 'A) (EQ ITEM ELEMENT))
               (RETURN-FROM GENERAL-FIND 1))
              ((AND (EQ EXTRA 'B) (EQ ITEM ELEMENT))
               (RETURN-FROM GENERAL-FIND 2))
              ((AND (EQ EXTRA 'C) (EQ ITEM ELEMENT))
               (RETURN-FROM GENERAL-FIND 3))
              ((AND (EQ EXTRA 'D) (EQ ITEM ELEMENT))
               (RETURN-FROM GENERAL-FIND 4))
              ((AND (EQ EXTRA 'E) (EQ ITEM ELEMENT))
               (RETURN-FROM GENERAL-FIND 5))
              ((AND (EQ EXTRA 'F) (EQ ITEM ELEMENT))
               (RETURN-FROM GENERAL-FIND 6))
              ((AND (EQ EXTRA 'G) (EQ ITEM ELEMENT))
               (RETURN-FROM GENERAL-FIND 7))
              ((AND (EQ EXTRA 'H) (EQ ITEM ELEMENT))
               (RETURN-FROM GENERAL-FIND 8))
              ((AND (EQ EXTRA 'I) (EQ ITEM ELEMENT))
               (RETURN-FROM GENERAL-FIND 9))
              ((AND (EQ EXTRA 'J) (EQ ITEM ELEMENT))
               (RETURN-FROM GENERAL-FIND 10))
              ((AND (EQ EXTRA 'K) (EQ ITEM ELEMENT))
               (RETURN-FROM GENERAL-FIND 11))
              ((AND (EQ EXTRA 'L) (EQ ITEM ELEMENT))
               (RETURN-FROM GENERAL-FIND 12))
              ((AND (EQ EXTRA 'M) (EQ ITEM ELEMENT))
               (RETURN-FROM GENERAL-FIND 13))
              ((AND (EQ EXTRA 'N) (EQ ITEM ELEMENT))
               (RETURN-FROM GENERAL-FIND 14))
              ((EQ ITEM ELEMENT) (RETURN-FROM GENERAL-FIND ELEMENT)) (T NIL))))

[SICL/Papers/Sequence-functions/special-case.lisp:104]
  (DEFUN FIND-1 (ITEM LIST)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (LOOP FOR ELEMENT IN LIST
          DO (WHEN (EQ ITEM ELEMENT) (RETURN-FROM FIND-1 ELEMENT))))

[SICL/Papers/Sequence-functions/special-case.lisp:110]
  (DEFUN FIND-2 (ITEM LIST END)
    (DECLARE (TYPE (OR NULL FIXNUM) END))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (LOOP FOR ELEMENT IN LIST
          FOR INDEX OF-TYPE FIXNUM FROM 0
          DO (IF (AND END (>= INDEX END))
                 (RETURN-FROM FIND-2 NIL)
                 (WHEN (EQ ITEM ELEMENT) (RETURN-FROM FIND-2 ELEMENT)))))

[SICL/Papers/Sequence-functions/special-case.lisp:120]
  (DEFUN FIND-3 (ITEM VECTOR)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (LOOP FOR INDEX FROM 0 BELOW (LENGTH VECTOR)
          FOR ELEMENT = (AREF VECTOR INDEX)
          WHEN (EQL ITEM ELEMENT) RETURN ELEMENT))

[SICL/Papers/Sequence-functions/special-case.lisp:127]
  (DEFUN FIND-4 (ITEM VECTOR)
    (DECLARE (TYPE (SIMPLE-ARRAY CHARACTER) VECTOR))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (LOOP FOR INDEX FROM 0 BELOW (LENGTH VECTOR)
          FOR ELEMENT = (AREF VECTOR INDEX)
          WHEN (EQL ITEM ELEMENT) RETURN ELEMENT))

[SICL/Papers/Sequence-functions/special-case.lisp:135]
  (DEFUN FIND-5 (ITEM VECTOR)
    (DECLARE (TYPE (SIMPLE-ARRAY CHARACTER) VECTOR))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (LOOP FOR INDEX FROM 0 BELOW (LENGTH VECTOR)
          FOR ELEMENT = (IF (SIMPLE-STRING-P VECTOR)
                            (AREF VECTOR INDEX)
                            (AREF VECTOR INDEX))
          WHEN (EQL ITEM ELEMENT) RETURN ELEMENT))

[SICL/Papers/Sequence-functions/special-case.lisp:145]
  (DEFUN FIND-6 (ITEM VECTOR)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8)) VECTOR))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (LOOP FOR INDEX FROM 0 BELOW (LENGTH VECTOR)
          FOR ELEMENT = (AREF VECTOR INDEX)
          WHEN (EQL ITEM ELEMENT) RETURN ELEMENT))

[SICL/Papers/Sequence-functions/special-case.lisp:153]
  (DEFUN FIND-7 (ITEM VECTOR)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (LOOP FOR INDEX FROM 0 BELOW (LENGTH VECTOR)
          FOR ELEMENT = (IF (TYPEP VECTOR '(SIMPLE-ARRAY (UNSIGNED-BYTE 8)))
                            (LOCALLY
                             (DECLARE
                              (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8)) VECTOR))
                             (AREF VECTOR INDEX))
                            (AREF VECTOR INDEX))
          WHEN (EQL ITEM ELEMENT) RETURN ELEMENT))

[SICL/Papers/Sliding-GC/test.lisp:9]
  (DEFUN COMPACT (HEAP BITMAP)
    (DECLARE (TYPE (SIMPLE-VECTOR NIL) HEAP)
             (TYPE (ARRAY BIT (NIL)) BITMAP)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (LET* ((D (POSITION 0 BITMAP)) (S (POSITION 1 BITMAP :START D)))
      (DECLARE (TYPE (INTEGER 0 NIL) D S))
      (LOOP UNTIL (= S NIL)
            DO (SETF (AREF HEAP D) (AREF HEAP S)) (INCF D) (INCF
                                                            S) (LOOP UNTIL (OR
                                                                            (=
                                                                             S
                                                                             NIL)
                                                                            (=
                                                                             (SBIT
                                                                              BITMAP
                                                                              S)
                                                                             1))
                                                                     DO (INCF
                                                                         S)))))

[SICL/Papers/Sliding-GC/test.lisp:49]
  (DEFUN BINARY-SEARCH (HEAP FIRST LAST ADDRESS)
    (DECLARE (TYPE (SIMPLE-VECTOR NIL) HEAP)
             (TYPE (INTEGER 0 (NIL)) FIRST LAST ADDRESS)
             (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (LET ((F FIRST) (L LAST))
      (DECLARE (TYPE (INTEGER 0 (NIL)) F L))
      (LOOP UNTIL (= (- L F) 2)
            DO (LET* ((MIDDLE (1+ (ASH (ASH (+ L F) -2) 1)))
                      (ELT (SVREF HEAP MIDDLE)))
                 (DECLARE (TYPE FIXNUM ELT))
                 (IF (< ADDRESS ELT)
                     (SETF L MIDDLE)
                     (SETF F MIDDLE))))
      (SVREF HEAP (1+ F))))

[SICL/Papers/Sliding-GC/test.lisp:98]
  (DEFUN ADJUST ()
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (LOOP WITH W = (WORST-FRONTIER 19)
          WITH L = (1- (EXPT 2 19))
          WITH G = *G*
          FOR I FROM 0 BELOW W
          DO (INCF (AREF *G* I) (BINARY-SEARCH G W L I))))

[SICL/Papers/Sliding-GC/test2.lisp:28]
  (DEFUN BUILD-TABLE (HEAP BITMAP START)
    (LET ((ACC 0) (END START))
      (DECLARE (TYPE FIXNUM ACC START END)
               (TYPE (SIMPLE-VECTOR NIL) HEAP)
               (TYPE (SIMPLE-ARRAY BIT (NIL)) BITMAP)
               (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
      (LOOP FOR ADDRESS OF-TYPE FIXNUM FROM 0
            FOR PREV OF-TYPE BIT = 1 THEN BIT
            FOR BIT OF-TYPE BIT ACROSS BITMAP
            DO (WHEN (= BIT 0)
                 (WHEN (= PREV 1)
                   (SETF (SVREF HEAP END) ADDRESS)
                   (SETF (SVREF HEAP (1+ END)) ACC)
                   (INCF END 2))
                 (INCF ACC))
            FINALLY (WHEN (= PREV 1)
                      (SETF (SVREF HEAP END) ADDRESS)
                      (SETF (SVREF HEAP (1+ END)) ACC)
                      (INCF END 2)) (RETURN END))))

[SICL/Papers/Sliding-GC/test3.lisp:28]
  (DEFUN BUILD-TABLE (HEAP BITMAP START)
    (LET ((ACC 0) (END START))
      (DECLARE (TYPE FIXNUM ACC START END)
               (TYPE (SIMPLE-VECTOR NIL) HEAP)
               (TYPE (SIMPLE-ARRAY BIT (NIL)) BITMAP)
               (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
      (LOOP FOR ADDRESS OF-TYPE FIXNUM FROM 0
            FOR PREV OF-TYPE BIT = 1 THEN BIT
            FOR BIT OF-TYPE BIT ACROSS BITMAP
            DO (WHEN (= BIT 0)
                 (WHEN (= PREV 1)
                   (SETF (SVREF HEAP END) ADDRESS)
                   (SETF (SVREF HEAP (1+ END)) ACC)
                   (INCF END 2))
                 (INCF ACC))
            FINALLY (WHEN (= PREV 1)
                      (SETF (SVREF HEAP END) ADDRESS)
                      (SETF (SVREF HEAP (1+ END)) ACC)
                      (INCF END 2)) (RETURN END))))

[TH/binding/file.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0)))

[TH/binding/generator.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0)))

[TH/binding/storage.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0)))

[TH/binding/tensor.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0)))

[TH/binding/th.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0)))

[TH/bp/backprop.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0)))

[TH/bp/conv.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0)))

[TH/bp/function.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0)))

[TH/bp/gd.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0)))

[TH/bp/loss.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0)))

[TH/bp/operator.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0)))

[TH/bp/support.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0)))

[TH/bp/utility.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0)))

[TH/db/cats-and-dogs.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))

[TH/db/celeba.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))

[TH/db/cifar.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))

[TH/db/fashion-original.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))

[TH/db/fashion.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0)))

[TH/db/imdb.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))

[TH/db/mnist-original.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0)))

[TH/db/mnist.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0)))

[TH/ffi/file.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0)))

[TH/ffi/generator.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0)))

[TH/ffi/libs.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0)))

[TH/ffi/macros.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0)))

[TH/ffi/mhack.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))

[TH/ffi/storages.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0)))

[TH/ffi/structs.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0)))

[TH/ffi/tensors.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0)))

[TH/ffi/thr.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))

[TH/layers/layers.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0)))

[TH/nn/ffi.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0)))

[TH/nn/nn.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0)))

[TH/object/file.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0)))

[TH/object/generator.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0)))

[TH/object/object.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0)))

[TH/object/storage.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0)))

[TH/object/tensor.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0)))

[TH/private/implementation.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0)))

[TH/private/interface.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0)))

[Vacietis/compiler/implementation.lisp:5]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 1)))

[Vacietis/compiler/implementation.lisp:65]
  (DEFUN SAP-REF-C-POINTER (SAP OFFSET)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0))
             (TYPE SYSTEM-AREA-POINTER SAP)
             (TYPE FIXNUM OFFSET))
    (LET* ((R-SAP (SB-SYS:SAP-REF-WORD SAP OFFSET))
           (R-OFFSET (SB-SYS:SAP-REF-WORD SAP (+ OFFSET SB-VM:N-WORD-BYTES)))
           (R-ID (SB-SYS:SAP-REF-WORD SAP (+ OFFSET (* 2 SB-VM:N-WORD-BYTES)))))
      (MAKE-C-POINTER :SAP (SB-SYS:INT-SAP R-SAP) :OFFSET R-OFFSET :ID R-ID)))

[Vacietis/compiler/implementation.lisp:77]
  (DEFUN (SETF SAP-REF-C-POINTER) (NEW-VALUE SAP OFFSET)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0))
             (TYPE SYSTEM-AREA-POINTER SAP)
             (TYPE FIXNUM OFFSET))
    (LET* ((W-SAP (C-POINTER-SAP NEW-VALUE))
           (W-OFFSET (C-POINTER-OFFSET NEW-VALUE))
           (W-ID (C-POINTER-ID NEW-VALUE)))
      (SB-KERNEL::%SET-SAP-REF-WORD SAP OFFSET (SB-SYS:SAP-INT W-SAP))
      (SB-KERNEL::%SET-SAP-REF-WORD SAP (+ OFFSET SB-VM:N-WORD-BYTES) W-OFFSET)
      (SB-KERNEL::%SET-SAP-REF-WORD SAP (+ OFFSET (* 2 SB-VM:N-WORD-BYTES))
       W-ID)))

[Vacietis/compiler/implementation.lisp:88]
  (DEFMACRO DEFINE-C-POINTER-REF-FUNCTIONS (OPTIONS &REST TYPES)
    (DECLARE (IGNORE OPTIONS))
    (LET (FORMS)
      (DOLIST (TYPE TYPES)
        (LET ((FNAME
               (INTERN (FORMAT NIL "C-POINTER-REF-~A" (SYMBOL-NAME TYPE)))))
          (PUSH
           (ECLECTOR.READER:QUASIQUOTE
            (DECLAIM (INLINE (ECLECTOR.READER:UNQUOTE FNAME))))
           FORMS)
          (PUSH
           (ECLECTOR.READER:QUASIQUOTE
            (DEFUN (ECLECTOR.READER:UNQUOTE FNAME) (PTR OFFSET)
              (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0))
                       (TYPE C-POINTER PTR)
                       (TYPE FIXNUM OFFSET))
              ((ECLECTOR.READER:UNQUOTE (SAP-GET-REF-FOR TYPE))
               (C-POINTER-SAP PTR) (+ (C-POINTER-OFFSET PTR) OFFSET))))
           FORMS)))
      (ECLECTOR.READER:QUASIQUOTE
       (PROGN (ECLECTOR.READER:UNQUOTE-SPLICING FORMS)))))

[Vacietis/compiler/reader.lisp:6]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 1)))

[Vacietis/compiler/reader.lisp:10]
  (DEFPARAMETER *OPTIMIZE* '(OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))

[Vacietis/compiler/vac.lisp:3]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 1)))

[ace.core/atomic.lisp:84]
  (DEFMACRO CAS2 (PLACE OLD1 OLD2 NEW1 NEW2 &ENVIRONMENT ENV)
    "With PLACE = (SVREF ARRAY INDEX), replace OLD1 and OLD2 values
with NEW1 and NEW2 values. Returns (values old1* old2*).
ARRAY must be full word (64b) or T element-type vector.
INDEX must be multiple of 2 - i.e. aligned at 16 bytes."
    (DESTRUCTURING-BIND
        (SVREF ARRAY INDEX)
        (MACROEXPAND PLACE ENV)
      (EXPECT (EQ 'SVREF SVREF))
      (ONCE-ONLY (ARRAY INDEX OLD1 OLD2 NEW1 NEW2)
       (ECLECTOR.READER:QUASIQUOTE
        (LOCALLY
         (DECLARE (OPTIMIZE (SAFETY 0)))
         (SB-VM::%VECTOR-CAS-PAIR (ECLECTOR.READER:UNQUOTE ARRAY)
          (ECLECTOR.READER:UNQUOTE INDEX) (ECLECTOR.READER:UNQUOTE OLD1)
          (ECLECTOR.READER:UNQUOTE OLD2) (ECLECTOR.READER:UNQUOTE NEW1)
          (ECLECTOR.READER:UNQUOTE NEW2)))))))

[ace.core/defun-test.lisp:395]
  (DEFUN* FUNCTION-WITH-REST-ARGS
   (A &REST ARGS &KEY B (C 1 C-P) &ALLOW-OTHER-KEYS &AUX (D (+ A B C)))
   (DECLARE (SELF (FIXNUM &REST T &KEY FIXNUM FIXNUM) LIST))
   (DECLARE (OPTIMIZE (SPEED 1) (DEBUG 2) (SAFETY 3))) (DECLARE (FIXNUM D))
   (LIST A ARGS B C C-P D))

[ace.core/defun-test.lisp:401]
  (DEFTEST TEST-FUNCTION-WITH-REST-ARGS NIL
   (DECLARE (OPTIMIZE (SPEED 1) (DEBUG 2) (SAFETY 3)))
   (EXPECT
    (EQUAL '(1 (:B 2 :C 3 :D 4) 2 3 T 6)
           (FUNCTION-WITH-REST-ARGS 1 :B 2 :C 3 :D 4)))
   (LET ((X 0))
     (EXPECT
      (EQUAL '(1 (:C 2 :B 3 :D 4) 3 2 T 6)
             (FUNCTION-WITH-REST-ARGS (INCF X) :C (INCF X) :B (INCF X) :D
              (INCF X))))))

[ace.core/defun-test.lisp:421]
  (DEFTEST TEST-FUNCTION-WITH-IGNORE NIL
   (DECLARE (OPTIMIZE (SPEED 1) (DEBUG 2) (SAFETY 3)))
   (EXPECT
    (EQUAL '(1 T 4 5 6 16 (:E 4 :F 5 :G 6 :D 7))
           (FUNCTION-WITH-IGNORE 1 2 3 :E 4 :F 5 :G 6 :D 7)))
   (EXPECT
    (EQUAL '(1 NIL 20 4 30 55 (:F 4)) (FUNCTION-WITH-IGNORE 1 2 3 :F 4)))
   (LET ((X 0))
     (EXPECT
      (EQUAL '(1 T 4 5 6 16 (:E 4 :F 5 :G 6 :D 7))
             (FUNCTION-WITH-IGNORE (INCF X) (INCF X) (INCF X) :E (INCF X) :F
              (INCF X) :G (INCF X) :D (INCF X))))))

[ace.core/defun-test.lisp:616]
  (DEFUN FUNCTION-CALL-P (CODE)
    "True if the CAR of CODE comes up in the disassembly."
    (LET* ((FUN
            (COMPILE NIL
                     (ECLECTOR.READER:QUASIQUOTE
                      (LAMBDA ()
                        (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
                        (ECLECTOR.READER:UNQUOTE CODE)))))
           (DISASSEMBLY
            (WITH-OUTPUT-TO-STRING (OUT) (DISASSEMBLE FUN :STREAM OUT))))
      (SEARCH (SYMBOL-NAME (FIRST CODE)) DISASSEMBLY)))

[ace.core/defun.lisp:22]
  (DECLAIM (OPTIMIZE (SPEED 3) (SAFETY 1)))

[ace.core/enum.lisp:268]
  (DEFUN PARSE-DEFINITION (NAME-AND-OPTIONS TOKENS &KEY (PACKAGE *PACKAGE*))
    "Parses the enum definition. Returns enum INFO.
 Arguments:
  NAME-AND-OPTIONS - (name &key bits prefix allow-alias export)
  TOKENS           - are the tokens specified in the ENUM:DEFINE form.
  PACKAGE          - the package to define new symbols in."
    (DECLARE (OPTIMIZE (SPEED 1) (SAFETY 3)))
    (DESTRUCTURING-BIND
        (ENUM-SYMBOL &KEY (CONSTANTS T) (BITS 32) PREFIX ALLOW-ALIASES EXPORT)
        (IF (CONSP NAME-AND-OPTIONS)
            NAME-AND-OPTIONS
            (LIST NAME-AND-OPTIONS))
      (LET* ((*PACKAGE* PACKAGE)
             (ENUM-NAME (SYMBOL-NAME ENUM-SYMBOL))
             (ENUM-OPTIONS
              (WHEN (CONSP NAME-AND-OPTIONS) (REST NAME-AND-OPTIONS)))
             (DEFAULT-OPTIONS
              (WHEN PREFIX
                (ECLECTOR.READER:QUASIQUOTE
                 (:PREFIX (ECLECTOR.READER:UNQUOTE PREFIX)))))
             (FIRST-NUMERAL
              (IF (NUMBERP (FIRST TOKENS))
                  (FIRST TOKENS)
                  1))
             (DOT (POSITION #\. ENUM-NAME :TEST #'CHAR= :FROM-END T))
             (SCOPE (AND DOT (SUBSEQ ENUM-NAME 0 DOT)))
             (VALUES 'NIL)
             (CONSTANTSP CONSTANTS)
             (CONSTANTS 'NIL))
        (LOOP FOR NUMERAL OF-TYPE NUMBER FROM FIRST-NUMERAL
              FOR TOKEN IN TOKENS
              FOR VALUE-OPTIONS = (ETYPECASE TOKEN
                                    (SYMBOL (LIST* TOKEN DEFAULT-OPTIONS))
                                    (LIST
                                     (WHEN (NUMBERP (FIRST TOKEN))
                                       (SETF NUMERAL
                                               (THE NUMERAL (POP TOKEN))))
                                     (APPEND TOKEN DEFAULT-OPTIONS))
                                    (NUMBER (SETF NUMERAL (- TOKEN 1)) NIL))
              DO (WHEN VALUE-OPTIONS
                   (DESTRUCTURING-BIND
                       (KEYWORD &KEY PREFIX &ALLOW-OTHER-KEYS)
                       VALUE-OPTIONS
                     (PUSH (LIST* NUMERAL VALUE-OPTIONS) VALUES)
                     (WHEN CONSTANTSP
                       (LET ((CONSTANT
                              (INTERN
                               (FORMAT NIL "+~@[~A.~]~@[~A-~]~A+" SCOPE PREFIX
                                       KEYWORD))))
                         (PUSH (LIST NUMERAL CONSTANT) CONSTANTS))))))
        (LET* ((VALUES (NREVERSE VALUES))
               (CONSTANTS (NREVERSE CONSTANTS))
               (COUNT (LENGTH VALUES))
               (DEFAULT (SECOND (FIRST VALUES)))
               (SORTED-VALUES (SORT VALUES #'< :KEY #'FIRST))
               (FIRST-VALUE (FIRST SORTED-VALUES))
               (FIRST-NUMERAL (FIRST FIRST-VALUE))
               (LAST-VALUE (FIRST (LAST SORTED-VALUES)))
               (LAST-NUMERAL (FIRST LAST-VALUE))
               (NIL-VALUE (FIND NIL VALUES :KEY #'SECOND))
               (NIL-NUMERAL (OR (FIRST NIL-VALUE) (1- FIRST-NUMERAL)))
               (MIN-NUMERAL (MIN FIRST-NUMERAL NIL-NUMERAL))
               (SPAN (1+ (- LAST-NUMERAL MIN-NUMERAL)))
               (BITS
                (IF (ZEROP BITS)
                    (INTEGER-LENGTH SPAN)
                    BITS))
               (ENUM-INFO
                (MAKE-INFO :NAME ENUM-SYMBOL :NIL-NUMERAL NIL-NUMERAL
                 :MIN-NUMERAL MIN-NUMERAL :MAX-NUMERAL LAST-NUMERAL :BITS BITS
                 :DEFAULT DEFAULT :VALUES SORTED-VALUES :CONSTANTS CONSTANTS
                 :NUMERAL-TO-KEYWORD
                 (#S(FORMGREP:SYMREF :NAME "CAT!" :QUALIFIER "SYMBOL")
                  ENUM-SYMBOL :-TO-KEYWORD)
                 :KEYWORD-TO-NUMERAL
                 (#S(FORMGREP:SYMREF :NAME "CAT!" :QUALIFIER "SYMBOL")
                  ENUM-SYMBOL :-TO-NUMERAL)
                 :EXPORTP EXPORT :OPTIONS ENUM-OPTIONS)))
          (EXPECT (>= BITS (INTEGER-LENGTH SPAN))
           "The requested ~D bits is less then required ~D bits for enum ~S."
           BITS (INTEGER-LENGTH SPAN) ENUM-NAME)
          (UNLESS ALLOW-ALIASES
            (LET ((DEDUP (REMOVE-DUPLICATES SORTED-VALUES :KEY #'FIRST)))
              (EXPECT (= COUNT (LENGTH (THE LIST DEDUP)))
               "Duplicate enum numerals in ~S:~{ ~S~}" ENUM-NAME
               (LET ((DUPS (SET-DIFFERENCE SORTED-VALUES DEDUP :KEY #'SECOND)))
                 (SORT (MAPCAR #'FIRST DUPS) #'<)))))
          ENUM-INFO))))

[ace.core/fast-ops.lisp:55]
  (DEFMACRO THE! (TYPE &BODY BODY)
    "Declares the result of the BODY to be of the TYPE. No safety checks are performed.
 Related: SB-EXT:TRULY-THE."
    (ECLECTOR.READER:QUASIQUOTE
     (LET ((RESULT (PROGN (ECLECTOR.READER:UNQUOTE-SPLICING BODY))))
       (LOCALLY
        (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3)))
        (THE (ECLECTOR.READER:UNQUOTE TYPE) RESULT)))))

[ace.core/functional-test.lisp:39]
  (DEFUN DIV (X Y)
    (DECLARE (FIXNUM X Y)
             (OPTIMIZE (SPEED 1) (SAFETY 3)))
    (/ X Y))

[ace.core/functional-test.lisp:43]
  (DEFUN DIV3 (X Y Z)
    (DECLARE (FIXNUM X Y Z)
             (OPTIMIZE (SPEED 1) (SAFETY 3)))
    (/ X Y Z))

[ace.core/functional-test.lisp:51]
  (DEFTEST COMPOSE-TEST2 NIL
   (EXPECT (EQUAL '(4) (FUNCALL (COMPOSE-LIST #'1+) 3)))
   (LOCALLY
    (DECLARE (NOTINLINE COMPOSE)
             (OPTIMIZE (SAFETY 3)))
    (EXPECT-ERROR (FUNCALL (COMPOSE #'LIST #'DIV) 1 1 1))))

[ace.core/functional-test.lisp:56]
  (DEFTEST COMPOSE-TEST3 NIL
   (FLET ((DIV (&REST ARGS)
            (APPLY #'+ ARGS)))
     (EXPECT (EQUAL '(3) (FUNCALL (COMPOSE #'LIST #'DIV) 1 1 1)))
     (EXPECT (EQUAL '(3) (FUNCALL (COMPOSE #'LIST 'DIV) 9 3)))
     (EXPECT (EQUAL '(1) (FUNCALL (COMPOSE #'LIST 'DIV3) 6 3 2)))
     (LOCALLY
      (DECLARE (NOTINLINE COMPOSE)
               (OPTIMIZE (SPEED 1) (SAFETY 3)))
      (EXPECT-ERROR (FUNCALL (COMPOSE #'LIST 'DIV) 1 1 1)))))

[ace.core/functional-test.lisp:65]
  (DEFTEST COMPOSE-TEST4 NIL (DECLARE (OPTIMIZE (SPEED 1) (SAFETY 3)))
   (FLET ((DIV (X)
            (1+ X)))
     (DECLARE (FTYPE (FUNCTION (FIXNUM) (VALUES FIXNUM &OPTIONAL)) DIV))
     (EXPECT (EQUAL '(2) (FUNCALL (COMPOSE #'LIST #'DIV) 1)))
     (LOCALLY
      (DECLARE (NOTINLINE COMPOSE))
      (EXPECT-ERROR (FUNCALL (COMPOSE #'LIST #'DIV) 1 1 1)))
     (EXPECT (EQUAL '(3) (FUNCALL (COMPOSE #'LIST 'DIV) 9 3)))))

[ace.core/functional-test.lisp:76]
  (DEFTEST COMPOSE-TEST5 NIL (DECLARE (OPTIMIZE (SPEED 1) (SAFETY 3)))
   (FLET ((DIV (X)
            (1+ X)))
     (EXPECT (EQUAL '(2) (FUNCALL (COMPOSE #'LIST #'DIV) 1)))
     (LOCALLY
      (DECLARE (NOTINLINE COMPOSE))
      (EXPECT-ERROR (FUNCALL (COMPOSE #'LIST #'DIV) 1 1 1)))
     (EXPECT (EQUAL '(3) (FUNCALL (COMPOSE #'LIST 'DIV) 9 3)))))

[ace.core/functional-test.lisp:88]
  (DEFUN DIVOPT (X &OPTIONAL (Y 2))
    (DECLARE (FIXNUM X Y)
             (OPTIMIZE (SPEED 1) (SAFETY 3)))
    (/ X Y))

[ace.core/functional-test.lisp:97]
  (DEFUN DIVOPT3 (X &OPTIONAL (Y 1) (Z 2))
    (DECLARE (FIXNUM X Y Z)
             (OPTIMIZE (SPEED 1) (SAFETY 3)))
    (/ X Y Z))

[ace.core/functional-test.lisp:103]
  (DEFUN DIVOPT3+ (X Y &OPTIONAL (Z 2))
    (DECLARE (FIXNUM X Y Z)
             (OPTIMIZE (SPEED 1) (SAFETY 3)))
    (/ X Y Z))

[ace.core/functional-test.lisp:108]
  (DEFUN DIVOPT3* (X Y &OPTIONAL (Z 2))
    (DECLARE (FIXNUM X Y Z)
             (OPTIMIZE (SPEED 1) (SAFETY 3)))
    (/ X Y Z))

[ace.core/fx.lisp:18]
  (DEFPACKAGE #:ACE.CORE.FX
    (:USE #:ACE.CORE.DEFUN #:ACE.CORE.FAST-OPS)
    (:IMPORT-FROM :CL
                  FIXNUM
                  INTEGER
                  INLINE
                  &OPTIONAL
                  T
                  BOOLEAN
                  INTEGER-LENGTH
                  DEFCONSTANT
                  DECLARE
                  DECLAIM
                  OPTIMIZE
                  SPEED
                  SAFETY
                  DEBUG
                  MOST-POSITIVE-FIXNUM
                  MOST-NEGATIVE-FIXNUM)
    (:EXPORT #:BITS
             #:POSITIVE-BITS
             #:MOD
             #:REM
             #:TRUNCATE
             #:FLOOR
             #:CEILING
             #:+
             #:-
             #:*
             #:/
             #:INCF
             #:DECF
             #:1+
             #:1-
             #:MAX
             #:MIN
             #:MAXF
             #:MINF
             #:MINUSP
             #:ZEROP
             #:PLUSP
             #:ODDP
             #:EVENP
             #:<
             #:>
             #:<=
             #:>=
             #:=
             #:/=
             #:LOGIOR
             #:LOGXOR
             #:LOGAND
             #:LOGANDC1
             #:LOGANDC2
             #:LOGBITP
             #:LOGIORF
             #:LOGXORF
             #:LOGANDF
             #:LOGANDC1F
             #:LOGANDC2F
             #:ASH
             #:ASHF
             #:ASH*))

[ace.core/macro-test.lisp:290]
  (DEFTEST OPTIMIZE-FOR-SPEED-TEST NIL
   (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 1) (SPACE 1)))
   (EXPECT (OPTIMIZE-FOR-SPEED-P!)))

[ace.core/macro-test.lisp:294]
  (DEFTEST NO-OPTIMIZE-FOR-SPEED-TEST NIL
   (DECLARE (OPTIMIZE (SPEED 0) (DEBUG 2) (SAFETY 3) (SPACE 1)))
   (EXPECT (NOT (OPTIMIZE-FOR-SPEED-P!))))

[ace.core/macro-test.lisp:298]
  (DEFTEST OPTIMIZE-FOR-DEBUG-TEST NIL
   (DECLARE (OPTIMIZE (SPEED 1) (DEBUG 2) (SAFETY 1) (SPACE 1)))
   (EXPECT (OPTIMIZE-FOR-DEBUG-P!)))

[ace.core/macro-test.lisp:302]
  (DEFTEST NO-OPTIMIZE-FOR-DEBUG-TEST NIL
   (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 1) (SPACE 1)))
   (EXPECT (NOT (OPTIMIZE-FOR-DEBUG-P!))))

[ace.core/macro.lisp:807]
  (DEFUN SAFETY-LEVEL (&OPTIONAL ENV)
    "Return the safety optimization level for the lexical ENV environment."
    (SB-C:POLICY (OR ENV SB-C::*POLICY*) SAFETY))

[ace.core/macro.lisp:822]
  (DEFUN OPTIMIZE-FOR-SPEED-P (&OPTIONAL ENVIRONMENT)
    "True if the current compiler optimization mode favors speed in the ENVIRONMENT provided."
    (SB-C:POLICY (OR ENVIRONMENT SB-C::*POLICY*)
                 (AND (> SPEED 1) (> SPEED SPACE) (> SPEED SAFETY)
                      (> SPEED DEBUG))))

[ace.core/thread-test.lisp:101]
  (DEFTEST TEST-UNPROTECTED-MUTEX-SAFE NIL (DECLARE (OPTIMIZE (SAFETY 3)))
   (LET ((MUTEX (MAKE-MUTEX "TEST")))
     (EXPECT-ERROR
      (CATCH :FOO (WITH-MUTEX (MUTEX :PROTECT NIL) (THROW :FOO :NO-ERROR))))))

[ace.core/thread-test.lisp:109]
  (DEFTEST TEST-UNPROTECTED-MUTEX-UNSAFE NIL (DECLARE (OPTIMIZE (SAFETY 0)))
   (LET ((MUTEX (MAKE-MUTEX "TEST")))
     (EXPECT (NOT (HOLDING-MUTEX-P MUTEX)))
     (EXPECT
      (EQ
       (CATCH :FOO
         (WITH-MUTEX (MUTEX :PROTECT NIL) (EXPECT (HOLDING-MUTEX-P MUTEX))
          (THROW :FOO :NO-ERROR)))
       :NO-ERROR))
     (EXPECT (HOLDING-MUTEX-P MUTEX))))

[ace.core/tty.lisp:30]
  (DEFUN ANSI (STREAM ARGUMENT &OPTIONAL COLON AT &REST CODES)
    "Prints the ARGUMENT to a TTY STREAM using ANSI codes if supported.
 The argument is printed as: CSI <code>(;<code>)* m <argument> CSI 0 m.
 At the end of the printing the TTY is reset to normal.
 COLON (:) prints the argument with *PRINT-PRETTY* bound to T.
 AT (@) prints the argument with *PRINT-ESCAPE* and *PRINT-READABLY* bound to T.
 CODES is a list of ANSI control codes.
 The codes are only emitted to an ANSI TTY.
 To force the codes to be always emitted by this function set *PRINT-ANSI*.
 Example:
   (format t \"~31/ansi/~%\" 'this-is-in-green)"
    (DECLARE (OPTIMIZE (SPEED 1) (SAFETY 3)))
    (LET ((*PRINT-PRETTY* COLON) (*PRINT-ESCAPE* AT) (*PRINT-READABLY* AT))
      (IF (OR *PRINT-ANSI* (TTYP STREAM))
          (FORMAT STREAM "~c[~{~D~^;~}m~W~c[0m" #\? CODES ARGUMENT #\?)
          (WRITE ARGUMENT :STREAM STREAM))))

[ace.flag/flag.lisp:94]
  (DEFMACRO DEFINE
            (FLAG DEFAULT DOC
             &KEY TYPE NAME NAMES PARSER (DEF 'DEFPARAMETER) SETTER)
    "Defines a flag and registers it as such under a name with stripped '*' and '-' in place of '_'.
 Flags in the FLAGS package are external. Note that the default name of the flag at command line
 does not include the package specifier and thus flags that share the same name may rise conflicts.
 Flags that accept nil allow for the --noflag syntax and may conflict with other flags having
 that 'no' prefixed name.

 Macro arguments:
  FLAG          - Defines the Lisp parameter that will store the flag.
                  When the symbol specified is a string or a keyword,
                  the flag is interned into and exported from the FLAGS package.
  DEFAULT       - The default value for the flag. May determine the type if not provided.
  DOC           - The documentation for the variable that also shows in help.
  TYPE          - Type to be assigned to the variable.
  NAME, NAMES   - The names of the flag to be used at the command-line.
                  Unless the NAME is specified the default is the name of the variable
                  in lowercase and with the '*' characters trimmed.
  PARSER        - A parser function to transform the value string into the flag value.
                  A non-nil return value from the parser is considered correctly parsed.
                  Use (values nil t) to represent correctly parsed NIL value.
                  If parser is not specified, a default parser for the flag type maybe invoked
                  using type-utils:parse-type method.
  DEF           - The defining operation used to define the flag.
                  Default is DEFPARAMETER. If NIL, the flag variable is not defined by this form
                  and the default value is ignored.
  SETTER        - The setter used to set the flag. If NIL, a default SETF setter is used.

 If no TYPE has been specified the type of the flag is derived from the DEFAULT value by following:
    BOOLEAN       -> BOOLEAN
    BIT           -> INTEGER
    FIXNUM        -> INTEGER
    CONS          -> LIST
    any STRING    -> STRING
    any CHARACTER -> CHARACTER
    otherwise     -> (type-of value)."
    (WHEN NAME (PUSH NAME NAMES))
    (FLET ((FAIL (&REST ARGS)
             (APPLY #'WARN ARGS)
             (RETURN-FROM DEFINE)))
      (UNLESS (TYPEP FLAG '(OR STRING SYMBOL))
        (FAIL "The name ~S of the flag is not a string or symbol." FLAG))
      (UNLESS (TYPEP DOC 'STRING)
        (FAIL "The flag ~S requires a help string." DOC))
      (UNLESS (TYPEP TYPE '(OR SYMBOL CONS))
        (FAIL
         "The type of flag ~S needs to be a proper type specifier. Provided: ~S."
         FLAG TYPE))
      (DOLIST (NAME NAMES)
        (UNLESS (STRINGP NAME)
          (FAIL
           "The additional names of the flag ~S need to be strings. Provided: ~S."
           FLAG NAME))
        (UNLESS (PLUSP (LENGTH NAME))
          (FAIL "One of the names ~S for the flag ~S is empty." NAMES FLAG)))
      (UNLESS
          (OR (NULL TYPE)
              (#S(FORMGREP:SYMREF :NAME "UNKNOWNP" :QUALIFIER "TYPE") TYPE)
              (NOT (CONSTANTP DEFAULT)) (TYPEP (EVAL DEFAULT) TYPE))
        (FAIL "The flag ~S default ~S is not of the required type: ~S." FLAG
         DEFAULT TYPE))
      (UNLESS (SYMBOLP PARSER)
        (FAIL "The parser ~S specified for the flag ~S is not a symbol." PARSER
         FLAG))
      (WHEN (TYPEP FLAG '(OR KEYWORD STRING))
        (EXPORT (SETF FLAG (INTERN (STRING FLAG) +FLAGS-PACKAGE+))
                +FLAGS-PACKAGE+))
      (LET* ((NON-NORMALIZED (REMOVE-IF #'ACCEPTABLE-FLAG-NAME-P NAMES))
             (LEN (LENGTH NON-NORMALIZED)))
        (WHEN NON-NORMALIZED
          (FAIL
           "The name~P~{ ~S~} for the flag ~S ~:[is~;are~] not well formed. ~
               The flag name can contain only alphanumeric and the '.', '-' and '_' characters. ~
               It should start with an alpha character and end with an alphanumeric character."
           LEN NON-NORMALIZED FLAG (> LEN 1))))
      (LET ((FLAG-VARIABLE-NAME
             (UNLESS NAMES
               (TYPECASE FLAG
                 (STRING FLAG)
                 (SYMBOL
                  (STRING-TRIM "*" (STRING-DOWNCASE (SYMBOL-NAME FLAG))))))))
        (WHEN
            (AND (NULL NAMES)
                 (NOT (ACCEPTABLE-FLAG-NAME-P FLAG-VARIABLE-NAME)))
          (FAIL "Cannot derive a flag name for the flag ~S. ~
                The flag name can contain only alphanumeric and the '.' and '-' characters. ~
                It should start with an alpha character and end with an alphanumeric character."
           FLAG))
        (LET* ((PROVIDED-NAMES (OR NAMES (LIST FLAG-VARIABLE-NAME)))
               (NAMES (MAPCAR #'NORMALIZED-FLAG-NAME PROVIDED-NAMES))
               (VALUE
                (#S(FORMGREP:SYMREF :NAME "GENSYM*" :QUALIFIER "MACRO")
                 :VALUE))
               (SPECIFIED-TYPE TYPE))
          (UNLESS TYPE
            (LET ((DECLAIMED
                   (#S(FORMGREP:SYMREF :NAME "DECLAIMED" :QUALIFIER "TYPE")
                    FLAG)))
              (SETF TYPE
                      (COND ((NOT (MEMBER DECLAIMED '(T NIL))) DECLAIMED)
                            ((CONSTANTP DEFAULT)
                             (#S(FORMGREP:SYMREF
                                 :NAME "UPGRADED-TYPE-OF"
                                 :QUALIFIER "TYPE")
                              (EVAL DEFAULT)))
                            (T NIL)))))
          (ECLECTOR.READER:QUASIQUOTE
           (PROGN
            (LET ((NULLABLE (TYPEP NIL '(ECLECTOR.READER:UNQUOTE TYPE))))
              (REGISTER '(ECLECTOR.READER:UNQUOTE FLAG)
               '(ECLECTOR.READER:UNQUOTE PROVIDED-NAMES) NULLABLE *FLAGS*)
              (REGISTER '(ECLECTOR.READER:UNQUOTE FLAG)
               '(ECLECTOR.READER:UNQUOTE NAMES) NULLABLE *FLAGS-NORMALIZED*))
            (ECLECTOR.READER:UNQUOTE-SPLICING
             (WHEN PARSER
               (ECLECTOR.READER:QUASIQUOTE
                ((SETF (GET '(ECLECTOR.READER:UNQUOTE FLAG) 'PARSER)
                         '(ECLECTOR.READER:UNQUOTE PARSER))))))
            (ECLECTOR.READER:UNQUOTE-SPLICING
             (WHEN SPECIFIED-TYPE
               (ECLECTOR.READER:QUASIQUOTE
                ((SETF (GET '(ECLECTOR.READER:UNQUOTE FLAG) 'SPECIFIED-TYPE)
                         '(ECLECTOR.READER:UNQUOTE SPECIFIED-TYPE))))))
            (ECLECTOR.READER:UNQUOTE-SPLICING
             (WHEN DEF
               (ECLECTOR.READER:QUASIQUOTE
                ((DECLAIM
                  (TYPE (ECLECTOR.READER:UNQUOTE TYPE)
                   (ECLECTOR.READER:UNQUOTE FLAG)))
                 ((ECLECTOR.READER:UNQUOTE DEF) (ECLECTOR.READER:UNQUOTE FLAG)
                  (ECLECTOR.READER:UNQUOTE DEFAULT)
                  (ECLECTOR.READER:UNQUOTE DOC))))))
            (EVAL-WHEN (:LOAD-TOPLEVEL)
              (SETF (GET '(ECLECTOR.READER:UNQUOTE FLAG) 'SETTER)
                      (ECLECTOR.READER:UNQUOTE
                       (OR SETTER
                           (ECLECTOR.READER:QUASIQUOTE
                            (LAMBDA ((ECLECTOR.READER:UNQUOTE VALUE))
                              (DECLARE (OPTIMIZE SAFETY))
                              (SETF (ECLECTOR.READER:UNQUOTE FLAG)
                                      (ECLECTOR.READER:UNQUOTE VALUE))))))))
            (ECLECTOR.READER:UNQUOTE-SPLICING
             (WHEN (EQ (SYMBOL-PACKAGE FLAG) +FLAGS-PACKAGE+)
               (ECLECTOR.READER:QUASIQUOTE
                ((EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
                   (EXPORT '(ECLECTOR.READER:UNQUOTE FLAG)
                           +FLAGS-PACKAGE+))))))
            '(ECLECTOR.READER:UNQUOTE FLAG)))))))

[ace.test/runner.lisp:220]
  (DEFUN REPORT-FAILURE (RUN &KEY (OUT *ERROR-OUTPUT*))
    "Reports a failed unit-test.
 Arguments:
  RUN - is the test RUN object containing data to report.
  OUT - the stream to output the error information."
    (DECLARE (OPTIMIZE (SPEED 1) (SAFETY 3)))
    (WITH-ACCESSORS ((TEST TEST-RUN-TEST) (ERROR TEST-RUN-ERROR)
                     (TRACE TEST-RUN-TRACE) (OUTPUT-TEXT TEST-RUN-OUTPUT-TEXT))
        RUN
      (LET* ((*PACKAGE* (OR (SYMBOL-PACKAGE TEST) *PACKAGE*))
             (EMSG
              (AND ERROR (IGNORE-ERRORS (FORMAT NIL "~@<~3I   ~A~:@>" ERROR))))
             (*PACKAGE* (FIND-PACKAGE "COMMON-LISP-USER"))
             (*PRINT-ANSI* (TTYP OUT))
             (OFFSET
              (IF *PRINT-ANSI*
                  9
                  0))
             (MSG
              (WITH-OUTPUT-TO-STRING (STR)
                (FORMAT STR "(~33@/ansi/)~vT=> ~31@/ansi/~%" TEST
                        (+ *STATUS-COLUMN* OFFSET) (TYPE-OF ERROR))
                (WHEN (PLUSP (LENGTH OUTPUT-TEXT))
                  (FORMAT STR "~%~A~&" OUTPUT-TEXT))
                (WHEN EMSG
                  (FORMAT STR "~%~A~&" (STRING-TRIM '(#\Newline) EMSG)))
                (FORMAT STR "~@[~%~A~&~]" TRACE)
                (SEPARATOR-LINE STR))))
        (FINISH-OUTPUT OUT)
        (FRESH-LINE OUT)
        (WRITE-STRING MSG OUT)
        (FINISH-OUTPUT OUT))))

[aether/src/utilities.lisp:30]
  (DEFMACRO DESTRUCTURING-PLACES (LAMBDA-LIST EXPRESSION &BODY BODY)
    "A variant of DESTRUCTURING-BIND that provides SETFs in the style of WITH-SLOTS, but it can only handle the required part of a DESTRUCTURING-LAMBDA-LIST."
    (CHECK-TYPE LAMBDA-LIST CONS)
    (#S(FORMGREP:SYMREF :NAME "WITH-GENSYMS" :QUALIFIER "A") (EXPR)
     (LABELS ((FORBID-AMPERSANDS (SYMBOL)
                (ASSERT
                 (NOT
                  (MEMBER SYMBOL
                          '(&KEY &REST &ALLOW-OTHER-KEYS &AUX &OPTIONAL)))))
              (GENERATE-BINDINGS (LAMBDA-LIST MACHINE-EXPR HUMAN-EXPR)
                (ETYPECASE LAMBDA-LIST
                  (CONS
                   (LET ((NEW-SYMBOL (GENSYM)))
                     (APPEND
                      (LIST
                       (ECLECTOR.READER:QUASIQUOTE
                        (CONS
                         ((ECLECTOR.READER:UNQUOTE HUMAN-EXPR)
                          (ECLECTOR.READER:UNQUOTE NEW-SYMBOL)
                          (ECLECTOR.READER:UNQUOTE MACHINE-EXPR)))))
                      (GENERATE-BINDINGS (CAR LAMBDA-LIST)
                       (ECLECTOR.READER:QUASIQUOTE
                        (CAR (ECLECTOR.READER:UNQUOTE NEW-SYMBOL)))
                       (ECLECTOR.READER:QUASIQUOTE
                        (CAR (ECLECTOR.READER:UNQUOTE HUMAN-EXPR))))
                      (GENERATE-BINDINGS (CDR LAMBDA-LIST)
                       (ECLECTOR.READER:QUASIQUOTE
                        (CDR (ECLECTOR.READER:UNQUOTE NEW-SYMBOL)))
                       (ECLECTOR.READER:QUASIQUOTE
                        (CDR (ECLECTOR.READER:UNQUOTE HUMAN-EXPR)))))))
                  (NULL
                   (LIST
                    (ECLECTOR.READER:QUASIQUOTE
                     (NULL ((ECLECTOR.READER:UNQUOTE HUMAN-EXPR))))))
                  (SYMBOL
                   (FORBID-AMPERSANDS LAMBDA-LIST)
                   (LIST
                    (ECLECTOR.READER:QUASIQUOTE
                     (PLACE
                      ((ECLECTOR.READER:UNQUOTE LAMBDA-LIST)
                       (ECLECTOR.READER:UNQUOTE MACHINE-EXPR)))))))))
       (LET* ((BINDINGS (GENERATE-BINDINGS LAMBDA-LIST EXPR EXPRESSION))
              (MACROLET-BINDINGS
               (LOOP :FOR (BINDING-TYPE BINDING-DATA) :IN BINDINGS
                     :WHEN (EQL 'PLACE BINDING-TYPE)
                     :COLLECT (ECLECTOR.READER:QUASIQUOTE
                               ((ECLECTOR.READER:UNQUOTE (FIRST BINDING-DATA))
                                (ECLECTOR.READER:UNQUOTE
                                 (SECOND BINDING-DATA))))))
              (LET-BINDINGS
               (LOOP :FOR (BINDING-TYPE BINDING-DATA) :IN BINDINGS
                     :WHEN (EQL 'CONS BINDING-TYPE)
                     :COLLECT (ECLECTOR.READER:QUASIQUOTE
                               ((ECLECTOR.READER:UNQUOTE (SECOND BINDING-DATA))
                                (ECLECTOR.READER:UNQUOTE
                                 (THIRD BINDING-DATA))))))
              (ASSERTIONS
               (#S(FORMGREP:SYMREF
                   :NAME "POLICY-COND"
                   :QUALIFIER "POLICY-COND")
                ((< 0 SAFETY)
                 (LOOP :FOR (BINDING-TYPE BINDING-DATA) :IN BINDINGS
                       :WHEN (OR (EQL 'NULL BINDING-TYPE)
                                 (EQL 'CONS BINDING-TYPE))
                       :COLLECT (ECLECTOR.READER:QUASIQUOTE
                                 (ASSERT
                                  (TYPEP
                                   (ECLECTOR.READER:UNQUOTE
                                    (FIRST BINDING-DATA))
                                   '(ECLECTOR.READER:UNQUOTE BINDING-TYPE))
                                  NIL "Expected ~a to be ~a, but got ~a"
                                  '(ECLECTOR.READER:UNQUOTE
                                    (FIRST BINDING-DATA))
                                  '(ECLECTOR.READER:UNQUOTE BINDING-TYPE)
                                  (ECLECTOR.READER:UNQUOTE
                                   (FIRST BINDING-DATA))))))
                (T NIL))))
         (SETF BODY
                 (ECLECTOR.READER:QUASIQUOTE
                  (LET (((ECLECTOR.READER:UNQUOTE EXPR)
                         (ECLECTOR.READER:UNQUOTE EXPRESSION)))
                    (ECLECTOR.READER:UNQUOTE-SPLICING ASSERTIONS)
                    (LET* (ECLECTOR.READER:UNQUOTE LET-BINDINGS)
                      (DECLARE
                       (IGNORABLE
                        (ECLECTOR.READER:UNQUOTE-SPLICING
                         (MAPCAR (FUNCTION FIRST) LET-BINDINGS))))
                      (SYMBOL-MACROLET (ECLECTOR.READER:UNQUOTE
                                        MACROLET-BINDINGS)
                        (ECLECTOR.READER:UNQUOTE-SPLICING BODY))))))))
     BODY))

[ahungry-fleece/contrib/sb-cover/cover.lisp:561]
  (DEFUN MAKE-SOURCE-RECORDER (FN SOURCE-MAP)
    "Return a macro character function that does the same as FN, but
additionally stores the result together with the stream positions
before and after of calling FN in the hashtable SOURCE-MAP."
    (DECLARE (TYPE (OR FUNCTION SYMBOL) FN))
    (LAMBDA (STREAM CHAR)
      (DECLARE (OPTIMIZE DEBUG SAFETY))
      (LET ((START (FILE-POSITION STREAM))
            (VALUES (MULTIPLE-VALUE-LIST (FUNCALL FN STREAM CHAR)))
            (END (FILE-POSITION STREAM)))
        (UNLESS (NULL VALUES)
          (PUSH (LIST START END *READ-SUPPRESS*)
                (GETHASH (CAR VALUES) SOURCE-MAP)))
        (VALUES-LIST VALUES))))

[ahungry-fleece/contrib/sb-md5/md5.lisp:63]
  (DEFUN F (X Y Z)
    (DECLARE (TYPE UB32 X Y Z)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LOGIOR (LOGAND X Y) (LOGANDC1 X Z)))

[ahungry-fleece/contrib/sb-md5/md5.lisp:68]
  (DEFUN G (X Y Z)
    (DECLARE (TYPE UB32 X Y Z)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LOGIOR (LOGAND X Z) (LOGANDC2 Y Z)))

[ahungry-fleece/contrib/sb-md5/md5.lisp:73]
  (DEFUN H (X Y Z)
    (DECLARE (TYPE UB32 X Y Z)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LOGXOR X Y Z))

[ahungry-fleece/contrib/sb-md5/md5.lisp:78]
  (DEFUN I (X Y Z)
    (DECLARE (TYPE UB32 X Y Z)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LDB (BYTE 32 0) (LOGXOR Y (LOGORC2 X Z))))

[ahungry-fleece/contrib/sb-md5/md5.lisp:85]
  (DEFUN MOD32+ (A B)
    (DECLARE (TYPE UB32 A B)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LDB (BYTE 32 0) (+ A B)))

[ahungry-fleece/contrib/sb-md5/md5.lisp:96]
  (DEFUN ROL32 (A S)
    (DECLARE (TYPE UB32 A)
             (TYPE (UNSIGNED-BYTE 5) S)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (SB-ROTATE-BYTE:ROTATE-BYTE S (BYTE 32 0) A))

[ahungry-fleece/contrib/sb-md5/md5.lisp:154]
  (DEFUN INITIAL-MD5-REGS ()
    "Create the initial working state of an MD5 run."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LET ((REGS (MAKE-ARRAY 4 :ELEMENT-TYPE '(UNSIGNED-BYTE 32))))
      (DECLARE (TYPE MD5-REGS REGS))
      (SETF (MD5-REGS-A REGS) +MD5-MAGIC-A+
            (MD5-REGS-B REGS) +MD5-MAGIC-B+
            (MD5-REGS-C REGS) +MD5-MAGIC-C+
            (MD5-REGS-D REGS) +MD5-MAGIC-D+)
      REGS))

[ahungry-fleece/contrib/sb-md5/md5.lisp:167]
  (DEFUN UPDATE-MD5-BLOCK (REGS BLOCK)
    "This is the core part of the MD5 algorithm.  It takes a complete 16
word block of input, and updates the working state in A, B, C, and D
accordingly."
    (DECLARE (TYPE MD5-REGS REGS)
             (TYPE (SIMPLE-ARRAY UB32 (16)) BLOCK)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LET ((A (MD5-REGS-A REGS))
          (B (MD5-REGS-B REGS))
          (C (MD5-REGS-C REGS))
          (D (MD5-REGS-D REGS)))
      (DECLARE (TYPE UB32 A B C D))
      (WITH-MD5-ROUND (F BLOCK) (A B C D 0 7 1) (D A B C 1 12 2)
       (C D A B 2 17 3) (B C D A 3 22 4) (A B C D 4 7 5) (D A B C 5 12 6)
       (C D A B 6 17 7) (B C D A 7 22 8) (A B C D 8 7 9) (D A B C 9 12 10)
       (C D A B 10 17 11) (B C D A 11 22 12) (A B C D 12 7 13)
       (D A B C 13 12 14) (C D A B 14 17 15) (B C D A 15 22 16))
      (WITH-MD5-ROUND (G BLOCK) (A B C D 1 5 17) (D A B C 6 9 18)
       (C D A B 11 14 19) (B C D A 0 20 20) (A B C D 5 5 21) (D A B C 10 9 22)
       (C D A B 15 14 23) (B C D A 4 20 24) (A B C D 9 5 25) (D A B C 14 9 26)
       (C D A B 3 14 27) (B C D A 8 20 28) (A B C D 13 5 29) (D A B C 2 9 30)
       (C D A B 7 14 31) (B C D A 12 20 32))
      (WITH-MD5-ROUND (H BLOCK) (A B C D 5 4 33) (D A B C 8 11 34)
       (C D A B 11 16 35) (B C D A 14 23 36) (A B C D 1 4 37) (D A B C 4 11 38)
       (C D A B 7 16 39) (B C D A 10 23 40) (A B C D 13 4 41) (D A B C 0 11 42)
       (C D A B 3 16 43) (B C D A 6 23 44) (A B C D 9 4 45) (D A B C 12 11 46)
       (C D A B 15 16 47) (B C D A 2 23 48))
      (WITH-MD5-ROUND (I BLOCK) (A B C D 0 6 49) (D A B C 7 10 50)
       (C D A B 14 15 51) (B C D A 5 21 52) (A B C D 12 6 53) (D A B C 3 10 54)
       (C D A B 10 15 55) (B C D A 1 21 56) (A B C D 8 6 57) (D A B C 15 10 58)
       (C D A B 6 15 59) (B C D A 13 21 60) (A B C D 4 6 61) (D A B C 11 10 62)
       (C D A B 2 15 63) (B C D A 9 21 64))
      (SETF (MD5-REGS-A REGS) (MOD32+ (MD5-REGS-A REGS) A)
            (MD5-REGS-B REGS) (MOD32+ (MD5-REGS-B REGS) B)
            (MD5-REGS-C REGS) (MOD32+ (MD5-REGS-C REGS) C)
            (MD5-REGS-D REGS) (MOD32+ (MD5-REGS-D REGS) D))
      REGS))

[ahungry-fleece/contrib/sb-md5/md5.lisp:212]
  (DEFUN FILL-BLOCK-UB8 (BLOCK BUFFER OFFSET)
    "Convert a complete 64 (unsigned-byte 8) input vector segment
starting from offset into the given 16 word MD5 block."
    (DECLARE (TYPE (INTEGER 0 NIL) OFFSET)
             (TYPE (SIMPLE-ARRAY UB32 (16)) BLOCK)
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) BUFFER)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (SB-KERNEL:UB8-BASH-COPY BUFFER OFFSET BLOCK 0 64)
    (LOOP FOR I OF-TYPE (INTEGER 0 16) FROM 0
          FOR J OF-TYPE (INTEGER 0 NIL) FROM OFFSET TO (+ OFFSET 63) BY 4
          DO (SETF (AREF BLOCK I)
                     (ASSEMBLE-UB32 (AREF BUFFER J) (AREF BUFFER (+ J 1))
                      (AREF BUFFER (+ J 2)) (AREF BUFFER (+ J 3))))))

[ahungry-fleece/contrib/sb-md5/md5.lisp:232]
  (DEFUN FILL-BLOCK-CHAR (BLOCK BUFFER OFFSET)
    "Convert a complete 64 character input string segment starting from
offset into the given 16 word MD5 block."
    (DECLARE (TYPE (INTEGER 0 NIL) OFFSET)
             (TYPE (SIMPLE-ARRAY UB32 (16)) BLOCK)
             (TYPE SIMPLE-STRING BUFFER)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (SB-KERNEL:UB8-BASH-COPY BUFFER OFFSET BLOCK 0 64)
    (LOOP FOR I OF-TYPE (INTEGER 0 16) FROM 0
          FOR J OF-TYPE (INTEGER 0 NIL) FROM OFFSET TO (+ OFFSET 63) BY 4
          DO (SETF (AREF BLOCK I)
                     (ASSEMBLE-UB32 (CHAR-CODE (SCHAR BUFFER J))
                      (CHAR-CODE (SCHAR BUFFER (+ J 1)))
                      (CHAR-CODE (SCHAR BUFFER (+ J 2)))
                      (CHAR-CODE (SCHAR BUFFER (+ J 3)))))))

[ahungry-fleece/contrib/sb-md5/md5.lisp:252]
  (DEFUN FILL-BLOCK (BLOCK BUFFER OFFSET)
    "Convert a complete 64 byte input vector segment into the given 16
word MD5 block.  This currently works on (unsigned-byte 8) and
character simple-arrays, via the functions `fill-block-ub8' and
`fill-block-char' respectively."
    (DECLARE (TYPE (INTEGER 0 NIL) OFFSET)
             (TYPE (SIMPLE-ARRAY UB32 (16)) BLOCK)
             (TYPE (SIMPLE-ARRAY * (*)) BUFFER)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (ETYPECASE BUFFER
      ((SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*))
       (FILL-BLOCK-UB8 BLOCK BUFFER OFFSET))
      (SIMPLE-STRING (FILL-BLOCK-CHAR BLOCK BUFFER OFFSET))))

[ahungry-fleece/contrib/sb-md5/md5.lisp:270]
  (DEFUN MD5REGS-DIGEST (REGS)
    "Create the final 16 byte message-digest from the MD5 working state
in regs.  Returns a (simple-array (unsigned-byte 8) (16))."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0))
             (TYPE MD5-REGS REGS))
    (LET ((RESULT (MAKE-ARRAY 16 :ELEMENT-TYPE '(UNSIGNED-BYTE 8))))
      (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (16)) RESULT))
      (MACROLET ((FROB (REG OFFSET)
                   (LET ((VAR (GENSYM)))
                     (ECLECTOR.READER:QUASIQUOTE
                      (LET (((ECLECTOR.READER:UNQUOTE VAR)
                             (ECLECTOR.READER:UNQUOTE REG)))
                        (DECLARE (TYPE UB32 (ECLECTOR.READER:UNQUOTE VAR)))
                        (SETF (AREF RESULT (ECLECTOR.READER:UNQUOTE OFFSET))
                                (LDB (BYTE 8 0) (ECLECTOR.READER:UNQUOTE VAR))
                              (AREF RESULT
                                    (ECLECTOR.READER:UNQUOTE (+ OFFSET 1)))
                                (LDB (BYTE 8 8) (ECLECTOR.READER:UNQUOTE VAR))
                              (AREF RESULT
                                    (ECLECTOR.READER:UNQUOTE (+ OFFSET 2)))
                                (LDB (BYTE 8 16) (ECLECTOR.READER:UNQUOTE VAR))
                              (AREF RESULT
                                    (ECLECTOR.READER:UNQUOTE (+ OFFSET 3)))
                                (LDB (BYTE 8 24)
                                     (ECLECTOR.READER:UNQUOTE VAR))))))))
        (FROB (MD5-REGS-A REGS) 0)
        (FROB (MD5-REGS-B REGS) 4)
        (FROB (MD5-REGS-C REGS) 8)
        (FROB (MD5-REGS-D REGS) 12))
      RESULT))

[ahungry-fleece/contrib/sb-md5/md5.lisp:309]
  (DEFUN COPY-TO-BUFFER (FROM FROM-OFFSET COUNT BUFFER BUFFER-OFFSET)
    "Copy a partial segment from input vector from starting at
from-offset and copying count elements into the 64 byte buffer
starting at buffer-offset."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0))
             (TYPE (UNSIGNED-BYTE 29) FROM-OFFSET)
             (TYPE (INTEGER 0 63) COUNT BUFFER-OFFSET)
             (TYPE (SIMPLE-ARRAY * (*)) FROM)
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (64)) BUFFER))
    (SB-KERNEL:UB8-BASH-COPY FROM FROM-OFFSET BUFFER BUFFER-OFFSET COUNT))

[ahungry-fleece/contrib/sb-md5/md5.lisp:320]
  (DEFUN UPDATE-MD5-STATE
         (STATE SEQUENCE &KEY (START 0) (END (LENGTH SEQUENCE)))
    "Update the given md5-state from sequence, which is either a
simple-string or a simple-array with element-type (unsigned-byte 8),
bounded by start and end, which must be numeric bounding-indices."
    (DECLARE (TYPE MD5-STATE STATE)
             (TYPE (SIMPLE-ARRAY * (*)) SEQUENCE)
             (TYPE FIXNUM START END)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LET ((REGS (MD5-STATE-REGS STATE))
          (BLOCK (MD5-STATE-BLOCK STATE))
          (BUFFER (MD5-STATE-BUFFER STATE))
          (BUFFER-INDEX (MD5-STATE-BUFFER-INDEX STATE))
          (LENGTH (- END START)))
      (DECLARE (TYPE MD5-REGS REGS)
               (TYPE FIXNUM LENGTH)
               (TYPE (INTEGER 0 63) BUFFER-INDEX)
               (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 32) (16)) BLOCK)
               (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (64)) BUFFER))
      (UNLESS (ZEROP BUFFER-INDEX)
        (LET ((AMOUNT (MIN (- 64 BUFFER-INDEX) LENGTH)))
          (DECLARE (TYPE (INTEGER 0 63) AMOUNT))
          (COPY-TO-BUFFER SEQUENCE START AMOUNT BUFFER BUFFER-INDEX)
          (SETQ START (THE FIXNUM (+ START AMOUNT)))
          (LET ((NEW-INDEX (MOD (+ BUFFER-INDEX AMOUNT) 64)))
            (WHEN (ZEROP NEW-INDEX)
              (FILL-BLOCK-UB8 BLOCK BUFFER 0)
              (UPDATE-MD5-BLOCK REGS BLOCK))
            (WHEN (>= START END)
              (SETF (MD5-STATE-BUFFER-INDEX STATE) NEW-INDEX)
              (INCF (MD5-STATE-AMOUNT STATE) LENGTH)
              (RETURN-FROM UPDATE-MD5-STATE STATE)))))
      (ETYPECASE SEQUENCE
        ((SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*))
         (LOCALLY
          (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) SEQUENCE))
          (LOOP FOR OFFSET OF-TYPE (UNSIGNED-BYTE 29) FROM START BELOW
                END BY 64
                UNTIL (< (- END OFFSET) 64)
                DO (FILL-BLOCK-UB8 BLOCK SEQUENCE OFFSET) (UPDATE-MD5-BLOCK
                                                           REGS BLOCK)
                FINALLY (LET ((AMOUNT (- END OFFSET)))
                          (UNLESS (ZEROP AMOUNT)
                            (COPY-TO-BUFFER SEQUENCE OFFSET AMOUNT BUFFER 0))
                          (SETF (MD5-STATE-BUFFER-INDEX STATE) AMOUNT)))))
        (SIMPLE-STRING
         (LOCALLY
          (DECLARE (TYPE SIMPLE-STRING SEQUENCE))
          (LOOP FOR OFFSET OF-TYPE (UNSIGNED-BYTE 29) FROM START BELOW
                END BY 64
                UNTIL (< (- END OFFSET) 64)
                DO (FILL-BLOCK-CHAR BLOCK SEQUENCE OFFSET) (UPDATE-MD5-BLOCK
                                                            REGS BLOCK)
                FINALLY (LET ((AMOUNT (- END OFFSET)))
                          (UNLESS (ZEROP AMOUNT)
                            (COPY-TO-BUFFER SEQUENCE OFFSET AMOUNT BUFFER 0))
                          (SETF (MD5-STATE-BUFFER-INDEX STATE) AMOUNT))))))
      (SETF (MD5-STATE-AMOUNT STATE)
              (THE (UNSIGNED-BYTE 29) (+ (MD5-STATE-AMOUNT STATE) LENGTH)))
      STATE))

[ahungry-fleece/contrib/sb-md5/md5.lisp:385]
  (DEFUN FINALIZE-MD5-STATE (STATE)
    "If the given md5-state has not already been finalized, finalize it,
by processing any remaining input in its buffer, with suitable padding
and appended bit-length, as specified by the MD5 standard.

The resulting MD5 message-digest is returned as an array of sixteen
(unsigned-byte 8) values.  Calling `update-md5-state' after a call to
`finalize-md5-state' results in unspecified behaviour."
    (DECLARE (TYPE MD5-STATE STATE)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (OR (MD5-STATE-FINALIZED-P STATE)
        (LET ((REGS (MD5-STATE-REGS STATE))
              (BLOCK (MD5-STATE-BLOCK STATE))
              (BUFFER (MD5-STATE-BUFFER STATE))
              (BUFFER-INDEX (MD5-STATE-BUFFER-INDEX STATE))
              (TOTAL-LENGTH (* 8 (MD5-STATE-AMOUNT STATE))))
          (DECLARE (TYPE MD5-REGS REGS)
                   (TYPE (INTEGER 0 63) BUFFER-INDEX)
                   (TYPE (SIMPLE-ARRAY UB32 (16)) BLOCK)
                   (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) BUFFER))
          (SETF (AREF BUFFER BUFFER-INDEX) 128)
          (LOOP FOR INDEX OF-TYPE (INTEGER 0 64) FROM (1+
                                                       BUFFER-INDEX) BELOW 64
                DO (SETF (AREF BUFFER INDEX) 0))
          (FILL-BLOCK-UB8 BLOCK BUFFER 0)
          (WHEN (>= BUFFER-INDEX 56)
            (UPDATE-MD5-BLOCK REGS BLOCK)
            (LOOP FOR INDEX OF-TYPE (INTEGER 0 16) FROM 0 BELOW 16
                  DO (SETF (AREF BLOCK INDEX) 0)))
          (SETF (AREF BLOCK 14) (LDB (BYTE 32 0) TOTAL-LENGTH))
          (UPDATE-MD5-BLOCK REGS BLOCK)
          (SETF (MD5-STATE-FINALIZED-P STATE) (MD5REGS-DIGEST REGS)))))

[ahungry-fleece/contrib/sb-md5/md5.lisp:430]
  (DEFUN MD5SUM-SEQUENCE (SEQUENCE &KEY (START 0) END)
    "Calculate the MD5 message-digest of data bounded by START and END
in SEQUENCE , which must be a vector with element-type (UNSIGNED-BYTE
8)."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 3) (SPACE 0) (DEBUG 1))
             (TYPE (VECTOR (UNSIGNED-BYTE 8)) SEQUENCE)
             (TYPE FIXNUM START))
    (LOCALLY
     (DECLARE (OPTIMIZE (SAFETY 1) (DEBUG 0)))
     (LET ((STATE (MAKE-MD5-STATE)))
       (DECLARE (TYPE MD5-STATE STATE))
       (LET ((END (OR END (LENGTH SEQUENCE))))
         (SB-KERNEL:WITH-ARRAY-DATA ((DATA SEQUENCE) (REAL-START START)
                                     (REAL-END END) :CHECK-FILL-POINTER T)
           (DECLARE (IGNORE REAL-END))
           (UPDATE-MD5-STATE STATE DATA :START REAL-START :END
            (+ REAL-START (- END START)))))
       (FINALIZE-MD5-STATE STATE))))

[ahungry-fleece/contrib/sb-md5/md5.lisp:451]
  (DEFUN MD5SUM-STRING (STRING &KEY (EXTERNAL-FORMAT :DEFAULT) (START 0) END)
    "Calculate the MD5 message-digest of the binary representation
of STRING (as octets) in EXTERNAL-FORMAT. The boundaries START
and END refer to character positions in the string, not to octets
in the resulting binary representation."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 3) (SPACE 0) (DEBUG 1))
             (TYPE STRING STRING)
             (TYPE FIXNUM START))
    (LOCALLY
     (DECLARE (OPTIMIZE (SAFETY 1) (DEBUG 0)))
     (MD5SUM-SEQUENCE
      (STRING-TO-OCTETS STRING :EXTERNAL-FORMAT EXTERNAL-FORMAT :START START
                        :END END))))

[ahungry-fleece/contrib/sb-md5/md5.lisp:471]
  (DEFUN MD5SUM-STREAM (STREAM)
    "Calculate an MD5 message-digest of the contents of STREAM, whose
element-type has to be (UNSIGNED-BYTE 8)."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 3) (SPACE 0) (DEBUG 1)))
    (DECLARE (TYPE STREAM STREAM))
    (LOCALLY
     (DECLARE (OPTIMIZE (SAFETY 1) (DEBUG 0)))
     (LET ((STATE (MAKE-MD5-STATE)))
       (DECLARE (TYPE MD5-STATE STATE))
       (COND
        ((EQUAL (STREAM-ELEMENT-TYPE STREAM) '(UNSIGNED-BYTE 8))
         (LET ((BUFFER
                (MAKE-ARRAY +BUFFER-SIZE+ :ELEMENT-TYPE '(UNSIGNED-BYTE 8))))
           (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (NIL)) BUFFER))
           (LOOP FOR BYTES OF-TYPE BUFFER-INDEX = (READ-SEQUENCE BUFFER STREAM)
                 DO (UPDATE-MD5-STATE STATE BUFFER :END BYTES)
                 UNTIL (< BYTES +BUFFER-SIZE+)
                 FINALLY (RETURN (FINALIZE-MD5-STATE STATE)))))
        ((EQUAL (STREAM-ELEMENT-TYPE STREAM) 'CHARACTER)
         (LET ((BUFFER (MAKE-STRING +BUFFER-SIZE+)))
           (DECLARE (TYPE (SIMPLE-STRING NIL) BUFFER))
           (LOOP FOR BYTES OF-TYPE BUFFER-INDEX = (READ-SEQUENCE BUFFER STREAM)
                 DO (UPDATE-MD5-STATE STATE BUFFER :END BYTES)
                 UNTIL (< BYTES +BUFFER-SIZE+)
                 FINALLY (RETURN (FINALIZE-MD5-STATE STATE)))))
        (T
         (ERROR "Unsupported stream element-type ~S for stream ~S."
                (STREAM-ELEMENT-TYPE STREAM) STREAM))))))

[ahungry-fleece/contrib/sb-md5/md5.lisp:504]
  (DEFUN MD5SUM-FILE (PATHNAME)
    "Calculate the MD5 message-digest of the file designated by
pathname."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 3) (SPACE 0) (DEBUG 1)))
    (LOCALLY
     (DECLARE (OPTIMIZE (SAFETY 1) (DEBUG 0)))
     (WITH-OPEN-FILE (STREAM PATHNAME :ELEMENT-TYPE '(UNSIGNED-BYTE 8))
       (MD5SUM-STREAM STREAM))))

[alexandria/alexandria-1/functions.lisp:24]
  (DEFUN DISJOIN (PREDICATE &REST MORE-PREDICATES)
    "Returns a function that applies each of PREDICATE and MORE-PREDICATE
functions in turn to its arguments, returning the primary value of the first
predicate that returns true, without calling the remaining predicates.
If none of the predicates returns true, NIL is returned."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
    (LET ((PREDICATE (ENSURE-FUNCTION PREDICATE))
          (MORE-PREDICATES (MAPCAR #'ENSURE-FUNCTION MORE-PREDICATES)))
      (LAMBDA (&REST ARGUMENTS)
        (OR (APPLY PREDICATE ARGUMENTS)
            (SOME (LAMBDA (P) (DECLARE (TYPE FUNCTION P)) (APPLY P ARGUMENTS))
                  MORE-PREDICATES)))))

[alexandria/alexandria-1/functions.lisp:58]
  (DEFUN COMPOSE (FUNCTION &REST MORE-FUNCTIONS)
    "Returns a function composed of FUNCTION and MORE-FUNCTIONS that applies its
arguments to to each in turn, starting from the rightmost of MORE-FUNCTIONS,
and then calling the next one with the primary value of the last."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
    (REDUCE
     (LAMBDA (F G)
       (LET ((F (ENSURE-FUNCTION F)) (G (ENSURE-FUNCTION G)))
         (LAMBDA (&REST ARGUMENTS)
           (DECLARE (DYNAMIC-EXTENT ARGUMENTS))
           (FUNCALL F (APPLY G ARGUMENTS)))))
     MORE-FUNCTIONS :INITIAL-VALUE FUNCTION))

[alexandria/alexandria-1/functions.lisp:72]
  (DEFINE-COMPILER-MACRO COMPOSE
      (FUNCTION &REST MORE-FUNCTIONS)
    (LABELS ((COMPOSE-1 (FUNS)
               (IF (CDR FUNS)
                   (ECLECTOR.READER:QUASIQUOTE
                    (FUNCALL (ECLECTOR.READER:UNQUOTE (CAR FUNS))
                             (ECLECTOR.READER:UNQUOTE (COMPOSE-1 (CDR FUNS)))))
                   (ECLECTOR.READER:QUASIQUOTE
                    (APPLY (ECLECTOR.READER:UNQUOTE (CAR FUNS)) ARGUMENTS)))))
      (LET* ((ARGS (CONS FUNCTION MORE-FUNCTIONS))
             (FUNS (MAKE-GENSYM-LIST (LENGTH ARGS) "COMPOSE")))
        (ECLECTOR.READER:QUASIQUOTE
         (LET (ECLECTOR.READER:UNQUOTE
               (LOOP
                FOR
                F
                IN
                FUNS
                FOR
                ARG
                IN
                ARGS
                COLLECT
                (ECLECTOR.READER:QUASIQUOTE
                 ((ECLECTOR.READER:UNQUOTE F)
                  (ENSURE-FUNCTION (ECLECTOR.READER:UNQUOTE ARG))))))
           (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
           (LAMBDA (&REST ARGUMENTS)
             (DECLARE (DYNAMIC-EXTENT ARGUMENTS))
             (ECLECTOR.READER:UNQUOTE (COMPOSE-1 FUNS))))))))

[alexandria/alexandria-1/functions.lisp:86]
  (DEFUN MULTIPLE-VALUE-COMPOSE (FUNCTION &REST MORE-FUNCTIONS)
    "Returns a function composed of FUNCTION and MORE-FUNCTIONS that applies
its arguments to each in turn, starting from the rightmost of
MORE-FUNCTIONS, and then calling the next one with all the return values of
the last."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
    (REDUCE
     (LAMBDA (F G)
       (LET ((F (ENSURE-FUNCTION F)) (G (ENSURE-FUNCTION G)))
         (LAMBDA (&REST ARGUMENTS)
           (DECLARE (DYNAMIC-EXTENT ARGUMENTS))
           (MULTIPLE-VALUE-CALL F (APPLY G ARGUMENTS)))))
     MORE-FUNCTIONS :INITIAL-VALUE FUNCTION))

[alexandria/alexandria-1/functions.lisp:101]
  (DEFINE-COMPILER-MACRO MULTIPLE-VALUE-COMPOSE
      (FUNCTION &REST MORE-FUNCTIONS)
    (LABELS ((COMPOSE-1 (FUNS)
               (IF (CDR FUNS)
                   (ECLECTOR.READER:QUASIQUOTE
                    (MULTIPLE-VALUE-CALL (ECLECTOR.READER:UNQUOTE (CAR FUNS))
                      (ECLECTOR.READER:UNQUOTE (COMPOSE-1 (CDR FUNS)))))
                   (ECLECTOR.READER:QUASIQUOTE
                    (APPLY (ECLECTOR.READER:UNQUOTE (CAR FUNS)) ARGUMENTS)))))
      (LET* ((ARGS (CONS FUNCTION MORE-FUNCTIONS))
             (FUNS (MAKE-GENSYM-LIST (LENGTH ARGS) "MV-COMPOSE")))
        (ECLECTOR.READER:QUASIQUOTE
         (LET (ECLECTOR.READER:UNQUOTE (MAPCAR #'LIST FUNS ARGS))
           (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
           (LAMBDA (&REST ARGUMENTS)
             (DECLARE (DYNAMIC-EXTENT ARGUMENTS))
             (ECLECTOR.READER:UNQUOTE (COMPOSE-1 FUNS))))))))

[alexandria/alexandria-1/functions.lisp:116]
  (DEFUN CURRY (FUNCTION &REST ARGUMENTS)
    "Returns a function that applies ARGUMENTS and the arguments
it is called with to FUNCTION."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (LET ((FN (ENSURE-FUNCTION FUNCTION)))
      (LAMBDA (&REST MORE)
        (DECLARE (DYNAMIC-EXTENT MORE))
        (MULTIPLE-VALUE-CALL FN (VALUES-LIST ARGUMENTS) (VALUES-LIST MORE)))))

[alexandria/alexandria-1/functions.lisp:126]
  (DEFINE-COMPILER-MACRO CURRY
      (FUNCTION &REST ARGUMENTS)
    (LET ((CURRIES (MAKE-GENSYM-LIST (LENGTH ARGUMENTS) "CURRY"))
          (FUN (GENSYM "FUN")))
      (ECLECTOR.READER:QUASIQUOTE
       (LET (((ECLECTOR.READER:UNQUOTE FUN)
              (ENSURE-FUNCTION (ECLECTOR.READER:UNQUOTE FUNCTION)))
             (ECLECTOR.READER:UNQUOTE-SPLICING
              (MAPCAR #'LIST CURRIES ARGUMENTS)))
         (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
         (LAMBDA (&REST MORE)
           (DECLARE (DYNAMIC-EXTENT MORE))
           (APPLY (ECLECTOR.READER:UNQUOTE FUN)
                  (ECLECTOR.READER:UNQUOTE-SPLICING CURRIES) MORE))))))

[alexandria/alexandria-1/functions.lisp:136]
  (DEFUN RCURRY (FUNCTION &REST ARGUMENTS)
    "Returns a function that applies the arguments it is called
with and ARGUMENTS to FUNCTION."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (LET ((FN (ENSURE-FUNCTION FUNCTION)))
      (LAMBDA (&REST MORE)
        (DECLARE (DYNAMIC-EXTENT MORE))
        (MULTIPLE-VALUE-CALL FN (VALUES-LIST MORE) (VALUES-LIST ARGUMENTS)))))

[alexandria/alexandria-1/functions.lisp:145]
  (DEFINE-COMPILER-MACRO RCURRY
      (FUNCTION &REST ARGUMENTS)
    (LET ((RCURRIES (MAKE-GENSYM-LIST (LENGTH ARGUMENTS) "RCURRY"))
          (FUN (GENSYM "FUN")))
      (ECLECTOR.READER:QUASIQUOTE
       (LET (((ECLECTOR.READER:UNQUOTE FUN)
              (ENSURE-FUNCTION (ECLECTOR.READER:UNQUOTE FUNCTION)))
             (ECLECTOR.READER:UNQUOTE-SPLICING
              (MAPCAR #'LIST RCURRIES ARGUMENTS)))
         (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
         (LAMBDA (&REST MORE)
           (DECLARE (DYNAMIC-EXTENT MORE))
           (MULTIPLE-VALUE-CALL (ECLECTOR.READER:UNQUOTE FUN)
             (VALUES-LIST MORE)
             (ECLECTOR.READER:UNQUOTE-SPLICING RCURRIES)))))))

[alexandria/alexandria-1/lists.lisp:4]
  (DEFUN SAFE-ENDP (X) (DECLARE (OPTIMIZE SAFETY)) (ENDP X))

[alloy/renderers/simple/transforms.lisp:39]
  (DEFUN MAT* (R A B)
    (DECLARE (TYPE (SIMPLE-ARRAY SINGLE-FLOAT (9)) R A B))
    (DECLARE (OPTIMIZE SPEED (SAFETY 1)))
    (LET ((A00 (AREF A 0))
          (A10 (AREF A 1))
          (A20 (AREF A 2))
          (A01 (AREF A 3))
          (A11 (AREF A 4))
          (A21 (AREF A 5))
          (A02 (AREF A 6))
          (A12 (AREF A 7))
          (A22 (AREF A 8))
          (B00 (AREF B 0))
          (B10 (AREF B 1))
          (B20 (AREF B 2))
          (B01 (AREF B 3))
          (B11 (AREF B 4))
          (B21 (AREF B 5))
          (B02 (AREF B 6))
          (B12 (AREF B 7))
          (B22 (AREF B 8)))
      (SETF (AREF R 0) (+ (* A00 B00) (* A10 B01) (* A20 B02)))
      (SETF (AREF R 1) (+ (* A00 B10) (* A10 B11) (* A20 B12)))
      (SETF (AREF R 2) (+ (* A00 B20) (* A10 B21) (* A20 B22)))
      (SETF (AREF R 3) (+ (* A01 B00) (* A11 B01) (* A21 B02)))
      (SETF (AREF R 4) (+ (* A01 B10) (* A11 B11) (* A21 B12)))
      (SETF (AREF R 5) (+ (* A01 B20) (* A11 B21) (* A21 B22)))
      (SETF (AREF R 6) (+ (* A02 B00) (* A12 B01) (* A22 B02)))
      (SETF (AREF R 7) (+ (* A02 B10) (* A12 B11) (* A22 B12)))
      (SETF (AREF R 8) (+ (* A02 B20) (* A12 B21) (* A22 B22)))
      R))

[antik/foreign-array/tests/fast-array-access.lisp:12]
  (DECLAIM (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))

[antik/foreign-array/tests/fast-array-access.lisp:14]
  (DEFUN AREF-ACCESS (DIM)
    "Given an integer dim, this constructs a function that, when supplied with a
   N-dimensional vector Z and some output vector (-> pointer?), yields the
   corresponding forces"
    (LET ((TEMP-VALUES
           (MAKE-ARRAY 2 :ELEMENT-TYPE 'DOUBLE-FLOAT :INITIAL-ELEMENT 0.0d0)))
      (LAMBDA (ZVECTOR OUTPUT)
        (DECLARE (FIXNUM DIM)
                 (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0))
                 (TYPE VECTOR-DOUBLE-FLOAT ZVECTOR))
        (DO ((I 0 (1+ I)))
            ((= I DIM))
          (DECLARE (FIXNUM I))
          (SETF (AREF TEMP-VALUES 0) 0.0d0)
          (DO ((M 0 (1+ M)))
              ((> M I))
            (DECLARE (FIXNUM M))
            (DO ((N I (1+ N)))
                ((= N DIM))
              (DECLARE (FIXNUM N))
              (SETF (AREF TEMP-VALUES 1) 0.0d0)
              (DO ((K M (1+ K)))
                  ((> K N))
                (DECLARE (FIXNUM K))
                (INCF (AREF TEMP-VALUES 1)
                      (#S(FORMGREP:SYMREF :NAME "AREF" :QUALIFIER "GRID")
                       (THE VECTOR-DOUBLE-FLOAT ZVECTOR) K)))
              (INCF (AREF TEMP-VALUES 0) (EXPT (AREF TEMP-VALUES 1) -2))))
          (SETF (#S(FORMGREP:SYMREF :NAME "AREF" :QUALIFIER "GRID") OUTPUT I)
                  (-
                   (#S(FORMGREP:SYMREF :NAME "AREF" :QUALIFIER "GRID")
                    (THE VECTOR-DOUBLE-FLOAT ZVECTOR) I)
                   (AREF TEMP-VALUES 0)))))))

[antik/foreign-array/tests/fast-array-access.lisp:35]
  (DEFUN AREF*-ACCESS (DIM)
    "Given an integer dim, this constructs a function that, when supplied with a
   N-dimensional vector Z and some output vector (-> pointer?), yields the
   corresponding forces"
    (LET ((TEMP-VALUES
           (MAKE-ARRAY 2 :ELEMENT-TYPE 'DOUBLE-FLOAT :INITIAL-ELEMENT 0.0d0)))
      (LAMBDA (ZVECTOR OUTPUT)
        (DECLARE (FIXNUM DIM)
                 (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
        (DO ((I 0 (1+ I)))
            ((= I DIM))
          (DECLARE (FIXNUM I))
          (SETF (AREF TEMP-VALUES 0) 0.0d0)
          (DO ((M 0 (1+ M)))
              ((> M I))
            (DECLARE (FIXNUM M))
            (DO ((N I (1+ N)))
                ((= N DIM))
              (DECLARE (FIXNUM N))
              (SETF (AREF TEMP-VALUES 1) 0.0d0)
              (DO ((K M (1+ K)))
                  ((> K N))
                (DECLARE (FIXNUM K))
                (INCF (AREF TEMP-VALUES 1)
                      (#S(FORMGREP:SYMREF :NAME "AREF*" :QUALIFIER "GRID")
                       (THE VECTOR-DOUBLE-FLOAT ZVECTOR) K)))
              (INCF (AREF TEMP-VALUES 0) (EXPT (AREF TEMP-VALUES 1) -2))))
          (SETF (#S(FORMGREP:SYMREF :NAME "AREF*" :QUALIFIER "GRID") OUTPUT I)
                  (-
                   (#S(FORMGREP:SYMREF :NAME "AREF*" :QUALIFIER "GRID")
                    (THE VECTOR-DOUBLE-FLOAT ZVECTOR) I)
                   (AREF TEMP-VALUES 0)))))))

[april/aplesque/aplesque.lisp:1090]
  (DEFUN REDUCE-ARRAY (INPUT FUNCTION AXIS &OPTIONAL LAST-AXIS WINDOW)
    "Reduce an array along by a given function along a given dimension, optionally with a window interval."
    (IF (= 0 (RANK INPUT))
        INPUT
        (LET* ((ODIMS (DIMS INPUT))
               (AXIS
                (OR AXIS
                    (IF (NOT LAST-AXIS)
                        0
                        (MAX 0 (1- (RANK INPUT))))))
               (RLEN (NTH AXIS ODIMS))
               (INCREMENT (REDUCE #'* (NTHCDR (1+ AXIS) ODIMS)))
               (WINDOW-REVERSED (AND WINDOW (> 0 WINDOW)))
               (WINDOW
                (IF WINDOW
                    (ABS WINDOW)))
               (WSEGMENT)
               (OUTPUT
                (MAKE-ARRAY
                 (LOOP :FOR DIM :IN ODIMS
                       :FOR DX :FROM 0
                       :WHEN (/= DX AXIS)
                       :COLLECT DIM
                       :WHEN (AND WINDOW (= DX AXIS))
                       :COLLECT (SETQ WSEGMENT (- DIM (1- WINDOW)))))))
          (IF (= 1 (FIRST (LAST ODIMS)))
              (XDOTIMES OUTPUT (I (SIZE OUTPUT))
               (SETF (ROW-MAJOR-AREF OUTPUT I) (ROW-MAJOR-AREF INPUT I)))
              (DOTIMES (I (SIZE OUTPUT))
                (DECLARE (OPTIMIZE (SAFETY 1)))
                (LET ((VALUE))
                  (FLET ((PROCESS-ITEM (IX)
                           (LET ((ITEM
                                  (ROW-MAJOR-AREF INPUT
                                                  (+ (* IX INCREMENT)
                                                     (IF WINDOW
                                                         (* RLEN
                                                            (FLOOR I WSEGMENT))
                                                         (IF (= 1 INCREMENT)
                                                             0
                                                             (*
                                                              (FLOOR I
                                                                     INCREMENT)
                                                              (-
                                                               (* INCREMENT
                                                                  RLEN)
                                                               INCREMENT))))
                                                     (IF (/= 1 INCREMENT)
                                                         I
                                                         (IF WINDOW
                                                             (IF (>= 1
                                                                     (RANK
                                                                      INPUT))
                                                                 I
                                                                 (MOD I
                                                                      WSEGMENT))
                                                             (* I RLEN)))))))
                             (SETQ VALUE
                                     (IF (NOT VALUE)
                                         ITEM
                                         (FUNCALL FUNCTION VALUE ITEM))))))
                    (IF WINDOW-REVERSED
                        (LOOP :FOR IX :BELOW WINDOW
                              :DO (PROCESS-ITEM IX))
                        (LOOP :FOR IX :FROM (1- (OR WINDOW RLEN)) :DOWNTO 0
                              :DO (PROCESS-ITEM IX))))
                  (SETF (ROW-MAJOR-AREF OUTPUT I) VALUE))))
          (IF (NOT
               (AND (ARRAYP OUTPUT) (= 0 (RANK OUTPUT))
                    (NOT (ARRAYP (AREF OUTPUT)))))
              OUTPUT
              (DISCLOSE OUTPUT)))))

[april/aplesque/aplesque.lisp:1891]
  (DEFUN TURN (INPUT AXIS &OPTIONAL DEGREES)
    "Scan a function across an array along a given axis. Used to implement the [ scan] operator with an option for inversion when used with the [⍣ power] operator taking a negative right operand."
    (IF (AND DEGREES
             (NOT
              (OR (IS-UNITARY DEGREES)
                  (AND (= (RANK DEGREES) (1- (RANK INPUT)))
                       (LOOP :FOR DD :IN (DIMS DEGREES)
                             :FOR ID :IN (LOOP :FOR D :IN (DIMS INPUT)
                                               :FOR DX :FROM 0
                                               :WHEN (/= DX AXIS)
                                               :COLLECT D)
                             :ALWAYS (= DD ID))))))
        (ERROR
         "Invalid degree array; degree array must have same dimensions as input array excluding the ~a"
         "axis along which the input array is to be rotated."))
    (IF (NOT (ARRAYP INPUT))
        INPUT
        (LET* ((IDIMS (DIMS INPUT))
               (RLEN (NTH AXIS IDIMS))
               (INCREMENT (REDUCE #'* (NTHCDR (1+ AXIS) IDIMS)))
               (VSET-SIZE (* INCREMENT (NTH AXIS IDIMS)))
               (OUTPUT (MAKE-ARRAY IDIMS :ELEMENT-TYPE (ELEMENT-TYPE INPUT)))
               (ADJUSTER
                (IF DEGREES
                    #'IDENTITY
                    (LAMBDA (X) (ABS (- X (1- RLEN)))))))
          (XDOTIMES OUTPUT (I (SIZE OUTPUT)) (DECLARE (OPTIMIZE (SAFETY 1)))
           (LET ((VINDEX
                  (FUNCALL ADJUSTER
                           (MOD
                            (+ (FLOOR I INCREMENT)
                               (IF (INTEGERP DEGREES)
                                   DEGREES
                                   (IF (ARRAYP DEGREES)
                                       (ROW-MAJOR-AREF DEGREES
                                                       (+ (MOD I INCREMENT)
                                                          (* INCREMENT
                                                             (FLOOR I
                                                                    VSET-SIZE))))
                                       0)))
                            RLEN))))
             (SETF (ROW-MAJOR-AREF OUTPUT I)
                     (ROW-MAJOR-AREF INPUT
                                     (+ (MOD I INCREMENT) (* INCREMENT VINDEX)
                                        (* VSET-SIZE (FLOOR I VSET-SIZE)))))))
          OUTPUT)))

[april/library.lisp:787]
  (DEFUN OPERATE-SCANNING
         (FUNCTION AXIS INDEX-ORIGIN &OPTIONAL LAST-AXIS INVERSE)
    "Scan a function across an array along a given axis. Used to implement the [ scan] operator with an option for inversion when used with the [⍣ power] operator taking a negative right operand."
    (LAMBDA (OMEGA)
      (IF (EQ :GET-METADATA OMEGA)
          (LIST :INVERSE
                (LET ((INVERSE-FUNCTION
                       (GETF (FUNCALL FUNCTION :GET-METADATA NIL) :INVERSE)))
                  (OPERATE-SCANNING INVERSE-FUNCTION AXIS INDEX-ORIGIN
                   LAST-AXIS T)))
          (IF (NOT (ARRAYP OMEGA))
              OMEGA
              (LET* ((ODIMS (DIMS OMEGA))
                     (AXIS
                      (OR (AND (FIRST AXIS) (- (FIRST AXIS) INDEX-ORIGIN))
                          (IF (NOT LAST-AXIS)
                              0
                              (1- (RANK OMEGA)))))
                     (RLEN (NTH AXIS ODIMS))
                     (INCREMENT (REDUCE #'* (NTHCDR (1+ AXIS) ODIMS)))
                     (OUTPUT (MAKE-ARRAY ODIMS)))
                (DOTIMES (I (SIZE OUTPUT))
                  (DECLARE (OPTIMIZE (SAFETY 1)))
                  (LET ((VALUE) (VECTOR-INDEX (MOD (FLOOR I INCREMENT) RLEN)))
                    (IF INVERSE
                        (LET ((ORIGINAL
                               (DISCLOSE
                                (ROW-MAJOR-AREF OMEGA
                                                (+ (MOD I INCREMENT)
                                                   (* INCREMENT VECTOR-INDEX)
                                                   (* INCREMENT RLEN
                                                      (FLOOR I
                                                             (* INCREMENT
                                                                RLEN))))))))
                          (SETQ VALUE
                                  (IF (= 0 VECTOR-INDEX)
                                      ORIGINAL
                                      (FUNCALL FUNCTION ORIGINAL
                                               (DISCLOSE
                                                (ROW-MAJOR-AREF OMEGA
                                                                (+
                                                                 (MOD I
                                                                      INCREMENT)
                                                                 (* INCREMENT
                                                                    (1-
                                                                     VECTOR-INDEX))
                                                                 (* INCREMENT
                                                                    RLEN
                                                                    (FLOOR I
                                                                           (*
                                                                            INCREMENT
                                                                            RLEN))))))))))
                        (LOOP :FOR IX :FROM VECTOR-INDEX :DOWNTO 0
                              :DO (LET ((ORIGINAL
                                         (ROW-MAJOR-AREF OMEGA
                                                         (+ (MOD I INCREMENT)
                                                            (* IX INCREMENT)
                                                            (* INCREMENT RLEN
                                                               (FLOOR I
                                                                      (*
                                                                       INCREMENT
                                                                       RLEN)))))))
                                    (SETQ VALUE
                                            (IF (NOT VALUE)
                                                (DISCLOSE ORIGINAL)
                                                (FUNCALL FUNCTION VALUE
                                                         (DISCLOSE
                                                          ORIGINAL)))))))
                    (SETF (ROW-MAJOR-AREF OUTPUT I) VALUE)))
                OUTPUT)))))

[april/maxpc-apache/input/list.lisp:10]
  (DEFMETHOD INPUT-EMPTY-P ((INPUT INDEX-LIST))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (NULL (THE LIST (INDEX-LIST-LIST INPUT))))

[april/maxpc-apache/input/list.lisp:14]
  (DEFMETHOD INPUT-FIRST ((INPUT INDEX-LIST))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (CAR (THE LIST (INDEX-LIST-LIST INPUT))))

[april/maxpc-apache/input/list.lisp:25]
  (DEFMETHOD INPUT-SEQUENCE ((INPUT INDEX-LIST) (LENGTH INTEGER))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (SUBSEQ (THE LIST (INDEX-LIST-LIST INPUT)) 0 LENGTH))

[april/maxpc-apache/input/stream.lisp:32]
  (DEFMETHOD FILL-BUFFER ((BUFFER VECTOR) (STREAM STREAM))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (LET ((NEXT
           (CASE (ELEMENT-TYPE STREAM)
             (CHARACTER (READ-CHAR STREAM NIL 'EOF))
             (OTHERWISE (READ-BYTE STREAM NIL 'EOF)))))
      (UNLESS (EQ NEXT 'EOF)
        (VECTOR-PUSH-EXTEND NEXT BUFFER (THE FIXNUM *CHUNK-SIZE*)))))

[april/maxpc-apache/input/stream.lisp:61]
  (DEFUN MAYBE-FILL-BUFFER (INPUT)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (LET ((POSITION (INDEX-POSITION INPUT))
          (BUFFER (INDEX-STREAM-BUFFER INPUT))
          (STREAM (INDEX-STREAM-STREAM INPUT)))
      (UNLESS
          (> (THE INDEX-POSITION (LENGTH (THE VECTOR BUFFER)))
             (THE INDEX-POSITION POSITION))
        (FILL-BUFFER BUFFER STREAM)))
    (VALUES))

[april/maxpc-apache/input/stream.lisp:71]
  (DEFMETHOD INPUT-EMPTY-P ((INPUT INDEX-STREAM))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (MAYBE-FILL-BUFFER INPUT)
    (= (THE INDEX-POSITION (INDEX-POSITION INPUT))
       (THE INDEX-POSITION
            (IF *BOUND*
                (MIN (LENGTH (THE VECTOR (INDEX-STREAM-BUFFER INPUT)))
                     (THE INDEX-POSITION *BOUND*))
                (LENGTH (THE VECTOR (INDEX-STREAM-BUFFER INPUT)))))))

[april/maxpc-apache/input/stream.lisp:81]
  (DEFMETHOD INPUT-FIRST ((INPUT INDEX-STREAM))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (MAYBE-FILL-BUFFER INPUT)
    (AREF (THE VECTOR (INDEX-STREAM-BUFFER INPUT))
          (THE INDEX-POSITION (INDEX-POSITION INPUT))))

[april/maxpc-apache/input/stream.lisp:87]
  (DEFMETHOD INPUT-REST ((INPUT INDEX-STREAM))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (LET ((POSITION (INDEX-POSITION INPUT))
          (BUFFER (INDEX-STREAM-BUFFER INPUT))
          (STREAM (INDEX-STREAM-STREAM INPUT)))
      (LET ((NEXT-POSITION (1+ (THE INDEX-POSITION POSITION))))
        (MAKE-INDEX-STREAM :STREAM (THE STREAM STREAM) :BUFFER
         (THE VECTOR BUFFER) :POSITION (THE INDEX-POSITION NEXT-POSITION)))))

[april/maxpc-apache/input/stream.lisp:100]
  (DEFMETHOD INPUT-SEQUENCE ((INPUT INDEX-STREAM) (LENGTH INTEGER))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (MAKE-ARRAY (THE INDEX-POSITION LENGTH) :ELEMENT-TYPE
                (INPUT-ELEMENT-TYPE INPUT) :DISPLACED-TO
                (INDEX-STREAM-BUFFER INPUT) :DISPLACED-INDEX-OFFSET
                (INDEX-POSITION INPUT)))

[april/maxpc-apache/input/vector.lisp:20]
  (DEFMETHOD INPUT-EMPTY-P ((INPUT INDEX-VECTOR))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (= (THE INDEX-POSITION (INDEX-POSITION INPUT))
       (THE INDEX-POSITION (LENGTH (THE VECTOR (INDEX-VECTOR-VECTOR INPUT))))))

[april/maxpc-apache/input/vector.lisp:25]
  (DEFMETHOD INPUT-FIRST ((INPUT INDEX-VECTOR))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (AREF (THE VECTOR (INDEX-VECTOR-VECTOR INPUT))
          (THE INDEX-POSITION (INDEX-POSITION INPUT))))

[april/maxpc-apache/input/vector.lisp:30]
  (DEFMETHOD INPUT-FIRST ((INPUT INDEX-SIMPLE-VECTOR))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (AREF (THE SIMPLE-VECTOR (INDEX-VECTOR-VECTOR INPUT))
          (THE INDEX-POSITION (INDEX-POSITION INPUT))))

[april/maxpc-apache/input/vector.lisp:35]
  (DEFMETHOD INPUT-FIRST ((INPUT INDEX-SIMPLE-STRING))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (AREF (THE SIMPLE-STRING (INDEX-VECTOR-VECTOR INPUT))
          (THE INDEX-POSITION (INDEX-POSITION INPUT))))

[april/maxpc-apache/input/vector.lisp:40]
  (DEFMETHOD INPUT-REST ((INPUT INDEX-VECTOR))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (MAKE-INDEX-VECTOR :VECTOR (THE VECTOR (INDEX-VECTOR-VECTOR INPUT))
     :POSITION (1+ (THE INDEX-POSITION (INDEX-POSITION INPUT)))))

[april/maxpc-apache/input/vector.lisp:46]
  (DEFMETHOD INPUT-REST ((INPUT INDEX-SIMPLE-VECTOR))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (MAKE-INDEX-SIMPLE-VECTOR :VECTOR
     (THE SIMPLE-VECTOR (INDEX-VECTOR-VECTOR INPUT)) :POSITION
     (1+ (THE INDEX-POSITION (INDEX-POSITION INPUT)))))

[april/maxpc-apache/input/vector.lisp:52]
  (DEFMETHOD INPUT-REST ((INPUT INDEX-SIMPLE-STRING))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (MAKE-INDEX-SIMPLE-STRING :VECTOR
     (THE SIMPLE-STRING (INDEX-VECTOR-VECTOR INPUT)) :POSITION
     (1+ (THE INDEX-POSITION (INDEX-POSITION INPUT)))))

[april/maxpc-apache/input/vector.lisp:61]
  (DEFMETHOD INPUT-SEQUENCE ((INPUT INDEX-VECTOR) (LENGTH INTEGER))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (MAKE-ARRAY (THE INDEX-POSITION LENGTH) :ELEMENT-TYPE
                (INPUT-ELEMENT-TYPE INPUT) :DISPLACED-TO
                (INDEX-VECTOR-VECTOR INPUT) :DISPLACED-INDEX-OFFSET
                (INDEX-VECTOR-POSITION INPUT)))

[architecture.hooks/src/hook.lisp:107]
  (DEFUN RUN-HOOK-FAST (HOOK &REST ARGS)
    "Run HOOK with ARGS like `run-hook', with the following differences:
+ do not run any methods installed on `run-hook'
+ do not install any restarts
+ do not collect or combine any values returned by handlers."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (DOLIST (HANDLER (HOOK-HANDLERS HOOK))
      (APPLY #'RUN-HANDLER-WITHOUT-RESTARTS HANDLER ARGS))
    (VALUES))

[architecture.hooks/src/util.lisp:17]
  (DEFUN RUN-HANDLER-WITHOUT-RESTARTS (HANDLER &REST ARGS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    "Run HANDLER with ARGS."
    (APPLY (THE FUNCTION HANDLER) ARGS))

[arnesi/src/string.lisp:64]
  (DEFUN FOLD-STRINGS (LIST)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (LET ((STRINGS 'NIL) (RESULT 'NIL))
      (DOLIST (OBJECT LIST)
        (TYPECASE OBJECT
          (STRING (PUSH OBJECT STRINGS))
          (T
           (WHEN STRINGS
             (PUSH (JOIN-STRINGS (NREVERSE STRINGS)) RESULT)
             (SETF STRINGS 'NIL))
           (PUSH OBJECT RESULT))))
      (WHEN STRINGS (PUSH (JOIN-STRINGS (NREVERSE STRINGS)) RESULT))
      (NREVERSE RESULT)))

[babel/src/encodings.lisp:320]
  (DEFUN PPRINT-INSTANTIATE-CONCRETE-MAPPINGS
         (
          &KEY (ENCODINGS (HASH-TABLE-KEYS *ABSTRACT-MAPPINGS*))
          (OPTIMIZE '((DEBUG 3) (SAFETY 3))) (OCTET-SEQ-SETTER 'UB-SET)
          (OCTET-SEQ-GETTER 'UB-GET)
          (OCTET-SEQ-TYPE '(SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)))
          (CODE-POINT-SEQ-SETTER 'STRING-SET)
          (CODE-POINT-SEQ-GETTER 'STRING-GET)
          (CODE-POINT-SEQ-TYPE 'SIMPLE-UNICODE-STRING))
    (LET ((ENCODINGS (ENSURE-LIST ENCODINGS))
          (*PACKAGE* (FIND-PACKAGE :BABEL-ENCODINGS))
          (*PRINT-CASE* :DOWNCASE))
      (PPRINT
       (MACROEXPAND
        (ECLECTOR.READER:QUASIQUOTE
         (INSTANTIATE-CONCRETE-MAPPINGS :ENCODINGS
          (ECLECTOR.READER:UNQUOTE ENCODINGS) :OPTIMIZE
          (ECLECTOR.READER:UNQUOTE OPTIMIZE) :OCTET-SEQ-GETTER
          (ECLECTOR.READER:UNQUOTE OCTET-SEQ-GETTER) :OCTET-SEQ-SETTER
          (ECLECTOR.READER:UNQUOTE OCTET-SEQ-SETTER) :OCTET-SEQ-TYPE
          (ECLECTOR.READER:UNQUOTE OCTET-SEQ-TYPE) :CODE-POINT-SEQ-GETTER
          (ECLECTOR.READER:UNQUOTE CODE-POINT-SEQ-GETTER)
          :CODE-POINT-SEQ-SETTER
          (ECLECTOR.READER:UNQUOTE CODE-POINT-SEQ-SETTER) :CODE-POINT-SEQ-TYPE
          (ECLECTOR.READER:UNQUOTE CODE-POINT-SEQ-TYPE))))))
    (VALUES))

[babel/src/strings.lisp:251]
  (DEFUN STRING-TO-OCTETS
         (STRING
          &KEY (ENCODING *DEFAULT-CHARACTER-ENCODING*) (START 0) END
          (USE-BOM :DEFAULT) (ERRORP (NOT *SUPPRESS-CHARACTER-CODING-ERRORS*)))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 2)))
    (LET ((*SUPPRESS-CHARACTER-CODING-ERRORS* (NOT ERRORP)))
      (ETYPECASE STRING
        (SIMPLE-BASE-STRING
         (UNLESS END (SETF END (LENGTH STRING)))
         (CHECK-VECTOR-BOUNDS STRING START END)
         (LET* ((MAPPING
                 (LOOKUP-MAPPING *SIMPLE-BASE-STRING-VECTOR-MAPPINGS*
                  ENCODING))
                (BOM (BOM-VECTOR ENCODING USE-BOM))
                (BOM-LENGTH (LENGTH BOM))
                (RESULT
                 (MAKE-ARRAY
                  (+
                   (THE ARRAY-INDEX
                        (FUNCALL (THE FUNCTION (OCTET-COUNTER MAPPING)) STRING
                                 START END -1))
                   BOM-LENGTH)
                  :ELEMENT-TYPE '(UNSIGNED-BYTE 8))))
           (REPLACE RESULT BOM)
           (FUNCALL (THE FUNCTION (ENCODER MAPPING)) STRING START END RESULT
                    BOM-LENGTH)
           RESULT))
        (STRING
         (WITH-CHECKED-SIMPLE-VECTOR
          ((STRING (COERCE STRING 'UNICODE-STRING)) (START START) (END END))
          (DECLARE (TYPE SIMPLE-UNICODE-STRING STRING))
          (LET* ((MAPPING (LOOKUP-MAPPING *STRING-VECTOR-MAPPINGS* ENCODING))
                 (BOM (BOM-VECTOR ENCODING USE-BOM))
                 (BOM-LENGTH (LENGTH BOM))
                 (RESULT
                  (MAKE-ARRAY
                   (+
                    (THE ARRAY-INDEX
                         (FUNCALL (THE FUNCTION (OCTET-COUNTER MAPPING)) STRING
                                  START END -1))
                    BOM-LENGTH)
                   :ELEMENT-TYPE '(UNSIGNED-BYTE 8))))
            (REPLACE RESULT BOM)
            (FUNCALL (THE FUNCTION (ENCODER MAPPING)) STRING START END RESULT
                     BOM-LENGTH)
            RESULT))))))

[binascii/tests/rt.lisp:56]
  (DEFVAR *OPTIMIZATION-SETTINGS* '((SAFETY 3)))

[binascii/tests/tests.lisp:6]
  (DEFUN ASCII-STRING-TO-OCTETS (STRING &KEY (START 0) END)
    "Convert STRING to a (VECTOR (UNSIGNED-BYTE 8)).  It is an error if
STRING contains any character whose CHAR-CODE is greater than 255."
    (DECLARE (TYPE STRING STRING)
             (TYPE FIXNUM START)
             (TYPE (OR NULL FIXNUM) END)
             (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (LET* ((LENGTH (LENGTH STRING))
           (VEC (MAKE-ARRAY LENGTH :ELEMENT-TYPE '(UNSIGNED-BYTE 8)))
           (END (OR END LENGTH)))
      (LOOP FOR I FROM START BELOW
            END
            DO (LET ((BYTE (CHAR-CODE (CHAR STRING I))))
                 (UNLESS (< BYTE 256)
                   (ERROR "~A is not an ASCII character" (CHAR STRING I)))
                 (SETF (AREF VEC I) BYTE))
            FINALLY (RETURN VEC))))

[bit-smasher/src/conversion.lisp:20]
  (DEFUN HEX->BITS (X)
    "Return the bit-vector for hexadecimal string X."
    (LET ((RESULT (MAKE-ARRAY (* 4 (LENGTH X)) :ELEMENT-TYPE 'BIT)))
      (DECLARE (TYPE (SIMPLE-ARRAY BIT) RESULT)
               (TYPE STRING X))
      (LOOP FOR C ACROSS X
            FOR I FROM 0 BY 4
            FOR BV = (HEX-TO-BIT-LOOKUP/UNSAFE C)
            DO (LOCALLY
                (DECLARE (OPTIMIZE (SAFETY 0)))
                (REPLACE RESULT BV :START1 I)))
      RESULT))

[bit-smasher/src/core.lisp:33]
  (DEFUN HEXCHAR->INT (CHAR)
    "Return the bit vector associated with a hex-value character CHAR from *bit-map*."
    (DECLARE (OPTIMIZE (SPEED 2) (SAFETY 0)))
    (COND ((CHAR<= #\0 CHAR #\9) (- (CHAR-CODE CHAR) NIL))
          ((CHAR<= #\a CHAR #\f) (- (CHAR-CODE CHAR) NIL))
          (T (- (CHAR-CODE CHAR) NIL) (CHAR<= #\A CHAR #\F))))

[bit-smasher/src/core.lisp:43]
  (DEFUN HEX-TO-BIT-LOOKUP/UNSAFE (CHAR)
    "Return the bit vector associated with a hex-value character CHAR from *bit-map*."
    (DECLARE (OPTIMIZE (SPEED 2) (SAFETY 0)))
    (AREF *BIT-MAP* (HEXCHAR->INT CHAR)))

[bit-smasher/src/core.lisp:48]
  (DEFUN HEX-TO-BIT-LOOKUP (CHAR)
    "Return the bit vector associated with a hex-value character CHAR from *bit-map*."
    (DECLARE (OPTIMIZE (SPEED 2) (SAFETY 0)))
    (COPY-SEQ (HEX-TO-BIT-LOOKUP/UNSAFE CHAR)))

[bit-smasher/src/from-ironclad.lisp:27]
  (DEFUN BYTE-ARRAY-TO-HEX-STRING (VECTOR)
    "Return a string containing the hexadecimal representation of the
subsequence of VECTOR between START and END.  ELEMENT-TYPE controls
the element-type of the returned string."
    (DECLARE (TYPE (VECTOR (UNSIGNED-BYTE 8)) VECTOR))
    (LET* ((LENGTH (LENGTH VECTOR)) (HEXDIGITS NIL))
      (LOOP WITH STRING = (MAKE-STRING (* LENGTH 2) :ELEMENT-TYPE 'BASE-CHAR)
            FOR I FROM 0 BELOW LENGTH
            FOR J FROM 0 BY 2
            DO (LET ((BYTE (AREF VECTOR I)))
                 (DECLARE (OPTIMIZE (SAFETY 0)))
                 (SETF (AREF STRING J) (AREF HEXDIGITS (LDB (BYTE 4 4) BYTE))
                       (AREF STRING (1+ J))
                         (AREF HEXDIGITS (LDB (BYTE 4 0) BYTE))))
            FINALLY (RETURN STRING))))

[bknr-web/src/html-match/compiler.lisp:317]
  (DEFUN HPC-PATTERN-LAMBDA (PATTERN)
    (WITH-GENSYMS (INPUT BINDINGS)
     (ECLECTOR.READER:QUASIQUOTE
      (LAMBDA
          ((ECLECTOR.READER:UNQUOTE INPUT) (ECLECTOR.READER:UNQUOTE BINDINGS))
        (DECLARE (OPTIMIZE (SPEED 2) (SAFETY 0)))
        (ECLECTOR.READER:UNQUOTE (HPC PATTERN INPUT BINDINGS))))))

[black-tie/src/perlin-noise.lisp:71]
  (DEFUN FADE (V)
    (DECLARE (INLINE * + -)
             (OPTIMIZE (COMPILATION-SPEED 0) (DEBUG 0) (SAFETY 0) (SPACE 0)
              (SPEED 3))
             (TYPE FLOAT V))
    (* V V V (+ (* V (- (* V 6) 15)) 10)))

[black-tie/src/perlin-noise.lisp:79]
  (DEFUN GRAD (HASH X Y Z)
    (DECLARE (INLINE * + - < = LOGAND)
             (OPTIMIZE (COMPILATION-SPEED 0) (DEBUG 0) (SAFETY 0) (SPACE 0)
              (SPEED 3))
             (TYPE FIXNUM HASH)
             (TYPE FLOAT X Y Z))
    (LET* ((H (LOGAND HASH 15))
           (U
            (IF (< H 8)
                X
                Y))
           (V
            (IF (< H 4)
                Y
                (IF (OR (= H 12) (= H 14))
                    X
                    Z))))
      (+
       (IF (= (LOGAND H 1) 0)
           U
           (- U))
       (IF (= (LOGAND H 2) 0)
           V
           (- V)))))

[black-tie/src/perlin-noise.lisp:92]
  (DEFUN LERP (V A B)
    (DECLARE (INLINE * + -)
             (OPTIMIZE (COMPILATION-SPEED 0) (DEBUG 0) (SAFETY 0) (SPACE 0)
              (SPEED 3))
             (TYPE FLOAT V A B))
    (+ A (* V (- B A))))

[black-tie/src/perlin-noise.lisp:100]
  (DEFUN PERLIN-NOISE (X Y Z)
    (DECLARE (INLINE + - FADE FLOOR GRAD LERP LOGAND MOD SVREF)
             (OPTIMIZE (COMPILATION-SPEED 0) (DEBUG 0) (SAFETY 0) (SPACE 0)
              (SPEED 3))
             (TYPE FLOAT X Y Z))
    (LET* ((XC (LOGAND (THE FIXNUM (FLOOR X)) 255))
           (YC (LOGAND (THE FIXNUM (FLOOR Y)) 255))
           (ZC (LOGAND (THE FIXNUM (FLOOR Z)) 255))
           (X (MOD X 1))
           (Y (MOD Y 1))
           (Z (MOD Z 1))
           (U (FADE X))
           (V (FADE Y))
           (W (FADE Z))
           (A (+ (THE FIXNUM (SVREF +PNP+ XC)) YC))
           (AA (+ (THE FIXNUM (SVREF +PNP+ A)) ZC))
           (AB (+ (THE FIXNUM (SVREF +PNP+ (+ A 1))) ZC))
           (B (+ (THE FIXNUM (SVREF +PNP+ (+ XC 1))) YC))
           (BA (+ (THE FIXNUM (SVREF +PNP+ B)) ZC))
           (BB (+ (THE FIXNUM (SVREF +PNP+ (+ B 1))) ZC)))
      (LERP W
       (LERP V (LERP U (GRAD AA X Y Z) (GRAD BA (- X 1) Y Z))
        (LERP U (GRAD AB X (- Y 1) Z) (GRAD BB (- X 1) (- Y 1) Z)))
       (LERP V
        (LERP U (GRAD (+ AA 1) X Y (- Z 1)) (GRAD (+ BA 1) (- X 1) Y (- Z 1)))
        (LERP U (GRAD (+ AB 1) X (- Y 1) (- Z 1))
         (GRAD (+ BB 1) (- X 1) (- Y 1) (- Z 1)))))))

[black-tie/src/perlin-noise.lisp:133]
  (DEFUN FADE-SF (V)
    (DECLARE (INLINE * + -)
             (OPTIMIZE (COMPILATION-SPEED 0) (DEBUG 0) (SAFETY 0) (SPACE 0)
              (SPEED 3))
             (TYPE SINGLE-FLOAT V))
    (* V V V (+ (* V (- (* V 6) 15)) 10)))

[black-tie/src/perlin-noise.lisp:141]
  (DEFUN GRAD-SF (HASH X Y Z)
    (DECLARE (INLINE * + - < = LOGAND)
             (OPTIMIZE (COMPILATION-SPEED 0) (DEBUG 0) (SAFETY 0) (SPACE 0)
              (SPEED 3))
             (TYPE FIXNUM HASH)
             (TYPE SINGLE-FLOAT X Y Z))
    (LET* ((H (LOGAND HASH 15))
           (U
            (IF (< H 8)
                X
                Y))
           (V
            (IF (< H 4)
                Y
                (IF (OR (= H 12) (= H 14))
                    X
                    Z))))
      (+
       (IF (= (LOGAND H 1) 0)
           U
           (- U))
       (IF (= (LOGAND H 2) 0)
           V
           (- V)))))

[black-tie/src/perlin-noise.lisp:154]
  (DEFUN LERP-SF (V A B)
    (DECLARE (INLINE * + -)
             (OPTIMIZE (COMPILATION-SPEED 0) (DEBUG 0) (SAFETY 0) (SPACE 0)
              (SPEED 3))
             (TYPE SINGLE-FLOAT V A B))
    (+ A (* V (- B A))))

[black-tie/src/perlin-noise.lisp:162]
  (DEFUN PERLIN-NOISE-SINGLE-FLOAT (X Y Z)
    "X, Y and Z need to be SINGLE-FLOATS."
    (DECLARE (INLINE + - FADE-SF FLOOR GRAD-SF LERP-SF LOGAND MOD SVREF)
             (OPTIMIZE (COMPILATION-SPEED 0) (DEBUG 0) (SAFETY 0) (SPACE 0)
              (SPEED 3))
             (TYPE SINGLE-FLOAT X Y Z))
    (LET* ((XC (LOGAND (THE FIXNUM (FLOOR X)) 255))
           (YC (LOGAND (THE FIXNUM (FLOOR Y)) 255))
           (ZC (LOGAND (THE FIXNUM (FLOOR Z)) 255))
           (X (MOD X 1))
           (Y (MOD Y 1))
           (Z (MOD Z 1))
           (U (FADE-SF X))
           (V (FADE-SF Y))
           (W (FADE-SF Z))
           (A (+ (THE FIXNUM (SVREF +PNP+ XC)) YC))
           (AA (+ (THE FIXNUM (SVREF +PNP+ A)) ZC))
           (AB (+ (THE FIXNUM (SVREF +PNP+ (+ A 1))) ZC))
           (B (+ (THE FIXNUM (SVREF +PNP+ (+ XC 1))) YC))
           (BA (+ (THE FIXNUM (SVREF +PNP+ B)) ZC))
           (BB (+ (THE FIXNUM (SVREF +PNP+ (+ B 1))) ZC)))
      (LERP-SF W
       (LERP-SF V (LERP-SF U (GRAD-SF AA X Y Z) (GRAD-SF BA (- X 1) Y Z))
        (LERP-SF U (GRAD-SF AB X (- Y 1) Z) (GRAD-SF BB (- X 1) (- Y 1) Z)))
       (LERP-SF V
        (LERP-SF U (GRAD-SF (+ AA 1) X Y (- Z 1))
         (GRAD-SF (+ BA 1) (- X 1) Y (- Z 1)))
        (LERP-SF U (GRAD-SF (+ AB 1) X (- Y 1) (- Z 1))
         (GRAD-SF (+ BB 1) (- X 1) (- Y 1) (- Z 1)))))))

[black-tie/src/perlin-noise.lisp:199]
  (DEFUN PERLIN-NOISE-CLOSURE (&OPTIONAL (PRECISION 128))
    "Returns a closure which can be called just like PERLIN-NOISE-SINGLE-FLOAT.
  PRECISION will be used to determine the size of the precalculated perlin
  cube.  The higher the precision to more elements will be in the cube and
  the more precise it will be (and the more memory it will consume).
  The number of elements in the cube is determined as PRECISION^3.
  NOTE: This does not give the same results for the same inputs as
        PERLIN-NOISE!"
    (LET ((CUBE
           (MAKE-ARRAY (LIST PRECISION PRECISION PRECISION) :ELEMENT-TYPE
                       'SINGLE-FLOAT))
          (PRECISION (COERCE PRECISION 'SINGLE-FLOAT)))
      (WITH-3D
       (X (TRUNCATE PRECISION) Y (TRUNCATE PRECISION) Z (TRUNCATE PRECISION))
       (SETF (AREF CUBE X Y Z)
               (PERLIN-NOISE (COERCE (- (/ X (/ PRECISION 2)) 1) 'SINGLE-FLOAT)
                (COERCE (- (/ Y (/ PRECISION 2)) 1) 'SINGLE-FLOAT)
                (COERCE (- (/ Z (/ PRECISION 2)) 1) 'SINGLE-FLOAT))))
      (LAMBDA (X Y Z)
        (DECLARE (INLINE * AREF MOD TRUNCATE)
                 (OPTIMIZE (COMPILATION-SPEED 0) (DEBUG 0) (SAFETY 0) (SPACE 0)
                  (SPEED 3))
                 (TYPE SINGLE-FLOAT PRECISION X Y Z))
        (AREF CUBE (THE FIXNUM (TRUNCATE (* (MOD X 1) PRECISION)))
              (THE FIXNUM (TRUNCATE (* (MOD Y 1) PRECISION)))
              (THE FIXNUM (TRUNCATE (* (MOD Z 1) PRECISION)))))))

[black-tie/src/simplex-noise.lisp:32]
  (DEFUN SNGRAD1D (HASH X)
    (DECLARE (INLINE * + - = LOGAND)
             (OPTIMIZE (COMPILATION-SPEED 0) (DEBUG 0) (SAFETY 0) (SPACE 0)
              (SPEED 3))
             (TYPE FIXNUM HASH)
             (TYPE FLOAT X))
    (LET* ((H (LOGAND HASH 15)) (GRAD (+ 1.0 (LOGAND H 7))))
      (IF (= (LOGAND H 8) 0)
          (- (* GRAD X))
          (* GRAD X))))

[black-tie/src/simplex-noise.lisp:45]
  (DEFUN SNGRAD1D-SF (HASH X)
    (DECLARE (INLINE * + - = LOGAND)
             (OPTIMIZE (COMPILATION-SPEED 0) (DEBUG 0) (SAFETY 0) (SPACE 0)
              (SPEED 3))
             (TYPE FIXNUM HASH)
             (TYPE SINGLE-FLOAT X))
    (LET* ((H (LOGAND HASH 15)) (GRAD (+ 1.0 (LOGAND H 7))))
      (IF (= (LOGAND H 8) 0)
          (- (* GRAD X))
          (* GRAD X))))

[black-tie/src/simplex-noise.lisp:66]
  (DEFUN SNGRAD2D (HASH X Y)
    (DECLARE (INLINE * + - < = LOGAND)
             (OPTIMIZE (COMPILATION-SPEED 0) (DEBUG 0) (SAFETY 0) (SPACE 0)
              (SPEED 3))
             (TYPE FIXNUM HASH)
             (TYPE FLOAT X Y))
    (LET* ((H (LOGAND HASH 7))
           (U
            (IF (< H 4)
                X
                Y))
           (V
            (IF (< H 4)
                Y
                X)))
      (+
       (IF (= (LOGAND H 1) 0)
           (- U)
           U)
       (IF (= (LOGAND H 2) 0)
           (* -2.0 V)
           (* 2.0 V)))))

[black-tie/src/simplex-noise.lisp:79]
  (DEFUN SNGRAD2D-SF (HASH X Y)
    (DECLARE (INLINE * + - < = LOGAND)
             (OPTIMIZE (COMPILATION-SPEED 0) (DEBUG 0) (SAFETY 0) (SPACE 0)
              (SPEED 3))
             (TYPE FIXNUM HASH)
             (TYPE SINGLE-FLOAT X Y))
    (LET* ((H (LOGAND HASH 7))
           (U
            (IF (< H 4)
                X
                Y))
           (V
            (IF (< H 4)
                Y
                X)))
      (+
       (IF (= (LOGAND H 1) 0)
           (- U)
           U)
       (IF (= (LOGAND H 2) 0)
           (* -2.0 V)
           (* 2.0 V)))))

[black-tie/src/simplex-noise.lisp:100]
  (DEFUN SNGRAD3D (HASH X Y Z)
    (DECLARE (INLINE * + - < = LOGAND)
             (OPTIMIZE (COMPILATION-SPEED 0) (DEBUG 0) (SAFETY 0) (SPACE 0)
              (SPEED 3))
             (TYPE FIXNUM HASH)
             (TYPE FLOAT X Y))
    (LET* ((H (LOGAND HASH 15))
           (U
            (IF (< H 8)
                X
                Y))
           (V
            (IF (< H 4)
                Y
                (IF (OR (= H 12) (= H 14))
                    X
                    Z))))
      (+
       (IF (= (LOGAND H 1) 0)
           (- U)
           U)
       (IF (= (LOGAND H 2) 0)
           (- V)
           V))))

[black-tie/src/simplex-noise.lisp:113]
  (DEFUN SNGRAD3D-SF (HASH X Y Z)
    (DECLARE (INLINE * + - < = LOGAND)
             (OPTIMIZE (COMPILATION-SPEED 0) (DEBUG 0) (SAFETY 0) (SPACE 0)
              (SPEED 3))
             (TYPE FIXNUM HASH)
             (TYPE SINGLE-FLOAT X Y))
    (LET* ((H (LOGAND HASH 15))
           (U
            (IF (< H 8)
                X
                Y))
           (V
            (IF (< H 4)
                Y
                (IF (OR (= H 12) (= H 14))
                    X
                    Z))))
      (+
       (IF (= (LOGAND H 1) 0)
           (- U)
           U)
       (IF (= (LOGAND H 2) 0)
           (- V)
           V))))

[black-tie/src/simplex-noise.lisp:154]
  (DEFUN SIMPLEX-NOISE-1D (X)
    (DECLARE (INLINE * + - FLOOR LOGAND SNGRAD1D SVREF)
             (OPTIMIZE (COMPILATION-SPEED 0) (DEBUG 0) (SAFETY 0) (SPACE 0)
              (SPEED 3))
             (TYPE FLOAT X))
    (LET* ((I0 (FLOOR X))
           (I1 (+ I0 1))
           (X0 (- X I0))
           (X1 (- X0 1.0))
           (|1-X0^2| (- 1.0 (* X0 X0)))
           (T0 (* |1-X0^2| |1-X0^2|))
           (N0 (* T0 T0 (SNGRAD1D (SVREF +PNP+ (LOGAND I0 255)) X0)))
           (|1-X1^2| (- 1.0 (* X1 X1)))
           (T1 (* |1-X1^2| |1-X1^2|))
           (N1 (* T1 T1 (SNGRAD1D (SVREF +PNP+ (LOGAND I1 255)) X1))))
      (* 0.395 (+ N0 N1))))

[black-tie/src/simplex-noise.lisp:175]
  (DEFUN SIMPLEX-NOISE-1D-SINGLE-FLOAT (X)
    "SINGLE-FLOAT version of SIMPLEX-NOISE-1D which has less accuracy but is a
  lot faster and generally good enough unless you need the precision."
    (DECLARE (INLINE * + - FLOOR LOGAND SNGRAD1D-SF SVREF)
             (OPTIMIZE (COMPILATION-SPEED 0) (DEBUG 0) (SAFETY 0) (SPACE 0)
              (SPEED 3))
             (TYPE SINGLE-FLOAT X))
    (LET* ((I0 (THE FIXNUM (FLOOR X)))
           (X0 (THE SINGLE-FLOAT (- X I0)))
           (X1 (THE SINGLE-FLOAT (- X0 1.0)))
           (|1-X0^2| (THE SINGLE-FLOAT (- 1.0 (* X0 X0))))
           (T0 (THE SINGLE-FLOAT (* |1-X0^2| |1-X0^2|)))
           (|1-X1^2| (THE SINGLE-FLOAT (- 1.0 (* X1 X1))))
           (T1 (THE SINGLE-FLOAT (* |1-X1^2| |1-X1^2|))))
      (* 0.395
         (+
          (THE SINGLE-FLOAT
               (* T0 T0
                  (SNGRAD1D-SF (THE FIXNUM (SVREF +PNP+ (LOGAND I0 255))) X0)))
          (THE SINGLE-FLOAT
               (* T1 T1
                  (SNGRAD1D-SF (THE FIXNUM (SVREF +PNP+ (LOGAND (+ I0 1) 255)))
                   X1)))))))

[black-tie/src/simplex-noise.lisp:236]
  (DEFUN SIMPLEX-NOISE-2D (X Y)
    (DECLARE (INLINE * + - < > FLOOR MOD SNGRAD2D SVREF)
             (OPTIMIZE (COMPILATION-SPEED 0) (DEBUG 0) (SAFETY 0) (SPACE 0)
              (SPEED 3))
             (TYPE FLOAT X Y))
    (LET* ((S (* +F2+ (+ X Y)))
           (I (FLOOR (+ X S)))
           (J (FLOOR (+ Y S)))
           (TT (* +G2+ (+ I J)))
           (X0 (- X (- I TT)))
           (Y0 (- Y (- J TT)))
           (I1
            (IF (> X0 Y0)
                1
                0))
           (J1
            (IF (> X0 Y0)
                0
                1))
           (X1 (+ (- X0 I1) +G2+))
           (Y1 (+ (- Y0 J1) +G2+))
           (X2 (+ (- X0 1.0) +G2*2+))
           (Y2 (+ (- Y0 1.0) +G2*2+))
           (II (MOD I 256))
           (JJ (MOD J 256))
           (T0 (- 0.5 (* X0 X0) (* Y0 Y0)))
           (N0
            (IF (< T0 0.0)
                0.0
                (* T0 T0 T0 T0
                   (SNGRAD2D (SVREF +PNP+ (+ II (SVREF +PNP+ JJ))) X0 Y0))))
           (T1 (- 0.5 (* X1 X1) (* Y1 Y1)))
           (N1
            (IF (< T1 0.0)
                0.0
                (* T1 T1 T1 T1
                   (SNGRAD2D (SVREF +PNP+ (+ II I1 (SVREF +PNP+ (+ JJ J1)))) X1
                    Y1))))
           (T2 (- 0.5 (* X2 X2) (* Y2 Y2)))
           (N2
            (IF (< T2 0.0)
                0.0
                (* T2 T2 T2 T2
                   (SNGRAD2D (SVREF +PNP+ (+ II 1 (SVREF +PNP+ (+ JJ 1)))) X2
                    Y2)))))
      (* 40.0 (+ N0 N1 N2))))

[black-tie/src/simplex-noise.lisp:276]
  (DEFUN SIMPLEX-NOISE-2D-SINGLE-FLOAT (X Y)
    "SINGLE-FLOAT version of SIMPLEX-NOISE-2D which has less accuracy but is a
 lot faster and generally good enough unless you need the precision."
    (DECLARE (INLINE * + - < > FLOOR MOD SNGRAD2D-SF SVREF)
             (OPTIMIZE (COMPILATION-SPEED 0) (DEBUG 0) (SAFETY 0) (SPACE 0)
              (SPEED 3))
             (TYPE SINGLE-FLOAT X Y))
    (LET* ((S (THE SINGLE-FLOAT (* (THE SINGLE-FLOAT +F2+) (+ X Y))))
           (I (THE FIXNUM (FLOOR (+ X S))))
           (J (THE FIXNUM (FLOOR (+ Y S))))
           (TT
            (THE SINGLE-FLOAT
                 (* (THE SINGLE-FLOAT +G2+) (THE FIXNUM (+ I J)))))
           (X0 (THE SINGLE-FLOAT (- X (- I TT))))
           (Y0 (THE SINGLE-FLOAT (- Y (- J TT))))
           (I1
            (THE FIXNUM
                 (IF (> X0 Y0)
                     1
                     0)))
           (J1
            (THE FIXNUM
                 (IF (> X0 Y0)
                     0
                     1)))
           (X1 (THE SINGLE-FLOAT (+ (- X0 I1) (THE SINGLE-FLOAT +G2+))))
           (Y1 (THE SINGLE-FLOAT (+ (- Y0 J1) (THE SINGLE-FLOAT +G2+))))
           (X2 (THE SINGLE-FLOAT (+ (- X0 1.0) (THE SINGLE-FLOAT +G2*2+))))
           (Y2 (THE SINGLE-FLOAT (+ (- Y0 1.0) (THE SINGLE-FLOAT +G2*2+))))
           (II (THE FIXNUM (MOD I 256)))
           (JJ (THE FIXNUM (MOD J 256)))
           (T0 (THE SINGLE-FLOAT (- 0.5 (* X0 X0) (* Y0 Y0))))
           (T1 (THE SINGLE-FLOAT (- 0.5 (* X1 X1) (* Y1 Y1))))
           (T2 (THE SINGLE-FLOAT (- 0.5 (* X2 X2) (* Y2 Y2)))))
      (* 40.0
         (+
          (THE SINGLE-FLOAT
               (IF (< T0 0.0)
                   0.0
                   (* T0 T0 T0 T0
                      (SNGRAD2D-SF
                       (THE FIXNUM
                            (SVREF +PNP+ (+ II (THE FIXNUM (SVREF +PNP+ JJ)))))
                       X0 Y0))))
          (THE SINGLE-FLOAT
               (IF (< T1 0.0)
                   0.0
                   (* T1 T1 T1 T1
                      (SNGRAD2D-SF
                       (THE FIXNUM
                            (SVREF +PNP+
                                   (+ II I1
                                      (THE FIXNUM (SVREF +PNP+ (+ JJ J1))))))
                       X1 Y1))))
          (THE SINGLE-FLOAT
               (IF (< T2 0.0)
                   0.0
                   (* T2 T2 T2 T2
                      (SNGRAD2D-SF
                       (THE FIXNUM
                            (SVREF +PNP+
                                   (+ II 1
                                      (THE FIXNUM (SVREF +PNP+ (+ JJ 1))))))
                       X2 Y2))))))))

[black-tie/src/simplex-noise.lisp:385]
  (DEFUN SIMPLEX-NOISE-3D (X Y Z)
    (DECLARE (INLINE * + - < > FLOOR MOD SNGRAD3D SVREF)
             (OPTIMIZE (COMPILATION-SPEED 0) (DEBUG 0) (SAFETY 0) (SPACE 0)
              (SPEED 3))
             (TYPE FLOAT X Y Z))
    (LET* ((S (* +F3+ (+ X Y Z)))
           (XS (+ X S))
           (YS (+ Y S))
           (ZS (+ Z S))
           (I (FLOOR XS))
           (J (FLOOR YS))
           (K (FLOOR ZS))
           (TT (* +G3+ (+ I J K)))
           (X0 (- X (- I TT)))
           (Y0 (- Y (- J TT)))
           (Z0 (- Z (- K TT)))
           (I1
            (IF (>= X0 Y0)
                (IF (>= Y0 Z0)
                    1
                    (IF (>= X0 Z0)
                        1
                        0))
                (IF (< Y0 Z0)
                    0
                    (IF (< X0 Z0)
                        0
                        0))))
           (J1
            (IF (>= X0 Y0)
                (IF (>= Y0 Z0)
                    0
                    (IF (>= X0 Z0)
                        0
                        0))
                (IF (< Y0 Z0)
                    0
                    (IF (< X0 Z0)
                        1
                        1))))
           (K1
            (IF (>= X0 Y0)
                (IF (>= Y0 Z0)
                    0
                    (IF (>= X0 Z0)
                        0
                        1))
                (IF (< Y0 Z0)
                    1
                    (IF (< X0 Z0)
                        0
                        0))))
           (I2
            (IF (>= X0 Y0)
                (IF (>= Y0 Z0)
                    1
                    (IF (>= X0 Z0)
                        1
                        1))
                (IF (< Y0 Z0)
                    0
                    (IF (< X0 Z0)
                        0
                        1))))
           (J2
            (IF (>= X0 Y0)
                (IF (>= Y0 Z0)
                    1
                    (IF (>= X0 Z0)
                        0
                        0))
                (IF (< Y0 Z0)
                    1
                    (IF (< X0 Z0)
                        1
                        1))))
           (K2
            (IF (>= X0 Y0)
                (IF (>= Y0 Z0)
                    0
                    (IF (>= X0 Z0)
                        1
                        1))
                (IF (< Y0 Z0)
                    1
                    (IF (< X0 Z0)
                        1
                        0))))
           (X1 (+ (- X0 I1) +G3+))
           (Y1 (+ (- Y0 J1) +G3+))
           (Z1 (+ (- Z0 K1) +G3+))
           (X2 (+ (- X0 I2) (* 2.0 +G3+)))
           (Y2 (+ (- Y0 J2) (* 2.0 +G3+)))
           (Z2 (+ (- Z0 K2) (* 2.0 +G3+)))
           (X3 (+ (- X0 1.0) (* 3.0 +G3+)))
           (Y3 (+ (- Y0 1.0) (* 3.0 +G3+)))
           (Z3 (+ (- Z0 1.0) (* 3.0 +G3+)))
           (II (MOD I 256))
           (JJ (MOD J 256))
           (KK (MOD K 256))
           (T0
            (IF (< (- 0.6 (* X0 X0) (* Y0 Y0) (* Z0 Z0)) 0.0)
                (- 0.6 (* X0 X0) (* Y0 Y0) (* Z0 Z0))
                (* (- 0.6 (* X0 X0) (* Y0 Y0) (* Z0 Z0))
                   (- 0.6 (* X0 X0) (* Y0 Y0) (* Z0 Z0)))))
           (N0
            (IF (< (- 0.6 (* X0 X0) (* Y0 Y0) (* Z0 Z0)) 0.0)
                0.0
                (* T0 T0
                   (SNGRAD3D
                    (SVREF +PNP+ (+ II (SVREF +PNP+ (+ JJ (SVREF +PNP+ KK)))))
                    X0 Y0 Z0))))
           (T1
            (IF (< (- 0.6 (* X1 X1) (* Y1 Y1) (* Z1 Z1)) 0.0)
                (- 0.6 (* X1 X1) (* Y1 Y1) (* Z1 Z1))
                (* (- 0.6 (* X1 X1) (* Y1 Y1) (* Z1 Z1))
                   (- 0.6 (* X1 X1) (* Y1 Y1) (* Z1 Z1)))))
           (N1
            (IF (< (- 0.6 (* X1 X1) (* Y1 Y1) (* Z1 Z1)) 0.0)
                0.0
                (* T1 T1
                   (SNGRAD3D
                    (SVREF +PNP+
                           (+ II I1
                              (SVREF +PNP+ (+ JJ J1 (SVREF +PNP+ (+ KK K1))))))
                    X1 Y1 Z1))))
           (T2
            (IF (< (- 0.6 (* X2 X2) (* Y2 Y2) (* Z2 Z2)) 0.0)
                (- 0.6 (* X2 X2) (* Y2 Y2) (* Z2 Z2))
                (* (- 0.6 (* X2 X2) (* Y2 Y2) (* Z2 Z2))
                   (- 0.6 (* X2 X2) (* Y2 Y2) (* Z2 Z2)))))
           (N2
            (IF (< (- 0.6 (* X2 X2) (* Y2 Y2) (* Z2 Z2)) 0.0)
                0.0
                (* T2 T2
                   (SNGRAD3D
                    (SVREF +PNP+
                           (+ II I2
                              (SVREF +PNP+ (+ JJ J2 (SVREF +PNP+ (+ KK K2))))))
                    X2 Y2 Z2))))
           (T3
            (IF (< (- 0.6 (* X3 X3) (* Y3 Y3) (* Z3 Z3)) 0.0)
                (- 0.6 (* X3 X3) (* Y3 Y3) (* Z3 Z3))
                (* (- 0.6 (* X3 X3) (* Y3 Y3) (* Z3 Z3))
                   (- 0.6 (* X3 X3) (* Y3 Y3) (* Z3 Z3)))))
           (N3
            (IF (< (- 0.6 (* X3 X3) (* Y3 Y3) (* Z3 Z3)) 0.0)
                0.0
                (* T3 T3
                   (SNGRAD3D
                    (SVREF +PNP+
                           (+ II 1
                              (SVREF +PNP+ (+ JJ 1 (SVREF +PNP+ (+ KK 1))))))
                    X3 Y3 Z3)))))
      (* 32.0 (+ N0 N1 N2 N3))))

[black-tie/src/simplex-noise.lisp:462]
  (DEFUN SIMPLEX-NOISE-3D-SINGLE-FLOAT (X Y Z)
    "SINGLE-FLOAT version of SIMPLEX-NOISE-3D which has less accuracy but is a
  lot faster and generally good enough unless you need the precision."
    (DECLARE (INLINE * + - < > FLOOR MOD SNGRAD3D-SF SVREF)
             (OPTIMIZE (COMPILATION-SPEED 0) (DEBUG 0) (SAFETY 0) (SPACE 0)
              (SPEED 3))
             (TYPE SINGLE-FLOAT X Y Z))
    (LET* ((S (THE SINGLE-FLOAT (* (THE SINGLE-FLOAT +F3+) (+ X Y Z))))
           (I (THE FIXNUM (FLOOR (+ X S))))
           (J (THE FIXNUM (FLOOR (+ Y S))))
           (K (THE FIXNUM (FLOOR (+ Z S))))
           (TT
            (THE SINGLE-FLOAT
                 (* (THE SINGLE-FLOAT +G3+) (THE FIXNUM (+ I J K)))))
           (X0 (THE SINGLE-FLOAT (- X (- I TT))))
           (Y0 (THE SINGLE-FLOAT (- Y (- J TT))))
           (Z0 (THE SINGLE-FLOAT (- Z (- K TT))))
           (I1 (THE FIXNUM 0))
           (J1 (THE FIXNUM 0))
           (K1 (THE FIXNUM 0))
           (I2 (THE FIXNUM 0))
           (J2 (THE FIXNUM 0))
           (K2 (THE FIXNUM 0)))
      (IF (>= X0 Y0)
          (IF (>= Y0 Z0)
              (SETF I1 1
                    I2 1
                    J2 1)
              (IF (>= X0 Z0)
                  (SETF I1 1
                        I2 1
                        K2 1)
                  (SETF K1 1
                        I2 1
                        K2 1)))
          (IF (< Y0 Z0)
              (SETF K1 1
                    J2 1
                    K2 1)
              (IF (< X0 Z0)
                  (SETF J1 1
                        J2 1
                        K2 1)
                  (SETF J1 1
                        I2 1
                        J2 1))))
      (LET* ((X1 (THE SINGLE-FLOAT (+ (- X0 I1) (THE SINGLE-FLOAT +G3+))))
             (Y1 (THE SINGLE-FLOAT (+ (- Y0 J1) (THE SINGLE-FLOAT +G3+))))
             (Z1 (THE SINGLE-FLOAT (+ (- Z0 K1) (THE SINGLE-FLOAT +G3+))))
             (X2 (THE SINGLE-FLOAT (+ (- X0 I2) (THE SINGLE-FLOAT +G3*2+))))
             (Y2 (THE SINGLE-FLOAT (+ (- Y0 J2) (THE SINGLE-FLOAT +G3*2+))))
             (Z2 (THE SINGLE-FLOAT (+ (- Z0 K2) (THE SINGLE-FLOAT +G3*2+))))
             (X3 (THE SINGLE-FLOAT (+ (- X0 1.0) (THE SINGLE-FLOAT +G3*3+))))
             (Y3 (THE SINGLE-FLOAT (+ (- Y0 1.0) (THE SINGLE-FLOAT +G3*3+))))
             (Z3 (THE SINGLE-FLOAT (+ (- Z0 1.0) (THE SINGLE-FLOAT +G3*3+))))
             (II (THE FIXNUM (MOD I 256)))
             (JJ (THE FIXNUM (MOD J 256)))
             (KK (THE FIXNUM (MOD K 256)))
             (T0 (THE SINGLE-FLOAT (- 0.6 (* X0 X0) (* Y0 Y0) (* Z0 Z0))))
             (T1 (THE SINGLE-FLOAT (- 0.6 (* X1 X1) (* Y1 Y1) (* Z1 Z1))))
             (T2 (THE SINGLE-FLOAT (- 0.6 (* X2 X2) (* Y2 Y2) (* Z2 Z2))))
             (T3 (THE SINGLE-FLOAT (- 0.6 (* X3 X3) (* Y3 Y3) (* Z3 Z3)))))
        (* 32.0
           (+
            (THE SINGLE-FLOAT
                 (IF (< T0 0.0)
                     0.0
                     (* T0 T0 T0 T0
                        (THE SINGLE-FLOAT
                             (SNGRAD3D-SF
                              (THE FIXNUM
                                   (SVREF +PNP+
                                          (+ II
                                             (THE FIXNUM
                                                  (SVREF +PNP+
                                                         (+ JJ
                                                            (THE FIXNUM
                                                                 (SVREF +PNP+
                                                                        KK))))))))
                              X0 Y0 Z0)))))
            (THE SINGLE-FLOAT
                 (IF (< T1 0.0)
                     0.0
                     (* T1 T1 T1 T1
                        (THE SINGLE-FLOAT
                             (SNGRAD3D-SF
                              (THE FIXNUM
                                   (SVREF +PNP+
                                          (+ II I1
                                             (THE FIXNUM
                                                  (SVREF +PNP+
                                                         (+ JJ J1
                                                            (THE FIXNUM
                                                                 (SVREF +PNP+
                                                                        (+ KK
                                                                           K1)))))))))
                              X1 Y1 Z1)))))
            (THE SINGLE-FLOAT
                 (IF (< T2 0.0)
                     0.0
                     (* T2 T2 T2 T2
                        (THE SINGLE-FLOAT
                             (SNGRAD3D-SF
                              (THE FIXNUM
                                   (SVREF +PNP+
                                          (+ II I2
                                             (THE FIXNUM
                                                  (SVREF +PNP+
                                                         (+ JJ J2
                                                            (THE FIXNUM
                                                                 (SVREF +PNP+
                                                                        (+ KK
                                                                           K2)))))))))
                              X2 Y2 Z2)))))
            (THE SINGLE-FLOAT
                 (IF (< T3 0.0)
                     0.0
                     (* T3 T3 T3 T3
                        (THE SINGLE-FLOAT
                             (SNGRAD3D-SF
                              (THE FIXNUM
                                   (SVREF +PNP+
                                          (+ II 1
                                             (THE FIXNUM
                                                  (SVREF +PNP+
                                                         (+ JJ 1
                                                            (THE FIXNUM
                                                                 (SVREF +PNP+
                                                                        (+ KK
                                                                           1)))))))))
                              X3 Y3 Z3))))))))))

[bordeaux-threads/apiv2/atomics-java.lisp:26]
  (DEFUN ATOMIC-INTEGER-CAS (ATOMIC-INTEGER OLD NEW)
    (DECLARE (TYPE ATOMIC-INTEGER ATOMIC-INTEGER)
             (TYPE %ATOMIC-INTEGER-VALUE OLD NEW)
             (OPTIMIZE (SAFETY 0) (SPEED 3)))
    (JCALL +ATOMIC-LONG-CAS+ (ATOMIC-INTEGER-CELL ATOMIC-INTEGER) OLD NEW))

[bordeaux-threads/apiv2/atomics-java.lisp:37]
  (DEFUN ATOMIC-INTEGER-DECF (ATOMIC-INTEGER &OPTIONAL (DELTA 1))
    (DECLARE (TYPE ATOMIC-INTEGER ATOMIC-INTEGER)
             (TYPE %ATOMIC-INTEGER-VALUE DELTA)
             (OPTIMIZE (SAFETY 0) (SPEED 3)))
    (LET ((INCREMENT (- DELTA)))
      (+
       (JCALL +ATOMIC-LONG-INCF+ (ATOMIC-INTEGER-CELL ATOMIC-INTEGER)
        INCREMENT)
       INCREMENT)))

[bordeaux-threads/apiv2/atomics-java.lisp:46]
  (DEFUN ATOMIC-INTEGER-INCF (ATOMIC-INTEGER &OPTIONAL (DELTA 1))
    (DECLARE (TYPE ATOMIC-INTEGER ATOMIC-INTEGER)
             (TYPE %ATOMIC-INTEGER-VALUE DELTA)
             (OPTIMIZE (SAFETY 0) (SPEED 3)))
    (+ (JCALL +ATOMIC-LONG-INCF+ (ATOMIC-INTEGER-CELL ATOMIC-INTEGER) DELTA)
       DELTA))

[bordeaux-threads/apiv2/atomics-java.lisp:57]
  (DEFUN ATOMIC-INTEGER-VALUE (ATOMIC-INTEGER)
    (DECLARE (TYPE ATOMIC-INTEGER ATOMIC-INTEGER)
             (OPTIMIZE (SAFETY 0) (SPEED 3)))
    (JCALL +ATOMIC-LONG-GET+ (ATOMIC-INTEGER-CELL ATOMIC-INTEGER)))

[bordeaux-threads/apiv2/atomics-java.lisp:66]
  (DEFUN (SETF ATOMIC-INTEGER-VALUE) (NEWVAL ATOMIC-INTEGER)
    (DECLARE (TYPE ATOMIC-INTEGER ATOMIC-INTEGER)
             (TYPE %ATOMIC-INTEGER-VALUE NEWVAL)
             (OPTIMIZE (SAFETY 0) (SPEED 3)))
    (JCALL +ATOMIC-LONG-SET+ (ATOMIC-INTEGER-CELL ATOMIC-INTEGER) NEWVAL)
    NEWVAL)

[bordeaux-threads/apiv2/atomics.lisp:76]
  (DEFUN ATOMIC-INTEGER-CAS (ATOMIC-INTEGER OLD NEW)
    "If the current value of `ATOMIC-INTEGER` is equal to `OLD`, replace
it with `NEW`.

Returns T if the replacement was successful, otherwise NIL."
    (DECLARE (TYPE ATOMIC-INTEGER ATOMIC-INTEGER)
             (TYPE %ATOMIC-INTEGER-VALUE OLD NEW)
             (OPTIMIZE (SAFETY 0) (SPEED 3)))
    (%WITH-LOCK ((ATOMIC-INTEGER-%LOCK ATOMIC-INTEGER) NIL)
     (COND
      ((= OLD (SLOT-VALUE ATOMIC-INTEGER 'CELL))
       (SETF (SLOT-VALUE ATOMIC-INTEGER 'CELL) NEW) T)
      (T NIL))))

[bordeaux-threads/apiv2/atomics.lisp:96]
  (DEFUN ATOMIC-INTEGER-DECF (ATOMIC-INTEGER &OPTIONAL (DELTA 1))
    "Decrements the value of `ATOMIC-INTEGER` by `DELTA`.

Returns the new value of `ATOMIC-INTEGER`."
    (DECLARE (TYPE ATOMIC-INTEGER ATOMIC-INTEGER)
             (TYPE %ATOMIC-INTEGER-VALUE DELTA)
             (OPTIMIZE (SAFETY 0) (SPEED 3)))
    (%WITH-LOCK ((ATOMIC-INTEGER-%LOCK ATOMIC-INTEGER) NIL)
     (DECF (ATOMIC-INTEGER-CELL ATOMIC-INTEGER) DELTA)))

[bordeaux-threads/apiv2/atomics.lisp:111]
  (DEFUN ATOMIC-INTEGER-INCF (ATOMIC-INTEGER &OPTIONAL (DELTA 1))
    "Increments the value of `ATOMIC-INTEGER` by `DELTA`.

Returns the new value of `ATOMIC-INTEGER`."
    (DECLARE (TYPE ATOMIC-INTEGER ATOMIC-INTEGER)
             (TYPE %ATOMIC-INTEGER-VALUE DELTA)
             (OPTIMIZE (SAFETY 0) (SPEED 3)))
    (%WITH-LOCK ((ATOMIC-INTEGER-%LOCK ATOMIC-INTEGER) NIL)
     (INCF (ATOMIC-INTEGER-CELL ATOMIC-INTEGER) DELTA)))

[bordeaux-threads/apiv2/atomics.lisp:126]
  (DEFUN ATOMIC-INTEGER-VALUE (ATOMIC-INTEGER)
    "Returns the current value of `ATOMIC-INTEGER`."
    (DECLARE (TYPE ATOMIC-INTEGER ATOMIC-INTEGER)
             (OPTIMIZE (SAFETY 0) (SPEED 3)))
    (%WITH-LOCK ((ATOMIC-INTEGER-%LOCK ATOMIC-INTEGER) NIL)
     (ATOMIC-INTEGER-CELL ATOMIC-INTEGER)))

[bordeaux-threads/apiv2/atomics.lisp:138]
  (DEFUN (SETF ATOMIC-INTEGER-VALUE) (NEWVAL ATOMIC-INTEGER)
    (DECLARE (TYPE ATOMIC-INTEGER ATOMIC-INTEGER)
             (TYPE %ATOMIC-INTEGER-VALUE NEWVAL)
             (OPTIMIZE (SAFETY 0) (SPEED 3)))
    (%WITH-LOCK ((ATOMIC-INTEGER-%LOCK ATOMIC-INTEGER) NIL)
     (SETF (ATOMIC-INTEGER-CELL ATOMIC-INTEGER) NEWVAL)))

[cambl/cambl.lisp:263]
  (DECLAIM (OPTIMIZE (DEBUG 3) (SAFETY 3) (SPEED 1) (SPACE 0)))

[cambl/cambl.lisp:966]
  (DEFUN VALUE-ROUND (AMOUNT &OPTIONAL PRECISION)
    "Round the given AMOUNT to the stated PRECISION.

  If PRECISION is less than the current internal precision, data will be lost.
If it is greater, this operation has no effect."
    (DECLARE (TYPE (OR FIXNUM+ NULL) PRECISION))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((DIVISOR
           (AND PRECISION
                (/ 1 (THE FIXNUM+ (EXPT 10 (THE FIXNUM+ PRECISION)))))))
      (ETYPECASE AMOUNT
        (RATIONAL
         (IF DIVISOR
             (* (ROUND AMOUNT DIVISOR) DIVISOR)
             AMOUNT))
        (AMOUNT
         (UNLESS DIVISOR
           (SETF DIVISOR
                   (/ 1
                      (THE FIXNUM+
                           (EXPT 10
                                 (THE FIXNUM+
                                      (DISPLAY-PRECISION
                                       (AMOUNT-COMMODITY AMOUNT))))))))
         (MAKE-AMOUNT :COMMODITY (AMOUNT-COMMODITY AMOUNT) :QUANTITY
          (* (ROUND (AMOUNT-QUANTITY AMOUNT) DIVISOR) DIVISOR) :FULL-PRECISION
          (OR PRECISION (DISPLAY-PRECISION (AMOUNT-COMMODITY AMOUNT)))
          :KEEP-PRECISION-P (AMOUNT-KEEP-PRECISION-P AMOUNT))))))

[cambl/cambl.lisp:1074]
  (DEFUN READ-AMOUNT-QUANTITY (IN)
    (DECLARE (TYPE STREAM IN))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (WITH-OUTPUT-TO-STRING (BUF NIL :ELEMENT-TYPE 'BASE-CHAR)
      (LET (LAST-SPECIAL)
        (LOOP FOR C = (READ-CHAR IN NIL)
              WHILE C
              DO (IF (DIGIT-CHAR-P C)
                     (PROGN
                      (WHEN LAST-SPECIAL
                        (WRITE-CHAR LAST-SPECIAL BUF)
                        (SETF LAST-SPECIAL NIL))
                      (WRITE-CHAR C BUF))
                     (IF (AND (NULL LAST-SPECIAL)
                              (OR (CHAR= C #\-) (CHAR= C #\.) (CHAR= C #\,)))
                         (SETF LAST-SPECIAL C)
                         (PROGN (UNREAD-CHAR C IN) (RETURN)))))
        (IF LAST-SPECIAL
            (UNREAD-CHAR LAST-SPECIAL IN)))))

[cambl/cambl.lisp:1098]
  (DEFUN PEEK-CHAR-IN-LINE (IN &OPTIONAL SKIP-WHITESPACE)
    (DECLARE (TYPE STREAM IN))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LOOP FOR C = (PEEK-CHAR NIL IN NIL)
          WHILE (AND C (CHAR/= C #\Newline))
          DO (IF (AND SKIP-WHITESPACE (OR (CHAR= #\  C) (CHAR= #\Tab C)))
                 (READ-CHAR IN)
                 (RETURN C))))

[cambl/cambl.lisp:1113]
  (DEFUN READ-UNTIL (IN CHAR &OPTIONAL ERROR-MESSAGE)
    (DECLARE (TYPE STREAM IN))
    (DECLARE (TYPE CHARACTER CHAR))
    (DECLARE (TYPE (OR STRING NULL) ERROR-MESSAGE))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (WITH-OUTPUT-TO-STRING (TEXT)
      (LOOP FOR C = (READ-CHAR IN NIL)
            WHILE (IF C
                      (CHAR/= CHAR C)
                      (IF ERROR-MESSAGE
                          (ERROR 'AMOUNT-ERROR :MSG ERROR-MESSAGE)))
            DO (WRITE-CHAR C TEXT))))

[cambl/cambl.lisp:1282]
  (DEFUN READ-AMOUNT
         (IN &KEY (OBSERVE-PROPERTIES-P T) (POOL *DEFAULT-COMMODITY-POOL*))
    "Parse an AMOUNT from the input stream IN.

  If :OBSERVE-PROPERTIES-P is T (the default), any display details noticed in
this amount will be set as defaults for displaying this kind of commodity in
the future.

  If :POOL is set, any commodities created by this routine (a maximum possible
of two, if an annotated price is given with a second commodity) will be
associated with the given commodity pool.

  The possible syntax for an amount is:

  [-]NUM[ ]SYM [ANNOTATION]
  SYM[ ][-]NUM [ANNOTATION]"
    (DECLARE (TYPE STREAM IN))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((CONNECTED-P T)
          (PREFIXED-P T)
          SYMBOL
          QUANTITY
          DETAILS
          NEGATIVE-P
          THOUSAND-MARKS-P
          EUROPEAN-STYLE-P)
      (WHEN (CHAR= #\- (PEEK-CHAR-IN-LINE IN T))
        (SETF NEGATIVE-P T)
        (READ-CHAR IN))
      (IF (DIGIT-CHAR-P (PEEK-CHAR-IN-LINE IN T))
          (PROGN
           (SETF QUANTITY (THE SIMPLE-STRING (READ-AMOUNT-QUANTITY IN)))
           (LET ((C (PEEK-CHAR-IN-LINE IN)))
             (IF (AND (CHARACTERP C) (CHAR= #\  C))
                 (SETF CONNECTED-P NIL))
             (LET ((N (PEEK-CHAR-IN-LINE IN T)))
               (WHEN (AND (CHARACTERP N) (NOT (CHAR= #\Newline N)))
                 (SETF SYMBOL (READ-COMMODITY-SYMBOL IN))
                 (IF SYMBOL
                     (SETF PREFIXED-P NIL))))))
          (PROGN
           (SETF SYMBOL (READ-COMMODITY-SYMBOL IN))
           (IF (CHAR= #\  (PEEK-CHAR NIL IN))
               (SETF CONNECTED-P NIL))
           (LET ((N (PEEK-CHAR-IN-LINE IN T)))
             (IF (AND (CHARACTERP N) (NOT (CHAR= #\Newline N)))
                 (SETF QUANTITY (THE SIMPLE-STRING (READ-AMOUNT-QUANTITY IN)))
                 (ERROR 'AMOUNT-ERROR :MSG
                        "No quantity specified for amount")))))
      (LET ((C (PEEK-CHAR-IN-LINE IN T)))
        (IF (AND (CHARACTERP C) (OR (CHAR= C #\{) (CHAR= C #\[) (CHAR= C #\()))
            (SETF DETAILS (READ-COMMODITY-ANNOTATION IN))))
      (MULTIPLE-VALUE-BIND (COMMODITY NEWLY-CREATED-P)
          (IF (AND SYMBOL
                   (NOT (ZEROP (LENGTH (COMMODITY-SYMBOL-NAME SYMBOL)))))
              (IF DETAILS
                  (FIND-ANNOTATED-COMMODITY SYMBOL DETAILS :POOL POOL
                   :CREATE-IF-NOT-EXISTS-P T)
                  (FIND-COMMODITY SYMBOL :POOL POOL :CREATE-IF-NOT-EXISTS-P T))
              (VALUES NIL NIL))
        (WHEN (AND COMMODITY OBSERVE-PROPERTIES-P)
          (SETF EUROPEAN-STYLE-P (COMMODITY-EUROPEAN-STYLE-P COMMODITY)))
        (LET* ((LAST-COMMA
                (LOCALLY
                 (DECLARE (MUFFLE-CONDITIONS COMPILER-NOTE))
                 (POSITION #\, QUANTITY :FROM-END T)))
               (LAST-PERIOD
                (LOCALLY
                 (DECLARE (MUFFLE-CONDITIONS COMPILER-NOTE))
                 (POSITION #\. QUANTITY :FROM-END T)))
               (LENGTH (LENGTH QUANTITY))
               (PRECISION
                (COND
                 ((AND LAST-COMMA LAST-PERIOD)
                  (LET ((INDEX (MAX LAST-COMMA LAST-PERIOD)))
                    (WHEN (= INDEX LAST-COMMA) (SETF EUROPEAN-STYLE-P T))
                    (- LENGTH INDEX 1)))
                 ((AND LAST-COMMA
                       (OR EUROPEAN-STYLE-P (/= (- LENGTH LAST-COMMA 1) 3)))
                  (SETF EUROPEAN-STYLE-P T) (- LENGTH LAST-COMMA 1))
                 ((AND LAST-PERIOD
                       (OR (NOT EUROPEAN-STYLE-P)
                           (/= (- LENGTH LAST-PERIOD 1) 3)))
                  (- LENGTH LAST-PERIOD 1))
                 (T 0)))
               (DENOMINATOR (THE INTEGER (EXPT 10 (THE FIXNUM+ PRECISION))))
               (QUANTITY
                (/
                 (PARSE-INTEGER
                  (DELETE-IF #'(LAMBDA (C) (OR (CHAR= #\. C) (CHAR= #\, C)))
                             QUANTITY))
                 DENOMINATOR)))
          (WHEN
              (OR (AND LAST-PERIOD EUROPEAN-STYLE-P)
                  (AND LAST-COMMA (NOT EUROPEAN-STYLE-P)))
            (SETF THOUSAND-MARKS-P T))
          (IF NEGATIVE-P
              (SETF QUANTITY (- QUANTITY)))
          (IF COMMODITY
              (PROGN
               (WHEN (OR NEWLY-CREATED-P OBSERVE-PROPERTIES-P)
                 (LET ((BASE-COMMODITY
                        (IF (ANNOTATED-COMMODITY-P COMMODITY)
                            (GET-REFERENT COMMODITY)
                            COMMODITY)))
                   (SETF (COMMODITY-SYMBOL-PREFIXED-P
                          (GET-SYMBOL BASE-COMMODITY))
                           PREFIXED-P)
                   (SETF (COMMODITY-SYMBOL-CONNECTED-P
                          (GET-SYMBOL BASE-COMMODITY))
                           CONNECTED-P)
                   (IF THOUSAND-MARKS-P
                       (SETF (GET-THOUSAND-MARKS-P BASE-COMMODITY)
                               THOUSAND-MARKS-P))
                   (WHEN EUROPEAN-STYLE-P
                     (SETF (GET-EUROPEAN-STYLE-P BASE-COMMODITY)
                             EUROPEAN-STYLE-P))
                   (IF (> PRECISION
                          (THE FIXNUM+ (GET-DISPLAY-PRECISION BASE-COMMODITY)))
                       (SETF (GET-DISPLAY-PRECISION BASE-COMMODITY)
                               PRECISION))))
               (MAKE-AMOUNT :COMMODITY COMMODITY :QUANTITY QUANTITY
                :FULL-PRECISION PRECISION))
              QUANTITY)))))

[cambl/cambl.lisp:1845]
  (DEFMETHOD PRINT-VALUE
             ((AMOUNT AMOUNT)
              &KEY (OUTPUT-STREAM *STANDARD-OUTPUT*) (OMIT-COMMODITY-P NIL)
              (FULL-PRECISION-P NIL) (WIDTH NIL) LATTER-WIDTH LINE-FEED-STRING)
    (DECLARE (TYPE STREAM OUTPUT-STREAM))
    (DECLARE (TYPE BOOLEAN OMIT-COMMODITY-P))
    (DECLARE (TYPE BOOLEAN FULL-PRECISION-P))
    (DECLARE (TYPE (OR FIXNUM NULL) WIDTH))
    (DECLARE (IGNORE LATTER-WIDTH LINE-FEED-STRING))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET* ((COMMODITY (AMOUNT-COMMODITY AMOUNT))
           (COMMODITY-SYMBOL
            (AND (NOT OMIT-COMMODITY-P) (COMMODITY-SYMBOL COMMODITY)))
           (DISPLAY-PRECISION
            (IF (OR FULL-PRECISION-P (AMOUNT-KEEP-PRECISION-P AMOUNT))
                (AMOUNT-PRECISION AMOUNT)
                (DISPLAY-PRECISION COMMODITY))))
      (IF WIDTH
          (FORMAT OUTPUT-STREAM "~v@A" WIDTH
                  (WITH-OUTPUT-TO-STRING (BUFFER)
                    (PRINT-VALUE-TO-STRING COMMODITY COMMODITY-SYMBOL
                     (AMOUNT-QUANTITY AMOUNT) DISPLAY-PRECISION BUFFER)))
          (PRINT-VALUE-TO-STRING COMMODITY COMMODITY-SYMBOL
           (AMOUNT-QUANTITY AMOUNT) DISPLAY-PRECISION OUTPUT-STREAM))))

[cambl/cambl.lisp:1953]
  (DEFUN SYMBOL-CHAR-INVALID-P (C)
    (DECLARE (TYPE CHARACTER C))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((CODE (CHAR-CODE C)))
      (AND (< CODE 256)
           (AREF (THE (SIMPLE-ARRAY BOOLEAN (256)) *INVALID-SYMBOL-CHARS*)
                 CODE))))

[cambl/cambl.lisp:1962]
  (DEFUN SYMBOL-NAME-NEEDS-QUOTING-P (NAME)
    "Return T if the given symbol NAME requires quoting."
    (DECLARE (TYPE STRING NAME))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LOOP FOR C ACROSS (THE SIMPLE-STRING NAME)
          DO (IF (SYMBOL-CHAR-INVALID-P C)
                 (RETURN T))))

[cambl/cambl.lisp:1977]
  (DEFUN READ-COMMODITY-SYMBOL (IN)
    "Parse a commodity symbol from the input stream IN.

  This is the correct entry point for creating a new commodity symbol.

  A commodity contain any character not found in *INVALID-SYMBOL-CHARS*.  To
include such characters in a symbol name---except for #\\\", which may never
appear in a symbol name---surround the commodity name with double quotes.  It
is an error if EOF is reached without reading the ending double quote.  If the
symbol name is not quoted, and an invalid character is reading, reading from
the stream stops and the invalid character is put back."
    (DECLARE (TYPE STREAM IN))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((BUF (MAKE-STRING-OUTPUT-STREAM)) NEEDS-QUOTING-P)
      (IF (CHAR= #\" (PEEK-CHAR NIL IN))
          (PROGN
           (READ-CHAR IN)
           (LOOP FOR C = (READ-CHAR IN NIL)
                 DO (IF C
                        (IF (CHAR= #\" C)
                            (RETURN)
                            (PROGN
                             (IF (SYMBOL-CHAR-INVALID-P C)
                                 (SETF NEEDS-QUOTING-P T))
                             (WRITE-CHAR C BUF)))
                        (ERROR 'COMMODITY-ERROR :MSG
                               "Quoted commodity symbol lacks closing quote"))))
          (LOOP FOR C = (READ-CHAR IN NIL)
                WHILE C
                DO (IF (SYMBOL-CHAR-INVALID-P C)
                       (PROGN (UNREAD-CHAR C IN) (RETURN))
                       (WRITE-CHAR C BUF))))
      (MAKE-COMMODITY-SYMBOL :NAME (GET-OUTPUT-STREAM-STRING BUF)
       :NEEDS-QUOTING-P NEEDS-QUOTING-P)))

[cambl/fprog.lisp:3]
  (DECLAIM (OPTIMIZE (SAFETY 0) (SPEED 3) (SPACE 1)))

[cells/test.lisp:61]
  (EVAL-WHEN (COMPILE LOAD)
    (PROCLAIM '(OPTIMIZE (SPEED 2) (SAFETY 3) (SPACE 1) (DEBUG 3))))

[cffi/src/cffi-lispworks.lisp:197]
  (DEFINE-COMPILER-MACRO %MEM-REF
      (&WHOLE FORM PTR TYPE &OPTIONAL (OFF 0))
    (IF (CONSTANTP TYPE)
        (LET ((TYPE (EVAL TYPE)))
          (IF (OR (64-BIT-TYPE-P TYPE) (EQL TYPE :POINTER))
              (LET ((FLI-TYPE (CONVERT-FOREIGN-TYPE TYPE))
                    (PTR-FORM
                     (IF (EQL OFF 0)
                         PTR
                         (ECLECTOR.READER:QUASIQUOTE
                          (INC-POINTER (ECLECTOR.READER:UNQUOTE PTR)
                           (ECLECTOR.READER:UNQUOTE OFF))))))
                (ECLECTOR.READER:QUASIQUOTE
                 (#S(FORMGREP:SYMREF :NAME "DEREFERENCE" :QUALIFIER "FLI")
                  (ECLECTOR.READER:UNQUOTE PTR-FORM) :TYPE
                  '(ECLECTOR.READER:UNQUOTE FLI-TYPE))))
              (LET ((LISP-TYPE (CONVERT-FOREIGN-TYPED-AREF-TYPE TYPE)))
                (ECLECTOR.READER:QUASIQUOTE
                 (LOCALLY
                  (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
                  (#S(FORMGREP:SYMREF
                      :NAME "FOREIGN-TYPED-AREF"
                      :QUALIFIER "FLI")
                   '(ECLECTOR.READER:UNQUOTE LISP-TYPE)
                   (ECLECTOR.READER:UNQUOTE PTR)
                   (THE FIXNUM (ECLECTOR.READER:UNQUOTE OFF))))))))
        FORM))

[cffi/src/cffi-lispworks.lisp:230]
  (DEFINE-COMPILER-MACRO %MEM-SET
      (&WHOLE FORM VAL PTR TYPE &OPTIONAL (OFF 0))
    (IF (CONSTANTP TYPE)
        (ONCE-ONLY (VAL)
         (LET ((TYPE (EVAL TYPE)))
           (IF (OR (64-BIT-TYPE-P TYPE) (EQL TYPE :POINTER))
               (LET ((FLI-TYPE (CONVERT-FOREIGN-TYPE TYPE))
                     (PTR-FORM
                      (IF (EQL OFF 0)
                          PTR
                          (ECLECTOR.READER:QUASIQUOTE
                           (INC-POINTER (ECLECTOR.READER:UNQUOTE PTR)
                            (ECLECTOR.READER:UNQUOTE OFF))))))
                 (ECLECTOR.READER:QUASIQUOTE
                  (SETF (#S(FORMGREP:SYMREF
                            :NAME "DEREFERENCE"
                            :QUALIFIER "FLI")
                         (ECLECTOR.READER:UNQUOTE PTR-FORM) :TYPE
                         '(ECLECTOR.READER:UNQUOTE FLI-TYPE))
                          (ECLECTOR.READER:UNQUOTE VAL))))
               (LET ((LISP-TYPE (CONVERT-FOREIGN-TYPED-AREF-TYPE TYPE)))
                 (ECLECTOR.READER:QUASIQUOTE
                  (LOCALLY
                   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
                   (SETF (#S(FORMGREP:SYMREF
                             :NAME "FOREIGN-TYPED-AREF"
                             :QUALIFIER "FLI")
                          '(ECLECTOR.READER:UNQUOTE LISP-TYPE)
                          (ECLECTOR.READER:UNQUOTE PTR)
                          (THE FIXNUM (ECLECTOR.READER:UNQUOTE OFF)))
                           (ECLECTOR.READER:UNQUOTE VAL))))))))
        FORM))

[chanl/examples/sieve.lisp:58]
  (DEFUN ERATOSTHENES (N)
    (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0))
             (FIXNUM N))
    (LET ((BIT-VECTOR (MAKE-ARRAY N :INITIAL-ELEMENT 1 :ELEMENT-TYPE 'BIT)))
      (LOOP FOR I FROM 2 UPTO (ISQRT N)
            DO (LOOP FOR J FIXNUM FROM I
                     FOR INDEX FIXNUM = (* I J)
                     UNTIL (>= INDEX N)
                     DO (SETF (SBIT BIT-VECTOR INDEX) 0)))
      (LOOP FOR I FROM 2 BELOW (LENGTH BIT-VECTOR)
            UNLESS (ZEROP (SBIT BIT-VECTOR I))
            COLLECT I)))

[chanl/src/utils.lisp:84]
  (DEFMACRO DEFINE-SPEEDY-FUNCTION (NAME ARGS &BODY BODY)
    (ECLECTOR.READER:QUASIQUOTE
     (PROGN
      (DECLAIM (INLINE (ECLECTOR.READER:UNQUOTE NAME)))
      (DEFUN (ECLECTOR.READER:UNQUOTE NAME) (ECLECTOR.READER:UNQUOTE ARGS)
        (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
        (ECLECTOR.READER:UNQUOTE-SPLICING BODY)))))

[cl+ssl/src/ffi.lisp:11]
  (EVAL-WHEN (:COMPILE-TOPLEVEL)
    (DECLAIM
     (OPTIMIZE (SPEED 3) (SPACE 1) (SAFETY 1) (DEBUG 0) (COMPILATION-SPEED 0))))

[cl+ssl/src/streams.lisp:17]
  (EVAL-WHEN (:COMPILE-TOPLEVEL)
    (DECLAIM
     (OPTIMIZE (SPEED 3) (SPACE 1) (SAFETY 1) (DEBUG 0) (COMPILATION-SPEED 0))))

[cl+ssl/src/x509.lisp:14]
  (DEFUN COPY-BYTES-TO-LISP-VECTOR (SRC-PTR VECTOR COUNT)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8)) VECTOR)
             (TYPE FIXNUM COUNT)
             (OPTIMIZE (SAFETY 0) (DEBUG 0) (SPEED 3)))
    (DOTIMES (I COUNT VECTOR)
      (SETF (AREF VECTOR I) (CFFI:MEM-AREF SRC-PTR :UNSIGNED-CHAR I))))

[cl+ssl/src/x509.lisp:28]
  (DEFUN ASN1-IASTRING-CHAR-P (BYTE)
    (DECLARE (TYPE (UNSIGNED-BYTE 8) BYTE)
             (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (< BYTE 128))

[cl+ssl/src/x509.lisp:35]
  (DEFUN ASN1-IASTRING-P (BYTES)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8)) BYTES)
             (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (EVERY #'ASN1-IASTRING-CHAR-P BYTES))

[cl+ssl/src/x509.lisp:48]
  (DEFUN ASN1-PRINTABLE-CHAR-P (BYTE)
    (DECLARE (TYPE (UNSIGNED-BYTE 8) BYTE)
             (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (COND ((AND (>= BYTE NIL) (<= BYTE NIL)) T)
          ((AND (>= BYTE NIL) (<= BYTE NIL)) T)
          ((AND (>= BYTE NIL) (<= BYTE NIL)) T)
          ((AND (>= BYTE NIL) (<= BYTE NIL)) T) ((= BYTE NIL) T)
          ((= BYTE NIL) T) ((= BYTE NIL) T) ((= BYTE NIL) T)))

[cl+ssl/src/x509.lisp:76]
  (DEFUN ASN1-PRINTABLE-STRING-P (BYTES)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8)) BYTES)
             (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (EVERY #'ASN1-PRINTABLE-CHAR-P BYTES))

[cl+ssl/src/x509.lisp:104]
  (DEFUN ASN1-TELETEX-CHAR-P (BYTE)
    (DECLARE (TYPE (UNSIGNED-BYTE 8) BYTE)
             (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (AND (>= BYTE 32) (< BYTE 128)))

[cl+ssl/src/x509.lisp:112]
  (DEFUN ASN1-TELETEX-STRING-P (BYTES)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8)) BYTES)
             (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (EVERY #'ASN1-TELETEX-CHAR-P BYTES))

[cl-aco/decision.lisp:7]
  (DEFUN AS-DECISION (ANT STEP N CHOICE-INFO PARAMETERS)
    "Determines an ant next action to be executed (ant system, no candidates list)."
    (DECLARE (IGNORE PARAMETERS)
             (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (LET* ((TOUR (ANT-TOUR ANT))
           (VISITED (ANT-VISITED ANT))
           (SUM-PROBABILITIES 0.0)
           (C (AREF TOUR (1- STEP)))
           (NODES (MAKE-ARRAY N :INITIAL-ELEMENT 0))
           (NODES-PROBABILITIES (MAKE-ARRAY N :INITIAL-ELEMENT 0.0))
           (SIZE 0))
      (LOOP WITH NC = (- (* N C) N)
            FOR I FROM 1 TO N
            UNLESS (AREF VISITED I)
            DO (LET ((NODE-PROBABILITY (AREF CHOICE-INFO (1- (+ NC I)))))
                 (SETF (AREF NODES SIZE) I)
                 (SETF (AREF NODES-PROBABILITIES SIZE) NODE-PROBABILITY)
                 (INCF SUM-PROBABILITIES NODE-PROBABILITY)
                 (INCF SIZE)))
      (WHEN (ZEROP SIZE) (ERROR "All nodes have been visited!"))
      (IF (<= SUM-PROBABILITIES 0.0)
          (PROGN
           (SETF SUM-PROBABILITIES 1.0)
           (SETF NODES-PROBABILITIES
                   (MAKE-ARRAY SIZE :INITIAL-ELEMENT (/ 1 SIZE))))
          (PROGN
           (LET ((MAX SUM-PROBABILITIES))
             (FLET ((SCALE (VALUE)
                      (/ (* VALUE 1.0) MAX)))
               (SETF SUM-PROBABILITIES (SCALE SUM-PROBABILITIES))
               (LOOP FOR I BELOW SIZE
                     DO (SETF (AREF NODES-PROBABILITIES I)
                                (SCALE (AREF NODES-PROBABILITIES I))))))))
      (LET ((NODE-POSITION
             (LOOP WITH LIMIT = (RANDOM SUM-PROBABILITIES)
                   FOR PROBABILITY ACROSS NODES-PROBABILITIES
                   FOR POSITION FROM 0 BELOW SIZE
                   SUM PROBABILITY INTO THRESHOLD
                   WHILE (< THRESHOLD LIMIT)
                   FINALLY (RETURN
                            (IF (>= POSITION SIZE)
                                (1- SIZE)
                                POSITION)))))
        (LET ((NODE (AREF NODES NODE-POSITION)))
          (SETF (AREF TOUR STEP) NODE)
          (SETF (AREF VISITED NODE) T)))))

[cl-ana/generic-math/number.lisp:30]
  (DECLAIM (OPTIMIZE (SPEED 3) (SAFETY 0) (COMPILATION-SPEED 0) (DEBUG 0)))

[cl-ana/hdf-cffi/examples/common.lisp:137]
  (DEFUN POS2D (COLS I J)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DECLARE (FIXNUM COLS I J))
    "2D array access function"
    (THE FIXNUM (+ (THE FIXNUM (* COLS I)) J)))

[cl-ana/hdf-table/hdf-table-chain.lisp:24]
  (DECLAIM (OPTIMIZE (SPEED 2) (SAFETY 1) (COMPILATION-SPEED 0) (DEBUG 1)))

[cl-ana/hdf-table/hdf-table.lisp:34]
  (DECLAIM (OPTIMIZE (SPEED 2) (SAFETY 1) (COMPILATION-SPEED 0) (DEBUG 1)))

[cl-ana/hdf-table/raw-hdf-table-chain.lisp:24]
  (DECLAIM (OPTIMIZE (SPEED 2) (SAFETY 1) (COMPILATION-SPEED 0) (DEBUG 1)))

[cl-ana/hdf-table/raw-hdf-table.lisp:34]
  (DECLAIM (OPTIMIZE (SPEED 2) (SAFETY 1) (COMPILATION-SPEED 0) (DEBUG 1)))

[cl-ana/hdf-utils/hdf-utils.lisp:27]
  (DECLAIM (OPTIMIZE (SPEED 3) (SAFETY 1) (COMPILATION-SPEED 0) (DEBUG 1)))

[cl-ana/table/table.lisp:42]
  (DECLAIM (OPTIMIZE (SPEED 2) (SAFETY 1) (COMPILATION-SPEED 0) (DEBUG 1)))

[cl-ana/tensor/tensor.lisp:41]
  (DECLAIM (OPTIMIZE (SPEED 3) (SAFETY 1) (COMPILATION-SPEED 0) (DEBUG 1)))

[cl-ana/typed-table/typed-table.lisp:24]
  (DECLAIM (OPTIMIZE (SPEED 3) (SAFETY 0) (COMPILATION-SPEED 0) (DEBUG 3)))

[cl-ana/typespec/typespec.lisp:24]
  (DECLAIM (OPTIMIZE (SPEED 3) (SAFETY 1) (COMPILATION-SPEED 0) (DEBUG 1)))

[cl-base64/decode.lisp:73]
  (DEFMACRO DEFINE-BASE64-DECODER (HOSE SINK)
    (ECLECTOR.READER:QUASIQUOTE
     (DEFUN (ECLECTOR.READER:UNQUOTE
             (INTERN (FORMAT NIL "~A-~A-~A-~A" '#:BASE64 HOSE '#:TO SINK)))
            (INPUT
             &KEY (TABLE +DECODE-TABLE+) (URI NIL)
             (ECLECTOR.READER:UNQUOTE-SPLICING
              (WHEN (EQ SINK :STREAM) (ECLECTOR.READER:QUASIQUOTE (STREAM))))
             (WHITESPACE :IGNORE))
       (ECLECTOR.READER:UNQUOTE
        (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
                 (ECLECTOR.READER:UNQUOTE
                  (ECASE HOSE
                    (:STREAM (QUOTE STREAM))
                    (:STRING (QUOTE STRING))))
                 INPUT))
       (LET/TYPED
        ((DECODE-TABLE
          (IF URI
              +URI-DECODE-TABLE+
              TABLE)
          DECODE-TABLE)
         (ECLECTOR.READER:UNQUOTE-SPLICING
          (ECASE SINK
            (:STREAM)
            (:USB8-ARRAY
             (ECASE HOSE
               (:STREAM
                (ECLECTOR.READER:QUASIQUOTE
                 ((RESULT
                   (MAKE-ARRAY 1024 :ELEMENT-TYPE '(UNSIGNED-BYTE 8)
                               :ADJUSTABLE T :FILL-POINTER 0)
                   (ARRAY (UNSIGNED-BYTE 8) (*))))))
               (:STRING
                (ECLECTOR.READER:QUASIQUOTE
                 ((RESULT
                   (MAKE-ARRAY (* 3 (CEILING (LENGTH INPUT) 4)) :ELEMENT-TYPE
                               '(UNSIGNED-BYTE 8))
                   (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)))
                  (RPOS 0 ARRAY-INDEX))))))
            (:STRING
             (CASE HOSE
               (:STREAM
                (ECLECTOR.READER:QUASIQUOTE
                 ((RESULT
                   (MAKE-ARRAY 1024 :ELEMENT-TYPE 'CHARACTER :ADJUSTABLE T
                               :FILL-POINTER 0)
                   (ARRAY CHARACTER (*))))))
               (:STRING
                (ECLECTOR.READER:QUASIQUOTE
                 ((RESULT
                   (MAKE-ARRAY (* 3 (CEILING (LENGTH INPUT) 4)) :ELEMENT-TYPE
                               'CHARACTER)
                   (SIMPLE-ARRAY CHARACTER (*)))
                  (RPOS 0 ARRAY-INDEX))))))
            (:INTEGER
             (ECLECTOR.READER:QUASIQUOTE ((RESULT 0 UNSIGNED-BYTE)))))))
        (FLET ((BAD-CHAR (POS CODE &OPTIONAL (ACTION :ERROR))
                 (LET ((ARGS
                        (LIST 'BAD-BASE64-CHARACTER :INPUT INPUT :POSITION POS
                              :CODE CODE)))
                   (ECASE ACTION
                     (:ERROR (APPLY #'ERROR ARGS))
                     (:CERROR
                      (APPLY #'CERROR "Ignore the error and continue." ARGS))
                     (:SIGNAL (APPLY #'SIGNAL ARGS)))))
               (INCOMPLETE-INPUT (POS)
                 (ERROR 'INCOMPLETE-BASE64-DATA :INPUT INPUT :POSITION POS)))
          (ECLECTOR.READER:UNQUOTE
           (LET ((BODY
                  (ECLECTOR.READER:QUASIQUOTE
                   (LET/TYPED
                    ((IPOS 0 ARRAY-INDEX) (BITSTORE 0 (UNSIGNED-BYTE 24))
                     (BITCOUNT 0 (INTEGER 0 14)) (SVALUE -1 (SIGNED-BYTE 8))
                     (PADCHAR 0 (INTEGER 0 3)) (CODE 0 FIXNUM))
                    (LOOP
                     (ECLECTOR.READER:UNQUOTE-SPLICING
                      (ECASE HOSE
                        (:STRING
                         (ECLECTOR.READER:QUASIQUOTE
                          ((IF (< IPOS LENGTH)
                               (SETQ CODE (CHAR-CODE (AREF INPUT IPOS)))
                               (RETURN)))))
                        (:STREAM
                         (ECLECTOR.READER:QUASIQUOTE
                          ((LET ((CHAR (READ-CHAR INPUT NIL NIL)))
                             (IF CHAR
                                 (SETQ CODE (CHAR-CODE CHAR))
                                 (RETURN))))))))
                     (COND
                      ((OR (< 127 CODE)
                           (= -1 (SETQ SVALUE (AREF DECODE-TABLE CODE))))
                       (BAD-CHAR IPOS CODE))
                      ((= -2 SVALUE)
                       (COND
                        ((<= (INCF PADCHAR) 2)
                         (UNLESS (<= 2 BITCOUNT) (BAD-CHAR IPOS CODE))
                         (DECF BITCOUNT 2))
                        (T (BAD-CHAR IPOS CODE))))
                      ((= -3 SVALUE)
                       (ECASE WHITESPACE
                         (:IGNORE)
                         (:ERROR (BAD-CHAR IPOS CODE :ERROR))
                         (:SIGNAL (BAD-CHAR IPOS CODE :SIGNAL))))
                      ((NOT (ZEROP PADCHAR)) (BAD-CHAR IPOS CODE))
                      (T
                       (SETF BITSTORE
                               (LOGIOR
                                (THE (UNSIGNED-BYTE 24) (ASH BITSTORE 6))
                                SVALUE))
                       (INCF BITCOUNT 6)
                       (WHEN (>= BITCOUNT 8)
                         (DECF BITCOUNT 8)
                         (LET ((BYTE
                                (LOGAND
                                 (THE (UNSIGNED-BYTE 24)
                                      (ASH BITSTORE (- BITCOUNT)))
                                 255)))
                           (DECLARE (TYPE (UNSIGNED-BYTE 8) BYTE))
                           (ECLECTOR.READER:UNQUOTE-SPLICING
                            (ECASE SINK
                              (:USB8-ARRAY
                               (ECASE HOSE
                                 (:STRING
                                  (ECLECTOR.READER:QUASIQUOTE
                                   ((SETF (AREF RESULT RPOS) BYTE)
                                    (INCF RPOS))))
                                 (:STREAM
                                  (ECLECTOR.READER:QUASIQUOTE
                                   ((VECTOR-PUSH-EXTEND BYTE RESULT))))))
                              (:STRING
                               (ECASE HOSE
                                 (:STRING
                                  (ECLECTOR.READER:QUASIQUOTE
                                   ((SETF (SCHAR RESULT RPOS) (CODE-CHAR BYTE))
                                    (INCF RPOS))))
                                 (:STREAM
                                  (ECLECTOR.READER:QUASIQUOTE
                                   ((VECTOR-PUSH-EXTEND (CODE-CHAR BYTE)
                                                        RESULT))))))
                              (:INTEGER
                               (ECLECTOR.READER:QUASIQUOTE
                                ((SETQ RESULT (LOGIOR (ASH RESULT 8) BYTE)))))
                              (:STREAM
                               '((WRITE-CHAR (CODE-CHAR BYTE) STREAM))))))
                         (SETF BITSTORE (LOGAND BITSTORE 255)))))
                     (INCF IPOS))
                    (UNLESS (ZEROP BITCOUNT) (INCOMPLETE-INPUT IPOS))
                    (ECLECTOR.READER:UNQUOTE
                     (ECASE SINK
                       ((:STRING :USB8-ARRAY)
                        (ECASE HOSE
                          (:STRING
                           (ECLECTOR.READER:QUASIQUOTE
                            (IF (= RPOS (LENGTH RESULT))
                                RESULT
                                (SUBSEQ RESULT 0 RPOS))))
                          (:STREAM
                           (ECLECTOR.READER:QUASIQUOTE (COPY-SEQ RESULT)))))
                       (:INTEGER 'RESULT)
                       (:STREAM 'STREAM)))))))
             (ECASE HOSE
               (:STRING
                (ECLECTOR.READER:QUASIQUOTE
                 (LET ((LENGTH (LENGTH INPUT)))
                   (DECLARE (TYPE ARRAY-LENGTH LENGTH))
                   (ETYPECASE/UNROLL
                    (INPUT SIMPLE-BASE-STRING SIMPLE-STRING STRING)
                    (ECLECTOR.READER:UNQUOTE BODY)))))
               (:STREAM BODY)))))))))

[cl-base64/encode.lisp:33]
  (DEFUN ROUND-NEXT-MULTIPLE (X N)
    "Round x up to the next highest multiple of n."
    (DECLARE (FIXNUM N)
             (OPTIMIZE (SPEED 3) (SAFETY 1) (SPACE 0)))
    (LET ((REMAINDER (MOD X N)))
      (DECLARE (FIXNUM REMAINDER))
      (IF (ZEROP REMAINDER)
          X
          (THE FIXNUM (+ X (THE FIXNUM (- N REMAINDER)))))))

[cl-base64/encode.lisp:43]
  (DEFMACRO DEF-*-TO-BASE64-* (INPUT-TYPE OUTPUT-TYPE)
    (ECLECTOR.READER:QUASIQUOTE
     (DEFUN (ECLECTOR.READER:UNQUOTE
             (INTERN
              (CONCATENATE 'STRING (SYMBOL-NAME INPUT-TYPE)
                           (SYMBOL-NAME :-TO-BASE64-)
                           (SYMBOL-NAME OUTPUT-TYPE))))
            (INPUT
             (ECLECTOR.READER:UNQUOTE-SPLICING
              (WHEN (EQ OUTPUT-TYPE :STREAM) '(OUTPUT)))
             &KEY (URI NIL) (COLUMNS 0))
       "Encode a string array to base64. If columns is > 0, designates
maximum number of columns in a line and the string will be terminated
with a #Newline."
       (DECLARE
        (ECLECTOR.READER:UNQUOTE-SPLICING
         (CASE INPUT-TYPE
           (:STRING (QUOTE ((STRING INPUT))))
           (:USB8-ARRAY (QUOTE ((TYPE (ARRAY (UNSIGNED-BYTE 8) (*)) INPUT))))))
        (FIXNUM COLUMNS)
        (OPTIMIZE (SPEED 3) (SAFETY 1) (SPACE 0)))
       (LET ((PAD
              (IF URI
                  *URI-PAD-CHAR*
                  *PAD-CHAR*))
             (ENCODE-TABLE
              (IF URI
                  *URI-ENCODE-TABLE*
                  *ENCODE-TABLE*)))
         (DECLARE (SIMPLE-STRING ENCODE-TABLE)
                  (CHARACTER PAD))
         (LET* ((STRING-LENGTH (LENGTH INPUT))
                (COMPLETE-GROUP-COUNT (TRUNCATE STRING-LENGTH 3))
                (REMAINDER (NTH-VALUE 1 (TRUNCATE STRING-LENGTH 3)))
                (PADDED-LENGTH (* 4 (TRUNCATE (+ STRING-LENGTH 2) 3)))
                (ECLECTOR.READER:UNQUOTE-SPLICING
                 (WHEN (EQ OUTPUT-TYPE :STRING)
                   '((NUM-LINES
                      (IF (PLUSP COLUMNS)
                          (TRUNCATE (+ PADDED-LENGTH (1- COLUMNS)) COLUMNS)
                          0))
                     (NUM-BREAKS
                      (IF (PLUSP NUM-LINES)
                          (1- NUM-LINES)
                          0))
                     (STRLEN (+ PADDED-LENGTH NUM-BREAKS))
                     (RESULT (MAKE-STRING STRLEN)) (IOUTPUT 0))))
                (COL
                 (IF (PLUSP COLUMNS)
                     0
                     (THE FIXNUM (1+ PADDED-LENGTH)))))
           (DECLARE
            (FIXNUM STRING-LENGTH PADDED-LENGTH COL
             (ECLECTOR.READER:UNQUOTE-SPLICING
              (WHEN (EQ OUTPUT-TYPE :STRING) (QUOTE (IOUTPUT)))))
            (ECLECTOR.READER:UNQUOTE-SPLICING
             (WHEN (EQ OUTPUT-TYPE :STRING) (QUOTE ((SIMPLE-STRING RESULT))))))
           (LABELS ((OUTPUT-CHAR (CH)
                      (IF (= COL COLUMNS)
                          (PROGN
                           (ECLECTOR.READER:UNQUOTE-SPLICING
                            (CASE OUTPUT-TYPE
                              (:STREAM '((WRITE-CHAR #\Newline OUTPUT)))
                              (:STRING
                               '((SETF (SCHAR RESULT IOUTPUT) #\Newline)
                                 (INCF IOUTPUT)))))
                           (SETQ COL 1))
                          (INCF COL))
                      (ECLECTOR.READER:UNQUOTE-SPLICING
                       (CASE OUTPUT-TYPE
                         (:STREAM '((WRITE-CHAR CH OUTPUT)))
                         (:STRING
                          '((SETF (SCHAR RESULT IOUTPUT) CH)
                            (INCF IOUTPUT))))))
                    (OUTPUT-GROUP (SVALUE CHARS)
                      (DECLARE (FIXNUM SVALUE CHARS))
                      (OUTPUT-CHAR
                       (SCHAR ENCODE-TABLE
                              (THE FIXNUM
                                   (LOGAND 63 (THE FIXNUM (ASH SVALUE -18))))))
                      (OUTPUT-CHAR
                       (SCHAR ENCODE-TABLE
                              (THE FIXNUM
                                   (LOGAND 63 (THE FIXNUM (ASH SVALUE -12))))))
                      (IF (> CHARS 2)
                          (OUTPUT-CHAR
                           (SCHAR ENCODE-TABLE
                                  (THE FIXNUM
                                       (LOGAND 63
                                               (THE FIXNUM (ASH SVALUE -6))))))
                          (OUTPUT-CHAR PAD))
                      (IF (> CHARS 3)
                          (OUTPUT-CHAR
                           (SCHAR ENCODE-TABLE
                                  (THE FIXNUM (LOGAND 63 SVALUE))))
                          (OUTPUT-CHAR PAD))))
             (DO ((IGROUP 0 (THE FIXNUM (1+ IGROUP)))
                  (ISOURCE 0 (THE FIXNUM (+ ISOURCE 3))))
                 ((= IGROUP COMPLETE-GROUP-COUNT)
                  (COND
                   ((= REMAINDER 2)
                    (OUTPUT-GROUP
                     (THE FIXNUM
                          (+
                           (THE FIXNUM
                                (ASH
                                 (ECLECTOR.READER:UNQUOTE
                                  (CASE INPUT-TYPE
                                    (:STRING
                                     '(CHAR-CODE
                                       (THE CHARACTER (CHAR INPUT ISOURCE))))
                                    (:USB8-ARRAY
                                     '(THE FIXNUM (AREF INPUT ISOURCE)))))
                                 16))
                           (THE FIXNUM
                                (ASH
                                 (ECLECTOR.READER:UNQUOTE
                                  (CASE INPUT-TYPE
                                    (:STRING
                                     '(CHAR-CODE
                                       (THE CHARACTER
                                            (CHAR INPUT
                                                  (THE FIXNUM (1+ ISOURCE))))))
                                    (:USB8-ARRAY
                                     '(THE FIXNUM
                                           (AREF INPUT
                                                 (THE FIXNUM (1+ ISOURCE)))))))
                                 8))))
                     3))
                   ((= REMAINDER 1)
                    (OUTPUT-GROUP
                     (THE FIXNUM
                          (ASH
                           (ECLECTOR.READER:UNQUOTE
                            (CASE INPUT-TYPE
                              (:STRING
                               '(CHAR-CODE
                                 (THE CHARACTER (CHAR INPUT ISOURCE))))
                              (:USB8-ARRAY
                               '(THE FIXNUM (AREF INPUT ISOURCE)))))
                           16))
                     2)))
                  (ECLECTOR.READER:UNQUOTE
                   (CASE OUTPUT-TYPE (:STRING 'RESULT) (:STREAM 'OUTPUT))))
               (DECLARE (FIXNUM IGROUP ISOURCE))
               (OUTPUT-GROUP
                (THE FIXNUM
                     (+
                      (THE FIXNUM
                           (ASH
                            (THE FIXNUM
                                 (ECLECTOR.READER:UNQUOTE
                                  (CASE INPUT-TYPE
                                    (:STRING
                                     '(CHAR-CODE
                                       (THE CHARACTER (CHAR INPUT ISOURCE))))
                                    (:USB8-ARRAY '(AREF INPUT ISOURCE)))))
                            16))
                      (THE FIXNUM
                           (ASH
                            (THE FIXNUM
                                 (ECLECTOR.READER:UNQUOTE
                                  (CASE INPUT-TYPE
                                    (:STRING
                                     '(CHAR-CODE
                                       (THE CHARACTER
                                            (CHAR INPUT
                                                  (THE FIXNUM (1+ ISOURCE))))))
                                    (:USB8-ARRAY '(AREF INPUT (1+ ISOURCE))))))
                            8))
                      (THE FIXNUM
                           (ECLECTOR.READER:UNQUOTE
                            (CASE INPUT-TYPE
                              (:STRING
                               '(CHAR-CODE
                                 (THE CHARACTER
                                      (CHAR INPUT
                                            (THE FIXNUM (+ 2 ISOURCE))))))
                              (:USB8-ARRAY '(AREF INPUT (+ 2 ISOURCE))))))))
                4))))))))

[cl-base64/encode.lisp:211]
  (DEFUN INTEGER-TO-BASE64-STRING (INPUT &KEY (URI NIL) (COLUMNS 0))
    "Encode an integer to base64 format."
    (DECLARE (INTEGER INPUT)
             (FIXNUM COLUMNS)
             (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 1)))
    (LET ((PAD
           (IF URI
               *URI-PAD-CHAR*
               *PAD-CHAR*))
          (ENCODE-TABLE
           (IF URI
               *URI-ENCODE-TABLE*
               *ENCODE-TABLE*)))
      (DECLARE (SIMPLE-STRING ENCODE-TABLE)
               (CHARACTER PAD))
      (LET* ((INPUT-BITS (INTEGER-LENGTH INPUT))
             (BYTE-BITS (ROUND-NEXT-MULTIPLE INPUT-BITS 8))
             (PADDED-BITS (ROUND-NEXT-MULTIPLE BYTE-BITS 6))
             (REMAINDER-PADDING (MOD PADDED-BITS 24))
             (PADDING-BITS
              (IF (ZEROP REMAINDER-PADDING)
                  0
                  (- 24 REMAINDER-PADDING)))
             (PADDING-CHARS (/ PADDING-BITS 6))
             (PADDED-LENGTH (/ (+ PADDED-BITS PADDING-BITS) 6))
             (LAST-LINE-LEN
              (IF (PLUSP COLUMNS)
                  (- PADDED-LENGTH
                     (* COLUMNS (TRUNCATE PADDED-LENGTH COLUMNS)))
                  0))
             (NUM-LINES
              (IF (PLUSP COLUMNS)
                  (TRUNCATE (+ PADDED-LENGTH (1- COLUMNS)) COLUMNS)
                  0))
             (NUM-BREAKS
              (IF (PLUSP NUM-LINES)
                  (1- NUM-LINES)
                  0))
             (STRLEN (+ PADDED-LENGTH NUM-BREAKS))
             (LAST-CHAR (1- STRLEN))
             (STR (MAKE-STRING STRLEN))
             (COL
              (IF (ZEROP LAST-LINE-LEN)
                  COLUMNS
                  LAST-LINE-LEN)))
        (DECLARE
         (FIXNUM PADDED-LENGTH NUM-LINES COL LAST-CHAR PADDING-CHARS
          LAST-LINE-LEN))
        (UNLESS (PLUSP COLUMNS) (SETQ COL -1))
        (DOTIMES (I PADDING-CHARS)
          (DECLARE (FIXNUM I))
          (SETF (SCHAR STR (THE FIXNUM (- LAST-CHAR I))) PAD))
        (DO* ((STRPOS (- LAST-CHAR PADDING-CHARS) (1- STRPOS))
              (INT (ASH INPUT (/ PADDING-BITS 3))))
             ((MINUSP STRPOS) STR)
          (DECLARE (FIXNUM STRPOS)
                   (INTEGER INT))
          (COND
           ((ZEROP COL) (SETF (SCHAR STR STRPOS) #\Newline) (SETQ COL COLUMNS))
           (T
            (SETF (SCHAR STR STRPOS)
                    (SCHAR ENCODE-TABLE (THE FIXNUM (LOGAND INT 63))))
            (SETQ INT (ASH INT -6)) (DECF COL)))))))

[cl-base64/encode.lisp:270]
  (DEFUN INTEGER-TO-BASE64-STREAM (INPUT STREAM &KEY (URI NIL) (COLUMNS 0))
    "Encode an integer to base64 format."
    (DECLARE (INTEGER INPUT)
             (FIXNUM COLUMNS)
             (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 1)))
    (LET ((PAD
           (IF URI
               *URI-PAD-CHAR*
               *PAD-CHAR*))
          (ENCODE-TABLE
           (IF URI
               *URI-ENCODE-TABLE*
               *ENCODE-TABLE*)))
      (DECLARE (SIMPLE-STRING ENCODE-TABLE)
               (CHARACTER PAD))
      (LET* ((INPUT-BITS (INTEGER-LENGTH INPUT))
             (BYTE-BITS (ROUND-NEXT-MULTIPLE INPUT-BITS 8))
             (PADDED-BITS (ROUND-NEXT-MULTIPLE BYTE-BITS 6))
             (REMAINDER-PADDING (MOD PADDED-BITS 24))
             (PADDING-BITS
              (IF (ZEROP REMAINDER-PADDING)
                  0
                  (- 24 REMAINDER-PADDING)))
             (PADDING-CHARS (/ PADDING-BITS 6))
             (PADDED-LENGTH (/ (+ PADDED-BITS PADDING-BITS) 6))
             (STRLEN PADDED-LENGTH)
             (NONPAD-CHARS (- STRLEN PADDING-CHARS))
             (LAST-NONPAD-CHAR (1- NONPAD-CHARS))
             (STR (MAKE-STRING STRLEN)))
        (DECLARE (FIXNUM PADDED-LENGTH LAST-NONPAD-CHAR))
        (DO* ((STRPOS 0 (THE FIXNUM (1+ STRPOS)))
              (INT (ASH INPUT (/ PADDING-BITS 3)) (ASH INT -6))
              (6BIT-VALUE (THE FIXNUM (LOGAND INT 63))
                          (THE FIXNUM (LOGAND INT 63))))
             ((= STRPOS NONPAD-CHARS)
              (LET ((COL 0))
                (DECLARE (FIXNUM COL))
                (DOTIMES (I NONPAD-CHARS)
                  (DECLARE (FIXNUM I))
                  (WRITE-CHAR (SCHAR STR I) STREAM)
                  (WHEN (PLUSP COLUMNS)
                    (INCF COL)
                    (WHEN (= COL COLUMNS)
                      (WRITE-CHAR #\Newline STREAM)
                      (SETQ COL 0))))
                (DOTIMES (IPAD PADDING-CHARS)
                  (DECLARE (FIXNUM IPAD))
                  (WRITE-CHAR PAD STREAM)
                  (WHEN (PLUSP COLUMNS)
                    (INCF COL)
                    (WHEN (= COL COLUMNS)
                      (WRITE-CHAR #\Newline STREAM)
                      (SETQ COL 0)))))
              STREAM)
          (DECLARE (FIXNUM 6BIT-VALUE STRPOS)
                   (INTEGER INT))
          (SETF (SCHAR STR (- LAST-NONPAD-CHAR STRPOS))
                  (SCHAR ENCODE-TABLE 6BIT-VALUE))))))

[cl-cairo2/src/user-font.lisp:28]
  (DEFCALLBACK USER-FONT-INIT-CB CAIRO_STATUS_T
   ((SCALED-FONT :POINTER) (CTX :POINTER) (EXTENTS :POINTER))
   (DECLAIM (OPTIMIZE (DEBUG 1) (SPEED 1) (SAFETY 1)))
   (LET* ((FONT-PTR (CAIRO_SCALED_FONT_GET_FONT_FACE SCALED-FONT))
          (USER-FONT
           (GETHASH (POINTER-ADDRESS FONT-PTR) *USER-FONT-PTR-TO-OBJECT*))
          (FONT-EXTENTS
           (MAKE-FONT-EXTENTS-T :ASCENT 1.0 :DESCENT 0.0 :HEIGHT 1.0
            :MAX-X-ADVANCE 1.0 :MAX-Y-ADVANCE 0.0)))
     (DECLARE (DYNAMIC-EXTENT FONT-EXTENTS))
     (WHEN (AND USER-FONT (SLOT-BOUNDP USER-FONT 'INIT-FUN))
       (SETF (SLOT-VALUE *USER-FONT-TEMP-CONTEXT* 'POINTER) CTX
             (SLOT-VALUE *USER-FONT-TEMP-SCALED-FONT* 'POINTER) SCALED-FONT
             (SLOT-VALUE *USER-FONT-TEMP-SCALED-FONT* 'FONT-FACE) USER-FONT)
       (FUNCALL (USER-FONT-INIT-FUN USER-FONT) *USER-FONT-TEMP-SCALED-FONT*
                *USER-FONT-TEMP-CONTEXT* FONT-EXTENTS)
       (FONT-EXTENTS-T-COPY-IN EXTENTS FONT-EXTENTS)))
   :CAIRO_STATUS_SUCCESS)

[cl-competitive/module/binary-heap.lisp:14]
  (DEFMACRO DEFINE-BINARY-HEAP (NAME &KEY ORDER (ELEMENT-TYPE 'FIXNUM))
    "Defines a binary heap specialized for the given order and the element
type. This macro defines a structure of the given NAME and relevant functions:
MAKE-<NAME>, <NAME>-PUSH, <NAME>-POP, <NAME>-CLEAR, <NAME>-EMPTY-P,
<NAME>-COUNT, and <NAME>-PEEK.

If ORDER is not given, heap for dynamic order is defined instead, and the
constructor takes an order function as an argument. Note that it will be
slightly slower than a static order, as it cannot be inlined."
    (CHECK-TYPE NAME SYMBOL)
    (LET* ((STRING-NAME (STRING NAME))
           (FNAME-PUSH (INTERN (FORMAT NIL "~A-PUSH" STRING-NAME)))
           (FNAME-POP (INTERN (FORMAT NIL "~A-POP" STRING-NAME)))
           (FNAME-CLEAR (INTERN (FORMAT NIL "~A-CLEAR" STRING-NAME)))
           (FNAME-EMPTY-P (INTERN (FORMAT NIL "~A-EMPTY-P" STRING-NAME)))
           (FNAME-COUNT (INTERN (FORMAT NIL "~A-COUNT" STRING-NAME)))
           (FNAME-PEEK (INTERN (FORMAT NIL "~A-PEEK" STRING-NAME)))
           (FNAME-MAKE (INTERN (FORMAT NIL "MAKE-~A" STRING-NAME)))
           (ACC-POSITION (INTERN (FORMAT NIL "~A-POSITION" STRING-NAME)))
           (ACC-DATA (INTERN (FORMAT NIL "~A-DATA" STRING-NAME)))
           (ACC-ORDER (INTERN (FORMAT NIL "~A-ORDER" STRING-NAME)))
           (DYNAMIC-ORDER (NULL ORDER))
           (ORDER (OR ORDER 'ORDER)))
      (ECLECTOR.READER:QUASIQUOTE
       (PROGN
        (DEFSTRUCT
            ((ECLECTOR.READER:UNQUOTE NAME)
             (:CONSTRUCTOR (ECLECTOR.READER:UNQUOTE FNAME-MAKE)
              (SIZE
               (ECLECTOR.READER:UNQUOTE-SPLICING (WHEN DYNAMIC-ORDER '(ORDER)))
               &AUX
               (DATA
                (LOCALLY
                 (DECLARE (MUFFLE-CONDITIONS STYLE-WARNING))
                 (MAKE-ARRAY (1+ SIZE) :ELEMENT-TYPE
                             '(ECLECTOR.READER:UNQUOTE ELEMENT-TYPE)))))))
          (DATA NIL :TYPE
           (SIMPLE-ARRAY (ECLECTOR.READER:UNQUOTE ELEMENT-TYPE) (*)))
          (POSITION 1 :TYPE (INTEGER 1 NIL))
          (ECLECTOR.READER:UNQUOTE-SPLICING
           (WHEN DYNAMIC-ORDER
             (ECLECTOR.READER:QUASIQUOTE ((ORDER NIL :TYPE FUNCTION))))))
        (DECLAIM (MAYBE-INLINE (ECLECTOR.READER:UNQUOTE FNAME-PUSH)))
        (DEFUN (ECLECTOR.READER:UNQUOTE FNAME-PUSH) (OBJ HEAP)
          "Inserts OBJ to HEAP."
          (DECLARE (OPTIMIZE (SPEED 3))
                   (TYPE (ECLECTOR.READER:UNQUOTE NAME) HEAP))
          (SYMBOL-MACROLET ((POSITION
                             ((ECLECTOR.READER:UNQUOTE ACC-POSITION) HEAP)))
            (WHEN
                (>= POSITION
                    (LENGTH ((ECLECTOR.READER:UNQUOTE ACC-DATA) HEAP)))
              (SETF ((ECLECTOR.READER:UNQUOTE ACC-DATA) HEAP)
                      (ADJUST-ARRAY ((ECLECTOR.READER:UNQUOTE ACC-DATA) HEAP)
                                    (MIN (- ARRAY-DIMENSION-LIMIT 1)
                                         (* POSITION 2)))))
            (LET ((DATA ((ECLECTOR.READER:UNQUOTE ACC-DATA) HEAP))
                  (ECLECTOR.READER:UNQUOTE-SPLICING
                   (WHEN DYNAMIC-ORDER
                     (ECLECTOR.READER:QUASIQUOTE
                      ((ORDER ((ECLECTOR.READER:UNQUOTE ACC-ORDER) HEAP)))))))
              (DECLARE
               ((SIMPLE-ARRAY (ECLECTOR.READER:UNQUOTE ELEMENT-TYPE) (*))
                DATA))
              (LABELS ((HEAPIFY (POS)
                         (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
                                  ((MOD NIL) POS))
                         (UNLESS (= POS 1)
                           (LET ((PARENT-POS (ASH POS -1)))
                             (WHEN
                                 (FUNCALL (ECLECTOR.READER:UNQUOTE ORDER)
                                          (AREF DATA POS)
                                          (AREF DATA PARENT-POS))
                               (ROTATEF (AREF DATA POS) (AREF DATA PARENT-POS))
                               (HEAPIFY PARENT-POS))))))
                (SETF (AREF DATA POSITION) OBJ)
                (HEAPIFY POSITION)
                (INCF POSITION)
                HEAP))))
        (DECLAIM (MAYBE-INLINE (ECLECTOR.READER:UNQUOTE FNAME-POP)))
        (DEFUN (ECLECTOR.READER:UNQUOTE FNAME-POP) (HEAP)
          "Removes and returns the element at the top of HEAP. Signals
HEAP-EMPTY-ERROR if HEAP is empty."
          (DECLARE (OPTIMIZE (SPEED 3))
                   (TYPE (ECLECTOR.READER:UNQUOTE NAME) HEAP))
          (SYMBOL-MACROLET ((POSITION
                             ((ECLECTOR.READER:UNQUOTE ACC-POSITION) HEAP)))
            (LET ((DATA ((ECLECTOR.READER:UNQUOTE ACC-DATA) HEAP))
                  (ECLECTOR.READER:UNQUOTE-SPLICING
                   (WHEN DYNAMIC-ORDER
                     (ECLECTOR.READER:QUASIQUOTE
                      ((ORDER ((ECLECTOR.READER:UNQUOTE ACC-ORDER) HEAP)))))))
              (DECLARE
               ((SIMPLE-ARRAY (ECLECTOR.READER:UNQUOTE ELEMENT-TYPE) (*))
                DATA))
              (LABELS ((HEAPIFY (POS)
                         (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
                                  ((MOD NIL) POS))
                         (LET* ((CHILD-POS1 (+ POS POS))
                                (CHILD-POS2 (1+ CHILD-POS1)))
                           (DECLARE ((MOD NIL) CHILD-POS1 CHILD-POS2))
                           (WHEN (<= CHILD-POS1 POSITION)
                             (IF (<= CHILD-POS2 POSITION)
                                 (IF (FUNCALL (ECLECTOR.READER:UNQUOTE ORDER)
                                              (AREF DATA CHILD-POS1)
                                              (AREF DATA CHILD-POS2))
                                     (UNLESS
                                         (FUNCALL
                                          (ECLECTOR.READER:UNQUOTE ORDER)
                                          (AREF DATA POS)
                                          (AREF DATA CHILD-POS1))
                                       (ROTATEF (AREF DATA POS)
                                                (AREF DATA CHILD-POS1))
                                       (HEAPIFY CHILD-POS1))
                                     (UNLESS
                                         (FUNCALL
                                          (ECLECTOR.READER:UNQUOTE ORDER)
                                          (AREF DATA POS)
                                          (AREF DATA CHILD-POS2))
                                       (ROTATEF (AREF DATA POS)
                                                (AREF DATA CHILD-POS2))
                                       (HEAPIFY CHILD-POS2)))
                                 (UNLESS
                                     (FUNCALL (ECLECTOR.READER:UNQUOTE ORDER)
                                              (AREF DATA POS)
                                              (AREF DATA CHILD-POS1))
                                   (ROTATEF (AREF DATA POS)
                                            (AREF DATA CHILD-POS1))))))))
                (WHEN (= POSITION 1) (ERROR 'HEAP-EMPTY-ERROR :HEAP HEAP))
                (PROG1 (AREF DATA 1)
                  (DECF POSITION)
                  (SETF (AREF DATA 1) (AREF DATA POSITION))
                  (HEAPIFY 1))))))
        (DECLAIM (INLINE (ECLECTOR.READER:UNQUOTE FNAME-CLEAR)))
        (DEFUN (ECLECTOR.READER:UNQUOTE FNAME-CLEAR) (HEAP)
          "Makes HEAP empty."
          (SETF ((ECLECTOR.READER:UNQUOTE ACC-POSITION) HEAP) 1)
          HEAP)
        (DECLAIM (INLINE (ECLECTOR.READER:UNQUOTE FNAME-EMPTY-P)))
        (DEFUN (ECLECTOR.READER:UNQUOTE FNAME-EMPTY-P) (HEAP)
          "Returns true iff HEAP is empty."
          (= 1 ((ECLECTOR.READER:UNQUOTE ACC-POSITION) HEAP)))
        (DECLAIM (INLINE (ECLECTOR.READER:UNQUOTE FNAME-COUNT)))
        (DEFUN (ECLECTOR.READER:UNQUOTE FNAME-COUNT) (HEAP)
          "Returns the current number of the elements in HEAP."
          (- ((ECLECTOR.READER:UNQUOTE ACC-POSITION) HEAP) 1))
        (DECLAIM (INLINE (ECLECTOR.READER:UNQUOTE FNAME-PEEK)))
        (DEFUN (ECLECTOR.READER:UNQUOTE FNAME-PEEK) (HEAP)
          "Returns the topmost element of HEAP. Signals HEAP-EMPTY-ERROR if HEAP
is empty."
          (IF (= 1 ((ECLECTOR.READER:UNQUOTE ACC-POSITION) HEAP))
              (ERROR 'HEAP-EMPTY-ERROR :HEAP HEAP)
              (AREF ((ECLECTOR.READER:UNQUOTE ACC-DATA) HEAP) 1)))))))

[cl-competitive/module/binom-mod-prime.lisp:32]
  (DEFUN INITIALIZE-BINOM ()
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (SETF (AREF *FACT* 0) 1
          (AREF *FACT* 1) 1
          (AREF *FACT-INV* 0) 1
          (AREF *FACT-INV* 1) 1
          (AREF *INV* 1) 1)
    (LOOP FOR I FROM 2 BELOW +BINOM-SIZE+
          DO (SETF (AREF *FACT* I)
                     (MOD (* I (AREF *FACT* (- I 1))) +BINOM-MOD+)
                   (AREF *INV* I)
                     (- +BINOM-MOD+
                        (MOD
                         (* (AREF *INV* (REM +BINOM-MOD+ I))
                            (FLOOR +BINOM-MOD+ I))
                         +BINOM-MOD+))
                   (AREF *FACT-INV* I)
                     (MOD (* (AREF *INV* I) (AREF *FACT-INV* (- I 1)))
                          +BINOM-MOD+))))

[cl-competitive/module/bit-basher.lisp:24]
  (DEFUN BIT-NOT! (SB-VECTOR &OPTIONAL (START 0) END)
    "Destructively flips the bits in the range [START, END)."
    (DECLARE (OPTIMIZE (SPEED 3))
             (SIMPLE-BIT-VECTOR SB-VECTOR)
             ((MOD NIL) START)
             ((OR NULL (MOD NIL)) END))
    (SETQ END (OR END (LENGTH SB-VECTOR)))
    (ASSERT (<= START END (LENGTH SB-VECTOR)))
    (MULTIPLE-VALUE-BIND (START/64 START%64)
        (FLOOR START 64)
      (MULTIPLE-VALUE-BIND (END/64 END%64)
          (FLOOR END 64)
        (DECLARE (OPTIMIZE (SAFETY 0)))
        (IF (= START/64 END/64)
            (SETF (SB-KERNEL:%VECTOR-RAW-BITS SB-VECTOR START/64)
                    (U64-DPB
                     (LDB (BYTE (- END%64 START%64) START%64)
                          (LOGXOR +MOST-POSITIVE-WORD+
                                  (SB-KERNEL:%VECTOR-RAW-BITS SB-VECTOR
                                                              START/64)))
                     (BYTE (- END%64 START%64) START%64)
                     (SB-KERNEL:%VECTOR-RAW-BITS SB-VECTOR START/64)))
            (PROGN
             (SETF (SB-KERNEL:%VECTOR-RAW-BITS SB-VECTOR START/64)
                     (DPB (SB-KERNEL:%VECTOR-RAW-BITS SB-VECTOR START/64)
                          (BYTE START%64 0)
                          (LOGXOR +MOST-POSITIVE-WORD+
                                  (SB-KERNEL:%VECTOR-RAW-BITS SB-VECTOR
                                                              START/64))))
             (LOOP FOR I FROM (+ 1 START/64) BELOW END/64
                   DO (SETF (SB-KERNEL:%VECTOR-RAW-BITS SB-VECTOR I)
                              (LOGXOR +MOST-POSITIVE-WORD+
                                      (SB-KERNEL:%VECTOR-RAW-BITS SB-VECTOR
                                                                  I))))
             (UNLESS (ZEROP END%64)
               (SETF (SB-KERNEL:%VECTOR-RAW-BITS SB-VECTOR END/64)
                       (DPB
                        (LOGXOR +MOST-POSITIVE-WORD+
                                (SB-KERNEL:%VECTOR-RAW-BITS SB-VECTOR END/64))
                        (BYTE END%64 0)
                        (SB-KERNEL:%VECTOR-RAW-BITS SB-VECTOR END/64))))))))
    SB-VECTOR)

[cl-competitive/module/bit-basher.lisp:92]
  (DEFUN BIT-COUNT (SB-VECTOR &OPTIONAL (START 0) END)
    "Counts 1's in the range [START, END)."
    (DECLARE (OPTIMIZE (SPEED 3))
             (SIMPLE-BIT-VECTOR SB-VECTOR)
             ((MOD NIL) START)
             ((OR NULL (MOD NIL)) END))
    (SETQ END (OR END (LENGTH SB-VECTOR)))
    (ASSERT (<= START END (LENGTH SB-VECTOR)))
    (MULTIPLE-VALUE-BIND (START/64 START%64)
        (FLOOR START 64)
      (MULTIPLE-VALUE-BIND (END/64 END%64)
          (FLOOR END 64)
        (DECLARE (OPTIMIZE (SAFETY 0)))
        (IF (= START/64 END/64)
            (LOGCOUNT
             (LDB (BYTE (- END%64 START%64) START%64)
                  (SB-KERNEL:%VECTOR-RAW-BITS SB-VECTOR START/64)))
            (LET ((RESULT 0))
              (DECLARE ((MOD NIL) RESULT))
              (INCF RESULT
                    (LOGCOUNT
                     (LDB (BYTE (- 64 START%64) START%64)
                          (SB-KERNEL:%VECTOR-RAW-BITS SB-VECTOR START/64))))
              (LOOP FOR I FROM (+ 1 START/64) BELOW END/64
                    DO (INCF RESULT
                             (LOGCOUNT
                              (SB-KERNEL:%VECTOR-RAW-BITS SB-VECTOR I))))
              (UNLESS (ZEROP END%64)
                (INCF RESULT
                      (LOGCOUNT
                       (LDB (BYTE END%64 0)
                            (SB-KERNEL:%VECTOR-RAW-BITS SB-VECTOR END/64)))))
              RESULT)))))

[cl-competitive/module/crt.lisp:12]
  (DEFUN %EXT-GCD/BIGNUM (A B)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (UNSIGNED-BYTE A B))
    (LET ((Y 1) (X 0) (U 1) (V 0))
      (DECLARE (INTEGER Y X U V))
      (LOOP (WHEN (ZEROP A) (RETURN (VALUES X Y)))
            (LET ((Q (FLOOR B A)))
              (DECF X (* Q U))
              (ROTATEF X U)
              (DECF Y (* Q V))
              (ROTATEF Y V)
              (DECF B (* Q A))
              (ROTATEF B A)))))

[cl-competitive/module/dinic.lisp:9]
  (DEFUN %FILL-DIST-TABLE (GRAPH SRC DIST-TABLE QUEUE)
    "Does BFS and sets DIST-TABLE to the distance between SRC and each vertex of
GRAPH, where an edge of zero capacity is regarded as disconnected."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             ((MOD NIL) SRC)
             ((SIMPLE-ARRAY LIST (*)) GRAPH)
             ((SIMPLE-ARRAY (UNSIGNED-BYTE 32) (*)) DIST-TABLE QUEUE))
    (LET* ((Q-FRONT 0) (Q-END 0))
      (DECLARE ((MOD NIL) Q-FRONT Q-END))
      (LABELS ((ENQUEUE (OBJ)
                 (SETF (AREF QUEUE Q-END) OBJ)
                 (INCF Q-END))
               (DEQUEUE ()
                 (PROG1 (AREF QUEUE Q-FRONT) (INCF Q-FRONT))))
        (DECLARE (INLINE ENQUEUE DEQUEUE))
        (FILL DIST-TABLE +GRAPH-INF-DISTANCE+)
        (SETF (AREF DIST-TABLE SRC) 0)
        (ENQUEUE SRC)
        (LOOP UNTIL (= Q-FRONT Q-END)
              FOR VERTEX = (DEQUEUE)
              DO (DOLIST (EDGE (AREF GRAPH VERTEX))
                   (LET ((NEIGHBOR (EDGE-TO EDGE)))
                     (WHEN
                         (AND (> (EDGE-CAPACITY EDGE) 0)
                              (= +GRAPH-INF-DISTANCE+
                                 (AREF DIST-TABLE NEIGHBOR)))
                       (SETF (AREF DIST-TABLE NEIGHBOR)
                               (+ 1 (AREF DIST-TABLE VERTEX)))
                       (ENQUEUE NEIGHBOR)))))))
    DIST-TABLE)

[cl-competitive/module/dinic.lisp:42]
  (DEFUN %FIND-PATH (SRC DEST TMP-GRAPH DIST-TABLE)
    "Finds an augmenting path, sends the maximum flow through it, and returns the
amount of the flow."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             ((MOD NIL) SRC DEST)
             ((SIMPLE-ARRAY LIST (*)) TMP-GRAPH)
             ((SIMPLE-ARRAY (UNSIGNED-BYTE 32) (*)) DIST-TABLE))
    (LABELS ((DFS (V FLOW)
               (DECLARE ((MOD NIL) V)
                        ((INTEGER 0 NIL) FLOW))
               (WHEN (= V DEST) (RETURN-FROM DFS FLOW))
               (LOOP (UNLESS (AREF TMP-GRAPH V) (RETURN 0))
                     (LET ((EDGE (CAR (AREF TMP-GRAPH V))))
                       (WHEN
                           (AND (> (EDGE-CAPACITY EDGE) 0)
                                (< (AREF DIST-TABLE V)
                                   (AREF DIST-TABLE (EDGE-TO EDGE))))
                         (LET ((RESULT
                                (DFS (EDGE-TO EDGE)
                                 (MIN FLOW (EDGE-CAPACITY EDGE)))))
                           (DECLARE ((INTEGER 0 NIL) RESULT))
                           (WHEN (> RESULT 0)
                             (DECF (EDGE-CAPACITY EDGE) RESULT)
                             (INCF (EDGE-CAPACITY (EDGE-REVERSED EDGE)) RESULT)
                             (RETURN RESULT)))))
                     (POP (AREF TMP-GRAPH V)))))
      (DFS SRC MOST-POSITIVE-FIXNUM)))

[cl-competitive/module/divisor-table.lisp:10]
  (DEFUN %MAKE-DIVISORS-LIST-TABLE (MAX)
    "Returns a vector of length MAX+1 whose each cell, vector[X], is a list
containing all the divisors of X in ascending order. Time and space complexity
is O(Nlog(N)). Note that vector[0] = NIL."
    (DECLARE (OPTIMIZE (SPEED 3))
             (UINT MAX)
             (MUFFLE-CONDITIONS STYLE-WARNING))
    (LET ((RESULT (MAKE-ARRAY (+ 1 MAX) :ELEMENT-TYPE 'LIST))
          (TAILS (MAKE-ARRAY (+ 1 MAX) :ELEMENT-TYPE 'LIST)))
      (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
      (LOOP FOR I FROM 1 TO MAX
            FOR CELL = (LIST 1)
            DO (SETF (AREF RESULT I) CELL
                     (AREF TAILS I) CELL))
      (SETF (AREF RESULT 0) NIL)
      (LOOP FOR DIVISOR FROM 2 TO MAX
            DO (LOOP FOR NUMBER FROM DIVISOR TO MAX BY DIVISOR
                     DO (SETF (CDR (AREF TAILS NUMBER)) (LIST DIVISOR)
                              (AREF TAILS NUMBER) (CDR (AREF TAILS NUMBER)))))
      RESULT))

[cl-competitive/module/eratosthenes.lisp:12]
  (DEFUN MAKE-PRIME-TABLE (SUP)
    "Returns a simple-bit-vector of length SUP, whose (0-based) i-th bit is 1 if i
is prime and 0 otherwise.

Example: (make-prime-table 10) => #*0011010100"
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (CHECK-TYPE SUP (INTEGER 2 (NIL)))
    (LET ((TABLE (MAKE-ARRAY SUP :ELEMENT-TYPE 'BIT :INITIAL-ELEMENT 0))
          (SUP/64 (CEILING SUP 64)))
      (WHEN (> SUP 2)
        (DOTIMES (I SUP/64)
          (SETF (SB-KERNEL:%VECTOR-RAW-BITS TABLE I) 12297829382473034410)))
      (SETF (SBIT TABLE 1) 0
            (SBIT TABLE 2) 1)
      (LOOP FOR P FROM 3 TO (+ 1 (ISQRT (- SUP 1))) BY 2
            WHEN (= 1 (SBIT TABLE P))
            DO (LOOP FOR COMPOSITE FROM (* P P) BELOW SUP BY P
                     DO (SETF (SBIT TABLE COMPOSITE) 0)))
      TABLE))

[cl-competitive/module/eratosthenes.lisp:38]
  (DEFUN MAKE-PRIME-SEQUENCE (SUP)
    "Returns the ascending sequence of primes smaller than SUP. Internally calls
MAKE-PRIME-TABLE and returns its result as the second value."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (CHECK-TYPE SUP (INTEGER 2 (NIL)))
    (LET ((TABLE (MAKE-PRIME-TABLE SUP)))
      (LET* ((LENGTH (COUNT 1 TABLE))
             (RESULT (MAKE-ARRAY LENGTH :ELEMENT-TYPE '(INTEGER 0 NIL)))
             (INDEX 0))
        (DECLARE ((INTEGER 0 NIL) LENGTH))
        (LOOP FOR X BELOW SUP
              WHEN (= 1 (SBIT TABLE X))
              DO (SETF (AREF RESULT INDEX) X) (INCF INDEX))
        (VALUES RESULT TABLE))))

[cl-competitive/module/experimental/mod-inverse.lisp:30]
  (DEFUN %MOD-INVERSE (INTEGER MODULUS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (MUFFLE-CONDITIONS COMPILER-NOTE))
    (MACROLET ((FROB (UTYPE STYPE)
                 (ECLECTOR.READER:QUASIQUOTE
                  (LET ((A INTEGER) (B MODULUS) (U 1) (V 0))
                    (DECLARE ((ECLECTOR.READER:UNQUOTE STYPE) A B U V))
                    (LOOP UNTIL (ZEROP B)
                          FOR QUOT = (FLOOR A B)
                          DO (DECF A
                                   (THE (ECLECTOR.READER:UNQUOTE STYPE)
                                        (* QUOT B))) (ROTATEF A B) (DECF U
                                                                         (THE
                                                                          (ECLECTOR.READER:UNQUOTE
                                                                           STYPE)
                                                                          (*
                                                                           QUOT
                                                                           V))) (ROTATEF
                                                                                 U
                                                                                 V))
                    (THE (ECLECTOR.READER:UNQUOTE UTYPE)
                         (IF (< U 0)
                             (+ U MODULUS)
                             U))))))
      (TYPECASE MODULUS
        ((UNSIGNED-BYTE 31) (FROB (UNSIGNED-BYTE 31) (SIGNED-BYTE 32)))
        ((UNSIGNED-BYTE 62) (FROB (UNSIGNED-BYTE 62) (SIGNED-BYTE 63)))
        (OTHERWISE (FROB (INTEGER 0) INTEGER)))))

[cl-competitive/module/experimental/mod-inverse.lisp:53]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (LOCALLY
     (DECLARE (MUFFLE-CONDITIONS STYLE-WARNING))
     (SB-C:DEFTRANSFORM MOD-INVERSE
         ((INTEGER MODULUS) * * :NODE NODE)
       "inline modular inverse"
       (LET ((RESULT (GENSYM)))
         (ECLECTOR.READER:QUASIQUOTE
          (LET* ((INTEGER (MOD INTEGER MODULUS))
                 ((ECLECTOR.READER:UNQUOTE RESULT)
                  (%MOD-INVERSE INTEGER MODULUS)))
            (ECLECTOR.READER:UNQUOTE-SPLICING
             (WHEN (SB-C:POLICY NODE (>= SAFETY 1))
               (ECLECTOR.READER:QUASIQUOTE
                ((UNLESS
                     (OR
                      (= 1
                         (REM (* INTEGER (ECLECTOR.READER:UNQUOTE RESULT))
                              MODULUS))
                      (= 1 MODULUS))
                   (ERROR 'DIVISION-BY-ZERO :OPERANDS (LIST INTEGER MODULUS)
                          :OPERATION 'MOD-INVERSE))))))
            (ECLECTOR.READER:UNQUOTE RESULT)))))))

[cl-competitive/module/experimental/test/mod-inverse.lisp:11]
  (TEST EXPERIMENTAL/MOD-INVERSE/RANDOM
   (LET ((*NUM-TRIALS* 1000) (*TEST-DRIBBLE* NIL))
     (MACROLET ((FROB (SIGNAL-P &REST DCLS)
                  (ECLECTOR.READER:QUASIQUOTE
                   (LOCALLY
                    (DECLARE (ECLECTOR.READER:UNQUOTE-SPLICING DCLS))
                    (FOR-ALL
                     ((A (GEN-INTEGER :MIN 0 :MAX 1000))
                      (M (GEN-INTEGER :MIN 2 :MAX 1000)))
                     (IF (/= 1 (GCD A M))
                         (ECLECTOR.READER:UNQUOTE
                          (IF SIGNAL-P
                              (ECLECTOR.READER:QUASIQUOTE
                               (SIGNALS DIVISION-BY-ZERO (MOD-INVERSE A M)))
                              (ECLECTOR.READER:QUASIQUOTE
                               (FINISHES (MOD-INVERSE A M)))))
                         (IS (= 1 (MOD (* A (MOD-INVERSE A M)) M)))))
                    (FOR-ALL
                     ((A
                       (GEN-INTEGER :MIN MOST-NEGATIVE-FIXNUM :MAX
                        MOST-POSITIVE-FIXNUM))
                      (M (GEN-INTEGER :MIN 2 :MAX MOST-POSITIVE-FIXNUM)))
                     (IF (/= 1 (GCD A M))
                         (ECLECTOR.READER:UNQUOTE
                          (IF SIGNAL-P
                              (ECLECTOR.READER:QUASIQUOTE
                               (SIGNALS DIVISION-BY-ZERO (MOD-INVERSE A M)))
                              (ECLECTOR.READER:QUASIQUOTE
                               (FINISHES (MOD-INVERSE A M)))))
                         (IS (= 1 (MOD (* A (MOD-INVERSE A M)) M)))))))))
       (FROB T (INLINE MOD-INVERSE))
       (FROB NIL (INLINE MOD-INVERSE) (OPTIMIZE (SAFETY 0)))
       (FROB T (NOTINLINE MOD-INVERSE))
       (FROB T (NOTINLINE MOD-INVERSE) (OPTIMIZE (SAFETY 0))))))

[cl-competitive/module/ext-gcd.lisp:9]
  (DEFUN %EXT-GCD (A B)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (FIXNUM A B))
    (LET ((Y 1) (X 0) (U 1) (V 0))
      (DECLARE (FIXNUM Y X U V))
      (LOOP (WHEN (ZEROP A) (RETURN (VALUES X Y)))
            (LET ((Q (FLOOR B A)))
              (DECF X (THE FIXNUM (* Q U)))
              (ROTATEF X U)
              (DECF Y (THE FIXNUM (* Q V)))
              (ROTATEF Y V)
              (DECF B (THE FIXNUM (* Q A)))
              (ROTATEF B A)))))

[cl-competitive/module/f2.lisp:10]
  (DEFUN F2-GEMM (A B)
    "Calculates A*B on GF(2). The width of A (and the height of B) must be
multiple of 64."
    (DECLARE (OPTIMIZE (SPEED 3))
             ((SIMPLE-ARRAY BIT (* *)) A B))
    (MULTIPLE-VALUE-BIND (LENGTH/64 REM)
        (FLOOR (ARRAY-DIMENSION A 1) 64)
      (DECLARE (OPTIMIZE (SAFETY 0)))
      (ASSERT (ZEROP REM))
      (ASSERT (= (ARRAY-DIMENSION A 1) (ARRAY-DIMENSION B 0)))
      (LET* ((TB
              (MAKE-ARRAY (LIST (ARRAY-DIMENSION B 1) (ARRAY-DIMENSION B 0))
                          :ELEMENT-TYPE 'BIT))
             (C
              (MAKE-ARRAY (LIST (ARRAY-DIMENSION A 0) (ARRAY-DIMENSION B 1))
                          :ELEMENT-TYPE 'BIT))
             (A-STORAGE (ARRAY-STORAGE-VECTOR A))
             (TB-STORAGE (ARRAY-STORAGE-VECTOR TB)))
        (DOTIMES (ROW (ARRAY-DIMENSION B 0))
          (DOTIMES (COL (ARRAY-DIMENSION B 1))
            (SETF (AREF TB ROW COL) (AREF B COL ROW))))
        (DOTIMES (ROW (ARRAY-DIMENSION A 0))
          (DOTIMES (COL (ARRAY-DIMENSION B 1))
            (LET ((RES 0)
                  (A-INDEX (FLOOR (ARRAY-ROW-MAJOR-INDEX A ROW 0) 64))
                  (TB-INDEX (FLOOR (ARRAY-ROW-MAJOR-INDEX TB COL 0) 64)))
              (DECLARE (BIT RES))
              (DOTIMES (K LENGTH/64)
                (SETQ RES
                        (LOGXOR RES
                                (LDB (BYTE 1 0)
                                     (LOGCOUNT
                                      (LOGAND
                                       (SB-KERNEL:%VECTOR-RAW-BITS A-STORAGE
                                                                   (+ K
                                                                      A-INDEX))
                                       (SB-KERNEL:%VECTOR-RAW-BITS TB-STORAGE
                                                                   (+ K
                                                                      TB-INDEX))))))))
              (SETF (AREF C ROW COL) RES))))
        C)))

[cl-competitive/module/f2.lisp:44]
  (DEFUN F2-GEMV (A V)
    "Calculates A*v on GF(2). The width of A (and the length of v) must be
multiple of 64."
    (DECLARE (OPTIMIZE (SPEED 3))
             ((SIMPLE-ARRAY BIT (* *)) A)
             ((SIMPLE-ARRAY BIT (*)) V))
    (MULTIPLE-VALUE-BIND (LENGTH/64 REM)
        (FLOOR (LENGTH V) 64)
      (DECLARE (OPTIMIZE (SAFETY 0)))
      (ASSERT (ZEROP REM))
      (ASSERT (= (ARRAY-DIMENSION A 1) (LENGTH V)))
      (LET* ((RES (MAKE-ARRAY (ARRAY-DIMENSION A 0) :ELEMENT-TYPE 'BIT))
             (A-STORAGE (ARRAY-STORAGE-VECTOR A))
             (V-STORAGE (ARRAY-STORAGE-VECTOR V)))
        (DOTIMES (ROW (ARRAY-DIMENSION A 0))
          (LET ((VALUE 0) (A-INDEX (FLOOR (ARRAY-ROW-MAJOR-INDEX A ROW 0) 64)))
            (DECLARE (BIT VALUE))
            (DOTIMES (K LENGTH/64)
              (SETQ VALUE
                      (LOGXOR VALUE
                              (LDB (BYTE 1 0)
                                   (LOGCOUNT
                                    (LOGAND
                                     (SB-KERNEL:%VECTOR-RAW-BITS A-STORAGE
                                                                 (+ K A-INDEX))
                                     (SB-KERNEL:%VECTOR-RAW-BITS V-STORAGE
                                                                 K)))))))
            (SETF (AREF RES ROW) VALUE)))
        RES)))

[cl-competitive/module/f2.lisp:72]
  (DEFUN F2-ECHELON! (MATRIX &OPTIONAL EXTENDED)
    "Returns the row echelon form of MATRIX by gaussian elimination on GF(2). If
EXTENDED is true, the last column is regarded as the right hand side of the
linear equations and is not eliminated. This function destructively modifies
MATRIX.

The width of MATRIX must be multiple of 64."
    (DECLARE (OPTIMIZE (SPEED 3))
             ((SIMPLE-ARRAY BIT (* *)) MATRIX))
    (DESTRUCTURING-BIND
        (M N)
        (ARRAY-DIMENSIONS MATRIX)
      (DECLARE (OPTIMIZE (SAFETY 0))
               ((INTEGER 0 NIL) M N))
      (MULTIPLE-VALUE-BIND (N/64 REM)
          (FLOOR N 64)
        (ASSERT (ZEROP REM))
        (LET* ((STORAGE (ARRAY-STORAGE-VECTOR MATRIX))
               (RANK 0)
               (COLS (MAKE-ARRAY M :ELEMENT-TYPE 'FIXNUM :INITIAL-ELEMENT -1)))
          (DECLARE (FIXNUM RANK))
          (DOTIMES
              (TARGET-COL
               (IF EXTENDED
                   (- N 1)
                   N))
            (LET* ((PIVOT-ROW
                    (DO ((I RANK (+ 1 I)))
                        ((= I M) -1)
                      (UNLESS (ZEROP (AREF MATRIX I TARGET-COL)) (RETURN I)))))
              (WHEN (>= PIVOT-ROW 0)
                (LET ((PIVOT-ROW/64
                       (FLOOR (ARRAY-ROW-MAJOR-INDEX MATRIX PIVOT-ROW 0) 64))
                      (RANK-ROW/64
                       (FLOOR (ARRAY-ROW-MAJOR-INDEX MATRIX RANK 0) 64)))
                  (LOOP FOR K FROM 0 BELOW N/64
                        DO (ROTATEF
                            (SB-KERNEL:%VECTOR-RAW-BITS STORAGE
                                                        (+ RANK-ROW/64 K))
                            (SB-KERNEL:%VECTOR-RAW-BITS STORAGE
                                                        (+ PIVOT-ROW/64 K))))
                  (DOTIMES (I M)
                    (UNLESS (OR (= I RANK) (ZEROP (AREF MATRIX I TARGET-COL)))
                      (LOOP WITH BASE/64 = (FLOOR
                                            (ARRAY-ROW-MAJOR-INDEX MATRIX I 0)
                                            64)
                            FOR K BELOW N/64
                            DO (SETF (SB-KERNEL:%VECTOR-RAW-BITS STORAGE
                                                                 (+ BASE/64 K))
                                       (LOGXOR
                                        (SB-KERNEL:%VECTOR-RAW-BITS STORAGE
                                                                    (+ BASE/64
                                                                       K))
                                        (SB-KERNEL:%VECTOR-RAW-BITS STORAGE
                                                                    (+
                                                                     RANK-ROW/64
                                                                     K))))))))
                (SETF (AREF COLS RANK) TARGET-COL)
                (INCF RANK))))
          (VALUES MATRIX COLS RANK)))))

[cl-competitive/module/f2.lisp:116]
  (DEFUN F2-SOLVE-LINEAR-SYSTEM! (MATRIX VECTOR)
    "Solves Ax = b on GF(2) and returns a root if it exists. Otherwise it returns
NIL. In addition, this function returns the rank of A as the second value. This
function destructively modifies MATRIX and VECTOR.

The width of A must be multiple of 64."
    (DECLARE (OPTIMIZE (SPEED 3))
             ((SIMPLE-ARRAY BIT (* *)) MATRIX)
             (SIMPLE-BIT-VECTOR VECTOR))
    (DESTRUCTURING-BIND
        (M N)
        (ARRAY-DIMENSIONS MATRIX)
      (DECLARE (OPTIMIZE (SAFETY 0))
               ((INTEGER 0 NIL) M N))
      (MULTIPLE-VALUE-BIND (N/64 REM)
          (FLOOR N 64)
        (ASSERT (AND (ZEROP REM) (= M (LENGTH VECTOR))))
        (LET* ((STORAGE (ARRAY-STORAGE-VECTOR MATRIX))
               (RANK 0)
               (COLS (MAKE-ARRAY M :ELEMENT-TYPE 'FIXNUM :INITIAL-ELEMENT -1)))
          (DECLARE (FIXNUM RANK))
          (DOTIMES (TARGET-COL N)
            (LET* ((PIVOT-ROW
                    (DO ((I RANK (+ 1 I)))
                        ((= I M) -1)
                      (UNLESS (ZEROP (AREF MATRIX I TARGET-COL)) (RETURN I)))))
              (WHEN (>= PIVOT-ROW 0)
                (LET ((PIVOT-ROW/64
                       (FLOOR (ARRAY-ROW-MAJOR-INDEX MATRIX PIVOT-ROW 0) 64))
                      (RANK-ROW/64
                       (FLOOR (ARRAY-ROW-MAJOR-INDEX MATRIX RANK 0) 64)))
                  (ROTATEF (AREF VECTOR RANK) (AREF VECTOR PIVOT-ROW))
                  (LOOP FOR K FROM 0 BELOW N/64
                        DO (ROTATEF
                            (SB-KERNEL:%VECTOR-RAW-BITS STORAGE
                                                        (+ RANK-ROW/64 K))
                            (SB-KERNEL:%VECTOR-RAW-BITS STORAGE
                                                        (+ PIVOT-ROW/64 K))))
                  (DOTIMES (I M)
                    (UNLESS (OR (= I RANK) (ZEROP (AREF MATRIX I TARGET-COL)))
                      (SETF (AREF VECTOR I)
                              (LOGXOR (AREF VECTOR I) (AREF VECTOR RANK)))
                      (LOOP WITH BASE/64 = (FLOOR
                                            (ARRAY-ROW-MAJOR-INDEX MATRIX I 0)
                                            64)
                            FOR K BELOW N/64
                            DO (SETF (SB-KERNEL:%VECTOR-RAW-BITS STORAGE
                                                                 (+ BASE/64 K))
                                       (LOGXOR
                                        (SB-KERNEL:%VECTOR-RAW-BITS STORAGE
                                                                    (+ BASE/64
                                                                       K))
                                        (SB-KERNEL:%VECTOR-RAW-BITS STORAGE
                                                                    (+
                                                                     RANK-ROW/64
                                                                     K))))))))
                (SETF (AREF COLS RANK) TARGET-COL)
                (INCF RANK))))
          (IF (LOOP FOR I FROM RANK BELOW M
                    ALWAYS (ZEROP (AREF VECTOR I)))
              (LET ((RESULT
                     (MAKE-ARRAY N :ELEMENT-TYPE 'BIT :INITIAL-ELEMENT 0)))
                (DOTIMES (I M)
                  (LET ((J (AREF COLS I)))
                    (WHEN (>= J 0) (SETF (AREF RESULT J) (AREF VECTOR I)))))
                (VALUES RESULT RANK))
              (VALUES NIL RANK))))))

[cl-competitive/module/fast-gcd.lisp:15]
  (DEFUN %FAST-GCD (U V)
    (DECLARE ((INTEGER 0 NIL) U V))
    (LET ((SHIFT (TZCOUNT (LOGIOR U V))))
      (DECLARE (OPTIMIZE (SAFETY 0)))
      (SETQ U (ASH U (- (TZCOUNT U))))
      (LOOP (SETQ V (ASH V (- (TZCOUNT V))))
            (WHEN (> U V) (ROTATEF U V))
            (DECF V U)
            (WHEN (ZEROP V) (RETURN (THE (INTEGER 1 NIL) (ASH U SHIFT)))))))

[cl-competitive/module/fft-real.lisp:20]
  (DEFUN %DFT! (F)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             ((SIMPLE-ARRAY FFT-FLOAT (*)) F))
    (PROG1 F
      (LET ((N (LENGTH F)) (THETA (COERCE (* -2 PI) 'FFT-FLOAT)))
        (DECLARE (FFT-FLOAT THETA))
        (ASSERT (POWER2-P N))
        (LET ((I 0))
          (DECLARE ((MOD NIL) I))
          (LOOP FOR J FROM 1 BELOW (- N 1)
                DO (LOOP FOR K OF-TYPE (MOD NIL) = (ASH N -1) THEN (ASH K -1)
                         WHILE (> K (SETQ I (LOGXOR I K)))) (WHEN (< J I)
                                                              (ROTATEF
                                                               (AREF F I)
                                                               (AREF F J)))))
        (DO* ((MH 1 M)
              (M (ASH MH 1) (ASH MH 1)))
             ((> M N))
          (DECLARE ((MOD NIL) MH M))
          (LET ((MQ (ASH MH -1)))
            (SETQ THETA (/ THETA 2))
            (DO ((JR 0 (+ JR M)))
                ((>= JR N))
              (DECLARE ((MOD NIL) JR))
              (LET ((XREAL (AREF F (+ JR MH))))
                (SETF (AREF F (+ JR MH)) (- (AREF F JR) XREAL))
                (INCF (AREF F JR) XREAL)))
            (DO ((I 1 (+ I 1)))
                ((>= I MQ))
              (DECLARE ((MOD NIL) I))
              (LET ((WREAL (COS (* THETA I))) (WIMAG (SIN (* THETA I))))
                (DO ((J 0 (+ J M)))
                    ((>= J N))
                  (LET* ((J+MH (+ J MH))
                         (J+M-I (- (+ J M) I))
                         (XREAL
                          (+ (* WREAL (AREF F (+ J+MH I)))
                             (* WIMAG (AREF F J+M-I))))
                         (XIMAG
                          (- (* WREAL (AREF F J+M-I))
                             (* WIMAG (AREF F (+ J+MH I))))))
                    (DECLARE ((MOD NIL) J+MH J+M-I))
                    (SETF (AREF F (+ J+MH I))
                            (+ (- (AREF F (- J+MH I))) XIMAG))
                    (SETF (AREF F J+M-I) (+ (AREF F (- J+MH I)) XIMAG))
                    (SETF (AREF F (- J+MH I)) (+ (AREF F (+ J I)) (- XREAL)))
                    (INCF (AREF F (+ J I)) XREAL))))))))))

[cl-competitive/module/fft-real.lisp:73]
  (DEFUN %INVERSE-DFT! (F)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             ((SIMPLE-ARRAY FFT-FLOAT (*)) F))
    (PROG1 F
      (LET* ((N (LENGTH F)) (THETA (/ (COERCE (* 2 PI) 'FFT-FLOAT) N)))
        (DECLARE (FFT-FLOAT THETA))
        (ASSERT (POWER2-P N))
        (SETF (AREF F 0) (/ (AREF F 0) 2))
        (SETF (AREF F (ASH N -1)) (/ (AREF F (ASH N -1)) 2))
        (DO* ((M N MH)
              (MH (ASH M -1) (ASH M -1)))
             ((ZEROP MH))
          (DECLARE ((MOD NIL) M MH))
          (LET ((MQ (ASH MH -1)))
            (DO ((JR 0 (+ JR M)))
                ((>= JR N))
              (DECLARE ((MOD NIL) JR))
              (LET ((XREAL (- (AREF F JR) (AREF F (+ JR MH)))))
                (INCF (AREF F JR) (AREF F (+ JR MH)))
                (SETF (AREF F (+ JR MH)) XREAL)))
            (DO ((I 1 (+ I 1)))
                ((>= I MQ))
              (LET ((WREAL (COS (* THETA I))) (WIMAG (SIN (* THETA I))))
                (DO ((J 0 (+ J M)))
                    ((>= J N))
                  (LET* ((J+MH (+ J MH))
                         (J+M-I (- (+ J M) I))
                         (XREAL (- (AREF F (+ J I)) (AREF F (- J+MH I))))
                         (XIMAG (+ (AREF F J+M-I) (AREF F (+ J+MH I)))))
                    (DECLARE ((MOD NIL) J+MH J+M-I))
                    (INCF (AREF F (+ J I)) (AREF F (- J+MH I)))
                    (SETF (AREF F (- J+MH I))
                            (- (AREF F J+M-I) (AREF F (+ J+MH I))))
                    (SETF (AREF F (+ J+MH I))
                            (+ (* WREAL XREAL) (* WIMAG XIMAG)))
                    (SETF (AREF F J+M-I)
                            (- (* WREAL XIMAG) (* WIMAG XREAL))))))))
          (SETQ THETA (* THETA 2)))
        (LET ((I 0))
          (DECLARE ((MOD NIL) I))
          (LOOP FOR J FROM 1 BELOW (- N 1)
                DO (LOOP FOR K OF-TYPE (MOD NIL) = (ASH N -1) THEN (ASH K -1)
                         WHILE (> K (SETQ I (LOGXOR I K)))) (WHEN (< J I)
                                                              (ROTATEF
                                                               (AREF F I)
                                                               (AREF F J))))))))

[cl-competitive/module/fft-real.lisp:129]
  (DEFUN %MAKE-TRIFUNC-TABLE (N)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (CHECK-TYPE N (MOD NIL))
    (ASSERT (POWER2-P N))
    (LET ((COS-TABLE (MAKE-ARRAY (ASH N -2) :ELEMENT-TYPE 'FFT-FLOAT))
          (SIN-TABLE (MAKE-ARRAY (ASH N -2) :ELEMENT-TYPE 'FFT-FLOAT))
          (THETA (/ (COERCE (* 2 PI) 'FFT-FLOAT) N)))
      (DOTIMES (I (ASH N -2))
        (SETF (AREF COS-TABLE I) (COS (* I THETA))
              (AREF SIN-TABLE I) (SIN (* I THETA))))
      (VALUES COS-TABLE SIN-TABLE)))

[cl-competitive/module/fft-real.lisp:154]
  (DEFUN %DFT-FIXED-BASE! (F)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             ((SIMPLE-ARRAY FFT-FLOAT (*)) F))
    (PROG1 F
      (LET* ((N (LENGTH F))
             (COS-TABLE *COS-TABLE*)
             (SIN-TABLE *SIN-TABLE*)
             (FACTOR N))
        (DECLARE ((MOD NIL) FACTOR)
                 ((SIMPLE-ARRAY FFT-FLOAT (*)) COS-TABLE SIN-TABLE))
        (ASSERT (POWER2-P N))
        (ASSERT (= (ASH N -2) (LENGTH COS-TABLE)))
        (LET ((I 0))
          (DECLARE ((MOD NIL) I))
          (LOOP FOR J FROM 1 BELOW (- N 1)
                DO (LOOP FOR K OF-TYPE (MOD NIL) = (ASH N -1) THEN (ASH K -1)
                         WHILE (> K (SETQ I (LOGXOR I K)))) (WHEN (< J I)
                                                              (ROTATEF
                                                               (AREF F I)
                                                               (AREF F J)))))
        (DO* ((MH 1 M)
              (M (ASH MH 1) (ASH MH 1)))
             ((> M N))
          (DECLARE ((MOD NIL) MH M))
          (LET ((MQ (ASH MH -1)))
            (SETQ FACTOR (ASH FACTOR -1))
            (DO ((JR 0 (+ JR M)))
                ((>= JR N))
              (DECLARE ((MOD NIL) JR))
              (LET ((XREAL (AREF F (+ JR MH))))
                (SETF (AREF F (+ JR MH)) (- (AREF F JR) XREAL))
                (INCF (AREF F JR) XREAL)))
            (DO ((I 1 (+ I 1)))
                ((>= I MQ))
              (DECLARE ((MOD NIL) I))
              (LET* ((INDEX (THE FIXNUM (* FACTOR I)))
                     (WREAL (AREF COS-TABLE INDEX))
                     (WIMAG (- (AREF SIN-TABLE INDEX))))
                (DO ((J 0 (+ J M)))
                    ((>= J N))
                  (LET* ((J+MH (+ J MH))
                         (J+M-I (- (+ J M) I))
                         (XREAL
                          (+ (* WREAL (AREF F (+ J+MH I)))
                             (* WIMAG (AREF F J+M-I))))
                         (XIMAG
                          (- (* WREAL (AREF F J+M-I))
                             (* WIMAG (AREF F (+ J+MH I))))))
                    (DECLARE ((MOD NIL) J+MH J+M-I))
                    (SETF (AREF F (+ J+MH I))
                            (+ (- (AREF F (- J+MH I))) XIMAG))
                    (SETF (AREF F J+M-I) (+ (AREF F (- J+MH I)) XIMAG))
                    (SETF (AREF F (- J+MH I)) (+ (AREF F (+ J I)) (- XREAL)))
                    (INCF (AREF F (+ J I)) XREAL))))))))))

[cl-competitive/module/fft-real.lisp:210]
  (DEFUN %INVERSE-DFT-FIXED-BASE! (F)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             ((SIMPLE-ARRAY FFT-FLOAT (*)) F))
    (PROG1 F
      (LET* ((N (LENGTH F))
             (COS-TABLE *COS-TABLE*)
             (SIN-TABLE *SIN-TABLE*)
             (FACTOR 1))
        (DECLARE ((MOD NIL) FACTOR)
                 ((SIMPLE-ARRAY FFT-FLOAT (*)) COS-TABLE SIN-TABLE))
        (ASSERT (POWER2-P N))
        (ASSERT (= (ASH N -2) (LENGTH COS-TABLE)))
        (SETF (AREF F 0) (/ (AREF F 0) 2))
        (SETF (AREF F (ASH N -1)) (/ (AREF F (ASH N -1)) 2))
        (DO* ((M N MH)
              (MH (ASH M -1) (ASH M -1)))
             ((ZEROP MH))
          (DECLARE ((MOD NIL) M MH))
          (LET ((MQ (ASH MH -1)))
            (DO ((JR 0 (+ JR M)))
                ((>= JR N))
              (DECLARE ((MOD NIL) JR))
              (LET ((XREAL (- (AREF F JR) (AREF F (+ JR MH)))))
                (INCF (AREF F JR) (AREF F (+ JR MH)))
                (SETF (AREF F (+ JR MH)) XREAL)))
            (DO ((I 1 (+ I 1)))
                ((>= I MQ))
              (LET* ((INDEX (THE FIXNUM (* FACTOR I)))
                     (WREAL (AREF COS-TABLE INDEX))
                     (WIMAG (AREF SIN-TABLE INDEX)))
                (DO ((J 0 (+ J M)))
                    ((>= J N))
                  (LET* ((J+MH (+ J MH))
                         (J+M-I (- (+ J M) I))
                         (XREAL (- (AREF F (+ J I)) (AREF F (- J+MH I))))
                         (XIMAG (+ (AREF F J+M-I) (AREF F (+ J+MH I)))))
                    (DECLARE ((MOD NIL) J+MH J+M-I))
                    (INCF (AREF F (+ J I)) (AREF F (- J+MH I)))
                    (SETF (AREF F (- J+MH I))
                            (- (AREF F J+M-I) (AREF F (+ J+MH I))))
                    (SETF (AREF F (+ J+MH I))
                            (+ (* WREAL XREAL) (* WIMAG XIMAG)))
                    (SETF (AREF F J+M-I)
                            (- (* WREAL XIMAG) (* WIMAG XREAL))))))))
          (SETQ FACTOR (ASH FACTOR 1)))
        (LET ((I 0))
          (DECLARE ((MOD NIL) I))
          (LOOP FOR J FROM 1 BELOW (- N 1)
                DO (LOOP FOR K OF-TYPE (MOD NIL) = (ASH N -1) THEN (ASH K -1)
                         WHILE (> K (SETQ I (LOGXOR I K)))) (WHEN (< J I)
                                                              (ROTATEF
                                                               (AREF F I)
                                                               (AREF F J))))))))

[cl-competitive/module/fft.lisp:18]
  (DEFUN %DFT! (F SIGN)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             ((SIMPLE-ARRAY (COMPLEX FFT-FLOAT) (*)) F)
             ((INTEGER -1 1) SIGN))
    (PROG1 F
      (LET* ((N (LENGTH F)) (THETA (* SIGN (/ (COERCE (* 2 PI) 'FFT-FLOAT) N))))
        (DECLARE (FFT-FLOAT THETA))
        (ASSERT (POWER2-P N))
        (DO ((M N (ASH M -1)))
            ((= M 1))
          (DECLARE ((INTEGER 0 NIL) M))
          (LET ((MH (ASH M -1)))
            (DECLARE ((INTEGER 0 NIL) MH))
            (DOTIMES (I MH)
              (LET ((W (CIS (* I THETA))))
                (DO ((J I (+ J M)))
                    ((>= J N))
                  (DECLARE ((INTEGER 0 NIL) J))
                  (LET* ((K (+ J MH)) (XT (- (AREF F J) (AREF F K))))
                    (DECLARE ((INTEGER 0 NIL) K))
                    (INCF (AREF F J) (AREF F K))
                    (SETF (AREF F K) (* W XT))))))
            (SETQ THETA (* THETA 2))))
        (LET ((I 0))
          (DECLARE ((INTEGER 0 NIL) I))
          (LOOP FOR J FROM 1 BELOW (- N 1)
                DO (LOOP FOR K OF-TYPE (INTEGER 0 NIL) = (ASH N -1) THEN (ASH K
                                                                              -1)
                         WHILE (> K (SETQ I (LOGXOR I K)))) (WHEN (< J I)
                                                              (ROTATEF
                                                               (AREF F I)
                                                               (AREF F J))))))))

[cl-competitive/module/fft.lisp:80]
  (DEFUN %DFT-CACHED-CIS! (F SIGN)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             ((SIMPLE-ARRAY (COMPLEX FFT-FLOAT) (*)) F)
             ((INTEGER -1 1) SIGN))
    (PROG1 F
      (LET ((N (LENGTH F))
            (TABLE
             (IF (= 1 SIGN)
                 *EXP-TABLE+*
                 *EXP-TABLE-*)))
        (DECLARE ((SIMPLE-ARRAY (COMPLEX FFT-FLOAT) (*)) TABLE))
        (ASSERT (POWER2-P N))
        (ASSERT (>= (LENGTH TABLE) (ASH N -1)))
        (DO ((M N (ASH M -1))
             (SHIFT 0 (+ SHIFT 1)))
            ((= M 1))
          (DECLARE ((INTEGER 0 NIL) M SHIFT))
          (LET ((MH (ASH M -1)))
            (DOTIMES (I MH)
              (DO ((J I (+ J M)))
                  ((>= J N))
                (DECLARE ((INTEGER 0 NIL) J))
                (LET* ((K (+ J MH))
                       (XT (- (AREF F J) (AREF F K)))
                       (CIS-INDEX (ASH I SHIFT)))
                  (DECLARE ((INTEGER 0 NIL) K CIS-INDEX))
                  (INCF (AREF F J) (AREF F K))
                  (SETF (AREF F K) (* (AREF TABLE CIS-INDEX) XT)))))))
        (LET ((I 0))
          (DECLARE ((INTEGER 0 NIL) I))
          (LOOP FOR J FROM 1 BELOW (- N 1)
                DO (LOOP FOR K OF-TYPE (INTEGER 0 NIL) = (ASH N -1) THEN (ASH K
                                                                              -1)
                         WHILE (> K (SETQ I (LOGXOR I K)))) (WHEN (< J I)
                                                              (ROTATEF
                                                               (AREF F I)
                                                               (AREF F J))))))))

[cl-competitive/module/ford-fulkerson.lisp:10]
  (DEFUN %FIND-FLOW (GRAPH SRC DEST CHECKED)
    "DFS"
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             ((MOD NIL) SRC DEST)
             (SIMPLE-BIT-VECTOR CHECKED)
             ((SIMPLE-ARRAY LIST (*)) GRAPH))
    (FILL CHECKED 0)
    (LABELS ((DFS (VERTEX FLOW)
               (DECLARE ((INTEGER 0 NIL) FLOW))
               (SETF (AREF CHECKED VERTEX) 1)
               (IF (= VERTEX DEST)
                   FLOW
                   (DOLIST (EDGE (AREF GRAPH VERTEX) 0)
                     (WHEN
                         (AND (ZEROP (AREF CHECKED (EDGE-TO EDGE)))
                              (> (EDGE-CAPACITY EDGE) 0))
                       (LET ((FLOW
                              (DFS (EDGE-TO EDGE)
                               (MIN FLOW (EDGE-CAPACITY EDGE)))))
                         (DECLARE ((INTEGER 0 NIL) FLOW))
                         (UNLESS (ZEROP FLOW)
                           (DECF (EDGE-CAPACITY EDGE) FLOW)
                           (INCF (EDGE-CAPACITY (EDGE-REVERSED EDGE)) FLOW)
                           (RETURN FLOW))))))))
      (DFS SRC MOST-POSITIVE-FIXNUM)))

[cl-competitive/module/hopcroft-karp.lisp:32]
  (DEFUN %FILL-LEVELS (BGRAPH LEVELS1 LEVELS2 QUEUE)
    "Does BFS and fills LEVELS."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             ((SIMPLE-ARRAY (UNSIGNED-BYTE 32) (*)) LEVELS1 LEVELS2 QUEUE))
    (LET ((GRAPH1 (BGRAPH-GRAPH1 BGRAPH))
          (MATCHING1 (BGRAPH-MATCHING1 BGRAPH))
          (MATCHING2 (BGRAPH-MATCHING2 BGRAPH))
          (Q-FRONT 0)
          (Q-END 0)
          (FOUND NIL))
      (DECLARE ((MOD NIL) Q-FRONT Q-END))
      (LABELS ((ENQUEUE (OBJ)
                 (SETF (AREF QUEUE Q-END) OBJ)
                 (INCF Q-END))
               (DEQUEUE ()
                 (PROG1 (AREF QUEUE Q-FRONT) (INCF Q-FRONT))))
        (DECLARE (INLINE ENQUEUE DEQUEUE))
        (FILL LEVELS1 +GRAPH-INF-DISTANCE+)
        (FILL LEVELS2 +GRAPH-INF-DISTANCE+)
        (DOTIMES (I (BGRAPH-SIZE1 BGRAPH))
          (WHEN (= -1 (AREF MATCHING1 I))
            (SETF (AREF LEVELS1 I) 0)
            (ENQUEUE I)))
        (LOOP UNTIL (= Q-FRONT Q-END)
              FOR VERTEX = (DEQUEUE)
              DO (DOLIST (NEXT (AREF GRAPH1 VERTEX))
                   (WHEN (= +GRAPH-INF-DISTANCE+ (AREF LEVELS2 NEXT))
                     (SETF (AREF LEVELS2 NEXT) (+ 1 (AREF LEVELS1 VERTEX)))
                     (LET ((PARTNER (AREF MATCHING2 NEXT)))
                       (WHEN (= -1 PARTNER) (SETQ FOUND T) (RETURN))
                       (SETF (AREF LEVELS1 PARTNER) (+ 1 (AREF LEVELS2 NEXT)))
                       (ENQUEUE PARTNER))))))
      FOUND))

[cl-competitive/module/hopcroft-karp.lisp:69]
  (DEFUN %FIND-MATCHING (BGRAPH SRC LEVELS1 LEVELS2)
    "Does DFS and makes matching greedily on the residual network."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             ((MOD NIL) SRC)
             ((SIMPLE-ARRAY (UNSIGNED-BYTE 32) (*)) LEVELS1 LEVELS2))
    (LET ((MATCHING1 (BGRAPH-MATCHING1 BGRAPH))
          (MATCHING2 (BGRAPH-MATCHING2 BGRAPH))
          (GRAPH1 (BGRAPH-GRAPH1 BGRAPH)))
      (LABELS ((DFS (V)
                 (DECLARE ((MOD NIL) V))
                 (DOLIST (NEXT (AREF GRAPH1 V))
                   (WHEN (= (AREF LEVELS2 NEXT) (+ 1 (AREF LEVELS1 V)))
                     (SETF (AREF LEVELS2 NEXT) +GRAPH-INF-DISTANCE+)
                     (LET ((PARTNER (AREF MATCHING2 NEXT)))
                       (WHEN (OR (= -1 PARTNER) (DFS PARTNER))
                         (SETF (AREF MATCHING1 V) NEXT
                               (AREF MATCHING2 NEXT) V
                               (AREF LEVELS1 V) +GRAPH-INF-DISTANCE+)
                         (RETURN-FROM DFS T)))))
                 (SETF (AREF LEVELS1 V) +GRAPH-INF-DISTANCE+)
                 NIL))
        (DFS SRC))))

[cl-competitive/module/implicit-treap.lisp:139]
  (DEFUN %HEAPIFY (NODE)
    "Makes it max-heap w.r.t. priorities by swapping the priorities of the whole
treap."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (WHEN NODE
      (LET ((HIGH-PRIORITY-NODE NODE))
        (WHEN
            (AND (%ITREAP-LEFT NODE)
                 (> (%ITREAP-PRIORITY (%ITREAP-LEFT NODE))
                    (%ITREAP-PRIORITY HIGH-PRIORITY-NODE)))
          (SETQ HIGH-PRIORITY-NODE (%ITREAP-LEFT NODE)))
        (WHEN
            (AND (%ITREAP-RIGHT NODE)
                 (> (%ITREAP-PRIORITY (%ITREAP-RIGHT NODE))
                    (%ITREAP-PRIORITY HIGH-PRIORITY-NODE)))
          (SETQ HIGH-PRIORITY-NODE (%ITREAP-RIGHT NODE)))
        (UNLESS (EQL HIGH-PRIORITY-NODE NODE)
          (ROTATEF (%ITREAP-PRIORITY HIGH-PRIORITY-NODE)
                   (%ITREAP-PRIORITY NODE))
          (%HEAPIFY HIGH-PRIORITY-NODE)))))

[cl-competitive/module/integer-root.lisp:48]
  (DEFUN IROOT (X INDEX)
    "Returns the greatest integer less than or equal to the non-negative INDEX-th
root of X."
    (DECLARE (OPTIMIZE (SPEED 3))
             (UINT X)
             ((INTEGER 1) INDEX))
    (LOCALLY
     (DECLARE (OPTIMIZE (SAFETY 0)))
     (COND ((ZEROP X) 0) ((> INDEX +BIT-WIDTH+) 1)
           ((>= INDEX 3)
            (LET ((OK 0) (NG (AREF *SUPREMUMS* INDEX)))
              (DECLARE (UINT OK NG))
              (LOOP UNTIL (= (THE UINT (- NG OK)) 1)
                    FOR MID = (LDB (BYTE +BIT-WIDTH+ 0)
                                   (+ (ASH NG -1) (ASH OK -1)
                                      (ASH (+ (LOGAND NG 1) (LOGAND OK 1))
                                           -1)))
                    WHEN (<= (%POWER MID INDEX) X)
                    DO (SETQ OK MID) ELSE
                    DO (SETQ NG MID))
              OK))
           ((= INDEX 2) (ISQRT X)) (T X))))

[cl-competitive/module/linear-sieve.lisp:34]
  (DEFUN MAKE-MINFACTOR-TABLE (SUP)
    "Returns a vector of length SUP, whose (0-based) i-th value is the smallest
prime factor of i. (Corner case: 0th value is 0 and 1st value is 1.) This
function returns an ascending vector of primes (less than SUP) as the second
value."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (CHECK-TYPE SUP (AND UINT (INTEGER 2)))
    (LET* ((TABLE (MAKE-ARRAY SUP :ELEMENT-TYPE 'UINT :INITIAL-ELEMENT 0))
           (UB (%CALC-PI-UPPER-BOUND (- SUP 1)))
           (PRIMES (MAKE-ARRAY UB :ELEMENT-TYPE 'UINT))
           (END 0))
      (DECLARE (UINT END))
      (SETF (AREF TABLE 1) 1)
      (LOOP FOR X FROM 2 BELOW SUP
            WHEN (ZEROP (AREF TABLE X))
            DO (SETF (AREF TABLE X) X) (SETF (AREF PRIMES END) X) (INCF END)
            DO (DOTIMES (I END)
                 (LET ((P (AREF PRIMES I)))
                   (WHEN (OR (>= (* P X) SUP) (> P (AREF TABLE X))) (RETURN))
                   (SETF (AREF TABLE (* P X)) P))))
      (VALUES TABLE (ADJUST-ARRAY PRIMES END))))

[cl-competitive/module/mod-inverse.lisp:27]
  (DEFUN %MOD-INVERSE (INTEGER MODULUS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (MUFFLE-CONDITIONS COMPILER-NOTE))
    (MACROLET ((FROB (UTYPE STYPE)
                 (ECLECTOR.READER:QUASIQUOTE
                  (LET ((A INTEGER) (B MODULUS) (U 1) (V 0))
                    (DECLARE ((ECLECTOR.READER:UNQUOTE STYPE) A B U V))
                    (LOOP UNTIL (ZEROP B)
                          FOR QUOT = (FLOOR A B)
                          DO (DECF A
                                   (THE (ECLECTOR.READER:UNQUOTE STYPE)
                                        (* QUOT B))) (ROTATEF A B) (DECF U
                                                                         (THE
                                                                          (ECLECTOR.READER:UNQUOTE
                                                                           STYPE)
                                                                          (*
                                                                           QUOT
                                                                           V))) (ROTATEF
                                                                                 U
                                                                                 V))
                    (THE (ECLECTOR.READER:UNQUOTE UTYPE)
                         (IF (< U 0)
                             (+ U MODULUS)
                             U))))))
      (TYPECASE MODULUS
        ((UNSIGNED-BYTE 31) (FROB (UNSIGNED-BYTE 31) (SIGNED-BYTE 32)))
        ((UNSIGNED-BYTE 62) (FROB (UNSIGNED-BYTE 62) (SIGNED-BYTE 63)))
        (OTHERWISE (FROB (INTEGER 0) INTEGER)))))

[cl-competitive/module/mod-log.lisp:7]
  (DEFUN MOD-LOG (X Y MODULUS &KEY FROM-ZERO)
    "Returns the smallest positive (or non-negative, when FROM-ZERO is true)
integer k that satiefies x^k = y mod p. Returns NIL if it is infeasible."
    (DECLARE (OPTIMIZE (SPEED 3))
             (INTEGER X Y)
             ((INTEGER 1 NIL) MODULUS))
    (LET ((X (MOD X MODULUS)) (Y (MOD Y MODULUS)) (G (GCD X MODULUS)))
      (DECLARE (OPTIMIZE (SAFETY 0))
               ((MOD NIL) X Y G))
      (WHEN (AND FROM-ZERO (OR (= Y 1) (= MODULUS 1))) (RETURN-FROM MOD-LOG 0))
      (IF (= G 1)
          (LET* ((M (+ 1 (ISQRT (- MODULUS 1))))
                 (X^M
                  (LOOP FOR I BELOW M
                        FOR RES OF-TYPE (INTEGER 0 NIL) = X THEN (MOD (* RES X)
                                                                      MODULUS)
                        FINALLY (RETURN RES)))
                 (TABLE (MAKE-HASH-TABLE :SIZE M :TEST 'EQ)))
            (LOOP FOR J FROM 0 BELOW M
                  FOR RES OF-TYPE (INTEGER 0 NIL) = Y THEN (MOD (* RES X)
                                                                MODULUS)
                  DO (SETF (GETHASH RES TABLE) J))
            (LOOP FOR I FROM 1 TO M
                  FOR X^M^I OF-TYPE (INTEGER 0 NIL) = X^M THEN (MOD
                                                                (* X^M^I X^M)
                                                                MODULUS)
                  FOR J = (GETHASH X^M^I TABLE)
                  WHEN J
                  DO (LOCALLY
                      (DECLARE ((INTEGER 0 NIL) J))
                      (RETURN (- (* I M) J)))
                  FINALLY (RETURN NIL)))
          (IF (= X Y)
              1
              (MULTIPLE-VALUE-BIND (Y-PRIME REM)
                  (FLOOR Y G)
                (IF (ZEROP REM)
                    (LET* ((X-PRIME (FLOOR X G))
                           (P-PRIME (FLOOR MODULUS G))
                           (NEXT-RHS
                            (MOD (* Y-PRIME (MOD-INVERSE X-PRIME P-PRIME))
                                 P-PRIME))
                           (RES (MOD-LOG X NEXT-RHS P-PRIME)))
                      (DECLARE ((INTEGER 0 NIL) X-PRIME P-PRIME NEXT-RHS))
                      (IF RES
                          (+ 1 RES)
                          NIL))
                    NIL))))))

[cl-competitive/module/ntt.lisp:86]
  (DEFMACRO DEFINE-NTT
            (MODULUS
             &KEY NTT INVERSE-NTT CONVOLVE MOD-INVERSE MOD-POWER &ENVIRONMENT
             ENV)
    (ASSERT (CONSTANTP MODULUS ENV))
    (LET* ((MODULUS (SB-INT:CONSTANT-FORM-VALUE MODULUS ENV))
           (NTT (OR NTT (INTERN "NTT!")))
           (INVERSE-NTT (OR INVERSE-NTT (INTERN "INVERSE-NTT!")))
           (CONVOLVE (OR CONVOLVE (INTERN "CONVOLVE")))
           (MOD-POWER (OR MOD-POWER (GENSYM "MOD-POWER")))
           (MOD-INVERSE (OR MOD-INVERSE (GENSYM "MOD-INVERSE")))
           (NTT-BASE (GENSYM "*NTT-BASE*"))
           (NTT-INV-BASE (GENSYM "*NTT-INV-BASE*"))
           (BASE-SIZE (%TZCOUNT (- MODULUS 1)))
           (ROOT (%CALC-GENERATOR MODULUS))
           (MODULUS (SB-INT:CONSTANT-FORM-VALUE MODULUS ENV)))
      (DECLARE (NTT-INT MODULUS))
      (ECLECTOR.READER:QUASIQUOTE
       (PROGN
        (DECLAIM (INLINE (ECLECTOR.READER:UNQUOTE MOD-POWER)))
        (DEFUN (ECLECTOR.READER:UNQUOTE MOD-POWER) (BASE EXP)
          (DECLARE (NTT-INT BASE)
                   ((INTEGER 0 NIL) EXP))
          (LET ((RES 1))
            (DECLARE (NTT-INT RES))
            (LOOP WHILE (> EXP 0)
                  WHEN (ODDP EXP)
                  DO (SETQ RES
                             (MOD (* RES BASE)
                                  (ECLECTOR.READER:UNQUOTE MODULUS)))
                  DO (SETQ BASE
                             (MOD (* BASE BASE)
                                  (ECLECTOR.READER:UNQUOTE MODULUS))
                           EXP (ASH EXP -1)))
            RES))
        (DECLAIM (INLINE (ECLECTOR.READER:UNQUOTE MOD-INVERSE)))
        (DEFUN (ECLECTOR.READER:UNQUOTE MOD-INVERSE) (X)
          ((ECLECTOR.READER:UNQUOTE MOD-POWER) X
           (- (ECLECTOR.READER:UNQUOTE MODULUS) 2)))
        (DECLAIM
         (NTT-VECTOR (ECLECTOR.READER:UNQUOTE NTT-BASE)
          (ECLECTOR.READER:UNQUOTE NTT-INV-BASE)))
        (DEFINE-LOAD-TIME-GLOBAL (ECLECTOR.READER:UNQUOTE NTT-BASE)
                                 (MAKE-ARRAY
                                  (ECLECTOR.READER:UNQUOTE BASE-SIZE)
                                  :ELEMENT-TYPE 'NTT-INT))
        (DEFINE-LOAD-TIME-GLOBAL (ECLECTOR.READER:UNQUOTE NTT-INV-BASE)
                                 (MAKE-ARRAY
                                  (ECLECTOR.READER:UNQUOTE BASE-SIZE)
                                  :ELEMENT-TYPE 'NTT-INT))
        (DOTIMES (I (ECLECTOR.READER:UNQUOTE BASE-SIZE))
          (SETF (AREF (ECLECTOR.READER:UNQUOTE NTT-BASE) I)
                  (MOD
                   (-
                    (%MOD-POWER (ECLECTOR.READER:UNQUOTE ROOT)
                     (ASH (- (ECLECTOR.READER:UNQUOTE MODULUS) 1) (- (+ I 2)))
                     (ECLECTOR.READER:UNQUOTE MODULUS)))
                   (ECLECTOR.READER:UNQUOTE MODULUS))
                (AREF (ECLECTOR.READER:UNQUOTE NTT-INV-BASE) I)
                  (%MOD-INVERSE (AREF (ECLECTOR.READER:UNQUOTE NTT-BASE) I)
                   (ECLECTOR.READER:UNQUOTE MODULUS))))
        (DECLAIM
         (FTYPE (FUNCTION * (VALUES NTT-VECTOR &OPTIONAL))
          (ECLECTOR.READER:UNQUOTE NTT)))
        (DEFUN (ECLECTOR.READER:UNQUOTE NTT) (VECTOR)
          (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
                   (VECTOR VECTOR))
          (CHECK-NTT-VECTOR VECTOR)
          (LABELS ((MOD* (X Y)
                     (MOD (* X Y) (ECLECTOR.READER:UNQUOTE MODULUS)))
                   (MOD+ (X Y)
                     (MOD (+ X Y) (ECLECTOR.READER:UNQUOTE MODULUS)))
                   (MOD- (X Y)
                     (MOD+ X
                      (THE NTT-INT (- (ECLECTOR.READER:UNQUOTE MODULUS) Y)))))
            (DECLARE (INLINE MOD* MOD+ MOD-))
            (LET* ((VECTOR (COERCE VECTOR 'NTT-VECTOR))
                   (LEN (LENGTH VECTOR))
                   (BASE (ECLECTOR.READER:UNQUOTE NTT-BASE)))
              (DECLARE (NTT-VECTOR VECTOR BASE)
                       (NTT-INT LEN))
              (WHEN (<= LEN 1)
                (RETURN-FROM (ECLECTOR.READER:UNQUOTE NTT) VECTOR))
              (LOOP FOR M OF-TYPE NTT-INT = (ASH LEN -1) THEN (ASH M -1)
                    WHILE (> M 0)
                    FOR W OF-TYPE NTT-INT = 1
                    FOR K OF-TYPE NTT-INT = 0
                    DO (LOOP FOR S OF-TYPE NTT-INT FROM 0 BELOW LEN BY (* 2 M)
                             DO (LOOP FOR I FROM S BELOW (+ S M)
                                      FOR J FROM (+ S M)
                                      FOR X = (AREF VECTOR I)
                                      FOR Y = (MOD* (AREF VECTOR J) W)
                                      DO (SETF (AREF VECTOR I) (MOD+ X Y)
                                               (AREF VECTOR J)
                                                 (MOD- X Y))) (INCF K) (SETQ W
                                                                               (MOD*
                                                                                W
                                                                                (AREF
                                                                                 BASE
                                                                                 (%TZCOUNT
                                                                                  K))))))
              VECTOR)))
        (DECLAIM
         (FTYPE (FUNCTION * (VALUES NTT-VECTOR &OPTIONAL))
          (ECLECTOR.READER:UNQUOTE INVERSE-NTT)))
        (DEFUN (ECLECTOR.READER:UNQUOTE INVERSE-NTT) (VECTOR &OPTIONAL INVERSE)
          (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
                   (VECTOR VECTOR))
          (CHECK-NTT-VECTOR VECTOR)
          (LABELS ((MOD* (X Y)
                     (MOD (* X Y) (ECLECTOR.READER:UNQUOTE MODULUS)))
                   (MOD+ (X Y)
                     (MOD (+ X Y) (ECLECTOR.READER:UNQUOTE MODULUS)))
                   (MOD- (X Y)
                     (MOD+ X
                      (THE NTT-INT (- (ECLECTOR.READER:UNQUOTE MODULUS) Y)))))
            (DECLARE (INLINE MOD* MOD+ MOD-))
            (LET* ((VECTOR (COERCE VECTOR 'NTT-VECTOR))
                   (LEN (LENGTH VECTOR))
                   (BASE (ECLECTOR.READER:UNQUOTE NTT-INV-BASE)))
              (DECLARE (NTT-VECTOR VECTOR BASE)
                       (NTT-INT LEN))
              (WHEN (<= LEN 1)
                (RETURN-FROM (ECLECTOR.READER:UNQUOTE INVERSE-NTT) VECTOR))
              (LOOP FOR M OF-TYPE NTT-INT = 1 THEN (ASH M 1)
                    WHILE (< M LEN)
                    FOR W OF-TYPE NTT-INT = 1
                    FOR K OF-TYPE NTT-INT = 0
                    DO (LOOP FOR S OF-TYPE NTT-INT FROM 0 BELOW LEN BY (* 2 M)
                             DO (LOOP FOR I FROM S BELOW (+ S M)
                                      FOR J FROM (+ S M)
                                      FOR X = (AREF VECTOR I)
                                      FOR Y = (AREF VECTOR J)
                                      DO (SETF (AREF VECTOR I) (MOD+ X Y)
                                               (AREF VECTOR J)
                                                 (MOD* (MOD- X Y) W))) (INCF
                                                                        K) (SETQ W
                                                                                   (MOD*
                                                                                    W
                                                                                    (AREF
                                                                                     BASE
                                                                                     (%TZCOUNT
                                                                                      K))))))
              (WHEN INVERSE
                (LET ((INV-LEN
                       ((ECLECTOR.READER:UNQUOTE MOD-POWER) LEN
                        (- (ECLECTOR.READER:UNQUOTE MODULUS) 2))))
                  (DOTIMES (I LEN)
                    (SETF (AREF VECTOR I) (MOD* INV-LEN (AREF VECTOR I))))))
              VECTOR)))
        (DECLAIM
         (FTYPE (FUNCTION * (VALUES NTT-VECTOR &OPTIONAL))
          (ECLECTOR.READER:UNQUOTE CONVOLVE)))
        (DEFUN (ECLECTOR.READER:UNQUOTE CONVOLVE) (VECTOR1 VECTOR2)
          (DECLARE (OPTIMIZE (SPEED 3))
                   (VECTOR VECTOR1 VECTOR2))
          (LET* ((LEN1 (LENGTH VECTOR1))
                 (LEN2 (LENGTH VECTOR2))
                 (MUL-LEN (MAX 0 (- (+ LEN1 LEN2) 1)))
                 (VECTOR1 (COERCE VECTOR1 'NTT-VECTOR))
                 (VECTOR2 (COERCE VECTOR2 'NTT-VECTOR)))
            (DECLARE (NTT-VECTOR VECTOR1 VECTOR2)
                     ((MOD NIL) MUL-LEN))
            (WHEN (OR (ZEROP LEN1) (ZEROP LEN2))
              (RETURN-FROM (ECLECTOR.READER:UNQUOTE CONVOLVE)
                (MAKE-ARRAY 0 :ELEMENT-TYPE 'NTT-INT)))
            (WHEN (<= (MIN LEN1 LEN2) 64)
              (LET ((RES
                     (MAKE-ARRAY MUL-LEN :ELEMENT-TYPE 'NTT-INT
                                 :INITIAL-ELEMENT 0)))
                (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
                (DOTIMES (D MUL-LEN)
                  (LOOP WITH COEF OF-TYPE NTT-INT = 0
                        FOR I FROM (MAX 0 (- D (- LEN2 1))) TO (MIN D
                                                                    (- LEN1 1))
                        FOR J = (- D I)
                        DO (SETQ COEF
                                   (MOD
                                    (+ COEF
                                       (* (AREF VECTOR1 I) (AREF VECTOR2 J)))
                                    (ECLECTOR.READER:UNQUOTE MODULUS)))
                        FINALLY (SETF (AREF RES D) COEF)))
                (RETURN-FROM (ECLECTOR.READER:UNQUOTE CONVOLVE) RES)))
            (LET* ((REQUIRED-LEN
                    (ASH 1 (INTEGER-LENGTH (MAX 0 (- MUL-LEN 1)))))
                   (VECTOR1
                    ((ECLECTOR.READER:UNQUOTE NTT)
                     (%ADJUST-ARRAY VECTOR1 REQUIRED-LEN)))
                   (VECTOR2
                    ((ECLECTOR.READER:UNQUOTE NTT)
                     (%ADJUST-ARRAY VECTOR2 REQUIRED-LEN))))
              (DOTIMES (I REQUIRED-LEN)
                (SETF (AREF VECTOR1 I)
                        (MOD (* (AREF VECTOR1 I) (AREF VECTOR2 I))
                             (ECLECTOR.READER:UNQUOTE MODULUS))))
              (ADJUST-ARRAY ((ECLECTOR.READER:UNQUOTE INVERSE-NTT) VECTOR1 T)
                            MUL-LEN))))))))

[cl-competitive/module/persistent-disjoint-set.lisp:102]
  (DEFUN PDS-OPENING-TIME (DISJOINT-SET X1 X2)
    "Returns the earliest time when X1 and X2 were connected. Returns NIL if X1
and X2 are not connected yet."
    (DECLARE (OPTIMIZE (SPEED 3))
             ((INTEGER 0 NIL) X1 X2)
             (PERSISTENT-DISJOINT-SET DISJOINT-SET))
    (LABELS ((BISECT (NG OK)
               (DECLARE (OPTIMIZE (SAFETY 0))
                        ((INTEGER 0 NIL) NG OK))
               (IF (<= (- OK NG) 1)
                   OK
                   (LET ((MID (ASH (+ NG OK) -1)))
                     (IF (PDS-CONNECTED-P DISJOINT-SET X1 X2 MID)
                         (BISECT NG MID)
                         (BISECT MID OK))))))
      (WHEN (PDS-CONNECTED-P DISJOINT-SET X1 X2 (PDS-NOW DISJOINT-SET))
        (BISECT 0 (PDS-NOW DISJOINT-SET)))))

[cl-competitive/module/persistent-disjoint-set.lisp:122]
  (DEFUN PDS-SIZE (DISJOINT-SET X TIME)
    "Returns the size of X at TIME."
    (DECLARE (OPTIMIZE (SPEED 3))
             ((INTEGER 0 NIL) X TIME))
    (WHEN (< (PDS-NOW DISJOINT-SET) TIME)
      (ERROR 'PERSISTENT-DISJOINT-SET-QUERY-FUTURE :SPECIFIED-TIME TIME
             :DISJOINT-SET DISJOINT-SET))
    (LET* ((ROOT (PDS-ROOT DISJOINT-SET X TIME))
           (ROOT-HISTORY (AREF (PDS-HISTORY DISJOINT-SET) ROOT)))
      (DECLARE (OPTIMIZE (SAFETY 0)))
      (LABELS ((BISECT-LEFT-1 (OK NG)
                 (DECLARE ((INTEGER 0 NIL) OK NG))
                 (IF (<= (- NG OK) 2)
                     OK
                     (LET ((MID (LOGAND -2 (ASH (+ OK NG) -1))))
                       (IF (<= (AREF ROOT-HISTORY MID) TIME)
                           (BISECT-LEFT-1 MID NG)
                           (BISECT-LEFT-1 OK MID))))))
        (AREF ROOT-HISTORY
              (+ 1 (BISECT-LEFT-1 0 (AREF (PDS-ENDS DISJOINT-SET) ROOT)))))))

[cl-competitive/module/random-graph.lisp:10]
  (DEFUN MAP-RANDOM-GRAPH (FUNCTION N &OPTIONAL (SAMPLE 1000))
    "Applies function SAMPLE times to the adjacency matrices of random directed
graphs of N vertices, which don't contain any multiple edges but may contain
self-loops.

If what you need is an undirected graph, you can just use the upper right (or
lower left) triangle. CANONIZE-ADJACENCY-MATRIX! may be helpful."
    (DECLARE ((INTEGER 1 NIL) N SAMPLE)
             (FUNCTION FUNCTION))
    (LET* ((NUM-WORDS (CEILING (* N N) SB-VM:N-WORD-BITS))
           (MATRIX
            (MAKE-ARRAY (LIST N N) :ELEMENT-TYPE 'BIT :INITIAL-ELEMENT 0))
           (STORAGE (ARRAY-STORAGE-VECTOR MATRIX)))
      (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
      (CHECK-TYPE NUM-WORDS (INTEGER 0 NIL))
      (DOTIMES (_ SAMPLE)
        (DOTIMES (I NUM-WORDS)
          (SETF (SB-KERNEL:%VECTOR-RAW-BITS STORAGE I) (RANDOM NIL)))
        (FUNCALL FUNCTION MATRIX))))

[cl-competitive/module/range-tree.lisp:153]
  (DEFUN %YNODE-MERGE (YNODE1 YNODE2)
    "Merges two YNODEs non-destructively in O(n) time."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET* ((LENGTH (+ (YNODE-COUNT YNODE1) (YNODE-COUNT YNODE2))))
      (DECLARE (FIXNUM LENGTH))
      (%PATH-TO-YNODE!
       (%YNODE-MERGE-PATH! (%YNODE-TO-PATH YNODE1) (%YNODE-TO-PATH YNODE2))
       LENGTH)))

[cl-competitive/module/ref-able-treap.lisp:297]
  (DEFUN TREAP-REF (TREAP INDEX)
    "Returns the INDEX-th element of TREAP."
    (DECLARE (OPTIMIZE (SPEED 3))
             ((OR NULL TREAP) TREAP)
             ((INTEGER 0 NIL) INDEX))
    (WHEN (>= INDEX (TREAP-COUNT TREAP))
      (ERROR 'INVALID-TREAP-INDEX-ERROR :TREAP TREAP :INDEX INDEX))
    (LABELS ((%REF (TREAP INDEX)
               (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
                        ((INTEGER 0 NIL) INDEX))
               (LET ((LEFT-COUNT (TREAP-COUNT (%TREAP-LEFT TREAP))))
                 (COND ((< INDEX LEFT-COUNT) (%REF (%TREAP-LEFT TREAP) INDEX))
                       ((> INDEX LEFT-COUNT)
                        (%REF (%TREAP-RIGHT TREAP) (- INDEX LEFT-COUNT 1)))
                       (T (%TREAP-KEY TREAP))))))
      (%REF TREAP INDEX)))

[cl-competitive/module/rho.lisp:13]
  (DEFUN %RHO (N)
    (DECLARE (OPTIMIZE (SPEED 3))
             (UINT N))
    (LET ((M (ASH 1 (INTEGER-LENGTH N))))
      (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
      (MACROLET ((F (X)
                   (ECLECTOR.READER:QUASIQUOTE
                    (LET ((XX (ECLECTOR.READER:UNQUOTE X)))
                      (MOD (+ C (* XX XX)) N)))))
        (LOOP REPEAT 100
              FOR C = (+ 1 (RANDOM 100))
              FOR Y OF-TYPE UINT = 2
              FOR R OF-TYPE UINT = 1
              FOR Q OF-TYPE UINT = 1
              FOR G OF-TYPE UINT = 1
              FOR YS OF-TYPE UINT = Y
              FOR X OF-TYPE UINT = Y
              DO (LOOP WHILE (= G 1)
                       DO (SETQ X Y) (DOTIMES (_ R)
                                       (SETQ Y (F Y))) (LET ((K 0))
                                                         (DECLARE (UINT K))
                                                         (LOOP WHILE (AND
                                                                      (< K R)
                                                                      (= G 1))
                                                               DO (SETQ YS
                                                                          Y) (DOTIMES
                                                                                 (_
                                                                                  (MIN
                                                                                   M
                                                                                   (-
                                                                                    R
                                                                                    K)))
                                                                               (SETQ Y
                                                                                       (F
                                                                                        Y)
                                                                                     Q
                                                                                       (MOD
                                                                                        (*
                                                                                         Q
                                                                                         (ABS
                                                                                          (-
                                                                                           X
                                                                                           Y)))
                                                                                        N))) (SETQ G
                                                                                                     (GCD
                                                                                                      Q
                                                                                                      N)) (INCF
                                                                                                           K
                                                                                                           M))) (SETQ R
                                                                                                                        (ASH
                                                                                                                         R
                                                                                                                         1)))
              WHEN (= G N)
              DO (SETQ G 1) (LOOP WHILE (= G 1)
                                  DO (SETQ YS (F YS)
                                           G (GCD (ABS (- X YS)) N)))
              WHEN (< G N)
              DO (RETURN G)
              FINALLY (ERROR "Not found.")))))

[cl-competitive/module/rolling-hash31.lisp:157]
  (DEFUN RHASH-GET-LCP (RHASH1 START1 RHASH2 START2)
    "Returns the length of the longest common prefix of two suffixes which begin
at START1 and START2."
    (DECLARE (OPTIMIZE (SPEED 3))
             ((MOD NIL) START1 START2))
    (ASSERT
     (AND (< START1 (LENGTH (RHASH-CUMUL RHASH1)))
          (< START2 (LENGTH (RHASH-CUMUL RHASH2)))))
    (LET ((MAX-LENGTH
           (MIN (- (LENGTH (RHASH-CUMUL RHASH1)) START1 1)
                (- (LENGTH (RHASH-CUMUL RHASH2)) START2 1))))
      (DECLARE (OPTIMIZE (SAFETY 0)))
      (LABELS ((BISECT (OK NG)
                 (DECLARE ((INTEGER 0 NIL) OK NG))
                 (IF (<= (- NG OK) 1)
                     OK
                     (LET ((MID (ASH (+ NG OK) -1)))
                       (IF (= (RHASH-QUERY RHASH1 START1 (+ START1 MID))
                              (RHASH-QUERY RHASH2 START2 (+ START2 MID)))
                           (BISECT MID NG)
                           (BISECT OK MID))))))
        (BISECT 0 (+ 1 MAX-LENGTH)))))

[cl-competitive/module/rolling-hash62.lisp:214]
  (DEFUN RHASH-GET-LCP (RHASH1 START1 RHASH2 START2)
    "Returns the length of the longest common prefix of two suffixes which begin
at START1 and START2."
    (DECLARE (OPTIMIZE (SPEED 3))
             ((MOD NIL) START1 START2))
    (ASSERT
     (AND (< START1 (LENGTH (RHASH-CUMUL1 RHASH1)))
          (< START2 (LENGTH (RHASH-CUMUL1 RHASH2)))))
    (LET ((MAX-LENGTH
           (MIN (- (LENGTH (RHASH-CUMUL1 RHASH1)) START1 1)
                (- (LENGTH (RHASH-CUMUL1 RHASH2)) START2 1))))
      (DECLARE (OPTIMIZE (SAFETY 0)))
      (LABELS ((BISECT (OK NG)
                 (DECLARE ((MOD NIL) OK NG))
                 (IF (<= (- NG OK) 1)
                     OK
                     (LET ((MID (ASH (+ NG OK) -1)))
                       (IF (= (RHASH-QUERY RHASH1 START1 (+ START1 MID))
                              (RHASH-QUERY RHASH2 START2 (+ START2 MID)))
                           (BISECT MID NG)
                           (BISECT OK MID))))))
        (BISECT 0 (+ 1 MAX-LENGTH)))))

[cl-competitive/module/ssp.lisp:19]
  (DEFUN HEAP-PUSH (COST VERTEX HEAP)
    (DECLARE (OPTIMIZE (SPEED 3)))
    (SYMBOL-MACROLET ((POSITION (HEAP-POSITION HEAP)))
      (WHEN (>= POSITION (LENGTH (HEAP-COSTS HEAP)))
        (SETF (HEAP-COSTS HEAP) (ADJUST-ARRAY (HEAP-COSTS HEAP) (* POSITION 2))
              (HEAP-VERTICES HEAP)
                (ADJUST-ARRAY (HEAP-VERTICES HEAP) (* POSITION 2))))
      (LET ((COSTS (HEAP-COSTS HEAP)) (VERTICES (HEAP-VERTICES HEAP)))
        (LABELS ((HEAPIFY (POS)
                   (DECLARE (OPTIMIZE (SAFETY 0)))
                   (UNLESS (= POS 1)
                     (LET ((PARENT-POS (ASH POS -1)))
                       (WHEN (< (AREF COSTS POS) (AREF COSTS PARENT-POS))
                         (ROTATEF (AREF COSTS POS) (AREF COSTS PARENT-POS))
                         (ROTATEF (AREF VERTICES POS)
                                  (AREF VERTICES PARENT-POS))
                         (HEAPIFY PARENT-POS))))))
          (SETF (AREF COSTS POSITION) COST
                (AREF VERTICES POSITION) VERTEX)
          (HEAPIFY POSITION)
          (INCF POSITION)
          HEAP))))

[cl-competitive/module/ssp.lisp:43]
  (DEFUN HEAP-POP (HEAP)
    (DECLARE (OPTIMIZE (SPEED 3)))
    (SYMBOL-MACROLET ((POSITION (HEAP-POSITION HEAP)))
      (LET ((COSTS (HEAP-COSTS HEAP)) (VERTICES (HEAP-VERTICES HEAP)))
        (LABELS ((HEAPIFY (POS)
                   (DECLARE (OPTIMIZE (SAFETY 0))
                            ((INTEGER 1 NIL) POS))
                   (LET* ((CHILD-POS1 (+ POS POS)) (CHILD-POS2 (1+ CHILD-POS1)))
                     (WHEN (<= CHILD-POS1 POSITION)
                       (IF (<= CHILD-POS2 POSITION)
                           (IF (< (AREF COSTS CHILD-POS1)
                                  (AREF COSTS CHILD-POS2))
                               (UNLESS
                                   (< (AREF COSTS POS) (AREF COSTS CHILD-POS1))
                                 (ROTATEF (AREF COSTS POS)
                                          (AREF COSTS CHILD-POS1))
                                 (ROTATEF (AREF VERTICES POS)
                                          (AREF VERTICES CHILD-POS1))
                                 (HEAPIFY CHILD-POS1))
                               (UNLESS
                                   (< (AREF COSTS POS) (AREF COSTS CHILD-POS2))
                                 (ROTATEF (AREF COSTS POS)
                                          (AREF COSTS CHILD-POS2))
                                 (ROTATEF (AREF VERTICES POS)
                                          (AREF VERTICES CHILD-POS2))
                                 (HEAPIFY CHILD-POS2)))
                           (UNLESS (< (AREF COSTS POS) (AREF COSTS CHILD-POS1))
                             (ROTATEF (AREF COSTS POS) (AREF COSTS CHILD-POS1))
                             (ROTATEF (AREF VERTICES POS)
                                      (AREF VERTICES CHILD-POS1))))))))
          (MULTIPLE-VALUE-PROG1 (VALUES (AREF COSTS 1) (AREF VERTICES 1))
            (DECF POSITION)
            (SETF (AREF COSTS 1) (AREF COSTS POSITION)
                  (AREF VERTICES 1) (AREF VERTICES POSITION))
            (HEAPIFY 1))))))

[cl-competitive/module/treap.lisp:162]
  (DEFUN TREAP-COUNT (TREAP)
    "Counts the number of elements in TREAP in O(n) time."
    (DECLARE (OPTIMIZE (SPEED 3))
             ((OR NULL TREAP) TREAP))
    (LABELS ((RECUR (TREAP)
               (DECLARE (OPTIMIZE (SAFETY 0)))
               (IF (NULL TREAP)
                   0
                   (+ 1 (TREAP-COUNT (%TREAP-LEFT TREAP))
                      (TREAP-COUNT (%TREAP-RIGHT TREAP))))))
      (RECUR TREAP)))

[cl-competitive/non-module/random.lisp:5]
  (LET ((X (LOAD-TIME-VALUE (RANDOM +DIVISOR+))))
    (DECLARE ((INTEGER 0 (NIL)) X))
    (DEFUN SEED-LCG (INITIAL-NUMBER) (SETQ X INITIAL-NUMBER))
    (DEFUN RANDOM-LCG ()
      (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
      (SETQ X (LOGAND (+ (* 1103515245 X) 12345) NIL))))

[cl-competitive/non-module/random.lisp:17]
  (DEFUN RANDOM-XOR32 ()
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((X *XOR32*))
      (DECLARE ((UNSIGNED-BYTE 32) X))
      (SETQ X (LDB (BYTE 32 0) (LOGXOR X (ASH X 13))))
      (SETQ X (LOGXOR X (ASH X -17)))
      (SETQ *XOR32* (LDB (BYTE 32 0) (LOGXOR X (ASH X 5))))))

[cl-competitive/non-module/random.lisp:25]
  (DEFUN BENCH (NUM)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             ((INTEGER 1 (NIL)) NUM))
    (LET ((SUM 0) (X 2463534242))
      (DECLARE ((INTEGER 0 NIL) SUM)
               ((UNSIGNED-BYTE 32) X))
      (DOTIMES (I NUM)
        (SETQ X (LDB (BYTE 32 0) (LOGXOR X (ASH X 13))))
        (SETQ X (LOGXOR X (ASH X -17)))
        (SETQ X (LDB (BYTE 32 0) (LOGXOR X (ASH X 5))))
        (INCF SUM (LOGAND 1 X)))
      SUM))

[cl-competitive/non-module/template.lisp:2]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (DEFPARAMETER *OPT* '(OPTIMIZE (SPEED 3) (SAFETY 2)))
    (QUICKLISP-CLIENT:QUICKLOAD '(:CL-DEBUG-PRINT :FIVEAM :CP/UTIL) :SILENT T)
    (USE-PACKAGE :CP/UTIL :CL-USER)
    (DOLIST (F '(:POPCNT :SSE4)) (PUSHNEW F SB-C:*BACKEND-SUBFEATURES*))
    (SETQ *RANDOM-STATE* (MAKE-RANDOM-STATE T)))

[cl-cont/test/cases.lisp:766]
  (DEFTEST SYMBOL-MACROLET-1
   (WITH-CALL/CC
    (SYMBOL-MACROLET ((A 1))
      (DECLARE (OPTIMIZE SAFETY))
      A))
   1)

[cl-cont/test/cases.lisp:785]
  (DEFTEST LOCALLY-1
   (LET (CC)
     (VALUES
      (WITH-CALL/CC
       (LOCALLY
        (DECLARE (OPTIMIZE SAFETY))
        (+ 1 (LET/CC K (SETF CC K) (FUNCALL K 2)))))
      (FUNCALL CC 5)))
   3 6)

[cl-csv/read-until.lisp:3]
  (DEFUN READ-INTO-BUFFER-UNTIL
         (BUFFER STREAM
          &KEY (NL #\Newline) NL-MATCH
          &AUX (C #\?) (NL-IDX (OR NL-MATCH -1))
          (NL-LEN (ETYPECASE NL (STRING (LENGTH NL)) (CHARACTER 1)))
          (NL-LEN-1 (- NL-LEN 1)) (BUFFER-LEN (LENGTH BUFFER)))
    "This reads into a buffer until either the buffer is full or the
   we have read the newline character(s).

   If we read the newline characters they will be the last character(s) in the
   buffer
  "
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0))
             (TYPE CHARACTER C)
             (TYPE (OR SIMPLE-STRING CHARACTER) NL)
             (TYPE FIXNUM NL-LEN NL-LEN-1 NL-IDX BUFFER-LEN)
             (TYPE (SIMPLE-ARRAY CHARACTER) BUFFER))
    (DOTIMES (I BUFFER-LEN)
      (SETF C (READ-CHAR STREAM NIL *EOF-CHAR*))
      (LET ((NEW-IDX (+ 1 NL-IDX)))
        (DECLARE (TYPE FIXNUM NEW-IDX))
        (IF (CHAR= (ETYPECASE NL (STRING (SCHAR NL NEW-IDX)) (CHARACTER NL)) C)
            (SETF NL-IDX NEW-IDX)
            (SETF NL-IDX -1)))
      (WHEN (CHAR= *EOF-CHAR* C)
        (IF (ZEROP I)
            (ERROR 'END-OF-FILE :STREAM STREAM)
            (RETURN-FROM READ-INTO-BUFFER-UNTIL I)))
      (SETF (SCHAR BUFFER I) C)
      (WHEN (= NL-LEN-1 NL-IDX) (RETURN-FROM READ-INTO-BUFFER-UNTIL (+ 1 I))))
    (RETURN-FROM READ-INTO-BUFFER-UNTIL BUFFER-LEN))

[cl-cuda/examples/sph-cpu.lisp:96]
  (DEFUN NORM (X Y Z)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (SQRT (+ (* X X) (* Y Y) (* Z Z))))

[cl-cuda/examples/sph-cpu.lisp:237]
  (DEFUN OFFSET (NEIGHBOR-MAP I J K L)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((CAPACITY (NEIGHBOR-MAP-CAPACITY NEIGHBOR-MAP))
          (SIZE-X (NEIGHBOR-MAP-SIZE-X NEIGHBOR-MAP))
          (SIZE-Y (NEIGHBOR-MAP-SIZE-Y NEIGHBOR-MAP)))
      (DECLARE (TYPE FIXNUM CAPACITY SIZE-X SIZE-Y))
      (THE FIXNUM
           (+
            (THE FIXNUM
                 (* CAPACITY
                    (THE FIXNUM (* SIZE-X (THE FIXNUM (* SIZE-Y K))))))
            (THE FIXNUM
                 (+ (THE FIXNUM (* CAPACITY (THE FIXNUM (* SIZE-X J))))
                    (THE FIXNUM (+ (THE FIXNUM (* CAPACITY I)) L))))))))

[cl-cuda/examples/sph-cpu.lisp:334]
  (DEFUN POLY6-KERNEL (DX DY DZ)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((R (NORM DX DY DZ)))
      (* (/ 315.0 (* 64.0 (FLOAT PI 0.0) (POW H 9)))
         (POW (- (* H H) (* R R)) 3))))

[cl-cuda/examples/sph-cpu.lisp:345]
  (DEFUN GRAD-SPIKY-KERNEL (DX DY DZ)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET* ((R (NORM DX DY DZ))
           (COEFF
            (* (/ -45.0 (* (FLOAT PI 0.0) (POW H 6))) (POW (- H R) 2)
               (/ 1.0 R))))
      (VALUES (* COEFF DX) (* COEFF DY) (* COEFF DZ))))

[cl-cuda/examples/sph-cpu.lisp:358]
  (DEFUN RAP-VISC-KERNEL (DX DY DZ)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((R (NORM DX DY DZ)))
      (* (/ 45.0 (* (FLOAT PI 0.0) (POW H 6))) (- H R))))

[cl-cuda/examples/sph-cpu.lisp:373]
  (DEFUN UPDATE-DENSITY (RHO POS N NEIGHBOR-MAP)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LOOP FOR I FROM 0 BELOW N
          DO (SETF (AREF RHO I) 0.0) (DO-NEIGHBORS (J NEIGHBOR-MAP POS I)
                                      (WITH-VEC3-AREF (XI YI ZI) (POS I)
                                       (WITH-VEC3-AREF (XJ YJ ZJ) (POS J)
                                        (LET* ((DX (* (- XI XJ) SIMSCALE))
                                               (DY (* (- YI YJ) SIMSCALE))
                                               (DZ (* (- ZI ZJ) SIMSCALE))
                                               (DR (NORM DX DY DZ)))
                                          (WHEN (<= DR H)
                                            (INCF (AREF RHO I)
                                                  (* PMASS
                                                     (POLY6-KERNEL DX DY
                                                      DZ))))))))))

[cl-cuda/examples/sph-cpu.lisp:409]
  (DEFUN PRESSURE-TERM (RHO PRS I J DX DY DZ)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (MULTIPLE-VALUE-BIND (X Y Z)
        (GRAD-SPIKY-KERNEL DX DY DZ)
      (LET ((COEFF
             (/ (* (- PMASS) (+ (AREF PRS I) (AREF PRS J)))
                (* 2.0 (AREF RHO J)))))
        (VALUES (* COEFF X) (* COEFF Y) (* COEFF Z)))))

[cl-cuda/examples/sph-cpu.lisp:425]
  (DEFUN VISCOSITY-TERM (VEL RHO I J DX DY DZ)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (WITH-VEC3-AREF (UI VI WI) (VEL I)
     (WITH-VEC3-AREF (UJ VJ WJ) (VEL J)
      (LET ((COEFF
             (* (/ (* VISC PMASS) (AREF RHO J)) (RAP-VISC-KERNEL DX DY DZ))))
        (VALUES (* COEFF (- UJ UI)) (* COEFF (- VJ VI)) (* COEFF (- WJ WI)))))))

[cl-cuda/examples/sph-cpu.lisp:444]
  (DEFUN UPDATE-FORCE (FORCE POS VEL RHO PRS N NEIGHBOR-MAP)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LOOP FOR I FROM 0 BELOW N
          DO (SET-VEC3-AREF FORCE I (VALUES 0.0 0.0 0.0)) (DO-NEIGHBORS
                                                           (J NEIGHBOR-MAP POS
                                                            I)
                                                           (WHEN (/= I J)
                                                             (WITH-VEC3-AREF
                                                              (XI YI ZI)
                                                              (POS I)
                                                              (WITH-VEC3-AREF
                                                               (XJ YJ ZJ)
                                                               (POS J)
                                                               (LET* ((DX
                                                                       (*
                                                                        (- XI
                                                                           XJ)
                                                                        SIMSCALE))
                                                                      (DY
                                                                       (*
                                                                        (- YI
                                                                           YJ)
                                                                        SIMSCALE))
                                                                      (DZ
                                                                       (*
                                                                        (- ZI
                                                                           ZJ)
                                                                        SIMSCALE))
                                                                      (DR
                                                                       (NORM DX
                                                                        DY DZ)))
                                                                 (WHEN
                                                                     (<= DR H)
                                                                   (INC-VEC3-AREF
                                                                    FORCE I
                                                                    (PRESSURE-TERM
                                                                     RHO PRS I
                                                                     J DX DY
                                                                     DZ))
                                                                   (INC-VEC3-AREF
                                                                    FORCE I
                                                                    (VISCOSITY-TERM
                                                                     VEL RHO I
                                                                     J DX DY
                                                                     DZ))))))))))

[cl-cuda/interop/examples/nbody.lisp:51]
  (DEFUN VEC3-ARRAY-VALUES (ARRAY I)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DECLARE (TYPE VEC3-ARRAY ARRAY)
             (TYPE FIXNUM I))
    (VALUES (AREF ARRAY (THE FIXNUM (+ (THE FIXNUM (* I 3)) 0)))
            (AREF ARRAY (THE FIXNUM (+ (THE FIXNUM (* I 3)) 1)))
            (AREF ARRAY (THE FIXNUM (+ (THE FIXNUM (* I 3)) 2)))))

[cl-cuda/interop/examples/nbody.lisp:64]
  (DEFUN %SET-VEC3-ARRAY (ARRAY I X Y Z)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DECLARE (TYPE VEC3-ARRAY ARRAY)
             (TYPE FIXNUM I))
    (SETF (AREF ARRAY (THE FIXNUM (+ (THE FIXNUM (* I 3)) 0))) X
          (AREF ARRAY (THE FIXNUM (+ (THE FIXNUM (* I 3)) 1))) Y
          (AREF ARRAY (THE FIXNUM (+ (THE FIXNUM (* I 3)) 2))) Z))

[cl-cuda/interop/examples/nbody.lisp:234]
  (DEFUN BODY-BODY-INTERACTION-CPU (X1 Y1 Z1 X2 Y2 Z2)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DECLARE (TYPE SINGLE-FLOAT X1 Y1 Z1 X2 Y2 Z2))
    (LET* ((RX (- X2 X1))
           (RY (- Y2 Y1))
           (RZ (- Z2 Z1))
           (SOFTENING-SQUARED (* 0.1 0.1))
           (DIST-SQR (+ (* RX RX) (* RY RY) (* RZ RZ) SOFTENING-SQUARED))
           (INV-DIST (/ 1.0 (SQRT DIST-SQR)))
           (INV-DIST-CUBE (* INV-DIST INV-DIST INV-DIST))
           (W 1.0)
           (S (* W INV-DIST-CUBE)))
      (VALUES (* RX S) (* RY S) (* RZ S))))

[cl-cuda/interop/examples/nbody.lisp:249]
  (DEFUN INTEGRATE-BODIES-CPU
         (NEW-POS OLD-POS VEL DELTA-TIME DAMPING TOTAL-NUM-BODIES)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DECLARE (TYPE FIXNUM TOTAL-NUM-BODIES)
             (TYPE SINGLE-FLOAT DELTA-TIME DAMPING)
             (TYPE VEC3-ARRAY NEW-POS OLD-POS VEL))
    (DOTIMES (I TOTAL-NUM-BODIES)
      (WITH-VEC3-ARRAY-VALUES ((X1 Y1 Z1) OLD-POS I)
       (DOTIMES (J TOTAL-NUM-BODIES)
         (WITH-VEC3-ARRAY-VALUES ((X2 Y2 Z2) OLD-POS J)
          (WHEN (/= I J)
            (MULTIPLE-VALUE-BIND (AX AY AZ)
                (BODY-BODY-INTERACTION-CPU X1 Y1 Z1 X2 Y2 Z2)
              (DECLARE (TYPE SINGLE-FLOAT AX AY AZ))
              (LET ((K (* DELTA-TIME DAMPING)))
                (WITH-VEC3-ARRAY-VALUES ((VX VY VZ) VEL I)
                 (SET-VEC3-ARRAY (VEL I) (+ VX (* AX K)) (+ VY (* AY K))
                  (+ VZ (* AZ K)))))))))
       (WITH-VEC3-ARRAY-VALUES ((VX VY VZ) VEL I)
        (SET-VEC3-ARRAY (NEW-POS I) (+ X1 (* VX DELTA-TIME))
         (+ Y1 (* VY DELTA-TIME)) (+ Z1 (* VZ DELTA-TIME)))))))

[cl-data-format-validation/parse-number.lisp:94]
  (DEFUN WHITE-SPACE-P (X)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE CHARACTER X))
    (AND (FIND X *WHITE-SPACE-CHARACTERS*) T))

[cl-data-structures/src/algorithms/cumulative-accumulate.lisp:182]
  (DEFMETHOD #S(FORMGREP:SYMREF
                :NAME "AGGREGATOR-CONSTRUCTOR"
                :QUALIFIER "CL-DS.ALG.META")
             ((RANGE CUMULATIVE-ACCUMULATE-RANGE) OUTER-CONSTRUCTOR
              (FUNCTION AGGREGATION-FUNCTION) (ARGUMENTS LIST))
    (DECLARE (OPTIMIZE (DEBUG 3) (SAFETY 1)))
    (LET ((FN (ENSURE-FUNCTION (READ-FUNCTION RANGE)))
          (INITIALIZED (SLOT-BOUNDP RANGE '%STATE))
          (OUTER-FN (CALL-NEXT-METHOD))
          (KEY (ENSURE-FUNCTION (READ-CUMULATIVE-KEY RANGE))))
      (#S(FORMGREP:SYMREF
          :NAME "AGGREGATOR-CONSTRUCTOR"
          :QUALIFIER "CL-DS.ALG.META")
       (READ-ORIGINAL-RANGE RANGE)
       (#S(FORMGREP:SYMREF
           :NAME "LAYER-AGGREGATOR-CONSTRUCTOR"
           :QUALIFIER "CL-DS.ALG.META")
        #'CUMULATIVE-ACCUMULATE OUTER-FN
        (LIST FN :KEY KEY :INITIALIZED INITIALIZED :STATE
              (IF INITIALIZED
                  (READ-INITIAL-STATE RANGE)
                  NIL)))
       FUNCTION ARGUMENTS)))

[cl-data-structures/src/algorithms/distinct.lisp:160]
  (DEFMETHOD #S(FORMGREP:SYMREF
                :NAME "AGGREGATOR-CONSTRUCTOR"
                :QUALIFIER "CL-DS.ALG.META")
             ((RANGE DISTINCT-PROXY) OUTER-CONSTRUCTOR
              (FUNCTION AGGREGATION-FUNCTION) (ARGUMENTS LIST))
    (DECLARE
     (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0) (SPACE 0) (COMPILATION-SPEED 0)))
    (BIND (((:SLOTS %KEY %SEEN) RANGE) (OUTER-FN (CALL-NEXT-METHOD)))
     (#S(FORMGREP:SYMREF
         :NAME "AGGREGATOR-CONSTRUCTOR"
         :QUALIFIER "CL-DS.ALG.META")
      (READ-ORIGINAL-RANGE RANGE)
      (#S(FORMGREP:SYMREF
          :NAME "LAYER-AGGREGATOR-CONSTRUCTOR"
          :QUALIFIER "CL-DS.ALG.META")
       #'DISTINCT OUTER-FN (LIST :SEEN %SEEN :KEY %KEY))
      FUNCTION ARGUMENTS)))

[cl-data-structures/src/algorithms/establish-special.lisp:110]
  (DEFMETHOD #S(FORMGREP:SYMREF
                :NAME "AGGREGATOR-CONSTRUCTOR"
                :QUALIFIER "CL-DS.ALG.META")
             ((RANGE ESTABLISH-SPECIAL-PROXY) OUTER-CONSTRUCTOR
              (FUNCTION AGGREGATION-FUNCTION) (ARGUMENTS LIST))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET* ((SPECIAL-KEY (ENSURE-FUNCTION (READ-KEY RANGE)))
           (BINDINGS (READ-BINDINGS RANGE))
           (VARIABLES (MAPCAR #'FIRST BINDINGS))
           (FUNCTIONS (MAPCAR (COMPOSE #'ENSURE-FUNCTION #'SECOND) BINDINGS))
           (OUTER-FN (CALL-NEXT-METHOD)))
      (ASSERT (FUNCTIONP OUTER-FN))
      (#S(FORMGREP:SYMREF
          :NAME "AGGREGATOR-CONSTRUCTOR"
          :QUALIFIER "CL-DS.ALG.META")
       (READ-ORIGINAL-RANGE RANGE)
       (#S(FORMGREP:SYMREF :NAME "CASES" :QUALIFIER "CL-DS.UTILS")
        ((:VARIANT (EQ SPECIAL-KEY #'IDENTITY) (EQ SPECIAL-KEY 'IDENTITY)))
        (#S(FORMGREP:SYMREF :NAME "LET-AGGREGATOR" :QUALIFIER "CL-DS.ALG.META")
         ((INNER
           (#S(FORMGREP:SYMREF
               :NAME "CALL-CONSTRUCTOR"
               :QUALIFIER "CL-DS.ALG.META")
            OUTER-FN)))
         ((ELEMENT)
          (LET ((VAR (FUNCALL SPECIAL-KEY ELEMENT)))
            (PROGV
                VARIABLES
                (MAPCAR
                 (LAMBDA (FUNCTION)
                   (ASSERT (FUNCTIONP FUNCTION))
                   (FUNCALL FUNCTION VAR))
                 FUNCTIONS)
              (#S(FORMGREP:SYMREF
                  :NAME "PASS-TO-AGGREGATION"
                  :QUALIFIER "CL-DS.ALG.META")
               INNER ELEMENT))))
         ((#S(FORMGREP:SYMREF
              :NAME "EXTRACT-RESULT"
              :QUALIFIER "CL-DS.ALG.META")
           INNER))
         (#S(FORMGREP:SYMREF :NAME "CLEANUP" :QUALIFIER "CL-DS.ALG.META")
          INNER)))
       FUNCTION ARGUMENTS)))

[cl-data-structures/src/algorithms/filtering.lisp:99]
  (DEFMETHOD #S(FORMGREP:SYMREF
                :NAME "AGGREGATOR-CONSTRUCTOR"
                :QUALIFIER "CL-DS.ALG.META")
             ((RANGE FILTERING-PROXY) OUTER-CONSTRUCTOR
              (FUNCTION AGGREGATION-FUNCTION) (ARGUMENTS LIST))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((OUTER-FN (CALL-NEXT-METHOD))
          (KEY (ENSURE-FUNCTION (READ-KEY RANGE))))
      (#S(FORMGREP:SYMREF :NAME "CASES" :QUALIFIER "CL-DS.UTILS")
       ((:VARIANT (EQ KEY #'IDENTITY)))
       (#S(FORMGREP:SYMREF
           :NAME "AGGREGATOR-CONSTRUCTOR"
           :QUALIFIER "CL-DS.ALG.META")
        (READ-ORIGINAL-RANGE RANGE)
        (#S(FORMGREP:SYMREF :NAME "LET-AGGREGATOR" :QUALIFIER "CL-DS.ALG.META")
         ((INNER
           (#S(FORMGREP:SYMREF
               :NAME "CALL-CONSTRUCTOR"
               :QUALIFIER "CL-DS.ALG.META")
            OUTER-FN)))
         ((ELEMENT)
          (UNLESS (SHOULD-SKIP RANGE RANGE (FUNCALL KEY ELEMENT))
            (#S(FORMGREP:SYMREF
                :NAME "PASS-TO-AGGREGATION"
                :QUALIFIER "CL-DS.ALG.META")
             INNER ELEMENT)))
         ((#S(FORMGREP:SYMREF
              :NAME "EXTRACT-RESULT"
              :QUALIFIER "CL-DS.ALG.META")
           INNER))
         (#S(FORMGREP:SYMREF :NAME "CLEANUP" :QUALIFIER "CL-DS.ALG.META")
          INNER))
        FUNCTION ARGUMENTS))))

[cl-data-structures/src/algorithms/flatten-lists.lisp:117]
  (DEFMETHOD #S(FORMGREP:SYMREF
                :NAME "AGGREGATOR-CONSTRUCTOR"
                :QUALIFIER "CL-DS.ALG.META")
             ((RANGE FLATTEN-PROXY) OUTER-CONSTRUCTOR
              (FUNCTION AGGREGATION-FUNCTION) (ARGUMENTS LIST))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((FLATTEN-KEY (ENSURE-FUNCTION (READ-KEY RANGE)))
          (OUTER-FN (CALL-NEXT-METHOD)))
      (#S(FORMGREP:SYMREF
          :NAME "AGGREGATOR-CONSTRUCTOR"
          :QUALIFIER "CL-DS.ALG.META")
       (READ-ORIGINAL-RANGE RANGE)
       (#S(FORMGREP:SYMREF :NAME "CASES" :QUALIFIER "CL-DS.UTILS")
        ((:VARIANT (EQ FLATTEN-KEY #'IDENTITY)))
        (#S(FORMGREP:SYMREF :NAME "LET-AGGREGATOR" :QUALIFIER "CL-DS.ALG.META")
         ((INNER
           (#S(FORMGREP:SYMREF
               :NAME "CALL-CONSTRUCTOR"
               :QUALIFIER "CL-DS.ALG.META")
            OUTER-FN)))
         ((ELEMENT)
          (LABELS ((IMPL (X)
                     (IF (LISTP X)
                         (MAP NIL #'IMPL X)
                         (#S(FORMGREP:SYMREF
                             :NAME "PASS-TO-AGGREGATION"
                             :QUALIFIER "CL-DS.ALG.META")
                          INNER X))))
            (~>> ELEMENT (FUNCALL FLATTEN-KEY) IMPL)))
         ((#S(FORMGREP:SYMREF
              :NAME "EXTRACT-RESULT"
              :QUALIFIER "CL-DS.ALG.META")
           INNER))
         (#S(FORMGREP:SYMREF :NAME "CLEANUP" :QUALIFIER "CL-DS.ALG.META")
          INNER)))
       FUNCTION ARGUMENTS)))

[cl-data-structures/src/algorithms/group-by.lisp:65]
  (DEFMETHOD #S(FORMGREP:SYMREF
                :NAME "AGGREGATOR-CONSTRUCTOR"
                :QUALIFIER "CL-DS.ALG.META")
             ((RANGE GROUP-BY-PROXY) OUTER-CONSTRUCTOR
              (FUNCTION AGGREGATION-FUNCTION) (ARGUMENTS LIST))
    (DECLARE
     (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0) (SPACE 0) (COMPILATION-SPEED 0)))
    (BIND
     ((GROUPS-PROTOTYPE (READ-GROUPS RANGE))
      (GROUP-BY-KEY (ENSURE-FUNCTION (READ-KEY RANGE)))
      (TRANSFORM (ENSURE-FUNCTION (READ-TRANSFORM RANGE)))
      (ACCEPT (ENSURE-FUNCTION (READ-HAVING RANGE)))
      (OUTER-FN (CALL-NEXT-METHOD)))
     (#S(FORMGREP:SYMREF
         :NAME "AGGREGATOR-CONSTRUCTOR"
         :QUALIFIER "CL-DS.ALG.META")
      (READ-ORIGINAL-RANGE RANGE)
      (#S(FORMGREP:SYMREF :NAME "CASES" :QUALIFIER "CL-DS.UTILS")
       ((:VARIANT (EQ GROUP-BY-KEY #'IDENTITY)))
       (#S(FORMGREP:SYMREF :NAME "LET-AGGREGATOR" :QUALIFIER "CL-DS.ALG.META")
        ((GROUPS (COPY-HASH-TABLE GROUPS-PROTOTYPE)))
        ((ELEMENT)
         (BIND
          ((SELECTED (~>> ELEMENT (FUNCALL GROUP-BY-KEY)))
           (*CURRENT-KEY* SELECTED) (GROUP (GETHASH SELECTED GROUPS)))
          (WHEN (NULL GROUP)
            (SETF GROUP
                    (#S(FORMGREP:SYMREF
                        :NAME "CALL-CONSTRUCTOR"
                        :QUALIFIER "CL-DS.ALG.META")
                     OUTER-FN)
                  (GETHASH SELECTED GROUPS) GROUP))
          (#S(FORMGREP:SYMREF
              :NAME "PASS-TO-AGGREGATION"
              :QUALIFIER "CL-DS.ALG.META")
           GROUP ELEMENT)))
        ((MAPHASH
          (LAMBDA (KEY AGGREGATOR &AUX (*CURRENT-KEY* KEY))
            (LET ((RESULT
                   (#S(FORMGREP:SYMREF
                       :NAME "EXTRACT-RESULT"
                       :QUALIFIER "CL-DS.ALG.META")
                    AGGREGATOR)))
              (IF (FUNCALL ACCEPT RESULT)
                  (SETF (GETHASH KEY GROUPS) (FUNCALL TRANSFORM RESULT))
                  (REMHASH KEY GROUPS))))
          GROUPS)
         (MAKE-INSTANCE 'GROUP-BY-RESULT-RANGE :HASH-TABLE GROUPS :KEYS
                        (~> GROUPS HASH-TABLE-KEYS (COERCE 'VECTOR)) :BEGIN 0
                        :END (HASH-TABLE-COUNT GROUPS)))
        (ITERATE (FOR (KEY GROUP) IN-HASHTABLE GROUPS)
         (#S(FORMGREP:SYMREF :NAME "CLEANUP" :QUALIFIER "CL-DS.ALG.META")
          GROUP))))
      FUNCTION ARGUMENTS)))

[cl-data-structures/src/algorithms/meta/generics.lisp:15]
  (DEFUN PASS-TO-AGGREGATION (AGGREGATOR ELEMENT)
    (DECLARE (TYPE AGGREGATOR AGGREGATOR)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (~> AGGREGATOR AGGREGATOR-PASS (FUNCALL ELEMENT))
    NIL)

[cl-data-structures/src/algorithms/meta/generics.lisp:23]
  (DEFUN EXTRACT-RESULT (AGGREGATOR)
    (DECLARE (TYPE AGGREGATOR AGGREGATOR)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (~> AGGREGATOR AGGREGATOR-EXTRACT FUNCALL))

[cl-data-structures/src/algorithms/meta/generics.lisp:30]
  (DEFUN CLEANUP (AGGREGATOR)
    (DECLARE (TYPE AGGREGATOR AGGREGATOR)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (~> AGGREGATOR AGGREGATOR-CLEANUP FUNCALL))

[cl-data-structures/src/algorithms/multiplex.lisp:135]
  (DEFMETHOD #S(FORMGREP:SYMREF
                :NAME "AGGREGATOR-CONSTRUCTOR"
                :QUALIFIER "CL-DS.ALG.META")
             ((RANGE MULTIPLEX-PROXY) OUTER-CONSTRUCTOR
              (FUNCTION AGGREGATION-FUNCTION) (ARGUMENTS LIST))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (COMPILATION-SPEED 0) (SPACE 0)))
    (BIND
     ((OUTER-FN (CALL-NEXT-METHOD))
      (FN (ENSURE-FUNCTION (READ-FUNCTION RANGE)))
      (KEY (ENSURE-FUNCTION (READ-KEY RANGE))))
     (#S(FORMGREP:SYMREF
         :NAME "AGGREGATOR-CONSTRUCTOR"
         :QUALIFIER "CL-DS.ALG.META")
      (READ-ORIGINAL-RANGE RANGE)
      (#S(FORMGREP:SYMREF :NAME "CASES" :QUALIFIER "CL-DS.UTILS")
       ((:VARIANT (EQ KEY #'IDENTITY)))
       (#S(FORMGREP:SYMREF :NAME "LET-AGGREGATOR" :QUALIFIER "CL-DS.ALG.META")
        ((INNER
          (#S(FORMGREP:SYMREF
              :NAME "CALL-CONSTRUCTOR"
              :QUALIFIER "CL-DS.ALG.META")
           OUTER-FN)))
        ((ELEMENT)
         (~>> ELEMENT (FUNCALL KEY) (FUNCALL FN)
          (#S(FORMGREP:SYMREF :NAME "TRAVERSE" :QUALIFIER "CL-DS") _
           (LAMBDA (X)
             (#S(FORMGREP:SYMREF
                 :NAME "PASS-TO-AGGREGATION"
                 :QUALIFIER "CL-DS.ALG.META")
              INNER X)))))
        ((#S(FORMGREP:SYMREF
             :NAME "EXTRACT-RESULT"
             :QUALIFIER "CL-DS.ALG.META")
          INNER))
        (#S(FORMGREP:SYMREF :NAME "CLEANUP" :QUALIFIER "CL-DS.ALG.META")
         INNER)))
      FUNCTION ARGUMENTS)))

[cl-data-structures/src/algorithms/on-each.lisp:189]
  (DEFMETHOD #S(FORMGREP:SYMREF
                :NAME "AGGREGATOR-CONSTRUCTOR"
                :QUALIFIER "CL-DS.ALG.META")
             ((RANGE PROXY-BOX-RANGE) OUTER-CONSTRUCTOR
              (FUNCTION AGGREGATION-FUNCTION) (ARGUMENTS LIST))
    (LET ((ON-EACH-KEY (ENSURE-FUNCTION (READ-KEY RANGE)))
          (OUTER-FN (CALL-NEXT-METHOD))
          (FUNCTOR (ACCESS-FUNCTOR RANGE))
          (FUNCTOR-CONSTRUCTOR
           (ENSURE-FUNCTION (READ-FUNCTOR-CONSTRUCTOR RANGE)))
          (FUNCTOR-PROTOTYPE (READ-FUNCTOR-PROTOTYPE RANGE)))
      (ASSERT (FUNCTIONP OUTER-FN))
      (LOCALLY
       (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
       (#S(FORMGREP:SYMREF
           :NAME "AGGREGATOR-CONSTRUCTOR"
           :QUALIFIER "CL-DS.ALG.META")
        (READ-ORIGINAL-RANGE RANGE)
        (#S(FORMGREP:SYMREF :NAME "CASES" :QUALIFIER "CL-DS.UTILS")
         ((:VARIANT (EQ ON-EACH-KEY #'IDENTITY) (EQ ON-EACH-KEY 'IDENTITY)))
         (#S(FORMGREP:SYMREF
             :NAME "LET-AGGREGATOR"
             :QUALIFIER "CL-DS.ALG.META")
          ((INNER
            (#S(FORMGREP:SYMREF
                :NAME "CALL-CONSTRUCTOR"
                :QUALIFIER "CL-DS.ALG.META")
             OUTER-FN))
           (RANGE-FUNCTION
            (ENSURE-FUNCTION
             (OR FUNCTOR (FUNCALL FUNCTOR-CONSTRUCTOR FUNCTOR-PROTOTYPE)))))
          ((ELEMENT)
           (~>> ELEMENT (FUNCALL ON-EACH-KEY) (FUNCALL RANGE-FUNCTION)
            (#S(FORMGREP:SYMREF
                :NAME "PASS-TO-AGGREGATION"
                :QUALIFIER "CL-DS.ALG.META")
             INNER)))
          ((#S(FORMGREP:SYMREF
               :NAME "EXTRACT-RESULT"
               :QUALIFIER "CL-DS.ALG.META")
            INNER))
          (#S(FORMGREP:SYMREF :NAME "CLEANUP" :QUALIFIER "CL-DS.ALG.META")
           INNER)))
        FUNCTION ARGUMENTS))))

[cl-data-structures/src/algorithms/only-different.lisp:91]
  (DEFMETHOD #S(FORMGREP:SYMREF
                :NAME "AGGREGATOR-CONSTRUCTOR"
                :QUALIFIER "CL-DS.ALG.META")
             ((RANGE ONLY-DIFFERENT-PROXY) OUTER-CONSTRUCTOR
              (FUNCTION AGGREGATION-FUNCTION) (ARGUMENTS LIST))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((OUTER-FN
           (OR OUTER-CONSTRUCTOR
               (#S(FORMGREP:SYMREF
                   :NAME "AGGREGATOR-CONSTRUCTOR"
                   :QUALIFIER "CL-DS.ALG.META")
                'NIL NIL FUNCTION ARGUMENTS)))
          (COMPARSION (ENSURE-FUNCTION (READ-COMPARSION RANGE)))
          (KEY (ENSURE-FUNCTION (READ-KEY RANGE))))
      (#S(FORMGREP:SYMREF :NAME "CASES" :QUALIFIER "CL-DS.UTILS")
       ((:VARIANT (EQ KEY #'IDENTITY)))
       (#S(FORMGREP:SYMREF
           :NAME "AGGREGATOR-CONSTRUCTOR"
           :QUALIFIER "CL-DS.ALG.META")
        (READ-ORIGINAL-RANGE RANGE)
        (#S(FORMGREP:SYMREF :NAME "LET-AGGREGATOR" :QUALIFIER "CL-DS.ALG.META")
         ((INNER
           (#S(FORMGREP:SYMREF
               :NAME "CALL-CONSTRUCTOR"
               :QUALIFIER "CL-DS.ALG.META")
            OUTER-FN))
          (PREVIOUS (ACCESS-PREVIOUS RANGE))
          (PREVIOUS-BOUND (ACCESS-PREVIOUS-BOUND RANGE)))
         ((ELEMENT)
          (LET ((KEY (FUNCALL KEY ELEMENT)))
            (UNLESS (AND PREVIOUS-BOUND (FUNCALL COMPARSION PREVIOUS KEY))
              (#S(FORMGREP:SYMREF
                  :NAME "PASS-TO-AGGREGATION"
                  :QUALIFIER "CL-DS.ALG.META")
               INNER ELEMENT)
              (SETF PREVIOUS KEY
                    PREVIOUS-BOUND T))))
         ((#S(FORMGREP:SYMREF
              :NAME "EXTRACT-RESULT"
              :QUALIFIER "CL-DS.ALG.META")
           INNER))
         (#S(FORMGREP:SYMREF :NAME "CLEANUP" :QUALIFIER "CL-DS.ALG.META")
          INNER))
        FUNCTION ARGUMENTS))))

[cl-data-structures/src/algorithms/only.lisp:68]
  (DEFMETHOD #S(FORMGREP:SYMREF
                :NAME "AGGREGATOR-CONSTRUCTOR"
                :QUALIFIER "CL-DS.ALG.META")
             ((RANGE ONLY-PROXY) OUTER-CONSTRUCTOR
              (FUNCTION AGGREGATION-FUNCTION) (ARGUMENTS LIST))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((OUTER-FN
           (OR OUTER-CONSTRUCTOR
               (#S(FORMGREP:SYMREF
                   :NAME "AGGREGATOR-CONSTRUCTOR"
                   :QUALIFIER "CL-DS.ALG.META")
                'NIL NIL FUNCTION ARGUMENTS)))
          (PREDICATE (ENSURE-FUNCTION (READ-PREDICATE RANGE)))
          (KEY (ENSURE-FUNCTION (READ-KEY RANGE))))
      (#S(FORMGREP:SYMREF :NAME "CASES" :QUALIFIER "CL-DS.UTILS")
       ((:VARIANT (EQ KEY #'IDENTITY)))
       (#S(FORMGREP:SYMREF
           :NAME "AGGREGATOR-CONSTRUCTOR"
           :QUALIFIER "CL-DS.ALG.META")
        (READ-ORIGINAL-RANGE RANGE)
        (#S(FORMGREP:SYMREF :NAME "LET-AGGREGATOR" :QUALIFIER "CL-DS.ALG.META")
         ((INNER
           (#S(FORMGREP:SYMREF
               :NAME "CALL-CONSTRUCTOR"
               :QUALIFIER "CL-DS.ALG.META")
            OUTER-FN)))
         ((ELEMENT)
          (WHEN (FUNCALL PREDICATE (FUNCALL KEY ELEMENT))
            (#S(FORMGREP:SYMREF
                :NAME "PASS-TO-AGGREGATION"
                :QUALIFIER "CL-DS.ALG.META")
             INNER ELEMENT)))
         ((#S(FORMGREP:SYMREF
              :NAME "EXTRACT-RESULT"
              :QUALIFIER "CL-DS.ALG.META")
           INNER))
         (#S(FORMGREP:SYMREF :NAME "CLEANUP" :QUALIFIER "CL-DS.ALG.META")
          INNER))
        FUNCTION ARGUMENTS))))

[cl-data-structures/src/algorithms/partition-if.lisp:48]
  (DEFMETHOD #S(FORMGREP:SYMREF
                :NAME "AGGREGATOR-CONSTRUCTOR"
                :QUALIFIER "CL-DS.ALG.META")
             ((RANGE PARTITION-IF-PROXY) OUTER-CONSTRUCTOR
              (FUNCTION AGGREGATION-FUNCTION) (ARGUMENTS LIST))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (BIND
     ((ON-FIRST (READ-ON-FIRST RANGE))
      (TEST (ENSURE-FUNCTION (READ-TEST RANGE)))
      (PARTITION-KEY (ENSURE-FUNCTION (READ-KEY RANGE)))
      (COLLECTED (ACCESS-COLLECTED RANGE)) (OUTER-FN (CALL-NEXT-METHOD)))
     (ASSERT (FUNCTIONP OUTER-FN))
     (#S(FORMGREP:SYMREF
         :NAME "AGGREGATOR-CONSTRUCTOR"
         :QUALIFIER "CL-DS.ALG.META")
      (READ-ORIGINAL-RANGE RANGE)
      (#S(FORMGREP:SYMREF
          :NAME "LAYER-AGGREGATOR-CONSTRUCTOR"
          :QUALIFIER "CL-DS.ALG.META")
       #'PARTITION-IF OUTER-FN
       (LIST TEST :KEY PARTITION-KEY :ON-FIRST ON-FIRST :COLLECTED COLLECTED))
      FUNCTION ARGUMENTS)))

[cl-data-structures/src/algorithms/repeat.lisp:95]
  (DEFMETHOD #S(FORMGREP:SYMREF
                :NAME "AGGREGATOR-CONSTRUCTOR"
                :QUALIFIER "CL-DS.ALG.META")
             ((RANGE REPEAT-PROXY) OUTER-CONSTRUCTOR
              (FUNCTION AGGREGATION-FUNCTION) (ARGUMENTS LIST))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((OUTER-FN (CALL-NEXT-METHOD))
          (POSITION (ACCESS-POSITION RANGE))
          (SIZE (READ-SIZE RANGE)))
      (DECLARE (TYPE FIXNUM POSITION SIZE))
      (ASSERT (FUNCTIONP OUTER-FN))
      (#S(FORMGREP:SYMREF
          :NAME "AGGREGATOR-CONSTRUCTOR"
          :QUALIFIER "CL-DS.ALG.META")
       (READ-ORIGINAL-RANGE RANGE)
       (#S(FORMGREP:SYMREF :NAME "LET-AGGREGATOR" :QUALIFIER "CL-DS.ALG.META")
        ((INNER
          (#S(FORMGREP:SYMREF
              :NAME "CALL-CONSTRUCTOR"
              :QUALIFIER "CL-DS.ALG.META")
           OUTER-FN))
         (DATA (VECT)))
        ((ELEMENT) (VECTOR-PUSH-EXTEND ELEMENT DATA))
        ((ITERATE (DECLARE (TYPE FIXNUM I)) (FOR I FROM POSITION BELOW SIZE)
          (ITERATE (FOR ELT IN-VECTOR DATA)
           (#S(FORMGREP:SYMREF
               :NAME "PASS-TO-AGGREGATION"
               :QUALIFIER "CL-DS.ALG.META")
            INNER ELT)))
         (#S(FORMGREP:SYMREF
             :NAME "EXTRACT-RESULT"
             :QUALIFIER "CL-DS.ALG.META")
          INNER)
         (#S(FORMGREP:SYMREF :NAME "CLEANUP" :QUALIFIER "CL-DS.ALG.META")
          INNER)))
       FUNCTION ARGUMENTS)))

[cl-data-structures/src/algorithms/reservoir-sample.lisp:6]
  (DEFUN GEN-W (COUNT &OPTIONAL (W 1.0d0))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (* W (EXP (/ (LOG (RANDOM 1.0d0)) COUNT))))

[cl-data-structures/src/algorithms/reservoir-sample.lisp:14]
  (DEFUN CALCULATE-SKIP-COUNT (W)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (1+
     (THE FIXNUM
          (FLOOR
           (/ (THE NEGATIVE-DOUBLE-FLOAT (LOG (RANDOM 1.0d0)))
              (THE NEGATIVE-DOUBLE-FLOAT (LOG (- 1 W))))))))

[cl-data-structures/src/algorithms/restrain-size.lisp:97]
  (DEFMETHOD #S(FORMGREP:SYMREF
                :NAME "AGGREGATOR-CONSTRUCTOR"
                :QUALIFIER "CL-DS.ALG.META")
             ((RANGE RESTRAIN-SIZE-PROXY) OUTER-CONSTRUCTOR
              (FUNCTION AGGREGATION-FUNCTION) (ARGUMENTS LIST))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((OUTER-FN (CALL-NEXT-METHOD))
          (POSITION (ACCESS-POSITION RANGE))
          (SIZE (READ-SIZE RANGE)))
      (DECLARE (TYPE FIXNUM POSITION SIZE))
      (ASSERT (FUNCTIONP OUTER-FN))
      (#S(FORMGREP:SYMREF
          :NAME "AGGREGATOR-CONSTRUCTOR"
          :QUALIFIER "CL-DS.ALG.META")
       (READ-ORIGINAL-RANGE RANGE)
       (#S(FORMGREP:SYMREF :NAME "LET-AGGREGATOR" :QUALIFIER "CL-DS.ALG.META")
        ((INNER
          (#S(FORMGREP:SYMREF
              :NAME "CALL-CONSTRUCTOR"
              :QUALIFIER "CL-DS.ALG.META")
           OUTER-FN))
         (POSITION POSITION))
        ((ELEMENT)
         (WHEN (< (THE FIXNUM POSITION) SIZE)
           (#S(FORMGREP:SYMREF
               :NAME "PASS-TO-AGGREGATION"
               :QUALIFIER "CL-DS.ALG.META")
            INNER ELEMENT)
           (INCF (THE FIXNUM POSITION))))
        ((#S(FORMGREP:SYMREF
             :NAME "EXTRACT-RESULT"
             :QUALIFIER "CL-DS.ALG.META")
          INNER))
        (#S(FORMGREP:SYMREF :NAME "CLEANUP" :QUALIFIER "CL-DS.ALG.META")
         INNER))
       FUNCTION ARGUMENTS)))

[cl-data-structures/src/algorithms/without.lisp:65]
  (DEFMETHOD #S(FORMGREP:SYMREF
                :NAME "AGGREGATOR-CONSTRUCTOR"
                :QUALIFIER "CL-DS.ALG.META")
             ((RANGE WITHOUT-PROXY) OUTER-CONSTRUCTOR
              (FUNCTION AGGREGATION-FUNCTION) (ARGUMENTS LIST))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((OUTER-FN
           (OR OUTER-CONSTRUCTOR
               (#S(FORMGREP:SYMREF
                   :NAME "AGGREGATOR-CONSTRUCTOR"
                   :QUALIFIER "CL-DS.ALG.META")
                'NIL NIL FUNCTION ARGUMENTS)))
          (PREDICATE (ENSURE-FUNCTION (READ-PREDICATE RANGE)))
          (KEY (ENSURE-FUNCTION (READ-KEY RANGE))))
      (#S(FORMGREP:SYMREF :NAME "CASES" :QUALIFIER "CL-DS.UTILS")
       ((:VARIANT (EQ KEY #'IDENTITY)))
       (#S(FORMGREP:SYMREF
           :NAME "AGGREGATOR-CONSTRUCTOR"
           :QUALIFIER "CL-DS.ALG.META")
        (READ-ORIGINAL-RANGE RANGE)
        (#S(FORMGREP:SYMREF :NAME "LET-AGGREGATOR" :QUALIFIER "CL-DS.ALG.META")
         ((INNER
           (#S(FORMGREP:SYMREF
               :NAME "CALL-CONSTRUCTOR"
               :QUALIFIER "CL-DS.ALG.META")
            OUTER-FN)))
         ((ELEMENT)
          (UNLESS (FUNCALL PREDICATE (FUNCALL KEY ELEMENT))
            (#S(FORMGREP:SYMREF
                :NAME "PASS-TO-AGGREGATION"
                :QUALIFIER "CL-DS.ALG.META")
             INNER ELEMENT)))
         ((#S(FORMGREP:SYMREF
              :NAME "EXTRACT-RESULT"
              :QUALIFIER "CL-DS.ALG.META")
           INNER))
         (#S(FORMGREP:SYMREF :NAME "CLEANUP" :QUALIFIER "CL-DS.ALG.META")
          INNER))
        FUNCTION ARGUMENTS))))

[cl-data-structures/src/common/abstract/common.lisp:24]
  (DEFUN TAGGED-NODE-OWNERSHIP-TAG (NODE)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (SLOT-VALUE NODE '%OWNERSHIP-TAG))

[cl-data-structures/src/common/abstract/common.lisp:56]
  (DEFMACRO DEFINE-TAGGED-UNTAGGED-NODE (NAME &BODY SLOTS)
    (LET* ((STRING (SYMBOL-NAME NAME))
           (TAGGED-NAME (INTERN (FORMAT NIL "~a-TAGGED" STRING)))
           (UNTAGGED-NAME (INTERN (FORMAT NIL "~a-UNTAGGED" STRING))))
      (ECLECTOR.READER:QUASIQUOTE
       (PROGN
        (DEFSTRUCT (ECLECTOR.READER:UNQUOTE UNTAGGED-NAME)
          (ECLECTOR.READER:UNQUOTE-SPLICING SLOTS))
        (DEFSTRUCT
            ((ECLECTOR.READER:UNQUOTE TAGGED-NAME)
             (:INCLUDE TAGGED-STRUCT-NODE))
          (ECLECTOR.READER:UNQUOTE-SPLICING SLOTS))
        (DEFTYPE (ECLECTOR.READER:UNQUOTE NAME) ()
          (ECLECTOR.READER:QUASIQUOTE
           (OR
            (ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE UNTAGGED-NAME))
            (ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE TAGGED-NAME)))))
        (ECLECTOR.READER:UNQUOTE-SPLICING
         (ITERATE (FOR SLOT IN SLOTS)
          (FOR FNAME = (STRUCT-ACCESSOR-NAME NAME SLOT))
          (COLLECT
           (ECLECTOR.READER:QUASIQUOTE
            (DEFUN (ECLECTOR.READER:UNQUOTE FNAME) (ARGUMENT)
              (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
                       (TYPE (ECLECTOR.READER:UNQUOTE NAME) ARGUMENT))
              (ETYPECASE ARGUMENT
                ((ECLECTOR.READER:UNQUOTE TAGGED-NAME)
                 ((ECLECTOR.READER:UNQUOTE
                   (STRUCT-ACCESSOR-NAME TAGGED-NAME SLOT))
                  ARGUMENT))
                ((ECLECTOR.READER:UNQUOTE UNTAGGED-NAME)
                 ((ECLECTOR.READER:UNQUOTE
                   (STRUCT-ACCESSOR-NAME UNTAGGED-NAME SLOT))
                  ARGUMENT))))))
          (COLLECT
           (ECLECTOR.READER:QUASIQUOTE
            (DEFUN (SETF (ECLECTOR.READER:UNQUOTE FNAME)) (NEW-VALUE ARGUMENT)
              (DECLARE (OPTIMIZE (SPEED 3))
                       (TYPE (ECLECTOR.READER:UNQUOTE NAME) ARGUMENT))
              (ETYPECASE ARGUMENT
                ((ECLECTOR.READER:UNQUOTE TAGGED-NAME)
                 (SETF ((ECLECTOR.READER:UNQUOTE
                         (STRUCT-ACCESSOR-NAME TAGGED-NAME SLOT))
                        ARGUMENT)
                         NEW-VALUE))
                ((ECLECTOR.READER:UNQUOTE UNTAGGED-NAME)
                 (SETF ((ECLECTOR.READER:UNQUOTE
                         (STRUCT-ACCESSOR-NAME UNTAGGED-NAME SLOT))
                        ARGUMENT)
                         NEW-VALUE))))))))
        (DEFUN (ECLECTOR.READER:UNQUOTE (INTERN (FORMAT NIL "MAKE-~a" NAME)))
               (
                &KEY
                (ECLECTOR.READER:UNQUOTE-SPLICING
                 (ITERATE (FOR SLOT IN SLOTS) (FOR SYMBOLP = (SYMBOLP SLOT))
                  (FOR SYMBOL =
                   (IF SYMBOLP
                       SLOT
                       (FIRST SLOT)))
                  (IF SYMBOLP
                      (COLLECT SYMBOL)
                      (COLLECT
                       (ECLECTOR.READER:QUASIQUOTE
                        ((ECLECTOR.READER:UNQUOTE SYMBOL)
                         (ECLECTOR.READER:UNQUOTE (SECOND SLOT))))))))
                OWNERSHIP-TAG)
          (IF (NULL OWNERSHIP-TAG)
              ((ECLECTOR.READER:UNQUOTE
                (INTERN (FORMAT NIL "MAKE-~a" UNTAGGED-NAME)))
               (ECLECTOR.READER:UNQUOTE-SPLICING
                (ITERATE (FOR SLOT IN SLOTS)
                 (FOR SYMBOL =
                  (IF (SYMBOLP SLOT)
                      SLOT
                      (FIRST SLOT)))
                 (COLLECT (MAKE-KEYWORD SYMBOL)) (COLLECT SYMBOL))))
              ((ECLECTOR.READER:UNQUOTE
                (INTERN (FORMAT NIL "MAKE-~a" TAGGED-NAME)))
               (ECLECTOR.READER:UNQUOTE-SPLICING
                (ITERATE (FOR SLOT IN SLOTS)
                 (FOR SYMBOL =
                  (IF (SYMBOLP SLOT)
                      SLOT
                      (FIRST SLOT)))
                 (COLLECT (MAKE-KEYWORD SYMBOL)) (COLLECT SYMBOL)))
               (ECLECTOR.READER:UNQUOTE (MAKE-KEYWORD 'OWNERSHIP-TAG))
               OWNERSHIP-TAG)))))))

[cl-data-structures/src/common/hamt/common.lisp:182]
  (DEFUN SET-IN-NODE-MASK (NODE POSITION BIT)
    (DECLARE (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 1)))
    (SETF (LDB (BYTE 1 POSITION) (HASH-NODE-NODE-MASK NODE)) BIT)
    NODE)

[cl-data-structures/src/common/hamt/common.lisp:195]
  (DEFUN HASH-NODE-TO-MASKED-INDEX (HASH-NODE INDEX)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 1) (SPACE 0)))
    (~>> HASH-NODE HASH-NODE-WHOLE-MASK (LDB (BYTE INDEX 0)) LOGCOUNT))

[cl-data-structures/src/common/hamt/common.lisp:204]
  (DEFUN HASH-NODE-CONTAINS (HASH-NODE INDEX)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 1) (SPACE 0)))
    (~>> (HASH-NODE-WHOLE-MASK HASH-NODE) (LDB-TEST (BYTE 1 INDEX))))

[cl-data-structures/src/common/hamt/common.lisp:211]
  (DEFUN HASH-NODE-CONTAINS-NODE (HASH-NODE INDEX)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 1) (SPACE 0)))
    (~>> (HASH-NODE-NODE-MASK HASH-NODE) (LDB-TEST (BYTE 1 INDEX))))

[cl-data-structures/src/common/hamt/common.lisp:218]
  (DEFUN HASH-NODE-ACCESS (HASH-NODE INDEX)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 1) (SPACE 0)))
    (~>> (HASH-NODE-TO-MASKED-INDEX HASH-NODE INDEX)
     (AREF (HASH-NODE-CONTENT HASH-NODE))))

[cl-data-structures/src/common/hamt/common.lisp:225]
  (DEFUN HASH-NODE-SIZE (NODE)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 1) (SPACE 0)))
    (LOGCOUNT (HASH-NODE-WHOLE-MASK NODE)))

[cl-data-structures/src/common/hamt/common.lisp:238]
  (DEFUN GO-DOWN-ON-PATH (CONTAINER HASH ON-LEAF ON-NIL AFTER)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 1) (SPACE 0))
             (TYPE FIXNUM HASH))
    (BIND
     ((STATUS NIL)
      ((:DFLET AFTER (INDEXES PATH DEPTH NEXT))
       (FUNCALL AFTER INDEXES PATH DEPTH NEXT)))
     (VALUES
      (BLOCK LOOP-BLOCK
        (WITH-HAMT-PATH NODE HASH (ACCESS-ROOT CONTAINER) :OPERATION AFTER
         :ON-LEAF
         (MULTIPLE-VALUE-BIND (B S C)
             (FUNCALL ON-LEAF NODE)
           (SETF STATUS S)
           (UNLESS C (RETURN-FROM LOOP-BLOCK NIL))
           B)
         :ON-NIL
         (MULTIPLE-VALUE-BIND (B S C)
             (FUNCALL ON-NIL)
           (SETF STATUS S)
           (UNLESS C (RETURN-FROM LOOP-BLOCK NIL))
           B)))
      STATUS)))

[cl-data-structures/src/common/hamt/common.lisp:272]
  (DEFUN COPY-NODE (NODE &KEY NODE-MASK OWNERSHIP-TAG CONTENT)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 1) (SPACE 0)))
    (MAKE-HASH-NODE :OWNERSHIP-TAG (OR OWNERSHIP-TAG (READ-OWNERSHIP-TAG NODE))
     :NODE-MASK (OR NODE-MASK (HASH-NODE-NODE-MASK NODE)) :CONTENT
     (OR CONTENT (HASH-NODE-CONTENT NODE))))

[cl-data-structures/src/common/hamt/common.lisp:281]
  (DEFUN HASH-NODE-REPLACE-IN-THE-COPY (HASH-NODE ITEM INDEX OWNERSHIP-TAG)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 1) (SPACE 0)))
    (LET* ((CONTENT (COPY-ARRAY (HASH-NODE-CONTENT HASH-NODE)))
           (NODE-MASK (HASH-NODE-NODE-MASK HASH-NODE)))
      (DECLARE (TYPE HASH-MASK NODE-MASK))
      (SETF (AREF CONTENT (LOGCOUNT (LDB (BYTE INDEX 0) NODE-MASK))) ITEM)
      (MAKE-HASH-NODE :NODE-MASK NODE-MASK :OWNERSHIP-TAG OWNERSHIP-TAG
       :CONTENT CONTENT)))

[cl-data-structures/src/common/hamt/common.lisp:298]
  (DEFUN HASH-NODE-INSERT-INTO-COPY (HASH-NODE CONTENT INDEX OWNERSHIP-TAG)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 1) (SPACE 0)))
    (BIND
     ((POSITION (HASH-NODE-TO-MASKED-INDEX HASH-NODE INDEX))
      ((:VECTORS CURRENT-ARRAY NEW-ARRAY) (HASH-NODE-CONTENT HASH-NODE)
       (MAKE-ARRAY (~> HASH-NODE HASH-NODE-WHOLE-MASK LOGCOUNT 1+))))
     (ASSERT (~> (ARRAY-DIMENSION NEW-ARRAY 0) (<= +MAXIMUM-CHILDREN-COUNT+)))
     (ITERATE (FOR I FROM 0 BELOW POSITION)
      (SETF (NEW-ARRAY I) (CURRENT-ARRAY I)))
     (SETF (NEW-ARRAY POSITION) CONTENT)
     (ITERATE (FOR I FROM POSITION BELOW (ARRAY-DIMENSION CURRENT-ARRAY 0))
      (FOR J FROM (1+ POSITION) BELOW (ARRAY-DIMENSION NEW-ARRAY 0))
      (SETF (NEW-ARRAY J) (CURRENT-ARRAY I)))
     (LET ((NODE-MASK (HASH-NODE-NODE-MASK HASH-NODE)))
       (SETF (LDB (BYTE 1 INDEX) NODE-MASK) 1)
       (MAKE-HASH-NODE :NODE-MASK NODE-MASK :OWNERSHIP-TAG OWNERSHIP-TAG
        :CONTENT NEW-ARRAY))))

[cl-data-structures/src/common/hamt/common.lisp:375]
  (DEFUN REBUILD-REHASHED-NODE (CONTAINER DEPTH CONFLICT OWNERSHIP-TAG)
    (DECLARE (OPTIMIZE (SPEED 0) (SAFETY 1) (DEBUG 3) (SPACE 0))
             (TYPE FIXNUM DEPTH))
    (FLET ((CONT (ARRAY)
             (BUILD-REHASHED-NODE CONTAINER (1+ DEPTH) ARRAY OWNERSHIP-TAG)))
      (DECLARE (DYNAMIC-EXTENT (FUNCTION CONT)))
      (BIND
       (((:ACCESSORS (LOCK HASH-NODE-LOCK) (TAG HASH-NODE-OWNERSHIP-TAG))
         CONFLICT))
       (IF (OR (>= DEPTH +DEPTH+) (NOT (FULL-BUCKET-P CONTAINER CONFLICT)))
           CONFLICT
           (REHASH CONFLICT DEPTH #'CONT)))))

[cl-data-structures/src/common/hamt/common.lisp:475]
  (DEFUN REHASH (CONFLICT LEVEL CONT)
    (DECLARE (TYPE LIST CONFLICT)
             (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 0) (SPACE 0)))
    (LET ((RESULT (MAKE-ARRAY +MAXIMUM-CHILDREN-COUNT+ :INITIAL-ELEMENT NIL))
          (BYTE
           (BYTE +HASH-LEVEL+
                 (THE FIXNUM
                      (* (THE FIXNUM +HASH-LEVEL+) (THE FIXNUM LEVEL))))))
      (DECLARE (DYNAMIC-EXTENT BYTE)
               (DYNAMIC-EXTENT RESULT))
      (ITERATE (FOR ITEM IN CONFLICT)
       (FOR HASH =
        (#S(FORMGREP:SYMREF
            :NAME "HASH-CONTENT-HASH"
            :QUALIFIER "CL-DS.COMMON")
         ITEM))
       (FOR INDEX = (LDB BYTE HASH)) (PUSH ITEM (AREF RESULT INDEX)))
      (FUNCALL CONT RESULT)))

[cl-data-structures/src/common/hamt/common.lisp:498]
  (DEFUN COPY-ON-WRITE (CONTAINER OWNERSHIP-TAG INDEXES PATH DEPTH CONFLICT)
    (DECLARE (TYPE INDEX-PATH INDEXES)
             (TYPE NODE-PATH PATH)
             (TYPE FIXNUM DEPTH)
             (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 0) (SPACE 0)))
    (#S(FORMGREP:SYMREF :NAME "WITH-VECTORS" :QUALIFIER "CL-DS.UTILS")
     (PATH INDEXES)
     (WHEN (AND (NOT (ZEROP DEPTH)) (EQ CONFLICT (PATH (- DEPTH 1))))
       (RETURN-FROM COPY-ON-WRITE (PATH 0)))
     (ITERATE (FOR I FROM (- DEPTH 1) DOWNTO 0) (FOR NODE = (PATH I))
      (FOR INDEX = (INDEXES I))
      (FOR AC INITIALLY
       (IF (OR
            (#S(FORMGREP:SYMREF :NAME "NULL-BUCKET-P" :QUALIFIER "CL-DS.META")
             CONFLICT)
            (NULL CONFLICT))
           CONFLICT
           (REBUILD-REHASHED-NODE CONTAINER DEPTH CONFLICT OWNERSHIP-TAG))
       THEN
       (IF AC
           (IF (HASH-NODE-CONTAINS NODE INDEX)
               (HASH-NODE-REPLACE-IN-THE-COPY NODE AC INDEX OWNERSHIP-TAG)
               (HASH-NODE-INSERT-INTO-COPY NODE AC INDEX OWNERSHIP-TAG))
           (IF (EQL 1 (HASH-NODE-SIZE NODE))
               AC
               (HASH-NODE-REMOVE-FROM-THE-COPY NODE INDEX OWNERSHIP-TAG))))
      (FINALLY (RETURN AC)))))

[cl-data-structures/src/common/hamt/common.lisp:534]
  (DEFUN TRANSACTIONAL-COPY-ON-WRITE
         (CONTAINER OWNERSHIP-TAG INDEXES PATH DEPTH CONFLICT)
    (DECLARE (TYPE (SIMPLE-ARRAY FIXNUM) INDEXES)
             (TYPE SIMPLE-ARRAY PATH)
             (TYPE FIXNUM DEPTH)
             (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 0) (SPACE 0)))
    (#S(FORMGREP:SYMREF :NAME "WITH-VECTORS" :QUALIFIER "CL-DS.UTILS")
     (PATH INDEXES)
     (ITERATE
      (WITH OWNED-DEPTH =
       (ITERATE (FOR I FROM 0 BELOW DEPTH) (FOR NODE = (PATH I))
        (WHILE (ACQUIRE-OWNERSHIP (THE HASH-NODE NODE) OWNERSHIP-TAG))
        (FINALLY (RETURN I))))
      (FOR I FROM (- DEPTH 1) DOWNTO 0) (FOR NODE = (PATH I))
      (FOR INDEX = (INDEXES I))
      (FOR AC INITIALLY
       (IF (OR
            (#S(FORMGREP:SYMREF :NAME "NULL-BUCKET-P" :QUALIFIER "CL-DS.META")
             CONFLICT)
            (NULL CONFLICT))
           CONFLICT
           (REBUILD-REHASHED-NODE CONTAINER DEPTH CONFLICT OWNERSHIP-TAG))
       THEN
       (IF AC
           (#S(FORMGREP:SYMREF :NAME "COND+" :QUALIFIER "CL-DS.UTILS")
            ((HASH-NODE-CONTAINS NODE INDEX) (< I OWNED-DEPTH))
            ((T T) (HASH-NODE-REPLACE! NODE AC INDEX))
            ((NIL T) (HASH-NODE-INSERT! NODE AC INDEX))
            ((T NIL)
             (HASH-NODE-REPLACE-IN-THE-COPY NODE AC INDEX OWNERSHIP-TAG))
            ((NIL NIL)
             (HASH-NODE-INSERT-INTO-COPY NODE AC INDEX OWNERSHIP-TAG)))
           (#S(FORMGREP:SYMREF :NAME "COND+" :QUALIFIER "CL-DS.UTILS")
            ((EQL 1 (HASH-NODE-SIZE NODE)) (< I OWNED-DEPTH)) ((T T) AC)
            ((T NIL) AC) ((NIL T) (HASH-NODE-REMOVE! NODE INDEX))
            ((NIL NIL)
             (HASH-NODE-REMOVE-FROM-THE-COPY NODE INDEX OWNERSHIP-TAG)))))
      (WHEN (EQ NODE AC) (LEAVE (PATH 0))) (FINALLY (RETURN AC)))))

[cl-data-structures/src/common/qp-trie.lisp:237]
  (DEFMACRO QP-TRIE-INSERT! (QP-TRIE BYTES NEW-NODE-FORM)
    (ONCE-ONLY (QP-TRIE BYTES)
     (ECLECTOR.READER:QUASIQUOTE
      (LOCALLY
       (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0))
                (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*))
                 (ECLECTOR.READER:UNQUOTE BYTES))
                (TYPE QP-TRIE (ECLECTOR.READER:UNQUOTE QP-TRIE)))
       (ASSERT (NOT (EMPTYP (ECLECTOR.READER:UNQUOTE BYTES))))
       (ITERATE
        (DECLARE (TYPE FIXNUM LENGTH I HALF-BYTE-1 HALF-BYTE-2 BYTE)
                 (TYPE QP-TRIE-NODE NODE))
        (WITH NODE = (ACCESS-ROOT (ECLECTOR.READER:UNQUOTE QP-TRIE)))
        (WITH LENGTH = (LENGTH (ECLECTOR.READER:UNQUOTE BYTES)))
        (FOR I FROM 0 BELOW (THE FIXNUM (1- LENGTH)))
        (FOR BYTE = (AREF (ECLECTOR.READER:UNQUOTE BYTES) I))
        (FOR (VALUES HALF-BYTE-1 HALF-BYTE-2) = (SPLIT-BYTE BYTE))
        (SETF NODE
                (QP-TRIE-NODE-GET-OR-INSERT-CHILD! NODE HALF-BYTE-1
                 (ECLECTOR.READER:UNQUOTE NEW-NODE-FORM))
              NODE
                (QP-TRIE-NODE-GET-OR-INSERT-CHILD! NODE HALF-BYTE-2
                 (ECLECTOR.READER:UNQUOTE NEW-NODE-FORM)))
        (FINALLY
         (BIND
          ((LAST-BYTE
            (AREF (ECLECTOR.READER:UNQUOTE BYTES) (THE FIXNUM (1- LENGTH))))
           ((:VALUES LAST-HALF-BYTE-1 LAST-HALF-BYTE-2) (SPLIT-BYTE LAST-BYTE))
           (NEXT-NODE
            (QP-TRIE-NODE-GET-OR-INSERT-CHILD! NODE LAST-HALF-BYTE-1
             (ECLECTOR.READER:UNQUOTE NEW-NODE-FORM)))
           (OLD-MASK (QP-TRIE-NODE-STORE-BITMASK NEXT-NODE))
           (NEW-MASK (QP-TRIE-NODE-MARK-LEAF! NEXT-NODE LAST-HALF-BYTE-2)))
          (RETURN (VALUES (NOT (EQL NEW-MASK OLD-MASK)) NEXT-NODE)))))))))

[cl-data-structures/src/common/qp-trie.lisp:278]
  (DEFUN QP-TRIE-FIND (QP-TRIE BYTES)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0))
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) BYTES))
    (ASSERT (NOT (EMPTYP BYTES)))
    (ITERATE
     (DECLARE (TYPE FIXNUM I LENGTH)
              (TYPE HALF-BYTE HALF-BYTE-1 HALF-BYTE-2))
     (WITH NODE = (ACCESS-ROOT QP-TRIE)) (WITH LENGTH = (LENGTH BYTES))
     (FOR I FROM 0 BELOW (1- LENGTH)) (FOR BYTE = (AREF BYTES I))
     (FOR (VALUES HALF-BYTE-1 HALF-BYTE-2) = (SPLIT-BYTE BYTE))
     (UNLESS (QP-TRIE-NODE-PRESENT-P NODE HALF-BYTE-1) (LEAVE (VALUES I NODE)))
     (FOR NEXT-NODE = (QP-TRIE-NODE-REF NODE HALF-BYTE-1))
     (UNLESS (QP-TRIE-NODE-PRESENT-P NEXT-NODE HALF-BYTE-2)
       (LEAVE (VALUES I NEXT-NODE)))
     (SETF NODE (QP-TRIE-NODE-REF NEXT-NODE HALF-BYTE-2))
     (FINALLY
      (BIND
       ((LAST-BYTE (AREF BYTES (1- LENGTH)))
        ((:VALUES HALF-BYTE-1 HALF-BYTE-2) (SPLIT-BYTE LAST-BYTE))
        (RESULT NIL))
       (UNLESS (QP-TRIE-NODE-PRESENT-P NODE HALF-BYTE-1) (RETURN (1- LENGTH)))
       (SETF NODE (QP-TRIE-NODE-REF NODE HALF-BYTE-1))
       (SETF RESULT (QP-TRIE-NODE-LEAF-PRESENT-P NODE HALF-BYTE-2))
       (IF RESULT
           (RETURN (VALUES LENGTH NODE))
           (RETURN (VALUES (1- LENGTH) NODE)))))))

[cl-data-structures/src/common/rrb/common.lisp:145]
  (DEFUN (SETF SPARSE-NREF) (NEW-VALUE NODE INDEX)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (WITH-SPARSE-RRB-NODE NODE
     (LET ((CONTENT (SPARSE-RRB-NODE-CONTENT NODE)))
       (IF (SPARSE-RRB-NODE-CONTAINS NODE INDEX)
           (SETF (AREF CONTENT (SINDEX INDEX)) NEW-VALUE)
           (LET* ((LENGTH (LENGTH CONTENT))
                  (BITMASK (SPARSE-RRB-NODE-BITMASK NODE))
                  (NEW-BITMASK (DPB 1 (BYTE 1 INDEX) BITMASK))
                  (CONTENT (SPARSE-RRB-NODE-CONTENT NODE))
                  (NEW-LENGTH (LOGCOUNT NEW-BITMASK))
                  (SINDEX 0)
                  (NEW-CONTENT
                   (IF (>= LENGTH NEW-LENGTH)
                       CONTENT
                       (MAKE-ARRAY
                        (CLAMP (* 2 LENGTH) 1 +MAXIMUM-CHILDREN-COUNT+)
                        :ELEMENT-TYPE (ARRAY-ELEMENT-TYPE CONTENT)))))
             (DECLARE (TYPE RRB-INDEX NEW-LENGTH)
                      (TYPE NODE-SIZE SINDEX)
                      (TYPE (SIMPLE-ARRAY * (*)) NEW-CONTENT))
             (ASSERT (>= LENGTH (LOGCOUNT BITMASK)))
             (ASSERT (>= (LENGTH NEW-CONTENT) (LOGCOUNT NEW-BITMASK)))
             (SETF (SPARSE-RRB-NODE-BITMASK NODE) NEW-BITMASK
                   SINDEX (SINDEX INDEX))
             (ITERATE (DECLARE (TYPE NODE-SIZE I)) (WITH I = (1- NEW-LENGTH))
              (WHILE (> I SINDEX))
              (SETF (AREF NEW-CONTENT I) (AREF CONTENT (1- I))) (DECF I))
             (UNLESS (EQ NEW-CONTENT CONTENT)
               (ITERATE (DECLARE (TYPE NODE-SIZE I)) (WITH I = 0)
                (WHILE (< I SINDEX))
                (SETF (AREF NEW-CONTENT I) (AREF CONTENT I)) (INCF I)))
             (SETF (AREF NEW-CONTENT SINDEX) NEW-VALUE
                   (SPARSE-RRB-NODE-CONTENT NODE) NEW-CONTENT))))))

[cl-data-structures/src/common/rrb/common.lisp:257]
  (DEFUN DEEP-COPY-SPARSE-RRB-NODE (NODE &OPTIONAL SIZE-CHANGE TAG)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SPACE 0) (SAFETY 0)))
    (WITH-SPARSE-RRB-NODE NODE
     (LET* ((CONTENT (SPARSE-RRB-NODE-CONTENT NODE))
            (CURRENT-SIZE (SPARSE-RRB-NODE-SIZE NODE))
            (DESIRED-SIZE
             (CLAMP
              (IF (NULL SIZE-CHANGE)
                  (THE FIXNUM (* 2 CURRENT-SIZE))
                  (THE FIXNUM (+ SIZE-CHANGE CURRENT-SIZE)))
              0 +MAXIMUM-CHILDREN-COUNT+)))
       (DECLARE (TYPE FIXNUM CURRENT-SIZE DESIRED-SIZE))
       (MAKE-SPARSE-RRB-NODE :OWNERSHIP-TAG TAG :BITMASK
        (SPARSE-RRB-NODE-BITMASK NODE) :CONTENT
        (COND ((EQL 0 SIZE-CHANGE) (COPY-ARRAY CONTENT))
              (T
               (LRET
                ((RESULT
                  (MAKE-ARRAY DESIRED-SIZE :ELEMENT-TYPE
                              (ARRAY-ELEMENT-TYPE CONTENT))))
                (ITERATE (FOR I FROM 0 BELOW CURRENT-SIZE)
                 (SETF (AREF RESULT I) (AREF CONTENT I))))))))))

[cl-data-structures/src/common/rrb/common.lisp:417]
  (DEFUN TAIL-OFFSET (SIZE)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0) (SPACE 0)))
    (IF (< SIZE 32)
        0
        (~> SIZE 1- (LOGAND +TAIL-MASK+))))

[cl-data-structures/src/common/rrb/common.lisp:449]
  (DEFUN INSERT-TAIL (RRB-CONTAINER OWNERSHIP-TAG CONTINUE TAIL)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (SPACE 0) (DEBUG 0)))
    (BIND
     (((:SLOTS %SIZE %SHIFT %ROOT) RRB-CONTAINER)
      (ROOT-OVERFLOW
       (>= (THE FIXNUM (ASH (THE FIXNUM %SIZE) (- +BIT-COUNT+)))
           (ASH 1 (* +BIT-COUNT+ (THE SHIFT %SHIFT))))))
     (IF ROOT-OVERFLOW
         (ITERATE (REPEAT %SHIFT)
          (FOR NODE INITIALLY
           (MAKE-RRB-NODE :CONTENT TAIL :OWNERSHIP-TAG OWNERSHIP-TAG) THEN
           (LET ((NEXT (MAKE-RRB-NODE :OWNERSHIP-TAG OWNERSHIP-TAG)))
             (SETF (NREF NEXT 0) NODE)
             NEXT))
          (FINALLY
           (BIND
            ((ROOT (MAKE-RRB-NODE :OWNERSHIP-TAG OWNERSHIP-TAG))
             ((:VECTORS CONTENT) (RRB-NODE-CONTENT ROOT)))
            (SETF (CONTENT 0) %ROOT
                  (CONTENT 1) NODE)
            (RETURN (VALUES ROOT T)))))
         (LET ((PATH (MAKE-ARRAY +MAXIMAL-SHIFT+ :INITIAL-ELEMENT NIL))
               (INDEXES
                (MAKE-ARRAY +MAXIMAL-SHIFT+ :ELEMENT-TYPE
                            (ECLECTOR.READER:QUASIQUOTE
                             (INTEGER 0
                              (ECLECTOR.READER:UNQUOTE
                               +MAXIMUM-CHILDREN-COUNT+))))))
           (DECLARE (DYNAMIC-EXTENT PATH)
                    (DYNAMIC-EXTENT INDEXES))
           (ITERATE (WITH SIZE = (THE NON-NEGATIVE-FIXNUM %SIZE))
            (REPEAT %SHIFT) (FOR I FROM 0)
            (FOR POSITION FROM (* +BIT-COUNT+ %SHIFT) DOWNTO 0 BY +BIT-COUNT+)
            (FOR INDEX = (LDB (BYTE +BIT-COUNT+ POSITION) SIZE))
            (FOR NODE INITIALLY %ROOT THEN (AND NODE (NREF NODE INDEX)))
            (SETF (AREF PATH I) NODE
                  (AREF INDEXES I) INDEX))
           (VALUES (FUNCALL CONTINUE PATH INDEXES %SHIFT OWNERSHIP-TAG TAIL)
                   NIL)))))

[cl-data-structures/src/common/rrb/common.lisp:502]
  (DEFUN DESCEND-INTO-TREE (RRB-CONTAINER LOCATION CONTINUE)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 1) (SPACE 0)))
    (LET ((PATH (MAKE-ARRAY +MAXIMAL-SHIFT+ :INITIAL-ELEMENT NIL))
          (SHIFT (ACCESS-SHIFT RRB-CONTAINER))
          (INDEXES
           (MAKE-ARRAY +MAXIMAL-SHIFT+ :ELEMENT-TYPE
                       (ECLECTOR.READER:QUASIQUOTE
                        (INTEGER 0
                         (ECLECTOR.READER:UNQUOTE +MAXIMUM-CHILDREN-COUNT+))))))
      (DECLARE (DYNAMIC-EXTENT PATH)
               (DYNAMIC-EXTENT INDEXES))
      (ITERATE (FOR I FROM 0 TO SHIFT)
       (FOR POSITION FROM (* +BIT-COUNT+ SHIFT) DOWNTO 0 BY +BIT-COUNT+)
       (FOR INDEX = (LDB (BYTE +BIT-COUNT+ POSITION) LOCATION))
       (FOR NODE INITIALLY (ACCESS-ROOT RRB-CONTAINER) THEN
        (AND NODE (NREF NODE INDEX)))
       (SETF (AREF PATH I) NODE
             (AREF INDEXES I) INDEX))
      (FUNCALL CONTINUE PATH INDEXES SHIFT)))

[cl-data-structures/src/common/rrb/common.lisp:528]
  (DEFUN RRB-AT (CONTAINER INDEX)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 1) (SPACE 0)))
    (IF (< INDEX (ACCESS-SIZE CONTAINER))
        (ITERATE (WITH SHIFT = (SLOT-VALUE CONTAINER '%SHIFT))
         (FOR POSITION FROM (* +BIT-COUNT+ SHIFT) DOWNTO 0 BY +BIT-COUNT+)
         (FOR I = (LDB (BYTE +BIT-COUNT+ POSITION) INDEX))
         (FOR NODE INITIALLY (SLOT-VALUE CONTAINER '%ROOT) THEN (NREF NODE I))
         (FINALLY (RETURN NODE)))
        (LET ((OFFSET (- INDEX (ACCESS-SIZE CONTAINER))))
          (~> CONTAINER ACCESS-TAIL (AREF OFFSET)))))

[cl-data-structures/src/common/rrb/common.lisp:560]
  (DEFUN COPY-ON-WRITE (PATH INDEXES SHIFT OWNERSHIP-TAG TAIL)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SPACE 0) (SAFETY 1)))
    (ITERATE (FOR I FROM (1- SHIFT) DOWNTO 0) (FOR POSITION = (AREF INDEXES I))
     (FOR OLD-NODE = (AREF PATH I))
     (FOR NODE INITIALLY
      (MAKE-RRB-NODE :CONTENT TAIL :OWNERSHIP-TAG OWNERSHIP-TAG) THEN
      (IF (NULL OLD-NODE)
          (LRET
           ((N
             (MAKE-RRB-NODE :CONTENT
              (~> TAIL ARRAY-ELEMENT-TYPE MAKE-NODE-CONTENT) :OWNERSHIP-TAG
              OWNERSHIP-TAG)))
           (SETF (NREF N POSITION) NODE))
          (RRB-NODE-PUSH-INTO-COPY OLD-NODE POSITION NODE OWNERSHIP-TAG)))
     (FINALLY (RETURN NODE))))

[cl-data-structures/src/common/rrb/common.lisp:626]
  (DEFUN DESTRUCTIVE-WRITE (PATH INDEXES SHIFT OWNERSHIP-TAG TAIL)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 1) (SPACE 0)))
    (ITERATE (FOR I FROM (1- SHIFT) DOWNTO 0) (FOR POSITION = (AREF INDEXES I))
     (FOR OLD-NODE = (AREF PATH I))
     (FOR NODE INITIALLY
      (MAKE-RRB-NODE :CONTENT TAIL :OWNERSHIP-TAG OWNERSHIP-TAG) THEN
      (IF (NULL OLD-NODE)
          (LRET
           ((N
             (MAKE-RRB-NODE :CONTENT
              (MAKE-NODE-CONTENT (ARRAY-ELEMENT-TYPE TAIL)) :OWNERSHIP-TAG
              OWNERSHIP-TAG)))
           (SETF (NREF N POSITION) NODE))
          (RRB-NODE-PUSH! OLD-NODE POSITION NODE)))
     (FINALLY (RETURN NODE))))

[cl-data-structures/src/common/rrb/common.lisp:645]
  (DEFUN REMOVE-TAIL (RRB-CONTAINER)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 1) (SPACE 0)))
    (BIND
     (((:SLOTS %SIZE %SHIFT %ROOT) RRB-CONTAINER)
      (ROOT-UNDERFLOW
       (EQL
        (ASH (THE FIXNUM (- %SIZE +MAXIMUM-CHILDREN-COUNT+))
             (THE FIXNUM (- (* %SHIFT +BIT-COUNT+))))
        1)))
     (IF (ZEROP %SHIFT)
         (VALUES NIL (RRB-NODE-CONTENT %ROOT) NIL)
         (ITERATE (WITH LAST = (1- (THE NON-NEGATIVE-FIXNUM %SIZE)))
          (REPEAT %SHIFT)
          (FOR POSITION FROM (* +BIT-COUNT+ %SHIFT) DOWNTO 0 BY +BIT-COUNT+)
          (FOR INDEX = (LDB (BYTE +BIT-COUNT+ POSITION) LAST))
          (FOR NODE INITIALLY %ROOT THEN (NREF NODE INDEX))
          (FINALLY (CHECK-TYPE NODE RRB-NODE)
           (RETURN
            (VALUES
             (IF ROOT-UNDERFLOW
                 (NREF %ROOT 0)
                 %ROOT)
             (RRB-NODE-CONTENT NODE) ROOT-UNDERFLOW)))))))

[cl-data-structures/src/common/rrb/common.lisp:1090]
  (DEFUN SPARSE-RRB-TREE-MAP (TREE DEPTH &KEY TREE-FUNCTION LEAF-FUNCTION)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE FIXNUM DEPTH))
    (#S(FORMGREP:SYMREF :NAME "CASES" :QUALIFIER "CL-DS.UTILS")
     ((NULL LEAF-FUNCTION) (NULL TREE-FUNCTION))
     (LABELS ((IMPL (NODE N)
                (DECLARE (TYPE FIXNUM N))
                (IF (= N DEPTH)
                    (UNLESS (NULL LEAF-FUNCTION) (FUNCALL LEAF-FUNCTION NODE))
                    (PROGN
                     (UNLESS (NULL TREE-FUNCTION) (FUNCALL TREE-FUNCTION NODE))
                     (ITERATE
                      (DECLARE (TYPE FIXNUM I NEXT-N)
                               (TYPE SIMPLE-VECTOR OCNTENT))
                      (WITH NEXT-N = (1+ N))
                      (WITH CONTENT = (SPARSE-RRB-NODE-CONTENT NODE))
                      (WITH LENGTH = (SPARSE-RRB-NODE-SIZE NODE))
                      (FOR I FROM 0 BELOW LENGTH) (FOR ELT = (SVREF CONTENT I))
                      (IMPL ELT NEXT-N))))))
       (IMPL TREE 0)
       TREE)))

[cl-data-structures/src/common/skip-list/common.lisp:42]
  (DEFUN SKIP-LIST-NODE-LEVEL (SKIP-LIST-NODE)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (~> SKIP-LIST-NODE SKIP-LIST-NODE-POINTERS LENGTH))

[cl-data-structures/src/common/skip-list/common.lisp:48]
  (DEFUN SKIP-LIST-NODE-AT (SKIP-LIST-NODE INDEX)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (~> SKIP-LIST-NODE SKIP-LIST-NODE-POINTERS (AREF INDEX)))

[cl-data-structures/src/common/skip-list/common.lisp:56]
  (DEFUN (SETF SKIP-LIST-NODE-AT) (NEW-VALUE SKIP-LIST-NODE INDEX)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (#S(FORMGREP:SYMREF :NAME "WITH-SLOTS-FOR" :QUALIFIER "CL-DS.UTILS")
     (SKIP-LIST-NODE SKIP-LIST-NODE) (SETF (AREF POINTERS INDEX) NEW-VALUE)))

[cl-data-structures/src/common/skip-list/common.lisp:107]
  (DEFUN COPY-INTO!
         (DESTINATION SOURCE
          &OPTIONAL
          (LIMIT
           (MIN (LENGTH (THE SIMPLE-VECTOR DESTINATION))
                (LENGTH (THE SIMPLE-VECTOR SOURCE))))
          (START 0))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0))
             (TYPE FIXNUM LIMIT))
    (ITERATE (DECLARE (TYPE FIXNUM I)) (FOR I FROM START BELOW LIMIT)
     (SETF (AREF DESTINATION I) (AREF SOURCE I))
     (FINALLY (RETURN DESTINATION))))

[cl-data-structures/src/common/skip-list/common.lisp:122]
  (DEFUN SKIP-LIST-NODE-UPDATE-POINTERS! (SKIP-LIST-NODE NEW-POINTERS)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (#S(FORMGREP:SYMREF :NAME "WITH-SLOTS-FOR" :QUALIFIER "CL-DS.UTILS")
     (SKIP-LIST-NODE SKIP-LIST-NODE) (COPY-INTO! POINTERS NEW-POINTERS))
    SKIP-LIST-NODE)

[cl-data-structures/src/common/skip-list/common.lisp:131]
  (DEFUN SKIP-LIST-NODE-COMPARE (TEST NODE1 NODE2)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (#S(FORMGREP:SYMREF :NAME "COND+" :QUALIFIER "CL-DS.UTILS")
     ((NULL NODE1) (NULL NODE2)) ((T T) NIL) ((NIL T) T) ((T NIL) NIL)
     ((NIL NIL)
      (FUNCALL TEST (SKIP-LIST-NODE-CONTENT NODE1)
               (SKIP-LIST-NODE-CONTENT NODE2)))))

[cl-data-structures/src/common/skip-list/common.lisp:143]
  (DEFUN NEW-NODE-UPDATE-POINTERS! (TEST SPLICED-NODE POINTERS)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (ITERATE (DECLARE (TYPE FIXNUM I))
     (WITH SPLICED-LEVEL = (SKIP-LIST-NODE-LEVEL SPLICED-NODE))
     (FOR I FROM 0 BELOW (LENGTH POINTERS)) (FOR REST = (AREF POINTERS I))
     (WHEN (NULL REST) (NEXT-ITERATION))
     (#S(FORMGREP:SYMREF :NAME "WITH-SLOTS-FOR" :QUALIFIER "CL-DS.UTILS")
      (REST SKIP-LIST-NODE)
      (ITERATE (DECLARE (TYPE FIXNUM J))
       (FOR J FROM (THE FIXNUM (1- (MIN LEVEL SPLICED-LEVEL))) DOWNTO 0)
       (IF (SKIP-LIST-NODE-COMPARE TEST SPLICED-NODE (AREF POINTERS J))
           (SETF (AREF POINTERS J) SPLICED-NODE)
           (FINISH))))
     (FINALLY (RETURN SPLICED-NODE))))

[cl-data-structures/src/common/skip-list/common.lisp:165]
  (DEFUN RANDOM-LEVEL (MAXIMUM-LEVEL)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (ITERATE (DECLARE (TYPE FIXNUM I)) (FOR I FROM 1 TO MAXIMUM-LEVEL)
     (UNTIL (ZEROP (RANDOM 2))) (FINALLY (RETURN I))))

[cl-data-structures/src/common/skip-list/common.lisp:175]
  (DEFUN MAKE-SKIP-LIST-NODE-OF-LEVEL
         (LEVEL &OPTIONAL (VALUE NIL VALUE-BOUND) (ASSOC VALUE-BOUND))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (IF ASSOC
        (MAKE-ASSOC-SKIP-LIST-NODE :POINTERS
         (MAKE-ARRAY LEVEL :INITIAL-ELEMENT NIL) :VALUE VALUE)
        (MAKE-SKIP-LIST-NODE :POINTERS
         (MAKE-ARRAY LEVEL :INITIAL-ELEMENT NIL))))

[cl-data-structures/src/common/skip-list/common.lisp:191]
  (DEFUN LOCATE-NODE (POINTERS ITEM TEST)
    (DECLARE
     (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0) (COMPILATION-SPEED 0) (SPACE 0)))
    (LET* ((POINTERS-LENGTH (LENGTH POINTERS))
           (PREV-RESULT (MAKE-ARRAY POINTERS-LENGTH :INITIAL-ELEMENT NIL))
           (LAST (1- POINTERS-LENGTH)))
      (ITERATE
       (DECLARE (TYPE FIXNUM I)
                (TYPE SIMPLE-VECTOR RESULT))
       (WITH RESULT = (COPY-ARRAY POINTERS)) (WITH I = LAST)
       (FOR NODE = (AREF RESULT I))
       (#S(FORMGREP:SYMREF :NAME "WITH-SLOTS-FOR" :QUALIFIER "CL-DS.UTILS")
        (NODE SKIP-LIST-NODE)
        (WHEN (AND NODE (FUNCALL TEST CONTENT ITEM))
          (COPY-INTO! PREV-RESULT RESULT LEVEL)
          (COPY-INTO! RESULT POINTERS)
          (SETF I LEVEL)))
       (DECF I) (WHILE (>= I 0))
       (FINALLY (RETURN (VALUES RESULT PREV-RESULT))))))

[cl-data-structures/src/common/skip-list/common.lisp:236]
  (DEFUN INSERT-NODE-BETWEEN! (POINTERS PREVIOUS-POINTERS TEST SKIP-LIST-NODE)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (NEW-NODE-UPDATE-POINTERS! TEST SKIP-LIST-NODE PREVIOUS-POINTERS)
    (SKIP-LIST-NODE-UPDATE-POINTERS! SKIP-LIST-NODE POINTERS)
    SKIP-LIST-NODE)

[cl-data-structures/src/common/skip-list/common.lisp:244]
  (DEFUN DELETE-NODE-BETWEEN! (POINTERS PREV-POINTERS)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (LRET ((RESULT (AREF POINTERS 0))) (ASSERT (NOT (NULL RESULT)))
     (ITERATE (DECLARE (TYPE FIXNUM I NEXT-SIZE))
      (WITH NEXT = (SKIP-LIST-NODE-POINTERS RESULT))
      (WITH NEXT-SIZE = (LENGTH NEXT)) (FOR I FROM 0 BELOW NEXT-SIZE)
      (FOR NODE = (AREF PREV-POINTERS I))
      (COPY-INTO! (SKIP-LIST-NODE-POINTERS NODE) NEXT))))

[cl-data-structures/src/common/skip-list/common.lisp:295]
  (DEFUN UPDATE-HEAD-POINTERS! (SKIP-LIST SKIP-LIST-NODE)
    (DECLARE (TYPE SKIP-LIST-NODE SKIP-LIST-NODE)
             (TYPE FUNDAMENTAL-SKIP-LIST SKIP-LIST)
             (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (ITERATE
     (DECLARE (TYPE FIXNUM I)
              (TYPE SIMPLE-VECTOR HEAD))
     (WITH HEAD = (READ-POINTERS SKIP-LIST))
     (WITH CONTENT = (SKIP-LIST-NODE-CONTENT SKIP-LIST-NODE))
     (WITH ORDERING-FUNCTION =
      (ENSURE-FUNCTION (READ-ORDERING-FUNCTION SKIP-LIST)))
     (FOR I FROM (~> SKIP-LIST-NODE SKIP-LIST-NODE-LEVEL 1-) DOWNTO 0)
     (FOR NODE = (AREF HEAD I))
     (WHEN (NULL NODE) (SETF (AREF HEAD I) SKIP-LIST-NODE) (NEXT-ITERATION))
     (FOR OLD-CONTENT = (SKIP-LIST-NODE-CONTENT NODE))
     (FOR SHOULD-GO-BEFORE = (FUNCALL ORDERING-FUNCTION CONTENT OLD-CONTENT))
     (IF SHOULD-GO-BEFORE
         (SETF (AREF HEAD I) SKIP-LIST-NODE)
         (FINISH))))

[cl-data-structures/src/counting/internal.lisp:46]
  (DEFUN COMBINE-NODES (NODE PARENT CHILDREN)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET* ((LAST-ELT NODE)
           (CONTENT
            (MAP 'VECTOR #'LIST* (THE VECTOR (READ-SETS PARENT)) CHILDREN))
           (LOWER-BOUND
            (LOWER-BOUND (THE VECTOR CONTENT) (THE FIXNUM (READ-TYPE LAST-ELT))
             #'< :KEY #'SORT-KEY)))
      (ITERATE (FOR I FROM (1+ LOWER-BOUND) BELOW (LENGTH CONTENT))
       (FOR ELT = (AREF CONTENT I)) (COLLECT ELT AT START))))

[cl-data-structures/src/counting/internal.lisp:70]
  (WITH-COMPILATION-UNIT NIL
    (DEFUN EXPAND-NODE (INDEX PARENT CHILDREN I QUEUE)
      (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0))
               (TYPE SET-INDEX-NODE PARENT)
               (TYPE SIMPLE-VECTOR CHILDREN)
               (TYPE NON-NEGATIVE-FIXNUM I))
      (ITERATE (WITH NEW-CHILDREN = (VECT))
       (WITH MINIMAL-SUPPORT = (READ-MINIMAL-SUPPORT INDEX))
       (DECLARE (TYPE VECTOR NEW-CHILDREN)
                (TYPE FIXNUM MINIMAL-SUPPORT))
       (FOR CHILDREN-COUNT = (LENGTH CHILDREN)) (WHILE (< I CHILDREN-COUNT))
       (UNLESS (EQL (THE FIXNUM (1+ I)) CHILDREN-COUNT)
         (ASYNC-EXPAND-NODE INDEX PARENT CHILDREN (1+ I) QUEUE))
       (FOR NODE = (THE SET-INDEX-NODE (CHILD-AT PARENT I)))
       (FOR SUPERSETS = (THE LIST (COMBINE-NODES NODE PARENT CHILDREN)))
       (FOR LOCATIONS = (THE (VECTOR FIXNUM) (AREF CHILDREN I)))
       (FOR COUNT = (LENGTH LOCATIONS))
       (ITERATE (DECLARE (TYPE (VECTOR FIXNUM) NODE-LOCATIONS))
        (FOR (NODE . NODE-LOCATIONS) IN SUPERSETS)
        (FOR INTERSECTION =
         (THE (VECTOR FIXNUM)
              (ORDERED-INTERSECTION #'< #'EQL LOCATIONS NODE-LOCATIONS)))
        (FOR INTERSECTION-SIZE = (LENGTH INTERSECTION))
        (WHEN (< INTERSECTION-SIZE MINIMAL-SUPPORT) (NEXT-ITERATION))
        (FOR NEW-NODE =
         (MAKE 'SET-INDEX-NODE :COUNT INTERSECTION-SIZE :TYPE
          (READ-TYPE NODE)))
        (VECTOR-PUSH-EXTEND (LIST* NEW-NODE INTERSECTION) NEW-CHILDREN))
       (SETF NEW-CHILDREN (SORT NEW-CHILDREN #'< :KEY #'SORT-KEY))
       (MAP NIL (LAMBDA (X) (PUSH-CHILD NODE (CAR X))) NEW-CHILDREN)
       (SETF PARENT (THE SET-INDEX-NODE NODE)
             I 0
             CHILDREN (MAP 'VECTOR #'CDR NEW-CHILDREN)
             (FILL-POINTER NEW-CHILDREN) 0)))
    (DEFUN ASYNC-EXPAND-NODE (INDEX PARENT CHILDREN I QUEUE)
      (~> (EXPAND-NODE INDEX PARENT CHILDREN I QUEUE) LPARALLEL.PROMISE:FUTURE
       (LPARALLEL.QUEUE:PUSH-QUEUE QUEUE))))

[cl-data-structures/src/dicts/hamt/api.lisp:60]
  (DEFUN MAKE-FUNCTIONAL-HAMT-DICTIONARY (HASH-FN EQUAL-FN)
    (DECLARE (OPTIMIZE (SAFETY 3)))
    (ASSURE FUNCTIONAL-HAMT-DICTIONARY
     (MAKE 'FUNCTIONAL-HAMT-DICTIONARY :HASH-FN (ENSURE-FUNCTION HASH-FN) :ROOT
      NIL :EQUAL-FN (ENSURE-FUNCTION EQUAL-FN))))

[cl-data-structures/src/dicts/hamt/api.lisp:70]
  (DEFUN MAKE-MUTABLE-HAMT-DICTIONARY (HASH-FN EQUAL-FN)
    (DECLARE (OPTIMIZE (SAFETY 3)))
    (ASSURE MUTABLE-HAMT-DICTIONARY
     (MAKE 'MUTABLE-HAMT-DICTIONARY :EQUAL-FN (ENSURE-FUNCTION EQUAL-FN)
      :HASH-FN (ENSURE-FUNCTION HASH-FN) :ROOT NIL)))

[cl-data-structures/src/dicts/hamt/api.lisp:80]
  (DEFUN MAKE-TRANSACTIONAL-HAMT-DICTIONARY (HASH-FN EQUAL-FN)
    (DECLARE (OPTIMIZE (SAFETY 3)))
    (~> (MAKE-MUTABLE-HAMT-DICTIONARY HASH-FN EQUAL-FN)
     #S(FORMGREP:SYMREF :NAME "BECOME-TRANSACTIONAL" :QUALIFIER "CL-DS")))

[cl-data-structures/src/dicts/hamt/api.lisp:87]
  (DEFUN HAMT-DICTIONARY-AT (CONTAINER LOCATION)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 0) (SPACE 0)))
    "Implementation of AT"
    (WITH-HASH-TREE-FUNCTIONS (CONTAINER)
     (LET* ((HASH (HASH-FN LOCATION)) (ROOT (ACCESS-ROOT CONTAINER)))
       (DECLARE (TYPE FIXNUM HASH))
       (HASH-DO (NODE INDEX) (ROOT HASH) :ON-LEAF
        (FIND-CONTENT CONTAINER NODE LOCATION HASH) :ON-NIL (VALUES NIL NIL)))))

[cl-data-structures/src/dicts/hamt/api.lisp:126]
  (DEFMETHOD #S(FORMGREP:SYMREF
                :NAME "POSITION-MODIFICATION"
                :QUALIFIER "CL-DS.META")
             (
              (OPERATION
               #S(FORMGREP:SYMREF
                  :NAME "GROW-FUNCTION"
                  :QUALIFIER "CL-DS.META"))
              CONTAINER (STRUCTURE FUNCTIONAL-HAMT-DICTIONARY) LOCATION
              &REST ALL
              &KEY VALUE)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 0) (SPACE 0)))
    (WITH-HASH-TREE-FUNCTIONS (STRUCTURE :CASES NIL)
     (BIND
      ((CHANGED NIL) (TAG NIL) (HASH (HASH-FN LOCATION))
       ((:DFLET GROW-BUCKET (BUCKET))
        (MULTIPLE-VALUE-BIND (A B)
            (APPLY #'GROW OPERATION CONTAINER BUCKET LOCATION HASH VALUE ALL)
          (SETF CHANGED
                  (#S(FORMGREP:SYMREF :NAME "CHANGED" :QUALIFIER "CL-DS") B))
          (VALUES A B CHANGED)))
       ((:DFLET COPY-ON-WRITE (INDEXES PATH DEPTH CONFLICT))
        (COPY-ON-WRITE STRUCTURE TAG INDEXES PATH DEPTH CONFLICT))
       ((:DFLET MAKE-BUCKET NIL)
        (BIND
         (((:VALUES A B)
           (APPLY
            #'#S(FORMGREP:SYMREF :NAME "MAKE-BUCKET" :QUALIFIER "CL-DS.META")
            CONTAINER OPERATION VALUE ALL)))
         (SETF CHANGED
                 (#S(FORMGREP:SYMREF :NAME "CHANGED" :QUALIFIER "CL-DS") B))
         (VALUES
          (LIST
           (#S(FORMGREP:SYMREF
               :NAME "MAKE-HASH-DICT-CONTENT"
               :QUALIFIER "CL-DS.COMMON")
            :LOCATION LOCATION :VALUE A :HASH HASH))
          B CHANGED)))
       ((:VALUES NEW-ROOT STATUS)
        (GO-DOWN-ON-PATH STRUCTURE HASH #'GROW-BUCKET #'MAKE-BUCKET
         #'COPY-ON-WRITE)))
      (VALUES
       (IF CHANGED
           (MAKE 'FUNCTIONAL-HAMT-DICTIONARY :HASH-FN
            (#S(FORMGREP:SYMREF :NAME "READ-HASH-FN" :QUALIFIER "CL-DS.DICTS")
             STRUCTURE)
            :EQUAL-FN
            (#S(FORMGREP:SYMREF :NAME "READ-EQUAL-FN" :QUALIFIER "CL-DS.DICTS")
             STRUCTURE)
            :OWNERSHIP-TAG TAG :ROOT NEW-ROOT :SIZE
            (IF (#S(FORMGREP:SYMREF :NAME "FOUND" :QUALIFIER "CL-DS") STATUS)
                (THE NON-NEGATIVE-FIXNUM (ACCESS-SIZE STRUCTURE))
                (1+ (THE NON-NEGATIVE-FIXNUM (ACCESS-SIZE STRUCTURE)))))
           STRUCTURE)
       STATUS))))

[cl-data-structures/src/dicts/hamt/api.lisp:190]
  (DEFMETHOD #S(FORMGREP:SYMREF
                :NAME "POSITION-MODIFICATION"
                :QUALIFIER "CL-DS.META")
             (
              (OPERATION
               #S(FORMGREP:SYMREF
                  :NAME "GROW-FUNCTION"
                  :QUALIFIER "CL-DS.META"))
              CONTAINER (STRUCTURE TRANSACTIONAL-HAMT-DICTIONARY) LOCATION
              &REST ALL
              &KEY VALUE)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 0) (SPACE 0)))
    (WITH-HASH-TREE-FUNCTIONS (STRUCTURE :CASES NIL)
     (BIND
      ((HASH (HASH-FN LOCATION)) (CHANGED NIL)
       ((:DFLET GROW-BUCKET (BUCKET))
        (MULTIPLE-VALUE-BIND (A B)
            (APPLY #'GROW
                   (#S(FORMGREP:SYMREF
                       :NAME "FUNCTIONAL-COUNTERPART"
                       :QUALIFIER "CL-DS.META")
                    OPERATION)
                   CONTAINER BUCKET LOCATION HASH VALUE ALL)
          (SETF CHANGED
                  (#S(FORMGREP:SYMREF :NAME "CHANGED" :QUALIFIER "CL-DS") B))
          (VALUES A B CHANGED)))
       ((:DFLET MAKE-BUCKET NIL)
        (BIND
         (((:VALUES A B)
           (APPLY
            #'#S(FORMGREP:SYMREF :NAME "MAKE-BUCKET" :QUALIFIER "CL-DS.META")
            CONTAINER OPERATION VALUE ALL)))
         (SETF CHANGED
                 (#S(FORMGREP:SYMREF :NAME "CHANGED" :QUALIFIER "CL-DS") B))
         (VALUES
          (LIST
           (#S(FORMGREP:SYMREF
               :NAME "MAKE-HASH-DICT-CONTENT"
               :QUALIFIER "CL-DS.COMMON")
            :LOCATION LOCATION :VALUE A :HASH HASH))
          B CHANGED)))
       ((:DFLET COPY-ON-WRITE (INDEXES PATH DEPTH CONFLICT))
        (TRANSACTIONAL-COPY-ON-WRITE STRUCTURE (READ-OWNERSHIP-TAG STRUCTURE)
         INDEXES PATH DEPTH CONFLICT))
       ((:VALUES NEW-ROOT STATUS)
        (GO-DOWN-ON-PATH STRUCTURE HASH #'GROW-BUCKET #'MAKE-BUCKET
         #'COPY-ON-WRITE)))
      (WHEN CHANGED
        (SETF (ACCESS-ROOT STRUCTURE) NEW-ROOT)
        (UNLESS (#S(FORMGREP:SYMREF :NAME "FOUND" :QUALIFIER "CL-DS") STATUS)
          (INCF (THE NON-NEGATIVE-FIXNUM (ACCESS-SIZE STRUCTURE)))))
      (VALUES STRUCTURE STATUS))))

[cl-data-structures/src/dicts/hamt/api.lisp:247]
  (DEFMETHOD #S(FORMGREP:SYMREF
                :NAME "POSITION-MODIFICATION"
                :QUALIFIER "CL-DS.META")
             (
              (OPERATION
               #S(FORMGREP:SYMREF
                  :NAME "SHRINK-FUNCTION"
                  :QUALIFIER "CL-DS.META"))
              CONTAINER (STRUCTURE FUNCTIONAL-HAMT-DICTIONARY) LOCATION
              &REST ALL
              &KEY)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 0) (SPACE 0)))
    (WITH-HASH-TREE-FUNCTIONS (STRUCTURE :CASES NIL)
     (BIND
      ((HASH (HASH-FN LOCATION)) (TAG NIL) (CHANGED NIL)
       ((:DFLET SHRINK-BUCKET (BUCKET))
        (MULTIPLE-VALUE-BIND (A B)
            (APPLY #'SHRINK OPERATION CONTAINER BUCKET LOCATION HASH ALL)
          (SETF CHANGED
                  (#S(FORMGREP:SYMREF :NAME "CHANGED" :QUALIFIER "CL-DS") B))
          (VALUES A B CHANGED)))
       ((:DFLET COPY-ON-WRITE (INDEXES PATH DEPTH CONFLICT))
        (COPY-ON-WRITE STRUCTURE TAG INDEXES PATH DEPTH CONFLICT))
       ((:DFLET JUST-RETURN NIL)
        (RETURN-FROM
            #S(FORMGREP:SYMREF
               :NAME "POSITION-MODIFICATION"
               :QUALIFIER "CL-DS.META")
          (VALUES STRUCTURE
                  #S(FORMGREP:SYMREF
                     :NAME "EMPTY-EAGER-MODIFICATION-OPERATION-STATUS"
                     :QUALIFIER "CL-DS.COMMON"))))
       ((:VALUES NEW-ROOT STATUS)
        (GO-DOWN-ON-PATH STRUCTURE HASH #'SHRINK-BUCKET #'JUST-RETURN
         #'COPY-ON-WRITE)))
      (VALUES
       (IF CHANGED
           (MAKE 'FUNCTIONAL-HAMT-DICTIONARY :HASH-FN
            (#S(FORMGREP:SYMREF :NAME "READ-HASH-FN" :QUALIFIER "CL-DS.DICTS")
             STRUCTURE)
            :EQUAL-FN
            (#S(FORMGREP:SYMREF :NAME "READ-EQUAL-FN" :QUALIFIER "CL-DS.DICTS")
             STRUCTURE)
            :ROOT NEW-ROOT :OWNERSHIP-TAG TAG :SIZE
            (1- (THE NON-NEGATIVE-FIXNUM (ACCESS-SIZE STRUCTURE))))
           STRUCTURE)
       STATUS))))

[cl-data-structures/src/dicts/hamt/api.lisp:300]
  (DEFMETHOD #S(FORMGREP:SYMREF
                :NAME "POSITION-MODIFICATION"
                :QUALIFIER "CL-DS.META")
             (
              (OPERATION
               #S(FORMGREP:SYMREF
                  :NAME "SHRINK-FUNCTION"
                  :QUALIFIER "CL-DS.META"))
              CONTAINER (STRUCTURE TRANSACTIONAL-HAMT-DICTIONARY) LOCATION
              &REST ALL
              &KEY)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 0) (SPACE 0)))
    (WITH-HASH-TREE-FUNCTIONS (STRUCTURE :CASES NIL)
     (BIND
      ((HASH (HASH-FN LOCATION)) (CHANGED NIL)
       ((:DFLET SHRINK-BUCKET (BUCKET))
        (MULTIPLE-VALUE-BIND (A B)
            (APPLY #'SHRINK
                   (#S(FORMGREP:SYMREF
                       :NAME "FUNCTIONAL-COUNTERPART"
                       :QUALIFIER "CL-DS.META")
                    OPERATION)
                   CONTAINER BUCKET LOCATION HASH ALL)
          (SETF CHANGED
                  (#S(FORMGREP:SYMREF :NAME "CHANGED" :QUALIFIER "CL-DS") B))
          (VALUES A B CHANGED)))
       ((:DFLET JUST-RETURN NIL)
        (RETURN-FROM
            #S(FORMGREP:SYMREF
               :NAME "POSITION-MODIFICATION"
               :QUALIFIER "CL-DS.META")
          (VALUES STRUCTURE
                  #S(FORMGREP:SYMREF
                     :NAME "EMPTY-EAGER-MODIFICATION-OPERATION-STATUS"
                     :QUALIFIER "CL-DS.COMMON"))))
       ((:DFLET COPY-ON-WRITE (INDEXES PATH DEPTH CONFLICT))
        (TRANSACTIONAL-COPY-ON-WRITE STRUCTURE (READ-OWNERSHIP-TAG STRUCTURE)
         INDEXES PATH DEPTH CONFLICT))
       ((:VALUES NEW-ROOT STATUS)
        (GO-DOWN-ON-PATH STRUCTURE HASH #'SHRINK-BUCKET #'JUST-RETURN
         #'COPY-ON-WRITE)))
      (WHEN CHANGED
        (SETF (ACCESS-ROOT STRUCTURE) NEW-ROOT)
        (DECF (THE NON-NEGATIVE-FIXNUM (ACCESS-SIZE STRUCTURE))))
      (VALUES STRUCTURE STATUS))))

[cl-data-structures/src/dicts/hamt/api.lisp:348]
  (DEFMETHOD #S(FORMGREP:SYMREF
                :NAME "POSITION-MODIFICATION"
                :QUALIFIER "CL-DS.META")
             (
              (OPERATION
               #S(FORMGREP:SYMREF
                  :NAME "SHRINK-FUNCTION"
                  :QUALIFIER "CL-DS.META"))
              CONTAINER (STRUCTURE MUTABLE-HAMT-DICTIONARY) LOCATION
              &REST ALL
              &KEY)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 0) (SPACE 0)))
    (WITH-HASH-TREE-FUNCTIONS (STRUCTURE)
     (LET* ((MODIFICATION-STATUS NIL)
            (HASH (HASH-FN LOCATION))
            (NEW-ROOT
             (WITH-DESTRUCTIVE-ERASE-HAMT NODE STRUCTURE HASH :ON-LEAF
              (MULTIPLE-VALUE-BIND (BUCKET STATUS)
                  (APPLY #'SHRINK OPERATION CONTAINER NODE LOCATION HASH ALL)
                (UNLESS
                    (#S(FORMGREP:SYMREF :NAME "CHANGED" :QUALIFIER "CL-DS")
                     STATUS)
                  (RETURN-FROM
                      #S(FORMGREP:SYMREF
                         :NAME "POSITION-MODIFICATION"
                         :QUALIFIER "CL-DS.META")
                    (VALUES STRUCTURE STATUS)))
                (SETF MODIFICATION-STATUS STATUS)
                BUCKET)
              :ON-NIL
              (RETURN-FROM
                  #S(FORMGREP:SYMREF
                     :NAME "POSITION-MODIFICATION"
                     :QUALIFIER "CL-DS.META")
                (VALUES STRUCTURE
                        #S(FORMGREP:SYMREF
                           :NAME "EMPTY-EAGER-MODIFICATION-OPERATION-STATUS"
                           :QUALIFIER "CL-DS.COMMON"))))))
       (DECF (ACCESS-SIZE STRUCTURE))
       (SETF (ACCESS-ROOT STRUCTURE) NEW-ROOT)
       (VALUES STRUCTURE MODIFICATION-STATUS))))

[cl-data-structures/src/dicts/hamt/api.lisp:388]
  (DEFMETHOD #S(FORMGREP:SYMREF
                :NAME "POSITION-MODIFICATION"
                :QUALIFIER "CL-DS.META")
             (
              (OPERATION
               #S(FORMGREP:SYMREF
                  :NAME "GROW-FUNCTION"
                  :QUALIFIER "CL-DS.META"))
              CONTAINER (STRUCTURE MUTABLE-HAMT-DICTIONARY) LOCATION
              &REST ALL
              &KEY VALUE)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 0) (SPACE 0)))
    (LET ((STATUS NIL)
          (HASH
           (FUNCALL
            (THE (-> (T) FIXNUM)
                 (#S(FORMGREP:SYMREF
                     :NAME "READ-HASH-FN"
                     :QUALIFIER "CL-DS.DICTS")
                  STRUCTURE))
            LOCATION)))
      (MACROLET ((HANDLE-BUCKET (&BODY BODY)
                   (ECLECTOR.READER:QUASIQUOTE
                    (MULTIPLE-VALUE-BIND (BUCKET S)
                        (ECLECTOR.READER:UNQUOTE-SPLICING BODY)
                      (UNLESS
                          (#S(FORMGREP:SYMREF
                              :NAME "CHANGED"
                              :QUALIFIER "CL-DS")
                           S)
                        (RETURN-FROM
                            #S(FORMGREP:SYMREF
                               :NAME "POSITION-MODIFICATION"
                               :QUALIFIER "CL-DS.META")
                          (VALUES STRUCTURE S)))
                      (SETF STATUS S)
                      BUCKET))))
        (BIND
         ((PREV-NODE NIL) (PREV-INDEX 0) (ROOT (ACCESS-ROOT STRUCTURE))
          (TAG (READ-OWNERSHIP-TAG STRUCTURE))
          ((:DFLET MAKE-BUCKET NIL)
           (BIND
            (((:VALUES A B)
              (APPLY
               #'#S(FORMGREP:SYMREF
                    :NAME "MAKE-BUCKET"
                    :QUALIFIER "CL-DS.META")
               CONTAINER OPERATION VALUE ALL)))
            (VALUES
             (LIST
              (#S(FORMGREP:SYMREF
                  :NAME "MAKE-HASH-DICT-CONTENT"
                  :QUALIFIER "CL-DS.COMMON")
               :LOCATION LOCATION :VALUE A :HASH HASH))
             B)))
          (RESULT
           (HASH-DO (NODE INDEX C) ((ACCESS-ROOT STRUCTURE) HASH) :ON-EVERY
            (SETF PREV-NODE NODE
                  PREV-INDEX INDEX)
            :ON-NIL
            (IF PREV-NODE
                (PROGN
                 (HASH-NODE-INSERT! PREV-NODE
                  (REBUILD-REHASHED-NODE STRUCTURE C
                   (HANDLE-BUCKET (MAKE-BUCKET)) TAG)
                  PREV-INDEX)
                 ROOT)
                (HANDLE-BUCKET (MAKE-BUCKET)))
            :ON-LEAF
            (IF PREV-NODE
                (PROGN
                 (HASH-NODE-REPLACE! PREV-NODE
                  (REBUILD-REHASHED-NODE STRUCTURE C
                   (HANDLE-BUCKET
                    (GROW OPERATION CONTAINER NODE LOCATION HASH VALUE))
                   TAG)
                  PREV-INDEX)
                 ROOT)
                (REBUILD-REHASHED-NODE STRUCTURE C
                 (HANDLE-BUCKET
                  (GROW OPERATION CONTAINER NODE LOCATION HASH VALUE))
                 TAG)))))
         (SETF (ACCESS-ROOT STRUCTURE) RESULT)
         (UNLESS (#S(FORMGREP:SYMREF :NAME "FOUND" :QUALIFIER "CL-DS") STATUS)
           (INCF (THE FIXNUM (ACCESS-SIZE STRUCTURE))))
         (VALUES STRUCTURE STATUS)))))

[cl-data-structures/src/dicts/srrb/api.lisp:123]
  (DEFUN SPARSE-RRB-VECTOR-AT (VECT POSITION)
    (DECLARE (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0))
             (TYPE INTEGER POSITION))
    (LET ((BOUND (ACCESS-INDEX-BOUND VECT))
          (TREE-BOUND (ACCESS-TREE-INDEX-BOUND VECT)))
      (DECLARE (TYPE FIXNUM BOUND TREE-BOUND))
      (COND ((NOT (< -1 POSITION BOUND)) (VALUES NIL NIL))
            ((< POSITION TREE-BOUND)
             (LET ((TREE (SLOT-VALUE VECT '%TREE)))
               (IF (#S(FORMGREP:SYMREF
                       :NAME "NULL-BUCKET-P"
                       :QUALIFIER "CL-DS.META")
                    TREE)
                   (VALUES NIL NIL)
                   (ITERATE
                    (DECLARE (TYPE FIXNUM BYTE-POSITION POSITION I)
                             (TYPE
                              #S(FORMGREP:SYMREF
                                 :NAME "SHIFT"
                                 :QUALIFIER "CL-DS.COMMON.RRB")
                              SHIFT))
                    (WITH NODE = TREE) (WITH SHIFT = (SLOT-VALUE VECT '%SHIFT))
                    (FOR BYTE-POSITION FROM
                     (*
                      #S(FORMGREP:SYMREF
                         :NAME "+BIT-COUNT+"
                         :QUALIFIER "CL-DS.COMMON.RRB")
                      SHIFT)
                     DOWNTO 0 BY
                     #S(FORMGREP:SYMREF
                        :NAME "+BIT-COUNT+"
                        :QUALIFIER "CL-DS.COMMON.RRB"))
                    (FOR I =
                     (LDB
                      (BYTE
                       #S(FORMGREP:SYMREF
                          :NAME "+BIT-COUNT+"
                          :QUALIFIER "CL-DS.COMMON.RRB")
                       BYTE-POSITION)
                      POSITION))
                    (LET* ((PRESENT
                            (#S(FORMGREP:SYMREF
                                :NAME "SPARSE-RRB-NODE-CONTAINS"
                                :QUALIFIER "CL-DS.COMMON.RRB")
                             NODE I)))
                      (UNLESS PRESENT
                        (RETURN-FROM SPARSE-RRB-VECTOR-AT (VALUES NIL NIL)))
                      (SETF NODE
                              (#S(FORMGREP:SYMREF
                                  :NAME "SPARSE-NREF"
                                  :QUALIFIER "CL-DS.COMMON.RRB")
                               (THE
                                #S(FORMGREP:SYMREF
                                   :NAME "SPARSE-RRB-NODE"
                                   :QUALIFIER "CL-DS.COMMON.RRB")
                                NODE)
                               I)))
                    (FINALLY (RETURN (VALUES NODE T)))))))
            (T
             (LET* ((OFFSET
                     (LOGANDC2 POSITION
                               #S(FORMGREP:SYMREF
                                  :NAME "+TAIL-MASK+"
                                  :QUALIFIER "CL-DS.COMMON.RRB")))
                    (PRESENT
                     (LDB-TEST (BYTE 1 OFFSET) (ACCESS-TAIL-MASK VECT))))
               (DECLARE
                (TYPE
                 #S(FORMGREP:SYMREF
                    :NAME "RRB-NODE-POSITION"
                    :QUALIFIER "CL-DS.COMMON.RRB")
                 OFFSET))
               (IF PRESENT
                   (VALUES (AREF (THE SIMPLE-VECTOR (ACCESS-TAIL VECT)) OFFSET)
                           T)
                   (VALUES NIL NIL)))))))

[cl-data-structures/src/dicts/srrb/api.lisp:167]
  (DEFMETHOD #S(FORMGREP:SYMREF :NAME "AT" :QUALIFIER "CL-DS")
             ((VECT FUNDAMENTAL-SPARSE-RRB-VECTOR) POSITION
              &REST MORE-POSITIONS)
    (DECLARE (OPTIMIZE (SPEED 1) (SPACE 0) (DEBUG 0) (SAFETY 3))
             (TYPE INTEGER POSITION))
    (#S(FORMGREP:SYMREF :NAME "ASSERT-ONE-DIMENSION" :QUALIFIER "CL-DS")
     MORE-POSITIONS)
    (SPARSE-RRB-VECTOR-AT VECT POSITION))

[cl-data-structures/src/dicts/srrb/internal.lisp:34]
  (DEFUN MAKE-NODE-FROM-TAIL (RRB-CONTAINER OWNERSHIP-TAG)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SPACE 0) (SAFETY 0)))
    (BIND
     (((:SLOTS %TREE-SIZE %SHIFT %TREE %TAIL %TAIL-MASK %ELEMENT-TYPE
        %TREE-INDEX-BOUND)
       RRB-CONTAINER)
      (TAIL-MASK (THE FIXNUM %TAIL-MASK)) (TAIL-SIZE (LOGCOUNT TAIL-MASK))
      (TAIL (THE SIMPLE-VECTOR %TAIL))
      (ELEMENT-TYPE (READ-ELEMENT-TYPE RRB-CONTAINER))
      (NEW-CONTENT
       (ITERATE (DECLARE (TYPE FIXNUM J I))
        (WITH RESULT = (MAKE-ARRAY TAIL-SIZE :ELEMENT-TYPE ELEMENT-TYPE))
        (WITH J = 0)
        (FOR I FROM 0 BELOW
         #S(FORMGREP:SYMREF
            :NAME "+MAXIMUM-CHILDREN-COUNT+"
            :QUALIFIER "CL-DS.COMMON.RRB"))
        (FOR PRESENT = (LDB-TEST (BYTE 1 I) TAIL-MASK))
        (WHEN PRESENT (SETF (AREF RESULT J) (AREF TAIL I)) (INCF J))
        (FINALLY (RETURN RESULT))))
      (NEW-NODE
       (#S(FORMGREP:SYMREF
           :NAME "MAKE-SPARSE-RRB-NODE"
           :QUALIFIER "CL-DS.COMMON.RRB")
        :CONTENT NEW-CONTENT :BITMASK TAIL-MASK :OWNERSHIP-TAG OWNERSHIP-TAG)))
     NEW-NODE))

[cl-data-structures/src/dicts/srrb/internal.lisp:168]
  (DEFUN INSERT-TAIL (STRUCTURE)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SPACE 0) (SAFETY 0)))
    (LET ((TAIL-MASK (ACCESS-TAIL-MASK STRUCTURE)))
      (DECLARE (TYPE FIXNUM TAIL-MASK))
      (IF (ZEROP TAIL-MASK)
          (MAKE (TYPE-OF STRUCTURE) :TREE (ACCESS-TREE STRUCTURE) :TAIL NIL
           :TAIL-MASK 0 :SHIFT (ACCESS-SHIFT STRUCTURE) :TREE-SIZE
           (ACCESS-TREE-SIZE STRUCTURE) :TREE-INDEX-BOUND
           (ACCESS-INDEX-BOUND STRUCTURE) :INDEX-BOUND
           (+
            #S(FORMGREP:SYMREF
               :NAME "+MAXIMUM-CHILDREN-COUNT+"
               :QUALIFIER "CL-DS.COMMON.RRB")
            (ACCESS-INDEX-BOUND STRUCTURE))
           :ELEMENT-TYPE (READ-ELEMENT-TYPE STRUCTURE))
          (BIND
           ((NEW-NODE (MAKE-NODE-FROM-TAIL STRUCTURE NIL))
            ((:ACCESSORS (TREE ACCESS-TREE) (TREE-SIZE ACCESS-TREE-SIZE)
              (INDEX-BOUND ACCESS-INDEX-BOUND) (%SHIFT ACCESS-SHIFT)
              (TREE-INDEX-BOUND ACCESS-TREE-INDEX-BOUND))
             STRUCTURE)
            (ROOT TREE) (SHIFT %SHIFT))
           (DECLARE (TYPE NON-NEGATIVE-FIXNUM SHIFT))
           (WHEN
               (AND
                (#S(FORMGREP:SYMREF
                    :NAME "NULL-BUCKET-P"
                    :QUALIFIER "CL-DS.META")
                 ROOT)
                (> INDEX-BOUND
                   #S(FORMGREP:SYMREF
                      :NAME "+MAXIMUM-CHILDREN-COUNT+"
                      :QUALIFIER "CL-DS.COMMON.RRB")))
             (SETF ROOT
                     (#S(FORMGREP:SYMREF
                         :NAME "MAKE-SPARSE-RRB-NODE"
                         :QUALIFIER "CL-DS.COMMON.RRB"))))
           (COND
            ((#S(FORMGREP:SYMREF :NAME "NULL-BUCKET-P" :QUALIFIER "CL-DS.META")
              ROOT)
             (SETF ROOT NEW-NODE))
            ((>=
              (ASH TREE-INDEX-BOUND
                   (-
                    #S(FORMGREP:SYMREF
                       :NAME "+BIT-COUNT+"
                       :QUALIFIER "CL-DS.COMMON.RRB")))
              (ASH 1
                   (*
                    #S(FORMGREP:SYMREF
                       :NAME "+BIT-COUNT+"
                       :QUALIFIER "CL-DS.COMMON.RRB")
                    SHIFT)))
             (LET ((NEW-ROOT
                    (INSERT-TAIL-HANDLE-ROOT-OVERFLOW SHIFT ROOT NEW-NODE NIL)))
               (INCF SHIFT)
               (SETF ROOT NEW-ROOT)))
            (T
             (BIND
              ((SIZE
                (~> STRUCTURE ACCESS-INDEX-BOUND
                 (-
                  #S(FORMGREP:SYMREF
                     :NAME "+MAXIMUM-CHILDREN-COUNT+"
                     :QUALIFIER "CL-DS.COMMON.RRB"))))
               ((:LABELS IMPL (NODE BYTE-POSITION DEPTH))
                (LET ((CURRENT-NODE
                       (IF (#S(FORMGREP:SYMREF
                               :NAME "NULL-BUCKET-P"
                               :QUALIFIER "CL-DS.META")
                            NODE)
                           (#S(FORMGREP:SYMREF
                               :NAME "MAKE-RRB-NODE"
                               :QUALIFIER "CL-DS.COMMON.RRB")
                            :CONTENT (MAKE-ARRAY 1))
                           (#S(FORMGREP:SYMREF
                               :NAME "DEEP-COPY-SPARSE-RRB-NODE"
                               :QUALIFIER "CL-DS.COMMON.RRB")
                            NODE 1))))
                  (IF (ZEROP DEPTH)
                      (INSERT-INTO-NODE! CURRENT-NODE NEW-NODE
                       (LDB
                        (BYTE
                         #S(FORMGREP:SYMREF
                            :NAME "+BIT-COUNT+"
                            :QUALIFIER "CL-DS.COMMON.RRB")
                         #S(FORMGREP:SYMREF
                            :NAME "+BIT-COUNT+"
                            :QUALIFIER "CL-DS.COMMON.RRB"))
                        SIZE))
                      (LET* ((INDEX
                              (LDB
                               (BYTE
                                #S(FORMGREP:SYMREF
                                   :NAME "+BIT-COUNT+"
                                   :QUALIFIER "CL-DS.COMMON.RRB")
                                BYTE-POSITION)
                               SIZE))
                             (PRESENT
                              (AND
                               (NOT
                                (#S(FORMGREP:SYMREF
                                    :NAME "NULL-BUCKET-P"
                                    :QUALIFIER "CL-DS.META")
                                 NODE))
                               (#S(FORMGREP:SYMREF
                                   :NAME "SPARSE-RRB-NODE-CONTAINS"
                                   :QUALIFIER "CL-DS.COMMON.RRB")
                                NODE INDEX)))
                             (NEXT-NODE
                              (IF PRESENT
                                  (#S(FORMGREP:SYMREF
                                      :NAME "SPARSE-NREF"
                                      :QUALIFIER "CL-DS.COMMON.RRB")
                                   NODE INDEX)
                                  #S(FORMGREP:SYMREF
                                     :NAME "NULL-BUCKET"
                                     :QUALIFIER "CL-DS.META")))
                             (NEW-NODE
                              (IMPL NEXT-NODE
                               (- BYTE-POSITION
                                  #S(FORMGREP:SYMREF
                                     :NAME "+BIT-COUNT+"
                                     :QUALIFIER "CL-DS.COMMON.RRB"))
                               (1- DEPTH))))
                        (SETF (#S(FORMGREP:SYMREF
                                  :NAME "SPARSE-NREF"
                                  :QUALIFIER "CL-DS.COMMON.RRB")
                               CURRENT-NODE INDEX)
                                NEW-NODE)))
                  CURRENT-NODE)))
              (SETF ROOT
                      (IMPL ROOT
                       (*
                        #S(FORMGREP:SYMREF
                           :NAME "+BIT-COUNT+"
                           :QUALIFIER "CL-DS.COMMON.RRB")
                        SHIFT)
                       (MAX 0 (1- SHIFT)))))))
           (MAKE (TYPE-OF STRUCTURE) :TREE ROOT :TAIL NIL :TAIL-MASK 0 :SHIFT
            SHIFT :TREE-SIZE
            (+ TREE-SIZE (LOGCOUNT (ACCESS-TAIL-MASK STRUCTURE)))
            :TREE-INDEX-BOUND (TREE-INDEX-BOUND ROOT SHIFT) :INDEX-BOUND
            (+
             #S(FORMGREP:SYMREF
                :NAME "+MAXIMUM-CHILDREN-COUNT+"
                :QUALIFIER "CL-DS.COMMON.RRB")
             (ACCESS-INDEX-BOUND STRUCTURE))
            :ELEMENT-TYPE (READ-ELEMENT-TYPE STRUCTURE))))))

[cl-data-structures/src/dicts/srrb/internal.lisp:360]
  (DEFUN MAKE-ADJUSTED-TREE (STRUCTURE POSITION NEW-SHIFT OWNERSHIP-TAG)
    (DECLARE (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0))
             (IGNORE POSITION))
    (BIND
     (((:ACCESSORS (ROOT ACCESS-TREE) (TREE-SIZE ACCESS-TREE-SIZE)
        (SHIFT ACCESS-SHIFT) (TREE-INDEX-BOUND ACCESS-TREE-INDEX-BOUND))
       STRUCTURE)
      (OLD-SHIFT SHIFT) (OLD-TREE-INDEX-BOUND TREE-INDEX-BOUND)
      (SHIFT-DIFFERENCE (- NEW-SHIFT OLD-SHIFT))
      (LARGER? (> SHIFT-DIFFERENCE 0)))
     (DECLARE (TYPE NON-NEGATIVE-FIXNUM OLD-TREE-INDEX-BOUND OLD-SHIFT)
              (TYPE BOOLEAN LARGER?)
              (TYPE FIXNUM SHIFT-DIFFERENCE))
     (ASSERT (NOT (ZEROP SHIFT-DIFFERENCE)))
     (IF LARGER?
         (IF (#S(FORMGREP:SYMREF :NAME "NULL-BUCKET-P" :QUALIFIER "CL-DS.META")
              ROOT)
             (#S(FORMGREP:SYMREF
                 :NAME "MAKE-SPARSE-RRB-NODE"
                 :QUALIFIER "CL-DS.COMMON.RRB")
              :OWNERSHIP-TAG OWNERSHIP-TAG)
             (ITERATE (DECLARE (TYPE FIXNUM I HIGHEST-CURRENT BYTE-POSITION))
              (WITH HIGHEST-CURRENT = (1- OLD-TREE-INDEX-BOUND))
              (WITH NEW-ROOT =
               (#S(FORMGREP:SYMREF
                   :NAME "MAKE-SPARSE-RRB-NODE"
                   :QUALIFIER "CL-DS.COMMON.RRB")
                :CONTENT (MAKE-ARRAY 1) :OWNERSHIP-TAG OWNERSHIP-TAG))
              (WITH NODE = NEW-ROOT)
              (WITH BYTE-POSITION =
               (*
                #S(FORMGREP:SYMREF
                   :NAME "+BIT-COUNT+"
                   :QUALIFIER "CL-DS.COMMON.RRB")
                NEW-SHIFT))
              (REPEAT (1- SHIFT-DIFFERENCE))
              (FOR I =
               (LDB
                (BYTE
                 #S(FORMGREP:SYMREF
                    :NAME "+BIT-COUNT+"
                    :QUALIFIER "CL-DS.COMMON.RRB")
                 BYTE-POSITION)
                HIGHEST-CURRENT))
              (SETF NODE (INSERT-NEW-NODE! NODE I OWNERSHIP-TAG))
              (DECF BYTE-POSITION
                    #S(FORMGREP:SYMREF
                       :NAME "+BIT-COUNT+"
                       :QUALIFIER "CL-DS.COMMON.RRB"))
              (FINALLY
               (LET ((I
                      (LDB
                       (BYTE
                        #S(FORMGREP:SYMREF
                           :NAME "+BIT-COUNT+"
                           :QUALIFIER "CL-DS.COMMON.RRB")
                        (* (1+ OLD-SHIFT)
                           #S(FORMGREP:SYMREF
                              :NAME "+BIT-COUNT+"
                              :QUALIFIER "CL-DS.COMMON.RRB")))
                       HIGHEST-CURRENT)))
                 (#S(FORMGREP:SYMREF
                     :NAME "WITH-SPARSE-RRB-NODE"
                     :QUALIFIER "CL-DS.COMMON.RRB")
                  NODE
                  (SETF (#S(FORMGREP:SYMREF
                            :NAME "SPARSE-NREF"
                            :QUALIFIER "CL-DS.COMMON.RRB")
                         NODE I)
                          ROOT))
                 (ASSERT
                  (EQ
                   (#S(FORMGREP:SYMREF
                       :NAME "SPARSE-NREF"
                       :QUALIFIER "CL-DS.COMMON.RRB")
                    NODE I)
                   ROOT))
                 (RETURN NEW-ROOT)))))
         (IF (#S(FORMGREP:SYMREF :NAME "NULL-BUCKET-P" :QUALIFIER "CL-DS.META")
              ROOT)
             (#S(FORMGREP:SYMREF
                 :NAME "MAKE-SPARSE-RRB-NODE"
                 :QUALIFIER "CL-DS.COMMON.RRB")
              :OWNERSHIP-TAG OWNERSHIP-TAG)
             (ITERATE (WITH NODE = ROOT)
              (UNTIL
               (~> NODE
                #S(FORMGREP:SYMREF
                   :NAME "SPARSE-RRB-NODE-BITMASK"
                   :QUALIFIER "CL-DS.COMMON.RRB")
                ZEROP))
              (REPEAT (- SHIFT-DIFFERENCE))
              (SETF NODE
                      (~> NODE
                       #S(FORMGREP:SYMREF
                          :NAME "SPARSE-RRB-NODE-CONTENT"
                          :QUALIFIER "CL-DS.COMMON.RRB")
                       FIRST-ELT))
              (FINALLY (RETURN NODE)))))))

[cl-data-structures/src/dicts/srrb/internal.lisp:783]
  (DEFUN DESTRUCTIVE-GROW-TREE!
         (OPERATION STRUCTURE CONTAINER POSITION ALL VALUE)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SPACE 0) (SAFETY 0)))
    (BIND
     ((FINAL-STATUS NIL) (OPERATION-TYPE (TYPE-OF OPERATION))
      (UPDATE?
       (MEMBER OPERATION-TYPE
               '(#S(FORMGREP:SYMREF
                    :NAME "UPDATE!-FUNCTION"
                    :QUALIFIER "CL-DS.META")
                 #S(FORMGREP:SYMREF
                    :NAME "UPDATE-IF!-FUNCTION"
                    :QUALIFIER "CL-DS.META"))))
      ((:ACCESSORS (ELEMENT-TYPE READ-ELEMENT-TYPE)) STRUCTURE)
      (SIZE-INCREASED 0)
      ((:LABELS IMPL (NODE BYTE-POSITION DEPTH))
       (DECLARE (TYPE FIXNUM DEPTH BYTE-POSITION))
       (LET* ((I
               (LDB
                (BYTE
                 #S(FORMGREP:SYMREF
                    :NAME "+BIT-COUNT+"
                    :QUALIFIER "CL-DS.COMMON.RRB")
                 BYTE-POSITION)
                POSITION))
              (PRESENT
               (AND
                (NOT
                 (#S(FORMGREP:SYMREF
                     :NAME "NULL-BUCKET-P"
                     :QUALIFIER "CL-DS.META")
                  NODE))
                (#S(FORMGREP:SYMREF
                    :NAME "SPARSE-RRB-NODE-CONTAINS"
                    :QUALIFIER "CL-DS.COMMON.RRB")
                 NODE I))))
         (WHEN (AND (NOT PRESENT) UPDATE?)
           (RETURN-FROM DESTRUCTIVE-GROW-TREE!
             (VALUES STRUCTURE
                     #S(FORMGREP:SYMREF
                        :NAME "EMPTY-EAGER-MODIFICATION-OPERATION-STATUS"
                        :QUALIFIER "CL-DS.COMMON"))))
         (IF (ZEROP DEPTH)
             (IF PRESENT
                 (BIND
                  ((CURRENT
                    (#S(FORMGREP:SYMREF
                        :NAME "SPARSE-NREF"
                        :QUALIFIER "CL-DS.COMMON.RRB")
                     NODE I))
                   ((:VALUES NEW-BUCKET STATUS)
                    (APPLY
                     #'#S(FORMGREP:SYMREF
                          :NAME "ALTER-BUCKET!"
                          :QUALIFIER "CL-DS.META")
                     CONTAINER OPERATION VALUE CURRENT ALL)))
                  (IF (#S(FORMGREP:SYMREF :NAME "CHANGED" :QUALIFIER "CL-DS")
                       STATUS)
                      (PROGN
                       (SETF (#S(FORMGREP:SYMREF
                                 :NAME "SPARSE-NREF"
                                 :QUALIFIER "CL-DS.COMMON.RRB")
                              NODE I)
                               NEW-BUCKET
                             FINAL-STATUS STATUS)
                       NODE)
                      (RETURN-FROM DESTRUCTIVE-GROW-TREE!
                        (VALUES STRUCTURE STATUS))))
                 (BIND
                  (((:VALUES NEW-BUCKET STATUS)
                    (APPLY
                     #'#S(FORMGREP:SYMREF
                          :NAME "MAKE-BUCKET"
                          :QUALIFIER "CL-DS.META")
                     CONTAINER OPERATION VALUE ALL))
                   (NODE
                    (IF (#S(FORMGREP:SYMREF
                            :NAME "NULL-BUCKET-P"
                            :QUALIFIER "CL-DS.META")
                         NODE)
                        (#S(FORMGREP:SYMREF
                            :NAME "MAKE-SPARSE-RRB-NODE"
                            :QUALIFIER "CL-DS.COMMON.RRB")
                         :CONTENT (MAKE-ARRAY 1 :ELEMENT-TYPE ELEMENT-TYPE))
                        NODE)))
                  (IF (#S(FORMGREP:SYMREF :NAME "CHANGED" :QUALIFIER "CL-DS")
                       STATUS)
                      (PROGN
                       (SETF (#S(FORMGREP:SYMREF
                                 :NAME "SPARSE-NREF"
                                 :QUALIFIER "CL-DS.COMMON.RRB")
                              NODE I)
                               NEW-BUCKET
                             SIZE-INCREASED 1
                             FINAL-STATUS STATUS)
                       (INCF (THE FIXNUM (ACCESS-TREE-SIZE STRUCTURE)))
                       NODE)
                      (RETURN-FROM DESTRUCTIVE-GROW-TREE!
                        (VALUES STRUCTURE STATUS)))))
             (IF PRESENT
                 (LET* ((NEXT-NODE
                         (#S(FORMGREP:SYMREF
                             :NAME "SPARSE-NREF"
                             :QUALIFIER "CL-DS.COMMON.RRB")
                          NODE I))
                        (NEW-NODE
                         (IMPL NEXT-NODE
                          (- BYTE-POSITION
                             #S(FORMGREP:SYMREF
                                :NAME "+BIT-COUNT+"
                                :QUALIFIER "CL-DS.COMMON.RRB"))
                          (1- DEPTH))))
                   (UNLESS (EQ NEW-NODE NEXT-NODE)
                     (SETF (#S(FORMGREP:SYMREF
                               :NAME "SPARSE-NREF"
                               :QUALIFIER "CL-DS.COMMON.RRB")
                            NODE I)
                             NEW-NODE))
                   NODE)
                 (LET ((NEW-NODE
                        (IMPL
                         #S(FORMGREP:SYMREF
                            :NAME "NULL-BUCKET"
                            :QUALIFIER "CL-DS.META")
                         (- BYTE-POSITION
                            #S(FORMGREP:SYMREF
                               :NAME "+BIT-COUNT+"
                               :QUALIFIER "CL-DS.COMMON.RRB"))
                         (1- DEPTH)))
                       (CURRENT-NODE
                        (IF (#S(FORMGREP:SYMREF
                                :NAME "NULL-BUCKET-P"
                                :QUALIFIER "CL-DS.META")
                             NODE)
                            (#S(FORMGREP:SYMREF
                                :NAME "MAKE-SPARSE-RRB-NODE"
                                :QUALIFIER "CL-DS.COMMON.RRB")
                             :CONTENT (MAKE-ARRAY 1))
                            NODE)))
                   (SETF (#S(FORMGREP:SYMREF
                             :NAME "SPARSE-NREF"
                             :QUALIFIER "CL-DS.COMMON.RRB")
                          CURRENT-NODE I)
                           NEW-NODE)
                   CURRENT-NODE)))))
      (SHIFT (ACCESS-SHIFT STRUCTURE)))
     (DECLARE (TYPE FIXNUM SHIFT SIZE-INCREASED))
     (INCF (THE FIXNUM (ACCESS-TREE-SIZE STRUCTURE)) SIZE-INCREASED)
     (LET* ((OLD-ROOT (ACCESS-TREE STRUCTURE))
            (NEW-ROOT
             (IMPL OLD-ROOT
              (THE FIXNUM
                   (*
                    #S(FORMGREP:SYMREF
                       :NAME "+BIT-COUNT+"
                       :QUALIFIER "CL-DS.COMMON.RRB")
                    SHIFT))
              SHIFT)))
       (UNLESS (EQ OLD-ROOT NEW-ROOT) (SETF (ACCESS-TREE STRUCTURE) NEW-ROOT)))
     (VALUES STRUCTURE FINAL-STATUS)))

[cl-data-structures/src/dicts/srrb/internal.lisp:864]
  (DEFUN TRANSACTIONAL-SHRINK-TREE!
         (OPERATION STRUCTURE CONTAINER POSITION ALL)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0) (SPACE 0)))
    (BIND
     ((SHIFT (ACCESS-SHIFT STRUCTURE))
      (TAG
       (#S(FORMGREP:SYMREF
           :NAME "READ-OWNERSHIP-TAG"
           :QUALIFIER "CL-DS.COMMON.ABSTRACT")
        STRUCTURE))
      (TREE (ACCESS-TREE STRUCTURE)))
     (#S(FORMGREP:SYMREF
         :NAME "WITH-SPARSE-RRB-NODE-PATH"
         :QUALIFIER "CL-DS.COMMON.RRB")
      (TREE POSITION SHIFT PATH INDEXES LENGTH ALL-PRESENT)
      (UNLESS ALL-PRESENT
        (RETURN-FROM TRANSACTIONAL-SHRINK-TREE!
          (VALUES STRUCTURE
                  #S(FORMGREP:SYMREF
                     :NAME "EMPTY-EAGER-MODIFICATION-OPERATION-STATUS"
                     :QUALIFIER "CL-DS.COMMON"))))
      (BIND
       ((CURRENT-BUCKET (SVREF PATH (1- LENGTH)))
        (LAST-NODE (SVREF PATH (- LENGTH 2)))
        (LAST-NODE-MASK
         (#S(FORMGREP:SYMREF
             :NAME "SPARSE-RRB-NODE-BITMASK"
             :QUALIFIER "CL-DS.COMMON.RRB")
          LAST-NODE))
        ((:VALUES NEW-BUCKET STATUS)
         (APPLY
          #'#S(FORMGREP:SYMREF :NAME "ALTER-BUCKET" :QUALIFIER "CL-DS.META")
          CONTAINER OPERATION NIL CURRENT-BUCKET ALL))
        (LAST-NODE-SIZE (LOGCOUNT LAST-NODE-MASK)))
       (DECLARE (TYPE FIXNUM LAST-NODE-SIZE LAST-NODE-MASK))
       (UNLESS (#S(FORMGREP:SYMREF :NAME "CHANGED" :QUALIFIER "CL-DS") STATUS)
         (RETURN-FROM TRANSACTIONAL-SHRINK-TREE! (VALUES STRUCTURE STATUS)))
       (WHEN
           (#S(FORMGREP:SYMREF :NAME "NULL-BUCKET-P" :QUALIFIER "CL-DS.META")
            NEW-BUCKET)
         (DECF LAST-NODE-SIZE)
         (DECF (THE FIXNUM (ACCESS-TREE-SIZE STRUCTURE))))
       (SETF (SVREF PATH (1- LENGTH)) NEW-BUCKET)
       (BLOCK END
         (LET ((RESULT
                (#S(FORMGREP:SYMREF
                    :NAME "REDUCE-PATH"
                    :QUALIFIER "CL-DS.COMMON.RRB")
                 (PREV INDEX NODE)
                 (IF (#S(FORMGREP:SYMREF
                         :NAME "NULL-BUCKET-P"
                         :QUALIFIER "CL-DS.META")
                      PREV)
                     (IF (HAS-SINGLE-CHILD-P NODE)
                         #S(FORMGREP:SYMREF
                            :NAME "NULL-BUCKET"
                            :QUALIFIER "CL-DS.META")
                         (IF (#S(FORMGREP:SYMREF
                                 :NAME "ACQUIRE-OWNERSHIP"
                                 :QUALIFIER "CL-DS.COMMON.ABSTRACT")
                              NODE TAG)
                             (#S(FORMGREP:SYMREF
                                 :NAME "SPARSE-RRB-NODE-ERASE!"
                                 :QUALIFIER "CL-DS.COMMON.RRB")
                              NODE INDEX)
                             (#S(FORMGREP:SYMREF
                                 :NAME "SPARSE-RRB-NODE-ERASE"
                                 :QUALIFIER "CL-DS.COMMON.RRB")
                              NODE INDEX TAG)))
                     (LET ((CURRENT
                            (#S(FORMGREP:SYMREF
                                :NAME "SPARSE-NREF"
                                :QUALIFIER "CL-DS.COMMON.RRB")
                             NODE INDEX)))
                       (ASSERT
                        (#S(FORMGREP:SYMREF
                            :NAME "SPARSE-RRB-NODE-CONTAINS"
                            :QUALIFIER "CL-DS.COMMON.RRB")
                         NODE INDEX))
                       (COND ((EQ CURRENT PREV) (RETURN-FROM END))
                             ((#S(FORMGREP:SYMREF
                                  :NAME "ACQUIRE-OWNERSHIP"
                                  :QUALIFIER "CL-DS.COMMON.ABSTRACT")
                               NODE TAG)
                              (SETF (#S(FORMGREP:SYMREF
                                        :NAME "SPARSE-NREF"
                                        :QUALIFIER "CL-DS.COMMON.RRB")
                                     NODE INDEX)
                                      PREV)
                              NODE)
                             (T
                              (SETF NODE
                                      (#S(FORMGREP:SYMREF
                                          :NAME "DEEP-COPY-SPARSE-RRB-NODE"
                                          :QUALIFIER "CL-DS.COMMON.RRB")
                                       NODE 0 TAG)
                                    (#S(FORMGREP:SYMREF
                                        :NAME "SPARSE-NREF"
                                        :QUALIFIER "CL-DS.COMMON.RRB")
                                     NODE INDEX)
                                      PREV)
                              NODE)))))))
           (SETF (ACCESS-TREE STRUCTURE) RESULT)))
       (TRANSACTIONAL-SHRINK-HANDLE-TAIL! STRUCTURE POSITION STATUS
        LAST-NODE-SIZE LAST-NODE-MASK LAST-NODE)))))

[cl-data-structures/src/dicts/srrb/internal.lisp:1082]
  (DEFUN SHRINK-TREE! (OPERATION STRUCTURE CONTAINER POSITION ALL)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LET ((SHIFT (ACCESS-SHIFT STRUCTURE)) (TREE (ACCESS-TREE STRUCTURE)))
      (DECLARE (TYPE FIXNUM SHIFT))
      (#S(FORMGREP:SYMREF
          :NAME "WITH-SPARSE-RRB-NODE-PATH"
          :QUALIFIER "CL-DS.COMMON.RRB")
       (TREE POSITION SHIFT PATH INDEXES LENGTH ALL-PRESENT)
       (UNLESS ALL-PRESENT
         (RETURN-FROM SHRINK-TREE!
           (VALUES STRUCTURE
                   #S(FORMGREP:SYMREF
                      :NAME "EMPTY-EAGER-MODIFICATION-OPERATION-STATUS"
                      :QUALIFIER "CL-DS.COMMON"))))
       (BIND
        ((CURRENT-BUCKET (SVREF PATH (1- LENGTH)))
         (LAST-NODE (SVREF PATH (- LENGTH 2)))
         (LAST-NODE-MASK
          (#S(FORMGREP:SYMREF
              :NAME "SPARSE-RRB-NODE-BITMASK"
              :QUALIFIER "CL-DS.COMMON.RRB")
           LAST-NODE))
         (LAST-NODE-SIZE (LOGCOUNT LAST-NODE-MASK))
         ((:VALUES NEW-BUCKET STATUS)
          (APPLY
           #'#S(FORMGREP:SYMREF :NAME "ALTER-BUCKET!" :QUALIFIER "CL-DS.META")
           CONTAINER OPERATION NIL CURRENT-BUCKET ALL)))
        (UNLESS (#S(FORMGREP:SYMREF :NAME "CHANGED" :QUALIFIER "CL-DS") STATUS)
          (RETURN-FROM SHRINK-TREE! (VALUES STRUCTURE STATUS)))
        (WHEN
            (#S(FORMGREP:SYMREF :NAME "NULL-BUCKET-P" :QUALIFIER "CL-DS.META")
             NEW-BUCKET)
          (DECF LAST-NODE-SIZE)
          (DECF (THE FIXNUM (ACCESS-TREE-SIZE STRUCTURE))))
        (SETF (SVREF PATH (1- LENGTH)) NEW-BUCKET)
        (BLOCK END
          (LET ((RESULT
                 (#S(FORMGREP:SYMREF
                     :NAME "REDUCE-PATH"
                     :QUALIFIER "CL-DS.COMMON.RRB")
                  (PREV INDEX NODE)
                  (IF (#S(FORMGREP:SYMREF
                          :NAME "NULL-BUCKET-P"
                          :QUALIFIER "CL-DS.META")
                       PREV)
                      (IF (HAS-SINGLE-CHILD-P NODE)
                          #S(FORMGREP:SYMREF
                             :NAME "NULL-BUCKET"
                             :QUALIFIER "CL-DS.META")
                          (#S(FORMGREP:SYMREF
                              :NAME "SPARSE-RRB-NODE-ERASE!"
                              :QUALIFIER "CL-DS.COMMON.RRB")
                           NODE INDEX))
                      (LET ((CURRENT
                             (#S(FORMGREP:SYMREF
                                 :NAME "SPARSE-NREF"
                                 :QUALIFIER "CL-DS.COMMON.RRB")
                              NODE INDEX)))
                        (COND ((EQL CURRENT PREV) (RETURN-FROM END))
                              (T
                               (SETF (#S(FORMGREP:SYMREF
                                         :NAME "SPARSE-NREF"
                                         :QUALIFIER "CL-DS.COMMON.RRB")
                                      NODE INDEX)
                                       PREV)
                               (ASSERT
                                (#S(FORMGREP:SYMREF
                                    :NAME "SPARSE-RRB-NODE-CONTAINS"
                                    :QUALIFIER "CL-DS.COMMON.RRB")
                                 NODE INDEX))
                               NODE)))))))
            (SETF (ACCESS-TREE STRUCTURE) RESULT)))
        (SHRINK-HANDLE-TAIL! STRUCTURE POSITION STATUS LAST-NODE-SIZE
         LAST-NODE-MASK LAST-NODE)))))

[cl-data-structures/src/dicts/srrb/internal.lisp:1127]
  (DEFUN SHRINK-TREE (OPERATION STRUCTURE CONTAINER POSITION ALL)
    (DECLARE (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 1)))
    (BIND ((SHIFT (ACCESS-SHIFT STRUCTURE)) (TREE (ACCESS-TREE STRUCTURE)))
     (#S(FORMGREP:SYMREF
         :NAME "WITH-SPARSE-RRB-NODE-PATH"
         :QUALIFIER "CL-DS.COMMON.RRB")
      (TREE POSITION SHIFT PATH INDEXES LENGTH ALL-PRESENT)
      (UNLESS ALL-PRESENT
        (RETURN-FROM SHRINK-TREE
          (VALUES STRUCTURE
                  #S(FORMGREP:SYMREF
                     :NAME "EMPTY-EAGER-MODIFICATION-OPERATION-STATUS"
                     :QUALIFIER "CL-DS.COMMON"))))
      (BIND
       ((CURRENT-BUCKET (SVREF PATH (1- LENGTH)))
        (LAST-NODE (SVREF PATH (- LENGTH 2)))
        (LAST-NODE-MASK
         (#S(FORMGREP:SYMREF
             :NAME "SPARSE-RRB-NODE-BITMASK"
             :QUALIFIER "CL-DS.COMMON.RRB")
          LAST-NODE))
        (LAST-NODE-SIZE (LOGCOUNT LAST-NODE-MASK))
        (TAIL (ACCESS-TAIL STRUCTURE))
        ((:VALUES NEW-BUCKET STATUS)
         (APPLY
          #'#S(FORMGREP:SYMREF :NAME "ALTER-BUCKET" :QUALIFIER "CL-DS.META")
          CONTAINER OPERATION NIL CURRENT-BUCKET ALL)))
       (UNLESS (#S(FORMGREP:SYMREF :NAME "CHANGED" :QUALIFIER "CL-DS") STATUS)
         (RETURN-FROM SHRINK-TREE (VALUES STRUCTURE STATUS)))
       (WHEN (#S(FORMGREP:SYMREF :NAME "CHANGED" :QUALIFIER "CL-DS") STATUS)
         (DECF LAST-NODE-SIZE)
         (DECF (THE FIXNUM (ACCESS-TREE-SIZE STRUCTURE))))
       (SETF (SVREF PATH (1- LENGTH)) NEW-BUCKET)
       (LET* ((ROOT
               (#S(FORMGREP:SYMREF
                   :NAME "REDUCE-PATH"
                   :QUALIFIER "CL-DS.COMMON.RRB")
                (PREV INDEX NODE)
                (IF (#S(FORMGREP:SYMREF
                        :NAME "NULL-BUCKET-P"
                        :QUALIFIER "CL-DS.META")
                     PREV)
                    (IF (HAS-SINGLE-CHILD-P NODE)
                        #S(FORMGREP:SYMREF
                           :NAME "NULL-BUCKET"
                           :QUALIFIER "CL-DS.META")
                        (#S(FORMGREP:SYMREF
                            :NAME "SPARSE-RRB-NODE-ERASE"
                            :QUALIFIER "CL-DS.COMMON.RRB")
                         NODE INDEX))
                    (LET ((NODE
                           (#S(FORMGREP:SYMREF
                               :NAME "DEEP-COPY-SPARSE-RRB-NODE"
                               :QUALIFIER "CL-DS.COMMON.RRB")
                            NODE 0)))
                      (SETF (#S(FORMGREP:SYMREF
                                :NAME "SPARSE-NREF"
                                :QUALIFIER "CL-DS.COMMON.RRB")
                             NODE INDEX)
                              PREV)
                      NODE))))
              (RESULT
               (MAKE (TYPE-OF STRUCTURE) :TREE ROOT :TAIL TAIL :TAIL-MASK
                (ACCESS-TAIL-MASK STRUCTURE) :SHIFT (ACCESS-SHIFT STRUCTURE)
                :TREE-SIZE (ACCESS-TREE-SIZE STRUCTURE) :TREE-INDEX-BOUND
                (ACCESS-TREE-INDEX-BOUND STRUCTURE) :INDEX-BOUND
                (ACCESS-INDEX-BOUND STRUCTURE) :ELEMENT-TYPE
                (READ-ELEMENT-TYPE STRUCTURE))))
         (SHRINK-HANDLE-TAIL! RESULT POSITION STATUS LAST-NODE-SIZE
          LAST-NODE-MASK LAST-NODE))))))

[cl-data-structures/src/sequences/rrb/api.lisp:23]
  (DEFMETHOD #S(FORMGREP:SYMREF
                :NAME "POSITION-MODIFICATION"
                :QUALIFIER "CL-DS.META")
             (
              (OPERATION
               #S(FORMGREP:SYMREF
                  :NAME "TAKE-OUT!-FUNCTION"
                  :QUALIFIER "CL-DS.META"))
              CONTAINER (STRUCTURE TRANSACTIONAL-RRB-VECTOR) LOCATION
              &REST REST
              &KEY &ALLOW-OTHER-KEYS)
    (DECLARE (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 1)))
    (BIND
     ((TAIL-SIZE
       (#S(FORMGREP:SYMREF
           :NAME "ACCESS-TAIL-SIZE"
           :QUALIFIER "CL-DS.COMMON.RRB")
        STRUCTURE))
      (RESULT-STATUS NIL) (TAIL-CHANGE 0)
      ((:DFLET SHRINK-BUCKET (BUCKET))
       (MULTIPLE-VALUE-BIND (BUCKET STATUS)
           (APPLY
            #'#S(FORMGREP:SYMREF :NAME "ALTER-BUCKET" :QUALIFIER "CL-DS.META")
            CONTAINER OPERATION LOCATION BUCKET REST)
         (SETF RESULT-STATUS STATUS)
         (UNLESS
             (#S(FORMGREP:SYMREF :NAME "CHANGED" :QUALIFIER "CL-DS") STATUS)
           (RETURN-FROM
               #S(FORMGREP:SYMREF
                  :NAME "POSITION-MODIFICATION"
                  :QUALIFIER "CL-DS.META")
             (VALUES STRUCTURE STATUS)))
         (WHEN
             (#S(FORMGREP:SYMREF :NAME "NULL-BUCKET-P" :QUALIFIER "CL-DS.META")
              BUCKET)
           (DECF TAIL-CHANGE))
         BUCKET)))
     (IF (ZEROP TAIL-SIZE)
         (IF (ZEROP
              (#S(FORMGREP:SYMREF
                  :NAME "ACCESS-SIZE"
                  :QUALIFIER "CL-DS.COMMON.RRB")
               STRUCTURE))
             (ERROR
              '#S(FORMGREP:SYMREF :NAME "EMPTY-CONTAINER" :QUALIFIER "CL-DS")
              :FORMAT-CONTROL "Can't take-out from empty container.")
             (BIND
              (((:VALUES NEW-ROOT TAIL SHIFT-DECREASED)
                (#S(FORMGREP:SYMREF
                    :NAME "REMOVE-TAIL"
                    :QUALIFIER "CL-DS.COMMON.RRB")
                 STRUCTURE))
               (NEW-SHIFT
                (IF SHIFT-DECREASED
                    (1-
                     (#S(FORMGREP:SYMREF
                         :NAME "ACCESS-SHIFT"
                         :QUALIFIER "CL-DS.COMMON.RRB")
                      STRUCTURE))
                    (#S(FORMGREP:SYMREF
                        :NAME "ACCESS-SHIFT"
                        :QUALIFIER "CL-DS.COMMON.RRB")
                     STRUCTURE)))
               (NEW-SIZE
                (MAX 0
                     (-
                      (#S(FORMGREP:SYMREF
                          :NAME "ACCESS-SIZE"
                          :QUALIFIER "CL-DS.COMMON.RRB")
                       STRUCTURE)
                      #S(FORMGREP:SYMREF
                         :NAME "+MAXIMUM-CHILDREN-COUNT+"
                         :QUALIFIER "CL-DS.COMMON.RRB"))))
               (NEW-TAIL TAIL)
               (TAIL-SIZE
                (IF (NULL NEW-ROOT)
                    (#S(FORMGREP:SYMREF
                        :NAME "ACCESS-SIZE"
                        :QUALIFIER "CL-DS.COMMON.RRB")
                     STRUCTURE)
                    #S(FORMGREP:SYMREF
                       :NAME "+MAXIMUM-CHILDREN-COUNT+"
                       :QUALIFIER "CL-DS.COMMON.RRB")))
               (LAST-INDEX (1- TAIL-SIZE))
               (NEW-BUCKET
                (~> NEW-TAIL
                 (AREF
                  (1-
                   #S(FORMGREP:SYMREF
                      :NAME "+MAXIMUM-CHILDREN-COUNT+"
                      :QUALIFIER "CL-DS.COMMON.RRB")))
                 SHRINK-BUCKET)))
              (COND
               ((AND
                 (#S(FORMGREP:SYMREF
                     :NAME "NULL-BUCKET-P"
                     :QUALIFIER "CL-DS.META")
                  NEW-BUCKET)
                 (ZEROP (+ TAIL-CHANGE TAIL-SIZE)))
                (SETF NEW-TAIL NIL))
               ((~> NEW-BUCKET
                 #S(FORMGREP:SYMREF
                    :NAME "NULL-BUCKET-P"
                    :QUALIFIER "CL-DS.META")
                 NOT)
                (SETF NEW-TAIL (COPY-ARRAY NEW-TAIL)
                      (AREF NEW-TAIL LAST-INDEX) NEW-BUCKET))
               (T
                (SETF NEW-TAIL (COPY-ARRAY NEW-TAIL)
                      (AREF NEW-TAIL LAST-INDEX) NIL)))
              (ASSERT (OR NEW-ROOT NEW-TAIL (ZEROP NEW-SIZE)))
              (ASSERT (<= 0 TAIL-SIZE +MAXIMUM-CHILDREN-COUNT+))
              (SETF (#S(FORMGREP:SYMREF
                        :NAME "ACCESS-ROOT"
                        :QUALIFIER "CL-DS.COMMON.RRB")
                     STRUCTURE)
                      NEW-ROOT
                    (#S(FORMGREP:SYMREF
                        :NAME "ACCESS-TAIL"
                        :QUALIFIER "CL-DS.COMMON.RRB")
                     STRUCTURE)
                      NEW-TAIL
                    (#S(FORMGREP:SYMREF
                        :NAME "ACCESS-TAIL-SIZE"
                        :QUALIFIER "CL-DS.COMMON.RRB")
                     STRUCTURE)
                      (+ TAIL-SIZE TAIL-CHANGE)
                    (#S(FORMGREP:SYMREF
                        :NAME "ACCESS-SIZE"
                        :QUALIFIER "CL-DS.COMMON.RRB")
                     STRUCTURE)
                      NEW-SIZE
                    (#S(FORMGREP:SYMREF
                        :NAME "ACCESS-SHIFT"
                        :QUALIFIER "CL-DS.COMMON.RRB")
                     STRUCTURE)
                      NEW-SHIFT)))
         (LET* ((TAIL
                 (#S(FORMGREP:SYMREF
                     :NAME "ACCESS-TAIL"
                     :QUALIFIER "CL-DS.COMMON.RRB")
                  STRUCTURE))
                (LAST-INDEX (1- TAIL-SIZE))
                (NEW-BUCKET (SHRINK-BUCKET (AREF TAIL LAST-INDEX))))
           (SETF (AREF TAIL (+ TAIL-CHANGE TAIL-SIZE))
                   (UNLESS
                       (#S(FORMGREP:SYMREF
                           :NAME "NULL-BUCKET-P"
                           :QUALIFIER "CL-DS.META")
                        NEW-BUCKET)
                     NEW-BUCKET))
           (INCF
            (#S(FORMGREP:SYMREF
                :NAME "ACCESS-TAIL-SIZE"
                :QUALIFIER "CL-DS.COMMON.RRB")
             STRUCTURE)
            TAIL-CHANGE)))
     (VALUES STRUCTURE RESULT-STATUS)))

[cl-data-structures/src/sequences/rrb/api.lisp:90]
  (DEFMETHOD #S(FORMGREP:SYMREF
                :NAME "POSITION-MODIFICATION"
                :QUALIFIER "CL-DS.META")
             (
              (OPERATION
               #S(FORMGREP:SYMREF
                  :NAME "TAKE-OUT!-FUNCTION"
                  :QUALIFIER "CL-DS.META"))
              CONTAINER (STRUCTURE MUTABLE-RRB-VECTOR) LOCATION
              &REST REST
              &KEY &ALLOW-OTHER-KEYS)
    (DECLARE (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 1)))
    (BIND
     ((TAIL-SIZE
       (#S(FORMGREP:SYMREF
           :NAME "ACCESS-TAIL-SIZE"
           :QUALIFIER "CL-DS.COMMON.RRB")
        STRUCTURE))
      (RESULT-STATUS NIL) (TAIL-CHANGE 0)
      ((:DFLET SHRINK-BUCKET (BUCKET))
       (MULTIPLE-VALUE-BIND (BUCKET STATUS)
           (APPLY
            #'#S(FORMGREP:SYMREF :NAME "ALTER-BUCKET!" :QUALIFIER "CL-DS.META")
            CONTAINER OPERATION LOCATION BUCKET REST)
         (SETF RESULT-STATUS STATUS)
         (UNLESS
             (#S(FORMGREP:SYMREF :NAME "CHANGED" :QUALIFIER "CL-DS") STATUS)
           (RETURN-FROM
               #S(FORMGREP:SYMREF
                  :NAME "POSITION-MODIFICATION"
                  :QUALIFIER "CL-DS.META")
             (VALUES STRUCTURE STATUS)))
         (WHEN
             (#S(FORMGREP:SYMREF :NAME "NULL-BUCKET-P" :QUALIFIER "CL-DS.META")
              BUCKET)
           (DECF TAIL-CHANGE))
         BUCKET)))
     (IF (ZEROP TAIL-SIZE)
         (IF (ZEROP
              (#S(FORMGREP:SYMREF
                  :NAME "ACCESS-SIZE"
                  :QUALIFIER "CL-DS.COMMON.RRB")
               STRUCTURE))
             (ERROR
              '#S(FORMGREP:SYMREF :NAME "EMPTY-CONTAINER" :QUALIFIER "CL-DS")
              :FORMAT-CONTROL "Can't take-out from empty container.")
             (BIND
              (((:VALUES NEW-ROOT TAIL SHIFT-DECREASED)
                (#S(FORMGREP:SYMREF
                    :NAME "REMOVE-TAIL"
                    :QUALIFIER "CL-DS.COMMON.RRB")
                 STRUCTURE))
               (NEW-SHIFT
                (IF SHIFT-DECREASED
                    (1-
                     (#S(FORMGREP:SYMREF
                         :NAME "ACCESS-SHIFT"
                         :QUALIFIER "CL-DS.COMMON.RRB")
                      STRUCTURE))
                    (#S(FORMGREP:SYMREF
                        :NAME "ACCESS-SHIFT"
                        :QUALIFIER "CL-DS.COMMON.RRB")
                     STRUCTURE)))
               (NEW-SIZE
                (MAX 0
                     (-
                      (#S(FORMGREP:SYMREF
                          :NAME "ACCESS-SIZE"
                          :QUALIFIER "CL-DS.COMMON.RRB")
                       STRUCTURE)
                      #S(FORMGREP:SYMREF
                         :NAME "+MAXIMUM-CHILDREN-COUNT+"
                         :QUALIFIER "CL-DS.COMMON.RRB"))))
               (NEW-TAIL TAIL)
               (TAIL-SIZE
                (IF (NULL NEW-ROOT)
                    (#S(FORMGREP:SYMREF
                        :NAME "ACCESS-SIZE"
                        :QUALIFIER "CL-DS.COMMON.RRB")
                     STRUCTURE)
                    #S(FORMGREP:SYMREF
                       :NAME "+MAXIMUM-CHILDREN-COUNT+"
                       :QUALIFIER "CL-DS.COMMON.RRB")))
               (LAST-INDEX (1- (+ TAIL-CHANGE TAIL-SIZE)))
               (NEW-BUCKET
                (~> NEW-TAIL
                 (AREF
                  (1-
                   #S(FORMGREP:SYMREF
                      :NAME "+MAXIMUM-CHILDREN-COUNT+"
                      :QUALIFIER "CL-DS.COMMON.RRB")))
                 SHRINK-BUCKET)))
              (COND
               ((AND
                 (#S(FORMGREP:SYMREF
                     :NAME "NULL-BUCKET-P"
                     :QUALIFIER "CL-DS.META")
                  NEW-BUCKET)
                 (ZEROP (+ TAIL-CHANGE TAIL-SIZE)))
                (SETF NEW-TAIL NIL))
               ((~> NEW-BUCKET
                 #S(FORMGREP:SYMREF
                    :NAME "NULL-BUCKET-P"
                    :QUALIFIER "CL-DS.META")
                 NOT)
                (SETF (AREF NEW-TAIL LAST-INDEX) NEW-BUCKET))
               (T (SETF (AREF NEW-TAIL LAST-INDEX) NIL)))
              (ASSERT (OR NEW-ROOT NEW-TAIL (ZEROP NEW-SIZE)))
              (ASSERT (<= 0 TAIL-SIZE +MAXIMUM-CHILDREN-COUNT+))
              (SETF (#S(FORMGREP:SYMREF
                        :NAME "ACCESS-SIZE"
                        :QUALIFIER "CL-DS.COMMON.RRB")
                     STRUCTURE)
                      NEW-SIZE
                    (#S(FORMGREP:SYMREF
                        :NAME "ACCESS-TAIL-SIZE"
                        :QUALIFIER "CL-DS.COMMON.RRB")
                     STRUCTURE)
                      (+ TAIL-SIZE TAIL-CHANGE)
                    (#S(FORMGREP:SYMREF
                        :NAME "ACCESS-TAIL"
                        :QUALIFIER "CL-DS.COMMON.RRB")
                     STRUCTURE)
                      NEW-TAIL
                    (#S(FORMGREP:SYMREF
                        :NAME "ACCESS-ROOT"
                        :QUALIFIER "CL-DS.COMMON.RRB")
                     STRUCTURE)
                      NEW-ROOT
                    (#S(FORMGREP:SYMREF
                        :NAME "ACCESS-SHIFT"
                        :QUALIFIER "CL-DS.COMMON.RRB")
                     STRUCTURE)
                      NEW-SHIFT)))
         (BIND
          ((TAIL
            (#S(FORMGREP:SYMREF
                :NAME "ACCESS-TAIL"
                :QUALIFIER "CL-DS.COMMON.RRB")
             STRUCTURE))
           (LAST-INDEX (1- TAIL-SIZE))
           (NEW-BUCKET (SHRINK-BUCKET (AREF TAIL LAST-INDEX))))
          (INCF
           (#S(FORMGREP:SYMREF
               :NAME "ACCESS-TAIL-SIZE"
               :QUALIFIER "CL-DS.COMMON.RRB")
            STRUCTURE)
           TAIL-CHANGE)
          (IF (#S(FORMGREP:SYMREF
                  :NAME "NULL-BUCKET-P"
                  :QUALIFIER "CL-DS.META")
               NEW-BUCKET)
              (SETF (AREF TAIL LAST-INDEX) NIL)
              (SETF (AREF TAIL LAST-INDEX) NEW-BUCKET))
          (WHEN (ZEROP (+ TAIL-SIZE TAIL-CHANGE))
            (SETF (#S(FORMGREP:SYMREF
                      :NAME "ACCESS-TAIL"
                      :QUALIFIER "CL-DS.COMMON.RRB")
                   STRUCTURE)
                    NIL))))
     (VALUES STRUCTURE RESULT-STATUS)))

[cl-data-structures/src/sequences/rrb/api.lisp:156]
  (DEFMETHOD #S(FORMGREP:SYMREF
                :NAME "POSITION-MODIFICATION"
                :QUALIFIER "CL-DS.META")
             (
              (OPERATION
               #S(FORMGREP:SYMREF
                  :NAME "GROW-FUNCTION"
                  :QUALIFIER "CL-DS.META"))
              (STRUCTURE MUTABLE-RRB-VECTOR) CONTAINER INDEX
              &REST REST
              &KEY VALUE &ALLOW-OTHER-KEYS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (SPACE 0) (DEBUG 0)))
    (BIND
     ((SIZE
       (#S(FORMGREP:SYMREF :NAME "ACCESS-SIZE" :QUALIFIER "CL-DS.COMMON.RRB")
        STRUCTURE))
      (RESULT-STATUS NIL)
      (LAST-INDEX
       (LDB
        (BYTE
         #S(FORMGREP:SYMREF :NAME "+BIT-COUNT+" :QUALIFIER "CL-DS.COMMON.RRB")
         0)
        INDEX))
      ((:DFLET CHANGE-BUCKET (BUCKET))
       (MULTIPLE-VALUE-BIND (NODE STATUS)
           (APPLY
            #'#S(FORMGREP:SYMREF :NAME "ALTER-BUCKET!" :QUALIFIER "CL-DS.META")
            CONTAINER OPERATION VALUE BUCKET REST)
         (UNLESS
             (#S(FORMGREP:SYMREF :NAME "CHANGED" :QUALIFIER "CL-DS") STATUS)
           (RETURN-FROM
               #S(FORMGREP:SYMREF
                  :NAME "POSITION-MODIFICATION"
                  :QUALIFIER "CL-DS.META")
             (VALUES STRUCTURE STATUS)))
         (SETF RESULT-STATUS STATUS)
         NODE)))
     (UNLESS
         (> (#S(FORMGREP:SYMREF :NAME "SIZE" :QUALIFIER "CL-DS") STRUCTURE)
            INDEX)
       (ERROR
        '#S(FORMGREP:SYMREF
            :NAME "ARGUMENT-VALUE-OUT-OF-BOUNDS"
            :QUALIFIER "CL-DS")
        :ARGUMENT 'INDEX :BOUNDS
        (LIST 0
              (#S(FORMGREP:SYMREF :NAME "SIZE" :QUALIFIER "CL-DS") STRUCTURE))
        :VALUE INDEX :FORMAT-CONTROL "Index out of range."))
     (IF (< INDEX SIZE)
         (LET* ((NODE
                 (ITERATE
                  (WITH SHIFT =
                   (#S(FORMGREP:SYMREF
                       :NAME "ACCESS-SHIFT"
                       :QUALIFIER "CL-DS.COMMON.RRB")
                    STRUCTURE))
                  (REPEAT SHIFT)
                  (FOR POSITION FROM
                   (*
                    #S(FORMGREP:SYMREF
                       :NAME "+BIT-COUNT+"
                       :QUALIFIER "CL-DS.COMMON.RRB")
                    SHIFT)
                   DOWNTO 0 BY
                   #S(FORMGREP:SYMREF
                      :NAME "+BIT-COUNT+"
                      :QUALIFIER "CL-DS.COMMON.RRB"))
                  (FOR I =
                   (LDB
                    (BYTE
                     #S(FORMGREP:SYMREF
                        :NAME "+BIT-COUNT+"
                        :QUALIFIER "CL-DS.COMMON.RRB")
                     POSITION)
                    INDEX))
                  (FOR NODE INITIALLY
                   (#S(FORMGREP:SYMREF
                       :NAME "ACCESS-ROOT"
                       :QUALIFIER "CL-DS.COMMON.RRB")
                    STRUCTURE)
                   THEN
                   (#S(FORMGREP:SYMREF
                       :NAME "NREF"
                       :QUALIFIER "CL-DS.COMMON.RRB")
                    NODE I))
                  (FINALLY (RETURN NODE))))
                (LAST-ARRAY (RRB-NODE-CONTENT NODE))
                (BUCKET (CHANGE-BUCKET (AREF LAST-ARRAY LAST-INDEX))))
           (SETF (AREF LAST-ARRAY LAST-INDEX) BUCKET))
         (LET* ((OFFSET (- INDEX SIZE))
                (TAIL
                 (#S(FORMGREP:SYMREF
                     :NAME "ACCESS-TAIL"
                     :QUALIFIER "CL-DS.COMMON.RRB")
                  STRUCTURE))
                (BUCKET (CHANGE-BUCKET (AREF TAIL OFFSET))))
           (SETF (AREF TAIL OFFSET) BUCKET)))
     (VALUES STRUCTURE RESULT-STATUS)))

[cl-data-structures/src/sequences/rrb/api.lisp:207]
  (DEFMETHOD #S(FORMGREP:SYMREF
                :NAME "POSITION-MODIFICATION"
                :QUALIFIER "CL-DS.META")
             (
              (OPERATION
               #S(FORMGREP:SYMREF
                  :NAME "PUT!-FUNCTION"
                  :QUALIFIER "CL-DS.META"))
              CONTAINER (STRUCTURE MUTABLE-RRB-VECTOR) LOCATION
              &REST REST
              &KEY VALUE &ALLOW-OTHER-KEYS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 0) (SPACE 0)))
    (BIND
     ((TAIL-SIZE
       (#S(FORMGREP:SYMREF
           :NAME "ACCESS-TAIL-SIZE"
           :QUALIFIER "CL-DS.COMMON.RRB")
        STRUCTURE))
      (TAIL
       (#S(FORMGREP:SYMREF :NAME "ACCESS-TAIL" :QUALIFIER "CL-DS.COMMON.RRB")
        STRUCTURE))
      ((:VALUES NEW-BUCKET STATUS)
       (APPLY #'#S(FORMGREP:SYMREF :NAME "MAKE-BUCKET" :QUALIFIER "CL-DS.META")
              CONTAINER OPERATION VALUE REST)))
     (UNLESS (#S(FORMGREP:SYMREF :NAME "CHANGED" :QUALIFIER "CL-DS") STATUS)
       (RETURN-FROM
           #S(FORMGREP:SYMREF
              :NAME "POSITION-MODIFICATION"
              :QUALIFIER "CL-DS.META")
         (VALUES STRUCTURE STATUS)))
     (IF (EQL TAIL-SIZE +MAXIMUM-CHILDREN-COUNT+)
         (BIND
          ((NEW-TAIL
            (~> STRUCTURE
             #S(FORMGREP:SYMREF
                :NAME "READ-ELEMENT-TYPE"
                :QUALIFIER "CL-DS.COMMON.RRB")
             #S(FORMGREP:SYMREF
                :NAME "MAKE-NODE-CONTENT"
                :QUALIFIER "CL-DS.COMMON.RRB")))
           ((:VALUES NEW-ROOT SHIFT-INCREASED)
            (#S(FORMGREP:SYMREF
                :NAME "INSERT-TAIL"
                :QUALIFIER "CL-DS.COMMON.RRB")
             STRUCTURE
             (#S(FORMGREP:SYMREF
                 :NAME "READ-OWNERSHIP-TAG"
                 :QUALIFIER "CL-DS.COMMON.ABSTRACT")
              STRUCTURE)
             #'#S(FORMGREP:SYMREF
                  :NAME "DESTRUCTIVE-WRITE"
                  :QUALIFIER "CL-DS.COMMON.RRB")
             TAIL)))
          (SETF (AREF NEW-TAIL 0) NEW-BUCKET
                (#S(FORMGREP:SYMREF
                    :NAME "ACCESS-TAIL"
                    :QUALIFIER "CL-DS.COMMON.RRB")
                 STRUCTURE)
                  NEW-TAIL
                (#S(FORMGREP:SYMREF
                    :NAME "ACCESS-ROOT"
                    :QUALIFIER "CL-DS.COMMON.RRB")
                 STRUCTURE)
                  NEW-ROOT
                (#S(FORMGREP:SYMREF
                    :NAME "ACCESS-TAIL-SIZE"
                    :QUALIFIER "CL-DS.COMMON.RRB")
                 STRUCTURE)
                  1)
          (WHEN SHIFT-INCREASED
            (INCF
             (#S(FORMGREP:SYMREF
                 :NAME "ACCESS-SHIFT"
                 :QUALIFIER "CL-DS.COMMON.RRB")
              STRUCTURE)))
          (INCF
           (#S(FORMGREP:SYMREF
               :NAME "ACCESS-SIZE"
               :QUALIFIER "CL-DS.COMMON.RRB")
            STRUCTURE)
           +MAXIMUM-CHILDREN-COUNT+)
          (VALUES STRUCTURE STATUS))
         (PROGN
          (SETF TAIL
                  (OR TAIL
                      (#S(FORMGREP:SYMREF
                          :NAME "MAKE-NODE-CONTENT"
                          :QUALIFIER "CL-DS.COMMON.RRB")))
                (AREF TAIL TAIL-SIZE) NEW-BUCKET
                (#S(FORMGREP:SYMREF
                    :NAME "ACCESS-TAIL"
                    :QUALIFIER "CL-DS.COMMON.RRB")
                 STRUCTURE)
                  TAIL)
          (INCF
           (#S(FORMGREP:SYMREF
               :NAME "ACCESS-TAIL-SIZE"
               :QUALIFIER "CL-DS.COMMON.RRB")
            STRUCTURE))
          (VALUES STRUCTURE STATUS)))))

[cl-data-structures/src/sequences/rrb/api.lisp:247]
  (DEFMETHOD #S(FORMGREP:SYMREF
                :NAME "POSITION-MODIFICATION"
                :QUALIFIER "CL-DS.META")
             (
              (OPERATION
               #S(FORMGREP:SYMREF
                  :NAME "FUNCTIONAL-PUT-FUNCTION"
                  :QUALIFIER "CL-DS.META"))
              CONTAINER (STRUCTURE FUNCTIONAL-RRB-VECTOR) LOCATION
              &REST REST
              &KEY VALUE &ALLOW-OTHER-KEYS)
    (DECLARE (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 1)))
    (BIND
     ((TAIL-SIZE
       (#S(FORMGREP:SYMREF
           :NAME "ACCESS-TAIL-SIZE"
           :QUALIFIER "CL-DS.COMMON.RRB")
        STRUCTURE))
      (TAG NIL) (TAIL-CHANGE 1)
      ((:VALUES NEW-BUCKET STATUS)
       (APPLY #'#S(FORMGREP:SYMREF :NAME "MAKE-BUCKET" :QUALIFIER "CL-DS.META")
              CONTAINER OPERATION VALUE REST)))
     (UNLESS (#S(FORMGREP:SYMREF :NAME "CHANGED" :QUALIFIER "CL-DS") STATUS)
       (RETURN-FROM
           #S(FORMGREP:SYMREF
              :NAME "POSITION-MODIFICATION"
              :QUALIFIER "CL-DS.META")
         (VALUES STRUCTURE STATUS)))
     (IF (EQL TAIL-SIZE +MAXIMUM-CHILDREN-COUNT+)
         (BIND
          ((NEW-TAIL
            (~> STRUCTURE
             #S(FORMGREP:SYMREF
                :NAME "READ-ELEMENT-TYPE"
                :QUALIFIER "CL-DS.COMMON.RRB")
             #S(FORMGREP:SYMREF
                :NAME "MAKE-NODE-CONTENT"
                :QUALIFIER "CL-DS.COMMON.RRB")))
           ((:VALUES NEW-ROOT SHIFT-INCREASED)
            (#S(FORMGREP:SYMREF
                :NAME "INSERT-TAIL"
                :QUALIFIER "CL-DS.COMMON.RRB")
             STRUCTURE TAG
             #'#S(FORMGREP:SYMREF
                  :NAME "COPY-ON-WRITE"
                  :QUALIFIER "CL-DS.COMMON.RRB")
             (#S(FORMGREP:SYMREF
                 :NAME "ACCESS-TAIL"
                 :QUALIFIER "CL-DS.COMMON.RRB")
              STRUCTURE))))
          (SETF (AREF NEW-TAIL 0) NEW-BUCKET)
          (MAKE 'FUNCTIONAL-RRB-VECTOR :ROOT NEW-ROOT :TAIL NEW-TAIL
           :OWNERSHIP-TAG TAG :TAIL-SIZE TAIL-CHANGE :SIZE
           (+ +MAXIMUM-CHILDREN-COUNT+
              (#S(FORMGREP:SYMREF
                  :NAME "ACCESS-SIZE"
                  :QUALIFIER "CL-DS.COMMON.RRB")
               STRUCTURE))
           :TAIL NEW-TAIL :SHIFT
           (IF SHIFT-INCREASED
               (1+
                (#S(FORMGREP:SYMREF
                    :NAME "ACCESS-SHIFT"
                    :QUALIFIER "CL-DS.COMMON.RRB")
                 STRUCTURE))
               (#S(FORMGREP:SYMREF
                   :NAME "ACCESS-SHIFT"
                   :QUALIFIER "CL-DS.COMMON.RRB")
                STRUCTURE))))
         (VALUES
          (MAKE 'FUNCTIONAL-RRB-VECTOR :ROOT
           (#S(FORMGREP:SYMREF
               :NAME "ACCESS-ROOT"
               :QUALIFIER "CL-DS.COMMON.RRB")
            STRUCTURE)
           :TAIL
           (LET* ((TAIL
                   (#S(FORMGREP:SYMREF
                       :NAME "ACCESS-TAIL"
                       :QUALIFIER "CL-DS.COMMON.RRB")
                    STRUCTURE))
                  (NEW-TAIL
                   (IF (NULL TAIL)
                       (~> STRUCTURE
                        #S(FORMGREP:SYMREF
                           :NAME "READ-ELEMENT-TYPE"
                           :QUALIFIER "CL-DS.COMMON.RRB")
                        #S(FORMGREP:SYMREF
                           :NAME "MAKE-NODE-CONTENT"
                           :QUALIFIER "CL-DS.COMMON.RRB"))
                       (COPY-ARRAY TAIL))))
             (SETF (AREF NEW-TAIL TAIL-SIZE) NEW-BUCKET)
             NEW-TAIL)
           :OWNERSHIP-TAG TAG :TAIL-SIZE (+ TAIL-SIZE TAIL-CHANGE)
           :OWNERSHIP-TAG TAG :SIZE
           (#S(FORMGREP:SYMREF
               :NAME "ACCESS-SIZE"
               :QUALIFIER "CL-DS.COMMON.RRB")
            STRUCTURE)
           :SHIFT
           (#S(FORMGREP:SYMREF
               :NAME "ACCESS-SHIFT"
               :QUALIFIER "CL-DS.COMMON.RRB")
            STRUCTURE))
          STATUS))))

[cl-data-structures/src/sequences/rrb/api.lisp:303]
  (DEFMETHOD #S(FORMGREP:SYMREF
                :NAME "POSITION-MODIFICATION"
                :QUALIFIER "CL-DS.META")
             (
              (OPERATION
               #S(FORMGREP:SYMREF
                  :NAME "PUT!-FUNCTION"
                  :QUALIFIER "CL-DS.META"))
              CONTAINER (STRUCTURE TRANSACTIONAL-RRB-VECTOR) LOCATION
              &REST REST
              &KEY VALUE &ALLOW-OTHER-KEYS)
    (DECLARE (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 1)))
    (BIND
     ((TAIL-SIZE
       (#S(FORMGREP:SYMREF
           :NAME "ACCESS-TAIL-SIZE"
           :QUALIFIER "CL-DS.COMMON.RRB")
        STRUCTURE))
      (TAG
       (#S(FORMGREP:SYMREF
           :NAME "READ-OWNERSHIP-TAG"
           :QUALIFIER "CL-DS.COMMON.ABSTRACT")
        STRUCTURE))
      (TAIL-CHANGE 1)
      ((:VALUES NEW-BUCKET STATUS)
       (APPLY #'#S(FORMGREP:SYMREF :NAME "MAKE-BUCKET" :QUALIFIER "CL-DS.META")
              CONTAINER OPERATION VALUE REST)))
     (UNLESS (#S(FORMGREP:SYMREF :NAME "CHANGED" :QUALIFIER "CL-DS") STATUS)
       (RETURN-FROM
           #S(FORMGREP:SYMREF
              :NAME "POSITION-MODIFICATION"
              :QUALIFIER "CL-DS.META")
         (VALUES STRUCTURE STATUS)))
     (IF (EQL TAIL-SIZE +MAXIMUM-CHILDREN-COUNT+)
         (BIND
          ((NEW-TAIL
            (~> STRUCTURE
             #S(FORMGREP:SYMREF
                :NAME "READ-ELEMENT-TYPE"
                :QUALIFIER "CL-DS.COMMON.RRB")
             #S(FORMGREP:SYMREF
                :NAME "MAKE-NODE-CONTENT"
                :QUALIFIER "CL-DS.COMMON.RRB")))
           ((:VALUES NEW-ROOT SHIFT-INCREASED)
            (#S(FORMGREP:SYMREF
                :NAME "INSERT-TAIL"
                :QUALIFIER "CL-DS.COMMON.RRB")
             STRUCTURE TAG
             #'#S(FORMGREP:SYMREF
                  :NAME "TRANSACTIONAL-COPY-ON-WRITE"
                  :QUALIFIER "CL-DS.COMMON.RRB")
             (#S(FORMGREP:SYMREF
                 :NAME "ACCESS-TAIL"
                 :QUALIFIER "CL-DS.COMMON.RRB")
              STRUCTURE))))
          (SETF (AREF NEW-TAIL 0) NEW-BUCKET)
          (SETF (#S(FORMGREP:SYMREF
                    :NAME "ACCESS-ROOT"
                    :QUALIFIER "CL-DS.COMMON.RRB")
                 STRUCTURE)
                  NEW-ROOT
                (#S(FORMGREP:SYMREF
                    :NAME "ACCESS-TAIL"
                    :QUALIFIER "CL-DS.COMMON.RRB")
                 STRUCTURE)
                  NEW-TAIL
                (#S(FORMGREP:SYMREF
                    :NAME "ACCESS-TAIL-SIZE"
                    :QUALIFIER "CL-DS.COMMON.RRB")
                 STRUCTURE)
                  TAIL-CHANGE
                (#S(FORMGREP:SYMREF
                    :NAME "ACCESS-SIZE"
                    :QUALIFIER "CL-DS.COMMON.RRB")
                 STRUCTURE)
                  (+ +MAXIMUM-CHILDREN-COUNT+
                     (#S(FORMGREP:SYMREF
                         :NAME "ACCESS-SIZE"
                         :QUALIFIER "CL-DS.COMMON.RRB")
                      STRUCTURE))
                (#S(FORMGREP:SYMREF
                    :NAME "ACCESS-SHIFT"
                    :QUALIFIER "CL-DS.COMMON.RRB")
                 STRUCTURE)
                  (IF SHIFT-INCREASED
                      (1+
                       (#S(FORMGREP:SYMREF
                           :NAME "ACCESS-SHIFT"
                           :QUALIFIER "CL-DS.COMMON.RRB")
                        STRUCTURE))
                      (#S(FORMGREP:SYMREF
                          :NAME "ACCESS-SHIFT"
                          :QUALIFIER "CL-DS.COMMON.RRB")
                       STRUCTURE))))
         (SETF (#S(FORMGREP:SYMREF
                   :NAME "ACCESS-TAIL"
                   :QUALIFIER "CL-DS.COMMON.RRB")
                STRUCTURE)
                 (LET* ((TAIL
                         (#S(FORMGREP:SYMREF
                             :NAME "ACCESS-TAIL"
                             :QUALIFIER "CL-DS.COMMON.RRB")
                          STRUCTURE))
                        (NEW-TAIL
                         (OR TAIL
                             (~> STRUCTURE
                              #S(FORMGREP:SYMREF
                                 :NAME "READ-ELEMENT-TYPE"
                                 :QUALIFIER "CL-DS.COMMON.RRB")
                              #S(FORMGREP:SYMREF
                                 :NAME "MAKE-NODE-CONTENT"
                                 :QUALIFIER "CL-DS.COMMON.RRB")))))
                   (SETF (AREF NEW-TAIL TAIL-SIZE) NEW-BUCKET)
                   NEW-TAIL)
               (#S(FORMGREP:SYMREF
                   :NAME "ACCESS-TAIL-SIZE"
                   :QUALIFIER "CL-DS.COMMON.RRB")
                STRUCTURE)
                 (+ TAIL-SIZE TAIL-CHANGE)))
     (VALUES STRUCTURE STATUS)))

[cl-data-structures/src/sequences/rrb/api.lisp:350]
  (DEFMETHOD #S(FORMGREP:SYMREF
                :NAME "POSITION-MODIFICATION"
                :QUALIFIER "CL-DS.META")
             (
              (OPERATION
               #S(FORMGREP:SYMREF
                  :NAME "TAKE-OUT-FUNCTION"
                  :QUALIFIER "CL-DS.META"))
              CONTAINER (STRUCTURE FUNCTIONAL-RRB-VECTOR) LOCATION
              &REST REST
              &KEY &ALLOW-OTHER-KEYS)
    (DECLARE (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 1) (DEBUG 0)))
    (BIND
     ((TAIL-SIZE
       (#S(FORMGREP:SYMREF
           :NAME "ACCESS-TAIL-SIZE"
           :QUALIFIER "CL-DS.COMMON.RRB")
        STRUCTURE))
      (TAG NIL) (RESULT-STATUS NIL) (TAIL-CHANGE 0)
      ((:DFLET SHRINK-BUCKET (BUCKET))
       (MULTIPLE-VALUE-BIND (BUCKET STATUS)
           (APPLY
            #'#S(FORMGREP:SYMREF :NAME "ALTER-BUCKET" :QUALIFIER "CL-DS.META")
            CONTAINER OPERATION LOCATION BUCKET REST)
         (SETF RESULT-STATUS STATUS)
         (UNLESS
             (#S(FORMGREP:SYMREF :NAME "CHANGED" :QUALIFIER "CL-DS") STATUS)
           (RETURN-FROM
               #S(FORMGREP:SYMREF
                  :NAME "POSITION-MODIFICATION"
                  :QUALIFIER "CL-DS.META")
             (VALUES STRUCTURE STATUS)))
         (WHEN
             (#S(FORMGREP:SYMREF :NAME "NULL-BUCKET-P" :QUALIFIER "CL-DS.META")
              BUCKET)
           (DECF TAIL-CHANGE))
         BUCKET)))
     (VALUES
      (IF (ZEROP TAIL-SIZE)
          (IF (ZEROP
               (#S(FORMGREP:SYMREF
                   :NAME "ACCESS-SIZE"
                   :QUALIFIER "CL-DS.COMMON.RRB")
                STRUCTURE))
              (ERROR
               '#S(FORMGREP:SYMREF :NAME "EMPTY-CONTAINER" :QUALIFIER "CL-DS")
               :FORMAT-CONTROL "Can't take-out from empty container.")
              (BIND
               (((:VALUES NEW-ROOT TAIL SHIFT-DECREASED)
                 (#S(FORMGREP:SYMREF
                     :NAME "REMOVE-TAIL"
                     :QUALIFIER "CL-DS.COMMON.RRB")
                  STRUCTURE))
                (NEW-SHIFT
                 (IF SHIFT-DECREASED
                     (1-
                      (#S(FORMGREP:SYMREF
                          :NAME "ACCESS-SHIFT"
                          :QUALIFIER "CL-DS.COMMON.RRB")
                       STRUCTURE))
                     (#S(FORMGREP:SYMREF
                         :NAME "ACCESS-SHIFT"
                         :QUALIFIER "CL-DS.COMMON.RRB")
                      STRUCTURE)))
                (NEW-SIZE
                 (MAX 0
                      (-
                       (#S(FORMGREP:SYMREF
                           :NAME "ACCESS-SIZE"
                           :QUALIFIER "CL-DS.COMMON.RRB")
                        STRUCTURE)
                       #S(FORMGREP:SYMREF
                          :NAME "+MAXIMUM-CHILDREN-COUNT+"
                          :QUALIFIER "CL-DS.COMMON.RRB"))))
                (NEW-TAIL TAIL)
                (TAIL-SIZE
                 (IF (NULL NEW-ROOT)
                     (#S(FORMGREP:SYMREF
                         :NAME "ACCESS-SIZE"
                         :QUALIFIER "CL-DS.COMMON.RRB")
                      STRUCTURE)
                     #S(FORMGREP:SYMREF
                        :NAME "+MAXIMUM-CHILDREN-COUNT+"
                        :QUALIFIER "CL-DS.COMMON.RRB")))
                (NEW-BUCKET
                 (~> NEW-TAIL
                  (AREF
                   (1-
                    #S(FORMGREP:SYMREF
                       :NAME "+MAXIMUM-CHILDREN-COUNT+"
                       :QUALIFIER "CL-DS.COMMON.RRB")))
                  SHRINK-BUCKET)))
               (COND
                ((AND
                  (#S(FORMGREP:SYMREF
                      :NAME "NULL-BUCKET-P"
                      :QUALIFIER "CL-DS.META")
                   NEW-BUCKET)
                  (ZEROP TAIL-SIZE))
                 (SETF NEW-TAIL NIL))
                ((~> NEW-BUCKET
                  #S(FORMGREP:SYMREF
                     :NAME "NULL-BUCKET-P"
                     :QUALIFIER "CL-DS.META")
                  NOT)
                 (SETF NEW-TAIL (COPY-ARRAY NEW-TAIL)
                       (AREF NEW-TAIL (1- TAIL-SIZE)) NEW-BUCKET))
                (T
                 (SETF NEW-TAIL (COPY-ARRAY NEW-TAIL)
                       (AREF NEW-TAIL (1- TAIL-SIZE)) NIL)))
               (ASSERT (OR NEW-ROOT NEW-TAIL (ZEROP NEW-SIZE)))
               (ASSERT (<= 0 TAIL-SIZE +MAXIMUM-CHILDREN-COUNT+))
               (MAKE 'FUNCTIONAL-RRB-VECTOR :ROOT NEW-ROOT :TAIL NEW-TAIL
                :OWNERSHIP-TAG TAG :TAIL-SIZE (+ TAIL-SIZE TAIL-CHANGE) :SIZE
                NEW-SIZE :SHIFT NEW-SHIFT)))
          (MAKE 'FUNCTIONAL-RRB-VECTOR :ROOT
           (#S(FORMGREP:SYMREF
               :NAME "ACCESS-ROOT"
               :QUALIFIER "CL-DS.COMMON.RRB")
            STRUCTURE)
           :TAIL
           (LET* ((TAIL
                   (#S(FORMGREP:SYMREF
                       :NAME "ACCESS-TAIL"
                       :QUALIFIER "CL-DS.COMMON.RRB")
                    STRUCTURE))
                  (NEW-BUCKET (SHRINK-BUCKET (AREF TAIL (1- TAIL-SIZE))))
                  (NEW-SIZE (+ TAIL-SIZE TAIL-CHANGE)))
             (IF (ZEROP NEW-SIZE)
                 (SETF TAIL NIL)
                 (SETF TAIL (COPY-ARRAY TAIL)
                       (AREF TAIL (1- TAIL-SIZE))
                         (AND
                          (NOT
                           (#S(FORMGREP:SYMREF
                               :NAME "NULL-BUCKET-P"
                               :QUALIFIER "CL-DS.META")
                            NEW-BUCKET))
                          NEW-BUCKET)))
             TAIL)
           :OWNERSHIP-TAG TAG :TAIL-SIZE
           (LET ((S (+ TAIL-SIZE TAIL-CHANGE)))
             (ASSERT (<= 0 S +MAXIMUM-CHILDREN-COUNT+))
             S)
           :OWNERSHIP-TAG TAG :SIZE
           (#S(FORMGREP:SYMREF
               :NAME "ACCESS-SIZE"
               :QUALIFIER "CL-DS.COMMON.RRB")
            STRUCTURE)
           :SHIFT
           (#S(FORMGREP:SYMREF
               :NAME "ACCESS-SHIFT"
               :QUALIFIER "CL-DS.COMMON.RRB")
            STRUCTURE)))
      RESULT-STATUS)))

[cl-data-structures/src/sequences/rrb/api.lisp:430]
  (DEFMETHOD #S(FORMGREP:SYMREF
                :NAME "POSITION-MODIFICATION"
                :QUALIFIER "CL-DS.META")
             (
              (OPERATION
               #S(FORMGREP:SYMREF
                  :NAME "GROW-FUNCTION"
                  :QUALIFIER "CL-DS.META"))
              CONTAINER (STRUCTURE TRANSACTIONAL-RRB-VECTOR) INDEX
              &REST REST
              &KEY VALUE &ALLOW-OTHER-KEYS)
    (DECLARE (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 1) (DEBUG 0)))
    (BIND
     ((TAG
       (#S(FORMGREP:SYMREF
           :NAME "READ-OWNERSHIP-TAG"
           :QUALIFIER "CL-DS.COMMON.ABSTRACT")
        STRUCTURE))
      (SHIFT
       (#S(FORMGREP:SYMREF :NAME "ACCESS-SHIFT" :QUALIFIER "CL-DS.COMMON.RRB")
        STRUCTURE))
      (SIZE
       (#S(FORMGREP:SYMREF :NAME "ACCESS-SIZE" :QUALIFIER "CL-DS.COMMON.RRB")
        STRUCTURE))
      (ROOT
       (#S(FORMGREP:SYMREF :NAME "ACCESS-ROOT" :QUALIFIER "CL-DS.COMMON.RRB")
        STRUCTURE))
      (RESULT-STATUS NIL)
      ((:DFLET CHANGE-BUCKET (BUCKET))
       (MULTIPLE-VALUE-BIND (NODE STATUS)
           (APPLY
            #'#S(FORMGREP:SYMREF :NAME "ALTER-BUCKET" :QUALIFIER "CL-DS.META")
            CONTAINER OPERATION VALUE BUCKET INDEX REST)
         (UNLESS
             (#S(FORMGREP:SYMREF :NAME "CHANGED" :QUALIFIER "CL-DS") STATUS)
           (RETURN-FROM
               #S(FORMGREP:SYMREF
                  :NAME "POSITION-MODIFICATION"
                  :QUALIFIER "CL-DS.META")
             (VALUES STRUCTURE STATUS)))
         (SETF RESULT-STATUS STATUS)
         NODE)))
     (UNLESS
         (> (#S(FORMGREP:SYMREF :NAME "SIZE" :QUALIFIER "CL-DS") STRUCTURE)
            INDEX)
       (ERROR
        '#S(FORMGREP:SYMREF
            :NAME "ARGUMENT-VALUE-OUT-OF-BOUNDS"
            :QUALIFIER "CL-DS")
        :ARGUMENT 'INDEX :BOUNDS
        (LIST 0
              (#S(FORMGREP:SYMREF :NAME "SIZE" :QUALIFIER "CL-DS") STRUCTURE))
        :VALUE INDEX :FORMAT-CONTROL "Index out of range."))
     (IF (< INDEX SIZE)
         (BIND
          (((:DFLET CONT (PATH INDEXES SHIFT &AUX (SHIFT (1- SHIFT))))
            (ITERATE
             (WITH OWNED-DEPTH =
              (ITERATE (FOR I FROM 0 BELOW SHIFT) (FOR NODE = (AREF PATH I))
               (WHILE
                (#S(FORMGREP:SYMREF
                    :NAME "ACQUIRE-OWNERSHIP"
                    :QUALIFIER "CL-DS.COMMON.ABSTRACT")
                 NODE TAG))
               (FINALLY (RETURN I))))
             (FOR I FROM SHIFT DOWNTO 0) (FOR POSITION = (AREF INDEXES I))
             (FOR OLD-NODE = (AREF PATH I))
             (FOR NODE INITIALLY
              (LET* ((BUCKET
                      (#S(FORMGREP:SYMREF
                          :NAME "NREF"
                          :QUALIFIER "CL-DS.COMMON.RRB")
                       (AREF PATH SHIFT) (AREF INDEX SHIFT)))
                     (NEXT-VALUE (CHANGE-BUCKET BUCKET))
                     (CONTENT
                      (IF (EQL SHIFT OWNED-DEPTH)
                          (AREF PATH SHIFT)
                          (COPY-ARRAY (RRB-NODE-CONTENT (AREF PATH SHIFT))))))
                (SETF (AREF CONTENT (AREF INDEX SHIFT)) NEXT-VALUE)
                (IF (EQL SHIFT OWNED-DEPTH)
                    (AREF PATH SHIFT)
                    (#S(FORMGREP:SYMREF
                        :NAME "MAKE-RRB-NODE"
                        :QUALIFIER "CL-DS.COMMON.RRB")
                     :OWNERSHIP-TAG TAG :CONTENT CONTENT)))
              THEN
              (IF (< I OWNED-DEPTH)
                  (#S(FORMGREP:SYMREF
                      :NAME "RRB-NODE-PUSH!"
                      :QUALIFIER "CL-DS.COMMON.RRB")
                   OLD-NODE POSITION NODE)
                  (#S(FORMGREP:SYMREF
                      :NAME "RRB-NODE-PUSH-INTO-COPY"
                      :QUALIFIER "CL-DS.COMMON.RRB")
                   OLD-NODE POSITION NODE TAG)))
             (FINALLY (RETURN NODE))))
           (NEW-ROOT
            (IF (ZEROP SHIFT)
                (#S(FORMGREP:SYMREF
                    :NAME "RRB-NODE-PUSH-INTO-COPY"
                    :QUALIFIER "CL-DS.COMMON.RRB")
                 ROOT INDEX
                 (CHANGE-BUCKET
                  (#S(FORMGREP:SYMREF
                      :NAME "NREF"
                      :QUALIFIER "CL-DS.COMMON.RRB")
                   ROOT INDEX))
                 TAG)
                (#S(FORMGREP:SYMREF
                    :NAME "DESCEND-INTO-TREE"
                    :QUALIFIER "CL-DS.COMMON.RRB")
                 STRUCTURE INDEX #'CONT))))
          (SETF (#S(FORMGREP:SYMREF
                    :NAME "ACCESS-ROOT"
                    :QUALIFIER "CL-DS.COMMON.RRB")
                 STRUCTURE)
                  NEW-ROOT))
         (LET* ((TAIL
                 (~> STRUCTURE
                  #S(FORMGREP:SYMREF
                     :NAME "ACCESS-TAIL"
                     :QUALIFIER "CL-DS.COMMON.RRB")))
                (OFFSET (- INDEX SIZE)))
           (SETF (AREF TAIL OFFSET) (CHANGE-BUCKET (AREF TAIL OFFSET)))))
     (VALUES STRUCTURE RESULT-STATUS)))

[cl-data-structures/src/sequences/rrb/api.lisp:510]
  (DEFMETHOD #S(FORMGREP:SYMREF
                :NAME "POSITION-MODIFICATION"
                :QUALIFIER "CL-DS.META")
             (
              (OPERATION
               #S(FORMGREP:SYMREF
                  :NAME "GROW-FUNCTION"
                  :QUALIFIER "CL-DS.META"))
              CONTAINER (STRUCTURE FUNCTIONAL-RRB-VECTOR) INDEX
              &REST REST
              &KEY VALUE &ALLOW-OTHER-KEYS)
    (DECLARE (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 1) (DEBUG 0)))
    (BIND
     ((TAIL-SIZE
       (#S(FORMGREP:SYMREF
           :NAME "ACCESS-TAIL-SIZE"
           :QUALIFIER "CL-DS.COMMON.RRB")
        STRUCTURE))
      (TAG NIL)
      (SHIFT
       (#S(FORMGREP:SYMREF :NAME "ACCESS-SHIFT" :QUALIFIER "CL-DS.COMMON.RRB")
        STRUCTURE))
      (SIZE
       (#S(FORMGREP:SYMREF :NAME "ACCESS-SIZE" :QUALIFIER "CL-DS.COMMON.RRB")
        STRUCTURE))
      (ROOT
       (#S(FORMGREP:SYMREF :NAME "ACCESS-ROOT" :QUALIFIER "CL-DS.COMMON.RRB")
        STRUCTURE))
      (RESULT-STATUS NIL)
      ((:DFLET CHANGE-BUCKET (BUCKET))
       (MULTIPLE-VALUE-BIND (NODE STATUS)
           (APPLY
            #'#S(FORMGREP:SYMREF :NAME "ALTER-BUCKET" :QUALIFIER "CL-DS.META")
            CONTAINER OPERATION VALUE BUCKET REST)
         (UNLESS
             (#S(FORMGREP:SYMREF :NAME "CHANGED" :QUALIFIER "CL-DS") STATUS)
           (RETURN-FROM
               #S(FORMGREP:SYMREF
                  :NAME "POSITION-MODIFICATION"
                  :QUALIFIER "CL-DS.META")
             (VALUES STRUCTURE STATUS)))
         (SETF RESULT-STATUS STATUS)
         NODE)))
     (UNLESS
         (> (#S(FORMGREP:SYMREF :NAME "SIZE" :QUALIFIER "CL-DS") STRUCTURE)
            INDEX)
       (ERROR
        '#S(FORMGREP:SYMREF
            :NAME "ARGUMENT-VALUE-OUT-OF-BOUNDS"
            :QUALIFIER "CL-DS")
        :ARGUMENT 'INDEX :BOUNDS
        (LIST 0
              (#S(FORMGREP:SYMREF :NAME "SIZE" :QUALIFIER "CL-DS") STRUCTURE))
        :VALUE INDEX :FORMAT-CONTROL "Index out of range."))
     (VALUES
      (IF (< INDEX SIZE)
          (BIND
           (((:DFLET CONT (PATH INDEXES SHIFT &AUX (SHIFT (1- SHIFT))))
             (ITERATE (FOR I FROM SHIFT DOWNTO 0)
              (FOR POSITION = (AREF INDEXES I)) (FOR OLD-NODE = (AREF PATH I))
              (FOR NODE INITIALLY
               (LET* ((BUCKET
                       (#S(FORMGREP:SYMREF
                           :NAME "NREF"
                           :QUALIFIER "CL-DS.COMMON.RRB")
                        (AREF PATH SHIFT) (AREF INDEX SHIFT)))
                      (NEXT-VALUE (CHANGE-BUCKET BUCKET))
                      (CONTENT
                       (COPY-ARRAY (RRB-NODE-CONTENT (AREF PATH SHIFT)))))
                 (SETF (AREF CONTENT (AREF INDEX SHIFT)) NEXT-VALUE)
                 (#S(FORMGREP:SYMREF
                     :NAME "MAKE-RRB-NODE"
                     :QUALIFIER "CL-DS.COMMON.RRB")
                  :OWNERSHIP-TAG TAG :CONTENT CONTENT))
               THEN
               (#S(FORMGREP:SYMREF
                   :NAME "RRB-NODE-PUSH-INTO-COPY"
                   :QUALIFIER "CL-DS.COMMON.RRB")
                OLD-NODE POSITION NODE TAG))
              (FINALLY (RETURN NODE))))
            (NEW-ROOT
             (IF (ZEROP SHIFT)
                 (#S(FORMGREP:SYMREF
                     :NAME "RRB-NODE-PUSH-INTO-COPY"
                     :QUALIFIER "CL-DS.COMMON.RRB")
                  ROOT INDEX
                  (CHANGE-BUCKET
                   (#S(FORMGREP:SYMREF
                       :NAME "NREF"
                       :QUALIFIER "CL-DS.COMMON.RRB")
                    ROOT INDEX))
                  TAG)
                 (#S(FORMGREP:SYMREF
                     :NAME "DESCEND-INTO-TREE"
                     :QUALIFIER "CL-DS.COMMON.RRB")
                  STRUCTURE INDEX #'CONT)))
            ((:ACCESSORS
              (TAIL
               #S(FORMGREP:SYMREF
                  :NAME "ACCESS-TAIL"
                  :QUALIFIER "CL-DS.COMMON.RRB"))
              (SHIFT
               #S(FORMGREP:SYMREF
                  :NAME "ACCESS-SHIFT"
                  :QUALIFIER "CL-DS.COMMON.RRB")))
             STRUCTURE))
           (MAKE 'FUNCTIONAL-RRB-VECTOR :ROOT NEW-ROOT :TAIL TAIL :SHIFT SHIFT
            :OWNERSHIP-TAG TAG :TAIL-SIZE TAIL-SIZE :SIZE SIZE))
          (MAKE 'FUNCTIONAL-RRB-VECTOR :ROOT
           (#S(FORMGREP:SYMREF
               :NAME "ACCESS-ROOT"
               :QUALIFIER "CL-DS.COMMON.RRB")
            STRUCTURE)
           :TAIL
           (LET* ((NEW-TAIL
                   (~> STRUCTURE
                    #S(FORMGREP:SYMREF
                       :NAME "ACCESS-TAIL"
                       :QUALIFIER "CL-DS.COMMON.RRB")
                    COPY-ARRAY))
                  (OFFSET (- INDEX SIZE)))
             (SETF (AREF NEW-TAIL OFFSET)
                     (CHANGE-BUCKET (AREF NEW-TAIL OFFSET)))
             NEW-TAIL)
           :OWNERSHIP-TAG TAG :TAIL-SIZE TAIL-SIZE :OWNERSHIP-TAG TAG :SIZE
           SIZE :SHIFT
           (#S(FORMGREP:SYMREF
               :NAME "ACCESS-SHIFT"
               :QUALIFIER "CL-DS.COMMON.RRB")
            STRUCTURE)))
      RESULT-STATUS)))

[cl-data-structures/src/streaming-algorithms/approximated-counts.lisp:142]
  (DEFUN APPROXIMATED-COUNTS-DISTANCE (A-SKETCH B-SKETCH)
    (CHECK-TYPE A-SKETCH APPROXIMATED-COUNTS)
    (CHECK-TYPE B-SKETCH APPROXIMATED-COUNTS)
    (ASSERT (COMPATIBLEP A-SKETCH B-SKETCH) (A-SKETCH B-SKETCH)
            (MAKE-CONDITION
             '#S(FORMGREP:SYMREF
                 :NAME "INCOMPATIBLE-ARGUMENTS"
                 :QUALIFIER "CL-DS")
             :PARAMETERS '(A-SKETCH B-SKETCH) :VALUES
             (ECLECTOR.READER:QUASIQUOTE
              ((ECLECTOR.READER:UNQUOTE A-SKETCH)
               (ECLECTOR.READER:UNQUOTE B-SKETCH)))
             :FORMAT-CONTROL
             "Sketches passed to the count-min-sketches-distance are not compatible."))
    (FLET ((COUNTER-MEAN (COUNTER LINE)
             (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
                      (TYPE (SIMPLE-ARRAY NON-NEGATIVE-FIXNUM (* *)) COUNTER)
                      (TYPE FIXNUM LINE))
             (ITERATE (DECLARE (TYPE FIXNUM I LENGTH TOTAL)) (WITH TOTAL = 0)
              (WITH LENGTH = (ARRAY-DIMENSION COUNTER 1))
              (FOR I FROM 0 BELOW LENGTH) (INCF TOTAL (AREF COUNTER LINE I))
              (FINALLY (RETURN (COERCE (/ TOTAL LENGTH) 'SINGLE-FLOAT))))))
      (ITERATE
       (DECLARE
        (TYPE (SIMPLE-ARRAY NON-NEGATIVE-FIXNUM (* *)) A-COUNTERS B-COUNTERS)
        (TYPE FIXNUM I)
        (OPTIMIZE (SPEED 3) (SAFETY 0)))
       (WITH A-COUNTERS = (ACCESS-COUNTERS A-SKETCH))
       (WITH B-COUNTERS = (ACCESS-COUNTERS B-SKETCH))
       (WITH LINE-SIZE = (ARRAY-DIMENSION A-COUNTERS 1))
       (FOR I FROM 0 BELOW (ARRAY-DIMENSION A-COUNTERS 0))
       (FOR SCORE =
        (ITERATE
         (DECLARE (TYPE FIXNUM J)
                  (TYPE NON-NEGATIVE-FIXNUM A B))
         (FOR J FROM 0 BELOW LINE-SIZE) (FOR A = (AREF A-COUNTERS I J))
         (FOR B = (AREF B-COUNTERS I J)) (SUM (SQRT (* A B)))))
       (FOR A-MEAN = (COUNTER-MEAN A-COUNTERS I))
       (FOR B-MEAN = (COUNTER-MEAN B-COUNTERS I))
       (MAXIMIZE
        (~>> (* A-MEAN B-MEAN LINE-SIZE LINE-SIZE) SQRT (/ 1) (* SCORE) (- 1)
         SQRT (COERCE _ 'SINGLE-FLOAT))))))

[cl-data-structures/src/streaming-algorithms/approximated-set-cardinality.lisp:43]
  (#S(FORMGREP:SYMREF
      :NAME "DEFINE-AGGREGATION-FUNCTION"
      :QUALIFIER "CL-DS.ALG.META")
   APPROXIMATED-SET-CARDINALITY APPROXIMATED-SET-CARDINALITY-FUNCTION
   (:RANGE &KEY HASH-FN KEY DATA-SKETCH)
   (:RANGE &KEY (HASH-FN #'SXHASH) (KEY #'IDENTITY)
    (DATA-SKETCH
     (CLEAN-SKETCH #'APPROXIMATED-SET-CARDINALITY :HASH-FN HASH-FN)))
   (%DATA-SKETCH)
   ((CHECK-TYPE DATA-SKETCH APPROXIMATED-SET-CARDINALITY)
    (SETF %DATA-SKETCH
            (#S(FORMGREP:SYMREF :NAME "CLONE" :QUALIFIER "CL-DS")
             DATA-SKETCH)))
   ((ELEMENT)
    (BIND
     (((:SLOTS %HASH-FN %REGISTERS) %DATA-SKETCH)
      (HASH-FN (ENSURE-FUNCTION %HASH-FN))
      (HASH (LDB (BYTE 64 0) (FUNCALL HASH-FN ELEMENT))))
     (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 1) (SPACE 0)))
     (#S(FORMGREP:SYMREF :NAME "ADD-HASH" :QUALIFIER "HLL") %REGISTERS HASH)))
   (%DATA-SKETCH))

[cl-data-structures/src/streaming-algorithms/approximated-top-k.lisp:4]
  (DEFUN MOVE-UPDATED (VECTOR POSITION)
    (DECLARE
     (TYPE
      (#S(FORMGREP:SYMREF :NAME "EXTENDABLE-VECTOR" :QUALIFIER "CL-DS.UTILS")
       LIST)
      VECTOR)
     (TYPE FIXNUM POSITION)
     (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (ITERATE (DECLARE (TYPE FIXNUM I J)) (FOR I FROM POSITION DOWNTO 0)
     (FOR J FROM (1- POSITION) DOWNTO 0)
     (FOR FRONT-COUNT = (CDR (AREF VECTOR J)))
     (FOR BACK-COUNT = (CDR (AREF VECTOR I)))
     (IF (> (THE POSITIVE-FIXNUM BACK-COUNT) (THE POSITIVE-FIXNUM FRONT-COUNT))
         (ROTATEF (AREF VECTOR I) (AREF VECTOR J))
         (FINISH))
     (FINALLY (RETURN VECTOR))))

[cl-data-structures/src/streaming-algorithms/hyperloglog.lisp:48]
  (DEFUN BETA (EZ)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((ZL (LOG (1+ EZ))))
      (DECLARE (TYPE DOUBLE-FLOAT EZ)
               (TYPE (DOUBLE-FLOAT 0.0d0 *) ZL))
      (+ (* -0.370393911d0 EZ) (* 0.070471823d0 ZL)
         (* 0.17393686d0 (EXPT ZL 2)) (* 0.16339839d0 (EXPT ZL 3))
         (* -0.09237745d0 (EXPT ZL 4)) (* 0.03738027d0 (EXPT ZL 5))
         (* -0.005384159d0 (EXPT ZL 6)) (* 4.2419d-4 (EXPT ZL 7)))))

[cl-data-structures/src/streaming-algorithms/hyperloglog.lisp:73]
  (DEFUN REG-SUM-AND-ZEROES (REGISTERS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (ITERATE
     (DECLARE (TYPE FIXNUM I)
              (TYPE DOUBLE-FLOAT SUM EZ))
     (WITH SUM = 0.0d0) (WITH EZ = 0.0d0)
     (FOR I FROM 0 BELOW (LENGTH REGISTERS)) (FOR VAL = (AREF REGISTERS I))
     (FOR LZ = (LZ VAL)) (WHEN (ZEROP LZ) (INCF EZ))
     (INCF SUM (/ 1.0d0 (EXPT 2.0d0 LZ))) (FINALLY (RETURN (VALUES SUM EZ)))))

[cl-data-structures/src/streaming-algorithms/hyperloglog.lisp:144]
  (DEFUN EXPECTED-COLLISIONS (N M)
    (ITERATE
     (DECLARE (TYPE (DOUBLE-FLOAT 0.0d0) X B1 B2 POWER DEN B2D B1D PRX PRY)
              (TYPE FIXNUM I)
              (OPTIMIZE (SPEED 3) (SAFETY 0)))
     (FOR I FROM 1 TO +2Q+) (WITH DEN = 0.0d0) (WITH POWER = 0.0d0)
     (WITH B2D = 0.0d0) (WITH B1D = 0.0d0) (WITH PRX = 0.0d0)
     (WITH PRY = 0.0d0) (WITH X = 0.0d0) (WITH B1 = 0.0d0) (WITH B2 = 0.0d0)
     (SETF DEN (EXPT 2.0d0 POWER)
           POWER
             (+
              (IF (= I +2Q+)
                  (+ +P+ +R+ I -1)
                  (+ +P+ +R+ I))
              0.0d0))
     (ITERATE
      (DECLARE (TYPE FIXNUM J)
               (TYPE DOUBLE-FLOAT PRX PRY))
      (FOR J FROM 1 TO +2R+)
      (IF (NOT (= I +2Q+))
          (SETF B1 (/ (+ +2R+ J) DEN)
                B2 (/ (+ +2R+ J 1) DEN))
          (SETF B1 (/ J DEN)
                B2 (/ (1+ J) DEN)))
      (SETF B2D (- 1.0d0 B2)
            B1D (- 1.0d0 B1)
            PRX (- (EXPT B2D N) (EXPT B1D N))
            PRY (- (EXPT B2D M) (EXPT B1D M)))
      (INCF X (* PRX PRY)))
     (FINALLY (RETURN (+ 0.5d0 (* X +P+))))))

[cl-data-structures/src/streaming-algorithms/hyperloglog.lisp:198]
  (DEFUN JACCARD (A B)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((C 0) (N 0))
      (DECLARE (TYPE FIXNUM C N))
      (ITERATE
       (DECLARE (TYPE FIXNUM I)
                (TYPE REGISTER EA EB))
       (FOR I FROM 0 BELOW +M+) (FOR EA = (AREF A I)) (FOR EB = (AREF B I))
       (WHEN (AND (NOT (ZEROP EA)) (= EA EB)) (INCF C))
       (UNLESS (= EA EB 0) (INCF N)))
      (WHEN (= C 0) (RETURN-FROM JACCARD 1.0d0))
      (LET* ((C1 (CARDINALITY A))
             (C2 (CARDINALITY B))
             (EC (APPROXIMATED-EXPECTED-COLLISIONS C1 C2)))
        (DECLARE (TYPE DOUBLE-FLOAT C1 C2 EC))
        (IF (< C EC)
            1.0d0
            (- 1.0d0 (/ (- C EC) N))))))

[cl-data-structures/src/streaming-algorithms/minhash.lisp:60]
  (DEFMETHOD MINHASH-CORPUS-HASH-VALUE
             ((CORPUS POLYNOMIAL-CALLBACK-MINHASH) ELEMENT)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (LET* ((K (READ-K CORPUS))
           (HASH-ARRAY (READ-HASH-ARRAY CORPUS))
           (RESULT (MAKE-ARRAY K :ELEMENT-TYPE '(UNSIGNED-BYTE 64)))
           (HASH
            (FUNCALL (ENSURE-FUNCTION (READ-HASH-FUNCTION CORPUS)) ELEMENT)))
      (DECLARE (TYPE FIXNUM K))
      (ITERATE (DECLARE (TYPE FIXNUM I)) (FOR I FROM 0 BELOW K)
       (SETF (AREF RESULT I)
               (#S(FORMGREP:SYMREF :NAME "HASHVAL-NO-DEPTH" :QUALIFIER "PH")
                HASH-ARRAY I HASH))
       (FINALLY (RETURN RESULT)))))

[cl-data-structures/src/streaming-algorithms/minhash.lisp:74]
  (DEFMETHOD MINHASH-CORPUS-HASH-VALUE
             ((CORPUS SEEDS-CALLBACK-MINHASH) ELEMENT)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (LET* ((K (READ-K CORPUS))
           (SEEDS (READ-SEEDS CORPUS))
           (RESULT (MAKE-ARRAY K :ELEMENT-TYPE '(UNSIGNED-BYTE 64)))
           (FUNCTION (ENSURE-FUNCTION (READ-HASH-FUNCTION CORPUS))))
      (DECLARE (TYPE FIXNUM K)
               (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (*)) SEEDS))
      (ITERATE (DECLARE (TYPE FIXNUM I)) (FOR I FROM 0 BELOW K)
       (FOR SEED = (AREF SEEDS I)) (FOR HASH = (FUNCALL FUNCTION ELEMENT SEED))
       (SETF (AREF RESULT I) HASH) (FINALLY (RETURN RESULT)))))

[cl-data-structures/src/streaming-algorithms/minhash.lisp:91]
  (DEFMETHOD MINHASH-CORPUS-HASH-VALUE ((CORPUS XORS-CALLBACK-MINHASH) ELEMENT)
    (LET* ((K (READ-K CORPUS))
           (XORS (READ-XORS CORPUS))
           (RESULT (MAKE-ARRAY K :ELEMENT-TYPE '(UNSIGNED-BYTE 64)))
           (FUNCTION (ENSURE-FUNCTION (READ-HASH-FUNCTION CORPUS)))
           (HASH (FUNCALL FUNCTION ELEMENT)))
      (DECLARE (TYPE FIXNUM K)
               (TYPE (UNSIGNED-BYTE 64) HASH)
               (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (*)) XORS))
      (ITERATE
       (DECLARE (TYPE FIXNUM I)
                (TYPE (UNSIGNED-BYTE 64) XOR)
                (OPTIMIZE (SPEED 3) (SAFETY 0)))
       (FOR I FROM 0 BELOW K) (FOR XOR = (AREF XORS I))
       (SETF (AREF RESULT I) (LOGXOR XOR HASH)) (FINALLY (RETURN RESULT)))))

[cl-data-structures/src/streaming-algorithms/minhash.lisp:217]
  (DEFUN MINHASH-CORPUS-MINHASH (CORPUS ELEMENTS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 0)))
    (#S(FORMGREP:SYMREF :NAME "WITH-SLOTS-FOR" :QUALIFIER "CL-DS.UTILS")
     (CORPUS MINHASH-CORPUS)
     (BIND
      ((COUNT (THE FIXNUM (READ-K CORPUS))) (HASH-TABLE TABLE)
       (MINIS
        (MAKE-ARRAY COUNT :ELEMENT-TYPE '(UNSIGNED-BYTE 64) :INITIAL-ELEMENT
                    #S(FORMGREP:SYMREF :NAME "+MAX-64-BITS+" :QUALIFIER "PH")))
       ((:FLET IMPL (ELEMENT))
        (LET ((SUB
               (THE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (*))
                    (GETHASH ELEMENT HASH-TABLE))))
          (UNLESS (NULL SUB)
            (ITERATE (DECLARE (TYPE FIXNUM I)) (FOR I FROM 0 BELOW COUNT)
             (MINF (AREF MINIS I) (AREF SUB I)))))))
      (#S(FORMGREP:SYMREF :NAME "ACROSS" :QUALIFIER "CL-DS") ELEMENTS #'IMPL)
      MINIS)))

[cl-data-structures/src/streaming-algorithms/minhash.lisp:243]
  (DEFMETHOD MINHASH ((CORPUS FUNDAMENTAL-MINHASH) ELEMENTS)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 1)))
    (BIND
     ((COUNT (THE FIXNUM (READ-K CORPUS)))
      (MINIS
       (MAKE-ARRAY COUNT :ELEMENT-TYPE '(UNSIGNED-BYTE 64) :INITIAL-ELEMENT
                   #S(FORMGREP:SYMREF :NAME "+MAX-64-BITS+" :QUALIFIER "PH")))
      ((:FLET IMPL (ELEMENT))
       (LET ((SUB (MINHASH-CORPUS-HASH-VALUE CORPUS ELEMENT)))
         (DECLARE (TYPE (OR NULL (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (*))) SUB))
         (UNLESS (NULL SUB)
           (ITERATE (DECLARE (TYPE FIXNUM I)) (FOR I FROM 0 BELOW COUNT)
            (MINF (AREF MINIS I) (AREF SUB I)))))))
     (#S(FORMGREP:SYMREF :NAME "ACROSS" :QUALIFIER "CL-DS") ELEMENTS #'IMPL)
     MINIS))

[cl-data-structures/src/streaming-algorithms/minhash.lisp:260]
  (DEFMETHOD MINHASH ((CORPUS ONE-BIT-MINHASH) ELEMENTS)
    (BIND
     ((K (THE FIXNUM (READ-K CORPUS))) (RESULT-SIZE (TRUNCATE K 64))
      (RESULT (MAKE-ARRAY RESULT-SIZE :ELEMENT-TYPE '(UNSIGNED-BYTE 64)))
      (MINIS
       (MAKE-ARRAY K :ELEMENT-TYPE '(UNSIGNED-BYTE 64) :INITIAL-ELEMENT
                   #S(FORMGREP:SYMREF :NAME "+MAX-64-BITS+" :QUALIFIER "PH")))
      ((:FLET MINI-IMPL (X)) (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
       (ITERATE
        (DECLARE (TYPE FIXNUM I)
                 (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (*)) HASHES))
        (WITH HASHES = (MINHASH-CORPUS-HASH-VALUE CORPUS X))
        (FOR I FROM 0 BELOW K) (MINF (AREF MINIS I) (AREF HASHES I)))))
     (#S(FORMGREP:SYMREF :NAME "ACROSS" :QUALIFIER "CL-DS") ELEMENTS
      #'MINI-IMPL)
     (ITERATE
      (DECLARE (TYPE FIXNUM I ARRAY-INDEX)
               (OPTIMIZE (SPEED 3) (SAFETY 0))
               (TYPE (INTEGER 0 63) BIT-INDEX)
               (TYPE (UNSIGNED-BYTE 64) MIN))
      (WITH ARRAY-INDEX = 0) (WITH BIT-INDEX = 0) (FOR I FROM 0 BELOW K)
      (FOR MIN = (AREF MINIS I))
      (SETF (LDB (BYTE 1 BIT-INDEX) (AREF RESULT ARRAY-INDEX))
              (LDB (BYTE 1 0) MIN))
      (WHEN (= BIT-INDEX 63)
        (INCF ARRAY-INDEX)
        (SETF BIT-INDEX 0)
        (NEXT-ITERATION))
      (INCF BIT-INDEX))
     RESULT))

[cl-data-structures/src/streaming-algorithms/minhash.lisp:296]
  (DEFUN MINHASH-JACCARD/FIXNUM (A B)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (#S(FORMGREP:SYMREF :NAME "LOLOL" :QUALIFIER "CL-DS.UTILS") (A B)
     (CHECK-TYPE A (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (*)))
     (CHECK-TYPE B (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (*)))
     (UNLESS (= (LENGTH A) (LENGTH B))
       (ERROR
        '#S(FORMGREP:SYMREF :NAME "INCOMPATIBLE-ARGUMENTS" :QUALIFIER "CL-DS")
        :PARAMETERS '(A B) :VALUES (LIST A B) :FORMAT-CONTROL
        "Lengths of input vectors must be equal."))
     (ITERATE (DECLARE (TYPE FIXNUM I LEN RESULT)) (WITH LEN = (LENGTH A))
      (WITH RESULT = LEN) (FOR I FROM 0 BELOW LEN)
      (WHEN (= (AREF A I) (AREF B I)) (DECF RESULT))
      (FINALLY (RETURN RESULT)))))

[cl-data-structures/src/streaming-algorithms/polynomial-hashing.lisp:28]
  (DEFUN HASHVAL-NO-DEPTH (HASHES J HASH)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE HASH-ARRAY HASHES)
             (TYPE NON-NEGATIVE-FIXNUM J HASH))
    (~> (AREF HASHES J 0) (* HASH) (LDB (BYTE 32 0) _) (+ (AREF HASHES J 1))
     (LDB (BYTE 32 0) _) (REM +LONG-PRIME+)))

[cl-data-structures/src/threads/buffer-range.lisp:73]
  (DEFMETHOD #S(FORMGREP:SYMREF
                :NAME "AGGREGATOR-CONSTRUCTOR"
                :QUALIFIER "CL-DS.ALG.META")
             ((RANGE BUFFER-RANGE) OUTER-CONSTRUCTOR
              (FUNCTION
               #S(FORMGREP:SYMREF
                  :NAME "AGGREGATION-FUNCTION"
                  :QUALIFIER "CL-DS.ALG.META"))
              (ARGUMENTS LIST))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (COMPILATION-SPEED 0) (SPACE 0)))
    (BIND
     ((OUTER-FN (CALL-NEXT-METHOD))
      (CHUNK-SIZE (THE FIXNUM (READ-CHUNK-SIZE RANGE)))
      (MAXIMUM-QUEUE-SIZE (READ-MAXIMUM-QUEUE-SIZE RANGE))
      (QUEUE (LPARALLEL.QUEUE:MAKE-QUEUE :FIXED-CAPACITY MAXIMUM-QUEUE-SIZE))
      (ERROR-LOCK (BORDEAUX-THREADS:MAKE-LOCK "error lock")) (STORED-ERROR NIL)
      ((:FLET THREAD-FUNCTION NIL)
       (ITERATE (FOR CONS = (LPARALLEL.QUEUE:POP-QUEUE QUEUE))
        (UNTIL (NULL CONS)) (FOR (ELT . INNER) = CONS)
        (HANDLER-CASE
         (ITERATE (FOR E IN-VECTOR ELT)
          (#S(FORMGREP:SYMREF
              :NAME "PASS-TO-AGGREGATION"
              :QUALIFIER "CL-DS.ALG.META")
           INNER E))
         (ERROR (E)
                (BORDEAUX-THREADS:WITH-LOCK-HELD (ERROR-LOCK)
                  (SETF STORED-ERROR E)
                  (LEAVE))))))
      (AGGREGATE-THREAD NIL))
     (#S(FORMGREP:SYMREF
         :NAME "AGGREGATOR-CONSTRUCTOR"
         :QUALIFIER "CL-DS.ALG.META")
      (#S(FORMGREP:SYMREF :NAME "READ-ORIGINAL-RANGE" :QUALIFIER "CL-DS.ALG")
       RANGE)
      (#S(FORMGREP:SYMREF :NAME "LET-AGGREGATOR" :QUALIFIER "CL-DS.ALG.META")
       ((INNER
         (#S(FORMGREP:SYMREF
             :NAME "CALL-CONSTRUCTOR"
             :QUALIFIER "CL-DS.ALG.META")
          OUTER-FN))
        (CHUNK (MAKE-ARRAY CHUNK-SIZE :FILL-POINTER 0))
        ((:FLET PUSH-CHUNK NIL)
         (LPARALLEL.QUEUE:PUSH-QUEUE (CONS (COPY-ARRAY CHUNK) INNER) QUEUE)
         (SETF (FILL-POINTER CHUNK) 0)))
       ((ELEMENT)
        (BORDEAUX-THREADS:WITH-LOCK-HELD (ERROR-LOCK)
          (UNLESS (NULL STORED-ERROR) (ERROR STORED-ERROR))
          (WHEN (NULL AGGREGATE-THREAD)
            (SETF AGGREGATE-THREAD
                    (BORDEAUX-THREADS:MAKE-THREAD #'THREAD-FUNCTION :NAME
                                                  "Aggregation Thread"))))
        (UNLESS (< (FILL-POINTER CHUNK) CHUNK-SIZE) (PUSH-CHUNK))
        (VECTOR-PUSH-EXTEND ELEMENT CHUNK))
       ((BORDEAUX-THREADS:WITH-LOCK-HELD (ERROR-LOCK)
          (UNLESS (NULL STORED-ERROR) (ERROR STORED-ERROR)))
        (UNLESS (ZEROP (FILL-POINTER CHUNK)) (PUSH-CHUNK))
        (LPARALLEL.QUEUE:PUSH-QUEUE NIL QUEUE)
        (BORDEAUX-THREADS:JOIN-THREAD AGGREGATE-THREAD)
        (SETF AGGREGATE-THREAD NIL)
        (BORDEAUX-THREADS:WITH-LOCK-HELD (ERROR-LOCK)
          (UNLESS (NULL STORED-ERROR) (ERROR STORED-ERROR)))
        (#S(FORMGREP:SYMREF :NAME "EXTRACT-RESULT" :QUALIFIER "CL-DS.ALG.META")
         INNER))
       (WHEN AGGREGATE-THREAD
         (IGNORE-ERRORS (BORDEAUX-THREADS:DESTROY-THREAD AGGREGATE-THREAD)))
       (#S(FORMGREP:SYMREF :NAME "CLEANUP" :QUALIFIER "CL-DS.ALG.META") INNER))
      FUNCTION ARGUMENTS)))

[cl-data-structures/src/threads/parallel-multiplex.lisp:54]
  (DEFMETHOD #S(FORMGREP:SYMREF
                :NAME "AGGREGATOR-CONSTRUCTOR"
                :QUALIFIER "CL-DS.ALG.META")
             ((RANGE PARALLEL-FORWARD-MULTIPLEX-PROXY) OUTER-CONSTRUCTOR
              (FUNCTION
               #S(FORMGREP:SYMREF
                  :NAME "AGGREGATION-FUNCTION"
                  :QUALIFIER "CL-DS.ALG.META"))
              (ARGUMENTS LIST))
    (DECLARE
     (OPTIMIZE (SPEED 1) (SAFETY 2) (DEBUG 1) (COMPILATION-SPEED 0) (SPACE 0)))
    (BIND
     ((OUTER-FN
       (OR OUTER-CONSTRUCTOR
           (#S(FORMGREP:SYMREF
               :NAME "AGGREGATOR-CONSTRUCTOR"
               :QUALIFIER "CL-DS.ALG.META")
            'NIL NIL FUNCTION ARGUMENTS)))
      (MAXIMUM-QUEUE-SIZE (READ-MAXIMUM-QUEUE-SIZE RANGE))
      (FN
       (ENSURE-FUNCTION
        (#S(FORMGREP:SYMREF :NAME "READ-FUNCTION" :QUALIFIER "CL-DS.ALG")
         RANGE)))
      (KEY
       (ENSURE-FUNCTION
        (#S(FORMGREP:SYMREF :NAME "READ-KEY" :QUALIFIER "CL-DS.ALG") RANGE)))
      (CHUNK-SIZE (READ-CHUNK-SIZE RANGE))
      (QUEUE (LPARALLEL.QUEUE:MAKE-QUEUE :FIXED-CAPACITY MAXIMUM-QUEUE-SIZE))
      (RESULT-QUEUE (LPARALLEL.QUEUE:MAKE-QUEUE))
      ((:FLET READ-RESULTS (&OPTIONAL BLOCK))
       (ITERATE
        (UNTIL (AND (NOT BLOCK) (LPARALLEL.QUEUE:QUEUE-EMPTY-P RESULT-QUEUE)))
        (SETF BLOCK NIL)
        (FOR (VECTOR . INNER) = (LPARALLEL.QUEUE:POP-QUEUE RESULT-QUEUE))
        (ITERATE (FOR ELT IN-VECTOR VECTOR)
         (#S(FORMGREP:SYMREF
             :NAME "PASS-TO-AGGREGATION"
             :QUALIFIER "CL-DS.ALG.META")
          INNER ELT))))
      ((:FLET PUSH-QUEUE (NEW INNER)) (READ-RESULTS)
       (LPARALLEL.QUEUE:WITH-LOCKED-QUEUE QUEUE
         (WHEN (LPARALLEL.QUEUE:QUEUE-FULL-P/NO-LOCK QUEUE)
           (ITERATE (WITH FUTURE = (LPARALLEL.QUEUE:POP-QUEUE/NO-LOCK QUEUE))
            (UNTIL (LPARALLEL.PROMISE:FULFILLEDP FUTURE)) (READ-RESULTS T)))
         (LPARALLEL.QUEUE:PUSH-QUEUE/NO-LOCK
          (LPARALLEL.PROMISE:FUTURE
            (LET ((RESULT (VECT)))
              (UNWIND-PROTECT
                  (~>> NEW (FUNCALL KEY) (FUNCALL FN)
                   (#S(FORMGREP:SYMREF :NAME "TRAVERSE" :QUALIFIER "CL-DS") _
                    (LAMBDA (ELEMENT)
                      (VECTOR-PUSH-EXTEND ELEMENT RESULT)
                      (UNLESS (< (FILL-POINTER RESULT) CHUNK-SIZE)
                        (LPARALLEL.QUEUE:PUSH-QUEUE
                         (CONS (COPY-ARRAY RESULT) INNER) RESULT-QUEUE)
                        (SETF (FILL-POINTER RESULT) 0)))))
                (LPARALLEL.QUEUE:PUSH-QUEUE (CONS RESULT INNER)
                                            RESULT-QUEUE))))
          QUEUE))))
     (#S(FORMGREP:SYMREF
         :NAME "AGGREGATOR-CONSTRUCTOR"
         :QUALIFIER "CL-DS.ALG.META")
      (#S(FORMGREP:SYMREF :NAME "READ-ORIGINAL-RANGE" :QUALIFIER "CL-DS.ALG")
       RANGE)
      (#S(FORMGREP:SYMREF :NAME "CASES" :QUALIFIER "CL-DS.UTILS")
       ((:VARIANT (EQ KEY #'IDENTITY)) (:VARIANT (EQ FN #'IDENTITY)))
       (#S(FORMGREP:SYMREF :NAME "LET-AGGREGATOR" :QUALIFIER "CL-DS.ALG.META")
        ((INNER
          (#S(FORMGREP:SYMREF
              :NAME "CALL-CONSTRUCTOR"
              :QUALIFIER "CL-DS.ALG.META")
           OUTER-FN)))
        ((ELEMENT) (PUSH-QUEUE ELEMENT INNER))
        ((ITERATE (UNTIL (LPARALLEL.QUEUE:QUEUE-EMPTY-P QUEUE))
          (FOR FUTURE = (LPARALLEL.QUEUE:POP-QUEUE QUEUE))
          (ITERATE (UNTIL (LPARALLEL.PROMISE:FULFILLEDP FUTURE))
           (READ-RESULTS T)))
         (READ-RESULTS)
         (#S(FORMGREP:SYMREF
             :NAME "EXTRACT-RESULT"
             :QUALIFIER "CL-DS.ALG.META")
          INNER))
        (#S(FORMGREP:SYMREF :NAME "CLEANUP" :QUALIFIER "CL-DS.ALG.META")
         INNER)))
      FUNCTION ARGUMENTS)))

[cl-data-structures/src/threads/parallel-on-each.lisp:59]
  (DEFMETHOD #S(FORMGREP:SYMREF
                :NAME "AGGREGATOR-CONSTRUCTOR"
                :QUALIFIER "CL-DS.ALG.META")
             ((RANGE PARALLEL-ON-EACH-PROXY) OUTER-CONSTRUCTOR
              (FUNCTION
               #S(FORMGREP:SYMREF
                  :NAME "AGGREGATION-FUNCTION"
                  :QUALIFIER "CL-DS.ALG.META"))
              (ARGUMENTS LIST))
    (DECLARE
     (OPTIMIZE (SPEED 1) (SAFETY 2) (DEBUG 2) (COMPILATION-SPEED 0) (SPACE 0)))
    (BIND
     ((OUTER-FN
       (OR OUTER-CONSTRUCTOR
           (#S(FORMGREP:SYMREF
               :NAME "AGGREGATOR-CONSTRUCTOR"
               :QUALIFIER "CL-DS.ALG.META")
            'NIL NIL FUNCTION ARGUMENTS)))
      (MAXIMUM-QUEUE-SIZE (READ-MAXIMUM-QUEUE-SIZE RANGE))
      (CHUNK-SIZE (THE FIXNUM (READ-CHUNK-SIZE RANGE)))
      (KEY
       (ENSURE-FUNCTION
        (#S(FORMGREP:SYMREF :NAME "READ-KEY" :QUALIFIER "CL-DS.ALG") RANGE)))
      (QUEUE (LPARALLEL.QUEUE:MAKE-QUEUE :FIXED-CAPACITY MAXIMUM-QUEUE-SIZE))
      (FUNCTOR
       (#S(FORMGREP:SYMREF :NAME "ACCESS-FUNCTOR" :QUALIFIER "CL-DS.ALG")
        RANGE))
      (FUNCTOR-CONSTRUCTOR
       (ENSURE-FUNCTION
        (#S(FORMGREP:SYMREF
            :NAME "READ-FUNCTOR-CONSTRUCTOR"
            :QUALIFIER "CL-DS.ALG")
         RANGE)))
      (FUNCTOR-PROTOTYPE
       (#S(FORMGREP:SYMREF
           :NAME "READ-FUNCTOR-PROTOTYPE"
           :QUALIFIER "CL-DS.ALG")
        RANGE))
      ((:FLET HANDLE-RESULT (ELT INNER))
       (SETF ELT (LPARALLEL.PROMISE:FORCE ELT))
       (ITERATE (WITH LENGTH = (LENGTH ELT)) (FOR I FROM 0 BELOW LENGTH)
        (FOR E = (AREF ELT I))
        (#S(FORMGREP:SYMREF
            :NAME "PASS-TO-AGGREGATION"
            :QUALIFIER "CL-DS.ALG.META")
         INNER E)))
      ((:FLET PUSH-CHUNK (FN CHUNK INNER))
       (DECLARE
        (TYPE
         (#S(FORMGREP:SYMREF
             :NAME "EXTENDABLE-VECTOR"
             :QUALIFIER "CL-DS.UTILS")
          T)
         CHUNK))
       (LET ((CHUNK (COPY-ARRAY CHUNK)))
         (LPARALLEL.QUEUE:WITH-LOCKED-QUEUE QUEUE
           (WHEN (LPARALLEL.QUEUE:QUEUE-FULL-P/NO-LOCK QUEUE)
             (BIND (((ELT . INNER) (LPARALLEL.QUEUE:POP-QUEUE/NO-LOCK QUEUE)))
              (HANDLE-RESULT ELT INNER)))
           (LPARALLEL.QUEUE:PUSH-QUEUE/NO-LOCK
            (CONS
             (LPARALLEL.PROMISE:FUTURE
               (ASSERT (ARRAY-HAS-FILL-POINTER-P CHUNK))
               (#S(FORMGREP:SYMREF :NAME "TRANSFORM" :QUALIFIER "CL-DS.UTILS")
                FN CHUNK))
             INNER)
            QUEUE)))
       (SETF (FILL-POINTER CHUNK) 0)))
     (#S(FORMGREP:SYMREF
         :NAME "AGGREGATOR-CONSTRUCTOR"
         :QUALIFIER "CL-DS.ALG.META")
      (#S(FORMGREP:SYMREF :NAME "READ-ORIGINAL-RANGE" :QUALIFIER "CL-DS.ALG")
       RANGE)
      (#S(FORMGREP:SYMREF :NAME "CASES" :QUALIFIER "CL-DS.UTILS")
       ((:VARIANT (EQ KEY #'IDENTITY)))
       (#S(FORMGREP:SYMREF :NAME "LET-AGGREGATOR" :QUALIFIER "CL-DS.ALG.META")
        ((INNER
          (#S(FORMGREP:SYMREF
              :NAME "CALL-CONSTRUCTOR"
              :QUALIFIER "CL-DS.ALG.META")
           OUTER-FN))
         (CHUNK (MAKE-ARRAY CHUNK-SIZE :FILL-POINTER 0))
         (RANGE-FUNCTION
          (ENSURE-FUNCTION
           (OR FUNCTOR (FUNCALL FUNCTOR-CONSTRUCTOR FUNCTOR-PROTOTYPE)))))
        ((ELEMENT)
         (UNLESS (< (FILL-POINTER CHUNK) CHUNK-SIZE)
           (PUSH-CHUNK RANGE-FUNCTION CHUNK INNER))
         (VECTOR-PUSH-EXTEND ELEMENT CHUNK))
        ((UNLESS (ZEROP (FILL-POINTER CHUNK))
           (PUSH-CHUNK RANGE-FUNCTION CHUNK INNER))
         (LPARALLEL.QUEUE:WITH-LOCKED-QUEUE QUEUE
           (ITERATE (UNTIL (LPARALLEL.QUEUE:QUEUE-EMPTY-P/NO-LOCK QUEUE))
            (FOR (ELT . INNER) = (LPARALLEL.QUEUE:POP-QUEUE/NO-LOCK QUEUE))
            (HANDLE-RESULT ELT INNER)))
         (#S(FORMGREP:SYMREF
             :NAME "EXTRACT-RESULT"
             :QUALIFIER "CL-DS.ALG.META")
          INNER))
        (#S(FORMGREP:SYMREF :NAME "CLEANUP" :QUALIFIER "CL-DS.ALG.META")
         INNER)))
      FUNCTION ARGUMENTS)))

[cl-data-structures/src/utils/arrays.lisp:196]
  (DEFUN SELECT-TOP (VECTOR COUNT PREDICATE &KEY (KEY #'IDENTITY))
    (DECLARE (TYPE NON-NEGATIVE-FIXNUM COUNT)
             (OPTIMIZE (SPEED 3) (SAFETY 1) (SPACE 0) (DEBUG 0)))
    (CHECK-TYPE VECTOR VECTOR)
    (ENSURE-FUNCTIONF PREDICATE KEY)
    (NEST (CASES ((EQ KEY #'IDENTITY) (SIMPLE-VECTOR-P VECTOR)))
     (LET* ((LENGTH (LENGTH VECTOR))
            (COUNT (MIN LENGTH COUNT))
            (RESULT
             (MAKE-ARRAY COUNT :ELEMENT-TYPE (ARRAY-ELEMENT-TYPE VECTOR)))
            (HEAP-SIZE LENGTH))
       (DECLARE (TYPE FIXNUM HEAP-SIZE COUNT LENGTH)))
     (LABELS ((COMPARE (A B)
                (DECLARE (TYPE FIXNUM A B))
                (FUNCALL PREDICATE (FUNCALL KEY (AREF VECTOR A))
                         (FUNCALL KEY (AREF VECTOR B))))
              (LEFT (I)
                (DECLARE (TYPE FIXNUM I))
                (THE FIXNUM (1+ (THE FIXNUM (* 2 I)))))
              (RIGHT (I)
                (DECLARE (TYPE FIXNUM I))
                (THE FIXNUM (+ 2 (THE FIXNUM (* 2 I)))))
              (HEAPIFY (I)
                (DECLARE (TYPE FIXNUM I))
                (ITERATE (DECLARE (TYPE FIXNUM L R SMALLEST))
                 (FOR L = (LEFT I)) (FOR R = (RIGHT I)) (FOR SMALLEST = I)
                 (WHEN (AND (< L HEAP-SIZE) (COMPARE L I)) (SETF SMALLEST L))
                 (WHEN (AND (< R HEAP-SIZE) (COMPARE R SMALLEST))
                   (SETF SMALLEST R))
                 (IF (EQL SMALLEST I)
                     (LEAVE)
                     (PSETF I SMALLEST
                            (AREF VECTOR SMALLEST) (AREF VECTOR I)
                            (AREF VECTOR I) (AREF VECTOR SMALLEST)))))
              (EXTRACT-MIN ()
                (WHEN (> HEAP-SIZE 1)
                  (SETF (AREF VECTOR 0) (AREF VECTOR (1- HEAP-SIZE)))
                  (HEAPIFY 0))
                (DECF HEAP-SIZE)))
       (DECLARE (INLINE EXTRACT-MIN HEAPIFY RIGHT LEFT COMPARE))
       (ITERATE (DECLARE (TYPE FIXNUM I START))
        (WITH START = (TRUNCATE (1- HEAP-SIZE) 2)) (FOR I FROM START DOWNTO 0)
        (HEAPIFY I))
       (ITERATE (DECLARE (TYPE FIXNUM I)) (FOR I FROM 0 BELOW COUNT)
        (SETF (AREF RESULT I) (AREF VECTOR 0)) (EXTRACT-MIN))
       RESULT)))

[cl-data-structures/src/utils/distances.lisp:31]
  (DEFUN INDEX-IN-CONTENT-OF-DISTANCE-MATRIX (SIZE ROW COLUMN)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0)))
    (THE INDEX (+ (- (* SIZE ROW) (/ (* ROW (1+ ROW)) 2) 1 ROW) COLUMN)))

[cl-data-structures/src/utils/distances.lisp:59]
  (DEFUN PARALLEL-FILL-DISTANCE-MATRIX-FROM-VECTOR
         (MATRIX FUNCTION SEQUENCE
          &KEY (KEY #'IDENTITY) (KEY-CONTEXT #'IDENTITY)
          (FUNCTION-CONTEXT #'IDENTITY))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0) (SPACE 0))
             (TYPE HALF-MATRIX MATRIX)
             (TYPE SEQUENCE SEQUENCE)
             (TYPE FUNCTION FUNCTION))
    (ASSERT (<= (LENGTH SEQUENCE) (READ-SIZE MATRIX)))
    (LET* ((SIZE (LENGTH SEQUENCE))
           (CONTENT (READ-CONTENT MATRIX))
           (TYPE (ARRAY-ELEMENT-TYPE CONTENT))
           (INDEXES
            (ITERATE (FOR I BELOW (LENGTH SEQUENCE))
             (COLLECT I INTO FORWARD AT START) (COLLECT I INTO BACKWARD)
             (FINALLY (RETURN (MAP '(VECTOR LIST) #'LIST BACKWARD FORWARD))))))
      (DECLARE (TYPE VECTOR INDEXES))
      (LPARALLEL.COGNATE:PMAP NIL
                              (LAMBDA (INDEX)
                                (FBIND
                                 ((DIST-FUNCTION
                                   (FUNCALL FUNCTION-CONTEXT FUNCTION))
                                  (KEY-FUNCTION (FUNCALL KEY-CONTEXT KEY)))
                                 (ITERATE (FOR I IN INDEX)
                                  (FOR X = (AREF SEQUENCE I))
                                  (ITERATE (FOR J FROM (1+ I) BELOW SIZE)
                                   (FOR Y = (AREF SEQUENCE J))
                                   (SETF (AREF CONTENT
                                               (INDEX-IN-CONTENT-OF-DISTANCE-MATRIX
                                                SIZE I J))
                                           (COERCE
                                            (DIST-FUNCTION (KEY-FUNCTION X)
                                             (KEY-FUNCTION Y))
                                            TYPE))))))
                              INDEXES)
      MATRIX))

[cl-data-structures/src/utils/distances.lisp:162]
  (DEFUN MREF (MATRIX FROM TO)
    (DECLARE (TYPE INDEX FROM TO)
             (TYPE HALF-MATRIX MATRIX)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LET* ((SIZE (SLOT-VALUE MATRIX '%SIZE))
           (KEY (SLOT-VALUE MATRIX '%KEY))
           (FROM (FUNCALL KEY FROM))
           (TO (FUNCALL KEY TO)))
      (DECLARE (TYPE INDEX SIZE TO FROM)
               (TYPE FUNCTION KEY))
      (COND
       ((OR (>= FROM SIZE) (>= TO SIZE) (EQL TO FROM))
        (ERROR "No such position in the matrix."))
       (T
        (LET ((CONTENT (SLOT-VALUE MATRIX '%CONTENT))
              (FROM (MIN FROM TO))
              (TO (MAX FROM TO)))
          (DECLARE (TYPE SIMPLE-ARRAY CONTENT))
          (AREF CONTENT (INDEX-IN-CONTENT-OF-DISTANCE-MATRIX SIZE FROM TO)))))))

[cl-data-structures/src/utils/distances.lisp:189]
  (DEFUN (SETF MREF) (VALUE MATRIX FROM TO)
    (DECLARE (TYPE INDEX FROM TO)
             (TYPE HALF-MATRIX MATRIX)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LET* ((SIZE (SLOT-VALUE MATRIX '%SIZE))
           (KEY (SLOT-VALUE MATRIX '%KEY))
           (TO (FUNCALL KEY TO))
           (FROM (FUNCALL KEY FROM)))
      (DECLARE (TYPE INDEX SIZE))
      (COND
       ((OR (>= FROM SIZE) (>= TO SIZE))
        (ERROR "No such position in the matrix!"))
       ((EQL FROM TO) (ERROR "Can't set dinstance to self"))
       (T
        (LET ((CONTENT (SLOT-VALUE MATRIX '%CONTENT))
              (FROM (MIN FROM TO))
              (TO (MAX FROM TO)))
          (DECLARE (TYPE SIMPLE-ARRAY CONTENT))
          (SETF (AREF CONTENT
                      (INDEX-IN-CONTENT-OF-DISTANCE-MATRIX SIZE FROM TO))
                  VALUE))))))

[cl-data-structures/src/utils/hashing.lisp:6]
  (DEFUN XORSHIFT (N I)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LOGXOR N (ASH N (- I))))

[cl-data-structures/src/utils/hashing.lisp:13]
  (DEFUN ROL64 (X K)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LOGIOR (LDB (BYTE 64 0) (ASH X K)) (LDB (BYTE 64 K) X)))

[cl-data-structures/src/utils/hashing.lisp:22]
  (DEFUN HASH-INTEGER (N &OPTIONAL (MULTI 2685821657736338717))
    "Attempts to randomize bits. Uses xorshift* algorithm."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (LET* ((NEW-STATE
            (~> (XORSHIFT N 12) (XORSHIFT -25) (LDB (BYTE 64 0) _)
             (XORSHIFT 27) (LDB (BYTE 64 0) _))))
      (VALUES (LDB (BYTE 64 0) (* NEW-STATE MULTI)) NEW-STATE)))

[cl-data-structures/src/utils/hashing.lisp:32]
  (DEFUN XOSHIRO256** (STATE)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (*)) STATE))
    (LET ((RESULT
           (LDB (BYTE 64 0)
                (* 9 (ROL64 (LDB (BYTE 64 0) (* 5 (AREF STATE 1))) 7))))
          (TEMP (LDB (BYTE 64 0) (ASH (AREF STATE 1) 17))))
      (MACROLET ((SXOR (FIRST SECOND)
                   (ECLECTOR.READER:QUASIQUOTE
                    (SETF (AREF STATE (ECLECTOR.READER:UNQUOTE FIRST))
                            (LOGXOR
                             (AREF STATE (ECLECTOR.READER:UNQUOTE FIRST))
                             (AREF STATE (ECLECTOR.READER:UNQUOTE SECOND)))))))
        (SXOR 2 0)
        (SXOR 3 1)
        (SXOR 1 2)
        (SXOR 0 3)
        (SETF (AREF STATE 2) (LOGXOR (AREF STATE 2) TEMP)
              (AREF STATE 3) (ROL64 (AREF STATE 3) 45)))
      RESULT))

[cl-data-structures/src/utils/hashing.lisp:55]
  (DEFUN SPLITMIX64 (STATE)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((NEW-STATE (LDB (BYTE 64 0) (+ STATE 11400714819323198485))))
      (VALUES
       (~> (XORSHIFT STATE 30) (* 13787848793156543929) (LDB (BYTE 64 0) _)
        (XORSHIFT 27) (* 10723151780598845931) (LDB (BYTE 64 0) _)
        (XORSHIFT 31))
       NEW-STATE)))

[cl-data-structures/src/utils/hashing.lisp:68]
  (DEFUN FIXNUM-HASH (A)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (FLET ((OP1 (A F1 F2)
             (DECLARE (TYPE FIXNUM A F1 F2))
             (LDB (BYTE 32 0) (+ A F1 (ASH A F2))))
           (OP2 (A F1 F2)
             (DECLARE (TYPE FIXNUM A F1 F2))
             (LDB (BYTE 32 0) (LOGXOR A F1 (ASH A F2)))))
      (DECLARE (INLINE OP1 OP2))
      (~> A (OP1 2127912214 12) (OP2 3345072700 -19) (OP1 374761393 5)
       (OP2 3550635116 9) (OP1 4251993797 3) (OP2 3042594569 -16))))

[cl-data-structures/src/utils/lists.lisp:11]
  (DEFUN INSERT-OR-REPLACE
         (LIST ELEMENT
          &KEY (TEST #'EQL) (LIST-KEY #'IDENTITY) (ITEM-KEY #'IDENTITY)
          (PRESERVE-ORDER NIL))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0) (SPACE 0)))
    "Insert element into set if it is not already here.

   @b(Returns three values:)
   @begin(list)
    @item(first -- new list)
    @item(second -- was any item replaced?)
    @item(third -- old value that was replaced (or nil if there was no such value))
   @end(list)"
    (ITERATE (WITH LAST-CELL = NIL) (WITH RESULT = NIL) (WITH REPLACED = NIL)
     (WITH VALUE = NIL) (FOR SUBLIST ON LIST) (FOR ELT = (CAR SUBLIST))
     (IF (FUNCALL TEST (FUNCALL LIST-KEY ELT) (FUNCALL ITEM-KEY ELEMENT))
         (PROGN
          (PUSH ELEMENT RESULT)
          (SETF REPLACED T
                VALUE ELT))
         (PUSH ELT RESULT))
     (UNLESS LAST-CELL (SETF LAST-CELL RESULT))
     (WHEN (AND REPLACED LAST-CELL (NOT PRESERVE-ORDER))
       (SETF (CDR LAST-CELL) (CDR SUBLIST))
       (FINISH))
     (FINALLY
      (RETURN
       (VALUES
        (LET ((R
               (IF PRESERVE-ORDER
                   (NREVERSE RESULT)
                   RESULT)))
          (IF REPLACED
              R
              (CONS ELEMENT R)))
        REPLACED VALUE)))))

[cl-data-structures/src/utils/lists.lisp:61]
  (DEFUN TRY-REMOVE
         (ITEM LIST &KEY (TEST #'EQL) (KEY #'IDENTITY) (PRESERVE-ORDER NIL))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0) (SPACE 0)))
    "Try to remove first item matching from the list.

   @b(Returns three values:)
   @begin(list)
    @item(first -- new list)
    @item(second -- did anything was removed?)
    @item(third -- value that was removed (or nil if nothing was removed))
   @end(list)"
    (ITERATE (FOR SUBLIST ON LIST) (FOR ELT = (CAR SUBLIST))
     (WITH REMOVED = NIL) (WITH VALUE = NIL) (WITH LAST-CELL = NIL)
     (IF (FUNCALL TEST (FUNCALL KEY ELT) ITEM)
         (SETF REMOVED T
               VALUE ELT)
         (COLLECT ELT INTO RESULT AT START))
     (UNLESS LAST-CELL (SETF LAST-CELL RESULT))
     (WHEN (AND REMOVED LAST-CELL (NOT PRESERVE-ORDER))
       (SETF (CDR LAST-CELL) (CDR SUBLIST))
       (FINISH))
     (FINALLY
      (RETURN
       (VALUES
        (IF PRESERVE-ORDER
            (REVERSE RESULT)
            RESULT)
        REMOVED VALUE)))))

[cl-data-structures/src/utils/lists.lisp:96]
  (DEFUN TRY-FIND-CELL (ITEM LIST &KEY (TEST #'EQL) (KEY #'IDENTITY))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0) (SPACE 0)))
    "@b(Returns) first matching sublist"
    (ITERATE (FOR ELT ON LIST)
     (WHEN (FUNCALL TEST (FUNCALL KEY (CAR ELT)) ITEM) (LEAVE ELT))))

[cl-data-structures/src/utils/lists.lisp:108]
  (DEFUN TRY-FIND (ITEM LIST &KEY (TEST #'EQL) (KEY #'IDENTITY))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0) (SPACE 0)))
    "@b(Returns) first matching elements as first value and boolean telling if it was found as second"
    (LET ((R (TRY-FIND-CELL ITEM LIST :TEST TEST :KEY KEY)))
      (VALUES (CAR R) (NOT (NULL R)))))

[cl-data-structures/src/utils/ordered-algorithms.lisp:101]
  (DEFUN ON-ORDERED-INTERSECTION
         (FUNCTION FIRST-ORDER SECOND-ORDER
          &KEY (ON-FIRST-MISSING #'IDENTITY) (ON-SECOND-MISSING #'IDENTITY)
          (KEY #'IDENTITY) (FIRST-KEY KEY) (SECOND-KEY KEY) (SAME #'=)
          (LESS #'<))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (CHECK-TYPE FIRST-ORDER VECTOR)
    (CHECK-TYPE SECOND-ORDER VECTOR)
    (CASES
     ((SIMPLE-VECTOR-P FIRST-ORDER) (SIMPLE-VECTOR-P SECOND-ORDER)
      (EQ KEY #'IDENTITY))
     (WITH-VECTORS (FIRST-ORDER SECOND-ORDER)
      (ITERATE (DECLARE (TYPE FIXNUM A B FIRST-LENGTH SECOND-LENGTH))
       (WITH A = 0) (WITH B = 0) (WITH FIRST-LENGTH = (LENGTH FIRST-ORDER))
       (WITH SECOND-LENGTH = (LENGTH SECOND-ORDER)) (WHILE (< A FIRST-LENGTH))
       (WHILE (< B SECOND-LENGTH))
       (FOR AV = (FUNCALL FIRST-KEY (FIRST-ORDER A)))
       (FOR BV = (FUNCALL SECOND-KEY (SECOND-ORDER B)))
       (COND
        ((FUNCALL SAME AV BV)
         (FUNCALL FUNCTION (FIRST-ORDER A) (SECOND-ORDER B)) (INCF A) (INCF B))
        ((FUNCALL LESS AV BV) (FUNCALL ON-SECOND-MISSING (FIRST-ORDER A))
         (INCF A))
        (T (FUNCALL ON-FIRST-MISSING (SECOND-ORDER B)) (INCF B)))
       (FINALLY
        (ITERATE (DECLARE (TYPE FIXNUM I))
         (FOR I FROM A BELOW (LENGTH FIRST-ORDER))
         (FUNCALL ON-SECOND-MISSING (FIRST-ORDER I)))
        (ITERATE (DECLARE (TYPE FIXNUM I))
         (FOR I FROM B BELOW (LENGTH SECOND-ORDER))
         (FUNCALL ON-FIRST-MISSING (SECOND-ORDER I))))))))

[cl-eval-bot/src/eval-bot.lisp:28]
  (DECLAIM (OPTIMIZE (SAFETY 3)))

[cl-eval-bot/src/sandbox-cl.lisp:22]
  (DECLAIM (OPTIMIZE (SAFETY 3)))

[cl-eval-bot/src/sandbox-extra.lisp:22]
  (DECLAIM (OPTIMIZE (SAFETY 3)))

[cl-eval-bot/src/sandbox-impl.lisp:27]
  (DECLAIM (OPTIMIZE (SAFETY 3)))

[cl-garnet/multi-garnet/multi-garnet.lisp:654]
  (DEFUN DESTROY-SCHEMA-HOOK
         (SCHEMA &OPTIONAL (SEND-DESTROY-MESSAGE NIL) RECURSIVE-P)
    (LET ((INVALID-CNS NIL) (INVALID-VARS NIL))
      (WHEN (SCHEMA-P SCHEMA)
        (LOCALLY
         (DECLARE (OPTIMIZE (SPEED 0) (SAFETY 3) (SPACE 0) (DEBUG 3)))
         (PROGN
          (MAPHASH
           #'(LAMBDA
                 (
                  #S(FORMGREP:SYMREF
                     :NAME "ITERATE-IGNORED-SLOT-NAME"
                     :QUALIFIER "KR")
                  #S(FORMGREP:SYMREF
                     :NAME "ITERATE-SLOT-VALUE-ENTRY"
                     :QUALIFIER "KR"))
               (DECLARE
                (IGNORE
                 #S(FORMGREP:SYMREF
                    :NAME "ITERATE-IGNORED-SLOT-NAME"
                    :QUALIFIER "KR")))
               (LET ((#S(FORMGREP:SYMREF :NAME "SLOT" :QUALIFIER "KR")
                      (#S(FORMGREP:SYMREF :NAME "SL-NAME" :QUALIFIER "KR")
                       #S(FORMGREP:SYMREF
                          :NAME "ITERATE-SLOT-VALUE-ENTRY"
                          :QUALIFIER "KR")))
                     (#S(FORMGREP:SYMREF :NAME "VALUE" :QUALIFIER "KR")
                      (#S(FORMGREP:SYMREF :NAME "SL-VALUE" :QUALIFIER "KR")
                       #S(FORMGREP:SYMREF
                          :NAME "ITERATE-SLOT-VALUE-ENTRY"
                          :QUALIFIER "KR"))))
                 (UNLESS
                     (#S(FORMGREP:SYMREF :NAME "IS-INHERITED" :QUALIFIER "KR")
                      (#S(FORMGREP:SYMREF :NAME "SL-BITS" :QUALIFIER "KR")
                       #S(FORMGREP:SYMREF
                          :NAME "ITERATE-SLOT-VALUE-ENTRY"
                          :QUALIFIER "KR")))
                   (UNLESS
                       (EQ #S(FORMGREP:SYMREF :NAME "VALUE" :QUALIFIER "KR")
                           #S(FORMGREP:SYMREF
                              :NAME "*NO-VALUE*"
                              :QUALIFIER "KR"))
                     (LET ((SLOT
                            #S(FORMGREP:SYMREF :NAME "SLOT" :QUALIFIER "KR")))
                       (LET ((VAL (GET-LOCAL-VALUE SCHEMA SLOT)))
                         (WHEN
                             (AND (CONSTRAINT-P VAL)
                                  (CONSTRAINT-IN-OBJ-SLOT VAL SCHEMA SLOT))
                           (REMOVE-BAD-INV-OBJECTS SCHEMA)
                           (REMOVE-CONSTRAINT-FROM-SLOT SCHEMA SLOT VAL))))))))
           (#S(FORMGREP:SYMREF :NAME "SCHEMA-BINS" :QUALIFIER "KR") SCHEMA))))
        (LOCALLY
         (DECLARE (OPTIMIZE (SPEED 0) (SAFETY 3) (SPACE 0) (DEBUG 3)))
         (PROGN
          (MAPHASH
           #'(LAMBDA
                 (
                  #S(FORMGREP:SYMREF
                     :NAME "ITERATE-IGNORED-SLOT-NAME"
                     :QUALIFIER "KR")
                  #S(FORMGREP:SYMREF
                     :NAME "ITERATE-SLOT-VALUE-ENTRY"
                     :QUALIFIER "KR"))
               (DECLARE
                (IGNORE
                 #S(FORMGREP:SYMREF
                    :NAME "ITERATE-IGNORED-SLOT-NAME"
                    :QUALIFIER "KR")))
               (LET ((#S(FORMGREP:SYMREF :NAME "SLOT" :QUALIFIER "KR")
                      (#S(FORMGREP:SYMREF :NAME "SL-NAME" :QUALIFIER "KR")
                       #S(FORMGREP:SYMREF
                          :NAME "ITERATE-SLOT-VALUE-ENTRY"
                          :QUALIFIER "KR")))
                     (#S(FORMGREP:SYMREF :NAME "VALUE" :QUALIFIER "KR")
                      (#S(FORMGREP:SYMREF :NAME "SL-VALUE" :QUALIFIER "KR")
                       #S(FORMGREP:SYMREF
                          :NAME "ITERATE-SLOT-VALUE-ENTRY"
                          :QUALIFIER "KR"))))
                 (UNLESS
                     (#S(FORMGREP:SYMREF :NAME "IS-INHERITED" :QUALIFIER "KR")
                      (#S(FORMGREP:SYMREF :NAME "SL-BITS" :QUALIFIER "KR")
                       #S(FORMGREP:SYMREF
                          :NAME "ITERATE-SLOT-VALUE-ENTRY"
                          :QUALIFIER "KR")))
                   (UNLESS
                       (EQ #S(FORMGREP:SYMREF :NAME "VALUE" :QUALIFIER "KR")
                           #S(FORMGREP:SYMREF
                              :NAME "*NO-VALUE*"
                              :QUALIFIER "KR"))
                     (LET ((SLOT
                            #S(FORMGREP:SYMREF :NAME "SLOT" :QUALIFIER "KR")))
                       (LET ((VAL (GET-LOCAL-VALUE SCHEMA SLOT)))
                         (WHEN
                             (AND (CONSTRAINT-P VAL)
                                  (CONSTRAINT-IN-OBJ-SLOT VAL SCHEMA SLOT))
                           (REMOVE-BAD-INV-OBJECTS SCHEMA)
                           (REMOVE-CONSTRAINT-FROM-SLOT SCHEMA SLOT VAL))))))))
           (#S(FORMGREP:SYMREF :NAME "SCHEMA-BINS" :QUALIFIER "KR") SCHEMA))))
        (LOOP FOR CN IN INVALID-CNS
              DO (REMOVE-BAD-INV-OBJECTS SCHEMA) (REMOVE-DISCONNECT-CONSTRAINT
                                                  CN))
        (LOOP FOR VAR IN INVALID-VARS
              DO (SETF (VAR-OS VAR) NIL))
        (CALL-HOOK-SAVE-FN
         #S(FORMGREP:SYMREF :NAME "DESTROY-SCHEMA" :QUALIFIER "KR") SCHEMA
         SEND-DESTROY-MESSAGE RECURSIVE-P)
        (LOOP FOR CN IN INVALID-CNS
              DO (CONNECT-ADD-CONSTRAINT CN)))))

[cl-garnet/src/contrib/mandelbrot/fmand.lisp:12]
  (DECLAIM
   (OPTIMIZE (SPEED 3) (SAFETY 1) (SPACE 0) (DEBUG 1) (COMPILATION-SPEED 0)))

[cl-garnet/src/contrib/mandelbrot/fmand.lisp:715]
  (DEFUN PLOT-POINT (X Y COLOR)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0)))
    (DECLARE (FIXNUM X Y COLOR))
    (SETF (AREF *PIXARRAY* Y X) COLOR))

[cl-garnet/src/contrib/mandelbrot/fmand.lisp:727]
  (DEFUN TST (K REC IMC)
    (DECLARE (FIXNUM K)
             (LONG-FLOAT REC IMC))
    (DECLARE (VALUES FIXNUM))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0)))
    (LET ((RE REC) (IM IMC))
      (DECLARE (LONG-FLOAT RE IM))
      (DOTIMES (J (- K 2) 0)
        (DECLARE (FIXNUM J))
        (LET ((RE2 (* RE RE)) (IM2 (* IM IM)))
          (DECLARE (LONG-FLOAT RE2 IM2))
          (WHEN (> (+ RE2 IM2) 256) (RETURN-FROM TST (F J)))
          (SETF IM (+ (* 2 RE IM) IMC)
                RE (+ (- RE2 IM2) REC))))))

[cl-garnet/src/contrib/mandelbrot/fmand.lisp:751]
  (DEFUN M ()
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0)))
    (INIT "Mandelbrot Plot" *PLOT-XY* *PLOT-XY*)
    (#S(FORMGREP:SYMREF :NAME "RAISE-WINDOW" :QUALIFIER "OPAL") *W*)
    (#S(FORMGREP:SYMREF :NAME "WITH-HOURGLASS-CURSOR" :QUALIFIER "OPAL")
     (LET* ((W *PLOT-XY*)
            (HALF-W (TRUNCATE W 2))
            (R *RADIUS*)
            (S (* 2.0d0 (/ R W)))
            (RECEN *REAL-CENTER*)
            (IMCEN *IMAGINARY-CENTER*)
            (K *ITERATIONS*))
       (DECLARE (FIXNUM W K)
                (LONG-FLOAT R S RECEN IMCEN))
       (UPDATE-ITERATIONS-SCROLL)
       (UPDATE-PROPSHEET)
       (#S(FORMGREP:SYMREF :NAME "UPDATE" :QUALIFIER "OPAL") *GW*)
       (DOTIMES (Y W)
         (DECLARE (FIXNUM Y))
         (UPDATE-INDICATOR Y)
         (#S(FORMGREP:SYMREF :NAME "UPDATE" :QUALIFIER "OPAL") *GW*)
         (SB-THREAD:THREAD-YIELD)
         (DOTIMES (X W)
           (DECLARE (FIXNUM X))
           (LET ((REC (+ (* S (- X HALF-W)) RECEN))
                 (IMC (+ (* S (- Y HALF-W)) IMCEN)))
             (DECLARE (LONG-FLOAT REC IMC))
             (PLOT-POINT X Y (TST K REC IMC))))))
     (#S(FORMGREP:SYMREF :NAME "UPDATE" :QUALIFIER "OPAL") *W* T)
     (#S(FORMGREP:SYMREF :NAME "UPDATE" :QUALIFIER "OPAL") *GW* T)))

[cl-garnet/src/contrib/virtual-agg/virt.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (SAFETY 0)))

[cl-garnet/src/contrib/virtual-agg/virt2.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (SAFETY 0)))

[cl-garnet/src/contrib/virtual-agg/virt3.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (SAFETY 0)))

[cl-garnet/src/contrib/virtual-agg/virt4.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (SAFETY 0)))

[cl-garnet/src/contrib/virtual-agg/virt5.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (SAFETY 0)))

[cl-garnet/src/demos/demo-scrollbar.lisp:487]
  (CREATE-INSTANCE 'OPEN-SCROLLBAR
   #S(FORMGREP:SYMREF :NAME "AGGREGADGET" :QUALIFIER "OPAL") (:LEFT 50)
   (:TOP 50) (:WIDTH 21) (:HEIGHT 200) (:END-RECT-HEIGHT 5) (:SHADOW-OFFSET 3)
   (:VALUE
    (O-FORMULA
     (#S(FORMGREP:SYMREF :NAME "CLIP-AND-MAP" :QUALIFIER "INTER")
      (SECOND (GVL :INDICATOR :BOX)) (GVL :BOUND-TOP)
      (- (GVL :BOUND-BOTTOM) (GVL :INDICATOR :HEIGHT) 2) 0 100)))
   (:BOUND-TOP (O-FORMULA (+ 1 (GVL :TOP) (GVL :END-RECT-HEIGHT))))
   (:BOUND-WIDTH (O-FORMULA (- (GVL :WIDTH) (GVL :SHADOW-OFFSET))))
   (:BOUND-HEIGHT (O-FORMULA (- (GVL :HEIGHT) (* 2 (GVL :END-RECT-HEIGHT)) 2)))
   (:BOUND-BOTTOM (O-FORMULA (+ (GVL :BOUND-TOP) (GVL :BOUND-HEIGHT))))
   (:PARTS
    (ECLECTOR.READER:QUASIQUOTE
     ((:BOUND-BOX
       (ECLECTOR.READER:UNQUOTE
        #S(FORMGREP:SYMREF :NAME "RECTANGLE" :QUALIFIER "OPAL"))
       (:LEFT (ECLECTOR.READER:UNQUOTE (O-FORMULA (GVL :PARENT :LEFT))))
       (:TOP (ECLECTOR.READER:UNQUOTE (O-FORMULA (GVL :PARENT :BOUND-TOP))))
       (:WIDTH
        (ECLECTOR.READER:UNQUOTE (O-FORMULA (GVL :PARENT :BOUND-WIDTH))))
       (:HEIGHT
        (ECLECTOR.READER:UNQUOTE (O-FORMULA (GVL :PARENT :BOUND-HEIGHT))))
       (:LINE-STYLE NIL))
      (:LINE
       (ECLECTOR.READER:UNQUOTE
        #S(FORMGREP:SYMREF :NAME "LINE" :QUALIFIER "OPAL"))
       (:X1
        (ECLECTOR.READER:UNQUOTE
         (O-FORMULA (+ (GVL :PARENT :LEFT) (FLOOR (GVL :PARENT :WIDTH) 2)))))
       (:Y1 (ECLECTOR.READER:UNQUOTE (O-FORMULA (GVL :PARENT :BOUND-TOP))))
       (:X2 (ECLECTOR.READER:UNQUOTE (O-FORMULA (GVL :X1))))
       (:Y2 (ECLECTOR.READER:UNQUOTE (O-FORMULA (GVL :PARENT :BOUND-BOTTOM))))
       (:LINE-STYLE
        (ECLECTOR.READER:UNQUOTE
         (CREATE-INSTANCE NIL
          #S(FORMGREP:SYMREF :NAME "LINE-STYLE" :QUALIFIER "OPAL")
          (:FOREGROUND-COLOR
           (IF *COLOR-P*
               #S(FORMGREP:SYMREF :NAME "GREEN" :QUALIFIER "OPAL")
               #S(FORMGREP:SYMREF :NAME "BLACK" :QUALIFIER "OPAL")))
          (:LINE-THICKNESS 4)
          (:STIPPLE
           #S(FORMGREP:SYMREF :NAME "GRAY-FILL-BITMAP" :QUALIFIER "OPAL"))))))
      (:TOP-END-RECT (ECLECTOR.READER:UNQUOTE OPEN-END-RECT)
       (:TOP (ECLECTOR.READER:UNQUOTE (O-FORMULA (GVL :PARENT :TOP))))
       (:FINAL-FN
        (ECLECTOR.READER:UNQUOTE
         #'(LAMBDA (INTERACTOR OBJ)
             (DECLARE (IGNORE OBJ))
             (LET ((SLIDER (G-VALUE INTERACTOR :OPERATES-ON :PARENT)))
               (S-VALUE SLIDER :VALUE 0))))))
      (:BOT-END-RECT (ECLECTOR.READER:UNQUOTE OPEN-END-RECT)
       (:TOP
        (ECLECTOR.READER:UNQUOTE
         (O-FORMULA (+ (GVL :PARENT :BOUND-BOTTOM) 1))))
       (:FINAL-FN
        (ECLECTOR.READER:UNQUOTE
         #'(LAMBDA (INTERACTOR OBJ)
             (DECLARE (IGNORE OBJ))
             (LET ((SLIDER (G-VALUE INTERACTOR :OPERATES-ON :PARENT)))
               (S-VALUE SLIDER :VALUE 100))))))
      (:INDICATOR
       (ECLECTOR.READER:UNQUOTE
        #S(FORMGREP:SYMREF :NAME "AGGREGADGET" :QUALIFIER "OPAL"))
       (:BOX (0 75 0 0))
       (:TOP
        (ECLECTOR.READER:UNQUOTE
         (O-FORMULA
          (LET ((PARENT (GVL :PARENT)))
            (#S(FORMGREP:SYMREF :NAME "CLIP-AND-MAP" :QUALIFIER "INTER")
             (GV PARENT :VALUE) 0 100 (GV PARENT :BOUND-TOP)
             (- (GV PARENT :BOUND-BOTTOM) (GVL :HEIGHT)))))))
       (:HEIGHT
        (ECLECTOR.READER:UNQUOTE
         (O-FORMULA
          (+ (* 3 (GVL :PARENT :BOUND-WIDTH)) (GVL :PARENT :SHADOW-OFFSET)))))
       (:PARTS
        ((:SHADOW
          (ECLECTOR.READER:UNQUOTE
           #S(FORMGREP:SYMREF :NAME "RECTANGLE" :QUALIFIER "OPAL"))
          (:LEFT
           (ECLECTOR.READER:UNQUOTE
            (O-FORMULA
             (+ (GVL :PARENT :PARENT :LEFT)
                (GVL :PARENT :PARENT :SHADOW-OFFSET)))))
          (:TOP
           (ECLECTOR.READER:UNQUOTE
            (O-FORMULA
             (+ (GVL :PARENT :TOP) (GVL :PARENT :PARENT :SHADOW-OFFSET)))))
          (:WIDTH
           (ECLECTOR.READER:UNQUOTE
            (O-FORMULA (GVL :PARENT :PARENT :BOUND-WIDTH))))
          (:HEIGHT (ECLECTOR.READER:UNQUOTE (O-FORMULA (* 3 (GVL :WIDTH)))))
          (:FILLING-STYLE
           (ECLECTOR.READER:UNQUOTE
            #S(FORMGREP:SYMREF :NAME "GREEN-FILL" :QUALIFIER "OPAL"))))
         (:TOP-TRILL
          (ECLECTOR.READER:UNQUOTE
           #S(FORMGREP:SYMREF :NAME "AGGREGADGET" :QUALIFIER "OPAL"))
          (:TOP (ECLECTOR.READER:UNQUOTE (O-FORMULA (GVL :PARENT :TOP))))
          (:PARTS
           ((:BOX (ECLECTOR.READER:UNQUOTE OPEN-TRILL-BOX))
            (:ARROW (ECLECTOR.READER:UNQUOTE OPEN-UP-ARROW))))
          (:INTERACTORS
           ((:TRILL (ECLECTOR.READER:UNQUOTE OPEN-INTER)
             (:FINAL-FUNCTION
              (ECLECTOR.READER:UNQUOTE
               #'(LAMBDA (INTERACTOR OBJ)
                   (DECLARE (IGNORE INTERACTOR))
                   (LET* ((SLIDER (G-VALUE OBJ :PARENT :PARENT))
                          (VALUE (G-VALUE SLIDER :VALUE)))
                     (WHEN (> VALUE 1)
                       (S-VALUE SLIDER :VALUE (- VALUE 1)))))))))))
         (:MIDDLE
          (ECLECTOR.READER:UNQUOTE
           #S(FORMGREP:SYMREF :NAME "RECTANGLE" :QUALIFIER "OPAL"))
          (:LEFT
           (ECLECTOR.READER:UNQUOTE (O-FORMULA (GVL :PARENT :PARENT :LEFT))))
          (:TOP
           (ECLECTOR.READER:UNQUOTE
            (O-FORMULA
             (+ (GVL :PARENT :PARENT :BOUND-WIDTH) (GVL :PARENT :TOP)))))
          (:WIDTH
           (ECLECTOR.READER:UNQUOTE
            (O-FORMULA (GVL :PARENT :PARENT :BOUND-WIDTH))))
          (:HEIGHT (ECLECTOR.READER:UNQUOTE (O-FORMULA (GVL :WIDTH))))
          (:FILLING-STYLE
           (ECLECTOR.READER:UNQUOTE
            #S(FORMGREP:SYMREF :NAME "WHITE-FILL" :QUALIFIER "OPAL"))))
         (:BOT-TRILL
          (ECLECTOR.READER:UNQUOTE
           #S(FORMGREP:SYMREF :NAME "AGGREGADGET" :QUALIFIER "OPAL"))
          (:TOP
           (ECLECTOR.READER:UNQUOTE
            (O-FORMULA
             (+ (GVL :PARENT :TOP) (* (GVL :PARENT :PARENT :BOUND-WIDTH) 2)))))
          (:PARTS
           ((:BOX (ECLECTOR.READER:UNQUOTE OPEN-TRILL-BOX))
            (:ARROW (ECLECTOR.READER:UNQUOTE OPEN-DOWN-ARROW))))
          (:INTERACTORS
           ((:TRILL (ECLECTOR.READER:UNQUOTE OPEN-INTER)
             (:FINAL-FUNCTION
              (ECLECTOR.READER:UNQUOTE
               #'(LAMBDA (INTERACTOR OBJ)
                   (DECLARE (IGNORE INTERACTOR))
                   (LET* ((SLIDER (G-VALUE OBJ :PARENT :PARENT))
                          (VALUE (G-VALUE SLIDER :VALUE)))
                     (WHEN (< VALUE 100)
                       (S-VALUE SLIDER :VALUE (+ VALUE 1)))))))))))))))))
   (:INTERACTORS
    (ECLECTOR.READER:QUASIQUOTE
     ((:SLIDE
       (ECLECTOR.READER:UNQUOTE
        #S(FORMGREP:SYMREF :NAME "MOVE-GROW-INTERACTOR" :QUALIFIER "INTER"))
       (:WINDOW
        (ECLECTOR.READER:UNQUOTE
         (O-FORMULA (GV-LOCAL :SELF :OPERATES-ON :WINDOW))))
       (:CONTINUOUS T)
       (:START-WHERE
        (ECLECTOR.READER:UNQUOTE
         (O-FORMULA (LIST :IN-BOX (GVL :OPERATES-ON :INDICATOR :MIDDLE)))))
       (:RUNNING-WHERE
        (ECLECTOR.READER:UNQUOTE
         (O-FORMULA (LIST :IN-BOX (GVL :OPERATES-ON :BOUND-BOX)))))
       (:OUTSIDE NIL)
       (:OBJ-TO-CHANGE
        (ECLECTOR.READER:UNQUOTE (O-FORMULA (GVL :OPERATES-ON :INDICATOR))))
       (:OBJ-TO-BE-MOVED
        (ECLECTOR.READER:UNQUOTE (O-FORMULA (GVL :OPERATES-ON :INDICATOR))))
       (:FEEDBACK-OBJ
        (ECLECTOR.READER:UNQUOTE (O-FORMULA (GVL :OPERATES-ON :INDICATOR))))
       (:GROW-P NIL) (:ATTACH-POINT :WHERE-HIT)
       (:WAITING-PRIORITY
        (ECLECTOR.READER:UNQUOTE
         #S(FORMGREP:SYMREF :NAME "HIGH-PRIORITY-LEVEL" :QUALIFIER "INTER"))))
      (:JUMP
       (ECLECTOR.READER:UNQUOTE
        #S(FORMGREP:SYMREF :NAME "MOVE-GROW-INTERACTOR" :QUALIFIER "INTER"))
       (:WINDOW
        (ECLECTOR.READER:UNQUOTE
         (O-FORMULA (GV-LOCAL :SELF :OPERATES-ON :WINDOW))))
       (:CONTINUOUS T)
       (:START-WHERE
        (ECLECTOR.READER:UNQUOTE
         (O-FORMULA (LIST :IN-BOX (GVL :OPERATES-ON :BOUND-BOX)))))
       (:RUNNING-WHERE
        (ECLECTOR.READER:UNQUOTE
         (O-FORMULA (LIST :IN-BOX (GVL :OPERATES-ON :BOUND-BOX)))))
       (:OUTSIDE NIL)
       (:OBJ-TO-BE-MOVED
        (ECLECTOR.READER:UNQUOTE (O-FORMULA (GVL :OPERATES-ON :INDICATOR))))
       (:GROW-P NIL)
       (:START-ACTION
        (ECLECTOR.READER:UNQUOTE
         #'(LAMBDA (INTERACTOR OBJ-OVER POINTS-LIST)
             (DECLARE (IGNORE OBJ-OVER POINTS-LIST))
             (LET* ((INDICATOR (G-VALUE INTERACTOR :OBJ-TO-BE-MOVED))
                    (SLIDER (G-VALUE INDICATOR :PARENT))
                    (VALUE (G-VALUE SLIDER :VALUE)))
               (IF (> (G-VALUE INTERACTOR :Y-OFF) (G-VALUE INDICATOR :TOP))
                   (WHEN (<= VALUE 95) (S-VALUE SLIDER :VALUE (+ VALUE 5)))
                   (WHEN (>= VALUE 5)
                     (S-VALUE SLIDER :VALUE (- VALUE 5)))))))))
      (:WHEEL
       (ECLECTOR.READER:UNQUOTE
        #S(FORMGREP:SYMREF :NAME "BUTTON-INTERACTOR" :QUALIFIER "INTER"))
       (:WINDOW
        (ECLECTOR.READER:UNQUOTE
         (O-FORMULA (GV-LOCAL :SELF :OPERATES-ON :WINDOW))))
       (:CONTINUOUS NIL)
       (:START-WHERE
        (ECLECTOR.READER:UNQUOTE
         (O-FORMULA (LIST :IN-BOX (GVL :OPERATES-ON :BOUND-BOX)))))
       (:START-EVENT (:DOWNSCROLLUP :UPSCROLLUP))
       (:FINAL-FUNCTION
        (ECLECTOR.READER:UNQUOTE
         #'(LAMBDA (INTERACTOR OBJ)
             (DECLARE (OPTIMIZE (SPEED 1) (SAFETY 3) (DEBUG 3)))
             (LET* ((SLIDER (G-VALUE OBJ :PARENT))
                    (VALUE (G-VALUE SLIDER :VALUE)))
               (IF (EQ
                    (#S(FORMGREP:SYMREF :NAME "EVENT-CHAR" :QUALIFIER "INTER")
                     #S(FORMGREP:SYMREF
                        :NAME "*CURRENT-EVENT*"
                        :QUALIFIER "INTER"))
                    (FIRST (G-VALUE INTERACTOR :START-EVENT)))
                   (WHEN (< VALUE 100) (S-VALUE SLIDER :VALUE (+ VALUE 1)))
                   (WHEN (> VALUE 0)
                     (S-VALUE SLIDER :VALUE (- VALUE 1)))))))))))))

[cl-garnet/src/demos/demo-scrollbar.lisp:766]
  (CREATE-INSTANCE 'NEXT-SCROLLBAR
   #S(FORMGREP:SYMREF :NAME "AGGREGADGET" :QUALIFIER "OPAL") (:LEFT 50)
   (:TOP 20) (:WIDTH 23) (:HEIGHT 250)
   (:VALUE
    (O-FORMULA
     (#S(FORMGREP:SYMREF :NAME "CLIP-AND-MAP" :QUALIFIER "INTER")
      (SECOND (GVL :INDICATOR :BOX)) (GVL :BOUND-TOP)
      (- (GVL :BOUND-BOTTOM) (GVL :INDICATOR :HEIGHT) 2) 0 100)))
   (:TRILL-LEFT (O-FORMULA (+ (GVL :LEFT) 2)))
   (:TRILL-WIDTH (O-FORMULA (- (GVL :WIDTH) 4)))
   (:BOUND-TOP (O-FORMULA (+ 2 (GVL :TOP))))
   (:BOUND-HEIGHT (O-FORMULA (- (GVL :HEIGHT) (* 2 (GVL :TRILL-WIDTH)) 8)))
   (:BOUND-BOTTOM (O-FORMULA (+ (GVL :BOUND-TOP) (GVL :BOUND-HEIGHT))))
   (:PARTS
    (ECLECTOR.READER:QUASIQUOTE
     ((:BOUND-BOX
       (ECLECTOR.READER:UNQUOTE
        #S(FORMGREP:SYMREF :NAME "RECTANGLE" :QUALIFIER "OPAL"))
       (:LEFT (ECLECTOR.READER:UNQUOTE (O-FORMULA (GVL :PARENT :LEFT))))
       (:TOP (ECLECTOR.READER:UNQUOTE (O-FORMULA (GVL :PARENT :BOUND-TOP))))
       (:WIDTH (ECLECTOR.READER:UNQUOTE (O-FORMULA (GVL :PARENT :WIDTH))))
       (:HEIGHT
        (ECLECTOR.READER:UNQUOTE (O-FORMULA (GVL :PARENT :BOUND-HEIGHT))))
       (:LINE-STYLE NIL))
      (:OUTLINE
       (ECLECTOR.READER:UNQUOTE
        #S(FORMGREP:SYMREF :NAME "RECTANGLE" :QUALIFIER "OPAL"))
       (:LEFT (ECLECTOR.READER:UNQUOTE (O-FORMULA (GVL :PARENT :LEFT))))
       (:TOP (ECLECTOR.READER:UNQUOTE (O-FORMULA (GVL :PARENT :TOP))))
       (:WIDTH (ECLECTOR.READER:UNQUOTE (O-FORMULA (GVL :PARENT :WIDTH))))
       (:HEIGHT (ECLECTOR.READER:UNQUOTE (O-FORMULA (GVL :PARENT :HEIGHT))))
       (:FILLING-STYLE
        (ECLECTOR.READER:UNQUOTE
         #S(FORMGREP:SYMREF :NAME "WHITE-FILL" :QUALIFIER "OPAL"))))
      (:BACKGROUND
       (ECLECTOR.READER:UNQUOTE
        #S(FORMGREP:SYMREF :NAME "RECTANGLE" :QUALIFIER "OPAL"))
       (:LEFT (ECLECTOR.READER:UNQUOTE (O-FORMULA (+ 2 (GVL :PARENT :LEFT)))))
       (:TOP (ECLECTOR.READER:UNQUOTE (O-FORMULA (+ 2 (GVL :PARENT :TOP)))))
       (:WIDTH
        (ECLECTOR.READER:UNQUOTE (O-FORMULA (- (GVL :PARENT :WIDTH) 3))))
       (:HEIGHT
        (ECLECTOR.READER:UNQUOTE (O-FORMULA (- (GVL :PARENT :HEIGHT) 3))))
       (:LINE-STYLE NIL)
       (:FILLING-STYLE (ECLECTOR.READER:UNQUOTE BLUE-GRAY-FILL)))
      (:TOP-TRILL
       (ECLECTOR.READER:UNQUOTE
        #S(FORMGREP:SYMREF :NAME "AGGREGADGET" :QUALIFIER "OPAL"))
       (:TOP
        (ECLECTOR.READER:UNQUOTE
         (O-FORMULA (+ (GVL :PARENT :BOUND-BOTTOM) 2))))
       (:HEIGHT
        (ECLECTOR.READER:UNQUOTE (O-FORMULA (GVL :PARENT :TRILL-WIDTH))))
       (:PARTS
        ((:BOX (ECLECTOR.READER:UNQUOTE NEXT-SHADOW-BOX))
         (:ARROW (ECLECTOR.READER:UNQUOTE NEXT-UP-ARROW))))
       (:INTERACTORS
        ((:TRILL (ECLECTOR.READER:UNQUOTE NEXT-INTER)
          (:FINAL-FUNCTION
           (ECLECTOR.READER:UNQUOTE
            #'(LAMBDA (INTERACTOR OBJ)
                (DECLARE (IGNORE INTERACTOR))
                (LET* ((SLIDER (G-VALUE OBJ :PARENT))
                       (VALUE (G-VALUE SLIDER :VALUE)))
                  (WHEN (> VALUE 1)
                    (S-VALUE SLIDER :VALUE (- VALUE 1)))))))))))
      (:BOT-TRILL
       (ECLECTOR.READER:UNQUOTE
        #S(FORMGREP:SYMREF :NAME "AGGREGADGET" :QUALIFIER "OPAL"))
       (:TOP
        (ECLECTOR.READER:UNQUOTE
         (O-FORMULA
          (+ (GVL :PARENT :BOUND-BOTTOM) (GVL :PARENT :TRILL-WIDTH) 4))))
       (:HEIGHT
        (ECLECTOR.READER:UNQUOTE (O-FORMULA (GVL :PARENT :TRILL-WIDTH))))
       (:PARTS
        ((:BOX (ECLECTOR.READER:UNQUOTE NEXT-SHADOW-BOX))
         (:ARROW (ECLECTOR.READER:UNQUOTE NEXT-DOWN-ARROW))))
       (:INTERACTORS
        ((:TRILL (ECLECTOR.READER:UNQUOTE NEXT-INTER)
          (:FINAL-FUNCTION
           (ECLECTOR.READER:UNQUOTE
            #'(LAMBDA (INTERACTOR OBJ)
                (DECLARE (IGNORE INTERACTOR))
                (LET* ((SLIDER (G-VALUE OBJ :PARENT))
                       (VALUE (G-VALUE SLIDER :VALUE)))
                  (WHEN (< VALUE 100)
                    (S-VALUE SLIDER :VALUE (+ VALUE 1)))))))))))
      (:INDICATOR
       (ECLECTOR.READER:UNQUOTE
        #S(FORMGREP:SYMREF :NAME "AGGREGADGET" :QUALIFIER "OPAL"))
       (:BOX (0 50 0 0))
       (:LEFT (ECLECTOR.READER:UNQUOTE (O-FORMULA (GVL :PARENT :TRILL-LEFT))))
       (:TOP
        (ECLECTOR.READER:UNQUOTE
         (O-FORMULA
          (LET ((PARENT (GVL :PARENT)))
            (#S(FORMGREP:SYMREF :NAME "CLIP-AND-MAP" :QUALIFIER "INTER")
             (GV PARENT :VALUE) 0 100 (GV PARENT :BOUND-TOP)
             (- (GV PARENT :BOUND-BOTTOM) (GVL :HEIGHT)))))))
       (:WIDTH
        (ECLECTOR.READER:UNQUOTE (O-FORMULA (GVL :PARENT :TRILL-WIDTH))))
       (:HEIGHT
        (ECLECTOR.READER:UNQUOTE
         (O-FORMULA (FLOOR (GVL :PARENT :BOUND-HEIGHT) 2))))
       (:CIRCLE-LEFT
        (ECLECTOR.READER:UNQUOTE
         (O-FORMULA (- (+ (GVL :LEFT) (FLOOR (GVL :WIDTH) 2)) 5))))
       (:CIRCLE-TOP
        (ECLECTOR.READER:UNQUOTE
         (O-FORMULA (- (+ (GVL :TOP) (FLOOR (GVL :HEIGHT) 2)) 5))))
       (:PARTS
        ((:RECT (ECLECTOR.READER:UNQUOTE NEXT-SHADOW-BOX))
         (:CIRC
          (ECLECTOR.READER:UNQUOTE
           #S(FORMGREP:SYMREF :NAME "CIRCLE" :QUALIFIER "OPAL"))
          (:LEFT
           (ECLECTOR.READER:UNQUOTE (O-FORMULA (GVL :PARENT :CIRCLE-LEFT))))
          (:TOP
           (ECLECTOR.READER:UNQUOTE (O-FORMULA (GVL :PARENT :CIRCLE-TOP))))
          (:WIDTH 10) (:HEIGHT 10)
          (:FILLING-STYLE
           (ECLECTOR.READER:UNQUOTE
            #S(FORMGREP:SYMREF :NAME "WHITE-FILL" :QUALIFIER "OPAL"))))
         (:SEMI
          (ECLECTOR.READER:UNQUOTE
           #S(FORMGREP:SYMREF :NAME "ARC" :QUALIFIER "OPAL"))
          (:LEFT
           (ECLECTOR.READER:UNQUOTE
            (O-FORMULA (+ 2 (GVL :PARENT :CIRCLE-LEFT)))))
          (:TOP
           (ECLECTOR.READER:UNQUOTE
            (O-FORMULA (+ 2 (GVL :PARENT :CIRCLE-TOP)))))
          (:WIDTH 8) (:HEIGHT 8) (:ANGLE1 (ECLECTOR.READER:UNQUOTE (/ PI 4)))
          (:ANGLE2 (ECLECTOR.READER:UNQUOTE PI)))))))))
   (:INTERACTORS
    (ECLECTOR.READER:QUASIQUOTE
     ((:SLIDE
       (ECLECTOR.READER:UNQUOTE
        #S(FORMGREP:SYMREF :NAME "MOVE-GROW-INTERACTOR" :QUALIFIER "INTER"))
       (:WINDOW
        (ECLECTOR.READER:UNQUOTE
         (O-FORMULA (GV-LOCAL :SELF :OPERATES-ON :WINDOW))))
       (:CONTINUOUS T)
       (:START-WHERE
        (ECLECTOR.READER:UNQUOTE
         (O-FORMULA (LIST :IN-BOX (GVL :OPERATES-ON :INDICATOR)))))
       (:RUNNING-WHERE
        (ECLECTOR.READER:UNQUOTE
         (O-FORMULA (LIST :IN-BOX (GVL :OPERATES-ON :BOUND-BOX)))))
       (:OUTSIDE NIL)
       (:OBJ-TO-BE-MOVED
        (ECLECTOR.READER:UNQUOTE (O-FORMULA (GVL :OPERATES-ON :INDICATOR))))
       (:FEEDBACK-OBJ
        (ECLECTOR.READER:UNQUOTE (O-FORMULA (GVL :OPERATES-ON :INDICATOR))))
       (:GROW-P NIL) (:ATTACH-POINT :WHERE-HIT)
       (:WAITING-PRIORITY
        (ECLECTOR.READER:UNQUOTE
         #S(FORMGREP:SYMREF :NAME "HIGH-PRIORITY-LEVEL" :QUALIFIER "INTER"))))
      (:JUMP
       (ECLECTOR.READER:UNQUOTE
        #S(FORMGREP:SYMREF :NAME "MOVE-GROW-INTERACTOR" :QUALIFIER "INTER"))
       (:WINDOW
        (ECLECTOR.READER:UNQUOTE
         (O-FORMULA (GV-LOCAL :SELF :OPERATES-ON :WINDOW))))
       (:CONTINUOUS T)
       (:START-WHERE
        (ECLECTOR.READER:UNQUOTE
         (O-FORMULA (LIST :IN-BOX (GVL :OPERATES-ON :BOUND-BOX)))))
       (:RUNNING-WHERE
        (ECLECTOR.READER:UNQUOTE
         (O-FORMULA (LIST :IN-BOX (GVL :OPERATES-ON :BOUND-BOX)))))
       (:OUTSIDE NIL)
       (:OBJ-TO-BE-MOVED
        (ECLECTOR.READER:UNQUOTE (O-FORMULA (GVL :OPERATES-ON :INDICATOR))))
       (:GROW-P NIL)
       (:START-ACTION
        (ECLECTOR.READER:UNQUOTE
         #'(LAMBDA (INTERACTOR OBJ-OVER POINTS-LIST)
             (DECLARE (IGNORE OBJ-OVER POINTS-LIST))
             (LET* ((INDICATOR (G-VALUE INTERACTOR :OBJ-TO-BE-MOVED))
                    (SLIDER (G-VALUE INDICATOR :PARENT))
                    (VALUE (G-VALUE SLIDER :VALUE)))
               (IF (> (G-VALUE INTERACTOR :Y-OFF) (G-VALUE INDICATOR :TOP))
                   (WHEN (<= VALUE 95) (S-VALUE SLIDER :VALUE (+ VALUE 5)))
                   (WHEN (>= VALUE 5)
                     (S-VALUE SLIDER :VALUE (- VALUE 5)))))))))
      (:WHEEL
       (ECLECTOR.READER:UNQUOTE
        #S(FORMGREP:SYMREF :NAME "BUTTON-INTERACTOR" :QUALIFIER "INTER"))
       (:WINDOW
        (ECLECTOR.READER:UNQUOTE
         (O-FORMULA (GV-LOCAL :SELF :OPERATES-ON :WINDOW))))
       (:CONTINUOUS NIL) (:START-EVENT (:DOWNSCROLLUP :UPSCROLLUP))
       (:START-WHERE
        (ECLECTOR.READER:UNQUOTE
         (O-FORMULA (LIST :IN-BOX (GVL :OPERATES-ON :BOUND-BOX)))))
       (:OUTSIDE NIL)
       (:FINAL-FUNCTION
        (ECLECTOR.READER:UNQUOTE
         #'(LAMBDA (INTERACTOR OBJ)
             (DECLARE (OPTIMIZE (SPEED 1) (SAFETY 3) (DEBUG 3)))
             (LET* ((SLIDER (G-VALUE OBJ :PARENT))
                    (VALUE (G-VALUE SLIDER :VALUE)))
               (IF (EQ
                    (#S(FORMGREP:SYMREF :NAME "EVENT-CHAR" :QUALIFIER "INTER")
                     #S(FORMGREP:SYMREF
                        :NAME "*CURRENT-EVENT*"
                        :QUALIFIER "INTER"))
                    (FIRST (G-VALUE INTERACTOR :START-EVENT)))
                   (WHEN (< VALUE 100) (S-VALUE SLIDER :VALUE (+ VALUE 1)))
                   (WHEN (> VALUE 0)
                     (S-VALUE SLIDER :VALUE (- VALUE 1)))))))))))))

[cl-garnet/src/gadgets/gauge.lisp:301]
  (CREATE-INSTANCE 'GAUGE
   #S(FORMGREP:SYMREF :NAME "AGGREGADGET" :QUALIFIER "OPAL") :DECLARE
   ((:PARAMETERS :LEFT :TOP :WIDTH :VAL-1 :VAL-2 :NUM-MARKS :TIC-MARKS-P
     :ENUMERATE-P :VALUE-FEEDBACK-P :POLYGON-NEEDLE-P :INT-FEEDBACK-P
     :TEXT-OFFSET :TITLE :TITLE-FONT :VALUE-FONT :ENUM-FONT :FORMAT-STRING
     :ENUM-FORMAT-STRING :VALUE :SELECTION-FUNCTION :VISIBLE)
    (:TYPE (NUMBER :VAL-1 :VAL-2 :VALUE) ((INTEGER 2) :NUM-MARKS)
     ((INTEGER 0) :TEXT-OFFSET)
     (KR-BOOLEAN :TIC-MARKS-P :ENUMERATE-P :VALUE-FEEDBACK-P :POLYGON-NEEDLE-P
      :INT-FEEDBACK-P)
     (STRING :FORMAT-STRING :ENUM-FORMAT-STRING) ((OR NULL STRING) :TITLE)
     ((OR (IS-A-P #S(FORMGREP:SYMREF :NAME "FONT" :QUALIFIER "OPAL"))
          (IS-A-P
           #S(FORMGREP:SYMREF :NAME "FONT-FROM-FILE" :QUALIFIER "OPAL")))
      :TITLE-FONT :VALUE-FONT :ENUM-FONT)
     ((OR NULL FUNCTION SYMBOL) :SELECTION-FUNCTION))
    (:MAYBE-CONSTANT :LEFT :TOP :WIDTH :POLYGON-NEEDLE-P :INT-FEEDBACK-P :TITLE
     :TITLE-FONT :VALUE-FONT :ENUM-FONT :NUM-MARKS :TIC-MARKS-P :ENUMERATE-P
     :VALUE-FEEDBACK-P :TEXT-OFFSET :VAL-1 :VAL-2 :FORMAT-STRING
     :ENUM-FORMAT-STRING :VISIBLE))
   (:LEFT 0) (:TOP 0) (:WIDTH 230) (:POLYGON-NEEDLE-P T) (:INT-FEEDBACK-P T)
   (:TITLE "Gauge")
   (:TITLE-FONT #S(FORMGREP:SYMREF :NAME "DEFAULT-FONT" :QUALIFIER "OPAL"))
   (:VALUE-FONT #S(FORMGREP:SYMREF :NAME "DEFAULT-FONT" :QUALIFIER "OPAL"))
   (:ENUM-FONT
    (#S(FORMGREP:SYMREF :NAME "GET-STANDARD-FONT" :QUALIFIER "OPAL") :FIXED
     :ROMAN :SMALL))
   (:NUM-MARKS 10) (:TIC-MARKS-P T) (:ENUMERATE-P T) (:VALUE-FEEDBACK-P T)
   (:FORMAT-STRING "~a") (:ENUM-FORMAT-STRING "~a") (:TEXT-OFFSET 5) (:VAL-1 0)
   (:VAL-2 180) (:SELECTION-FUNCTION NIL)
   (:ANGLE
    (O-FORMULA
     (#S(FORMGREP:SYMREF :NAME "CLIP-AND-MAP" :QUALIFIER "INTER") (GVL :VALUE)
      (GVL :VAL-1) (GVL :VAL-2) 0 PI)
     (/ #S(FORMGREP:SYMREF :NAME "SHORT-PI" :QUALIFIER "GU") 3)))
   (:VALUE
    (O-FORMULA
     (#S(FORMGREP:SYMREF :NAME "CLIP-AND-MAP" :QUALIFIER "INTER") (GVL :ANGLE)
      0 (COERCE PI 'SHORT-FLOAT) (GVL :VAL-1) (GVL :VAL-2))
     (/ #S(FORMGREP:SYMREF :NAME "SHORT-PI" :QUALIFIER "GU") 3)))
   (:NEEDLE-LENGTH (O-FORMULA (* (GVL :RADIUS) 0.8)))
   (:INV-BASE-LENGTH (O-FORMULA (/ 15.0 (GVL :NEEDLE-LENGTH))))
   (:VAL-1-WIDTH
    (O-FORMULA
     (#S(FORMGREP:SYMREF :NAME "STRING-WIDTH" :QUALIFIER "OPAL")
      (GVL :ENUM-FONT) (FORMAT NIL (GVL :ENUM-FORMAT-STRING) (GVL :VAL-1)))))
   (:VAL-2-WIDTH
    (O-FORMULA
     (#S(FORMGREP:SYMREF :NAME "STRING-WIDTH" :QUALIFIER "OPAL")
      (GVL :ENUM-FONT) (FORMAT NIL (GVL :ENUM-FORMAT-STRING) (GVL :VAL-2)))))
   (:ENUM-HEIGHT
    (O-FORMULA
     (#S(FORMGREP:SYMREF :NAME "STRING-HEIGHT" :QUALIFIER "OPAL")
      (GVL :ENUM-FONT) "0")))
   (:CIRCLE-LEFT
    (O-FORMULA
     (IF (GVL :ENUMERATE-P)
         (+ 5 (GVL :LEFT) (GVL :VAL-2-WIDTH))
         (GVL :LEFT))))
   (:CIRCLE-TOP
    (O-FORMULA
     (IF (GVL :ENUMERATE-P)
         (+ 8 (GVL :TOP) (GVL :ENUM-HEIGHT))
         (GVL :TOP))))
   (:CIRCLE-WIDTH
    (O-FORMULA
     (- (GVL :WIDTH)
        (IF (GVL :ENUMERATE-P)
            (+ (GVL :VAL-1-WIDTH) (GVL :VAL-2-WIDTH) (* 2 (GVL :TEXT-OFFSET)))
            0))))
   (:RADIUS (O-FORMULA (ROUND (GVL :CIRCLE-WIDTH) 2)))
   (:CENTER-X (O-FORMULA (+ (GVL :CIRCLE-LEFT) (GVL :RADIUS))))
   (:CENTER-Y (O-FORMULA (+ (GVL :CIRCLE-TOP) (GVL :RADIUS))))
   (:HEIGHT
    (O-FORMULA
     (-
      (IF (GVL :VALUE-FEEDBACK-P)
          (#S(FORMGREP:SYMREF :NAME "GV-BOTTOM" :QUALIFIER "OPAL")
           (GVL :VALUE-FEEDBACK))
          (IF (GVL :TITLE)
              (#S(FORMGREP:SYMREF :NAME "GV-BOTTOM" :QUALIFIER "OPAL")
               (GVL :GAUGE-TITLE))
              (+ (GVL :CENTER-Y) (ROUND (* (GVL :NEEDLE-LENGTH) 0.2)))))
      (GVL :TOP))))
   (:PARTS
    (ECLECTOR.READER:QUASIQUOTE
     ((:SEMI-CIRC (ECLECTOR.READER:UNQUOTE GAUGE-SEMI-CIRC))
      (:BASE-LINE (ECLECTOR.READER:UNQUOTE GAUGE-BASE-LINE))
      (:TIC-MARKS (ECLECTOR.READER:UNQUOTE GAUGE-TIC-MARKS))
      (:NEEDLE1 (ECLECTOR.READER:UNQUOTE GAUGE-NEEDLE1))
      (:NEEDLE2 (ECLECTOR.READER:UNQUOTE GAUGE-NEEDLE2))
      (:INT-FEEDBACK (ECLECTOR.READER:UNQUOTE GAUGE-INT-FEEDBACK))
      (:GAUGE-TITLE (ECLECTOR.READER:UNQUOTE GAUGE-TITLE))
      (:VALUE-FEEDBACK (ECLECTOR.READER:UNQUOTE GAUGE-VALUE-FEEDBACK)))))
   (:INTERACTORS
    (ECLECTOR.READER:QUASIQUOTE
     ((:ROTATE
       (ECLECTOR.READER:UNQUOTE
        #S(FORMGREP:SYMREF :NAME "ANGLE-INTERACTOR" :QUALIFIER "INTER"))
       (:WINDOW
        (ECLECTOR.READER:UNQUOTE
         (O-FORMULA (GV-LOCAL :SELF :OPERATES-ON :WINDOW))))
       (:OUTSIDE :LAST)
       (:START-WHERE
        (ECLECTOR.READER:UNQUOTE
         (O-FORMULA
          (LIST :CUSTOM (GV-LOCAL :SELF :OPERATES-ON)
                #'(LAMBDA (GAUGE INTER EVENT)
                    (DECLARE (IGNORE INTER))
                    (LET* ((MOUSE-X
                            (#S(FORMGREP:SYMREF
                                :NAME "EVENT-X"
                                :QUALIFIER "INTER")
                             EVENT))
                           (MOUSE-Y
                            (#S(FORMGREP:SYMREF
                                :NAME "EVENT-Y"
                                :QUALIFIER "INTER")
                             EVENT))
                           (CENTER-X (G-VALUE GAUGE :CENTER-X))
                           (CENTER-Y (G-VALUE GAUGE :CENTER-Y)))
                      (AND (<= MOUSE-Y CENTER-Y)
                           (<
                            (SQRT
                             (+ (EXPT (- CENTER-X MOUSE-X) 2)
                                (EXPT (- CENTER-Y MOUSE-Y) 2)))
                            (G-VALUE GAUGE :RADIUS))
                           GAUGE)))))))
       (:CENTER-OF-ROTATION
        (ECLECTOR.READER:UNQUOTE
         (O-FORMULA
          (LIST (GV (KR-PATH 0 :OPERATES-ON) :CENTER-X)
                (GV (KR-PATH 0 :OPERATES-ON) :CENTER-Y)))))
       (:OBJ-TO-CHANGE
        (ECLECTOR.READER:UNQUOTE (O-FORMULA (KR-PATH 0 :OPERATES-ON))))
       (:FEEDBACK-OBJ
        (ECLECTOR.READER:UNQUOTE
         (O-FORMULA
          (WHEN (GV (KR-PATH 0 :OPERATES-ON) :INT-FEEDBACK-P)
            (GV (KR-PATH 0 :OPERATES-ON) :INT-FEEDBACK)))))
       (:OUTSIDE-ACTION
        (ECLECTOR.READER:UNQUOTE
         #'(LAMBDA (AN-INTER OUTSIDE-CONTROL OBJ)
             (DECLARE (IGNORE OUTSIDE-CONTROL))
             (LET* ((ANGLE-OBJ (OR (G-VALUE AN-INTER :FEEDBACK-OBJ) OBJ))
                    (NEW-ANGLE
                     (IF (> (G-VALUE ANGLE-OBJ :ANGLE) 1.5)
                         #S(FORMGREP:SYMREF :NAME "SHORT-PI" :QUALIFIER "GU")
                         0)))
               (S-VALUE AN-INTER :SAVED-LAST-ANGLE
                (S-VALUE ANGLE-OBJ :ANGLE NEW-ANGLE))))))
       (:RUNNING-ACTION
        (ECLECTOR.READER:UNQUOTE
         #'(LAMBDA (INTERACTOR OBJ ANGLE DELTA)
             (CALL-PROTOTYPE-METHOD INTERACTOR OBJ ANGLE DELTA)
             (LET ((GAUGE (G-VALUE INTERACTOR :OPERATES-ON)))
               (WHEN (NOT (G-VALUE GAUGE :INT-FEEDBACK-P))
                 (KR-SEND GAUGE :SELECTION-FUNCTION GAUGE
                  (G-VALUE GAUGE :VALUE)))))))
       (:FINAL-FUNCTION
        (ECLECTOR.READER:UNQUOTE
         #'(LAMBDA (INTERACTOR ANGLE)
             (DECLARE (IGNORE ANGLE))
             (LET ((GAUGE (G-VALUE INTERACTOR :OPERATES-ON)))
               (KR-SEND GAUGE :SELECTION-FUNCTION GAUGE
                (G-VALUE GAUGE :VALUE)))))))
      (:WHEEL
       (ECLECTOR.READER:UNQUOTE
        #S(FORMGREP:SYMREF :NAME "BUTTON-INTERACTOR" :QUALIFIER "INTER"))
       (:WINDOW
        (ECLECTOR.READER:UNQUOTE
         (O-FORMULA (GV-LOCAL :SELF :OPERATES-ON :WINDOW))))
       (:CONTINUOUS NIL)
       (:OBJ-TO-CHANGE
        (ECLECTOR.READER:UNQUOTE (O-FORMULA (KR-PATH 0 :OPERATES-ON))))
       (:INC-BY
        (ECLECTOR.READER:UNQUOTE
         (O-FORMULA (GV (KR-PATH 0 :PARENT) :SCR-INCR))))
       (:START-WHERE
        (ECLECTOR.READER:UNQUOTE
         (O-FORMULA
          (LIST :CUSTOM (GV-LOCAL :SELF :OPERATES-ON)
                #'(LAMBDA (GAUGE INTER EVENT)
                    (DECLARE (IGNORE INTER))
                    (LET* ((MOUSE-X
                            (#S(FORMGREP:SYMREF
                                :NAME "EVENT-X"
                                :QUALIFIER "INTER")
                             EVENT))
                           (MOUSE-Y
                            (#S(FORMGREP:SYMREF
                                :NAME "EVENT-Y"
                                :QUALIFIER "INTER")
                             EVENT))
                           (CENTER-X (G-VALUE GAUGE :CENTER-X))
                           (CENTER-Y (G-VALUE GAUGE :CENTER-Y)))
                      (AND (<= MOUSE-Y CENTER-Y)
                           (<
                            (+ (EXPT (- CENTER-X MOUSE-X) 2)
                               (EXPT (- CENTER-Y MOUSE-Y) 2))
                            (EXPT (G-VALUE GAUGE :RADIUS) 2))
                           GAUGE)))))))
       (:START-EVENT (:UPSCROLLUP :DOWNSCROLLUP))
       (:FINAL-FUNCTION
        (ECLECTOR.READER:UNQUOTE
         #'(LAMBDA (INTERACTOR OBJ)
             (DECLARE (IGNORE OBJ))
             (DECLARE (OPTIMIZE (SPEED 2) (SAFETY 3) (DEBUG 3)))
             (LET* ((BAR (G-VALUE INTERACTOR :OPERATES-ON))
                    (VALUE (G-VALUE BAR :VALUE))
                    (VAL-1 (G-VALUE BAR :VAL-1))
                    (VAL-2 (G-VALUE BAR :VAL-2))
                    (INC-BY (OR (G-VALUE BAR :SCR-INCR) 5))
                    (UP-OR-LEFT (FIRST (G-VALUE INTERACTOR :START-EVENT))))
               (IF (EQ
                    (#S(FORMGREP:SYMREF :NAME "EVENT-CHAR" :QUALIFIER "INTER")
                     #S(FORMGREP:SYMREF
                        :NAME "*CURRENT-EVENT*"
                        :QUALIFIER "INTER"))
                    UP-OR-LEFT)
                   (IF (< VAL-1 VAL-2)
                       (LET ((THRESH-VAL (+ VAL-1 INC-BY)))
                         (IF (> VALUE THRESH-VAL)
                             (S-VALUE BAR :VALUE (- VALUE INC-BY))
                             (S-VALUE BAR :VALUE VAL-1)))
                       (LET ((THRESH-VAL (- VAL-1 INC-BY)))
                         (IF (< VALUE THRESH-VAL)
                             (S-VALUE BAR :VALUE (+ VALUE INC-BY))
                             (S-VALUE BAR :VALUE VAL-1))))
                   (IF (< VAL-1 VAL-2)
                       (LET ((THRESH-VAL (- VAL-2 INC-BY)))
                         (IF (< VALUE THRESH-VAL)
                             (S-VALUE BAR :VALUE (+ VALUE INC-BY))
                             (S-VALUE BAR :VALUE VAL-2)))
                       (LET ((THRESH-VAL (+ VAL-2 INC-BY)))
                         (IF (> VALUE THRESH-VAL)
                             (S-VALUE BAR :VALUE (- VALUE INC-BY))
                             (S-VALUE BAR :VALUE VAL-2)))))
               (KR-SEND BAR :SELECTION-FUNCTION BAR
                (G-VALUE BAR :VALUE)))))))))))

[cl-garnet/src/gem/x.lisp:377]
  (DEFUN SET-FILLING-STYLE (FILLING-STYLE GEM-GC XLIB-GC ROOT-WINDOW X-DRAW-FN)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (SPACE 0) (DEBUG 2)))
    (WHEN FILLING-STYLE
      (UNLESS (EQ X-DRAW-FN BOOLE-2)
        (LET ((X-STIPPLE (GET-X-STIPPLE FILLING-STYLE ROOT-WINDOW)))
          (WHEN
              (OR (SET-GC GEM-GC XLIB-GC :FUNCTION X-DRAW-FN)
                  (NOT (EQ FILLING-STYLE (GEM-GC-OPAL-STYLE GEM-GC))))
            (SET-GC GEM-GC XLIB-GC :FOREGROUND
             (G-VALUE FILLING-STYLE :FOREGROUND-COLOR :COLORMAP-INDEX))
            (SET-GC GEM-GC XLIB-GC :BACKGROUND
             (G-VALUE FILLING-STYLE :BACKGROUND-COLOR :COLORMAP-INDEX)))
          (UNLESS (EQ FILLING-STYLE (GEM-GC-OPAL-STYLE GEM-GC))
            (SETF (GEM-GC-OPAL-STYLE GEM-GC) FILLING-STYLE)
            (SET-GC GEM-GC XLIB-GC :FILL-STYLE
             (G-VALUE FILLING-STYLE :FILL-STYLE))
            (SET-GC GEM-GC XLIB-GC :FILL-RULE
             (G-VALUE FILLING-STYLE :FILL-RULE)))
          (IF X-STIPPLE
              (SET-GC GEM-GC XLIB-GC :STIPPLE X-STIPPLE))))
      (SET-GC GEM-GC XLIB-GC :FUNCTION X-DRAW-FN)))

[cl-garnet/src/jewel/x.lisp:324]
  (DEFUN SET-LINE-STYLE (LINE-STYLE GEM-GC XLIB-GC ROOT-WINDOW X-DRAW-FN)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (WHEN LINE-STYLE
      (LET ((DRAW-FN-CHANGED? (SET-GC GEM-GC XLIB-GC :FUNCTION X-DRAW-FN)))
        (UNLESS (EQ X-DRAW-FN BOOLE-2)
          (LET ((X-STIPPLE (GET-X-STIPPLE LINE-STYLE ROOT-WINDOW))
                X-DASH-PATTERN)
            (WHEN
                (OR DRAW-FN-CHANGED?
                    (NOT (EQ LINE-STYLE (GEM-GC-OPAL-STYLE GEM-GC))))
              (SET-GC GEM-GC XLIB-GC :FOREGROUND
               (G-VALUE LINE-STYLE :FOREGROUND-COLOR :COLORMAP-INDEX))
              (SET-GC GEM-GC XLIB-GC :BACKGROUND
               (G-VALUE LINE-STYLE :BACKGROUND-COLOR :COLORMAP-INDEX)))
            (UNLESS (EQ LINE-STYLE (GEM-GC-OPAL-STYLE GEM-GC))
              (SETF (GEM-GC-OPAL-STYLE GEM-GC) LINE-STYLE)
              (SET-GC GEM-GC XLIB-GC :LINE-WIDTH
               (G-VALUE LINE-STYLE :LINE-THICKNESS))
              (SET-GC GEM-GC XLIB-GC :LINE-STYLE
               (G-VALUE LINE-STYLE :LINE-STYLE))
              (SET-GC GEM-GC XLIB-GC :CAP-STYLE
               (G-VALUE LINE-STYLE :CAP-STYLE))
              (SET-GC GEM-GC XLIB-GC :JOIN-STYLE
               (G-VALUE LINE-STYLE :JOIN-STYLE))
              (IF (SETQ X-DASH-PATTERN (G-VALUE LINE-STYLE :DASH-PATTERN))
                  (SET-GC GEM-GC XLIB-GC :DASHES X-DASH-PATTERN)))
            (IF X-STIPPLE
                (PROGN
                 (SET-GC GEM-GC XLIB-GC :FILL-STYLE :OPAQUE-STIPPLED)
                 (SET-GC GEM-GC XLIB-GC :STIPPLE X-STIPPLE))
                (SET-GC GEM-GC XLIB-GC :FILL-STYLE :SOLID)))))))

[cl-garnet/src/jewel/x.lisp:372]
  (DEFUN SET-FILLING-STYLE (FILLING-STYLE GEM-GC XLIB-GC ROOT-WINDOW X-DRAW-FN)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (SPACE 0) (DEBUG 2)))
    (WHEN FILLING-STYLE
      (UNLESS (EQ X-DRAW-FN BOOLE-2)
        (LET ((X-STIPPLE (GET-X-STIPPLE FILLING-STYLE ROOT-WINDOW)))
          (WHEN
              (OR (SET-GC GEM-GC XLIB-GC :FUNCTION X-DRAW-FN)
                  (NOT (EQ FILLING-STYLE (GEM-GC-OPAL-STYLE GEM-GC))))
            (SET-GC GEM-GC XLIB-GC :FOREGROUND
             (G-VALUE FILLING-STYLE :FOREGROUND-COLOR :COLORMAP-INDEX))
            (SET-GC GEM-GC XLIB-GC :BACKGROUND
             (G-VALUE FILLING-STYLE :BACKGROUND-COLOR :COLORMAP-INDEX)))
          (UNLESS (EQ FILLING-STYLE (GEM-GC-OPAL-STYLE GEM-GC))
            (SETF (GEM-GC-OPAL-STYLE GEM-GC) FILLING-STYLE)
            (SET-GC GEM-GC XLIB-GC :FILL-STYLE
             (G-VALUE FILLING-STYLE :FILL-STYLE))
            (SET-GC GEM-GC XLIB-GC :FILL-RULE
             (G-VALUE FILLING-STYLE :FILL-RULE)))
          (IF X-STIPPLE
              (SET-GC GEM-GC XLIB-GC :STIPPLE X-STIPPLE))))
      (SET-GC GEM-GC XLIB-GC :FUNCTION X-DRAW-FN)))

[cl-garnet/src/jewel/x.lisp:998]
  (DEFUN X-DRAW-TEXT
         (WINDOW X Y STRING FONT FUNCTION LINE-STYLE
          &OPTIONAL FILL-BACKGROUND INVERT-P)
    (DECLARE (FIXNUM X Y))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0) (SPACE 1)))
    (SETF FONT (G-VALUE FONT :XFONT))
    (SETF FUNCTION (GET FUNCTION :X-DRAW-FUNCTION))
    (LET* ((DISPLAY-INFO (G-VALUE WINDOW :DISPLAY-INFO))
           (ROOT-WINDOW (DISPLAY-INFO-ROOT-WINDOW DISPLAY-INFO))
           (DRAWABLE (THE-DRAWABLE WINDOW)))
      (IF (AND LINE-STYLE FONT)
          (LET* ((LINE-STYLE-GC (DISPLAY-INFO-LINE-STYLE-GC DISPLAY-INFO))
                 (XLIB-GC-LINE (GEM-GC-GCONTEXT LINE-STYLE-GC)))
            (SET-LINE-STYLE LINE-STYLE LINE-STYLE-GC XLIB-GC-LINE ROOT-WINDOW
             FUNCTION)
            (SET-GC LINE-STYLE-GC XLIB-GC-LINE :FONT FONT)
            (IF FILL-BACKGROUND
                (LET ((BACKGROUND
                       (G-VALUE LINE-STYLE :BACKGROUND-COLOR :COLORMAP-INDEX))
                      (FOREGROUND
                       (IF INVERT-P
                           (G-VALUE LINE-STYLE :FOREGROUND-COLOR
                            :COLORMAP-INDEX))))
                  (IF INVERT-P
                      (PROGN
                       (SET-GC LINE-STYLE-GC XLIB-GC-LINE :FOREGROUND
                        BACKGROUND)
                       (SET-GC LINE-STYLE-GC XLIB-GC-LINE :BACKGROUND
                        FOREGROUND))
                      (SET-GC LINE-STYLE-GC XLIB-GC-LINE :BACKGROUND
                       BACKGROUND))
                  (#S(FORMGREP:SYMREF
                      :NAME "DRAW-IMAGE-GLYPHS"
                      :QUALIFIER "XLIB")
                   DRAWABLE XLIB-GC-LINE X Y STRING)
                  (WHEN INVERT-P
                    (SET-GC LINE-STYLE-GC XLIB-GC-LINE :FOREGROUND FOREGROUND)
                    (SET-GC LINE-STYLE-GC XLIB-GC-LINE :BACKGROUND
                     BACKGROUND)))
                (#S(FORMGREP:SYMREF :NAME "DRAW-GLYPHS" :QUALIFIER "XLIB")
                 DRAWABLE XLIB-GC-LINE X Y STRING))))))

[cl-garnet/src/kr/kr-macros.lisp:23]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (DEFVAR *SPECIAL-KR-OPTIMIZATION*
      '(OPTIMIZE (SPEED 0) (SAFETY 3) (SPACE 0) (DEBUG 3))))

[cl-garnet/src/opal/update-window.lisp:521]
  (DEFINE-METHOD :UPDATE #S(FORMGREP:SYMREF :NAME "WINDOW" :QUALIFIER "OPAL")
   (A-WINDOW &OPTIONAL (TOTAL-P NIL)) (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
   (BORDEAUX-THREADS:WITH-RECURSIVE-LOCK-HELD (#S(FORMGREP:SYMREF
                                                  :NAME "*UPDATE-LOCK*"
                                                  :QUALIFIER "GEM"))
     (LET* ((WIN-INFO (G-LOCAL-VALUE A-WINDOW :WIN-UPDATE-INFO))
            (DRAWABLE (G-LOCAL-VALUE A-WINDOW :DRAWABLE))
            (WINDOW-AGG (G-LOCAL-VALUE A-WINDOW :AGGREGATE))
            (INVALID-SLOTS (WIN-UPDATE-INFO-INVALID-SLOTS WIN-INFO))
            INVALID-VOBS)
       (UNLESS DRAWABLE
         (SETQ DRAWABLE (INSTALL-DRAWABLE WINDOW-AGG A-WINDOW WIN-INFO))
         (SETQ TOTAL-P T))
       (WHEN INVALID-SLOTS
         (SETQ INVALID-SLOTS
                 (FIX-INVALID-SLOTS INVALID-SLOTS WIN-INFO A-WINDOW))
         (IF (PROCESS-INVALID-SLOTS INVALID-SLOTS WIN-INFO A-WINDOW DRAWABLE)
             (SETQ TOTAL-P T)))
       (WHEN TOTAL-P (DO-FIX-UPDATE-SLOTS WIN-INFO A-WINDOW))
       (LOOP
        (SETQ INVALID-VOBS (WIN-UPDATE-INFO-INVALID-VIEW-OBJECTS WIN-INFO))
        (UNLESS INVALID-VOBS (RETURN))
        (SETF (WIN-UPDATE-INFO-INVALID-VIEW-OBJECTS WIN-INFO) NIL)
        (DOLIST (VOB INVALID-VOBS)
          (WHEN (AND (SCHEMA-P VOB) (EQ A-WINDOW (G-LOCAL-VALUE VOB :WINDOW)))
            (FIX-UPDATE-SLOTS VOB)))
        (FREE-LIST INVALID-VOBS))
       (LET* ((INVALID-OBJECTS (WIN-UPDATE-INFO-INVALID-OBJECTS WIN-INFO))
              (INVALID-XORS (WIN-UPDATE-INFO-INVALID-XOR-FASTDRAWS WIN-INFO))
              (INVALID-COPYS (WIN-UPDATE-INFO-INVALID-COPY-FASTDRAWS WIN-INFO))
              (VISIBLE (EQ (G-VALUE A-WINDOW :VISIBLE) T))
              (WIN-OLD-BBOX
               (UPDATE-INFO-OLD-BBOX
                (THE UPDATE-INFO (G-LOCAL-VALUE A-WINDOW :UPDATE-INFO))))
              (PARTIAL-P
               (AND WINDOW-AGG (G-VALUE WINDOW-AGG :VISIBLE)
                    (OR INVALID-OBJECTS INVALID-XORS INVALID-COPYS
                        (BBOX-VALID-P WIN-OLD-BBOX)))))
         (WHEN VISIBLE
           (SETF (WIN-UPDATE-INFO-INVALID-OBJECTS WIN-INFO) NIL
                 (WIN-UPDATE-INFO-INVALID-XOR-FASTDRAWS WIN-INFO) NIL
                 (WIN-UPDATE-INFO-INVALID-COPY-FASTDRAWS WIN-INFO) NIL))
         (WHEN (OR TOTAL-P PARTIAL-P)
           (LET* ((WIN-NEW-BBOX (WIN-UPDATE-INFO-NEW-BBOX WIN-INFO))
                  (BUFFER (G-VALUE A-WINDOW :BUFFER))
                  (DISPLAY-INFO (G-VALUE A-WINDOW :DISPLAY-INFO))
                  (LINE-STYLE-GC (DISPLAY-INFO-LINE-STYLE-GC DISPLAY-INFO))
                  (FILLING-STYLE-GC
                   (DISPLAY-INFO-FILLING-STYLE-GC DISPLAY-INFO))
                  FASTDRAW-OBJECTS
                  OBJ-UPDATE-SLOTS-VALUES
                  OBJ-UPDATE-INFO)
             (IF BUFFER
                 (SETF (BBOX-VALID-P NEWLY-INVISIBLE-FASTDRAWS-BBOX) NIL))
             (WHEN (AND WINDOW-AGG VISIBLE)
               (IF TOTAL-P
                   (PROGN
                    (DO-TOTAL-UPDATE INVALID-OBJECTS INVALID-XORS INVALID-COPYS
                     A-WINDOW WINDOW-AGG BUFFER EXPOSED-CLIP-MASK LINE-STYLE-GC
                     FILLING-STYLE-GC))
                   (DO-PARTIAL-UPDATE INVALID-OBJECTS INVALID-XORS
                    INVALID-COPYS A-WINDOW WINDOW-AGG BUFFER EXPOSED-CLIP-MASK
                    LINE-STYLE-GC FILLING-STYLE-GC OBJ-UPDATE-INFO
                    OBJ-UPDATE-SLOTS-VALUES WIN-INFO WIN-NEW-BBOX WIN-OLD-BBOX
                    FASTDRAW-OBJECTS)))
             (WHEN (AND VISIBLE BUFFER)
               (IF (OR TOTAL-P (NULL WIN-NEW-BBOX))
                   (#S(FORMGREP:SYMREF :NAME "BIT-BLIT" :QUALIFIER "GEM")
                    A-WINDOW BUFFER 0 0 (G-VALUE A-WINDOW :WIDTH)
                    (G-VALUE A-WINDOW :HEIGHT) DRAWABLE 0 0)
                   (PROGN
                    (WHEN WIN-NEW-BBOX
                      (MERGE-BBOX NEWLY-INVISIBLE-FASTDRAWS-BBOX WIN-NEW-BBOX))
                    (WHEN WIN-OLD-BBOX
                      (MERGE-BBOX NEWLY-INVISIBLE-FASTDRAWS-BBOX WIN-OLD-BBOX))
                    (WHEN (BBOX-VALID-P NEWLY-INVISIBLE-FASTDRAWS-BBOX)
                      (COPY-FROM-BUFFER-TO-DRAWABLE A-WINDOW
                       NEWLY-INVISIBLE-FASTDRAWS-BBOX BUFFER DRAWABLE)))))
             (SETF (BBOX-VALID-P WIN-OLD-BBOX) NIL
                   (BBOX-VALID-P WIN-NEW-BBOX) NIL)))
         (WHEN (OR TOTAL-P PARTIAL-P INVALID-SLOTS)
           (#S(FORMGREP:SYMREF :NAME "FLUSH-OUTPUT" :QUALIFIER "GEM")
            A-WINDOW))
         (LET ((BASE-CHILDREN (G-VALUE A-WINDOW :CHILD)))
           (IF (AND BASE-CHILDREN (NOT (G-VALUE A-WINDOW :EXPOSED-BBOX)))
               (DO* ((CHILDREN BASE-CHILDREN (REST CHILDREN))
                     (CHILD (FIRST CHILDREN) (FIRST CHILDREN)))
                    ((NULL CHILDREN))
                 (UNLESS (EQ A-WINDOW (G-VALUE CHILD :PARENT))
                   (PUSHNEW :PARENT
                            (WIN-UPDATE-INFO-INVALID-SLOTS
                             (G-VALUE CHILD :WIN-UPDATE-INFO)))
                   (SETQ CHILDREN (COPY-LIST CHILDREN))
                   (UNLESS (EQ A-WINDOW (G-VALUE CHILD :OLD-PARENT))
                     (S-VALUE A-WINDOW :CHILD
                      (DELETE CHILD (G-VALUE A-WINDOW :CHILD)))))
                 (UPDATE CHILD TOTAL-P)))))))
   (S-VALUE A-WINDOW :IN-PROGRESS NIL))

[cl-garnet/src/opal/update.lisp:21]
  (DEFUN UPDATE-SLOTS-VALUES-CHANGED (OBJECT FIRST-CHANGED OBJ-UPDATE-INFO)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (LET* ((UPDATE-SLOTS-VALUES (G-LOCAL-VALUE OBJECT :UPDATE-SLOTS-VALUES))
           (START-SLOT-LIST (GET-VALUE OBJECT :UPDATE-SLOTS))
           (FIRST-P (NULL UPDATE-SLOTS-VALUES))
           CHANGED-P
           NEW-VALUE)
      (IF FIRST-P
          (SETQ UPDATE-SLOTS-VALUES
                  (S-VALUE OBJECT :UPDATE-SLOTS-VALUES
                   (MAKE-ARRAY (LENGTH START-SLOT-LIST) :INITIAL-ELEMENT
                               NIL))))
      (SETF (UPDATE-INFO-FORCE-COMPUTATION-P OBJ-UPDATE-INFO) NIL)
      (DOTIMES (X FIRST-CHANGED) (SETQ START-SLOT-LIST (CDR START-SLOT-LIST)))
      (DO ((SLOT-LIST START-SLOT-LIST (CDR SLOT-LIST))
           (VALS-INDX FIRST-CHANGED (1+ VALS-INDX)))
          ((NULL SLOT-LIST) CHANGED-P)
        (UNLESS
            (EQUAL (AREF UPDATE-SLOTS-VALUES VALS-INDX)
                   (SETQ NEW-VALUE (G-VALUE OBJECT (CAR SLOT-LIST))))
          (SETF (AREF UPDATE-SLOTS-VALUES VALS-INDX)
                  (IF (LISTP NEW-VALUE)
                      (COPY-LIST NEW-VALUE)
                      NEW-VALUE))
          (SETQ CHANGED-P T)))))

[cl-garnet/src/opal/update.lisp:52]
  (DEFUN SIMPLE-UPDATE-SLOTS-VALUES-CHANGED (OBJECT)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (LET ((UPDATE-SLOTS-VALUES (G-LOCAL-VALUE OBJECT :UPDATE-SLOTS-VALUES)))
      (IF UPDATE-SLOTS-VALUES
          (DO ((SLOT-LIST (GET-VALUE OBJECT :UPDATE-SLOTS) (CDR SLOT-LIST))
               (VALS-INDX 0 (1+ VALS-INDX)))
              ((NULL SLOT-LIST) NIL)
            (UNLESS
                (EQUAL (AREF UPDATE-SLOTS-VALUES VALS-INDX)
                       (G-VALUE OBJECT (CAR SLOT-LIST)))
              (RETURN VALS-INDX)))
          0)))

[cl-garnet/src/opal/update.lisp:71]
  (DEFINE-METHOD :UPDATE AGGREGATE
   (AGG UPDATE-INFO LINE-STYLE-GC FILLING-STYLE-GC BBOX-1 BBOX-2 &OPTIONAL
    (TOTAL-P NIL))
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
   (LET ((DIRTY-P (UPDATE-INFO-DIRTY-P UPDATE-INFO))
         (AGG-BBOX (UPDATE-INFO-OLD-BBOX UPDATE-INFO)))
     (WHEN
         (OR DIRTY-P TOTAL-P
             (AND (BBOX-VALID-P AGG-BBOX)
                  (BBOX-INTERSECTS-EITHER-P AGG-BBOX BBOX-1 BBOX-2)))
       (LET (CHILD-UPDATE-INFO CHILD-BBOX)
         (SETF (BBOX-VALID-P AGG-BBOX) NIL)
         (DOVALUES (CHILD AGG :COMPONENTS :LOCAL T)
          (IF (G-VALUE CHILD :VISIBLE)
              (PROGN
               (SETQ CHILD-BBOX
                       (UPDATE-INFO-OLD-BBOX
                        (SETQ CHILD-UPDATE-INFO
                                (G-LOCAL-VALUE CHILD :UPDATE-INFO))))
               (IF (IS-A-P CHILD AGGREGATE)
                   (UPDATE CHILD CHILD-UPDATE-INFO LINE-STYLE-GC
                    FILLING-STYLE-GC BBOX-1 BBOX-2 TOTAL-P)
                   (UPDATE CHILD CHILD-UPDATE-INFO BBOX-1 BBOX-2 TOTAL-P))
               (MERGE-BBOX AGG-BBOX CHILD-BBOX))
              (LET ((CHILD-UPDATE-INFO (G-LOCAL-VALUE CHILD :UPDATE-INFO)))
                (WHEN (UPDATE-INFO-DIRTY-P CHILD-UPDATE-INFO)
                  (CLEAR-DIRTY-BITS CHILD CHILD-UPDATE-INFO)))))
         (IF DIRTY-P
             (SETF (UPDATE-INFO-DIRTY-P UPDATE-INFO) NIL))))))

[cl-garnet/src/opal/update.lisp:110]
  (DEFINE-METHOD :UPDATE GRAPHICAL-OBJECT
   (GOB UPDATE-INFO BBOX-1 BBOX-2 &OPTIONAL (TOTAL-P NIL))
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
   (LET ((OLD-BBOX (UPDATE-INFO-OLD-BBOX UPDATE-INFO))
         (A-WINDOW (G-VALUE GOB :WINDOW)))
     (UNLESS A-WINDOW (SETF A-WINDOW (G-VALUE GOB :PARENT :WINDOW)))
     (UNLESS (UPDATE-INFO-ON-FASTDRAW-LIST-P UPDATE-INFO)
       (COND
        (TOTAL-P (UPDATE-SLOTS-VALUES-CHANGED GOB 0 UPDATE-INFO)
         (UPDATE-BBOX GOB OLD-BBOX) (DRAW GOB A-WINDOW)
         (SETF (UPDATE-INFO-DIRTY-P UPDATE-INFO) NIL))
        ((UPDATE-INFO-DIRTY-P UPDATE-INFO)
         (WHEN (UPDATE-INFO-FORCE-COMPUTATION-P UPDATE-INFO)
           (UPDATE-SLOTS-VALUES-CHANGED GOB 0 UPDATE-INFO)
           (UPDATE-BBOX GOB OLD-BBOX))
         (DRAW GOB A-WINDOW) (SETF (UPDATE-INFO-DIRTY-P UPDATE-INFO) NIL))
        (BBOX-2
         (WHEN
             (OR (BBOX-INTERSECT-P OLD-BBOX BBOX-1)
                 (BBOX-INTERSECT-P OLD-BBOX BBOX-2))
           (DRAW GOB A-WINDOW)))
        ((BBOX-INTERSECT-P OLD-BBOX BBOX-1) (DRAW GOB A-WINDOW)))
       (SETF (UPDATE-INFO-INVALID-P UPDATE-INFO) NIL))))

[cl-garnet/src/ps/ps.lisp:1705]
  (DEFUN PRINT-LINE-QUALITIES (OBJ)
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (SPACE 1)))
    (LET ((LINE-STYLE (G-VALUE OBJ :LINE-STYLE)))
      (IF LINE-STYLE
          (LET* ((LINE-THICKNESS
                  (LET ((LT (G-VALUE LINE-STYLE :LINE-THICKNESS)))
                    (IF (EQ LT 0)
                        1
                        LT)))
                 (LINE-CAP
                  (CASE (G-VALUE LINE-STYLE :CAP-STYLE)
                    (:BUTT 0)
                    (:ROUND 1)
                    (:PROJECTING 2)
                    (OTHERWISE 0)))
                 (LINE-JOIN
                  (CASE (G-VALUE LINE-STYLE :JOIN-STYLE)
                    (:MITER 0)
                    (:ROUND 1)
                    (:BEVEL 2)
                    (OTHERWISE 0)))
                 (DASH-PATTERN
                  (LET ((DP (G-VALUE LINE-STYLE :DASH-PATTERN)))
                    (IF DP
                        (SUBSTITUTE #\[ #\(
                                    (SUBSTITUTE #\] #\)
                                                (CONCATENATE 'STRING
                                                             (PRIN1-TO-STRING
                                                              DP)
                                                             " ")))
                        "[] "))))
            (PRINT-COLOR-INFO LINE-STYLE :FOREGROUND-COLOR)
            (FORMAT T "~S ~S " LINE-CAP LINE-JOIN)
            (FORMAT T "~a" DASH-PATTERN)
            (FORMAT T "~S " LINE-THICKNESS))
          (FORMAT T "[0 0 0] 0 0 [] -1 "))))

[cl-gserver/src/atomic/atomic-abcl.lisp:31]
  (DEFMETHOD ATOMIC-CAS ((INT ATOMIC-INTEGER) OLD NEW)
    (DECLARE (TYPE %ATOMIC-INTEGER-VALUE OLD NEW)
             (OPTIMIZE (SAFETY 0) (SPEED 3)))
    (#S(FORMGREP:SYMREF :NAME "JCALL" :QUALIFIER "JAVA") +ATOMIC-LONG-CAS+
     (ATOMIC-INTEGER-CELL INT) OLD NEW))

[cl-gserver/src/atomic/atomic-abcl.lisp:55]
  (DEFMETHOD ATOMIC-GET ((INT ATOMIC-INTEGER))
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3)))
    (#S(FORMGREP:SYMREF :NAME "JCALL" :QUALIFIER "JAVA") +ATOMIC-LONG-GET+
     (ATOMIC-INTEGER-CELL INT)))

[cl-gserver/src/atomic/atomic-abcl.lisp:91]
  (DEFMETHOD ATOMIC-CAS ((REF ATOMIC-REFERENCE) EXPECTED NEW)
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3)))
    (#S(FORMGREP:SYMREF :NAME "JCALL" :QUALIFIER "JAVA") +ATOMIC-REFERENCE-CAS+
     (ATOMIC-REFERENCE-CELL REF) EXPECTED NEW))

[cl-gserver/src/atomic/atomic-abcl.lisp:99]
  (DEFMETHOD ATOMIC-GET ((REF ATOMIC-REFERENCE))
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3)))
    (#S(FORMGREP:SYMREF :NAME "JCALL" :QUALIFIER "JAVA") +ATOMIC-REFERENCE-GET+
     (ATOMIC-REFERENCE-CELL REF)))

[cl-htm/src/model/implementation.lisp:208]
  (DEFUN HASHVAL (HASHES WIDTH J HASH)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE (SIMPLE-ARRAY FIXNUM (* 2)) HASHES)
             (TYPE NON-NEGATIVE-FIXNUM WIDTH J HASH))
    (~> (AREF HASHES J 0) (* HASH) (LDB (BYTE 32 0) _) (+ (AREF HASHES J 1))
     (LDB (BYTE 32 0) _) (REM +LONG-PRIME+) (REM WIDTH)))

[cl-htm/src/model/internal.lisp:23]
  (DEFUN JACCARD-METRIC (VECT1 VECT2)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 1) (SPACE 0))
             (TYPE (ARRAY FIXNUM (*)) VECT1 VECT2))
    (LET* ((UNION 0.0)
           (INTERSECTION 0.0)
           (INCREASE-UNION (LAMBDA (X) (DECLARE (IGNORE X)) (INCF UNION))))
      (DECLARE (TYPE SINGLE-FLOAT UNION INTERSECTION))
      (#S(FORMGREP:SYMREF
          :NAME "ON-ORDERED-INTERSECTION"
          :QUALIFIER "CL-DS.UTILS")
       (LAMBDA (A B) (DECLARE (IGNORE A B)) (INCF UNION) (INCF INTERSECTION))
       VECT1 VECT2 :ON-FIRST-MISSING INCREASE-UNION :ON-SECOND-MISSING
       INCREASE-UNION)
      (- 1.0 (/ INTERSECTION UNION))))

[cl-htm/src/neuron-layer/implementation.lisp:9]
  (DEFMETHOD CALCULATE-ACTIVE-SYNAPSES-FOR-COLUMNS
             ((LAYER NEURON-LAYER)
              (INPUT #S(FORMGREP:SYMREF :NAME "SDR" :QUALIFIER "CL-HTM.SDR"))
              (COLUMNS NEURON-COLUMN))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (SPACE 0) (DEBUG 0)))
    (NEST
     (#S(FORMGREP:SYMREF :NAME "WITH-DATA" :QUALIFIER "VECTOR-CLASSES")
      (((COLUMN-INPUT INPUT)) COLUMNS COLUMN NEURON-COLUMN))
     (#S(FORMGREP:SYMREF :NAME "WITH-DATA" :QUALIFIER "VECTOR-CLASSES")
      (((ACTIVE
         #S(FORMGREP:SYMREF :NAME "ACTIVE-NEURONS" :QUALIFIER "CL-HTM.SDR")))
       INPUT J #S(FORMGREP:SYMREF :NAME "SDR" :QUALIFIER "CL-HTM.SDR")))
     (#S(FORMGREP:SYMREF :NAME "WITH-DATA" :QUALIFIER "VECTOR-CLASSES")
      (((SYNAPS PROXIMAL-SYNAPSES-STRENGTH)) COLUMNS COLUMN NEURON-COLUMN))
     (BIND
      ((SIZE
        (#S(FORMGREP:SYMREF :NAME "SIZE" :QUALIFIER "VECTOR-CLASSES") COLUMNS))
       (SYNAPSES-COUNT (ACCESS-SYNAPSES-COUNT LAYER))
       (RESULT (MAKE-ARRAY SIZE :ELEMENT-TYPE 'NON-NEGATIVE-FIXNUM))
       ((:DFLET COUNT-FOR-COLUMN (COLUMN))
        (DECLARE (TYPE NON-NEGATIVE-FIXNUM COLUMN SIZE))
        (ITERATE (WITH RESULT = 0) (FOR I FROM 0 BELOW SYNAPSES-COUNT)
         (FOR J = (COLUMN-INPUT I))
         (UNLESS (ZEROP (ACTIVE)) (INCF RESULT (SYNAPS)))
         (FINALLY (RETURN RESULT)))))
      (DECLARE (TYPE FIXNUM SYNAPSES-COUNT SIZE))
      (ITERATE (DECLARE (TYPE FIXNUM I)) (FOR I FROM 0 BELOW SIZE)
       (SETF (AREF RESULT I) (COUNT-FOR-COLUMN I)))
      RESULT)))

[cl-htm/src/neuron-layer/implementation.lisp:61]
  (DEFMETHOD SELECT-PREDICTIVE-NEURONS
             ((LAYER NEURON-LAYER)
              (SDR #S(FORMGREP:SYMREF :NAME "SDR" :QUALIFIER "CL-HTM.SDR"))
              (TRAINING-PARAMETERS
               #S(FORMGREP:SYMREF
                  :NAME "FUNDAMENTAL-PARAMETERS"
                  :QUALIFIER "CL-HTM.TRAINING"))
              (COLUMNS NEURON-COLUMN) ACTIVE-COLUMNS CONTEXT)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 0) (SPACE 0))
             (IGNORE SDR))
    (CHECK-TYPE ACTIVE-COLUMNS (ARRAY FIXNUM (*)))
    (BIND
     ((THRESHOLD
       (#S(FORMGREP:SYMREF :NAME "THRESHOLD" :QUALIFIER "CL-HTM.TRAINING")
        TRAINING-PARAMETERS))
      (COLUMN-SIZE
       (/
        (THE FIXNUM
             (#S(FORMGREP:SYMREF :NAME "SIZE" :QUALIFIER "VECTOR-CLASSES")
              LAYER))
        (THE FIXNUM
             (#S(FORMGREP:SYMREF :NAME "SIZE" :QUALIFIER "VECTOR-CLASSES")
              COLUMNS))))
      (PREVIOUS-ACTIVE-NEURONS
       (#S(FORMGREP:SYMREF :NAME "ACTIVE-NEURONS" :QUALIFIER "CL-HTM.TRAINING")
        CONTEXT))
      (RESULT
       (MAKE-ARRAY (TRUNCATE COLUMN-SIZE 10) :ADJUSTABLE T :FILL-POINTER 0
                   :ELEMENT-TYPE T))
      ((:FLET MATCHING-TEST (ACTIVE-SYNAPSES SEGMENT &AUX (ACTIVITY 0)))
       (DECLARE (TYPE SEGMENT SEGMENT)
                (TYPE FIXNUM ACTIVITY))
       (#S(FORMGREP:SYMREF
           :NAME "ON-ORDERED-INTERSECTION"
           :QUALIFIER "CL-DS.UTILS")
        (LAMBDA (PREVIOUS-NEURON SOURCE.WEIGHT)
          (DECLARE (IGNORE PREVIOUS-NEURON))
          (VECTOR-PUSH-EXTEND SOURCE.WEIGHT ACTIVE-SYNAPSES)
          (INCF ACTIVITY (WEIGHT SOURCE.WEIGHT)))
        PREVIOUS-ACTIVE-NEURONS (SEGMENT-SOURCE-WEIGHT SEGMENT) :SECOND-KEY
        #'SOURCE)
       (> ACTIVITY THRESHOLD))
      ((:FLET ACTIVE-SEGMENT (SEGMENT ACTIVE-SYNAPSES))
       (#S(FORMGREP:SYMREF :NAME "MATCHING" :QUALIFIER "CL-HTM.UTILS") SEGMENT
        (CURRY #'MATCHING-TEST ACTIVE-SYNAPSES)))
      ((:FLET GATHER-NEURONS (COLUMN-INDEX))
       (ITERATE (DECLARE (TYPE FIXNUM I NEURON-INDEX COLUMN-START))
        (WITH COLUMN-START = (* COLUMN-INDEX COLUMN-SIZE))
        (WITH ACTIVE-SYNAPSES = (VECT)) (FOR NEURON-INDEX FROM COLUMN-START)
        (FOR I FROM 0 BELOW COLUMN-SIZE)
        (FOR SEGMENT = (DISTAL-SEGMENT LAYER NEURON-INDEX))
        (FOR ACTIVE-SEGMENT = (ACTIVE-SEGMENT SEGMENT ACTIVE-SYNAPSES))
        (UNLESS (NULL ACTIVE-SEGMENT)
          (VECTOR-PUSH-EXTEND
           (NEURON.SEGMENT NEURON-INDEX ACTIVE-SEGMENT ACTIVE-SYNAPSES) RESULT)
          (LEAVE))
        (SETF (FILL-POINTER ACTIVE-SYNAPSES) 0))))
     (DECLARE (TYPE FIXNUM THRESHOLD COLUMN-SIZE)
              (TYPE VECTOR RESULT))
     (MAP NIL #'GATHER-NEURONS ACTIVE-COLUMNS) RESULT))

[cl-htm/src/neuron-layer/implementation.lisp:116]
  (DEFMETHOD SELECT-ACTIVE-NEURONS
             ((LAYER NEURON-LAYER) (COLUMNS NEURON-COLUMN)
              (INPUT #S(FORMGREP:SYMREF :NAME "SDR" :QUALIFIER "CL-HTM.SDR"))
              ACTIVE-COLUMNS PREDICTIVE-NEURONS ACTIVE-NEURONS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0)))
    (CHECK-TYPE PREDICTIVE-NEURONS VECTOR)
    (CHECK-TYPE ACTIVE-COLUMNS (SIMPLE-ARRAY FIXNUM (*)))
    (CHECK-TYPE ACTIVE-NEURONS (ARRAY * (*)))
    (SETF (FILL-POINTER ACTIVE-NEURONS) 0)
    (LET* ((COLUMN-SIZE
            (TRUNCATE
             (#S(FORMGREP:SYMREF :NAME "SIZE" :QUALIFIER "VECTOR-CLASSES")
              LAYER)
             (#S(FORMGREP:SYMREF :NAME "SIZE" :QUALIFIER "VECTOR-CLASSES")
              COLUMNS)))
           (PUSH-TO-VECTOR
            (LAMBDA (COLUMN NEURON)
              (DECLARE (IGNORE COLUMN)
                       (TYPE NON-NEGATIVE-FIXNUM NEURON))
              (VECTOR-PUSH-EXTEND (NEURON NEURON) ACTIVE-NEURONS)))
           (BURST-COLUMN
            (LAMBDA (COLUMN-INDEX)
              (DECLARE (TYPE NON-NEGATIVE-FIXNUM COLUMN-INDEX))
              (ITERATE (DECLARE (TYPE FIXNUM I)) (FOR I FROM COLUMN-INDEX)
               (REPEAT COLUMN-SIZE) (VECTOR-PUSH-EXTEND I ACTIVE-NEURONS)))))
      (DECLARE (TYPE NON-NEGATIVE-FIXNUM COLUMN-SIZE))
      (#S(FORMGREP:SYMREF
          :NAME "ON-ORDERED-INTERSECTION"
          :QUALIFIER "CL-DS.UTILS")
       PUSH-TO-VECTOR ACTIVE-COLUMNS PREDICTIVE-NEURONS :SAME #'EQL
       :ON-SECOND-MISSING BURST-COLUMN :SECOND-KEY
       (LAMBDA (NEURON)
         (DECLARE (TYPE NON-NEGATIVE-FIXNUM NEURON))
         (TRUNCATE (NEURON NEURON) COLUMN-SIZE)))
      ACTIVE-NEURONS))

[cl-htm/src/neuron-layer/implementation.lisp:277]
  (DEFMETHOD UPDATE-SYNAPSES
             (
              (PARAMETERS
               #S(FORMGREP:SYMREF
                  :NAME "FUNDAMENTAL-PARAMETERS"
                  :QUALIFIER "CL-HTM.TRAINING"))
              (LAYER NEURON-LAYER)
              (INPUT #S(FORMGREP:SYMREF :NAME "SDR" :QUALIFIER "CL-HTM.SDR"))
              (MODE
               #S(FORMGREP:SYMREF
                  :NAME "TRAIN-MODE"
                  :QUALIFIER "CL-HTM.TRAINING"))
              (COLUMNS NEURON-COLUMN) CONTEXT ACTIVE-COLUMNS PREDICTIVE-NEURONS
              ACTIVE-NEURONS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 0) (SPACE 0)))
    (CHECK-TYPE PREDICTIVE-NEURONS VECTOR)
    (CHECK-TYPE ACTIVE-COLUMNS (SIMPLE-ARRAY * (*)))
    (CHECK-TYPE ACTIVE-NEURONS VECTOR)
    (UPDATE-NEURONS LAYER ACTIVE-NEURONS PREDICTIVE-NEURONS PARAMETERS CONTEXT)
    NIL)

[cl-htm/src/neuron-layer/implementation.lisp:316]
  (DEFMETHOD ACTIVATE
             ((LAYER NEURON-LAYER)
              (SDR #S(FORMGREP:SYMREF :NAME "SDR" :QUALIFIER "CL-HTM.SDR"))
              (CONTEXT
               #S(FORMGREP:SYMREF
                  :NAME "FUNDAMENTAL-CONTEXT"
                  :QUALIFIER "CL-HTM.TRAINING"))
              (TRAINING-PARAMETERS
               #S(FORMGREP:SYMREF
                  :NAME "FUNDAMENTAL-PARAMETERS"
                  :QUALIFIER "CL-HTM.TRAINING"))
              (MODE
               #S(FORMGREP:SYMREF
                  :NAME "PREDICT-MODE"
                  :QUALIFIER "CL-HTM.TRAINING")))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 1)))
    (LET* ((COLUMNS (COLUMNS LAYER))
           (ACTIVE-NEURONS
            (#S(FORMGREP:SYMREF
                :NAME "ACTIVE-NEURONS"
                :QUALIFIER "CL-HTM.TRAINING")
             CONTEXT))
           (ACTIVE-SYNAPSES-FOR-COLUMNS
            (CALCULATE-ACTIVE-SYNAPSES-FOR-COLUMNS LAYER SDR COLUMNS))
           (ACTIVE-COLUMNS
            (SELECT-ACTIVE-COLUMNS LAYER TRAINING-PARAMETERS COLUMNS
             ACTIVE-SYNAPSES-FOR-COLUMNS))
           (PREDICTIVE-NEURONS
            (SELECT-PREDICTIVE-NEURONS LAYER SDR TRAINING-PARAMETERS COLUMNS
             ACTIVE-COLUMNS CONTEXT)))
      (SELECT-ACTIVE-NEURONS LAYER COLUMNS SDR ACTIVE-COLUMNS
       PREDICTIVE-NEURONS ACTIVE-NEURONS)
      (#S(FORMGREP:SYMREF :NAME "WITH-DATA" :QUALIFIER "VECTOR-CLASSES")
       (((NEURON
          #S(FORMGREP:SYMREF :NAME "ACTIVE-NEURONS" :QUALIFIER "CL-HTM.SDR")))
        SDR I #S(FORMGREP:SYMREF :NAME "SDR" :QUALIFIER "CL-HTM.SDR"))
       (#S(FORMGREP:SYMREF :NAME "CLEAR-ALL-ACTIVE" :QUALIFIER "CL-HTM.SDR")
        SDR)
       (MAP NIL (LAMBDA (I) (SETF (NEURON) 1)) ACTIVE-NEURONS)
       (SETF (#S(FORMGREP:SYMREF
                 :NAME "DENSE-ACTIVE-NEURONS"
                 :QUALIFIER "CL-HTM.SDR")
              SDR)
               ACTIVE-NEURONS
             (#S(FORMGREP:SYMREF
                 :NAME "ACTIVE-NEURONS"
                 :QUALIFIER "CL-HTM.TRAINING")
              CONTEXT)
               ACTIVE-NEURONS
             (#S(FORMGREP:SYMREF
                 :NAME "PAST-PREDICTIVE-NEURONS"
                 :QUALIFIER "CL-HTM.TRAINING")
              CONTEXT)
               PREDICTIVE-NEURONS))))

[cl-htm/src/neuron-layer/implementation.lisp:359]
  (DEFMETHOD ACTIVATE
             ((LAYER NEURON-LAYER)
              (SDR #S(FORMGREP:SYMREF :NAME "SDR" :QUALIFIER "CL-HTM.SDR"))
              (CONTEXT
               #S(FORMGREP:SYMREF
                  :NAME "FUNDAMENTAL-CONTEXT"
                  :QUALIFIER "CL-HTM.TRAINING"))
              (TRAINING-PARAMETERS
               #S(FORMGREP:SYMREF
                  :NAME "FUNDAMENTAL-PARAMETERS"
                  :QUALIFIER "CL-HTM.TRAINING"))
              (MODE
               #S(FORMGREP:SYMREF
                  :NAME "FUNDAMENTAL-MODE"
                  :QUALIFIER "CL-HTM.TRAINING")))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (LET* ((COLUMNS (COLUMNS LAYER))
           (ACTIVE-NEURONS
            (#S(FORMGREP:SYMREF
                :NAME "ACTIVE-NEURONS"
                :QUALIFIER "CL-HTM.TRAINING")
             CONTEXT))
           (ACTIVE-SYNAPSES-FOR-COLUMNS
            (CALCULATE-ACTIVE-SYNAPSES-FOR-COLUMNS LAYER SDR COLUMNS))
           (ACTIVE-COLUMNS
            (SELECT-ACTIVE-COLUMNS LAYER TRAINING-PARAMETERS COLUMNS
             ACTIVE-SYNAPSES-FOR-COLUMNS))
           (PREDICTIVE-NEURONS
            (SELECT-PREDICTIVE-NEURONS LAYER SDR TRAINING-PARAMETERS COLUMNS
             ACTIVE-COLUMNS CONTEXT)))
      (DECLARE (TYPE (ARRAY FIXNUM (*)) ACTIVE-COLUMNS)
               (TYPE (ARRAY * (*)) PREDICTIVE-NEURONS))
      (SELECT-ACTIVE-NEURONS LAYER COLUMNS SDR ACTIVE-COLUMNS
       PREDICTIVE-NEURONS ACTIVE-NEURONS)
      (UNLESS
          (#S(FORMGREP:SYMREF
              :NAME "FIRST-ITERATION"
              :QUALIFIER "CL-HTM.TRAINING")
           CONTEXT)
        (UPDATE-SYNAPSES TRAINING-PARAMETERS LAYER SDR MODE COLUMNS CONTEXT
         ACTIVE-COLUMNS PREDICTIVE-NEURONS ACTIVE-NEURONS))
      (#S(FORMGREP:SYMREF :NAME "WITH-DATA" :QUALIFIER "VECTOR-CLASSES")
       (((NEURON
          #S(FORMGREP:SYMREF :NAME "ACTIVE-NEURONS" :QUALIFIER "CL-HTM.SDR")))
        SDR I #S(FORMGREP:SYMREF :NAME "SDR" :QUALIFIER "CL-HTM.SDR"))
       (#S(FORMGREP:SYMREF :NAME "CLEAR-ALL-ACTIVE" :QUALIFIER "CL-HTM.SDR")
        SDR)
       (MAP NIL (LAMBDA (I) (SETF (NEURON) 1)) ACTIVE-NEURONS)
       (SETF (#S(FORMGREP:SYMREF
                 :NAME "DENSE-ACTIVE-NEURONS"
                 :QUALIFIER "CL-HTM.SDR")
              SDR)
               ACTIVE-NEURONS))
      (SETF (#S(FORMGREP:SYMREF
                :NAME "ACTIVE-NEURONS"
                :QUALIFIER "CL-HTM.TRAINING")
             CONTEXT)
              ACTIVE-NEURONS
            (#S(FORMGREP:SYMREF
                :NAME "PAST-PREDICTIVE-NEURONS"
                :QUALIFIER "CL-HTM.TRAINING")
             CONTEXT)
              PREDICTIVE-NEURONS)))

[cl-htm/src/sdr/implementation.lisp:4]
  (DEFMETHOD CLEAR-ALL-ACTIVE ((SDR SDR))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((ACTIVE (DENSE-ACTIVE-NEURONS SDR)))
      (DECLARE (TYPE (OR NULL (ARRAY * (*))) ACTIVE))
      (#S(FORMGREP:SYMREF :NAME "WITH-DATA" :QUALIFIER "VECTOR-CLASSES")
       (((ACTIVE-NEURON ACTIVE-NEURONS)) SDR I SDR)
       (IF (NULL ACTIVE)
           (ITERATE (DECLARE (TYPE FIXNUM I))
            (FOR I FROM 0 BELOW
             (THE FIXNUM
                  (#S(FORMGREP:SYMREF :NAME "SIZE" :QUALIFIER "VECTOR-CLASSES")
                   SDR)))
            (SETF (ACTIVE-NEURON) 0))
           (ITERATE (DECLARE (TYPE FIXNUM I K LENGTH))
            (WITH LENGTH = (LENGTH ACTIVE)) (FOR K FROM 0 BELOW LENGTH)
            (FOR I = (AREF ACTIVE K)) (SETF (ACTIVE-NEURON) 0))))
      (SETF (DENSE-ACTIVE-NEURONS SDR) NIL))
    SDR)

[cl-html-parse/dev/cl-html-parse.lisp:108]
  (DEFUN GET-COLLECTOR ()
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (LET (COL)
      (DO* ((COLS *COLLECTORS* (CDR COLS))
            (THIS (CAR COLS) (CAR COLS)))
           ((NULL COLS))
        (IF* THIS THEN (SETF (CAR COLS) NIL) (SETQ COL THIS) (RETURN)))
      (IF* COL THEN (SETF (COLLECTOR-NEXT COL) 0) COL ELSE
       (MAKE-COLLECTOR :NEXT 0 :MAX 100 :DATA (MAKE-STRING 100)))))

[cl-html-parse/dev/cl-html-parse.lisp:126]
  (DEFUN PUT-BACK-COLLECTOR (COL)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (DO ((COLS *COLLECTORS* (CDR COLS)))
        ((NULL COLS) NIL)
      (IF* (NULL (CAR COLS)) THEN (SETF (CAR COLS) COL) (RETURN))))

[cl-html-parse/dev/cl-html-parse.lisp:138]
  (DEFUN GROW-AND-ADD (COLL CH)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (LET* ((ODATA (COLLECTOR-DATA COLL))
           (NDATA (MAKE-STRING (* 2 (LENGTH ODATA)))))
      (DOTIMES (I (LENGTH ODATA)) (SETF (SCHAR NDATA I) (SCHAR ODATA I)))
      (SETF (COLLECTOR-DATA COLL) NDATA)
      (SETF (COLLECTOR-MAX COLL) (LENGTH NDATA))
      (LET ((NEXT (COLLECTOR-NEXT COLL)))
        (SETF (SCHAR NDATA NEXT) CH)
        (SETF (COLLECTOR-NEXT COLL) (1+ NEXT)))))

[cl-html-parse/dev/cl-html-parse.lisp:164]
  (DEFPARAMETER *CHARACTERISTICS*
    (LET ((ARR (MAKE-ARRAY 128 :INITIAL-ELEMENT 0)))
      (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
      (MACROLET ((WITH-RANGE ((VAR FROM TO) &REST BODY)
                   (ECLECTOR.READER:QUASIQUOTE
                    (DO (((ECLECTOR.READER:UNQUOTE VAR) (CHAR-CODE
                                                         (ECLECTOR.READER:UNQUOTE
                                                          FROM))
                                                        (1+
                                                         (ECLECTOR.READER:UNQUOTE
                                                          VAR)))
                         (MMAX (CHAR-CODE (ECLECTOR.READER:UNQUOTE TO))))
                        ((> (ECLECTOR.READER:UNQUOTE VAR) MMAX))
                      (ECLECTOR.READER:UNQUOTE-SPLICING BODY))))
                 (ADDIT (INDEX CHARISTIC)
                   (ECLECTOR.READER:QUASIQUOTE
                    (SETF (SVREF ARR (ECLECTOR.READER:UNQUOTE INDEX))
                            (LOGIOR (SVREF ARR (ECLECTOR.READER:UNQUOTE INDEX))
                                    (ECLECTOR.READER:UNQUOTE CHARISTIC))))))
        (WITH-RANGE (I #\A #\Z)
         (ADDIT I
          (+ CHAR-TAGCHARACTER CHAR-ATTRIBNAMECHAR
             CHAR-ATTRIBUNDELIMATTRIBVALUE)))
        (WITH-RANGE (I #\a #\z)
         (ADDIT I
          (+ CHAR-TAGCHARACTER CHAR-ATTRIBNAMECHAR
             CHAR-ATTRIBUNDELIMATTRIBVALUE)))
        (WITH-RANGE (I #\0 #\9)
         (ADDIT I
          (+ CHAR-TAGCHARACTER CHAR-ATTRIBNAMECHAR
             CHAR-ATTRIBUNDELIMATTRIBVALUE)))
        (ADDIT (CHAR-CODE #\:) (+ CHAR-ATTRIBNAMECHAR CHAR-TAGCHARACTER))
        (ADDIT (CHAR-CODE #\_) (+ CHAR-ATTRIBNAMECHAR CHAR-TAGCHARACTER))
        (ADDIT (CHAR-CODE #\-)
         (+ CHAR-ATTRIBNAMECHAR CHAR-ATTRIBUNDELIMATTRIBVALUE))
        (ADDIT (CHAR-CODE #\.)
         (+ CHAR-ATTRIBNAMECHAR CHAR-ATTRIBUNDELIMATTRIBVALUE))
        (ADDIT (CHAR-CODE #\:) CHAR-ATTRIBUNDELIMATTRIBVALUE)
        (ADDIT (CHAR-CODE #\@) CHAR-ATTRIBUNDELIMATTRIBVALUE)
        (ADDIT (CHAR-CODE #\/) CHAR-ATTRIBUNDELIMATTRIBVALUE)
        (ADDIT (CHAR-CODE #\!) CHAR-ATTRIBUNDELIMATTRIBVALUE)
        (ADDIT (CHAR-CODE #\#) CHAR-ATTRIBUNDELIMATTRIBVALUE)
        (ADDIT (CHAR-CODE #\$) CHAR-ATTRIBUNDELIMATTRIBVALUE)
        (ADDIT (CHAR-CODE #\%) CHAR-ATTRIBUNDELIMATTRIBVALUE)
        (ADDIT (CHAR-CODE #\^) CHAR-ATTRIBUNDELIMATTRIBVALUE)
        (ADDIT (CHAR-CODE #\&) CHAR-ATTRIBUNDELIMATTRIBVALUE)
        (ADDIT (CHAR-CODE #\() CHAR-ATTRIBUNDELIMATTRIBVALUE)
        (ADDIT (CHAR-CODE #\)) CHAR-ATTRIBUNDELIMATTRIBVALUE)
        (ADDIT (CHAR-CODE #\_) CHAR-ATTRIBUNDELIMATTRIBVALUE)
        (ADDIT (CHAR-CODE #\=) CHAR-ATTRIBUNDELIMATTRIBVALUE)
        (ADDIT (CHAR-CODE #\+) CHAR-ATTRIBUNDELIMATTRIBVALUE)
        (ADDIT (CHAR-CODE #\\) CHAR-ATTRIBUNDELIMATTRIBVALUE)
        (ADDIT (CHAR-CODE #\|) CHAR-ATTRIBUNDELIMATTRIBVALUE)
        (ADDIT (CHAR-CODE #\{) CHAR-ATTRIBUNDELIMATTRIBVALUE)
        (ADDIT (CHAR-CODE #\}) CHAR-ATTRIBUNDELIMATTRIBVALUE)
        (ADDIT (CHAR-CODE #\[) CHAR-ATTRIBUNDELIMATTRIBVALUE)
        (ADDIT (CHAR-CODE #\]) CHAR-ATTRIBUNDELIMATTRIBVALUE)
        (ADDIT (CHAR-CODE #\;) CHAR-ATTRIBUNDELIMATTRIBVALUE)
        (ADDIT (CHAR-CODE #\') CHAR-ATTRIBUNDELIMATTRIBVALUE)
        (ADDIT (CHAR-CODE #\") CHAR-ATTRIBUNDELIMATTRIBVALUE)
        (ADDIT (CHAR-CODE #\,) CHAR-ATTRIBUNDELIMATTRIBVALUE)
        (ADDIT (CHAR-CODE #\<) CHAR-ATTRIBUNDELIMATTRIBVALUE)
        (ADDIT (CHAR-CODE #\?) CHAR-ATTRIBUNDELIMATTRIBVALUE)
        (ADDIT (CHAR-CODE #\-) CHAR-TAGCHARACTER)
        (ADDIT (CHAR-CODE #\!) CHAR-TAGCHARACTER)
        (ADDIT (CHAR-CODE #\ ) CHAR-SPACECHAR)
        (ADDIT (CHAR-CODE #\Tab) CHAR-SPACECHAR)
        (ADDIT (CHAR-CODE #\Return) CHAR-SPACECHAR)
        (ADDIT (CHAR-CODE #\Newline) CHAR-SPACECHAR))
      ARR))

[cl-html-parse/dev/cl-html-parse.lisp:256]
  (DEFUN CHAR-CHARACTERISTIC (CHAR BIT)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (LET ((CODE (CHAR-CODE CHAR)))
      (IF* (<= 0 CODE 127) THEN
       (NOT (ZEROP (LOGAND (SVREF *CHARACTERISTICS* CODE) BIT))))))

[cl-html-parse/dev/cl-html-parse.lisp:536]
  (DEFUN GET-TOKENBUF ()
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (LET (BUF)
      (DO* ((BUFS *TOKENBUFS* (CDR BUFS))
            (THIS (CAR BUFS) (CAR BUFS)))
           ((NULL BUFS))
        (IF* THIS THEN (SETF (CAR BUFS) NIL) (SETQ BUF THIS) (RETURN)))
      (IF* BUF THEN (SETF (TOKENBUF-CUR BUF) 0) (SETF (TOKENBUF-MAX BUF) 0) BUF
       ELSE
       (MAKE-TOKENBUF :CUR 0 :MAX 0 :DATA
        (MAKE-ARRAY 1024 :ELEMENT-TYPE 'CHARACTER)))))

[cl-html-parse/dev/cl-html-parse.lisp:555]
  (DEFUN PUT-BACK-TOKENBUF (BUF)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (DO ((BUFS *TOKENBUFS* (CDR BUFS)))
        ((NULL BUFS) NIL)
      (IF* (NULL (CAR BUFS)) THEN (SETF (CAR BUFS) BUF) (RETURN))))

[cl-html-parse/dev/cl-html-parse.lisp:571]
  (DEFUN NEXT-TOKEN
         (STREAM IGNORE-STRINGS RAW-MODE-DELIMITER READ-SEQUENCE-FUNC TOKENBUF
          PARSE-ENTITIES)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (MACROLET ((NEXT-CHAR (STREAM)
                 (ECLECTOR.READER:QUASIQUOTE
                  (LET ((CUR (TOKENBUF-CUR TOKENBUF))
                        (TB (TOKENBUF-DATA TOKENBUF)))
                    (IF* (>= CUR (TOKENBUF-MAX TOKENBUF)) THEN
                     (IF*
                      (ZEROP
                       (SETF (TOKENBUF-MAX TOKENBUF)
                               (IF* READ-SEQUENCE-FUNC THEN
                                (FUNCALL READ-SEQUENCE-FUNC TB STREAM) ELSE
                                (READ-SEQUENCE TB STREAM))))
                      THEN (SETQ CUR NIL) ELSE (SETQ CUR 0)))
                    (IF* CUR THEN
                     (PROG1 (SCHAR TB CUR)
                       (SETF (TOKENBUF-CUR TOKENBUF) (1+ CUR)))))))
               (UN-NEXT-CHAR (STREAM CH)
                 (ECLECTOR.READER:QUASIQUOTE (DECF (TOKENBUF-CUR TOKENBUF))))
               (CLEAR-COLL (COLL)
                 (ECLECTOR.READER:QUASIQUOTE (SETF (COLLECTOR-NEXT COLL) 0)))
               (ADD-TO-COLL (COLL CH)
                 (ECLECTOR.READER:QUASIQUOTE
                  (LET ((.NEXT.
                         (COLLECTOR-NEXT (ECLECTOR.READER:UNQUOTE COLL))))
                    (IF*
                     (>= .NEXT. (COLLECTOR-MAX (ECLECTOR.READER:UNQUOTE COLL)))
                     THEN
                     (GROW-AND-ADD (ECLECTOR.READER:UNQUOTE COLL)
                      (ECLECTOR.READER:UNQUOTE CH))
                     ELSE
                     (SETF (SCHAR
                            (COLLECTOR-DATA (ECLECTOR.READER:UNQUOTE COLL))
                            .NEXT.)
                             (ECLECTOR.READER:UNQUOTE CH))
                     (SETF (COLLECTOR-NEXT (ECLECTOR.READER:UNQUOTE COLL))
                             (1+ .NEXT.)))))))
      (LET ((STATE
             (IF* RAW-MODE-DELIMITER THEN STATE-RAWDATA ELSE STATE-PCDATA))
            (COLL (GET-COLLECTOR))
            (CH)
            (VALUE-DELIM)
            (TAG-TO-RETURN)
            (ATTRIBS-TO-RETURN)
            (END-TAG)
            (ATTRIB-NAME)
            (ATTRIB-VALUE)
            (NAME-LENGTH 0)
            (RAW-LENGTH 0)
            (XML-BAILOUT))
        (LOOP (SETQ CH (NEXT-CHAR STREAM))
              (IF* (NULL CH) THEN (RETURN))
              (CASE STATE
                (()
                 (IF* (EQ CH #\<) THEN
                  (IF* (> (COLLECTOR-NEXT COLL) 0) THEN
                   (UN-NEXT-CHAR STREAM CH) (RETURN) ELSE
                   (SETQ STATE STATE-READTAGFIRST))
                  ELSEIF (AND PARSE-ENTITIES (EQ CH #\&)) THEN
                  (LET (RES (MAX 10))
                    (LOOP
                     (LET ((CH (NEXT-CHAR STREAM)))
                       (IF* (NULL CH) THEN
                        (ERROR "End of file after & entity marker") ELSEIF
                        (EQ CH #\;) THEN (RETURN) ELSEIF (ZEROP (DECF MAX))
                        THEN
                        (ERROR
                         "No semicolon found after entity starting: &~{~a~}"
                         (NREVERSE RES))
                        ELSE (PUSH CH RES))))
                    (SETQ RES (NREVERSE RES))
                    (IF* (EQ (CAR RES) #\#) THEN
                     (LET ((COUNT 0))
                       (DOLIST (CH (CDR RES))
                         (LET ((CODE (CHAR-CODE CH)))
                           (IF* (<= NIL CODE NIL) THEN
                            (SETQ COUNT (+ (* 10 COUNT) (- CODE NIL))) ELSE
                            (ERROR "non decimal digit after &# - ~s" CH))))
                       (ADD-TO-COLL COLL (CODE-CHAR COUNT)))
                     ELSE
                     (LET ((NAME
                            (MAKE-ARRAY (LENGTH RES) :ELEMENT-TYPE 'CHARACTER
                                        :INITIAL-CONTENTS RES)))
                       (LET ((CH (GETHASH NAME *HTML-ENTITY-TO-CODE*)))
                         (IF* CH THEN (ADD-TO-COLL COLL (CODE-CHAR CH)) ELSE
                          (ERROR "No such entity as ~s" NAME))))))
                  ELSE
                  (IF* (NOT (EQ CH #\Return)) THEN (ADD-TO-COLL COLL CH))))
                (()
                 (IF* (EQ #\/ CH) THEN (SETQ END-TAG T) ELSE
                  (IF* (EQ #\! CH) THEN (SETF XML-BAILOUT T)
                   (SETQ NAME-LENGTH 0))
                  (UN-NEXT-CHAR STREAM CH))
                 (SETQ STATE STATE-READTAG))
                (()
                 (IF* (CHAR-CHARACTERISTIC CH CHAR-TAGCHARACTER) THEN
                  (ADD-TO-COLL COLL (TO-PREFERRED-CASE CH)) (INCF NAME-LENGTH)
                  (IF* (AND (EQ NAME-LENGTH 3) (COLL-HAS-COMMENT COLL)) THEN
                   (CLEAR-COLL COLL) (SETQ STATE STATE-READCOMMENT))
                  ELSE (SETQ TAG-TO-RETURN (COMPUTE-TAG COLL))
                  (CLEAR-COLL COLL)
                  (IF* (EQ CH #\>) THEN (RETURN) ELSEIF XML-BAILOUT THEN
                   (UN-NEXT-CHAR STREAM CH) (RETURN) ELSE
                   (IF* (EQ TAG-TO-RETURN :!--) THEN
                    (SETQ STATE STATE-READCOMMENT) ELSE
                    (UN-NEXT-CHAR STREAM CH)
                    (SETQ STATE STATE-FINDATTRIBNAME)))))
                (()
                 (IF* (EQ CH #\>) THEN (RETURN) ELSEIF (EQ CH #\=) THEN
                  (POP ATTRIBS-TO-RETURN)
                  (SETQ ATTRIB-NAME (POP ATTRIBS-TO-RETURN))
                  (SETQ STATE STATE-FINDVALUE) ELSEIF
                  (CHAR-CHARACTERISTIC CH CHAR-ATTRIBNAMECHAR) THEN
                  (UN-NEXT-CHAR STREAM CH) (SETQ STATE STATE-ATTRIBNAME) ELSE
                  NIL))
                (()
                 (IF* (CHAR-CHARACTERISTIC CH CHAR-SPACECHAR) THENRET ELSEIF
                  (EQ CH #\>) THEN
                  (SETQ ATTRIB-VALUE (STRING-DOWNCASE (STRING ATTRIB-NAME)))
                  (PUSH ATTRIB-NAME ATTRIBS-TO-RETURN)
                  (PUSH ATTRIB-VALUE ATTRIBS-TO-RETURN)
                  (UN-NEXT-CHAR STREAM CH) (SETQ STATE STATE-FINDATTRIBNAME)
                  ELSE (UN-NEXT-CHAR STREAM CH)
                  (SETQ STATE STATE-ATTRIBSTARTVALUE)))
                (()
                 (IF* (CHAR-CHARACTERISTIC CH CHAR-ATTRIBNAMECHAR) THEN
                  (ADD-TO-COLL COLL (TO-PREFERRED-CASE CH)) ELSEIF (EQ #\= CH)
                  THEN (SETQ ATTRIB-NAME (COMPUTE-TAG COLL)) (CLEAR-COLL COLL)
                  (SETQ STATE STATE-ATTRIBSTARTVALUE) ELSE
                  (SETQ ATTRIB-NAME (COMPUTE-TAG COLL)) (CLEAR-COLL COLL)
                  (SETQ ATTRIB-VALUE (STRING-DOWNCASE (STRING ATTRIB-NAME)))
                  (PUSH ATTRIB-NAME ATTRIBS-TO-RETURN)
                  (PUSH ATTRIB-VALUE ATTRIBS-TO-RETURN)
                  (UN-NEXT-CHAR STREAM CH) (SETQ STATE STATE-FINDATTRIBNAME)))
                (()
                 (IF* (OR (EQ CH #\") (EQ CH #\')) THEN (SETQ VALUE-DELIM CH)
                  (SETQ STATE STATE-ATTRIBVALUEDELIM) ELSEIF (EQ #\  CH) THEN
                  NIL ELSE (UN-NEXT-CHAR STREAM CH)
                  (SETQ STATE STATE-ATTRIBVALUENODELIM)))
                (()
                 (IF* (EQ CH VALUE-DELIM) THEN
                  (SETQ ATTRIB-VALUE (COMPUTE-COLL-STRING COLL))
                  (CLEAR-COLL COLL) (PUSH ATTRIB-NAME ATTRIBS-TO-RETURN)
                  (PUSH ATTRIB-VALUE ATTRIBS-TO-RETURN)
                  (SETQ STATE STATE-FINDATTRIBNAME) ELSE
                  (ADD-TO-COLL COLL CH)))
                (()
                 (IF* (CHAR-CHARACTERISTIC CH CHAR-ATTRIBUNDELIMATTRIBVALUE)
                  THEN (ADD-TO-COLL COLL CH) ELSE (UN-NEXT-CHAR STREAM CH)
                  (SETQ ATTRIB-VALUE (COMPUTE-COLL-STRING COLL))
                  (CLEAR-COLL COLL) (PUSH ATTRIB-NAME ATTRIBS-TO-RETURN)
                  (PUSH ATTRIB-VALUE ATTRIBS-TO-RETURN)
                  (SETQ STATE STATE-FINDATTRIBNAME)))
                (()
                 (IF* (EQ CH #\-) THEN (SETQ STATE STATE-READCOMMENT-ONE) ELSE
                  (ADD-TO-COLL COLL CH)))
                (()
                 (IF* (EQ CH #\-) THEN (SETQ STATE STATE-READCOMMENT-TWO) ELSE
                  (ADD-TO-COLL COLL #\-) (ADD-TO-COLL COLL CH)
                  (SETQ STATE STATE-READCOMMENT)))
                (()
                 (IF* (EQ CH #\>) THEN (RETURN) ELSEIF (EQ CH #\-) THEN
                  (ADD-TO-COLL COLL #\-) ELSE (ADD-TO-COLL COLL #\-)
                  (ADD-TO-COLL COLL #\-) (SETQ STATE STATE-READCOMMENT)))
                (()
                 (IF*
                  (EQ (TO-PREFERRED-CASE CH)
                      (ELT RAW-MODE-DELIMITER RAW-LENGTH))
                  THEN (INCF RAW-LENGTH)
                  (WHEN (= RAW-LENGTH (LENGTH RAW-MODE-DELIMITER))
                    (WHEN (/= (LENGTH RAW-MODE-DELIMITER) 1)
                      (PUSH :END-TAG (TOKENBUF-FIRST-PASS TOKENBUF))
                      (IF* (EQUAL RAW-MODE-DELIMITER "</STYLE>") THEN
                       (PUSH :STYLE (TOKENBUF-FIRST-PASS TOKENBUF)) ELSEIF
                       (EQUAL RAW-MODE-DELIMITER "</style>") THEN
                       (PUSH :STYLE (TOKENBUF-FIRST-PASS TOKENBUF)) ELSEIF
                       (EQUAL RAW-MODE-DELIMITER "</SCRIPT>") THEN
                       (PUSH :SCRIPT (TOKENBUF-FIRST-PASS TOKENBUF)) ELSEIF
                       (EQUAL RAW-MODE-DELIMITER "</script>") THEN
                       (PUSH :SCRIPT (TOKENBUF-FIRST-PASS TOKENBUF)) ELSE
                       (ERROR "unexpected raw-mode-delimiter")))
                    (RETURN))
                  ELSE
                  (DOTIMES (I RAW-LENGTH)
                    (ADD-TO-COLL COLL (ELT RAW-MODE-DELIMITER I)))
                  (SETF RAW-LENGTH 0) (ADD-TO-COLL COLL CH)))))
        (CASE STATE
          ((NIL NIL)
           (IF* (ZEROP (COLLECTOR-NEXT COLL)) THEN
            (VALUES NIL
                    (IF (EQ STATE STATE-PCDATA)
                        :EOF
                        :PCDATA))
            ELSE
            (VALUES
             (PROG1 (IF* (NULL IGNORE-STRINGS) THEN (COMPUTE-COLL-STRING COLL))
               (PUT-BACK-COLLECTOR COLL))
             :PCDATA)))
          (()
           (WHEN (NULL TAG-TO-RETURN)
             (ERROR "unexpected end of input encountered"))
           (PUT-BACK-COLLECTOR COLL)
           (VALUES TAG-TO-RETURN
                   (IF* END-TAG THEN :END-TAG ELSE
                    (IF* XML-BAILOUT THEN :XML ELSE :START-TAG))))
          (()
           (PUT-BACK-COLLECTOR COLL)
           (IF* END-TAG THEN (VALUES TAG-TO-RETURN :END-TAG) ELSEIF
            ATTRIBS-TO-RETURN THEN
            (VALUES (CONS TAG-TO-RETURN (NREVERSE ATTRIBS-TO-RETURN))
                    :START-TAG)
            ELSE (VALUES TAG-TO-RETURN :START-TAG)))
          (()
           (VALUES
            (PROG1 (IF* (NULL IGNORE-STRINGS) THEN (COMPUTE-COLL-STRING COLL))
              (PUT-BACK-COLLECTOR COLL))
            :COMMENT))
          (T
           (IF* (NULL CH) THEN (ERROR "unexpected end of input encountered")
            ELSE (ERROR "internal error, can't be here in state ~d" STATE)))))))

[cl-html-parse/dev/cl-html-parse.lisp:929]
  (DEFUN COMPUTE-TAG (COLL)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (INTERN
     (STRING-UPCASE (SUBSEQ (COLLECTOR-DATA COLL) 0 (COLLECTOR-NEXT COLL)))
     *KWD-PACKAGE*))

[cl-html-parse/dev/cl-html-parse.lisp:939]
  (DEFUN COMPUTE-COLL-STRING (COLL)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (LET ((STR (MAKE-STRING (COLLECTOR-NEXT COLL)))
          (FROM (COLLECTOR-DATA COLL)))
      (DOTIMES (I (COLLECTOR-NEXT COLL)) (SETF (SCHAR STR I) (SCHAR FROM I)))
      STR))

[cl-html-parse/dev/cl-html-parse.lisp:949]
  (DEFUN COLL-HAS-COMMENT (COLL)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (AND (EQ 3 (COLLECTOR-NEXT COLL))
         (LET ((DATA (COLLECTOR-DATA COLL)))
           (AND (EQ #\! (SCHAR DATA 0)) (EQ #\- (SCHAR DATA 1))
                (EQ #\- (SCHAR DATA 2))))))

[cl-html-parse/dev/cl-html-parse.lisp:1054]
  (DEFMETHOD PARSE-HTML
             ((P STREAM)
              &KEY CALLBACK-ONLY CALLBACKS COLLECT-ROGUE-TAGS NO-BODY-TAGS
              PARSE-ENTITIES)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (PHTML-INTERNAL P NIL CALLBACK-ONLY CALLBACKS COLLECT-ROGUE-TAGS
     NO-BODY-TAGS PARSE-ENTITIES))

[cl-html-parse/dev/cl-html-parse.lisp:1064]
  (DEFUN PHTML-INTERNAL
         (P READ-SEQUENCE-FUNC CALLBACK-ONLY CALLBACKS COLLECT-ROGUE-TAGS
          NO-BODY-TAGS PARSE-ENTITIES)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (LET ((RAW-MODE-DELIMITER NIL)
          (PENDING NIL)
          (CURRENT-TAG :START-PARSE)
          (LAST-TAG :START-PARSE)
          (CURRENT-CALLBACK-TAGS NIL)
          (PENDING-CH-FORMAT NIL)
          (CLOSED-PENDING-CH-FORMAT NIL)
          (NEW-OPENS NIL)
          (TOKENBUF (GET-TOKENBUF))
          (GUTS)
          (ROGUE-TAGS))
      (LABELS ((CLOSE-OFF-TAGS (NAME STOP-AT COLLECT-ROGUES ONCE-ONLY)
                 (FORMAT T "close off name ~s, stop at ~s, ct ~s~%" NAME
                         STOP-AT CURRENT-TAG)
                 (IF* (MEMBER (TAG-NAME CURRENT-TAG) NAME :TEST #'EQ) THEN
                  (LOOP
                   (WHEN
                       (AND COLLECT-ROGUES
                            (NOT (MEMBER (TAG-NAME CURRENT-TAG) *KNOWN-TAGS*)))
                     (PUSH (TAG-NAME CURRENT-TAG) ROGUE-TAGS))
                   (CLOSE-CURRENT-TAG)
                   (IF*
                    (OR ONCE-ONLY (MEMBER (TAG-NAME CURRENT-TAG) *CH-FORMAT*)
                        (NOT (MEMBER (TAG-NAME CURRENT-TAG) NAME :TEST #'EQ)))
                    THEN (RETURN)))
                  ELSEIF (MEMBER (TAG-NAME CURRENT-TAG) STOP-AT :TEST #'EQ)
                  THEN NIL ELSE
                  (DOLIST (ENT PENDING)
                    (IF* (MEMBER (TAG-NAME (CAR ENT)) NAME :TEST #'EQ) THEN
                     (LOOP
                      (WHEN
                          (AND COLLECT-ROGUES
                               (NOT
                                (MEMBER (TAG-NAME CURRENT-TAG) *KNOWN-TAGS*)))
                        (PUSH (TAG-NAME CURRENT-TAG) ROGUE-TAGS))
                      (CLOSE-CURRENT-TAG)
                      (IF* (MEMBER (TAG-NAME CURRENT-TAG) NAME :TEST #'EQ) THEN
                       (CLOSE-CURRENT-TAG) (RETURN)))
                     (RETURN) ELSEIF
                     (MEMBER (TAG-NAME (CAR ENT)) STOP-AT :TEST #'EQ) THEN
                     (RETURN)))))
               (CLOSE-CURRENT-TAG ()
                 (WHEN (MEMBER (TAG-NAME CURRENT-TAG) *CH-FORMAT* :TEST #'EQ)
                   (PUSH CURRENT-TAG CLOSED-PENDING-CH-FORMAT))
                 (LET (ELEMENT)
                   (IF* (TAG-NO-PCDATA (TAG-NAME CURRENT-TAG)) THEN
                    (SETQ ELEMENT
                            (ECLECTOR.READER:QUASIQUOTE
                             ((ECLECTOR.READER:UNQUOTE CURRENT-TAG)
                              (ECLECTOR.READER:UNQUOTE-SPLICING
                               (STRIP-REV-PCDATA GUTS)))))
                    ELSE
                    (SETQ ELEMENT
                            (ECLECTOR.READER:QUASIQUOTE
                             ((ECLECTOR.READER:UNQUOTE CURRENT-TAG)
                              (ECLECTOR.READER:UNQUOTE-SPLICING
                               (NREVERSE GUTS))))))
                   (LET ((CALLBACK (TAG-CALLBACK (TAG-NAME CURRENT-TAG))))
                     (WHEN CALLBACK
                       (SETF CURRENT-CALLBACK-TAGS
                               (REST CURRENT-CALLBACK-TAGS))
                       (FUNCALL CALLBACK ELEMENT)))
                   (LET* ((PREV (POP PENDING)))
                     (SETQ CURRENT-TAG (CAR PREV)
                           GUTS (CDR PREV))
                     (PUSH ELEMENT GUTS))))
               (SAVE-STATE ()
                 (PUSH (CONS CURRENT-TAG GUTS) PENDING)
                 (FORMAT T "state saved, pending ~s~%" PENDING))
               (STRIP-REV-PCDATA (STUFF)
                 (LET (RES)
                   (DOLIST (ST STUFF)
                     (IF* (NOT (STRINGP ST)) THEN (PUSH ST RES)))
                   RES))
               (CHECK-IN-LINE (CHECK-TAG)
                 (SETF NEW-OPENS NIL)
                 (LET (VAL
                       KIND
                       (I 0)
                       (LENGTH (LENGTH (TOKENBUF-FIRST-PASS TOKENBUF))))
                   (LOOP
                    (IF* (< I LENGTH) THEN
                     (SETF VAL (NTH I (TOKENBUF-FIRST-PASS TOKENBUF)))
                     (SETF KIND (NTH (+ I 1) (TOKENBUF-FIRST-PASS TOKENBUF)))
                     (SETF I (+ I 2))
                     (IF* (= I LENGTH) THEN
                      (SETF (TOKENBUF-FIRST-PASS TOKENBUF)
                              (NREVERSE (TOKENBUF-FIRST-PASS TOKENBUF))))
                     ELSE (MULTIPLE-VALUE-SETQ (VAL KIND) (GET-NEXT-TOKEN T))
                     (PUSH VAL (TOKENBUF-FIRST-PASS TOKENBUF))
                     (PUSH KIND (TOKENBUF-FIRST-PASS TOKENBUF)))
                    (WHEN (EQ KIND :EOF)
                      (IF* (= I LENGTH) THEN
                       (SETF (TOKENBUF-FIRST-PASS TOKENBUF)
                               (NREVERSE (TOKENBUF-FIRST-PASS TOKENBUF))))
                      (RETURN))
                    (WHEN (AND (EQ VAL CHECK-TAG) (EQ KIND :END-TAG))
                      (IF* (= I LENGTH) THEN
                       (SETF (TOKENBUF-FIRST-PASS TOKENBUF)
                               (NREVERSE (TOKENBUF-FIRST-PASS TOKENBUF))))
                      (RETURN))
                    (WHEN (MEMBER VAL *CH-FORMAT* :TEST #'EQ)
                      (IF* (EQ KIND :START-TAG) THEN (PUSH VAL NEW-OPENS)
                       ELSEIF (MEMBER VAL NEW-OPENS :TEST #'EQ) THEN
                       (SETF NEW-OPENS (REMOVE VAL NEW-OPENS :COUNT 1)) ELSE
                       (CLOSE-OFF-TAGS (LIST VAL) NIL NIL NIL))))))
               (GET-NEXT-TOKEN (FORCE)
                 (IF* (OR FORCE (NULL (TOKENBUF-FIRST-PASS TOKENBUF))) THEN
                  (MULTIPLE-VALUE-BIND (VAL KIND)
                      (NEXT-TOKEN P NIL RAW-MODE-DELIMITER READ-SEQUENCE-FUNC
                       TOKENBUF PARSE-ENTITIES)
                    (VALUES VAL KIND))
                  ELSE
                  (LET ((VAL (FIRST (TOKENBUF-FIRST-PASS TOKENBUF)))
                        (KIND (SECOND (TOKENBUF-FIRST-PASS TOKENBUF))))
                    (SETF (TOKENBUF-FIRST-PASS TOKENBUF)
                            (REST (REST (TOKENBUF-FIRST-PASS TOKENBUF))))
                    (VALUES VAL KIND)))))
        (LOOP
         (MULTIPLE-VALUE-BIND (VAL KIND)
             (GET-NEXT-TOKEN NIL)
           (FORMAT T "val: ~s kind: ~s  last-tag ~s pending ~s~%" VAL KIND
                   LAST-TAG PENDING)
           (CASE KIND
             (:PCDATA
              (WHEN
                  (OR (AND CALLBACK-ONLY CURRENT-CALLBACK-TAGS)
                      (NOT CALLBACK-ONLY))
                (IF* (MEMBER LAST-TAG *IN-LINE*) THEN (PUSH VAL GUTS) ELSE
                 (WHEN
                     (DOTIMES (I (LENGTH VAL) NIL)
                       (WHEN
                           (NOT
                            (CHAR-CHARACTERISTIC (ELT VAL I) CHAR-SPACECHAR))
                         (RETURN T)))
                   (PUSH VAL GUTS))))
              (WHEN
                  (AND (= (LENGTH RAW-MODE-DELIMITER) 1)
                       (OR (AND CALLBACK-ONLY CURRENT-CALLBACK-TAGS)
                           (NOT CALLBACK-ONLY)))
                (CLOSE-OFF-TAGS (LIST LAST-TAG) NIL NIL T))
              (SETF RAW-MODE-DELIMITER NIL))
             (:XML
              (SETF LAST-TAG VAL)
              (SETF RAW-MODE-DELIMITER ">")
              (LET* ((NAME (TAG-NAME VAL)))
                (WHEN (AND CALLBACK-ONLY (TAG-CALLBACK NAME))
                  (PUSH NAME CURRENT-CALLBACK-TAGS))
                (SAVE-STATE)
                (SETQ CURRENT-TAG VAL)
                (SETQ GUTS NIL)))
             (:START-TAG
              (SETF LAST-TAG VAL)
              (IF*
               (OR (EQ LAST-TAG :STYLE)
                   (AND (LISTP LAST-TAG) (EQ (FIRST LAST-TAG) :STYLE)))
               THEN
               (SETF RAW-MODE-DELIMITER
                       (IF* (EQ (CURRENT-CASE-MODE) :CASE-INSENSITIVE-UPPER)
                        THEN "</STYLE>" ELSE "</style>"))
               ELSEIF
               (OR (EQ LAST-TAG :SCRIPT)
                   (AND (LISTP LAST-TAG) (EQ (FIRST LAST-TAG) :SCRIPT)))
               THEN
               (SETF RAW-MODE-DELIMITER
                       (IF* (EQ (CURRENT-CASE-MODE) :CASE-INSENSITIVE-UPPER)
                        THEN "</SCRIPT>" ELSE "</script>")))
              (LET* ((NAME (TAG-NAME VAL))
                     (AUTO-CLOSE (TAG-AUTO-CLOSE NAME))
                     (AUTO-CLOSE-STOP NIL)
                     (NO-END (OR (TAG-NO-END NAME) (MEMBER NAME NO-BODY-TAGS))))
                (WHEN (AND CALLBACK-ONLY (TAG-CALLBACK NAME))
                  (PUSH NAME CURRENT-CALLBACK-TAGS))
                (WHEN
                    (OR (AND CALLBACK-ONLY CURRENT-CALLBACK-TAGS)
                        (NOT CALLBACK-ONLY))
                  (IF* AUTO-CLOSE THEN
                   (SETQ AUTO-CLOSE-STOP (TAG-AUTO-CLOSE-STOP NAME))
                   (CLOSE-OFF-TAGS AUTO-CLOSE AUTO-CLOSE-STOP NIL NIL))
                  (WHEN (AND PENDING-CH-FORMAT (NOT NO-END))
                    (IF* (MEMBER NAME *CH-FORMAT* :TEST #'EQ) THEN NIL ELSEIF
                     (MEMBER NAME *IN-LINE* :TEST #'EQ) THEN
                     (CHECK-IN-LINE NAME) ELSE
                     (DOLIST (THIS-TAG (REVERSE PENDING-CH-FORMAT))
                       (CLOSE-OFF-TAGS
                        (LIST
                         (IF (LISTP THIS-TAG)
                             (FIRST THIS-TAG)
                             THIS-TAG))
                        NIL NIL NIL))))
                  (IF* NO-END THEN
                   (LET ((CALLBACK
                          (TAG-CALLBACK
                           (TAG-NAME
                            (IF* (ATOM VAL) THEN VAL ELSE (FIRST VAL))))))
                     (WHEN CALLBACK
                       (FUNCALL CALLBACK
                                (IF* (ATOM VAL) THEN VAL ELSE (LIST VAL)))))
                   (PUSH (IF* (ATOM VAL) THEN VAL ELSE (LIST VAL)) GUTS) ELSE
                   (SAVE-STATE) (SETQ CURRENT-TAG VAL) (SETQ GUTS NIL))
                  (IF* (MEMBER NAME *CH-FORMAT* :TEST #'EQ) THEN
                   (PUSH VAL PENDING-CH-FORMAT) ELSE
                   (WHEN
                       (NOT
                        (OR (EQ LAST-TAG :STYLE)
                            (AND (LISTP LAST-TAG) (EQ (FIRST LAST-TAG) :STYLE))
                            (EQ LAST-TAG :SCRIPT)
                            (AND (LISTP LAST-TAG)
                                 (EQ (FIRST LAST-TAG) :SCRIPT))))
                     (DOLIST (TMP (REVERSE CLOSED-PENDING-CH-FORMAT))
                       (SAVE-STATE)
                       (SETF CURRENT-TAG TMP)
                       (SETF GUTS NIL))))
                  (WHEN
                      (NOT
                       (OR (EQ LAST-TAG :STYLE)
                           (AND (LISTP LAST-TAG) (EQ (FIRST LAST-TAG) :STYLE))
                           (EQ LAST-TAG :SCRIPT)
                           (AND (LISTP LAST-TAG)
                                (EQ (FIRST LAST-TAG) :SCRIPT))))
                    (SETF CLOSED-PENDING-CH-FORMAT NIL)))))
             (:END-TAG
              (SETF RAW-MODE-DELIMITER NIL)
              (WHEN
                  (OR (AND CALLBACK-ONLY CURRENT-CALLBACK-TAGS)
                      (NOT CALLBACK-ONLY))
                (CLOSE-OFF-TAGS (LIST VAL) NIL NIL T)
                (WHEN (MEMBER VAL *CH-FORMAT* :TEST #'EQ)
                  (SETF PENDING-CH-FORMAT
                          (REMOVE VAL PENDING-CH-FORMAT :COUNT 1 :TEST
                                  #'(LAMBDA (X Y)
                                      (EQ X
                                          (IF (LISTP Y)
                                              (FIRST Y)
                                              Y)))))
                  (SETF CLOSED-PENDING-CH-FORMAT
                          (REMOVE VAL CLOSED-PENDING-CH-FORMAT :COUNT 1 :TEST
                                  #'(LAMBDA (X Y)
                                      (EQ X
                                          (IF (LISTP Y)
                                              (FIRST Y)
                                              Y))))))
                (DOLIST (TMP (REVERSE CLOSED-PENDING-CH-FORMAT))
                  (SAVE-STATE)
                  (SETF CURRENT-TAG TMP)
                  (SETF GUTS NIL))
                (SETF CLOSED-PENDING-CH-FORMAT NIL)))
             (:COMMENT
              (SETF RAW-MODE-DELIMITER NIL)
              (WHEN
                  (OR (AND CALLBACK-ONLY CURRENT-CALLBACK-TAGS)
                      (NOT CALLBACK-ONLY))
                (PUSH
                 (ECLECTOR.READER:QUASIQUOTE
                  (:COMMENT (ECLECTOR.READER:UNQUOTE VAL)))
                 GUTS)))
             (:EOF
              (SETF RAW-MODE-DELIMITER NIL)
              (WHEN
                  (OR (AND CALLBACK-ONLY CURRENT-CALLBACK-TAGS)
                      (NOT CALLBACK-ONLY))
                (CLOSE-OFF-TAGS '(:START-PARSE) NIL COLLECT-ROGUE-TAGS NIL))
              (PUT-BACK-TOKENBUF TOKENBUF)
              (IF COLLECT-ROGUE-TAGS
                  (RETURN (VALUES (CDAR GUTS) ROGUE-TAGS))
                  (RETURN (CDAR GUTS))))))))))

[cl-html-parse/dev/cl-html-parse.lisp:1350]
  (DEFMETHOD PARSE-HTML
             (FILE
              &KEY CALLBACK-ONLY CALLBACKS COLLECT-ROGUE-TAGS NO-BODY-TAGS
              PARSE-ENTITIES)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (WITH-OPEN-FILE (P FILE :DIRECTION :INPUT)
      (PARSE-HTML P :CALLBACK-ONLY CALLBACK-ONLY :CALLBACKS CALLBACKS
       :COLLECT-ROGUE-TAGS COLLECT-ROGUE-TAGS :NO-BODY-TAGS NO-BODY-TAGS
       :PARSE-ENTITIES PARSE-ENTITIES)))

[cl-html-parse/dev/cl-html-parse.lisp:1361]
  (DEFMETHOD PARSE-HTML
             ((STR STRING)
              &KEY CALLBACK-ONLY CALLBACKS COLLECT-ROGUE-TAGS NO-BODY-TAGS
              PARSE-ENTITIES)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (PARSE-HTML (MAKE-STRING-INPUT-STREAM STR) :CALLBACK-ONLY CALLBACK-ONLY
     :CALLBACKS CALLBACKS :COLLECT-ROGUE-TAGS COLLECT-ROGUE-TAGS :NO-BODY-TAGS
     NO-BODY-TAGS :PARSE-ENTITIES PARSE-ENTITIES))

[cl-irregsexp/src/force.lisp:72]
  (DEFUN-CONSISTENT FORCE-SIMPLE-STRING (VAL)
   "Return a representation of VAL as a string, doing the work at compile-time if possible."
   (DECLARE (OPTIMIZE SPEED (SAFETY 0)))
   (LET ((VAL (FORCE-STRING VAL)))
     (ETYPECASE VAL
       (SIMPLE-STRING VAL)
       (STRING (REPLACE (MAKE-STRING (LENGTH VAL)) VAL)))))

[cl-irregsexp/src/macros.lisp:54]
  (DEFMACRO DEFUN-CAREFUL (NAME LAMBDA-LIST &BODY BODY)
    (ECLECTOR.READER:QUASIQUOTE
     (PROGN
      (DEFUN (ECLECTOR.READER:UNQUOTE NAME)
             (ECLECTOR.READER:UNQUOTE LAMBDA-LIST)
        (DECLARE (OPTIMIZE DEBUG SAFETY (SPEED 0)))
        (ECLECTOR.READER:UNQUOTE-SPLICING BODY)))))

[cl-irregsexp/src/opt.lisp:3]
  (DEFPARAMETER *OPTIMIZE-UNSAFE*
    (ECLECTOR.READER:QUASIQUOTE (OPTIMIZE SPEED (SAFETY 0))))

[cl-irregsexp/src/opt.lisp:7]
  (DEFPARAMETER *OPTIMIZE-UNSAFE*
    (ECLECTOR.READER:QUASIQUOTE (OPTIMIZE (SAFETY 3) DEBUG (SPEED 0))))

[cl-isaac/isaac-32.lisp:19]
  (DEFUN GENERATE-NEXT-ISAAC-BLOCK (CTX)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (INCF (ISAAC-CTX-C CTX))
    (INCF (ISAAC-CTX-B CTX) (ISAAC-CTX-C CTX))
    (LOOP FOR I FROM 0 BELOW 256
          DO (SETF (ISAAC-CTX-A CTX)
                     (LOGXOR (ISAAC-CTX-A CTX)
                             (LOGAND 4294967295
                                     (THE (UNSIGNED-BYTE 32)
                                          (ASH (ISAAC-CTX-A CTX)
                                               (ECASE (LOGAND I 3)
                                                 ((0) 13)
                                                 ((1) -6)
                                                 ((2) 2)
                                                 ((3) -16))))))) (SETF (ISAAC-CTX-A
                                                                        CTX)
                                                                         (LOGAND
                                                                          4294967295
                                                                          (+
                                                                           (ISAAC-CTX-A
                                                                            CTX)
                                                                           (AREF
                                                                            (ISAAC-CTX-RANDMEM
                                                                             CTX)
                                                                            (LOGAND
                                                                             (+
                                                                              I
                                                                              128)
                                                                             255))))) (LET* ((X
                                                                                              (AREF
                                                                                               (ISAAC-CTX-RANDMEM
                                                                                                CTX)
                                                                                               I))
                                                                                             (Y
                                                                                              (LOGAND
                                                                                               4294967295
                                                                                               (+
                                                                                                (AREF
                                                                                                 (ISAAC-CTX-RANDMEM
                                                                                                  CTX)
                                                                                                 (LOGAND
                                                                                                  (ASH
                                                                                                   X
                                                                                                   -2)
                                                                                                  255))
                                                                                                (ISAAC-CTX-A
                                                                                                 CTX)
                                                                                                (ISAAC-CTX-B
                                                                                                 CTX)))))
                                                                                        (SETF (AREF
                                                                                               (ISAAC-CTX-RANDMEM
                                                                                                CTX)
                                                                                               I)
                                                                                                Y)
                                                                                        (SETF (ISAAC-CTX-B
                                                                                               CTX)
                                                                                                (LOGAND
                                                                                                 4294967295
                                                                                                 (+
                                                                                                  (AREF
                                                                                                   (ISAAC-CTX-RANDMEM
                                                                                                    CTX)
                                                                                                   (LOGAND
                                                                                                    (ASH
                                                                                                     Y
                                                                                                     -10)
                                                                                                    255))
                                                                                                  X)))
                                                                                        (SETF (AREF
                                                                                               (ISAAC-CTX-RANDRSL
                                                                                                CTX)
                                                                                               I)
                                                                                                (ISAAC-CTX-B
                                                                                                 CTX)))))

[cl-isaac/isaac-32.lisp:49]
  (DEFUN RAND32 (CTX)
    (LET ((C (ISAAC-CTX-RANDCNT CTX)))
      (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
      (DECF (ISAAC-CTX-RANDCNT CTX))
      (IF (ZEROP C)
          (PROGN
           (GENERATE-NEXT-ISAAC-BLOCK CTX)
           (SETF (ISAAC-CTX-RANDCNT CTX) 255)
           (AREF (ISAAC-CTX-RANDRSL CTX) 255))
          (AREF (ISAAC-CTX-RANDRSL CTX) (ISAAC-CTX-RANDCNT CTX)))))

[cl-isaac/isaac-64.lisp:21]
  (DEFUN GENERATE-NEXT-ISAAC64-BLOCK (CTX)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (INCF (ISAAC64-CTX-C CTX))
    (INCF (ISAAC64-CTX-B CTX) (ISAAC64-CTX-C CTX))
    (LOOP FOR I FROM 0 BELOW 256
          DO (SETF (ISAAC64-CTX-A CTX)
                     (LOGXOR (ISAAC64-CTX-A CTX)
                             (LOGAND 18446744073709551615
                                     (THE (UNSIGNED-BYTE 64)
                                          (ASH (ISAAC64-CTX-A CTX)
                                               (ECASE (LOGAND I 3)
                                                 ((0) 21)
                                                 ((1) -5)
                                                 ((2) 12)
                                                 ((3) -33))))))) (SETF (ISAAC64-CTX-A
                                                                        CTX)
                                                                         (LOGAND
                                                                          18446744073709551615
                                                                          (+
                                                                           (ISAAC64-CTX-A
                                                                            CTX)
                                                                           (AREF
                                                                            (ISAAC64-CTX-RANDMEM
                                                                             CTX)
                                                                            (LOGAND
                                                                             (+
                                                                              I
                                                                              128)
                                                                             255))))) (LET* ((X
                                                                                              (AREF
                                                                                               (ISAAC64-CTX-RANDMEM
                                                                                                CTX)
                                                                                               I))
                                                                                             (Y
                                                                                              (LOGAND
                                                                                               18446744073709551615
                                                                                               (+
                                                                                                (AREF
                                                                                                 (ISAAC64-CTX-RANDMEM
                                                                                                  CTX)
                                                                                                 (LOGAND
                                                                                                  (ASH
                                                                                                   X
                                                                                                   -2)
                                                                                                  255))
                                                                                                (ISAAC64-CTX-A
                                                                                                 CTX)
                                                                                                (ISAAC64-CTX-B
                                                                                                 CTX)))))
                                                                                        (SETF (AREF
                                                                                               (ISAAC64-CTX-RANDMEM
                                                                                                CTX)
                                                                                               I)
                                                                                                Y)
                                                                                        (SETF (ISAAC64-CTX-B
                                                                                               CTX)
                                                                                                (LOGAND
                                                                                                 18446744073709551615
                                                                                                 (+
                                                                                                  (AREF
                                                                                                   (ISAAC64-CTX-RANDMEM
                                                                                                    CTX)
                                                                                                   (LOGAND
                                                                                                    (ASH
                                                                                                     Y
                                                                                                     -10)
                                                                                                    255))
                                                                                                  X)))
                                                                                        (SETF (AREF
                                                                                               (ISAAC64-CTX-RANDRSL
                                                                                                CTX)
                                                                                               I)
                                                                                                (ISAAC64-CTX-B
                                                                                                 CTX)))))

[cl-isaac/isaac-64.lisp:51]
  (DEFUN RAND64 (CTX)
    (LET ((C (ISAAC64-CTX-RANDCNT CTX)))
      (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
      (DECF (ISAAC64-CTX-RANDCNT CTX))
      (IF (ZEROP C)
          (PROGN
           (GENERATE-NEXT-ISAAC64-BLOCK CTX)
           (SETF (ISAAC64-CTX-RANDCNT CTX) 255)
           (AREF (ISAAC64-CTX-RANDRSL CTX) 255))
          (AREF (ISAAC64-CTX-RANDRSL CTX) (ISAAC64-CTX-RANDCNT CTX)))))

[cl-jpeg/jpeg.lisp:94]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (DEFPARAMETER *OPTIMIZE*
      '(OPTIMIZE (SAFETY 0) (SPACE 0) (DEBUG 0) (SPEED 3))))

[cl-jpl-util/jpl-util.lisp:1386]
  (DEFUN FRACTIONAL (INPUT DENOMINATORS)
    "Finds the closest approximation of INPUT of the form (+ I (/ N D)),
where I is an integer with the same sign as INPUT, N is a numerator of
the same sign as INPUT, and D is a denominator from the non-empty list
of positive integers DENOMINATORS.  Returns the values I, N, and D.

For example, with DENOMINATORS equal to (2 3 4), here are
some results from example values of INPUT:

  0.5 => 0 1 2
  3.667 => 3 2 3
  365.2425 => 365 1 4

It is conventional to express U.S. customary units with fractions,
rather than decimal numbers.  You can use FRACTIONAL to do this:

  (defun format-inches (stream inches)
    (multiple-value-bind (i n d)
	(jpl-util:fractional inches '(2 4 8 16))
      ;; If you're really clever, I'm sure you can squeeze this into
      ;; one big FORMAT control.

      ;; Explicitly print minus sign, rather than use the sign of i,
      ;; in-case i is zero but n is negative.
      (when (minusp inches)
	(princ #- stream))
      (princ (abs i) stream)
      (unless (zerop n)
	(format stream \" ~D/~D\" (abs n) d))
      (princ \" in\" stream))
    (values))

  (format-inches t -0.07)  => -0 1/16 in
  (format-inches t 3.882)  => 3 7/8 in
  (format-inches t 11.997) => 12 in"
    (DECLARE (OPTIMIZE SAFETY DEBUG)
             (TYPE REAL INPUT))
    (LABELS ((FRACTION (D)
               (MULTIPLE-VALUE-BIND (I FRAC-PART)
                   (TRUNCATE INPUT)
                 (LET* ((N (ROUND (* FRAC-PART D)))
                        (APPROXIMATION (FRACTION-VALUE I N D)))
                   (MULTIPLE-VALUE-BIND (I FRAC-PART)
                       (TRUNCATE APPROXIMATION)
                     (LET ((N (* FRAC-PART D)))
                       (LIST I N D))))))
             (FRACTION-VALUE (I N D)
               (+ I (/ N D)))
             (FRACTION-ABS-ERROR (FRACTION)
               (ABS (- INPUT (APPLY #'FRACTION-VALUE FRACTION)))))
      (LET ((APPROXIMATIONS
             (IF (ZEROP (MOD INPUT 1))
                 (ECLECTOR.READER:QUASIQUOTE
                  (((ECLECTOR.READER:UNQUOTE INPUT) 0
                    (ECLECTOR.READER:UNQUOTE (FIRST DENOMINATORS)))))
                 (MAP 'LIST #'FRACTION DENOMINATORS))))
        (VALUES-LIST (BEST APPROXIMATIONS #'< :KEY #'FRACTION-ABS-ERROR)))))

[cl-libsvm-format/src/cl-libsvm-format.lisp:12]
  (EVAL-WHEN (:COMPILE-TOPLEVEL)
    (DEFPARAMETER *OPTIMIZE-SETTINGS*
      '(OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0))))

[cl-libsvm-format/src/cl-libsvm-format.lisp:178]
  (DEFUN PARSE-STREAM
         (STREAM
          &KEY (BUFFER-SIZE 8192) (FIELD-SIZE 1024) (LABEL-TYPE 'FIXNUM))
    (DECLARE (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (DECLARE (TYPE FIXNUM BUFFER-SIZE FIELD-SIZE))
    (LET ((STATE (MAKE-STATE BUFFER-SIZE FIELD-SIZE :LABEL-TYPE LABEL-TYPE)))
      (LOOP FOR SIZE = (READ-SEQUENCE (STATE-BUFFER STATE) STREAM)
            UNTIL (= SIZE 0)
            DO (PARSE SIZE STATE)
            FINALLY (RETURN (FINISH STATE)))))

[cl-libsvm-format/src/parse-float.lisp:9]
  (LOCALLY
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
   (DEFTYPE VALID-RADIX ()
     "A valid Common Lisp radix."
     (ECLECTOR.READER:QUASIQUOTE (INTEGER 2 36)))
   (DEFTYPE BOUNDING-INDEX ()
     "A valid upper bound to a string."
     (ECLECTOR.READER:QUASIQUOTE
      (INTEGER 0 (ECLECTOR.READER:UNQUOTE ARRAY-TOTAL-SIZE-LIMIT))))
   (DEFTYPE STRING-INDEX ()
     "A valid string index."
     (ECLECTOR.READER:QUASIQUOTE
      (INTEGER 0 (ECLECTOR.READER:UNQUOTE (1- ARRAY-TOTAL-SIZE-LIMIT)))))
   (DECLAIM (TYPE SIMPLE-BASE-STRING +WHITESPACE-CHARACTERS+))
   (ALEXANDRIA:DEFINE-CONSTANT +WHITESPACE-CHARACTERS+
                               (COERCE
                                '(#\  #\Tab #\Return #\Newline #\Newline
                                  #\Page)
                                'SIMPLE-BASE-STRING)
                               :TEST #'STRING= :DOCUMENTATION
                               "List of whitespace characters")
   (DECLAIM (INLINE SIGN-CHAR-P))
   (DEFUN SIGN-CHAR-P (CHARACTER)
     "Predicate for testing if CHARACTER is a sign character (i.e. #+ or #-)."
     (DECLARE (TYPE CHARACTER CHARACTER))
     (OR (CHAR= #\+ CHARACTER) (CHAR= #\- CHARACTER)))
   (DECLAIM (INLINE WHITESPACE-CHAR-P))
   (DEFUN WHITESPACE-CHAR-P (CHARACTER)
     "Predicate for testing if CHARACTER is a whitespace character."
     (DECLARE (TYPE CHARACTER CHARACTER))
     (LOOP :FOR C :ACROSS +WHITESPACE-CHARACTERS+
           :THEREIS (CHAR= C CHARACTER)))
   (DEFUN PARSE-INTEGER-ONLY
          (STRING
           &KEY (START 0) (END (LENGTH STRING)) (RADIX 10) (ALLOW-SIGN T))
     "Parse an integer from a string, without skipping whitespaces.
Returns three values: the integer, the position in the string that
ended the parsing, and a boolean which is T if the parsing ended due
to a whitespace or end of the string, and NIL otherwise.  If
allow-sign is NIL (T by default), also signs are not allowed in the
string (i.e. cannot start with #+ or #-)."
     (DECLARE (TYPE (SIMPLE-ARRAY CHARACTER) STRING)
              (TYPE STRING-INDEX START)
              (TYPE BOUNDING-INDEX END)
              (TYPE VALID-RADIX RADIX))
     (LET ((INDEX START))
       (DECLARE (TYPE STRING-INDEX INDEX))
       (IF (>= INDEX END)
           (VALUES NIL INDEX T)
           (LET ((CHAR (CHAR STRING INDEX)))
             (IF (OR (AND (NOT ALLOW-SIGN) (SIGN-CHAR-P CHAR))
                     (WHITESPACE-CHAR-P CHAR))
                 (VALUES NIL INDEX T)
                 (MULTIPLE-VALUE-BIND (VALUE POSITION)
                     (PARSE-INTEGER STRING :START INDEX :END END :JUNK-ALLOWED
                                    T :RADIX RADIX)
                   (IF (OR (= POSITION END)
                           (WHITESPACE-CHAR-P (CHAR STRING POSITION)))
                       (VALUES VALUE POSITION T)
                       (VALUES VALUE POSITION NIL))))))))
   (DEFUN PARSE-FLOAT
          (STRING
           &KEY (START 0) (END (LENGTH STRING)) (RADIX 10) (JUNK-ALLOWED NIL)
           (DECIMAL-CHARACTER #\.) (EXPONENT-CHARACTER #\e))
     "Similar to PARSE-INTEGER, but parses a floating point value and
  returns the value as the specified TYPE (by default
  *READ-DEFAULT-FLOAT-FORMAT*). The DECIMAL-CHARACTER (by default #.)
  specifies the separator between the integer and decimal parts, and
  the EXPONENT-CHARACTER (by default #e, case insensitive) specifies
  the character before the exponent. Note that the exponent is only
  parsed if RADIX is 10."
     (DECLARE (TYPE (SIMPLE-ARRAY CHARACTER) STRING)
              (TYPE VALID-RADIX RADIX)
              (TYPE STRING-INDEX START)
              (TYPE BOUNDING-INDEX END)
              (TYPE CHARACTER DECIMAL-CHARACTER EXPONENT-CHARACTER))
     (LET* ((SIGN 1)
            (DIGITS 0)
            (INDEX START)
            (INTEGER-PART NIL)
            (DECIMAL-PART 0)
            (EXPONENT-PART 0)
            (RESULT NIL))
       (DECLARE (TYPE STRING-INDEX INDEX)
                (TYPE (SIGNED-BYTE 64) SIGN EXPONENT-PART)
                (TYPE (OR NULL (SIGNED-BYTE 64)) INTEGER-PART DECIMAL-PART))
       (LABELS ((PARSE-SIGN ()
                  (IF (= INDEX END)
                      #'PARSE-FINISH
                      (LET ((CHAR (CHAR STRING INDEX)))
                        (COND
                         ((CHAR= #\- CHAR)
                          (IF (>= (INCF INDEX) END)
                              #'PARSE-FINISH
                              (PROGN (SETF SIGN -1) #'PARSE-INTEGER-PART)))
                         ((CHAR= #\+ CHAR)
                          (IF (>= (INCF INDEX) END)
                              #'PARSE-FINISH
                              #'PARSE-INTEGER-PART))
                         (T #'PARSE-INTEGER-PART)))))
                (PARSE-INTEGER-PART ()
                  (MULTIPLE-VALUE-BIND (VALUE POSITION FINISHED)
                      (PARSE-INTEGER-ONLY STRING :START INDEX :END END :RADIX
                       RADIX :ALLOW-SIGN NIL)
                    (DECLARE (TYPE BOUNDING-INDEX POSITION))
                    (SETF INTEGER-PART VALUE
                          INDEX POSITION)
                    (IF FINISHED
                        #'PARSE-FINISH
                        (LET ((CHAR (CHAR STRING INDEX)))
                          (COND
                           ((CHAR= CHAR DECIMAL-CHARACTER) (INCF INDEX)
                            #'PARSE-DECIMAL-PART)
                           ((NULL INTEGER-PART) #'PARSE-FINISH)
                           ((AND (CHAR= CHAR EXPONENT-CHARACTER) (= RADIX 10))
                            (SETF INDEX (+ 1 INDEX)
                                  DECIMAL-PART 0)
                            #'PARSE-EXPONENT-PART)
                           (T #'PARSE-FINISH))))))
                (PARSE-DECIMAL-PART ()
                  (MULTIPLE-VALUE-BIND (VALUE POSITION FINISHED)
                      (PARSE-INTEGER-ONLY STRING :START INDEX :END END :RADIX
                       RADIX :ALLOW-SIGN NIL)
                    (DECLARE (TYPE BOUNDING-INDEX POSITION))
                    (SETF DECIMAL-PART (OR VALUE 0)
                          DIGITS (- POSITION INDEX)
                          INDEX POSITION)
                    (WHEN (AND DECIMAL-PART (NULL INTEGER-PART))
                      (SETF INTEGER-PART 0))
                    (IF FINISHED
                        #'PARSE-FINISH
                        (PROGN
                         (UNLESS DECIMAL-PART (SETF DECIMAL-PART 0))
                         (IF (AND (= RADIX 10)
                                  (CHAR= (CHAR STRING INDEX)
                                         EXPONENT-CHARACTER))
                             (PROGN (INCF INDEX) #'PARSE-EXPONENT-PART)
                             #'PARSE-FINISH)))))
                (PARSE-EXPONENT-PART ()
                  (MULTIPLE-VALUE-BIND (VALUE POSITION)
                      (PARSE-INTEGER STRING :START INDEX :END END :JUNK-ALLOWED
                                     T)
                    (DECLARE (TYPE BOUNDING-INDEX POSITION))
                    (SETF EXPONENT-PART (OR VALUE 0)
                          INDEX POSITION)
                    #'PARSE-FINISH))
                (PARSE-FINISH ()
                  (IF INTEGER-PART
                      (IF (OR (= INDEX END) JUNK-ALLOWED)
                          (SETF RESULT
                                  (* SIGN
                                     (+ (COERCE INTEGER-PART 'SINGLE-FLOAT)
                                        (* (COERCE DECIMAL-PART 'SINGLE-FLOAT)
                                           (EXPT (COERCE RADIX 'SINGLE-FLOAT)
                                                 (COERCE (- DIGITS)
                                                         'SINGLE-FLOAT))))
                                     (EXPT 10
                                           (COERCE EXPONENT-PART
                                                   'SINGLE-FLOAT))))
                          (SIMPLE-PARSE-ERROR "junk in string ~S." STRING))
                      (UNLESS JUNK-ALLOWED
                        (SIMPLE-PARSE-ERROR "junk in string ~S." STRING)))
                  NIL))
         (DECLARE
          (DYNAMIC-EXTENT (FUNCTION PARSE-SIGN) (FUNCTION PARSE-INTEGER-PART)
           (FUNCTION PARSE-DECIMAL-PART) (FUNCTION PARSE-EXPONENT-PART)
           (FUNCTION PARSE-FINISH)))
         (LOOP WITH PARSER = #'PARSE-SIGN
               WHILE PARSER
               DO (SETF PARSER (FUNCALL (THE FUNCTION PARSER)))
               FINALLY (RETURN (VALUES RESULT INDEX)))))))

[cl-libsvm/liblinear.lisp:235]
  (DEFUN FOO (P)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (SETF (FOREIGN-SLOT-VALUE P 'PROBLEM-STRUCT 'BIAS) 1.0d0))

[cl-libsvm/liblinear.lisp:239]
  (DEFUN FOO (P)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (SETF (FOREIGN-SLOT-VALUE P 'PROBLEM-STRUCT 'L) 1))

[cl-mathstats/dev/density-fns.lisp:15]
  (DEFUN GAMMA-LN (X)
    "Returns the natural logarithm of the Gamma function evaluated at `x.'
Mathematically, the Gamma function is defined to be the integral from 0 to
Infinity of t^x exp(-t) dt.  The implementation is copied, with extensions for
the reflection formula, from Numerical Recipes in C, section 6.1.  The argument
`x' must be positive.  Full accuracy is obtained for x>1.  For x<1, the
reflection formula is used.  The computation is done using double-floats, and
the result is a double-float."
    (FLET ((DO-IT (X)
             (DECLARE (OPTIMIZE (SPEED 3) (SPACE 1) (SAFETY 0) (DEBUG 0))
                      (TYPE DOUBLE-FLOAT X))
             (COND
              ((<= X 0.0d0) (ERROR "arg to gamma-ln must be positive:  ~s" X))
              ((> X 1.0d302) (ERROR "Argument too large:  ~e" X))
              ((= X 0.5d0) (LOG +SQRT-PI+))
              ((< X 1.0d0)
               (LET ((Z (- 1.0d0 X)))
                 (DECLARE (TYPE DOUBLE-FLOAT Z))
                 (- (+ (LOG Z) +LOG-PI+)
                    (+ (GAMMA-LN (+ 1.0d0 Z)) (LOG (SIN (* PI Z)))))))
              (T
               (LET* ((XX (- X 1.0d0)) (TMP (+ XX 5.5d0)) (SER 1.0d0))
                 (DECLARE (TYPE DOUBLE-FLOAT XX TMP SER))
                 (DECF TMP (* (+ XX 0.5d0) (LOG TMP)))
                 (DOLIST
                     (COEF
                      '(76.18009173d0 -86.50532033d0 24.01409822d0
                        -1.231739516d0 0.00120858003d0 -5.36382d-6))
                   (DECLARE (TYPE DOUBLE-FLOAT COEF))
                   (INCF XX 1.0d0)
                   (INCF SER (/ COEF XX)))
                 (- (LOG (* 2.50662827465d0 SER)) TMP))))))
      (IF (TYPEP X 'DOUBLE-FLOAT)
          (DO-IT X)
          (DO-IT (COERCE X 'DOUBLE-FLOAT)))))

[cl-mathstats/dev/sha1.lisp:73]
  (DEFUN F1 (X Y Z)
    (DECLARE (TYPE UB32 X Y Z)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (#S(FORMGREP:SYMREF :NAME "32BIT-LOGICAL-OR" :QUALIFIER "KERNEL")
     (#S(FORMGREP:SYMREF :NAME "32BIT-LOGICAL-AND" :QUALIFIER "KERNEL") X Y)
     (#S(FORMGREP:SYMREF :NAME "32BIT-LOGICAL-ANDC1" :QUALIFIER "KERNEL") X Z))
    (SB-KERNEL::32BIT-LOGICAL-OR (SB-KERNEL::32BIT-LOGICAL-AND X Y)
     (SB-KERNEL::32BIT-LOGICAL-ANDC1 X Z)))

[cl-mathstats/dev/sha1.lisp:88]
  (DEFUN F2 (X Y Z)
    (DECLARE (TYPE UB32 X Y Z)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (#S(FORMGREP:SYMREF :NAME "32BIT-LOGICAL-XOR" :QUALIFIER "KERNEL") X
     (#S(FORMGREP:SYMREF :NAME "32BIT-LOGICAL-XOR" :QUALIFIER "KERNEL") Y Z))
    (SB-KERNEL::32BIT-LOGICAL-XOR X (SB-KERNEL::32BIT-LOGICAL-XOR Y Z)))

[cl-mathstats/dev/sha1.lisp:101]
  (DEFUN F3 (X Y Z)
    (DECLARE (TYPE UB32 X Y Z)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (#S(FORMGREP:SYMREF :NAME "32BIT-LOGICAL-OR" :QUALIFIER "KERNEL")
     (#S(FORMGREP:SYMREF :NAME "32BIT-LOGICAL-OR" :QUALIFIER "KERNEL")
      (#S(FORMGREP:SYMREF :NAME "32BIT-LOGICAL-AND" :QUALIFIER "KERNEL") X Y)
      (#S(FORMGREP:SYMREF :NAME "32BIT-LOGICAL-AND" :QUALIFIER "KERNEL") X Z))
     (#S(FORMGREP:SYMREF :NAME "32BIT-LOGICAL-AND" :QUALIFIER "KERNEL") Y Z))
    (SB-KERNEL::32BIT-LOGICAL-OR
     (SB-KERNEL::32BIT-LOGICAL-OR (SB-KERNEL::32BIT-LOGICAL-AND X Y)
      (SB-KERNEL::32BIT-LOGICAL-AND X Z))
     (SB-KERNEL::32BIT-LOGICAL-AND Y Z)))

[cl-mathstats/dev/sha1.lisp:126]
  (DEFUN MOD32+ (A B)
    (DECLARE (TYPE UB32 A B)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LDB (BYTE 32 0) (+ A B)))

[cl-mathstats/dev/sha1.lisp:142]
  (DEFUN ROL32 (A S)
    (DECLARE (TYPE UB32 A)
             (TYPE (UNSIGNED-BYTE 5) S)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (#S(FORMGREP:SYMREF :NAME "32BIT-LOGICAL-OR" :QUALIFIER "KERNEL")
     (#S(FORMGREP:SYMREF :NAME "SHIFT-TOWARDS-END" :QUALIFIER "KERNEL") A S)
     (#S(FORMGREP:SYMREF :NAME "SHIFT-TOWARDS-START" :QUALIFIER "KERNEL") A S)
     (ASH A (- S 32)))
    (SB-ROTATE-BYTE:ROTATE-BYTE S (BYTE 32 0) A))

[cl-mathstats/dev/sha1.lisp:200]
  (DEFUN INITIAL-SHA1-REGS ()
    "Create the initial working state of an SHA1 run."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LET ((REGS (MAKE-ARRAY 5 :ELEMENT-TYPE '(UNSIGNED-BYTE 32))))
      (DECLARE (TYPE SHA1-REGS REGS))
      (SETF (SHA1-REGS-A REGS) +SHA1-MAGIC-A+
            (SHA1-REGS-B REGS) +SHA1-MAGIC-B+
            (SHA1-REGS-C REGS) +SHA1-MAGIC-C+
            (SHA1-REGS-D REGS) +SHA1-MAGIC-D+
            (SHA1-REGS-E REGS) +SHA1-MAGIC-E+)
      REGS))

[cl-mathstats/dev/sha1.lisp:212]
  (DEFUN UPDATE-SHA1-BLOCK (REGS BLOCK)
    (DECLARE (TYPE SHA1-REGS REGS)
             (TYPE (SIMPLE-ARRAY UB32 (80)) BLOCK)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LET ((A (SHA1-REGS-A REGS))
          (B (SHA1-REGS-B REGS))
          (C (SHA1-REGS-C REGS))
          (D (SHA1-REGS-D REGS))
          (E (SHA1-REGS-E REGS)))
      (WITH-SHA1-ROUND (BLOCK F1 +K1+) (A B C D E 0) (A B C D E 1)
       (A B C D E 2) (A B C D E 3) (A B C D E 4) (A B C D E 5) (A B C D E 6)
       (A B C D E 7) (A B C D E 8) (A B C D E 9) (A B C D E 10) (A B C D E 11)
       (A B C D E 12) (A B C D E 13) (A B C D E 14) (A B C D E 15)
       (A B C D E 16) (A B C D E 17) (A B C D E 18) (A B C D E 19))
      (WITH-SHA1-ROUND (BLOCK F2 +K2+) (A B C D E 20) (A B C D E 21)
       (A B C D E 22) (A B C D E 23) (A B C D E 24) (A B C D E 25)
       (A B C D E 26) (A B C D E 27) (A B C D E 28) (A B C D E 29)
       (A B C D E 30) (A B C D E 31) (A B C D E 32) (A B C D E 33)
       (A B C D E 34) (A B C D E 35) (A B C D E 36) (A B C D E 37)
       (A B C D E 38) (A B C D E 39))
      (WITH-SHA1-ROUND (BLOCK F3 +K3+) (A B C D E 40) (A B C D E 41)
       (A B C D E 42) (A B C D E 43) (A B C D E 44) (A B C D E 45)
       (A B C D E 46) (A B C D E 47) (A B C D E 48) (A B C D E 49)
       (A B C D E 50) (A B C D E 51) (A B C D E 52) (A B C D E 53)
       (A B C D E 54) (A B C D E 55) (A B C D E 56) (A B C D E 57)
       (A B C D E 58) (A B C D E 59))
      (WITH-SHA1-ROUND (BLOCK F2 +K4+) (A B C D E 60) (A B C D E 61)
       (A B C D E 62) (A B C D E 63) (A B C D E 64) (A B C D E 65)
       (A B C D E 66) (A B C D E 67) (A B C D E 68) (A B C D E 69)
       (A B C D E 70) (A B C D E 71) (A B C D E 72) (A B C D E 73)
       (A B C D E 74) (A B C D E 75) (A B C D E 76) (A B C D E 77)
       (A B C D E 78) (A B C D E 79))
      (SETF (SHA1-REGS-A REGS) (MOD32+ (SHA1-REGS-A REGS) A)
            (SHA1-REGS-B REGS) (MOD32+ (SHA1-REGS-B REGS) B)
            (SHA1-REGS-C REGS) (MOD32+ (SHA1-REGS-C REGS) C)
            (SHA1-REGS-D REGS) (MOD32+ (SHA1-REGS-D REGS) D)
            (SHA1-REGS-E REGS) (MOD32+ (SHA1-REGS-E REGS) E))
      REGS))

[cl-mathstats/dev/sha1.lisp:248]
  (DEFUN EXPAND-BLOCK (BLOCK)
    "Expand the first 16 words in BLOCK to fill the entire 80 word space
available."
    (DECLARE (TYPE (SIMPLE-ARRAY UB32 (80)) BLOCK)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LOOP FOR I OF-TYPE (INTEGER 16 80) FROM 16 BELOW 80
          DO (SETF (AREF BLOCK I)
                     (ROL32
                      (#S(FORMGREP:SYMREF
                          :NAME "32BIT-LOGICAL-XOR"
                          :QUALIFIER "KERNEL")
                       (#S(FORMGREP:SYMREF
                           :NAME "32BIT-LOGICAL-XOR"
                           :QUALIFIER "KERNEL")
                        (AREF BLOCK (- I 3)) (AREF BLOCK (- I 8)))
                       (#S(FORMGREP:SYMREF
                           :NAME "32BIT-LOGICAL-XOR"
                           :QUALIFIER "KERNEL")
                        (AREF BLOCK (- I 14)) (AREF BLOCK (- I 16))))
                      (SB-KERNEL::32BIT-LOGICAL-XOR
                       (SB-KERNEL::32BIT-LOGICAL-XOR (AREF BLOCK (- I 3))
                        (AREF BLOCK (- I 8)))
                       (SB-KERNEL::32BIT-LOGICAL-XOR (AREF BLOCK (- I 14))
                        (AREF BLOCK (- I 16))))
                      1))))

[cl-mathstats/dev/sha1.lisp:275]
  (DEFUN FILL-BLOCK (BLOCK BUFFER OFFSET)
    "Convert a complete 64 byte input vector segment into the given 80
word SHA1 block.  This currently works on (unsigned-byte 8) and
character simple-arrays, via the functions `fill-block-ub8' and
`fill-block-char' respectively."
    (DECLARE (TYPE (INTEGER 0 NIL) OFFSET)
             (TYPE (SIMPLE-ARRAY UB32 (80)) BLOCK)
             (TYPE (SIMPLE-ARRAY * (*)) BUFFER)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (ETYPECASE BUFFER
      ((SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*))
       (FILL-BLOCK-UB8 BLOCK BUFFER OFFSET))
      (SIMPLE-STRING (FILL-BLOCK-CHAR BLOCK BUFFER OFFSET)))
    (EXPAND-BLOCK BLOCK))

[cl-mathstats/dev/sha1.lisp:291]
  (DEFUN FILL-BLOCK-UB8 (BLOCK BUFFER OFFSET)
    "Convert a complete 64 (unsigned-byte 8) input vector segment
starting from offset into the given 16 word SHA1 block.  Calling this function
without subsequently calling EXPAND-BLOCK results in undefined behavior."
    (DECLARE (TYPE (INTEGER 0 NIL) OFFSET)
             (TYPE (SIMPLE-ARRAY UB32 (80)) BLOCK)
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) BUFFER)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (#S(FORMGREP:SYMREF :NAME "BIT-BASH-COPY" :QUALIFIER "KERNEL") BUFFER
     (+
      (* #S(FORMGREP:SYMREF :NAME "VECTOR-DATA-OFFSET" :QUALIFIER "VM")
         #S(FORMGREP:SYMREF :NAME "WORD-BITS" :QUALIFIER "VM"))
      (* OFFSET #S(FORMGREP:SYMREF :NAME "BYTE-BITS" :QUALIFIER "VM")))
     BLOCK
     (* #S(FORMGREP:SYMREF :NAME "VECTOR-DATA-OFFSET" :QUALIFIER "VM")
        #S(FORMGREP:SYMREF :NAME "WORD-BITS" :QUALIFIER "VM"))
     (* 64 #S(FORMGREP:SYMREF :NAME "BYTE-BITS" :QUALIFIER "VM")))
    (SB-KERNEL::BIT-BASH-COPY BUFFER
     (+ (* SB-VM:VECTOR-DATA-OFFSET SB-VM:N-WORD-BITS)
        (* OFFSET SB-VM:N-BYTE-BITS))
     BLOCK (* SB-VM:VECTOR-DATA-OFFSET SB-VM:N-WORD-BITS)
     (* 64 SB-VM:N-BYTE-BITS)))

[cl-mathstats/dev/sha1.lisp:322]
  (DEFUN FILL-BLOCK-CHAR (BLOCK BUFFER OFFSET)
    "Convert a complete 64 character input string segment starting from
offset into the given 16 word SHA1 block.  Calling this function without
subsequently calling EXPAND-BLOCK results in undefined behavior."
    (DECLARE (TYPE (INTEGER 0 NIL) OFFSET)
             (TYPE (SIMPLE-ARRAY UB32 (80)) BLOCK)
             (TYPE SIMPLE-STRING BUFFER)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (#S(FORMGREP:SYMREF :NAME "BIT-BASH-COPY" :QUALIFIER "KERNEL") BUFFER
     (+
      (* #S(FORMGREP:SYMREF :NAME "VECTOR-DATA-OFFSET" :QUALIFIER "VM")
         #S(FORMGREP:SYMREF :NAME "WORD-BITS" :QUALIFIER "VM"))
      (* OFFSET #S(FORMGREP:SYMREF :NAME "BYTE-BITS" :QUALIFIER "VM")))
     BLOCK
     (* #S(FORMGREP:SYMREF :NAME "VECTOR-DATA-OFFSET" :QUALIFIER "VM")
        #S(FORMGREP:SYMREF :NAME "WORD-BITS" :QUALIFIER "VM"))
     (* 64 #S(FORMGREP:SYMREF :NAME "BYTE-BITS" :QUALIFIER "VM")))
    (SB-KERNEL::BIT-BASH-COPY BUFFER
     (+ (* SB-VM:VECTOR-DATA-OFFSET SB-VM:N-WORD-BITS)
        (* OFFSET SB-VM:N-BYTE-BITS))
     BLOCK (* SB-VM:VECTOR-DATA-OFFSET SB-VM:N-WORD-BITS)
     (* 64 SB-VM:N-BYTE-BITS)))

[cl-mathstats/dev/sha1.lisp:353]
  (DEFUN SHA1REGS-DIGEST (REGS)
    "Create the final 20 byte message-digest from the SHA1 working state in
REGS.  Returns a (simple-array (unsigned-byte 8) (20))."
    (DECLARE (TYPE SHA1-REGS REGS)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LET ((RESULT (MAKE-ARRAY 20 :ELEMENT-TYPE '(UNSIGNED-BYTE 8))))
      (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (20)) RESULT))
      (MACROLET ((FROB (REG OFFSET)
                   (LET ((VAR (GENSYM)))
                     (ECLECTOR.READER:QUASIQUOTE
                      (LET (((ECLECTOR.READER:UNQUOTE VAR)
                             (ECLECTOR.READER:UNQUOTE REG)))
                        (DECLARE (TYPE UB32 (ECLECTOR.READER:UNQUOTE VAR)))
                        (SETF (AREF RESULT (ECLECTOR.READER:UNQUOTE OFFSET))
                                (LDB (BYTE 8 24) (ECLECTOR.READER:UNQUOTE VAR))
                              (AREF RESULT
                                    (ECLECTOR.READER:UNQUOTE (+ OFFSET 1)))
                                (LDB (BYTE 8 16) (ECLECTOR.READER:UNQUOTE VAR))
                              (AREF RESULT
                                    (ECLECTOR.READER:UNQUOTE (+ OFFSET 2)))
                                (LDB (BYTE 8 8) (ECLECTOR.READER:UNQUOTE VAR))
                              (AREF RESULT
                                    (ECLECTOR.READER:UNQUOTE (+ OFFSET 3)))
                                (LDB (BYTE 8 0)
                                     (ECLECTOR.READER:UNQUOTE VAR))))))))
        (FROB (SHA1-REGS-A REGS) 0)
        (FROB (SHA1-REGS-B REGS) 4)
        (FROB (SHA1-REGS-C REGS) 8)
        (FROB (SHA1-REGS-D REGS) 12)
        (FROB (SHA1-REGS-E REGS) 16))
      RESULT))

[cl-mathstats/dev/sha1.lisp:391]
  (DEFUN COPY-TO-BUFFER (FROM FROM-OFFSET COUNT BUFFER BUFFER-OFFSET)
    "Copy a partial segment from input vector from starting at
from-offset and copying count elements into the 64 byte buffer
starting at buffer-offset."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0))
             (TYPE (UNSIGNED-BYTE 29) FROM-OFFSET)
             (TYPE (INTEGER 0 63) COUNT BUFFER-OFFSET)
             (TYPE (SIMPLE-ARRAY * (*)) FROM)
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (64)) BUFFER))
    (#S(FORMGREP:SYMREF :NAME "BIT-BASH-COPY" :QUALIFIER "KERNEL") FROM
     (+
      (* #S(FORMGREP:SYMREF :NAME "VECTOR-DATA-OFFSET" :QUALIFIER "VM")
         #S(FORMGREP:SYMREF :NAME "WORD-BITS" :QUALIFIER "VM"))
      (* FROM-OFFSET #S(FORMGREP:SYMREF :NAME "BYTE-BITS" :QUALIFIER "VM")))
     BUFFER
     (+
      (* #S(FORMGREP:SYMREF :NAME "VECTOR-DATA-OFFSET" :QUALIFIER "VM")
         #S(FORMGREP:SYMREF :NAME "WORD-BITS" :QUALIFIER "VM"))
      (* BUFFER-OFFSET #S(FORMGREP:SYMREF :NAME "BYTE-BITS" :QUALIFIER "VM")))
     (* COUNT #S(FORMGREP:SYMREF :NAME "BYTE-BITS" :QUALIFIER "VM")))
    (SB-KERNEL::BIT-BASH-COPY FROM
     (+ (* SB-VM:VECTOR-DATA-OFFSET SB-VM:N-WORD-BITS)
        (* FROM-OFFSET SB-VM:N-BYTE-BITS))
     BUFFER
     (+ (* SB-VM:VECTOR-DATA-OFFSET SB-VM:N-WORD-BITS)
        (* BUFFER-OFFSET SB-VM:N-BYTE-BITS))
     (* COUNT SB-VM:N-BYTE-BITS)))

[cl-mathstats/dev/sha1.lisp:432]
  (DEFUN UPDATE-SHA1-STATE
         (STATE SEQUENCE &KEY (START 0) (END (LENGTH SEQUENCE)))
    (DECLARE (TYPE SHA1-STATE STATE)
             (TYPE (SIMPLE-ARRAY * (*)) SEQUENCE)
             (TYPE FIXNUM START END)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0))
             (#S(FORMGREP:SYMREF :NAME "OPTIMIZE-INTERFACE" :QUALIFIER "EXT")
              (SAFETY 1) (DEBUG 1)))
    (LET ((REGS (SHA1-STATE-REGS STATE))
          (BLOCK (SHA1-STATE-BLOCK STATE))
          (BUFFER (SHA1-STATE-BUFFER STATE))
          (BUFFER-INDEX (SHA1-STATE-BUFFER-INDEX STATE))
          (LENGTH (- END START)))
      (DECLARE (TYPE SHA1-REGS REGS)
               (TYPE FIXNUM LENGTH)
               (TYPE (INTEGER 0 63) BUFFER-INDEX)
               (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 32) (80)) BLOCK)
               (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (64)) BUFFER))
      (UNLESS (ZEROP BUFFER-INDEX)
        (LET ((AMOUNT (MIN (- 64 BUFFER-INDEX) LENGTH)))
          (DECLARE (TYPE (INTEGER 0 63) AMOUNT))
          (COPY-TO-BUFFER SEQUENCE START AMOUNT BUFFER BUFFER-INDEX)
          (SETQ START (THE FIXNUM (+ START AMOUNT)))
          (WHEN (>= START END)
            (SETF (SHA1-STATE-BUFFER-INDEX STATE) (+ BUFFER-INDEX AMOUNT))
            (RETURN-FROM UPDATE-SHA1-STATE STATE)))
        (FILL-BLOCK-UB8 BLOCK BUFFER 0)
        (EXPAND-BLOCK BLOCK)
        (UPDATE-SHA1-BLOCK REGS BLOCK))
      (ETYPECASE SEQUENCE
        ((SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*))
         (LOCALLY
          (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) SEQUENCE))
          (LOOP FOR OFFSET OF-TYPE (UNSIGNED-BYTE 29) FROM START BELOW
                END BY 64
                UNTIL (< (- END OFFSET) 64)
                DO (FILL-BLOCK-UB8 BLOCK SEQUENCE OFFSET) (EXPAND-BLOCK
                                                           BLOCK) (UPDATE-SHA1-BLOCK
                                                                   REGS BLOCK)
                FINALLY (LET ((AMOUNT (- END OFFSET)))
                          (UNLESS (ZEROP AMOUNT)
                            (COPY-TO-BUFFER SEQUENCE OFFSET AMOUNT BUFFER 0))
                          (SETF (SHA1-STATE-BUFFER-INDEX STATE) AMOUNT)))))
        (SIMPLE-STRING
         (LOCALLY
          (DECLARE (TYPE SIMPLE-STRING SEQUENCE))
          (LOOP FOR OFFSET OF-TYPE (UNSIGNED-BYTE 29) FROM START BELOW
                END BY 64
                UNTIL (< (- END OFFSET) 64)
                DO (FILL-BLOCK-CHAR BLOCK SEQUENCE OFFSET) (EXPAND-BLOCK
                                                            BLOCK) (UPDATE-SHA1-BLOCK
                                                                    REGS BLOCK)
                FINALLY (LET ((AMOUNT (- END OFFSET)))
                          (UNLESS (ZEROP AMOUNT)
                            (COPY-TO-BUFFER SEQUENCE OFFSET AMOUNT BUFFER 0))
                          (SETF (SHA1-STATE-BUFFER-INDEX STATE) AMOUNT))))))
      (SETF (SHA1-STATE-AMOUNT STATE) (+ (SHA1-STATE-AMOUNT STATE) LENGTH))
      STATE))

[cl-mathstats/dev/sha1.lisp:494]
  (DEFUN FINALIZE-SHA1-STATE (STATE)
    (DECLARE (TYPE SHA1-STATE STATE)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0))
             (#S(FORMGREP:SYMREF :NAME "OPTIMIZE-INTERFACE" :QUALIFIER "EXT")
              (SAFETY 1) (DEBUG 1)))
    (OR (SHA1-STATE-FINALIZED-P STATE)
        (LET ((REGS (SHA1-STATE-REGS STATE))
              (BLOCK (SHA1-STATE-BLOCK STATE))
              (BUFFER (SHA1-STATE-BUFFER STATE))
              (BUFFER-INDEX (SHA1-STATE-BUFFER-INDEX STATE))
              (TOTAL-LENGTH (* 8 (SHA1-STATE-AMOUNT STATE))))
          (DECLARE (TYPE SHA1-REGS REGS)
                   (TYPE (INTEGER 0 63) BUFFER-INDEX)
                   (TYPE (SIMPLE-ARRAY UB32 (80)) BLOCK)
                   (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) BUFFER))
          (SETF (AREF BUFFER BUFFER-INDEX) 128)
          (WHEN (> BUFFER-INDEX 55)
            (LOOP FOR INDEX OF-TYPE (INTEGER 0 64) FROM (1+
                                                         BUFFER-INDEX) BELOW 64
                  DO (SETF (AREF BUFFER INDEX) 0))
            (FILL-BLOCK-UB8 BLOCK BUFFER 0)
            (EXPAND-BLOCK BLOCK)
            (UPDATE-SHA1-BLOCK REGS BLOCK)
            (LOOP FOR INDEX OF-TYPE (INTEGER 0 14) FROM 0 BELOW 14
                  DO (SETF (AREF BLOCK INDEX) 0)))
          (WHEN (< BUFFER-INDEX 55)
            (LOOP FOR INDEX OF-TYPE (INTEGER 0 56) FROM (1+
                                                         BUFFER-INDEX) BELOW 56
                  DO (SETF (AREF BUFFER INDEX) 0))
            (FILL-BLOCK-UB8 BLOCK BUFFER 0))
          (SETF (AREF BLOCK 14) (LDB (BYTE 32 32) TOTAL-LENGTH)
                (AREF BLOCK 15) (LDB (BYTE 32 0) TOTAL-LENGTH))
          (EXPAND-BLOCK BLOCK)
          (UPDATE-SHA1-BLOCK REGS BLOCK)
          (SETF (SHA1-STATE-FINALIZED-P STATE) (SHA1REGS-DIGEST REGS)))))

[cl-mpi/examples/cellular.lisp:23]
  (DEFUN UPDATE (SRC DST)
    (DECLARE (TYPE SIMPLE-BIT-VECTOR SRC DST)
             (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (LOOP FOR I FROM 1 BELOW (- (LENGTH SRC) 1)
          DO (LET ((X__ (AREF SRC (- I 1)))
                   (_X_ (AREF SRC I))
                   (__X (AREF SRC (+ I 1))))
               (SETF (AREF DST I)
                       (AREF #*01110110 (+ (* 4 X__) (* 2 _X_) __X))))))

[cl-mpi/mpi/utilities.lisp:215]
  (DEFUN STATIC-VECTOR-MPI-DATA (VECTOR &OPTIONAL START END)
    "Return a pointer to the raw memory of the given vector, as well as the
corresponding MPI-DATATYPE and the number of elements to transmit.

WARNING: If ARRAY is somehow moved in memory (e.g. by the garbage collector),
your code is broken, so better have a look at the STATIC-VECTORS package."
    (DECLARE (TYPE (SIMPLE-ARRAY * (*)) VECTOR)
             (TYPE INDEX START END)
             (OPTIMIZE (SAFETY 0) (DEBUG 0)))
    (LET* ((DIM (LENGTH VECTOR)) (START (OR START 0)) (END (OR END DIM)))
      (ASSERT (<= 0 START END DIM))
      (STATIC-VECTOR-MPI-DATA-DISPATCH VECTOR START END)))

[cl-murmurhash/cl-murmurhash.lisp:191]
  (LOCALLY
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
   (DEFUN HASH32-OCTETS (VEC SEED &OPTIONAL (LEN (LENGTH VEC)) MIX-ONLY)
     (DECLARE (INDEX LEN)
              (OCTET-VECTOR VEC))
     (HASH32-BODY AREF))
   (DEFUN HASH32-INTEGER (VEC SEED &OPTIONAL (LEN (BYTE-LENGTH VEC)) MIX-ONLY)
     (DECLARE (INTEGER VEC)
              ((INTEGER 0 *) LEN))
     (IF (TYPEP VEC 'U32)
         (LOCALLY (DECLARE (TYPE (INTEGER 0 4) LEN)) (HASH32-BODY BYTE-REF))
         (HASH32-BODY BYTE-REF)))
   (DEFUN HASH32-8-BIT-STRING (VEC SEED &OPTIONAL (LEN (LENGTH VEC)) MIX-ONLY)
     (DECLARE (INDEX LEN)
              (SIMPLE-STRING VEC))
     (HASH32-BODY CHAR-REF)))

[cl-murmurhash/cl-murmurhash.lisp:323]
  (LOCALLY
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
   (DEFUN HASH128-OCTETS (VEC SEED &OPTIONAL (LEN (LENGTH VEC)) MIX-ONLY)
     (DECLARE (INDEX LEN)
              (OCTET-VECTOR VEC))
     (HASH128-BODY AREF))
   (DEFUN HASH128-INTEGER (VEC SEED &OPTIONAL (LEN (BYTE-LENGTH VEC)) MIX-ONLY)
     (DECLARE (INTEGER VEC))
     (HASH128-BODY BYTE-REF))
   (DEFUN HASH128-8-BIT-STRING (VEC SEED &OPTIONAL (LEN (LENGTH VEC)) MIX-ONLY)
     (DECLARE (INDEX LEN)
              (SIMPLE-STRING VEC))
     (HASH128-BODY CHAR-REF)))

[cl-num-utils/src/old/optimization.lisp:11]
  (DEFUN GOLDEN-SECTION-MINIMIZE (F A B TOL &OPTIONAL (MAX-ITER 100))
    "Find a local minimum of F in the [A,B] interval.  The algorithm terminates
when the minimum is bracketed in an interval smaller than TOL.  Since the
algorithm is slow, TOL should not be chosen smaller then necessary.  The
algorithm will also find the local minimum at the endpoints, and if F is
unimodal, it will find the global minimum.  MAX-ITER is there for terminating
the algorithm, in case tolerance is zero or too small.  All values (except
max-iter) should be double-float, and F should be of
type (FUNCTION (DOUBLE-FLOAT) DOUBLE-FLOAT).

Note: when F is constant on a range, golden-section-minimize ``pulls
to the left'', ie will keep picking smaller values."
    (DECLARE (DOUBLE-FLOAT A B TOL)
             (FIXNUM MAX-ITER)
             (TYPE (FUNCTION (DOUBLE-FLOAT) DOUBLE-FLOAT) F)
             (INLINE GOLDEN-SECTION-COMBINATION)
             (OPTIMIZE SPEED (SAFETY 1)))
    (WHEN (> A B) (ROTATEF A B))
    (LET* ((M1 (GOLDEN-SECTION-COMBINATION A B))
           (M2 (GOLDEN-SECTION-COMBINATION B A))
           (F1 (FUNCALL F M1))
           (F2 (FUNCALL F M2)))
      (DECLARE (DOUBLE-FLOAT M1 M2 F1 F2))
      (ITER (REPEAT MAX-ITER) (DECLARE (ITERATE:DECLARE-VARIABLES))
       (WHEN (<= (ABS (- B A)) TOL)
         (RETURN-FROM GOLDEN-SECTION-MINIMIZE
           (IF (< F1 F2)
               (VALUES M1 F1)
               (VALUES M2 F2))))
       (IF (<= F1 F2)
           (PROGN
            (SHIFTF B M2 M1 (GOLDEN-SECTION-COMBINATION M1 A))
            (SHIFTF F2 F1 (FUNCALL F M1)))
           (PROGN
            (SHIFTF A M1 M2 (GOLDEN-SECTION-COMBINATION M2 B))
            (SHIFTF F1 F2 (FUNCALL F M2)))))
      (ERROR 'REACHED-MAXIMUM-ITERATIONS :N MAX-ITER)))

[cl-online-learning/src/cl-online-learning.lisp:38]
  (DEFUN SIGN (X)
    (DECLARE (TYPE SINGLE-FLOAT X)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (IF (> X 0.0)
        1.0
        -1.0))

[cl-online-learning/src/cl-online-learning.lisp:44]
  (DEFUN F (INPUT WEIGHT BIAS)
    (DECLARE (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) INPUT WEIGHT)
             (TYPE SINGLE-FLOAT BIAS)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (+ (DOT WEIGHT INPUT) BIAS))

[cl-online-learning/src/cl-online-learning.lisp:50]
  (DEFUN F! (INPUT WEIGHT BIAS RESULT)
    (DECLARE (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) INPUT WEIGHT)
             (TYPE (SIMPLE-ARRAY SINGLE-FLOAT 1) RESULT)
             (TYPE SINGLE-FLOAT BIAS)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DOT! WEIGHT INPUT RESULT)
    (SETF (AREF RESULT 0) (+ (AREF RESULT 0) BIAS))
    (VALUES))

[cl-online-learning/src/cl-online-learning.lisp:60]
  (DEFUN SF (INPUT WEIGHT BIAS)
    (DECLARE (TYPE SPARSE-VECTOR INPUT)
             (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) WEIGHT)
             (TYPE SINGLE-FLOAT BIAS)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (+ (DS-DOT WEIGHT INPUT) BIAS))

[cl-online-learning/src/cl-online-learning.lisp:67]
  (DEFUN SF! (INPUT WEIGHT BIAS RESULT)
    (DECLARE (TYPE SPARSE-VECTOR INPUT)
             (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) WEIGHT)
             (TYPE (SIMPLE-ARRAY SINGLE-FLOAT 1) RESULT)
             (TYPE SINGLE-FLOAT BIAS)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DS-DOT! WEIGHT INPUT RESULT)
    (SETF (AREF RESULT 0) (+ (AREF RESULT 0) BIAS))
    (VALUES))

[cl-online-learning/src/cl-online-learning.lisp:85]
  (DEFMACRO DEFINE-LEARNER
            (LEARNER-TYPE (LEARNER INPUT TRAINING-LABEL) &BODY BODY)
    (ECLECTOR.READER:QUASIQUOTE
     (PROGN
      (DEFUN (ECLECTOR.READER:UNQUOTE
              (INTERN (CATSTR (SYMBOL-NAME LEARNER-TYPE) "-UPDATE")))
             ((ECLECTOR.READER:UNQUOTE LEARNER) (ECLECTOR.READER:UNQUOTE INPUT)
              (ECLECTOR.READER:UNQUOTE TRAINING-LABEL))
        (DECLARE
         (TYPE (ECLECTOR.READER:UNQUOTE LEARNER-TYPE)
          (ECLECTOR.READER:UNQUOTE LEARNER))
         (TYPE
          (ECLECTOR.READER:UNQUOTE
           (IF (SPARSE-SYMBOL? LEARNER-TYPE)
               (QUOTE SPARSE-VECTOR)
               (QUOTE (SIMPLE-ARRAY SINGLE-FLOAT))))
          (ECLECTOR.READER:UNQUOTE INPUT))
         (TYPE SINGLE-FLOAT (ECLECTOR.READER:UNQUOTE TRAINING-LABEL))
         (OPTIMIZE (SPEED 3) (SAFETY 0)))
        (ECLECTOR.READER:UNQUOTE-SPLICING BODY)
        (ECLECTOR.READER:UNQUOTE LEARNER))
      (DEFUN (ECLECTOR.READER:UNQUOTE
              (INTERN (CATSTR (SYMBOL-NAME LEARNER-TYPE) "-TRAIN")))
             (LEARNER TRAINING-DATA)
        (ETYPECASE TRAINING-DATA
          (LIST
           (DOLIST (DATUM TRAINING-DATA)
             ((ECLECTOR.READER:UNQUOTE
               (INTERN (CATSTR (SYMBOL-NAME LEARNER-TYPE) "-UPDATE")))
              LEARNER (CDR DATUM) (CAR DATUM))))
          (VECTOR
           (LOOP FOR DATUM ACROSS TRAINING-DATA
                 DO ((ECLECTOR.READER:UNQUOTE
                      (INTERN (CATSTR (SYMBOL-NAME LEARNER-TYPE) "-UPDATE")))
                     LEARNER (CDR DATUM) (CAR DATUM)))))
        LEARNER)
      (DEFUN (ECLECTOR.READER:UNQUOTE
              (INTERN (CATSTR (SYMBOL-NAME LEARNER-TYPE) "-PREDICT")))
             (LEARNER INPUT)
        (SIGN
         ((ECLECTOR.READER:UNQUOTE
           (IF (SPARSE-SYMBOL? LEARNER-TYPE)
               'SF
               'F))
          INPUT
          ((ECLECTOR.READER:UNQUOTE
            (INTERN (CATSTR (SYMBOL-NAME LEARNER-TYPE) "-WEIGHT")))
           LEARNER)
          ((ECLECTOR.READER:UNQUOTE
            (INTERN (CATSTR (SYMBOL-NAME LEARNER-TYPE) "-BIAS")))
           LEARNER))))
      (DEFUN (ECLECTOR.READER:UNQUOTE
              (INTERN (CATSTR (SYMBOL-NAME LEARNER-TYPE) "-TEST")))
             (LEARNER TEST-DATA &KEY (QUIET-P NIL) (STREAM NIL))
        (LET* ((LEN (LENGTH TEST-DATA))
               (N-CORRECT
                (COUNT-IF
                 (LAMBDA (DATUM)
                   (LET ((PREDICT
                          ((ECLECTOR.READER:UNQUOTE
                            (INTERN
                             (CATSTR (SYMBOL-NAME LEARNER-TYPE) "-PREDICT")))
                           LEARNER (CDR DATUM))))
                     (FORMAT STREAM "~D~%" (ROUND PREDICT))
                     (= PREDICT (CAR DATUM))))
                 TEST-DATA))
               (ACCURACY (* (/ N-CORRECT LEN) 100.0)))
          (IF (NOT QUIET-P)
              (FORMAT T "Accuracy: ~f%, Correct: ~A, Total: ~A~%" ACCURACY
                      N-CORRECT LEN))
          (VALUES ACCURACY N-CORRECT LEN))))))

[cl-online-learning/src/cl-online-learning.lisp:379]
  (DEFUN LOGISTIC-REGRESSION-GRADIENT!
         (TRAINING-LABEL INPUT-VECTOR WEIGHT-VECTOR BIAS C TMP-VEC G-RESULT
          G0-RESULT)
    (DECLARE (TYPE SINGLE-FLOAT TRAINING-LABEL BIAS C)
             (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) INPUT-VECTOR WEIGHT-VECTOR
              TMP-VEC G-RESULT)
             (TYPE (SIMPLE-ARRAY SINGLE-FLOAT 1) G0-RESULT)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (F! INPUT-VECTOR WEIGHT-VECTOR BIAS G0-RESULT)
    (LET ((SIGMOID-VAL (SIGMOID (* TRAINING-LABEL (AREF G0-RESULT 0)))))
      (DECLARE (TYPE (SINGLE-FLOAT 0.0) SIGMOID-VAL))
      (V*N INPUT-VECTOR (* (- 1.0 SIGMOID-VAL) (* -1.0 TRAINING-LABEL))
       TMP-VEC)
      (V*N WEIGHT-VECTOR (* 2.0 C) G-RESULT)
      (V+ TMP-VEC G-RESULT G-RESULT)
      (SETF (AREF G0-RESULT 0)
              (+ (* (- 1.0 SIGMOID-VAL) (* -1.0 TRAINING-LABEL))
                 (* 2.0 C BIAS)))
      (VALUES)))

[cl-online-learning/src/cl-online-learning.lisp:487]
  (DEFINE-LEARNER LR+ADAM (LEARNER INPUT TRAINING-LABEL)
   (LET ((WEIGHT (LR+ADAM-WEIGHT LEARNER))
         (BIAS (LR+ADAM-BIAS LEARNER))
         (C (LR+ADAM-C LEARNER))
         (TMP-VEC (LR+ADAM-TMP-VEC LEARNER))
         (TMP-FLOAT (LR+ADAM-TMP-FLOAT LEARNER))
         (G (LR+ADAM-G LEARNER))
         (G0 0.0)
         (M (LR+ADAM-M LEARNER))
         (M0 (LR+ADAM-M0 LEARNER))
         (V (LR+ADAM-V LEARNER))
         (V0 (LR+ADAM-V0 LEARNER))
         (ALPHA (LR+ADAM-ALPHA LEARNER))
         (BETA1 (LR+ADAM-BETA1 LEARNER))
         (BETA2 (LR+ADAM-BETA2 LEARNER))
         (BETA1^T (LR+ADAM-BETA1^T LEARNER))
         (BETA2^T (LR+ADAM-BETA2^T LEARNER))
         (EPSILON (LR+ADAM-EPSILON LEARNER)))
     (DECLARE
      (TYPE SINGLE-FLOAT BIAS C G0 M0 V0 ALPHA BETA1 BETA2 BETA1^T BETA2^T
       EPSILON)
      (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) WEIGHT TMP-VEC G M V)
      (TYPE (SIMPLE-ARRAY SINGLE-FLOAT 1) TMP-FLOAT)
      (OPTIMIZE (SPEED 3) (SAFETY 0)))
     (LOGISTIC-REGRESSION-GRADIENT! TRAINING-LABEL INPUT WEIGHT BIAS C TMP-VEC
      G TMP-FLOAT)
     (SETF G0 (AREF TMP-FLOAT 0))
     (V*N M BETA1 M)
     (V*N G (- 1.0 BETA1) TMP-VEC)
     (V+ M TMP-VEC M)
     (V* G G G)
     (V*N V BETA2 V)
     (V*N G (- 1.0 BETA2) TMP-VEC)
     (V+ V TMP-VEC V)
     (LET ((NEW-M0 (+ (* BETA1 M0) (* (- 1.0 BETA1) G0)))
           (NEW-V0 (+ (* BETA2 V0) (* (- 1.0 BETA2) (* G0 G0))))
           (EPSILON-COEFFICIENT-SQRT-INNER (- 1.0 BETA2^T)))
       (DECLARE (TYPE SINGLE-FLOAT NEW-M0)
                (TYPE (SINGLE-FLOAT 0.0) NEW-V0
                 EPSILON-COEFFICIENT-SQRT-INNER))
       (LET* ((EPSILON-COEFFICIENT (SQRT EPSILON-COEFFICIENT-SQRT-INNER))
              (EPSILON^ (* EPSILON-COEFFICIENT EPSILON))
              (ALPHA_T (* ALPHA (/ EPSILON-COEFFICIENT (- 1.0 BETA1^T)))))
         (V-SQRT V TMP-VEC)
         (V+N TMP-VEC EPSILON^ TMP-VEC)
         (V/ M TMP-VEC TMP-VEC)
         (V*N TMP-VEC ALPHA_T TMP-VEC)
         (V- WEIGHT TMP-VEC WEIGHT)
         (SETF (LR+ADAM-M0 LEARNER) NEW-M0
               (LR+ADAM-V0 LEARNER) NEW-V0
               (LR+ADAM-BIAS LEARNER)
                 (- BIAS (* ALPHA_T (/ NEW-M0 (+ (SQRT NEW-V0) EPSILON^)))))))
     (SETF (LR+ADAM-BETA1^T LEARNER) (* BETA1 BETA1^T)
           (LR+ADAM-BETA2^T LEARNER) (* BETA2 BETA2^T))))

[cl-online-learning/src/cl-online-learning.lisp:757]
  (DEFUN LOGISTIC-REGRESSION-GRADIENT-SPARSE!
         (TRAINING-LABEL INPUT-VECTOR WEIGHT-VECTOR BIAS C TMP-VEC G-RESULT
          G0-RESULT)
    (DECLARE (TYPE SINGLE-FLOAT TRAINING-LABEL BIAS C)
             (TYPE SPARSE-VECTOR INPUT-VECTOR)
             (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) WEIGHT-VECTOR TMP-VEC G-RESULT)
             (TYPE (SIMPLE-ARRAY SINGLE-FLOAT 1) G0-RESULT)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (SF! INPUT-VECTOR WEIGHT-VECTOR BIAS G0-RESULT)
    (LET ((SIGMOID-VAL (SIGMOID (* TRAINING-LABEL (AREF G0-RESULT 0)))))
      (DECLARE (TYPE (SINGLE-FLOAT 0.0) SIGMOID-VAL))
      (SPS-V*N INPUT-VECTOR (* (- 1.0 SIGMOID-VAL) (* -1.0 TRAINING-LABEL))
       TMP-VEC)
      (V*N WEIGHT-VECTOR (* 2.0 C) G-RESULT)
      (DPS-V+ G-RESULT TMP-VEC (SPARSE-VECTOR-INDEX-VECTOR INPUT-VECTOR)
       G-RESULT)
      (SETF (AREF G0-RESULT 0)
              (+ (* (- 1.0 SIGMOID-VAL) (* -1.0 TRAINING-LABEL))
                 (* 2.0 C BIAS)))
      (VALUES)))

[cl-online-learning/src/cl-online-learning.lisp:870]
  (DEFINE-LEARNER SPARSE-LR+ADAM (LEARNER INPUT TRAINING-LABEL)
   (LET ((WEIGHT (SPARSE-LR+ADAM-WEIGHT LEARNER))
         (BIAS (SPARSE-LR+ADAM-BIAS LEARNER))
         (C (SPARSE-LR+ADAM-C LEARNER))
         (TMP-VEC (SPARSE-LR+ADAM-TMP-VEC LEARNER))
         (TMP-FLOAT (SPARSE-LR+ADAM-TMP-FLOAT LEARNER))
         (G (SPARSE-LR+ADAM-G LEARNER))
         (G0 0.0)
         (M (SPARSE-LR+ADAM-M LEARNER))
         (M0 (SPARSE-LR+ADAM-M0 LEARNER))
         (V (SPARSE-LR+ADAM-V LEARNER))
         (V0 (SPARSE-LR+ADAM-V0 LEARNER))
         (ALPHA (SPARSE-LR+ADAM-ALPHA LEARNER))
         (BETA1 (SPARSE-LR+ADAM-BETA1 LEARNER))
         (BETA2 (SPARSE-LR+ADAM-BETA2 LEARNER))
         (BETA1^T (SPARSE-LR+ADAM-BETA1^T LEARNER))
         (BETA2^T (SPARSE-LR+ADAM-BETA2^T LEARNER))
         (EPSILON (SPARSE-LR+ADAM-EPSILON LEARNER)))
     (DECLARE
      (TYPE SINGLE-FLOAT BIAS C G0 M0 V0 ALPHA BETA1 BETA2 BETA1^T BETA2^T
       EPSILON)
      (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) WEIGHT TMP-VEC G M V)
      (TYPE (SIMPLE-ARRAY SINGLE-FLOAT 1) TMP-FLOAT)
      (OPTIMIZE (SPEED 3) (SAFETY 0)))
     (LOGISTIC-REGRESSION-GRADIENT-SPARSE! TRAINING-LABEL INPUT WEIGHT BIAS C
      TMP-VEC G TMP-FLOAT)
     (SETF G0 (AREF TMP-FLOAT 0))
     (V*N M BETA1 M)
     (V*N G (- 1.0 BETA1) TMP-VEC)
     (V+ M TMP-VEC M)
     (V* G G G)
     (V*N V BETA2 V)
     (V*N G (- 1.0 BETA2) TMP-VEC)
     (V+ V TMP-VEC V)
     (LET ((NEW-M0 (+ (* BETA1 M0) (* (- 1.0 BETA1) G0)))
           (NEW-V0 (+ (* BETA2 V0) (* (- 1.0 BETA2) (* G0 G0))))
           (EPSILON-COEFFICIENT-SQRT-INNER (- 1.0 BETA2^T)))
       (DECLARE (TYPE SINGLE-FLOAT NEW-M0)
                (TYPE (SINGLE-FLOAT 0.0) NEW-V0
                 EPSILON-COEFFICIENT-SQRT-INNER))
       (LET* ((EPSILON-COEFFICIENT (SQRT EPSILON-COEFFICIENT-SQRT-INNER))
              (EPSILON^ (* EPSILON-COEFFICIENT EPSILON))
              (ALPHA_T (* ALPHA (/ EPSILON-COEFFICIENT (- 1.0 BETA1^T)))))
         (V-SQRT V TMP-VEC)
         (V+N TMP-VEC EPSILON^ TMP-VEC)
         (V/ M TMP-VEC TMP-VEC)
         (V*N TMP-VEC ALPHA_T TMP-VEC)
         (V- WEIGHT TMP-VEC WEIGHT)
         (SETF (SPARSE-LR+ADAM-M0 LEARNER) NEW-M0
               (SPARSE-LR+ADAM-V0 LEARNER) NEW-V0
               (SPARSE-LR+ADAM-BIAS LEARNER)
                 (- BIAS (* ALPHA_T (/ NEW-M0 (+ (SQRT NEW-V0) EPSILON^)))))))
     (SETF (SPARSE-LR+ADAM-BETA1^T LEARNER) (* BETA1 BETA1^T)
           (SPARSE-LR+ADAM-BETA2^T LEARNER) (* BETA2 BETA2^T))))

[cl-online-learning/src/rls.lisp:5]
  (DEFMACRO DEFINE-REGRESSION-LEARNER
            (LEARNER-TYPE (LEARNER INPUT TARGET) &BODY BODY)
    (ECLECTOR.READER:QUASIQUOTE
     (PROGN
      (DEFUN (ECLECTOR.READER:UNQUOTE
              (INTERN (CATSTR (SYMBOL-NAME LEARNER-TYPE) "-UPDATE")))
             ((ECLECTOR.READER:UNQUOTE LEARNER) (ECLECTOR.READER:UNQUOTE INPUT)
              (ECLECTOR.READER:UNQUOTE TARGET))
        (DECLARE
         (TYPE (ECLECTOR.READER:UNQUOTE LEARNER-TYPE)
          (ECLECTOR.READER:UNQUOTE LEARNER))
         (TYPE
          (ECLECTOR.READER:UNQUOTE
           (IF (SPARSE-SYMBOL? LEARNER-TYPE)
               (QUOTE
                #S(FORMGREP:SYMREF
                   :NAME "SPARSE-VECTOR"
                   :QUALIFIER "CLOL.VECTOR"))
               (QUOTE (SIMPLE-ARRAY SINGLE-FLOAT))))
          (ECLECTOR.READER:UNQUOTE INPUT))
         (TYPE SINGLE-FLOAT (ECLECTOR.READER:UNQUOTE TARGET))
         (OPTIMIZE (SPEED 3) (SAFETY 0)))
        (ECLECTOR.READER:UNQUOTE-SPLICING BODY)
        (ECLECTOR.READER:UNQUOTE LEARNER))
      (DEFUN (ECLECTOR.READER:UNQUOTE
              (INTERN (CATSTR (SYMBOL-NAME LEARNER-TYPE) "-TRAIN")))
             (LEARNER TRAINING-DATA)
        (ETYPECASE TRAINING-DATA
          (LIST
           (DOLIST (DATUM TRAINING-DATA)
             ((ECLECTOR.READER:UNQUOTE
               (INTERN (CATSTR (SYMBOL-NAME LEARNER-TYPE) "-UPDATE")))
              LEARNER (CDR DATUM) (CAR DATUM))))
          (VECTOR
           (LOOP FOR DATUM ACROSS TRAINING-DATA
                 DO ((ECLECTOR.READER:UNQUOTE
                      (INTERN (CATSTR (SYMBOL-NAME LEARNER-TYPE) "-UPDATE")))
                     LEARNER (CDR DATUM) (CAR DATUM)))))
        LEARNER)
      (DEFUN (ECLECTOR.READER:UNQUOTE
              (INTERN (CATSTR (SYMBOL-NAME LEARNER-TYPE) "-PREDICT")))
             (LEARNER INPUT)
        ((ECLECTOR.READER:UNQUOTE
          (IF (SPARSE-SYMBOL? LEARNER-TYPE)
              'SF
              'F))
         INPUT
         ((ECLECTOR.READER:UNQUOTE
           (INTERN (CATSTR (SYMBOL-NAME LEARNER-TYPE) "-WEIGHT")))
          LEARNER)
         ((ECLECTOR.READER:UNQUOTE
           (INTERN (CATSTR (SYMBOL-NAME LEARNER-TYPE) "-BIAS")))
          LEARNER)))
      (DEFUN (ECLECTOR.READER:UNQUOTE
              (INTERN (CATSTR (SYMBOL-NAME LEARNER-TYPE) "-TEST")))
             (LEARNER TEST-DATA &KEY (QUIET-P NIL))
        (FLET ((SQUARE (X)
                 (* X X)))
          (LET* ((LEN (LENGTH TEST-DATA))
                 (SUM-SQUARE-ERROR
                  (REDUCE #'+
                          (MAPCAR
                           (LAMBDA (DATUM)
                             (SQUARE
                              (-
                               ((ECLECTOR.READER:UNQUOTE
                                 (INTERN
                                  (CATSTR (SYMBOL-NAME LEARNER-TYPE)
                                   "-PREDICT")))
                                LEARNER (CDR DATUM))
                               (CAR DATUM))))
                           TEST-DATA)))
                 (RMSE (SQRT (/ SUM-SQUARE-ERROR LEN))))
            (IF (NOT QUIET-P)
                (FORMAT T "RMSE: ~A~%" RMSE))
            RMSE))))))

[cl-online-learning/src/vector.lisp:26]
  (DEFUN V+ (X Y RESULT)
    (DECLARE (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) X Y RESULT)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DOVEC X I (SETF (AREF RESULT I) (+ (AREF X I) (AREF Y I))))
    RESULT)

[cl-online-learning/src/vector.lisp:32]
  (DEFUN V- (X Y RESULT)
    (DECLARE (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) X Y RESULT)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DOVEC X I (SETF (AREF RESULT I) (- (AREF X I) (AREF Y I))))
    RESULT)

[cl-online-learning/src/vector.lisp:38]
  (DEFUN V*N (VEC N RESULT)
    (DECLARE (TYPE SINGLE-FLOAT N)
             (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) VEC RESULT)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DOVEC VEC I (SETF (AREF RESULT I) (* N (AREF VEC I))))
    RESULT)

[cl-online-learning/src/vector.lisp:45]
  (DEFUN V+N (X N RESULT)
    (DECLARE (TYPE SINGLE-FLOAT N)
             (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) X RESULT)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DOVEC X I (SETF (AREF RESULT I) (+ (AREF X I) N)))
    RESULT)

[cl-online-learning/src/vector.lisp:52]
  (DEFUN V* (X Y RESULT)
    (DECLARE (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) X Y RESULT)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DOVEC X I (SETF (AREF RESULT I) (* (AREF X I) (AREF Y I))))
    RESULT)

[cl-online-learning/src/vector.lisp:58]
  (DEFUN V/ (X Y RESULT)
    (DECLARE (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) X Y RESULT)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DOVEC X I (SETF (AREF RESULT I) (/ (AREF X I) (AREF Y I))))
    RESULT)

[cl-online-learning/src/vector.lisp:64]
  (DEFUN V-SQRT (X RESULT)
    (DECLARE (TYPE (SIMPLE-ARRAY (SINGLE-FLOAT 0.0)) X RESULT)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DOVEC X I (SETF (AREF RESULT I) (SQRT (AREF X I))))
    RESULT)

[cl-online-learning/src/vector.lisp:73]
  (DEFUN DOT (X Y)
    (DECLARE (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) X Y)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((RESULT 0.0))
      (DECLARE (TYPE SINGLE-FLOAT RESULT))
      (DOVEC X I (INCF RESULT (* (AREF X I) (AREF Y I))))
      RESULT))

[cl-online-learning/src/vector.lisp:81]
  (DEFUN DOT! (X Y RESULT)
    (DECLARE (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) X Y)
             (TYPE (SIMPLE-ARRAY SINGLE-FLOAT 1) RESULT)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((ACC 0.0))
      (DECLARE (TYPE SINGLE-FLOAT ACC))
      (DOVEC X I (INCF ACC (* (AREF X I) (AREF Y I))))
      (SETF (AREF RESULT 0) ACC))
    RESULT)

[cl-online-learning/src/vector.lisp:112]
  (DEFUN S-V*N (SPARSE-X N RESULT)
    (DECLARE (TYPE SPARSE-VECTOR SPARSE-X RESULT)
             (TYPE SINGLE-FLOAT N)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DOSVEC SPARSE-X I
     (SETF (AREF (SPARSE-VECTOR-VALUE-VECTOR RESULT) I)
             (* (AREF (SPARSE-VECTOR-VALUE-VECTOR SPARSE-X) I) N)))
    RESULT)

[cl-online-learning/src/vector.lisp:122]
  (DEFUN SPS-V*N (SPARSE-X N RESULT)
    (DECLARE (TYPE SPARSE-VECTOR SPARSE-X)
             (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) RESULT)
             (TYPE SINGLE-FLOAT N)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DOSVEC SPARSE-X I
     (LET ((DENCE-INDEX (AREF (SPARSE-VECTOR-INDEX-VECTOR SPARSE-X) I)))
       (DECLARE (TYPE FIXNUM DENCE-INDEX))
       (SETF (AREF RESULT DENCE-INDEX)
               (* (AREF (SPARSE-VECTOR-VALUE-VECTOR SPARSE-X) I) N))))
    RESULT)

[cl-online-learning/src/vector.lisp:134]
  (DEFUN DS-V+ (DENCE-X SPARSE-Y RESULT)
    (DECLARE (TYPE SPARSE-VECTOR SPARSE-Y)
             (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) DENCE-X RESULT)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DOSVEC SPARSE-Y I
     (LET ((DENCE-INDEX (AREF (SPARSE-VECTOR-INDEX-VECTOR SPARSE-Y) I)))
       (DECLARE (TYPE FIXNUM DENCE-INDEX))
       (SETF (AREF RESULT DENCE-INDEX)
               (+ (AREF DENCE-X DENCE-INDEX)
                  (AREF (SPARSE-VECTOR-VALUE-VECTOR SPARSE-Y) I)))))
    RESULT)

[cl-online-learning/src/vector.lisp:146]
  (DEFUN DS-V- (DENCE-X SPARSE-Y RESULT)
    (DECLARE (TYPE SPARSE-VECTOR SPARSE-Y)
             (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) DENCE-X RESULT)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DOSVEC SPARSE-Y I
     (LET ((DENCE-INDEX (AREF (SPARSE-VECTOR-INDEX-VECTOR SPARSE-Y) I)))
       (DECLARE (TYPE FIXNUM DENCE-INDEX))
       (SETF (AREF RESULT DENCE-INDEX)
               (- (AREF DENCE-X DENCE-INDEX)
                  (AREF (SPARSE-VECTOR-VALUE-VECTOR SPARSE-Y) I)))))
    RESULT)

[cl-online-learning/src/vector.lisp:158]
  (DEFUN DS-V* (DENCE-X SPARSE-Y RESULT)
    (DECLARE (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) DENCE-X RESULT)
             (TYPE SPARSE-VECTOR SPARSE-Y)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DOSVEC SPARSE-Y I
     (LET ((DENCE-INDEX (AREF (SPARSE-VECTOR-INDEX-VECTOR SPARSE-Y) I)))
       (DECLARE (TYPE FIXNUM DENCE-INDEX))
       (SETF (AREF RESULT DENCE-INDEX)
               (* (AREF DENCE-X DENCE-INDEX)
                  (AREF (SPARSE-VECTOR-VALUE-VECTOR SPARSE-Y) I)))))
    RESULT)

[cl-online-learning/src/vector.lisp:170]
  (DEFUN DS2S-V* (DENCE-X SPARSE-Y SPARSE-RESULT)
    (DECLARE (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) DENCE-X)
             (TYPE SPARSE-VECTOR SPARSE-Y SPARSE-RESULT)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DOSVEC SPARSE-Y I
     (LET ((DENCE-INDEX (AREF (SPARSE-VECTOR-INDEX-VECTOR SPARSE-Y) I)))
       (DECLARE (TYPE FIXNUM DENCE-INDEX))
       (SETF (AREF (SPARSE-VECTOR-VALUE-VECTOR SPARSE-RESULT) I)
               (* (AREF DENCE-X DENCE-INDEX)
                  (AREF (SPARSE-VECTOR-VALUE-VECTOR SPARSE-Y) I)))))
    SPARSE-RESULT)

[cl-online-learning/src/vector.lisp:182]
  (DEFUN DS-V/ (DENCE-X SPARSE-Y RESULT)
    (DECLARE (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) DENCE-X RESULT)
             (TYPE SPARSE-VECTOR SPARSE-Y)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DOSVEC SPARSE-Y I
     (LET ((DENCE-INDEX (AREF (SPARSE-VECTOR-INDEX-VECTOR SPARSE-Y) I)))
       (DECLARE (TYPE FIXNUM DENCE-INDEX))
       (SETF (AREF RESULT DENCE-INDEX)
               (/ (AREF DENCE-X DENCE-INDEX)
                  (AREF (SPARSE-VECTOR-VALUE-VECTOR SPARSE-Y) I)))))
    RESULT)

[cl-online-learning/src/vector.lisp:197]
  (DEFUN DS-DOT (DENCE-X SPARSE-Y)
    (DECLARE (TYPE SPARSE-VECTOR SPARSE-Y)
             (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) DENCE-X)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((RESULT 0.0))
      (DECLARE (TYPE SINGLE-FLOAT RESULT))
      (DOSVEC SPARSE-Y I
       (LET ((DENCE-INDEX (AREF (SPARSE-VECTOR-INDEX-VECTOR SPARSE-Y) I)))
         (DECLARE (TYPE FIXNUM DENCE-INDEX))
         (INCF RESULT
               (* (AREF DENCE-X DENCE-INDEX)
                  (AREF (SPARSE-VECTOR-VALUE-VECTOR SPARSE-Y) I)))))
      RESULT))

[cl-online-learning/src/vector.lisp:211]
  (DEFUN DS-DOT! (DENCE-X SPARSE-Y RESULT)
    (DECLARE (TYPE SPARSE-VECTOR SPARSE-Y)
             (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) DENCE-X)
             (TYPE (SIMPLE-ARRAY SINGLE-FLOAT 1) RESULT)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((ACC 0.0))
      (DECLARE (TYPE SINGLE-FLOAT ACC))
      (DOSVEC SPARSE-Y I
       (LET ((DENCE-INDEX (AREF (SPARSE-VECTOR-INDEX-VECTOR SPARSE-Y) I)))
         (DECLARE (TYPE FIXNUM DENCE-INDEX))
         (INCF ACC
               (* (AREF DENCE-X DENCE-INDEX)
                  (AREF (SPARSE-VECTOR-VALUE-VECTOR SPARSE-Y) I)))))
      (SETF (AREF RESULT 0) ACC)
      RESULT))

[cl-online-learning/src/vector.lisp:228]
  (DEFUN DPS-V+ (DENCE-X PSEUDOSPARSE-Y INDEX-VECTOR RESULT)
    (DECLARE (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) DENCE-X PSEUDOSPARSE-Y RESULT)
             (TYPE (SIMPLE-ARRAY FIXNUM) INDEX-VECTOR)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DOVEC INDEX-VECTOR I
     (LET ((DENCE-INDEX (AREF INDEX-VECTOR I)))
       (DECLARE (TYPE FIXNUM DENCE-INDEX))
       (SETF (AREF RESULT DENCE-INDEX)
               (+ (AREF DENCE-X DENCE-INDEX)
                  (AREF PSEUDOSPARSE-Y DENCE-INDEX)))))
    RESULT)

[cl-online-learning/src/vector.lisp:240]
  (DEFUN DPS-V- (DENCE-X PSEUDOSPARSE-Y INDEX-VECTOR RESULT)
    (DECLARE (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) DENCE-X PSEUDOSPARSE-Y RESULT)
             (TYPE (SIMPLE-ARRAY FIXNUM) INDEX-VECTOR)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DOVEC INDEX-VECTOR I
     (LET ((DENCE-INDEX (AREF INDEX-VECTOR I)))
       (DECLARE (TYPE FIXNUM DENCE-INDEX))
       (SETF (AREF RESULT DENCE-INDEX)
               (- (AREF DENCE-X DENCE-INDEX)
                  (AREF PSEUDOSPARSE-Y DENCE-INDEX)))))
    RESULT)

[cl-online-learning/src/vector.lisp:252]
  (DEFUN DPS-V* (DENCE-X PSEUDOSPARSE-Y INDEX-VECTOR RESULT)
    (DECLARE (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) DENCE-X PSEUDOSPARSE-Y RESULT)
             (TYPE (SIMPLE-ARRAY FIXNUM) INDEX-VECTOR)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DOVEC INDEX-VECTOR I
     (LET ((DENCE-INDEX (AREF INDEX-VECTOR I)))
       (DECLARE (TYPE FIXNUM DENCE-INDEX))
       (SETF (AREF RESULT DENCE-INDEX)
               (* (AREF DENCE-X DENCE-INDEX)
                  (AREF PSEUDOSPARSE-Y DENCE-INDEX)))))
    RESULT)

[cl-online-learning/src/vector.lisp:264]
  (DEFUN PS-V*N (PSEUDOSPARSE-X N INDEX-VECTOR RESULT)
    (DECLARE (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) PSEUDOSPARSE-X RESULT)
             (TYPE (SIMPLE-ARRAY FIXNUM) INDEX-VECTOR)
             (TYPE SINGLE-FLOAT N)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DOVEC INDEX-VECTOR I
     (LET ((DENCE-INDEX (AREF INDEX-VECTOR I)))
       (DECLARE (TYPE FIXNUM DENCE-INDEX))
       (SETF (AREF RESULT DENCE-INDEX)
               (* N (AREF PSEUDOSPARSE-X DENCE-INDEX)))))
    RESULT)

[cl-pass/src/cl-pass.lisp:30]
  (DEFUN HASH
         (PASSWORD
          &KEY (TYPE :PBKDF2-SHA256) (SALT (SALT 16)) (ITERATIONS 20000))
    "Hash a password string."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (LET ((PASS
           (#S(FORMGREP:SYMREF
               :NAME "STRING-TO-UTF-8-BYTES"
               :QUALIFIER "TRIVIAL-UTF-8")
            PASSWORD)))
      (CASE TYPE
        (:PBKDF2-SHA1 (PBKDF2 PASS SALT :SHA1 ITERATIONS))
        (:PBKDF2-SHA256 (PBKDF2 PASS SALT :SHA256 ITERATIONS))
        (:PBKDF2-SHA512 (PBKDF2 PASS SALT :SHA512 ITERATIONS))
        (T
         (ERROR "No such digest: ~A. Available digests: ~A." TYPE
                +KNOWN-DIGESTS+)))))

[cl-pdf/contrib/zlib.work.lisp:102]
  (DEFUN BLOCK-COMPRESS (SOURCE)
    "Returns two values: array of bytes containing the compressed data
 and the numbe of compressed bytes"
    (IF (<= (LENGTH SOURCE) *Z-BLOCK-THRESHOLD*)
        (COMPRESS SOURCE)
        (#S(FORMGREP:SYMREF :NAME "WITH-FOREIGN-OBJECT" :QUALIFIER "UFFI")
         (Z-STREAM 'Z-STREAM)
         (SETF (#S(FORMGREP:SYMREF :NAME "GET-SLOT-VALUE" :QUALIFIER "UFFI")
                Z-STREAM 'Z-STREAM 'ZALLOC)
                 0)
         (SETF (#S(FORMGREP:SYMREF :NAME "GET-SLOT-VALUE" :QUALIFIER "UFFI")
                Z-STREAM 'Z-STREAM 'ZFREE)
                 0)
         (SETF (#S(FORMGREP:SYMREF :NAME "GET-SLOT-VALUE" :QUALIFIER "UFFI")
                Z-STREAM 'Z-STREAM 'OPAQUE)
                 0)
         (SETF (#S(FORMGREP:SYMREF :NAME "GET-SLOT-VALUE" :QUALIFIER "UFFI")
                Z-STREAM 'Z-STREAM 'ALDER)
                 0)
         (SETF (#S(FORMGREP:SYMREF :NAME "GET-SLOT-VALUE" :QUALIFIER "UFFI")
                Z-STREAM 'Z-STREAM 'RESERVED)
                 0)
         (SETF (#S(FORMGREP:SYMREF :NAME "GET-SLOT-VALUE" :QUALIFIER "UFFI")
                Z-STREAM 'Z-STREAM 'STATE)
                 0)
         (LET* ((SOURCE-BUF
                 (#S(FORMGREP:SYMREF
                     :NAME "ALLOCATE-FOREIGN-STRING"
                     :QUALIFIER "UFFI")
                  *Z-BLOCK-SIZE* :UNSIGNED T))
                (DEST-BUF
                 (#S(FORMGREP:SYMREF
                     :NAME "ALLOCATE-FOREIGN-STRING"
                     :QUALIFIER "UFFI")
                  *Z-BLOCK-SIZE* :UNSIGNED T)))
           (SETF (#S(FORMGREP:SYMREF :NAME "GET-SLOT-VALUE" :QUALIFIER "UFFI")
                  Z-STREAM 'Z-STREAM 'NEXT-IN)
                   SOURCE-BUF)
           (SETF (#S(FORMGREP:SYMREF :NAME "GET-SLOT-VALUE" :QUALIFIER "UFFI")
                  Z-STREAM 'Z-STREAM 'AVAIL-IN)
                   0)
           (SETF (#S(FORMGREP:SYMREF :NAME "GET-SLOT-VALUE" :QUALIFIER "UFFI")
                  Z-STREAM 'Z-STREAM 'TOTAL-IN)
                   0)
           (SETF (#S(FORMGREP:SYMREF :NAME "GET-SLOT-VALUE" :QUALIFIER "UFFI")
                  Z-STREAM 'Z-STREAM 'NEXT-OUT)
                   DEST-BUF)
           (SETF (#S(FORMGREP:SYMREF :NAME "GET-SLOT-VALUE" :QUALIFIER "UFFI")
                  Z-STREAM 'Z-STREAM 'AVAIL-OUT)
                   *Z-BLOCK-SIZE*)
           (SETF (#S(FORMGREP:SYMREF :NAME "GET-SLOT-VALUE" :QUALIFIER "UFFI")
                  Z-STREAM 'Z-STREAM 'TOTAL-OUT)
                   0)
           (DEFLATE-INIT Z-STREAM +Z-DEFAULT-COMPRESSION+)
           (UNWIND-PROTECT
               (LOOP WITH LENGTH = (LENGTH SOURCE)
                     FOR START FROM 0 BY BLOCK-SIZE
                     FOR BLOCK-SIZE = (MIN *Z-BLOCK-SIZE* (- LENGTH START))
                     DO (UNLESS (ZEROP BLOCK-SIZE)
                          (LOCALLY
                           (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0)
                            (TYPE (SIMPLE-STRING SOURCE)))
                           (DOTIMES (I BLOCK-SIZE)
                             (DECLARE (TYPE FIXNUM I))
                             (SETF (#S(FORMGREP:SYMREF
                                       :NAME "DEREF-ARRAY"
                                       :QUALIFIER "UFFI")
                                    SOURCE-BUF '(:ARRAY :UNSIGNED-CHAR) I)
                                     (AREF SOURCE (+ I START)))))
                          (SETF (#S(FORMGREP:SYMREF
                                    :NAME "GET-SLOT-VALUE"
                                    :QUALIFIER "UFFI")
                                 Z-STREAM 'Z-STREAM 'NEXT-IN)
                                  SOURCE-BUF)
                          (SETF (#S(FORMGREP:SYMREF
                                    :NAME "GET-SLOT-VALUE"
                                    :QUALIFIER "UFFI")
                                 Z-STREAM 'Z-STREAM 'AVAIL-IN)
                                  BLOCK-SIZE)) (DEFLATE Z-STREAM
                                                +Z-NO-FLUSH+) (IF (ZEROP
                                                                   RESULT)
                                                                  (VALUES
                                                                   (#S(FORMGREP:SYMREF
                                                                       :NAME "CONVERT-FROM-FOREIGN-STRING"
                                                                       :QUALIFIER "UFFI")
                                                                    DEST
                                                                    :LENGTH
                                                                    NEWDESTLEN
                                                                    :NULL-TERMINATED-P
                                                                    NIL)
                                                                   NEWDESTLEN)
                                                                  (ERROR
                                                                   "zlib error, code ~D"
                                                                   RESULT)))
             (PROGN
              (#S(FORMGREP:SYMREF
                  :NAME "FREE-FOREIGN-OBJECT"
                  :QUALIFIER "UFFI")
               SOURCE-BUF)
              (#S(FORMGREP:SYMREF
                  :NAME "FREE-FOREIGN-OBJECT"
                  :QUALIFIER "UFFI")
               DEST-BUF)))))))

[cl-pdf/examples/examples.lisp:458]
  (DEFUN GEN-MANDELBROT-BITS (W H)
    (DECLARE (OPTIMIZE SPEED (DEBUG 0) (SAFETY 0) (SPACE 0))
             (TYPE FIXNUM W H))
    (LET* ((NB-COLS 30000)
           (NB-ITER (EXPT 2 11))
           (CENTER #C(-0.7714390420105d0 0.1264514778485d0))
           (ZOOM (* (EXPT (/ H 320) 2) 268436766))
           (INC (/ H (* 150000.0d0 ZOOM)))
           (COLS (MAKE-COLOR-MAP NB-COLS 1 0.2 0.9 0.24 0.21 T))
           (C #C(0.0d0 0.0d0))
           (Z #C(0.0d0 0.0d0))
           (REGION NIL))
      (DECLARE (TYPE DOUBLE-FLOAT INC))
      (DOTIMES (I H)
        (DOTIMES (J W)
          (SETF C
                  (COMPLEX
                   (+ (REALPART CENTER)
                      (* INC (+ (THE FIXNUM J) (/ W -2.0d0))))
                   (+ (IMAGPART CENTER)
                      (* INC (+ (THE FIXNUM I) (/ H -2.0d0)))))
                Z #C(0.0d0 0.0d0))
          (PUSH
           (DOTIMES (N NB-ITER 0)
             (SETF Z (+ (* Z Z) C))
             (WHEN (< 2 (ABS Z))
               (RETURN
                (- NB-ITER (- N (LOG (LOG (ABS (+ (* Z Z) C)) 10) 2))))))
           REGION)))
      (WITH-OUTPUT-TO-STRING (S)
        (LET ((MAX (REDUCE #'MAX REGION)))
          (DOLIST (X (NREVERSE REGION))
            (DESTRUCTURING-BIND
                (R G B)
                (IF (ZEROP X)
                    '(0 0 0)
                    (ELT COLS
                         (FLOOR (EXPT (/ X MAX) (/ NB-ITER 256))
                                (/ 1 (1- NB-COLS)))))
              (FORMAT S "~2,'0x~2,'0x~2,'0x" R G B)))))))

[cl-pdf/zlib.lisp:114]
  (DEFUN STRING-TO-OCTETS (STRING START END)
    "Convert STRING to a sequence of octets, if possible."
    (DECLARE (TYPE STRING STRING)
             (TYPE FIXNUM START END)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (STRING-TO-OCTETS STRING :EXTERNAL-FORMAT :ISO-8859-1 :START START :END
                      END)
    (#S(FORMGREP:SYMREF :NAME "STRING-TO-OCTETS" :QUALIFIER "EXCL") STRING
     :EXTERNAL-FORMAT :OCTETS :START START :END END :NULL-TERMINATE NIL)
    (#S(FORMGREP:SYMREF :NAME "CONVERT-STRING-TO-BYTES" :QUALIFIER "EXT")
     STRING
     #S(FORMGREP:SYMREF :NAME "*DEFAULT-FILE-ENCODING*" :QUALIFIER "CUSTOM")
     :START START :END END)
    (#S(FORMGREP:SYMREF :NAME "ENCODE-STRING-TO-OCTETS" :QUALIFIER "CCL")
     STRING :EXTERNAL-FORMAT :LATIN-1 :START START :END END)
    (#S(FORMGREP:SYMREF :NAME "STRING-TO-OCTETS" :QUALIFIER "EXT") STRING
     :EXTERNAL-FORMAT :ISO-8859-1 :START START :END END)
    (LET* ((LENGTH (- END START))
           (RESULT
            (MAKE-ARRAY LENGTH :ELEMENT-TYPE
                        '#S(FORMGREP:SYMREF
                            :NAME "OCTET"
                            :QUALIFIER "SALZA2"))))
      (LOOP FOR I FIXNUM FROM START BELOW
            END
            FOR J FIXNUM FROM 0
            DO (SETF (AREF RESULT J) (CHAR-CODE (AREF STRING I))))
      RESULT)
    (ERROR "Do not know how to convert a string to octets."))

[cl-png/ops.lisp:405]
  (DEFUN CONVOLVE (IMAGE KERNEL &KEY FILL)
    "Returns a new image of type IMAGE produced by convolving KERNEL
  with IMAGE. This is not a circular convolution and no values are
  computed in the border region where the kernel is not completely
  contained in IMAGE.

  FILL controls the output image size: if set, it returns an image the
  same size as IMAGE, if NIL, it returns an image which is shrunk to
  exclude the uncomputed border region (the dimensions of KERNEL-1).

  KERNEL must be a 2-d square mask with odd dimensions (e.g. 3x3), a
  simple-array of type FLOAT. IMAGE can be GRAYSCALE-IMAGE or an
  RGB-IMAGE - in the latter case the channels are convolved with the
  KERNEL seperately.

  If FILL is set, it must consist of a list of values of the same type
  as the pixels of IMAGE. For example, an rgb-image with 8-bit pixels
  might have a fill of '(#x7f #x7f #x7f), whereas a grayscale-image
  would have a fill of '(#x7f). If FILL is not set the image will shrink.
"
    (DECLARE (OPTIMIZE (SPEED 2) (COMPILATION-SPEED 0) (SAFETY 0) (DEBUG 0)))
    (DECLARE (TYPE (SIMPLE-ARRAY FLOAT (* *)) KERNEL))
    (LET* ((DIM (ARRAY-DIMENSION KERNEL 0))
           (1SIDE (FLOOR DIM 2))
           (COLORS (THE FIXNUM (COLOR-CHANNELS IMAGE)))
           (MAXVAL (THE FIXNUM (MAX-COLOR-INDEX IMAGE)))
           (WIDTH (THE FIXNUM (IMAGE-WIDTH IMAGE)))
           (HEIGHT (THE FIXNUM (IMAGE-HEIGHT IMAGE))))
      (FLET ((INNERPROD (RO CO K)
               (DECLARE (TYPE FIXNUM RO CO K))
               (LET ((ACCUM 0.0))
                 (DECLARE (TYPE FLOAT ACCUM))
                 (DOTIMES (R DIM)
                   (DOTIMES (C DIM)
                     (INCF ACCUM
                           (* (AREF KERNEL R C)
                              (THE FIXNUM (AREF IMAGE (+ RO R) (+ CO C) K))))))
                 (THE FIXNUM (MAX 0 (MIN (THE FIXNUM (FLOOR ACCUM)) MAXVAL))))))
        (LET ((NEWROWS (THE FIXNUM (- HEIGHT 1SIDE 1SIDE)))
              (NEWCOLS (THE FIXNUM (- WIDTH 1SIDE 1SIDE))))
          (IF FILL
              (LET ((NEW (MAKE-IMAGE-LIKE IMAGE)))
                (DOTIMES (R 1SIDE)
                  (DOTIMES (C WIDTH)
                    (DOTIMES (K COLORS)
                      (SETF (AREF NEW R C K) (NTH K FILL)
                            (AREF NEW (- HEIGHT R 1) C K) (NTH K FILL)))))
                (DOTIMES (C 1SIDE)
                  (DOTIMES (R HEIGHT)
                    (DOTIMES (K COLORS)
                      (SETF (AREF NEW R C K) (NTH K FILL)
                            (AREF NEW R (- WIDTH C 1) K) (NTH K FILL)))))
                (DOTIMES (R NEWROWS NEW)
                  (DOTIMES (C NEWCOLS)
                    (DOTIMES (K COLORS)
                      (SETF (THE FIXNUM (AREF NEW (+ R 1SIDE) (+ C 1SIDE) K))
                              (INNERPROD R C K))))))
              (LET ((NEW
                     (MAKE-IMAGE NEWROWS NEWCOLS (IMAGE-CHANNELS IMAGE)
                      (IMAGE-BIT-DEPTH IMAGE))))
                (DOTIMES (R NEWROWS NEW)
                  (DOTIMES (C NEWCOLS)
                    (DOTIMES (K COLORS)
                      (SETF (THE FIXNUM (AREF NEW R C K))
                              (INNERPROD R C K)))))))))))

[cl-protobufs/utilities.lisp:16]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (DEFPARAMETER $OPTIMIZE-DEFAULT
      '(OPTIMIZE (SPEED 1) (SAFETY 3) (DEBUG 3))
      "Compiler optimization settings for safe, debuggable code.")
    (DEFPARAMETER $OPTIMIZE-FAST-UNSAFE
      '(OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0))
      "Compiler optimization settings for fast, unsafe, hard-to-debug code."))

[cl-protobufs/utilities.lisp:18]
  (DEFPARAMETER $OPTIMIZE-DEFAULT
    '(OPTIMIZE (SPEED 1) (SAFETY 3) (DEBUG 3))
    "Compiler optimization settings for safe, debuggable code.")

[cl-protobufs/utilities.lisp:20]
  (DEFPARAMETER $OPTIMIZE-FAST-UNSAFE
    '(OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0))
    "Compiler optimization settings for fast, unsafe, hard-to-debug code.")

[cl-randist/GIG.lisp:3]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 1)))

[cl-randist/binomial.lisp:3]
  (DECLAIM (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 0)))

[cl-randist/chisq.lisp:3]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 1)))

[cl-randist/exponential.lisp:5]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 1)))

[cl-randist/f.lisp:3]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 1)))

[cl-randist/gamma.lisp:21]
  (DECLAIM
   (OPTIMIZE (SPEED 3) (DEBUG 2) (SAFETY 2) (SPACE 0) (COMPILATION-SPEED 0)))

[cl-randist/jmt.lisp:61]
  (DECLAIM
   (OPTIMIZE (SPEED 3) (DEBUG 2) (SAFETY 2) (SPACE 0) (COMPILATION-SPEED 0)))

[cl-randist/multinomial.lisp:3]
  (DECLAIM (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 0)))

[cl-randist/nbinomial.lisp:3]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 3) (SAFETY 1)))

[cl-randist/normal.lisp:26]
  (DECLAIM
   (OPTIMIZE (SPEED 3) (DEBUG 2) (SAFETY 2) (SPACE 0) (COMPILATION-SPEED 0)))

[cl-randist/pareto.lisp:3]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 1)))

[cl-randist/poisson.lisp:3]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 3) (SAFETY 1)))

[cl-randist/t.lisp:3]
  (DECLAIM (OPTIMIZE (SPEED 1) (DEBUG 3) (SAFETY 1)))

[cl-random-forest/src/experimental/multi-grained-scanning.lisp:198]
  (DEFUN MAKE-REFINE-DATASET-FROM-PATCH-DATAMATRIX
         (FOREST DATAMATRIX PATCH-DATAMATRIX)
    (LET ((INDEX-OFFSET (FOREST-INDEX-OFFSET FOREST))
          (LEN (ARRAY-DIMENSION DATAMATRIX 0))
          (N-TREE (FOREST-N-TREE FOREST))
          (N-PATCH
           (/ (ARRAY-DIMENSION PATCH-DATAMATRIX 0)
              (ARRAY-DIMENSION DATAMATRIX 0))))
      (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
               (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) DATAMATRIX PATCH-DATAMATRIX)
               (TYPE (SIMPLE-ARRAY FIXNUM) INDEX-OFFSET)
               (TYPE FIXNUM LEN N-TREE N-PATCH))
      (LET ((REFINE-DATASET (MAKE-ARRAY LEN)))
        (LOOP FOR I FROM 0 BELOW LEN
              DO (SETF (AREF REFINE-DATASET I)
                         (MAKE-ARRAY (* N-TREE N-PATCH) :ELEMENT-TYPE
                                     'FIXNUM)))
        (MAPC/PMAPC
         (LAMBDA (DTREE)
           (LET* ((TREE-ID (DTREE-ID DTREE))
                  (OFFSET (AREF INDEX-OFFSET TREE-ID)))
             (DECLARE (TYPE FIXNUM TREE-ID OFFSET))
             (LOOP FOR I FIXNUM FROM 0 BELOW LEN
                   DO (LOOP FOR PATCH-INDEX FIXNUM FROM 0 BELOW N-PATCH
                            DO (LET ((LEAF-INDEX
                                      (NODE-LEAF-INDEX
                                       (FIND-LEAF (DTREE-ROOT DTREE)
                                        PATCH-DATAMATRIX
                                        (+ (* I N-PATCH) PATCH-INDEX))))
                                     (REFINE-DATUM (SVREF REFINE-DATASET I)))
                                 (DECLARE (TYPE FIXNUM LEAF-INDEX)
                                          (TYPE (SIMPLE-ARRAY FIXNUM)
                                           REFINE-DATUM))
                                 (SETF (AREF REFINE-DATUM
                                             (+ (* PATCH-INDEX N-TREE)
                                                TREE-ID))
                                         (+ LEAF-INDEX OFFSET))))))
           (FORMAT T ".")
           (FORCE-OUTPUT))
         (FOREST-DTREE-LIST FOREST))
        (TERPRI)
        REFINE-DATASET)))

[cl-random-forest/src/experimental/workspace.lisp:56]
  (DEFUN CONSTRUCT-DTREE-LAMBDA (DTREE)
    (ECLECTOR.READER:QUASIQUOTE
     (LAMBDA (D I)
       (DECLARE
        (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (DEBUG 0)
         (COMPILATION-SPEED 0))
        (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT) D)
        (TYPE FIXNUM I))
       (ECLECTOR.READER:UNQUOTE (EXTRACT-NODE (DTREE-ROOT DTREE))))))

[cl-random-forest/src/experimental/workspace.lisp:66]
  (LAMBDA (DATAMATRIX DATUM-INDEX)
    (DECLARE
     (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (DEBUG 0) (COMPILATION-SPEED 0))
     (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT) DATAMATRIX)
     (TYPE FIXNUM DATUM-INDEX))
    (IF (>= (AREF DATAMATRIX DATUM-INDEX 0) -0.7394168078526362d0)
        (IF (>= (AREF DATAMATRIX DATUM-INDEX 1) 0.8903535809681147d0)
            3
            1)
        (IF (>= (AREF DATAMATRIX DATUM-INDEX 1) 0.5876648784761986d0)
            2
            0)))

[cl-random-forest/src/experimental/workspace.lisp:184]
  (DEFUN ARGMAX (ARR)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT) ARR))
    (LET ((MAX 0.0d0) (MAX-I 0))
      (DECLARE (TYPE DOUBLE-FLOAT MAX)
               (TYPE FIXNUM MAX-I))
      (LOOP FOR I FIXNUM FROM 0 BELOW (LENGTH ARR)
            DO (WHEN (> (AREF ARR I) MAX)
                 (SETF MAX (AREF ARR I)
                       MAX-I I)))
      MAX-I))

[cl-random-forest/src/feature-importance.lisp:27]
  (DEFUN TEST-DTREE-OOB
         (DTREE DATAMATRIX TARGET &KEY QUIET-P OOB-SAMPLE-INDICES)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE DTREE DTREE)
             (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) DATAMATRIX)
             (TYPE (SIMPLE-ARRAY FIXNUM (*)) TARGET))
    (LET* ((N-CORRECT 0)
           (OOB-SAMPLE-INDICES
            (IF (NULL OOB-SAMPLE-INDICES)
                (DTREE-OOB-SAMPLE-INDICES DTREE)
                OOB-SAMPLE-INDICES))
           (LEN-OOB (LENGTH OOB-SAMPLE-INDICES)))
      (DECLARE (TYPE FIXNUM N-CORRECT LEN-OOB)
               (TYPE (SIMPLE-ARRAY FIXNUM (*)) OOB-SAMPLE-INDICES))
      (LOOP FOR I FIXNUM FROM 0 BELOW LEN-OOB
            DO (LET ((J (AREF OOB-SAMPLE-INDICES I)))
                 (DECLARE (TYPE FIXNUM J))
                 (WHEN (= (PREDICT-DTREE DTREE DATAMATRIX J) (AREF TARGET J))
                   (INCF N-CORRECT))))
      (CALC-ACCURACY N-CORRECT LEN-OOB :QUIET-P QUIET-P)))

[cl-random-forest/src/feature-importance.lisp:48]
  (DEFUN FIND-LEAF-RANDOMIZED
         (NODE DATAMATRIX DATUM-INDEX RANDOMIZED-ATTRIBUTE OOB-SAMPLE-INDICES)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE FIXNUM DATUM-INDEX)
             (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) DATAMATRIX)
             (TYPE (SIMPLE-ARRAY FIXNUM) OOB-SAMPLE-INDICES))
    (FLET ((RANDOM-PICK-OOB-INDEX ()
             (AREF OOB-SAMPLE-INDICES (RANDOM (LENGTH OOB-SAMPLE-INDICES)))))
      (COND ((NULL NODE) NIL) ((NULL (NODE-TEST-ATTRIBUTE NODE)) NODE)
            (T
             (LET* ((ATTRIBUTE (NODE-TEST-ATTRIBUTE NODE))
                    (THRESHOLD (NODE-TEST-THRESHOLD NODE))
                    (DATUM
                     (IF (= ATTRIBUTE RANDOMIZED-ATTRIBUTE)
                         (AREF DATAMATRIX (RANDOM-PICK-OOB-INDEX) ATTRIBUTE)
                         (AREF DATAMATRIX DATUM-INDEX ATTRIBUTE))))
               (DECLARE (TYPE FIXNUM ATTRIBUTE)
                        (TYPE SINGLE-FLOAT THRESHOLD DATUM))
               (IF (>= DATUM THRESHOLD)
                   (FIND-LEAF-RANDOMIZED (NODE-LEFT-NODE NODE) DATAMATRIX
                    DATUM-INDEX RANDOMIZED-ATTRIBUTE OOB-SAMPLE-INDICES)
                   (FIND-LEAF-RANDOMIZED (NODE-RIGHT-NODE NODE) DATAMATRIX
                    DATUM-INDEX RANDOMIZED-ATTRIBUTE OOB-SAMPLE-INDICES)))))))

[cl-random-forest/src/feature-importance.lisp:70]
  (DEFUN PREDICT-DTREE-RANDOMIZED
         (DTREE DATAMATRIX DATUM-INDEX RANDOMIZED-ATTRIBUTE OOB-SAMPLE-INDICES)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE DTREE DTREE)
             (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) DATAMATRIX)
             (TYPE FIXNUM DATUM-INDEX RANDOMIZED-ATTRIBUTE)
             (TYPE (SIMPLE-ARRAY FIXNUM) OOB-SAMPLE-INDICES))
    (LET ((MAX 0.0)
          (MAX-CLASS 0)
          (DIST
           (NODE-CLASS-DISTRIBUTION
            (FIND-LEAF-RANDOMIZED (DTREE-ROOT DTREE) DATAMATRIX DATUM-INDEX
             RANDOMIZED-ATTRIBUTE OOB-SAMPLE-INDICES)))
          (N-CLASS (DTREE-N-CLASS DTREE)))
      (DECLARE (TYPE SINGLE-FLOAT MAX)
               (TYPE FIXNUM MAX-CLASS N-CLASS)
               (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) DIST))
      (LOOP FOR I FIXNUM FROM 0 TO (1- N-CLASS)
            DO (WHEN (> (AREF DIST I) MAX)
                 (SETF MAX (AREF DIST I)
                       MAX-CLASS I)))
      MAX-CLASS))

[cl-random-forest/src/feature-importance.lisp:91]
  (DEFUN TEST-DTREE-OOB-RANDOMIZED
         (DTREE DATAMATRIX TARGET RANDOMIZED-ATTRIBUTE
          &KEY QUIET-P OOB-SAMPLE-INDICES)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE DTREE DTREE)
             (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) DATAMATRIX)
             (TYPE (SIMPLE-ARRAY FIXNUM (*)) TARGET))
    (LET* ((N-CORRECT 0)
           (OOB-SAMPLE-INDICES
            (IF (NULL OOB-SAMPLE-INDICES)
                (DTREE-OOB-SAMPLE-INDICES DTREE)
                OOB-SAMPLE-INDICES))
           (LEN-OOB (LENGTH OOB-SAMPLE-INDICES)))
      (DECLARE (TYPE FIXNUM N-CORRECT LEN-OOB)
               (TYPE (SIMPLE-ARRAY FIXNUM (*)) OOB-SAMPLE-INDICES))
      (LOOP FOR I FIXNUM FROM 0 BELOW LEN-OOB
            DO (LET ((J (AREF OOB-SAMPLE-INDICES I)))
                 (DECLARE (TYPE FIXNUM J))
                 (WHEN
                     (=
                      (PREDICT-DTREE-RANDOMIZED DTREE DATAMATRIX J
                       RANDOMIZED-ATTRIBUTE OOB-SAMPLE-INDICES)
                      (AREF TARGET J))
                   (INCF N-CORRECT))))
      (CALC-ACCURACY N-CORRECT LEN-OOB :QUIET-P QUIET-P)))

[cl-random-forest/src/feature-importance.lisp:131]
  (DEFUN TEST-RTREE-OOB
         (RTREE DATAMATRIX TARGET &KEY QUIET-P OOB-SAMPLE-INDICES)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE DTREE RTREE)
             (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) DATAMATRIX TARGET))
    (LET* ((SUM-SQUARE-ERROR 0.0)
           (OOB-SAMPLE-INDICES
            (IF (NULL OOB-SAMPLE-INDICES)
                (DTREE-OOB-SAMPLE-INDICES RTREE)
                OOB-SAMPLE-INDICES))
           (LEN-OOB (LENGTH OOB-SAMPLE-INDICES)))
      (DECLARE (TYPE SINGLE-FLOAT SUM-SQUARE-ERROR)
               (TYPE FIXNUM LEN-OOB)
               (TYPE (SIMPLE-ARRAY FIXNUM) OOB-SAMPLE-INDICES))
      (LOOP FOR I FIXNUM FROM 0 BELOW LEN-OOB
            DO (LET ((J (AREF OOB-SAMPLE-INDICES I)))
                 (DECLARE (TYPE FIXNUM J))
                 (INCF SUM-SQUARE-ERROR
                       (SQUARE
                        (- (PREDICT-RTREE RTREE DATAMATRIX J)
                           (AREF TARGET J))))))
      (SETF SUM-SQUARE-ERROR (SQRT (/ SUM-SQUARE-ERROR LEN-OOB)))
      (WHEN (NULL QUIET-P) (FORMAT T "RMSE: ~A~%" SUM-SQUARE-ERROR))
      SUM-SQUARE-ERROR))

[cl-random-forest/src/feature-importance.lisp:161]
  (DEFUN TEST-RTREE-OOB-RANDOMIZED
         (RTREE DATAMATRIX TARGET RANDOMIZED-ATTRIBUTE
          &KEY QUIET-P OOB-SAMPLE-INDICES)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE DTREE RTREE)
             (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) DATAMATRIX TARGET)
             (TYPE FIXNUM RANDOMIZED-ATTRIBUTE))
    (LET* ((SUM-SQUARE-ERROR 0.0)
           (OOB-SAMPLE-INDICES
            (IF (NULL OOB-SAMPLE-INDICES)
                (DTREE-OOB-SAMPLE-INDICES RTREE)
                OOB-SAMPLE-INDICES))
           (LEN-OOB (LENGTH OOB-SAMPLE-INDICES)))
      (DECLARE (TYPE SINGLE-FLOAT SUM-SQUARE-ERROR)
               (TYPE FIXNUM LEN-OOB)
               (TYPE (SIMPLE-ARRAY FIXNUM) OOB-SAMPLE-INDICES))
      (LOOP FOR I FIXNUM FROM 0 BELOW LEN-OOB
            DO (LET ((J (AREF OOB-SAMPLE-INDICES I)))
                 (DECLARE (TYPE FIXNUM J))
                 (INCF SUM-SQUARE-ERROR
                       (SQUARE
                        (-
                         (PREDICT-RTREE-RANDOMIZED RTREE DATAMATRIX J
                          RANDOMIZED-ATTRIBUTE OOB-SAMPLE-INDICES)
                         (AREF TARGET J))))))
      (SETF SUM-SQUARE-ERROR (SQRT (/ SUM-SQUARE-ERROR LEN-OOB)))
      (WHEN (NULL QUIET-P) (FORMAT T "RMSE: ~A~%" SUM-SQUARE-ERROR))
      SUM-SQUARE-ERROR))

[cl-random-forest/src/random-forest.lisp:193]
  (DEFUN CLASS-DISTRIBUTION (SAMPLE-INDICES TERMINATE-INDEX DTREE)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE (SIMPLE-ARRAY FIXNUM) SAMPLE-INDICES)
             (TYPE FIXNUM TERMINATE-INDEX)
             (TYPE DTREE DTREE))
    (LET ((N-CLASS (DTREE-N-CLASS DTREE))
          (CLASS-COUNT-ARRAY (DTREE-CLASS-COUNT-ARRAY DTREE))
          (TARGET (DTREE-TARGET DTREE)))
      (DECLARE (TYPE FIXNUM N-CLASS)
               (TYPE (SIMPLE-ARRAY FIXNUM) TARGET)
               (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) CLASS-COUNT-ARRAY))
      (LOOP FOR I FIXNUM FROM 0 BELOW N-CLASS
            DO (SETF (AREF CLASS-COUNT-ARRAY I) 0.0))
      (LOOP FOR I FIXNUM FROM 0 BELOW TERMINATE-INDEX
            DO (LET* ((DATUM-INDEX (AREF SAMPLE-INDICES I))
                      (CLASS-LABEL (AREF TARGET DATUM-INDEX)))
                 (INCF (AREF CLASS-COUNT-ARRAY CLASS-LABEL) 1.0)))
      (LET ((SUM
             (LOOP FOR C SINGLE-FLOAT ACROSS CLASS-COUNT-ARRAY
                   SUMMING C SINGLE-FLOAT)))
        (DECLARE (TYPE SINGLE-FLOAT SUM))
        (LOOP FOR I FIXNUM FROM 0 BELOW N-CLASS
              DO (IF (= SUM 0.0)
                     (SETF (AREF CLASS-COUNT-ARRAY I) (/ 1.0 N-CLASS))
                     (SETF (AREF CLASS-COUNT-ARRAY I)
                             (/ (AREF CLASS-COUNT-ARRAY I) SUM)))))
      CLASS-COUNT-ARRAY))

[cl-random-forest/src/random-forest.lisp:226]
  (DEFUN GINI (SAMPLE-INDICES TERMINATE-INDEX DTREE)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE (SIMPLE-ARRAY FIXNUM) SAMPLE-INDICES)
             (TYPE FIXNUM TERMINATE-INDEX)
             (TYPE DTREE DTREE))
    (LET ((DIST (CLASS-DISTRIBUTION SAMPLE-INDICES TERMINATE-INDEX DTREE))
          (SUM 0.0)
          (N-CLASS (DTREE-N-CLASS DTREE)))
      (DECLARE (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) DIST)
               (TYPE FIXNUM N-CLASS)
               (TYPE SINGLE-FLOAT SUM))
      (LOOP FOR I FIXNUM FROM 0 BELOW N-CLASS
            DO (LET ((PK (AREF DIST I)))
                 (DECLARE (TYPE (SINGLE-FLOAT 0.0) PK))
                 (SETF SUM
                         (+ SUM
                            (IF (= PK 0.0)
                                0.0
                                (* PK PK))))))
      (* -1.0 SUM)))

[cl-random-forest/src/random-forest.lisp:246]
  (DEFUN ENTROPY (SAMPLE-INDICES TERMINATE-INDEX DTREE)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE (SIMPLE-ARRAY FIXNUM) SAMPLE-INDICES)
             (TYPE FIXNUM TERMINATE-INDEX)
             (TYPE DTREE DTREE))
    (LET ((DIST (CLASS-DISTRIBUTION SAMPLE-INDICES TERMINATE-INDEX DTREE))
          (SUM 0.0)
          (N-CLASS (DTREE-N-CLASS DTREE)))
      (DECLARE (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) DIST)
               (TYPE FIXNUM N-CLASS)
               (TYPE SINGLE-FLOAT SUM))
      (LOOP FOR I FIXNUM FROM 0 BELOW N-CLASS
            DO (LET ((PK (AREF DIST I)))
                 (DECLARE (TYPE (SINGLE-FLOAT 0.0) PK))
                 (SETF SUM
                         (+ SUM
                            (IF (= PK 0.0)
                                0.0
                                (* PK (LOG PK)))))))
      (* -1.0 SUM)))

[cl-random-forest/src/random-forest.lisp:272]
  (DEFUN VARIANCE (SAMPLE-INDICES TERMINATE-INDEX RTREE)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE (SIMPLE-ARRAY FIXNUM) SAMPLE-INDICES)
             (TYPE FIXNUM TERMINATE-INDEX)
             (TYPE DTREE RTREE))
    (IF (ZEROP TERMINATE-INDEX)
        0.0
        (LET ((LEN (* TERMINATE-INDEX 1.0))
              (TARGET (DTREE-TARGET RTREE))
              (SUM 0.0))
          (DECLARE (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) TARGET)
                   (TYPE SINGLE-FLOAT SUM LEN))
          (LET ((AVE
                 (PROGN
                  (LOOP FOR I FIXNUM FROM 0 BELOW TERMINATE-INDEX
                        DO (INCF SUM (AREF TARGET (AREF SAMPLE-INDICES I))))
                  (/ SUM LEN))))
            (DECLARE (TYPE SINGLE-FLOAT AVE))
            (LET ((SUM-OF-SQUARES 0.0))
              (DECLARE (TYPE SINGLE-FLOAT SUM-OF-SQUARES))
              (LOOP FOR I FIXNUM FROM 0 BELOW TERMINATE-INDEX
                    DO (INCF SUM-OF-SQUARES
                             (SQUARE
                              (- (AREF TARGET (AREF SAMPLE-INDICES I)) AVE))))
              SUM-OF-SQUARES)))))

[cl-random-forest/src/random-forest.lisp:297]
  (DEFUN REGION-MIN/MAX (SAMPLE-INDICES DATAMATRIX ATTRIBUTE)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE (SIMPLE-ARRAY FIXNUM) SAMPLE-INDICES)
             (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) DATAMATRIX)
             (TYPE FIXNUM ATTRIBUTE))
    (LET ((MIN (AREF DATAMATRIX (AREF SAMPLE-INDICES 0) ATTRIBUTE))
          (MAX (AREF DATAMATRIX (AREF SAMPLE-INDICES 0) ATTRIBUTE)))
      (DECLARE (TYPE SINGLE-FLOAT MIN MAX))
      (LOOP FOR INDEX FIXNUM ACROSS SAMPLE-INDICES
            DO (LET ((ELEM (AREF DATAMATRIX INDEX ATTRIBUTE)))
                 (DECLARE (TYPE SINGLE-FLOAT ELEM))
                 (COND ((< MAX ELEM) (SETF MAX ELEM))
                       ((> MIN ELEM) (SETF MIN ELEM)))))
      (VALUES MIN MAX)))

[cl-random-forest/src/random-forest.lisp:312]
  (DEFUN MAKE-RANDOM-TEST (NODE)
    (LET* ((DTREE (NODE-DTREE NODE))
           (DATAMATRIX (DTREE-DATAMATRIX DTREE))
           (ATTRIBUTE (RANDOM (THE FIXNUM (DTREE-DATUM-DIM DTREE))))
           (SAMPLE-INDICES (NODE-SAMPLE-INDICES NODE)))
      (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
               (TYPE (SIMPLE-ARRAY FIXNUM) SAMPLE-INDICES)
               (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) DATAMATRIX)
               (TYPE FIXNUM ATTRIBUTE))
      (MULTIPLE-VALUE-BIND (MIN MAX)
          (REGION-MIN/MAX SAMPLE-INDICES DATAMATRIX ATTRIBUTE)
        (DECLARE (TYPE SINGLE-FLOAT MIN MAX))
        (LET ((THRESHOLD
               (IF (= MIN MAX)
                   MIN
                   (RANDOM-UNIFORM MIN MAX))))
          (DECLARE (TYPE SINGLE-FLOAT THRESHOLD))
          (VALUES ATTRIBUTE THRESHOLD)))))

[cl-random-forest/src/random-forest.lisp:328]
  (DEFUN SPLIT-SAMPLE-INDICES
         (SAMPLE-INDICES TRUE-ARRAY FALSE-ARRAY ATTRIBUTE THRESHOLD DATAMATRIX)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE (SIMPLE-ARRAY FIXNUM) SAMPLE-INDICES TRUE-ARRAY FALSE-ARRAY)
             (TYPE FIXNUM ATTRIBUTE)
             (TYPE SINGLE-FLOAT THRESHOLD)
             (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) DATAMATRIX))
    (LET ((TRUE-LEN 0) (FALSE-LEN 0))
      (DECLARE (TYPE FIXNUM TRUE-LEN FALSE-LEN))
      (LOOP FOR INDEX FIXNUM ACROSS SAMPLE-INDICES
            DO (COND
                ((>= (AREF DATAMATRIX INDEX ATTRIBUTE) THRESHOLD)
                 (SETF (AREF TRUE-ARRAY TRUE-LEN) INDEX) (INCF TRUE-LEN))
                (T (SETF (AREF FALSE-ARRAY FALSE-LEN) INDEX)
                 (INCF FALSE-LEN))))
      (VALUES TRUE-LEN FALSE-LEN)))

[cl-random-forest/src/random-forest.lisp:346]
  (DEFUN COPY-TMP->BEST! (DTREE)
    (LET ((TMP-ARR1 (DTREE-TMP-ARR1 DTREE))
          (TMP-INDEX1 (DTREE-TMP-INDEX1 DTREE))
          (TMP-ARR2 (DTREE-TMP-ARR2 DTREE))
          (TMP-INDEX2 (DTREE-TMP-INDEX2 DTREE))
          (BEST-ARR1 (DTREE-BEST-ARR1 DTREE))
          (BEST-ARR2 (DTREE-BEST-ARR2 DTREE)))
      (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
               (TYPE FIXNUM TMP-INDEX1 TMP-INDEX2)
               (TYPE (SIMPLE-ARRAY FIXNUM) TMP-ARR1 TMP-ARR2 BEST-ARR1
                BEST-ARR2))
      (LOOP FOR I FIXNUM FROM 0 BELOW TMP-INDEX1
            DO (SETF (AREF BEST-ARR1 I) (AREF TMP-ARR1 I)))
      (LOOP FOR I FIXNUM FROM 0 BELOW TMP-INDEX2
            DO (SETF (AREF BEST-ARR2 I) (AREF TMP-ARR2 I)))
      (SETF (DTREE-BEST-INDEX1 DTREE) TMP-INDEX1
            (DTREE-BEST-INDEX2 DTREE) TMP-INDEX2)))

[cl-random-forest/src/random-forest.lisp:363]
  (DEFUN MAKE-PARTIAL-ARR (ARR LEN)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE (SIMPLE-ARRAY FIXNUM) ARR)
             (TYPE FIXNUM LEN))
    (LET ((NEW-ARR (MAKE-ARRAY LEN :ELEMENT-TYPE 'FIXNUM)))
      (LOOP FOR I FIXNUM FROM 0 BELOW LEN
            DO (SETF (AREF NEW-ARR I) (AREF ARR I)))
      NEW-ARR))

[cl-random-forest/src/random-forest.lisp:455]
  (DEFUN FIND-LEAF (NODE DATAMATRIX DATUM-INDEX)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE FIXNUM DATUM-INDEX)
             (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) DATAMATRIX))
    (COND ((NULL NODE) NIL) ((NULL (NODE-TEST-ATTRIBUTE NODE)) NODE)
          (T
           (LET ((ATTRIBUTE (NODE-TEST-ATTRIBUTE NODE))
                 (THRESHOLD (NODE-TEST-THRESHOLD NODE)))
             (DECLARE (TYPE FIXNUM ATTRIBUTE)
                      (TYPE SINGLE-FLOAT THRESHOLD))
             (IF (>= (AREF DATAMATRIX DATUM-INDEX ATTRIBUTE) THRESHOLD)
                 (FIND-LEAF (NODE-LEFT-NODE NODE) DATAMATRIX DATUM-INDEX)
                 (FIND-LEAF (NODE-RIGHT-NODE NODE) DATAMATRIX DATUM-INDEX))))))

[cl-random-forest/src/random-forest.lisp:471]
  (DEFUN ARGMAX (ARR)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) ARR))
    (LET ((MAX MOST-NEGATIVE-SINGLE-FLOAT) (MAX-I 0))
      (DECLARE (TYPE SINGLE-FLOAT MAX)
               (TYPE FIXNUM MAX-I))
      (LOOP FOR I FIXNUM FROM 0 BELOW (LENGTH ARR)
            DO (WHEN (> (AREF ARR I) MAX)
                 (SETF MAX (AREF ARR I)
                       MAX-I I)))
      MAX-I))

[cl-random-forest/src/random-forest.lisp:484]
  (DEFUN PREDICT-DTREE (DTREE DATAMATRIX DATUM-INDEX)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE DTREE DTREE)
             (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) DATAMATRIX)
             (TYPE FIXNUM DATUM-INDEX))
    (LET ((DIST
           (NODE-CLASS-DISTRIBUTION
            (FIND-LEAF (DTREE-ROOT DTREE) DATAMATRIX DATUM-INDEX))))
      (DECLARE (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) DIST))
      (ARGMAX DIST)))

[cl-random-forest/src/random-forest.lisp:499]
  (DEFUN TEST-DTREE (DTREE DATAMATRIX TARGET &KEY QUIET-P)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE DTREE DTREE)
             (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) DATAMATRIX)
             (TYPE (SIMPLE-ARRAY FIXNUM (*)) TARGET))
    (LET ((N-CORRECT 0) (LEN (LENGTH TARGET)))
      (DECLARE (TYPE FIXNUM N-CORRECT LEN))
      (LOOP FOR I FIXNUM FROM 0 BELOW LEN
            DO (WHEN (= (PREDICT-DTREE DTREE DATAMATRIX I) (AREF TARGET I))
                 (INCF N-CORRECT)))
      (CALC-ACCURACY N-CORRECT LEN :QUIET-P QUIET-P)))

[cl-random-forest/src/random-forest.lisp:515]
  (DEFUN NODE-REGRESSION-MEAN (NODE)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE NODE NODE))
    (LET ((RTREE (NODE-DTREE NODE)))
      (DECLARE (TYPE DTREE RTREE))
      (LET ((TARGET (DTREE-TARGET RTREE))
            (PRED 0.0)
            (SAMPLE-INDICES (NODE-SAMPLE-INDICES NODE)))
        (DECLARE (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) TARGET)
                 (TYPE SINGLE-FLOAT PRED)
                 (TYPE (SIMPLE-ARRAY FIXNUM) SAMPLE-INDICES))
        (LET ((LEN (* (LENGTH SAMPLE-INDICES) 1.0)))
          (DECLARE (TYPE SINGLE-FLOAT LEN))
          (IF (ZEROP LEN)
              PRED
              (PROGN
               (LOOP FOR I FIXNUM ACROSS SAMPLE-INDICES
                     DO (INCF PRED (AREF TARGET I)))
               (/ PRED LEN)))))))

[cl-random-forest/src/random-forest.lisp:538]
  (DEFUN TEST-RTREE (RTREE DATAMATRIX TARGET &KEY QUIET-P)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE DTREE RTREE)
             (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) DATAMATRIX TARGET))
    (LET ((SUM-SQUARE-ERROR 0.0) (N-DATA (ARRAY-DIMENSION DATAMATRIX 0)))
      (DECLARE (TYPE SINGLE-FLOAT SUM-SQUARE-ERROR)
               (TYPE FIXNUM N-DATA))
      (LOOP FOR I FIXNUM FROM 0 BELOW N-DATA
            DO (INCF SUM-SQUARE-ERROR
                     (SQUARE
                      (- (PREDICT-RTREE RTREE DATAMATRIX I) (AREF TARGET I)))))
      (SETF SUM-SQUARE-ERROR (SQRT (/ SUM-SQUARE-ERROR N-DATA)))
      (WHEN (NULL QUIET-P) (FORMAT T "RMSE: ~A~%" SUM-SQUARE-ERROR))
      SUM-SQUARE-ERROR))

[cl-random-forest/src/random-forest.lisp:707]
  (DEFUN CLASS-DISTRIBUTION-FOREST (FOREST DATAMATRIX DATUM-INDEX)
    (LET ((N-CLASS (FOREST-N-CLASS FOREST))
          (N-TREE (FOREST-N-TREE FOREST))
          (CLASS-COUNT-ARRAY (FOREST-CLASS-COUNT-ARRAY FOREST)))
      (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
               (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) DATAMATRIX CLASS-COUNT-ARRAY)
               (TYPE FIXNUM DATUM-INDEX N-CLASS N-TREE))
      (LOOP FOR I FIXNUM FROM 0 BELOW N-CLASS
            DO (SETF (AREF CLASS-COUNT-ARRAY I) 0.0))
      (DOLIST (DTREE (FOREST-DTREE-LIST FOREST))
        (LET ((DIST
               (NODE-CLASS-DISTRIBUTION
                (FIND-LEAF (DTREE-ROOT DTREE) DATAMATRIX DATUM-INDEX))))
          (DECLARE (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) DIST))
          (LOOP FOR I FIXNUM FROM 0 BELOW N-CLASS
                DO (INCF (AREF CLASS-COUNT-ARRAY I) (AREF DIST I)))))
      (LOOP FOR I FIXNUM FROM 0 BELOW N-CLASS
            DO (SETF (AREF CLASS-COUNT-ARRAY I)
                       (/ (AREF CLASS-COUNT-ARRAY I) N-TREE)))
      CLASS-COUNT-ARRAY))

[cl-random-forest/src/random-forest.lisp:730]
  (DEFUN PREDICT-FOREST (FOREST DATAMATRIX DATUM-INDEX)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE FOREST FOREST)
             (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) DATAMATRIX)
             (TYPE FIXNUM DATUM-INDEX))
    (LET ((DIST (CLASS-DISTRIBUTION-FOREST FOREST DATAMATRIX DATUM-INDEX)))
      (DECLARE (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) DIST))
      (ARGMAX DIST)))

[cl-random-forest/src/random-forest.lisp:739]
  (DEFUN TEST-FOREST (FOREST DATAMATRIX TARGET &KEY QUIET-P)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE FOREST FOREST)
             (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) DATAMATRIX)
             (TYPE (SIMPLE-ARRAY FIXNUM) TARGET))
    (LET ((N-CORRECT 0) (LEN (LENGTH TARGET)))
      (DECLARE (TYPE FIXNUM N-CORRECT LEN))
      (LOOP FOR I FIXNUM FROM 0 BELOW LEN
            DO (WHEN (= (PREDICT-FOREST FOREST DATAMATRIX I) (AREF TARGET I))
                 (INCF N-CORRECT)))
      (CALC-ACCURACY N-CORRECT LEN :QUIET-P QUIET-P)))

[cl-random-forest/src/random-forest.lisp:773]
  (DEFUN MAKE-REFINE-VECTOR (FOREST DATAMATRIX DATUM-INDEX)
    (LET ((INDEX-OFFSET (FOREST-INDEX-OFFSET FOREST))
          (N-TREE (FOREST-N-TREE FOREST)))
      (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
               (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) DATAMATRIX)
               (TYPE (SIMPLE-ARRAY FIXNUM) INDEX-OFFSET)
               (TYPE FIXNUM DATUM-INDEX N-TREE))
      (LET ((LEAF-INDEX-LIST
             (MAPCAR/PMAPCAR
              (LAMBDA (DTREE)
                (LET ((NODE
                       (FIND-LEAF (DTREE-ROOT DTREE) DATAMATRIX DATUM-INDEX)))
                  (NODE-LEAF-INDEX NODE)))
              (FOREST-DTREE-LIST FOREST))))
        (LET ((SV-INDEX
               (MAKE-ARRAY (FOREST-N-TREE FOREST) :ELEMENT-TYPE 'FIXNUM))
              (SV-VAL
               (MAKE-ARRAY (FOREST-N-TREE FOREST) :ELEMENT-TYPE 'SINGLE-FLOAT
                           :INITIAL-ELEMENT 1.0)))
          (DECLARE (TYPE (SIMPLE-ARRAY FIXNUM) SV-INDEX)
                   (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) SV-VAL))
          (LOOP FOR I FIXNUM FROM 0 BELOW N-TREE
                FOR INDEX FIXNUM IN LEAF-INDEX-LIST
                DO (SETF (AREF SV-INDEX I) (+ INDEX (AREF INDEX-OFFSET I))))
          (#S(FORMGREP:SYMREF
              :NAME "MAKE-SPARSE-VECTOR"
              :QUALIFIER "CLOL.VECTOR")
           SV-INDEX SV-VAL)))))

[cl-random-forest/src/random-forest.lisp:831]
  (DEFUN MAKE-REFINE-DATASET (FOREST DATAMATRIX)
    (LET ((INDEX-OFFSET (FOREST-INDEX-OFFSET FOREST))
          (LEN (ARRAY-DIMENSION DATAMATRIX 0))
          (N-TREE (FOREST-N-TREE FOREST)))
      (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
               (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) DATAMATRIX)
               (TYPE (SIMPLE-ARRAY FIXNUM) INDEX-OFFSET)
               (TYPE FIXNUM LEN N-TREE))
      (LET ((REFINE-DATASET (MAKE-ARRAY LEN)))
        (LOOP FOR I FROM 0 BELOW LEN
              DO (SETF (AREF REFINE-DATASET I)
                         (MAKE-ARRAY N-TREE :ELEMENT-TYPE 'FIXNUM)))
        (MAPC/PMAPC
         (LAMBDA (DTREE)
           (LET* ((TREE-ID (DTREE-ID DTREE))
                  (OFFSET (AREF INDEX-OFFSET TREE-ID)))
             (DECLARE (TYPE FIXNUM TREE-ID OFFSET))
             (LOOP FOR I FIXNUM FROM 0 BELOW LEN
                   DO (LET ((LEAF-INDEX
                             (NODE-LEAF-INDEX
                              (FIND-LEAF (DTREE-ROOT DTREE) DATAMATRIX I)))
                            (REFINE-DATUM (SVREF REFINE-DATASET I)))
                        (DECLARE (TYPE FIXNUM LEAF-INDEX)
                                 (TYPE (SIMPLE-ARRAY FIXNUM) REFINE-DATUM))
                        (SETF (AREF REFINE-DATUM TREE-ID)
                                (+ LEAF-INDEX OFFSET)))))
           (FORMAT T ".")
           (FORCE-OUTPUT))
         (FOREST-DTREE-LIST FOREST))
        (TERPRI)
        REFINE-DATASET)))

[cl-random/src/mt19337-generator.lisp:182]
  (DEFMETHOD NEXT-CHUNK ((RNG MT19937))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET* ((STATE (STATE RNG)) (K (AREF STATE 2)))
      (DECLARE (TYPE (MOD 628) K))
      (WHEN (= K +MT19937-N+) (RANDOM-MT19937-UPDATE STATE) (SETF K 0))
      (SETF (AREF STATE 2) (1+ K))
      (LET ((Y (AREF STATE (+ 3 K))))
        (DECLARE (TYPE (UNSIGNED-BYTE 32) Y))
        (SETF Y (LOGXOR Y (ASH Y -11)))
        (SETF Y (LOGXOR Y (ASH (LOGAND Y (ASH +MT19937-B+ -7)) 7)))
        (SETF Y (LOGXOR Y (ASH (LOGAND Y (ASH +MT19937-C+ -15)) 15)))
        (SETF Y (LOGXOR Y (ASH Y -18)))
        Y)))

[cl-random/src/mt19337-generator.lisp:199]
  (DEFUN RANDOM-MT19937-UPDATE (STATE)
    (DECLARE
     (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 32) (+MT19937-STATE-LENGTH+)) STATE)
     (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((Y 0))
      (DECLARE (TYPE (UNSIGNED-BYTE 32) Y))
      (DO ((KK 3 (1+ KK)))
          ((>= KK (+ 3 (- +MT19937-N+ +MT19937-M+))))
        (DECLARE (TYPE (MOD 628) KK))
        (SETF Y
                (LOGIOR (LOGAND (AREF STATE KK) +MT19937-UPPER-MASK+)
                        (LOGAND (AREF STATE (1+ KK)) +MT19937-LOWER-MASK+)))
        (SETF (AREF STATE KK)
                (LOGXOR (AREF STATE (+ KK +MT19937-M+)) (ASH Y -1)
                        (AREF STATE (LOGAND Y 1)))))
      (DO ((KK (+ (- +MT19937-N+ +MT19937-M+) 3) (1+ KK)))
          ((>= KK (+ (1- +MT19937-N+) 3)))
        (DECLARE (TYPE (MOD 628) KK))
        (SETF Y
                (LOGIOR (LOGAND (AREF STATE KK) +MT19937-UPPER-MASK+)
                        (LOGAND (AREF STATE (1+ KK)) +MT19937-LOWER-MASK+)))
        (SETF (AREF STATE KK)
                (LOGXOR (AREF STATE (+ KK (- +MT19937-M+ +MT19937-N+)))
                        (ASH Y -1) (AREF STATE (LOGAND Y 1)))))
      (SETF Y
              (LOGIOR
               (LOGAND (AREF STATE (+ 3 (1- +MT19937-N+)))
                       +MT19937-UPPER-MASK+)
               (LOGAND (AREF STATE 3) +MT19937-LOWER-MASK+)))
      (SETF (AREF STATE (+ 3 (1- +MT19937-N+)))
              (LOGXOR (AREF STATE (+ 3 (1- +MT19937-M+))) (ASH Y -1)
                      (AREF STATE (LOGAND Y 1)))))
    (VALUES))

[cl-random/src/univariate.lisp:97]
  (DEFUN DRAW-STANDARD-NORMAL (&KEY (RNG *RANDOM-STATE*))
    "Draw a random number from N(0,1)."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (MUFFLE-CONDITIONS COMPILER-NOTE))
    (TAGBODY
     TOP
      (LET* ((U (NEXT 1.0d0 RNG))
             (V (* 1.7156d0 (- (NEXT 1.0d0 RNG) 0.5d0)))
             (X (- U 0.449871d0))
             (Y (+ (ABS V) 0.386595d0))
             (Q (+ (EXPT X 2) (* Y (- (* 0.196d0 Y) (* 0.25472d0 X))))))
        (IF (AND (> Q 0.27597d0)
                 (OR (> Q 0.27846d0)
                     (PLUSP (+ (EXPT V 2) (* 4 (EXPT U 2) (LOG U))))))
            (GO TOP)
            (RETURN-FROM DRAW-STANDARD-NORMAL (/ V U))))))

[cl-rfc4251/src/encoder.lisp:60]
  (DEFMETHOD ENCODE ((TYPE (EQL :UINT16-BE)) VALUE STREAM &KEY)
    "Encode an unsigned 16-bit integer in big-endian byte order"
    (DECLARE (TYPE (UNSIGNED-BYTE 16) VALUE))
    (DECLARE (OPTIMIZE (SAFETY 3)))
    (ENCODE :RAW-BYTES (ENCODE-INT-BE VALUE :ADD-SIGN NIL :MIN-BYTES 2) STREAM))

[cl-rfc4251/src/encoder.lisp:66]
  (DEFMETHOD ENCODE ((TYPE (EQL :UINT16-LE)) VALUE STREAM &KEY)
    "Encode an unsigned 16-bit integer in little-endian byte order"
    (DECLARE (TYPE (UNSIGNED-BYTE 16) VALUE))
    (DECLARE (OPTIMIZE (SAFETY 3)))
    (ENCODE :RAW-BYTES (ENCODE-INT-LE VALUE :ADD-SIGN NIL :MIN-BYTES 2) STREAM))

[cl-rfc4251/src/encoder.lisp:76]
  (DEFMETHOD ENCODE ((TYPE (EQL :UINT32-BE)) VALUE STREAM &KEY)
    "Encode an unsigned 32-bit integer in big-endian byte order"
    (DECLARE (TYPE (UNSIGNED-BYTE 32) VALUE))
    (DECLARE (OPTIMIZE (SAFETY 3)))
    (ENCODE :RAW-BYTES (ENCODE-INT-BE VALUE :ADD-SIGN NIL :MIN-BYTES 4) STREAM))

[cl-rfc4251/src/encoder.lisp:82]
  (DEFMETHOD ENCODE ((TYPE (EQL :UINT32-LE)) VALUE STREAM &KEY)
    "Encode an unsigned 32-bit integer in little-endian byte order"
    (DECLARE (TYPE (UNSIGNED-BYTE 32) VALUE))
    (DECLARE (OPTIMIZE (SAFETY 3)))
    (ENCODE :RAW-BYTES (ENCODE-INT-LE VALUE :ADD-SIGN NIL :MIN-BYTES 4) STREAM))

[cl-rfc4251/src/encoder.lisp:92]
  (DEFMETHOD ENCODE ((TYPE (EQL :UINT64-BE)) VALUE STREAM &KEY)
    "Encode an unsigned 64-bit integer in big-endian byte order"
    (DECLARE (TYPE (UNSIGNED-BYTE 64) VALUE))
    (DECLARE (OPTIMIZE (SAFETY 3)))
    (ENCODE :RAW-BYTES (ENCODE-INT-BE VALUE :ADD-SIGN NIL :MIN-BYTES 8) STREAM))

[cl-rfc4251/src/encoder.lisp:98]
  (DEFMETHOD ENCODE ((TYPE (EQL :UINT64-LE)) VALUE STREAM &KEY)
    "Encode an unsigned 64-bit integer in little-endian byte order"
    (DECLARE (TYPE (UNSIGNED-BYTE 64) VALUE))
    (DECLARE (OPTIMIZE (SAFETY 3)))
    (ENCODE :RAW-BYTES (ENCODE-INT-LE VALUE :ADD-SIGN NIL :MIN-BYTES 8) STREAM))

[cl-shlex/shlex.lisp:170]
  (DEFUN FIND-SORTED (CHAR STRING)
    "Find CHAR in STRING, a sorted string, by bisection."
    (DECLARE ((SIMPLE-ARRAY CHARACTER (*)) STRING)
             (OPTIMIZE SPEED (SAFETY 1)))
    (AND (CHARACTERP CHAR)
         (LET* ((LEN (LENGTH STRING)))
           (IF (< LEN 5)
               (IF (< LEN 2)
                   (IF (ZEROP LEN)
                       NIL
                       (CHAR= (AREF STRING 0) CHAR))
                   (FIND CHAR STRING))
               (LET ((IDX (BISECT-LEFT STRING CHAR #'CHAR<)))
                 (AND (< IDX (LENGTH STRING))
                      (CHAR= CHAR (AREF STRING IDX))))))))

[cl-shlex/shlex.lisp:398]
  (DEFSUBST SAFE-CHAR? (CHAR)
   (DECLARE (OPTIMIZE SPEED (SAFETY 1))
            (TYPE (SIMPLE-ARRAY BIT (128)) SAFE-CHAR-MAP))
   (LET ((CODE (CHAR-CODE CHAR)))
     (AND (< CODE 128) (EQL 1 (AREF SAFE-CHAR-MAP CODE)))))

[cl-speedy-queue/cl-speedy-queue.lisp:46]
  (DEFMACRO DEFINE-SPEEDY-FUNCTION (NAME ARGS &BODY BODY)
    (ECLECTOR.READER:QUASIQUOTE
     (PROGN
      (DECLAIM (INLINE (ECLECTOR.READER:UNQUOTE NAME)))
      (DEFUN (ECLECTOR.READER:UNQUOTE NAME) (ECLECTOR.READER:UNQUOTE ARGS)
        (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
        (ECLECTOR.READER:UNQUOTE-SPLICING BODY)))))

[cl-store/circularities.lisp:136]
  (DEFMETHOD BACKEND-STORE ((BACKEND RESOLVING-BACKEND) (PLACE STREAM) (OBJ T))
    "Store OBJ into PLACE. Does the setup for counters and seen values."
    (DECLARE (OPTIMIZE SPEED (SAFETY 1) (DEBUG 0)))
    (LET ((*STORED-COUNTER* 0) (*STORED-VALUES* (GET-STORE-HASH)))
      (STORE-BACKEND-CODE BACKEND PLACE)
      (BACKEND-STORE-OBJECT BACKEND OBJ PLACE)
      OBJ))

[cl-store/circularities.lisp:145]
  (DEFUN SEEN (OBJ)
    "Has this object already been stored?"
    (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
    (INCF *STORED-COUNTER*)
    (GETHASH OBJ *STORED-VALUES*))

[cl-store/circularities.lisp:151]
  (DEFUN UPDATE-SEEN (OBJ)
    "Register OBJ as having been stored."
    (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
    (SETF (GETHASH OBJ *STORED-VALUES*) *STORED-COUNTER*)
    NIL)

[cl-store/circularities.lisp:173]
  (DEFUN GET-REF (OBJ)
    (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
    (IF (NEEDS-CHECKP OBJ)
        (MULTIPLE-VALUE-BIND (VAL WIN)
            (SEEN OBJ)
          (IF (OR VAL WIN)
              VAL
              (UPDATE-SEEN OBJ)))
        NIL))

[cl-store/circularities.lisp:207]
  (DEFUN UPDATE-RESTORED (SPOT VAL)
    (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
    (SETF (GETHASH SPOT *RESTORED-VALUES*) VAL))

[cl-store/circularities.lisp:211]
  (DEFUN HANDLE-NORMAL (BACKEND READER PLACE)
    (DECLARE (OPTIMIZE SPEED (SAFETY 1) (DEBUG 0)))
    (LET ((SPOT (INCF *RESTORE-COUNTER*))
          (VALS (NEW-VAL (INTERNAL-RESTORE-OBJECT BACKEND READER PLACE))))
      (UPDATE-RESTORED SPOT VALS)
      VALS))

[cl-store/circularities.lisp:222]
  (DEFUN HANDLE-RESTORE (PLACE BACKEND)
    (DECLARE (OPTIMIZE SPEED (SAFETY 1) (DEBUG 0)))
    (LET ((READER (GET-NEXT-READER BACKEND PLACE)))
      (DECLARE (TYPE SYMBOL READER))
      (COND
       ((REFERRERP BACKEND READER) (INCF *RESTORE-COUNTER*)
        (NEW-VAL (INTERNAL-RESTORE-OBJECT BACKEND READER PLACE)))
       ((NOT (INT-OR-CHAR-P BACKEND READER))
        (HANDLE-NORMAL BACKEND READER PLACE))
       (T (NEW-VAL (INTERNAL-RESTORE-OBJECT BACKEND READER PLACE))))))

[cl-store/circularities.lisp:234]
  (DEFMETHOD BACKEND-RESTORE-OBJECT ((BACKEND RESOLVING-BACKEND) (PLACE T))
    "Retrieve a object from PLACE, does housekeeping for circularity fixing."
    (DECLARE (OPTIMIZE SPEED (SAFETY 1) (DEBUG 0)))
    (IF *CHECK-FOR-CIRCS*
        (HANDLE-RESTORE PLACE BACKEND)
        (CALL-NEXT-METHOD)))

[cl-store/circularities.lisp:253]
  (DEFUN NEW-VAL (VAL)
    "Tries to get a referred value to reduce unnecessary cirularity fixing."
    (DECLARE (OPTIMIZE SPEED (SAFETY 1) (DEBUG 0)))
    (IF (REFERRER-P VAL)
        (MULTIPLE-VALUE-BIND (NEW-VAL WIN)
            (REFERRED-VALUE VAL *RESTORED-VALUES*)
          (IF (OR NEW-VAL WIN)
              NEW-VAL
              VAL))
        VAL))

[cl-store/default-backend.lisp:80]
  (DEFMETHOD REFERRERP ((BACKEND CL-STORE) (READER T))
    (DECLARE (OPTIMIZE SPEED (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (EQL READER 'REFERRER))

[cl-store/default-backend.lisp:89]
  (DEFUN LOOKUP-CODE (CODE)
    (DECLARE (OPTIMIZE SPEED (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (GETHASH CODE *RESTORERS*))

[cl-store/default-backend.lisp:93]
  (DEFMETHOD GET-NEXT-READER ((BACKEND CL-STORE) (STREAM STREAM))
    (DECLARE (OPTIMIZE SPEED (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LET ((TYPE-CODE (READ-TYPE-CODE STREAM)))
      (OR (LOOKUP-CODE TYPE-CODE)
          (ERROR "Type code ~A is not registered." TYPE-CODE))))

[cl-store/default-backend.lisp:127]
  (DEFMETHOD INT-OR-CHAR-P ((BACKEND CL-STORE) (TYPE SYMBOL))
    (DECLARE (OPTIMIZE SPEED (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (FIND TYPE '(32-BIT-INTEGER INTEGER CHARACTER T-OBJECT NIL-OBJECT)))

[cl-store/default-backend.lisp:131]
  (DEFSTORE-CL-STORE (OBJ INTEGER STREAM)
   (DECLARE (OPTIMIZE SPEED (SAFETY 1) (DEBUG 0)))
   (IF (TYPEP OBJ 'SB32)
       (STORE-32-BIT-INTEGER OBJ STREAM)
       (STORE-ARBITRARY-INTEGER OBJ STREAM)))

[cl-store/default-backend.lisp:137]
  (DEFUN DUMP-INT (OBJ STREAM)
    (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
    (ETYPECASE OBJ
      ((UNSIGNED-BYTE 8) (WRITE-BYTE 1 STREAM) (WRITE-BYTE OBJ STREAM))
      ((UNSIGNED-BYTE 32) (WRITE-BYTE 2 STREAM) (STORE-32-BIT OBJ STREAM))))

[cl-store/default-backend.lisp:143]
  (DEFUN UNDUMP-INT (STREAM)
    (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
    (ECASE (READ-BYTE STREAM)
      (1 (READ-BYTE STREAM))
      (2 (READ-32-BIT STREAM NIL))))

[cl-store/default-backend.lisp:149]
  (DEFUN STORE-32-BIT-INTEGER (OBJ STREAM)
    (DECLARE (OPTIMIZE SPEED (SAFETY 1) (DEBUG 0))
             (TYPE SB32 OBJ))
    (OUTPUT-TYPE-CODE +32-BIT-INTEGER-CODE+ STREAM)
    (WRITE-BYTE
     (IF (MINUSP OBJ)
         1
         0)
     STREAM)
    (DUMP-INT (ABS OBJ) STREAM))

[cl-store/default-backend.lisp:155]
  (DEFRESTORE-CL-STORE (32-BIT-INTEGER STREAM)
   (DECLARE (OPTIMIZE SPEED (SAFETY 1) (DEBUG 0)))
   (FUNCALL
    (IF (ZEROP (THE FIXNUM (READ-BYTE STREAM)))
        #'+
        #'-)
    (UNDUMP-INT STREAM)))

[cl-store/default-backend.lisp:391]
  (DEFRESTORE-CL-STORE (CONS STREAM)
   (DECLARE (OPTIMIZE SPEED (SAFETY 1) (DEBUG 0)))
   (LET* ((CONSES (RESTORE-OBJECT STREAM)) (RET NIL) (TAIL RET))
     (DOTIMES (X CONSES)
       (LET ((OBJ (RESTORE-OBJECT STREAM)))
         (WHEN (AND *CHECK-FOR-CIRCS* (REFERRER-P OBJ))
           (LET ((X X))
             (PUSH
              (DELAY (SETF (NTH X RET) (REFERRED-VALUE OBJ *RESTORED-VALUES*)))
              *NEED-TO-FIX*)))
         (IF RET
             (SETF (CDR TAIL) (LIST OBJ)
                   TAIL (CDR TAIL))
             (SETF RET (LIST OBJ)
                   TAIL (LAST RET)))))
     (LET ((LAST1 (RESTORE-OBJECT STREAM)))
       (IF (AND *CHECK-FOR-CIRCS* (REFERRER-P LAST1))
           (PUSH
            (DELAY (SETF (CDR TAIL) (REFERRED-VALUE LAST1 *RESTORED-VALUES*)))
            *NEED-TO-FIX*)
           (SETF (CDR TAIL) LAST1)))
     RET))

[cl-store/default-backend.lisp:587]
  (DEFSTORE-CL-STORE (OBJ ARRAY STREAM)
   (DECLARE (OPTIMIZE SPEED (SAFETY 1) (DEBUG 0)))
   (TYPECASE OBJ
     (SIMPLE-BASE-STRING (STORE-SIMPLE-BASE-STRING OBJ STREAM))
     (SIMPLE-STRING (STORE-SIMPLE-STRING OBJ STREAM))
     (SIMPLE-VECTOR (STORE-SIMPLE-VECTOR OBJ STREAM))
     ((SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*))
      (STORE-SIMPLE-BYTE-VECTOR OBJ STREAM))
     (T (STORE-ARRAY OBJ STREAM))))

[cl-store/default-backend.lisp:597]
  (DEFUN STORE-ARRAY (OBJ STREAM)
    (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0))
             (TYPE ARRAY OBJ))
    (OUTPUT-TYPE-CODE +ARRAY-CODE+ STREAM)
    (IF (AND (= (ARRAY-RANK OBJ) 1) (ARRAY-HAS-FILL-POINTER-P OBJ))
        (STORE-OBJECT (FILL-POINTER OBJ) STREAM)
        (STORE-OBJECT NIL STREAM))
    (STORE-OBJECT (ARRAY-ELEMENT-TYPE OBJ) STREAM)
    (STORE-OBJECT (ADJUSTABLE-ARRAY-P OBJ) STREAM)
    (STORE-OBJECT (ARRAY-DIMENSIONS OBJ) STREAM)
    (DOLIST (X (MULTIPLE-VALUE-LIST (ARRAY-DISPLACEMENT OBJ)))
      (STORE-OBJECT X STREAM))
    (STORE-OBJECT (ARRAY-TOTAL-SIZE OBJ) STREAM)
    (LOOP FOR X FROM 0 BELOW (ARRAY-TOTAL-SIZE OBJ)
          DO (STORE-OBJECT (ROW-MAJOR-AREF OBJ X) STREAM)))

[cl-store/default-backend.lisp:617]
  (DEFRESTORE-CL-STORE (ARRAY STREAM)
   (DECLARE (OPTIMIZE SPEED (SAFETY 1) (DEBUG 0)))
   (LET* ((FILL-POINTER (RESTORE-OBJECT STREAM))
          (ELEMENT-TYPE (RESTORE-OBJECT STREAM))
          (ADJUSTABLE (RESTORE-OBJECT STREAM))
          (DIMENSIONS (RESTORE-OBJECT STREAM))
          (DISPLACED-TO (RESTORE-OBJECT STREAM))
          (DISPLACED-OFFSET (RESTORE-OBJECT STREAM))
          (SIZE (RESTORE-OBJECT STREAM))
          (RES
           (MAKE-ARRAY DIMENSIONS :ELEMENT-TYPE ELEMENT-TYPE :ADJUSTABLE
                       ADJUSTABLE :FILL-POINTER FILL-POINTER)))
     (DECLARE (TYPE CONS DIMENSIONS)
              (TYPE ARRAY-TOT-SIZE SIZE))
     (WHEN DISPLACED-TO
       (ADJUST-ARRAY RES DIMENSIONS :DISPLACED-TO DISPLACED-TO
                     :DISPLACED-INDEX-OFFSET DISPLACED-OFFSET))
     (RESOLVING-OBJECT (OBJ RES)
      (LOOP FOR X FROM 0 BELOW SIZE
            DO (LET ((POS X))
                 (SETTING (ROW-MAJOR-AREF OBJ POS) (RESTORE-OBJECT STREAM)))))))

[cl-store/default-backend.lisp:639]
  (DEFUN STORE-SIMPLE-VECTOR (OBJ STREAM)
    (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0))
             (TYPE SIMPLE-VECTOR OBJ))
    (OUTPUT-TYPE-CODE +SIMPLE-VECTOR-CODE+ STREAM)
    (STORE-OBJECT (LENGTH OBJ) STREAM)
    (LOOP FOR X ACROSS OBJ
          DO (STORE-OBJECT X STREAM)))

[cl-store/default-backend.lisp:647]
  (DEFRESTORE-CL-STORE (SIMPLE-VECTOR STREAM)
   (DECLARE (OPTIMIZE SPEED (SAFETY 1) (DEBUG 0)))
   (LET* ((SIZE (RESTORE-OBJECT STREAM)) (RES (MAKE-ARRAY SIZE)))
     (DECLARE (TYPE ARRAY-SIZE SIZE))
     (RESOLVING-OBJECT (OBJ RES)
      (DOTIMES (I SIZE)
        (LET ((X I))
          (SETTING (AREF OBJ X) (RESTORE-OBJECT STREAM)))))
     RES))

[cl-store/default-backend.lisp:660]
  (DEFUN STORE-SIMPLE-BYTE-VECTOR (OBJ STREAM)
    (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0))
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) OBJ))
    (OUTPUT-TYPE-CODE +SIMPLE-BYTE-VECTOR-CODE+ STREAM)
    (STORE-OBJECT (LENGTH OBJ) STREAM)
    (LOOP FOR X ACROSS OBJ
          DO (WRITE-BYTE X STREAM)))

[cl-store/default-backend.lisp:668]
  (DEFRESTORE-CL-STORE (SIMPLE-BYTE-VECTOR STREAM)
   (DECLARE (OPTIMIZE SPEED (SAFETY 1) (DEBUG 0)))
   (LET* ((SIZE (RESTORE-OBJECT STREAM))
          (RES (MAKE-ARRAY SIZE :ELEMENT-TYPE '(UNSIGNED-BYTE 8))))
     (DECLARE (TYPE ARRAY-SIZE SIZE))
     (RESOLVING-OBJECT (OBJ RES)
      (DOTIMES (I SIZE)
        (LET ((X I))
          (SETTING (AREF OBJ X) (READ-BYTE STREAM)))))
     RES))

[cl-store/default-backend.lisp:687]
  (DEFUN UNICODE-STRING-P (STRING)
    "An implementation specific test for a unicode string."
    (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0))
             (TYPE SIMPLE-STRING STRING))
    NIL
    (NOT
     (TYPEP STRING '#S(FORMGREP:SYMREF :NAME "8-BIT-STRING" :QUALIFIER "LW"))))

[cl-store/default-backend.lisp:695]
  (DEFUN STORE-SIMPLE-STRING (OBJ STREAM)
    (DECLARE (TYPE SIMPLE-STRING OBJ)
             (OPTIMIZE SPEED (SAFETY 1) (DEBUG 0)))
    (COND
     ((UNICODE-STRING-P OBJ) (OUTPUT-TYPE-CODE +UNICODE-STRING-CODE+ STREAM)
      (DUMP-STRING #'DUMP-INT OBJ STREAM))
     (T (OUTPUT-TYPE-CODE +SIMPLE-STRING-CODE+ STREAM)
      (DUMP-STRING #'WRITE-BYTE OBJ STREAM))))

[cl-store/default-backend.lisp:704]
  (DEFUN STORE-SIMPLE-BASE-STRING (OBJ STREAM)
    (DECLARE (TYPE SIMPLE-STRING OBJ)
             (OPTIMIZE SPEED (SAFETY 1) (DEBUG 0)))
    (COND
     ((UNICODE-STRING-P OBJ)
      (OUTPUT-TYPE-CODE +UNICODE-BASE-STRING-CODE+ STREAM)
      (DUMP-STRING #'DUMP-INT OBJ STREAM))
     (T (OUTPUT-TYPE-CODE +SIMPLE-BASE-STRING-CODE+ STREAM)
      (DUMP-STRING #'WRITE-BYTE OBJ STREAM))))

[cl-store/default-backend.lisp:713]
  (DEFUN DUMP-STRING (DUMPER OBJ STREAM)
    (DECLARE (SIMPLE-STRING OBJ)
             (FUNCTION DUMPER)
             (STREAM STREAM)
             (OPTIMIZE SPEED (SAFETY 1) (DEBUG 0)))
    (DUMP-INT (THE ARRAY-SIZE (LENGTH OBJ)) STREAM)
    (LOOP FOR X ACROSS OBJ
          DO (FUNCALL DUMPER (CHAR-CODE X) STREAM)))

[cl-store/default-backend.lisp:735]
  (DEFUN UNDUMP-STRING (READER TYPE STREAM)
    (DECLARE (TYPE FUNCTION READER)
             (TYPE STREAM STREAM)
             (OPTIMIZE SPEED (SAFETY 1) (DEBUG 0)))
    (LET* ((LENGTH (THE ARRAY-SIZE (UNDUMP-INT STREAM)))
           (RES (MAKE-STRING LENGTH :ELEMENT-TYPE TYPE)))
      (DECLARE (TYPE SIMPLE-STRING RES))
      (DOTIMES (X LENGTH)
        (SETF (SCHAR RES X) (CODE-CHAR (FUNCALL READER STREAM))))
      RES))

[cl-store/utils.lisp:112]
  (DEFUN STORE-32-BIT (OBJ STREAM)
    "Write OBJ down STREAM as a 32 bit integer."
    (DECLARE (OPTIMIZE SPEED (DEBUG 0) (SAFETY 0))
             (TYPE UB32 OBJ))
    (WRITE-BYTE (LDB (BYTE 8 0) OBJ) STREAM)
    (WRITE-BYTE (LDB (BYTE 8 8) OBJ) STREAM)
    (WRITE-BYTE (LDB (BYTE 8 16) OBJ) STREAM)
    (WRITE-BYTE (+ 0 (LDB (BYTE 8 24) OBJ)) STREAM))

[cl-store/utils.lisp:124]
  (DEFUN READ-32-BIT (BUF &OPTIONAL (SIGNED T))
    "Read a signed or unsigned byte off STREAM."
    (DECLARE (OPTIMIZE SPEED (DEBUG 0) (SAFETY 0)))
    (LET ((BYTE1 (READ-BYTE BUF))
          (BYTE2 (READ-BYTE BUF))
          (BYTE3 (READ-BYTE BUF))
          (BYTE4 (READ-BYTE BUF)))
      (DECLARE (TYPE (MOD 256) BYTE1 BYTE2 BYTE3 BYTE4))
      (LET ((RET (MAKE-UB32 BYTE4 BYTE3 BYTE2 BYTE1)))
        (IF (AND SIGNED (> BYTE1 127))
            (LOGIOR (ASH -1 32) RET)
            RET))))

[cl-string-match/contrib/ascii-strings.lisp:107]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (DECLAIM (OPTIMIZE SAFETY DEBUG)))

[cl-string-match/src/package.lisp:133]
  (DEFVAR *STANDARD-OPTIMIZE-SETTINGS*
    '(OPTIMIZE SAFETY DEBUG)
    "The standard optimize settings used by most declaration
expressions. Tuned for best performance by default, but when the
SM-DEBUG-ENABLED keyword is present in the *FEATURES* list, makes
debug and safety its priority at the expense of everything else.")

[cl-string-match/src/package.lisp:154]
  (DEFVAR *STANDARD-DEBUG-SETTINGS*
    '(OPTIMIZE SAFETY DEBUG)
    "The standard debug settings to be used in functions under development.")

[cl-tcod/tcod.lisp:30]
  (DECLAIM (OPTIMIZE (SPEED 0) (SAFETY 2) (DEBUG 3)))

[cl-variates/dev/poisson-random.lisp:21]
  (DEFUN POISSON-RANDOM* (GENERATOR TEST-MEAN)
    "Returns an integer valued floating point number that is a random
deviate drawn from a Poisson distribution of mean test-mean using the
generator as a source of uniform random deviates. The Poisson distribution
gives the probability of a the number m Poisson random processes ocuring in
a given interval of time."
    (DECLARE (OPTIMIZE (SPEED 3) (SPACE 1) (SAFETY 0) (DEBUG 0)))
    (FLET ((DO-IT (MEAN)
             (DECLARE (TYPE DOUBLE-FLOAT MEAN))
             (LET ((EM 0.0d0)
                   (I 0.0d0)
                   (Y 0.0d0)
                   (SQ 0.0d0)
                   (ALXM 0.0d0)
                   (G 0.0d0))
               (DECLARE (TYPE DOUBLE-FLOAT EM I Y SQ ALXM G))
               (IF (< MEAN 12.0d0)
                   (PROGN
                    (SETF G (EXP (- MEAN))
                          EM -1.0d0
                          I 1.0d0)
                    (DO ((DONE-ONCE? NIL T))
                        ((AND DONE-ONCE? (<= I G)))
                      (INCF EM)
                      (SETF I (* I (NEXT-ELEMENT GENERATOR)))))
                   (PROGN
                    (SETF SQ (SQRT (* 2.0d0 MEAN))
                          ALXM (LOG MEAN)
                          G (- (* MEAN ALXM) (GAMMA-LN (1+ MEAN))))
                    (DO ((DONE-ONCE-A? NIL T))
                        ((AND DONE-ONCE-A? (<= (NEXT-ELEMENT GENERATOR) I)))
                      (DO ((DONE-ONCE-B? NIL T))
                          ((AND DONE-ONCE-B? (>= EM 0.0d0)))
                        (SETF Y
                                (TAN
                                 (* (NEXT-ELEMENT GENERATOR)
                                    (COERCE PI 'DOUBLE-FLOAT)))
                              EM (+ MEAN (* Y SQ))))
                      (SETF EM (FLOAT (FLOOR EM) 1.0d0)
                            I
                              (* 0.9d0 (1+ (* Y Y))
                                 (EXP
                                  (- (* EM ALXM) (GAMMA-LN (1+ EM)) G)))))))
               EM)))
      (IF (TYPEP TEST-MEAN 'DOUBLE-FLOAT)
          (DO-IT TEST-MEAN)
          (DO-IT (COERCE TEST-MEAN 'DOUBLE-FLOAT)))))

[cl-vectors/aa-bin.lisp:42]
  (DEFUN MAP-LINE-INTERSECTIONS (FUNCTION X1 Y1 X2 Y2)
    (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
    (WHEN (/= Y1 Y2)
      (WHEN (> Y1 Y2) (ROTATEF Y1 Y2) (ROTATEF X1 X2))
      (LET ((DX (- X2 X1)) (DY (- Y2 Y1)))
        (LOOP FOR N FROM (* +CELL-WIDTH+ (CEILING Y1 +CELL-WIDTH+)) UPTO (*
                                                                          +CELL-WIDTH+
                                                                          (FLOOR
                                                                           (1-
                                                                            Y2)
                                                                           +CELL-WIDTH+)) BY +CELL-WIDTH+
              DO (FUNCALL FUNCTION (+ X1 (FLOOR (* DX (- N Y1)) DY)) N)))))

[cl-vectors/aa-misc.lisp:68]
  (DEFUN IMAGE-PUT-PIXEL
         (IMAGE
          &OPTIONAL (COLOR #(0 0 0)) (OPACITY 1.0)
          (ALPHA-FUNCTION :NORMALIZED))
    (CHECK-TYPE IMAGE (ARRAY OCTET (* * 3)))
    (LET ((WIDTH (IMAGE-WIDTH IMAGE)) (HEIGHT (IMAGE-HEIGHT IMAGE)))
      (CASE ALPHA-FUNCTION
        (:NORMALIZED (SETF ALPHA-FUNCTION #'ALPHA/NORMALIZED))
        (:EVEN-ODD (SETF ALPHA-FUNCTION #'ALPHA/EVEN-ODD)))
      (IF (/= OPACITY 1.0)
          (LAMBDA (X Y ALPHA)
            (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
            (WHEN (AND (<= 0 X (1- WIDTH)) (<= 0 Y (1- HEIGHT)))
              (LOOP FOR RGB BELOW 3
                    DO (SETF (AREF IMAGE Y X RGB)
                               (BLEND-VALUE (AREF IMAGE Y X RGB)
                                (AREF COLOR RGB)
                                (FLOOR
                                 (* OPACITY
                                    (FUNCALL ALPHA-FUNCTION ALPHA))))))))
          (LAMBDA (X Y ALPHA)
            (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
            (WHEN (AND (<= 0 X (1- WIDTH)) (<= 0 Y (1- HEIGHT)))
              (LOOP FOR RGB BELOW 3
                    DO (SETF (AREF IMAGE Y X RGB)
                               (BLEND-VALUE (AREF IMAGE Y X RGB)
                                (AREF COLOR RGB)
                                (FUNCALL ALPHA-FUNCTION ALPHA)))))))))

[cl-vectors/aa-misc.lisp:97]
  (DEFUN IMAGE-PUT-SPAN
         (IMAGE
          &OPTIONAL (COLOR #(0 0 0)) (OPACITY 1.0)
          (ALPHA-FUNCTION :NORMALIZED))
    (CHECK-TYPE IMAGE (ARRAY OCTET (* * 3)))
    (LET ((WIDTH (IMAGE-WIDTH IMAGE)) (HEIGHT (IMAGE-HEIGHT IMAGE)))
      (CASE ALPHA-FUNCTION
        (:NORMALIZED (SETF ALPHA-FUNCTION #'ALPHA/NORMALIZED))
        (:EVEN-ODD (SETF ALPHA-FUNCTION #'ALPHA/EVEN-ODD)))
      (IF (/= OPACITY 1.0)
          (LAMBDA (X1 X2 Y ALPHA)
            (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
            (WHEN (AND (< X1 WIDTH) (> X2 0) (<= 0 Y (1- HEIGHT)))
              (SETF ALPHA (FUNCALL ALPHA-FUNCTION ALPHA))
              (LOOP FOR X FROM (MAX 0 X1) BELOW (MIN X2 WIDTH)
                    DO (LOOP FOR RGB BELOW 3
                             DO (SETF (AREF IMAGE Y X RGB)
                                        (BLEND-VALUE (AREF IMAGE Y X RGB)
                                         (AREF COLOR RGB)
                                         (FLOOR (* OPACITY ALPHA))))))))
          (LAMBDA (X1 X2 Y ALPHA)
            (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
            (WHEN (AND (< X1 WIDTH) (> X2 0) (<= 0 Y (1- HEIGHT)))
              (SETF ALPHA (FUNCALL ALPHA-FUNCTION ALPHA))
              (LOOP FOR X FROM (MAX 0 X1) BELOW (MIN X2 WIDTH)
                    DO (LOOP FOR RGB BELOW 3
                             DO (SETF (AREF IMAGE Y X RGB)
                                        (BLEND-VALUE (AREF IMAGE Y X RGB)
                                         (AREF COLOR RGB) ALPHA)))))))))

[cl-vectors/aa.lisp:463]
  (DEFUN SCANLINE-SWEEP (SCANLINE FUNCTION FUNCTION-SPAN &KEY START END)
    "Call FUNCTION for each pixel on the polygon covered by
SCANLINE. The pixels are scanned in increasing X. The sweep can
be limited to a range by START (included) or/and END (excluded)."
    (DECLARE (OPTIMIZE SPEED (DEBUG 0) (SAFETY 0) (SPACE 2)))
    (LET ((COVER 0) (Y (SCANLINE-Y SCANLINE)) (CELLS SCANLINE) (LAST-X NIL))
      (WHEN START
        (LOOP WHILE (AND CELLS (< (CELL-X (CAR CELLS)) START))
              DO (INCF COVER (CELL-COVER (CAR CELLS))) (SETF LAST-X
                                                               (CELL-X
                                                                (CAR CELLS))
                                                             CELLS
                                                               (CDR CELLS))))
      (WHEN CELLS
        (DOLIST (CELL CELLS)
          (LET ((X (CELL-X CELL)))
            (WHEN (AND LAST-X (> X (1+ LAST-X)))
              (LET ((ALPHA (COMPUTE-ALPHA COVER 0)))
                (UNLESS (ZEROP ALPHA)
                  (LET ((START-X
                         (IF START
                             (MAX START (1+ LAST-X))
                             (1+ LAST-X)))
                        (END-X
                         (IF END
                             (MIN END X)
                             X)))
                    (IF FUNCTION-SPAN
                        (FUNCALL FUNCTION-SPAN START-X END-X Y ALPHA)
                        (LOOP FOR IX FROM START-X BELOW END-X
                              DO (FUNCALL FUNCTION IX Y ALPHA)))))))
            (WHEN (AND END (>= X END)) (RETURN))
            (INCF COVER (CELL-COVER CELL))
            (LET ((ALPHA (COMPUTE-ALPHA COVER (CELL-AREA CELL))))
              (UNLESS (ZEROP ALPHA) (FUNCALL FUNCTION X Y ALPHA)))
            (SETF LAST-X X))))))

[cl4l/cl4l.lisp:9]
  (DEFMACRO CL4L-OPTIMIZE (&KEY SPEED)
    (ECLECTOR.READER:QUASIQUOTE
     (LET* ((SPD (OR (ECLECTOR.READER:UNQUOTE SPEED) *CL4L-SPEED*))
            (DBG (- 3 SPD)))
       (DECLARE (TYPE FIXNUM SPD)
                (TYPE FIXNUM DBG))
       (ECLECTOR.READER:QUASIQUOTE
        (DECLARE
         (OPTIMIZE (SPEED (ECLECTOR.READER:UNQUOTE SPD))
          (SAFETY (ECLECTOR.READER:UNQUOTE DBG))
          (DEBUG (ECLECTOR.READER:UNQUOTE DBG))))))))

[cloakbuild/cloak/lisp/assembler.lisp:22]
  (DEFUN ASSEMBLE-CLASS
         (NAME SUPER &KEY INTERFACES FLAGS FIELDS METHODS ATTRIBUTES FILENAME)
    (DECLARE (OPTIMIZE (SAFETY 3)))
    (LET* ((*CONSTANTS* (MAKE-CONSTANT-POOL))
           (*BUFFER* (MAKE-OUTPUT-BUFFER))
           (THIS (PUT-CONSTANT :CLASS (PUT-CONSTANT :UTF8 NAME)))
           (SUPER (PUT-CONSTANT :CLASS (PUT-CONSTANT :UTF8 SUPER)))
           (INTERFACES
            (MAP 'VECTOR
                 (LAMBDA (I) (PUT-CONSTANT :CLASS (PUT-CONSTANT :STRING I)))
                 INTERFACES)))
      (MAP NIL #'ASSEMBLE-METHOD! METHODS)
      (LET ((*BUFFER* NIL))
        (EMIT* #'EMIT-FIELD-OR-METHOD FIELDS)
        (EMIT* #'EMIT-FIELD-OR-METHOD METHODS)
        (EMIT* #'EMIT-ATTRIBUTE ATTRIBUTES))
      (EMIT-INT 3405691582)
      (EMIT-SHORT (CDR *SMALLEST-SUPPORTED-VERSION*))
      (EMIT-SHORT (CAR *SMALLEST-SUPPORTED-VERSION*))
      (EMIT* #'EMIT-CONSTANT *CONSTANTS*)
      (EMIT-SHORT (ENCODE-CLASS-ACCESS-FLAGS FLAGS))
      (EMIT-SHORT THIS)
      (EMIT-SHORT SUPER)
      (EMIT* #'EMIT-SHORT INTERFACES)
      (EMIT* #'EMIT-FIELD-OR-METHOD FIELDS)
      (EMIT* #'EMIT-FIELD-OR-METHOD METHODS)
      (EMIT* #'EMIT-ATTRIBUTE ATTRIBUTES)
      (WHEN FILENAME
        (WITH-OPEN-FILE (S FILENAME :DIRECTION :OUTPUT :IF-EXISTS :RENAME)
          (WRITE-SEQUENCE *BUFFER* S)))
      *BUFFER*))

[cloakbuild/cloak/lisp/compiler.lisp:1751]
  (DEFUN TRANSLATE-CLASS-FILE (CF LISP-PATHNAME)
    (WITH-OPEN-FILE (S LISP-PATHNAME :DIRECTION :OUTPUT :IF-EXISTS :SUPERSEDE)
      (WRITE-LINE "(in-package :cloak)" S)
      (WRITE-LINE "(declaim (optimize sb-c::compute-debug-fun))" S)
      (FOR ((I :FROM 0) (METHOD :IN (CF.METHODS CF)))
       (UNLESS (CM.ABSTRACTP METHOD)
         (MULTIPLE-VALUE-BIND (FORM OPTIMIZEP)
             (IF (CM.NATIVEP METHOD)
                 (VALUES (FASL-TRANSLATE-NATIVE-METHOD CF METHOD I) T)
                 (FASL-TRANSLATE-NORMAL-METHOD CF METHOD I))
           (UNLESS (CM.NATIVEP METHOD)
             (SETF (CM.LINE-NUMBERS METHOD)
                     (BUILD-LINE-TABLE FORM (CM.LINE-NUMBERS METHOD))))
           (LET* ((*PACKAGE* (FIND-PACKAGE :CLOAK))
                  (FAST
                   '((SPEED 3) (SAFETY 0) (INHIBIT-WARNINGS 0)
                     (COMPILATION-SPEED 0)))
                  (SLOW
                   '((SPEED 1) (SAFETY 0) INHIBIT-WARNINGS COMPILATION-SPEED))
                  (POLICY
                   (IF OPTIMIZEP
                       FAST
                       SLOW)))
             (WRITE-SOURCE
              (ECLECTOR.READER:QUASIQUOTE
               (DECLAIM (OPTIMIZE (ECLECTOR.READER:UNQUOTE-SPLICING POLICY))))
              S)
             (WRITE-SOURCE FORM S)))))))

[cloakbuild/cloak/lisp/fndb.lisp:19]
  (DECLAIM
   (OPTIMIZE (SPEED 3) (SAFETY 0) (SB-C::RECOGNIZE-SELF-CALLS 0)
    (INHIBIT-WARNINGS 0)))

[cloakbuild/cloak/lisp/fns.lisp:19]
  (DECLAIM
   (OPTIMIZE (SPEED 3) (SAFETY 0) (SB-C::RECOGNIZE-SELF-CALLS 0)
    (INHIBIT-WARNINGS 0)))

[cloakbuild/cloak/lisp/fns.lisp:55]
  (DEFSUBST INT-TRUNCATE (A B)
   (DECLARE (TYPE (SIGNED-BYTE 32) A B)
            (OPTIMIZE (SPEED 3) (SAFETY 0)))
   (IF (AND (EQL B -1) (EQL A NIL))
       A
       (VALUES (THE (SIGNED-BYTE 32) (TRUNCATE A B)))))

[cloakbuild/cloak/lisp/fns.lisp:61]
  (DEFSUBST IREM (A B)
   (DECLARE (TYPE (SIGNED-BYTE 32) A B)
            (OPTIMIZE (SPEED 3) (SAFETY 0)))
   (IF (EQL B -1)
       0
       (NTH-VALUE 1 (THE (SIGNED-BYTE 32) (TRUNCATE A B)))))

[cloakbuild/cloak/lisp/fns.lisp:88]
  (DEFSUBST LONG-TRUNCATE (A B)
   (DECLARE (TYPE (SIGNED-BYTE 64) A B)
            (OPTIMIZE (SPEED 3) (SAFETY 0)))
   (IF (AND (EQL B -1) (EQL A NIL))
       A
       (VALUES (TRUNCATE64 A B))))

[cloakbuild/cloak/lisp/fnvops.lisp:19]
  (DECLAIM
   (OPTIMIZE (SPEED 3) (SAFETY 0) (SB-C::RECOGNIZE-SELF-CALLS 0)
    (INHIBIT-WARNINGS 0)))

[cloakbuild/cloak/lisp/jnidefs.lisp:499]
  (DECLAIM (OPTIMIZE (SPEED 3) (SAFETY 0)))

[cloakbuild/cloak/lisp/loader.lisp:303]
  (DEFUN %MAKE-CLOAK-OBJECT (CLASS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (MAYBE-INITIALIZE-CLASS CLASS)
    (%CLONE-OBJECT (CLS.PROTOTYPE CLASS)))

[cloakbuild/cloak/lisp/native/VMObject.lisp:3]
  (DEFUN FAST-COPY-STRUCTURE (STRUCTURE)
    (DECLARE (TYPE STRUCTURE-OBJECT STRUCTURE)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET* ((LEN (SB-KERNEL:%INSTANCE-LENGTH STRUCTURE))
           (RES (SB-KERNEL:%MAKE-INSTANCE LEN)))
      (DECLARE (TYPE FIXNUM LEN))
      (SETF (SB-KERNEL:%INSTANCE-LAYOUT RES)
              (SB-KERNEL:%INSTANCE-LAYOUT STRUCTURE))
      (DOTIMES (I (1- LEN))
        (DECLARE (TYPE FIXNUM I))
        (SETF (SB-KERNEL:%RAW-INSTANCE-REF/WORD RES I)
                (SB-KERNEL:%RAW-INSTANCE-REF/WORD STRUCTURE I)))
      RES))

[cloakbuild/cloak/lisp/native/VMObject.lisp:17]
  (DEFUN %CLONE-OBJECT (C)
    (DECLARE (TYPE STRUCTURE-OBJECT C)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((RESULT (FAST-COPY-STRUCTURE C)))
      (SETF (CO.MONITOR RESULT) 0)
      (SETF (CO.HASH-CODE RESULT) (GENERATE-HASH-CODE))
      RESULT))

[cloakbuild/cloak/lisp/native/VMThread.lisp:109]
  (DEFUN ENTER-OBJECT-MONITOR (OBJECT)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((ID *THREAD-ID*))
      (WHEN (ZEROP (%CMPXCHG OBJECT 2 0 ID))
        (LET ((THING (CO.MONITOR OBJECT)))
          (COND ((NOT (TYPEP THING 'FIXNUM)) (ENTER-MONITOR THING))
                ((EQL (LOGAND THING 65535) ID)
                 (IF (< THING 16777216)
                     (SETF (CO.MONITOR OBJECT) (+ THING 65536))
                     (SETF (CO.MONITOR OBJECT)
                             (MAKE-UPGRADED-MONITOR (+ 2 (ASH THING -16))))))
                (T
                 (LOOP (YIELD)
                       (IF (ZEROP (%CMPXCHG OBJECT 2 0 ID))
                           (LET ((THING (CO.MONITOR OBJECT)))
                             (WHEN (NOT (TYPEP THING 'FIXNUM))
                               (ENTER-MONITOR THING)
                               (RETURN)))
                           (LET ((FAT (MAKE-MONITOR)))
                             (ENTER-MONITOR FAT)
                             (SETF (CO.MONITOR OBJECT) FAT)
                             (RETURN))))))))))

[cloakbuild/cloak/lisp/native/VMThread.lisp:142]
  (DEFUN EXIT-OBJECT-MONITOR (OBJECT)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((ID *THREAD-ID*) (THING (CO.MONITOR OBJECT)))
      (COND ((EQ THING ID) (SETF (CO.MONITOR OBJECT) 0) T)
            ((NOT (TYPEP THING 'FIXNUM)) (EXIT-MONITOR THING))
            ((EQL (LOGAND THING 65535) ID)
             (SETF (CO.MONITOR OBJECT) (- THING 65536)) T)
            (T NIL))))

[cloakbuild/cloak/lisp/native/VMThrowable.lisp:54]
  (DECLAIM (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))

[cloakbuild/cloak/lisp/package.lisp:9]
  (DEFVAR #S(FORMGREP:SYMREF :NAME "*FAST*" :QUALIFIER "CLOAK")
    '(OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))

[cloakbuild/cloak/lisp/sbcl.lisp:91]
  (DEFUN ENCODE-PSEUDO-UTF-8 (UCS16 &OPTIONAL (START 0) (END (LENGTH UCS16)))
    (DECLARE (OPTIMIZE SPEED (SAFETY 0)))
    (WITH-OUTPUT-TO-STRING (S)
      (FLET ((ADD-BYTE (B)
               (DECLARE (TYPE (UNSIGNED-BYTE 8) B))
               (WRITE-CHAR (CODE-CHAR B) S)))
        (DECLARE (INLINE ADD-BYTE))
        (LOOP FOR I FROM START BELOW
              END
              FOR CODE = (ELT UCS16 I)
              DO (ECASE (SB-IMPL::CHAR-LEN-AS-UTF8 CODE)
                   (1 (ADD-BYTE CODE))
                   (2
                    (ADD-BYTE (LOGIOR 192 (LDB (BYTE 5 6) CODE)))
                    (ADD-BYTE (LOGIOR 128 (LDB (BYTE 6 0) CODE))))
                   (3
                    (ADD-BYTE (LOGIOR 224 (LDB (BYTE 4 12) CODE)))
                    (ADD-BYTE (LOGIOR 128 (LDB (BYTE 6 6) CODE)))
                    (ADD-BYTE (LOGIOR 128 (LDB (BYTE 6 0) CODE))))
                   (4
                    (ADD-BYTE (LOGIOR 240 (LDB (BYTE 3 18) CODE)))
                    (ADD-BYTE (LOGIOR 128 (LDB (BYTE 6 12) CODE)))
                    (ADD-BYTE (LOGIOR 128 (LDB (BYTE 6 6) CODE)))
                    (ADD-BYTE (LOGIOR 128 (LDB (BYTE 6 0) CODE)))))))))

[cloakbuild/cloak/lisp/sbcl.lisp:171]
  (PROGN
   (DECLAIM (INLINE YIELD))
   (DEFUN YIELD ()
     (DECLARE (OPTIMIZE SPEED (SAFETY 0)))
     (ALIEN-FUNCALL (EXTERN-ALIEN "sched_yield" #'INT))
     (VALUES)))

[cloakbuild/cloak/lisp/word.lisp:5]
  (DECLAIM
   (OPTIMIZE (SPEED 3) (SAFETY 0) (SB-C::RECOGNIZE-SELF-CALLS 0)
    (INHIBIT-WARNINGS 0)))

[cloakbuild/sb-regpair/arith.lisp:3]
  (DECLAIM
   (OPTIMIZE (SPEED 3) (SAFETY 0) (SB-C::RECOGNIZE-SELF-CALLS 0)
    (INHIBIT-WARNINGS 0)))

[cloakbuild/sb-regpair/boot.lisp:3]
  (DECLAIM
   (OPTIMIZE (SPEED 0) (SAFETY 3) (SB-C::RECOGNIZE-SELF-CALLS 0)
    (INHIBIT-WARNINGS 0)))

[cloakbuild/sb-regpair/move.lisp:3]
  (DECLAIM
   (OPTIMIZE (SPEED 3) (SAFETY 0) (SB-C::RECOGNIZE-SELF-CALLS 0)
    (INHIBIT-WARNINGS 0)))

[cloakbuild/sb-regpair/test.lisp:11]
  (DECLAIM (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0) (INHIBIT-WARNINGS 1)))

[cloakbuild/sb-regpair/test.lisp:75]
  (DEFTEST MISC.1
   (LET* ((FN1
           '(LAMBDA (C)
              (DECLARE (TYPE (INTEGER -2509539973275357 307138139370397) C))
              (DECLARE
               (OPTIMIZE (SPACE 2) (SAFETY 1) (SB-C:INSERT-STEP-CONDITIONS 0)
                (SPEED 3) (COMPILATION-SPEED 0) (DEBUG 2)))
              (MOD 536870911 C)))
          (FN2
           '(LAMBDA (C)
              (DECLARE (NOTINLINE MIN MOD))
              (DECLARE
               (OPTIMIZE (COMPILATION-SPEED 3) (DEBUG 0) (SPACE 2) (SAFETY 1)
                (SB-C:INSERT-STEP-CONDITIONS 0) (SPEED 3)))
              (MOD 536870911 C)))
          (VALS '(-139242990082387))
          (V1 (APPLY (COMPILE NIL FN1) VALS))
          (V2 (APPLY (COMPILE NIL FN2) VALS)))
     (IF (EQL V1 V2)
         :GOOD
         (LIST V1 V2)))
   :GOOD)

[cloakbuild/sb-regpair/test.lisp:106]
  (DEFTEST MISC.2
   (LET* ((FN1
           '(LAMBDA (A B C D)
              (DECLARE (TYPE (INTEGER -12753328152637 7095426891440) A))
              (DECLARE (TYPE (INTEGER -9360 80136811250778) B))
              (DECLARE (TYPE (INTEGER -4496778193 9477197336451) C))
              (DECLARE (TYPE (INTEGER 290 451008085731007426) D))
              (DECLARE (IGNORABLE A B C D))
              (DECLARE
               (OPTIMIZE (DEBUG 1) (SPACE 2) (COMPILATION-SPEED 1) (SPEED 3)
                (SAFETY 2) (SB-C:INSERT-STEP-CONDITIONS 0)))
              (REM (- C B C) -10)))
          (FN2
           '(LAMBDA (A B C D)
              (DECLARE (NOTINLINE MIN - REM))
              (DECLARE
               (OPTIMIZE (SPACE 2) (DEBUG 2) (SB-C:INSERT-STEP-CONDITIONS 0)
                (COMPILATION-SPEED 3) (SAFETY 2) (SPEED 2)))
              (REM (- C B C) -10)))
          (VALS
           '(2564632883841 76722715549658 3297591191825 117574508097306983))
          (V1 (APPLY (COMPILE NIL FN1) VALS))
          (V2 (APPLY (COMPILE NIL FN2) VALS)))
     (IF (EQL V1 V2)
         :GOOD
         (LIST V1 V2)))
   :GOOD)

[cloakbuild/sb-regpair/test.lisp:141]
  (DEFTEST MISC.3
   (LET* ((FN1
           '(LAMBDA (A B C D)
              (DECLARE (TYPE (INTEGER 14 20393469362751) A))
              (DECLARE (TYPE (INTEGER -6752 7409126) B))
              (DECLARE (TYPE (INTEGER -4377487038334041 -621584236252022) C))
              (DECLARE (TYPE (INTEGER -314725 479690) D))
              (DECLARE (IGNORABLE A B C D))
              (DECLARE
               (OPTIMIZE (SAFETY 3) (COMPILATION-SPEED 1)
                (SB-C:INSERT-STEP-CONDITIONS 0) (DEBUG 2) (SPACE 0) (SPEED 3)))
              (REM
               (IF (LDB-TEST (BYTE 15 0) C)
                   (LET* ((*S4* (MAKE-ARRAY NIL :INITIAL-ELEMENT 0)))
                     A)
                   B)
               (MIN -67 0))))
          (FN2
           '(LAMBDA (A B C D)
              (DECLARE (NOTINLINE MIN MAKE-ARRAY BYTE LDB-TEST REM))
              (DECLARE
               (OPTIMIZE (SPEED 1) (SPACE 1) (DEBUG 1) (SAFETY 0)
                (COMPILATION-SPEED 3) (SB-C:INSERT-STEP-CONDITIONS 0)))
              (REM
               (IF (LDB-TEST (BYTE 15 0) C)
                   (LET* ((*S4* (MAKE-ARRAY NIL :INITIAL-ELEMENT 0)))
                     A)
                   B)
               (MIN -67 0))))
          (VALS '(6000002766545 6210485 -683005776915248 180043))
          (V1 (APPLY (COMPILE NIL FN1) VALS))
          (V2 (APPLY (COMPILE NIL FN2) VALS)))
     (IF (EQL V1 V2)
         :GOOD
         (LIST V1 V2)))
   :GOOD)

[cloakbuild/sb-regpair/vm.lisp:3]
  (DECLAIM
   (OPTIMIZE (SPEED 3) (SAFETY 0) (SB-C::RECOGNIZE-SELF-CALLS 0)
    (INHIBIT-WARNINGS 0)))

[closer-mop/closer-allegro.lisp:26]
  (PROGN
   (DEFMETHOD SLOT-BOUNDP-USING-CLASS
              ((CLASS STANDARD-CLASS) OBJECT (SLOT SYMBOL))
     (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0) (COMPILATION-SPEED 0)))
     (LET ((SLOTD
            (FIND SLOT (CLASS-SLOTS CLASS) :TEST #'EQ :KEY
                  #'SLOT-DEFINITION-NAME)))
       (IF SLOTD
           (SLOT-BOUNDP-USING-CLASS CLASS OBJECT SLOTD)
           (SLOT-MISSING CLASS OBJECT SLOT 'SLOT-BOUNDP))))
   (DEFMETHOD SLOT-BOUNDP-USING-CLASS
              ((CLASS STANDARD-CLASS) OBJECT
               (SLOTD STANDARD-EFFECTIVE-SLOT-DEFINITION))
     (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0) (COMPILATION-SPEED 0)))
     (SLOT-BOUNDP-USING-CLASS
      (LOAD-TIME-VALUE (CLASS-PROTOTYPE (FIND-CLASS 'STANDARD-CLASS))) OBJECT
      (SLOT-DEFINITION-NAME SLOTD))))

[closer-mop/closer-allegro.lisp:47]
  (DEFMETHOD SLOT-MAKUNBOUND-USING-CLASS
             ((CLASS STANDARD-CLASS) OBJECT (SLOT SYMBOL))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0) (COMPILATION-SPEED 0)))
    (LET ((SLOTD
           (FIND SLOT (CLASS-SLOTS CLASS) :TEST #'EQ :KEY
                 #'SLOT-DEFINITION-NAME)))
      (IF SLOTD
          (SLOT-MAKUNBOUND-USING-CLASS CLASS OBJECT SLOTD)
          (SLOT-MISSING CLASS OBJECT SLOT 'SLOT-MAKUNBOUND))))

[closer-mop/closer-allegro.lisp:58]
  (DEFMETHOD SLOT-MAKUNBOUND-USING-CLASS
             ((CLASS STANDARD-CLASS) OBJECT
              (SLOTD STANDARD-EFFECTIVE-SLOT-DEFINITION))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0) (COMPILATION-SPEED 0)))
    (SLOT-MAKUNBOUND-USING-CLASS
     (LOAD-TIME-VALUE (CLASS-PROTOTYPE (FIND-CLASS 'STANDARD-CLASS))) OBJECT
     (SLOT-DEFINITION-NAME SLOTD)))

[closer-mop/closer-lispworks.lisp:150]
  (DEFUN FIND-SLOT (SLOT-NAME CLASS)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0) (COMPILATION-SPEED 0)))
    (LOOP FOR SLOT IN (CLASS-SLOTS CLASS)
          WHEN (EQ SLOT-NAME (SLOT-DEFINITION-NAME SLOT)) RETURN SLOT))

[closer-mop/closer-lispworks.lisp:157]
  (DEFMETHOD SLOT-VALUE-USING-CLASS
             ((CLASS STANDARD-CLASS) OBJECT (SLOT SYMBOL))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0) (COMPILATION-SPEED 0)))
    (LET ((SLOTD (FIND-SLOT SLOT CLASS)))
      (IF SLOTD
          (SLOT-VALUE-USING-CLASS CLASS OBJECT SLOTD)
          (SLOT-MISSING CLASS OBJECT SLOT 'SLOT-VALUE))))

[closer-mop/closer-lispworks.lisp:166]
  (DEFMETHOD SLOT-VALUE-USING-CLASS
             ((CLASS STANDARD-CLASS) OBJECT
              (SLOTD STANDARD-EFFECTIVE-SLOT-DEFINITION))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0) (COMPILATION-SPEED 0)))
    (SLOT-VALUE-USING-CLASS
     (LOAD-TIME-VALUE (CLASS-PROTOTYPE (FIND-CLASS 'STANDARD-CLASS))) OBJECT
     (SLOT-DEFINITION-NAME SLOTD)))

[closer-mop/closer-lispworks.lisp:175]
  (DEFMETHOD (SETF SLOT-VALUE-USING-CLASS)
             (NEW-VALUE (CLASS STANDARD-CLASS) OBJECT (SLOT SYMBOL))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0) (COMPILATION-SPEED 0)))
    (LET ((SLOTD (FIND-SLOT SLOT CLASS)))
      (IF SLOTD
          (SETF (SLOT-VALUE-USING-CLASS CLASS OBJECT SLOTD) NEW-VALUE)
          (SLOT-MISSING CLASS OBJECT SLOT 'SETF NEW-VALUE))))

[closer-mop/closer-lispworks.lisp:185]
  (DEFMETHOD (SETF SLOT-VALUE-USING-CLASS)
             (NEW-VALUE (CLASS STANDARD-CLASS) OBJECT
              (SLOTD STANDARD-EFFECTIVE-SLOT-DEFINITION))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0) (COMPILATION-SPEED 0)))
    (SETF (SLOT-VALUE-USING-CLASS
           (LOAD-TIME-VALUE (CLASS-PROTOTYPE (FIND-CLASS 'STANDARD-CLASS)))
           OBJECT (SLOT-DEFINITION-NAME SLOTD))
            NEW-VALUE))

[closer-mop/closer-lispworks.lisp:195]
  (DEFMETHOD SLOT-BOUNDP-USING-CLASS
             ((CLASS STANDARD-CLASS) OBJECT (SLOT SYMBOL))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0) (COMPILATION-SPEED 0)))
    (LET ((SLOTD (FIND-SLOT SLOT CLASS)))
      (IF SLOTD
          (SLOT-BOUNDP-USING-CLASS CLASS OBJECT SLOTD)
          (SLOT-MISSING CLASS OBJECT SLOT 'SLOT-BOUNDP))))

[closer-mop/closer-lispworks.lisp:204]
  (DEFMETHOD SLOT-BOUNDP-USING-CLASS
             ((CLASS STANDARD-CLASS) OBJECT
              (SLOTD STANDARD-EFFECTIVE-SLOT-DEFINITION))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0) (COMPILATION-SPEED 0)))
    (SLOT-BOUNDP-USING-CLASS
     (LOAD-TIME-VALUE (CLASS-PROTOTYPE (FIND-CLASS 'STANDARD-CLASS))) OBJECT
     (SLOT-DEFINITION-NAME SLOTD)))

[closer-mop/closer-lispworks.lisp:213]
  (DEFMETHOD SLOT-MAKUNBOUND-USING-CLASS
             ((CLASS STANDARD-CLASS) OBJECT (SLOT SYMBOL))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0) (COMPILATION-SPEED 0)))
    (LET ((SLOTD (FIND-SLOT SLOT CLASS)))
      (IF SLOTD
          (SLOT-MAKUNBOUND-USING-CLASS CLASS OBJECT SLOTD)
          (SLOT-MISSING CLASS OBJECT SLOT 'SLOT-MAKUNBOUND))))

[closer-mop/closer-lispworks.lisp:222]
  (DEFMETHOD SLOT-MAKUNBOUND-USING-CLASS
             ((CLASS STANDARD-CLASS) OBJECT
              (SLOTD STANDARD-EFFECTIVE-SLOT-DEFINITION))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0) (COMPILATION-SPEED 0)))
    (SLOT-MAKUNBOUND-USING-CLASS
     (LOAD-TIME-VALUE (CLASS-PROTOTYPE (FIND-CLASS 'STANDARD-CLASS))) OBJECT
     (SLOT-DEFINITION-NAME SLOTD)))

[closer-mop/closer-mop-shared.lisp:69]
  (PROGN
   (DEFCLASS STANDARD-GENERIC-FUNCTION (STANDARD-GENERIC-FUNCTION)
             ((ARGUMENT-ORDER :ACCESSOR ARGUMENT-ORDER))
             (:METACLASS
              #S(FORMGREP:SYMREF
                 :NAME "FUNCALLABLE-STANDARD-CLASS"
                 :QUALIFIER "CLOS"))
             (:DEFAULT-INITARGS :NAME (COPY-SYMBOL :NAME) :METHOD-CLASS
              (FIND-CLASS 'STANDARD-METHOD)))
   (PROGN
    (DEFGENERIC METHOD-FUNCTION
        (METHOD)
      (:METHOD ((METHOD METHOD))
       (#S(FORMGREP:SYMREF :NAME "METHOD-FUNCTION" :QUALIFIER "CCL") METHOD)))
    (DEFCLASS STANDARD-METHOD (STANDARD-METHOD)
              ((FN :INITARG :REAL-FUNCTION :READER METHOD-FUNCTION))))
   (DEFUN COMPUTE-ARGUMENT-ORDER (GF NOF-REQUIRED-ARGS)
     (LOOP WITH SPECIALIZED-COUNT = (MAKE-ARRAY NOF-REQUIRED-ARGS
                                                :INITIAL-ELEMENT 0)
           FOR METHOD IN (GENERIC-FUNCTION-METHODS GF)
           DO (LOOP FOR SPECIALIZER IN (METHOD-SPECIALIZERS METHOD)
                    FOR INDEX FROM 0
                    UNLESS (EQ SPECIALIZER (FIND-CLASS 'T))
                    DO (INCF (SVREF SPECIALIZED-COUNT INDEX)))
           FINALLY (LOOP FOR ARG IN (GENERIC-FUNCTION-ARGUMENT-PRECEDENCE-ORDER
                                     GF)
                         FOR POS = (POSITION ARG
                                             (GENERIC-FUNCTION-LAMBDA-LIST GF))
                         WHEN (> (SVREF SPECIALIZED-COUNT POS) 0)
                         COLLECT POS INTO ARGUMENT-ORDER
                         FINALLY (RETURN-FROM COMPUTE-ARGUMENT-ORDER
                                   (COERCE ARGUMENT-ORDER 'SIMPLE-VECTOR)))))
   (DEFUN PARSE-METHOD-BODY (BODY ERROR-FORM)
     (LOOP WITH DOCUMENTATION = NIL
           FOR (CAR . CDR) = BODY THEN CDR
           WHILE (OR (AND CDR (STRINGP CAR))
                     (AND (CONSP CAR) (EQ (CAR CAR) 'DECLARE)))
           IF (STRINGP CAR)
           DO (SETQ DOCUMENTATION
                      (IF (NULL DOCUMENTATION)
                          CAR
                          (WARN "Too many documentation strings in ~S."
                                ERROR-FORM))) ELSE
           APPEND (CDR CAR) INTO DECLARATIONS
           FINALLY (RETURN
                    (VALUES DOCUMENTATION DECLARATIONS (CONS CAR CDR)))))
   (DEFUN BLOCK-NAME (FUNCTION-NAME)
     (COND ((SYMBOLP FUNCTION-NAME) FUNCTION-NAME)
           ((AND (CONSP FUNCTION-NAME) (EQL (FIRST FUNCTION-NAME) 'SETF)
                 (CONSP (CDR FUNCTION-NAME)) (NULL (CDDR FUNCTION-NAME)))
            (SECOND FUNCTION-NAME))
           (T (ERROR "~S is not a valid function name." FUNCTION-NAME))))
   (DEFGENERIC COMPUTE-APPLICABLE-METHODS-USING-CLASSES
       (GENERIC-FUNCTION CLASSES)
     (:METHOD ((GF STANDARD-GENERIC-FUNCTION) CLASSES)
      (LABELS ((SUBCLASS* (SPEC1 SPEC2 ARG-SPEC)
                 (LET ((CPL (CLASS-PRECEDENCE-LIST ARG-SPEC)))
                   (DECLARE (TYPE LIST CPL))
                   (FIND SPEC2 (THE LIST (CDR (MEMBER SPEC1 CPL :TEST #'EQ)))
                         :TEST #'EQ)))
               (METHOD-MORE-SPECIFIC-P (M1 M2)
                 (DECLARE (TYPE METHOD M1 M2))
                 (LOOP FOR N OF-TYPE FIXNUM ACROSS (ARGUMENT-ORDER GF)
                       FOR SPEC1 = (NTH N (METHOD-SPECIALIZERS M1))
                       FOR SPEC2 = (NTH N (METHOD-SPECIALIZERS M2))
                       UNLESS (EQ SPEC1 SPEC2) RETURN (SUBCLASS* SPEC1 SPEC2
                                                       (NTH N CLASSES)))))
        (LET ((APPLICABLE-METHODS
               (SORT
                (LOOP FOR METHOD OF-TYPE METHOD IN (THE LIST
                                                        (GENERIC-FUNCTION-METHODS
                                                         GF))
                      WHEN (LOOP FOR CLASS IN CLASSES
                                 FOR SPECIALIZER IN (THE LIST
                                                         (METHOD-SPECIALIZERS
                                                          METHOD))
                                 IF (TYPEP SPECIALIZER 'EQL-SPECIALIZER)
                                 DO (WHEN
                                        (TYPEP
                                         (EQL-SPECIALIZER-OBJECT SPECIALIZER)
                                         CLASS)
                                      (RETURN-FROM
                                          COMPUTE-APPLICABLE-METHODS-USING-CLASSES
                                        (VALUES 'NIL NIL))) ELSE
                                 IF (NOT
                                     (SUBCLASSP CLASS SPECIALIZER)) RETURN NIL
                                 FINALLY (RETURN T))
                      COLLECT METHOD)
                #'METHOD-MORE-SPECIFIC-P)))
          (VALUES APPLICABLE-METHODS T)))))
   (DEFGENERIC COMPUTE-EFFECTIVE-METHOD-FUNCTION
       (GF EFFECTIVE-METHOD OPTIONS))
   (DEFGENERIC COMPUTE-EFFECTIVE-METHOD
       (GENERIC-FUNCTION COMBINATION METHODS))
   (DEFGENERIC COMPUTE-DISCRIMINATING-FUNCTION
       (GENERIC-FUNCTION))
   (DEFUN GET-EMF (GF ARGS NOF-REQUIRED-ARGS)
     (DECLARE (OPTIMIZE (SPEED 3) (SPACE 0) (COMPILATION-SPEED 0)))
     (LET ((APPLICABLE-METHODS
            (COMPUTE-APPLICABLE-METHODS GF (SUBSEQ ARGS 0 NOF-REQUIRED-ARGS))))
       (IF APPLICABLE-METHODS
           (MULTIPLE-VALUE-BIND (EFFECTIVE-METHOD OPTIONS)
               (COMPUTE-EFFECTIVE-METHOD GF
                (GENERIC-FUNCTION-METHOD-COMBINATION GF) APPLICABLE-METHODS)
             (COMPUTE-EFFECTIVE-METHOD-FUNCTION GF EFFECTIVE-METHOD OPTIONS))
           (LAMBDA (&REST ARGS) (APPLY #'NO-APPLICABLE-METHOD GF ARGS)))))
   (DEFUN GET-EMF-USING-CLASSES (GF ARGS CLASSES NOF-REQUIRED-ARGS)
     (DECLARE (TYPE GENERIC-FUNCTION GF)
              (TYPE LIST ARGS CLASSES)
              (OPTIMIZE (SPEED 3) (SPACE 0) (COMPILATION-SPEED 0)))
     (MULTIPLE-VALUE-BIND (APPLICABLE-METHODS VALIDP)
         (COMPUTE-APPLICABLE-METHODS-USING-CLASSES GF CLASSES)
       (UNLESS VALIDP
         (SETQ APPLICABLE-METHODS
                 (COMPUTE-APPLICABLE-METHODS GF
                                             (SUBSEQ ARGS 0
                                                     NOF-REQUIRED-ARGS))))
       (VALUES
        (IF APPLICABLE-METHODS
            (MULTIPLE-VALUE-BIND (EFFECTIVE-METHOD OPTIONS)
                (COMPUTE-EFFECTIVE-METHOD GF
                 (GENERIC-FUNCTION-METHOD-COMBINATION GF) APPLICABLE-METHODS)
              (COMPUTE-EFFECTIVE-METHOD-FUNCTION GF EFFECTIVE-METHOD OPTIONS))
            (LAMBDA (&REST ARGS) (APPLY #'NO-APPLICABLE-METHOD GF ARGS)))
        VALIDP)))
   (DEFVAR *STANDARD-GFS*
     (LIST #'COMPUTE-APPLICABLE-METHODS
           #'COMPUTE-APPLICABLE-METHODS-USING-CLASSES
           #'COMPUTE-EFFECTIVE-METHOD #'COMPUTE-EFFECTIVE-METHOD-FUNCTION
           #'GENERIC-FUNCTION-METHOD-CLASS #'MAKE-METHOD-LAMBDA
           #'COMPUTE-DISCRIMINATING-FUNCTION))
   (DEFUN ONLY-STANDARD-METHODS (GF &REST OTHER-GFS)
     (DECLARE (OPTIMIZE (SPEED 3) (SPACE 0) (COMPILATION-SPEED 0)))
     (LOOP FOR OTHER-GF IN (OR OTHER-GFS *STANDARD-GFS*)
           ALWAYS (LOOP FOR METHOD IN (GENERIC-FUNCTION-METHODS OTHER-GF)
                        FOR SPECIALIZER = (FIRST (METHOD-SPECIALIZERS METHOD))
                        IF (AND (TYPEP SPECIALIZER 'CLASS)
                                (SUBCLASSP SPECIALIZER
                                 (FIND-CLASS 'STANDARD-GENERIC-FUNCTION))
                                (NOT
                                 (EQ SPECIALIZER
                                     (FIND-CLASS 'STANDARD-GENERIC-FUNCTION)))
                                (TYPEP GF SPECIALIZER)) RETURN NIL ELSE
                        IF (AND (TYPEP SPECIALIZER 'EQL-SPECIALIZER)
                                (EQL (EQL-SPECIALIZER-OBJECT SPECIALIZER)
                                     GF)) RETURN NIL
                        FINALLY (RETURN T))))
   (DEFUN METHODS-ALL-THE-SAME-SPECIALIZERS (GF)
     (DECLARE (OPTIMIZE (SPEED 3) (SPACE 0) (COMPILATION-SPEED 0)))
     (LOOP WITH TEMPLATE = (FIRST (GENERIC-FUNCTION-METHODS GF))
           FOR METHOD IN (REST (GENERIC-FUNCTION-METHODS GF))
           ALWAYS (LOOP FOR SPEC1 IN (METHOD-SPECIALIZERS TEMPLATE)
                        FOR SPEC2 IN (METHOD-SPECIALIZERS METHOD)
                        ALWAYS (ETYPECASE SPEC1
                                 (CLASS
                                  (ETYPECASE SPEC2
                                    (CLASS (EQ SPEC1 SPEC2))
                                    (EQL-SPECIALIZER NIL)))
                                 (EQL-SPECIALIZER
                                  (ETYPECASE SPEC2
                                    (CLASS NIL)
                                    (EQL-SPECIALIZER
                                     (EQL (EQL-SPECIALIZER-OBJECT SPEC1)
                                          (EQL-SPECIALIZER-OBJECT
                                           SPEC2)))))))))
   (DEFUN COMPUTE-DISCRIMINATOR (GF COMPUTE-NATIVE-DISCRIMINATOR)
     (DECLARE (OPTIMIZE (SPEED 3) (SPACE 0) (COMPILATION-SPEED 0)))
     (LET ((NOF-REQUIRED-ARGS
            (LENGTH
             (REQUIRED-ARGS
              (HANDLER-CASE (GENERIC-FUNCTION-LAMBDA-LIST GF)
                            (UNBOUND-SLOT NIL
                             (RETURN-FROM COMPUTE-DISCRIMINATOR
                               (FUNCALL COMPUTE-NATIVE-DISCRIMINATOR)))))))
           DISCRIMINATOR)
       (SETF (ARGUMENT-ORDER GF) (COMPUTE-ARGUMENT-ORDER GF NOF-REQUIRED-ARGS))
       (FLET ((DISCRIMINATE
                  (EMF-SETTER ARGS
                   &OPTIONAL
                   (CLASSES
                    (LOOP FOR ARG IN ARGS
                          REPEAT NOF-REQUIRED-ARGS
                          COLLECT (CLASS-OF ARG))))
                (DECLARE (TYPE LIST ARGS CLASSES)
                         (TYPE FUNCTION EMF-SETTER))
                (MULTIPLE-VALUE-BIND (EMF VALIDP)
                    (GET-EMF-USING-CLASSES GF ARGS CLASSES NOF-REQUIRED-ARGS)
                  (FUNCALL EMF-SETTER
                           (IF VALIDP
                               EMF
                               (LAMBDA (&REST ARGS)
                                 (APPLY
                                  (THE FUNCTION
                                       (GET-EMF GF ARGS NOF-REQUIRED-ARGS))
                                  ARGS))))
                  (APPLY (THE FUNCTION EMF) ARGS))))
         (WHEN
             (ONLY-STANDARD-METHODS GF #'COMPUTE-APPLICABLE-METHODS
              #'COMPUTE-APPLICABLE-METHODS-USING-CLASSES)
           (SETQ DISCRIMINATOR
                   (IF (ONLY-STANDARD-METHODS GF #'COMPUTE-EFFECTIVE-METHOD
                        #'COMPUTE-EFFECTIVE-METHOD-FUNCTION
                        #'MAKE-METHOD-LAMBDA #'COMPUTE-DISCRIMINATING-FUNCTION)
                       (FUNCALL COMPUTE-NATIVE-DISCRIMINATOR)
                       (LET ((ARGUMENT-ORDER (ARGUMENT-ORDER GF)))
                         (COND
                          ((NULL (GENERIC-FUNCTION-METHODS GF))
                           (LAMBDA (&REST ARGS)
                             (APPLY #'NO-APPLICABLE-METHOD GF ARGS)))
                          ((METHODS-ALL-THE-SAME-SPECIALIZERS GF)
                           (LET ((SPECIALIZERS
                                  (METHOD-SPECIALIZERS
                                   (FIRST (GENERIC-FUNCTION-METHODS GF))))
                                 (EFFECTIVE-METHOD-FUNCTION NIL))
                             (DECLARE (TYPE LIST SPECIALIZERS))
                             (LAMBDA (&REST ARGS)
                               (DECLARE
                                (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)
                                 (COMPILATION-SPEED 0)))
                               (COND
                                ((LOOP FOR ARG IN ARGS
                                       FOR SPEC IN SPECIALIZERS
                                       ALWAYS (ETYPECASE SPEC
                                                (CLASS (TYPEP ARG SPEC))
                                                (EQL-SPECIALIZER
                                                 (EQL ARG
                                                      (EQL-SPECIALIZER-OBJECT
                                                       SPEC)))))
                                 (IF EFFECTIVE-METHOD-FUNCTION
                                     (APPLY
                                      (THE FUNCTION EFFECTIVE-METHOD-FUNCTION)
                                      ARGS)
                                     (DISCRIMINATE
                                      (LAMBDA (EMF)
                                        (SETQ EFFECTIVE-METHOD-FUNCTION EMF))
                                      ARGS)))
                                (T (APPLY #'NO-APPLICABLE-METHOD GF ARGS))))))
                          ((= (LENGTH ARGUMENT-ORDER) 1)
                           (LET ((DISPATCH-ARGUMENT-INDEX
                                  (SVREF ARGUMENT-ORDER 0))
                                 (EMFS (MAKE-HASH-TABLE :TEST #'EQ)))
                             (DECLARE (TYPE HASH-TABLE EMFS)
                                      (TYPE FIXNUM DISPATCH-ARGUMENT-INDEX))
                             (LAMBDA (&REST ARGS)
                               (DECLARE
                                (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)
                                 (COMPILATION-SPEED 0)))
                               (LET* ((DISPATCH-CLASS
                                       (CLASS-OF
                                        (NTH DISPATCH-ARGUMENT-INDEX ARGS)))
                                      (EFFECTIVE-METHOD-FUNCTION
                                       (GETHASH DISPATCH-CLASS EMFS)))
                                 (IF EFFECTIVE-METHOD-FUNCTION
                                     (APPLY
                                      (THE FUNCTION EFFECTIVE-METHOD-FUNCTION)
                                      ARGS)
                                     (DISCRIMINATE
                                      (LAMBDA (EMF)
                                        (SETF (GETHASH DISPATCH-CLASS EMFS)
                                                EMF))
                                      ARGS)))))))))))
         (IF DISCRIMINATOR
             DISCRIMINATOR
             (LET ((EMFS (MAKE-HASH-TABLE :TEST #'EQUAL)))
               (DECLARE (TYPE HASH-TABLE EMFS))
               (LAMBDA (&REST ARGS)
                 (DECLARE
                  (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)
                   (COMPILATION-SPEED 0)))
                 (LET* ((CLASSES
                         (LOOP FOR ARG IN ARGS
                               REPEAT NOF-REQUIRED-ARGS
                               COLLECT (CLASS-OF ARG)))
                        (EFFECTIVE-METHOD-FUNCTION
                         (GETHASH (THE LIST CLASSES) EMFS)))
                   (IF EFFECTIVE-METHOD-FUNCTION
                       (APPLY (THE FUNCTION EFFECTIVE-METHOD-FUNCTION) ARGS)
                       (DISCRIMINATE
                        (LAMBDA (EMF)
                          (SETF (GETHASH (THE LIST CLASSES) EMFS) EMF))
                        ARGS CLASSES)))))))))
   (DEFMETHOD COMPUTE-DISCRIMINATING-FUNCTION ((GF STANDARD-GENERIC-FUNCTION))
     (COMPUTE-DISCRIMINATOR GF #'CALL-NEXT-METHOD))
   (DEFMACRO DEFGENERIC (&WHOLE FORM NAME (&REST ARGS) &BODY OPTIONS)
     (UNLESS (EVERY #'CONSP OPTIONS)
       (ERROR "Illegal generic function options in defgeneric form ~S." FORM))
     (LET ((OPTIONS-WITHOUT-METHODS
            (REMOVE :METHOD OPTIONS :KEY #'CAR :TEST #'EQ)))
       (ECLECTOR.READER:QUASIQUOTE
        (PROGN
         (EVAL-WHEN (:COMPILE-TOPLEVEL)
           (DEFGENERIC (ECLECTOR.READER:UNQUOTE NAME)
               (ECLECTOR.READER:UNQUOTE ARGS)
             (ECLECTOR.READER:UNQUOTE-SPLICING OPTIONS-WITHOUT-METHODS)))
         (EVAL-WHEN (:LOAD-TOPLEVEL :EXECUTE)
           (DEFGENERIC (ECLECTOR.READER:UNQUOTE NAME)
               (ECLECTOR.READER:UNQUOTE ARGS)
             (ECLECTOR.READER:UNQUOTE-SPLICING OPTIONS)))))))
   (DEFINE-CONDITION DEFMETHOD-WITHOUT-GENERIC-FUNCTION
       (STYLE-WARNING)
       ((NAME :INITARG :NAME :READER DWG-NAME))
     (:REPORT
      (LAMBDA (C S)
        (FORMAT S
                "No generic function present when encountering a defmethod for ~S. Assuming it will be an instance of standard-generic-function."
                (DWG-NAME C)))))
   (DEFINE-SYMBOL-MACRO WARN-ON-DEFMETHOD-WITHOUT-GENERIC-FUNCTION NIL)
   (DEFMACRO DEFMETHOD (&WHOLE FORM NAME &BODY BODY &ENVIRONMENT ENV)
     (DECLARE (IGNORE BODY))
     (LET ((GENERIC-FUNCTION (WHEN (FBOUNDP NAME) (FDEFINITION NAME))))
       (WHEN (MACROEXPAND 'WARN-ON-DEFMETHOD-WITHOUT-GENERIC-FUNCTION ENV)
         (UNLESS GENERIC-FUNCTION
           (WARN 'DEFMETHOD-WITHOUT-GENERIC-FUNCTION :NAME NAME)))
       (ECLECTOR.READER:QUASIQUOTE
        (DEFMETHOD (ECLECTOR.READER:UNQUOTE-SPLICING (CDR FORM)))))))

[closure-common/encodings.lisp:222]
  (DEFMETHOD DECODE-SEQUENCE
             ((ENCODING (EQL :UTF-8)) IN IN-START IN-END OUT OUT-START OUT-END
              EOF?)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) IN)
             (TYPE (SIMPLE-ARRAY NIL (*)) OUT)
             (TYPE FIXNUM IN-START IN-END OUT-START OUT-END))
    (LET ((WPTR OUT-START) (RPTR IN-START) BYTE0)
      (MACROLET ((PUT (X)
                   (ECLECTOR.READER:QUASIQUOTE
                    ((LAMBDA (X)
                       (WHEN (OR (<= 55296 X 56319) (<= 56320 X 57343))
                         (XERROR "surrogate encoded in UTF-8: #x~X." X))
                       (COND
                        ((OR (%> X 1114111) (EQL X 65534) (EQL X 65535))
                         (XERROR "not a valid code point: #x~X" X))
                        ((%> X 65535)
                         (SETF (AREF OUT (%+ 0 WPTR)) (%+ 55232 (ASH X -10))
                               (AREF OUT (%+ 1 WPTR))
                                 (%IOR 56320 (%AND X 1023)))
                         (SETF WPTR (%+ WPTR 2)))
                        (T (SETF (AREF OUT WPTR) X) (SETF WPTR (%+ WPTR 1)))))
                     (ECLECTOR.READER:UNQUOTE X))))
                 (PUT1 (X)
                   (ECLECTOR.READER:QUASIQUOTE
                    (PROGN
                     (SETF (AREF OUT WPTR) (ECLECTOR.READER:UNQUOTE X))
                     (SETF WPTR (%+ WPTR 1))))))
        (LOOP (WHEN (%= (+ WPTR 1) OUT-END) (RETURN))
              (WHEN (%>= RPTR IN-END) (RETURN))
              (SETQ BYTE0 (AREF IN RPTR))
              (COND
               ((= BYTE0 13)
                (COND
                 ((>= (%+ RPTR 1) IN-END)
                  (COND (EOF? (PUT 10) (SETF RPTR (%+ RPTR 1))) (T (RETURN))))
                 ((= (AREF IN (%+ RPTR 1)) 10) (SETF RPTR (%+ RPTR 1)))
                 (T (PUT 10) (SETF RPTR (%+ RPTR 1)))))
               ((%<= BYTE0 127) (PUT1 BYTE0) (SETF RPTR (%+ RPTR 1)))
               ((%<= BYTE0 191)
                (XERROR "Corrupted UTF-8 input (initial byte was #b~8,'0B)"
                 BYTE0)
                (SETF RPTR (%+ RPTR 1)))
               ((%<= BYTE0 223)
                (COND
                 ((<= (%+ RPTR 2) IN-END)
                  (PUT
                   (DPB (LDB (BYTE 5 0) BYTE0) (BYTE 5 6)
                        (DPB (LDB (BYTE 6 0) (AREF IN (%+ RPTR 1))) (BYTE 6 0)
                             0)))
                  (SETF RPTR (%+ RPTR 2)))
                 (T (RETURN))))
               ((%<= BYTE0 239)
                (COND
                 ((<= (%+ RPTR 3) IN-END)
                  (PUT
                   (DPB (LDB (BYTE 4 0) BYTE0) (BYTE 4 12)
                        (DPB (LDB (BYTE 6 0) (AREF IN (%+ 1 RPTR))) (BYTE 6 6)
                             (DPB (LDB (BYTE 6 0) (AREF IN (%+ 2 RPTR)))
                                  (BYTE 6 0) 0))))
                  (SETF RPTR (%+ RPTR 3)))
                 (T (RETURN))))
               ((%<= BYTE0 247)
                (COND
                 ((<= (%+ RPTR 4) IN-END)
                  (PUT
                   (DPB (LDB (BYTE 3 0) BYTE0) (BYTE 3 18)
                        (DPB (LDB (BYTE 6 0) (AREF IN (%+ 1 RPTR))) (BYTE 6 12)
                             (DPB (LDB (BYTE 6 0) (AREF IN (%+ 2 RPTR)))
                                  (BYTE 6 6)
                                  (DPB (LDB (BYTE 6 0) (AREF IN (%+ 3 RPTR)))
                                       (BYTE 6 0) 0)))))
                  (SETF RPTR (%+ RPTR 4)))
                 (T (RETURN))))
               ((%<= BYTE0 251)
                (COND
                 ((<= (%+ RPTR 5) IN-END)
                  (PUT
                   (DPB (LDB (BYTE 2 0) BYTE0) (BYTE 2 24)
                        (DPB (LDB (BYTE 6 0) (AREF IN (%+ 1 RPTR))) (BYTE 6 18)
                             (DPB (LDB (BYTE 6 0) (AREF IN (%+ 2 RPTR)))
                                  (BYTE 6 12)
                                  (DPB (LDB (BYTE 6 0) (AREF IN (%+ 3 RPTR)))
                                       (BYTE 6 6)
                                       (DPB
                                        (LDB (BYTE 6 0) (AREF IN (%+ 4 RPTR)))
                                        (BYTE 6 0) 0))))))
                  (SETF RPTR (%+ RPTR 5)))
                 (T (RETURN))))
               ((%<= BYTE0 253)
                (COND
                 ((<= (%+ RPTR 6) IN-END)
                  (PUT
                   (DPB (LDB (BYTE 1 0) BYTE0) (BYTE 1 30)
                        (DPB (LDB (BYTE 6 0) (AREF IN (%+ 1 RPTR))) (BYTE 6 24)
                             (DPB (LDB (BYTE 6 0) (AREF IN (%+ 2 RPTR)))
                                  (BYTE 6 18)
                                  (DPB (LDB (BYTE 6 0) (AREF IN (%+ 3 RPTR)))
                                       (BYTE 6 12)
                                       (DPB
                                        (LDB (BYTE 6 0) (AREF IN (%+ 4 RPTR)))
                                        (BYTE 6 6)
                                        (DPB
                                         (LDB (BYTE 6 0) (AREF IN (%+ 5 RPTR)))
                                         (BYTE 6 0) 0)))))))
                  (SETF RPTR (%+ RPTR 6)))
                 (T (RETURN))))
               (T
                (XERROR "Corrupted UTF-8 input (initial byte was #b~8,'0B)"
                 BYTE0)))))
      (VALUES WPTR RPTR)))

[closure-common/encodings.lisp:357]
  (DEFMETHOD DECODE-SEQUENCE
             ((ENCODING SIMPLE-8-BIT-ENCODING) IN IN-START IN-END OUT OUT-START
              OUT-END EOF?)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) IN)
             (TYPE (SIMPLE-ARRAY NIL (*)) OUT)
             (TYPE FIXNUM IN-START IN-END OUT-START OUT-END))
    (LET ((WPTR OUT-START)
          (RPTR IN-START)
          (BYTE 0)
          (TABLE (SLOT-VALUE ENCODING 'TABLE)))
      (DECLARE (TYPE FIXNUM WPTR RPTR)
               (TYPE (UNSIGNED-BYTE 8) BYTE)
               (TYPE (SIMPLE-ARRAY NIL (*)) TABLE))
      (LOOP (WHEN (%= WPTR OUT-END) (RETURN))
            (WHEN (%>= RPTR IN-END) (RETURN))
            (SETQ BYTE (AREF IN RPTR))
            (COND
             ((= BYTE 13)
              (COND
               ((>= (%+ RPTR 1) IN-END)
                (COND
                 (EOF? (SETF (AREF OUT WPTR) 10) (SETF WPTR (%+ WPTR 1))
                  (SETF RPTR (%+ RPTR 1)))
                 (T (RETURN))))
               ((= (AREF IN (%+ RPTR 1)) 10) (SETF RPTR (%+ RPTR 1)))
               (T (SETF (AREF OUT WPTR) 10) (SETF WPTR (%+ WPTR 1))
                (SETF RPTR (%+ RPTR 1)))))
             (T (SETF (AREF OUT WPTR) (AREF TABLE BYTE))
              (SETF WPTR (%+ WPTR 1)) (SETF RPTR (%+ RPTR 1)))))
      (VALUES WPTR RPTR)))

[closure-common/stream-scl.lisp:27]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (DEFPARAMETER *FAST* '(OPTIMIZE (SPEED 3) (SAFETY 3))))

[closure-common/xstream.lisp:68]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (DEFPARAMETER *FAST* '(OPTIMIZE (SPEED 3) (SAFETY 0))))

[clsql/db-oracle/oracle-sql.lisp:635]
  (DEFUN MAKE-QUERY-CURSOR-CDS (DATABASE STMTHP RESULT-TYPES FIELD-NAMES)
    (DECLARE (OPTIMIZE (SAFETY 3) (SPEED 3))
             (TYPE ORACLE-DATABASE DATABASE)
             (TYPE POINTER-POINTER-VOID STMTHP))
    (WITH-SLOTS (ERRHP)
        DATABASE
      (#S(FORMGREP:SYMREF :NAME "WITH-FOREIGN-OBJECTS" :QUALIFIER "UFFI")
       ((DTYPE-FOREIGN :UNSIGNED-SHORT) (PARMDP :POINTER-VOID)
        (PRECISION :SHORT) (SCALE :BYTE) (COLNAME '(* :UNSIGNED-CHAR))
        (COLNAMELEN 'UB4) (COLSIZE 'UB2) (DEFNP ':POINTER-VOID))
       (LET ((BUFFER NIL) (SIZEOF NIL))
         (DO ((ICOLUMN 0 (1+ ICOLUMN))
              (CDS-AS-REVERSED-LIST NIL))
             ((NOT
               (EQL
                (OCI-PARAM-GET (DEREF-VP STMTHP) +OCI-HTYPE-STMT+
                 (DEREF-VP ERRHP) PARMDP (1+ ICOLUMN) :DATABASE DATABASE)
                +OCI-SUCCESS+))
              (COERCE (REVERSE CDS-AS-REVERSED-LIST) 'SIMPLE-VECTOR))
           (OCI-ATTR-GET (DEREF-VP PARMDP) +OCI-DTYPE-PARAM+ DTYPE-FOREIGN
            +UNSIGNED-INT-NULL-POINTER+ +OCI-ATTR-DATA-TYPE+ (DEREF-VP ERRHP))
           (LET ((DTYPE
                  (#S(FORMGREP:SYMREF :NAME "DEREF-POINTER" :QUALIFIER "UFFI")
                   DTYPE-FOREIGN :UNSIGNED-SHORT)))
             (DECLARE (FIXNUM DTYPE))
             (CASE DTYPE
               (()
                (SETF BUFFER
                        (ACQUIRE-FOREIGN-RESOURCE :UNSIGNED-CHAR
                         (* 32 +N-BUF-ROWS+)))
                (SETF SIZEOF 32
                      DTYPE NIL))
               (()
                (OCI-ATTR-GET (DEREF-VP PARMDP) +OCI-DTYPE-PARAM+ PRECISION
                 +UNSIGNED-INT-NULL-POINTER+ +OCI-ATTR-PRECISION+
                 (DEREF-VP ERRHP))
                (OCI-ATTR-GET (DEREF-VP PARMDP) +OCI-DTYPE-PARAM+ SCALE
                 +UNSIGNED-INT-NULL-POINTER+ +OCI-ATTR-SCALE+ (DEREF-VP ERRHP))
                (LET ((*SCALE
                       (#S(FORMGREP:SYMREF
                           :NAME "DEREF-POINTER"
                           :QUALIFIER "UFFI")
                        SCALE :BYTE))
                      (*PRECISION
                       (#S(FORMGREP:SYMREF
                           :NAME "DEREF-POINTER"
                           :QUALIFIER "UFFI")
                        PRECISION :SHORT)))
                  (COND
                   ((OR (AND (MINUSP *SCALE) (ZEROP *PRECISION))
                        (AND (ZEROP *SCALE) (PLUSP *PRECISION)))
                    (SETF BUFFER (ACQUIRE-FOREIGN-RESOURCE :INT +N-BUF-ROWS+)
                          SIZEOF 4
                          DTYPE NIL))
                   (T
                    (SETF BUFFER
                            (ACQUIRE-FOREIGN-RESOURCE :DOUBLE +N-BUF-ROWS+)
                          SIZEOF 8
                          DTYPE NIL)))))
               (T
                (SETF (#S(FORMGREP:SYMREF
                          :NAME "DEREF-POINTER"
                          :QUALIFIER "UFFI")
                       COLSIZE :UNSIGNED-SHORT)
                        0)
                (SETF DTYPE NIL)
                (OCI-ATTR-GET (DEREF-VP PARMDP) +OCI-DTYPE-PARAM+ COLSIZE
                 +UNSIGNED-INT-NULL-POINTER+ +OCI-ATTR-DATA-SIZE+
                 (DEREF-VP ERRHP))
                (LET ((COLSIZE-INCLUDING-NULL
                       (1+
                        (#S(FORMGREP:SYMREF
                            :NAME "DEREF-POINTER"
                            :QUALIFIER "UFFI")
                         COLSIZE :UNSIGNED-SHORT))))
                  (SETF BUFFER
                          (ACQUIRE-FOREIGN-RESOURCE :UNSIGNED-CHAR
                           (* +N-BUF-ROWS+ COLSIZE-INCLUDING-NULL)))
                  (SETF SIZEOF COLSIZE-INCLUDING-NULL))))
             (LET ((RETCODES
                    (ACQUIRE-FOREIGN-RESOURCE :UNSIGNED-SHORT +N-BUF-ROWS+))
                   (INDICATORS (ACQUIRE-FOREIGN-RESOURCE :SHORT +N-BUF-ROWS+))
                   (COLNAME-STRING ""))
               (WHEN FIELD-NAMES
                 (OCI-ATTR-GET (DEREF-VP PARMDP) +OCI-DTYPE-PARAM+ COLNAME
                  COLNAMELEN +OCI-ATTR-NAME+ (DEREF-VP ERRHP))
                 (SETQ COLNAME-STRING
                         (#S(FORMGREP:SYMREF
                             :NAME "CONVERT-FROM-FOREIGN-STRING"
                             :QUALIFIER "UFFI")
                          (#S(FORMGREP:SYMREF
                              :NAME "DEREF-POINTER"
                              :QUALIFIER "UFFI")
                           COLNAME '(* :UNSIGNED-CHAR))
                          :LENGTH
                          (#S(FORMGREP:SYMREF
                              :NAME "DEREF-POINTER"
                              :QUALIFIER "UFFI")
                           COLNAMELEN 'UB4)
                          :ENCODING (ENCODING DATABASE))))
               (PUSH
                (MAKE-CD :NAME COLNAME-STRING :SIZEOF SIZEOF :BUFFER BUFFER
                 :OCI-DATA-TYPE DTYPE :RETCODES RETCODES :INDICATORS INDICATORS
                 :RESULT-TYPE
                 (COND ((CONSP RESULT-TYPES) (NTH ICOLUMN RESULT-TYPES))
                       ((NULL RESULT-TYPES) :STRING) (T RESULT-TYPES)))
                CDS-AS-REVERSED-LIST)
               (OCI-DEFINE-BY-POS (DEREF-VP STMTHP) DEFNP (DEREF-VP ERRHP)
                (1+ ICOLUMN) (FOREIGN-RESOURCE-BUFFER BUFFER) SIZEOF DTYPE
                (FOREIGN-RESOURCE-BUFFER INDICATORS)
                +UNSIGNED-SHORT-NULL-POINTER+
                (FOREIGN-RESOURCE-BUFFER RETCODES) +OCI-DEFAULT+))))))))

[clsql/db-postgresql-socket/postgresql-socket-api.lisp:237]
  (DEFUN READ-BYTES (SOCKET LENGTH)
    "Read a byte array of the given length from a stream."
    (DECLARE (TYPE STREAM SOCKET)
             (TYPE FIXNUM LENGTH)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((RESULT (MAKE-ARRAY LENGTH :ELEMENT-TYPE '(UNSIGNED-BYTE 8))))
      (READ-SEQUENCE RESULT SOCKET)
      RESULT))

[clsql/db-postgresql-socket/postgresql-socket-api.lisp:246]
  (DEFUN READ-SOCKET-SEQUENCE (STREAM LENGTH &OPTIONAL (ALLOW-WIDE T))
    (DECLARE (STREAM STREAM)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((BYTES (MAKE-ARRAY LENGTH :ELEMENT-TYPE '(UNSIGNED-BYTE 8))))
      (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) BYTES))
      (READ-SEQUENCE BYTES STREAM)
      (IF ALLOW-WIDE
          (#S(FORMGREP:SYMREF
              :NAME "DECODE-STRING-FROM-OCTETS"
              :QUALIFIER "CCL")
           BYTES :EXTERNAL-FORMAT :UTF-8)
          (MAP 'STRING #'CODE-CHAR BYTES)))
    (LET ((BYTES (MAKE-ARRAY LENGTH :ELEMENT-TYPE '(UNSIGNED-BYTE 8))))
      (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) BYTES))
      (READ-SEQUENCE BYTES STREAM)
      (IF ALLOW-WIDE
          (OCTETS-TO-STRING BYTES)
          (MAP 'STRING #'CODE-CHAR BYTES))))

[clsql/db-sqlite/sqlite-sql.lisp:85]
  (DEFMETHOD DATABASE-QUERY
             (QUERY-EXPRESSION (DATABASE SQLITE-DATABASE) RESULT-TYPES
              FIELD-NAMES)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0) (SPACE 0)))
    (HANDLER-CASE
     (LET ((VM
            (#S(FORMGREP:SYMREF :NAME "SQLITE-COMPILE" :QUALIFIER "SQLITE")
             (SQLITE-DB DATABASE) QUERY-EXPRESSION))
           (ROWS 'NIL)
           (COL-NAMES 'NIL))
       (UNWIND-PROTECT
           (MULTIPLE-VALUE-BIND (N-COL NEW-ROW SQLITE-COL-NAMES)
               (#S(FORMGREP:SYMREF :NAME "SQLITE-STEP" :QUALIFIER "SQLITE") VM)
             (DECLARE
              (TYPE
               #S(FORMGREP:SYMREF
                  :NAME "SQLITE-ROW-POINTER-TYPE"
                  :QUALIFIER "SQLITE")
               NEW-ROW))
             (WHEN (> N-COL 0)
               (WHEN FIELD-NAMES
                 (SETF COL-NAMES
                         (LOOP FOR I FROM 0 BELOW N-COL
                               COLLECT (#S(FORMGREP:SYMREF
                                           :NAME "SQLITE-AREF"
                                           :QUALIFIER "SQLITE")
                                        SQLITE-COL-NAMES I
                                        (ENCODING DATABASE)))))
               (LET ((CANONICALIZED-RESULT-TYPES
                      (CANONICALIZE-RESULT-TYPES RESULT-TYPES N-COL
                       SQLITE-COL-NAMES DATABASE)))
                 (FLET ((EXTRACT-ROW-DATA (ROW)
                          (DECLARE
                           (TYPE
                            #S(FORMGREP:SYMREF
                               :NAME "SQLITE-ROW-POINTER-TYPE"
                               :QUALIFIER "SQLITE")
                            ROW))
                          (LOOP FOR I FROM 0 BELOW N-COL
                                COLLECT (#S(FORMGREP:SYMREF
                                            :NAME "CONVERT-RAW-FIELD"
                                            :QUALIFIER "CLSQL-UFFI")
                                         (#S(FORMGREP:SYMREF
                                             :NAME "SQLITE-RAW-AREF"
                                             :QUALIFIER "SQLITE")
                                          ROW I)
                                         (NTH I CANONICALIZED-RESULT-TYPES)
                                         :ENCODING (ENCODING DATABASE)))))
                   (PUSH (EXTRACT-ROW-DATA NEW-ROW) ROWS)
                   (DO ()
                       (NIL)
                     (MULTIPLE-VALUE-BIND (N-COL NEW-ROW)
                         (#S(FORMGREP:SYMREF
                             :NAME "SQLITE-STEP"
                             :QUALIFIER "SQLITE")
                          VM)
                       (DECLARE
                        (TYPE
                         #S(FORMGREP:SYMREF
                            :NAME "SQLITE-ROW-POINTER-TYPE"
                            :QUALIFIER "SQLITE")
                         NEW-ROW))
                       (IF (> N-COL 0)
                           (PUSH (EXTRACT-ROW-DATA NEW-ROW) ROWS)
                           (RETURN))))))))
         (#S(FORMGREP:SYMREF :NAME "SQLITE-FINALIZE" :QUALIFIER "SQLITE") VM))
       (VALUES (NREVERSE ROWS) COL-NAMES))
     (#S(FORMGREP:SYMREF :NAME "SQLITE-ERROR" :QUALIFIER "SQLITE") (ERR)
      (ERROR 'SQL-DATABASE-DATA-ERROR :DATABASE DATABASE :EXPRESSION
             QUERY-EXPRESSION :ERROR-ID
             (#S(FORMGREP:SYMREF :NAME "SQLITE-ERROR-CODE" :QUALIFIER "SQLITE")
              ERR)
             :MESSAGE
             (#S(FORMGREP:SYMREF
                 :NAME "SQLITE-ERROR-MESSAGE"
                 :QUALIFIER "SQLITE")
              ERR)))))

[clsql/db-sqlite3/sqlite3-sql.lisp:189]
  (DEFMETHOD DATABASE-QUERY
             (QUERY-EXPRESSION (DATABASE SQLITE3-DATABASE) RESULT-TYPES
              FIELD-NAMES)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0) (SPACE 0)))
    (HANDLER-CASE
     (LET ((STMT
            (#S(FORMGREP:SYMREF :NAME "SQLITE3-PREPARE" :QUALIFIER "SQLITE3")
             (SQLITE3-DB DATABASE) QUERY-EXPRESSION))
           (ROWS 'NIL)
           (COL-NAMES 'NIL))
       (DECLARE
        (TYPE
         #S(FORMGREP:SYMREF :NAME "SQLITE3-STMT-TYPE" :QUALIFIER "SQLITE3")
         STMT))
       (UNWIND-PROTECT
           (WHEN
               (#S(FORMGREP:SYMREF :NAME "SQLITE3-STEP" :QUALIFIER "SQLITE3")
                STMT)
             (LET ((N-COL
                    (#S(FORMGREP:SYMREF
                        :NAME "SQLITE3-COLUMN-COUNT"
                        :QUALIFIER "SQLITE3")
                     STMT)))
               (FLET ((EXTRACT-ROW-DATA ()
                        (LOOP FOR I FROM 0 BELOW N-COL
                              FOR TYPES = (GET-RESULT-TYPES STMT N-COL
                                           RESULT-TYPES) THEN (REST TYPES)
                              COLLECT (IF (EQ (FIRST TYPES) :BLOB)
                                          (#S(FORMGREP:SYMREF
                                              :NAME "CONVERT-RAW-FIELD"
                                              :QUALIFIER "CLSQL-UFFI")
                                           (#S(FORMGREP:SYMREF
                                               :NAME "SQLITE3-COLUMN-BLOB"
                                               :QUALIFIER "SQLITE3")
                                            STMT I)
                                           (CAR TYPES) :LENGTH
                                           (#S(FORMGREP:SYMREF
                                               :NAME "SQLITE3-COLUMN-BYTES"
                                               :QUALIFIER "SQLITE3")
                                            STMT I)
                                           :ENCODING (ENCODING DATABASE))
                                          (#S(FORMGREP:SYMREF
                                              :NAME "CONVERT-RAW-FIELD"
                                              :QUALIFIER "CLSQL-UFFI")
                                           (#S(FORMGREP:SYMREF
                                               :NAME "SQLITE3-COLUMN-TEXT"
                                               :QUALIFIER "SQLITE3")
                                            STMT I)
                                           (CAR TYPES) :ENCODING
                                           (ENCODING DATABASE))))))
                 (WHEN FIELD-NAMES
                   (SETF COL-NAMES
                           (LOOP FOR N FROM 0 BELOW N-COL
                                 COLLECT (#S(FORMGREP:SYMREF
                                             :NAME "SQLITE3-COLUMN-NAME"
                                             :QUALIFIER "SQLITE3")
                                          STMT N))))
                 (PUSH (EXTRACT-ROW-DATA) ROWS)
                 (DO* ()
                      (NIL)
                   (IF (#S(FORMGREP:SYMREF
                           :NAME "SQLITE3-STEP"
                           :QUALIFIER "SQLITE3")
                        STMT)
                       (PUSH (EXTRACT-ROW-DATA) ROWS)
                       (RETURN))))))
         (#S(FORMGREP:SYMREF :NAME "SQLITE3-FINALIZE" :QUALIFIER "SQLITE3")
          STMT))
       (VALUES (NREVERSE ROWS) COL-NAMES))
     (#S(FORMGREP:SYMREF :NAME "SQLITE3-ERROR" :QUALIFIER "SQLITE3") (ERR)
      (ERROR 'SQL-DATABASE-DATA-ERROR :DATABASE DATABASE :EXPRESSION
             QUERY-EXPRESSION :ERROR-ID
             (#S(FORMGREP:SYMREF
                 :NAME "SQLITE3-ERROR-CODE"
                 :QUALIFIER "SQLITE3")
              ERR)
             :MESSAGE
             (#S(FORMGREP:SYMREF
                 :NAME "SQLITE3-ERROR-MESSAGE"
                 :QUALIFIER "SQLITE3")
              ERR)))))

[clsql/sql/ansi-loop.lisp:154]
  (DEFUN LOOP-OPTIMIZATION-QUANTITIES (ENV)
    (DECLARE (VALUES SPEED SPACE SAFETY COMPILATION-SPEED DEBUG))
    (LET ((STUFF (DECLARATION-INFORMATION 'OPTIMIZE ENV)))
      (VALUES (OR (CDR (ASSOC 'SPEED STUFF)) 1)
              (OR (CDR (ASSOC 'SPACE STUFF)) 1)
              (OR (CDR (ASSOC 'SAFETY STUFF)) 1)
              (OR (CDR (ASSOC 'COMPILATION-SPEED STUFF)) 1)
              (OR (CDR (ASSOC 'DEBUG STUFF)) 1)))
    (VALUES #S(FORMGREP:SYMREF :NAME "TIME" :QUALIFIER "COMPILER")
            #S(FORMGREP:SYMREF :NAME "SPACE" :QUALIFIER "COMPILER")
            #S(FORMGREP:SYMREF :NAME "SAFETY" :QUALIFIER "COMPILER")
            #S(FORMGREP:SYMREF :NAME "COMPILATION-SPEED" :QUALIFIER "COMPILER")
            1))

[clsql/sql/cmucl-compat.lisp:46]
  (DEFMACRO SHRINK-VECTOR (VEC LEN)
    "Shrinks a vector. Optimized if vector has a fill pointer.
Needs to be a macro to overwrite value of VEC."
    (LET ((NEW-VEC (GENSYM)))
      (ECLECTOR.READER:QUASIQUOTE
       (COND
        ((ADJUSTABLE-ARRAY-P (ECLECTOR.READER:UNQUOTE VEC))
         (ADJUST-ARRAY (ECLECTOR.READER:UNQUOTE VEC)
                       (ECLECTOR.READER:UNQUOTE LEN)))
        ((TYPEP (ECLECTOR.READER:UNQUOTE VEC) 'SIMPLE-ARRAY)
         (LET (((ECLECTOR.READER:UNQUOTE NEW-VEC)
                (MAKE-ARRAY (ECLECTOR.READER:UNQUOTE LEN) :ELEMENT-TYPE
                            (ARRAY-ELEMENT-TYPE
                             (ECLECTOR.READER:UNQUOTE VEC)))))
           (CHECK-TYPE (ECLECTOR.READER:UNQUOTE LEN) FIXNUM)
           (LOCALLY
            (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0)))
            (DOTIMES (I (ECLECTOR.READER:UNQUOTE LEN))
              (DECLARE (FIXNUM I))
              (SETF (AREF (ECLECTOR.READER:UNQUOTE NEW-VEC) I)
                      (AREF (ECLECTOR.READER:UNQUOTE VEC) I))))
           (SETQ (ECLECTOR.READER:UNQUOTE VEC)
                   (ECLECTOR.READER:UNQUOTE NEW-VEC))))
        ((TYPEP (ECLECTOR.READER:UNQUOTE VEC) 'VECTOR)
         (SETF (FILL-POINTER (ECLECTOR.READER:UNQUOTE VEC))
                 (ECLECTOR.READER:UNQUOTE LEN))
         (ECLECTOR.READER:UNQUOTE VEC))
        (T
         (ERROR "Unable to shrink vector ~S which is type-of ~S"
                (ECLECTOR.READER:UNQUOTE VEC)
                (TYPE-OF (ECLECTOR.READER:UNQUOTE VEC))))))))

[clsql/sql/expressions.lisp:987]
  (DEFMETHOD DATABASE-OUTPUT-SQL ((STR STRING) DATABASE)
    (DECLARE
     (OPTIMIZE (SPEED 3) (SAFETY 1)
      (#S(FORMGREP:SYMREF :NAME "INHIBIT-WARNINGS" :QUALIFIER "EXTENSIONS")
       3)))
    (LET ((LEN (LENGTH STR)))
      (DECLARE (TYPE FIXNUM LEN))
      (COND ((ZEROP LEN) +EMPTY-STRING+)
            ((AND (NULL (POSITION #\' STR)) (NULL (POSITION #\\ STR)))
             (CONCATENATE 'STRING "'" STR "'"))
            (T
             (LET ((BUF (MAKE-STRING (+ (* LEN 2) 2) :INITIAL-ELEMENT #\')))
               (DECLARE (SIMPLE-STRING BUF))
               (DO* ((I 0 (INCF I))
                     (J 1 (INCF J)))
                    ((= I LEN) (SUBSEQ BUF 0 (1+ J)))
                 (DECLARE (TYPE FIXNUM I J))
                 (LET ((CHAR (AREF STR I)))
                   (DECLARE (CHARACTER CHAR))
                   (COND
                    ((CHAR= CHAR #\') (SETF (AREF BUF J) #\') (INCF J)
                     (SETF (AREF BUF J) #\'))
                    ((AND (CHAR= CHAR #\\)
                          (MEMBER (DATABASE-UNDERLYING-TYPE DATABASE)
                                  '(:POSTGRESQL :MYSQL) :TEST #'EQ))
                     (SETF (AREF BUF J) #\\) (INCF J) (SETF (AREF BUF J) #\\))
                    (T (SETF (AREF BUF J) CHAR))))))))))

[clsql/sql/utils.lisp:168]
  (DEFUN POSITION-CHAR (CHAR STRING START MAX)
    "From KMRCL."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0))
             (FIXNUM START MAX)
             (SIMPLE-STRING STRING))
    (DO* ((I START (1+ I)))
         ((= I MAX) NIL)
      (DECLARE (FIXNUM I))
      (WHEN (CHAR= CHAR (SCHAR STRING I)) (RETURN I))))

[clsql/sql/utils.lisp:177]
  (DEFUN DELIMITED-STRING-TO-LIST
         (STRING &OPTIONAL (SEPARATOR #\ ) SKIP-TERMINAL)
    "Split a string with delimiter, from KMRCL."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (COMPILATION-SPEED 0))
             (TYPE STRING STRING)
             (TYPE CHARACTER SEPARATOR))
    (DO* ((LEN (LENGTH STRING))
          (OUTPUT 'NIL)
          (POS 0)
          (END (POSITION-CHAR SEPARATOR STRING POS LEN)
               (POSITION-CHAR SEPARATOR STRING POS LEN)))
         ((NULL END)
          (IF (< POS LEN)
              (PUSH (SUBSEQ STRING POS) OUTPUT)
              (WHEN (OR (NOT SKIP-TERMINAL) (ZEROP LEN)) (PUSH "" OUTPUT)))
          (NREVERSE OUTPUT))
      (DECLARE (TYPE FIXNUM POS LEN)
               (TYPE (OR NULL FIXNUM) END))
      (PUSH (SUBSEQ STRING POS END) OUTPUT)
      (SETQ POS (1+ END))))

[clsql/sql/utils.lisp:325]
  (DEFUN REPLACED-STRING-LENGTH (STR REPL-ALIST)
    (DECLARE (SIMPLE-STRING STR)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0)))
    (DO* ((I 0 (1+ I))
          (ORIG-LEN (LENGTH STR))
          (NEW-LEN ORIG-LEN))
         ((= I ORIG-LEN) NEW-LEN)
      (DECLARE (FIXNUM I ORIG-LEN NEW-LEN))
      (LET* ((C (CHAR STR I)) (MATCH (ASSOC C REPL-ALIST :TEST #'CHAR=)))
        (DECLARE (CHARACTER C))
        (WHEN MATCH
          (INCF NEW-LEN (1- (LENGTH (THE SIMPLE-STRING (CDR MATCH)))))))))

[clsql/sql/utils.lisp:341]
  (DEFUN SUBSTITUTE-CHARS-STRINGS (STR REPL-ALIST)
    "Replace all instances of a chars with a string. repl-alist is an assoc
list of characters and replacement strings."
    (DECLARE (SIMPLE-STRING STR)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0)))
    (DO* ((ORIG-LEN (LENGTH STR))
          (NEW-STRING (MAKE-STRING (REPLACED-STRING-LENGTH STR REPL-ALIST)))
          (SPOS 0 (1+ SPOS))
          (DPOS 0))
         ((>= SPOS ORIG-LEN) NEW-STRING)
      (DECLARE (FIXNUM SPOS DPOS)
               (SIMPLE-STRING NEW-STRING))
      (LET* ((C (CHAR STR SPOS)) (MATCH (ASSOC C REPL-ALIST :TEST #'CHAR=)))
        (DECLARE (CHARACTER C))
        (IF MATCH
            (LET* ((SUBST (CDR MATCH)) (LEN (LENGTH SUBST)))
              (DECLARE (FIXNUM LEN)
                       (SIMPLE-STRING SUBST))
              (DOTIMES (J LEN)
                (DECLARE (FIXNUM J))
                (SETF (CHAR NEW-STRING DPOS) (CHAR SUBST J))
                (INCF DPOS)))
            (PROGN (SETF (CHAR NEW-STRING DPOS) C) (INCF DPOS))))))

[clsql/uffi/clsql-uffi.lisp:20]
  (DEFUN CANONICALIZE-TYPE-LIST (TYPES AUTO-LIST)
    "Ensure a field type list meets expectations"
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DO ((I 0 (1+ I))
         (NEW-TYPES 'NIL)
         (LENGTH-TYPES (LENGTH TYPES))
         (LENGTH-AUTO-LIST (LENGTH AUTO-LIST)))
        ((= I LENGTH-AUTO-LIST) (NREVERSE NEW-TYPES))
      (DECLARE (FIXNUM LENGTH-TYPES LENGTH-AUTO-LIST I))
      (IF (>= I LENGTH-TYPES)
          (PUSH T NEW-TYPES)
          (PUSH
           (CASE (NTH I TYPES)
             (:INT
              (CASE (NTH I AUTO-LIST) (:INT32 :INT32) (:INT64 :INT64) (T T)))
             (:DOUBLE (CASE (NTH I AUTO-LIST) (:DOUBLE :DOUBLE) (T T)))
             (:INT32
              (IF (EQ :INT32 (NTH I AUTO-LIST))
                  :INT32
                  T))
             (:INT64
              (IF (EQ :INT64 (NTH I AUTO-LIST))
                  :INT64
                  T))
             (:BLOB :BLOB)
             (:UINT :UINT)
             (T T))
           NEW-TYPES))))

[clsql/uffi/clsql-uffi.lisp:128]
  (DEFUN STRTOUL (CHAR-PTR)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0))
             (TYPE CHAR-PTR-DEF CHAR-PTR))
    (C-STRTOUL CHAR-PTR
     #S(FORMGREP:SYMREF :NAME "+NULL-CSTRING-POINTER+" :QUALIFIER "UFFI") 10))

[clsql/uffi/clsql-uffi.lisp:133]
  (DEFUN STRTOULL (CHAR-PTR)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0))
             (TYPE CHAR-PTR-DEF CHAR-PTR))
    (C-STRTOULL CHAR-PTR
     #S(FORMGREP:SYMREF :NAME "+NULL-CSTRING-POINTER+" :QUALIFIER "UFFI") 10))

[clsql/uffi/clsql-uffi.lisp:138]
  (DEFUN STRTOLL (CHAR-PTR)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0))
             (TYPE CHAR-PTR-DEF CHAR-PTR))
    (C-STRTOLL CHAR-PTR
     #S(FORMGREP:SYMREF :NAME "+NULL-CSTRING-POINTER+" :QUALIFIER "UFFI") 10))

[clsql/uffi/clsql-uffi.lisp:143]
  (DEFUN CONVERT-RAW-FIELD (CHAR-PTR TYPE &KEY LENGTH ENCODING)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0))
             (TYPE CHAR-PTR-DEF CHAR-PTR))
    (UNLESS
        (#S(FORMGREP:SYMREF :NAME "NULL-POINTER-P" :QUALIFIER "UFFI") CHAR-PTR)
      (CASE TYPE
        (:DOUBLE (ATOF CHAR-PTR))
        (:INT (ATOL CHAR-PTR))
        (:INT32 (ATOI CHAR-PTR))
        (:UINT32 (STRTOUL CHAR-PTR))
        (:UINT (STRTOUL CHAR-PTR))
        (:INT64 (STRTOLL CHAR-PTR))
        (:UINT64 (STRTOULL CHAR-PTR))
        (:BLOB
         (IF LENGTH
             (#S(FORMGREP:SYMREF
                 :NAME "CONVERT-FROM-FOREIGN-USB8"
                 :QUALIFIER "UFFI")
              CHAR-PTR LENGTH)
             (ERROR "Can't return blob since length is not specified.")))
        (T
         (#S(FORMGREP:SYMREF
             :NAME "CONVERT-FROM-FOREIGN-STRING"
             :QUALIFIER "UFFI")
          CHAR-PTR :NULL-TERMINATED-P (NULL LENGTH) :LENGTH LENGTH :ENCODING
          ENCODING)))))

[clx/build-clx.lisp:4]
  (PROCLAIM '(OPTIMIZE (SPEED 3) (SAFETY 1) (SPACE 1) (COMPILATION-SPEED 0)))

[clx/defsystem.lisp:168]
  (SETQ #S(FORMGREP:SYMREF
           :NAME "GENERATE-INTERRUPT-CHECKS-SWITCH"
           :QUALIFIER "COMPILER")
          (COMPILE NIL
                   '(LAMBDA (SAFETY SIZE SPEED &OPTIONAL DEBUG)
                      (DECLARE (IGNORE SIZE DEBUG))
                      (OR (< SPEED 3) (> SAFETY 0)))))

[clx/defsystem.lisp:349]
  (DEFUN COMPILE-CLX
         (
          &OPTIONAL (SOURCE-PATHNAME-DEFAULTS "") (BINARY-PATHNAME-DEFAULTS "")
          &KEY (COMPILE-C T))
    (LET* ((SOURCE-PATH (PATHNAME SOURCE-PATHNAME-DEFAULTS))
           (PATH
            (MAKE-PATHNAME :HOST (PATHNAME-HOST SOURCE-PATH) :DEVICE
                           (PATHNAME-DEVICE SOURCE-PATH) :DIRECTORY
                           (PATHNAME-DIRECTORY SOURCE-PATH) :NAME
                           (PATHNAME-NAME SOURCE-PATH) :TYPE NIL :VERSION
                           (PATHNAME-VERSION SOURCE-PATH)))
           (BINARY-PATH (MERGE-PATHNAMES BINARY-PATHNAME-DEFAULTS PATH))
           (*COMPILE-VERBOSE* T)
           (*LOAD-VERBOSE* T))
      (IF (AND (EQUAL (PATHNAME-TYPE SOURCE-PATH) (PATHNAME-TYPE BINARY-PATH))
               (NOT (NULL (PATHNAME-TYPE BINARY-PATH))))
          (ERROR "Source and binary pathname defaults have same type ~s ~s"
                 SOURCE-PATH BINARY-PATH))
      (FORMAT T "~&;;; Default paths: ~s ~s~%" SOURCE-PATH BINARY-PATH)
      (PROGN
       (UNLESS (MEMBER :PQC *FEATURES*)
         (CERROR "Go ahead anyway."
                 "Lucid's production mode compiler must be loaded to compile CLX."))
       (PROCLAIM
        '(OPTIMIZE (SPEED 3) (SAFETY 1) (SPACE 0) (COMPILATION-SPEED 0))))
      (LABELS ((COMPILE-LISP (FILENAME)
                 (LET ((SOURCE (MERGE-PATHNAMES FILENAME SOURCE-PATH))
                       (BINARY (MERGE-PATHNAMES FILENAME BINARY-PATH)))
                   (LOAD SOURCE)
                   (IF (EQUAL SOURCE BINARY)
                       (COMPILE-FILE SOURCE)
                       (COMPILE-FILE SOURCE :OUTPUT-FILE BINARY))
                   BINARY))
               (COMPILE-AND-LOAD (FILENAME)
                 (LOAD (COMPILE-LISP FILENAME)))
               (COMPILE-C (FILENAME)
                 (LET* ((C-FILENAME (CONCATENATE 'STRING FILENAME ".c"))
                        (O-FILENAME (CONCATENATE 'STRING FILENAME ".o"))
                        (SRC (MERGE-PATHNAMES C-FILENAME SOURCE-PATH))
                        (OBJ (MERGE-PATHNAMES O-FILENAME BINARY-PATH))
                        (ARGS
                         (LIST "-c" (NAMESTRING SRC) "-o" (NAMESTRING OBJ)
                               "-G 0" "-DSYSV" "-I/usr/include/bsd"
                               "-DHPUX -DHPUX7.0")))
                   (FORMAT T ";;; cc~{ ~A~}~%" ARGS)
                   (UNLESS
                       (ZEROP
                        (MULTIPLE-VALUE-BIND (IOSTREAM ESTREAM EXITSTATUS PID)
                            (#S(FORMGREP:SYMREF
                                :NAME "RUN-PROGRAM"
                                :QUALIFIER "SYSTEM")
                             "cc" :ARGUMENTS ARGS)
                          (DECLARE (IGNORE IOSTREAM ESTREAM PID))
                          EXITSTATUS)
                        (SYSTEM (FORMAT NIL "cc~{ ~A~}" ARGS)))
                     (ERROR "Compile of ~A failed." SRC)))))
        (WITH-COMPILATION-UNIT
            #S(FORMGREP:SYMREF
               :NAME "WITH-DEFERRED-WARNINGS"
               :QUALIFIER "LUCID")
          NIL
          (COMPILE-AND-LOAD "package")
          (WHEN COMPILE-C (COMPILE-C "socket"))
          (COMPILE-LISP "sockcl")
          (CLX-FOREIGN-FILES BINARY-PATH)
          (COMPILE-AND-LOAD "excldep")
          (COMPILE-AND-LOAD "depdefs")
          (COMPILE-AND-LOAD "clx")
          (COMPILE-AND-LOAD "dependent")
          (COMPILE-AND-LOAD "exclcmac")
          (COMPILE-AND-LOAD "macros")
          (COMPILE-AND-LOAD "bufmac")
          (COMPILE-AND-LOAD "buffer")
          (COMPILE-AND-LOAD "display")
          (COMPILE-AND-LOAD "gcontext")
          (COMPILE-AND-LOAD "input")
          (COMPILE-AND-LOAD "requests")
          (COMPILE-AND-LOAD "fonts")
          (COMPILE-AND-LOAD "graphics")
          (COMPILE-AND-LOAD "text")
          (COMPILE-AND-LOAD "attributes")
          (COMPILE-AND-LOAD "translate")
          (COMPILE-AND-LOAD "keysyms")
          (COMPILE-AND-LOAD "manager")
          (COMPILE-AND-LOAD "image")
          (COMPILE-AND-LOAD "resource")))))

[clx/dep-allegro.lisp:53]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (DEFCONSTANT +BUFFER-SPEED+ 1 "Speed compiler option for buffer code.")
    (DEFCONSTANT +BUFFER-SAFETY+ 3 "Safety compiler option for buffer code.")
    (DEFCONSTANT +BUFFER-DEBUG+ 2 "Debug compiler option for buffer code>")
    (DEFUN DECLARE-BUFMAC ()
      (ECLECTOR.READER:QUASIQUOTE
       (DECLARE
        (OPTIMIZE (SPEED (ECLECTOR.READER:UNQUOTE +BUFFER-SPEED+))
         (SAFETY (ECLECTOR.READER:UNQUOTE +BUFFER-SAFETY+))
         (DEBUG (ECLECTOR.READER:UNQUOTE +BUFFER-DEBUG+))))))
    (DEFUN DECLARE-BUFFUN ()
      (ECLECTOR.READER:QUASIQUOTE
       (DECLARE
        (OPTIMIZE (SPEED (ECLECTOR.READER:UNQUOTE +BUFFER-SPEED+))
         (SAFETY (ECLECTOR.READER:UNQUOTE +BUFFER-SAFETY+))
         (DEBUG (ECLECTOR.READER:UNQUOTE +BUFFER-DEBUG+)))))))

[clx/dep-allegro.lisp:714]
  (DEFUN BUFFER-REPLACE
         (TARGET-SEQUENCE SOURCE-SEQUENCE TARGET-START TARGET-END
          &OPTIONAL (SOURCE-START 0))
    (DECLARE (TYPE BUFFER-BYTES TARGET-SEQUENCE SOURCE-SEQUENCE)
             (TYPE ARRAY-INDEX TARGET-START TARGET-END SOURCE-START)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((SOURCE-END (LENGTH SOURCE-SEQUENCE)))
      (DECLARE (TYPE ARRAY-INDEX SOURCE-END))
      (#S(FORMGREP:SYMREF :NAME "IF*" :QUALIFIER "EXCL")
       (AND (EQ TARGET-SEQUENCE SOURCE-SEQUENCE) (> TARGET-START SOURCE-START))
       THEN
       (LET ((NELTS
              (MIN (- TARGET-END TARGET-START) (- SOURCE-END SOURCE-START))))
         (DO ((TARGET-INDEX (+ TARGET-START NELTS -1) (1- TARGET-INDEX))
              (SOURCE-INDEX (+ SOURCE-START NELTS -1) (1- SOURCE-INDEX)))
             ((= TARGET-INDEX (1- TARGET-START)) TARGET-SEQUENCE)
           (DECLARE (TYPE ARRAY-INDEX TARGET-INDEX SOURCE-INDEX))
           (SETF (AREF TARGET-SEQUENCE TARGET-INDEX)
                   (AREF SOURCE-SEQUENCE SOURCE-INDEX))))
       ELSE
       (DO ((TARGET-INDEX TARGET-START (1+ TARGET-INDEX))
            (SOURCE-INDEX SOURCE-START (1+ SOURCE-INDEX)))
           ((OR (= TARGET-INDEX TARGET-END) (= SOURCE-INDEX SOURCE-END))
            TARGET-SEQUENCE)
         (DECLARE (TYPE ARRAY-INDEX TARGET-INDEX SOURCE-INDEX))
         (SETF (AREF TARGET-SEQUENCE TARGET-INDEX)
                 (AREF SOURCE-SEQUENCE SOURCE-INDEX))))))

[clx/dep-allegro.lisp:806]
  (DEFMACRO TYPE? (OBJECT TYPE)
    (IF (NOT (CONSTANTP TYPE))
        (ECLECTOR.READER:QUASIQUOTE
         (TYPEP (ECLECTOR.READER:UNQUOTE OBJECT)
                (ECLECTOR.READER:UNQUOTE TYPE)))
        (PROGN
         (SETQ TYPE (EVAL TYPE))
         (LET ((PREDICATE
                (ASSOC TYPE
                       '((DRAWABLE DRAWABLE-P) (WINDOW WINDOW-P)
                         (PIXMAP PIXMAP-P) (CURSOR CURSOR-P) (FONT FONT-P)
                         (GCONTEXT GCONTEXT-P) (COLORMAP COLORMAP-P)
                         (NULL NULL) (INTEGER INTEGERP)))))
           (COND
            (PREDICATE
             (ECLECTOR.READER:QUASIQUOTE
              ((ECLECTOR.READER:UNQUOTE (SECOND PREDICATE))
               (ECLECTOR.READER:UNQUOTE OBJECT))))
            ((EQ TYPE 'GENERALIZED-BOOLEAN) 'T)
            (+TYPE-CHECK?+
             (ECLECTOR.READER:QUASIQUOTE
              (LOCALLY
               (DECLARE (OPTIMIZE SAFETY))
               (TYPEP (ECLECTOR.READER:UNQUOTE OBJECT)
                      '(ECLECTOR.READER:UNQUOTE TYPE)))))
            (T
             (ECLECTOR.READER:QUASIQUOTE
              (TYPEP (ECLECTOR.READER:UNQUOTE OBJECT)
                     '(ECLECTOR.READER:UNQUOTE TYPE)))))))))

[clx/dep-allegro.lisp:1244]
  (DEFUN COMPUTE-IMAGE-BYTE-AND-BIT-ORDERING ()
    (DECLARE (CLX-VALUES IMAGE-BYTE-LSB-FIRST-P IMAGE-BIT-LSB-FIRST-P))
    (LET ((ORDERING NIL)
          (A (MAKE-ARRAY '(1 32) :ELEMENT-TYPE 'BIT :INITIAL-ELEMENT 0)))
      (DOTIMES (I 4)
        (PUSH
         (FLET ((BITPOS (A I N)
                  (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0)))
                  (DECLARE (TYPE (SIMPLE-ARRAY BIT (* *)) A)
                           (TYPE FIXNUM I N))
                  (WITH-UNDERLYING-SIMPLE-VECTOR (V (UNSIGNED-BYTE 8) A)
                   (PROG2 (SETF (AREF V I) N)
                       (DOTIMES (I 32)
                         (UNLESS (ZEROP (AREF A 0 I)) (RETURN I)))
                     (SETF (AREF V I) 0)))))
           (LIST (BITPOS A I 128) (BITPOS A I 1)))
         ORDERING))
      (SETQ ORDERING (CONS (FLOOR +IMAGE-UNIT+ 8) (NREVERSE ORDERING)))
      (LET ((BYTE-AND-BIT-ORDERING
             (SECOND
              (ASSOC ORDERING *IMAGE-BIT-ORDERING-TABLE* :TEST #'EQUAL))))
        (UNLESS BYTE-AND-BIT-ORDERING
          (ERROR "Couldn't determine image byte and bit ordering~@
                measured image ordering = ~A"
                 ORDERING))
        (VALUES-LIST BYTE-AND-BIT-ORDERING))))

[clx/dep-lispworks.lisp:49]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (DEFCONSTANT +BUFFER-SPEED+ 1 "Speed compiler option for buffer code.")
    (DEFCONSTANT +BUFFER-SAFETY+ 3 "Safety compiler option for buffer code.")
    (DEFCONSTANT +BUFFER-DEBUG+ 2 "Debug compiler option for buffer code>")
    (DEFUN DECLARE-BUFMAC ()
      (ECLECTOR.READER:QUASIQUOTE
       (DECLARE
        (OPTIMIZE (SPEED (ECLECTOR.READER:UNQUOTE +BUFFER-SPEED+))
         (SAFETY (ECLECTOR.READER:UNQUOTE +BUFFER-SAFETY+))
         (DEBUG (ECLECTOR.READER:UNQUOTE +BUFFER-DEBUG+))))))
    (DEFUN DECLARE-BUFFUN ()
      (ECLECTOR.READER:QUASIQUOTE
       (DECLARE
        (OPTIMIZE (SPEED (ECLECTOR.READER:UNQUOTE +BUFFER-SPEED+))
         (SAFETY (ECLECTOR.READER:UNQUOTE +BUFFER-SAFETY+))
         (DEBUG (ECLECTOR.READER:UNQUOTE +BUFFER-DEBUG+)))))))

[clx/dep-openmcl.lisp:54]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (DEFCONSTANT +BUFFER-SPEED+ 1 "Speed compiler option for buffer code.")
    (DEFCONSTANT +BUFFER-SAFETY+ 3 "Safety compiler option for buffer code.")
    (DEFCONSTANT +BUFFER-DEBUG+ 2 "Debug compiler option for buffer code>")
    (DEFUN DECLARE-BUFMAC ()
      (ECLECTOR.READER:QUASIQUOTE
       (DECLARE
        (OPTIMIZE (SPEED (ECLECTOR.READER:UNQUOTE +BUFFER-SPEED+))
         (SAFETY (ECLECTOR.READER:UNQUOTE +BUFFER-SAFETY+))
         (DEBUG (ECLECTOR.READER:UNQUOTE +BUFFER-DEBUG+))))))
    (DEFUN DECLARE-BUFFUN ()
      (ECLECTOR.READER:QUASIQUOTE
       (DECLARE
        (OPTIMIZE (SPEED (ECLECTOR.READER:UNQUOTE +BUFFER-SPEED+))
         (SAFETY (ECLECTOR.READER:UNQUOTE +BUFFER-SAFETY+))
         (DEBUG (ECLECTOR.READER:UNQUOTE +BUFFER-DEBUG+)))))))

[clx/dep-openmcl.lisp:770]
  (DEFMACRO TYPE? (OBJECT TYPE)
    (IF (NOT (CONSTANTP TYPE))
        (ECLECTOR.READER:QUASIQUOTE
         (TYPEP (ECLECTOR.READER:UNQUOTE OBJECT)
                (ECLECTOR.READER:UNQUOTE TYPE)))
        (PROGN
         (SETQ TYPE (EVAL TYPE))
         (LET ((PREDICATE
                (ASSOC TYPE
                       '((DRAWABLE DRAWABLE-P) (WINDOW WINDOW-P)
                         (PIXMAP PIXMAP-P) (CURSOR CURSOR-P) (FONT FONT-P)
                         (GCONTEXT GCONTEXT-P) (COLORMAP COLORMAP-P)
                         (NULL NULL) (INTEGER INTEGERP)))))
           (COND
            (PREDICATE
             (ECLECTOR.READER:QUASIQUOTE
              ((ECLECTOR.READER:UNQUOTE (SECOND PREDICATE))
               (ECLECTOR.READER:UNQUOTE OBJECT))))
            ((EQ TYPE 'GENERALIZED-BOOLEAN) 'T)
            (+TYPE-CHECK?+
             (ECLECTOR.READER:QUASIQUOTE
              (LOCALLY
               (DECLARE (OPTIMIZE SAFETY))
               (TYPEP (ECLECTOR.READER:UNQUOTE OBJECT)
                      '(ECLECTOR.READER:UNQUOTE TYPE)))))
            (T
             (ECLECTOR.READER:QUASIQUOTE
              (TYPEP (ECLECTOR.READER:UNQUOTE OBJECT)
                     '(ECLECTOR.READER:UNQUOTE TYPE)))))))))

[clx/dependent.lisp:61]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (DEFCONSTANT +BUFFER-SPEED+ 1 "Speed compiler option for buffer code.")
    (DEFCONSTANT +BUFFER-SAFETY+ 3 "Safety compiler option for buffer code.")
    (DEFCONSTANT +BUFFER-DEBUG+ 3 "Debug compiler option for buffer code>")
    (DEFUN DECLARE-BUFMAC ()
      (ECLECTOR.READER:QUASIQUOTE
       (DECLARE
        (OPTIMIZE (SPEED (ECLECTOR.READER:UNQUOTE +BUFFER-SPEED+))
         (SAFETY (ECLECTOR.READER:UNQUOTE +BUFFER-SAFETY+))
         (DEBUG (ECLECTOR.READER:UNQUOTE +BUFFER-DEBUG+))))))
    (DEFUN DECLARE-BUFFUN ()
      (ECLECTOR.READER:QUASIQUOTE
       (DECLARE
        (OPTIMIZE (SPEED (ECLECTOR.READER:UNQUOTE +BUFFER-SPEED+))
         (SAFETY (ECLECTOR.READER:UNQUOTE +BUFFER-SAFETY+))
         (DEBUG (ECLECTOR.READER:UNQUOTE +BUFFER-DEBUG+)))))))

[clx/dependent.lisp:664]
  (PROGN
   (DECLAIM (INLINE YIELD))
   (DEFUN YIELD ()
     (DECLARE (OPTIMIZE SPEED (SAFETY 0)))
     (ALIEN-FUNCALL (EXTERN-ALIEN "sched_yield" #'INT))
     (VALUES)))

[clx/exclcmac.lisp:22]
  (#S(FORMGREP:SYMREF :NAME "DEFCMACRO" :QUALIFIER "EXCL") CARD8P (X)
   (LET ((XX (GENSYM)))
     (ECLECTOR.READER:QUASIQUOTE
      (LET (((ECLECTOR.READER:UNQUOTE XX) (ECLECTOR.READER:UNQUOTE X)))
        (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
                 (FIXNUM (ECLECTOR.READER:UNQUOTE XX)))
        (AND
         (#S(FORMGREP:SYMREF :NAME "FIXNUMP" :QUALIFIER "EXCL")
          (ECLECTOR.READER:UNQUOTE XX))
         (> NIL (ECLECTOR.READER:UNQUOTE XX))
         (>= (ECLECTOR.READER:UNQUOTE XX) 0))))))

[clx/exclcmac.lisp:29]
  (#S(FORMGREP:SYMREF :NAME "DEFCMACRO" :QUALIFIER "EXCL") CARD16P (X)
   (LET ((XX (GENSYM)))
     (ECLECTOR.READER:QUASIQUOTE
      (LET (((ECLECTOR.READER:UNQUOTE XX) (ECLECTOR.READER:UNQUOTE X)))
        (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
                 (FIXNUM (ECLECTOR.READER:UNQUOTE XX)))
        (AND
         (#S(FORMGREP:SYMREF :NAME "FIXNUMP" :QUALIFIER "EXCL")
          (ECLECTOR.READER:UNQUOTE XX))
         (> NIL (ECLECTOR.READER:UNQUOTE XX))
         (>= (ECLECTOR.READER:UNQUOTE XX) 0))))))

[clx/exclcmac.lisp:36]
  (#S(FORMGREP:SYMREF :NAME "DEFCMACRO" :QUALIFIER "EXCL") INT8P (X)
   (LET ((XX (GENSYM)))
     (ECLECTOR.READER:QUASIQUOTE
      (LET (((ECLECTOR.READER:UNQUOTE XX) (ECLECTOR.READER:UNQUOTE X)))
        (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
                 (FIXNUM (ECLECTOR.READER:UNQUOTE XX)))
        (AND
         (#S(FORMGREP:SYMREF :NAME "FIXNUMP" :QUALIFIER "EXCL")
          (ECLECTOR.READER:UNQUOTE XX))
         (> NIL (ECLECTOR.READER:UNQUOTE XX))
         (>= (ECLECTOR.READER:UNQUOTE XX) NIL))))))

[clx/exclcmac.lisp:43]
  (#S(FORMGREP:SYMREF :NAME "DEFCMACRO" :QUALIFIER "EXCL") INT16P (X)
   (LET ((XX (GENSYM)))
     (ECLECTOR.READER:QUASIQUOTE
      (LET (((ECLECTOR.READER:UNQUOTE XX) (ECLECTOR.READER:UNQUOTE X)))
        (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
                 (FIXNUM (ECLECTOR.READER:UNQUOTE XX)))
        (AND
         (#S(FORMGREP:SYMREF :NAME "FIXNUMP" :QUALIFIER "EXCL")
          (ECLECTOR.READER:UNQUOTE XX))
         (> NIL (ECLECTOR.READER:UNQUOTE XX))
         (>= (ECLECTOR.READER:UNQUOTE XX) NIL))))))

[clx/excldefsys.lisp:27]
  (SETQ #S(FORMGREP:SYMREF
           :NAME "GENERATE-INTERRUPT-CHECKS-SWITCH"
           :QUALIFIER "COMPILER")
          (COMPILE NIL
                   '(LAMBDA (SAFETY SIZE SPEED)
                      (DECLARE (IGNORE SIZE))
                      (OR (< SPEED 3) (> SAFETY 0)))))

[clx/excldep.lisp:87]
  (DEFUN CARD8P (X)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (FIXNUM X))
    (IF (AND (#S(FORMGREP:SYMREF :NAME "FIXNUMP" :QUALIFIER "EXCL") X)
             (> NIL X) (>= X 0))
        T
        NIL))

[clx/excldep.lisp:94]
  (DEFUN CARD16P (X)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (FIXNUM X))
    (IF (AND (#S(FORMGREP:SYMREF :NAME "FIXNUMP" :QUALIFIER "EXCL") X)
             (> NIL X) (>= X 0))
        T
        NIL))

[clx/excldep.lisp:101]
  (DEFUN CARD29P (X)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (IF (OR
         (AND (#S(FORMGREP:SYMREF :NAME "FIXNUMP" :QUALIFIER "EXCL") X)
              (>= (THE FIXNUM X) 0))
         (AND (#S(FORMGREP:SYMREF :NAME "BIGNUMP" :QUALIFIER "EXCL") X)
              (> NIL (THE BIGNUM X)) (>= (THE BIGNUM X) 0)))
        T
        NIL))

[clx/excldep.lisp:109]
  (DEFUN CARD32P (X)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (IF (OR
         (AND (#S(FORMGREP:SYMREF :NAME "FIXNUMP" :QUALIFIER "EXCL") X)
              (>= (THE FIXNUM X) 0))
         (AND (#S(FORMGREP:SYMREF :NAME "BIGNUMP" :QUALIFIER "EXCL") X)
              (> NIL (THE BIGNUM X)) (>= (THE BIGNUM X) 0)))
        T
        NIL))

[clx/excldep.lisp:117]
  (DEFUN INT8P (X)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (FIXNUM X))
    (IF (AND (#S(FORMGREP:SYMREF :NAME "FIXNUMP" :QUALIFIER "EXCL") X)
             (> NIL X) (>= X NIL))
        T
        NIL))

[clx/excldep.lisp:124]
  (DEFUN INT16P (X)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (FIXNUM X))
    (IF (AND (#S(FORMGREP:SYMREF :NAME "FIXNUMP" :QUALIFIER "EXCL") X)
             (> NIL X) (>= X NIL))
        T
        NIL))

[clx/excldep.lisp:131]
  (DEFUN INT32P (X)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (IF (OR (#S(FORMGREP:SYMREF :NAME "FIXNUMP" :QUALIFIER "EXCL") X)
            (AND (#S(FORMGREP:SYMREF :NAME "BIGNUMP" :QUALIFIER "EXCL") X)
                 (> NIL (THE BIGNUM X)) (>= (THE BIGNUM X) NIL)))
        T
        NIL))

[clx/excldep.lisp:142]
  (DEFUN ANGLEP (X)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (IF (OR
         (AND (#S(FORMGREP:SYMREF :NAME "FIXNUMP" :QUALIFIER "EXCL") X)
              (>= (THE FIXNUM X) NIL) (<= (THE FIXNUM X) NIL))
         (AND (#S(FORMGREP:SYMREF :NAME "SINGLE-FLOAT-P" :QUALIFIER "EXCL") X)
              (>= (THE SINGLE-FLOAT X) NIL) (<= (THE SINGLE-FLOAT X) NIL))
         (AND (#S(FORMGREP:SYMREF :NAME "DOUBLE-FLOAT-P" :QUALIFIER "EXCL") X)
              (>= (THE DOUBLE-FLOAT X) NIL) (<= (THE DOUBLE-FLOAT X) NIL)))
        T
        NIL))

[clx/excldep.lisp:165]
  (DEFMACRO WITH-INTERRUPT-CHECKING-ON (&BODY BODY)
    (ECLECTOR.READER:QUASIQUOTE
     (LOCALLY
      (DECLARE (OPTIMIZE (SAFETY 1)))
      (ECLECTOR.READER:UNQUOTE-SPLICING BODY))))

[clx/extensions/glx.lisp:75]
  (EVAL-WHEN (:COMPILE-TOPLEVEL) (DECLAIM (OPTIMIZE (DEBUG 3) (SAFETY 3))))

[clx/macros.lisp:951]
  (DEFMACRO THREADED-ATOMIC-PUSH (ITEM LIST NEXT TYPE)
    (LET ((X (GENSYM)) (Y (GENSYM)))
      (ECLECTOR.READER:QUASIQUOTE
       (LET (((ECLECTOR.READER:UNQUOTE X) (ECLECTOR.READER:UNQUOTE ITEM)))
         (DECLARE
          (TYPE (ECLECTOR.READER:UNQUOTE TYPE) (ECLECTOR.READER:UNQUOTE X)))
         (LOOP
          (LET (((ECLECTOR.READER:UNQUOTE Y) (ECLECTOR.READER:UNQUOTE LIST)))
            (DECLARE
             (TYPE (OR NULL (ECLECTOR.READER:UNQUOTE TYPE))
              (ECLECTOR.READER:UNQUOTE Y))
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
            (SETF ((ECLECTOR.READER:UNQUOTE NEXT) (ECLECTOR.READER:UNQUOTE X))
                    (ECLECTOR.READER:UNQUOTE Y))
            (WHEN
                (CONDITIONAL-STORE (ECLECTOR.READER:UNQUOTE LIST)
                 (ECLECTOR.READER:UNQUOTE Y) (ECLECTOR.READER:UNQUOTE X))
              (RETURN (ECLECTOR.READER:UNQUOTE X)))))))))

[clx/macros.lisp:964]
  (DEFMACRO THREADED-ATOMIC-POP (LIST NEXT TYPE)
    (LET ((Y (GENSYM)))
      (ECLECTOR.READER:QUASIQUOTE
       (LOOP
        (LET (((ECLECTOR.READER:UNQUOTE Y) (ECLECTOR.READER:UNQUOTE LIST)))
          (DECLARE
           (TYPE (OR NULL (ECLECTOR.READER:UNQUOTE TYPE))
            (ECLECTOR.READER:UNQUOTE Y))
           (OPTIMIZE (SPEED 3) (SAFETY 0)))
          (IF (NULL (ECLECTOR.READER:UNQUOTE Y))
              (RETURN NIL)
              (WHEN
                  (CONDITIONAL-STORE (ECLECTOR.READER:UNQUOTE LIST)
                   (ECLECTOR.READER:UNQUOTE Y)
                   ((ECLECTOR.READER:UNQUOTE NEXT)
                    (THE (ECLECTOR.READER:UNQUOTE TYPE)
                         (ECLECTOR.READER:UNQUOTE Y))))
                (SETF ((ECLECTOR.READER:UNQUOTE NEXT)
                       (THE (ECLECTOR.READER:UNQUOTE TYPE)
                            (ECLECTOR.READER:UNQUOTE Y)))
                        NIL)
                (RETURN (ECLECTOR.READER:UNQUOTE Y)))))))))

[clx/macros.lisp:976]
  (DEFMACRO THREADED-NCONC (ITEM LIST NEXT TYPE)
    (LET ((FIRST (GENSYM)) (X (GENSYM)) (Y (GENSYM)) (Z (GENSYM)))
      (ECLECTOR.READER:QUASIQUOTE
       (LET (((ECLECTOR.READER:UNQUOTE Z) (ECLECTOR.READER:UNQUOTE ITEM))
             ((ECLECTOR.READER:UNQUOTE FIRST) (ECLECTOR.READER:UNQUOTE LIST)))
         (DECLARE
          (TYPE (ECLECTOR.READER:UNQUOTE TYPE) (ECLECTOR.READER:UNQUOTE Z))
          (TYPE (OR NULL (ECLECTOR.READER:UNQUOTE TYPE))
           (ECLECTOR.READER:UNQUOTE FIRST))
          (OPTIMIZE (SPEED 3) (SAFETY 0)))
         (IF (NULL (ECLECTOR.READER:UNQUOTE FIRST))
             (SETF (ECLECTOR.READER:UNQUOTE LIST) (ECLECTOR.READER:UNQUOTE Z))
             (DO* (((ECLECTOR.READER:UNQUOTE X) (ECLECTOR.READER:UNQUOTE FIRST)
                                                (ECLECTOR.READER:UNQUOTE Y))
                   ((ECLECTOR.READER:UNQUOTE Y) ((ECLECTOR.READER:UNQUOTE NEXT)
                                                 (ECLECTOR.READER:UNQUOTE X))
                                                ((ECLECTOR.READER:UNQUOTE NEXT)
                                                 (ECLECTOR.READER:UNQUOTE X))))
                  ((NULL (ECLECTOR.READER:UNQUOTE Y))
                   (SETF ((ECLECTOR.READER:UNQUOTE NEXT)
                          (ECLECTOR.READER:UNQUOTE X))
                           (ECLECTOR.READER:UNQUOTE Z))
                   (ECLECTOR.READER:UNQUOTE FIRST))
               (DECLARE
                (TYPE (ECLECTOR.READER:UNQUOTE TYPE)
                 (ECLECTOR.READER:UNQUOTE X))
                (TYPE (OR NULL (ECLECTOR.READER:UNQUOTE TYPE))
                 (ECLECTOR.READER:UNQUOTE Y)))))))))

[clx/macros.lisp:996]
  (DEFMACRO THREADED-PUSH (ITEM LIST NEXT TYPE)
    (LET ((X (GENSYM)))
      (ECLECTOR.READER:QUASIQUOTE
       (LET (((ECLECTOR.READER:UNQUOTE X) (ECLECTOR.READER:UNQUOTE ITEM)))
         (DECLARE
          (TYPE (ECLECTOR.READER:UNQUOTE TYPE) (ECLECTOR.READER:UNQUOTE X))
          (OPTIMIZE (SPEED 3) (SAFETY 0)))
         (SHIFTF ((ECLECTOR.READER:UNQUOTE NEXT) (ECLECTOR.READER:UNQUOTE X))
                 (ECLECTOR.READER:UNQUOTE LIST) (ECLECTOR.READER:UNQUOTE X))
         (ECLECTOR.READER:UNQUOTE X)))))

[clx/macros.lisp:1004]
  (DEFMACRO THREADED-POP (LIST NEXT TYPE)
    (LET ((X (GENSYM)))
      (ECLECTOR.READER:QUASIQUOTE
       (LET (((ECLECTOR.READER:UNQUOTE X) (ECLECTOR.READER:UNQUOTE LIST)))
         (DECLARE
          (TYPE (OR NULL (ECLECTOR.READER:UNQUOTE TYPE))
           (ECLECTOR.READER:UNQUOTE X))
          (OPTIMIZE (SPEED 3) (SAFETY 0)))
         (WHEN (ECLECTOR.READER:UNQUOTE X)
           (SHIFTF (ECLECTOR.READER:UNQUOTE LIST)
                   ((ECLECTOR.READER:UNQUOTE NEXT)
                    (THE (ECLECTOR.READER:UNQUOTE TYPE)
                         (ECLECTOR.READER:UNQUOTE X)))
                   NIL))
         (ECLECTOR.READER:UNQUOTE X)))))

[clx/macros.lisp:1013]
  (DEFMACRO THREADED-ENQUEUE (ITEM HEAD TAIL NEXT TYPE)
    (LET ((X (GENSYM)))
      (ECLECTOR.READER:QUASIQUOTE
       (LET (((ECLECTOR.READER:UNQUOTE X) (ECLECTOR.READER:UNQUOTE ITEM)))
         (DECLARE
          (TYPE (ECLECTOR.READER:UNQUOTE TYPE) (ECLECTOR.READER:UNQUOTE X))
          (OPTIMIZE (SPEED 3) (SAFETY 0)))
         (IF (NULL (ECLECTOR.READER:UNQUOTE TAIL))
             (THREADED-NCONC (ECLECTOR.READER:UNQUOTE X)
              (ECLECTOR.READER:UNQUOTE HEAD) (ECLECTOR.READER:UNQUOTE NEXT)
              (ECLECTOR.READER:UNQUOTE TYPE))
             (THREADED-NCONC (ECLECTOR.READER:UNQUOTE X)
              ((ECLECTOR.READER:UNQUOTE NEXT)
               (THE (ECLECTOR.READER:UNQUOTE TYPE)
                    (ECLECTOR.READER:UNQUOTE TAIL)))
              (ECLECTOR.READER:UNQUOTE NEXT) (ECLECTOR.READER:UNQUOTE TYPE)))
         (SETF (ECLECTOR.READER:UNQUOTE TAIL) (ECLECTOR.READER:UNQUOTE X))))))

[clx/macros.lisp:1023]
  (DEFMACRO THREADED-DEQUEUE (HEAD TAIL NEXT TYPE)
    (LET ((X (GENSYM)))
      (ECLECTOR.READER:QUASIQUOTE
       (LET (((ECLECTOR.READER:UNQUOTE X) (ECLECTOR.READER:UNQUOTE HEAD)))
         (DECLARE
          (TYPE (OR NULL (ECLECTOR.READER:UNQUOTE TYPE))
           (ECLECTOR.READER:UNQUOTE X))
          (OPTIMIZE (SPEED 3) (SAFETY 0)))
         (WHEN (ECLECTOR.READER:UNQUOTE X)
           (WHEN
               (EQ (ECLECTOR.READER:UNQUOTE X) (ECLECTOR.READER:UNQUOTE TAIL))
             (SETF (ECLECTOR.READER:UNQUOTE TAIL)
                     ((ECLECTOR.READER:UNQUOTE NEXT)
                      (THE (ECLECTOR.READER:UNQUOTE TYPE)
                           (ECLECTOR.READER:UNQUOTE X)))))
           (SETF (ECLECTOR.READER:UNQUOTE HEAD)
                   ((ECLECTOR.READER:UNQUOTE NEXT)
                    (THE (ECLECTOR.READER:UNQUOTE TYPE)
                         (ECLECTOR.READER:UNQUOTE X)))))
         (ECLECTOR.READER:UNQUOTE X)))))

[clx/macros.lisp:1034]
  (DEFMACRO THREADED-REQUEUE (ITEM HEAD TAIL NEXT TYPE)
    (LET ((X (GENSYM)))
      (ECLECTOR.READER:QUASIQUOTE
       (LET (((ECLECTOR.READER:UNQUOTE X) (ECLECTOR.READER:UNQUOTE ITEM)))
         (DECLARE
          (TYPE (ECLECTOR.READER:UNQUOTE TYPE) (ECLECTOR.READER:UNQUOTE X))
          (OPTIMIZE (SPEED 3) (SAFETY 0)))
         (IF (NULL (ECLECTOR.READER:UNQUOTE TAIL))
             (SETF (ECLECTOR.READER:UNQUOTE TAIL)
                     (SETF (ECLECTOR.READER:UNQUOTE HEAD)
                             (ECLECTOR.READER:UNQUOTE X)))
             (SHIFTF
              ((ECLECTOR.READER:UNQUOTE NEXT) (ECLECTOR.READER:UNQUOTE X))
              (ECLECTOR.READER:UNQUOTE HEAD) (ECLECTOR.READER:UNQUOTE X)))
         (ECLECTOR.READER:UNQUOTE X)))))

[clx/macros.lisp:1051]
  (DEFMACRO THREADED-DELETE (ITEM LIST NEXT TYPE)
    (LET ((X (GENSYM)) (Y (GENSYM)) (Z (GENSYM)) (FIRST (GENSYM)))
      (ECLECTOR.READER:QUASIQUOTE
       (LET (((ECLECTOR.READER:UNQUOTE X) (ECLECTOR.READER:UNQUOTE ITEM))
             ((ECLECTOR.READER:UNQUOTE FIRST) (ECLECTOR.READER:UNQUOTE LIST)))
         (DECLARE
          (TYPE (ECLECTOR.READER:UNQUOTE TYPE) (ECLECTOR.READER:UNQUOTE X))
          (TYPE (OR NULL (ECLECTOR.READER:UNQUOTE TYPE))
           (ECLECTOR.READER:UNQUOTE FIRST))
          (OPTIMIZE (SPEED 3) (SAFETY 0)))
         (WHEN (ECLECTOR.READER:UNQUOTE FIRST)
           (IF (EQ (ECLECTOR.READER:UNQUOTE FIRST) (ECLECTOR.READER:UNQUOTE X))
               (SETF (ECLECTOR.READER:UNQUOTE FIRST)
                       (SETF (ECLECTOR.READER:UNQUOTE LIST)
                               ((ECLECTOR.READER:UNQUOTE NEXT)
                                (ECLECTOR.READER:UNQUOTE X))))
               (DO* (((ECLECTOR.READER:UNQUOTE Y) (ECLECTOR.READER:UNQUOTE
                                                   FIRST)
                                                  (ECLECTOR.READER:UNQUOTE Z))
                     ((ECLECTOR.READER:UNQUOTE Z) ((ECLECTOR.READER:UNQUOTE
                                                    NEXT)
                                                   (ECLECTOR.READER:UNQUOTE Y))
                                                  ((ECLECTOR.READER:UNQUOTE
                                                    NEXT)
                                                   (ECLECTOR.READER:UNQUOTE
                                                    Y))))
                    ((OR (NULL (ECLECTOR.READER:UNQUOTE Z))
                         (EQ (ECLECTOR.READER:UNQUOTE Z)
                             (ECLECTOR.READER:UNQUOTE X)))
                     (WHEN
                         (EQ (ECLECTOR.READER:UNQUOTE Z)
                             (ECLECTOR.READER:UNQUOTE X))
                       (SETF ((ECLECTOR.READER:UNQUOTE NEXT)
                              (ECLECTOR.READER:UNQUOTE Y))
                               ((ECLECTOR.READER:UNQUOTE NEXT)
                                (ECLECTOR.READER:UNQUOTE X)))))
                 (DECLARE
                  (TYPE (ECLECTOR.READER:UNQUOTE TYPE)
                   (ECLECTOR.READER:UNQUOTE Y)))
                 (DECLARE
                  (TYPE (OR NULL (ECLECTOR.READER:UNQUOTE TYPE))
                   (ECLECTOR.READER:UNQUOTE Z))))))
         (SETF ((ECLECTOR.READER:UNQUOTE NEXT) (ECLECTOR.READER:UNQUOTE X))
                 NIL)
         (ECLECTOR.READER:UNQUOTE FIRST)))))

[clx/macros.lisp:1074]
  (DEFMACRO THREADED-LENGTH (LIST NEXT TYPE)
    (LET ((X (GENSYM)) (COUNT (GENSYM)))
      (ECLECTOR.READER:QUASIQUOTE
       (DO (((ECLECTOR.READER:UNQUOTE X) (ECLECTOR.READER:UNQUOTE LIST)
                                         ((ECLECTOR.READER:UNQUOTE NEXT)
                                          (THE (ECLECTOR.READER:UNQUOTE TYPE)
                                               (ECLECTOR.READER:UNQUOTE X))))
            ((ECLECTOR.READER:UNQUOTE COUNT) 0
                                             (INDEX1+
                                              (ECLECTOR.READER:UNQUOTE
                                               COUNT))))
           ((NULL (ECLECTOR.READER:UNQUOTE X)) (ECLECTOR.READER:UNQUOTE COUNT))
         (DECLARE
          (TYPE (OR NULL (ECLECTOR.READER:UNQUOTE TYPE))
           (ECLECTOR.READER:UNQUOTE X))
          (TYPE ARRAY-INDEX (ECLECTOR.READER:UNQUOTE COUNT))
          (OPTIMIZE (SPEED 3) (SAFETY 0)))))))

[coalton/benchmarks/big-float.lisp:66]
  (DECLAIM (OPTIMIZE (SPEED 3) (SAFETY 1)))

[coalton/benchmarks/fibonacci.lisp:57]
  (DEFUN LISP-FIB (N)
    (DECLARE (TYPE INTEGER N)
             (VALUES INTEGER)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (WHEN (= N 0) (RETURN-FROM LISP-FIB 0))
    (WHEN (= N 1) (RETURN-FROM LISP-FIB 1))
    (+ (LISP-FIB (- N 1)) (LISP-FIB (- N 2))))

[coalton/benchmarks/fibonacci.lisp:71]
  (DECLAIM (OPTIMIZE (SPEED 3) (SAFETY 0)))

[coalton/docs/design-docs/function-calls-benchmarks.lisp:15]
  (DEFMACRO DEFINE-FUNCTION-MACROS ()
    (LABELS ((DEFINE-FUNCTION-MACROS-WITH-ARITY (ARITY)
               (DECLARE (TYPE FIXNUM ARITY))
               (LET ((CONSTRUCTOR-SYM (INTERN (FORMAT NIL "F~D" ARITY)))
                     (APPLICATION-SYM (INTERN (FORMAT NIL "A~D" ARITY)))
                     (FUNCTION-SYM (ALEXANDRIA:MAKE-GENSYM "F"))
                     (ARG-SYMS (ALEXANDRIA:MAKE-GENSYM-LIST ARITY)))
                 (LABELS ((BUILD-CURRIED-FUNCTION (ARGS)
                            (IF (NULL (CAR ARGS))
                                (ECLECTOR.READER:QUASIQUOTE
                                 (FUNCALL
                                  (ECLECTOR.READER:UNQUOTE FUNCTION-SYM)
                                  (ECLECTOR.READER:UNQUOTE-SPLICING ARG-SYMS)))
                                (ECLECTOR.READER:QUASIQUOTE
                                 (LAMBDA ((ECLECTOR.READER:UNQUOTE (CAR ARGS)))
                                   (ECLECTOR.READER:UNQUOTE
                                    (BUILD-CURRIED-FUNCTION (CDR ARGS)))))))
                          (BUILD-CURRIED-FUNCTION-TYPE (ARITY)
                            (IF (= 0 ARITY)
                                'T
                                (ECLECTOR.READER:QUASIQUOTE
                                 (FUNCTION (T)
                                  (ECLECTOR.READER:UNQUOTE
                                   (BUILD-CURRIED-FUNCTION-TYPE
                                    (1- ARITY)))))))
                          (BUILD-CURRIED-FUNCTION-CALL (FUN ARGS)
                            (IF (NULL (CAR ARGS))
                                (ECLECTOR.READER:QUASIQUOTE
                                 (THE
                                  (ECLECTOR.READER:UNQUOTE
                                   (BUILD-CURRIED-FUNCTION-TYPE ARITY))
                                  (ECLECTOR.READER:UNQUOTE FUN)))
                                (ECLECTOR.READER:QUASIQUOTE
                                 (FUNCALL
                                  (ECLECTOR.READER:UNQUOTE
                                   (BUILD-CURRIED-FUNCTION-CALL FUN
                                    (CDR ARGS)))
                                  (ECLECTOR.READER:UNQUOTE (CAR ARGS)))))))
                   (ECLECTOR.READER:QUASIQUOTE
                    (PROGN
                     (DECLAIM
                      (INLINE (ECLECTOR.READER:UNQUOTE CONSTRUCTOR-SYM)))
                     (DEFUN (ECLECTOR.READER:UNQUOTE CONSTRUCTOR-SYM)
                            ((ECLECTOR.READER:UNQUOTE FUNCTION-SYM))
                       (DECLARE
                        (TYPE
                         (FUNCTION
                          (ECLECTOR.READER:UNQUOTE
                           (LOOP :FOR I :BELOW ARITY
                                 :COLLECT (QUOTE T)))
                          T)
                         (ECLECTOR.READER:UNQUOTE FUNCTION-SYM))
                        (OPTIMIZE (SPEED 3) (SAFETY 0))
                        (VALUES FUNCTION-ENTRY))
                       (MAKE-FUNCTION-ENTRY :ARITY
                        (ECLECTOR.READER:UNQUOTE ARITY) :FUNCTION
                        (ECLECTOR.READER:UNQUOTE FUNCTION-SYM) :CURRIED
                        (ECLECTOR.READER:UNQUOTE
                         (BUILD-CURRIED-FUNCTION ARG-SYMS))))
                     (DECLAIM
                      (INLINE (ECLECTOR.READER:UNQUOTE APPLICATION-SYM)))
                     (DEFUN (ECLECTOR.READER:UNQUOTE APPLICATION-SYM)
                            ((ECLECTOR.READER:UNQUOTE FUNCTION-SYM)
                             (ECLECTOR.READER:UNQUOTE-SPLICING ARG-SYMS))
                       (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
                                (TYPE (OR FUNCTION FUNCTION-ENTRY)
                                 (ECLECTOR.READER:UNQUOTE FUNCTION-SYM)))
                       (TYPECASE (ECLECTOR.READER:UNQUOTE FUNCTION-SYM)
                         (FUNCTION-ENTRY
                          (IF (=
                               (FUNCTION-ENTRY-ARITY
                                (ECLECTOR.READER:UNQUOTE FUNCTION-SYM))
                               (ECLECTOR.READER:UNQUOTE ARITY))
                              (FUNCALL
                               (THE
                                (FUNCTION
                                 (ECLECTOR.READER:UNQUOTE
                                  (LOOP :FOR I :BELOW ARITY
                                        :COLLECT 'T))
                                 T)
                                (FUNCTION-ENTRY-FUNCTION
                                 (ECLECTOR.READER:UNQUOTE FUNCTION-SYM)))
                               (ECLECTOR.READER:UNQUOTE-SPLICING ARG-SYMS))
                              (ECLECTOR.READER:UNQUOTE
                               (BUILD-CURRIED-FUNCTION-CALL
                                (ECLECTOR.READER:QUASIQUOTE
                                 (FUNCTION-ENTRY-CURRIED
                                  (ECLECTOR.READER:UNQUOTE FUNCTION-SYM)))
                                (REVERSE ARG-SYMS)))))
                         (FUNCTION
                          (ECLECTOR.READER:UNQUOTE
                           (BUILD-CURRIED-FUNCTION-CALL FUNCTION-SYM
                            ARG-SYMS)))))))))))
      (ECLECTOR.READER:QUASIQUOTE
       (PROGN
        (ECLECTOR.READER:UNQUOTE-SPLICING
         (LOOP :FOR I :OF-TYPE FIXNUM :FROM 2 :BELOW 10
               :COLLECT (DEFINE-FUNCTION-MACROS-WITH-ARITY I)))))))

[coalton/docs/design-docs/function-calls-benchmarks.lisp:68]
  (DEFUN ADD3 (A B C)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE (SIGNED-BYTE 32) A B C)
             (VALUES (SIGNED-BYTE 32)))
    (+ A B C))

[coalton/docs/design-docs/function-calls-benchmarks.lisp:82]
  (DEFUN ADD4-CURRIED (A)
    (DECLARE (TYPE (SIGNED-BYTE 32) A)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LAMBDA (B)
      (DECLARE (TYPE (SIGNED-BYTE 32) B)
               (OPTIMIZE (SPEED 3) (SAFETY 0)))
      (LAMBDA (C)
        (DECLARE (TYPE (SIGNED-BYTE 32) C)
                 (OPTIMIZE (SPEED 3) (SAFETY 0)))
        (LAMBDA (D)
          (DECLARE (TYPE (SIGNED-BYTE 32) D)
                   (OPTIMIZE (SPEED 3) (SAFETY 0)))
          (+ A B C D)))))

[coalton/docs/design-docs/function-calls-benchmarks.lisp:106]
  (DEFUN RUN-FADD4 (A B C D)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (A4 (THE (OR FUNCTION FUNCTION-ENTRY) FADD4) A B C D))

[coalton/docs/design-docs/function-calls-benchmarks.lisp:112]
  (#S(FORMGREP:SYMREF :NAME "DEFINE-BENCHMARK" :QUALIFIER "TRIVIAL-BENCHMARK")
   BENCHMARK-ADD4 NIL (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
   (LOOP :FOR I :BELOW 10000
         :FOR J :BELOW 10000
         :FOR K :BELOW 10000
         :FOR L :BELOW 10000
         :DO (#S(FORMGREP:SYMREF
                 :NAME "WITH-BENCHMARK-SAMPLING"
                 :QUALIFIER "TRIVIAL-BENCHMARK")
              (DOTIMES (_ 10000) (ADD4 I _ K L)))))

[coalton/docs/design-docs/function-calls-benchmarks.lisp:122]
  (#S(FORMGREP:SYMREF :NAME "DEFINE-BENCHMARK" :QUALIFIER "TRIVIAL-BENCHMARK")
   BENCHMARK-FADD4 NIL (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
   (LOOP :FOR I :BELOW 10000
         :FOR J :BELOW 10000
         :FOR K :BELOW 10000
         :FOR L :BELOW 10000
         :DO (#S(FORMGREP:SYMREF
                 :NAME "WITH-BENCHMARK-SAMPLING"
                 :QUALIFIER "TRIVIAL-BENCHMARK")
              (DOTIMES (_ 10000)
                (A4 (THE (OR FUNCTION-ENTRY FUNCTION) FADD4) I _ K L)))))

[coalton/docs/design-docs/function-calls-benchmarks.lisp:132]
  (#S(FORMGREP:SYMREF :NAME "DEFINE-BENCHMARK" :QUALIFIER "TRIVIAL-BENCHMARK")
   BENCHMARK-ADD4-A4 NIL (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
   (LOOP :FOR I :BELOW 10000
         :FOR J :BELOW 10000
         :FOR K :BELOW 10000
         :FOR L :BELOW 10000
         :DO (#S(FORMGREP:SYMREF
                 :NAME "WITH-BENCHMARK-SAMPLING"
                 :QUALIFIER "TRIVIAL-BENCHMARK")
              (DOTIMES (_ 10000) (A4 #'ADD4-CURRIED I _ K L)))))

[coalton/docs/design-docs/function-calls-benchmarks.lisp:142]
  (#S(FORMGREP:SYMREF :NAME "DEFINE-BENCHMARK" :QUALIFIER "TRIVIAL-BENCHMARK")
   BENCHMARK-UNOPTIMIZED-ADD4 NIL (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
   (LOOP :FOR I :BELOW 10000
         :FOR J :BELOW 10000
         :FOR K :BELOW 10000
         :FOR L :BELOW 10000
         :DO (#S(FORMGREP:SYMREF
                 :NAME "WITH-BENCHMARK-SAMPLING"
                 :QUALIFIER "TRIVIAL-BENCHMARK")
              (DOTIMES (_ 10000) (UNOPTIMIZED-ADD4 I _ K L)))))

[coalton/docs/design-docs/function-calls-benchmarks.lisp:152]
  (#S(FORMGREP:SYMREF :NAME "DEFINE-BENCHMARK" :QUALIFIER "TRIVIAL-BENCHMARK")
   BENCHMARK-UNOPTIMIZED-FADD4 NIL (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
   (LOOP :FOR I :BELOW 10000
         :FOR J :BELOW 10000
         :FOR K :BELOW 10000
         :FOR L :BELOW 10000
         :DO (#S(FORMGREP:SYMREF
                 :NAME "WITH-BENCHMARK-SAMPLING"
                 :QUALIFIER "TRIVIAL-BENCHMARK")
              (DOTIMES (_ 10000)
                (A4 (THE FUNCTION-ENTRY FADD4-NO-TYPES) I _ K L)))))

[coalton/docs/design-docs/function-calls-benchmarks.lisp:162]
  (#S(FORMGREP:SYMREF :NAME "DEFINE-BENCHMARK" :QUALIFIER "TRIVIAL-BENCHMARK")
   BENCHMARK-FADD4-A2-A2 NIL (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
   (LOOP :FOR I :BELOW 10000
         :FOR J :BELOW 10000
         :FOR K :BELOW 10000
         :FOR L :BELOW 10000
         :DO (#S(FORMGREP:SYMREF
                 :NAME "WITH-BENCHMARK-SAMPLING"
                 :QUALIFIER "TRIVIAL-BENCHMARK")
              (DOTIMES (_ 10000)
                (A2 (A2 (THE FUNCTION-ENTRY FADD4) I _) K L)))))

[coalton/docs/design-docs/function-calls-benchmarks.lisp:172]
  (#S(FORMGREP:SYMREF :NAME "DEFINE-BENCHMARK" :QUALIFIER "TRIVIAL-BENCHMARK")
   BENCHMARK-NOOP NIL (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
   (LOOP :FOR I :BELOW 10000
         :FOR J :BELOW 10000
         :FOR K :BELOW 10000
         :FOR L :BELOW 10000
         :DO (#S(FORMGREP:SYMREF
                 :NAME "WITH-BENCHMARK-SAMPLING"
                 :QUALIFIER "TRIVIAL-BENCHMARK")
              (DOTIMES (_ 10000) NIL))))

[coalton/examples/small-coalton-programs/src/microbench1.lisp:32]
  (DECLAIM (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))

[coalton/examples/small-coalton-programs/src/microbench1.lisp:44]
  (DECLAIM (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))

[coalton/examples/small-coalton-programs/src/microbench1.lisp:54]
  (DECLAIM (OPTIMIZE (SPEED 1) (SAFETY 1) (DEBUG 1)))

[coalton/examples/small-coalton-programs/src/microbench1.lisp:56]
  (DEFUN TIME-IT (THUNK REPEAT)
    "Run THUNK a total of REPEAT times, and return the number of
milliseconds it took."
    (DECLARE (OPTIMIZE (SPEED 0) SAFETY DEBUG))
    (LET ((START (GET-INTERNAL-RUN-TIME)))
      (LOOP :REPEAT
            REPEAT
            :DO (FUNCALL THUNK))
      (ROUND (* 1000 (- (GET-INTERNAL-RUN-TIME) START))
             INTERNAL-TIME-UNITS-PER-SECOND)))

[coalton/examples/small-coalton-programs/src/microbench1.lisp:65]
  (DEFUN RUN (&OPTIONAL (SIZE (* 32 1024 1024)) (REPEAT 16))
    (LET ((A
           (MAKE-ARRAY SIZE :ELEMENT-TYPE 'SINGLE-FLOAT :INITIAL-ELEMENT 0.0))
          (B
           (MAKE-ARRAY SIZE :ELEMENT-TYPE 'SINGLE-FLOAT :INITIAL-ELEMENT 0.0))
          (C
           (MAKE-ARRAY SIZE :ELEMENT-TYPE 'SINGLE-FLOAT :INITIAL-ELEMENT 0.0)))
      (DOTIMES (I SIZE) (SETF (AREF A I) (RANDOM 1.0)))
      (REPLACE B A)
      (REPLACE C A)
      (FLET ((LISP-TEST ()
               (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
               (DOTIMES (I SIZE)
                 (DECLARE (TYPE FIXNUM I))
                 (SETF (AREF A I)
                         (#S(FORMGREP:SYMREF
                             :NAME "F"
                             :QUALIFIER "LISP-MICROBENCH1")
                          (AREF A I)))))
             (HAND-OPTIMIZED-LISP-TEST ()
               (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
               (DOTIMES (I SIZE)
                 (DECLARE (TYPE FIXNUM I))
                 (SETF (AREF A I)
                         (#S(FORMGREP:SYMREF
                             :NAME "F-HAND-OPTIMIZED"
                             :QUALIFIER "LISP-MICROBENCH1")
                          (AREF A I)))))
             (COALTON-TEST ()
               (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
               (DOTIMES (I SIZE)
                 (DECLARE (TYPE FIXNUM I))
                 (SETF (AREF A I)
                         (#S(FORMGREP:SYMREF
                             :NAME "F"
                             :QUALIFIER "COALTON-MICROBENCH1")
                          (AREF A I))))))
        (LET* ((LISP-TIME (TIME-IT #'LISP-TEST REPEAT))
               (COALTON-TIME (TIME-IT #'COALTON-TEST REPEAT))
               (HAND-OPTIMIZED-TIME
                (TIME-IT #'HAND-OPTIMIZED-LISP-TEST REPEAT))
               (DELTA (- LISP-TIME COALTON-TIME)))
          (FORMAT T "Lisp took ~D ms~%" LISP-TIME)
          (FORMAT T "Coalton took ~D ms~%" COALTON-TIME)
          (COND
           ((PLUSP DELTA)
            (FORMAT T "Coalton was faster by ~D ms (~3,2F%)~%" DELTA
                    (* 100.0 (/ DELTA LISP-TIME))))
           ((MINUSP DELTA)
            (FORMAT T "Lisp was faster by ~D ms (~3,2F%)~%" (ABS DELTA)
                    (* 100.0 (/ (ABS DELTA) COALTON-TIME))))
           (T (FORMAT T "Both Lisp and Coalton equal~%")))
          (FORMAT T "The hand-optimized function took ~D ms~%"
                  HAND-OPTIMIZED-TIME)
          (FINISH-OUTPUT)))))

[coalton/src/settings.lisp:48]
  (DEFVAR *COALTON-OPTIMIZE* '(OPTIMIZE (SPEED 3) (SAFETY 0)))

[coalton/src/settings.lisp:50]
  (DEFVAR *COALTON-OPTIMIZE-LIBRARY* '(OPTIMIZE (SPEED 3) (SAFETY 1)))

[com.google.base/optimize.lisp:38]
  (DEFPARAMETER *OPTIMIZE-DEFAULT*
    '(OPTIMIZE (COMPILATION-SPEED 0) (DEBUG 3) (SAFETY 3) (SPACE 1) (SPEED 1))
    "Compiler optimization settings that emphasize debugging over speed.  Most
code should use these settings.")

[com.google.base/optimize.lisp:43]
  (DEFPARAMETER *OPTIMIZE-FAST-UNSAFE*
    '(OPTIMIZE (COMPILATION-SPEED 0) (DEBUG 2) (SAFETY 0) (SPACE 1) (SPEED 3))
    "Compiler optimization settings that emphasize speed at the expense of
debugging and run-time safety.  Only low-level performance sensitive code that
has been extensively tested should use these settings.")

[common-cold/test-monadcc.lisp:191]
  (DEFUN FAST-FIB-ANF (N)
    (DECLARE (OPTIMIZE SPEED (SAFETY 0))
             (TYPE UNSIGNED-BYTE N))
    (IF (< N 2)
        1
        (BIND (T1 (FAST-FIB-ANF (- N 1)))
         (BIND (T2 (FAST-FIB-ANF (- N 2))) (+ T1 T2)))))

[commonqt/primitive-call.lisp:82]
  (DEFUN MAKE-OPTIMIZED (INSTANCE &KEY INSTANCE-RESOLVER ARGS RESOLVER)
    (FLET ((NUMBER-OF-NON-CONSTANTP (LIST)
             (COUNT-IF-NOT #'CONSTANTP LIST)))
      (MULTIPLE-VALUE-BIND (FIX-TYPES ARGS)
          (PARSE-OPTIMIZED-CALL-ARGS ARGS)
        (LET ((ARGSYMS (MAKE-SYMBOLS 'ARG (LENGTH ARGS)))
              (SIGSYMS (MAKE-SYMBOLS 'SIG (NUMBER-OF-NON-CONSTANTP ARGS)))
              (INSTANCE-QCLASS-SYM (GENSYM "INSTANCE-QCLASS"))
              (INSTANCE-EXTRA-SIG-SYM (GENSYM "INSTANCE-EXTRA-SIG"))
              (INSTANCE-SYM (GENSYM "INSTANCE")))
          (ECLECTOR.READER:QUASIQUOTE
           (MULTIPLE-VALUE-BIND
               ((ECLECTOR.READER:UNQUOTE INSTANCE-SYM)
                (ECLECTOR.READER:UNQUOTE INSTANCE-QCLASS-SYM)
                (ECLECTOR.READER:UNQUOTE INSTANCE-EXTRA-SIG-SYM))
               (ECLECTOR.READER:UNQUOTE (FUNCALL INSTANCE-RESOLVER INSTANCE))
             (DECLARE
              (TYPE (UNSIGNED-BYTE 24)
               (ECLECTOR.READER:UNQUOTE INSTANCE-QCLASS-SYM)))
             (LET ((ECLECTOR.READER:UNQUOTE-SPLICING
                    (ITER (FOR ARG IN ARGS) (FOR SYM IN ARGSYMS)
                     (UNLESS (CONSTANTP ARG)
                       (COLLECT
                        (ECLECTOR.READER:QUASIQUOTE
                         ((ECLECTOR.READER:UNQUOTE SYM)
                          (ECLECTOR.READER:UNQUOTE ARG))))))))
               (LET* ((TYPES '(ECLECTOR.READER:UNQUOTE FIX-TYPES))
                      (ARGS
                       (ECLECTOR.READER:UNQUOTE
                        (IF (ZEROP (NUMBER-OF-NON-CONSTANTP ARGS))
                            (ECLECTOR.READER:QUASIQUOTE
                             '(ECLECTOR.READER:UNQUOTE (MAPCAR #'EVAL ARGS)))
                            (ECLECTOR.READER:QUASIQUOTE
                             (LIST*
                              (ECLECTOR.READER:UNQUOTE-SPLICING
                               (LOOP FOR (ARG . REST) ON ARGS
                                     FOR ARGSYM IN ARGSYMS
                                     COLLECT (IF (CONSTANTP ARG)
                                                 ARG
                                                 ARGSYM)
                                     IF (ZEROP (NUMBER-OF-NON-CONSTANTP REST))
                                     COLLECT (ECLECTOR.READER:QUASIQUOTE
                                              '(ECLECTOR.READER:UNQUOTE
                                                (MAPCAR #'EVAL REST)))
                                     AND
                                     DO (LOOP-FINISH))))))))
                      (INSTANCE (ECLECTOR.READER:UNQUOTE INSTANCE-SYM))
                      (ECLECTOR.READER:UNQUOTE-SPLICING
                       (LOOP WITH SIGS = SIGSYMS
                             FOR ARG IN ARGS
                             FOR ARGSYM IN ARGSYMS
                             UNLESS (CONSTANTP ARG)
                             COLLECT (ECLECTOR.READER:QUASIQUOTE
                                      ((ECLECTOR.READER:UNQUOTE (POP SIGS))
                                       (SIGNATURE-TYPE
                                        (ECLECTOR.READER:UNQUOTE ARGSYM)))))))
                 (DECLARE (DYNAMIC-EXTENT ARGS)
                          (OPTIMIZE (SAFETY 0)))
                 (CACHED-VALUES-BIND (FUN) (ECLECTOR.READER:UNQUOTE RESOLVER)
                  (((ECLECTOR.READER:UNQUOTE INSTANCE-QCLASS-SYM) :HASH T)
                   ((ECLECTOR.READER:UNQUOTE INSTANCE-EXTRA-SIG-SYM))
                   (ECLECTOR.READER:UNQUOTE-SPLICING
                    (LOOP FOR SIG IN SIGSYMS
                          COLLECT (ECLECTOR.READER:QUASIQUOTE
                                   ((ECLECTOR.READER:UNQUOTE SIG) :HASH
                                    SXHASH)))))
                  (DECLARE (TYPE CONT-FUN FUN))
                  (FUNCALL FUN (ECLECTOR.READER:UNQUOTE INSTANCE-SYM)
                           ARGS))))))))))

[commonqt/test/microbench.lisp:254]
  (DEFUN BENCH-NEW-QOBJECT/CFFI (&OPTIONAL (REPEAT *REPEAT*))
    (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
    (LET ((OBJECTS (MAKE-ARRAY REPEAT)))
      (PROG1
          (%WITH-STACK (STACK ITEM 2)
           (MEASURE-DOTIMES (X REPEAT)
            (SETF (ELT OBJECTS X)
                    (PROGN
                     (%CALL-CLASSFN <CLASSFN-QOBJECT> <MARG-QOBJECT>
                      (CFFI-SYS:NULL-POINTER) STACK)
                     (LET ((OBJECT (ITEM 0 PTR)))
                       (SETF (ITEM 1 PTR) <BINDING>)
                       (%CALL-CLASSFN <CLASSFN-QOBJECT> 0 OBJECT STACK)
                       OBJECT)))))
        (LET ((CLASS (FIND-QCLASS "QObject")))
          (ITER (FOR OBJECT IN-VECTOR OBJECTS)
           (DELETE (%QOBJECT CLASS OBJECT)))))))

[commonqt/test/microbench.lisp:274]
  (DEFUN BENCH-NEW-QCOLOR/CFFI (&OPTIONAL (REPEAT *REPEAT*))
    (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
    (LET ((OBJECTS (MAKE-ARRAY REPEAT)))
      (PROG1
          (%WITH-STACK (STACK ITEM 2)
           (MEASURE-DOTIMES (X REPEAT)
            (SETF (ELT OBJECTS X)
                    (PROGN
                     (%CALL-CLASSFN <CLASSFN-QCOLOR> <MARG-QCOLOR>
                      (CFFI-SYS:NULL-POINTER) STACK)
                     (LET ((OBJECT (ITEM 0 PTR)))
                       (SETF (ITEM 1 PTR) <BINDING>)
                       (%CALL-CLASSFN <CLASSFN-QCOLOR> 0 OBJECT STACK)
                       OBJECT)))))
        (LET ((CLASS (FIND-QCLASS "QColor")))
          (ITER (FOR OBJECT IN-VECTOR OBJECTS)
           (DELETE (%QOBJECT CLASS OBJECT)))))))

[commonqt/test/microbench.lisp:294]
  (DEFUN BENCH-NEW-QCOLOR3/CFFI (&OPTIONAL (REPEAT *REPEAT*))
    (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
    (LET ((OBJECTS (MAKE-ARRAY REPEAT)))
      (PROG1
          (%WITH-STACK (STACK ITEM 4)
           (MEASURE-DOTIMES (X REPEAT)
            (SETF (ELT OBJECTS X)
                    (PROGN
                     (SETF (ITEM 1 INT) 1)
                     (SETF (ITEM 2 INT) 2)
                     (SETF (ITEM 3 INT) 3)
                     (%CALL-CLASSFN <CLASSFN-QCOLOR> <MARG-QCOLOR/3>
                      (CFFI-SYS:NULL-POINTER) STACK)
                     (LET ((OBJECT (ITEM 0 PTR)))
                       (SETF (ITEM 1 PTR) <BINDING>)
                       (%CALL-CLASSFN <CLASSFN-QCOLOR> 0 OBJECT STACK)
                       OBJECT)))))
        (LET ((CLASS (FIND-QCLASS "QColor")))
          (ITER (FOR OBJECT IN-VECTOR OBJECTS)
           (DELETE (%QOBJECT CLASS OBJECT)))))))

[commonqt/test/microbench.lisp:317]
  (DEFUN BENCH-NEW-QCOLOR4/CFFI (&OPTIONAL (REPEAT *REPEAT*))
    (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
    (LET ((OBJECTS (MAKE-ARRAY REPEAT)))
      (PROG1
          (%WITH-STACK (STACK ITEM 5)
           (MEASURE-DOTIMES (X REPEAT)
            (SETF (ELT OBJECTS X)
                    (PROGN
                     (SETF (ITEM 1 INT) 1)
                     (SETF (ITEM 2 INT) 2)
                     (SETF (ITEM 3 INT) 3)
                     (SETF (ITEM 4 INT) 4)
                     (%CALL-CLASSFN <CLASSFN-QCOLOR> <MARG-QCOLOR/4>
                      (CFFI-SYS:NULL-POINTER) STACK)
                     (LET ((OBJECT (ITEM 0 PTR)))
                       (SETF (ITEM 1 PTR) <BINDING>)
                       (%CALL-CLASSFN <CLASSFN-QCOLOR> 0 OBJECT STACK)
                       OBJECT)))))
        (LET ((CLASS (FIND-QCLASS "QColor")))
          (ITER (FOR OBJECT IN-VECTOR OBJECTS)
           (DELETE (%QOBJECT CLASS OBJECT)))))))

[contextl/cx-dynamic-environments.lisp:40]
  (PROGN
   (DEFCLASS DYNAMIC-ENVIRONMENT NIL
             ((DYNAMIC-WINDS :INITARG :DYNAMIC-WINDS :READER DYNAMIC-WINDS)))
   (DEFUN CAPTURE-DYNAMIC-ENVIRONMENT (&OPTIONAL MARK)
     (MAKE-INSTANCE 'DYNAMIC-ENVIRONMENT :DYNAMIC-WINDS
                    (LOOP WITH DYNAMIC-WINDS = 'NIL
                          FOR ENTRY IN *DYNAMIC-WIND-STACK*
                          IF (FUNCTIONP ENTRY)
                          DO (PUSH ENTRY DYNAMIC-WINDS) ELSE
                          IF (EQ ENTRY MARK) RETURN DYNAMIC-WINDS
                          FINALLY (RETURN DYNAMIC-WINDS))))
   (DEFGENERIC CALL-WITH-DYNAMIC-ENVIRONMENT
       (ENVIRONMENT THUNK)
     (:METHOD ((ENVIRONMENT DYNAMIC-ENVIRONMENT) (THUNK FUNCTION))
      (DECLARE
       (OPTIMIZE (SPEED 3) (SPACE 3) (DEBUG 0) (SAFETY 0)
        (COMPILATION-SPEED 0)))
      (LABELS ((PERFORM-CALLS (ENVIRONMENT THUNK)
                 (COND
                  (ENVIRONMENT (ASSERT (CONSP ENVIRONMENT))
                   (LET ((FUNCTION (FIRST ENVIRONMENT)))
                     (ASSERT (FUNCTIONP FUNCTION))
                     (LET ((*DYNAMIC-WIND-STACK*
                            (CONS FUNCTION *DYNAMIC-WIND-STACK*)))
                       (FUNCALL FUNCTION
                                (LAMBDA ()
                                  (PERFORM-CALLS (REST ENVIRONMENT) THUNK))))))
                  (T (FUNCALL THUNK)))))
        (PERFORM-CALLS (DYNAMIC-WINDS ENVIRONMENT) THUNK))))
   (DEFMACRO WITH-DYNAMIC-ENVIRONMENT ((ENVIRONMENT) &BODY BODY)
     (ECLECTOR.READER:QUASIQUOTE
      (CALL-WITH-DYNAMIC-ENVIRONMENT (ECLECTOR.READER:UNQUOTE ENVIRONMENT)
       (LAMBDA () (ECLECTOR.READER:UNQUOTE-SPLICING BODY))))))

[contextl/cx-layer.lisp:74]
  (DEFUN ADJOIN-LAYER (LAYER ACTIVE-CONTEXT)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0) (COMPILATION-SPEED 0)))
    (OR (GETF (LAYER-CONTEXT-CHILDREN/ENSURE-ACTIVE ACTIVE-CONTEXT) LAYER)
        (GETF (LAYER-CONTEXT-CHILDREN/ENSURE-ACTIVE ACTIVE-CONTEXT)
              (LAYER-NAME LAYER))
        (SAFE-ADJOIN-LAYER LAYER ACTIVE-CONTEXT)))

[contextl/cx-layer.lisp:81]
  (DEFUN ENSURE-ACTIVE-LAYER (LAYER-NAME)
    (SETF *ACTIVE-CONTEXT*
            (LOCALLY
             (DECLARE
              (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0) (COMPILATION-SPEED 0)))
             (ADJOIN-LAYER LAYER-NAME *ACTIVE-CONTEXT*)))
    (VALUES))

[contextl/cx-layer.lisp:124]
  (DEFUN REMOVE-LAYER (LAYER ACTIVE-CONTEXT)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0) (COMPILATION-SPEED 0)))
    (OR (GETF (LAYER-CONTEXT-CHILDREN/ENSURE-INACTIVE ACTIVE-CONTEXT) LAYER)
        (GETF (LAYER-CONTEXT-CHILDREN/ENSURE-INACTIVE ACTIVE-CONTEXT)
              (LAYER-NAME LAYER))
        (SAFE-REMOVE-LAYER LAYER ACTIVE-CONTEXT)))

[contextl/cx-layer.lisp:131]
  (DEFUN ENSURE-INACTIVE-LAYER (LAYER-NAME)
    (SETF *ACTIVE-CONTEXT*
            (LOCALLY
             (DECLARE
              (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0) (COMPILATION-SPEED 0)))
             (REMOVE-LAYER LAYER-NAME *ACTIVE-CONTEXT*)))
    (VALUES))

[contextl/cx-layer.lisp:139]
  (DEFMACRO %WITH-ACTIVE-LAYERS ((&REST LAYER-NAMES) &BODY BODY)
    (ECLECTOR.READER:QUASIQUOTE
     (LET ((*ACTIVE-CONTEXT*
            (LOCALLY
             (DECLARE
              (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0) (COMPILATION-SPEED 0)))
             (ECLECTOR.READER:UNQUOTE
              (LOOP FOR FORM = '*ACTIVE-CONTEXT* THEN (ECLECTOR.READER:QUASIQUOTE
                                                       (ADJOIN-LAYER
                                                        '(ECLECTOR.READER:UNQUOTE
                                                          LAYER-NAME)
                                                        (ECLECTOR.READER:UNQUOTE
                                                         FORM)))
                    FOR LAYER-NAME IN LAYER-NAMES
                    FINALLY (RETURN FORM))))))
       (ECLECTOR.READER:UNQUOTE-SPLICING BODY))))

[contextl/cx-layer.lisp:182]
  (DEFMACRO %WITH-INACTIVE-LAYERS ((&REST LAYER-NAMES) &BODY BODY)
    (ECLECTOR.READER:QUASIQUOTE
     (LET ((*ACTIVE-CONTEXT*
            (LOCALLY
             (DECLARE
              (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0) (COMPILATION-SPEED 0)))
             (ECLECTOR.READER:UNQUOTE
              (LOOP FOR FORM = '*ACTIVE-CONTEXT* THEN (ECLECTOR.READER:QUASIQUOTE
                                                       (REMOVE-LAYER
                                                        '(ECLECTOR.READER:UNQUOTE
                                                          LAYER-NAME)
                                                        (ECLECTOR.READER:UNQUOTE
                                                         FORM)))
                    FOR LAYER-NAME IN LAYER-NAMES
                    FINALLY (RETURN FORM))))))
       (ECLECTOR.READER:UNQUOTE-SPLICING BODY))))

[contextl/cx-layered-access-class.lisp:114]
  (DEFGENERIC ADD-LAYERED-ACCESSORS
      (CLASS)
    (:METHOD ((CLASS LAYERED-ACCESS-CLASS))
     (LOOP WITH READER-SPECIALIZERS = (LIST CLASS)
           WITH WRITER-SPECIALIZERS = (LIST (FIND-CLASS 'T) CLASS)
           FOR SLOT IN (CLASS-DIRECT-SLOTS CLASS)
           FOR SLOT-NAME = (SLOT-DEFINITION-NAME SLOT)
           FOR LAYER = (FIND-LAYER-CLASS (SLOT-DEFINITION-LAYER SLOT))
           DO (LOOP FOR LAYERED-READER IN (SLOT-DEFINITION-LAYERED-READERS
                                           SLOT)
                    FOR GF = (ENSURE-LAYERED-FUNCTION LAYERED-READER
                              :LAMBDA-LIST '(OBJECT))
                    FOR METHOD = (ENSURE-LAYERED-METHOD LAYERED-READER
                                  (ECLECTOR.READER:QUASIQUOTE
                                   (LAMBDA (OBJECT)
                                     (DECLARE
                                      (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)
                                       (COMPILATION-SPEED 0)))
                                     (SLOT-VALUE OBJECT
                                                 '(ECLECTOR.READER:UNQUOTE
                                                   SLOT-NAME))))
                                  :IN-LAYER LAYER :SPECIALIZERS
                                  READER-SPECIALIZERS)
                    DO (PUSH (CONS GF METHOD)
                             (LAYERED-ACCESSOR-METHODS
                              SLOT))) (LOOP FOR LAYERED-WRITER IN (SLOT-DEFINITION-LAYERED-WRITERS
                                                                   SLOT)
                                            FOR GF = (ENSURE-LAYERED-FUNCTION
                                                      LAYERED-WRITER
                                                      :LAMBDA-LIST
                                                      '(NEW-VALUE OBJECT)
                                                      :ARGUMENT-PRECEDENCE-ORDER
                                                      '(OBJECT NEW-VALUE))
                                            FOR METHOD = (ENSURE-LAYERED-METHOD
                                                          LAYERED-WRITER
                                                          (ECLECTOR.READER:QUASIQUOTE
                                                           (LAMBDA
                                                               (NEW-VALUE
                                                                OBJECT)
                                                             (DECLARE
                                                              (OPTIMIZE
                                                               (SPEED 3)
                                                               (DEBUG 0)
                                                               (SAFETY 0)
                                                               (COMPILATION-SPEED
                                                                0)))
                                                             (SETF (SLOT-VALUE
                                                                    OBJECT
                                                                    '(ECLECTOR.READER:UNQUOTE
                                                                      SLOT-NAME))
                                                                     NEW-VALUE)))
                                                          :IN-LAYER LAYER
                                                          :SPECIALIZERS
                                                          WRITER-SPECIALIZERS)
                                            DO (PUSH (CONS GF METHOD)
                                                     (LAYERED-ACCESSOR-METHODS
                                                      SLOT))))))

[contextl/cx-layered-function-macros.lisp:86]
  (DEFMACRO DEFINE-LAYERED-FUNCTION (NAME (&REST ARGS) &BODY OPTIONS)
    (LET ((DEFINER (LF-DEFINER-NAME NAME))
          (DOCUMENTATION (ASSOC :DOCUMENTATION OPTIONS)))
      (WITH-UNIQUE-NAMES (LAYER-ARG REST-ARG)
       (ECLECTOR.READER:QUASIQUOTE
        (PROGN
         (DEFGENERIC (ECLECTOR.READER:UNQUOTE DEFINER)
             ((ECLECTOR.READER:UNQUOTE LAYER-ARG)
              (ECLECTOR.READER:UNQUOTE-SPLICING ARGS))
           (ECLECTOR.READER:UNQUOTE-SPLICING
            (UNLESS (MEMBER :GENERIC-FUNCTION-CLASS OPTIONS :KEY #'CAR)
              '((:GENERIC-FUNCTION-CLASS LAYERED-FUNCTION))))
           (:ARGUMENT-PRECEDENCE-ORDER
            (ECLECTOR.READER:UNQUOTE-SPLICING
             (LET ((ARGUMENT-PRECEDENCE-ORDER
                    (ASSOC :ARGUMENT-PRECEDENCE-ORDER OPTIONS)))
               (IF ARGUMENT-PRECEDENCE-ORDER
                   (CDR ARGUMENT-PRECEDENCE-ORDER)
                   (REQUIRED-ARGS ARGS))))
            (ECLECTOR.READER:UNQUOTE LAYER-ARG))
           (ECLECTOR.READER:UNQUOTE-SPLICING
            (LOOP FOR OPTION IN (REMOVE :ARGUMENT-PRECEDENCE-ORDER OPTIONS :KEY
                                        #'CAR)
                  IF (EQ (CAR OPTION) :METHOD)
                  COLLECT (MULTIPLE-VALUE-BIND
                              (LAYER-ARG LAYER QUALIFIERS ARGS METHOD-BODY)
                              (PARSE-METHOD-BODY OPTION (CDR OPTION))
                            (ECLECTOR.READER:QUASIQUOTE
                             (:METHOD
                              (ECLECTOR.READER:UNQUOTE-SPLICING QUALIFIERS)
                              (((ECLECTOR.READER:UNQUOTE LAYER-ARG)
                                (ECLECTOR.READER:UNQUOTE
                                 (PREPARE-LAYER LAYER)))
                               (ECLECTOR.READER:UNQUOTE-SPLICING ARGS))
                              (ECLECTOR.READER:UNQUOTE-SPLICING
                               (PREPARE-LAYERED-METHOD-BODY NAME OPTION
                                LAYER-ARG METHOD-BODY))))) ELSE
                  IF (NOT (EQ (CAR OPTION) :DOCUMENTATION))
                  COLLECT OPTION)))
         (DECLAIM (INLINE (ECLECTOR.READER:UNQUOTE NAME)))
         (ECLECTOR.READER:UNQUOTE
          (MULTIPLE-VALUE-BIND (REQUIRED-PARAMETERS LAMBDA-LIST-KEYWORD)
              (PARSE-GF-LAMBDA-LIST ARGS)
            (IF LAMBDA-LIST-KEYWORD
                (ECLECTOR.READER:QUASIQUOTE
                 (DEFUN (ECLECTOR.READER:UNQUOTE NAME)
                        ((ECLECTOR.READER:UNQUOTE-SPLICING REQUIRED-PARAMETERS)
                         &REST (ECLECTOR.READER:UNQUOTE REST-ARG))
                   (DECLARE
                    (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)
                     (COMPILATION-SPEED 0)))
                   (ECLECTOR.READER:UNQUOTE-SPLICING
                    (WHEN DOCUMENTATION (LIST (CADR DOCUMENTATION))))
                   (APPLY #'(ECLECTOR.READER:UNQUOTE DEFINER)
                          (LAYER-CONTEXT-PROTOTYPE *ACTIVE-CONTEXT*)
                          (ECLECTOR.READER:UNQUOTE-SPLICING
                           REQUIRED-PARAMETERS)
                          (ECLECTOR.READER:UNQUOTE REST-ARG))))
                (ECLECTOR.READER:QUASIQUOTE
                 (DEFUN (ECLECTOR.READER:UNQUOTE NAME)
                        (
                         (ECLECTOR.READER:UNQUOTE-SPLICING
                          REQUIRED-PARAMETERS))
                   (DECLARE
                    (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)
                     (COMPILATION-SPEED 0)))
                   (ECLECTOR.READER:UNQUOTE-SPLICING
                    (WHEN DOCUMENTATION (LIST (CADR DOCUMENTATION))))
                   (FUNCALL #'(ECLECTOR.READER:UNQUOTE DEFINER)
                            (LAYER-CONTEXT-PROTOTYPE *ACTIVE-CONTEXT*)
                            (ECLECTOR.READER:UNQUOTE-SPLICING
                             REQUIRED-PARAMETERS)))))))
         (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
           (BIND-LF-NAMES '(ECLECTOR.READER:UNQUOTE NAME)))
         #'(ECLECTOR.READER:UNQUOTE DEFINER))))))

[contextl/cx-layered-function.lisp:3]
  (DEFUN ENSURE-LAYERED-FUNCTION
         (NAME
          &REST INITARGS
          &KEY (LAMBDA-LIST NIL LAMBDA-LIST-P)
          (ARGUMENT-PRECEDENCE-ORDER (REQUIRED-ARGS LAMBDA-LIST))
          (DOCUMENTATION NIL) (GENERIC-FUNCTION-CLASS 'LAYERED-FUNCTION)
          &ALLOW-OTHER-KEYS)
    (UNLESS LAMBDA-LIST-P
      (ERROR "The layered function ~S must be initialized with a lambda list."
             NAME))
    (LET ((GF
           (LET ((LAYER-ARG (GENSYM "LAYER-ARG-")))
             (APPLY #'ENSURE-GENERIC-FUNCTION (LF-DEFINER-NAME NAME)
                    :GENERIC-FUNCTION-CLASS GENERIC-FUNCTION-CLASS
                    :ARGUMENT-PRECEDENCE-ORDER
                    (ECLECTOR.READER:QUASIQUOTE
                     ((ECLECTOR.READER:UNQUOTE-SPLICING
                       ARGUMENT-PRECEDENCE-ORDER)
                      (ECLECTOR.READER:UNQUOTE LAYER-ARG)))
                    :LAMBDA-LIST
                    (ECLECTOR.READER:QUASIQUOTE
                     ((ECLECTOR.READER:UNQUOTE LAYER-ARG)
                      (ECLECTOR.READER:UNQUOTE-SPLICING LAMBDA-LIST)))
                    (LOOP FOR (KEY VALUE) ON INITARGS BY #'CDDR
                          UNLESS (EQ KEY :DOCUMENTATION)
                          NCONC (LIST KEY VALUE))))))
      (SETF (FDEFINITION NAME)
              (LET ((LAMBDA
                     (ECLECTOR.READER:QUASIQUOTE
                      (LAMBDA (&REST REST)
                        (DECLARE
                         (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)
                          (COMPILATION-SPEED 0)))
                        (APPLY (THE FUNCTION (ECLECTOR.READER:UNQUOTE GF))
                               (LAYER-CONTEXT-PROTOTYPE *ACTIVE-CONTEXT*)
                               REST)))))
                (COERCE LAMBDA 'FUNCTION)))
      (WHEN DOCUMENTATION (SETF (DOCUMENTATION NAME 'FUNCTION) DOCUMENTATION))
      (BIND-LF-NAMES NAME)
      GF))

[contextl/cx-special-class.lisp:117]
  (DEFMETHOD SLOT-UNBOUND ((CLASS SPECIAL-CLASS) OBJECT SLOT-NAME)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0) (COMPILATION-SPEED 0)))
    (IF *SYMBOL-ACCESS*
        (LET ((SLOT
               (FIND SLOT-NAME (THE LIST (CLASS-SLOTS CLASS)) :TEST #'EQ :KEY
                     #'SLOT-DEFINITION-NAME)))
          (IF (TYPEP SLOT 'SPECIAL-EFFECTIVE-SLOT-DEFINITION)
              (SETF (SLOT-VALUE-USING-CLASS CLASS OBJECT SLOT)
                      (MAKE-SPECIAL-SYMBOL))
              (CALL-NEXT-METHOD)))
        (CALL-NEXT-METHOD)))

[contextl/cx-special-class.lisp:130]
  (DEFMETHOD SLOT-VALUE-USING-CLASS
             ((CLASS SPECIAL-CLASS) OBJECT
              (SLOT SPECIAL-EFFECTIVE-SLOT-DEFINITION))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0) (COMPILATION-SPEED 0)))
    (IF *SYMBOL-ACCESS*
        (CALL-NEXT-METHOD)
        (LET ((SLOT-SYMBOL (WITH-SYMBOL-ACCESS (CALL-NEXT-METHOD))))
          (DECLARE (TYPE SYMBOL SLOT-SYMBOL))
          (IF (DYNAMIC-SYMBOL-BOUNDP SLOT-SYMBOL)
              (DYNAMIC-SYMBOL-VALUE SLOT-SYMBOL)
              (SLOT-UNBOUND CLASS OBJECT (SLOT-DEFINITION-NAME SLOT))))))

[contextl/cx-special-class.lisp:141]
  (DEFMETHOD (SETF SLOT-VALUE-USING-CLASS)
             (NEW-VALUE (CLASS SPECIAL-CLASS) OBJECT
              (SLOT SPECIAL-EFFECTIVE-SLOT-DEFINITION))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0) (COMPILATION-SPEED 0)))
    (IF *SYMBOL-ACCESS*
        (CALL-NEXT-METHOD)
        (LET ((SLOT-SYMBOL
               (WITH-SYMBOL-ACCESS (SLOT-VALUE-USING-CLASS CLASS OBJECT SLOT))))
          (SETF (DYNAMIC-SYMBOL-VALUE (THE SYMBOL SLOT-SYMBOL)) NEW-VALUE))))

[contextl/cx-special-class.lisp:149]
  (DEFMETHOD SLOT-BOUNDP-USING-CLASS
             ((CLASS SPECIAL-CLASS) OBJECT
              (SLOT SPECIAL-EFFECTIVE-SLOT-DEFINITION))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0) (COMPILATION-SPEED 0)))
    (IF *SYMBOL-ACCESS*
        (CALL-NEXT-METHOD)
        (LET ((SLOT-SYMBOL
               (WITH-SYMBOL-ACCESS (SLOT-VALUE-USING-CLASS CLASS OBJECT SLOT))))
          (DYNAMIC-SYMBOL-BOUNDP (THE SYMBOL SLOT-SYMBOL)))))

[contextl/cx-special-class.lisp:157]
  (DEFMETHOD SLOT-MAKUNBOUND-USING-CLASS
             ((CLASS SPECIAL-CLASS) OBJECT
              (SLOT SPECIAL-EFFECTIVE-SLOT-DEFINITION))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0) (COMPILATION-SPEED 0)))
    (IF *SYMBOL-ACCESS*
        (CALL-NEXT-METHOD)
        (LET ((SLOT-SYMBOL
               (WITH-SYMBOL-ACCESS (SLOT-VALUE-USING-CLASS CLASS OBJECT SLOT))))
          (DYNAMIC-SYMBOL-MAKUNBOUND (THE SYMBOL SLOT-SYMBOL))
          OBJECT)))

[curry-compose-reader-macros/test.lisp:58]
  (DEFTEST CURRY.FIXED-ARITY-ERROR.1
   (LOCALLY
    (DECLARE (OPTIMIZE SAFETY))
    (LET ((FN (ER "{1 list 1}")))
      (HANDLER-CASE (PROGN (FUNCALL FN) NIL) (ERROR NIL T))))
   T)

[curry-compose-reader-macros/test.lisp:65]
  (DEFTEST CURRY.FIXED-ARITY-ERROR.2
   (LOCALLY
    (DECLARE (OPTIMIZE SAFETY))
    (LET ((FN (ER "{1 list 1}")))
      (HANDLER-CASE (PROGN (FUNCALL FN 'A 'B) NIL) (ERROR NIL T))))
   T)

[cxml-stp/attribute.lisp:83]
  (DEFUN XML-CHARACTERS-P (STR)
    (DECLARE (OPTIMIZE SPEED (SAFETY 0)))
    (EVERY
     (LAMBDA (C)
       (LET ((CODE (CHAR-CODE C)))
         (OR (EQL CODE 9) (EQL CODE 10) (EQL CODE 13) (<= 32 CODE 55295)
             (<= 55296 CODE 57343) (<= 57344 CODE 65533))))
     (THE STRING STR)))

[cxml-stp/element.lisp:412]
  (DEFUN CHECK-URI-LIKE (NEWVAL)
    (DECLARE (OPTIMIZE SPEED (SAFETY 0)))
    (CHECK-TYPE NEWVAL STRING)
    (WHEN
        (SOME
         (LAMBDA (C)
           (LET ((CODE (CHAR-CODE C)))
             (OR (> CODE 126)
                 (AND (< CODE 32) (NOT (EQL CODE 9)) (NOT (EQL CODE 10))
                      (NOT (EQL CODE 13))))))
         NEWVAL)
      (STP-ERROR "invalid characters in URI")))

[cxml/xml/xml-parse.lisp:173]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (DEFPARAMETER *FAST* '(OPTIMIZE (SPEED 3) (SAFETY 0))))

[cxml/xml/xml-parse.lisp:409]
  (DEFUN ROD-SUBSEQ** (SOURCE START &OPTIONAL (END (LENGTH SOURCE)))
    (DECLARE (TYPE (SIMPLE-ARRAY RUNE (*)) SOURCE)
             (TYPE UFIXNUM START)
             (TYPE UFIXNUM END)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((RES (MAKE-ARRAY (%- END START) :ELEMENT-TYPE 'RUNE)))
      (DECLARE (TYPE (SIMPLE-ARRAY RUNE (*)) RES))
      (LET ((I (%- END START)))
        (DECLARE (TYPE UFIXNUM I))
        (LOOP (SETF I (- I 1))
              (WHEN (= I 0) (RETURN))
              (SETF (%RUNE RES I) (%RUNE SOURCE (THE UFIXNUM (+ I START))))))
      RES))

[cxml/xml/xml-parse.lisp:3592]
  (DEFUN READ-CDATA (INPUT)
    (READ-DATA-UNTIL*
     ((LAMBDA (RUNE)
        (DECLARE (TYPE RUNE RUNE))
        (WHEN
            (AND (%RUNE< RUNE U+0020)
                 (NOT
                  (OR (%RUNE= RUNE U+0009) (%RUNE= RUNE U+000A)
                      (%RUNE= RUNE U+000D))))
          (WF-ERROR INPUT "code point invalid: ~A" RUNE))
        (OR (%RUNE= RUNE <) (%RUNE= RUNE &)))
      INPUT SOURCE START END)
     (LOCALLY
      (DECLARE (TYPE (SIMPLE-ARRAY RUNE (*)) SOURCE)
               (TYPE UFIXNUM START)
               (TYPE UFIXNUM END)
               (OPTIMIZE (SPEED 3) (SAFETY 0)))
      (LET ((RES (MAKE-ARRAY (%- END START) :ELEMENT-TYPE 'RUNE)))
        (DECLARE (TYPE (SIMPLE-ARRAY RUNE (*)) RES))
        (LET ((I (%- END START)))
          (DECLARE (TYPE UFIXNUM I))
          (LOOP (SETF I (- I 1))
                (SETF (%RUNE RES I) (%RUNE SOURCE (THE UFIXNUM (+ I START))))
                (WHEN (= I 0) (RETURN))))
        RES))))

[damn-fast-priority-queue/damn-fast-priority-queue/src.lisp:17]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (DEFPARAMETER *OPTIMIZE-QUALITIES*
      (ECLECTOR.READER:QUASIQUOTE
       (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0) (SPACE 0)
        (COMPILATION-SPEED 0)))))

[damn-fast-priority-queue/damn-fast-stable-priority-queue/src.lisp:18]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (DEFPARAMETER *OPTIMIZE-QUALITIES*
      (ECLECTOR.READER:QUASIQUOTE
       (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0) (SPACE 0)
        (COMPILATION-SPEED 0)))))

[deflate/deflate.lisp:110]
  (DEFUN UPDATE-ADLER32-CHECKSUM (CRC BUFFER END)
    (DECLARE (TYPE (UNSIGNED-BYTE 32) CRC)
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) BUFFER)
             (TYPE FIXNUM END)
             (OPTIMIZE (SPEED 3) (DEBUG 0) (SPACE 0) (SAFETY 0))
             (MUFFLE-CONDITIONS COMPILER-NOTE))
    (LET ((S1 (LDB (BYTE 16 0) CRC)) (S2 (LDB (BYTE 16 16) CRC)))
      (DECLARE (TYPE (UNSIGNED-BYTE 32) S1 S2))
      (DOTIMES (I END)
        (DECLARE (TYPE FIXNUM I))
        (SETQ S1 (MOD (+ S1 (AREF BUFFER I)) +ADLER-32-BASE+)
              S2 (MOD (+ S2 S1) +ADLER-32-BASE+)))
      (DPB S2 (BYTE 16 16) S1)))

[deflate/deflate.lisp:158]
  (DEFUN UPDATE-CRC32-CHECKSUM (CRC BUFFER END)
    (DECLARE (TYPE (UNSIGNED-BYTE 32) CRC)
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) BUFFER)
             (TYPE FIXNUM END)
             (OPTIMIZE (SPEED 3) (DEBUG 0) (SPACE 0) (SAFETY 0))
             (MUFFLE-CONDITIONS COMPILER-NOTE))
    (LET ((TABLE (LOAD-TIME-VALUE (GENERATE-CRC32-TABLE)))
          (CUR (LOGXOR CRC 4294967295)))
      (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 32) (256)) TABLE)
               (TYPE (UNSIGNED-BYTE 32) CUR))
      (DOTIMES (I END)
        (DECLARE (TYPE FIXNUM I))
        (LET ((INDEX (LOGAND 255 (LOGXOR CUR (AREF BUFFER I)))))
          (DECLARE (TYPE (UNSIGNED-BYTE 8) INDEX))
          (SETQ CUR (LOGXOR (AREF TABLE INDEX) (ASH CUR -8)))))
      (LOGXOR CUR 4294967295)))

[deflate/deflate.lisp:176]
  (DEFUN UPDATE-CRC32-CHECKSUM (CRC BUFFER END)
    (DECLARE (TYPE (UNSIGNED-BYTE 32) CRC)
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) BUFFER)
             (TYPE FIXNUM END)
             (OPTIMIZE (SPEED 3) (DEBUG 0) (SPACE 0) (SAFETY 0) (FLOAT 0)))
    (LET ((TABLE (LOAD-TIME-VALUE (GENERATE-CRC32-TABLE)))
          (CUR
           (#S(FORMGREP:SYMREF :NAME "INT32-LOGNOT" :QUALIFIER "SYS")
            (#S(FORMGREP:SYMREF :NAME "INTEGER-TO-INT32" :QUALIFIER "SYS")
             (DPB (LDB (BYTE 32 0) CRC) (BYTE 32 0)
                  (IF (LOGBITP 31 CRC)
                      -1
                      0))))))
      (DECLARE
       (TYPE #S(FORMGREP:SYMREF :NAME "SIMPLE-INT32-VECTOR" :QUALIFIER "SYS")
        TABLE)
       (TYPE #S(FORMGREP:SYMREF :NAME "INT32" :QUALIFIER "SYS") CUR))
      (DOTIMES (I END)
        (DECLARE (TYPE FIXNUM I))
        (LET ((INDEX
               (#S(FORMGREP:SYMREF :NAME "INT32-TO-INTEGER" :QUALIFIER "SYS")
                (#S(FORMGREP:SYMREF :NAME "INT32-LOGAND" :QUALIFIER "SYS") 255
                 (#S(FORMGREP:SYMREF :NAME "INT32-LOGXOR" :QUALIFIER "SYS") CUR
                  (AREF BUFFER I))))))
          (DECLARE (TYPE FIXNUM INDEX))
          (SETQ CUR
                  (#S(FORMGREP:SYMREF :NAME "INT32-LOGXOR" :QUALIFIER "SYS")
                   (#S(FORMGREP:SYMREF :NAME "INT32-AREF" :QUALIFIER "SYS")
                    TABLE INDEX)
                   (#S(FORMGREP:SYMREF :NAME "INT32-LOGAND" :QUALIFIER "SYS")
                    16777215
                    (#S(FORMGREP:SYMREF :NAME "INT32>>" :QUALIFIER "SYS") CUR
                     8))))))
      (LDB (BYTE 32 0)
           (#S(FORMGREP:SYMREF :NAME "INT32-TO-INTEGER" :QUALIFIER "SYS")
            (#S(FORMGREP:SYMREF :NAME "INT32-LOGNOT" :QUALIFIER "SYS") CUR)))))

[deflate/deflate.lisp:311]
  (DEFUN BIT-STREAM-COPY-BLOCK (STREAM OUT-STREAM)
    (DECLARE (TYPE BIT-STREAM STREAM)
             (TYPE SLIDING-WINDOW-STREAM OUT-STREAM)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    "Copy a given block of bytes directly from the underlying stream."
    (SETF (BIT-STREAM-BITS STREAM) 0
          (BIT-STREAM-BIT-COUNT STREAM) 0)
    (LET* ((LEN
            (LOGIOR (BIT-STREAM-GET-BYTE STREAM)
                    (ASH (BIT-STREAM-GET-BYTE STREAM) 8)))
           (NLEN
            (LDB (BYTE 16 0)
                 (LOGNOT
                  (LOGIOR (BIT-STREAM-GET-BYTE STREAM)
                          (ASH (BIT-STREAM-GET-BYTE STREAM) 8))))))
      (UNLESS (= LEN NLEN)
        (ERROR 'DEFLATE-DECOMPRESSION-ERROR :FORMAT-CONTROL
               "Block length mismatch for stored block: LEN(~D) vs. NLEN(~D)!"
               :FORMAT-ARGUMENTS (LIST LEN NLEN)))
      (DOTIMES (I LEN)
        (SLIDING-WINDOW-STREAM-WRITE-BYTE OUT-STREAM
         (BIT-STREAM-GET-BYTE STREAM)))))

[deflate/deflate.lisp:387]
  (DEFUN READ-HUFFMAN-CODE (BIT-STREAM DECODE-TREE)
    (DECLARE (TYPE BIT-STREAM BIT-STREAM)
             (TYPE DECODE-TREE DECODE-TREE)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    "Read the next huffman code word from the given bit-stream and
return its decoded symbol, for the huffman code given by decode-tree."
    (LOOP WITH LENGTH-COUNT OF-TYPE (SIMPLE-ARRAY FIXNUM
                                     (*)) = (DECODE-TREE-LENGTH-COUNT
                                             DECODE-TREE)
          WITH CODE-SYMBOLS OF-TYPE (SIMPLE-ARRAY FIXNUM
                                     (*)) = (DECODE-TREE-CODE-SYMBOLS
                                             DECODE-TREE)
          FOR CODE OF-TYPE FIXNUM = (BIT-STREAM-READ-BITS BIT-STREAM 1) THEN (+
                                                                              (*
                                                                               CODE
                                                                               2)
                                                                              (BIT-STREAM-READ-BITS
                                                                               BIT-STREAM
                                                                               1))
          FOR INDEX OF-TYPE FIXNUM = 0 THEN (+ INDEX COUNT)
          FOR FIRST OF-TYPE FIXNUM = 0 THEN (* (+ FIRST COUNT) 2)
          FOR LENGTH OF-TYPE FIXNUM UPFROM 1 BELOW (LENGTH LENGTH-COUNT)
          FOR
          COUNT = (AREF LENGTH-COUNT LENGTH)
          THEREIS (WHEN (< CODE (THE FIXNUM (+ FIRST COUNT)))
                    (AREF CODE-SYMBOLS (+ INDEX (- CODE FIRST))))
          FINALLY (ERROR 'DEFLATE-DECOMPRESSION-ERROR :FORMAT-CONTROL
                         "Corrupted Data detected during decompression: ~
             Incorrect huffman code (~X) in huffman decode!"
                         :FORMAT-ARGUMENTS (LIST CODE))))

[defstar/defstar.lisp:260]
  (DECLAIM (OPTIMIZE (SPEED 0) (SAFETY 3) (DEBUG 3)))

[dexador/src/util.lisp:36]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (DEFVAR *SPEEDY-DECLARATION*
      '(DECLARE
        (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (COMPILATION-SPEED 0))))
    (DEFVAR *CAREFUL-DECLARATION* '(DECLARE (OPTIMIZE (SPEED 3) (SAFETY 2)))))

[dufy/src/core/builtin-rgbspaces.lisp:7]
  (DEFUN LINEARIZE-SCRGB-NL (X)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (DOUBLE-FLOAT X))
    (COND ((> X NIL) (EXPT (* (+ 0.099d0 X) NIL) NIL))
          ((< X (* 4.5d0 -0.018d0)) (- (EXPT (* (- 0.099d0 X) NIL) NIL)))
          (T (* X NIL))))

[dufy/src/core/builtin-rgbspaces.lisp:16]
  (DEFUN DELINEARIZE-SCRGB-NL (X)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (DOUBLE-FLOAT X))
    (COND ((> X 0.018d0) (+ (* 1.099d0 (EXPT X 0.45d0)) -0.099d0))
          ((< X -0.018d0) (+ (* -1.099d0 (EXPT (- X) 0.45d0)) 0.099d0))
          (T (* X 4.5d0))))

[dufy/src/core/builtin-rgbspaces.lisp:100]
  (DEFUN LINEARIZE-PROPHOTO (X)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (DOUBLE-FLOAT X))
    (COND ((> X NIL) (EXPT X 1.8d0)) ((< X NIL) (- (EXPT (- X) 1.8d0)))
          (T (* X NIL))))

[dufy/src/core/builtin-rgbspaces.lisp:109]
  (DEFUN DELINEARIZE-PROPHOTO (X)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (DOUBLE-FLOAT X))
    (COND ((> X NIL) (EXPT X NIL)) ((< X NIL) (- (EXPT (- X) NIL)))
          (T (* X 16.0d0))))

[dufy/src/core/cat.lisp:73]
  (DEFINE-PRIMARY-CONVERTER (XYZ LMS)
   (X Y Z &KEY (ILLUMINANT +ILLUM-D65+) (CAT +BRADFORD+))
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
   "ILLUMINANT can be NIL and in that case the transform is virtually equivalent
to that of illuminant E. "
   (WITH-ENSURING-TYPE DOUBLE-FLOAT (X Y Z)
    (IF ILLUMINANT
        (LET* ((MAT (CAT-MATRIX CAT))
               (FACTOR-L
                (+ (* (ILLUMINANT-X ILLUMINANT) (AREF MAT 0 0)) (AREF MAT 0 1)
                   (* (ILLUMINANT-Z ILLUMINANT) (AREF MAT 0 2))))
               (FACTOR-M
                (+ (* (ILLUMINANT-X ILLUMINANT) (AREF MAT 1 0)) (AREF MAT 1 1)
                   (* (ILLUMINANT-Z ILLUMINANT) (AREF MAT 1 2))))
               (FACTOR-S
                (+ (* (ILLUMINANT-X ILLUMINANT) (AREF MAT 2 0)) (AREF MAT 2 1)
                   (* (ILLUMINANT-Z ILLUMINANT) (AREF MAT 2 2)))))
          (MULTIPLE-VALUE-BIND (L M S)
              (MULTIPLY-MAT-VEC MAT X Y Z)
            (VALUES (/ L FACTOR-L) (/ M FACTOR-M) (/ S FACTOR-S))))
        (MULTIPLY-MAT-VEC (CAT-MATRIX CAT) X Y Z))))

[dufy/src/core/cat.lisp:96]
  (DEFINE-PRIMARY-CONVERTER (LMS XYZ)
   (L M S &KEY (ILLUMINANT +ILLUM-D65+) (CAT +BRADFORD+))
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
   "ILLUMINANT can be NIL and in that case the transform is virtually equivalent
to that of illuminant E. "
   (WITH-ENSURING-TYPE DOUBLE-FLOAT (L M S)
    (IF ILLUMINANT
        (LET* ((MAT (CAT-MATRIX CAT))
               (FACTOR-L
                (+ (* (ILLUMINANT-X ILLUMINANT) (AREF MAT 0 0)) (AREF MAT 0 1)
                   (* (ILLUMINANT-Z ILLUMINANT) (AREF MAT 0 2))))
               (FACTOR-M
                (+ (* (ILLUMINANT-X ILLUMINANT) (AREF MAT 1 0)) (AREF MAT 1 1)
                   (* (ILLUMINANT-Z ILLUMINANT) (AREF MAT 1 2))))
               (FACTOR-S
                (+ (* (ILLUMINANT-X ILLUMINANT) (AREF MAT 2 0)) (AREF MAT 2 1)
                   (* (ILLUMINANT-Z ILLUMINANT) (AREF MAT 2 2)))))
          (MULTIPLY-MAT-VEC (CAT-INV-MATRIX CAT) (* L FACTOR-L) (* M FACTOR-M)
           (* S FACTOR-S)))
        (MULTIPLY-MAT-VEC (CAT-INV-MATRIX CAT) L M S))))

[dufy/src/core/cat.lisp:118]
  (DEFUN CALC-CAT-MATRIX
         (FROM-ILLUMINANT TO-ILLUMINANT &OPTIONAL (CAT +BRADFORD+))
    "Returns a 3*3 chromatic adaptation matrix between FROM-ILLUMINANT
and TO-ILLUMINANT in XYZ space."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (LET ((TMATRIX (CAT-MATRIX CAT)))
      (MULTIPLE-VALUE-BIND (SOURCE-L SOURCE-M SOURCE-S)
          (MULTIPLY-MAT-VEC TMATRIX (ILLUMINANT-X FROM-ILLUMINANT) 1.0d0
           (ILLUMINANT-Z FROM-ILLUMINANT))
        (MULTIPLE-VALUE-BIND (DEST-L DEST-M DEST-S)
            (MULTIPLY-MAT-VEC TMATRIX (ILLUMINANT-X TO-ILLUMINANT) 1.0d0
             (ILLUMINANT-Z TO-ILLUMINANT))
          (LET ((L-RATIO (/ DEST-L SOURCE-L))
                (M-RATIO (/ DEST-M SOURCE-M))
                (S-RATIO (/ DEST-S SOURCE-S))
                (MATRIX1 (MAKE-ARRAY '(3 3) :ELEMENT-TYPE 'DOUBLE-FLOAT)))
            (DECLARE (DYNAMIC-EXTENT MATRIX1))
            (SETF (AREF MATRIX1 0 0) (* L-RATIO (AREF TMATRIX 0 0)))
            (SETF (AREF MATRIX1 0 1) (* L-RATIO (AREF TMATRIX 0 1)))
            (SETF (AREF MATRIX1 0 2) (* L-RATIO (AREF TMATRIX 0 2)))
            (SETF (AREF MATRIX1 1 0) (* M-RATIO (AREF TMATRIX 1 0)))
            (SETF (AREF MATRIX1 1 1) (* M-RATIO (AREF TMATRIX 1 1)))
            (SETF (AREF MATRIX1 1 2) (* M-RATIO (AREF TMATRIX 1 2)))
            (SETF (AREF MATRIX1 2 0) (* S-RATIO (AREF TMATRIX 2 0)))
            (SETF (AREF MATRIX1 2 1) (* S-RATIO (AREF TMATRIX 2 1)))
            (SETF (AREF MATRIX1 2 2) (* S-RATIO (AREF TMATRIX 2 2)))
            (MULTIPLY-MAT-MAT (CAT-INV-MATRIX CAT) MATRIX1))))))

[dufy/src/core/cat.lisp:151]
  (DEFUN GEN-CAT-FUNCTION (FROM-ILLUMINANT TO-ILLUMINANT &KEY (CAT +BRADFORD+))
    "Returns a chromatic adaptation function.
 (funcall (gen-cat-function +illum-a+ +illum-e+) 0.9504d0 1.0d0 1.0889d0)
=> 0.9999700272441295d0
0.999998887365445d0
0.9999997282885571d0 ; transformed white point"
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (LET ((MAT (CALC-CAT-MATRIX FROM-ILLUMINANT TO-ILLUMINANT CAT)))
      #'(LAMBDA (X Y Z)
          (WITH-ENSURING-TYPE DOUBLE-FLOAT (X Y Z)
           (MULTIPLY-MAT-VEC MAT X Y Z)))))

[dufy/src/core/cat.lisp:163]
  (DEFMACRO DEFINE-CAT-FUNCTION
            (NAME FROM-ILLUMINANT TO-ILLUMINANT &KEY (CAT '+BRADFORD+))
    "DEFINE-macro of GEN-CAT-FUNCTION.
 (define-cat-function d65-to-e +illum-d65+ +illum-e+)
 (d65-to-e 0.9504d0 1.0d0 1.0889d0)
;; => 0.9999700272441295d0
;; 0.999998887365445d0
;; 0.9999997282885571d0"
    (UNLESS (AND (SYMBOLP FROM-ILLUMINANT) (SYMBOLP TO-ILLUMINANT))
      (ERROR "FROM-ILLUMINANT and TO-ILLUMINANT must be symbols"))
    (ECLECTOR.READER:QUASIQUOTE
     (PROGN
      (DECLAIM (INLINE (ECLECTOR.READER:UNQUOTE NAME))
               (FTYPE
                (FUNCTION *
                 (VALUES DOUBLE-FLOAT DOUBLE-FLOAT DOUBLE-FLOAT &OPTIONAL))
                (ECLECTOR.READER:UNQUOTE NAME)))
      (DEFUN (ECLECTOR.READER:UNQUOTE NAME) (X Y Z)
        (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
        (LET ((MAT
               (LOAD-TIME-VALUE
                (CALC-CAT-MATRIX (ECLECTOR.READER:UNQUOTE FROM-ILLUMINANT)
                 (ECLECTOR.READER:UNQUOTE TO-ILLUMINANT)
                 (ECLECTOR.READER:UNQUOTE CAT))
                T)))
          (WITH-ENSURING-TYPE DOUBLE-FLOAT (X Y Z)
           (MULTIPLY-MAT-VEC MAT X Y Z)))))))

[dufy/src/core/cat.lisp:194]
  (DEFUN GEN-RGBSPACE-CHANGER
         (FROM-RGBSPACE TO-RGBSPACE &KEY (TARGET :LRGB) (CAT +BRADFORD+))
    "Returns a function for changing RGB working space.

 (funcall (gen-rgbspace-changer +srgb+ +adobe+ :target :rgb) 0 1 0)
;; => 0.5649506908657044d0
;; 1.0d0
;; 0.2344342037422755d0
;; change from sRGB to Adobe RGB.

TARGET ::= :LRGB | :RGB | :QRGB | :RGBPACK

Note about clamping:
LRGB case: no clamping;
RGB case: no clamping;
QRGB case: with clamping;
RGBPACK case: with clamping."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (LET ((MAT (CALC-CAT-MATRIX-FOR-LRGB FROM-RGBSPACE TO-RGBSPACE CAT)))
      (ECASE TARGET
        (:LRGB
         #'(LAMBDA (LR LG LB)
             (MULTIPLY-MAT-VEC MAT (FLOAT LR 1.0d0) (FLOAT LG 1.0d0)
              (FLOAT LB 1.0d0))))
        (:RGB
         #'(LAMBDA (R G B)
             (MULTIPLE-VALUE-CALL #'LRGB-TO-RGB
               (MULTIPLE-VALUE-CALL #'MULTIPLY-MAT-VEC
                 MAT
                 (RGB-TO-LRGB (FLOAT R 1.0d0) (FLOAT G 1.0d0) (FLOAT B 1.0d0)
                  :RGBSPACE FROM-RGBSPACE))
               :RGBSPACE
               TO-RGBSPACE)))
        (:QRGB
         #'(LAMBDA (QR QG QB)
             (MULTIPLE-VALUE-CALL #'LRGB-TO-QRGB
               (MULTIPLE-VALUE-CALL #'MULTIPLY-MAT-VEC
                 MAT
                 (QRGB-TO-LRGB QR QG QB :RGBSPACE FROM-RGBSPACE))
               :RGBSPACE
               TO-RGBSPACE)))
        (:RGBPACK
         #'(LAMBDA (INT)
             (MULTIPLE-VALUE-CALL #'LRGB-TO-RGBPACK
               (MULTIPLE-VALUE-CALL #'MULTIPLY-MAT-VEC
                 MAT
                 (RGBPACK-TO-LRGB INT :RGBSPACE FROM-RGBSPACE))
               :RGBSPACE
               TO-RGBSPACE))))))

[dufy/src/core/deltae.lisp:13]
  (DEFINE-FUNCTIONAL (LAB-DELTAEAB LAB :TERM DELTAEAB) (L1 A1 B1 L2 A2 B2)
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
   "CIE 1976. Euclidean distance in L*a*b* space."
   (WITH-ENSURING-TYPE DOUBLE-FLOAT (L1 A1 B1 L2 A2 B2)
    (SQRT (+ (SQUARE (- L1 L2)) (SQUARE (- A1 A2)) (SQUARE (- B1 B2))))))

[dufy/src/core/deltae.lisp:25]
  (DEFINE-FUNCTIONAL (LAB-DELTAE94 LAB :TERM DELTAE94)
   (L1 A1 B1 L2 A2 B2 &KEY (APPLICATION :GRAPHIC-ARTS))
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1))) "CIE 1994.
APPLICATION ::= :graphic-arts | :textiles"
   (WITH-ENSURING-TYPE DOUBLE-FLOAT (L1 A1 B1 L2 A2 B2)
    (LET ((C1 (SQRT (+ (SQUARE A1) (SQUARE B1))))
          (C2 (SQRT (+ (SQUARE A2) (SQUARE B2)))))
      (LET* ((DELTA-L (- L1 L2))
             (DELTA-C (- C1 C2))
             (DELTA-A (- A1 A2))
             (DELTA-B (- B1 B2))
             (DELTA-H
              (SQRT
               (THE (DOUBLE-FLOAT 0.0d0)
                    (+ (SQUARE DELTA-A) (SQUARE DELTA-B)
                       (- (SQUARE DELTA-C)))))))
        (MULTIPLE-VALUE-BIND (KL K1 K2)
            (ECASE APPLICATION
              (:GRAPHIC-ARTS (VALUES 1.0d0 0.045d0 0.015d0))
              (:TEXTILES (VALUES 2.0d0 0.048d0 0.014d0)))
          (LET ((SC (+ 1.0d0 (* K1 C1))) (SH (+ 1.0d0 (* K2 C1))))
            (SQRT
             (+ (SQUARE (/ DELTA-L KL)) (SQUARE (/ DELTA-C SC))
                (SQUARE (/ DELTA-H SH))))))))))

[dufy/src/core/deltae.lisp:54]
  (DEFINE-FUNCTIONAL (LAB-DELTAE00 LAB :TERM DELTAE00) (L1 A1 B1 L2 A2 B2)
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1))) "CIEDE2000.

Tested with the test set by Sharma-Wu-Dalal. See \"The CIEDE2000
Color-Difference Formula: Implementation Notes, Supplementary Test Data, and
Mathematical Observations\", 2004."
   (WITH-ENSURING-TYPE DOUBLE-FLOAT (L1 A1 B1 L2 A2 B2)
    (LET* ((C1 (SQRT (+ (SQUARE A1) (SQUARE B1))))
           (C2 (SQRT (+ (SQUARE A2) (SQUARE B2))))
           (DELTALPRIME (- L2 L1))
           (LMEAN (* 0.5d0 (+ L1 L2)))
           (CMEAN (* 0.5d0 (+ C1 C2)))
           (CMEAN7 (POW CMEAN 7))
           (G (* 0.5d0 (- 1.0d0 (SQRT (/ CMEAN7 (+ CMEAN7 NIL))))))
           (APRIME1 (+ A1 (* A1 G)))
           (APRIME2 (+ A2 (* A2 G)))
           (CPRIME1 (SQRT (+ (SQUARE APRIME1) (SQUARE B1))))
           (CPRIME2 (SQRT (+ (SQUARE APRIME2) (SQUARE B2))))
           (CMEANPRIME (* 0.5d0 (+ CPRIME1 CPRIME2)))
           (CMEANPRIME7 (POW CMEANPRIME 7))
           (DELTACPRIME (- CPRIME2 CPRIME1))
           (HPRIME1 (MOD (ATAN B1 APRIME1) TWO-PI))
           (HPRIME2 (MOD (ATAN B2 APRIME2) TWO-PI))
           (DELTAHPRIME (- HPRIME2 HPRIME1))
           (CAPHMEANPRIME 0.0d0))
      (COND
       ((OR (ZEROP CPRIME1) (ZEROP CPRIME2)) (SETF DELTAHPRIME 0.0d0)
        (SETF CAPHMEANPRIME (+ HPRIME1 HPRIME2)))
       ((<= (ABS DELTAHPRIME) PI)
        (SETF CAPHMEANPRIME (* (+ HPRIME1 HPRIME2) 0.5d0)))
       ((<= HPRIME2 HPRIME1) (INCF DELTAHPRIME TWO-PI)
        (IF (< (+ HPRIME1 HPRIME2) TWO-PI)
            (SETF CAPHMEANPRIME (* 0.5d0 (+ HPRIME1 HPRIME2 TWO-PI)))
            (SETF CAPHMEANPRIME (* 0.5d0 (+ HPRIME1 HPRIME2 (- TWO-PI))))))
       (T (DECF DELTAHPRIME TWO-PI)
        (IF (< (+ HPRIME1 HPRIME2) TWO-PI)
            (SETF CAPHMEANPRIME (* 0.5d0 (+ HPRIME1 HPRIME2 TWO-PI)))
            (SETF CAPHMEANPRIME (* 0.5d0 (+ HPRIME1 HPRIME2 (- TWO-PI)))))))
      (LET* ((DELTACAPHPRIME
              (* 2.0d0 (SQRT (* CPRIME1 CPRIME2)) (SIN (* DELTAHPRIME 0.5d0))))
             (VART
              (+ 1.0d0 (* -0.17d0 (COS (- CAPHMEANPRIME NIL)))
                 (* 0.24d0 (COS (* 2.0d0 CAPHMEANPRIME)))
                 (* 0.32d0 (COS (+ (* 3.0d0 CAPHMEANPRIME) NIL)))
                 (* -0.2d0 (COS (- (* 4.0d0 CAPHMEANPRIME) NIL)))))
             (LMEAN-OFFSETTED-SQUARED (SQUARE (- LMEAN 50.0d0)))
             (VARSL
              (+ 1.0d0
                 (/ (* 0.015d0 LMEAN-OFFSETTED-SQUARED)
                    (SQRT (+ 20.0d0 LMEAN-OFFSETTED-SQUARED)))))
             (VARSC (+ 1.0d0 (* 0.045d0 CMEANPRIME)))
             (VARSH (+ 1.0d0 (* 0.015d0 CMEANPRIME VART)))
             (VARRT
              (* -2.0d0 (SQRT (/ CMEANPRIME7 (+ CMEANPRIME7 NIL)))
                 (SIN
                  (* NIL (EXP (- (SQUARE (* (- CAPHMEANPRIME NIL) NIL))))))))
             (FACTOR-L (/ DELTALPRIME VARSL))
             (FACTOR-C (/ DELTACPRIME VARSC))
             (FACTOR-H (/ DELTACAPHPRIME VARSH)))
        (SQRT
         (THE (DOUBLE-FLOAT 0.0d0)
              (+ (SQUARE FACTOR-L) (SQUARE FACTOR-C) (SQUARE FACTOR-H)
                 (* VARRT FACTOR-C FACTOR-H))))))))

[dufy/src/core/deltae.lisp:126]
  (DEFINE-FUNCTIONAL (LAB-DELTAECMC LAB :TERM DELTAECMC)
   (L1 A1 B1 L2 A2 B2 &KEY (L-FACTOR 2.0d0) (C-FACTOR 1.0d0))
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1))) "CMC l:c"
   (WITH-ENSURING-TYPE DOUBLE-FLOAT (L1 A1 B1 L2 A2 B2 L-FACTOR C-FACTOR)
    (LET* ((DELTAA (- A1 A2))
           (DELTAB (- B1 B2))
           (DELTAL (- L1 L2))
           (C1-SQUARED (+ (SQUARE A1) (SQUARE B1)))
           (C1 (SQRT C1-SQUARED))
           (C1-4 (SQUARE C1-SQUARED))
           (C2 (SQRT (+ (* A2 A2) (* B2 B2))))
           (DELTAC (- C1 C2))
           (DELTAH-2
            (THE (DOUBLE-FLOAT 0.0d0)
                 (+ (SQUARE DELTAA) (SQUARE DELTAB) (- (SQUARE DELTAC)))))
           (H1 (MOD (ATAN B1 A1) TWO-PI))
           (F (SQRT (/ C1-4 (+ 1900.0d0 C1-4))))
           (TT
            (IF (OR (< H1 NIL) (< NIL H1))
                (+ 0.36d0 (ABS (* 0.4d0 (COS (+ H1 NIL)))))
                (+ 0.56d0 (ABS (* 0.2d0 (COS (+ H1 NIL)))))))
           (SL
            (IF (< L1 16.0d0)
                0.511d0
                (/ (* 0.040975d0 L1) (1+ (* 0.01765d0 L1)))))
           (SC (+ 0.638d0 (/ (* 0.0638d0 C1) (1+ (* 0.0131d0 C1)))))
           (SH (* SC (+ 1.0d0 (* F TT) (- F))))
           (FACTOR-L (/ DELTAL (* L-FACTOR SL)))
           (FACTOR-C (/ DELTAC (* C-FACTOR SC)))
           (FACTOR-H-2 (/ DELTAH-2 (* SH SH))))
      (SQRT (+ (* FACTOR-L FACTOR-L) (* FACTOR-C FACTOR-C) FACTOR-H-2)))))

[dufy/src/core/illuminants-data.lisp:14]
  (DEFPARAMETER +ILLUM-A+
    (MAKE-ILLUMINANT :SPECTRUM
     #'(LAMBDA (WL)
         (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
         (LET ((WL (FLOAT WL 1.0d0)))
           (ASSERT (>= WL 0.0d0))
           (* 100.0d0 (EXPT (/ 560.0d0 (THE (DOUBLE-FLOAT 0.0d0) WL)) 5)
              (/ NIL (- (EXP (/ 1.435d7 (* 2848.0d0 WL))) 1.0d0)))))
     :BEGIN-WL 380 :END-WL 780 :BAND 5 :COMPILE-TIME T))

[dufy/src/core/lab-and-luv.lisp:19]
  (DEFUN FUNCTION-F (X)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (DOUBLE-FLOAT X))
    (IF (> X NIL)
        (EXPT X NIL)
        (+ (* NIL X) NIL)))

[dufy/src/core/lab-and-luv.lisp:26]
  (DEFINE-PRIMARY-CONVERTER (XYZ LAB) (X Y Z &KEY (ILLUMINANT +ILLUM-D65+))
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
   (WITH-ENSURING-TYPE DOUBLE-FLOAT (X Y Z)
    (LET ((FX (FUNCTION-F (/ X (ILLUMINANT-X ILLUMINANT))))
          (FY (FUNCTION-F Y))
          (FZ (FUNCTION-F (/ Z (ILLUMINANT-Z ILLUMINANT)))))
      (VALUES (- (* 116.0d0 FY) 16.0d0) (* 500.0d0 (- FX FY))
              (* 200.0d0 (- FY FZ))))))

[dufy/src/core/lab-and-luv.lisp:36]
  (DEFINE-PRIMARY-CONVERTER (LAB XYZ)
   (LSTAR ASTAR BSTAR &KEY (ILLUMINANT +ILLUM-D65+))
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
   (LET* ((FY (* (+ (FLOAT LSTAR 1.0d0) 16.0d0) 1/116))
          (FX (+ FY (* (FLOAT ASTAR 1.0d0) 0.002d0)))
          (FZ (- FY (* (FLOAT BSTAR 1.0d0) 0.005d0))))
     (VALUES
      (IF (> FX NIL)
          (* (ILLUMINANT-X ILLUMINANT) FX FX FX)
          (* (- FX NIL) NIL (ILLUMINANT-X ILLUMINANT)))
      (IF (> FY NIL)
          (* FY FY FY)
          (* (- FY NIL) NIL))
      (IF (> FZ NIL)
          (* (ILLUMINANT-Z ILLUMINANT) FZ FZ FZ)
          (* (- FZ NIL) NIL (ILLUMINANT-Z ILLUMINANT))))))

[dufy/src/core/lab-and-luv.lisp:52]
  (DEFUN LSTAR-TO-Y (LSTAR)
    "L* (of L*a*b*) to Y (of XYZ)"
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (LET* ((FY (* (+ (FLOAT LSTAR 1.0d0) 16.0d0) 1/116)))
      (IF (> FY NIL)
          (* FY FY FY)
          (* (- FY 4/29) NIL))))

[dufy/src/core/lab-and-luv.lisp:61]
  (DEFUN Y-TO-LSTAR (Y)
    "Y (of XYZ) to L* (of L*a*b*)"
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (- (* 116.0d0 (FUNCTION-F (FLOAT Y 1.0d0))) 16.0d0))

[dufy/src/core/lab-and-luv.lisp:66]
  (DEFINE-PRIMARY-CONVERTER (LAB LCHAB) (LSTAR ASTAR BSTAR)
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
   (WITH-ENSURING-TYPE DOUBLE-FLOAT (LSTAR ASTAR BSTAR)
    (VALUES LSTAR (SQRT (+ (* ASTAR ASTAR) (* BSTAR BSTAR)))
            (MOD (* (ATAN BSTAR ASTAR) +360/TWO-PI+) 360.0d0))))

[dufy/src/core/lab-and-luv.lisp:73]
  (DEFINE-PRIMARY-CONVERTER (LCHAB LAB) (LSTAR CSTARAB HAB)
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
   (WITH-ENSURING-TYPE DOUBLE-FLOAT (LSTAR CSTARAB HAB)
    (LET ((HUE-TWO-PI (* HAB +TWO-PI/360+)))
      (VALUES LSTAR (* CSTARAB (COS HUE-TWO-PI))
              (* CSTARAB (SIN HUE-TWO-PI))))))

[dufy/src/core/lab-and-luv.lisp:105]
  (DEFUN CALC-UVPRIME (X Y)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (DOUBLE-FLOAT X Y))
    "Calculates u' and v' from xy."
    (LET ((DENOM (+ (* -2.0d0 X) (* 12.0d0 Y) 3.0d0)))
      (VALUES (/ (* 4.0d0 X) DENOM) (/ (* 9.0d0 Y) DENOM))))

[dufy/src/core/lab-and-luv.lisp:114]
  (DEFUN CALC-UVPRIME-FROM-XYZ (X Y Z)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (DOUBLE-FLOAT X Y Z))
    "Calculates u' and v' from XYZ."
    (LET ((DENOM (+ X (* 15.0d0 Y) (* 3.0d0 Z))))
      (VALUES (/ (* 4.0d0 X) DENOM) (/ (* 9.0d0 Y) DENOM))))

[dufy/src/core/lab-and-luv.lisp:122]
  (DEFINE-PRIMARY-CONVERTER (XYZ LUV) (X Y Z &KEY (ILLUMINANT +ILLUM-D65+))
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
   (WITH-ENSURING-TYPE DOUBLE-FLOAT (X Y Z)
    (MULTIPLE-VALUE-BIND (UPRIME VPRIME)
        (CALC-UVPRIME-FROM-XYZ X Y Z)
      (MULTIPLE-VALUE-BIND (URPRIME VRPRIME)
          (CALC-UVPRIME-FROM-XYZ (ILLUMINANT-X ILLUMINANT) 1.0d0
           (ILLUMINANT-Z ILLUMINANT))
        (LET ((LSTAR
               (IF (> Y NIL)
                   (- (* 116.0d0 (EXPT Y NIL)) 16.0d0)
                   (* NIL Y))))
          (VALUES LSTAR (* 13.0d0 LSTAR (- UPRIME URPRIME))
                  (* 13.0d0 LSTAR (- VPRIME VRPRIME))))))))

[dufy/src/core/lab-and-luv.lisp:138]
  (DEFINE-PRIMARY-CONVERTER (LUV XYZ)
   (LSTAR USTAR VSTAR &KEY (ILLUMINANT +ILLUM-D65+))
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
   (WITH-ENSURING-TYPE DOUBLE-FLOAT (LSTAR USTAR VSTAR)
    (MULTIPLE-VALUE-BIND (URPRIME VRPRIME)
        (CALC-UVPRIME-FROM-XYZ (ILLUMINANT-X ILLUMINANT) 1.0d0
         (ILLUMINANT-Z ILLUMINANT))
      (LET* ((UPRIME (+ (/ USTAR (* 13.0d0 LSTAR)) URPRIME))
             (VPRIME (+ (/ VSTAR (* 13.0d0 LSTAR)) VRPRIME))
             (L (/ (+ LSTAR 16.0d0) 116.0d0))
             (Y
              (IF (<= LSTAR 8.0d0)
                  (* LSTAR NIL)
                  (* L L L))))
        (VALUES (* Y (/ (* 9.0d0 UPRIME) (* 4.0d0 VPRIME))) Y
                (* Y
                   (/ (- 12.0d0 (* 3.0d0 UPRIME) (* 20.0d0 VPRIME))
                      (* 4.0d0 VPRIME))))))))

[dufy/src/core/lab-and-luv.lisp:155]
  (DEFINE-PRIMARY-CONVERTER (LUV LCHUV) (LSTAR USTAR VSTAR)
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
   (WITH-ENSURING-TYPE DOUBLE-FLOAT (LSTAR USTAR VSTAR)
    (VALUES LSTAR (SQRT (+ (* USTAR USTAR) (* VSTAR VSTAR)))
            (MOD (* (ATAN VSTAR USTAR) +360/TWO-PI+) 360.0d0))))

[dufy/src/core/lab-and-luv.lisp:162]
  (DEFINE-PRIMARY-CONVERTER (LCHUV LUV) (LSTAR CSTARUV HUV)
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
   (WITH-ENSURING-TYPE DOUBLE-FLOAT (LSTAR CSTARUV HUV)
    (LET ((HUE-TWO-PI (* HUV +TWO-PI/360+)))
      (VALUES LSTAR (* CSTARUV (COS HUE-TWO-PI))
              (* CSTARUV (SIN HUE-TWO-PI))))))

[dufy/src/core/rgb.lisp:42]
  (DEFUN GEN-LINEARIZER (GAMMA)
    "Returns a linearization function for a given gamma value. You shouldn't call
the returned function directly as it is not safe. Use LINEARIZE instead."
    (LET ((GAMMA (FLOAT GAMMA 1.0d0)))
      #'(LAMBDA (X)
          (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
                   (DOUBLE-FLOAT X))
          (IF (PLUSP X)
              (EXPT X GAMMA)
              (- (EXPT (- X) GAMMA))))))

[dufy/src/core/rgb.lisp:53]
  (DEFUN GEN-DELINEARIZER (GAMMA)
    "Returns a gamma-correction function for a given gamma value. You shouldn't
call the returned function directly as it is not safe. Use DELINEARIZE instead."
    (LET ((/GAMMA (/ (FLOAT GAMMA 1.0d0))))
      #'(LAMBDA (X)
          (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
                   (DOUBLE-FLOAT X))
          (IF (PLUSP X)
              (EXPT X /GAMMA)
              (- (EXPT (- X) /GAMMA))))))

[dufy/src/core/rgb.lisp:99]
  (DEFUN MAKE-RGBSPACE
         (XR YR XG YG XB YB
          &KEY (ILLUMINANT +ILLUM-D65+) (LMIN 0.0d0) (LMAX 1.0d0)
          (LINEARIZER (RCURRY #'FLOAT 1.0d0))
          (DELINEARIZER (RCURRY #'FLOAT 1.0d0)) (BIT-PER-CHANNEL 8)
          (FORCE-NORMAL NIL))
    "xr, yr, xg, yg, xb, yb := primary coordinates in the xy plane.
[lmin, lmax] := range of linear values ([0, 1] typically).

LINEARIZER and DELINEARIZER must be (FUNCTION * (VALUES DOUBLE-FLOAT
&OPTIONAL)).

If FORCE-NORMAL is T, the nominal range of gamma-corrected values is forcibly
set to [0d0, 1d0]. This option is used to avoid the computed range being
e.g. [0d0, 0.9999999999999999d0]."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1))
             ((FUNCTION * (VALUES DOUBLE-FLOAT &OPTIONAL)) LINEARIZER
              DELINEARIZER))
    (WITH-ENSURING-TYPE DOUBLE-FLOAT (XR YR XG YG XB YB)
     (LET ((COORDINATES
            (MAKE-ARRAY '(3 3) :ELEMENT-TYPE 'DOUBLE-FLOAT :INITIAL-CONTENTS
                        (ECLECTOR.READER:QUASIQUOTE
                         (((ECLECTOR.READER:UNQUOTE XR)
                           (ECLECTOR.READER:UNQUOTE XG)
                           (ECLECTOR.READER:UNQUOTE XB))
                          ((ECLECTOR.READER:UNQUOTE YR)
                           (ECLECTOR.READER:UNQUOTE YG)
                           (ECLECTOR.READER:UNQUOTE YB))
                          ((ECLECTOR.READER:UNQUOTE (- 1.0d0 XR YR))
                           (ECLECTOR.READER:UNQUOTE (- 1.0d0 XG YG))
                           (ECLECTOR.READER:UNQUOTE (- 1.0d0 XB YB))))))))
       (MULTIPLE-VALUE-BIND (SR SG SB)
           (MULTIPLY-MAT-VEC (INVERT-MATRIX COORDINATES)
            (ILLUMINANT-X ILLUMINANT) 1.0d0 (ILLUMINANT-Z ILLUMINANT))
         (LET* ((MAT
                 (MAKE-ARRAY '(3 3) :ELEMENT-TYPE 'DOUBLE-FLOAT
                             :INITIAL-CONTENTS
                             (ECLECTOR.READER:QUASIQUOTE
                              (((ECLECTOR.READER:UNQUOTE
                                 (* SR (AREF COORDINATES 0 0)))
                                (ECLECTOR.READER:UNQUOTE
                                 (* SG (AREF COORDINATES 0 1)))
                                (ECLECTOR.READER:UNQUOTE
                                 (* SB (AREF COORDINATES 0 2))))
                               ((ECLECTOR.READER:UNQUOTE
                                 (* SR (AREF COORDINATES 1 0)))
                                (ECLECTOR.READER:UNQUOTE
                                 (* SG (AREF COORDINATES 1 1)))
                                (ECLECTOR.READER:UNQUOTE
                                 (* SB (AREF COORDINATES 1 2))))
                               ((ECLECTOR.READER:UNQUOTE
                                 (* SR (AREF COORDINATES 2 0)))
                                (ECLECTOR.READER:UNQUOTE
                                 (* SG (AREF COORDINATES 2 1)))
                                (ECLECTOR.READER:UNQUOTE
                                 (* SB (AREF COORDINATES 2 2))))))))
                (MIN
                 (IF FORCE-NORMAL
                     0.0d0
                     (FUNCALL DELINEARIZER LMIN)))
                (MAX
                 (IF FORCE-NORMAL
                     1.0d0
                     (FUNCALL DELINEARIZER LMAX)))
                (NORMAL (AND (= MIN 0.0d0) (= MAX 1.0d0)))
                (QMAX (- (EXPT 2 BIT-PER-CHANNEL) 1))
                (QMAX-FLOAT (FLOAT QMAX 1.0d0))
                (LEN (- MAX MIN)))
           (%MAKE-RGBSPACE :XR XR :YR YR :XG XG :YG YG :XB XB :YB YB
            :ILLUMINANT ILLUMINANT :LINEARIZER LINEARIZER :DELINEARIZER
            DELINEARIZER :TO-XYZ-MATRIX MAT :FROM-XYZ-MATRIX
            (INVERT-MATRIX MAT) :LMAX LMAX :LMIN LMIN :MIN MIN :MAX MAX :LENGTH
            LEN :/LENGTH (/ LEN) :NORMAL NORMAL :BIT-PER-CHANNEL
            BIT-PER-CHANNEL :QMAX QMAX :QMAX-FLOAT QMAX-FLOAT
            :QMAX-FLOAT/LENGTH (/ QMAX-FLOAT LEN) :LENGTH/QMAX-FLOAT
            (/ LEN QMAX-FLOAT)))))))

[dufy/src/core/rgb.lisp:161]
  (DEFUN LINEARIZE-SRGB (X)
    "linearizer of sRGB (actually the same as bg-sRGB)"
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (DOUBLE-FLOAT X))
    (COND ((> X NIL) (EXPT (* (+ 0.055d0 X) NIL) 2.4d0))
          ((< X NIL) (- (EXPT (* (- 0.055d0 X) NIL) 2.4d0))) (T (* X NIL))))

[dufy/src/core/rgb.lisp:171]
  (DEFUN DELINEARIZE-SRGB (X)
    "delinealizer of sRGB (actually the same as bg-sRGB)"
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (DOUBLE-FLOAT X))
    (COND ((> X 0.0031308d0) (+ (* 1.055d0 (EXPT X NIL)) -0.055d0))
          ((< X -0.0031308d0) (+ (* -1.055d0 (EXPT (- X) NIL)) 0.055d0))
          (T (* X 12.92d0))))

[dufy/src/core/rgb.lisp:188]
  (DEFINE-PRIMARY-CONVERTER (XYZ LRGB)
   (X Y Z &KEY (RGBSPACE +SRGB+) &AUX
    (ILLUMINANT (RGBSPACE-ILLUMINANT RGBSPACE)))
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1))
            (IGNORABLE ILLUMINANT))
   (MULTIPLY-MAT-VEC (RGBSPACE-FROM-XYZ-MATRIX RGBSPACE) (FLOAT X 1.0d0)
    (FLOAT Y 1.0d0) (FLOAT Z 1.0d0)))

[dufy/src/core/rgb.lisp:196]
  (DEFINE-PRIMARY-CONVERTER (LRGB XYZ)
   (LR LG LB &KEY (RGBSPACE +SRGB+) &AUX
    (ILLUMINANT (RGBSPACE-ILLUMINANT RGBSPACE)))
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1))
            (IGNORABLE ILLUMINANT))
   (MULTIPLY-MAT-VEC (RGBSPACE-TO-XYZ-MATRIX RGBSPACE) (FLOAT LR 1.0d0)
    (FLOAT LG 1.0d0) (FLOAT LB 1.0d0)))

[dufy/src/core/rgb.lisp:208]
  (DEFUN LRGB-OUT-OF-GAMUT-P
         (LR LG LB &KEY (RGBSPACE +SRGB+) (THRESHOLD 1.0d-4))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    "Returns true if at least one of LR, LG, and LB is outside the
interval [RGBSPACE-LMIN - THRESHOLD, RGBSPACE-LMAX + THRESHOLD]."
    (WITH-ENSURING-TYPE DOUBLE-FLOAT (LR LG LB THRESHOLD)
     (LET ((INF (- (RGBSPACE-LMIN RGBSPACE) THRESHOLD))
           (SUP (+ (RGBSPACE-LMAX RGBSPACE) THRESHOLD)))
       (NOT (AND (<= INF LR SUP) (<= INF LG SUP) (<= INF LB SUP))))))

[dufy/src/core/rgb.lisp:220]
  (DEFUN LINEARIZE (X &KEY (RGBSPACE +SRGB+))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (FUNCALL (RGBSPACE-LINEARIZER RGBSPACE) (FLOAT X 1.0d0)))

[dufy/src/core/rgb.lisp:225]
  (DEFUN DELINEARIZE (X &KEY (RGBSPACE +SRGB+))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (FUNCALL (RGBSPACE-DELINEARIZER RGBSPACE) (FLOAT X 1.0d0)))

[dufy/src/core/rgb.lisp:229]
  (DEFINE-PRIMARY-CONVERTER (LRGB RGB) (LR LG LB &KEY (RGBSPACE +SRGB+))
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
   (LET ((DELIN (RGBSPACE-DELINEARIZER RGBSPACE)))
     (VALUES (FUNCALL DELIN (FLOAT LR 1.0d0)) (FUNCALL DELIN (FLOAT LG 1.0d0))
             (FUNCALL DELIN (FLOAT LB 1.0d0)))))

[dufy/src/core/rgb.lisp:236]
  (DEFINE-PRIMARY-CONVERTER (RGB LRGB) (R G B &KEY (RGBSPACE +SRGB+))
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
   (LET ((LIN (RGBSPACE-LINEARIZER RGBSPACE)))
     (VALUES (FUNCALL LIN (FLOAT R 1.0d0)) (FUNCALL LIN (FLOAT G 1.0d0))
             (FUNCALL LIN (FLOAT B 1.0d0)))))

[dufy/src/core/rgb.lisp:243]
  (DEFUN RGB-OUT-OF-GAMUT-P (R G B &KEY (RGBSPACE +SRGB+) (THRESHOLD 1.0d-4))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    "Returns true if at least one of R, G, and B is outside the interval
[RGBSPACE-MIN - THRESHOLD, RGBSPACE-MAX + THRESHOLD]."
    (WITH-ENSURING-TYPE DOUBLE-FLOAT (R G B THRESHOLD)
     (LET ((INF (- (RGBSPACE-MIN RGBSPACE) THRESHOLD))
           (SUP (+ (RGBSPACE-MAX RGBSPACE) THRESHOLD)))
       (NOT (AND (<= INF R SUP) (<= INF G SUP) (<= INF B SUP))))))

[dufy/src/core/rgb.lisp:258]
  (DEFUN QRGB-OUT-OF-GAMUT-P (QR QG QB &KEY (RGBSPACE +SRGB+) (THRESHOLD 0))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1))
             (FIXNUM QR QG QB THRESHOLD))
    (LET ((INF (- THRESHOLD)) (SUP (+ (RGBSPACE-QMAX RGBSPACE) THRESHOLD)))
      (NOT (AND (<= INF QR SUP) (<= INF QG SUP) (<= INF QB SUP)))))

[dufy/src/core/rgb.lisp:268]
  (DEFUN QUANTIZE (X &KEY (RGBSPACE +SRGB+) (CLAMP T))
    "Quantizes an RGB value to a QRGB value"
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (IF CLAMP
        (CLAMP
         (ROUND
          (* (- (FLOAT X 1.0d0) (RGBSPACE-MIN RGBSPACE))
             (RGBSPACE-QMAX-FLOAT/LENGTH RGBSPACE)))
         0 (RGBSPACE-QMAX RGBSPACE))
        (ROUND
         (* (- (FLOAT X 1.0d0) (RGBSPACE-MIN RGBSPACE))
            (RGBSPACE-QMAX-FLOAT/LENGTH RGBSPACE)))))

[dufy/src/core/rgb.lisp:280]
  (DEFUN DEQUANTIZE (N &KEY (RGBSPACE +SRGB+))
    "Dequantizes a QRGB value to an RGB value"
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1))
             (FIXNUM N))
    (+ (RGBSPACE-MIN RGBSPACE) (* N (RGBSPACE-LENGTH/QMAX-FLOAT RGBSPACE))))

[dufy/src/core/rgb.lisp:287]
  (DEFINE-PRIMARY-CONVERTER (RGB QRGB) (R G B &KEY (RGBSPACE +SRGB+) (CLAMP T))
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
   "Quantizes RGB values from [RGBSPACE-MIN, RGBSPACE-MAX] ([0, 1] typically) to
0, 1, ..., RGBSPACE-QMAX (255 typically), though it accepts all the real values
and properly processes them as out-of-gamut color."
   (WITH-ENSURING-TYPE DOUBLE-FLOAT (R G B)
    (LET ((MIN (RGBSPACE-MIN RGBSPACE))
          (QMAX-FLOAT/LENGTH (RGBSPACE-QMAX-FLOAT/LENGTH RGBSPACE))
          (QMAX (RGBSPACE-QMAX RGBSPACE)))
      (IF CLAMP
          (VALUES (CLAMP (ROUND (* (- R MIN) QMAX-FLOAT/LENGTH)) 0 QMAX)
                  (CLAMP (ROUND (* (- G MIN) QMAX-FLOAT/LENGTH)) 0 QMAX)
                  (CLAMP (ROUND (* (- B MIN) QMAX-FLOAT/LENGTH)) 0 QMAX))
          (VALUES (ROUND (* (- R MIN) QMAX-FLOAT/LENGTH))
                  (ROUND (* (- G MIN) QMAX-FLOAT/LENGTH))
                  (ROUND (* (- B MIN) QMAX-FLOAT/LENGTH)))))))

[dufy/src/core/rgb.lisp:304]
  (DEFINE-PRIMARY-CONVERTER (RGBA QRGBA)
   (R G B ALPHA &KEY (RGBSPACE +SRGB+) (CLAMP T))
   "Quantizes RGBA values from [RGBSPACE-MIN, RGBSPACE-MAX] ([0, 1],
typically) to {0, 1, ..., RGBSPACE-QMAX} ({0, 1, ..., 255},
typically), though it accepts all the real values."
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
   (WITH-ENSURING-TYPE DOUBLE-FLOAT (R G B ALPHA)
    (LET ((MIN (RGBSPACE-MIN RGBSPACE))
          (QMAX-FLOAT/LENGTH (RGBSPACE-QMAX-FLOAT/LENGTH RGBSPACE))
          (QMAX (RGBSPACE-QMAX RGBSPACE)))
      (IF CLAMP
          (VALUES (CLAMP (ROUND (* (- R MIN) QMAX-FLOAT/LENGTH)) 0 QMAX)
                  (CLAMP (ROUND (* (- G MIN) QMAX-FLOAT/LENGTH)) 0 QMAX)
                  (CLAMP (ROUND (* (- B MIN) QMAX-FLOAT/LENGTH)) 0 QMAX)
                  (CLAMP (ROUND (* (- ALPHA MIN) QMAX-FLOAT/LENGTH)) 0 QMAX))
          (VALUES (ROUND (* (- R MIN) QMAX-FLOAT/LENGTH))
                  (ROUND (* (- G MIN) QMAX-FLOAT/LENGTH))
                  (ROUND (* (- B MIN) QMAX-FLOAT/LENGTH))
                  (ROUND (* (- ALPHA MIN) QMAX-FLOAT/LENGTH)))))))

[dufy/src/core/rgb.lisp:323]
  (DEFINE-PRIMARY-CONVERTER (QRGB RGB) (QR QG QB &KEY (RGBSPACE +SRGB+))
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
   (LET ((MIN (RGBSPACE-MIN RGBSPACE))
         (LENGTH/QMAX-FLOAT (RGBSPACE-LENGTH/QMAX-FLOAT RGBSPACE)))
     (VALUES (+ MIN (* QR LENGTH/QMAX-FLOAT)) (+ MIN (* QG LENGTH/QMAX-FLOAT))
             (+ MIN (* QB LENGTH/QMAX-FLOAT)))))

[dufy/src/core/rgb.lisp:331]
  (DEFINE-PRIMARY-CONVERTER (QRGBA RGBA)
   (QR QG QB QALPHA &KEY (RGBSPACE +SRGB+))
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
   (LET ((MIN (RGBSPACE-MIN RGBSPACE))
         (LENGTH/QMAX-FLOAT (RGBSPACE-LENGTH/QMAX-FLOAT RGBSPACE)))
     (VALUES (+ MIN (* QR LENGTH/QMAX-FLOAT)) (+ MIN (* QG LENGTH/QMAX-FLOAT))
             (+ MIN (* QB LENGTH/QMAX-FLOAT))
             (+ MIN (* QALPHA LENGTH/QMAX-FLOAT)))))

[dufy/src/core/rgb.lisp:343]
  (DEFINE-PRIMARY-CONVERTER (QRGB RGBPACK)
   (QR QG QB &KEY (RGBSPACE +SRGB+) &AUX (CLAMP NIL))
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1))
            (IGNORABLE CLAMP))
   (LET ((BPC (RGBSPACE-BIT-PER-CHANNEL RGBSPACE))
         (QMAX (RGBSPACE-QMAX RGBSPACE)))
     (+ (ASH (CLAMP QR 0 QMAX) (+ BPC BPC)) (ASH (CLAMP QG 0 QMAX) BPC)
        (CLAMP QB 0 QMAX))))

[dufy/src/core/rgb.lisp:352]
  (DEFINE-PRIMARY-CONVERTER (RGBPACK QRGB) (INT &KEY (RGBSPACE +SRGB+))
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
   "Decodes a packed RGB value, whose type depends on RGBSPACE but is
typically unsigned 24-bit integer.

It is guaranteed that this converter can correctly process a packed RGBA value
if its order is ARGB."
   (LET ((MINUS-BPC (- (RGBSPACE-BIT-PER-CHANNEL RGBSPACE)))
         (QMAX (RGBSPACE-QMAX RGBSPACE)))
     (VALUES (LOGAND (ASH INT (+ MINUS-BPC MINUS-BPC)) QMAX)
             (LOGAND (ASH INT MINUS-BPC) QMAX) (LOGAND INT QMAX))))

[dufy/src/core/rgb.lisp:365]
  (DEFINE-PRIMARY-CONVERTER (QRGBA RGBAPACK)
   (QR QG QB QALPHA &KEY (RGBSPACE +SRGB+) (ORDER :ARGB) &AUX (CLAMP NIL))
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1))
            (IGNORABLE CLAMP))
   "Decodes a packed RGBA value, whose type depends on RGBSPACE but is typically
unsigned 32-bit integer.

The order can be :ARGB or :RGBA. Note that it is different from the 'physical'
byte order in your machine, which depends on the endianess."
   (LET* ((BPC (RGBSPACE-BIT-PER-CHANNEL RGBSPACE))
          (2BPC (+ BPC BPC))
          (QMAX (RGBSPACE-QMAX RGBSPACE)))
     (ECASE ORDER
       (:ARGB
        (+ (CLAMP QB 0 QMAX) (ASH (CLAMP QG 0 QMAX) BPC)
           (ASH (CLAMP QR 0 QMAX) 2BPC)
           (ASH (CLAMP QALPHA 0 QMAX) (+ 2BPC BPC))))
       (:RGBA
        (+ (CLAMP QALPHA 0 QMAX) (ASH (CLAMP QB 0 QMAX) BPC)
           (ASH (CLAMP QG 0 QMAX) 2BPC)
           (ASH (CLAMP QR 0 QMAX) (+ 2BPC BPC)))))))

[dufy/src/core/rgb.lisp:386]
  (DEFINE-PRIMARY-CONVERTER (RGBAPACK QRGBA)
   (INT &KEY (RGBSPACE +SRGB+) (ORDER :ARGB))
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
   "The order can be :ARGB or :RGBA. Note that it is different from the
  'physical' byte order in your machine, which depends on the endianess."
   (LET* ((-BPC (- (RGBSPACE-BIT-PER-CHANNEL RGBSPACE)))
          (-2BPC (+ -BPC -BPC))
          (QMAX (RGBSPACE-QMAX RGBSPACE)))
     (ECASE ORDER
       (:ARGB
        (VALUES (LOGAND (ASH INT -2BPC) QMAX) (LOGAND (ASH INT -BPC) QMAX)
                (LOGAND INT QMAX) (LOGAND (ASH INT (+ -2BPC -BPC)) QMAX)))
       (:RGBA
        (VALUES (LOGAND (ASH INT (+ -2BPC -BPC)) QMAX)
                (LOGAND (ASH INT -2BPC) QMAX) (LOGAND (ASH INT -BPC) QMAX)
                (LOGAND INT QMAX))))))

[dufy/src/core/rgb.lisp:423]
  (DEFINE-PRIMARY-CONVERTER (HSV RGB) (HUE SAT VAL)
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
   "Non-normal RGB space is also accepted, though it depends on the situation
whether the returned values are meaningful."
   (LET ((HUE
          (THE (DOUBLE-FLOAT 0.0d0 360.0d0) (MOD (FLOAT HUE 1.0d0) 360.0d0)))
         (SAT (FLOAT SAT 1.0d0))
         (VAL (FLOAT VAL 1.0d0)))
     (LET* ((C (* VAL SAT))
            (H-PRIME (* HUE NIL))
            (H-PRIME-INT (FLOOR H-PRIME))
            (X (* C (- 1.0d0 (ABS (- (MOD H-PRIME 2.0d0) 1.0d0)))))
            (BASE (- VAL C)))
       (COND ((= SAT 0.0d0) (VALUES BASE BASE BASE))
             ((= 0 H-PRIME-INT) (VALUES VAL (+ BASE X) BASE))
             ((= 1 H-PRIME-INT) (VALUES (+ BASE X) VAL BASE))
             ((= 2 H-PRIME-INT) (VALUES BASE VAL (+ BASE X)))
             ((= 3 H-PRIME-INT) (VALUES BASE (+ BASE X) VAL))
             ((= 4 H-PRIME-INT) (VALUES (+ BASE X) BASE VAL))
             ((= 5 H-PRIME-INT) (VALUES VAL BASE (+ BASE X)))
             (T (ERROR "Reached unreachable clause"))))))

[dufy/src/core/rgb.lisp:446]
  (DEFINE-PRIMARY-CONVERTER (RGB HSV) (R G B)
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
   "Non-normal RGB space is also accepted, though it depends on the
situation whether the returned values are meaningful."
   (WITH-ENSURING-TYPE DOUBLE-FLOAT (R G B)
    (LET* ((MAXRGB (MAX R G B))
           (MINRGB (MIN R G B))
           (S
            (IF (= MAXRGB 0.0d0)
                0.0d0
                (/ (- MAXRGB MINRGB) MAXRGB)))
           (H
            (COND ((= MINRGB MAXRGB) 0.0d0)
                  ((= MINRGB B)
                   (+ (* 60.0d0 (/ (- G R) (- MAXRGB MINRGB))) 60.0d0))
                  ((= MINRGB R)
                   (+ (* 60.0d0 (/ (- B G) (- MAXRGB MINRGB))) 180.0d0))
                  ((= MINRGB G)
                   (+ (* 60.0d0 (/ (- R B) (- MAXRGB MINRGB))) 300.0d0)))))
      (VALUES H S MAXRGB))))

[dufy/src/core/rgb.lisp:464]
  (DEFINE-PRIMARY-CONVERTER (HSL RGB) (HUE SAT LUM)
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
   "Non-normal RGB space is also accepted, though it depends on the
situation whether the returned values are meaningful."
   (WITH-ENSURING-TYPE DOUBLE-FLOAT (HUE SAT LUM)
    (LET* ((HUE (MOD HUE 360.0d0))
           (TMP (* 0.5d0 SAT (- 1.0d0 (ABS (+ LUM LUM -1.0d0)))))
           (MAX (+ LUM TMP))
           (MIN (- LUM TMP))
           (DELTA (- MAX MIN))
           (H-PRIME (FLOOR (THE (DOUBLE-FLOAT 0.0d0 6.0d0) (* HUE 1/60)))))
      (COND ((= SAT 0.0d0) (VALUES MAX MAX MAX))
            ((= 0 H-PRIME) (VALUES MAX (+ MIN (* DELTA HUE 1/60)) MIN))
            ((= 1 H-PRIME)
             (VALUES (+ MIN (* DELTA (- 120.0d0 HUE) 1/60)) MAX MIN))
            ((= 2 H-PRIME)
             (VALUES MIN MAX (+ MIN (* DELTA (- HUE 120.0d0) 1/60))))
            ((= 3 H-PRIME)
             (VALUES MIN (+ MIN (* DELTA (- 240.0d0 HUE) 1/60)) MAX))
            ((= 4 H-PRIME)
             (VALUES (+ MIN (* DELTA (- HUE 240.0d0) 1/60)) MIN MAX))
            ((= 5 H-PRIME)
             (VALUES MAX MIN (+ MIN (* DELTA (- 360.0d0 HUE) 1/60))))
            (T (ERROR "Reached unreachable clause."))))))

[dufy/src/core/rgb.lisp:498]
  (DEFINE-PRIMARY-CONVERTER (RGB HSL) (R G B)
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
   "Non-normal RGB space is also accepted, though it depends on the
situation whether the returned values are meaningful."
   (WITH-ENSURING-TYPE DOUBLE-FLOAT (R G B)
    (LET ((MINRGB (MIN R G B)) (MAXRGB (MAX R G B)))
      (VALUES
       (COND ((= MINRGB MAXRGB) 0.0d0)
             ((= MINRGB B) (+ 60.0d0 (* 60.0d0 (/ (- G R) (- MAXRGB MINRGB)))))
             ((= MINRGB R)
              (+ 180.0d0 (* 60.0d0 (/ (- B G) (- MAXRGB MINRGB)))))
             ((= MINRGB G)
              (+ 300.0d0 (* 60.0d0 (/ (- R B) (- MAXRGB MINRGB))))))
       (LET ((DENOM (- 1.0d0 (ABS (+ MAXRGB MINRGB -1.0d0)))))
         (IF (ZEROP DENOM)
             0.0d0
             (/ (- MAXRGB MINRGB) DENOM)))
       (* 0.5d0 (+ MAXRGB MINRGB))))))

[dufy/src/core/spectrum.lisp:20]
  (DEFUN GEN-SPECTRUM (SPECTRUM-SEQ &OPTIONAL (BEGIN-WL 360) (END-WL 830))
    "GEN-SPECTRUM returns a spectral power distribution
function, #'(lambda (wavelength-nm) ...), which interpolates SPECTRUM-SEQ
linearly.

Note: SPECTRUM-SEQ must be a sequence of double-float.  If the type of
SPECTRUM-SEQ is (simple-array double-float (*)), it is not copied but
referenced, otherwise it is copied by (coerce spectrum-seq '(simple-array
double-float (*)))."
    (CHECK-TYPE SPECTRUM-SEQ SEQUENCE)
    (LET* ((SPECTRUM-ARR
            (IF (TYPEP SPECTRUM-SEQ '(SIMPLE-ARRAY DOUBLE-FLOAT (*)))
                SPECTRUM-SEQ
                (COERCE SPECTRUM-SEQ '(SIMPLE-ARRAY DOUBLE-FLOAT (*)))))
           (SIZE (- (LENGTH SPECTRUM-ARR) 1))
           (BEGIN-WL-F (FLOAT BEGIN-WL 1.0d0))
           (END-WL-F (FLOAT END-WL 1.0d0)))
      (IF (= SIZE (- END-WL BEGIN-WL))
          #'(LAMBDA (WL-NM)
              (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
              (MULTIPLE-VALUE-BIND (QUOT REM)
                  (FLOOR
                   (- (CLAMP (FLOAT WL-NM 1.0d0) BEGIN-WL-F END-WL-F)
                      BEGIN-WL-F))
                (LERP REM (AREF SPECTRUM-ARR QUOT)
                 (AREF SPECTRUM-ARR (MIN (1+ QUOT) SIZE)))))
          (LET* ((BAND (/ (- END-WL-F BEGIN-WL-F) SIZE)) (/BAND (/ BAND)))
            #'(LAMBDA (WL-NM)
                (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
                (LET* ((WL-OFFSET
                        (- (CLAMP (FLOAT WL-NM 1.0d0) BEGIN-WL-F END-WL-F)
                           BEGIN-WL-F))
                       (FRAC (MOD WL-OFFSET BAND))
                       (COEF (* FRAC /BAND))
                       (IDX (ROUND (* (- WL-OFFSET FRAC) /BAND))))
                  (LERP COEF (AREF SPECTRUM-ARR IDX)
                   (AREF SPECTRUM-ARR (MIN (+ IDX 1) SIZE)))))))))

[dufy/src/core/spectrum.lisp:60]
  (DEFUN APPROXIMATE-SPECTRUM
         (SPECTRUM &KEY (BEGIN-WL 360.0d0) (END-WL 830.0d0) (BAND 1.0d0))
    "Generates an approximate spectrum of SPECTRUM by pieacewise linearization. It
is used to lighten a \"heavy\" spectrum function."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1))
             (SPECTRUM-FUNCTION SPECTRUM))
    (WITH-ENSURING-TYPE DOUBLE-FLOAT (BEGIN-WL END-WL BAND)
     (LET* ((PARTITIONS (MAX 2 (ROUND (/ (- END-WL BEGIN-WL) BAND))))
            (PARTITIONS-F (FLOAT PARTITIONS 1.0d0))
            (POINTS (MAKE-ARRAY (1+ PARTITIONS) :ELEMENT-TYPE 'DOUBLE-FLOAT)))
       (DECLARE (FIXNUM PARTITIONS))
       (GEN-SPECTRUM
        (LOOP FOR I FROM 0 TO PARTITIONS
              FOR WL = (LERP (/ I PARTITIONS-F) BEGIN-WL END-WL)
              DO (SETF (AREF POINTS I) (FUNCALL SPECTRUM WL))
              FINALLY (RETURN POINTS))
        BEGIN-WL END-WL))))

[dufy/src/core/spectrum.lisp:96]
  (DEFUN MAKE-OBSERVER (CMF-TABLE &OPTIONAL (BEGIN-WL 360) (END-WL 830))
    "Generates an observer object based on CMF arrays, which must be (SIMPLE-ARRAY
DOUBLE-FLOAT (* 3)). The response outside the interval [begin-wl, end-wl] is
regarded as 0."
    (LET ((BEGIN-WL-F (FLOAT BEGIN-WL 1.0d0)) (END-WL-F (FLOAT END-WL 1.0d0)))
      (LABELS ((GEN-CMF-1DIM (ARR NUM &OPTIONAL (BEGIN-WL 360) (END-WL 830))
                 (DECLARE ((SIMPLE-ARRAY DOUBLE-FLOAT (* 3)) ARR))
                 (LET ((SIZE (- (ARRAY-DIMENSION ARR 0) 1)))
                   (IF (= SIZE (- END-WL BEGIN-WL))
                       #'(LAMBDA (WL)
                           (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
                           (LET ((WL (FLOAT WL 1.0d0)))
                             (IF (OR (< WL BEGIN-WL-F) (< END-WL-F WL))
                                 0.0d0
                                 (MULTIPLE-VALUE-BIND (QUOT REM)
                                     (FLOOR (- WL BEGIN-WL-F))
                                   (LERP REM (AREF ARR QUOT NUM)
                                    (AREF ARR (MIN (1+ QUOT) SIZE) NUM))))))
                       (LET* ((BAND (/ (- END-WL-F BEGIN-WL-F) SIZE))
                              (/BAND (/ BAND)))
                         #'(LAMBDA (WL)
                             (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
                             (LET ((WL (FLOAT WL 1.0d0)))
                               (IF (OR (< WL BEGIN-WL-F) (< END-WL-F WL))
                                   0.0d0
                                   (LET* ((WL-OFFSET (- WL BEGIN-WL-F))
                                          (FRAC (MOD WL-OFFSET BAND))
                                          (COEF (* FRAC /BAND))
                                          (IDX
                                           (ROUND
                                            (* (- WL-OFFSET FRAC) /BAND))))
                                     (LERP COEF (AREF ARR IDX NUM)
                                      (AREF ARR (MIN (+ IDX 1) SIZE)
                                            NUM))))))))))
               (GEN-CMF-3DIMS (ARR &OPTIONAL (BEGIN-WL 360) (END-WL 830))
                 (DECLARE ((SIMPLE-ARRAY DOUBLE-FLOAT (* 3)) ARR))
                 (LET ((SIZE (- (ARRAY-DIMENSION ARR 0) 1)))
                   (IF (= SIZE (- END-WL BEGIN-WL))
                       #'(LAMBDA (WL)
                           (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
                           (LET ((WL (FLOAT WL 1.0d0)))
                             (IF (OR (< WL BEGIN-WL-F) (< END-WL-F WL))
                                 (VALUES 0.0d0 0.0d0 0.0d0)
                                 (MULTIPLE-VALUE-BIND (QUOT REM)
                                     (FLOOR (- WL BEGIN-WL-F))
                                   (VALUES
                                    (LERP REM (AREF ARR QUOT 0)
                                     (AREF ARR (MIN (1+ QUOT) SIZE) 0))
                                    (LERP REM (AREF ARR QUOT 1)
                                     (AREF ARR (MIN (1+ QUOT) SIZE) 1))
                                    (LERP REM (AREF ARR QUOT 2)
                                     (AREF ARR (MIN (1+ QUOT) SIZE) 2)))))))
                       (LET* ((BAND (/ (- END-WL-F BEGIN-WL-F) SIZE))
                              (/BAND (/ BAND)))
                         #'(LAMBDA (WL)
                             (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
                             (LET ((WL (FLOAT WL 1.0d0)))
                               (IF (OR (< WL BEGIN-WL-F) (< END-WL-F WL))
                                   (VALUES 0.0d0 0.0d0 0.0d0)
                                   (LET* ((WL-OFFSET (- WL BEGIN-WL-F))
                                          (FRAC (MOD WL-OFFSET BAND))
                                          (COEF (* FRAC /BAND))
                                          (IDX
                                           (ROUND
                                            (* (- WL-OFFSET FRAC) /BAND)))
                                          (IDX+1 (MIN (1+ IDX) SIZE)))
                                     (VALUES
                                      (LERP COEF (AREF ARR IDX 0)
                                       (AREF ARR IDX+1 0))
                                      (LERP COEF (AREF ARR IDX 1)
                                       (AREF ARR IDX+1 1))
                                      (LERP COEF (AREF ARR IDX 2)
                                       (AREF ARR IDX+1 2))))))))))))
        (%MAKE-OBSERVER :BEGIN-WL BEGIN-WL :END-WL END-WL :CMF-TABLE CMF-TABLE
         :CMF-X (GEN-CMF-1DIM CMF-TABLE 0 BEGIN-WL END-WL) :CMF-Y
         (GEN-CMF-1DIM CMF-TABLE 1 BEGIN-WL END-WL) :CMF-Z
         (GEN-CMF-1DIM CMF-TABLE 2 BEGIN-WL END-WL) :CMF
         (GEN-CMF-3DIMS CMF-TABLE BEGIN-WL END-WL)))))

[dufy/src/core/spectrum.lisp:204]
  (DEFUN MAKE-ILLUM-D-SPECTRUM-ARRAY
         (TEMPERATURE &OPTIONAL (BEGIN-WL 300) (END-WL 830))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (CHECK-TYPE BEGIN-WL FIXNUM)
    (CHECK-TYPE END-WL FIXNUM)
    (LET ((S0-FUNC (LOAD-TIME-VALUE (GEN-SPECTRUM +S0-TABLE+ 300 830) T))
          (S1-FUNC (LOAD-TIME-VALUE (GEN-SPECTRUM +S1-TABLE+ 300 830) T))
          (S2-FUNC (LOAD-TIME-VALUE (GEN-SPECTRUM +S2-TABLE+ 300 830) T)))
      (DECLARE (TYPE SPECTRUM-FUNCTION S0-FUNC S1-FUNC S2-FUNC))
      (LABELS ((CALC-XD (TEMP)
                 (LET ((/TEMP (/ TEMP)))
                   (IF (<= TEMP 7000.0d0)
                       (+ 0.244063d0
                          (* /TEMP
                             (+ 99.11d0
                                (* /TEMP (+ 2967800.0d0 (* /TEMP -4.607d9))))))
                       (+ 0.23704d0
                          (* /TEMP
                             (+ 247.48d0
                                (* /TEMP
                                   (+ 1901800.0d0 (* /TEMP -2.0064d9)))))))))
               (CALC-YD (XD)
                 (+ -0.275d0 (* XD (+ 2.87d0 (* XD -3.0d0))))))
        (LET* ((XD (CALC-XD (FLOAT TEMPERATURE 1.0d0)))
               (YD (CALC-YD XD))
               (DENOM (+ 0.0241d0 (* XD 0.2562d0) (* YD -0.7341d0)))
               (M1 (/ (+ -1.3515d0 (* XD -1.7703d0) (* YD 5.9114d0)) DENOM))
               (M2 (/ (+ 0.03d0 (* XD -31.4424d0) (* YD 30.0717d0)) DENOM))
               (SPD-ARR
                (MAKE-ARRAY (1+ (- END-WL BEGIN-WL)) :ELEMENT-TYPE
                            'DOUBLE-FLOAT :INITIAL-ELEMENT 0.0d0)))
          (LOOP FOR WL FROM BEGIN-WL TO END-WL
                DO (SETF (AREF SPD-ARR (- WL BEGIN-WL))
                           (+ (FUNCALL S0-FUNC WL) (* M1 (FUNCALL S1-FUNC WL))
                              (* M2 (FUNCALL S2-FUNC WL)))))
          SPD-ARR))))

[dufy/src/core/spectrum.lisp:246]
  (DEFUN BB-SPECTRUM (WAVELENGTH-NM &OPTIONAL (TEMPERATURE 5000.0d0))
    "Spectrum function of a blackbody. Note that it is not normalized."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (LET ((WLM (* (FLOAT WAVELENGTH-NM 1.0d0) 1.0d-9)))
      (CHECK-TYPE WLM (DOUBLE-FLOAT 0.0d0))
      (/ (* 3.74183d-16 (EXPT WLM -5.0d0))
         (- (EXP (/ 0.014388d0 (* WLM (FLOAT TEMPERATURE 1.0d0)))) 1.0d0))))

[dufy/src/core/spectrum.lisp:255]
  (DEFUN OPTIMAL-SPECTRUM-PEAK
         (WAVELENGTH-NM &OPTIONAL (WL1 300.0d0) (WL2 830.0d0))
    "Spectrum function of optimal colors:
f(x) = 1d0 if wl1 <= x <= wl2,
f(x) = 0d0 otherwise."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (IF (<= WL1 WAVELENGTH-NM WL2)
        1.0d0
        0.0d0))

[dufy/src/core/spectrum.lisp:263]
  (DEFUN OPTIMAL-SPECTRUM-TROUGH
         (WAVELENGTH-NM &OPTIONAL (WL1 300.0d0) (WL2 830.0d0))
    "Spectrum function of optimal colors:
f(x) = 1d0 if x <= wl2 or wl1 <= x,
f(x) = 0d0 otherwise."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (IF (OR (<= WAVELENGTH-NM WL1) (<= WL2 WAVELENGTH-NM))
        1.0d0
        0.0d0))

[dufy/src/core/spectrum.lisp:273]
  (DEFUN FLAT-SPECTRUM (WAVELENGTH-NM)
    "(constantly 1d0)"
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DECLARE (IGNORE WAVELENGTH-NM))
    1.0d0)

[dufy/src/core/spectrum.lisp:296]
  (DEFUN ILLUMINANT-XY (ILLUMINANT)
    "Returns the xy chromacity coordinates of a given illuminant."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1))
             (TYPE ILLUMINANT ILLUMINANT))
    (LET* ((X (ILLUMINANT-X ILLUMINANT))
           (Z (ILLUMINANT-Z ILLUMINANT))
           (SUM (+ X 1.0d0 Z)))
      (IF (= SUM 0)
          (VALUES 0.0d0 0.0d0)
          (VALUES (/ X SUM) (/ SUM)))))

[dufy/src/core/spectrum.lisp:320]
  (DEFUN %SPECTRUM-TO-XYZ
         (SPECTRUM ILLUMINANT-SPD OBSERVER
          &OPTIONAL (BEGIN-WL 360) (END-WL 830) (BAND 1))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1))
             (SPECTRUM-FUNCTION SPECTRUM ILLUMINANT-SPD))
    "Is an internal function and will be called in SPECTRUM-TO-XYZ in another module.

SPECTRUM := spectral reflectance (or transmittance) ILLUMINANT-SPD :=
SPD of illuminant"
    (LET ((X 0.0d0)
          (Y 0.0d0)
          (Z 0.0d0)
          (MAX-Y 0.0d0)
          (CMF (OBSERVER-CMF OBSERVER)))
      (DECLARE (DOUBLE-FLOAT X Y Z MAX-Y))
      (LOOP FOR WL FROM BEGIN-WL TO END-WL BY BAND
            DO (LET* ((P (FUNCALL ILLUMINANT-SPD WL))
                      (REFLEC (FUNCALL SPECTRUM WL))
                      (FACTOR (* P REFLEC)))
                 (MULTIPLE-VALUE-BIND (X-MATCH Y-MATCH Z-MATCH)
                     (FUNCALL CMF WL)
                   (INCF X (* X-MATCH FACTOR))
                   (INCF Y (* Y-MATCH FACTOR))
                   (INCF Z (* Z-MATCH FACTOR))
                   (INCF MAX-Y (* Y-MATCH P)))))
      (LET ((NORMALIZING-FACTOR (/ MAX-Y)))
        (VALUES (* X NORMALIZING-FACTOR) (* Y NORMALIZING-FACTOR)
                (* Z NORMALIZING-FACTOR)))))

[dufy/src/core/spectrum.lisp:344]
  (DEFUN CALC-TO-SPECTRUM-MATRIX
         (ILLUMINANT-SPD OBSERVER
          &OPTIONAL (BEGIN-WL 360) (END-WL 830) (BAND 1))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    "The returned matrix will be used in XYZ-to-spectrum conversion."
    (LET ((MAT
           (LOAD-TIME-VALUE
            (MAKE-ARRAY '(3 3) :ELEMENT-TYPE 'DOUBLE-FLOAT :INITIAL-ELEMENT
                        0.0d0))))
      (MULTIPLE-VALUE-BIND (A00 A10 A20)
          (%SPECTRUM-TO-XYZ (OBSERVER-CMF-X OBSERVER) ILLUMINANT-SPD OBSERVER
           BEGIN-WL END-WL BAND)
        (MULTIPLE-VALUE-BIND (A01 A11 A21)
            (%SPECTRUM-TO-XYZ (OBSERVER-CMF-Y OBSERVER) ILLUMINANT-SPD OBSERVER
             BEGIN-WL END-WL BAND)
          (MULTIPLE-VALUE-BIND (A02 A12 A22)
              (%SPECTRUM-TO-XYZ (OBSERVER-CMF-Z OBSERVER) ILLUMINANT-SPD
               OBSERVER BEGIN-WL END-WL BAND)
            (SETF (AREF MAT 0 0) A00
                  (AREF MAT 0 1) A01
                  (AREF MAT 0 2) A02
                  (AREF MAT 1 0) A10
                  (AREF MAT 1 1) A11
                  (AREF MAT 1 2) A12
                  (AREF MAT 2 0) A20
                  (AREF MAT 2 1) A21
                  (AREF MAT 2 2) A22))))
      (INVERT-MATRIX MAT)))

[dufy/src/core/xyz.lisp:17]
  (DEFINE-PRIMARY-CONVERTER (XYY XYZ) (SMALL-X SMALL-Y Y)
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
   "Converts xyY to XYZ. The nominal range of Y is [0, 1], though all real values
are accepted."
   (WITH-ENSURING-TYPE DOUBLE-FLOAT (SMALL-X SMALL-Y Y)
    (IF (ZEROP SMALL-Y)
        (VALUES 0.0d0 Y 0.0d0)
        (VALUES (/ (* SMALL-X Y) SMALL-Y) Y
                (/ (* (- 1.0d0 SMALL-X SMALL-Y) Y) SMALL-Y)))))

[dufy/src/core/xyz.lisp:28]
  (DEFINE-PRIMARY-CONVERTER (XYZ XYY) (X Y Z)
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
   "Converts XYZ to xyY. The nominal range of Y is [0, 1], though all real values
are accepted."
   (WITH-ENSURING-TYPE DOUBLE-FLOAT (X Y Z)
    (LET ((SUM (+ X Y Z)))
      (IF (= SUM 0)
          (VALUES 0.0d0 0.0d0 Y)
          (VALUES (/ X SUM) (/ Y SUM) Y)))))

[dufy/src/core/xyz.lisp:38]
  (DEFINE-PRIMARY-CONVERTER (SPECTRUM XYZ)
   (SPECTRUM &KEY (ILLUMINANT +ILLUM-D65+) (BEGIN-WL 360) (END-WL 830)
    (BAND 1))
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
   "Computes the XYZ values of SPECTRUM in reflective or transmissive case. The
function SPECTRUM, a spectral reflectance, must be defined at least in
[BEGIN-WL, END-WL]; the SPECTRUM is called for BEGIN-WL, BEGIN-WL + BAND,
BEGIN-WL + 2*BAND, ..., BEGIN-WL + n*BAND (<= END-WL)."
   (IF (ILLUMINANT-NO-SPD-P ILLUMINANT)
       (ERROR 'NO-SPD-ERROR :ILLUMINANT ILLUMINANT)
       (%SPECTRUM-TO-XYZ SPECTRUM (ILLUMINANT-SPECTRUM ILLUMINANT)
        (ILLUMINANT-OBSERVER ILLUMINANT) BEGIN-WL END-WL BAND)))

[dufy/src/core/xyz.lisp:54]
  (DEFINE-PRIMARY-CONVERTER (XYZ SPECTRUM)
   (X Y Z &KEY (ILLUMINANT +ILLUM-D65+))
   "Converts XYZ to spectrum, which is, of course, a spectrum among many and may
contain a negative spectral density."
   (IF (ILLUMINANT-NO-SPD-P ILLUMINANT)
       (ERROR 'NO-SPD-ERROR :ILLUMINANT ILLUMINANT)
       (LET ((OBSERVER (ILLUMINANT-OBSERVER ILLUMINANT)))
         (MULTIPLE-VALUE-BIND (FAC-X FAC-Y FAC-Z)
             (MULTIPLY-MAT-VEC (ILLUMINANT-TO-SPECTRUM-MATRIX ILLUMINANT) X Y
              Z)
           #'(LAMBDA (WL)
               (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
               (+ (* FAC-X (FUNCALL (OBSERVER-CMF-X OBSERVER) WL))
                  (* FAC-Y (FUNCALL (OBSERVER-CMF-Y OBSERVER) WL))
                  (* FAC-Z (FUNCALL (OBSERVER-CMF-Z OBSERVER) WL))))))))

[dufy/src/examples/visualize-munsell.lisp:10]
  (DEFUN MHVC-TO-QRGB (HUE40 VALUE CHROMA &KEY (RGBSPACE +SRGB+) (CLAMP T))
    "Illuminant D65.
The illuminant of RGBSPACE must also be D65."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1))
             (INLINE XYZ-TO-QRGB))
    (MULTIPLE-VALUE-CALL #'XYZ-TO-QRGB
      (MHVC-TO-XYZ HUE40 VALUE CHROMA)
      :RGBSPACE
      RGBSPACE
      :CLAMP
      CLAMP))

[dufy/src/examples/visualize-munsell.lisp:20]
  (DEFUN DRAW-SRGB-IN-MUNSELL
         (
          &OPTIONAL (SIZE 300) (FRAMERATE 10)
          (BG-COLOR #S(FORMGREP:SYMREF :NAME "*BLACK*" :QUALIFIER "SDL")))
    "Graphical demonstration with SDL. Renders the sRGB space in the Munsell
space."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1))
             (TYPE UINT SIZE FRAMERATE))
    (LET* ((VALUE100 0)
           (RADIUS (ROUND (/ SIZE 2)))
           (CENTER-X RADIUS)
           (CENTER-Y RADIUS)
           (MAX-CHROMA 30.0d0)
           (LINE-COL
            (#S(FORMGREP:SYMREF :NAME "COLOR" :QUALIFIER "SDL") :R 255 :G 255
             :B 255 :A 128)))
      (LABELS ((POLAR (I J)
                 (DECLARE (TYPE SINT I J))
                 (LET ((DELTA-X (- J CENTER-X)) (DELTA-Y (- I CENTER-Y)))
                   (DECLARE (TYPE SINT DELTA-X DELTA-Y))
                   (VALUES (SQRT (+ (* DELTA-Y DELTA-Y) (* DELTA-X DELTA-X)))
                           (ATAN DELTA-Y DELTA-X))))
               (COORD-TO-MHVC (I J)
                 (MULTIPLE-VALUE-BIND (R THETA)
                     (POLAR I J)
                   (VALUES (- 20 (* THETA NIL)) (* VALUE100 0.1d0)
                           (* MAX-CHROMA (/ R RADIUS))))))
        (DECLARE (INLINE COORD-TO-MHVC POLAR)
                 (UINT VALUE100 RADIUS CENTER-X CENTER-Y))
        (#S(FORMGREP:SYMREF :NAME "WITH-INIT" :QUALIFIER "SDL") NIL
         (#S(FORMGREP:SYMREF :NAME "WINDOW" :QUALIFIER "SDL") SIZE SIZE :BPP 32
          :TITLE-CAPTION "sRGB in Munsell space" :SW T)
         (#S(FORMGREP:SYMREF :NAME "INITIALISE-DEFAULT-FONT" :QUALIFIER "SDL")
          #S(FORMGREP:SYMREF :NAME "*FONT-10X20*" :QUALIFIER "SDL"))
         (#S(FORMGREP:SYMREF :NAME "CLEAR-DISPLAY" :QUALIFIER "SDL") BG-COLOR)
         (SETF (#S(FORMGREP:SYMREF :NAME "FRAME-RATE" :QUALIFIER "SDL"))
                 FRAMERATE)
         (#S(FORMGREP:SYMREF :NAME "WITH-EVENTS" :QUALIFIER "SDL") NIL
          (:QUIT-EVENT NIL T)
          (:KEY-DOWN-EVENT NIL
           (#S(FORMGREP:SYMREF :NAME "PUSH-QUIT-EVENT" :QUALIFIER "SDL")))
          (:MOUSE-BUTTON-DOWN-EVENT (:X J :Y I)
           (FORMAT T "(H V C) = ~A~%"
                   (MULTIPLE-VALUE-LIST (COORD-TO-MHVC I J))))
          (:IDLE NIL
           (WHEN (<= VALUE100 100)
             (#S(FORMGREP:SYMREF :NAME "CLEAR-DISPLAY" :QUALIFIER "SDL")
              BG-COLOR)
             (LPARALLEL.COGNATE:PDOTIMES (I SIZE)
               (DOTIMES (J SIZE)
                 (MULTIPLE-VALUE-BIND (QR QG QB)
                     (MULTIPLE-VALUE-CALL #'MHVC-TO-QRGB
                       (COORD-TO-MHVC I J)
                       :CLAMP
                       NIL)
                   (DECLARE (TYPE SINT QR QG QB))
                   (WHEN (AND (<= 0 QR 255) (<= 0 QG 255) (<= 0 QB 255))
                     (#S(FORMGREP:SYMREF :NAME "DRAW-PIXEL-*" :QUALIFIER "SDL")
                      I J :COLOR
                      (#S(FORMGREP:SYMREF :NAME "COLOR" :QUALIFIER "SDL") :R QR
                       :G QG :B QB :A 0))))))
             (#S(FORMGREP:SYMREF :NAME "DRAW-VLINE" :QUALIFIER "SDL") CENTER-X
              0 SIZE :COLOR LINE-COL)
             (#S(FORMGREP:SYMREF :NAME "DRAW-HLINE" :QUALIFIER "SDL") 0 SIZE
              CENTER-Y :COLOR LINE-COL)
             (#S(FORMGREP:SYMREF :NAME "DRAW-STRING-SOLID" :QUALIFIER "SDL")
              (FORMAT NIL "V=~,2F" (* VALUE100 0.1d0))
              (#S(FORMGREP:SYMREF :NAME "POINT" :QUALIFIER "SDL") :X 10 :Y 10))
             (#S(FORMGREP:SYMREF :NAME "UPDATE-DISPLAY" :QUALIFIER "SDL"))
             (INCF VALUE100))))))))

[dufy/src/hsluv/hsluv.lisp:32]
  (DEFUN MAX-CHROMA-FOR-LH (L H)
    "Given L and H values, return the maximum chroma, constrained to
  those values."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (DOUBLE-FLOAT L H))
    (LET ((HRAD (DEGREE-TO-RADIAN H)) (BOUNDS (GET-CIELUV-BOUNDS L)))
      (REDUCE #'MIN
              (REMOVE-IF #'NEGATIVE-REAL-P
                         (MAPCAR
                          #'(LAMBDA (B)
                              (MB-LINE-RAY-INTERSECT-DISTANCE HRAD B))
                          BOUNDS))
              :INITIAL-VALUE MOST-POSITIVE-DOUBLE-FLOAT)))

[dufy/src/hsluv/hsluv.lisp:46]
  (DEFUN MAX-SAFE-CHROMA-FOR-L (L)
    "Given L, return the maximum chroma available over the full range of hues.

For a fixed L, the in-gamut colors are bounded by a convex polygon, whose
boundary lines are given by GET-CIELUV-BOUNDS. The maximum safe chroma is the
maximum chroma that would be valid for any hue."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (DOUBLE-FLOAT L))
    (LET ((BOUNDS (GET-CIELUV-BOUNDS L)))
      (REDUCE #'MIN
              (REMOVE-IF #'NEGATIVE-REAL-P
                         (MAPCAR #'MB-LINE-DISTANCE-FROM-ORIGIN BOUNDS))
              :INITIAL-VALUE MOST-POSITIVE-DOUBLE-FLOAT)))

[dufy/src/hsluv/hsluv.lisp:63]
  (DEFUN GET-CIELUV-BOUNDS (L)
    "Return a list of lines representing the boundaries of the polygon defining
the in-gamut colors in CIELUV for a fixed L."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (DOUBLE-FLOAT L))
    (LET* ((BOUNDS NIL)
           (SUB1 (/ (EXPT (+ L 16) 3) 1560896.0d0))
           (SUB2
            (IF (> SUB1 +CIELUV-EPSILON+)
                SUB1
                (/ L +CIELUV-KAPPA+))))
      (DECLARE (DOUBLE-FLOAT SUB1 SUB2))
      (DOTIMES (C 3)
        (LET ((M1 (AREF +M-BOUNDS+ C 0))
              (M2 (AREF +M-BOUNDS+ C 1))
              (M3 (AREF +M-BOUNDS+ C 2)))
          (DOTIMES (TI 2)
            (LET ((TOP1 (* SUB2 (- (* 284517 M1) (* 94839.0d0 M3))))
                  (TOP2
                   (- (* SUB2 L (+ (* 838422 M3) (* 769860 M2) (* 731718 M1)))
                      (* 769860 TI L)))
                  (BOTTOM
                   (+ (* SUB2 (- (* 632260 M3) (* 126452 M2))) (* TI 126452))))
              (DECLARE (DOUBLE-FLOAT TOP1 TOP2 BOTTOM))
              (PUSH
               (MAKE-MB-LINE :SLOPE (/ TOP1 BOTTOM) :INTERCEPT (/ TOP2 BOTTOM))
               BOUNDS)))))
      BOUNDS))

[dufy/src/hsluv/hsluv.lisp:88]
  (DEFINE-PRIMARY-CONVERTER (HSLUV LCHUV) (HUV SAT LSTAR)
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
   (WITH-ENSURING-TYPE DOUBLE-FLOAT (HUV SAT LSTAR)
    (COND ((> LSTAR 99.999999d0) (VALUES 100.0d0 0.0d0 HUV))
          ((< LSTAR 1.0d-6) (VALUES 0.0d0 0.0d0 HUV))
          (T
           (VALUES LSTAR (* SAT (/ (MAX-CHROMA-FOR-LH LSTAR HUV) 100.0d0))
                   HUV)))))

[dufy/src/hsluv/hsluv.lisp:97]
  (DEFINE-PRIMARY-CONVERTER (LCHUV HSLUV) (LSTAR CSTARUV HUV)
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
   (WITH-ENSURING-TYPE DOUBLE-FLOAT (LSTAR CSTARUV HUV)
    (COND ((> LSTAR 99.999999d0) (VALUES HUV 0.0d0 100.0d0))
          ((< LSTAR 1.0d-6) (VALUES HUV 0.0d0 0.0d0))
          (T
           (LET ((C (MAX-CHROMA-FOR-LH LSTAR HUV)))
             (VALUES HUV (* (/ CSTARUV C) 100.0d0) LSTAR))))))

[dufy/src/hsluv/hsluv.lisp:110]
  (DEFINE-PRIMARY-CONVERTER (HPLUV LCHUV) (HUV PSAT LSTAR)
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
   (WITH-ENSURING-TYPE DOUBLE-FLOAT (HUV PSAT LSTAR)
    (COND ((> LSTAR 99.999999d0) (VALUES 100.0d0 0.0d0 HUV))
          ((< LSTAR 1.0d-6) (VALUES 0.0d0 0.0d0 HUV))
          (T
           (VALUES LSTAR (* PSAT (/ (MAX-SAFE-CHROMA-FOR-L LSTAR) 100.0d0))
                   HUV)))))

[dufy/src/hsluv/hsluv.lisp:119]
  (DEFINE-PRIMARY-CONVERTER (LCHUV HPLUV) (LSTAR CSTARUV HUV)
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
   (WITH-ENSURING-TYPE DOUBLE-FLOAT (LSTAR CSTARUV HUV)
    (COND ((> LSTAR 99.999999d0) (VALUES HUV 0.0d0 100.0d0))
          ((< LSTAR 1.0d-6) (VALUES HUV 0.0d0 0.0d0))
          (T
           (LET ((C (MAX-SAFE-CHROMA-FOR-L LSTAR)))
             (VALUES HUV (* (/ CSTARUV C) 100.0d0) LSTAR))))))

[dufy/src/internal/matrix.lisp:20]
  (DEFUN DETERMINANT (MAT)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1))
             (MATRIX33 MAT))
    (+ (* (AREF MAT 0 0) (AREF MAT 1 1) (AREF MAT 2 2))
       (* (AREF MAT 1 0) (AREF MAT 2 1) (AREF MAT 0 2))
       (* (AREF MAT 2 0) (AREF MAT 0 1) (AREF MAT 1 2))
       (- (* (AREF MAT 0 0) (AREF MAT 2 1) (AREF MAT 1 2)))
       (- (* (AREF MAT 2 0) (AREF MAT 1 1) (AREF MAT 0 2)))
       (- (* (AREF MAT 1 0) (AREF MAT 0 1) (AREF MAT 2 2)))))

[dufy/src/internal/matrix.lisp:31]
  (DEFUN INVERT-MATRIX (MAT)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1))
             (MATRIX33 MAT))
    (LET ((/DET (/ (DETERMINANT MAT)))
          (INVMAT (MAKE-ARRAY '(3 3) :ELEMENT-TYPE 'DOUBLE-FLOAT)))
      (SETF (AREF INVMAT 0 0)
              (* /DET
                 (- (* (AREF MAT 1 1) (AREF MAT 2 2))
                    (* (AREF MAT 1 2) (AREF MAT 2 1))))
            (AREF INVMAT 0 1)
              (* /DET
                 (- (* (AREF MAT 0 2) (AREF MAT 2 1))
                    (* (AREF MAT 0 1) (AREF MAT 2 2))))
            (AREF INVMAT 0 2)
              (* /DET
                 (- (* (AREF MAT 0 1) (AREF MAT 1 2))
                    (* (AREF MAT 0 2) (AREF MAT 1 1))))
            (AREF INVMAT 1 0)
              (* /DET
                 (- (* (AREF MAT 1 2) (AREF MAT 2 0))
                    (* (AREF MAT 1 0) (AREF MAT 2 2))))
            (AREF INVMAT 1 1)
              (* /DET
                 (- (* (AREF MAT 0 0) (AREF MAT 2 2))
                    (* (AREF MAT 0 2) (AREF MAT 2 0))))
            (AREF INVMAT 1 2)
              (* /DET
                 (- (* (AREF MAT 0 2) (AREF MAT 1 0))
                    (* (AREF MAT 0 0) (AREF MAT 1 2))))
            (AREF INVMAT 2 0)
              (* /DET
                 (- (* (AREF MAT 1 0) (AREF MAT 2 1))
                    (* (AREF MAT 1 1) (AREF MAT 2 0))))
            (AREF INVMAT 2 1)
              (* /DET
                 (- (* (AREF MAT 0 1) (AREF MAT 2 0))
                    (* (AREF MAT 0 0) (AREF MAT 2 1))))
            (AREF INVMAT 2 2)
              (* /DET
                 (- (* (AREF MAT 0 0) (AREF MAT 1 1))
                    (* (AREF MAT 0 1) (AREF MAT 1 0)))))
      INVMAT))

[dufy/src/internal/matrix.lisp:58]
  (DEFUN MULTIPLY-MAT-VEC (MATRIX X Y Z)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1))
             (MATRIX33 MATRIX))
    (WITH-ENSURING-TYPE DOUBLE-FLOAT (X Y Z)
     (VALUES
      (+ (* X (AREF MATRIX 0 0)) (* Y (AREF MATRIX 0 1))
         (* Z (AREF MATRIX 0 2)))
      (+ (* X (AREF MATRIX 1 0)) (* Y (AREF MATRIX 1 1))
         (* Z (AREF MATRIX 1 2)))
      (+ (* X (AREF MATRIX 2 0)) (* Y (AREF MATRIX 2 1))
         (* Z (AREF MATRIX 2 2))))))

[dufy/src/internal/matrix.lisp:73]
  (DEFUN MULTIPLY-MAT-MAT (MAT1 MAT2)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1))
             (MATRIX33 MAT1 MAT2))
    (LET ((RET-MAT (MAKE-ARRAY '(3 3) :ELEMENT-TYPE 'DOUBLE-FLOAT)))
      (DOTIMES-UNROLL (I 3)
       (DOTIMES-UNROLL (J 3)
        (SETF (AREF RET-MAT I J)
                (+ (* (AREF MAT1 I 0) (AREF MAT2 0 J))
                   (* (AREF MAT1 I 1) (AREF MAT2 1 J))
                   (* (AREF MAT1 I 2) (AREF MAT2 2 J))))))
      RET-MAT))

[dufy/src/internal/matrix.lisp:85]
  (DEFUN MULTIPLY-MATRICES (MAT1 &REST MATS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (IF (NULL MATS)
        MAT1
        (MULTIPLY-MAT-MAT MAT1
         (APPLY #'MULTIPLY-MATRICES (CAR MATS) (CDR MATS)))))

[dufy/src/internal/mb-line.lisp:13]
  (DEFUN MB-LINE-RAY-INTERSECT-DISTANCE (THETA LINE)
    "Return the (signed) distance at which a ray, starting at the origin and travelling at angle THETA, intersects LINE."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1))
             (DOUBLE-FLOAT THETA)
             (MB-LINE LINE))
    (/ (MB-LINE-INTERCEPT LINE)
       (- (SIN THETA) (* (MB-LINE-SLOPE LINE) (COS THETA)))))

[dufy/src/internal/mb-line.lisp:22]
  (DEFUN MB-LINE-DISTANCE-FROM-ORIGIN (LINE)
    "Return the distance from the line to the origin."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1))
             (MB-LINE LINE))
    (/ (ABS (MB-LINE-INTERCEPT LINE))
       (SQRT (+ (SQUARE (MB-LINE-SLOPE LINE)) 1.0d0))))

[dufy/src/munsell/convert.lisp:22]
  (DEFUN MHVC-TO-LCHAB-ALL-INTEGER-CASE
         (HUE40 SCALED-VALUE HALF-CHROMA &OPTIONAL (DARK NIL))
    "All integer case. There are no type checks: e.g. HUE40 must be in
{0, 1, ...., 39}."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (FIXNUM HUE40 SCALED-VALUE HALF-CHROMA))
    (MACROLET ((GEN-BODY (TABLE-L TABLE-C-H)
                 (ECLECTOR.READER:QUASIQUOTE
                  (IF (<= HALF-CHROMA 25)
                      (VALUES
                       (AREF (ECLECTOR.READER:UNQUOTE TABLE-L) SCALED-VALUE)
                       (AREF (ECLECTOR.READER:UNQUOTE TABLE-C-H) HUE40
                             SCALED-VALUE HALF-CHROMA 0)
                       (AREF (ECLECTOR.READER:UNQUOTE TABLE-C-H) HUE40
                             SCALED-VALUE HALF-CHROMA 1))
                      (LET ((CSTARAB
                             (AREF (ECLECTOR.READER:UNQUOTE TABLE-C-H) HUE40
                                   SCALED-VALUE 25 0))
                            (FACTOR (* HALF-CHROMA NIL)))
                        (VALUES
                         (AREF (ECLECTOR.READER:UNQUOTE TABLE-L) SCALED-VALUE)
                         (* CSTARAB FACTOR)
                         (AREF (ECLECTOR.READER:UNQUOTE TABLE-C-H) HUE40
                               SCALED-VALUE 25 1)))))))
      (IF DARK
          (GEN-BODY +MRD-TABLE-L-DARK+ +MRD-TABLE-CH-DARK+)
          (GEN-BODY +MRD-TABLE-L+ +MRD-TABLE-CH+))))

[dufy/src/munsell/convert.lisp:43]
  (DEFUN MHVC-TO-LCHAB-VALUE-CHROMA-INTEGER-CASE
         (HUE40 SCALED-VALUE HALF-CHROMA &OPTIONAL (DARK NIL))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             ((DOUBLE-FLOAT 0.0d0 40.0d0) HUE40)
             (FIXNUM SCALED-VALUE HALF-CHROMA))
    (LET ((HUE1 (FLOOR HUE40)) (HUE2 (MOD (CEILING HUE40) 40)))
      (MULTIPLE-VALUE-BIND (LSTAR CSTARAB1 HAB1)
          (MHVC-TO-LCHAB-ALL-INTEGER-CASE HUE1 SCALED-VALUE HALF-CHROMA DARK)
        (IF (= HUE1 HUE2)
            (VALUES LSTAR CSTARAB1 HAB1)
            (MULTIPLE-VALUE-BIND (_ CSTARAB2 HAB2)
                (MHVC-TO-LCHAB-ALL-INTEGER-CASE HUE2 SCALED-VALUE HALF-CHROMA
                 DARK)
              (DECLARE (IGNORE _)
                       ((DOUBLE-FLOAT 0.0d0 360.0d0) HAB1 HAB2))
              (IF (= HAB1 HAB2)
                  (VALUES LSTAR CSTARAB1 HAB1)
                  (LET* ((HAB (CIRCULAR-LERP (- HUE40 HUE1) HAB1 HAB2 360.0d0))
                         (CSTARAB
                          (+
                           (* CSTARAB1
                              (/ (MOD (- HAB2 HAB) 360.0d0)
                                 (MOD (- HAB2 HAB1) 360.0d0)))
                           (* CSTARAB2
                              (/ (MOD (- HAB HAB1) 360.0d0)
                                 (MOD (- HAB2 HAB1) 360.0d0))))))
                    (DECLARE ((DOUBLE-FLOAT 0.0d0 360.0d0) HAB))
                    (VALUES LSTAR CSTARAB HAB))))))))

[dufy/src/munsell/convert.lisp:67]
  (DEFUN MHVC-TO-LCHAB-VALUE-INTEGER-CASE
         (HUE40 SCALED-VALUE HALF-CHROMA &OPTIONAL (DARK NIL))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             ((DOUBLE-FLOAT 0.0d0 40.0d0) HUE40)
             (NON-NEGATIVE-NON-LARGE-DOUBLE-FLOAT HALF-CHROMA)
             (FIXNUM SCALED-VALUE))
    (LET ((HCHROMA1 (FLOOR HALF-CHROMA)) (HCHROMA2 (CEILING HALF-CHROMA)))
      (IF (= HCHROMA1 HCHROMA2)
          (MHVC-TO-LCHAB-VALUE-CHROMA-INTEGER-CASE HUE40 SCALED-VALUE HCHROMA1
           DARK)
          (MULTIPLE-VALUE-BIND (LSTAR ASTAR1 BSTAR1)
              (MULTIPLE-VALUE-CALL #'LCHAB-TO-LAB
                (MHVC-TO-LCHAB-VALUE-CHROMA-INTEGER-CASE HUE40 SCALED-VALUE
                 HCHROMA1 DARK))
            (MULTIPLE-VALUE-BIND (_ ASTAR2 BSTAR2)
                (MULTIPLE-VALUE-CALL #'LCHAB-TO-LAB
                  (MHVC-TO-LCHAB-VALUE-CHROMA-INTEGER-CASE HUE40 SCALED-VALUE
                   HCHROMA2 DARK))
              (DECLARE (IGNORE _)
                       (DOUBLE-FLOAT LSTAR ASTAR1 BSTAR1 ASTAR2 BSTAR2))
              (LET* ((ASTAR
                      (+ (* ASTAR1 (- HCHROMA2 HALF-CHROMA))
                         (* ASTAR2 (- HALF-CHROMA HCHROMA1))))
                     (BSTAR
                      (+ (* BSTAR1 (- HCHROMA2 HALF-CHROMA))
                         (* BSTAR2 (- HALF-CHROMA HCHROMA1)))))
                (LAB-TO-LCHAB LSTAR ASTAR BSTAR)))))))

[dufy/src/munsell/convert.lisp:90]
  (DEFUN MHVC-TO-LCHAB-GENERAL-CASE
         (HUE40 SCALED-VALUE HALF-CHROMA &OPTIONAL (DARK NIL))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             ((DOUBLE-FLOAT 0.0d0 40.0d0) HUE40 SCALED-VALUE)
             (NON-NEGATIVE-NON-LARGE-DOUBLE-FLOAT HALF-CHROMA))
    (LET ((TRUE-VALUE
           (IF DARK
               (* SCALED-VALUE 0.2d0)
               SCALED-VALUE)))
      (LET ((SCALED-VAL1 (FLOOR SCALED-VALUE))
            (SCALED-VAL2 (CEILING SCALED-VALUE))
            (LSTAR (MUNSELL-VALUE-TO-LSTAR TRUE-VALUE)))
        (IF (= SCALED-VAL1 SCALED-VAL2)
            (MHVC-TO-LCHAB-VALUE-INTEGER-CASE HUE40 SCALED-VAL1 HALF-CHROMA
             DARK)
            (IF (ZEROP SCALED-VAL1)
                (MULTIPLE-VALUE-BIND (_ CSTARAB HAB)
                    (MHVC-TO-LCHAB-VALUE-INTEGER-CASE HUE40 1 HALF-CHROMA DARK)
                  (DECLARE (IGNORE _))
                  (VALUES LSTAR CSTARAB HAB))
                (MULTIPLE-VALUE-BIND (LSTAR1 ASTAR1 BSTAR1)
                    (MULTIPLE-VALUE-CALL #'LCHAB-TO-LAB
                      (MHVC-TO-LCHAB-VALUE-INTEGER-CASE HUE40 SCALED-VAL1
                       HALF-CHROMA DARK))
                  (MULTIPLE-VALUE-BIND (LSTAR2 ASTAR2 BSTAR2)
                      (MULTIPLE-VALUE-CALL #'LCHAB-TO-LAB
                        (MHVC-TO-LCHAB-VALUE-INTEGER-CASE HUE40 SCALED-VAL2
                         HALF-CHROMA DARK))
                    (DECLARE
                     (DOUBLE-FLOAT LSTAR1 ASTAR1 BSTAR1 LSTAR2 ASTAR2 BSTAR2))
                    (LET ((ASTAR
                           (+ (* ASTAR1 (/ (- LSTAR2 LSTAR) (- LSTAR2 LSTAR1)))
                              (* ASTAR2
                                 (/ (- LSTAR LSTAR1) (- LSTAR2 LSTAR1)))))
                          (BSTAR
                           (+ (* BSTAR1 (/ (- LSTAR2 LSTAR) (- LSTAR2 LSTAR1)))
                              (* BSTAR2
                                 (/ (- LSTAR LSTAR1) (- LSTAR2 LSTAR1))))))
                      (LAB-TO-LCHAB LSTAR ASTAR BSTAR)))))))))

[dufy/src/munsell/convert.lisp:122]
  (DEFINE-PRIMARY-CONVERTER (MHVC LCHAB :NAME MHVC-TO-LCHAB-ILLUM-C)
   (HUE40 VALUE CHROMA &AUX (ILLUMINANT +ILLUM-C+))
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1))
            (IGNORABLE ILLUMINANT))
   "Illuminant C."
   (LET ((HUE40 (MOD (FLOAT HUE40 1.0d0) 40.0d0))
         (VALUE (CLAMP (FLOAT VALUE 1.0d0) 0.0d0 10.0d0))
         (CHROMA
          (CLAMP (FLOAT CHROMA 1.0d0) 0.0d0
           *MOST-POSITIVE-NON-LARGE-DOUBLE-FLOAT*)))
     (IF (>= VALUE 1.0d0)
         (MHVC-TO-LCHAB-GENERAL-CASE HUE40 VALUE (* CHROMA 0.5d0) NIL)
         (MHVC-TO-LCHAB-GENERAL-CASE HUE40 (* VALUE 5.0d0) (* CHROMA 0.5d0)
          T))))

[dufy/src/munsell/convert.lisp:144]
  (DEFUN MHVC-TO-XYZ (HUE40 VALUE CHROMA)
    "Illuminant D65.
This converter involves the Bradford transformation from illuminant C
to illuminant D65."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (MULTIPLE-VALUE-CALL #'C-TO-D65
      (MHVC-TO-XYZ-ILLUM-C (FLOAT HUE40 1.0d0) (FLOAT VALUE 1.0d0)
       (FLOAT CHROMA 1.0d0))))

[dufy/src/munsell/convert.lisp:164]
  (DEFUN MUNSELL-TO-XYZ (MUNSELLSPEC)
    "Illuminant D65."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (MULTIPLE-VALUE-CALL #'MHVC-TO-XYZ (MUNSELL-TO-MHVC MUNSELLSPEC)))

[dufy/src/munsell/convert.lisp:204]
  (DEFUN CALC-ISOCHROMA-OVOID (VALUE CHROMA/2)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1))
             ((DOUBLE-FLOAT 0.0d0 10.0d0) VALUE)
             (FIXNUM CHROMA/2))
    (LET* ((OVOID (MAKE-ARRAY '(40 2) :ELEMENT-TYPE 'DOUBLE-FLOAT))
           (VALUE1 (FLOOR VALUE))
           (VALUE2 (CEILING VALUE))
           (R (- VALUE VALUE1)))
      (DECLARE ((DOUBLE-FLOAT 0.0d0 1.0d0) R))
      (IF (= VALUE1 VALUE2)
          (CALC-ISOCHROMA-OVOID-INTEGER-CASE VALUE1 CHROMA/2)
          (DOTIMES (HUE40 40 OVOID)
            (SETF (AREF OVOID HUE40 0)
                    (LERP R (AREF +MRD-TABLE-CH+ HUE40 VALUE1 CHROMA/2 0)
                     (AREF +MRD-TABLE-CH+ HUE40 VALUE2 CHROMA/2 0)))
            (SETF (AREF OVOID HUE40 1)
                    (CIRCULAR-LERP R
                     (AREF +MRD-TABLE-CH+ HUE40 VALUE1 CHROMA/2 1)
                     (AREF +MRD-TABLE-CH+ HUE40 VALUE2 CHROMA/2 1) 360.0d0))))))

[dufy/src/munsell/fundamental.lisp:43]
  (DEFUN MAX-CHROMA-IN-MRD (HUE40 VALUE &KEY (USE-DARK T))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    "Returns the largest chroma in the Munsell Renotation Data (all.dat)
for a given hue and value. If you want to ignore the data for value =
0.2, 0.4, 0.6, or 0.8, give NIL to USE-DARK(, though it is maybe only
for development). "
    (WITH-ENSURING-TYPE DOUBLE-FLOAT (HUE40 VALUE)
     (LET* ((HUE (MOD HUE40 40.0d0))
            (HUE1 (FLOOR HUE))
            (HUE2 (MOD (CEILING HUE) 40)))
       (IF (OR (>= VALUE 1) (NOT USE-DARK))
           (LET ((VAL1 (FLOOR VALUE)) (VAL2 (CEILING VALUE)))
             (MIN (AREF +MAX-CHROMA-TABLE+ HUE1 VAL1)
                  (AREF +MAX-CHROMA-TABLE+ HUE1 VAL2)
                  (AREF +MAX-CHROMA-TABLE+ HUE2 VAL1)
                  (AREF +MAX-CHROMA-TABLE+ HUE2 VAL2)))
           (LET* ((DARK-VALUE (* VALUE 5.0d0))
                  (DARK-VAL1 (FLOOR DARK-VALUE))
                  (DARK-VAL2 (CEILING DARK-VALUE)))
             (MIN (AREF +MAX-CHROMA-TABLE-DARK+ HUE1 DARK-VAL1)
                  (AREF +MAX-CHROMA-TABLE-DARK+ HUE1 DARK-VAL2)
                  (AREF +MAX-CHROMA-TABLE-DARK+ HUE2 DARK-VAL1)
                  (AREF +MAX-CHROMA-TABLE-DARK+ HUE2 DARK-VAL2)))))))

[dufy/src/munsell/fundamental.lisp:71]
  (DEFUN MUNSELL-VALUE-TO-Y (V)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    "Converts Munsell value to Y, whose nominal range is [0, 1]. The
formula is based on ASTM D1535-08e1. Note that this function does no
clamping even if V is outside the interval [0, 10]."
    (WITH-ENSURING-TYPE DOUBLE-FLOAT (V)
     (* V
        (+ 1.1914d0
           (* V
              (+ -0.22533d0
                 (* V (+ 0.23352d0 (* V (+ -0.020484d0 (* V 8.1939d-4))))))))
        0.01d0)))

[dufy/src/munsell/fundamental.lisp:86]
  (DEFUN Y-TO-MUNSELL-VALUE (Y)
    "Interpolates the inversion table of MUNSELL-VALUE-TO-Y linearly,
whose band width is 1e-3. It is guaranteed that the round-trip
error, (abs (- (y (munsell-value-to-y (y-to-munsell-value y))))), is
smaller than 1e-5."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (LET* ((Y1000 (* (CLAMP (FLOAT Y 1.0d0) 0.0d0 1.0d0) 1000))
           (Y1 (FLOOR Y1000))
           (Y2 (CEILING Y1000)))
      (IF (= Y1 Y2)
          (AREF +Y-TO-MUNSELL-VALUE-TABLE+ Y1)
          (LET ((R (- Y1000 Y1)))
            (+ (* (- 1 R) (AREF +Y-TO-MUNSELL-VALUE-TABLE+ Y1))
               (* R (AREF +Y-TO-MUNSELL-VALUE-TABLE+ Y2)))))))

[dufy/src/munsell/fundamental.lisp:103]
  (DEFUN EVALUATE-ERROR-OF-Y-TO-MUNSELL-VALUE (&OPTIONAL (NUM 100000000))
    "For devel. Returns the maximal error and the corresponding Y."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1))
             (FIXNUM NUM))
    (LET ((MAX-ERROR 0.0d0) (WORST-Y 0.0d0))
      (DOTIMES (N NUM)
        (LET* ((Y (RANDOM 1.0d0))
               (DELTA (ABS (- (MUNSELL-VALUE-TO-Y (Y-TO-MUNSELL-VALUE Y)) Y))))
          (WHEN (>= DELTA MAX-ERROR)
            (SETF WORST-Y Y
                  MAX-ERROR DELTA))))
      (VALUES MAX-ERROR WORST-Y)))

[dufy/src/munsell/fundamental.lisp:118]
  (DEFUN LSTAR-TO-MUNSELL-VALUE (LSTAR)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (Y-TO-MUNSELL-VALUE (LSTAR-TO-Y (FLOAT LSTAR 1.0d0))))

[dufy/src/munsell/fundamental.lisp:159]
  (DEFINE-PRIMARY-CONVERTER (MUNSELL MHVC) (MUNSELLSPEC)
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1))) "Usage Example:
 (dufy:munsell-to-mhvc \"0.02RP 0.9/3.5\")
;; => 36.008d0
;; 0.9d0
;; 3.5d0

Many other notations of numbers are acceptable; an ugly specification
as follows are also available:

 (dufy:munsell-to-mhvc \"2d-2RP .9/ #x0ffffff\")
;; => 36.008d0
;; 0.9d0
;; 1.6777215d7

However, the capital letters and  '/' are reserved:

 (dufy:munsell-to-mhvc \"2D-2RP 9/10 / #X0FFFFFF\")
;; => ERROR,
"
   (LET* ((LST
           (LET ((*READ-DEFAULT-FLOAT-FORMAT* 'DOUBLE-FLOAT))
             (MAPCAR
              (COMPOSE (RCURRY #'COERCE 'DOUBLE-FLOAT) #'READ-FROM-STRING)
              (REMOVE "" (CL-PPCRE:SPLIT "[^0-9.a-z-#]+" MUNSELLSPEC) :TEST
                      #'STRING=))))
          (HUE-NAME
           (THE STRING (CL-PPCRE:SCAN-TO-STRINGS "[A-Z]+" MUNSELLSPEC)))
          (HUE-NUMBER
           (SWITCH (HUE-NAME :TEST #'STRING=) ("R" 0) ("YR" 1) ("Y" 2) ("GY" 3)
            ("G" 4) ("BG" 5) ("B" 6) ("PB" 7) ("P" 8) ("RP" 9) ("N" -1)
            (T
             (ERROR 'MUNSELLSPEC-PARSE-ERROR :SPEC
                    (FORMAT NIL "Invalid hue designator: ~A" HUE-NAME))))))
     (COND ((= HUE-NUMBER -1) (VALUES 0.0d0 (CAR LST) 0.0d0))
           ((/= (LENGTH LST) 3)
            (ERROR 'MUNSELLSPEC-PARSE-ERROR :SPEC
                   (FORMAT NIL "Contains more than 3 numbers: ~A" LST)))
           (T
            (SETF (CAR LST)
                    (MOD
                     (+ (* HUE-NUMBER 4)
                        (* (THE DOUBLE-FLOAT (CAR LST)) 0.4d0))
                     40.0d0))
            (VALUES-LIST LST)))))

[dufy/src/munsell/invert.lisp:44]
  (DEFUN LCHAB-TO-MHVC-ALL-INTEGER-CASE (LSTAR/10 CSTARAB/20 HAB/9)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1))
             (FIXNUM LSTAR/10 CSTARAB/20 HAB/9))
    "All integer case. Does no type checks: e.g. HAB/9 must be in {0, 1,
...., 39}."
    (DECLARE (FIXNUM LSTAR/10 CSTARAB/20 HAB/9))
    (IF (<= CSTARAB/20 25)
        (VALUES (AREF +INVERSED-MRD-TABLE-HC+ LSTAR/10 CSTARAB/20 HAB/9 0)
                (AREF +INVERSED-MRD-TABLE-V+ LSTAR/10)
                (AREF +INVERSED-MRD-TABLE-HC+ LSTAR/10 CSTARAB/20 HAB/9 1))
        (LET ((CHROMA-AT-BOUNDARY
               (AREF +INVERSED-MRD-TABLE-HC+ LSTAR/10 25 HAB/9 1))
              (FACTOR (* CSTARAB/20 NIL)))
          (VALUES (AREF +INVERSED-MRD-TABLE-HC+ LSTAR/10 25 HAB/9 0)
                  (AREF +INVERSED-MRD-TABLE-V+ LSTAR/10)
                  (* CHROMA-AT-BOUNDARY FACTOR)))))

[dufy/src/munsell/invert.lisp:62]
  (DEFUN LCHAB-TO-MHVC-L-C-INTEGER-CASE (LSTAR/10 CSTARAB/20 HAB/9)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1))
             (FIXNUM LSTAR/10 CSTARAB/20)
             ((DOUBLE-FLOAT 0.0d0 40.0d0) HAB/9))
    (LET ((HAB1 (FLOOR HAB/9)) (HAB2 (MOD (CEILING HAB/9) 40)))
      (MULTIPLE-VALUE-BIND (HUE1 VALUE CHROMA1)
          (LCHAB-TO-MHVC-ALL-INTEGER-CASE LSTAR/10 CSTARAB/20 HAB1)
        (IF (= HAB1 HAB2)
            (VALUES HUE1 VALUE CHROMA1)
            (MULTIPLE-VALUE-BIND (HUE2 _ CHROMA2)
                (LCHAB-TO-MHVC-ALL-INTEGER-CASE LSTAR/10 CSTARAB/20 HAB2)
              (DECLARE (IGNORE _)
                       ((DOUBLE-FLOAT 0.0d0 40.0d0) HUE1 HUE2))
              (IF (= HUE1 HUE2)
                  (VALUES HUE1 VALUE CHROMA1)
                  (LET* ((HUE40
                          (CIRCULAR-LERP (- HAB/9 HAB1) HUE1 HUE2 40.0d0))
                         (CHROMA
                          (+
                           (* CHROMA1
                              (/ (MOD (- HUE2 HUE40) 40.0d0)
                                 (MOD (- HUE2 HUE1) 40.0d0)))
                           (* CHROMA2
                              (/ (MOD (- HUE40 HUE1) 40.0d0)
                                 (MOD (- HUE2 HUE1) 40.0d0))))))
                    (DECLARE ((DOUBLE-FLOAT 0.0d0 40.0d0) HUE40))
                    (VALUES HUE40 VALUE CHROMA))))))))

[dufy/src/munsell/invert.lisp:86]
  (DEFUN LCHAB-TO-MHVC-L-INTEGER-CASE (LSTAR/10 CSTARAB/20 HAB/9)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1))
             (FIXNUM LSTAR/10)
             (NON-NEGATIVE-NON-LARGE-DOUBLE-FLOAT CSTARAB/20)
             ((DOUBLE-FLOAT 0.0d0 40.0d0) HAB/9))
    (LET ((CSTARAB1 (FLOOR CSTARAB/20)) (CSTARAB2 (CEILING CSTARAB/20)))
      (IF (= CSTARAB1 CSTARAB2)
          (LCHAB-TO-MHVC-L-C-INTEGER-CASE LSTAR/10 CSTARAB1 HAB/9)
          (MULTIPLE-VALUE-BIND (X1 Y1 VALUE)
              (MULTIPLE-VALUE-CALL #'MHVC-TO-CARTESIAN
                (LCHAB-TO-MHVC-L-C-INTEGER-CASE LSTAR/10 CSTARAB1 HAB/9))
            (MULTIPLE-VALUE-BIND (X2 Y2 _)
                (MULTIPLE-VALUE-CALL #'MHVC-TO-CARTESIAN
                  (LCHAB-TO-MHVC-L-C-INTEGER-CASE LSTAR/10 CSTARAB2 HAB/9))
              (DECLARE (IGNORE _)
                       (DOUBLE-FLOAT VALUE X1 Y1 X2 Y2))
              (LET ((X
                     (+ (* X1 (- CSTARAB2 CSTARAB/20))
                        (* X2 (- CSTARAB/20 CSTARAB1))))
                    (Y
                     (+ (* Y1 (- CSTARAB2 CSTARAB/20))
                        (* Y2 (- CSTARAB/20 CSTARAB1)))))
                (CARTESIAN-TO-MHVC X Y VALUE)))))))

[dufy/src/munsell/invert.lisp:109]
  (DEFUN LCHAB-TO-MHVC-GENERAL-CASE (LSTAR/10 CSTARAB/20 HAB/9)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1))
             ((DOUBLE-FLOAT 0.0d0 10.0d0) LSTAR/10)
             (NON-NEGATIVE-NON-LARGE-DOUBLE-FLOAT CSTARAB/20)
             ((DOUBLE-FLOAT 0.0d0 40.0d0) HAB/9))
    (LET ((LSTAR1 (FLOOR LSTAR/10))
          (LSTAR2 (CEILING LSTAR/10))
          (VALUE (LSTAR-TO-MUNSELL-VALUE (* LSTAR/10 10))))
      (IF (= LSTAR1 LSTAR2)
          (LCHAB-TO-MHVC-L-INTEGER-CASE LSTAR1 CSTARAB/20 HAB/9)
          (IF (ZEROP LSTAR1)
              (MULTIPLE-VALUE-BIND (HUE40 _ CHROMA)
                  (LCHAB-TO-MHVC-L-INTEGER-CASE 1 CSTARAB/20 HAB/9)
                (DECLARE (IGNORE _))
                (VALUES HUE40 VALUE CHROMA))
              (MULTIPLE-VALUE-BIND (X1 Y1 VALUE1)
                  (MULTIPLE-VALUE-CALL #'MHVC-TO-CARTESIAN
                    (LCHAB-TO-MHVC-L-INTEGER-CASE LSTAR1 CSTARAB/20 HAB/9))
                (MULTIPLE-VALUE-BIND (X2 Y2 VALUE2)
                    (MULTIPLE-VALUE-CALL #'MHVC-TO-CARTESIAN
                      (LCHAB-TO-MHVC-L-INTEGER-CASE LSTAR2 CSTARAB/20 HAB/9))
                  (DECLARE (DOUBLE-FLOAT X1 Y1 VALUE1 X2 Y2 VALUE2))
                  (LET ((X
                         (+ (* X1 (/ (- VALUE2 VALUE) (- VALUE2 VALUE1)))
                            (* X2 (/ (- VALUE VALUE1) (- VALUE2 VALUE1)))))
                        (Y
                         (+ (* Y1 (/ (- VALUE2 VALUE) (- VALUE2 VALUE1)))
                            (* Y2 (/ (- VALUE VALUE1) (- VALUE2 VALUE1))))))
                    (CARTESIAN-TO-MHVC X Y VALUE))))))))

[dufy/src/munsell/invert.lisp:140]
  (DEFUN PREDICT-LCHAB-TO-MHVC (LSTAR CSTARAB HAB)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    "Illuminant C."
    (WITH-ENSURING-TYPE DOUBLE-FLOAT (LSTAR CSTARAB HAB)
     (LET ((LSTAR/10 (CLAMP (* LSTAR 0.1d0) 0.0d0 10.0d0))
           (CSTARAB/20
            (CLAMP (* CSTARAB NIL) 0.0d0
             *MOST-POSITIVE-NON-LARGE-DOUBLE-FLOAT*))
           (HAB/9 (MOD (* HAB NIL) 40.0d0)))
       (LCHAB-TO-MHVC-GENERAL-CASE LSTAR/10 CSTARAB/20 HAB/9))))

[dufy/src/munsell/invert.lisp:200]
  (DEFINE-PRIMARY-CONVERTER (LCHAB MHVC :NAME LCHAB-TO-MHVC-ILLUM-C)
   (LSTAR CSTARAB HAB &KEY (MAX-ITERATION 200) (IF-REACH-MAX :ERROR)
    (FACTOR 0.5d0) (THRESHOLD 1.0d-6) &AUX (ILLUMINANT +ILLUM-C+))
   "Is an inverter of MHVC-TO-LCHAB-ILLUM-C with a simple iteration algorithm,
which is almost same as the one in \"An Open-Source Inversion Algorithm for the
Munsell Renotation\" by Paul Centore, 2011:

V := LSTAR-TO-MUNSELL-VALUE(L*);
C_0 := C*_ab / 5.5;
H_0 := h_ab / 9;
C_(n+1) :=  C_n + FACTOR * ΔC_n;
H_(n+1) := H_n + FACTOR * ΔH_n;

Δ(H_n) and Δ(C_n) are internally calculated at every step. This function
returns Munsell HVC values if C_0 <= THRESHOLD or if V <= THRESHOLD or when
max(Δ(H_n), Δ(C_n)) falls below THRESHOLD.

IF-REACH-MAX specifies the action to be taken if the loop reaches the
MAX-ITERATION as follows:

:error: Error of type DUFY:LARGE-APPROXIMATION-ERROR is signaled.
:return40: Three 40d0s are returned.
:raw: Just returns HVC as it is.
"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1))
            (IGNORABLE ILLUMINANT)
            (FIXNUM MAX-ITERATION))
   (WITH-ENSURING-TYPE DOUBLE-FLOAT (LSTAR CSTARAB HAB FACTOR THRESHOLD)
    (LET ((INIT-HUE40 (* HAB NIL)) (INIT-CHROMA (* CSTARAB NIL)))
      (INVERT-MHVC-TO-LCHAB LSTAR CSTARAB HAB INIT-HUE40 INIT-CHROMA
       :MAX-ITERATION MAX-ITERATION :IF-REACH-MAX IF-REACH-MAX :FACTOR FACTOR
       :THRESHOLD THRESHOLD))))

[fare-csv/csv.lisp:62]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :EXECUTE)
    (DECLAIM (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 3))
             (MUFFLE-CONDITIONS COMPILER-NOTE)))

[fare-quasiquote/quasiquote.lisp:10]
  (DECLAIM (OPTIMIZE (SPEED 1) (SAFETY 3) (DEBUG 3)))

[fare-utils/base/parse-cl-syntax.lisp:46]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (DEFUN PARSE-MACRO-LAMBDA-LIST (MACRO-LAMBDA-LIST)
      (DECLARE (OPTIMIZE (SPEED 0) (SAFETY 3) (DEBUG 3)))
      (LET ((WHOLE NIL) (FRONT NIL) (ENVIRONMENT NIL) (REST MACRO-LAMBDA-LIST))
        (LABELS ((ACCEPT ()
                   (PUSH (POP REST) FRONT))
                 (ACCEPT-&KW? (KEYWORD)
                   (WHEN (AND (CONSP REST) (EQ KEYWORD (CAR REST))) T))
                 (ACCEPT-&KW-ID? (KEYWORD)
                   (WHEN (ACCEPT-&KW? KEYWORD)
                     (ASSERT (CONSP (CDR REST)))
                     (ASSERT (IDENTIFIERP (CADR REST)))
                     T))
                 (ACCEPT-ENV ()
                   (WHEN (ACCEPT-&KW-ID? '&ENVIRONMENT)
                     (IF ENVIRONMENT
                         (ERROR
                          "only one ~S argument allowed in macro-lambda-list, got ~S"
                          '&ENVIRONMENT MACRO-LAMBDA-LIST)
                         (SETF ENVIRONMENT (PROGN (POP REST) (POP REST))))))
                 (RESULT ()
                   (VALUES (NRECONC FRONT REST) (OR WHOLE (GENSYM "WHOLE"))
                           (AND WHOLE T) (OR ENVIRONMENT (GENSYM "ENV"))
                           (AND ENVIRONMENT T)))
                 (ACCEPT-VARS ()
                   (LOOP :WHILE (AND (CONSP REST)
                                     (OR (CONSP (CAR REST))
                                         (IDENTIFIERP (CAR REST))))
                         :DO (ACCEPT))))
          (WHEN (ACCEPT-&KW-ID? '&WHOLE)
            (SETF WHOLE (PROGN (POP REST) (POP REST))))
          (ACCEPT-ENV)
          (ACCEPT-VARS)
          (ACCEPT-ENV)
          (WHEN (ACCEPT-&KW? '&OPTIONAL) (ACCEPT) (ACCEPT-VARS) (ACCEPT-ENV))
          (COND ((IDENTIFIERP REST) (RESULT))
                (T
                 (WHEN (OR (ACCEPT-&KW? '&BODY) (ACCEPT-&KW? '&REST))
                   (WHEN (ACCEPT-&KW-ID? (CAR REST)) (ACCEPT) (ACCEPT))
                   (ACCEPT-ENV))
                 (WHEN (ACCEPT-&KW? '&KEY)
                   (ACCEPT)
                   (ACCEPT-VARS)
                   (WHEN (ACCEPT-&KW? '&ALLOW-OTHER-KEY) (ACCEPT))
                   (ACCEPT-ENV))
                 (WHEN (ACCEPT-&KW? '&AUX) (ACCEPT-VARS) (ACCEPT-ENV))
                 (ASSERT (NULL REST)) (RESULT)))))))

[fare-utils/stateful/sorting.lisp:38]
  (DEFUN STABLE-STRONGLY-CONNECTED-COMPONENTS/ORDINALS (SIZE ARCS)
    (DECLARE (OPTIMIZE (SPEED 0) (SAFETY 3) (DEBUG 3)))
    (LET* ((COLOR (MAKE-ARRAY SIZE :INITIAL-ELEMENT NIL))
           (FINISHERS (MAKE-ARRAY SIZE :INITIAL-ELEMENT NIL))
           (CURRENT-FINISHER SIZE)
           (ADJACENCY-TABLE (ADJACENCY-TABLE/ORDINALS SIZE ARCS))
           (REVERSE-ADJACENCY-TABLE
            (REVERSE-ADJACENCY-TABLE/ORDINALS SIZE ARCS))
           (BUCKETS (MAKE-ARRAY SIZE :INITIAL-ELEMENT NIL))
           (LEAST (MAKE-ARRAY SIZE :INITIAL-ELEMENT NIL))
           (CURRENT-LEAST NIL))
      (LABELS ((DFS1 (NODE)
                 (SETF (AREF COLOR NODE) T)
                 (LOOP :FOR NEXT :IN (AREF ADJACENCY-TABLE NODE)
                       :UNLESS (AREF COLOR NEXT)
                       :DO (DFS1 NEXT))
                 (SETF (AREF FINISHERS (DECF CURRENT-FINISHER)) NODE))
               (DFS2 (NODE)
                 (SETF CURRENT-LEAST NODE)
                 (DFS2-1 NODE NODE)
                 (SETF (AREF LEAST NODE) CURRENT-LEAST))
               (DFS2-1 (NODE FOREFATHER)
                 (SETF (AREF COLOR NODE) NIL)
                 (LOOP :FOR NEXT :IN (AREF REVERSE-ADJACENCY-TABLE NODE)
                       :WHEN (AREF COLOR NEXT)
                       :DO (PROGN
                            (WHEN (< NODE CURRENT-LEAST)
                              (SETF CURRENT-LEAST NODE))
                            (DFS2-1 NEXT FOREFATHER)))
                 (SETF (AREF BUCKETS NODE) FOREFATHER)))
        (LOOP :FOR I :BELOW SIZE
              :UNLESS (AREF COLOR I)
              :DO (DFS1 I))
        (LOOP :FOR I :BELOW SIZE
              :FOR J = (AREF FINISHERS I)
              :WHEN (AREF COLOR J)
              :DO (DFS2 J))
        (LOOP :FOR I :BELOW SIZE
              :DO (SETF (AREF BUCKETS I) (AREF LEAST (AREF BUCKETS I))))
        (VALUES (STABLE-BUCKET-SORT/ORDINALS SIZE BUCKETS) BUCKETS))))

[fast-http/src/byte-vector.lisp:49]
  (DEFUN DIGIT-BYTE-CHAR-P (BYTE)
    (DECLARE (TYPE (UNSIGNED-BYTE 8) BYTE)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (<= NIL BYTE NIL))

[fast-http/src/byte-vector.lisp:55]
  (DEFUN DIGIT-BYTE-CHAR-TO-INTEGER (BYTE)
    (DECLARE (TYPE (UNSIGNED-BYTE 8) BYTE)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (THE FIXNUM (- BYTE NIL)))

[fast-http/src/byte-vector.lisp:60]
  (DEFUN ALPHA-BYTE-CHAR-P (BYTE)
    (DECLARE (TYPE (UNSIGNED-BYTE 8) BYTE)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (OR (<= NIL BYTE NIL) (<= NIL BYTE NIL)))

[fast-http/src/byte-vector.lisp:66]
  (DEFUN ALPHA-BYTE-CHAR-TO-LOWER-CHAR (BYTE)
    (DECLARE (TYPE (UNSIGNED-BYTE 8) BYTE)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (THE CHARACTER
         (COND ((<= NIL BYTE NIL) (CODE-CHAR (+ BYTE 32)))
               (T (<= NIL BYTE NIL) (CODE-CHAR BYTE)))))

[fast-http/src/byte-vector.lisp:81]
  (DEFUN MARK-BYTE-CHAR-P (BYTE)
    (DECLARE (TYPE (UNSIGNED-BYTE 8) BYTE)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (OR (= BYTE NIL) (= BYTE NIL) (= BYTE NIL) (= BYTE NIL) (= BYTE NIL)
        (= BYTE NIL) (= BYTE NIL) (= BYTE NIL) (= BYTE NIL)))

[fast-http/src/byte-vector.lisp:96]
  (DEFUN BYTE-TO-ASCII-LOWER (X)
    (DECLARE (TYPE (UNSIGNED-BYTE 8) X)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (IF (<= NIL X NIL)
        (- X NIL)
        X))

[fast-http/src/byte-vector.lisp:104]
  (DEFUN ASCII-OCTETS-TO-STRING (OCTETS &KEY (START 0) (END (LENGTH OCTETS)))
    (DECLARE (TYPE SIMPLE-BYTE-VECTOR OCTETS)
             (TYPE (UNSIGNED-BYTE 64) START END)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET* ((LEN (THE (UNSIGNED-BYTE 64) (- END START)))
           (STRING (MAKE-STRING LEN :ELEMENT-TYPE 'CHARACTER)))
      (DECLARE (TYPE (UNSIGNED-BYTE 64) LEN)
               (TYPE SIMPLE-STRING STRING))
      (DO ((I 0 (1+ I))
           (J START (1+ J)))
          ((= J END) STRING)
        (SETF (AREF STRING I) (CODE-CHAR (AREF OCTETS J))))))

[fast-http/src/byte-vector.lisp:119]
  (DEFUN ASCII-OCTETS-TO-LOWER-STRING
         (OCTETS &KEY (START 0) (END (LENGTH OCTETS)))
    (DECLARE (TYPE SIMPLE-BYTE-VECTOR OCTETS)
             (TYPE (UNSIGNED-BYTE 64) START END)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET* ((LEN (THE (UNSIGNED-BYTE 64) (- END START)))
           (STRING (MAKE-STRING LEN :ELEMENT-TYPE 'CHARACTER)))
      (DECLARE (TYPE (UNSIGNED-BYTE 64) LEN)
               (TYPE SIMPLE-STRING STRING))
      (DO ((I 0 (1+ I))
           (J START (1+ J)))
          ((= J END) STRING)
        (SETF (AREF STRING I)
                (CODE-CHAR (BYTE-TO-ASCII-LOWER (AREF OCTETS J)))))))

[fast-http/src/byte-vector.lisp:133]
  (DEFUN APPEND-BYTE-VECTORS (VEC1 VEC2)
    (DECLARE (TYPE SIMPLE-BYTE-VECTOR VEC1 VEC2)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET* ((VEC1-LEN (LENGTH VEC1))
           (VEC2-LEN (LENGTH VEC2))
           (RESULT
            (MAKE-ARRAY (+ VEC1-LEN VEC2-LEN) :ELEMENT-TYPE
                        '(UNSIGNED-BYTE 8))))
      (DECLARE (TYPE SIMPLE-BYTE-VECTOR RESULT))
      (REPLACE RESULT VEC1 :START1 0)
      (REPLACE RESULT VEC2 :START1 VEC1-LEN)
      RESULT))

[fast-http/src/fast-http.lisp:103]
  (DEFUN-CAREFUL MAKE-PARSER
   (HTTP &KEY FIRST-LINE-CALLBACK HEADER-CALLBACK BODY-CALLBACK
    FINISH-CALLBACK)
   (DECLARE (TYPE HTTP HTTP))
   (LET (CALLBACKS
         (PARSE-FN
          (ETYPECASE HTTP
            (HTTP-REQUEST #'PARSE-REQUEST)
            (HTTP-RESPONSE #'PARSE-RESPONSE)))
         (HEADERS NIL)
         (HEADER-VALUE-BUFFER NIL)
         PARSING-HEADER-FIELD
         DATA-BUFFER
         HEADER-COMPLETE-P
         COMPLETEDP)
     (FLET ((COLLECT-PREV-HEADER-VALUE ()
              (WHEN HEADER-VALUE-BUFFER
                (LET ((HEADER-VALUE
                       (LOCALLY
                        (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
                        (COERCE-TO-STRING
                         (THE (OR OCTETS-CONCATENATED-XSUBSEQS OCTETS-XSUBSEQ)
                              HEADER-VALUE-BUFFER)))))
                  (IF (STRING= PARSING-HEADER-FIELD "set-cookie")
                      (PUSH HEADER-VALUE (GETHASH "set-cookie" HEADERS))
                      (MULTIPLE-VALUE-BIND (PREVIOUS-VALUE EXISTP)
                          (GETHASH (THE SIMPLE-STRING PARSING-HEADER-FIELD)
                                   HEADERS)
                        (SETF (GETHASH (THE SIMPLE-STRING PARSING-HEADER-FIELD)
                                       HEADERS)
                                (IF EXISTP
                                    (IF (SIMPLE-STRING-P PREVIOUS-VALUE)
                                        (CONCATENATE 'STRING
                                                     (THE SIMPLE-STRING
                                                          PREVIOUS-VALUE)
                                                     ", " HEADER-VALUE)
                                        (FORMAT NIL "~A, ~A" PREVIOUS-VALUE
                                                HEADER-VALUE))
                                    HEADER-VALUE))))))))
       (SETQ CALLBACKS
               (MAKE-CALLBACKS :MESSAGE-BEGIN
                (LAMBDA (HTTP)
                  (DECLARE (IGNORE HTTP))
                  (SETQ HEADERS (MAKE-HASH-TABLE :TEST 'EQUAL)
                        HEADER-COMPLETE-P NIL
                        COMPLETEDP NIL))
                :URL
                (LAMBDA (HTTP DATA START END)
                  (DECLARE (TYPE SIMPLE-BYTE-VECTOR DATA)
                           (TYPE POINTER START END))
                  (SETF (HTTP-RESOURCE HTTP)
                          (ASCII-OCTETS-TO-STRING DATA :START START :END END)))
                :STATUS
                (LAMBDA (HTTP DATA START END)
                  (DECLARE (TYPE SIMPLE-BYTE-VECTOR DATA)
                           (TYPE POINTER START END))
                  (SETF (HTTP-STATUS-TEXT HTTP)
                          (ASCII-OCTETS-TO-STRING DATA :START START :END END)))
                :FIRST-LINE
                (AND FIRST-LINE-CALLBACK
                     (LAMBDA (HTTP)
                       (DECLARE (IGNORE HTTP))
                       (FUNCALL (THE FUNCTION FIRST-LINE-CALLBACK))))
                :HEADER-FIELD
                (LAMBDA (HTTP DATA START END)
                  (DECLARE (IGNORE HTTP)
                           (TYPE SIMPLE-BYTE-VECTOR DATA)
                           (TYPE POINTER START END))
                  (COLLECT-PREV-HEADER-VALUE)
                  (SETQ HEADER-VALUE-BUFFER (MAKE-CONCATENATED-XSUBSEQS))
                  (SETQ PARSING-HEADER-FIELD
                          (ASCII-OCTETS-TO-LOWER-STRING DATA :START START :END
                           END)))
                :HEADER-VALUE
                (LAMBDA (HTTP DATA START END)
                  (DECLARE (IGNORE HTTP)
                           (TYPE SIMPLE-BYTE-VECTOR DATA)
                           (TYPE POINTER START END))
                  (XNCONCF HEADER-VALUE-BUFFER
                   (XSUBSEQ (SUBSEQ (THE SIMPLE-BYTE-VECTOR DATA) START END)
                    0)))
                :HEADERS-COMPLETE
                (LAMBDA (HTTP)
                  (COLLECT-PREV-HEADER-VALUE)
                  (SETQ HEADER-VALUE-BUFFER NIL)
                  (WHEN (GETHASH "set-cookie" HEADERS)
                    (SETF (GETHASH "set-cookie" HEADERS)
                            (NREVERSE (GETHASH "set-cookie" HEADERS))))
                  (SETF (HTTP-HEADERS HTTP) HEADERS)
                  (WHEN HEADER-CALLBACK
                    (FUNCALL (THE FUNCTION HEADER-CALLBACK) HEADERS))
                  (WHEN
                      (AND (NOT (HTTP-CHUNKED-P HTTP))
                           (NOT (NUMBERP (HTTP-CONTENT-LENGTH HTTP))))
                    (SETQ COMPLETEDP T))
                  (SETQ HEADER-COMPLETE-P T))
                :BODY
                (AND BODY-CALLBACK
                     (LAMBDA (HTTP DATA START END)
                       (DECLARE (IGNORE HTTP)
                                (TYPE SIMPLE-BYTE-VECTOR DATA)
                                (TYPE POINTER START END))
                       (FUNCALL (THE FUNCTION BODY-CALLBACK) DATA START END)))
                :MESSAGE-COMPLETE
                (LAMBDA (HTTP)
                  (DECLARE (IGNORE HTTP))
                  (COLLECT-PREV-HEADER-VALUE)
                  (WHEN FINISH-CALLBACK
                    (FUNCALL (THE FUNCTION FINISH-CALLBACK)))
                  (SETQ COMPLETEDP T)))))
     (LAMBDA (DATA &KEY (START 0) END)
       (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 2)))
       (COND
        ((EQL DATA :EOF) (SETQ COMPLETEDP T)
         (WHEN FINISH-CALLBACK (FUNCALL (THE FUNCTION FINISH-CALLBACK))))
        (T
         (LOCALLY
          (DECLARE (TYPE SIMPLE-BYTE-VECTOR DATA)
                   (TYPE POINTER START))
          (CHECK-TYPE END (OR NULL POINTER))
          (WHEN DATA-BUFFER
            (SETQ DATA
                    (COERCE-TO-SEQUENCE
                     (XNCONC (XSUBSEQ DATA-BUFFER 0)
                      (XSUBSEQ (THE SIMPLE-BYTE-VECTOR DATA) START
                       (OR END (LENGTH DATA))))))
            (SETQ DATA-BUFFER NIL
                  START 0
                  END NIL))
          (SETF (HTTP-MARK HTTP) START)
          (HANDLER-CASE
           (FUNCALL PARSE-FN HTTP CALLBACKS (THE SIMPLE-BYTE-VECTOR DATA)
                    :START START :END END)
           (EOF NIL
            (SETQ DATA-BUFFER
                    (SUBSEQ DATA (HTTP-MARK HTTP) (OR END (LENGTH DATA)))))))))
       (VALUES HTTP HEADER-COMPLETE-P COMPLETEDP))))

[fast-http/src/parser.lisp:789]
  (DEFUN PARSE-HEADER-VALUE-PARAMETERS
         (DATA
          &KEY HEADER-VALUE-CALLBACK HEADER-PARAMETER-KEY-CALLBACK
          HEADER-PARAMETER-VALUE-CALLBACK)
    (DECLARE (TYPE SIMPLE-STRING DATA)
             (OPTIMIZE (SPEED 3) (SAFETY 2)))
    (LET* ((HEADER-NAME-MARK 0)
           PARAMETER-KEY-MARK
           PARAMETER-VALUE-MARK
           PARSING-QUOTED-STRING-P
           (P 0)
           (END (LENGTH DATA))
           (CHAR (AREF DATA P)))
      (DECLARE (TYPE CHARACTER CHAR))
      (WHEN (= END 0) (RETURN-FROM PARSE-HEADER-VALUE-PARAMETERS 0))
      (MACROLET ((GO-STATE (STATE &OPTIONAL (ADVANCE 1))
                   (ECLECTOR.READER:QUASIQUOTE
                    (LOCALLY
                     (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
                     (INCF P (ECLECTOR.READER:UNQUOTE ADVANCE))
                     (WHEN (= P END) (GO EOF))
                     (SETQ CHAR (AREF DATA P))
                     (GO (ECLECTOR.READER:UNQUOTE STATE))))))
        (FLET ((TOKENP (CHAR)
                 (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
                 (LET ((BYTE (CHAR-CODE CHAR)))
                   (AND (< BYTE 128)
                        (NOT
                         (CHAR= (THE CHARACTER (AREF +TOKENS+ BYTE)) #\?))))))
          (TAGBODY
           PARSING-HEADER-VALUE-START
            (CASE CHAR
              ((#\  #\Tab) (GO-STATE PARSING-HEADER-VALUE))
              (OTHERWISE
               (UNLESS (TOKENP CHAR) (ERROR 'INVALID-HEADER-VALUE))
               (SETQ HEADER-NAME-MARK P)
               (GO-STATE PARSING-HEADER-VALUE 0)))
           PARSING-HEADER-VALUE
            (CASE CHAR
              (#\;
               (WHEN HEADER-VALUE-CALLBACK
                 (FUNCALL (THE FUNCTION HEADER-VALUE-CALLBACK) DATA
                          HEADER-NAME-MARK P))
               (SETQ HEADER-NAME-MARK NIL)
               (GO-STATE LOOKING-FOR-PARAMETER-KEY))
              (OTHERWISE (GO-STATE PARSING-HEADER-VALUE)))
           LOOKING-FOR-PARAMETER-KEY
            (CASE CHAR
              ((#\  #\Tab #\; #\Newline #\Return)
               (GO-STATE LOOKING-FOR-PARAMETER-KEY))
              (OTHERWISE
               (UNLESS (TOKENP CHAR) (ERROR 'INVALID-PARAMETER-KEY))
               (SETQ PARAMETER-KEY-MARK P)
               (GO-STATE PARSING-PARAMETER-KEY)))
           PARSING-PARAMETER-KEY
            (CASE CHAR
              (#\=
               (ASSERT PARAMETER-KEY-MARK)
               (WHEN HEADER-PARAMETER-KEY-CALLBACK
                 (FUNCALL (THE FUNCTION HEADER-PARAMETER-KEY-CALLBACK) DATA
                          PARAMETER-KEY-MARK P))
               (SETQ PARAMETER-KEY-MARK NIL)
               (GO-STATE PARSING-PARAMETER-VALUE-START))
              (OTHERWISE
               (UNLESS (TOKENP CHAR) (ERROR 'INVALID-PARAMETER-KEY))
               (GO-STATE PARSING-PARAMETER-KEY)))
           PARSING-PARAMETER-VALUE-START
            (CASE CHAR
              (#\"
               (SETQ PARAMETER-VALUE-MARK (1+ P))
               (SETQ PARSING-QUOTED-STRING-P T)
               (GO-STATE PARSING-PARAMETER-QUOTED-VALUE))
              ((NIL NIL) (GO-STATE PARSING-PARAMETER-VALUE-START))
              (OTHERWISE
               (SETQ PARAMETER-VALUE-MARK P)
               (GO-STATE PARSING-PARAMETER-VALUE 0)))
           PARSING-PARAMETER-QUOTED-VALUE
            (IF (CHAR= CHAR #\")
                (PROGN
                 (ASSERT PARAMETER-VALUE-MARK)
                 (SETQ PARSING-QUOTED-STRING-P NIL)
                 (WHEN HEADER-PARAMETER-VALUE-CALLBACK
                   (FUNCALL (THE FUNCTION HEADER-PARAMETER-VALUE-CALLBACK) DATA
                            PARAMETER-VALUE-MARK P))
                 (SETQ PARAMETER-VALUE-MARK NIL)
                 (GO-STATE LOOKING-FOR-PARAMETER-KEY))
                (GO-STATE PARSING-PARAMETER-QUOTED-VALUE))
           PARSING-PARAMETER-VALUE
            (CASE CHAR
              (#\;
               (ASSERT PARAMETER-VALUE-MARK)
               (WHEN HEADER-PARAMETER-VALUE-CALLBACK
                 (FUNCALL (THE FUNCTION HEADER-PARAMETER-VALUE-CALLBACK) DATA
                          PARAMETER-VALUE-MARK P))
               (SETQ PARAMETER-VALUE-MARK NIL)
               (GO-STATE LOOKING-FOR-PARAMETER-KEY))
              (OTHERWISE (GO-STATE PARSING-PARAMETER-VALUE)))
           EOF
            (WHEN HEADER-NAME-MARK
              (WHEN HEADER-VALUE-CALLBACK
                (FUNCALL (THE FUNCTION HEADER-VALUE-CALLBACK) DATA
                         HEADER-NAME-MARK P)))
            (WHEN PARAMETER-KEY-MARK (ERROR 'INVALID-EOF-STATE))
            (WHEN PARAMETER-VALUE-MARK
              (WHEN PARSING-QUOTED-STRING-P (ERROR 'INVALID-EOF-STATE))
              (WHEN HEADER-PARAMETER-VALUE-CALLBACK
                (FUNCALL (THE FUNCTION HEADER-PARAMETER-VALUE-CALLBACK) DATA
                         PARAMETER-VALUE-MARK P))))))
      P))

[fast-http/src/util.lisp:24]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (DEFVAR *INSANE-DECLARATION*
      '(DECLARE
        (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (COMPILATION-SPEED 0))))
    (DEFVAR *SPEEDY-DECLARATION*
      '(DECLARE
        (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (COMPILATION-SPEED 0))))
    (DEFVAR *CAREFUL-DECLARATION* '(DECLARE (OPTIMIZE (SPEED 3) (SAFETY 2)))))

[fast-http/src/util.lisp:165]
  (DEFUN %WHITESPACEP (CHAR)
    (DECLARE (TYPE CHARACTER CHAR)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (OR (CHAR= CHAR #\ ) (CHAR= CHAR #\Tab)))

[fast-http/src/util.lisp:172]
  (DEFUN POSITION-NOT-WHITESPACE (STRING &KEY FROM-END)
    (DECLARE (TYPE STRING STRING)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET* ((LEN (LENGTH STRING))
           (START
            (IF FROM-END
                (1- LEN)
                0))
           (END
            (IF FROM-END
                0
                (1- LEN)))
           (STEP-FN
            (IF FROM-END
                #'1-
                #'1+)))
      (DECLARE (TYPE INTEGER LEN START END))
      (DO ((I START (FUNCALL STEP-FN I)))
          ((= I END) I)
        (DECLARE (TYPE INTEGER I))
        (UNLESS (%WHITESPACEP (AREF STRING I))
          (RETURN-FROM POSITION-NOT-WHITESPACE I)))))

[fast-http/src/util.lisp:187]
  (DEFUN NUMBER-STRING-P (STRING)
    (DECLARE (TYPE STRING STRING)
             (OPTIMIZE (SPEED 3) (SAFETY 2)))
    (WHEN (ZEROP (LENGTH STRING)) (RETURN-FROM NUMBER-STRING-P NIL))
    (LET ((END (POSITION-NOT-WHITESPACE STRING :FROM-END T)) (DOT-READ-P NIL))
      (WHEN (NULL END) (RETURN-FROM NUMBER-STRING-P NIL))
      (LOCALLY
       (DECLARE (TYPE INTEGER END)
                (OPTIMIZE (SAFETY 0)))
       (INCF END)
       (DO ((I (THE INTEGER (OR (POSITION-NOT-WHITESPACE STRING) 0)) (1+ I)))
           ((= I END) T)
         (DECLARE (TYPE INTEGER I))
         (LET ((CHAR (AREF STRING I)))
           (DECLARE (TYPE CHARACTER CHAR))
           (COND ((ALPHA-CHAR-P CHAR) (RETURN-FROM NUMBER-STRING-P NIL))
                 ((DIGIT-CHAR-P CHAR))
                 ((CHAR= CHAR #\.)
                  (WHEN DOT-READ-P (RETURN-FROM NUMBER-STRING-P NIL))
                  (SETQ DOT-READ-P T))
                 (T (RETURN-FROM NUMBER-STRING-P NIL))))))))

[fast-io/src/io.lisp:35]
  (DEFUN (SETF BUFFER-POSITION) (NEW-POS BUFFER)
    "Set the buffer position for input-buffer"
    (CHECK-TYPE BUFFER INPUT-BUFFER)
    (LET* ((POS (INPUT-BUFFER-POS BUFFER))
           (VEC (INPUT-BUFFER-VECTOR BUFFER))
           (VEC-LEN (LENGTH VEC)))
      (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1))
               (TYPE OCTET-VECTOR VEC)
               (TYPE NON-NEGATIVE-FIXNUM POS VEC-LEN NEW-POS))
      (WHEN-LET
       ((STREAM-UPDATE-NEEDED? (OR (> POS VEC-LEN) (> NEW-POS VEC-LEN)))
        (STREAM (INPUT-BUFFER-STREAM BUFFER)))
       (LET* ((STREAM-FILE-POS (FILE-POSITION STREAM))
              (POS-DIFF (- NEW-POS POS))
              (STREAM-DIFF
               (COND
                ((AND (> POS VEC-LEN) (< NEW-POS VEC-LEN)) (- VEC-LEN POS))
                ((AND (< POS VEC-LEN) (> NEW-POS VEC-LEN))
                 (- POS-DIFF (- VEC-LEN POS)))
                (T POS-DIFF)))
              (NEW-STREAM-POS (+ STREAM-FILE-POS STREAM-DIFF)))
         (DECLARE (TYPE NON-NEGATIVE-FIXNUM STREAM-FILE-POS NEW-STREAM-POS)
                  (TYPE FIXNUM POS-DIFF STREAM-DIFF))
         (FILE-POSITION STREAM NEW-STREAM-POS))))
    (SETF (SLOT-VALUE BUFFER 'POS) NEW-POS))

[fast-io/src/io.lisp:113]
  (DEFUN FAST-WRITE-BYTE (BYTE OUTPUT-BUFFER)
    (DECLARE (TYPE OCTET BYTE)
             (TYPE OUTPUT-BUFFER OUTPUT-BUFFER)
             (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (WHEN
        (= (OUTPUT-BUFFER-FILL OUTPUT-BUFFER)
           (ARRAY-DIMENSION (OUTPUT-BUFFER-VECTOR OUTPUT-BUFFER) 0))
      (IF (STREAMP (OUTPUT-BUFFER-OUTPUT OUTPUT-BUFFER))
          (FLUSH OUTPUT-BUFFER)
          (EXTEND OUTPUT-BUFFER)))
    (PROG1
        (SETF (AREF (OUTPUT-BUFFER-VECTOR OUTPUT-BUFFER)
                    (OUTPUT-BUFFER-FILL OUTPUT-BUFFER))
                BYTE)
      (INCF (OUTPUT-BUFFER-FILL OUTPUT-BUFFER))
      (INCF (OUTPUT-BUFFER-LEN OUTPUT-BUFFER))))

[fast-websocket/src/fast-websocket.lisp:53]
  (DEFUN MAKE-PAYLOAD-CALLBACK
         (WS MESSAGE-CALLBACK PING-CALLBACK PONG-CALLBACK CLOSE-CALLBACK)
    (DECLARE
     (TYPE (OR NULL FUNCTION) MESSAGE-CALLBACK PING-CALLBACK PONG-CALLBACK
      CLOSE-CALLBACK))
    (LET ((BUFFER (MAKE-OUTPUT-BUFFER)))
      (LAMBDA (PAYLOAD &KEY (START 0) (END (LENGTH PAYLOAD)))
        (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 2))
                 (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) PAYLOAD)
                 (TYPE INTEGER START END))
        (ECASE (OPCODE-NAME (WS-OPCODE WS))
          (:CONTINUATION
           (FAST-WRITE-SEQUENCE PAYLOAD BUFFER START END)
           (WHEN (WS-FIN WS)
             (LET ((MESSAGE (FINISH-OUTPUT-BUFFER BUFFER)))
               (WHEN (WS-MASK WS) (MASK-MESSAGE MESSAGE (WS-MASKING-KEY WS)))
               (SETF BUFFER (MAKE-OUTPUT-BUFFER))
               (WHEN MESSAGE-CALLBACK
                 (FUNCALL (THE FUNCTION MESSAGE-CALLBACK)
                          (IF (EQ (WS-MODE WS) :TEXT)
                              (HANDLER-CASE
                               (OCTETS-TO-STRING MESSAGE :ENCODING :UTF-8)
                               (CHARACTER-DECODING-ERROR NIL
                                (ERROR 'ENCODING-ERROR)))
                              MESSAGE))))))
          (:TEXT
           (IF (WS-FIN WS)
               (WHEN MESSAGE-CALLBACK
                 (HANDLER-CASE
                  (FUNCALL (THE FUNCTION MESSAGE-CALLBACK)
                           (IF (WS-MASK WS)
                               (OCTETS-TO-STRING
                                (LET ((PAYLOAD (SUBSEQ PAYLOAD START END)))
                                  (MASK-MESSAGE PAYLOAD (WS-MASKING-KEY WS)))
                                :ENCODING :UTF-8)
                               (OCTETS-TO-STRING PAYLOAD :ENCODING :UTF-8
                                                 :START START :END END)))
                  (CHARACTER-DECODING-ERROR NIL (ERROR 'ENCODING-ERROR))))
               (FAST-WRITE-SEQUENCE PAYLOAD BUFFER START END)))
          (:BINARY
           (IF (WS-FIN WS)
               (WHEN MESSAGE-CALLBACK
                 (FUNCALL MESSAGE-CALLBACK
                          (IF (WS-MASK WS)
                              (LET ((PAYLOAD (SUBSEQ PAYLOAD START END)))
                                (MASK-MESSAGE PAYLOAD (WS-MASKING-KEY WS)))
                              (SUBSEQ PAYLOAD START END))))
               (FAST-WRITE-SEQUENCE PAYLOAD BUFFER START END)))
          (:CLOSE
           (LET* ((PAYLOAD (SUBSEQ PAYLOAD START END))
                  (PAYLOAD
                   (IF (WS-MASK WS)
                       (MASK-MESSAGE PAYLOAD (WS-MASKING-KEY WS))
                       PAYLOAD))
                  (LENGTH (- END START))
                  (HAS-CODE (<= 2 LENGTH))
                  (CODE
                   (IF HAS-CODE
                       (+ (* 256 (AREF PAYLOAD 0)) (AREF PAYLOAD 1))
                       NIL)))
             (DECLARE (TYPE INTEGER LENGTH))
             (UNLESS (OR (ZEROP LENGTH) (ACCEPTABLE-ERROR-CODE-P CODE))
               (SETQ CODE (ERROR-CODE :PROTOCOL-ERROR)))
             (IF HAS-CODE
                 (LET ((REASON
                        (OCTETS-TO-STRING PAYLOAD :ENCODING :UTF-8 :START 2)))
                   (FUNCALL CLOSE-CALLBACK REASON :CODE CODE))
                 (FUNCALL CLOSE-CALLBACK "" :CODE CODE))))
          (:PING
           (WHEN PING-CALLBACK
             (LET ((PAYLOAD (SUBSEQ PAYLOAD START END)))
               (WHEN (WS-MASK WS) (MASK-MESSAGE PAYLOAD (WS-MASKING-KEY WS)))
               (FUNCALL (THE FUNCTION PING-CALLBACK) PAYLOAD))))
          (:PONG
           (WHEN PONG-CALLBACK
             (LET ((PAYLOAD (SUBSEQ PAYLOAD START END)))
               (WHEN (WS-MASK WS) (MASK-MESSAGE PAYLOAD (WS-MASKING-KEY WS)))
               (FUNCALL (THE FUNCTION PONG-CALLBACK) PAYLOAD))))))))

[fast-websocket/src/parser.lisp:15]
  (DEFUN MAKE-LL-PARSER
         (WS &KEY REQUIRE-MASKING (MAX-LENGTH 67108863) PAYLOAD-CALLBACK)
    (DECLARE (TYPE (OR NULL FUNCTION) PAYLOAD-CALLBACK)
             (TYPE FIXNUM MAX-LENGTH))
    (NAMED-LAMBDA PARSER (DATA &KEY (START 0) (END (LENGTH DATA)))
     (DECLARE (TYPE FIXNUM START END)
              (TYPE OCTETS DATA)
              (OPTIMIZE (SPEED 3) (SAFETY 2)))
     (WHEN (= START END) (RETURN-FROM PARSER START))
     (LET ((I START))
       (DECLARE (TYPE FIXNUM I))
       (TAGBODY
         (ECASE (WS-STAGE WS)
           (0 (GO PARSING-FIRST-BYTE))
           (1 (GO PARSING-SECOND-BYTE))
           (2 (GO PARSING-EXTENDED-LENGTH))
           (3 (GO PARSING-MASKING-KEY))
           (4 (GO PARSING-PAYLOAD)))
        PARSING-FIRST-BYTE
         (LET* ((BYTE (AREF DATA I)) (FIN (= (LOGAND BYTE +FIN+) +FIN+)))
           (DECLARE (TYPE OCTET BYTE))
           (DOLIST (RSV (LIST +RSV1+ +RSV2+ +RSV3+))
             (WHEN (= (LOGAND BYTE RSV) RSV)
               (ERROR 'PROTOCOL-ERROR :FORMAT-CONTROL "Reserved bit is on: ~A"
                      :FORMAT-ARGUMENTS (LIST RSV))))
           (LET ((OPCODE (LOGAND BYTE +OPCODE+)))
             (UNLESS (VALID-OPCODE-P OPCODE)
               (ERROR 'PROTOCOL-ERROR :FORMAT-CONTROL
                      "Unrecognized frame opcode: ~A" :FORMAT-ARGUMENTS
                      (LIST OPCODE)))
             (UNLESS (OR FIN (FRAGMENTED-OPCODE-P OPCODE))
               (ERROR 'PROTOCOL-ERROR :FORMAT-CONTROL
                      "Received fragmented control frame: opcode = ~A"
                      :FORMAT-ARGUMENTS (LIST OPCODE)))
             (WHEN (AND (WS-MODE WS) (OPENING-OPCODE-P OPCODE))
               (ERROR 'PROTOCOL-ERROR :FORMAT-CONTROL
                      "Received new data frame but previous continuous frame is unfinished"))
             (SETF (WS-FIN WS) FIN
                   (WS-OPCODE WS) OPCODE)))
         (INCF I)
         (SETF (WS-STAGE WS) 1)
        PARSING-SECOND-BYTE
         (WHEN (= I END) (GO END))
         (LET ((BYTE (AREF DATA I)))
           (DECLARE (TYPE OCTET BYTE))
           (INCF I)
           (SETF (WS-MASK WS) (= (LOGAND BYTE +MASK+) +MASK+))
           (UNLESS (EQL REQUIRE-MASKING (WS-MASK WS))
             (ERROR 'UNACCEPTABLE :REQUIRE-MASKING REQUIRE-MASKING))
           (LET ((LENGTH (LOGAND BYTE +LENGTH+)))
             (SETF (WS-LENGTH WS) LENGTH)
             (COND
              ((<= 0 LENGTH 125)
               (WHEN (< MAX-LENGTH LENGTH)
                 (ERROR 'TOO-LARGE :LENGTH LENGTH :MAX-LENGTH MAX-LENGTH))
               (IF (WS-MASK WS)
                   (PROGN (SETF (WS-STAGE WS) 3) (GO PARSING-MASKING-KEY))
                   (PROGN (SETF (WS-STAGE WS) 4) (GO PARSING-PAYLOAD))))
              (T
               (SETF (WS-LENGTH-SIZE WS)
                       (IF (= LENGTH 126)
                           2
                           8))
               (SETF (WS-STAGE WS) 2)))))
        PARSING-EXTENDED-LENGTH
         (WHEN (< END (+ I (WS-LENGTH-SIZE WS)))
           (RETURN-FROM PARSER (VALUES I T)))
         (LET ((LENGTH 0))
           (DECLARE (TYPE INTEGER LENGTH))
           (DOTIMES (J (WS-LENGTH-SIZE WS))
             (SETF LENGTH (+ (ASH LENGTH 8) (AREF DATA I)))
             (INCF I))
           (UNLESS (OR (FRAGMENTED-OPCODE-P (WS-OPCODE WS)) (<= LENGTH 125))
             (ERROR 'PROTOCOL-ERROR :FORMAT-CONTROL
                    "Received control frame having too long payload: ~A"
                    :FORMAT-ARGUMENTS (LIST LENGTH)))
           (WHEN (< MAX-LENGTH LENGTH)
             (ERROR 'TOO-LARGE :LENGTH LENGTH :MAX-LENGTH MAX-LENGTH))
           (SETF (WS-LENGTH WS) LENGTH))
         (IF (WS-MASK WS)
             (SETF (WS-STAGE WS) 3)
             (PROGN (SETF (WS-STAGE WS) 4) (GO PARSING-PAYLOAD)))
        PARSING-MASKING-KEY
         (WHEN (< END (+ I 4)) (RETURN-FROM PARSER (VALUES I T)))
         (DOTIMES (J 4)
           (SETF (AREF (WS-MASKING-KEY WS) J) (AREF DATA I))
           (INCF I))
         (SETF (WS-STAGE WS) 4)
        PARSING-PAYLOAD
         (LET* ((PAYLOAD-END (+ I (WS-LENGTH WS)))
                (READ-A-PART (< END PAYLOAD-END))
                (NEXT-END
                 (IF READ-A-PART
                     END
                     PAYLOAD-END)))
           (DECLARE (TYPE INTEGER PAYLOAD-END))
           (CASE (OPCODE-NAME (WS-OPCODE WS))
             (:CONTINUATION
              (UNLESS (WS-MODE WS)
                (ERROR 'PROTOCOL-ERROR :FORMAT-CONTROL
                       "Received unexpected continuation frame")))
             (:TEXT (UNLESS (WS-FIN WS) (SETF (WS-MODE WS) :TEXT)))
             (:BINARY (UNLESS (WS-FIN WS) (SETF (WS-MODE WS) :BINARY))))
           (WHEN PAYLOAD-CALLBACK
             (FUNCALL (THE FUNCTION PAYLOAD-CALLBACK) DATA :START I :END
                      NEXT-END))
           (WHEN (AND (WS-FIN WS) (= (WS-OPCODE WS) NIL))
             (SETF (WS-MODE WS) NIL))
           (IF READ-A-PART
               (PROGN (DECF (WS-LENGTH WS) (- END I)) (SETQ I NEXT-END))
               (PROGN
                (SETF (WS-STAGE WS) 0)
                (SETQ I NEXT-END)
                (UNLESS (= I END) (GO PARSING-FIRST-BYTE)))))
        END
         (RETURN-FROM PARSER I)))))

[femlisp/src/basic/macros.lisp:478]
  (DEFMACRO VERY-QUICKLY (&BODY FORMS)
    (ECLECTOR.READER:QUASIQUOTE
     (LOCALLY
      (DECLARE (OPTIMIZE (SAFETY 0) (SPACE 0) (SPEED 3) (FLOAT 0)))
      (ECLECTOR.READER:UNQUOTE-SPLICING FORMS))))

[femlisp/src/discretization/ellsys-fe.lisp:85]
  (DEFMETHOD DISCRETIZE-LOCALLY
             ((PROBLEM <ELLSYS-PROBLEM>) COEFFS VECFE QRULE FE-GEOMETRY
              &KEY MATRIX RHS MASS-MATRIX LOCAL-U LOCAL-V RESIDUAL-P
              FE-PARAMETERS &ALLOW-OTHER-KEYS)
    "Local discretization for a pde system of the form described in the
documentation of the package @package{ELLSYS}."
    (DECLARE (OPTIMIZE (DEBUG 3) (SAFETY 3)))
    (WHEN LOCAL-V (ASSERT RESIDUAL-P))
    (LET ((CELL (GETF FE-GEOMETRY :CELL))
          (IP-VALUES (IP-VALUES VECFE QRULE))
          (IP-GRADIENTS
           (AND
            (INTERSECTION (MAPCAR #'COEFFICIENT-NAME COEFFS)
                          '(#S(FORMGREP:SYMREF
                               :NAME "A"
                               :QUALIFIER "FL.ELLSYS")
                            #S(FORMGREP:SYMREF
                               :NAME "AI"
                               :QUALIFIER "FL.ELLSYS")
                            #S(FORMGREP:SYMREF
                               :NAME "B"
                               :QUALIFIER "FL.ELLSYS")
                            #S(FORMGREP:SYMREF
                               :NAME "C"
                               :QUALIFIER "FL.ELLSYS")
                            #S(FORMGREP:SYMREF
                               :NAME "H"
                               :QUALIFIER "FL.ELLSYS")))
            (IP-GRADIENTS VECFE QRULE)))
          (GRADIENTS (GETF FE-GEOMETRY :GRADIENTS))
          (GRADIENT-INVERSES (GETF FE-GEOMETRY :GRADIENT-INVERSES))
          (CONVECTION-DIAGONAL
           (AND *UPWINDING*
                (MAKE-ARRAY (NR-OF-COMPONENTS PROBLEM) :INITIAL-ELEMENT NIL))))
      (DBG :DISC "Starting assembly for cell ~A" CELL)
      (DBG :DISC "Number of quadrature points = ~A" (LENGTH IP-VALUES))
      (DBG-WHEN :DISC-DETAILED
       (WHEN LOCAL-V (FORMAT T "Local-v=~%~A~%" LOCAL-V))
       (WHEN LOCAL-U (FORMAT T "Local-u=~%~A~%" LOCAL-U)))
      (LOOP FOR I FROM 0
            AND GLOBAL ACROSS (GETF FE-GEOMETRY :GLOBAL-COORDS)
            AND WEIGHT ACROSS (GETF FE-GEOMETRY :WEIGHTS)
            DO (DBG :DISC "Operating on quadrature point ~A" GLOBAL) (LET* ((DPHI
                                                                             (AND
                                                                              GRADIENTS
                                                                              (AREF
                                                                               GRADIENTS
                                                                               I)))
                                                                            (DPHI^-1
                                                                             (AND
                                                                              GRADIENTS
                                                                              (AREF
                                                                               GRADIENT-INVERSES
                                                                               I)))
                                                                            (SHAPE-VALS
                                                                             (AREF
                                                                              IP-VALUES
                                                                              I))
                                                                            (SHAPE-GRADS
                                                                             (AND
                                                                              IP-GRADIENTS
                                                                              (AREF
                                                                               IP-GRADIENTS
                                                                               I)))
                                                                            (GRADIENTS
                                                                             (AND
                                                                              DPHI^-1
                                                                              SHAPE-GRADS
                                                                              (MAP
                                                                               'VECTOR
                                                                               (RCURRY
                                                                                #'M*
                                                                                DPHI^-1)
                                                                               SHAPE-GRADS)))
                                                                            (COEFF-INPUT
                                                                             (CONSTRUCT-COEFF-INPUT
                                                                              CELL
                                                                              GLOBAL
                                                                              DPHI
                                                                              SHAPE-VALS
                                                                              GRADIENTS
                                                                              FE-PARAMETERS
                                                                              PROBLEM))
                                                                            (LEFT-VALS
                                                                             (IF LOCAL-V
                                                                                 (MAP
                                                                                  'VECTOR
                                                                                  #'M*-TN
                                                                                  LOCAL-V
                                                                                  SHAPE-VALS)
                                                                                 SHAPE-VALS))
                                                                            (RIGHT-VALS
                                                                             (IF RESIDUAL-P
                                                                                 (MAP
                                                                                  'VECTOR
                                                                                  #'M*-TN
                                                                                  LOCAL-U
                                                                                  SHAPE-VALS)
                                                                                 SHAPE-VALS))
                                                                            (LEFT-GRADIENTS
                                                                             (IF LOCAL-V
                                                                                 (MAP
                                                                                  'VECTOR
                                                                                  #'M*-TN
                                                                                  LOCAL-V
                                                                                  GRADIENTS)
                                                                                 GRADIENTS))
                                                                            (RIGHT-GRADIENTS
                                                                             (IF LOCAL-U
                                                                                 (MAP
                                                                                  'VECTOR
                                                                                  #'M*-TN
                                                                                  LOCAL-U
                                                                                  GRADIENTS)
                                                                                 GRADIENTS)))
                                                                       (ASSERT
                                                                        (VECTORP
                                                                         LEFT-VALS))
                                                                       (DBG-WHEN
                                                                        :DISC-DETAILED
                                                                        (FORMAT
                                                                         T
                                                                         "left-vals=~%~A~%"
                                                                         LEFT-VALS)
                                                                        (FORMAT
                                                                         T
                                                                         "left-gradients=~%~A~%"
                                                                         LEFT-GRADIENTS)
                                                                        (FORMAT
                                                                         T
                                                                         "right-vals=~%~A~%"
                                                                         RIGHT-VALS)
                                                                        (FORMAT
                                                                         T
                                                                         "right-gradients=~%~A~%"
                                                                         RIGHT-GRADIENTS))
                                                                       (LOOP FOR COEFF IN COEFFS
                                                                             FOR NAME = (COEFFICIENT-NAME
                                                                                         COEFF)
                                                                             DO (WHEN
                                                                                    MATRIX
                                                                                  (CASE
                                                                                      NAME
                                                                                    (#S(FORMGREP:SYMREF
                                                                                        :NAME "A"
                                                                                        :QUALIFIER "FL.ELLSYS")
                                                                                     (DBG
                                                                                      :DISC
                                                                                      "Discretizing diffusion")
                                                                                     (LET ((DIFF-TENSOR
                                                                                            (EVALUATE
                                                                                             COEFF
                                                                                             COEFF-INPUT)))
                                                                                       (FOR-EACH-ENTRY-AND-KEY
                                                                                        #'(LAMBDA
                                                                                              (
                                                                                               DIFFUSION
                                                                                               I
                                                                                               J)
                                                                                            (GEMM!
                                                                                             WEIGHT
                                                                                             (AREF
                                                                                              LEFT-GRADIENTS
                                                                                              J)
                                                                                             (M*-NT
                                                                                              DIFFUSION
                                                                                              (AREF
                                                                                               RIGHT-GRADIENTS
                                                                                               I))
                                                                                             1.0
                                                                                             (MREF
                                                                                              MATRIX
                                                                                              I
                                                                                              J)
                                                                                             :NN))
                                                                                        DIFF-TENSOR)))
                                                                                    (#S(FORMGREP:SYMREF
                                                                                        :NAME "AI"
                                                                                        :QUALIFIER "FL.ELLSYS")
                                                                                     (DBG
                                                                                      :DISC
                                                                                      "Discretizing resistance")
                                                                                     (LET ((RESISTANCE-TENSOR
                                                                                            (EVALUATE
                                                                                             COEFF
                                                                                             COEFF-INPUT)))
                                                                                       (FOR-EACH-ENTRY-AND-KEY
                                                                                        #'(LAMBDA
                                                                                              (
                                                                                               RESISTANCE
                                                                                               I
                                                                                               J)
                                                                                            (LET ((FACTOR
                                                                                                   (M/
                                                                                                    (M*-TN
                                                                                                     DPHI
                                                                                                     (M*
                                                                                                      RESISTANCE
                                                                                                      DPHI)))))
                                                                                              (GEMM!
                                                                                               WEIGHT
                                                                                               (M*
                                                                                                (AREF
                                                                                                 SHAPE-GRADS
                                                                                                 J)
                                                                                                FACTOR)
                                                                                               (AREF
                                                                                                SHAPE-GRADS
                                                                                                I)
                                                                                               1.0
                                                                                               (MREF
                                                                                                MATRIX
                                                                                                I
                                                                                                J)
                                                                                               :NT)))
                                                                                        RESISTANCE-TENSOR)))
                                                                                    (#S(FORMGREP:SYMREF
                                                                                        :NAME "B"
                                                                                        :QUALIFIER "FL.ELLSYS")
                                                                                     (DBG
                                                                                      :DISC
                                                                                      "Discretizing convection")
                                                                                     (LET ((VELOCITY-TENSOR
                                                                                            (EVALUATE
                                                                                             COEFF
                                                                                             COEFF-INPUT)))
                                                                                       (FOR-EACH-ENTRY-AND-KEY
                                                                                        #'(LAMBDA
                                                                                              (
                                                                                               VELOCITY
                                                                                               I
                                                                                               J)
                                                                                            (IF (AND
                                                                                                 CONVECTION-DIAGONAL
                                                                                                 (=
                                                                                                  I
                                                                                                  J))
                                                                                                (LET ((CONTRIBUTION
                                                                                                       (SCAL
                                                                                                        WEIGHT
                                                                                                        (M*-NT
                                                                                                         (M*
                                                                                                          (AREF
                                                                                                           LEFT-GRADIENTS
                                                                                                           I)
                                                                                                          (SCAL
                                                                                                           -1.0
                                                                                                           VELOCITY))
                                                                                                         (AREF
                                                                                                          RIGHT-VALS
                                                                                                          J)))))
                                                                                                  (IF (AREF
                                                                                                       CONVECTION-DIAGONAL
                                                                                                       I)
                                                                                                      (M+!
                                                                                                       CONTRIBUTION
                                                                                                       (AREF
                                                                                                        CONVECTION-DIAGONAL
                                                                                                        I))
                                                                                                      (SETF (AREF
                                                                                                             CONVECTION-DIAGONAL
                                                                                                             I)
                                                                                                              CONTRIBUTION)))
                                                                                                (AXPY!
                                                                                                 WEIGHT
                                                                                                 (M*-NT
                                                                                                  (M*
                                                                                                   (AREF
                                                                                                    LEFT-GRADIENTS
                                                                                                    I)
                                                                                                   (SCAL
                                                                                                    -1.0
                                                                                                    VELOCITY))
                                                                                                  (AREF
                                                                                                   RIGHT-VALS
                                                                                                   J))
                                                                                                 (MREF
                                                                                                  MATRIX
                                                                                                  I
                                                                                                  J))))
                                                                                        VELOCITY-TENSOR)))
                                                                                    (#S(FORMGREP:SYMREF
                                                                                        :NAME "C"
                                                                                        :QUALIFIER "FL.ELLSYS")
                                                                                     (DBG
                                                                                      :DISC
                                                                                      "Discretizing non-conservative convection")
                                                                                     (LET ((VELOCITY-TENSOR
                                                                                            (EVALUATE
                                                                                             COEFF
                                                                                             COEFF-INPUT)))
                                                                                       (FOR-EACH-ENTRY-AND-KEY
                                                                                        #'(LAMBDA
                                                                                              (
                                                                                               VELOCITY
                                                                                               I
                                                                                               J)
                                                                                            (GEMM!
                                                                                             WEIGHT
                                                                                             (AREF
                                                                                              LEFT-VALS
                                                                                              I)
                                                                                             (M*
                                                                                              (AREF
                                                                                               RIGHT-GRADIENTS
                                                                                               J)
                                                                                              VELOCITY)
                                                                                             1.0
                                                                                             (MREF
                                                                                              MATRIX
                                                                                              I
                                                                                              J)
                                                                                             :NT))
                                                                                        VELOCITY-TENSOR)))
                                                                                    (#S(FORMGREP:SYMREF
                                                                                        :NAME "R"
                                                                                        :QUALIFIER "FL.ELLSYS")
                                                                                     (DBG
                                                                                      :DISC
                                                                                      "Discretizing reaction")
                                                                                     (LET ((REACTION-TENSOR
                                                                                            (EVALUATE
                                                                                             COEFF
                                                                                             COEFF-INPUT)))
                                                                                       (FOR-EACH-ENTRY-AND-KEY
                                                                                        #'(LAMBDA
                                                                                              (
                                                                                               REACTION
                                                                                               I
                                                                                               J)
                                                                                            (UNLESS
                                                                                                (MZEROP
                                                                                                 REACTION)
                                                                                              (WHEN
                                                                                                  (STANDARD-MATRIX-P
                                                                                                   REACTION)
                                                                                                (ASSERT
                                                                                                 (=
                                                                                                  1
                                                                                                  (NROWS
                                                                                                   REACTION)
                                                                                                  (NCOLS
                                                                                                   REACTION)))
                                                                                                (SETQ REACTION
                                                                                                        (VREF
                                                                                                         REACTION
                                                                                                         0)))
                                                                                              (GEMM!
                                                                                               (*
                                                                                                WEIGHT
                                                                                                REACTION)
                                                                                               (AREF
                                                                                                LEFT-VALS
                                                                                                I)
                                                                                               (AREF
                                                                                                RIGHT-VALS
                                                                                                J)
                                                                                               1.0
                                                                                               (MREF
                                                                                                MATRIX
                                                                                                I
                                                                                                J)
                                                                                               :NT)))
                                                                                        REACTION-TENSOR))))) (WHEN
                                                                                                                 RHS
                                                                                                               (CASE
                                                                                                                   NAME
                                                                                                                 (#S(FORMGREP:SYMREF
                                                                                                                     :NAME "F"
                                                                                                                     :QUALIFIER "FL.ELLSYS")
                                                                                                                  (DBG
                                                                                                                   :DISC
                                                                                                                   "Discretizing standard source")
                                                                                                                  (LET ((SOURCE-VECTOR
                                                                                                                         (EVALUATE
                                                                                                                          COEFF
                                                                                                                          COEFF-INPUT)))
                                                                                                                    (FOR-EACH-ENTRY-AND-KEY
                                                                                                                     #'(LAMBDA
                                                                                                                           (
                                                                                                                            SOURCE
                                                                                                                            K)
                                                                                                                         (GEMM!
                                                                                                                          WEIGHT
                                                                                                                          (AREF
                                                                                                                           LEFT-VALS
                                                                                                                           K)
                                                                                                                          (ENSURE-MATLISP
                                                                                                                           SOURCE)
                                                                                                                          1.0
                                                                                                                          (AREF
                                                                                                                           RHS
                                                                                                                           K)))
                                                                                                                     SOURCE-VECTOR)))
                                                                                                                 (#S(FORMGREP:SYMREF
                                                                                                                     :NAME "G"
                                                                                                                     :QUALIFIER "FL.ELLSYS")
                                                                                                                  (DBG
                                                                                                                   :DISC
                                                                                                                   "Discretizing g-source")
                                                                                                                  (LET ((G-SOURCE-VECTOR
                                                                                                                         (EVALUATE
                                                                                                                          COEFF
                                                                                                                          COEFF-INPUT)))
                                                                                                                    (FOR-EACH-ENTRY-AND-KEY
                                                                                                                     #'(LAMBDA
                                                                                                                           (
                                                                                                                            G-SOURCE
                                                                                                                            K)
                                                                                                                         (GEMM!
                                                                                                                          WEIGHT
                                                                                                                          (AREF
                                                                                                                           LEFT-GRADIENTS
                                                                                                                           K)
                                                                                                                          G-SOURCE
                                                                                                                          1.0
                                                                                                                          (AREF
                                                                                                                           RHS
                                                                                                                           K)))
                                                                                                                     G-SOURCE-VECTOR)))
                                                                                                                 (#S(FORMGREP:SYMREF
                                                                                                                     :NAME "H"
                                                                                                                     :QUALIFIER "FL.ELLSYS")
                                                                                                                  (DBG
                                                                                                                   :DISC
                                                                                                                   "Discretizing h-source")
                                                                                                                  (LET ((DIFF-TENSOR
                                                                                                                         (EVALUATE
                                                                                                                          (GET-COEFFICIENT
                                                                                                                           COEFFS
                                                                                                                           '#S(FORMGREP:SYMREF
                                                                                                                               :NAME "A"
                                                                                                                               :QUALIFIER "FL.ELLSYS"))
                                                                                                                          COEFF-INPUT))
                                                                                                                        (GAMMA
                                                                                                                         (EVALUATE
                                                                                                                          COEFF
                                                                                                                          COEFF-INPUT)))
                                                                                                                    (FOR-EACH-ENTRY-AND-KEY
                                                                                                                     #'(LAMBDA
                                                                                                                           (
                                                                                                                            DIFFUSION
                                                                                                                            I
                                                                                                                            J)
                                                                                                                         (GEMM!
                                                                                                                          WEIGHT
                                                                                                                          (AREF
                                                                                                                           LEFT-GRADIENTS
                                                                                                                           J)
                                                                                                                          (M*
                                                                                                                           DIFFUSION
                                                                                                                           (AREF
                                                                                                                            GAMMA
                                                                                                                            J))
                                                                                                                          1.0
                                                                                                                          (AREF
                                                                                                                           RHS
                                                                                                                           I)))
                                                                                                                     DIFF-TENSOR))))))
                                                                       (WHEN
                                                                           MASS-MATRIX
                                                                         (DBG
                                                                          :DISC
                                                                          "Discretizing mass matrix")
                                                                         (LOOP FOR I FROM 0
                                                                               AND VALS ACROSS SHAPE-VALS
                                                                               DO (GEMM!
                                                                                   WEIGHT
                                                                                   VALS
                                                                                   VALS
                                                                                   1.0
                                                                                   (MREF
                                                                                    MASS-MATRIX
                                                                                    I
                                                                                    I)
                                                                                   :NT)))))
      (WHEN CONVECTION-DIAGONAL
        (ASSERT (<= (DISCRETIZATION-ORDER VECFE) 1) NIL
                "This too simple technique only works for FE of order 1 and very special problems.")
        (DOVEC ((ENTRY I) CONVECTION-DIAGONAL)
         (WHEN ENTRY
           (M+! (ENSURE-M-MATRIX-PROPERTY ENTRY) (MREF MATRIX I I)))))
      (WHEREAS
       ((FE-RHS-FUNCTION
         (AND RHS
              (GET-COEFFICIENT COEFFS
               '#S(FORMGREP:SYMREF :NAME "FE-RHS" :QUALIFIER "FL.ELLSYS")))))
       (M+!
        (EVALUATE FE-RHS-FUNCTION
         (LIST :CELL CELL :FE VECFE :GEOMETRY FE-GEOMETRY))
        RHS))
      (DBG :DISC "Terminating assembly for cell ~A" CELL)))

[femlisp/src/discretization/fe.lisp:214]
  (DEFMETHOD INITIALIZE-INSTANCE :AFTER
             ((VECFE <VECTOR-FE>) &KEY &ALLOW-OTHER-KEYS)
    (DECLARE (OPTIMIZE SAFETY DEBUG))
    (WITH-SLOTS (COMPONENTS DOFS BASIS PROPERTIES)
        VECFE
      (WHEN (PLUSP (LENGTH COMPONENTS))
        (ASSERT (SAMEP COMPONENTS :KEY #'REFERENCE-CELL))
        (SETF (SLOT-VALUE VECFE 'REFCELL) (REFERENCE-CELL (AREF COMPONENTS 0)))
        (LET* ((REFCELL (REFERENCE-CELL VECFE))
               (NR-COMPS (LENGTH COMPONENTS))
               (NR-SUBCELLS (NR-OF-SUBCELLS REFCELL))
               (SUBCELL-OFFSETS (MAKE-ARRAY NR-COMPS :INITIAL-ELEMENT NIL))
               (SUBCELL-NDOFS (MAKE-FIXNUM-VEC NR-SUBCELLS)))
          (LOOP WITH SUBCELL-OFF = (MAKE-FIXNUM-VEC NR-SUBCELLS 0)
                FOR I FROM 0
                AND FE ACROSS COMPONENTS
                DO (SETF (AREF SUBCELL-OFFSETS I) (COPY-SEQ SUBCELL-OFF)) (M+!
                                                                           (SUBCELL-NDOFS
                                                                            FE)
                                                                           SUBCELL-NDOFS) (M+!
                                                                                           (SUBCELL-NDOFS
                                                                                            FE)
                                                                                           SUBCELL-OFF))
          (SETF (GETF PROPERTIES 'SUBCELL-OFFSETS) SUBCELL-OFFSETS)
          (SETF (GETF PROPERTIES 'SUBCELL-NDOFS) SUBCELL-NDOFS)
          (SETQ DOFS
                  (LOOP+
                   (COMP (FE COMPONENTS) (SUBCELL-OFFSET SUBCELL-OFFSETS))
                   NCONCING
                   (LOOP+ ((DOF (FE-DOFS FE))) COLLECTING
                    (NEW-VECTOR-DOF-FROM-DOF DOF COMP SUBCELL-OFFSET))))
          (SETQ BASIS
                  (REDUCE (CURRY #'CONCATENATE 'VECTOR) COMPONENTS :KEY
                          #'FE-BASIS))))))

[femlisp/src/matlisp/sparse-matrix.lisp:399]
  (DEFUN GENERATE-SPARSE-MATRIX-VECTOR-GEMM!-TEMPLATE (JOB)
    "Generates the GEMM-XX! routine defined by JOB."
    (ASSERT (MEMBER JOB '(:NN :NT :TN :TT)))
    (LET ((GEMM-JOB (SYMCONC "GEMM-" (SYMBOL-NAME JOB) "!")))
      (EVAL
       (ECLECTOR.READER:QUASIQUOTE
        (DEFMETHOD (ECLECTOR.READER:UNQUOTE GEMM-JOB)
                   (ALPHA (A <SPARSE-MATRIX>) (Y <SPARSE-VECTOR>) BETA
                    (X <SPARSE-VECTOR>))
          (DECLARE (OPTIMIZE (SPEED 3) (SPACE 2) (SAFETY 1)))
          (WITH-WORKERS
           ((LAMBDA (X-KEY)
              (LET ((X-VALUES (VREF X X-KEY)))
                (SCAL! BETA X-VALUES)
                ((ECLECTOR.READER:UNQUOTE
                  (IF (MEMBER JOB '(:NN :NT))
                      'FOR-EACH-KEY-AND-ENTRY-IN-ROW
                      'FOR-EACH-KEY-AND-ENTRY-IN-COL))
                 #'(LAMBDA (Y-KEY MBLOCK)
                     (LET ((Y-VALUES (VREF Y Y-KEY)))
                       ((ECLECTOR.READER:UNQUOTE GEMM-JOB) ALPHA MBLOCK
                        Y-VALUES 1.0 X-VALUES)))
                 A X-KEY))))
           ((ECLECTOR.READER:UNQUOTE
             (IF (MEMBER JOB '(:NN :NT))
                 'FOR-EACH-ROW-KEY
                 'FOR-EACH-COL-KEY))
            #'WORK-ON A))
          X)))))

[femlisp/src/matlisp/sparse-matrix.lisp:423]
  (DEFUN GENERATE-SPARSE-MATRIX-VECTOR-GEMM!-TEMPLATE (JOB)
    "Generates the GEMM-XX! routine defined by JOB."
    (ASSERT (MEMBER JOB '(:NN :NT :TN :TT)))
    (LET ((GEMM-JOB (SYMCONC "GEMM-" (SYMBOL-NAME JOB) "!")))
      (EVAL
       (ECLECTOR.READER:QUASIQUOTE
        (DEFMETHOD (ECLECTOR.READER:UNQUOTE GEMM-JOB)
                   (ALPHA (A <SPARSE-MATRIX>) (Y <SPARSE-VECTOR>) BETA
                    (X <SPARSE-VECTOR>))
          (DECLARE (OPTIMIZE (SPEED 3) (SPACE 2) (SAFETY 1)))
          (DOLIST (RK (ROW-KEYS A))
            (VREF
             (ECLECTOR.READER:UNQUOTE
              (ECASE JOB ((:NN :NT) 'X) ((:TN :TT) 'Y)))
             RK))
          (DOLIST (CK (COL-KEYS A))
            (VREF
             (ECLECTOR.READER:UNQUOTE
              (ECASE JOB ((:NN :NT) 'Y) ((:TN :TT) 'X)))
             CK))
          (ECLECTOR.READER:UNQUOTE
           (ECASE JOB
             ((:NN :NT)
              (ECLECTOR.READER:QUASIQUOTE
               (ECASE (ACCESS-TYPE A :SUGGEST :ROW)
                 (:ROW
                  (DIC-FOR-EACH
                   (LAMBDA (RK ROW)
                     (LET ((X-VALUES (VREF X RK)))
                       (SCAL! BETA X-VALUES)
                       (DIC-FOR-EACH
                        (LAMBDA (CK MBLOCK)
                          (LET ((Y-VALUES (VREF Y CK)))
                            ((ECLECTOR.READER:UNQUOTE GEMM-JOB) ALPHA MBLOCK
                             Y-VALUES 1.0 X-VALUES)))
                        ROW)))
                   (ROW-TABLE A) :PARALLEL T))
                 (:COLUMN
                  (SCAL! BETA X)
                  (DOCOLS (CK A)
                   (LET ((Y-VALUES (VREF Y CK)))
                     (DOROW ((RK MBLOCK) A CK)
                      ((ECLECTOR.READER:UNQUOTE GEMM-JOB) ALPHA MBLOCK Y-VALUES
                       1.0 (VREF X RK)))))))))
             ((:TN :TT)
              (ECLECTOR.READER:QUASIQUOTE
               (ECASE (ACCESS-TYPE A :SUGGEST :COLUMN)
                 (:COLUMN
                  (DIC-FOR-EACH
                   (LAMBDA (CK COLUMN)
                     (LET ((X-VALUES (VREF X CK)))
                       (SCAL! BETA X-VALUES)
                       (DIC-FOR-EACH
                        (LAMBDA (RK MBLOCK)
                          (LET ((Y-VALUES (VREF Y RK)))
                            ((ECLECTOR.READER:UNQUOTE GEMM-JOB) ALPHA MBLOCK
                             Y-VALUES 1.0 X-VALUES)))
                        COLUMN)))
                   (COLUMN-TABLE A) :PARALLEL T)
                  (DOCOLS (CK A)
                   (LET ((X-VALUES (VREF X CK)))
                     (SCAL! BETA X-VALUES)
                     (DOCOL ((RK MBLOCK) A CK)
                      (LET ((Y-VALUES (VREF Y RK)))
                        ((ECLECTOR.READER:UNQUOTE GEMM-JOB) ALPHA MBLOCK
                         Y-VALUES 1.0 X-VALUES))))))
                 (:ROW
                  (SCAL! BETA X)
                  (DOROWS (RK A)
                   (LET ((Y-VALUES (VREF Y RK)))
                     (DOROW ((CK MBLOCK) A RK)
                      ((ECLECTOR.READER:UNQUOTE GEMM-JOB) ALPHA MBLOCK Y-VALUES
                       1.0 (VREF X CK)))))))))))
          X)))))

[femlisp/src/mesh/cell.lisp:299]
  (WITH-MEMOIZATION (:TYPE :LOCAL :SIZE 2 :ID 'L2G-EVALUATOR)
   (DEFUN L2G-EVALUATOR (CELL)
     "Returns an evaluator for @arg{cell} which maps barycentric coordinates
to g-coordinates."
     (MEMOIZING-LET ((CELL CELL))
      (LET ((DIM (EMBEDDED-DIMENSION CELL)) (G-CORNERS (G-CORNERS CELL)))
        (DECLARE (TYPE FIXNUM DIM))
        (LAMBDA (WEIGHTS)
          (DECLARE (TYPE DOUBLE-VEC WEIGHTS))
          (LET ((RESULT (MAKE-DOUBLE-VEC DIM)))
            (DECLARE (TYPE DOUBLE-VEC RESULT))
            (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
            (LOOP FOR WEIGHT OF-TYPE DOUBLE-FLOAT ACROSS WEIGHTS
                  AND CORNER OF-TYPE DOUBLE-VEC IN G-CORNERS
                  DO (DOTIMES (I DIM)
                       (INCF (AREF RESULT I) (* WEIGHT (AREF CORNER I))))
                  FINALLY (RETURN RESULT))))))))

[femlisp/src/mesh/structured.lisp:118]
  (DEFUN TEST2 ()
    (LET* ((N 1000)
           (MAT
            (MAKE-ARRAY (* N N) :ELEMENT-TYPE 'DOUBLE-FLOAT :INITIAL-ELEMENT
                        1.0)))
      (DECLARE (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT (*)) MAT)
               (FIXNUM N)
               (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
      (LOOP FOR I OF-TYPE FIXNUM BELOW 10
            DO (LOOP FOR POS1 OF-TYPE FIXNUM FROM 1 BELOW (1- N)
                     DO (LOOP FOR POS2 OF-TYPE FIXNUM FROM (+ POS1
                                                              N) BELOW (THE
                                                                        FIXNUM
                                                                        (+ POS1
                                                                           (THE
                                                                            FIXNUM
                                                                            (*
                                                                             (THE
                                                                              FIXNUM
                                                                              (1-
                                                                               N))
                                                                             N)))) BY N
                              DO (LET ((A0
                                        (AREF MAT (THE FIXNUM (- POS2 1001))))
                                       (A1 (AREF MAT (THE FIXNUM (- POS2 1))))
                                       (A2
                                        (AREF MAT (THE FIXNUM (+ POS2 999))))
                                       (A3
                                        (AREF MAT (THE FIXNUM (- POS2 1000))))
                                       (A4 (AREF MAT (THE FIXNUM (- POS2 0))))
                                       (A5
                                        (AREF MAT (THE FIXNUM (+ POS2 1000))))
                                       (A6
                                        (AREF MAT (THE FIXNUM (- POS2 999))))
                                       (A7 (AREF MAT (THE FIXNUM (+ POS2 1))))
                                       (A8
                                        (AREF MAT (THE FIXNUM (+ POS2 1001)))))
                                   (SETF (AREF MAT POS2)
                                           (* 0.11111111
                                              (+ A0 A1 A2 A3 A4 A5 A6 A7
                                                 A8)))))))))

[femlisp/src/mesh/structured.lisp:142]
  (DEFUN TEST ()
    (LET* ((DIM 2) (N 1000) (ENTRIES (MAKE-DOUBLE-VEC (EXPT N DIM) 1.0)))
      (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0) (COMPILATION-SPEED 0)))
      (LOOP FOR POS1 OF-TYPE FIXNUM FROM 1 BELOW (- N 1)
            DO (LOOP FOR POS2 OF-TYPE FIXNUM FROM (+ POS1 N) BY N BELOW (+ POS1
                                                                           (* N
                                                                              (-
                                                                               N
                                                                               1)))
                     DO (SETF (AREF ENTRIES POS2)
                                (LET ((T0 (AREF ENTRIES (+ POS2 -1001)))
                                      (T1 (AREF ENTRIES (+ POS2 -1)))
                                      (T2 (AREF ENTRIES (+ POS2 999)))
                                      (T3 (AREF ENTRIES (+ POS2 -1000)))
                                      (T4 (AREF ENTRIES (+ POS2 0)))
                                      (T5 (AREF ENTRIES (+ POS2 1000)))
                                      (T6 (AREF ENTRIES (+ POS2 -999)))
                                      (T7 (AREF ENTRIES (+ POS2 1)))
                                      (T8 (AREF ENTRIES (+ POS2 1001))))
                                  (* 0.11111111
                                     (+ T0 T1 T2 T3 T4 T5 T6 T7 T8))))))))

[femlisp/src/mesh/structured.lisp:162]
  (DEFUN TEST ()
    (LET* ((DIM 2) (N 1000) (ENTRIES (MAKE-DOUBLE-VEC (EXPT N DIM) 1.0)))
      (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0) (COMPILATION-SPEED 0)))
      (DOTIMES (I 10)
        (LOOP FOR POS1 OF-TYPE FIXNUM FROM 1 BELOW (- N 1)
              DO (LOOP FOR POS2 OF-TYPE FIXNUM FROM (+ POS1 N) BY N BELOW (+
                                                                           POS1
                                                                           (* N
                                                                              (-
                                                                               N
                                                                               1)))
                       DO (SETF (AREF ENTRIES POS2)
                                  (+
                                   (* 0.11111111 (AREF ENTRIES (+ POS2 -1001)))
                                   (* 0.11111111 (AREF ENTRIES (+ POS2 -1)))
                                   (* 0.11111111 (AREF ENTRIES (+ POS2 999)))
                                   (* 0.11111111 (AREF ENTRIES (+ POS2 -1000)))
                                   (* 0.11111111 (AREF ENTRIES (+ POS2 0)))
                                   (* 0.11111111 (AREF ENTRIES (+ POS2 1000)))
                                   (* 0.11111111 (AREF ENTRIES (+ POS2 -999)))
                                   (* 0.11111111 (AREF ENTRIES (+ POS2 1)))
                                   (* 0.11111111
                                      (AREF ENTRIES (+ POS2 1001))))) (SETF (AREF
                                                                             ENTRIES
                                                                             POS2)
                                                                              (*
                                                                               0.11111111
                                                                               (+
                                                                                (AREF
                                                                                 ENTRIES
                                                                                 (+
                                                                                  POS2
                                                                                  -1001))
                                                                                (AREF
                                                                                 ENTRIES
                                                                                 (+
                                                                                  POS2
                                                                                  -1))
                                                                                (AREF
                                                                                 ENTRIES
                                                                                 (+
                                                                                  POS2
                                                                                  999))
                                                                                (AREF
                                                                                 ENTRIES
                                                                                 (+
                                                                                  POS2
                                                                                  -1000))
                                                                                (AREF
                                                                                 ENTRIES
                                                                                 (+
                                                                                  POS2
                                                                                  0))
                                                                                (AREF
                                                                                 ENTRIES
                                                                                 (+
                                                                                  POS2
                                                                                  1000))
                                                                                (AREF
                                                                                 ENTRIES
                                                                                 (+
                                                                                  POS2
                                                                                  -999))
                                                                                (AREF
                                                                                 ENTRIES
                                                                                 (+
                                                                                  POS2
                                                                                  1))
                                                                                (AREF
                                                                                 ENTRIES
                                                                                 (+
                                                                                  POS2
                                                                                  1001))))))))))

[femlisp/src/parallel/parallel.lisp:17]
  (DEFUN CALCULATE-EFFECTIVE-CACHESIZE ()
    "Calculates effective cachesize in bytes."
    (LET ((L 27))
      (FLET ((TEST (K)
               (LET* ((N (EXPT 2 K))
                      (COUNT (EXPT 2 (- L K)))
                      (X (MAKE-DOUBLE-FLOAT-ARRAY N))
                      (Y (MAKE-DOUBLE-FLOAT-ARRAY N)))
                 (DECLARE (OPTIMIZE SPEED (SAFETY 0)))
                 (MEASURE-TIME (LAMBDA () (REPLACE X Y)) COUNT))))
        (FORMAT T
                "Measuring effective cache size (this may take some time)...~%")
        (LOOP FOR K FROM 10 BELOW 22
              FOR PREVIOUS = NIL THEN NEXT
              AND NEXT = (TEST K)
              DO (FORMAT T "~2D ~A~%" K NEXT) (FORCE-OUTPUT) (WHEN
                                                                 (AND PREVIOUS
                                                                      (> NEXT
                                                                         (* 1.2
                                                                            PREVIOUS)))
                                                               (LOOP-FINISH))
              FINALLY (RETURN (EXPT 2 (+ K 3)))))))

[fiveam/t/tests.lisp:156]
  (DEFUN STACK-EXHAUST ()
    (DECLARE (OPTIMIZE (DEBUG 3) (SPEED 0) (SPACE 0) (SAFETY 3)))
    (CONS 42 (STACK-EXHAUST)))

[flexi-streams/util.lisp:211]
  (DEFUN GET-MULTIBYTE-MAPPER (TABLE CODE)
    "this function is borrowed from sbcl's source file \"/src/code/external-formats/mb-util.lisp\",
it search char code in \"table\" with specified \"code\""
    (DECLARE (OPTIMIZE SPEED (SAFETY 0))
             (TYPE (ARRAY * (* 2)) TABLE)
             (TYPE FIXNUM CODE))
    (LABELS ((RECUR (START END)
               (DECLARE (TYPE FIXNUM START END))
               (LET* ((M (ASH (+ START END) -1)) (X (AREF TABLE M 0)))
                 (DECLARE (TYPE FIXNUM M X))
                 (COND ((= X CODE) (AREF TABLE M 1))
                       ((AND (< X CODE) (< M END)) (RECUR (1+ M) END))
                       ((AND (> X CODE) (> M START)) (RECUR START (1- M)))))))
      (RECUR 0 (1- (ARRAY-DIMENSION TABLE 0)))))

[float-features/float-features.lisp:329]
  (DEFUN SINGLE-FLOAT-BITS (FLOAT)
    (LDB (BYTE 32 0)
         (#S(FORMGREP:SYMREF :NAME "SINGLE-FLOAT-BITS" :QUALIFIER "SYSTEM")
          FLOAT))
    (MULTIPLE-VALUE-BIND (HIGH LOW)
        (#S(FORMGREP:SYMREF :NAME "SINGLE-FLOAT-TO-SHORTS" :QUALIFIER "EXCL")
         FLOAT)
      (LOGIOR LOW (ASH HIGH 16)))
    (#S(FORMGREP:SYMREF :NAME "SINGLE-FLOAT-BITS" :QUALIFIER "CCL") FLOAT)
    (#S(FORMGREP:SYMREF :NAME "SINGLE-FLOAT-TO-BITS" :QUALIFIER "EXT") FLOAT)
    (LDB (BYTE 32 0)
         (#S(FORMGREP:SYMREF :NAME "SINGLE-FLOAT-BITS" :QUALIFIER "KERNEL")
          FLOAT))
    (#S(FORMGREP:SYMREF :NAME "SINGLE-FLOAT-BITS" :QUALIFIER "SI") FLOAT)
    (LET ((V
           (#S(FORMGREP:SYMREF :NAME "MAKE-TYPED-AREF-VECTOR" :QUALIFIER "SYS")
            4)))
      (DECLARE (OPTIMIZE (SPEED 3) (FLOAT 0) (SAFETY 0)))
      (DECLARE (DYNAMIC-EXTENT V))
      (SETF (#S(FORMGREP:SYMREF :NAME "TYPED-AREF" :QUALIFIER "SYS")
             'SINGLE-FLOAT V 0)
              FLOAT)
      (#S(FORMGREP:SYMREF :NAME "TYPED-AREF" :QUALIFIER "SYS")
       '(UNSIGNED-BYTE 32) V 0))
    (#S(FORMGREP:SYMREF
        :NAME "SINGLE-FLOAT-TO-IEEE-BINARY32"
        :QUALIFIER "MEZZANO.EXTENSIONS")
     FLOAT)
    (LDB (BYTE 32 0) (SB-KERNEL:SINGLE-FLOAT-BITS FLOAT)))

[float-features/float-features.lisp:357]
  (DEFUN DOUBLE-FLOAT-BITS (FLOAT)
    (LOGIOR
     (#S(FORMGREP:SYMREF :NAME "DOUBLE-FLOAT-LOW-BITS" :QUALIFIER "SYSTEM")
      FLOAT)
     (ASH
      (#S(FORMGREP:SYMREF :NAME "DOUBLE-FLOAT-HIGH-BITS" :QUALIFIER "SYSTEM")
       FLOAT)
      32))
    (MULTIPLE-VALUE-BIND (S3 S2 S1 S0)
        (#S(FORMGREP:SYMREF :NAME "DOUBLE-FLOAT-TO-SHORTS" :QUALIFIER "EXCL")
         FLOAT)
      (LOGIOR S0 (ASH S1 16) (ASH S2 32) (ASH S3 48)))
    (MULTIPLE-VALUE-BIND (HIGH LOW)
        (#S(FORMGREP:SYMREF :NAME "DOUBLE-FLOAT-BITS" :QUALIFIER "CCL") FLOAT)
      (LOGIOR LOW (ASH HIGH 32)))
    (#S(FORMGREP:SYMREF :NAME "DOUBLE-FLOAT-TO-BITS" :QUALIFIER "EXT") FLOAT)
    (LDB (BYTE 64 0)
         (LOGIOR
          (#S(FORMGREP:SYMREF
              :NAME "DOUBLE-FLOAT-LOW-BITS"
              :QUALIFIER "KERNEL")
           FLOAT)
          (ASH
           (#S(FORMGREP:SYMREF
               :NAME "DOUBLE-FLOAT-HIGH-BITS"
               :QUALIFIER "KERNEL")
            FLOAT)
           32)))
    (#S(FORMGREP:SYMREF :NAME "DOUBLE-FLOAT-BITS" :QUALIFIER "SI") FLOAT)
    (LET ((V
           (#S(FORMGREP:SYMREF :NAME "MAKE-TYPED-AREF-VECTOR" :QUALIFIER "SYS")
            8)))
      (DECLARE (OPTIMIZE (SPEED 3) (FLOAT 0) (SAFETY 0)))
      (DECLARE (DYNAMIC-EXTENT V))
      (SETF (#S(FORMGREP:SYMREF :NAME "TYPED-AREF" :QUALIFIER "SYS")
             'DOUBLE-FLOAT V 0)
              FLOAT)
      (#S(FORMGREP:SYMREF :NAME "TYPED-AREF" :QUALIFIER "SYS")
       '(UNSIGNED-BYTE 64) V 0))
    (#S(FORMGREP:SYMREF
        :NAME "DOUBLE-FLOAT-TO-IEEE-BINARY64"
        :QUALIFIER "MEZZANO.EXTENSIONS")
     FLOAT)
    (LDB (BYTE 64 0)
         (LOGIOR (SB-KERNEL:DOUBLE-FLOAT-LOW-BITS FLOAT)
                 (ASH (SB-KERNEL:DOUBLE-FLOAT-HIGH-BITS FLOAT) 32))))

[float-features/float-features.lisp:446]
  (DEFUN BITS-SINGLE-FLOAT (BITS)
    (#S(FORMGREP:SYMREF :NAME "MAKE-SINGLE-FLOAT" :QUALIFIER "SYSTEM") BITS)
    (#S(FORMGREP:SYMREF :NAME "SHORTS-TO-SINGLE-FLOAT" :QUALIFIER "EXCL")
     (LDB (BYTE 16 16) BITS) (LDB (BYTE 16 0) BITS))
    (#S(FORMGREP:SYMREF
        :NAME "HOST-SINGLE-FLOAT-FROM-UNSIGNED-BYTE-32"
        :QUALIFIER "CCL")
     BITS)
    (#S(FORMGREP:SYMREF :NAME "BITS-TO-SINGLE-FLOAT" :QUALIFIER "EXT") BITS)
    (FLET ((S32 (X)
             (LOGIOR X (- (MASK-FIELD (BYTE 1 31) X)))))
      (#S(FORMGREP:SYMREF :NAME "MAKE-SINGLE-FLOAT" :QUALIFIER "KERNEL")
       (S32 BITS)))
    (#S(FORMGREP:SYMREF :NAME "BITS-SINGLE-FLOAT" :QUALIFIER "SI") BITS)
    (LET ((V
           (#S(FORMGREP:SYMREF :NAME "MAKE-TYPED-AREF-VECTOR" :QUALIFIER "SYS")
            4)))
      (DECLARE (OPTIMIZE SPEED (FLOAT 0) (SAFETY 0)))
      (DECLARE (DYNAMIC-EXTENT V))
      (SETF (#S(FORMGREP:SYMREF :NAME "TYPED-AREF" :QUALIFIER "SYS")
             '(UNSIGNED-BYTE 32) V 0)
              BITS)
      (#S(FORMGREP:SYMREF :NAME "TYPED-AREF" :QUALIFIER "SYS") 'SINGLE-FLOAT V
       0))
    (#S(FORMGREP:SYMREF
        :NAME "IEEE-BINARY32-TO-SINGLE-FLOAT"
        :QUALIFIER "MEZZANO.EXTENSIONS")
     BITS)
    (SB-KERNEL:MAKE-SINGLE-FLOAT
     (SB-C::MASK-SIGNED-FIELD 32 (THE (UNSIGNED-BYTE 32) BITS))))

[float-features/float-features.lisp:476]
  (DEFUN BITS-DOUBLE-FLOAT (BITS)
    (#S(FORMGREP:SYMREF :NAME "MAKE-DOUBLE-FLOAT" :QUALIFIER "SYSTEM") BITS)
    (#S(FORMGREP:SYMREF :NAME "SHORTS-TO-DOUBLE-FLOAT" :QUALIFIER "EXCL")
     (LDB (BYTE 16 48) BITS) (LDB (BYTE 16 32) BITS) (LDB (BYTE 16 16) BITS)
     (LDB (BYTE 16 0) BITS))
    (#S(FORMGREP:SYMREF :NAME "DOUBLE-FLOAT-FROM-BITS" :QUALIFIER "CCL")
     (LDB (BYTE 32 32) BITS) (LDB (BYTE 32 0) BITS))
    (#S(FORMGREP:SYMREF :NAME "BITS-TO-DOUBLE-FLOAT" :QUALIFIER "EXT") BITS)
    (FLET ((S32 (X)
             (LOGIOR X (- (MASK-FIELD (BYTE 1 31) X)))))
      (#S(FORMGREP:SYMREF :NAME "MAKE-DOUBLE-FLOAT" :QUALIFIER "KERNEL")
       (S32 (LDB (BYTE 32 32) BITS)) (LDB (BYTE 32 0) BITS)))
    (#S(FORMGREP:SYMREF :NAME "BITS-DOUBLE-FLOAT" :QUALIFIER "SI") BITS)
    (LET ((V
           (#S(FORMGREP:SYMREF :NAME "MAKE-TYPED-AREF-VECTOR" :QUALIFIER "SYS")
            8)))
      (DECLARE (OPTIMIZE SPEED (FLOAT 0) (SAFETY 0)))
      (DECLARE (DYNAMIC-EXTENT V))
      (SETF (#S(FORMGREP:SYMREF :NAME "TYPED-AREF" :QUALIFIER "SYS")
             '(UNSIGNED-BYTE 64) V 0)
              BITS)
      (#S(FORMGREP:SYMREF :NAME "TYPED-AREF" :QUALIFIER "SYS") 'DOUBLE-FLOAT V
       0))
    (#S(FORMGREP:SYMREF
        :NAME "IEEE-BINARY64-TO-DOUBLE-FLOAT"
        :QUALIFIER "MEZZANO.EXTENSIONS")
     BITS)
    (SB-KERNEL:MAKE-DOUBLE-FLOAT
     (SB-C::MASK-SIGNED-FIELD 32
                              (LDB (BYTE 32 32) (THE (UNSIGNED-BYTE 64) BITS)))
     (LDB (BYTE 32 0) BITS)))

[fn/fn.lisp:77]
  (DEFUN FN~ (FUNCTION &REST ARGS)
    "Partially apply args to function"
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
             (FUNCTION FUNCTION))
    (LAMBDA (&REST REST-OF-THE-ARGS)
      (MULTIPLE-VALUE-CALL FUNCTION
        (VALUES-LIST ARGS)
        (VALUES-LIST REST-OF-THE-ARGS))))

[fn/fn.lisp:86]
  (DEFINE-COMPILER-MACRO FN~
      (FUNCTION &REST ARGS)
    (LET ((GFUNC (GENSYM "function")))
      (ECLECTOR.READER:QUASIQUOTE
       (LET (((ECLECTOR.READER:UNQUOTE GFUNC)
              (ECLECTOR.READER:UNQUOTE FUNCTION)))
         (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
                  (FUNCTION (ECLECTOR.READER:UNQUOTE GFUNC)))
         (LAMBDA (&REST REST-OF-THE-ARGS)
           (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
           (APPLY (ECLECTOR.READER:UNQUOTE GFUNC)
                  (ECLECTOR.READER:UNQUOTE-SPLICING ARGS) REST-OF-THE-ARGS))))))

[fn/fn.lisp:95]
  (DEFUN FN~R (FUNCTION &REST ARGS)
    "Partially apply args to function"
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
             (FUNCTION FUNCTION))
    (LAMBDA (&REST REST-OF-THE-ARGS)
      (MULTIPLE-VALUE-CALL FUNCTION
        (VALUES-LIST REST-OF-THE-ARGS)
        (VALUES-LIST ARGS))))

[fn/fn.lisp:104]
  (DEFUN FN+ (FUNCTION &REST MORE-FUNCTIONS)
    "Returns a function composed of FUNCTION and MORE-FUNCTIONS that applies its
arguments to to each in turn, starting from the rightmost of MORE-FUNCTIONS,
and then calling the next one with the primary value of the last."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
    (UNLESS (AND (FUNCTIONP FUNCTION) (EVERY #'FUNCTIONP MORE-FUNCTIONS))
      (ERROR "fn+ can only compose functions"))
    (REDUCE
     (LAMBDA (F G)
       (DECLARE (TYPE FUNCTION F G))
       (LAMBDA (&REST ARGUMENTS)
         (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
                  (DYNAMIC-EXTENT ARGUMENTS))
         (FUNCALL F (APPLY G ARGUMENTS))))
     MORE-FUNCTIONS :INITIAL-VALUE FUNCTION))

[fset/Code/bounded-sets.lisp:169]
  (DEFMETHOD INTERNAL-DO-SET
             ((BS BOUNDED-SET) ELT-FN &OPTIONAL (VALUE-FN (LAMBDA () NIL)))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE FUNCTION ELT-FN VALUE-FN))
    (IF (BOUNDED-SET-COMPLEMENT? BS)
        (INTERNAL-DO-SET (BOUNDED-SET-UNIVERSE BS)
         (LAMBDA (X)
           (UNLESS (CONTAINS? (BOUNDED-SET-SET BS) X) (FUNCALL ELT-FN X)))
         VALUE-FN)
        (INTERNAL-DO-SET (BOUNDED-SET-SET BS) ELT-FN VALUE-FN)))

[fset/Code/fset.lisp:851]
  (DEFUN LIST-PARTITION (PRED LS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE FUNCTION PRED))
    (LET ((RES1 NIL) (RES2 NIL))
      (DOLIST (X LS)
        (IF (FUNCALL PRED X)
            (PUSH X RES1)
            (PUSH X RES2)))
      (VALUES (NREVERSE RES1) (NREVERSE RES2))))

[fset/Code/fset.lisp:1090]
  (DEFMETHOD INTERNAL-DO-SET
             ((S WB-SET) ELT-FN &OPTIONAL (VALUE-FN (LAMBDA () NIL)))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE FUNCTION ELT-FN VALUE-FN))
    (DO-WB-SET-TREE-MEMBERS (X (WB-SET-CONTENTS S) (FUNCALL VALUE-FN))
     (FUNCALL ELT-FN X)))

[fset/Code/fset.lisp:1109]
  (DEFUN SET-FILTER (PRED S)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE FUNCTION PRED))
    (LET ((RESULT NIL))
      (DO-SET (X S)
       (WHEN (FUNCALL PRED X) (SETQ RESULT (WB-SET-TREE-WITH RESULT X))))
      (MAKE-WB-SET RESULT)))

[fset/Code/fset.lisp:1127]
  (DEFUN SET-PARTITION (PRED S)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE FUNCTION PRED))
    (LET ((RESULT-1 NIL) (RESULT-2 NIL))
      (DO-SET (X S)
       (IF (FUNCALL PRED X)
           (SETQ RESULT-1 (WB-SET-TREE-WITH RESULT-1 X))
           (SETQ RESULT-2 (WB-SET-TREE-WITH RESULT-2 X))))
      (VALUES (MAKE-WB-SET RESULT-1) (MAKE-WB-SET RESULT-2))))

[fset/Code/fset.lisp:1175]
  (DEFUN SET-REDUCE (FN S INITIAL-VALUE KEY INIT?)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE FUNCTION FN)
             (TYPE (OR FUNCTION NULL) KEY))
    (LET ((RESULT INITIAL-VALUE) (CALL-FN? INIT?))
      (IF (AND (NOT INIT?) (EMPTY? S))
          (SETQ RESULT (FUNCALL FN))
          (DO-SET (X S)
           (IF CALL-FN?
               (SETQ RESULT
                       (FUNCALL FN RESULT
                                (IF KEY
                                    (FUNCALL KEY X)
                                    X)))
               (SETQ RESULT
                       (IF KEY
                           (FUNCALL KEY X)
                           X)
                     CALL-FN? T))))
      RESULT))

[fset/Code/fset.lisp:1217]
  (DEFMETHOD CONVERT ((TO-TYPE (EQL 'VECTOR)) (S SET) &KEY)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((RESULT (MAKE-ARRAY (THE FIXNUM (SIZE S)))) (I 0))
      (DECLARE (TYPE FIXNUM I))
      (DO-SET (X S) (SETF (SVREF RESULT I) X) (INCF I))
      RESULT))

[fset/Code/fset.lisp:1239]
  (DEFMETHOD FIND (ITEM (S SET) &KEY KEY TEST)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((TEST (COERCE-TO-FUNCTION-OR-EQUAL? TEST)))
      (IF KEY
          (LET ((KEY (COERCE-TO-FUNCTION KEY)))
            (DO-SET (X S)
             (WHEN (FUNCALL TEST ITEM (FUNCALL KEY X)) (RETURN X))))
          (IF (NOT (EQ TEST #'EQUAL?))
              (DO-SET (X S) (WHEN (FUNCALL TEST ITEM X) (RETURN X)))
              (NTH-VALUE 1 (LOOKUP S ITEM))))))

[fset/Code/fset.lisp:1253]
  (DEFMETHOD FIND-IF (PRED (S SET) &KEY KEY)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((PRED (COERCE-TO-FUNCTION PRED)))
      (IF KEY
          (LET ((KEY (COERCE-TO-FUNCTION KEY)))
            (DO-SET (X S) (WHEN (FUNCALL PRED (FUNCALL KEY X)) (RETURN X))))
          (DO-SET (X S) (WHEN (FUNCALL PRED X) (RETURN X))))))

[fset/Code/fset.lisp:1265]
  (DEFMETHOD FIND-IF-NOT (PRED (S SET) &KEY KEY)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((PRED (COERCE-TO-FUNCTION PRED)))
      (FIND-IF #'(LAMBDA (X) (NOT (FUNCALL PRED X))) S :KEY KEY)))

[fset/Code/fset.lisp:1270]
  (DEFMETHOD COUNT (ITEM (S SET) &KEY KEY TEST)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((TEST DEFAULT? (COERCE-TO-FUNCTION-OR-EQUAL? TEST)))
      (IF KEY
          (LET ((KEY (COERCE-TO-FUNCTION KEY)) (TOTAL 0))
            (DECLARE (FIXNUM TOTAL))
            (DO-SET (X S TOTAL)
             (WHEN (FUNCALL TEST ITEM (FUNCALL KEY X)) (INCF TOTAL))))
          (IF DEFAULT?
              (IF (LOOKUP S ITEM)
                  1
                  0)
              (LET ((TOTAL 0))
                (DECLARE (FIXNUM TOTAL))
                (DO-SET (X S TOTAL)
                 (WHEN (FUNCALL TEST ITEM X) (INCF TOTAL))))))))

[fset/Code/fset.lisp:1288]
  (DEFMETHOD COUNT-IF (PRED (S SET) &KEY KEY)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((PRED (COERCE-TO-FUNCTION PRED)) (N 0))
      (DECLARE (FIXNUM N))
      (IF KEY
          (LET ((KEY (COERCE-TO-FUNCTION KEY)))
            (DO-SET (X S N) (WHEN (FUNCALL PRED (FUNCALL KEY X)) (INCF N))))
          (DO-SET (X S N) (WHEN (FUNCALL PRED X) (INCF N))))))

[fset/Code/fset.lisp:1302]
  (DEFMETHOD COUNT-IF-NOT (PRED (S SET) &KEY KEY)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((PRED (COERCE-TO-FUNCTION PRED)))
      (COUNT-IF #'(LAMBDA (X) (NOT (FUNCALL PRED X))) S :KEY KEY)))

[fset/Code/fset.lisp:1520]
  (DEFMETHOD INTERNAL-DO-BAG-PAIRS
             ((B WB-BAG) ELT-FN &OPTIONAL (VALUE-FN (LAMBDA () NIL)))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE FUNCTION ELT-FN VALUE-FN))
    (DO-WB-BAG-TREE-PAIRS (X N (WB-BAG-CONTENTS B) (FUNCALL VALUE-FN))
     (FUNCALL ELT-FN X N)))

[fset/Code/fset.lisp:1595]
  (DEFUN BAG-REDUCE (FN B INITIAL-VALUE KEY INIT?)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE FUNCTION FN)
             (TYPE (OR FUNCTION NULL) KEY))
    (LET ((RESULT INITIAL-VALUE) (CALL-FN? INIT?))
      (IF (AND (NOT INIT?) (EMPTY? B))
          (SETQ RESULT (FUNCALL FN))
          (DO-BAG (X B)
           (IF CALL-FN?
               (SETQ RESULT
                       (FUNCALL FN RESULT
                                (IF KEY
                                    (FUNCALL KEY X)
                                    X)))
               (SETQ RESULT
                       (IF KEY
                           (FUNCALL KEY X)
                           X)
                     CALL-FN? T))))
      RESULT))

[fset/Code/fset.lisp:1622]
  (DEFMETHOD CONVERT ((TO-TYPE (EQL 'LIST)) (B BAG) &KEY)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((RESULT NIL))
      (DO-BAG (VALUE B) (PUSH VALUE RESULT))
      (NREVERSE RESULT)))

[fset/Code/fset.lisp:1635]
  (DEFMETHOD CONVERT ((TO-TYPE (EQL 'ALIST)) (B BAG) &KEY)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((RESULT NIL))
      (DO-BAG-PAIRS (VALUE COUNT B) (PUSH (CONS VALUE COUNT) RESULT))
      (NREVERSE RESULT)))

[fset/Code/fset.lisp:1686]
  (DEFMETHOD FIND (ITEM (B BAG) &KEY KEY TEST)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((TEST (COERCE-TO-FUNCTION-OR-EQUAL? TEST)))
      (IF KEY
          (LET ((KEY (COERCE-TO-FUNCTION KEY)))
            (DO-BAG-PAIRS (X N B NIL) (DECLARE (IGNORE N))
             (WHEN (FUNCALL TEST ITEM (FUNCALL KEY X)) (RETURN X))))
          (IF (NOT (EQ TEST #'EQUAL?))
              (DO-BAG-PAIRS (X N B NIL) (DECLARE (IGNORE N))
               (WHEN (FUNCALL TEST ITEM X) (RETURN X)))
              (NTH-VALUE 1 (LOOKUP B ITEM))))))

[fset/Code/fset.lisp:1702]
  (DEFMETHOD FIND-IF (PRED (B BAG) &KEY KEY)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((PRED (COERCE-TO-FUNCTION PRED)))
      (IF KEY
          (LET ((KEY (COERCE-TO-FUNCTION KEY)))
            (DO-BAG-PAIRS (X N B NIL) (DECLARE (IGNORE N))
             (WHEN (FUNCALL PRED (FUNCALL KEY X)) (RETURN X))))
          (DO-BAG-PAIRS (X N B NIL) (DECLARE (IGNORE N))
           (WHEN (FUNCALL PRED X) (RETURN X))))))

[fset/Code/fset.lisp:1716]
  (DEFMETHOD FIND-IF-NOT (PRED (B BAG) &KEY KEY)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((PRED (COERCE-TO-FUNCTION PRED)))
      (FIND-IF #'(LAMBDA (X) (NOT (FUNCALL PRED X))) B :KEY KEY)))

[fset/Code/fset.lisp:1721]
  (DEFMETHOD COUNT (ITEM (B BAG) &KEY KEY TEST)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((TEST DEFAULT? (COERCE-TO-FUNCTION-OR-EQUAL? TEST)))
      (IF KEY
          (LET ((KEY (COERCE-TO-FUNCTION KEY)) (TOTAL 0))
            (DO-BAG-PAIRS (X N B TOTAL)
             (WHEN (FUNCALL TEST ITEM (FUNCALL KEY X))
               (SETQ TOTAL (GEN + TOTAL N)))))
          (IF DEFAULT?
              (MULTIPLICITY B ITEM)
              (LET ((TOTAL 0))
                (DO-BAG-PAIRS (X N B TOTAL)
                 (WHEN (FUNCALL TEST ITEM X) (SETQ TOTAL (GEN + TOTAL N)))))))))

[fset/Code/fset.lisp:1737]
  (DEFMETHOD COUNT-IF (PRED (B BAG) &KEY KEY)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((PRED (COERCE-TO-FUNCTION PRED)) (TOTAL 0))
      (IF KEY
          (LET ((KEY (COERCE-TO-FUNCTION KEY)))
            (DO-BAG-PAIRS (X N B TOTAL)
             (WHEN (FUNCALL PRED (FUNCALL KEY X))
               (SETQ TOTAL (GEN + TOTAL N)))))
          (DO-BAG-PAIRS (X N B TOTAL)
           (WHEN (FUNCALL PRED X) (SETQ TOTAL (GEN + TOTAL N)))))))

[fset/Code/fset.lisp:1750]
  (DEFMETHOD COUNT-IF-NOT (PRED (S BAG) &KEY KEY)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((PRED (COERCE-TO-FUNCTION PRED)))
      (COUNT-IF #'(LAMBDA (X) (NOT (FUNCALL PRED X))) S :KEY KEY)))

[fset/Code/fset.lisp:1921]
  (DEFMETHOD INTERNAL-DO-MAP
             ((M WB-MAP) ELT-FN &OPTIONAL (VALUE-FN (LAMBDA () NIL)))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE FUNCTION ELT-FN VALUE-FN))
    (DO-WB-MAP-TREE-PAIRS (X Y (WB-MAP-CONTENTS M) (FUNCALL VALUE-FN))
     (FUNCALL ELT-FN X Y)))

[fset/Code/fset.lisp:1965]
  (DEFUN MAP-REDUCE (FN M INITIAL-VALUE KEY INIT?)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE FUNCTION FN)
             (TYPE (OR FUNCTION NULL) KEY))
    (UNLESS INIT?
      (ERROR 'SIMPLE-PROGRAM-ERROR :FORMAT-CONTROL
             "~A on a map requires an initial value" :FORMAT-ARGUMENTS
             '(REDUCE)))
    (LET ((RESULT INITIAL-VALUE))
      (DO-MAP (X Y M)
       (LET ((X
              Y
              (IF KEY
                  (FUNCALL KEY X Y)
                  (VALUES X Y))))
         (SETQ RESULT (FUNCALL FN RESULT X Y))))
      RESULT))

[fset/Code/fset.lisp:2131]
  (DEFMETHOD FIND (ITEM (M MAP) &KEY KEY TEST)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((TEST (COERCE-TO-FUNCTION-OR-EQUAL? TEST)))
      (IF KEY
          (LET ((KEY (COERCE-TO-FUNCTION KEY)))
            (DO-MAP (X Y M NIL)
             (WHEN (FUNCALL TEST ITEM (FUNCALL KEY X)) (RETURN (VALUES X Y)))))
          (IF (NOT (EQ TEST #'EQUAL?))
              (DO-MAP (X Y M NIL)
               (WHEN (FUNCALL TEST ITEM X) (RETURN (VALUES X Y))))
              (LET ((VAL VAL? (LOOKUP M ITEM)))
                (IF VAL?
                    (VALUES ITEM VAL)
                    (VALUES NIL NIL)))))))

[fset/Code/fset.lisp:2147]
  (DEFMETHOD FIND-IF (PRED (M MAP) &KEY KEY)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((PRED (COERCE-TO-FUNCTION PRED)))
      (IF KEY
          (LET ((KEY (COERCE-TO-FUNCTION KEY)))
            (DO-MAP (X Y M NIL)
             (WHEN (FUNCALL PRED (FUNCALL KEY X)) (RETURN (VALUES X Y)))))
          (DO-MAP (X Y M NIL) (WHEN (FUNCALL PRED X) (RETURN (VALUES X Y)))))))

[fset/Code/fset.lisp:2159]
  (DEFMETHOD FIND-IF-NOT (PRED (M MAP) &KEY KEY)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((PRED (COERCE-TO-FUNCTION PRED)))
      (FIND-IF #'(LAMBDA (X) (NOT (FUNCALL PRED X))) M :KEY KEY)))

[fset/Code/fset.lisp:2164]
  (DEFMETHOD COUNT (ITEM (M MAP) &KEY KEY TEST)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((TEST DEFAULT? (COERCE-TO-FUNCTION-OR-EQUAL? TEST)))
      (IF KEY
          (LET ((KEY (COERCE-TO-FUNCTION KEY)) (TOTAL 0))
            (DECLARE (FIXNUM TOTAL))
            (DO-MAP (X Y M TOTAL) (DECLARE (IGNORE Y))
             (WHEN (FUNCALL TEST ITEM (FUNCALL KEY X)) (INCF TOTAL))))
          (IF DEFAULT?
              (IF (LOOKUP M ITEM)
                  1
                  0)
              (LET ((TOTAL 0))
                (DECLARE (FIXNUM TOTAL))
                (DO-MAP (X Y M TOTAL) (DECLARE (IGNORE Y))
                 (WHEN (FUNCALL TEST ITEM X) (INCF TOTAL))))))))

[fset/Code/fset.lisp:2184]
  (DEFMETHOD COUNT-IF (PRED (M MAP) &KEY KEY)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((PRED (COERCE-TO-FUNCTION PRED)) (N 0))
      (DECLARE (FIXNUM N))
      (IF KEY
          (LET ((KEY (COERCE-TO-FUNCTION KEY)))
            (DO-MAP (X Y M N) (DECLARE (IGNORE Y))
             (WHEN (FUNCALL PRED (FUNCALL KEY X)) (INCF N))))
          (DO-MAP (X Y M N) (DECLARE (IGNORE Y))
           (WHEN (FUNCALL PRED X) (INCF N))))))

[fset/Code/fset.lisp:2200]
  (DEFMETHOD COUNT-IF-NOT (PRED (M MAP) &KEY KEY)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((PRED (COERCE-TO-FUNCTION PRED)))
      (COUNT-IF #'(LAMBDA (X) (NOT (FUNCALL PRED X))) M :KEY KEY)))

[fset/Code/fset.lisp:2486]
  (DEFMETHOD INTERNAL-DO-SEQ
             ((S WB-SEQ) ELT-FN VALUE-FN INDEX?
              &KEY (START 0) (END (WB-SEQ-TREE-SIZE (WB-SEQ-CONTENTS S)))
              FROM-END?)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE FUNCTION ELT-FN)
             (TYPE (OR NULL FUNCTION) VALUE-FN))
    (CHECK-TYPE START FIXNUM)
    (CHECK-TYPE END FIXNUM)
    (IF INDEX?
        (LET ((I START))
          (DECLARE (TYPE FIXNUM I))
          (DO-WB-SEQ-TREE-MEMBERS-GEN
           (X (WB-SEQ-CONTENTS S) START END FROM-END?
            (WHEN VALUE-FN (FUNCALL VALUE-FN)))
           (FUNCALL ELT-FN X I) (INCF I)))
        (DO-WB-SEQ-TREE-MEMBERS-GEN
         (X (WB-SEQ-CONTENTS S) START END FROM-END?
          (WHEN VALUE-FN (FUNCALL VALUE-FN)))
         (FUNCALL ELT-FN X))))

[fset/Code/fset.lisp:2530]
  (DEFMETHOD RANGE-CONTAINS? ((S SEQ) X)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DO-SEQ (Y S) (WHEN (EQUAL? Y X) (RETURN T))))

[fset/Code/fset.lisp:2551]
  (DEFUN SEQ-FILTER (FN S)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE FUNCTION FN))
    (LET ((RESULT NIL))
      (DO-SEQ (X S) (WHEN (FUNCALL FN X) (PUSH X RESULT)))
      (MAKE-WB-SEQ (WB-SEQ-TREE-FROM-LIST (NREVERSE RESULT)) (SEQ-DEFAULT S))))

[fset/Code/fset.lisp:2576]
  (DEFUN SEQ-PARTITION (FN S)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE FUNCTION FN))
    (LET ((RESULT-1 NIL) (RESULT-2 NIL))
      (DO-SEQ (X S)
       (IF (FUNCALL FN X)
           (PUSH X RESULT-1)
           (PUSH X RESULT-2)))
      (VALUES
       (MAKE-WB-SEQ (WB-SEQ-TREE-FROM-LIST (NREVERSE RESULT-1))
        (SEQ-DEFAULT S))
       (MAKE-WB-SEQ (WB-SEQ-TREE-FROM-LIST (NREVERSE RESULT-2))
        (SEQ-DEFAULT S)))))

[fset/Code/fset.lisp:2605]
  (DEFUN SEQ-IMAGE (FN S)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE FUNCTION FN))
    (LET ((RESULT NIL))
      (DO-SEQ (X S) (PUSH (FUNCALL FN X) RESULT))
      (MAKE-WB-SEQ (WB-SEQ-TREE-FROM-LIST (NREVERSE RESULT)) (SEQ-DEFAULT S))))

[fset/Code/fset.lisp:2628]
  (DEFUN SEQ-REDUCE (FN S INITIAL-VALUE KEY INIT? START END FROM-END?)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE FUNCTION FN)
             (TYPE (OR FUNCTION NULL) KEY)
             (TYPE FIXNUM START END))
    (LET ((RESULT INITIAL-VALUE) (CALL-FN? INIT?))
      (IF (AND (NOT INIT?) (EMPTY? S))
          (SETQ RESULT (FUNCALL FN))
          (IF (AND (= START 0) (= END (THE FIXNUM (SIZE S))) (NOT FROM-END?))
              (DO-SEQ (X S)
               (IF CALL-FN?
                   (SETQ RESULT
                           (FUNCALL FN RESULT
                                    (IF KEY
                                        (FUNCALL KEY X)
                                        X)))
                   (SETQ RESULT
                           (IF KEY
                               (FUNCALL KEY X)
                               X)
                         CALL-FN? T)))
              (DOTIMES (I (- END START))
                (DECLARE (TYPE FIXNUM I))
                (LET ((X
                       (LOOKUP S
                        (IF FROM-END?
                            (THE FIXNUM (- END I 1))
                            (THE FIXNUM (+ I START))))))
                  (IF CALL-FN?
                      (SETQ RESULT
                              (FUNCALL FN RESULT
                                       (IF KEY
                                           (FUNCALL KEY X)
                                           X)))
                      (SETQ RESULT
                              (IF KEY
                                  (FUNCALL KEY X)
                                  X)
                            CALL-FN? T))))))
      RESULT))

[fset/Code/fset.lisp:2654]
  (DEFMETHOD FIND (ITEM (S SEQ) &KEY KEY TEST START END FROM-END)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((TEST (COERCE-TO-FUNCTION-OR-EQUAL? TEST))
          (START (OR START 0))
          (END (OR END (SIZE S))))
      (IF KEY
          (LET ((KEY (COERCE-TO-FUNCTION KEY)))
            (DO-SEQ (X S :START START :END END :FROM-END? FROM-END :VALUE NIL)
             (WHEN (FUNCALL TEST ITEM (FUNCALL KEY X)) (RETURN X))))
          (DO-SEQ (X S :START START :END END :FROM-END? FROM-END :VALUE NIL)
           (WHEN (FUNCALL TEST ITEM X) (RETURN X))))))

[fset/Code/fset.lisp:2668]
  (DEFMETHOD FIND-IF (PRED (S SEQ) &KEY KEY START END FROM-END)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((PRED (COERCE-TO-FUNCTION PRED))
          (START (OR START 0))
          (END (OR END (SIZE S))))
      (IF KEY
          (LET ((KEY (COERCE-TO-FUNCTION KEY)))
            (DO-SEQ (X S :START START :END END :FROM-END? FROM-END :VALUE NIL)
             (WHEN (FUNCALL PRED (FUNCALL KEY X)) (RETURN X))))
          (DO-SEQ (X S :START START :END END :FROM-END? FROM-END :VALUE NIL)
           (WHEN (FUNCALL PRED X) (RETURN X))))))

[fset/Code/fset.lisp:2682]
  (DEFMETHOD FIND-IF-NOT (PRED (S SEQ) &KEY KEY START END FROM-END)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((PRED (COERCE-TO-FUNCTION PRED)))
      (FIND-IF #'(LAMBDA (X) (NOT (FUNCALL PRED X))) S :KEY KEY :START START
               :END END :FROM-END FROM-END)))

[fset/Code/fset.lisp:2688]
  (DEFMETHOD COUNT (ITEM (S SEQ) &KEY KEY TEST START END FROM-END)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((TEST (COERCE-TO-FUNCTION-OR-EQUAL? TEST))
          (TOTAL 0)
          (START (OR START 0))
          (END (OR END (SIZE S))))
      (DECLARE (FIXNUM TOTAL))
      (IF KEY
          (LET ((KEY (COERCE-TO-FUNCTION KEY)))
            (DO-SEQ (X S :START START :END END :FROM-END? FROM-END)
             (WHEN (FUNCALL TEST ITEM (FUNCALL KEY X)) (INCF TOTAL))))
          (DO-SEQ (X S :START START :END END :FROM-END? FROM-END)
           (WHEN (FUNCALL TEST ITEM X) (INCF TOTAL))))
      TOTAL))

[fset/Code/fset.lisp:2705]
  (DEFMETHOD COUNT-IF (PRED (S SEQ) &KEY KEY START END FROM-END)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((PRED (COERCE-TO-FUNCTION PRED))
          (N 0)
          (START (OR START 0))
          (END (OR END (SIZE S))))
      (DECLARE (FIXNUM N))
      (IF KEY
          (LET ((KEY (COERCE-TO-FUNCTION KEY)))
            (DO-SEQ (X S :START START :END END :FROM-END? FROM-END)
             (WHEN (FUNCALL PRED (FUNCALL KEY X)) (INCF N))))
          (DO-SEQ (X S :START START :END END :FROM-END? FROM-END)
           (WHEN (FUNCALL PRED X) (INCF N))))
      N))

[fset/Code/fset.lisp:2722]
  (DEFMETHOD COUNT-IF-NOT (PRED (S SEQ) &KEY KEY START END FROM-END)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((PRED (COERCE-TO-FUNCTION PRED)))
      (COUNT-IF #'(LAMBDA (X) (NOT (FUNCALL PRED X))) S :KEY KEY :START START
                :END END :FROM-END FROM-END)))

[fset/Code/fset.lisp:2728]
  (DEFMETHOD POSITION (ITEM (S SEQ) &KEY KEY TEST START END FROM-END)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE (OR FIXNUM NULL) START END))
    (LET ((TEST DEFAULT? (COERCE-TO-FUNCTION-OR-EQUAL? TEST))
          (START (OR START 0))
          ((POS START))
          (END (OR END (SIZE S))))
      (DECLARE (FIXNUM POS))
      (BLOCK DONE-BLOCK
        (FLET ((DONE ()
                 (RETURN-FROM DONE-BLOCK
                   (IF FROM-END
                       (GEN + START (- END POS 1))
                       POS))))
          (IF KEY
              (LET ((KEY (COERCE-TO-FUNCTION KEY)))
                (IF DEFAULT?
                    (DO-SEQ (X S :START START :END END :FROM-END? FROM-END)
                     (WHEN (EQUAL? ITEM (FUNCALL KEY X)) (DONE)) (INCF POS))
                    (DO-SEQ (X S :START START :END END :FROM-END? FROM-END)
                     (WHEN (FUNCALL TEST ITEM (FUNCALL KEY X)) (DONE))
                     (INCF POS))))
              (IF DEFAULT?
                  (DO-SEQ (X S :START START :END END :FROM-END? FROM-END)
                   (WHEN (EQUAL? ITEM X) (DONE)) (INCF POS))
                  (DO-SEQ (X S :START START :END END :FROM-END? FROM-END)
                   (WHEN (FUNCALL TEST ITEM X) (DONE)) (INCF POS))))))))

[fset/Code/fset.lisp:2760]
  (DEFMETHOD POSITION-IF (PRED (S SEQ) &KEY KEY START END FROM-END)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE (OR FIXNUM NULL) START END))
    (LET ((PRED (COERCE-TO-FUNCTION PRED))
          (START (OR START 0))
          ((POS START))
          (END (OR END (SIZE S))))
      (DECLARE (FIXNUM POS))
      (BLOCK DONE-BLOCK
        (FLET ((DONE ()
                 (RETURN-FROM DONE-BLOCK
                   (IF FROM-END
                       (GEN + START (- END POS 1))
                       POS))))
          (IF KEY
              (LET ((KEY (COERCE-TO-FUNCTION KEY)))
                (DO-SEQ (X S :START START :END END :FROM-END? FROM-END)
                 (WHEN (FUNCALL PRED (FUNCALL KEY X)) (DONE)) (INCF POS)))
              (DO-SEQ (X S :START START :END END :FROM-END? FROM-END)
               (WHEN (FUNCALL PRED X) (DONE)) (INCF POS)))))))

[fset/Code/fset.lisp:2782]
  (DEFMETHOD POSITION-IF-NOT (PRED (S SEQ) &KEY KEY START END FROM-END)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((PRED (COERCE-TO-FUNCTION PRED)))
      (POSITION-IF #'(LAMBDA (X) (NOT (FUNCALL PRED X))) S :KEY KEY :START
                   START :END END :FROM-END FROM-END)))

[fset/Code/fset.lisp:2788]
  (DEFMETHOD REMOVE (ITEM (S SEQ) &KEY KEY TEST START END FROM-END COUNT)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((START (OR START 0))
          (END (OR END (SIZE S)))
          (COUNT (OR COUNT (SIZE S)))
          ((HEAD (SUBSEQ S 0 START)) (TAIL (SUBSEQ S END)))
          (MID NIL)
          (TEST
           (IF TEST
               (COERCE-TO-FUNCTION TEST)
               #'EQUAL?))
          (KEY (AND KEY (COERCE-TO-FUNCTION KEY))))
      (DECLARE (FIXNUM COUNT))
      (DO-SEQ (X S :START START :END END :FROM-END? FROM-END)
       (IF (AND (> COUNT 0)
                (FUNCALL TEST ITEM
                         (IF KEY
                             (FUNCALL KEY X)
                             X)))
           (DECF COUNT)
           (PUSH X MID)))
      (CONCAT HEAD
       (CONCAT
        (CONVERT 'SEQ
         (IF FROM-END
             MID
             (NREVERSE MID)))
        TAIL))))

[fset/Code/fset.lisp:2807]
  (DEFMETHOD REMOVE-IF (PRED (S SEQ) &KEY KEY START END FROM-END COUNT)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((START (OR START 0))
          (END (OR END (SIZE S)))
          (COUNT (OR COUNT (SIZE S)))
          ((HEAD (SUBSEQ S 0 START)) (TAIL (SUBSEQ S END)))
          (MID NIL)
          (PRED (COERCE-TO-FUNCTION PRED))
          (KEY (AND KEY (COERCE-TO-FUNCTION KEY))))
      (DECLARE (FIXNUM COUNT))
      (DO-SEQ (X S :START START :END END :FROM-END? FROM-END)
       (IF (AND (> COUNT 0)
                (FUNCALL PRED
                         (IF KEY
                             (FUNCALL KEY X)
                             X)))
           (DECF COUNT)
           (PUSH X MID)))
      (CONCAT HEAD
       (CONCAT
        (CONVERT 'SEQ
         (IF FROM-END
             MID
             (NREVERSE MID)))
        TAIL))))

[fset/Code/fset.lisp:2826]
  (DEFMETHOD REMOVE-IF-NOT (PRED (S SEQ) &KEY KEY START END FROM-END COUNT)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((PRED (COERCE-TO-FUNCTION PRED)))
      (REMOVE-IF #'(LAMBDA (X) (NOT (FUNCALL PRED X))) S :KEY KEY :START START
                 :END END :FROM-END FROM-END :COUNT COUNT)))

[fset/Code/fset.lisp:2832]
  (DEFMETHOD SUBSTITUTE
             (NEWITEM OLDITEM (S SEQ) &KEY KEY TEST START END FROM-END COUNT)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((START (OR START 0))
          (END (OR END (SIZE S)))
          (COUNT (OR COUNT (SIZE S)))
          ((HEAD (SUBSEQ S 0 START)) (TAIL (SUBSEQ S END)))
          (MID NIL)
          (TEST
           (IF TEST
               (COERCE-TO-FUNCTION TEST)
               #'EQUAL?))
          (KEY (AND KEY (COERCE-TO-FUNCTION KEY))))
      (DECLARE (FIXNUM COUNT))
      (DO-SEQ (X S :START START :END END :FROM-END? FROM-END)
       (IF (AND (> COUNT 0)
                (FUNCALL TEST OLDITEM
                         (IF KEY
                             (FUNCALL KEY X)
                             X)))
           (PROGN (PUSH NEWITEM MID) (DECF COUNT))
           (PUSH X MID)))
      (CONCAT HEAD
       (CONCAT
        (CONVERT 'SEQ
         (IF FROM-END
             MID
             (NREVERSE MID)))
        TAIL))))

[fset/Code/fset.lisp:2851]
  (DEFMETHOD SUBSTITUTE-IF
             (NEWITEM PRED (S SEQ) &KEY KEY START END FROM-END COUNT)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((START (OR START 0))
          (END (OR END (SIZE S)))
          (COUNT (OR COUNT (SIZE S)))
          ((HEAD (SUBSEQ S 0 START)) (TAIL (SUBSEQ S END)))
          (MID NIL)
          (PRED (COERCE-TO-FUNCTION PRED))
          (KEY (AND KEY (COERCE-TO-FUNCTION KEY))))
      (DECLARE (FIXNUM COUNT))
      (DO-SEQ (X S :START START :END END :FROM-END? FROM-END)
       (IF (AND (> COUNT 0)
                (FUNCALL PRED
                         (IF KEY
                             (FUNCALL KEY X)
                             X)))
           (PROGN (PUSH NEWITEM MID) (DECF COUNT))
           (PUSH X MID)))
      (CONCAT HEAD
       (CONCAT
        (CONVERT 'SEQ
         (IF FROM-END
             MID
             (NREVERSE MID)))
        TAIL))))

[fset/Code/fset.lisp:2870]
  (DEFMETHOD SUBSTITUTE-IF-NOT
             (NEWITEM PRED (S SEQ) &KEY KEY START END FROM-END COUNT)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((PRED (COERCE-TO-FUNCTION PRED)))
      (SUBSTITUTE-IF NEWITEM #'(LAMBDA (X) (NOT (FUNCALL PRED X))) S :KEY KEY
                     :START START :END END :FROM-END FROM-END :COUNT COUNT)))

[fset/Code/port.lisp:344]
  (DEFMACRO GEN (OP &REST ARGS)
    (LET ((VARS
           (MAPCAR
            (LAMBDA (X)
              (AND (NOT (OR (SYMBOLP X) (NUMBERP X))) (GENSYM "VAR-")))
            ARGS)))
      (ECLECTOR.READER:QUASIQUOTE
       (LET (ECLECTOR.READER:UNQUOTE
             (REMOVE
              NIL
              (MAPCAR
               (LAMBDA (VAR ARG)
                 (AND VAR
                      (ECLECTOR.READER:QUASIQUOTE
                       ((ECLECTOR.READER:UNQUOTE VAR)
                        (ECLECTOR.READER:UNQUOTE ARG)))))
               VARS ARGS)))
         (LOCALLY
          (DECLARE (OPTIMIZE (SPEED 1) (SAFETY 1)))
          ((ECLECTOR.READER:UNQUOTE OP) ECLECTOR.READER:UNQUOTE
           (MAPCAR (LAMBDA (VAR ARG) (OR VAR ARG)) VARS ARGS)))))))

[fset/Code/testing.lisp:2171]
  (DEFUN TEST-SET-OPERATIONS (I)
    (DECLARE (OPTIMIZE (SPEED 0) (SAFETY 3) (DEBUG 3)))
    (LET ((FS0 (EMPTY-SET)) (S0 NIL) (FS1 (EMPTY-SET)) (S1 NIL))
      (DOTIMES (J 100)
        (LET* ((R (MAKE-MY-INTEGER (RANDOM 200))) (TMP (WITH FS0 R)))
          (PUSHNEW R S0 :TEST #'EQUAL?)
          (UNLESS (VERIFY TMP)
            (ERROR "Set verify failed on iteration ~D, adding ~A" I R))
          (UNLESS (= (SIZE TMP) (LENGTH S0))
            (ERROR "Set size or with failed on iteration ~D, adding ~A: ~D, ~D"
                   I R (SIZE TMP) (LENGTH S0)))
          (UNLESS
              (AND (SUBSET? FS0 TMP)
                   (OR (CONTAINS? FS0 R) (NOT (SUBSET? TMP FS0))))
            (ERROR "Set subset? failed on iteration ~D" I))
          (SETQ FS0 TMP)))
      (DOTIMES (J 100)
        (LET* ((R (MAKE-MY-INTEGER (RANDOM 200))) (TMP (WITH FS1 R)))
          (PUSHNEW R S1 :TEST #'EQUAL?)
          (UNLESS (VERIFY TMP)
            (ERROR "Set verify failed on iteration ~D, adding ~A" I R))
          (UNLESS (= (SIZE TMP) (LENGTH S1))
            (ERROR "Set size or with failed on iteration ~D, adding ~A: ~D, ~D"
                   I R (SIZE TMP) (LENGTH S1)))
          (UNLESS
              (AND (SUBSET? FS1 TMP)
                   (OR (CONTAINS? FS1 R) (NOT (SUBSET? TMP FS1))))
            (ERROR "Set subset? failed on iteration ~D" I))
          (SETQ FS1 TMP)
          (UNLESS
              (EQV (DISJOINT? FS0 FS1) (DISJOINT? FS1 FS0)
               (NOT (DO-SET (X FS1 NIL) (WHEN (CONTAINS? FS0 X) (RETURN T)))))
            (ERROR "Set disjoint? failed on iteration ~D" I))))
      (DOTIMES (J 20)
        (LET ((R (MAKE-MY-INTEGER (RANDOM 200))))
          (UNLESS (EQV (CONTAINS? FS0 R) (MEMBER R S0 :TEST #'EQUAL?))
            (ERROR "Set contains? failed (fs0) on iteration ~D, ~A" I R))
          (SETQ S0 (REMOVE R S0 :TEST #'EQUAL?))
          (LET ((TMP (LESS FS0 R)))
            (UNLESS (VERIFY TMP)
              (ERROR "Set verify failed on iteration ~D, removing ~A" I R))
            (UNLESS (= (SIZE TMP) (LENGTH S0))
              (ERROR
               "Set size or less failed (fs0) on iteration ~D, removing ~A" I
               R))
            (SETQ FS0 TMP))))
      (DOTIMES (J 20)
        (LET ((R (MAKE-MY-INTEGER (RANDOM 200))))
          (UNLESS (EQV (CONTAINS? FS1 R) (MEMBER R S1 :TEST #'EQUAL?))
            (ERROR "Set contains? failed (fs1) on iteration ~D" I))
          (SETQ S1 (REMOVE R S1 :TEST #'EQUAL?))
          (LET ((TMP (LESS FS1 R)))
            (UNLESS (VERIFY TMP)
              (ERROR "Set verify failed on iteration ~D, removing ~A" I R))
            (UNLESS (= (SIZE TMP) (LENGTH S1))
              (ERROR
               "Set size or less failed (fs1) on iteration ~D, removing ~A" I
               R))
            (SETQ FS1 TMP))))
      (WHEN (= I 0)
        (LET ((TMP (WITH FS0 NIL)))
          (UNLESS (VERIFY TMP) (ERROR "Set verify failed adding NIL"))
          (SETQ TMP (LESS TMP NIL))
          (UNLESS (VERIFY TMP) (ERROR "Set verify failed removing NIL"))))
      (UNLESS (CONTAINS? FS0 (ARB FS0))
        (ERROR "Set arb/contains? failed (fs0) on iteration ~D" I))
      (UNLESS (CONTAINS? FS1 (ARB FS1))
        (ERROR "Set arb/contains? failed (fs1) on iteration ~D" I))
      (UNLESS
          (MEMBER
           (COMPARE (LEAST FS0)
            (REDUCE
             (LAMBDA (MI1 MI2)
               (IF (< (MY-INTEGER-VALUE MI1) (MY-INTEGER-VALUE MI2))
                   MI1
                   MI2))
             S0))
           '(:EQUAL :UNEQUAL))
        (ERROR "Set least failed on iteration ~D" I))
      (UNLESS
          (MEMBER
           (COMPARE (GREATEST FS0)
            (REDUCE
             (LAMBDA (MI1 MI2)
               (IF (> (MY-INTEGER-VALUE MI1) (MY-INTEGER-VALUE MI2))
                   MI1
                   MI2))
             S0))
           '(:EQUAL :UNEQUAL))
        (ERROR "Set greatest failed on iteration ~D" I))
      (UNLESS (EQUAL? FS0 (CONVERT 'SET S0))
        (ERROR "Set equal? failed (fs0) on iteration ~D" I))
      (UNLESS (EQUAL? FS1 (CONVERT 'SET S1))
        (ERROR "Set equal? failed (fs1) on iteration ~D" I))
      (UNLESS (EQUAL? (CONVERT 'LIST FS0) (GMAP :LIST NIL (:SET FS0)))
        (ERROR "Set iterator failed (fs0) on iteration ~D" I))
      (UNLESS (EQUAL? FS1 (GMAP :SET NIL (:LIST (CONVERT 'LIST FS1))))
        (ERROR "Set iterator or accumulator failed (fs1) on iteration ~D" I))
      (LET ((FSU (UNION FS0 FS1)) (SU (UNION S0 S1 :TEST #'EQUAL?)))
        (UNLESS (AND (VERIFY FSU) (EQUAL? FSU (CONVERT 'SET SU)))
          (ERROR "Set union failed on iteration ~D " I)))
      (LET ((FSI (INTERSECTION FS0 FS1))
            (SI (INTERSECTION S0 S1 :TEST #'EQUAL?)))
        (UNLESS (AND (VERIFY FSI) (EQUAL? FSI (CONVERT 'SET SI)))
          (ERROR "Set intersection failed on iteration ~D " I)))
      (LET ((FSD (SET-DIFFERENCE FS0 FS1))
            (SD (SET-DIFFERENCE S0 S1 :TEST #'EQUAL?)))
        (UNLESS (AND (VERIFY FSD) (EQUAL? FSD (CONVERT 'SET SD)))
          (ERROR "Set-difference failed on iteration ~D " I)))
      (LET ((FSD1 FSD2 (SET-DIFFERENCE-2 FS0 FS1))
            (SD1 (SET-DIFFERENCE S0 S1 :TEST #'EQUAL?))
            (SD2 (SET-DIFFERENCE S1 S0 :TEST #'EQUAL?)))
        (UNLESS (AND (VERIFY FSD1) (EQUAL? FSD1 (CONVERT 'SET SD1)))
          (ERROR "Set-difference-2 failed (fsd1) on iteration ~D " I))
        (UNLESS (AND (VERIFY FSD2) (EQUAL? FSD2 (CONVERT 'SET SD2)))
          (ERROR "Set-difference-2 failed (fsd2) on iteration ~D " I)))
      (LET ((FS0A (LESS FS0 (PICK FS0))) (FS0B (LESS FS0 (PICK FS0))))
        (UNLESS
            (EQ (COMPARE FS0A FS0B)
                (SET-COMPARE (CONVERT 'LIST FS0A) (CONVERT 'LIST FS0B)))
          (ERROR "Set compare failed (fs0) on iteration ~D: ~A, ~A" I FS0A
                 FS0B)))
      (LET ((FS1A (LESS FS1 (PICK FS1))) (FS1B (LESS FS1 (PICK FS1))))
        (UNLESS
            (EQ (COMPARE FS1A FS1B)
                (SET-COMPARE (CONVERT 'LIST FS1A) (CONVERT 'LIST FS1B)))
          (ERROR "Set compare failed (fs1) on iteration ~D" I)))
      (UNLESS
          (GMAP :AND
           (LAMBDA (X I) (AND (EQL (RANK FS0 X) I) (EQUAL? X (AT-RANK FS0 I))))
           (:SET FS0) (:INDEX 0 (SIZE FS0)))
        (ERROR "Set rank, at-rank, or iterator failed"))
      (LET ((R
             (DO ((R (RANDOM 200) (RANDOM 200))) ((NOT (CONTAINS? FS0 R)) R))))
        (UNLESS
            (= (RANK FS0 R)
               (IF (GREATER-THAN? R (GREATEST FS0))
                   (1- (SIZE FS0))
                   (DO ((R2 R (1+ R2)))
                       ((CONTAINS? FS0 R2) (1- (RANK FS0 R2))))))
          (ERROR "Set rank of non-member failed")))
      FS0))

[fset/Code/testing.lisp:2313]
  (DEFUN TEST-MAP-OPERATIONS (I A-SET)
    (DECLARE (OPTIMIZE (SPEED 0) (SAFETY 3) (DEBUG 3)))
    (LET ((FM0 (EMPTY-MAP)) (M0 NIL) (FM1 (EMPTY-MAP)) (M1 NIL))
      (DOTIMES (J 100)
        (LET* ((R (MAKE-MY-INTEGER (RANDOM 100)))
               (V (RANDOM 3))
               (TMP (WITH FM0 R V)))
          (SETQ M0 (ALIST-ASSIGN M0 R V))
          (UNLESS (VERIFY TMP)
            (ERROR "Map verify failed on iteration ~D, adding ~A -> ~A; ~D, ~D"
                   I R V M0 TMP))
          (UNLESS (= (SIZE TMP) (LENGTH M0))
            (ERROR
             "Map size or with failed on iteration ~D, adding ~A -> ~A; ~D, ~D"
             I R V M0 TMP))
          (SETQ FM0 TMP)))
      (DOTIMES (J 100)
        (LET* ((R (MAKE-MY-INTEGER (RANDOM 100)))
               (V (RANDOM 3))
               (TMP (WITH FM1 R V)))
          (SETQ M1 (ALIST-ASSIGN M1 R V))
          (UNLESS (VERIFY TMP)
            (ERROR "Map verify failed on iteration ~D, adding ~A -> ~A; ~D, ~D"
                   I R V M1 TMP))
          (UNLESS (= (SIZE TMP) (LENGTH M1))
            (ERROR
             "Map size or with failed on iteration ~D, adding ~A -> ~A; ~D, ~D"
             I R V M1 TMP))
          (SETQ FM1 TMP)))
      (DOTIMES (J 20)
        (LET ((R (MAKE-MY-INTEGER (RANDOM 100))))
          (UNLESS (EQL (LOOKUP FM0 R) (CDR (ASSOC R M0 :TEST #'EQUAL?)))
            (ERROR "Map lookup failed (fm0) on iteration ~D: ~A, ~A, ~A" I FM0
                   M0 R))
          (LET ((TMP (LESS FM0 R)))
            (SETQ M0 (ALIST-REMOVE M0 R))
            (UNLESS (VERIFY TMP)
              (ERROR "Map verify failed (fm0) on iteration ~D, removing ~A" I
                     R))
            (UNLESS (= (SIZE TMP) (LENGTH M0))
              (ERROR
               "Map size or less failed (fm0) on iteration ~D, removing ~A: ~A, ~A"
               I R TMP M0))
            (SETQ FM0 TMP))))
      (DOTIMES (J 20)
        (LET ((R (MAKE-MY-INTEGER (RANDOM 100))))
          (UNLESS (EQL (LOOKUP FM1 R) (CDR (ASSOC R M1 :TEST #'EQUAL?)))
            (ERROR "Map lookup failed (fm1) on iteration ~D: ~A, ~A, ~A" I FM1
                   M1 R))
          (LET ((TMP (LESS FM1 R)))
            (SETQ M1 (ALIST-REMOVE M1 R))
            (UNLESS (VERIFY TMP)
              (ERROR "Map verify failed (fm1) on iteration ~D, removing ~A" I
                     R))
            (UNLESS (= (SIZE TMP) (LENGTH M1))
              (ERROR
               "Map size or less failed (fm1) on iteration ~D, removing ~A" I
               R))
            (SETQ FM1 TMP))))
      (UNLESS (DOMAIN-CONTAINS? FM0 (ARB FM0))
        (ERROR "Map arb/contains? failed (fm0) on iteration ~D" I))
      (UNLESS (DOMAIN-CONTAINS? FM1 (ARB FM1))
        (ERROR "Map arb/contains? failed (fm1) on iteration ~D" I))
      (UNLESS
          (MEMBER
           (COMPARE (LEAST FM0)
            (REDUCE
             (LAMBDA (MI1 MI2)
               (IF (< (MY-INTEGER-VALUE MI1) (MY-INTEGER-VALUE MI2))
                   MI1
                   MI2))
             (MAPCAR #'CAR M0)))
           '(:EQUAL :UNEQUAL))
        (ERROR "Map least failed on iteration ~D" I))
      (UNLESS
          (MEMBER
           (COMPARE (GREATEST FM0)
            (REDUCE
             (LAMBDA (MI1 MI2)
               (IF (> (MY-INTEGER-VALUE MI1) (MY-INTEGER-VALUE MI2))
                   MI1
                   MI2))
             (MAPCAR #'CAR M0)))
           '(:EQUAL :UNEQUAL))
        (ERROR "Map greatest failed on iteration ~D" I))
      (UNLESS (EQUAL? FM0 (CONVERT 'MAP M0))
        (ERROR "Map equal? failed (fm0) on iteration ~D" I))
      (UNLESS (EQUAL? FM1 (CONVERT 'MAP M1))
        (ERROR "Map equal? failed (fm1) on iteration ~D" I))
      (UNLESS
          (EQ (MAP-COMPARE (CONVERT 'LIST FM0) (GMAP :LIST #'CONS (:MAP FM0)))
              ':EQUAL)
        (ERROR "Map iterator failed (fm0) on iteration ~D" I))
      (UNLESS (EQUAL? FM1 (GMAP :MAP NIL (:ALIST (CONVERT 'LIST FM1))))
        (ERROR "Map iterator/accumulator failed (fm1) on iteration ~D" I))
      (UNLESS (EQ (MAP-COMPARE (CONVERT 'LIST FM0) M0) ':EQUAL)
        (ERROR "Map equal? failed (fm1) on iteration ~D" I))
      (UNLESS (EQ (MAP-COMPARE (CONVERT 'LIST FM1) M1) ':EQUAL)
        (ERROR "Map equal? failed (fm1) on iteration ~D" I))
      (LET ((FM0-DOM (DOMAIN FM0)) (FM1-DOM (DOMAIN FM1)))
        (LET ((FM0A (WITH (LESS FM0 (PICK FM0-DOM)) (PICK FM0-DOM) (RANDOM 3)))
              (FM0B (WITH (LESS FM0 (PICK FM0-DOM)) (PICK FM0-DOM) (RANDOM 3))))
          (UNLESS
              (EQ (COMPARE FM0A FM0B)
                  (MAP-COMPARE (CONVERT 'LIST FM0A) (CONVERT 'LIST FM0B)))
            (ERROR "Map compare failed (fm0) on iteration ~D" I)))
        (LET ((FM1A (WITH (LESS FM1 (PICK FM1-DOM)) (PICK FM1-DOM) (RANDOM 3)))
              (FM1B (WITH (LESS FM1 (PICK FM1-DOM)) (PICK FM1-DOM) (RANDOM 3))))
          (UNLESS
              (EQ (COMPARE FM1A FM1B)
                  (MAP-COMPARE (CONVERT 'LIST FM1A) (CONVERT 'LIST FM1B)))
            (ERROR "Map compare failed (fm1) on iteration ~D" I))))
      (LET ((FMU (MAP-UNION FM0 FM1)) (MU M0))
        (DOLIST (PR M1) (SETQ MU (ALIST-ASSIGN MU (CAR PR) (CDR PR))))
        (UNLESS (AND (VERIFY FMU) (EQUAL? FMU (CONVERT 'MAP MU)))
          (ERROR "Map union failed on iteration ~D: ~A, ~A, ~A, ~A" I MU FMU
                 FM0 FM1))
        (LET ((FMD1 FMD2 (MAP-DIFFERENCE-2 FMU FM1)))
          (UNLESS
              (AND (EQUAL? FMU (MAP-UNION (RESTRICT FM1 (DOMAIN FMU)) FMD1))
                   (EQUAL? FM1 (MAP-UNION (RESTRICT FMU (DOMAIN FM1)) FMD2)))
            (ERROR "Map difference failed on iteration ~D" I))))
      (LET ((FMI (MAP-INTERSECTION FM0 FM1)) (MI NIL))
        (DOLIST (PR M1)
          (WHEN (ASSOC (CAR PR) M0 :TEST #'EQUAL?)
            (SETQ MI (ALIST-ASSIGN MI (CAR PR) (CDR PR)))))
        (UNLESS (AND (VERIFY FMI) (EQUAL? FMI (CONVERT 'MAP MI)))
          (ERROR "Map intersection failed on iteration ~D: ~A, ~A, ~A, ~A" I MI
                 FMI FM0 FM1)))
      (LET ((FMR (RESTRICT FM0 A-SET))
            (MR (REMOVE-IF-NOT #'(LAMBDA (PR) (CONTAINS? A-SET (CAR PR))) M0)))
        (UNLESS (AND (VERIFY FMR) (EQUAL? FMR (CONVERT 'MAP MR)))
          (ERROR "Map restrict failed on iteration ~D: ~A, ~A" I FMR MR)))
      (LET ((FMR (RESTRICT-NOT FM0 A-SET))
            (MR (REMOVE-IF #'(LAMBDA (PR) (CONTAINS? A-SET (CAR PR))) M0)))
        (UNLESS (AND (VERIFY FMR) (EQUAL? FMR (CONVERT 'MAP MR)))
          (ERROR "Map restrict-not failed on iteration ~D: ~A, ~A, ~A" I FMR MR
                 FM0)))
      (UNLESS
          (GMAP :AND
           (LAMBDA (X Y I)
             (AND (EQL (RANK FM0 X) I)
                  (LET ((RX RY (AT-RANK FM0 I)))
                    (AND (EQUAL? X RX) (= Y RY)))))
           (:MAP FM0) (:INDEX 0 (SIZE FM0)))
        (ERROR "Map rank, at-rank, or iterator failed"))
      (LET ((R
             (DO ((R (RANDOM 200) (RANDOM 200)))
                 ((NOT (DOMAIN-CONTAINS? FM0 R)) R))))
        (UNLESS
            (= (RANK FM0 R)
               (IF (GREATER-THAN? R (GREATEST FM0))
                   (1- (SIZE FM0))
                   (DO ((R2 R (1+ R2)))
                       ((CONTAINS? FM0 R2) (1- (RANK FM0 R2))))))
          (ERROR "Map rank of non-member failed")))))

[fset/Code/testing.lisp:2460]
  (DEFUN TEST-BAG-OPERATIONS (I)
    (DECLARE (OPTIMIZE (SPEED 0) (SAFETY 3) (DEBUG 3)))
    (LET ((FB0 (EMPTY-BAG)) (B0 NIL) (FB1 (EMPTY-BAG)) (B1 NIL))
      (DOTIMES (J 100)
        (LET* ((R (MAKE-MY-INTEGER (RANDOM 200))) (TMP (WITH FB0 R)))
          (SETQ B0
                  (ALIST-ASSIGN B0 R
                   (1+ (OR (CDR (ASSOC R B0 :TEST #'EQUAL?)) 0))))
          (UNLESS (VERIFY TMP)
            (ERROR "Bag verify failed (fb0) on iteration ~D, adding ~A" I R))
          (UNLESS (= (SIZE TMP) (ALIST-BAG-SIZE B0))
            (ERROR
             "Bag size or with failed (fb0) on iteration ~D, adding ~A: ~D, ~D"
             I R (SIZE TMP) (ALIST-BAG-SIZE B0)))
          (UNLESS (= (SET-SIZE TMP) (LENGTH B0))
            (ERROR "Bag set-size failed (fb0) on iteration ~D" I))
          (UNLESS (AND (SUBBAG? FB0 TMP) (NOT (SUBBAG? TMP FB0)))
            (ERROR "Bag subbag? failed (fb0) on iteration ~D" I))
          (SETQ FB0 TMP)))
      (DOTIMES (J 100)
        (LET* ((R (MAKE-MY-INTEGER (RANDOM 200))) (TMP (WITH FB1 R)))
          (SETQ B1
                  (ALIST-ASSIGN B1 R
                   (1+ (OR (CDR (ASSOC R B1 :TEST #'EQUAL?)) 0))))
          (UNLESS (VERIFY TMP)
            (ERROR "Bag verify failed (fb1) on iteration ~D, adding ~A" I R))
          (UNLESS (= (SIZE TMP) (ALIST-BAG-SIZE B1))
            (ERROR
             "Bag size or with failed (fb1) on iteration ~D, adding ~A: ~D, ~D"
             I R (SIZE TMP) (ALIST-BAG-SIZE B1)))
          (UNLESS (= (SET-SIZE TMP) (LENGTH B1))
            (ERROR "Bag set-size failed (fb1) on iteration ~D" I))
          (UNLESS (AND (SUBBAG? FB1 TMP) (NOT (SUBBAG? TMP FB1)))
            (ERROR "Bag Subbag? failed (fb1) on iteration ~D" I))
          (SETQ FB1 TMP)))
      (DOTIMES (J 20)
        (LET ((R (MAKE-MY-INTEGER (RANDOM 200))))
          (UNLESS (EQV (CONTAINS? FB0 R) (ASSOC R B0 :TEST #'EQUAL?))
            (ERROR "Bag contains? failed (fb0) on iteration ~D, ~A" I R))
          (SETQ B0 (ALIST-BAG-REMOVE B0 R))
          (LET ((TMP (LESS FB0 R)))
            (UNLESS (VERIFY TMP)
              (ERROR "Bag verify failed on iteration ~D, removing ~A" I R))
            (UNLESS (= (SIZE TMP) (ALIST-BAG-SIZE B0))
              (ERROR
               "Bag size or less failed (fb0) on iteration ~D, removing ~A" I
               R))
            (SETQ FB0 TMP))))
      (DOTIMES (J 20)
        (LET ((R (MAKE-MY-INTEGER (RANDOM 200))))
          (UNLESS (EQV (CONTAINS? FB1 R) (ASSOC R B1 :TEST #'EQUAL?))
            (ERROR "Bag contains? failed (fb1) on iteration ~D" I))
          (SETQ B1 (ALIST-BAG-REMOVE B1 R))
          (LET ((TMP (LESS FB1 R)))
            (UNLESS (VERIFY TMP)
              (ERROR "Bag verify failed on iteration ~D, removing ~A" I R))
            (UNLESS (= (SIZE TMP) (ALIST-BAG-SIZE B1))
              (ERROR
               "Bag size or less failed (fb1) on iteration ~D, removing ~A" I
               R))
            (SETQ FB1 TMP))))
      (WHEN (= I 0)
        (LET ((TMP (WITH FB0 NIL)))
          (UNLESS (VERIFY TMP) (ERROR "Bag verify failed adding NIL"))
          (SETQ TMP (LESS TMP NIL))
          (UNLESS (VERIFY TMP) (ERROR "Bag verify failed removing NIL"))))
      (UNLESS (CONTAINS? FB0 (ARB FB0))
        (ERROR "Bag arb/contains? failed (fb0) on iteration ~D" I))
      (UNLESS (CONTAINS? FB1 (ARB FB1))
        (ERROR "Bag arb/contains? failed (fb1) on iteration ~D" I))
      (UNLESS
          (MEMBER
           (COMPARE (LEAST FB0)
            (REDUCE
             (LAMBDA (MI1 MI2)
               (IF (< (MY-INTEGER-VALUE MI1) (MY-INTEGER-VALUE MI2))
                   MI1
                   MI2))
             (MAPCAR #'CAR B0)))
           '(:EQUAL :UNEQUAL))
        (ERROR "Bag least failed on iteration ~D" I))
      (UNLESS
          (MEMBER
           (COMPARE (GREATEST FB0)
            (REDUCE
             (LAMBDA (MI1 MI2)
               (IF (> (MY-INTEGER-VALUE MI1) (MY-INTEGER-VALUE MI2))
                   MI1
                   MI2))
             (MAPCAR #'CAR B0)))
           '(:EQUAL :UNEQUAL))
        (ERROR "Bag greatest failed on iteration ~D" I))
      (UNLESS (EQUAL? FB0 (CONVERT 'BAG B0 :FROM-TYPE 'ALIST))
        (ERROR "Bag equal? failed (fb0) on iteration ~D" I))
      (UNLESS (EQUAL? FB1 (CONVERT 'BAG B1 :FROM-TYPE 'ALIST))
        (ERROR "Bag equal? failed (fb1) on iteration ~D" I))
      (UNLESS (EQUAL? (CONVERT 'LIST FB0) (GMAP :LIST NIL (:BAG FB0)))
        (ERROR "Bag iterator failed (fb0) on iteration ~D" I))
      (UNLESS (EQUAL? FB1 (GMAP :BAG NIL (:LIST (CONVERT 'LIST FB1))))
        (ERROR "Bag iterator/accumulator failed (fb1) on iteration ~D" I))
      (UNLESS
          (EQ
           (MAP-COMPARE (CONVERT 'ALIST FB0)
            (GMAP :LIST #'CONS (:BAG-PAIRS FB0)))
           ':EQUAL)
        (ERROR "Bag pair iterator failed (fb0) on iteration ~D" I))
      (UNLESS (EQUAL? FB1 (GMAP :BAG-PAIRS NIL (:ALIST (CONVERT 'ALIST FB1))))
        (ERROR "Bag pair iterator/accumulator failed (fb1) on iteration ~D" I))
      (LET ((FBU (UNION FB0 FB1)) (BU (ALIST-BAG-UNION B0 B1)))
        (UNLESS
            (AND (VERIFY FBU) (EQUAL? FBU (CONVERT 'BAG BU :FROM-TYPE 'ALIST)))
          (ERROR "Bag union failed on iteration ~D " I)))
      (LET ((FBI (INTERSECTION FB0 FB1)) (BI (ALIST-BAG-INTERSECTION B0 B1)))
        (UNLESS
            (AND (VERIFY FBI) (EQUAL? FBI (CONVERT 'BAG BI :FROM-TYPE 'ALIST)))
          (ERROR "Bag intersection failed on iteration ~D " I)))
      (LET ((FBD (BAG-DIFFERENCE FB0 FB1)) (BD (ALIST-BAG-DIFFERENCE B0 B1)))
        (UNLESS
            (AND (VERIFY FBD) (EQUAL? FBD (CONVERT 'BAG BD :FROM-TYPE 'ALIST)))
          (ERROR "Bag-difference failed on iteration ~D " I)))
      (LET ((FBS (BAG-SUM FB0 FB1)) (BS (ALIST-BAG-SUM B0 B1)))
        (UNLESS
            (AND (VERIFY FBS) (EQUAL? FBS (CONVERT 'BAG BS :FROM-TYPE 'ALIST)))
          (ERROR "Bag-sum failed on iteration ~D " I)))
      (LET ((FBP (BAG-PRODUCT FB0 FB1)) (BP (ALIST-BAG-PRODUCT B0 B1)))
        (UNLESS
            (AND (VERIFY FBP) (EQUAL? FBP (CONVERT 'BAG BP :FROM-TYPE 'ALIST)))
          (ERROR "Bag-product failed on iteration ~D " I)))
      (LET ((FB0A (LESS FB0 (PICK FB0))) (FB0B (LESS FB0 (PICK FB0))))
        (UNLESS
            (EQ (COMPARE FB0A FB0B)
                (MAP-COMPARE (CONVERT 'ALIST FB0A) (CONVERT 'ALIST FB0B)))
          (ERROR "Compare failed (fb0) on iteration ~D: ~A, ~A" I FB0A FB0B)))
      (LET ((FB1A (LESS FB1 (PICK FB1))) (FB1B (LESS FB1 (PICK FB1))))
        (UNLESS
            (EQ (COMPARE FB1A FB1B)
                (MAP-COMPARE (CONVERT 'ALIST FB1A) (CONVERT 'ALIST FB1B)))
          (ERROR "Compare failed (fb1) on iteration ~D" I)))
      (UNLESS
          (GMAP :AND
           (LAMBDA (X N I)
             (AND (EQL (RANK FB0 X) I)
                  (LET ((RX RN (AT-RANK FB0 I)))
                    (AND (EQUAL? X RX) (= N RN)))))
           (:BAG-PAIRS FB0) (:INDEX 0 (SIZE FB0)))
        (ERROR "Bag rank, at-rank, or iterator failed"))
      (LET ((R
             (DO ((R (RANDOM 200) (RANDOM 200))) ((NOT (CONTAINS? FB0 R)) R))))
        (UNLESS
            (= (RANK FB0 R)
               (IF (GREATER-THAN? R (GREATEST FB0))
                   (1- (SET-SIZE FB0))
                   (DO ((R2 R (1+ R2)))
                       ((CONTAINS? FB0 R2) (1- (RANK FB0 R2))))))
          (ERROR "Bag rank of non-member failed")))
      FB0))

[fset/Code/tuples.lisp:500]
  (DEFMETHOD INTERNAL-DO-TUPLE ((TUP TUPLE) ELT-FN VALUE-FN)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE FUNCTION ELT-FN VALUE-FN))
    (DO-TUPLE-INTERNAL (X Y TUP (FUNCALL VALUE-FN)) (FUNCALL ELT-FN X Y)))

[fset/Code/wb-trees.lisp:115]
  (DEFUN SET-VALUE-SIZE (VALUE)
    "The number of members represented by `value', which can be more than 1 if
`value' is an `Equivalent-Set'."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (IF (EQUIVALENT-SET? VALUE)
        (LENGTH (EQUIVALENT-SET-MEMBERS VALUE))
        1))

[fset/Code/wb-trees.lisp:126]
  (DEFUN WB-SET-TREE-SIZE (TREE)
    "The number of members contained in this tree."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-SET-TREE TREE))
    (COND ((NULL TREE) 0) ((SIMPLE-VECTOR-P TREE) (LENGTH TREE))
          (T (WB-SET-TREE-NODE-SIZE TREE))))

[fset/Code/wb-trees.lisp:135]
  (DEFUN MAKE-WB-SET-TREE-NODE (VALUE LEFT RIGHT)
    "The low-level constructor for a set tree node."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (MAKE-RAW-WB-SET-TREE-NODE
     (THE FIXNUM
          (+ (WB-SET-TREE-SIZE LEFT) (WB-SET-TREE-SIZE RIGHT)
             (SET-VALUE-SIZE VALUE)))
     VALUE LEFT RIGHT))

[fset/Code/wb-trees.lisp:144]
  (DEFUN WB-SET-TREE-ARB (TREE)
    "Selects an arbitrary member of the set.  Assumes it is nonnull."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-SET-TREE TREE))
    (COND ((NULL TREE) (ERROR "`WB-Set-Tree-Arb' called on empty tree"))
          ((SIMPLE-VECTOR-P TREE) (SVREF TREE 0))
          (T
           (LET ((VALUE (WB-SET-TREE-NODE-VALUE TREE)))
             (IF (EQUIVALENT-SET? VALUE)
                 (CAR (EQUIVALENT-SET-MEMBERS VALUE))
                 VALUE)))))

[fset/Code/wb-trees.lisp:158]
  (DEFUN WB-SET-TREE-LEAST (TREE)
    "Assumes `tree' is nonempty.  Returns the least member, or an arbitrary
least member if there are more than one."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-SET-TREE TREE))
    (LET ((VAL (WB-SET-TREE-MINIMUM-VALUE TREE)))
      (IF (EQUIVALENT-SET? VAL)
          (CAR (EQUIVALENT-SET-MEMBERS VAL))
          VAL)))

[fset/Code/wb-trees.lisp:169]
  (DEFUN WB-SET-TREE-LESS-LEAST (TREE)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-SET-TREE TREE))
    (COND ((NULL TREE) NIL)
          ((SIMPLE-VECTOR-P TREE)
           (AND (> (LENGTH TREE) 1) (VECTOR-SUBSEQ TREE 1)))
          (T
           (LET ((LEFT (WB-SET-TREE-NODE-LEFT TREE)))
             (IF LEFT
                 (WB-SET-TREE-BUILD-NODE (WB-SET-TREE-NODE-VALUE TREE)
                  (WB-SET-TREE-LESS-LEAST LEFT) (WB-SET-TREE-NODE-RIGHT TREE))
                 (LET ((VAL (WB-SET-TREE-NODE-VALUE TREE)))
                   (IF (EQUIVALENT-SET? VAL)
                       (LET ((MEMS (EQUIVALENT-SET-MEMBERS VAL)))
                         (MAKE-WB-SET-TREE-NODE
                          (IF (= (LENGTH MEMS) 2)
                              (CADR MEMS)
                              (MAKE-EQUIVALENT-SET (CDR MEMS)))
                          NIL (WB-SET-TREE-NODE-RIGHT TREE)))
                       (WB-SET-TREE-NODE-RIGHT TREE))))))))

[fset/Code/wb-trees.lisp:192]
  (DEFUN WB-SET-TREE-GREATEST (TREE)
    "Assumes `tree' is nonempty.  Returns the greatest member, or an arbitrary
greatest member if there are more than one."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-SET-TREE TREE))
    (IF (SIMPLE-VECTOR-P TREE)
        (SVREF TREE (1- (LENGTH TREE)))
        (LET ((RIGHT (WB-SET-TREE-NODE-RIGHT TREE)))
          (IF RIGHT
              (WB-SET-TREE-GREATEST RIGHT)
              (LET ((VAL (WB-SET-TREE-NODE-VALUE TREE)))
                (IF (EQUIVALENT-SET? VAL)
                    (CAR (LAST (EQUIVALENT-SET-MEMBERS VAL)))
                    VAL))))))

[fset/Code/wb-trees.lisp:207]
  (DEFUN WB-SET-TREE-MEMBER? (TREE VALUE)
    "Returns true iff `value' is a member of `tree'."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-SET-TREE TREE))
    (COND ((NULL TREE) NIL)
          ((SIMPLE-VECTOR-P TREE)
           (EQ (VECTOR-SET-BINARY-SEARCH TREE VALUE) ':EQUAL))
          (T
           (LET ((NODE-VAL (WB-SET-TREE-NODE-VALUE TREE))
                 ((COMP (COMPARE VALUE NODE-VAL))))
             (ECASE COMP
               (:EQUAL T)
               ((:UNEQUAL)
                (AND (EQUIVALENT-SET? NODE-VAL)
                     (MEMBER VALUE (EQUIVALENT-SET-MEMBERS NODE-VAL) :TEST
                             #'EQUAL?)))
               ((:LESS)
                (WB-SET-TREE-MEMBER? (WB-SET-TREE-NODE-LEFT TREE) VALUE))
               ((:GREATER)
                (WB-SET-TREE-MEMBER? (WB-SET-TREE-NODE-RIGHT TREE) VALUE)))))))

[fset/Code/wb-trees.lisp:227]
  (DEFUN WB-SET-TREE-MEMBER?-CFN (TREE VALUE CFN)
    "Returns true iff `value' is a member of `tree'."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-SET-TREE TREE)
             (TYPE FUNCTION CFN))
    (COND ((NULL TREE) NIL)
          ((SIMPLE-VECTOR-P TREE)
           (EQ (VECTOR-SET-BINARY-SEARCH-CFN TREE VALUE CFN) ':EQUAL))
          (T
           (LET ((NODE-VAL (WB-SET-TREE-NODE-VALUE TREE))
                 ((COMP (FUNCALL CFN VALUE NODE-VAL))))
             (ECASE COMP
               (:EQUAL T)
               ((:UNEQUAL)
                (AND (EQUIVALENT-SET? NODE-VAL)
                     (MEMBER VALUE (EQUIVALENT-SET-MEMBERS NODE-VAL) :TEST
                             #'EQUAL?)))
               ((:LESS)
                (WB-SET-TREE-MEMBER? (WB-SET-TREE-NODE-LEFT TREE) VALUE))
               ((:GREATER)
                (WB-SET-TREE-MEMBER? (WB-SET-TREE-NODE-RIGHT TREE) VALUE)))))))

[fset/Code/wb-trees.lisp:248]
  (DEFUN WB-SET-TREE-FIND-EQUIVALENT (TREE VALUE)
    "If `tree' contains one or more values equivalent to `value', returns (first
value) true and (second value) either the one value or an `Equivalent-Set'
containing the values; otherwise `nil'."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-SET-TREE TREE))
    (COND ((NULL TREE) NIL)
          ((SIMPLE-VECTOR-P TREE)
           (LET ((FOUND? IDX (VECTOR-SET-BINARY-SEARCH TREE VALUE)))
             (AND FOUND? (VALUES T (SVREF TREE IDX)))))
          (T
           (LET ((NODE-VAL (WB-SET-TREE-NODE-VALUE TREE))
                 ((COMP (COMPARE VALUE NODE-VAL))))
             (ECASE COMP
               ((:EQUAL :UNEQUAL) (VALUES T NODE-VAL))
               ((:LESS)
                (WB-SET-TREE-FIND-EQUIVALENT (WB-SET-TREE-NODE-LEFT TREE)
                 VALUE))
               ((:GREATER)
                (WB-SET-TREE-FIND-EQUIVALENT (WB-SET-TREE-NODE-RIGHT TREE)
                 VALUE)))))))

[fset/Code/wb-trees.lisp:270]
  (DEFUN WB-SET-TREE-FIND-EQUAL (TREE VALUE)
    "If `tree' contains a value equal to `value', returns (first value) true and
(second value) the value; otherwise `nil'."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-SET-TREE TREE))
    (COND ((NULL TREE) NIL)
          ((SIMPLE-VECTOR-P TREE)
           (LET ((FOUND? IDX (VECTOR-SET-BINARY-SEARCH TREE VALUE)))
             (AND FOUND?
                  (LET ((V (SVREF TREE IDX)))
                    (AND (EQUAL? V VALUE) (VALUES T (SVREF TREE IDX)))))))
          (T
           (LET ((NODE-VAL (WB-SET-TREE-NODE-VALUE TREE))
                 ((COMP (COMPARE VALUE NODE-VAL))))
             (ECASE COMP
               ((:EQUAL :UNEQUAL)
                (IF (EQUIVALENT-SET? NODE-VAL)
                    (LET ((V
                           (FIND VALUE (EQUIVALENT-SET-MEMBERS NODE-VAL) :TEST
                                 #'EQUAL?)))
                      (AND V (VALUES T V)))
                    (VALUES T NODE-VAL)))
               ((:LESS)
                (WB-SET-TREE-FIND-EQUAL (WB-SET-TREE-NODE-LEFT TREE) VALUE))
               ((:GREATER)
                (WB-SET-TREE-FIND-EQUAL (WB-SET-TREE-NODE-RIGHT TREE)
                 VALUE)))))))

[fset/Code/wb-trees.lisp:327]
  (DEFUN WB-SET-TREE-WITH (TREE VALUE)
    "If `value' is in `tree', returns `tree'; otherwise returns `tree' with
`value' added.  `value' may be an `Equivalent-Set'."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-SET-TREE TREE))
    (COND
     ((NULL TREE)
      (IF (NOT (EQUIVALENT-SET? VALUE))
          (VECTOR VALUE)
          (MAKE-WB-SET-TREE-NODE VALUE NIL NIL)))
     ((SIMPLE-VECTOR-P TREE)
      (LET ((FOUND? IDX (VECTOR-SET-BINARY-SEARCH TREE VALUE))
            ((RIGHT-START
              (IF FOUND?
                  (1+ IDX)
                  IDX))))
        (IF (AND (EQ FOUND? ':EQUAL) (NOT (EQUIVALENT-SET? VALUE)))
            TREE
            (IF (AND (NOT FOUND?) (< (LENGTH TREE) *WB-TREE-MAX-VECTOR-LENGTH*)
                     (NOT (EQUIVALENT-SET? VALUE)))
                (VECTOR-INSERT TREE IDX VALUE)
                (MAKE-WB-SET-TREE-NODE
                 (IF FOUND?
                     (EQUIVALENT-SET-UNION (SVREF TREE IDX) VALUE)
                     VALUE)
                 (AND (> IDX 0) (VECTOR-SUBSEQ TREE 0 IDX))
                 (AND (< RIGHT-START (LENGTH TREE))
                      (VECTOR-SUBSEQ TREE RIGHT-START)))))))
     (T
      (LET ((NODE-VAL (WB-SET-TREE-NODE-VALUE TREE))
            ((COMP (COMPARE VALUE NODE-VAL))))
        (ECASE COMP
          ((:EQUAL :UNEQUAL)
           (IF (AND (NOT (EQUIVALENT-SET? NODE-VAL))
                    (NOT (EQUIVALENT-SET? VALUE)) (EQ COMP ':EQUAL))
               TREE
               (MAKE-WB-SET-TREE-NODE (EQUIVALENT-SET-UNION NODE-VAL VALUE)
                (WB-SET-TREE-NODE-LEFT TREE) (WB-SET-TREE-NODE-RIGHT TREE))))
          ((:LESS)
           (LET ((LEFT (WB-SET-TREE-NODE-LEFT TREE))
                 ((NEW-LEFT (WB-SET-TREE-WITH LEFT VALUE))))
             (IF (EQ NEW-LEFT LEFT)
                 TREE
                 (WB-SET-TREE-BUILD-NODE NODE-VAL NEW-LEFT
                  (WB-SET-TREE-NODE-RIGHT TREE)))))
          ((:GREATER)
           (LET ((RIGHT (WB-SET-TREE-NODE-RIGHT TREE))
                 ((NEW-RIGHT (WB-SET-TREE-WITH RIGHT VALUE))))
             (IF (EQ NEW-RIGHT RIGHT)
                 TREE
                 (WB-SET-TREE-BUILD-NODE NODE-VAL (WB-SET-TREE-NODE-LEFT TREE)
                  NEW-RIGHT)))))))))

[fset/Code/wb-trees.lisp:385]
  (DEFUN VECTOR-INSERT (VEC IDX VAL)
    "Returns a new vector like `vec' but with `val' inserted at `idx'.  Careful --
does no bounds checking on `vec', which it assumes is simple."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE SIMPLE-VECTOR VEC)
             (TYPE FIXNUM IDX))
    (LET ((LEN (LENGTH VEC)) ((NEW-VEC (MAKE-ARRAY (1+ LEN)))))
      (DOTIMES (I IDX) (SETF (SVREF NEW-VEC I) (SVREF VEC I)))
      (SETF (SVREF NEW-VEC IDX) VAL)
      (DOTIMES (I (- LEN IDX))
        (SETF (SVREF NEW-VEC (+ IDX I 1)) (SVREF VEC (+ IDX I))))
      NEW-VEC))

[fset/Code/wb-trees.lisp:402]
  (DEFUN VECTOR-SUBSEQ (VEC START &OPTIONAL (END (LENGTH VEC)))
    "Returns a subsequence of `vec' between `start' and `end', or `nil' if
the result would be of zero length.  Careful -- does no bounds checking
on `vec', which it assumes is simple."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE SIMPLE-VECTOR VEC)
             (TYPE FIXNUM START END))
    (AND (> END START)
         (LET ((LEN (- END START)) ((NEW-VEC (MAKE-ARRAY LEN))))
           (DOTIMES (I LEN) (SETF (SVREF NEW-VEC I) (SVREF VEC (+ I START))))
           NEW-VEC)))

[fset/Code/wb-trees.lisp:422]
  (DEFUN WB-SET-TREE-LESS (TREE VALUE)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-SET-TREE TREE))
    (COND ((NULL TREE) NIL)
          ((SIMPLE-VECTOR-P TREE)
           (LET ((FOUND? IDX (VECTOR-SET-BINARY-SEARCH TREE VALUE)))
             (IF (EQ FOUND? ':EQUAL)
                 (AND (> (LENGTH TREE) 1) (VECTOR-REMOVE-AT TREE IDX))
                 TREE)))
          (T
           (LET ((NODE-VAL (WB-SET-TREE-NODE-VALUE TREE))
                 ((COMP (COMPARE VALUE NODE-VAL))))
             (ECASE COMP
               ((:EQUAL :UNEQUAL)
                (IF (NOT (EQUIVALENT-SET? NODE-VAL))
                    (IF (EQ COMP ':UNEQUAL)
                        TREE
                        (WB-SET-TREE-JOIN (WB-SET-TREE-NODE-LEFT TREE)
                         (WB-SET-TREE-NODE-RIGHT TREE)))
                    (LET ((IGNORE
                           DIFF
                           (EQUIVALENT-SET-DIFFERENCE NODE-VAL VALUE)))
                      (DECLARE (IGNORE IGNORE))
                      (WB-SET-TREE-BUILD-NODE DIFF (WB-SET-TREE-NODE-LEFT TREE)
                       (WB-SET-TREE-NODE-RIGHT TREE)))))
               ((:LESS)
                (LET ((LEFT (WB-SET-TREE-NODE-LEFT TREE))
                      ((NEW-LEFT (WB-SET-TREE-LESS LEFT VALUE))))
                  (IF (EQ NEW-LEFT LEFT)
                      TREE
                      (WB-SET-TREE-BUILD-NODE NODE-VAL NEW-LEFT
                       (WB-SET-TREE-NODE-RIGHT TREE)))))
               ((:GREATER)
                (LET ((RIGHT (WB-SET-TREE-NODE-RIGHT TREE))
                      ((NEW-RIGHT (WB-SET-TREE-LESS RIGHT VALUE))))
                  (IF (EQ NEW-RIGHT RIGHT)
                      TREE
                      (WB-SET-TREE-BUILD-NODE NODE-VAL
                       (WB-SET-TREE-NODE-LEFT TREE) NEW-RIGHT)))))))))

[fset/Code/wb-trees.lisp:461]
  (DEFUN VECTOR-REMOVE-AT (VEC IDX)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE SIMPLE-VECTOR VEC)
             (TYPE FIXNUM IDX))
    (LET ((LEN (LENGTH VEC)))
      (AND (> LEN 0)
           (LET ((NEW-VEC (MAKE-ARRAY (1- LEN))))
             (DOTIMES (I IDX) (SETF (SVREF NEW-VEC I) (SVREF VEC I)))
             (DOTIMES (I (- LEN IDX 1))
               (SETF (SVREF NEW-VEC (+ IDX I)) (SVREF VEC (+ IDX I 1))))
             NEW-VEC))))

[fset/Code/wb-trees.lisp:507]
  (DEFUN WB-SET-TREE-UNION-RNG (TREE1 TREE2 LO HI)
    "Returns the union of `tree1' with `tree2', considering only those members
that are above `lo' and below `hi', and assuming that the root values of `tree1'
and `tree2' are in this range."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-SET-TREE TREE1 TREE2))
    (COND ((EQ TREE1 TREE2) (WB-SET-TREE-SPLIT TREE1 LO HI))
          ((NULL TREE2) (WB-SET-TREE-SPLIT TREE1 LO HI))
          ((NULL TREE1) (WB-SET-TREE-SPLIT TREE2 LO HI))
          ((AND (SIMPLE-VECTOR-P TREE1) (SIMPLE-VECTOR-P TREE2))
           (WB-SET-TREE-VECTOR-UNION TREE1 TREE2 LO HI))
          ((SIMPLE-VECTOR-P TREE1) (WB-SET-TREE-UNION-RNG TREE2 TREE1 LO HI))
          (T
           (LET ((VAL1 (WB-SET-TREE-NODE-VALUE TREE1))
                 ((EQVV2? EQVV2 (WB-SET-TREE-FIND-EQUIVALENT TREE2 VAL1))))
             (WB-SET-TREE-CONCAT
              (IF EQVV2?
                  (EQUIVALENT-SET-UNION VAL1 EQVV2)
                  VAL1)
              (WB-SET-TREE-UNION-RNG
               (WB-SET-TREE-TRIM (WB-SET-TREE-NODE-LEFT TREE1) LO VAL1)
               (WB-SET-TREE-TRIM TREE2 LO VAL1) LO VAL1)
              (WB-SET-TREE-UNION-RNG
               (WB-SET-TREE-TRIM (WB-SET-TREE-NODE-RIGHT TREE1) VAL1 HI)
               (WB-SET-TREE-TRIM TREE2 VAL1 HI) VAL1 HI))))))

[fset/Code/wb-trees.lisp:552]
  (DEFUN WB-SET-TREE-INTERSECT-RNG (TREE1 TREE2 LO HI)
    "Returns the intersection of `tree1' with `tree2', considering only those
members that are above `lo' and below `hi', and assuming that the root values
of `tree1' and `tree2' are in this range."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-SET-TREE TREE1 TREE2))
    (COND ((EQ TREE1 TREE2) (WB-SET-TREE-SPLIT TREE1 LO HI))
          ((OR (NULL TREE1) (NULL TREE2)) NIL)
          ((AND (SIMPLE-VECTOR-P TREE1) (SIMPLE-VECTOR-P TREE2))
           (VECTOR-SET-INTERSECT TREE1 TREE2 LO HI))
          ((SIMPLE-VECTOR-P TREE1)
           (WB-SET-TREE-INTERSECT-RNG (WB-SET-TREE-TRIM TREE2 LO HI) TREE1 LO
            HI))
          (T
           (LET ((VAL1 (WB-SET-TREE-NODE-VALUE TREE1))
                 ((NEW-LEFT
                   (WB-SET-TREE-INTERSECT-RNG (WB-SET-TREE-NODE-LEFT TREE1)
                    (WB-SET-TREE-TRIM TREE2 LO VAL1) LO VAL1))
                  (NEW-RIGHT
                   (WB-SET-TREE-INTERSECT-RNG (WB-SET-TREE-NODE-RIGHT TREE1)
                    (WB-SET-TREE-TRIM TREE2 VAL1 HI) VAL1 HI)))
                 ((EQVV2? EQVV2 (WB-SET-TREE-FIND-EQUIVALENT TREE2 VAL1))
                  ((NONNULL? ISECT
                    (AND EQVV2? (EQUIVALENT-SET-INTERSECT VAL1 EQVV2))))))
             (IF NONNULL?
                 (WB-SET-TREE-CONCAT ISECT NEW-LEFT NEW-RIGHT)
                 (WB-SET-TREE-JOIN NEW-LEFT NEW-RIGHT))))))

[fset/Code/wb-trees.lisp:590]
  (DEFUN WB-SET-TREE-DIFF-RNG (TREE1 TREE2 LO HI)
    "Returns the set difference of `tree1' less `tree2', considering only those
members that are above `lo' and below `hi', and assuming that the root values
of `tree1' and `tree2' are in this range."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-SET-TREE TREE1 TREE2))
    (COND ((EQ TREE1 TREE2) NIL) ((NULL TREE1) NIL)
          ((NULL TREE2) (WB-SET-TREE-SPLIT TREE1 LO HI))
          ((AND (SIMPLE-VECTOR-P TREE1) (SIMPLE-VECTOR-P TREE2))
           (VECTOR-SET-DIFF TREE1 TREE2 LO HI))
          ((SIMPLE-VECTOR-P TREE1)
           (LET ((VAL2 (WB-SET-TREE-NODE-VALUE TREE2))
                 ((NEW-LEFT
                   (WB-SET-TREE-DIFF-RNG (WB-SET-TREE-TRIM TREE1 LO VAL2)
                    (WB-SET-TREE-TRIM (WB-SET-TREE-NODE-LEFT TREE2) LO VAL2) LO
                    VAL2))
                  (NEW-RIGHT
                   (WB-SET-TREE-DIFF-RNG (WB-SET-TREE-TRIM TREE1 VAL2 HI)
                    (WB-SET-TREE-TRIM (WB-SET-TREE-NODE-RIGHT TREE2) VAL2 HI)
                    VAL2 HI)))
                 ((EQVV1? EQVV1 (WB-SET-TREE-FIND-EQUIVALENT TREE1 VAL2))
                  ((NONNULL? DIFF
                    (AND EQVV1? (EQUIVALENT-SET-DIFFERENCE EQVV1 VAL2))))))
             (IF NONNULL?
                 (WB-SET-TREE-CONCAT DIFF NEW-LEFT NEW-RIGHT)
                 (WB-SET-TREE-JOIN NEW-LEFT NEW-RIGHT))))
          (T
           (LET ((VAL1 (WB-SET-TREE-NODE-VALUE TREE1))
                 ((NEW-LEFT
                   (WB-SET-TREE-DIFF-RNG (WB-SET-TREE-NODE-LEFT TREE1)
                    (WB-SET-TREE-TRIM TREE2 LO VAL1) LO VAL1))
                  (NEW-RIGHT
                   (WB-SET-TREE-DIFF-RNG (WB-SET-TREE-NODE-RIGHT TREE1)
                    (WB-SET-TREE-TRIM TREE2 VAL1 HI) VAL1 HI)))
                 ((EQVV2? EQVV2 (WB-SET-TREE-FIND-EQUIVALENT TREE2 VAL1))
                  ((NONNULL? DIFF
                    (IF EQVV2?
                        (EQUIVALENT-SET-DIFFERENCE VAL1 EQVV2)
                        (VALUES T VAL1))))))
             (IF NONNULL?
                 (WB-SET-TREE-CONCAT DIFF NEW-LEFT NEW-RIGHT)
                 (WB-SET-TREE-JOIN NEW-LEFT NEW-RIGHT))))))

[fset/Code/wb-trees.lisp:643]
  (DEFUN WB-SET-TREE-DIFF-2-RNG (TREE1 TREE2 LO HI)
    "Returns two values: the set difference of `tree1' less `tree2', and that of
`tree2' less `tree1', considering only those members that are above `lo' and
below `hi', and assuming that the root values of `tree1' and `tree2' are in
this range."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-SET-TREE TREE1 TREE2))
    (COND ((EQ TREE1 TREE2) (VALUES NIL NIL))
          ((OR (NULL TREE1) (NULL TREE2))
           (VALUES (WB-SET-TREE-SPLIT TREE1 LO HI)
                   (WB-SET-TREE-SPLIT TREE2 LO HI)))
          ((AND (SIMPLE-VECTOR-P TREE1) (SIMPLE-VECTOR-P TREE2))
           (VECTOR-SET-DIFF-2 TREE1 TREE2 LO HI))
          ((SIMPLE-VECTOR-P TREE1)
           (LET ((VAL2 (WB-SET-TREE-NODE-VALUE TREE2))
                 ((NEW-LEFT-1 NEW-LEFT-2
                   (WB-SET-TREE-DIFF-2-RNG (WB-SET-TREE-TRIM TREE1 LO VAL2)
                    (WB-SET-TREE-TRIM (WB-SET-TREE-NODE-LEFT TREE2) LO VAL2) LO
                    VAL2))
                  (NEW-RIGHT-1 NEW-RIGHT-2
                   (WB-SET-TREE-DIFF-2-RNG (WB-SET-TREE-TRIM TREE1 VAL2 HI)
                    (WB-SET-TREE-TRIM (WB-SET-TREE-NODE-RIGHT TREE2) VAL2 HI)
                    VAL2 HI)))
                 ((EQVV1? EQVV1 (WB-SET-TREE-FIND-EQUIVALENT TREE1 VAL2))
                  ((NONNULL1? DIFF1
                    (AND EQVV1? (EQUIVALENT-SET-DIFFERENCE EQVV1 VAL2)))
                   (NONNULL2? DIFF2
                    (IF EQVV1?
                        (EQUIVALENT-SET-DIFFERENCE VAL2 EQVV1)
                        (VALUES T VAL2))))))
             (VALUES
              (IF NONNULL1?
                  (WB-SET-TREE-CONCAT DIFF1 NEW-LEFT-1 NEW-RIGHT-1)
                  (WB-SET-TREE-JOIN NEW-LEFT-1 NEW-RIGHT-1))
              (IF NONNULL2?
                  (WB-SET-TREE-CONCAT DIFF2 NEW-LEFT-2 NEW-RIGHT-2)
                  (WB-SET-TREE-JOIN NEW-LEFT-2 NEW-RIGHT-2)))))
          (T
           (LET ((VAL1 (WB-SET-TREE-NODE-VALUE TREE1))
                 ((NEW-LEFT-1 NEW-LEFT-2
                   (WB-SET-TREE-DIFF-2-RNG (WB-SET-TREE-NODE-LEFT TREE1)
                    (WB-SET-TREE-TRIM TREE2 LO VAL1) LO VAL1))
                  (NEW-RIGHT-1 NEW-RIGHT-2
                   (WB-SET-TREE-DIFF-2-RNG (WB-SET-TREE-NODE-RIGHT TREE1)
                    (WB-SET-TREE-TRIM TREE2 VAL1 HI) VAL1 HI))
                  ((EQVV2? EQVV2 (WB-SET-TREE-FIND-EQUIVALENT TREE2 VAL1))
                   ((NONNULL1? DIFF1
                     (IF EQVV2?
                         (EQUIVALENT-SET-DIFFERENCE VAL1 EQVV2)
                         (VALUES T VAL1)))
                    (NONNULL2? DIFF2
                     (AND EQVV2? (EQUIVALENT-SET-DIFFERENCE EQVV2 VAL1)))))))
             (VALUES
              (IF NONNULL1?
                  (WB-SET-TREE-CONCAT DIFF1 NEW-LEFT-1 NEW-RIGHT-1)
                  (WB-SET-TREE-JOIN NEW-LEFT-1 NEW-RIGHT-1))
              (IF NONNULL2?
                  (WB-SET-TREE-CONCAT DIFF2 NEW-LEFT-2 NEW-RIGHT-2)
                  (WB-SET-TREE-JOIN NEW-LEFT-2 NEW-RIGHT-2)))))))

[fset/Code/wb-trees.lisp:716]
  (DEFUN WB-SET-TREE-COMPARE-RNG (TREE1 BASE1 TREE2 BASE2 LO HI)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-SET-TREE TREE1 TREE2)
             (TYPE FIXNUM BASE1 BASE2 LO HI))
    (COND ((AND (EQ TREE1 TREE2) (= BASE1 BASE2)) ':EQUAL) ((= LO HI) ':EQUAL)
          ((AND (SIMPLE-VECTOR-P TREE1) (SIMPLE-VECTOR-P TREE2))
           (LET ((UNEQUAL? NIL))
             (OR
              (GMAP :OR
               #'(LAMBDA (VAL1 VAL2)
                   (LET ((COMP (COMPARE VAL1 VAL2)))
                     (WHEN (EQ COMP ':UNEQUAL) (SETQ UNEQUAL? T))
                     (AND (OR (EQ COMP ':LESS) (EQ COMP ':GREATER)) COMP)))
               (:SIMPLE-VECTOR TREE1 :START (- LO BASE1) :STOP (- HI BASE1))
               (:SIMPLE-VECTOR TREE2 :START (- LO BASE2) :STOP (- HI BASE2)))
              (IF UNEQUAL?
                  ':UNEQUAL
                  ':EQUAL))))
          ((SIMPLE-VECTOR-P TREE1)
           (LET ((REV-COMP
                  (WB-SET-TREE-COMPARE-RNG TREE2 BASE2 TREE1 BASE1 LO HI)))
             (ECASE REV-COMP
               (:LESS ':GREATER)
               (:GREATER ':LESS)
               ((:EQUAL :UNEQUAL) REV-COMP))))
          (T
           (LET ((LEFT1 (WB-SET-TREE-NODE-LEFT TREE1))
                 ((LEFT1-SIZE (WB-SET-TREE-SIZE LEFT1))
                  ((NEW-HI (THE FIXNUM (+ BASE1 LEFT1-SIZE)))
                   ((LEFT1A BASE1A
                     (WB-SET-TREE-RANK-TRIM LEFT1 BASE1 LO NEW-HI))
                    (TREE2A BASE2A
                     (WB-SET-TREE-RANK-TRIM TREE2 BASE2 LO NEW-HI))
                    ((LEFT-COMP
                      (WB-SET-TREE-COMPARE-RNG LEFT1A BASE1A TREE2A BASE2A LO
                       NEW-HI)))))))
             (IF (OR (EQ LEFT-COMP ':LESS) (EQ LEFT-COMP ':GREATER))
                 LEFT-COMP
                 (LET ((VAL1 (WB-SET-TREE-NODE-VALUE TREE1))
                       (VAL2
                        (WB-SET-TREE-RANK-ELEMENT-INTERNAL TREE2
                         (THE FIXNUM (- NEW-HI BASE2))))
                       ((VAL-COMP (EQUIVALENT-SET-COMPARE VAL1 VAL2))))
                   (IF (OR (EQ VAL-COMP ':LESS) (EQ VAL-COMP ':GREATER))
                       VAL-COMP
                       (LET ((VAL1-SIZE (SET-VALUE-SIZE VAL1))
                             ((NEW-LO
                               (THE FIXNUM (+ BASE1 LEFT1-SIZE VAL1-SIZE)))
                              ((RIGHT1A BASE1A
                                (WB-SET-TREE-RANK-TRIM
                                 (WB-SET-TREE-NODE-RIGHT TREE1) NEW-LO NEW-LO
                                 HI))
                               (TREE2A BASE2A
                                (WB-SET-TREE-RANK-TRIM TREE2 BASE2 NEW-LO HI))
                               ((RIGHT-COMP
                                 (WB-SET-TREE-COMPARE-RNG RIGHT1A BASE1A TREE2A
                                  BASE2A NEW-LO HI))))))
                         (IF (NOT (EQ RIGHT-COMP ':EQUAL))
                             RIGHT-COMP
                             (IF (EQ LEFT-COMP ':UNEQUAL)
                                 ':UNEQUAL
                                 VAL-COMP))))))))))

[fset/Code/wb-trees.lisp:775]
  (DEFUN WB-SET-TREE-RANK-TRIM (TREE BASE LO HI)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-SET-TREE TREE)
             (TYPE FIXNUM BASE LO HI)
             (VALUES WB-SET-TREE FIXNUM))
    (IF (OR (NULL TREE) (SIMPLE-VECTOR-P TREE))
        (VALUES TREE BASE)
        (LET ((NODE-RANK
               (+ BASE (WB-SET-TREE-SIZE (WB-SET-TREE-NODE-LEFT TREE)))))
          (DECLARE (TYPE FIXNUM NODE-RANK))
          (IF (>= NODE-RANK LO)
              (IF (< NODE-RANK HI)
                  (VALUES TREE BASE)
                  (WB-SET-TREE-RANK-TRIM (WB-SET-TREE-NODE-LEFT TREE) BASE LO
                   HI))
              (WB-SET-TREE-RANK-TRIM (WB-SET-TREE-NODE-RIGHT TREE)
               (+ NODE-RANK (SET-VALUE-SIZE (WB-SET-TREE-NODE-VALUE TREE))) LO
               HI)))))

[fset/Code/wb-trees.lisp:835]
  (DEFUN WB-SET-TREE-RANK-ELEMENT-INTERNAL (TREE RANK)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-SET-TREE TREE)
             (TYPE FIXNUM RANK))
    (COND ((NULL TREE) (ERROR "Bug in set comparator"))
          ((SIMPLE-VECTOR-P TREE) (VALUES (SVREF TREE RANK) 0))
          (T
           (LET ((LEFT (WB-SET-TREE-NODE-LEFT TREE))
                 ((LEFT-SIZE (WB-SET-TREE-SIZE LEFT))))
             (IF (< RANK LEFT-SIZE)
                 (WB-SET-TREE-RANK-ELEMENT-INTERNAL LEFT RANK)
                 (LET ((VAL (WB-SET-TREE-NODE-VALUE TREE))
                       ((VAL-SIZE (SET-VALUE-SIZE VAL))
                        (RANK (- RANK LEFT-SIZE))))
                   (DECLARE (TYPE FIXNUM RANK))
                   (IF (< RANK VAL-SIZE)
                       (VALUES VAL RANK)
                       (WB-SET-TREE-RANK-ELEMENT-INTERNAL
                        (WB-SET-TREE-NODE-RIGHT TREE) (- RANK VAL-SIZE)))))))))

[fset/Code/wb-trees.lisp:869]
  (DEFUN WB-SET-TREE-SUBSET?-RNG (TREE1 TREE2 LO HI)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-SET-TREE TREE1 TREE2))
    (COND ((EQ TREE1 TREE2) T) ((NULL TREE1) T)
          ((AND (SIMPLE-VECTOR-P TREE1)
                (OR (NULL TREE2) (SIMPLE-VECTOR-P TREE2)))
           (VECTOR-SET-SUBSET? TREE1 TREE2 LO HI))
          ((SIMPLE-VECTOR-P TREE1)
           (LET ((VAL2 (WB-SET-TREE-NODE-VALUE TREE2)))
             (AND
              (WB-SET-TREE-SUBSET?-RNG (WB-SET-TREE-TRIM TREE1 LO VAL2)
               (WB-SET-TREE-NODE-LEFT TREE2) LO VAL2)
              (LET ((EQVV1? EQVV1 (WB-SET-TREE-FIND-EQUIVALENT TREE1 VAL2)))
                (AND (OR (NOT EQVV1?) (EQUIVALENT-SET-SUBSET? EQVV1 VAL2))
                     (WB-SET-TREE-SUBSET?-RNG (WB-SET-TREE-TRIM TREE1 VAL2 HI)
                      (WB-SET-TREE-NODE-RIGHT TREE2) VAL2 HI))))))
          (T
           (LET ((VAL1 (WB-SET-TREE-NODE-VALUE TREE1)))
             (AND
              (WB-SET-TREE-SUBSET?-RNG (WB-SET-TREE-NODE-LEFT TREE1)
               (WB-SET-TREE-TRIM TREE2 LO VAL1) LO VAL1)
              (LET ((EQVV2? EQVV2 (WB-SET-TREE-FIND-EQUIVALENT TREE2 VAL1)))
                (AND EQVV2? (EQUIVALENT-SET-SUBSET? VAL1 EQVV2)
                     (WB-SET-TREE-SUBSET?-RNG (WB-SET-TREE-NODE-RIGHT TREE1)
                      (WB-SET-TREE-TRIM TREE2 VAL1 HI) VAL1 HI))))))))

[fset/Code/wb-trees.lisp:971]
  (DEFUN VECTOR-SET-BINARY-SEARCH (VEC VALUE)
    "Searches a vector set `vec' for `value'.  Returns two values, a symbol and an
index.  If `value', or a value equivalent to `value', is in `vec', the symbol
is `:equal' resp. `:unequal', and the index is the position of the value;
otherwise, the symbol is `nil' and the index is where `value' would go if it
were to be inserted."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE SIMPLE-VECTOR VEC)
             (VALUES T FIXNUM))
    (DO ((LO 0)
         (HI (1- (LENGTH VEC))))
        ((> LO HI) (VALUES NIL LO))
      (DECLARE (TYPE FIXNUM LO HI))
      (LET ((MID (ASH (THE FIXNUM (+ LO HI)) -1))
            ((VEC-VAL (SVREF VEC MID)) ((COMP (COMPARE VALUE VEC-VAL)))))
        (ECASE COMP
          ((:EQUAL :UNEQUAL) (RETURN (VALUES COMP MID)))
          (:LESS (SETQ HI (1- MID)))
          (:GREATER (SETQ LO (1+ MID)))))))

[fset/Code/wb-trees.lisp:994]
  (DEFUN VECTOR-SET-BINARY-SEARCH-CFN (VEC VALUE CFN)
    "Searches a vector set `vec' for `value'.  Returns two values, a symbol and an
index.  If `value', or a value equivalent to `value', is in `vec', the symbol
is `:equal' resp. `:unequal', and the index is the position of the value;
otherwise, the symbol is `nil' and the index is where `value' would go if it
were to be inserted."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE SIMPLE-VECTOR VEC)
             (VALUES T FIXNUM)
             (TYPE FUNCTION CFN))
    (DO ((LO 0)
         (HI (1- (LENGTH VEC))))
        ((> LO HI) (VALUES NIL LO))
      (DECLARE (TYPE FIXNUM LO HI))
      (LET ((MID (ASH (THE FIXNUM (+ LO HI)) -1))
            ((VEC-VAL (SVREF VEC MID)) ((COMP (FUNCALL CFN VALUE VEC-VAL)))))
        (ECASE COMP
          ((:EQUAL :UNEQUAL) (RETURN (VALUES COMP MID)))
          (:LESS (SETQ HI (1- MID)))
          (:GREATER (SETQ LO (1+ MID)))))))

[fset/Code/wb-trees.lisp:1040]
  (DEFUN WB-SET-TREE-SPLIT (TREE LO HI)
    "Corresponds to Adams' `split_lt' and `split_gt'.  Returns a tree containing
those members of `tree' above `lo' and below `hi'."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-SET-TREE TREE))
    (COND ((NULL TREE) NIL)
          ((AND (EQ LO HEDGE-NEGATIVE-INFINITY)
                (EQ HI HEDGE-POSITIVE-INFINITY))
           TREE)
          ((SIMPLE-VECTOR-P TREE)
           (LET ((LEN (LENGTH TREE))
                 ((SPLIT-POINT-LO
                   (IF (EQ LO HEDGE-NEGATIVE-INFINITY)
                       0
                       (VECTOR-SET-BINARY-SEARCH-LO TREE LO)))
                  (SPLIT-POINT-HI
                   (IF (EQ HI HEDGE-POSITIVE-INFINITY)
                       LEN
                       (VECTOR-SET-BINARY-SEARCH-HI TREE HI)))))
             (AND (> SPLIT-POINT-HI SPLIT-POINT-LO)
                  (IF (AND (= SPLIT-POINT-LO 0) (= SPLIT-POINT-HI LEN))
                      TREE
                      (VECTOR-SUBSEQ TREE SPLIT-POINT-LO SPLIT-POINT-HI)))))
          ((AND (NOT (EQ LO HEDGE-NEGATIVE-INFINITY))
                (NOT (GREATER-THAN? (WB-SET-TREE-NODE-VALUE TREE) LO)))
           (WB-SET-TREE-SPLIT (WB-SET-TREE-NODE-RIGHT TREE) LO HI))
          ((AND (NOT (EQ HI HEDGE-POSITIVE-INFINITY))
                (NOT (LESS-THAN? (WB-SET-TREE-NODE-VALUE TREE) HI)))
           (WB-SET-TREE-SPLIT (WB-SET-TREE-NODE-LEFT TREE) LO HI))
          (T
           (LET ((NEW-LEFT
                  (WB-SET-TREE-SPLIT (WB-SET-TREE-NODE-LEFT TREE) LO
                   HEDGE-POSITIVE-INFINITY))
                 (NEW-RIGHT
                  (WB-SET-TREE-SPLIT (WB-SET-TREE-NODE-RIGHT TREE)
                   HEDGE-NEGATIVE-INFINITY HI)))
             (IF (AND (EQ NEW-LEFT (WB-SET-TREE-NODE-LEFT TREE))
                      (EQ NEW-RIGHT (WB-SET-TREE-NODE-RIGHT TREE)))
                 TREE
                 (WB-SET-TREE-CONCAT (WB-SET-TREE-NODE-VALUE TREE) NEW-LEFT
                  NEW-RIGHT))))))

[fset/Code/wb-trees.lisp:1078]
  (DEFUN WB-SET-TREE-TRIM (TREE LO HI)
    "Corresponds to Adams' `trim' and variants.  Removes any tree nodes whose
values are less than `lo' or greater than `hi'.  Note, this does _not_ guarantee
that the result only contains values between `lo' and `hi'; use `-Split' for
that.  This, however, doesn't cons."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-SET-TREE TREE))
    (COND ((NULL TREE) NIL)
          ((SIMPLE-VECTOR-P TREE)
           (AND
            (OR (EQ LO HEDGE-NEGATIVE-INFINITY)
                (GREATER-THAN? (SVREF TREE (1- (LENGTH TREE))) LO))
            (OR (EQ HI HEDGE-POSITIVE-INFINITY) (LESS-THAN? (SVREF TREE 0) HI))
            TREE))
          (T
           (LET ((VAL (WB-SET-TREE-NODE-VALUE TREE)))
             (IF (OR (EQ LO HEDGE-NEGATIVE-INFINITY) (GREATER-THAN? VAL LO))
                 (IF (OR (EQ HI HEDGE-POSITIVE-INFINITY) (LESS-THAN? VAL HI))
                     TREE
                     (WB-SET-TREE-TRIM (WB-SET-TREE-NODE-LEFT TREE) LO HI))
                 (WB-SET-TREE-TRIM (WB-SET-TREE-NODE-RIGHT TREE) LO HI))))))

[fset/Code/wb-trees.lisp:1103]
  (DEFUN WB-SET-TREE-CONCAT (VALUE LEFT RIGHT)
    "Corresponds to Adams' `concat3'.  Assumes that (all values in `left') <=
`value' <= (all values in `right'); returns a new tree containing all values.
This does more rebalancing than `WB-Set-Tree-Build-Node', which otherwise
has the same contract.  `value' may be an `Equivalent-Set'."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-SET-TREE LEFT RIGHT))
    (COND ((NULL LEFT) (WB-SET-TREE-WITH RIGHT VALUE))
          ((NULL RIGHT) (WB-SET-TREE-WITH LEFT VALUE))
          ((AND (WB-SET-TREE-NODE? LEFT)
                (> (WB-SET-TREE-SIZE LEFT)
                   (THE FIXNUM
                        (* (WB-SET-TREE-SIZE RIGHT) WB-TREE-BALANCE-FACTOR))))
           (WB-SET-TREE-BUILD-NODE (WB-SET-TREE-NODE-VALUE LEFT)
            (WB-SET-TREE-NODE-LEFT LEFT)
            (WB-SET-TREE-CONCAT VALUE (WB-SET-TREE-NODE-RIGHT LEFT) RIGHT)))
          ((AND (WB-SET-TREE-NODE? RIGHT)
                (> (WB-SET-TREE-SIZE RIGHT)
                   (THE FIXNUM
                        (* (WB-SET-TREE-SIZE LEFT) WB-TREE-BALANCE-FACTOR))))
           (WB-SET-TREE-BUILD-NODE (WB-SET-TREE-NODE-VALUE RIGHT)
            (WB-SET-TREE-CONCAT VALUE LEFT (WB-SET-TREE-NODE-LEFT RIGHT))
            (WB-SET-TREE-NODE-RIGHT RIGHT)))
          (T (WB-SET-TREE-BUILD-NODE VALUE LEFT RIGHT))))

[fset/Code/wb-trees.lisp:1141]
  (DEFUN WB-SET-TREE-MINIMUM-VALUE (TREE)
    "Assumes `tree' is nonempty.  Returns the minimum value.  This may be an
`Equivalent-Set'."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-SET-TREE TREE))
    (IF (SIMPLE-VECTOR-P TREE)
        (SVREF TREE 0)
        (LET ((LEFT (WB-SET-TREE-NODE-LEFT TREE)))
          (IF LEFT
              (WB-SET-TREE-MINIMUM-VALUE LEFT)
              (WB-SET-TREE-NODE-VALUE TREE)))))

[fset/Code/wb-trees.lisp:1153]
  (DEFUN WB-SET-TREE-LESS-MINIMUM (TREE)
    "Assumes `tree' is nonempty.  Returns a new tree with the minimum value
or `Equivalent-Set' removed."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-SET-TREE TREE))
    (IF (SIMPLE-VECTOR-P TREE)
        (AND (> (LENGTH TREE) 1) (VECTOR-SUBSEQ TREE 1))
        (LET ((LEFT (WB-SET-TREE-NODE-LEFT TREE)))
          (IF LEFT
              (WB-SET-TREE-CONCAT (WB-SET-TREE-NODE-VALUE TREE)
               (WB-SET-TREE-LESS-MINIMUM LEFT) (WB-SET-TREE-NODE-RIGHT TREE))
              (WB-SET-TREE-NODE-RIGHT TREE)))))

[fset/Code/wb-trees.lisp:1167]
  (DEFUN WB-SET-TREE-BUILD-NODE (VALUE LEFT RIGHT)
    "Constructs a `WB-Set-Tree', performing one rebalancing step if required.
`value' must already be known to go between `left' and `right'."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-SET-TREE LEFT RIGHT))
    (COND
     ((AND (OR (NULL LEFT) (SIMPLE-VECTOR-P LEFT))
           (OR (NULL RIGHT) (SIMPLE-VECTOR-P RIGHT)))
      (IF (AND (NOT (EQUIVALENT-SET? VALUE))
               (< (+ (LENGTH-NV LEFT) (LENGTH-NV RIGHT))
                  *WB-TREE-MAX-VECTOR-LENGTH*))
          (CONCATENATE 'SIMPLE-VECTOR LEFT (VECTOR VALUE) RIGHT)
          (MAKE-WB-SET-TREE-NODE VALUE LEFT RIGHT)))
     (T
      (LET ((SIZL (WB-SET-TREE-SIZE LEFT)) (SIZR (WB-SET-TREE-SIZE RIGHT)))
        (COND
         ((AND (WB-SET-TREE-NODE? LEFT)
               (> SIZL (THE (SIGNED-BYTE 32) (* SIZR WB-TREE-BALANCE-FACTOR))))
          (LET ((LL (WB-SET-TREE-NODE-LEFT LEFT))
                (RL (WB-SET-TREE-NODE-RIGHT LEFT)))
            (IF (OR (NULL RL) (SIMPLE-VECTOR-P RL)
                    (<= (WB-SET-TREE-SIZE RL) (WB-SET-TREE-SIZE LL)))
                (MAKE-WB-SET-TREE-NODE (WB-SET-TREE-NODE-VALUE LEFT) LL
                 (WB-SET-TREE-BUILD-NODE VALUE RL RIGHT))
                (MAKE-WB-SET-TREE-NODE (WB-SET-TREE-NODE-VALUE RL)
                 (WB-SET-TREE-BUILD-NODE (WB-SET-TREE-NODE-VALUE LEFT) LL
                  (WB-SET-TREE-NODE-LEFT RL))
                 (WB-SET-TREE-BUILD-NODE VALUE (WB-SET-TREE-NODE-RIGHT RL)
                  RIGHT)))))
         ((AND (WB-SET-TREE-NODE? RIGHT)
               (> SIZR (THE (SIGNED-BYTE 32) (* SIZL WB-TREE-BALANCE-FACTOR))))
          (LET ((LR (WB-SET-TREE-NODE-LEFT RIGHT))
                (RR (WB-SET-TREE-NODE-RIGHT RIGHT)))
            (IF (OR (NULL LR) (SIMPLE-VECTOR-P LR)
                    (<= (WB-SET-TREE-SIZE LR) (WB-SET-TREE-SIZE RR)))
                (MAKE-WB-SET-TREE-NODE (WB-SET-TREE-NODE-VALUE RIGHT)
                 (WB-SET-TREE-BUILD-NODE VALUE LEFT LR) RR)
                (MAKE-WB-SET-TREE-NODE (WB-SET-TREE-NODE-VALUE LR)
                 (WB-SET-TREE-BUILD-NODE VALUE LEFT (WB-SET-TREE-NODE-LEFT LR))
                 (WB-SET-TREE-BUILD-NODE (WB-SET-TREE-NODE-VALUE RIGHT)
                  (WB-SET-TREE-NODE-RIGHT LR) RR)))))
         (T (MAKE-WB-SET-TREE-NODE VALUE LEFT RIGHT)))))))

[fset/Code/wb-trees.lisp:1261]
  (DEFUN WB-SET-TREE-VECTOR-UNION (VEC1 VEC2 LO HI)
    "Returns the union of vectors `vec1' and `vec2', restricted to those members
above `lo' and below `hi'.  Creates new set tree nodes if needed, either
because the result exceeds the vector threshold size, or because one or more
pairs of equivalent members were found."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE SIMPLE-VECTOR VEC1 VEC2))
    (LET ((NEW-VEC ANY-EQUIVALENT? (VECTOR-SET-UNION VEC1 VEC2 LO HI)))
      (DECLARE (TYPE SIMPLE-VECTOR NEW-VEC))
      (IF ANY-EQUIVALENT?
          (REDUCE #'WB-SET-TREE-WITH NEW-VEC :INITIAL-VALUE NIL)
          (IF (> (LENGTH NEW-VEC) *WB-TREE-MAX-VECTOR-LENGTH*)
              (LET ((SPLIT-POINT (FLOOR (LENGTH NEW-VEC) 2)))
                (MAKE-WB-SET-TREE-NODE (SVREF NEW-VEC SPLIT-POINT)
                 (VECTOR-SUBSEQ NEW-VEC 0 SPLIT-POINT)
                 (VECTOR-SUBSEQ NEW-VEC (1+ SPLIT-POINT))))
              NEW-VEC))))

[fset/Code/wb-trees.lisp:1280]
  (DEFUN VECTOR-SET-UNION (VEC1 VEC2 LO HI)
    "Returns, as a vector, the union of vectors `vec1' and `vec2', restricted to
those members above `lo' and below `hi'."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE SIMPLE-VECTOR VEC1 VEC2))
    (LET ((I1 0) (I2 0) (LEN1 (LENGTH VEC1)) (LEN2 (LENGTH VEC2)))
      (DECLARE (TYPE FIXNUM I1 I2 LEN1 LEN2))
      (UNLESS (EQ LO HEDGE-NEGATIVE-INFINITY)
        (DO () ((OR (= I1 LEN1) (LESS-THAN? LO (SVREF VEC1 I1)))) (INCF I1))
        (DO () ((OR (= I2 LEN2) (LESS-THAN? LO (SVREF VEC2 I2)))) (INCF I2)))
      (UNLESS (EQ HI HEDGE-POSITIVE-INFINITY)
        (DO ()
            ((OR (= I1 LEN1) (LESS-THAN? (SVREF VEC1 (1- LEN1)) HI)))
          (DECF LEN1))
        (DO ()
            ((OR (= I2 LEN2) (LESS-THAN? (SVREF VEC2 (1- LEN2)) HI)))
          (DECF LEN2)))
      (DO ((RES NIL)
           (ANY-EQUIVALENT? NIL))
          ((AND (= I1 LEN1) (= I2 LEN2))
           (VALUES (COERCE (NREVERSE RES) 'SIMPLE-VECTOR) ANY-EQUIVALENT?))
        (COND
         ((= I1 LEN1)
          (DO () ((= I2 LEN2)) (PUSH (SVREF VEC2 I2) RES) (INCF I2)))
         ((= I2 LEN2)
          (DO () ((= I1 LEN1)) (PUSH (SVREF VEC1 I1) RES) (INCF I1)))
         (T
          (LET ((V1 (SVREF VEC1 I1))
                (V2 (SVREF VEC2 I2))
                ((COMP (COMPARE V1 V2))))
            (ECASE COMP
              ((:EQUAL) (PUSH V1 RES) (INCF I1) (INCF I2))
              ((:LESS) (PUSH V1 RES) (INCF I1))
              ((:GREATER) (PUSH V2 RES) (INCF I2))
              ((:UNEQUAL)
               (PUSH (EQUIVALENT-SET-UNION V1 V2) RES)
               (INCF I1)
               (INCF I2)
               (SETQ ANY-EQUIVALENT? T)))))))))

[fset/Code/wb-trees.lisp:1340]
  (DEFUN VECTOR-SET-INTERSECT (VEC1 VEC2 LO HI)
    "Returns, as a vector, the intersection of vectors `vec1' and `vec2', restricted
to those members above `lo' and below `hi'."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE SIMPLE-VECTOR VEC1 VEC2))
    (LET ((I1 0) (I2 0) (LEN1 (LENGTH VEC1)) (LEN2 (LENGTH VEC2)))
      (DECLARE (TYPE FIXNUM I1 I2 LEN1 LEN2))
      (UNLESS (EQ LO HEDGE-NEGATIVE-INFINITY)
        (DO () ((OR (= I1 LEN1) (LESS-THAN? LO (SVREF VEC1 I1)))) (INCF I1)))
      (UNLESS (EQ HI HEDGE-POSITIVE-INFINITY)
        (DO ()
            ((OR (= I1 LEN1) (LESS-THAN? (SVREF VEC1 (1- LEN1)) HI)))
          (DECF LEN1)))
      (DO ((RES NIL))
          ((OR (= I1 LEN1) (= I2 LEN2))
           (AND RES (COERCE (NREVERSE RES) 'SIMPLE-VECTOR)))
        (LET ((V1 (SVREF VEC1 I1))
              (V2 (SVREF VEC2 I2))
              ((COMP (COMPARE V1 V2))))
          (ECASE COMP
            ((:EQUAL) (PUSH V1 RES) (INCF I1) (INCF I2))
            ((:LESS) (INCF I1))
            ((:GREATER) (INCF I2))
            ((:UNEQUAL) (INCF I1) (INCF I2)))))))

[fset/Code/wb-trees.lisp:1375]
  (DEFUN VECTOR-SET-DIFF (VEC1 VEC2 LO HI)
    "Returns, as a vector, the set difference of vectors `vec1' less `vec2',
restricted to those members above `lo' and below `hi'."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE SIMPLE-VECTOR VEC1 VEC2))
    (LET ((I1 0) (I2 0) (LEN1 (LENGTH VEC1)) (LEN2 (LENGTH VEC2)))
      (DECLARE (TYPE FIXNUM LEN1 LEN2))
      (UNLESS (EQ LO HEDGE-NEGATIVE-INFINITY)
        (DO () ((OR (= I1 LEN1) (LESS-THAN? LO (SVREF VEC1 I1)))) (INCF I1)))
      (UNLESS (EQ HI HEDGE-POSITIVE-INFINITY)
        (DO ()
            ((OR (= I1 LEN1) (LESS-THAN? (SVREF VEC1 (1- LEN1)) HI)))
          (DECF LEN1)))
      (DO ((RES NIL))
          ((OR (= I1 LEN1) (= I2 LEN2))
           (DO () ((= I1 LEN1)) (PUSH (SVREF VEC1 I1) RES) (INCF I1))
           (AND RES (COERCE (NREVERSE RES) 'SIMPLE-VECTOR)))
        (LET ((V1 (SVREF VEC1 I1))
              (V2 (SVREF VEC2 I2))
              ((COMP (COMPARE V1 V2))))
          (ECASE COMP
            ((:EQUAL) (INCF I1) (INCF I2))
            ((:LESS) (PUSH V1 RES) (INCF I1))
            ((:GREATER) (INCF I2))
            ((:UNEQUAL) (PUSH V1 RES) (INCF I1) (INCF I2)))))))

[fset/Code/wb-trees.lisp:1414]
  (DEFUN VECTOR-SET-DIFF-2 (VEC1 VEC2 LO HI)
    "Returns, as two vector values, the set difference of vectors `str1' less `str2'
and that of `str2' less `str1', restricted to those members above `lo' and below
`hi'."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE SIMPLE-VECTOR VEC1 VEC2))
    (LET ((I1 0) (I2 0) (LEN1 (LENGTH VEC1)) (LEN2 (LENGTH VEC2)))
      (DECLARE (TYPE FIXNUM LEN1 LEN2))
      (UNLESS (EQ LO HEDGE-NEGATIVE-INFINITY)
        (DO () ((OR (= I1 LEN1) (LESS-THAN? LO (SVREF VEC1 I1)))) (INCF I1))
        (DO () ((OR (= I2 LEN2) (LESS-THAN? LO (SVREF VEC2 I2)))) (INCF I2)))
      (UNLESS (EQ HI HEDGE-POSITIVE-INFINITY)
        (DO ()
            ((OR (= I1 LEN1) (LESS-THAN? (SVREF VEC1 (1- LEN1)) HI)))
          (DECF LEN1))
        (DO ()
            ((OR (= I2 LEN2) (LESS-THAN? (SVREF VEC2 (1- LEN2)) HI)))
          (DECF LEN2)))
      (DO ((RES1 NIL)
           (RES2 NIL))
          ((OR (= I1 LEN1) (= I2 LEN2))
           (DO () ((= I1 LEN1)) (PUSH (SVREF VEC1 I1) RES1) (INCF I1))
           (DO () ((= I2 LEN2)) (PUSH (SVREF VEC2 I2) RES2) (INCF I2))
           (VALUES (AND RES1 (COERCE (NREVERSE RES1) 'SIMPLE-VECTOR))
                   (AND RES2 (COERCE (NREVERSE RES2) 'SIMPLE-VECTOR))))
        (LET ((V1 (SVREF VEC1 I1))
              (V2 (SVREF VEC2 I2))
              ((COMP (COMPARE V1 V2))))
          (ECASE COMP
            ((:EQUAL) (INCF I1) (INCF I2))
            ((:LESS) (PUSH V1 RES1) (INCF I1))
            ((:GREATER) (PUSH V2 RES2) (INCF I2))
            ((:UNEQUAL) (PUSH V1 RES1) (PUSH V2 RES2) (INCF I1) (INCF I2)))))))

[fset/Code/wb-trees.lisp:1465]
  (DEFUN VECTOR-SET-SUBSET? (VEC1 VEC2 LO HI)
    "Returns true iff `vec1' contains all members of `vec2', restricted
to those members above `lo' and below `hi'.  `vec2' may be `nil'."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE (OR NULL SIMPLE-VECTOR) VEC1 VEC2))
    (LET ((I1 0) (I2 0) (LEN1 (LENGTH-NV VEC1)) (LEN2 (LENGTH-NV VEC2)))
      (DECLARE (TYPE FIXNUM LEN1 LEN2))
      (UNLESS (EQ LO HEDGE-NEGATIVE-INFINITY)
        (DO () ((OR (= I1 LEN1) (LESS-THAN? LO (SVREF VEC1 I1)))) (INCF I1)))
      (UNLESS (EQ HI HEDGE-POSITIVE-INFINITY)
        (DO ()
            ((OR (= I1 LEN1) (LESS-THAN? (SVREF VEC1 (1- LEN1)) HI)))
          (DECF LEN1)))
      (DO ()
          ((OR (= I1 LEN1) (= I2 LEN2)) (= I1 LEN1))
        (LET ((V1 (SVREF VEC1 I1))
              (V2 (SVREF VEC2 I2))
              ((COMP (COMPARE V1 V2))))
          (ECASE COMP
            ((:EQUAL) (INCF I1) (INCF I2))
            ((:LESS) (RETURN NIL))
            ((:GREATER) (INCF I2))
            ((:UNEQUAL) (RETURN NIL)))))))

[fset/Code/wb-trees.lisp:1498]
  (DEFUN VECTOR-SET-DISJOINT? (VEC1 VEC2 LO HI)
    "Returns true iff `vec1' does not contain any member of `vec2', restricted
to those members above `lo' and below `hi'."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE SIMPLE-VECTOR VEC1 VEC2))
    (LET ((I1 0) (I2 0) (LEN1 (LENGTH VEC1)) (LEN2 (LENGTH VEC2)))
      (DECLARE (TYPE FIXNUM I1 I2 LEN1 LEN2))
      (UNLESS (EQ LO HEDGE-NEGATIVE-INFINITY)
        (DO () ((OR (= I1 LEN1) (LESS-THAN? LO (SVREF VEC1 I1)))) (INCF I1)))
      (UNLESS (EQ HI HEDGE-POSITIVE-INFINITY)
        (DO ()
            ((OR (= I1 LEN1) (LESS-THAN? (SVREF VEC1 (1- LEN1)) HI)))
          (DECF LEN1)))
      (DO ()
          ((OR (= I1 LEN1) (= I2 LEN2)) T)
        (LET ((V1 (SVREF VEC1 I1))
              (V2 (SVREF VEC2 I2))
              ((COMP (COMPARE V1 V2))))
          (ECASE COMP
            ((:EQUAL) (RETURN NIL))
            ((:LESS) (INCF I1))
            ((:GREATER) (INCF I2))
            ((:UNEQUAL) (INCF I1) (INCF I2)))))))

[fset/Code/wb-trees.lisp:1575]
  (DEFUN WB-SET-TREE-ITERATOR-CANONICALIZE (ITER)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LOOP
     (LET ((SP (SVREF ITER 0))
           ((NODE (SVREF ITER SP)) (IDX (SVREF ITER (1+ SP)))))
       (DECLARE (FIXNUM SP IDX))
       (COND
        ((NULL NODE)
         (IF (= SP 1)
             (RETURN)
             (PROGN
              (DECF SP 2)
              (SETF (SVREF ITER 0) SP)
              (INCF (THE FIXNUM (SVREF ITER (1+ SP)))))))
        ((SIMPLE-VECTOR-P NODE)
         (COND ((< IDX (LENGTH NODE)) (RETURN))
               ((= SP 1) (SETF (SVREF ITER 1) NIL) (RETURN))
               (T (DECF SP 2) (SETF (SVREF ITER 0) SP)
                (INCF (THE FIXNUM (SVREF ITER (1+ SP)))))))
        ((= IDX 0)
         (UNLESS (< (+ SP 3) (LENGTH ITER))
           (ERROR
            "Internal FSet error: iterator stack overflow.  Please report this bug."))
         (INCF SP 2) (SETF (SVREF ITER 0) SP)
         (SETF (SVREF ITER SP) (WB-SET-TREE-NODE-LEFT NODE))
         (SETF (SVREF ITER (1+ SP)) 0))
        ((= IDX (1+ (SET-VALUE-SIZE (WB-SET-TREE-NODE-VALUE NODE))))
         (SETF (SVREF ITER SP) (WB-SET-TREE-NODE-RIGHT NODE))
         (SETF (SVREF ITER (1+ SP)) 0))
        (T (RETURN)))))
    ITER)

[fset/Code/wb-trees.lisp:1613]
  (DEFUN WB-SET-TREE-ITERATOR-DONE? (ITER)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (NULL (SVREF ITER (SVREF ITER 0))))

[fset/Code/wb-trees.lisp:1617]
  (DEFUN WB-SET-TREE-ITERATOR-GET (ITER)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((SP (SVREF ITER 0))
          ((NODE (SVREF ITER SP)) (IDX (SVREF ITER (1+ SP)))))
      (DECLARE (FIXNUM IDX))
      (IF (NULL NODE)
          (VALUES NIL NIL)
          (PROGN
           (INCF (THE FIXNUM (SVREF ITER (1+ SP))))
           (WB-SET-TREE-ITERATOR-CANONICALIZE ITER)
           (VALUES
            (IF (SIMPLE-VECTOR-P NODE)
                (SVREF NODE IDX)
                (LET ((VAL (WB-SET-TREE-NODE-VALUE NODE)))
                  (IF (EQUIVALENT-SET? VAL)
                      (NTH (1- IDX) (EQUIVALENT-SET-MEMBERS VAL))
                      VAL)))
            T)))))

[fset/Code/wb-trees.lisp:1639]
  (DEFUN MAKE-WB-TREE-ITERATOR (TREE SIZE FRAME-SIZE NODES-HAVE-VALUES?)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE FIXNUM FRAME-SIZE))
    (LET ((DEPTH (THE FIXNUM (WB-TREE-MAX-DEPTH SIZE NODES-HAVE-VALUES?)))
          ((STACK
            (MAKE-ARRAY (THE FIXNUM (1+ (THE FIXNUM (* FRAME-SIZE DEPTH))))))))
      (SETF (SVREF STACK 0) 1)
      (SETF (SVREF STACK 1) TREE)
      (DOTIMES (I (1- FRAME-SIZE)) (SETF (SVREF STACK (+ I 2)) 0))
      STACK))

[fset/Code/wb-trees.lisp:1671]
  (DEFUN WB-TREE-MAX-DEPTH (SIZE NODES-HAVE-VALUES?)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE FIXNUM SIZE))
    (IF (< SIZE WB-TREE-PRECOMPUTED-MAX-DEPTHS)
        (SVREF
         (IF NODES-HAVE-VALUES?
             +WB-TREE-MAX-DEPTHS-WITH-VALUES+
             +WB-TREE-MAX-DEPTHS-WITHOUT-VALUES+)
         SIZE)
        (VALUES
         (CEILING
          (* (1- (INTEGER-LENGTH SIZE))
             (/ (LOG 2)
                (LOG
                 (/ (+ 1 WB-TREE-BALANCE-FACTOR) WB-TREE-BALANCE-FACTOR))))))))

[fset/Code/wb-trees.lisp:1692]
  (DEFUN EQUIVALENT-SET-UNION (VAL1 VAL2)
    "Both `val1' and `val2' may be single values (representing singleton sets)
or `Equivalent-Set's of values.  Returns their union represented as a single
value if a singleton, else as an `Equivalent-Set'."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (IF (EQUIVALENT-SET? VAL1)
        (IF (EQUIVALENT-SET? VAL2)
            (LET ((MEMS1 (EQUIVALENT-SET-MEMBERS VAL1))
                  (MEMS2 (EQUIVALENT-SET-MEMBERS VAL2))
                  ((UNION (UNION MEMS1 MEMS2 :TEST #'EQUAL?))
                   ((UNION-LEN (LENGTH UNION)))))
              (COND ((= UNION-LEN (LENGTH MEMS1)) VAL1)
                    ((= UNION-LEN (LENGTH MEMS2)) VAL2)
                    (T (MAKE-EQUIVALENT-SET UNION))))
            (IF (MEMBER VAL2 (EQUIVALENT-SET-MEMBERS VAL1) :TEST #'EQUAL?)
                VAL1
                (MAKE-EQUIVALENT-SET
                 (CONS VAL2 (EQUIVALENT-SET-MEMBERS VAL1)))))
        (IF (EQUIVALENT-SET? VAL2)
            (IF (MEMBER VAL1 (EQUIVALENT-SET-MEMBERS VAL2) :TEST #'EQUAL?)
                VAL2
                (MAKE-EQUIVALENT-SET
                 (CONS VAL1 (EQUIVALENT-SET-MEMBERS VAL2))))
            (IF (EQUAL? VAL1 VAL2)
                VAL1
                (MAKE-EQUIVALENT-SET (LIST VAL1 VAL2))))))

[fset/Code/wb-trees.lisp:1716]
  (DEFUN EQUIVALENT-SET-INTERSECT (VAL1 VAL2)
    "Both `val1' and `val2' may be single values (representing singleton sets)
or `Equivalent-Set's of values.  If their intersection is nonnull, returns
two values: true, and the intersection, represented as a single value if a
singleton, else as an `Equivalent-Set'.  If the intersection is null, returns
`nil'."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (IF (EQUIVALENT-SET? VAL1)
        (IF (EQUIVALENT-SET? VAL2)
            (LET ((MEMS1 (EQUIVALENT-SET-MEMBERS VAL1))
                  (MEMS2 (EQUIVALENT-SET-MEMBERS VAL2))
                  ((ISECT (INTERSECTION MEMS1 MEMS2 :TEST #'EQUAL?))
                   ((ISECT-LEN (LENGTH ISECT)))))
              (COND ((NULL ISECT) NIL)
                    ((= ISECT-LEN (LENGTH MEMS1)) (VALUES T VAL1))
                    ((= ISECT-LEN (LENGTH MEMS2)) (VALUES T VAL2))
                    ((= ISECT-LEN 1) (VALUES T (CAR ISECT)))
                    (T (VALUES T (MAKE-EQUIVALENT-SET ISECT)))))
            (AND (MEMBER VAL2 (EQUIVALENT-SET-MEMBERS VAL1) :TEST #'EQUAL?)
                 (VALUES T VAL2)))
        (IF (EQUIVALENT-SET? VAL2)
            (AND (MEMBER VAL1 (EQUIVALENT-SET-MEMBERS VAL2) :TEST #'EQUAL?)
                 (VALUES T VAL1))
            (AND (EQUAL? VAL1 VAL2) (VALUES T VAL1)))))

[fset/Code/wb-trees.lisp:1741]
  (DEFUN EQUIVALENT-SET-DIFFERENCE (VAL1 VAL2)
    "Both `val1' and `val2' may be single values (representing singleton sets)
or `Equivalent-Set's of values.  If their difference is nonnull, returns
two values: true, and the difference, represented as a single value if a
singleton, else as an `Equivalent-Set'.  If the difference is null, returns
`nil'."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (IF (EQUIVALENT-SET? VAL1)
        (LET ((MEMS1 (EQUIVALENT-SET-MEMBERS VAL1))
              (MEMS2
               (IF (EQUIVALENT-SET? VAL2)
                   (EQUIVALENT-SET-MEMBERS VAL2)
                   (LIST VAL2)))
              ((DIFF (SET-DIFFERENCE MEMS1 MEMS2 :TEST #'EQUAL?))
               ((DIFF-LEN (LENGTH DIFF)))))
          (COND ((NULL DIFF) NIL) ((= DIFF-LEN (LENGTH MEMS1)) (VALUES T VAL1))
                ((= DIFF-LEN 1) (VALUES T (CAR DIFF)))
                (T (VALUES T (MAKE-EQUIVALENT-SET DIFF)))))
        (IF (EQUIVALENT-SET? VAL2)
            (AND
             (NOT (MEMBER VAL1 (EQUIVALENT-SET-MEMBERS VAL2) :TEST #'EQUAL?))
             (VALUES T VAL1))
            (AND (NOT (EQUAL? VAL1 VAL2)) (VALUES T VAL1)))))

[fset/Code/wb-trees.lisp:1763]
  (DEFUN EQUIVALENT-SET-SUBSET? (VAL1 VAL2)
    "Both `val1' and `val2' may be single values (representing singleton sets)
or `Equivalent-Set's of values.  Returns true iff `val2' contains all members
of `val1'."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (IF (EQUIVALENT-SET? VAL1)
        (AND (EQUIVALENT-SET? VAL2)
             (LET ((MEMS2 (EQUIVALENT-SET-MEMBERS VAL2)))
               (DOLIST (M1 (EQUIVALENT-SET-MEMBERS VAL1) T)
                 (UNLESS (MEMBER M1 MEMS2 :TEST #'EQUAL?) (RETURN NIL)))))
        (IF (EQUIVALENT-SET? VAL2)
            (MEMBER VAL1 (EQUIVALENT-SET-MEMBERS VAL2) :TEST #'EQUAL?)
            (EQUAL? VAL1 VAL2))))

[fset/Code/wb-trees.lisp:1778]
  (DEFUN EQUIVALENT-SET-DISJOINT? (VAL1 VAL2)
    "Both `val1' and `val2' may be single values (representing singleton sets)
or `Equivalent-Set's of values.  If their intersection is null, returns
true, else false."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (IF (EQUIVALENT-SET? VAL1)
        (IF (EQUIVALENT-SET? VAL2)
            (DOLIST (M1 (EQUIVALENT-SET-MEMBERS VAL1) T)
              (WHEN (MEMBER M1 (EQUIVALENT-SET-MEMBERS VAL2) :TEST #'EQUAL?)
                (RETURN NIL)))
            (NOT (MEMBER VAL2 (EQUIVALENT-SET-MEMBERS VAL1) :TEST #'EQUAL?)))
        (IF (EQUIVALENT-SET? VAL2)
            (NOT (MEMBER VAL1 (EQUIVALENT-SET-MEMBERS VAL2) :TEST #'EQUAL?))
            (NOT (EQUAL? VAL1 VAL2)))))

[fset/Code/wb-trees.lisp:1793]
  (DEFUN EQUIVALENT-SET-COMPARE (VAL1 VAL2)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((COMP (COMPARE VAL1 VAL2)))
      (IF (OR (EQ COMP ':LESS) (EQ COMP ':GREATER))
          COMP
          (IF (EQUIVALENT-SET? VAL1)
              (IF (EQUIVALENT-SET? VAL2)
                  (LET ((MEMS1 (EQUIVALENT-SET-MEMBERS VAL1))
                        (MEMS2 (EQUIVALENT-SET-MEMBERS VAL2))
                        ((LEN1 (LENGTH MEMS1)) (LEN2 (LENGTH MEMS2))))
                    (COND ((< LEN1 LEN2) ':GREATER) ((> LEN1 LEN2) ':LESS)
                          (T
                           (IF (GMAP :AND
                                #'(LAMBDA (X) (MEMBER X MEMS2 :TEST #'EQUAL?))
                                (:LIST MEMS1))
                               ':EQUAL
                               ':UNEQUAL))))
                  ':LESS)
              (IF (EQUIVALENT-SET? VAL2)
                  ':GREATER
                  COMP)))))

[fset/Code/wb-trees.lisp:1895]
  (DEFUN BAG-VALUE-SIZE (VALUE)
    "The number of values represented by `value', which can be more than 1 if
`key' is an `Equivalent-Bag'."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (IF (EQUIVALENT-BAG? VALUE)
        (LENGTH (EQUIVALENT-BAG-ALIST VALUE))
        1))

[fset/Code/wb-trees.lisp:1904]
  (DEFUN WB-BAG-TREE-SIZE (TREE)
    "The number of value/count pairs contained in this tree."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-BAG-TREE TREE))
    (COND ((NULL TREE) 0)
          ((CONSP TREE) (LENGTH (THE SIMPLE-VECTOR (CAR TREE))))
          (T (WB-BAG-TREE-NODE-SIZE TREE))))

[fset/Code/wb-trees.lisp:1914]
  (DEFUN WB-BAG-TREE-TOTAL-COUNT (TREE)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-BAG-TREE TREE))
    (COND ((NULL TREE) 0) ((CONSP TREE) (REDUCE #'+ (CDR TREE)))
          (T (WB-BAG-TREE-NODE-TOTAL-COUNT TREE))))

[fset/Code/wb-trees.lisp:1930]
  (DEFUN MAKE-WB-BAG-TREE-NODE (VALUE COUNT LEFT RIGHT)
    "The low-level constructor for a bag tree node.  `count' is ignored and can be
`nil' if value is an `Equivalent-Bag'."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-BAG-TREE LEFT RIGHT))
    (MAKE-RAW-WB-BAG-TREE-NODE
     (GEN + (WB-BAG-TREE-SIZE LEFT) (WB-BAG-TREE-SIZE RIGHT)
      (BAG-VALUE-SIZE VALUE))
     (GEN + (WB-BAG-TREE-TOTAL-COUNT LEFT) (WB-BAG-TREE-TOTAL-COUNT RIGHT)
      (IF (EQUIVALENT-BAG? VALUE)
          (GMAP :GEN-SUM #'CDR (:LIST (EQUIVALENT-BAG-ALIST VALUE)))
          (OR COUNT 0)))
     VALUE (OR COUNT 0) LEFT RIGHT))

[fset/Code/wb-trees.lisp:1946]
  (DEFUN WB-BAG-TREE-ARB-PAIR (TREE)
    "Returns an arbitrary member of the bag and its count.  Assumes the bag is
nonempty."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-BAG-TREE TREE))
    (IF (CONSP TREE)
        (VALUES (SVREF (CAR TREE) 0) (SVREF (CDR TREE) 0))
        (LET ((VALUE (WB-BAG-TREE-NODE-VALUE TREE)))
          (IF (EQUIVALENT-BAG? VALUE)
              (LET ((ALIST (EQUIVALENT-BAG-ALIST VALUE)))
                (VALUES (CAAR ALIST) (CDAR ALIST)))
              (VALUES VALUE (WB-BAG-TREE-NODE-COUNT TREE))))))

[fset/Code/wb-trees.lisp:1959]
  (DEFUN WB-BAG-TREE-LEAST-PAIR (TREE)
    "Assumes `tree' is nonempty.  Returns the least member, or an arbitrary
least member if there are more than one; the second value is the associated
count."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-BAG-TREE TREE))
    (LET ((VAL COUNT (WB-BAG-TREE-MINIMUM-PAIR TREE)))
      (IF (EQUIVALENT-BAG? VAL)
          (LET ((PR (CAR (EQUIVALENT-BAG-ALIST VAL))))
            (VALUES (CAR PR) (CDR PR)))
          (VALUES VAL COUNT))))

[fset/Code/wb-trees.lisp:1972]
  (DEFUN WB-BAG-TREE-LESS-LEAST (TREE ALL?)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-BAG-TREE TREE))
    (COND ((NULL TREE) NIL)
          ((CONSP TREE)
           (IF (OR ALL? (= 1 (THE INTEGER (SVREF (CDR TREE) 0))))
               (AND (> (LENGTH (THE SIMPLE-VECTOR (CAR TREE))) 1)
                    (CONS (VECTOR-SUBSEQ (CAR TREE) 1)
                          (VECTOR-SUBSEQ (CDR TREE) 1)))
               (CONS (CAR TREE)
                     (VECTOR-UPDATE (CDR TREE) 0
                      (1- (THE INTEGER (SVREF (CDR TREE) 0)))))))
          (T
           (LET ((LEFT (WB-BAG-TREE-NODE-LEFT TREE)))
             (IF LEFT
                 (WB-BAG-TREE-BUILD-NODE (WB-BAG-TREE-NODE-VALUE TREE)
                  (WB-BAG-TREE-NODE-COUNT TREE)
                  (WB-BAG-TREE-LESS-LEAST LEFT ALL?)
                  (WB-BAG-TREE-NODE-RIGHT TREE))
                 (LET ((VAL (WB-BAG-TREE-NODE-VALUE TREE)))
                   (IF (EQUIVALENT-BAG? VAL)
                       (LET ((ALIST (EQUIVALENT-BAG-ALIST VAL)))
                         (IF (OR ALL? (= (THE INTEGER (CDAR ALIST)) 1))
                             (IF (= (LENGTH ALIST) 2)
                                 (MAKE-WB-BAG-TREE-NODE (CAADR ALIST)
                                  (CDADR ALIST) NIL
                                  (WB-BAG-TREE-NODE-RIGHT TREE))
                                 (MAKE-WB-BAG-TREE-NODE
                                  (MAKE-EQUIVALENT-BAG (CDR ALIST)) 0 NIL
                                  (WB-BAG-TREE-NODE-RIGHT TREE)))
                             (MAKE-WB-BAG-TREE-NODE
                              (MAKE-EQUIVALENT-BAG
                               (CONS
                                (CONS (CAAR ALIST)
                                      (1- (THE INTEGER (CDAR ALIST))))
                                (CDR ALIST)))
                              0 NIL (WB-BAG-TREE-NODE-RIGHT TREE))))
                       (IF (OR ALL? (= (WB-BAG-TREE-NODE-COUNT TREE) 1))
                           (WB-BAG-TREE-NODE-RIGHT TREE)
                           (MAKE-WB-BAG-TREE-NODE (WB-BAG-TREE-NODE-VALUE TREE)
                            (1- (WB-BAG-TREE-NODE-COUNT TREE)) NIL
                            (WB-BAG-TREE-NODE-RIGHT TREE))))))))))

[fset/Code/wb-trees.lisp:2012]
  (DEFUN WB-BAG-TREE-GREATEST-PAIR (TREE)
    "Assumes `tree' is nonempty.  Returns the greatest member, or an arbitrary
greatest member if there are more than one; the second value is the associated
multiplicity."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-BAG-TREE TREE))
    (IF (CONSP TREE)
        (LET ((IDX (1- (LENGTH (THE SIMPLE-VECTOR (CAR TREE))))))
          (VALUES (SVREF (CAR TREE) IDX) (SVREF (CDR TREE) IDX)))
        (LET ((RIGHT (WB-BAG-TREE-NODE-RIGHT TREE)))
          (IF RIGHT
              (WB-BAG-TREE-GREATEST-PAIR RIGHT)
              (LET ((VAL (WB-BAG-TREE-NODE-VALUE TREE)))
                (IF (EQUIVALENT-BAG? VAL)
                    (LET ((PR (CAR (LAST (EQUIVALENT-BAG-ALIST VAL)))))
                      (VALUES (CAR PR) (CDR PR)))
                    (VALUES VAL (WB-BAG-TREE-NODE-COUNT TREE))))))))

[fset/Code/wb-trees.lisp:2031]
  (DEFUN WB-BAG-TREE-MULTIPLICITY (TREE VALUE)
    "Returns the multiplicity of `value' in `tree', or 0 if `value' does not
appear in `tree'.  As a second value, returns the value found, if any."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-BAG-TREE TREE))
    (COND ((NULL TREE) (VALUES 0 NIL))
          ((CONSP TREE)
           (LET ((FOUND? IDX (VECTOR-SET-BINARY-SEARCH (CAR TREE) VALUE)))
             (IF (EQ FOUND? ':EQUAL)
                 (VALUES (SVREF (CDR TREE) IDX) (SVREF (CAR TREE) IDX))
                 (VALUES 0 NIL))))
          (T
           (LET ((NODE-VAL (WB-BAG-TREE-NODE-VALUE TREE))
                 ((COMP (COMPARE VALUE NODE-VAL))))
             (ECASE COMP
               ((:EQUAL :UNEQUAL)
                (IF (EQUIVALENT-BAG? NODE-VAL)
                    (LET ((PR
                           (ASSOC VALUE (EQUIVALENT-BAG-ALIST NODE-VAL) :TEST
                                  #'EQUAL?)))
                      (IF PR
                          (VALUES (CDR PR) (CAR PR))
                          (VALUES 0 NIL)))
                    (IF (EQ COMP ':EQUAL)
                        (VALUES (WB-BAG-TREE-NODE-COUNT TREE) NODE-VAL)
                        (VALUES 0 NIL))))
               ((:LESS)
                (WB-BAG-TREE-MULTIPLICITY (WB-BAG-TREE-NODE-LEFT TREE) VALUE))
               ((:GREATER)
                (WB-BAG-TREE-MULTIPLICITY (WB-BAG-TREE-NODE-RIGHT TREE)
                 VALUE)))))))

[fset/Code/wb-trees.lisp:2060]
  (DEFUN WB-BAG-TREE-FIND-EQUIVALENT (TREE VALUE)
    "If `tree' contains one or more values equivalent to `value', returns (first
value) true, (second value) either the one value or an `Equivalent-Bag'
containing the values, and (third value) if the second value was a single
value, the corresponding count; otherwise `nil'."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-BAG-TREE TREE))
    (COND ((NULL TREE) NIL)
          ((CONSP TREE)
           (LET ((FOUND? IDX (VECTOR-SET-BINARY-SEARCH (CAR TREE) VALUE)))
             (AND FOUND?
                  (VALUES T (SVREF (CAR TREE) IDX) (SVREF (CDR TREE) IDX)))))
          (T
           (LET ((NODE-VAL (WB-BAG-TREE-NODE-VALUE TREE))
                 ((COMP (COMPARE VALUE NODE-VAL))))
             (ECASE COMP
               ((:EQUAL :UNEQUAL)
                (VALUES T NODE-VAL (WB-BAG-TREE-NODE-COUNT TREE)))
               (:LESS
                (WB-BAG-TREE-FIND-EQUIVALENT (WB-BAG-TREE-NODE-LEFT TREE)
                 VALUE))
               (:GREATER
                (WB-BAG-TREE-FIND-EQUIVALENT (WB-BAG-TREE-NODE-RIGHT TREE)
                 VALUE)))))))

[fset/Code/wb-trees.lisp:2085]
  (DEFUN WB-BAG-TREE-WITH (TREE VALUE &OPTIONAL (COUNT 1))
    "Returns `tree' with `value' added with a count of `count' (if it was already
present, its count is incremented by `count').  `value' may be an `Equivalent-Bag'."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-BAG-TREE TREE))
    (COND
     ((NULL TREE)
      (IF (NOT (EQUIVALENT-BAG? VALUE))
          (CONS (VECTOR VALUE) (VECTOR COUNT))
          (MAKE-WB-BAG-TREE-NODE VALUE COUNT NIL NIL)))
     ((CONSP TREE)
      (LET ((FOUND? IDX (VECTOR-SET-BINARY-SEARCH (CAR TREE) VALUE))
            ((RIGHT-START
              (IF FOUND?
                  (1+ IDX)
                  IDX))))
        (IF (AND (EQ FOUND? ':EQUAL) (NOT (EQUIVALENT-BAG? VALUE)))
            (CONS (CAR TREE)
                  (VECTOR-UPDATE (CDR TREE) IDX
                   (GEN + (SVREF (CDR TREE) IDX) COUNT)))
            (IF (AND (NOT FOUND?)
                     (< (LENGTH (THE SIMPLE-VECTOR (CAR TREE)))
                        *WB-TREE-MAX-VECTOR-LENGTH*)
                     (NOT (EQUIVALENT-BAG? VALUE)))
                (CONS (VECTOR-INSERT (CAR TREE) IDX VALUE)
                      (VECTOR-INSERT (CDR TREE) IDX COUNT))
                (LET ((NEW-VAL
                       NEW-COUNT
                       (IF FOUND?
                           (EQUIVALENT-BAG-SUM (SVREF (CAR TREE) IDX)
                            (SVREF (CDR TREE) IDX) VALUE COUNT)
                           (VALUES VALUE COUNT))))
                  (MAKE-WB-BAG-TREE-NODE NEW-VAL NEW-COUNT
                   (AND (> IDX 0)
                        (CONS (VECTOR-SUBSEQ (CAR TREE) 0 IDX)
                              (VECTOR-SUBSEQ (CDR TREE) 0 IDX)))
                   (AND (< RIGHT-START (LENGTH (THE SIMPLE-VECTOR (CAR TREE))))
                        (CONS (VECTOR-SUBSEQ (CAR TREE) RIGHT-START)
                              (VECTOR-SUBSEQ (CDR TREE) RIGHT-START)))))))))
     (T
      (LET ((NODE-VAL (WB-BAG-TREE-NODE-VALUE TREE))
            (NODE-COUNT (WB-BAG-TREE-NODE-COUNT TREE))
            ((COMP (COMPARE VALUE NODE-VAL))))
        (ECASE COMP
          ((:EQUAL :UNEQUAL)
           (LET ((NEW-VAL
                  NEW-COUNT
                  (EQUIVALENT-BAG-SUM NODE-VAL NODE-COUNT VALUE COUNT)))
             (MAKE-WB-BAG-TREE-NODE NEW-VAL NEW-COUNT
              (WB-BAG-TREE-NODE-LEFT TREE) (WB-BAG-TREE-NODE-RIGHT TREE))))
          ((:LESS)
           (WB-BAG-TREE-BUILD-NODE NODE-VAL NODE-COUNT
            (WB-BAG-TREE-WITH (WB-BAG-TREE-NODE-LEFT TREE) VALUE COUNT)
            (WB-BAG-TREE-NODE-RIGHT TREE)))
          ((:GREATER)
           (WB-BAG-TREE-BUILD-NODE NODE-VAL NODE-COUNT
            (WB-BAG-TREE-NODE-LEFT TREE)
            (WB-BAG-TREE-WITH (WB-BAG-TREE-NODE-RIGHT TREE) VALUE COUNT))))))))

[fset/Code/wb-trees.lisp:2151]
  (DEFUN WB-BAG-TREE-LESS (TREE VALUE &OPTIONAL (COUNT 1))
    "Returns `tree' with the count for `value' decremented; if that count was
1, `value' is removed entirely."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-BAG-TREE TREE)
             (TYPE INTEGER COUNT))
    (COND ((NULL TREE) NIL)
          ((CONSP TREE)
           (LET ((FOUND? IDX (VECTOR-SET-BINARY-SEARCH (CAR TREE) VALUE)))
             (IF (EQ FOUND? ':EQUAL)
                 (LET ((PREV-COUNT (THE INTEGER (SVREF (CDR TREE) IDX))))
                   (IF (GEN > PREV-COUNT COUNT)
                       (CONS (CAR TREE)
                             (VECTOR-UPDATE (CDR TREE) IDX
                              (GEN - PREV-COUNT COUNT)))
                       (AND (> (LENGTH (THE SIMPLE-VECTOR (CAR TREE))) 1)
                            (CONS (VECTOR-REMOVE-AT (CAR TREE) IDX)
                                  (VECTOR-REMOVE-AT (CDR TREE) IDX)))))
                 TREE)))
          (T
           (LET ((NODE-VAL (WB-BAG-TREE-NODE-VALUE TREE))
                 (NODE-COUNT (WB-BAG-TREE-NODE-COUNT TREE))
                 ((COMP (COMPARE VALUE NODE-VAL))))
             (ECASE COMP
               ((:EQUAL :UNEQUAL)
                (LET ((NONNULL?
                       VALUE
                       COUNT
                       (EQUIVALENT-BAG-DIFFERENCE NODE-VAL NODE-COUNT VALUE
                        COUNT)))
                  (IF NONNULL?
                      (MAKE-WB-BAG-TREE-NODE VALUE COUNT
                       (WB-BAG-TREE-NODE-LEFT TREE)
                       (WB-BAG-TREE-NODE-RIGHT TREE))
                      (WB-BAG-TREE-JOIN (WB-BAG-TREE-NODE-LEFT TREE)
                       (WB-BAG-TREE-NODE-RIGHT TREE)))))
               ((:LESS)
                (LET ((LEFT (WB-BAG-TREE-NODE-LEFT TREE))
                      ((NEW-LEFT (WB-BAG-TREE-LESS LEFT VALUE))))
                  (WB-BAG-TREE-BUILD-NODE NODE-VAL NODE-COUNT NEW-LEFT
                   (WB-BAG-TREE-NODE-RIGHT TREE))))
               ((:GREATER)
                (LET ((RIGHT (WB-BAG-TREE-NODE-RIGHT TREE))
                      ((NEW-RIGHT (WB-BAG-TREE-LESS RIGHT VALUE))))
                  (WB-BAG-TREE-BUILD-NODE NODE-VAL NODE-COUNT
                   (WB-BAG-TREE-NODE-LEFT TREE) NEW-RIGHT))))))))

[fset/Code/wb-trees.lisp:2205]
  (DEFUN WB-BAG-TREE-UNION-RNG (TREE1 TREE2 LO HI)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-BAG-TREE TREE1 TREE2))
    (COND ((EQ TREE1 TREE2) (WB-BAG-TREE-SPLIT TREE1 LO HI))
          ((NULL TREE2) (WB-BAG-TREE-SPLIT TREE1 LO HI))
          ((NULL TREE1) (WB-BAG-TREE-SPLIT TREE2 LO HI))
          ((AND (CONSP TREE1) (CONSP TREE2))
           (WB-BAG-TREE-VECTOR-PAIR-UNION TREE1 TREE2 LO HI))
          ((CONSP TREE1) (WB-BAG-TREE-UNION-RNG TREE2 TREE1 LO HI))
          (T
           (LET ((VAL1 (WB-BAG-TREE-NODE-VALUE TREE1))
                 (COUNT1 (WB-BAG-TREE-NODE-COUNT TREE1))
                 ((EQVV2? EQVV2 EQVC2 (WB-BAG-TREE-FIND-EQUIVALENT TREE2 VAL1))
                  ((VAL COUNT
                    (IF EQVV2?
                        (EQUIVALENT-BAG-UNION VAL1 COUNT1 EQVV2 EQVC2)
                        (VALUES VAL1 COUNT1))))))
             (WB-BAG-TREE-CONCAT VAL COUNT
              (WB-BAG-TREE-UNION-RNG
               (WB-BAG-TREE-TRIM (WB-BAG-TREE-NODE-LEFT TREE1) LO VAL1)
               (WB-BAG-TREE-TRIM TREE2 LO VAL1) LO VAL1)
              (WB-BAG-TREE-UNION-RNG
               (WB-BAG-TREE-TRIM (WB-BAG-TREE-NODE-RIGHT TREE1) VAL1 HI)
               (WB-BAG-TREE-TRIM TREE2 VAL1 HI) VAL1 HI))))))

[fset/Code/wb-trees.lisp:2239]
  (DEFUN WB-BAG-TREE-SUM-RNG (TREE1 TREE2 LO HI)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-BAG-TREE TREE1 TREE2))
    (COND ((NULL TREE2) (WB-BAG-TREE-SPLIT TREE1 LO HI))
          ((NULL TREE1) (WB-BAG-TREE-SPLIT TREE2 LO HI))
          ((AND (CONSP TREE1) (CONSP TREE2))
           (WB-BAG-TREE-VECTOR-PAIR-SUM TREE1 TREE2 LO HI))
          ((CONSP TREE1) (WB-BAG-TREE-SUM-RNG TREE2 TREE1 LO HI))
          (T
           (LET ((VAL1 (WB-BAG-TREE-NODE-VALUE TREE1))
                 (COUNT1 (WB-BAG-TREE-NODE-COUNT TREE1))
                 ((EQVV2? EQVV2 EQVC2 (WB-BAG-TREE-FIND-EQUIVALENT TREE2 VAL1))
                  ((VAL COUNT
                    (IF EQVV2?
                        (EQUIVALENT-BAG-SUM VAL1 COUNT1 EQVV2 EQVC2)
                        (VALUES VAL1 COUNT1))))))
             (WB-BAG-TREE-CONCAT VAL COUNT
              (WB-BAG-TREE-SUM-RNG
               (WB-BAG-TREE-TRIM (WB-BAG-TREE-NODE-LEFT TREE1) LO VAL1)
               (WB-BAG-TREE-TRIM TREE2 LO VAL1) LO VAL1)
              (WB-BAG-TREE-SUM-RNG
               (WB-BAG-TREE-TRIM (WB-BAG-TREE-NODE-RIGHT TREE1) VAL1 HI)
               (WB-BAG-TREE-TRIM TREE2 VAL1 HI) VAL1 HI))))))

[fset/Code/wb-trees.lisp:2274]
  (DEFUN WB-BAG-TREE-INTERSECT-RNG (TREE1 TREE2 LO HI)
    "Returns the intersection of `tree1' with `tree2', considering only those
members that are above `lo' and below `hi', and assuming that the root values
of `tree1' and `tree2' are in this range."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-BAG-TREE TREE1 TREE2))
    (COND ((EQ TREE1 TREE2) (WB-BAG-TREE-SPLIT TREE1 LO HI))
          ((OR (NULL TREE1) (NULL TREE2)) NIL)
          ((AND (CONSP TREE1) (CONSP TREE2))
           (VECTOR-PAIR-BAG-INTERSECT TREE1 TREE2 LO HI))
          ((CONSP TREE1)
           (WB-BAG-TREE-INTERSECT-RNG (WB-BAG-TREE-TRIM TREE2 LO HI) TREE1 LO
            HI))
          (T
           (LET ((VAL1 (WB-BAG-TREE-NODE-VALUE TREE1))
                 (COUNT1 (WB-BAG-TREE-NODE-COUNT TREE1))
                 ((NEW-LEFT
                   (WB-BAG-TREE-INTERSECT-RNG (WB-BAG-TREE-NODE-LEFT TREE1)
                    (WB-BAG-TREE-TRIM TREE2 LO VAL1) LO VAL1))
                  (NEW-RIGHT
                   (WB-BAG-TREE-INTERSECT-RNG (WB-BAG-TREE-NODE-RIGHT TREE1)
                    (WB-BAG-TREE-TRIM TREE2 VAL1 HI) VAL1 HI)))
                 ((EQVV2? EQVV2 EQVC2 (WB-BAG-TREE-FIND-EQUIVALENT TREE2 VAL1))
                  ((NONNULL? VALUE COUNT
                    (AND EQVV2?
                         (EQUIVALENT-BAG-INTERSECT VAL1 COUNT1 EQVV2 EQVC2))))))
             (IF NONNULL?
                 (WB-BAG-TREE-CONCAT VALUE COUNT NEW-LEFT NEW-RIGHT)
                 (WB-BAG-TREE-JOIN NEW-LEFT NEW-RIGHT))))))

[fset/Code/wb-trees.lisp:2312]
  (DEFUN WB-BAG-TREE-PRODUCT-RNG (TREE1 TREE2 LO HI)
    "Returns the Production of `tree1' with `tree2', considering only those
members that are above `lo' and below `hi', and assuming that the root values
of `tree1' and `tree2' are in this range."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-BAG-TREE TREE1 TREE2))
    (COND ((OR (NULL TREE1) (NULL TREE2)) NIL)
          ((AND (CONSP TREE1) (CONSP TREE2))
           (VECTOR-PAIR-BAG-PRODUCT TREE1 TREE2 LO HI))
          ((CONSP TREE1)
           (WB-BAG-TREE-PRODUCT-RNG (WB-BAG-TREE-TRIM TREE2 LO HI) TREE1 LO
            HI))
          (T
           (LET ((VAL1 (WB-BAG-TREE-NODE-VALUE TREE1))
                 (COUNT1 (WB-BAG-TREE-NODE-COUNT TREE1))
                 ((NEW-LEFT
                   (WB-BAG-TREE-PRODUCT-RNG (WB-BAG-TREE-NODE-LEFT TREE1)
                    (WB-BAG-TREE-TRIM TREE2 LO VAL1) LO VAL1))
                  (NEW-RIGHT
                   (WB-BAG-TREE-PRODUCT-RNG (WB-BAG-TREE-NODE-RIGHT TREE1)
                    (WB-BAG-TREE-TRIM TREE2 VAL1 HI) VAL1 HI)))
                 ((EQVV2? EQVV2 EQVC2 (WB-BAG-TREE-FIND-EQUIVALENT TREE2 VAL1))
                  ((NONNULL? VALUE COUNT
                    (AND EQVV2?
                         (EQUIVALENT-BAG-PRODUCT VAL1 COUNT1 EQVV2 EQVC2))))))
             (IF NONNULL?
                 (WB-BAG-TREE-CONCAT VALUE COUNT NEW-LEFT NEW-RIGHT)
                 (WB-BAG-TREE-JOIN NEW-LEFT NEW-RIGHT))))))

[fset/Code/wb-trees.lisp:2351]
  (DEFUN WB-BAG-TREE-DIFF-RNG (TREE1 TREE2 LO HI)
    "Returns the set difference of `tree1' less `tree2', considering only those
members that are above `lo' and below `hi', and assuming that the root values
of `tree1' and `tree2' are in this range."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-BAG-TREE TREE1 TREE2))
    (COND ((EQ TREE1 TREE2) NIL) ((NULL TREE1) NIL)
          ((NULL TREE2) (WB-BAG-TREE-SPLIT TREE1 LO HI))
          ((AND (CONSP TREE1) (CONSP TREE2))
           (VECTOR-PAIR-BAG-DIFF TREE1 TREE2 LO HI))
          ((CONSP TREE1)
           (LET ((VAL2 (WB-BAG-TREE-NODE-VALUE TREE2))
                 (COUNT2 (WB-BAG-TREE-NODE-COUNT TREE2))
                 ((NEW-LEFT
                   (WB-BAG-TREE-DIFF-RNG (WB-BAG-TREE-TRIM TREE1 LO VAL2)
                    (WB-BAG-TREE-TRIM (WB-BAG-TREE-NODE-LEFT TREE2) LO VAL2) LO
                    VAL2))
                  (NEW-RIGHT
                   (WB-BAG-TREE-DIFF-RNG (WB-BAG-TREE-TRIM TREE1 VAL2 HI)
                    (WB-BAG-TREE-TRIM (WB-BAG-TREE-NODE-RIGHT TREE2) VAL2 HI)
                    VAL2 HI)))
                 ((EQVV1? EQVV1 EQVC1 (WB-BAG-TREE-FIND-EQUIVALENT TREE1 VAL2))
                  ((NONNULL? VALUE COUNT
                    (AND EQVV1?
                         (EQUIVALENT-BAG-DIFFERENCE EQVV1 EQVC1 VAL2
                          COUNT2))))))
             (IF NONNULL?
                 (WB-BAG-TREE-CONCAT VALUE COUNT NEW-LEFT NEW-RIGHT)
                 (WB-BAG-TREE-JOIN NEW-LEFT NEW-RIGHT))))
          (T
           (LET ((VAL1 (WB-BAG-TREE-NODE-VALUE TREE1))
                 (COUNT1 (WB-BAG-TREE-NODE-COUNT TREE1))
                 ((NEW-LEFT
                   (WB-BAG-TREE-DIFF-RNG (WB-BAG-TREE-NODE-LEFT TREE1)
                    (WB-BAG-TREE-TRIM TREE2 LO VAL1) LO VAL1))
                  (NEW-RIGHT
                   (WB-BAG-TREE-DIFF-RNG (WB-BAG-TREE-NODE-RIGHT TREE1)
                    (WB-BAG-TREE-TRIM TREE2 VAL1 HI) VAL1 HI)))
                 ((EQVV2? EQVV2 EQVC2 (WB-BAG-TREE-FIND-EQUIVALENT TREE2 VAL1))
                  ((NONNULL? VALUE COUNT
                    (IF EQVV2?
                        (EQUIVALENT-BAG-DIFFERENCE VAL1 COUNT1 EQVV2 EQVC2)
                        (VALUES T VAL1 COUNT1))))))
             (IF NONNULL?
                 (WB-BAG-TREE-CONCAT VALUE COUNT NEW-LEFT NEW-RIGHT)
                 (WB-BAG-TREE-JOIN NEW-LEFT NEW-RIGHT))))))

[fset/Code/wb-trees.lisp:2467]
  (DEFUN WB-BAG-TREE-RANK-TRIM (TREE BASE LO HI)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-BAG-TREE TREE)
             (TYPE FIXNUM BASE LO HI)
             (VALUES WB-BAG-TREE FIXNUM))
    (IF (OR (NULL TREE) (CONSP TREE))
        (VALUES TREE BASE)
        (LET ((NODE-RANK
               (+ BASE (WB-BAG-TREE-SIZE (WB-BAG-TREE-NODE-LEFT TREE)))))
          (DECLARE (TYPE FIXNUM NODE-RANK))
          (IF (>= NODE-RANK LO)
              (IF (< NODE-RANK HI)
                  (VALUES TREE BASE)
                  (WB-BAG-TREE-RANK-TRIM (WB-BAG-TREE-NODE-LEFT TREE) BASE LO
                   HI))
              (WB-BAG-TREE-RANK-TRIM (WB-BAG-TREE-NODE-RIGHT TREE)
               (+ NODE-RANK (BAG-VALUE-SIZE (WB-BAG-TREE-NODE-VALUE TREE))) LO
               HI)))))

[fset/Code/wb-trees.lisp:2529]
  (DEFUN WB-BAG-TREE-RANK-PAIR-INTERNAL (TREE RANK)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-BAG-TREE TREE)
             (TYPE FIXNUM RANK))
    (COND ((NULL TREE) (ERROR "Bug in bag comparator"))
          ((CONSP TREE)
           (VALUES (SVREF (CAR TREE) RANK) (SVREF (CDR TREE) RANK) 0))
          (T
           (LET ((LEFT (WB-BAG-TREE-NODE-LEFT TREE))
                 ((LEFT-SIZE (WB-BAG-TREE-SIZE LEFT))))
             (IF (< RANK LEFT-SIZE)
                 (WB-BAG-TREE-RANK-PAIR-INTERNAL LEFT RANK)
                 (LET ((VAL (WB-BAG-TREE-NODE-VALUE TREE))
                       ((VAL-SIZE (BAG-VALUE-SIZE VAL))
                        (RANK (- RANK LEFT-SIZE))))
                   (DECLARE (TYPE FIXNUM RANK))
                   (IF (< RANK VAL-SIZE)
                       (VALUES VAL (WB-BAG-TREE-NODE-COUNT TREE) RANK)
                       (WB-BAG-TREE-RANK-PAIR-INTERNAL
                        (WB-BAG-TREE-NODE-RIGHT TREE)
                        (THE FIXNUM (- RANK VAL-SIZE))))))))))

[fset/Code/wb-trees.lisp:2563]
  (DEFUN WB-BAG-TREE-SUBBAG?-RNG (TREE1 TREE2 LO HI)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-BAG-TREE TREE1 TREE2))
    (COND ((NULL TREE1) T) ((EQ TREE1 TREE2) T)
          ((AND (CONSP TREE1) (OR (NULL TREE2) (CONSP TREE2)))
           (VECTOR-PAIR-BAG-SUBBAG? TREE1 TREE2 LO HI))
          ((CONSP TREE1)
           (LET ((VAL2 (WB-BAG-TREE-NODE-VALUE TREE2))
                 (COUNT2 (WB-BAG-TREE-NODE-COUNT TREE2)))
             (AND
              (WB-BAG-TREE-SUBBAG?-RNG (WB-BAG-TREE-TRIM TREE1 LO VAL2)
               (WB-BAG-TREE-NODE-LEFT TREE2) LO VAL2)
              (LET ((EQVV1?
                     EQVV1
                     EQVC1
                     (WB-BAG-TREE-FIND-EQUIVALENT TREE1 VAL2)))
                (AND
                 (OR (NOT EQVV1?)
                     (EQUIVALENT-BAG-SUBBAG? EQVV1 EQVC1 VAL2 COUNT2))
                 (WB-BAG-TREE-SUBBAG?-RNG (WB-BAG-TREE-TRIM TREE1 VAL2 HI)
                  (WB-BAG-TREE-NODE-RIGHT TREE2) VAL2 HI))))))
          (T
           (LET ((VAL1 (WB-BAG-TREE-NODE-VALUE TREE1))
                 (COUNT1 (WB-BAG-TREE-NODE-COUNT TREE1)))
             (AND
              (WB-BAG-TREE-SUBBAG?-RNG (WB-BAG-TREE-NODE-LEFT TREE1)
               (WB-BAG-TREE-TRIM TREE2 LO VAL1) LO VAL1)
              (LET ((EQVV2?
                     EQVV2
                     EQVC2
                     (WB-BAG-TREE-FIND-EQUIVALENT TREE2 VAL1)))
                (AND EQVV2? (EQUIVALENT-BAG-SUBBAG? VAL1 COUNT1 EQVV2 EQVC2)
                     (WB-BAG-TREE-SUBBAG?-RNG (WB-BAG-TREE-NODE-RIGHT TREE1)
                      (WB-BAG-TREE-TRIM TREE2 VAL1 HI) VAL1 HI))))))))

[fset/Code/wb-trees.lisp:2611]
  (DEFUN WB-SET-TREE-TO-BAG-TREE (TREE)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-SET-TREE TREE))
    (COND ((NULL TREE) NIL)
          ((SIMPLE-VECTOR-P TREE)
           (CONS TREE (MAKE-ARRAY (LENGTH TREE) :INITIAL-ELEMENT 1)))
          (T
           (LET ((VALUE (WB-SET-TREE-NODE-VALUE TREE))
                 (SIZE (WB-SET-TREE-NODE-SIZE TREE))
                 (NEW-LEFT
                  (WB-SET-TREE-TO-BAG-TREE (WB-SET-TREE-NODE-LEFT TREE)))
                 (NEW-RIGHT
                  (WB-SET-TREE-TO-BAG-TREE (WB-SET-TREE-NODE-RIGHT TREE))))
             (IF (EQUIVALENT-SET? VALUE)
                 (MAKE-RAW-WB-BAG-TREE-NODE SIZE SIZE
                  (MAKE-EQUIVALENT-BAG
                   (MAPCAR #'(LAMBDA (X) (CONS X 1))
                           (EQUIVALENT-SET-MEMBERS VALUE)))
                  0 NEW-LEFT NEW-RIGHT)
                 (MAKE-RAW-WB-BAG-TREE-NODE SIZE SIZE VALUE 1 NEW-LEFT
                  NEW-RIGHT))))))

[fset/Code/wb-trees.lisp:2630]
  (DEFUN WB-BAG-TREE-TO-SET-TREE (TREE)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-BAG-TREE TREE))
    (COND ((NULL TREE) NIL) ((CONSP TREE) (CAR TREE))
          (T
           (LET ((VALUE (WB-BAG-TREE-NODE-VALUE TREE))
                 (SIZE (WB-BAG-TREE-NODE-SIZE TREE))
                 (NEW-LEFT
                  (WB-BAG-TREE-TO-SET-TREE (WB-BAG-TREE-NODE-LEFT TREE)))
                 (NEW-RIGHT
                  (WB-BAG-TREE-TO-SET-TREE (WB-BAG-TREE-NODE-RIGHT TREE))))
             (IF (EQUIVALENT-BAG? VALUE)
                 (MAKE-RAW-WB-SET-TREE-NODE SIZE
                  (MAKE-EQUIVALENT-SET
                   (MAPCAR #'CAR (EQUIVALENT-BAG-ALIST VALUE)))
                  NEW-LEFT NEW-RIGHT)
                 (MAKE-RAW-WB-SET-TREE-NODE SIZE VALUE NEW-LEFT NEW-RIGHT))))))

[fset/Code/wb-trees.lisp:2651]
  (DEFUN WB-BAG-TREE-SPLIT (TREE LO HI)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-BAG-TREE TREE))
    (COND ((NULL TREE) NIL)
          ((AND (EQ LO HEDGE-NEGATIVE-INFINITY)
                (EQ HI HEDGE-POSITIVE-INFINITY))
           TREE)
          ((CONSP TREE)
           (LET ((VALS (THE SIMPLE-VECTOR (CAR TREE)))
                 (COUNTS (THE SIMPLE-VECTOR (CDR TREE)))
                 ((LEN (LENGTH VALS))
                  ((SPLIT-POINT-LO
                    (IF (EQ LO HEDGE-NEGATIVE-INFINITY)
                        0
                        (VECTOR-SET-BINARY-SEARCH-LO VALS LO)))
                   (SPLIT-POINT-HI
                    (IF (EQ HI HEDGE-POSITIVE-INFINITY)
                        LEN
                        (VECTOR-SET-BINARY-SEARCH-HI VALS HI))))))
             (AND (> SPLIT-POINT-HI SPLIT-POINT-LO)
                  (IF (AND (= SPLIT-POINT-LO 0) (= SPLIT-POINT-HI LEN))
                      TREE
                      (CONS (VECTOR-SUBSEQ VALS SPLIT-POINT-LO SPLIT-POINT-HI)
                            (VECTOR-SUBSEQ COUNTS SPLIT-POINT-LO
                             SPLIT-POINT-HI))))))
          ((NOT
            (OR (EQ LO HEDGE-NEGATIVE-INFINITY)
                (GREATER-THAN? (WB-BAG-TREE-NODE-VALUE TREE) LO)))
           (WB-BAG-TREE-SPLIT (WB-BAG-TREE-NODE-RIGHT TREE) LO HI))
          ((NOT
            (OR (EQ HI HEDGE-POSITIVE-INFINITY)
                (LESS-THAN? (WB-BAG-TREE-NODE-VALUE TREE) HI)))
           (WB-BAG-TREE-SPLIT (WB-BAG-TREE-NODE-LEFT TREE) LO HI))
          (T
           (LET ((NEW-LEFT
                  (WB-BAG-TREE-SPLIT (WB-BAG-TREE-NODE-LEFT TREE) LO
                   HEDGE-POSITIVE-INFINITY))
                 (NEW-RIGHT
                  (WB-BAG-TREE-SPLIT (WB-BAG-TREE-NODE-RIGHT TREE)
                   HEDGE-NEGATIVE-INFINITY HI)))
             (IF (AND (EQ NEW-LEFT (WB-BAG-TREE-NODE-LEFT TREE))
                      (EQ NEW-RIGHT (WB-BAG-TREE-NODE-RIGHT TREE)))
                 TREE
                 (WB-BAG-TREE-CONCAT (WB-BAG-TREE-NODE-VALUE TREE)
                  (WB-BAG-TREE-NODE-COUNT TREE) NEW-LEFT NEW-RIGHT))))))

[fset/Code/wb-trees.lisp:2691]
  (DEFUN WB-BAG-TREE-TRIM (TREE LO HI)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-BAG-TREE TREE))
    (COND ((NULL TREE) NIL)
          ((CONSP TREE)
           (AND
            (OR (EQ LO HEDGE-NEGATIVE-INFINITY)
                (GREATER-THAN?
                 (SVREF (CAR TREE)
                        (1- (LENGTH (THE SIMPLE-VECTOR (CAR TREE)))))
                 LO))
            (OR (EQ HI HEDGE-POSITIVE-INFINITY)
                (LESS-THAN? (SVREF (CAR TREE) 0) HI))
            TREE))
          (T
           (LET ((VAL (WB-BAG-TREE-NODE-VALUE TREE)))
             (IF (OR (EQ LO HEDGE-NEGATIVE-INFINITY) (GREATER-THAN? VAL LO))
                 (IF (OR (EQ HI HEDGE-POSITIVE-INFINITY) (LESS-THAN? VAL HI))
                     TREE
                     (WB-BAG-TREE-TRIM (WB-BAG-TREE-NODE-LEFT TREE) LO HI))
                 (WB-BAG-TREE-TRIM (WB-BAG-TREE-NODE-RIGHT TREE) LO HI))))))

[fset/Code/wb-trees.lisp:2714]
  (DEFUN WB-BAG-TREE-CONCAT (VALUE COUNT LEFT RIGHT)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-BAG-TREE LEFT RIGHT))
    (COND ((NULL LEFT) (WB-BAG-TREE-WITH RIGHT VALUE COUNT))
          ((NULL RIGHT) (WB-BAG-TREE-WITH LEFT VALUE COUNT))
          ((AND (WB-BAG-TREE-NODE? LEFT)
                (> (WB-BAG-TREE-SIZE LEFT)
                   (* (WB-BAG-TREE-SIZE RIGHT) WB-TREE-BALANCE-FACTOR)))
           (WB-BAG-TREE-BUILD-NODE (WB-BAG-TREE-NODE-VALUE LEFT)
            (WB-BAG-TREE-NODE-COUNT LEFT) (WB-BAG-TREE-NODE-LEFT LEFT)
            (WB-BAG-TREE-CONCAT VALUE COUNT (WB-BAG-TREE-NODE-RIGHT LEFT)
             RIGHT)))
          ((AND (WB-BAG-TREE-NODE? RIGHT)
                (> (WB-BAG-TREE-SIZE RIGHT)
                   (* (WB-BAG-TREE-SIZE LEFT) WB-TREE-BALANCE-FACTOR)))
           (WB-BAG-TREE-BUILD-NODE (WB-BAG-TREE-NODE-VALUE RIGHT)
            (WB-BAG-TREE-NODE-COUNT RIGHT)
            (WB-BAG-TREE-CONCAT VALUE COUNT LEFT (WB-BAG-TREE-NODE-LEFT RIGHT))
            (WB-BAG-TREE-NODE-RIGHT RIGHT)))
          (T (WB-BAG-TREE-BUILD-NODE VALUE COUNT LEFT RIGHT))))

[fset/Code/wb-trees.lisp:2748]
  (DEFUN WB-BAG-TREE-MINIMUM-PAIR (TREE)
    "Assumes `tree' is nonempty.  Returns the minimum value and count as two
values.  The value may be an `Equivalent-Bag', in which case, as usual, the
count is not meaningful."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-BAG-TREE TREE))
    (IF (CONSP TREE)
        (VALUES (SVREF (CAR TREE) 0) (SVREF (CDR TREE) 0))
        (LET ((LEFT (WB-BAG-TREE-NODE-LEFT TREE)))
          (IF LEFT
              (WB-BAG-TREE-MINIMUM-PAIR LEFT)
              (VALUES (WB-BAG-TREE-NODE-VALUE TREE)
                      (WB-BAG-TREE-NODE-COUNT TREE))))))

[fset/Code/wb-trees.lisp:2763]
  (DEFUN WB-BAG-TREE-LESS-MINIMUM (TREE)
    "Assumes `tree' is nonempty.  Returns a new tree with the minimum value
removed."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-BAG-TREE TREE))
    (IF (CONSP TREE)
        (AND (> (LENGTH (THE SIMPLE-VECTOR (CAR TREE))) 1)
             (CONS (VECTOR-SUBSEQ (CAR TREE) 1) (VECTOR-SUBSEQ (CDR TREE) 1)))
        (LET ((LEFT (WB-BAG-TREE-NODE-LEFT TREE)))
          (IF LEFT
              (WB-BAG-TREE-CONCAT (WB-BAG-TREE-NODE-VALUE TREE)
               (WB-BAG-TREE-NODE-COUNT TREE) (WB-BAG-TREE-LESS-MINIMUM LEFT)
               (WB-BAG-TREE-NODE-RIGHT TREE))
              (WB-BAG-TREE-NODE-RIGHT TREE)))))

[fset/Code/wb-trees.lisp:2780]
  (DEFUN WB-BAG-TREE-BUILD-NODE (VALUE COUNT LEFT RIGHT)
    "Constructs a `WB-Bag-Tree', performing one rebalancing step if required.
`value' must already be known to go between `left' and `right'."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-BAG-TREE LEFT RIGHT))
    (IF (AND (OR (NULL LEFT) (CONSP LEFT)) (OR (NULL RIGHT) (CONSP RIGHT)))
        (IF (AND (NOT (EQUIVALENT-BAG? VALUE))
                 (<
                  (+ (LENGTH-NV (THE (OR NULL SIMPLE-VECTOR) (CAR LEFT)))
                     (LENGTH-NV (THE (OR NULL SIMPLE-VECTOR) (CAR RIGHT))))
                  *WB-TREE-MAX-VECTOR-LENGTH*))
            (CONS
             (CONCATENATE 'SIMPLE-VECTOR (CAR LEFT) (VECTOR VALUE) (CAR RIGHT))
             (CONCATENATE 'SIMPLE-VECTOR (CDR LEFT) (VECTOR COUNT)
                          (CDR RIGHT)))
            (MAKE-WB-BAG-TREE-NODE VALUE COUNT LEFT RIGHT))
        (LET ((SIZL (WB-BAG-TREE-SIZE LEFT)) (SIZR (WB-BAG-TREE-SIZE RIGHT)))
          (COND
           ((AND (WB-BAG-TREE-NODE? LEFT)
                 (> SIZL (* SIZR WB-TREE-BALANCE-FACTOR)))
            (LET ((LL (WB-BAG-TREE-NODE-LEFT LEFT))
                  (RL (WB-BAG-TREE-NODE-RIGHT LEFT)))
              (IF (OR (NULL RL) (CONSP RL)
                      (<= (WB-BAG-TREE-SIZE RL) (WB-BAG-TREE-SIZE LL)))
                  (MAKE-WB-BAG-TREE-NODE (WB-BAG-TREE-NODE-VALUE LEFT)
                   (WB-BAG-TREE-NODE-COUNT LEFT) LL
                   (WB-BAG-TREE-BUILD-NODE VALUE COUNT RL RIGHT))
                  (MAKE-WB-BAG-TREE-NODE (WB-BAG-TREE-NODE-VALUE RL)
                   (WB-BAG-TREE-NODE-COUNT RL)
                   (WB-BAG-TREE-BUILD-NODE (WB-BAG-TREE-NODE-VALUE LEFT)
                    (WB-BAG-TREE-NODE-COUNT LEFT) LL
                    (WB-BAG-TREE-NODE-LEFT RL))
                   (WB-BAG-TREE-BUILD-NODE VALUE COUNT
                    (WB-BAG-TREE-NODE-RIGHT RL) RIGHT)))))
           ((AND (WB-BAG-TREE-NODE? RIGHT)
                 (> SIZR (* SIZL WB-TREE-BALANCE-FACTOR)))
            (LET ((LR (WB-BAG-TREE-NODE-LEFT RIGHT))
                  (RR (WB-BAG-TREE-NODE-RIGHT RIGHT)))
              (IF (OR (NULL LR) (CONSP LR)
                      (<= (WB-BAG-TREE-SIZE LR) (WB-BAG-TREE-SIZE RR)))
                  (MAKE-WB-BAG-TREE-NODE (WB-BAG-TREE-NODE-VALUE RIGHT)
                   (WB-BAG-TREE-NODE-COUNT RIGHT)
                   (WB-BAG-TREE-BUILD-NODE VALUE COUNT LEFT LR) RR)
                  (MAKE-WB-BAG-TREE-NODE (WB-BAG-TREE-NODE-VALUE LR)
                   (WB-BAG-TREE-NODE-COUNT LR)
                   (WB-BAG-TREE-BUILD-NODE VALUE COUNT LEFT
                    (WB-BAG-TREE-NODE-LEFT LR))
                   (WB-BAG-TREE-BUILD-NODE (WB-BAG-TREE-NODE-VALUE RIGHT)
                    (WB-BAG-TREE-NODE-COUNT RIGHT) (WB-BAG-TREE-NODE-RIGHT LR)
                    RR)))))
           (T (MAKE-WB-BAG-TREE-NODE VALUE COUNT LEFT RIGHT))))))

[fset/Code/wb-trees.lisp:2906]
  (DEFUN VECTOR-PAIR-BAG-UNION (PR1 PR2 LO HI)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE CONS PR1 PR2))
    (LET ((VALS1 (THE SIMPLE-VECTOR (CAR PR1)))
          (VALS2 (THE SIMPLE-VECTOR (CAR PR2)))
          (COUNTS1 (CDR PR1))
          (COUNTS2 (CDR PR2))
          (I1 0)
          (I2 0)
          ((LEN1 (LENGTH VALS1)) (LEN2 (LENGTH VALS2))))
      (DECLARE (TYPE FIXNUM I1 I2 LEN1 LEN2))
      (UNLESS (EQ LO HEDGE-NEGATIVE-INFINITY)
        (DO () ((OR (= I1 LEN1) (LESS-THAN? LO (SVREF VALS1 I1)))) (INCF I1))
        (DO () ((OR (= I2 LEN2) (LESS-THAN? LO (SVREF VALS2 I2)))) (INCF I2)))
      (UNLESS (EQ HI HEDGE-POSITIVE-INFINITY)
        (DO ()
            ((OR (= I1 LEN1) (LESS-THAN? (SVREF VALS1 (1- LEN1)) HI)))
          (DECF LEN1))
        (DO ()
            ((OR (= I2 LEN2) (LESS-THAN? (SVREF VALS2 (1- LEN2)) HI)))
          (DECF LEN2)))
      (DO ((VALS NIL)
           (COUNTS NIL)
           (ANY-EQUIVALENT? NIL))
          ((AND (= I1 LEN1) (= I2 LEN2))
           (VALUES
            (CONS (COERCE (NREVERSE VALS) 'SIMPLE-VECTOR)
                  (COERCE (NREVERSE COUNTS) 'SIMPLE-VECTOR))
            ANY-EQUIVALENT?))
        (COND
         ((= I1 LEN1)
          (DO ()
              ((= I2 LEN2))
            (PUSH (SVREF VALS2 I2) VALS)
            (PUSH (SVREF COUNTS2 I2) COUNTS)
            (INCF I2)))
         ((= I2 LEN2)
          (DO ()
              ((= I1 LEN1))
            (PUSH (SVREF VALS1 I1) VALS)
            (PUSH (SVREF COUNTS1 I1) COUNTS)
            (INCF I1)))
         (T
          (LET ((VAL1 (SVREF VALS1 I1))
                (VAL2 (SVREF VALS2 I2))
                ((COMP (COMPARE VAL1 VAL2))))
            (ECASE COMP
              (:EQUAL
               (PUSH VAL1 VALS)
               (PUSH (GEN MAX (SVREF COUNTS1 I1) (SVREF COUNTS2 I2)) COUNTS)
               (INCF I1)
               (INCF I2))
              (:LESS
               (PUSH VAL1 VALS)
               (PUSH (SVREF COUNTS1 I1) COUNTS)
               (INCF I1))
              (:GREATER
               (PUSH VAL2 VALS)
               (PUSH (SVREF COUNTS2 I2) COUNTS)
               (INCF I2))
              (:UNEQUAL
               (PUSH
                (EQUIVALENT-BAG-UNION VAL1 (SVREF COUNTS1 I1) VAL2
                 (SVREF COUNTS2 I2))
                VALS)
               (PUSH 0 COUNTS)
               (INCF I1)
               (INCF I2)
               (SETQ ANY-EQUIVALENT? T)))))))))

[fset/Code/wb-trees.lisp:2973]
  (DEFUN WB-BAG-TREE-VECTOR-PAIR-SUM (PR1 PR2 LO HI)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE CONS PR1 PR2))
    (LET ((NEW-PR ANY-EQUIVALENT? (VECTOR-PAIR-BAG-SUM PR1 PR2 LO HI))
          ((LEN (LENGTH (THE SIMPLE-VECTOR (CAR NEW-PR))))))
      (IF ANY-EQUIVALENT?
          (LET ((RESULT NIL))
            (DOTIMES (I LEN)
              (SETQ RESULT
                      (WB-BAG-TREE-WITH RESULT (SVREF (CAR NEW-PR) I)
                       (SVREF (CDR NEW-PR) I))))
            RESULT)
          (IF (> LEN *WB-TREE-MAX-VECTOR-LENGTH*)
              (LET ((SPLIT-POINT (FLOOR LEN 2)))
                (MAKE-WB-BAG-TREE-NODE (SVREF (CAR NEW-PR) SPLIT-POINT)
                 (SVREF (CDR NEW-PR) SPLIT-POINT)
                 (CONS (VECTOR-SUBSEQ (CAR NEW-PR) 0 SPLIT-POINT)
                       (VECTOR-SUBSEQ (CDR NEW-PR) 0 SPLIT-POINT))
                 (CONS (VECTOR-SUBSEQ (CAR NEW-PR) (1+ SPLIT-POINT))
                       (VECTOR-SUBSEQ (CDR NEW-PR) (1+ SPLIT-POINT)))))
              NEW-PR))))

[fset/Code/wb-trees.lisp:2996]
  (DEFUN VECTOR-PAIR-BAG-SUM (PR1 PR2 LO HI)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE CONS PR1 PR2))
    (LET ((VALS1 (THE SIMPLE-VECTOR (CAR PR1)))
          (VALS2 (THE SIMPLE-VECTOR (CAR PR2)))
          (COUNTS1 (CDR PR1))
          (COUNTS2 (CDR PR2))
          (I1 0)
          (I2 0)
          ((LEN1 (LENGTH VALS1)) (LEN2 (LENGTH VALS2))))
      (DECLARE (TYPE FIXNUM I1 I2 LEN1 LEN2))
      (UNLESS (EQ LO HEDGE-NEGATIVE-INFINITY)
        (DO () ((OR (= I1 LEN1) (LESS-THAN? LO (SVREF VALS1 I1)))) (INCF I1))
        (DO () ((OR (= I2 LEN2) (LESS-THAN? LO (SVREF VALS2 I2)))) (INCF I2)))
      (UNLESS (EQ HI HEDGE-POSITIVE-INFINITY)
        (DO ()
            ((OR (= I1 LEN1) (LESS-THAN? (SVREF VALS1 (1- LEN1)) HI)))
          (DECF LEN1))
        (DO ()
            ((OR (= I2 LEN2) (LESS-THAN? (SVREF VALS2 (1- LEN2)) HI)))
          (DECF LEN2)))
      (DO ((VALS NIL)
           (COUNTS NIL)
           (ANY-EQUIVALENT? NIL))
          ((AND (= I1 LEN1) (= I2 LEN2))
           (VALUES
            (CONS (COERCE (NREVERSE VALS) 'SIMPLE-VECTOR)
                  (COERCE (NREVERSE COUNTS) 'SIMPLE-VECTOR))
            ANY-EQUIVALENT?))
        (COND
         ((= I1 LEN1)
          (DO ()
              ((= I2 LEN2))
            (PUSH (SVREF VALS2 I2) VALS)
            (PUSH (SVREF COUNTS2 I2) COUNTS)
            (INCF I2)))
         ((= I2 LEN2)
          (DO ()
              ((= I1 LEN1))
            (PUSH (SVREF VALS1 I1) VALS)
            (PUSH (SVREF COUNTS1 I1) COUNTS)
            (INCF I1)))
         (T
          (LET ((VAL1 (SVREF VALS1 I1))
                (VAL2 (SVREF VALS2 I2))
                ((COMP (COMPARE VAL1 VAL2))))
            (ECASE COMP
              (:EQUAL
               (PUSH VAL1 VALS)
               (PUSH (GEN + (SVREF COUNTS1 I1) (SVREF COUNTS2 I2)) COUNTS)
               (INCF I1)
               (INCF I2))
              (:LESS
               (PUSH VAL1 VALS)
               (PUSH (SVREF COUNTS1 I1) COUNTS)
               (INCF I1))
              (:GREATER
               (PUSH VAL2 VALS)
               (PUSH (SVREF COUNTS2 I2) COUNTS)
               (INCF I2))
              (:UNEQUAL
               (PUSH
                (EQUIVALENT-BAG-UNION VAL1 (SVREF COUNTS1 I1) VAL2
                 (SVREF COUNTS2 I2))
                VALS)
               (PUSH 0 COUNTS)
               (INCF I1)
               (INCF I2)
               (SETQ ANY-EQUIVALENT? T)))))))))

[fset/Code/wb-trees.lisp:3063]
  (DEFUN VECTOR-PAIR-BAG-INTERSECT (PR1 PR2 LO HI)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE CONS PR1 PR2))
    (LET ((VALS1 (THE SIMPLE-VECTOR (CAR PR1)))
          (VALS2 (THE SIMPLE-VECTOR (CAR PR2)))
          (COUNTS1 (CDR PR1))
          (COUNTS2 (CDR PR2))
          (I1 0)
          (I2 0)
          ((LEN1 (LENGTH VALS1)) (LEN2 (LENGTH VALS2))))
      (DECLARE (TYPE FIXNUM I1 I2 LEN1 LEN2))
      (UNLESS (EQ LO HEDGE-NEGATIVE-INFINITY)
        (DO () ((OR (= I1 LEN1) (LESS-THAN? LO (SVREF VALS1 I1)))) (INCF I1))
        (DO () ((OR (= I2 LEN2) (LESS-THAN? LO (SVREF VALS2 I2)))) (INCF I2)))
      (UNLESS (EQ HI HEDGE-POSITIVE-INFINITY)
        (DO ()
            ((OR (= I1 LEN1) (LESS-THAN? (SVREF VALS1 (1- LEN1)) HI)))
          (DECF LEN1))
        (DO ()
            ((OR (= I2 LEN2) (LESS-THAN? (SVREF VALS2 (1- LEN2)) HI)))
          (DECF LEN2)))
      (DO ((VALS NIL)
           (COUNTS NIL))
          ((OR (= I1 LEN1) (= I2 LEN2))
           (AND VALS
                (CONS (COERCE (NREVERSE VALS) 'SIMPLE-VECTOR)
                      (COERCE (NREVERSE COUNTS) 'SIMPLE-VECTOR))))
        (LET ((VAL1 (SVREF VALS1 I1))
              (VAL2 (SVREF VALS2 I2))
              ((COMP (COMPARE VAL1 VAL2))))
          (ECASE COMP
            (:EQUAL
             (PUSH VAL1 VALS)
             (PUSH (GEN MIN (SVREF COUNTS1 I1) (SVREF COUNTS2 I2)) COUNTS)
             (INCF I1)
             (INCF I2))
            (:LESS (INCF I1))
            (:GREATER (INCF I2))
            (:UNEQUAL (INCF I1) (INCF I2)))))))

[fset/Code/wb-trees.lisp:3108]
  (DEFUN VECTOR-PAIR-BAG-PRODUCT (PR1 PR2 LO HI)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE CONS PR1 PR2))
    (LET ((VALS1 (THE SIMPLE-VECTOR (CAR PR1)))
          (VALS2 (THE SIMPLE-VECTOR (CAR PR2)))
          (COUNTS1 (CDR PR1))
          (COUNTS2 (CDR PR2))
          (I1 0)
          (I2 0)
          ((LEN1 (LENGTH VALS1)) (LEN2 (LENGTH VALS2))))
      (DECLARE (TYPE FIXNUM I1 I2 LEN1 LEN2))
      (UNLESS (EQ LO HEDGE-NEGATIVE-INFINITY)
        (DO () ((OR (= I1 LEN1) (LESS-THAN? LO (SVREF VALS1 I1)))) (INCF I1))
        (DO () ((OR (= I2 LEN2) (LESS-THAN? LO (SVREF VALS2 I2)))) (INCF I2)))
      (UNLESS (EQ HI HEDGE-POSITIVE-INFINITY)
        (DO ()
            ((OR (= I1 LEN1) (LESS-THAN? (SVREF VALS1 (1- LEN1)) HI)))
          (DECF LEN1))
        (DO ()
            ((OR (= I2 LEN2) (LESS-THAN? (SVREF VALS2 (1- LEN2)) HI)))
          (DECF LEN2)))
      (DO ((VALS NIL)
           (COUNTS NIL))
          ((OR (= I1 LEN1) (= I2 LEN2))
           (AND VALS
                (CONS (COERCE (NREVERSE VALS) 'SIMPLE-VECTOR)
                      (COERCE (NREVERSE COUNTS) 'SIMPLE-VECTOR))))
        (LET ((VAL1 (SVREF VALS1 I1))
              (VAL2 (SVREF VALS2 I2))
              ((COMP (COMPARE VAL1 VAL2))))
          (ECASE COMP
            (:EQUAL
             (PUSH VAL1 VALS)
             (PUSH (GEN * (SVREF COUNTS1 I1) (SVREF COUNTS2 I2)) COUNTS)
             (INCF I1)
             (INCF I2))
            (:LESS (INCF I1))
            (:GREATER (INCF I2))
            (:UNEQUAL (INCF I1) (INCF I2)))))))

[fset/Code/wb-trees.lisp:3153]
  (DEFUN VECTOR-PAIR-BAG-DIFF (PR1 PR2 LO HI)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE CONS PR1 PR2))
    (LET ((VALS1 (THE SIMPLE-VECTOR (CAR PR1)))
          (VALS2 (THE SIMPLE-VECTOR (CAR PR2)))
          (COUNTS1 (CDR PR1))
          (COUNTS2 (CDR PR2))
          (I1 0)
          (I2 0)
          ((LEN1 (LENGTH VALS1)) (LEN2 (LENGTH VALS2))))
      (DECLARE (TYPE FIXNUM I1 I2 LEN1 LEN2))
      (UNLESS (EQ LO HEDGE-NEGATIVE-INFINITY)
        (DO () ((OR (= I1 LEN1) (LESS-THAN? LO (SVREF VALS1 I1)))) (INCF I1)))
      (UNLESS (EQ HI HEDGE-POSITIVE-INFINITY)
        (DO ()
            ((OR (= I1 LEN1) (LESS-THAN? (SVREF VALS1 (1- LEN1)) HI)))
          (DECF LEN1)))
      (DO ((VALS NIL)
           (COUNTS NIL))
          ((OR (= I1 LEN1) (= I2 LEN2))
           (DO ()
               ((= I1 LEN1))
             (PUSH (SVREF VALS1 I1) VALS)
             (PUSH (SVREF COUNTS1 I1) COUNTS)
             (INCF I1))
           (AND VALS
                (CONS (COERCE (NREVERSE VALS) 'SIMPLE-VECTOR)
                      (COERCE (NREVERSE COUNTS) 'SIMPLE-VECTOR))))
        (LET ((V1 (SVREF VALS1 I1))
              (V2 (SVREF VALS2 I2))
              ((COMP (COMPARE V1 V2))))
          (ECASE COMP
            ((:EQUAL)
             (LET ((C1 (THE INTEGER (SVREF COUNTS1 I1)))
                   ((C (GEN - C1 (SVREF COUNTS2 I2)))))
               (WHEN (GEN > C 0) (PUSH V1 VALS) (PUSH C COUNTS)))
             (INCF I1)
             (INCF I2))
            ((:LESS) (PUSH V1 VALS) (PUSH (SVREF COUNTS1 I1) COUNTS) (INCF I1))
            ((:GREATER) (INCF I2))
            ((:UNEQUAL)
             (PUSH V1 VALS)
             (PUSH (SVREF COUNTS1 I1) COUNTS)
             (INCF I1)
             (INCF I2)))))))

[fset/Code/wb-trees.lisp:3204]
  (DEFUN VECTOR-PAIR-BAG-SUBBAG? (PR1 PR2 LO HI)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE CONS PR1 PR2))
    (LET ((VALS1 (THE SIMPLE-VECTOR (CAR PR1)))
          (VALS2 (THE SIMPLE-VECTOR (CAR PR2)))
          (COUNTS1 (CDR PR1))
          (COUNTS2 (CDR PR2))
          (I1 0)
          (I2 0)
          ((LEN1 (LENGTH VALS1)) (LEN2 (LENGTH VALS2))))
      (DECLARE (TYPE FIXNUM I1 I2 LEN1 LEN2))
      (UNLESS (EQ LO HEDGE-NEGATIVE-INFINITY)
        (DO () ((OR (= I1 LEN1) (LESS-THAN? LO (SVREF VALS1 I1)))) (INCF I1)))
      (UNLESS (EQ HI HEDGE-POSITIVE-INFINITY)
        (DO ()
            ((OR (= I1 LEN1) (LESS-THAN? (SVREF VALS1 (1- LEN1)) HI)))
          (DECF LEN1)))
      (DO ()
          ((OR (= I1 LEN1) (= I2 LEN2)) (= I1 LEN1))
        (LET ((V1 (SVREF VALS1 I1))
              (V2 (SVREF VALS2 I2))
              ((COMP (COMPARE V1 V2))))
          (ECASE COMP
            ((:EQUAL)
             (WHEN (GEN > (SVREF COUNTS1 I1) (SVREF COUNTS2 I2)) (RETURN NIL))
             (INCF I1)
             (INCF I2))
            ((:LESS) (RETURN NIL))
            ((:GREATER) (INCF I2))
            ((:UNEQUAL) (RETURN NIL)))))))

[fset/Code/wb-trees.lisp:3287]
  (DEFUN WB-BAG-TREE-ITERATOR-CANONICALIZE (ITER)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LOOP
     (LET ((SP (SVREF ITER 0))
           ((NODE (SVREF ITER SP))
            (IDX1 (SVREF ITER (+ SP 1)))
            (IDX2 (SVREF ITER (+ SP 2)))))
       (DECLARE (FIXNUM SP IDX1 IDX2))
       (COND
        ((NULL NODE)
         (IF (= SP 1)
             (RETURN)
             (PROGN
              (DECF SP 3)
              (SETF (SVREF ITER 0) SP)
              (INCF (THE FIXNUM (SVREF ITER (+ SP 1)))))))
        ((CONSP NODE)
         (COND
          ((< IDX1 (LENGTH (THE SIMPLE-VECTOR (CDR NODE))))
           (IF (< IDX2 (THE FIXNUM (SVREF (CDR NODE) IDX1)))
               (RETURN)
               (PROGN
                (INCF (THE FIXNUM (SVREF ITER (+ SP 1))))
                (SETF (SVREF ITER (+ SP 2)) 0))))
          ((= SP 1) (SETF (SVREF ITER 1) NIL) (RETURN))
          (T (DECF SP 3) (SETF (SVREF ITER 0) SP)
           (INCF (THE FIXNUM (SVREF ITER (+ SP 1)))))))
        ((= IDX1 0)
         (UNLESS (< (+ SP 5) (LENGTH ITER))
           (ERROR
            "Internal FSet error: iterator stack overflow.  Please report this bug."))
         (INCF SP 3) (SETF (SVREF ITER 0) SP)
         (SETF (SVREF ITER SP) (WB-BAG-TREE-NODE-LEFT NODE))
         (SETF (SVREF ITER (+ SP 1)) 0) (SETF (SVREF ITER (+ SP 2)) 0))
        (T
         (LET ((VAL (WB-BAG-TREE-NODE-VALUE NODE)))
           (IF (EQUIVALENT-BAG? VAL)
               (LET ((ALIST (EQUIVALENT-BAG-ALIST VAL)))
                 (IF (< (1- IDX1) (LENGTH ALIST))
                     (IF (< IDX2 (THE FIXNUM (CDR (NTH (1- IDX1) ALIST))))
                         (RETURN)
                         (PROGN
                          (INCF (THE FIXNUM (SVREF ITER (+ SP 1))))
                          (SETF (SVREF ITER (+ SP 2)) 0)))
                     (PROGN
                      (SETF (SVREF ITER SP) (WB-BAG-TREE-NODE-RIGHT NODE))
                      (SETF (SVREF ITER (+ SP 1)) 0)
                      (SETF (SVREF ITER (+ SP 2)) 0))))
               (IF (= IDX1 1)
                   (IF (< IDX2 (THE FIXNUM (WB-BAG-TREE-NODE-COUNT NODE)))
                       (RETURN)
                       (INCF (THE FIXNUM (SVREF ITER (+ SP 1)))))
                   (PROGN
                    (SETF (SVREF ITER SP) (WB-BAG-TREE-NODE-RIGHT NODE))
                    (SETF (SVREF ITER (+ SP 1)) 0)
                    (SETF (SVREF ITER (+ SP 2)) 0)))))))))
    ITER)

[fset/Code/wb-trees.lisp:3350]
  (DEFUN WB-BAG-TREE-ITERATOR-DONE? (ITER)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (NULL (SVREF ITER (SVREF ITER 0))))

[fset/Code/wb-trees.lisp:3354]
  (DEFUN WB-BAG-TREE-ITERATOR-GET (ITER)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((SP (SVREF ITER 0))
          ((NODE (SVREF ITER SP)) (IDX1 (SVREF ITER (+ SP 1)))))
      (DECLARE (FIXNUM SP IDX1))
      (COND ((NULL NODE) (VALUES NIL NIL))
            ((CONSP NODE)
             (PROGN
              (INCF (THE FIXNUM (SVREF ITER (+ SP 2))))
              (WB-BAG-TREE-ITERATOR-CANONICALIZE ITER)
              (VALUES (SVREF (CAR NODE) IDX1) T)))
            (T
             (LET ((VAL (WB-BAG-TREE-NODE-VALUE NODE)))
               (IF (EQUIVALENT-BAG? VAL)
                   (LET ((ALIST (EQUIVALENT-BAG-ALIST VAL)))
                     (INCF (THE FIXNUM (SVREF ITER (+ SP 2))))
                     (WB-BAG-TREE-ITERATOR-CANONICALIZE ITER)
                     (VALUES (CAR (NTH (1- IDX1) ALIST)) T))
                   (PROGN
                    (INCF (THE FIXNUM (SVREF ITER (+ SP 2))))
                    (WB-BAG-TREE-ITERATOR-CANONICALIZE ITER)
                    (VALUES VAL T))))))))

[fset/Code/wb-trees.lisp:3394]
  (DEFUN WB-BAG-TREE-PAIR-ITERATOR-CANONICALIZE (ITER)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LOOP
     (LET ((SP (SVREF ITER 0))
           ((NODE (SVREF ITER SP)) (IDX (SVREF ITER (1+ SP)))))
       (DECLARE (FIXNUM SP IDX))
       (COND
        ((NULL NODE)
         (IF (= SP 1)
             (RETURN)
             (PROGN
              (DECF SP 2)
              (SETF (SVREF ITER 0) SP)
              (INCF (THE FIXNUM (SVREF ITER (1+ SP)))))))
        ((CONSP NODE)
         (COND ((< IDX (LENGTH (THE SIMPLE-ARRAY (CAR NODE)))) (RETURN))
               ((= SP 1) (SETF (SVREF ITER 1) NIL) (RETURN))
               (T (DECF SP 2) (SETF (SVREF ITER 0) SP)
                (INCF (THE FIXNUM (SVREF ITER (1+ SP)))))))
        ((= IDX 0)
         (UNLESS (< (+ SP 3) (LENGTH ITER))
           (ERROR
            "Internal FSet error: iterator stack overflow.  Please report this bug."))
         (INCF SP 2) (SETF (SVREF ITER 0) SP)
         (SETF (SVREF ITER SP) (WB-BAG-TREE-NODE-LEFT NODE))
         (SETF (SVREF ITER (1+ SP)) 0))
        ((= IDX (1+ (BAG-VALUE-SIZE (WB-BAG-TREE-NODE-VALUE NODE))))
         (SETF (SVREF ITER SP) (WB-BAG-TREE-NODE-RIGHT NODE))
         (SETF (SVREF ITER (1+ SP)) 0))
        (T (RETURN)))))
    ITER)

[fset/Code/wb-trees.lisp:3432]
  (DEFUN WB-BAG-TREE-PAIR-ITERATOR-DONE? (ITER)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (NULL (SVREF ITER (SVREF ITER 0))))

[fset/Code/wb-trees.lisp:3436]
  (DEFUN WB-BAG-TREE-PAIR-ITERATOR-GET (ITER)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((SP (SVREF ITER 0))
          ((NODE (SVREF ITER SP)) (IDX (SVREF ITER (1+ SP)))))
      (DECLARE (FIXNUM IDX))
      (IF (NULL NODE)
          (VALUES NIL NIL NIL)
          (PROGN
           (INCF (THE FIXNUM (SVREF ITER (1+ SP))))
           (WB-BAG-TREE-PAIR-ITERATOR-CANONICALIZE ITER)
           (IF (CONSP NODE)
               (VALUES (SVREF (CAR NODE) IDX) (SVREF (CDR NODE) IDX) T)
               (LET ((VAL (WB-BAG-TREE-NODE-VALUE NODE)))
                 (IF (EQUIVALENT-BAG? VAL)
                     (LET ((PR (NTH (1- IDX) (EQUIVALENT-BAG-ALIST VAL))))
                       (VALUES (CAR PR) (CDR PR) T))
                     (VALUES VAL (WB-BAG-TREE-NODE-COUNT NODE) T))))))))

[fset/Code/wb-trees.lisp:3458]
  (DEFUN EQUIVALENT-BAG-SUM (VAL1 COUNT1 VAL2 COUNT2)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE INTEGER COUNT1 COUNT2))
    (IF (EQUIVALENT-BAG? VAL1)
        (LET ((ALIST1 (EQUIVALENT-BAG-ALIST VAL1)))
          (IF (EQUIVALENT-BAG? VAL2)
              (LET ((ALIST2 (COPY-LIST (EQUIVALENT-BAG-ALIST VAL2)))
                    (RESULT NIL))
                (DOLIST (PR1 ALIST1)
                  (LET ((PR2 (ASSOC (CAR PR1) ALIST2 :TEST #'EQUAL?)))
                    (IF PR2
                        (PROGN
                         (PUSH (CONS (CAR PR1) (GEN + (CDR PR1) (CDR PR2)))
                               RESULT)
                         (SETQ ALIST2 (DELETE PR2 ALIST2)))
                        (PUSH PR1 RESULT))))
                (SETQ RESULT (NCONC ALIST2 RESULT))
                (MAKE-EQUIVALENT-BAG RESULT))
              (LET ((PR1 (ASSOC VAL2 ALIST1 :TEST #'EQUAL?)))
                (IF PR1
                    (MAKE-EQUIVALENT-BAG
                     (CONS (CONS VAL2 (GEN + (CDR PR1) COUNT2))
                           (REMOVE PR1 ALIST1)))
                    (MAKE-EQUIVALENT-BAG (CONS (CONS VAL2 COUNT2) ALIST1))))))
        (IF (EQUIVALENT-BAG? VAL2)
            (EQUIVALENT-BAG-SUM VAL2 COUNT2 VAL1 COUNT1)
            (IF (EQUAL? VAL1 VAL2)
                (VALUES VAL1 (GEN + COUNT1 COUNT2))
                (MAKE-EQUIVALENT-BAG
                 (LIST (CONS VAL1 COUNT1) (CONS VAL2 COUNT2)))))))

[fset/Code/wb-trees.lisp:3486]
  (DEFUN EQUIVALENT-BAG-UNION (VAL1 COUNT1 VAL2 COUNT2)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE INTEGER COUNT1 COUNT2))
    (IF (EQUIVALENT-BAG? VAL1)
        (LET ((ALIST1 (EQUIVALENT-BAG-ALIST VAL1)))
          (IF (EQUIVALENT-BAG? VAL2)
              (LET ((ALIST2 (COPY-LIST (EQUIVALENT-BAG-ALIST VAL2)))
                    (RESULT NIL))
                (DOLIST (PR1 ALIST1)
                  (LET ((PR2 (ASSOC (CAR PR1) ALIST2 :TEST #'EQUAL?)))
                    (IF PR2
                        (PROGN
                         (PUSH (CONS (CAR PR1) (GEN MAX (CDR PR1) (CDR PR2)))
                               RESULT)
                         (SETQ ALIST2 (DELETE PR2 ALIST2)))
                        (PUSH PR1 RESULT))))
                (SETQ RESULT (NCONC ALIST2 RESULT))
                (MAKE-EQUIVALENT-BAG RESULT))
              (LET ((PR1 (ASSOC VAL2 ALIST1 :TEST #'EQUAL?)))
                (IF PR1
                    (MAKE-EQUIVALENT-BAG
                     (CONS (CONS VAL2 (GEN MAX (CDR PR1) COUNT2))
                           (REMOVE PR1 ALIST1)))
                    (MAKE-EQUIVALENT-BAG (CONS (CONS VAL2 COUNT2) ALIST1))))))
        (IF (EQUIVALENT-BAG? VAL2)
            (EQUIVALENT-BAG-UNION VAL2 COUNT2 VAL1 COUNT1)
            (IF (EQUAL? VAL1 VAL2)
                (VALUES VAL1 (GEN MAX COUNT1 COUNT2))
                (MAKE-EQUIVALENT-BAG
                 (LIST (CONS VAL1 COUNT1) (CONS VAL2 COUNT2)))))))

[fset/Code/wb-trees.lisp:3514]
  (DEFUN EQUIVALENT-BAG-INTERSECT (VAL1 COUNT1 VAL2 COUNT2)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE INTEGER COUNT1 COUNT2))
    (IF (EQUIVALENT-BAG? VAL1)
        (LET ((ALIST1 (EQUIVALENT-BAG-ALIST VAL1)))
          (IF (EQUIVALENT-BAG? VAL2)
              (LET ((ALIST2 (EQUIVALENT-BAG-ALIST VAL2)) (RESULT NIL))
                (DOLIST (PR1 ALIST1)
                  (LET ((PR2 (ASSOC (CAR PR1) ALIST2 :TEST #'EQUAL?)))
                    (WHEN PR2
                      (PUSH (CONS (CAR PR1) (GEN MIN (CDR PR1) (CDR PR2)))
                            RESULT))))
                (COND ((NULL RESULT) NIL)
                      ((NULL (CDR RESULT))
                       (VALUES T (CAAR RESULT) (CDAR RESULT)))
                      (T (VALUES T (MAKE-EQUIVALENT-BAG RESULT)))))
              (LET ((PR1 (ASSOC VAL2 ALIST1 :TEST #'EQUAL?)))
                (AND PR1 (VALUES T VAL2 (GEN MIN (CDR PR1) COUNT2))))))
        (IF (EQUIVALENT-BAG? VAL2)
            (LET ((PR2 (ASSOC VAL1 (EQUIVALENT-BAG-ALIST VAL2) :TEST #'EQUAL?)))
              (AND PR2 (VALUES T VAL1 (GEN MIN COUNT1 (CDR PR2)))))
            (AND (EQUAL? VAL1 VAL2) (VALUES T VAL1 (GEN MIN COUNT1 COUNT2))))))

[fset/Code/wb-trees.lisp:3539]
  (DEFUN EQUIVALENT-BAG-PRODUCT (VAL1 COUNT1 VAL2 COUNT2)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE INTEGER COUNT1 COUNT2))
    (IF (EQUIVALENT-BAG? VAL1)
        (LET ((ALIST1 (EQUIVALENT-BAG-ALIST VAL1)))
          (IF (EQUIVALENT-BAG? VAL2)
              (LET ((ALIST2 (EQUIVALENT-BAG-ALIST VAL2)) (RESULT NIL))
                (DOLIST (PR1 ALIST1)
                  (LET ((PR2 (ASSOC (CAR PR1) ALIST2 :TEST #'EQUAL?)))
                    (WHEN PR2
                      (PUSH (CONS (CAR PR1) (GEN * (CDR PR1) (CDR PR2)))
                            RESULT))))
                (COND ((NULL RESULT) NIL)
                      ((NULL (CDR RESULT))
                       (VALUES T (CAAR RESULT) (CDAR RESULT)))
                      (T (VALUES T (MAKE-EQUIVALENT-BAG RESULT)))))
              (LET ((PR1 (ASSOC VAL2 ALIST1 :TEST #'EQUAL?)))
                (AND PR1 (VALUES T VAL2 (GEN * (CDR PR1) COUNT2))))))
        (IF (EQUIVALENT-BAG? VAL2)
            (LET ((PR2 (ASSOC VAL1 (EQUIVALENT-BAG-ALIST VAL2) :TEST #'EQUAL?)))
              (AND PR2 (VALUES T VAL1 (GEN * COUNT1 (CDR PR2)))))
            (AND (EQUAL? VAL1 VAL2) (VALUES T VAL1 (GEN * COUNT1 COUNT2))))))

[fset/Code/wb-trees.lisp:3564]
  (DEFUN EQUIVALENT-BAG-DIFFERENCE (VAL1 COUNT1 VAL2 COUNT2)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE INTEGER COUNT1 COUNT2))
    (IF (EQUIVALENT-BAG? VAL1)
        (LET ((ALIST1 (EQUIVALENT-BAG-ALIST VAL1))
              (ALIST2
               (IF (EQUIVALENT-BAG? VAL2)
                   (EQUIVALENT-BAG-ALIST VAL2)
                   (LIST (CONS VAL2 COUNT2))))
              (RESULT NIL))
          (DOLIST (PR1 ALIST1)
            (LET ((PR2 (ASSOC (CAR PR1) ALIST2 :TEST #'EQUAL?)))
              (COND ((NULL PR2) (PUSH PR1 RESULT))
                    ((GEN > (CDR PR1) (CDR PR2))
                     (PUSH (CONS (CAR PR1) (GEN - (CDR PR1) (CDR PR2)))
                           RESULT)))))
          (COND ((NULL RESULT) NIL)
                ((NULL (CDR RESULT)) (VALUES T (CAAR RESULT) (CDAR RESULT)))
                (T (VALUES T (MAKE-EQUIVALENT-BAG RESULT)))))
        (IF (EQUIVALENT-BAG? VAL2)
            (LET ((PR2 (ASSOC VAL1 (EQUIVALENT-BAG-ALIST VAL2) :TEST #'EQUAL?)))
              (COND ((NULL PR2) (VALUES T VAL1 COUNT1))
                    ((GEN > COUNT1 (CDR PR2))
                     (VALUES T VAL1 (GEN - COUNT1 (CDR PR2))))))
            (IF (EQUAL? VAL1 VAL2)
                (AND (GEN > COUNT1 COUNT2)
                     (VALUES T VAL1 (GEN - COUNT1 COUNT2)))
                (VALUES T VAL1 COUNT1)))))

[fset/Code/wb-trees.lisp:3593]
  (DEFUN EQUIVALENT-BAG-SUBBAG? (VAL1 COUNT1 VAL2 COUNT2)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE INTEGER COUNT1 COUNT2))
    (IF (EQUIVALENT-BAG? VAL1)
        (AND (EQUIVALENT-BAG? VAL2)
             (LET ((ALIST2 (EQUIVALENT-BAG-ALIST VAL2)))
               (DOLIST (PR1 (EQUIVALENT-BAG-ALIST VAL1) T)
                 (LET ((PR2 (ASSOC (CAR PR1) ALIST2 :TEST #'EQUAL?)))
                   (UNLESS (AND PR2 (GEN <= (CDR PR1) (CDR PR2)))
                     (RETURN NIL))))))
        (IF (EQUIVALENT-BAG? VAL2)
            (LET ((PR2 (ASSOC VAL1 (EQUIVALENT-BAG-ALIST VAL2) :TEST #'EQUAL?)))
              (AND PR2 (GEN <= COUNT1 (CDR PR2))))
            (AND (EQUAL? VAL1 VAL2) (GEN <= COUNT1 COUNT2)))))

[fset/Code/wb-trees.lisp:3609]
  (DEFUN EQUIVALENT-BAG-COMPARE (VAL1 COUNT1 VAL2 COUNT2)
    "Compares two pairs where the key of either or both may be an `Equivalent-Bag'."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE INTEGER COUNT1 COUNT2))
    (LET ((COMP (COMPARE VAL1 VAL2)))
      (IF (OR (EQ COMP ':LESS) (EQ COMP ':GREATER))
          COMP
          (IF (EQUIVALENT-BAG? VAL1)
              (IF (EQUIVALENT-BAG? VAL2)
                  (LET ((MEMS1 (EQUIVALENT-BAG-ALIST VAL1))
                        (MEMS2 (EQUIVALENT-BAG-ALIST VAL2))
                        ((LEN1 (LENGTH MEMS1)) (LEN2 (LENGTH MEMS2))))
                    (COND ((< LEN1 LEN2) ':GREATER) ((> LEN1 LEN2) ':LESS)
                          ((EVERY
                            #'(LAMBDA (PR1)
                                (LET ((PR2
                                       (ASSOC (CAR PR1) MEMS2 :TEST #'EQUAL?)))
                                  (AND PR2 (EQUAL? (CDR PR1) (CDR PR2)))))
                            MEMS1)
                           ':EQUAL)
                          (T
                           (LET ((SET1
                                  (REDUCE #'WB-SET-TREE-WITH
                                          (MAPCAR #'CDR MEMS1) :INITIAL-VALUE
                                          NIL))
                                 (SET2
                                  (REDUCE #'WB-SET-TREE-WITH
                                          (MAPCAR #'CDR MEMS2) :INITIAL-VALUE
                                          NIL))
                                 ((COMP (WB-SET-TREE-COMPARE SET1 SET2))))
                             (IF (EQ COMP ':EQUAL)
                                 ':UNEQUAL
                                 COMP)))))
                  ':LESS)
              (COND ((EQUIVALENT-BAG? VAL2) ':GREATER)
                    ((GEN < COUNT1 COUNT2) ':LESS)
                    ((GEN > COUNT1 COUNT2) ':GREATER) (T COMP))))))

[fset/Code/wb-trees.lisp:3729]
  (DEFUN MAKE-WB-MAP-TREE-NODE (KEY VALUE LEFT RIGHT)
    "The low-level constructor for a map tree node."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (MAKE-RAW-WB-MAP-TREE-NODE
     (THE FIXNUM
          (+ (WB-MAP-TREE-SIZE LEFT) (WB-MAP-TREE-SIZE RIGHT)
             (MAP-KEY-SIZE KEY)))
     KEY VALUE LEFT RIGHT))

[fset/Code/wb-trees.lisp:3738]
  (DEFUN WB-MAP-TREE-ARB-PAIR (TREE)
    "Selects an arbitrary pair of the map.  Assumes it is nonnull."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-MAP-TREE TREE))
    (COND ((NULL TREE) (ERROR "`WB-Map-Tree-Arb-Pair' called on empty tree"))
          ((CONSP TREE) (VALUES (SVREF (CAR TREE) 0) (SVREF (CDR TREE) 0)))
          (T
           (LET ((KEY (WB-MAP-TREE-NODE-KEY TREE)))
             (IF (EQUIVALENT-MAP? KEY)
                 (LET ((PR (CAR (EQUIVALENT-MAP-ALIST KEY))))
                   (VALUES (CAR PR) (CDR PR)))
                 (VALUES KEY (WB-MAP-TREE-NODE-VALUE TREE)))))))

[fset/Code/wb-trees.lisp:3753]
  (DEFUN WB-MAP-TREE-LEAST-PAIR (TREE)
    "Assumes `tree' is nonempty.  Returns the least key and its value, or an
arbitrary least key and its value if there are more than one."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-MAP-TREE TREE))
    (LET ((KEY VAL (WB-MAP-TREE-MINIMUM-PAIR TREE)))
      (IF (EQUIVALENT-MAP? KEY)
          (LET ((PR (CAR (EQUIVALENT-MAP-ALIST KEY))))
            (VALUES (CAR PR) (CDR PR)))
          (VALUES KEY VAL))))

[fset/Code/wb-trees.lisp:3766]
  (DEFUN WB-MAP-TREE-LESS-LEAST-PAIR (TREE)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-MAP-TREE TREE))
    (COND ((NULL TREE) NIL)
          ((CONSP TREE)
           (AND (> (LENGTH (THE SIMPLE-VECTOR (CAR TREE))) 1)
                (CONS (VECTOR-SUBSEQ (CAR TREE) 1)
                      (VECTOR-SUBSEQ (CDR TREE) 1))))
          (T
           (LET ((LEFT (WB-MAP-TREE-NODE-LEFT TREE)))
             (IF LEFT
                 (WB-MAP-TREE-BUILD-NODE (WB-MAP-TREE-NODE-KEY TREE)
                  (WB-MAP-TREE-NODE-VALUE TREE)
                  (WB-MAP-TREE-LESS-LEAST-PAIR LEFT)
                  (WB-MAP-TREE-NODE-RIGHT TREE))
                 (LET ((KEY (WB-MAP-TREE-NODE-KEY TREE)))
                   (IF (EQUIVALENT-MAP? KEY)
                       (LET ((ALIST (EQUIVALENT-MAP-ALIST KEY)))
                         (IF (= (LENGTH ALIST) 2)
                             (MAKE-WB-MAP-TREE-NODE (CAADR ALIST) (CDADR ALIST)
                              NIL (WB-MAP-TREE-NODE-RIGHT TREE))
                             (MAKE-WB-MAP-TREE-NODE
                              (MAKE-EQUIVALENT-MAP (CDR ALIST)) 0 NIL
                              (WB-MAP-TREE-NODE-RIGHT TREE))))
                       (WB-MAP-TREE-NODE-RIGHT TREE))))))))

[fset/Code/wb-trees.lisp:3792]
  (DEFUN WB-MAP-TREE-GREATEST-PAIR (TREE)
    "Assumes `tree' is nonempty.  Returns the greatest key and its value, or an
arbitrary greatest key and its value if there are more than one."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-MAP-TREE TREE))
    (IF (CONSP TREE)
        (LET ((IDX (1- (LENGTH (THE SIMPLE-VECTOR (CAR TREE))))))
          (VALUES (SVREF (CAR TREE) IDX) (SVREF (CDR TREE) IDX)))
        (LET ((RIGHT (WB-MAP-TREE-NODE-RIGHT TREE)))
          (IF RIGHT
              (WB-MAP-TREE-GREATEST-PAIR RIGHT)
              (LET ((KEY (WB-MAP-TREE-NODE-KEY TREE)))
                (IF (EQUIVALENT-MAP? KEY)
                    (LET ((PR (CAR (LAST (EQUIVALENT-MAP-ALIST KEY)))))
                      (VALUES (CAR PR) (CDR PR)))
                    (VALUES KEY (WB-MAP-TREE-NODE-VALUE TREE))))))))

[fset/Code/wb-trees.lisp:3814]
  (DEFUN WB-MAP-TREE-LOOKUP (TREE KEY)
    "If `tree' contains a pair whose key is `key', returns two values, true and
the associated value; otherwise `nil'."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-MAP-TREE TREE))
    (COND ((NULL TREE) NIL)
          ((CONSP TREE)
           (LET ((FOUND? IDX (VECTOR-SET-BINARY-SEARCH (CAR TREE) KEY)))
             (AND (EQ FOUND? ':EQUAL) (VALUES T (SVREF (CDR TREE) IDX)))))
          (T
           (LET ((NODE-KEY (WB-MAP-TREE-NODE-KEY TREE))
                 ((COMP (COMPARE KEY NODE-KEY))))
             (ECASE COMP
               ((:EQUAL :UNEQUAL)
                (IF (EQUIVALENT-MAP? NODE-KEY)
                    (LET ((PR
                           (ASSOC KEY (EQUIVALENT-MAP-ALIST NODE-KEY) :TEST
                                  #'EQUAL?)))
                      (AND PR (VALUES T (CDR PR))))
                    (AND (EQ COMP ':EQUAL)
                         (VALUES T (WB-MAP-TREE-NODE-VALUE TREE)))))
               (:LESS (WB-MAP-TREE-LOOKUP (WB-MAP-TREE-NODE-LEFT TREE) KEY))
               (:GREATER
                (WB-MAP-TREE-LOOKUP (WB-MAP-TREE-NODE-RIGHT TREE) KEY)))))))

[fset/Code/wb-trees.lisp:3839]
  (DEFUN WB-MAP-TREE-FIND-EQUIVALENT (TREE KEY)
    "If `tree' contains one or more keys equivalent to `value', returns (first
value) true, (second value) either the one key or an `Equivalent-Map'
containing the values, and (third value) if the second value was a single
key, the corresponding value; otherwise `nil'."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-MAP-TREE TREE))
    (COND ((NULL TREE) NIL)
          ((CONSP TREE)
           (LET ((FOUND? IDX (VECTOR-SET-BINARY-SEARCH (CAR TREE) KEY)))
             (AND FOUND?
                  (VALUES T (SVREF (CAR TREE) IDX) (SVREF (CDR TREE) IDX)))))
          (T
           (LET ((NODE-KEY (WB-MAP-TREE-NODE-KEY TREE))
                 ((COMP (COMPARE KEY NODE-KEY))))
             (ECASE COMP
               ((:EQUAL :UNEQUAL)
                (VALUES T NODE-KEY (WB-MAP-TREE-NODE-VALUE TREE)))
               (:LESS
                (WB-MAP-TREE-FIND-EQUIVALENT (WB-MAP-TREE-NODE-LEFT TREE) KEY))
               (:GREATER
                (WB-MAP-TREE-FIND-EQUIVALENT (WB-MAP-TREE-NODE-RIGHT TREE)
                 KEY)))))))

[fset/Code/wb-trees.lisp:3864]
  (DEFUN WB-MAP-TREE-WITH (TREE KEY VALUE)
    "Returns a new tree like `tree' but with the pair < `key', `value' > added,
shadowing any previous pair with the same key."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-MAP-TREE TREE))
    (COND
     ((NULL TREE)
      (IF (NOT (EQUIVALENT-MAP? KEY))
          (CONS (VECTOR KEY) (VECTOR VALUE))
          (MAKE-WB-MAP-TREE-NODE KEY NIL NIL NIL)))
     ((CONSP TREE)
      (LET ((FOUND? IDX (VECTOR-SET-BINARY-SEARCH (CAR TREE) KEY))
            ((RIGHT-START
              (IF FOUND?
                  (1+ IDX)
                  IDX))))
        (IF (AND (EQ FOUND? ':EQUAL) (NOT (EQUIVALENT-MAP? KEY)))
            (CONS (CAR TREE) (VECTOR-UPDATE (CDR TREE) IDX VALUE))
            (IF (AND (NOT FOUND?)
                     (< (LENGTH (THE SIMPLE-VECTOR (CAR TREE)))
                        *WB-TREE-MAX-VECTOR-LENGTH*)
                     (NOT (EQUIVALENT-MAP? KEY)))
                (CONS (VECTOR-INSERT (CAR TREE) IDX KEY)
                      (VECTOR-INSERT (CDR TREE) IDX VALUE))
                (MAKE-WB-MAP-TREE-NODE
                 (IF FOUND?
                     (EQUIVALENT-MAP-UNION (SVREF (CAR TREE) IDX)
                      (SVREF (CDR TREE) IDX) KEY VALUE)
                     KEY)
                 VALUE
                 (AND (> IDX 0)
                      (CONS (VECTOR-SUBSEQ (CAR TREE) 0 IDX)
                            (VECTOR-SUBSEQ (CDR TREE) 0 IDX)))
                 (AND (< RIGHT-START (LENGTH (THE SIMPLE-VECTOR (CAR TREE))))
                      (CONS (VECTOR-SUBSEQ (CAR TREE) RIGHT-START)
                            (VECTOR-SUBSEQ (CDR TREE) RIGHT-START))))))))
     (T
      (LET ((NODE-KEY (WB-MAP-TREE-NODE-KEY TREE))
            ((COMP (COMPARE KEY NODE-KEY))))
        (ECASE COMP
          ((:EQUAL :UNEQUAL)
           (MAKE-WB-MAP-TREE-NODE
            (EQUIVALENT-MAP-UNION NODE-KEY (WB-MAP-TREE-NODE-VALUE TREE) KEY
             VALUE)
            VALUE (WB-MAP-TREE-NODE-LEFT TREE) (WB-MAP-TREE-NODE-RIGHT TREE)))
          ((:LESS)
           (WB-MAP-TREE-BUILD-NODE (WB-MAP-TREE-NODE-KEY TREE)
            (WB-MAP-TREE-NODE-VALUE TREE)
            (WB-MAP-TREE-WITH (WB-MAP-TREE-NODE-LEFT TREE) KEY VALUE)
            (WB-MAP-TREE-NODE-RIGHT TREE)))
          ((:GREATER)
           (WB-MAP-TREE-BUILD-NODE (WB-MAP-TREE-NODE-KEY TREE)
            (WB-MAP-TREE-NODE-VALUE TREE) (WB-MAP-TREE-NODE-LEFT TREE)
            (WB-MAP-TREE-WITH (WB-MAP-TREE-NODE-RIGHT TREE) KEY VALUE))))))))

[fset/Code/wb-trees.lisp:3927]
  (DEFUN VECTOR-UPDATE (VEC IDX VAL)
    "Returns a new vector like `vec' but with `val' at `idx'."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE SIMPLE-VECTOR VEC)
             (TYPE FIXNUM IDX))
    (LET ((LEN (LENGTH VEC)) ((NEW-VEC (MAKE-ARRAY LEN))))
      (DOTIMES (I LEN) (SETF (SVREF NEW-VEC I) (SVREF VEC I)))
      (SETF (SVREF NEW-VEC IDX) VAL)
      NEW-VEC))

[fset/Code/wb-trees.lisp:3943]
  (DEFUN WB-MAP-TREE-LESS (TREE KEY)
    "Returns a new tree like `tree', but with any entry for `key' removed."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-MAP-TREE TREE))
    (COND ((NULL TREE) NIL)
          ((CONSP TREE)
           (LET ((FOUND? IDX (VECTOR-SET-BINARY-SEARCH (CAR TREE) KEY)))
             (IF (EQ FOUND? ':EQUAL)
                 (AND (> (LENGTH (THE SIMPLE-VECTOR (CAR TREE))) 1)
                      (CONS (VECTOR-REMOVE-AT (CAR TREE) IDX)
                            (VECTOR-REMOVE-AT (CDR TREE) IDX)))
                 TREE)))
          (T
           (LET ((NODE-KEY (WB-MAP-TREE-NODE-KEY TREE))
                 ((COMP (COMPARE KEY NODE-KEY))))
             (ECASE COMP
               ((:EQUAL :UNEQUAL)
                (IF (NOT (EQUIVALENT-MAP? NODE-KEY))
                    (IF (EQ COMP ':UNEQUAL)
                        TREE
                        (WB-MAP-TREE-JOIN (WB-MAP-TREE-NODE-LEFT TREE)
                         (WB-MAP-TREE-NODE-RIGHT TREE)))
                    (LET ((KEY VAL (EQUIVALENT-MAP-LESS NODE-KEY KEY)))
                      (IF (EQ KEY NODE-KEY)
                          TREE
                          (WB-MAP-TREE-BUILD-NODE KEY VAL
                           (WB-MAP-TREE-NODE-LEFT TREE)
                           (WB-MAP-TREE-NODE-RIGHT TREE))))))
               ((:LESS)
                (LET ((LEFT (WB-MAP-TREE-NODE-LEFT TREE))
                      ((NEW-LEFT (WB-MAP-TREE-LESS LEFT KEY))))
                  (IF (EQ NEW-LEFT LEFT)
                      TREE
                      (WB-MAP-TREE-BUILD-NODE NODE-KEY
                       (WB-MAP-TREE-NODE-VALUE TREE) NEW-LEFT
                       (WB-MAP-TREE-NODE-RIGHT TREE)))))
               ((:GREATER)
                (LET ((RIGHT (WB-MAP-TREE-NODE-RIGHT TREE))
                      ((NEW-RIGHT (WB-MAP-TREE-LESS RIGHT KEY))))
                  (IF (EQ NEW-RIGHT RIGHT)
                      TREE
                      (WB-MAP-TREE-BUILD-NODE NODE-KEY
                       (WB-MAP-TREE-NODE-VALUE TREE)
                       (WB-MAP-TREE-NODE-LEFT TREE) NEW-RIGHT)))))))))

[fset/Code/wb-trees.lisp:3986]
  (DEFUN WB-MAP-TREE-MINIMUM-PAIR (TREE)
    "Assumes `tree' is nonempty.  Returns the minimum key and value as two
values.  The key may be an `Equivalent-Map', in which case, as usual, the
value is not meaningful."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-MAP-TREE TREE))
    (IF (CONSP TREE)
        (VALUES (SVREF (CAR TREE) 0) (SVREF (CDR TREE) 0))
        (LET ((LEFT (WB-MAP-TREE-NODE-LEFT TREE)))
          (IF LEFT
              (WB-MAP-TREE-MINIMUM-PAIR LEFT)
              (VALUES (WB-MAP-TREE-NODE-KEY TREE)
                      (WB-MAP-TREE-NODE-VALUE TREE))))))

[fset/Code/wb-trees.lisp:4001]
  (DEFUN WB-MAP-TREE-LESS-MINIMUM (TREE)
    "Assumes `tree' is nonempty.  Returns a new tree with the minimum key/value
pair removed."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-MAP-TREE TREE))
    (IF (CONSP TREE)
        (AND (> (LENGTH (THE SIMPLE-VECTOR (CAR TREE))) 1)
             (CONS (VECTOR-SUBSEQ (CAR TREE) 1) (VECTOR-SUBSEQ (CDR TREE) 1)))
        (LET ((LEFT (WB-MAP-TREE-NODE-LEFT TREE)))
          (IF LEFT
              (WB-MAP-TREE-CONCAT (WB-MAP-TREE-NODE-KEY TREE)
               (WB-MAP-TREE-NODE-VALUE TREE) (WB-MAP-TREE-LESS-MINIMUM LEFT)
               (WB-MAP-TREE-NODE-RIGHT TREE))
              (WB-MAP-TREE-NODE-RIGHT TREE)))))

[fset/Code/wb-trees.lisp:4024]
  (DEFUN WB-MAP-TREE-DOMAIN (TREE)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-MAP-TREE TREE))
    (COND ((NULL TREE) NIL) ((CONSP TREE) (CAR TREE))
          (T
           (LET ((KEY (WB-MAP-TREE-NODE-KEY TREE))
                 ((ELT
                   (IF (EQUIVALENT-MAP? KEY)
                       (MAKE-EQUIVALENT-SET
                        (MAPCAR #'CAR (EQUIVALENT-MAP-ALIST KEY)))
                       KEY))))
             (MAKE-WB-SET-TREE-NODE ELT
              (WB-MAP-TREE-DOMAIN (WB-MAP-TREE-NODE-LEFT TREE))
              (WB-MAP-TREE-DOMAIN (WB-MAP-TREE-NODE-RIGHT TREE)))))))

[fset/Code/wb-trees.lisp:4046]
  (DEFUN WB-MAP-TREE-UNION-RNG (TREE1 TREE2 VAL-FN LO HI)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE FUNCTION VAL-FN)
             (TYPE WB-MAP-TREE TREE1 TREE2))
    (COND ((EQ TREE1 TREE2) (WB-MAP-TREE-SPLIT TREE1 LO HI))
          ((NULL TREE2) (WB-MAP-TREE-SPLIT TREE1 LO HI))
          ((NULL TREE1) (WB-MAP-TREE-SPLIT TREE2 LO HI))
          ((AND (CONSP TREE1) (CONSP TREE2))
           (WB-MAP-TREE-VECTOR-PAIR-UNION TREE1 TREE2 VAL-FN LO HI))
          ((CONSP TREE1)
           (LET ((KEY2 (WB-MAP-TREE-NODE-KEY TREE2))
                 (VAL2 (WB-MAP-TREE-NODE-VALUE TREE2))
                 ((EQVK1? EQVK1 EQVV1 (WB-MAP-TREE-FIND-EQUIVALENT TREE1 KEY2))
                  ((KEY VAL
                    (IF EQVK1?
                        (EQUIVALENT-MAP-UNION EQVK1 EQVV1 KEY2 VAL2 VAL-FN)
                        (VALUES KEY2 VAL2))))))
             (WB-MAP-TREE-CONCAT KEY VAL
              (WB-MAP-TREE-UNION-RNG (WB-MAP-TREE-TRIM TREE1 LO KEY2)
               (WB-MAP-TREE-TRIM (WB-MAP-TREE-NODE-LEFT TREE2) LO KEY2) VAL-FN
               LO KEY2)
              (WB-MAP-TREE-UNION-RNG (WB-MAP-TREE-TRIM TREE1 KEY2 HI)
               (WB-MAP-TREE-TRIM (WB-MAP-TREE-NODE-RIGHT TREE2) KEY2 HI) VAL-FN
               KEY2 HI))))
          (T
           (LET ((KEY1 (WB-MAP-TREE-NODE-KEY TREE1))
                 (VAL1 (WB-MAP-TREE-NODE-VALUE TREE1))
                 ((EQVK2? EQVK2 EQVV2 (WB-MAP-TREE-FIND-EQUIVALENT TREE2 KEY1))
                  ((KEY VAL
                    (IF EQVK2?
                        (EQUIVALENT-MAP-UNION KEY1 VAL1 EQVK2 EQVV2 VAL-FN)
                        (VALUES KEY1 VAL1))))))
             (WB-MAP-TREE-CONCAT KEY VAL
              (WB-MAP-TREE-UNION-RNG (WB-MAP-TREE-NODE-LEFT TREE1)
               (WB-MAP-TREE-TRIM TREE2 LO KEY1) VAL-FN LO KEY1)
              (WB-MAP-TREE-UNION-RNG (WB-MAP-TREE-NODE-RIGHT TREE1)
               (WB-MAP-TREE-TRIM TREE2 KEY1 HI) VAL-FN KEY1 HI))))))

[fset/Code/wb-trees.lisp:4094]
  (DEFUN WB-MAP-TREE-INTERSECT-RNG (TREE1 TREE2 VAL-FN LO HI)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE FUNCTION VAL-FN)
             (TYPE WB-MAP-TREE TREE1 TREE2))
    (COND ((EQ TREE1 TREE2) (WB-MAP-TREE-SPLIT TREE1 LO HI))
          ((OR (NULL TREE1) (NULL TREE2)) NIL)
          ((AND (CONSP TREE1) (CONSP TREE2))
           (VECTOR-PAIR-INTERSECT TREE1 TREE2 VAL-FN LO HI))
          ((CONSP TREE1)
           (LET ((KEY2 (WB-MAP-TREE-NODE-KEY TREE2))
                 (VAL2 (WB-MAP-TREE-NODE-VALUE TREE2))
                 ((EQVK1? EQVK1 EQVV1 (WB-MAP-TREE-FIND-EQUIVALENT TREE1 KEY2))
                  ((NONNULL? KEY VAL
                    (AND EQVK1?
                         (EQUIVALENT-MAP-INTERSECT EQVK1 EQVV1 KEY2 VAL2
                          VAL-FN))))))
             (WB-MAP-TREE-CONCAT-MAYBE NONNULL? KEY VAL
              (WB-MAP-TREE-INTERSECT-RNG (WB-MAP-TREE-TRIM TREE1 LO KEY2)
               (WB-MAP-TREE-TRIM (WB-MAP-TREE-NODE-LEFT TREE2) LO KEY2) VAL-FN
               LO KEY2)
              (WB-MAP-TREE-INTERSECT-RNG (WB-MAP-TREE-TRIM TREE1 KEY2 HI)
               (WB-MAP-TREE-TRIM (WB-MAP-TREE-NODE-RIGHT TREE2) KEY2 HI) VAL-FN
               KEY2 HI))))
          (T
           (LET ((KEY1 (WB-MAP-TREE-NODE-KEY TREE1))
                 (VAL1 (WB-MAP-TREE-NODE-VALUE TREE1))
                 ((EQVK2? EQVK2 EQVV2 (WB-MAP-TREE-FIND-EQUIVALENT TREE2 KEY1))
                  ((NONNULL? KEY VAL
                    (AND EQVK2?
                         (EQUIVALENT-MAP-INTERSECT KEY1 VAL1 EQVK2 EQVV2
                          VAL-FN))))))
             (WB-MAP-TREE-CONCAT-MAYBE NONNULL? KEY VAL
              (WB-MAP-TREE-INTERSECT-RNG (WB-MAP-TREE-NODE-LEFT TREE1)
               (WB-MAP-TREE-TRIM TREE2 LO KEY1) VAL-FN LO KEY1)
              (WB-MAP-TREE-INTERSECT-RNG (WB-MAP-TREE-NODE-RIGHT TREE1)
               (WB-MAP-TREE-TRIM TREE2 KEY1 HI) VAL-FN KEY1 HI))))))

[fset/Code/wb-trees.lisp:4207]
  (DEFUN WB-MAP-TREE-RESTRICT-RNG (MAP-TREE SET-TREE LO HI)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-MAP-TREE MAP-TREE)
             (TYPE WB-SET-TREE SET-TREE))
    (COND ((OR (NULL MAP-TREE) (NULL SET-TREE)) NIL)
          ((CONSP MAP-TREE)
           (IF (SIMPLE-VECTOR-P SET-TREE)
               (VECTOR-PAIR-RESTRICT MAP-TREE SET-TREE LO HI)
               (LET ((RAW-ELT (WB-SET-TREE-NODE-VALUE SET-TREE))
                     ((SET-ELT
                       (IF (EQUIVALENT-SET? RAW-ELT)
                           (CAR (EQUIVALENT-SET-MEMBERS RAW-ELT))
                           RAW-ELT))
                      ((NEW-LEFT
                        (WB-MAP-TREE-RESTRICT-RNG
                         (WB-MAP-TREE-TRIM MAP-TREE LO SET-ELT)
                         (WB-SET-TREE-TRIM (WB-SET-TREE-NODE-LEFT SET-TREE) LO
                          SET-ELT)
                         LO SET-ELT))
                       (NEW-RIGHT
                        (WB-MAP-TREE-RESTRICT-RNG
                         (WB-MAP-TREE-TRIM MAP-TREE SET-ELT HI)
                         (WB-SET-TREE-TRIM (WB-SET-TREE-NODE-RIGHT SET-TREE)
                          SET-ELT HI)
                         SET-ELT HI))
                       (EQVK? EQVK EQVV
                        (WB-MAP-TREE-FIND-EQUIVALENT MAP-TREE SET-ELT)))))
                 (IF (NOT EQVK?)
                     (WB-MAP-TREE-JOIN NEW-LEFT NEW-RIGHT)
                     (LET ((RPR?
                            RKEY
                            RVAL
                            (EQUIVALENT-MAP-RESTRICT EQVK EQVV RAW-ELT)))
                       (IF RPR?
                           (WB-MAP-TREE-CONCAT RKEY RVAL NEW-LEFT NEW-RIGHT)
                           (WB-MAP-TREE-JOIN NEW-LEFT NEW-RIGHT)))))))
          (T
           (LET ((RAW-KEY (WB-MAP-TREE-NODE-KEY MAP-TREE))
                 ((MAP-KEY
                   (IF (EQUIVALENT-MAP? RAW-KEY)
                       (CAAR (EQUIVALENT-MAP-ALIST RAW-KEY))
                       RAW-KEY))
                  ((NEW-LEFT
                    (WB-MAP-TREE-RESTRICT-RNG (WB-MAP-TREE-NODE-LEFT MAP-TREE)
                     (WB-SET-TREE-TRIM SET-TREE LO MAP-KEY) LO MAP-KEY))
                   (NEW-RIGHT
                    (WB-MAP-TREE-RESTRICT-RNG (WB-MAP-TREE-NODE-RIGHT MAP-TREE)
                     (WB-SET-TREE-TRIM SET-TREE MAP-KEY HI) MAP-KEY HI))
                   (EQVV? EQVV
                    (WB-SET-TREE-FIND-EQUIVALENT SET-TREE MAP-KEY)))))
             (IF (NOT EQVV?)
                 (WB-MAP-TREE-JOIN NEW-LEFT NEW-RIGHT)
                 (LET ((MAP-VAL (WB-MAP-TREE-NODE-VALUE MAP-TREE))
                       ((RPR? RKEY RVAL
                         (EQUIVALENT-MAP-RESTRICT RAW-KEY MAP-VAL EQVV))))
                   (IF RPR?
                       (WB-MAP-TREE-CONCAT RKEY RVAL NEW-LEFT NEW-RIGHT)
                       (WB-MAP-TREE-JOIN NEW-LEFT NEW-RIGHT))))))))

[fset/Code/wb-trees.lisp:4261]
  (DEFUN WB-MAP-TREE-RESTRICT-NOT-RNG (MAP-TREE SET-TREE LO HI)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-MAP-TREE MAP-TREE)
             (TYPE WB-SET-TREE SET-TREE))
    (COND ((NULL MAP-TREE) NIL)
          ((NULL SET-TREE) (WB-MAP-TREE-SPLIT MAP-TREE LO HI))
          ((CONSP MAP-TREE)
           (IF (SIMPLE-VECTOR-P SET-TREE)
               (VECTOR-PAIR-RESTRICT-NOT MAP-TREE SET-TREE LO HI)
               (LET ((RAW-ELT (WB-SET-TREE-NODE-VALUE SET-TREE))
                     ((SET-ELT
                       (IF (EQUIVALENT-SET? RAW-ELT)
                           (CAR (EQUIVALENT-SET-MEMBERS RAW-ELT))
                           RAW-ELT))
                      ((NEW-LEFT
                        (WB-MAP-TREE-RESTRICT-NOT-RNG
                         (WB-MAP-TREE-TRIM MAP-TREE LO SET-ELT)
                         (WB-SET-TREE-TRIM (WB-SET-TREE-NODE-LEFT SET-TREE) LO
                          SET-ELT)
                         LO SET-ELT))
                       (NEW-RIGHT
                        (WB-MAP-TREE-RESTRICT-NOT-RNG
                         (WB-MAP-TREE-TRIM MAP-TREE SET-ELT HI)
                         (WB-SET-TREE-TRIM (WB-SET-TREE-NODE-RIGHT SET-TREE)
                          SET-ELT HI)
                         SET-ELT HI))
                       (EQVK? EQVK EQVV
                        (WB-MAP-TREE-FIND-EQUIVALENT MAP-TREE SET-ELT)))))
                 (IF (NOT EQVK?)
                     (WB-MAP-TREE-JOIN NEW-LEFT NEW-RIGHT)
                     (LET ((RPR?
                            RKEY
                            RVAL
                            (EQUIVALENT-MAP-RESTRICT-NOT EQVK EQVV RAW-ELT)))
                       (IF RPR?
                           (WB-MAP-TREE-CONCAT RKEY RVAL NEW-LEFT NEW-RIGHT)
                           (WB-MAP-TREE-JOIN NEW-LEFT NEW-RIGHT)))))))
          (T
           (LET ((RAW-KEY (WB-MAP-TREE-NODE-KEY MAP-TREE))
                 ((MAP-KEY
                   (IF (EQUIVALENT-MAP? RAW-KEY)
                       (CAAR (EQUIVALENT-MAP-ALIST RAW-KEY))
                       RAW-KEY))
                  ((NEW-LEFT
                    (WB-MAP-TREE-RESTRICT-NOT-RNG
                     (WB-MAP-TREE-NODE-LEFT MAP-TREE)
                     (WB-SET-TREE-TRIM SET-TREE LO MAP-KEY) LO MAP-KEY))
                   (NEW-RIGHT
                    (WB-MAP-TREE-RESTRICT-NOT-RNG
                     (WB-MAP-TREE-NODE-RIGHT MAP-TREE)
                     (WB-SET-TREE-TRIM SET-TREE MAP-KEY HI) MAP-KEY HI))
                   (EQVV? EQVV
                    (WB-SET-TREE-FIND-EQUIVALENT SET-TREE MAP-KEY)))))
             (LET ((MAP-VAL (WB-MAP-TREE-NODE-VALUE MAP-TREE)))
               (IF (NOT EQVV?)
                   (WB-MAP-TREE-CONCAT RAW-KEY MAP-VAL NEW-LEFT NEW-RIGHT)
                   (LET ((RPR?
                          RKEY
                          RVAL
                          (EQUIVALENT-MAP-RESTRICT-NOT RAW-KEY MAP-VAL EQVV)))
                     (IF RPR?
                         (WB-MAP-TREE-CONCAT RKEY RVAL NEW-LEFT NEW-RIGHT)
                         (WB-MAP-TREE-JOIN NEW-LEFT NEW-RIGHT)))))))))

[fset/Code/wb-trees.lisp:4324]
  (DEFUN WB-MAP-TREE-COMPARE-RNG (TREE1 BASE1 TREE2 BASE2 LO HI VAL-FN)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-MAP-TREE TREE1 TREE2)
             (TYPE FIXNUM BASE1 BASE2 LO HI)
             (TYPE FUNCTION VAL-FN))
    (COND ((AND (EQ TREE1 TREE2) (= BASE1 BASE2)) ':EQUAL) ((= LO HI) ':EQUAL)
          ((AND (CONSP TREE1) (CONSP TREE2))
           (LET ((UNEQUAL? NIL))
             (OR
              (GMAP :OR
               #'(LAMBDA (KEY1 VAL1 KEY2 VAL2)
                   (LET ((KEY-COMP (COMPARE KEY1 KEY2)))
                     (WHEN (EQ KEY-COMP ':UNEQUAL) (SETQ UNEQUAL? T))
                     (IF (OR (EQ KEY-COMP ':LESS) (EQ KEY-COMP ':GREATER))
                         KEY-COMP
                         (LET ((VAL-COMP (FUNCALL VAL-FN VAL1 VAL2)))
                           (WHEN (EQ VAL-COMP ':UNEQUAL) (SETQ UNEQUAL? T))
                           (AND
                            (OR (EQ VAL-COMP ':LESS) (EQ VAL-COMP ':GREATER))
                            VAL-COMP)))))
               (:SIMPLE-VECTOR (CAR TREE1) :START (- LO BASE1) :STOP
                (- HI BASE1))
               (:SIMPLE-VECTOR (CDR TREE1) :START (- LO BASE1) :STOP
                (- HI BASE1))
               (:SIMPLE-VECTOR (CAR TREE2) :START (- LO BASE2) :STOP
                (- HI BASE2))
               (:SIMPLE-VECTOR (CDR TREE2) :START (- LO BASE2) :STOP
                (- HI BASE2)))
              (IF UNEQUAL?
                  ':UNEQUAL
                  ':EQUAL))))
          ((CONSP TREE1)
           (LET ((REV-COMP
                  (WB-MAP-TREE-COMPARE-RNG TREE2 BASE2 TREE1 BASE1 LO HI
                   VAL-FN)))
             (ECASE REV-COMP
               (:LESS ':GREATER)
               (:GREATER ':LESS)
               ((:EQUAL :UNEQUAL) REV-COMP))))
          (T
           (LET ((LEFT1 (WB-MAP-TREE-NODE-LEFT TREE1))
                 ((LEFT1-SIZE (THE FIXNUM (WB-MAP-TREE-SIZE LEFT1)))
                  ((NEW-HI (THE FIXNUM (+ BASE1 LEFT1-SIZE)))
                   ((LEFT1A BASE1A
                     (WB-MAP-TREE-RANK-TRIM LEFT1 BASE1 LO NEW-HI))
                    (TREE2A BASE2A
                     (WB-MAP-TREE-RANK-TRIM TREE2 BASE2 LO NEW-HI))
                    ((LEFT-COMP
                      (WB-MAP-TREE-COMPARE-RNG LEFT1A BASE1A TREE2A BASE2A LO
                       NEW-HI VAL-FN)))))))
             (IF (OR (EQ LEFT-COMP ':LESS) (EQ LEFT-COMP ':GREATER))
                 LEFT-COMP
                 (LET ((KEY1 (WB-MAP-TREE-NODE-KEY TREE1))
                       (VAL1 (WB-MAP-TREE-NODE-VALUE TREE1))
                       (KEY2
                        VAL2
                        (WB-MAP-TREE-RANK-PAIR-INTERNAL TREE2
                         (THE FIXNUM (- NEW-HI BASE2))))
                       ((COMP
                         (EQUIVALENT-MAP-COMPARE KEY1 VAL1 KEY2 VAL2 VAL-FN))))
                   (IF (OR (EQ COMP ':LESS) (EQ COMP ':GREATER))
                       COMP
                       (LET ((KEY1-SIZE (MAP-KEY-SIZE KEY1))
                             ((NEW-LO
                               (THE FIXNUM (+ BASE1 LEFT1-SIZE KEY1-SIZE)))
                              ((RIGHT1A BASE1A
                                (WB-MAP-TREE-RANK-TRIM
                                 (WB-MAP-TREE-NODE-RIGHT TREE1)
                                 (THE FIXNUM (+ BASE1 LEFT1-SIZE KEY1-SIZE))
                                 NEW-LO HI))
                               (TREE2A BASE2A
                                (WB-MAP-TREE-RANK-TRIM TREE2 BASE2 NEW-LO HI))
                               ((RIGHT-COMP
                                 (WB-MAP-TREE-COMPARE-RNG RIGHT1A BASE1A TREE2A
                                  BASE2A NEW-LO HI VAL-FN))))))
                         (IF (NOT (EQ RIGHT-COMP ':EQUAL))
                             RIGHT-COMP
                             (IF (EQ LEFT-COMP ':UNEQUAL)
                                 ':UNEQUAL
                                 COMP))))))))))

[fset/Code/wb-trees.lisp:4390]
  (DEFUN WB-MAP-TREE-RANK-TRIM (TREE BASE LO HI)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-MAP-TREE TREE)
             (TYPE FIXNUM BASE LO HI))
    (IF (OR (NULL TREE) (CONSP TREE))
        (VALUES TREE BASE)
        (LET ((NODE-RANK
               (THE FIXNUM
                    (+ BASE (WB-MAP-TREE-SIZE (WB-MAP-TREE-NODE-LEFT TREE))))))
          (IF (>= NODE-RANK LO)
              (IF (< NODE-RANK HI)
                  (VALUES TREE BASE)
                  (WB-MAP-TREE-RANK-TRIM (WB-MAP-TREE-NODE-LEFT TREE) BASE LO
                   HI))
              (WB-MAP-TREE-RANK-TRIM (WB-MAP-TREE-NODE-RIGHT TREE)
               (+ NODE-RANK (MAP-KEY-SIZE (WB-MAP-TREE-NODE-KEY TREE))) LO
               HI)))))

[fset/Code/wb-trees.lisp:4449]
  (DEFUN WB-MAP-TREE-RANK-PAIR-INTERNAL (TREE RANK)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-MAP-TREE TREE)
             (TYPE FIXNUM RANK))
    (COND ((NULL TREE) (ERROR "Bug in map comparator"))
          ((CONSP TREE)
           (VALUES (SVREF (CAR TREE) RANK) (SVREF (CDR TREE) RANK) 0))
          (T
           (LET ((LEFT (WB-MAP-TREE-NODE-LEFT TREE))
                 ((LEFT-SIZE (WB-MAP-TREE-SIZE LEFT))))
             (IF (< RANK LEFT-SIZE)
                 (WB-MAP-TREE-RANK-PAIR-INTERNAL LEFT RANK)
                 (LET ((KEY (WB-MAP-TREE-NODE-KEY TREE))
                       ((KEY-SIZE (MAP-KEY-SIZE KEY)))
                       (RANK (- RANK LEFT-SIZE)))
                   (DECLARE (TYPE FIXNUM RANK KEY-SIZE))
                   (IF (< RANK KEY-SIZE)
                       (VALUES KEY (WB-MAP-TREE-NODE-VALUE TREE) RANK)
                       (WB-MAP-TREE-RANK-PAIR-INTERNAL
                        (WB-MAP-TREE-NODE-RIGHT TREE)
                        (THE FIXNUM (- RANK KEY-SIZE))))))))))

[fset/Code/wb-trees.lisp:4474]
  (DEFUN WB-MAP-TREE-SPLIT (TREE LO HI)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-MAP-TREE TREE))
    (COND ((NULL TREE) NIL)
          ((AND (EQ LO HEDGE-NEGATIVE-INFINITY)
                (EQ HI HEDGE-POSITIVE-INFINITY))
           TREE)
          ((CONSP TREE)
           (LET ((KEYS (CAR TREE))
                 (VALS (CDR TREE))
                 ((LEN (LENGTH (THE SIMPLE-VECTOR KEYS)))
                  ((SPLIT-POINT-LO
                    (IF (EQ LO HEDGE-NEGATIVE-INFINITY)
                        0
                        (VECTOR-SET-BINARY-SEARCH-LO KEYS LO)))
                   (SPLIT-POINT-HI
                    (IF (EQ HI HEDGE-POSITIVE-INFINITY)
                        LEN
                        (VECTOR-SET-BINARY-SEARCH-HI KEYS HI))))))
             (AND (> SPLIT-POINT-HI SPLIT-POINT-LO)
                  (IF (AND (= SPLIT-POINT-LO 0) (= SPLIT-POINT-HI LEN))
                      TREE
                      (CONS (VECTOR-SUBSEQ KEYS SPLIT-POINT-LO SPLIT-POINT-HI)
                            (VECTOR-SUBSEQ VALS SPLIT-POINT-LO
                             SPLIT-POINT-HI))))))
          ((NOT
            (OR (EQ LO HEDGE-NEGATIVE-INFINITY)
                (GREATER-THAN? (WB-MAP-TREE-NODE-KEY TREE) LO)))
           (WB-MAP-TREE-SPLIT (WB-MAP-TREE-NODE-RIGHT TREE) LO HI))
          ((NOT
            (OR (EQ HI HEDGE-POSITIVE-INFINITY)
                (LESS-THAN? (WB-MAP-TREE-NODE-KEY TREE) HI)))
           (WB-MAP-TREE-SPLIT (WB-MAP-TREE-NODE-LEFT TREE) LO HI))
          (T
           (LET ((NEW-LEFT
                  (WB-MAP-TREE-SPLIT (WB-MAP-TREE-NODE-LEFT TREE) LO
                   HEDGE-POSITIVE-INFINITY))
                 (NEW-RIGHT
                  (WB-MAP-TREE-SPLIT (WB-MAP-TREE-NODE-RIGHT TREE)
                   HEDGE-NEGATIVE-INFINITY HI)))
             (IF (AND (EQ NEW-LEFT (WB-MAP-TREE-NODE-LEFT TREE))
                      (EQ NEW-RIGHT (WB-MAP-TREE-NODE-RIGHT TREE)))
                 TREE
                 (WB-MAP-TREE-CONCAT (WB-MAP-TREE-NODE-KEY TREE)
                  (WB-MAP-TREE-NODE-VALUE TREE) NEW-LEFT NEW-RIGHT))))))

[fset/Code/wb-trees.lisp:4514]
  (DEFUN WB-MAP-TREE-TRIM (TREE LO HI)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-MAP-TREE TREE))
    (COND ((NULL TREE) NIL)
          ((CONSP TREE)
           (AND
            (OR (EQ LO HEDGE-NEGATIVE-INFINITY)
                (GREATER-THAN?
                 (SVREF (CAR TREE)
                        (1- (LENGTH (THE SIMPLE-VECTOR (CAR TREE)))))
                 LO))
            (OR (EQ HI HEDGE-POSITIVE-INFINITY)
                (LESS-THAN? (SVREF (CAR TREE) 0) HI))
            TREE))
          (T
           (LET ((KEY (WB-MAP-TREE-NODE-KEY TREE)))
             (IF (OR (EQ LO HEDGE-NEGATIVE-INFINITY) (GREATER-THAN? KEY LO))
                 (IF (OR (EQ HI HEDGE-POSITIVE-INFINITY) (LESS-THAN? KEY HI))
                     TREE
                     (WB-MAP-TREE-TRIM (WB-MAP-TREE-NODE-LEFT TREE) LO HI))
                 (WB-MAP-TREE-TRIM (WB-MAP-TREE-NODE-RIGHT TREE) LO HI))))))

[fset/Code/wb-trees.lisp:4537]
  (DEFUN WB-MAP-TREE-CONCAT-MAYBE (PAIR? KEY VALUE LEFT RIGHT)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (IF PAIR?
        (WB-MAP-TREE-CONCAT KEY VALUE LEFT RIGHT)
        (WB-MAP-TREE-JOIN LEFT RIGHT)))

[fset/Code/wb-trees.lisp:4542]
  (DEFUN WB-MAP-TREE-CONCAT (KEY VALUE LEFT RIGHT)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-MAP-TREE LEFT RIGHT))
    (COND ((NULL LEFT) (WB-MAP-TREE-WITH RIGHT KEY VALUE))
          ((NULL RIGHT) (WB-MAP-TREE-WITH LEFT KEY VALUE))
          ((AND (WB-MAP-TREE-NODE? LEFT)
                (> (WB-MAP-TREE-NODE-SIZE LEFT)
                   (* (WB-MAP-TREE-SIZE RIGHT) WB-TREE-BALANCE-FACTOR)))
           (WB-MAP-TREE-BUILD-NODE (WB-MAP-TREE-NODE-KEY LEFT)
            (WB-MAP-TREE-NODE-VALUE LEFT) (WB-MAP-TREE-NODE-LEFT LEFT)
            (WB-MAP-TREE-CONCAT KEY VALUE (WB-MAP-TREE-NODE-RIGHT LEFT)
             RIGHT)))
          ((AND (WB-MAP-TREE-NODE? RIGHT)
                (> (WB-MAP-TREE-NODE-SIZE RIGHT)
                   (* (WB-MAP-TREE-SIZE LEFT) WB-TREE-BALANCE-FACTOR)))
           (WB-MAP-TREE-BUILD-NODE (WB-MAP-TREE-NODE-KEY RIGHT)
            (WB-MAP-TREE-NODE-VALUE RIGHT)
            (WB-MAP-TREE-CONCAT KEY VALUE LEFT (WB-MAP-TREE-NODE-LEFT RIGHT))
            (WB-MAP-TREE-NODE-RIGHT RIGHT)))
          (T (WB-MAP-TREE-BUILD-NODE KEY VALUE LEFT RIGHT))))

[fset/Code/wb-trees.lisp:4576]
  (DEFUN WB-MAP-TREE-BUILD-NODE (KEY VALUE LEFT RIGHT)
    "Constructs a `WB-Map-Tree', performing one rebalancing step if required.
`key' must already be known to go between `left' and `right'."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-MAP-TREE LEFT RIGHT))
    (IF (AND (OR (NULL LEFT) (CONSP LEFT)) (OR (NULL RIGHT) (CONSP RIGHT)))
        (IF (AND (NOT (EQUIVALENT-MAP? KEY))
                 (<
                  (+ (LENGTH-NV (THE (OR NULL SIMPLE-VECTOR) (CAR LEFT)))
                     (LENGTH-NV (THE (OR NULL SIMPLE-VECTOR) (CAR RIGHT))))
                  *WB-TREE-MAX-VECTOR-LENGTH*))
            (CONS
             (CONCATENATE 'SIMPLE-VECTOR (CAR LEFT) (VECTOR KEY) (CAR RIGHT))
             (CONCATENATE 'SIMPLE-VECTOR (CDR LEFT) (VECTOR VALUE)
                          (CDR RIGHT)))
            (MAKE-WB-MAP-TREE-NODE KEY VALUE LEFT RIGHT))
        (LET ((SIZL (WB-MAP-TREE-SIZE LEFT)) (SIZR (WB-MAP-TREE-SIZE RIGHT)))
          (COND
           ((AND (WB-MAP-TREE-NODE? LEFT)
                 (> SIZL (* SIZR WB-TREE-BALANCE-FACTOR)))
            (LET ((LL (WB-MAP-TREE-NODE-LEFT LEFT))
                  (RL (WB-MAP-TREE-NODE-RIGHT LEFT)))
              (IF (OR (NULL RL) (CONSP RL)
                      (<= (WB-MAP-TREE-SIZE RL) (WB-MAP-TREE-SIZE LL)))
                  (MAKE-WB-MAP-TREE-NODE (WB-MAP-TREE-NODE-KEY LEFT)
                   (WB-MAP-TREE-NODE-VALUE LEFT) LL
                   (WB-MAP-TREE-BUILD-NODE KEY VALUE RL RIGHT))
                  (MAKE-WB-MAP-TREE-NODE (WB-MAP-TREE-NODE-KEY RL)
                   (WB-MAP-TREE-NODE-VALUE RL)
                   (WB-MAP-TREE-BUILD-NODE (WB-MAP-TREE-NODE-KEY LEFT)
                    (WB-MAP-TREE-NODE-VALUE LEFT) LL
                    (WB-MAP-TREE-NODE-LEFT RL))
                   (WB-MAP-TREE-BUILD-NODE KEY VALUE
                    (WB-MAP-TREE-NODE-RIGHT RL) RIGHT)))))
           ((AND (WB-MAP-TREE-NODE? RIGHT)
                 (> SIZR (* SIZL WB-TREE-BALANCE-FACTOR)))
            (LET ((LR (WB-MAP-TREE-NODE-LEFT RIGHT))
                  (RR (WB-MAP-TREE-NODE-RIGHT RIGHT)))
              (IF (OR (NULL LR) (CONSP LR)
                      (<= (WB-MAP-TREE-SIZE LR) (WB-MAP-TREE-SIZE RR)))
                  (MAKE-WB-MAP-TREE-NODE (WB-MAP-TREE-NODE-KEY RIGHT)
                   (WB-MAP-TREE-NODE-VALUE RIGHT)
                   (WB-MAP-TREE-BUILD-NODE KEY VALUE LEFT LR) RR)
                  (MAKE-WB-MAP-TREE-NODE (WB-MAP-TREE-NODE-KEY LR)
                   (WB-MAP-TREE-NODE-VALUE LR)
                   (WB-MAP-TREE-BUILD-NODE KEY VALUE LEFT
                    (WB-MAP-TREE-NODE-LEFT LR))
                   (WB-MAP-TREE-BUILD-NODE (WB-MAP-TREE-NODE-KEY RIGHT)
                    (WB-MAP-TREE-NODE-VALUE RIGHT) (WB-MAP-TREE-NODE-RIGHT LR)
                    RR)))))
           (T (MAKE-WB-MAP-TREE-NODE KEY VALUE LEFT RIGHT))))))

[fset/Code/wb-trees.lisp:4688]
  (DEFUN VECTOR-PAIR-UNION (PR1 PR2 VAL-FN LO HI)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE CONS PR1 PR2)
             (TYPE FUNCTION VAL-FN))
    (LET ((KEYS1 (THE SIMPLE-VECTOR (CAR PR1)))
          (KEYS2 (THE SIMPLE-VECTOR (CAR PR2)))
          (VALS1 (THE SIMPLE-VECTOR (CDR PR1)))
          (VALS2 (THE SIMPLE-VECTOR (CDR PR2)))
          (I1 0)
          (I2 0)
          ((LEN1 (LENGTH KEYS1)) (LEN2 (LENGTH KEYS2))))
      (DECLARE (TYPE FIXNUM I1 I2 LEN1 LEN2))
      (UNLESS (EQ LO HEDGE-NEGATIVE-INFINITY)
        (DO () ((OR (= I1 LEN1) (LESS-THAN? LO (SVREF KEYS1 I1)))) (INCF I1))
        (DO () ((OR (= I2 LEN2) (LESS-THAN? LO (SVREF KEYS2 I2)))) (INCF I2)))
      (UNLESS (EQ HI HEDGE-POSITIVE-INFINITY)
        (DO ()
            ((OR (= I1 LEN1) (LESS-THAN? (SVREF KEYS1 (1- LEN1)) HI)))
          (DECF LEN1))
        (DO ()
            ((OR (= I2 LEN2) (LESS-THAN? (SVREF KEYS2 (1- LEN2)) HI)))
          (DECF LEN2)))
      (DO ((KEYS NIL)
           (VALS NIL)
           (ANY-EQUIVALENT? NIL))
          ((AND (= I1 LEN1) (= I2 LEN2))
           (VALUES
            (CONS (COERCE (NREVERSE KEYS) 'SIMPLE-VECTOR)
                  (COERCE (NREVERSE VALS) 'SIMPLE-VECTOR))
            ANY-EQUIVALENT?))
        (COND
         ((= I1 LEN1)
          (DO ()
              ((= I2 LEN2))
            (PUSH (SVREF KEYS2 I2) KEYS)
            (PUSH (SVREF VALS2 I2) VALS)
            (INCF I2)))
         ((= I2 LEN2)
          (DO ()
              ((= I1 LEN1))
            (PUSH (SVREF KEYS1 I1) KEYS)
            (PUSH (SVREF VALS1 I1) VALS)
            (INCF I1)))
         (T
          (LET ((KEY1 (SVREF KEYS1 I1))
                (KEY2 (SVREF KEYS2 I2))
                ((COMP (COMPARE KEY1 KEY2))))
            (ECASE COMP
              ((:EQUAL)
               (PUSH KEY1 KEYS)
               (PUSH (FUNCALL VAL-FN (SVREF VALS1 I1) (SVREF VALS2 I2)) VALS)
               (INCF I1)
               (INCF I2))
              ((:LESS) (PUSH KEY1 KEYS) (PUSH (SVREF VALS1 I1) VALS) (INCF I1))
              ((:GREATER)
               (PUSH KEY2 KEYS)
               (PUSH (SVREF VALS2 I2) VALS)
               (INCF I2))
              ((:UNEQUAL)
               (PUSH
                (EQUIVALENT-MAP-UNION KEY1 (SVREF VALS1 I1) KEY2
                 (SVREF VALS2 I2) VAL-FN)
                KEYS)
               (PUSH NIL VALS)
               (INCF I1)
               (INCF I2)
               (SETQ ANY-EQUIVALENT? T)))))))))

[fset/Code/wb-trees.lisp:4756]
  (DEFUN VECTOR-PAIR-INTERSECT (PR1 PR2 VAL-FN LO HI)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE CONS PR1 PR2)
             (TYPE FUNCTION VAL-FN))
    (LET ((KEYS1 (THE SIMPLE-VECTOR (CAR PR1)))
          (VALS1 (THE SIMPLE-VECTOR (CDR PR1)))
          (KEYS2 (THE SIMPLE-VECTOR (CAR PR2)))
          (VALS2 (THE SIMPLE-VECTOR (CDR PR2)))
          (I1 0)
          (I2 0)
          ((LEN1 (LENGTH KEYS1)) (LEN2 (LENGTH KEYS2))))
      (DECLARE (TYPE FIXNUM I1 I2 LEN1 LEN2))
      (UNLESS (EQ LO HEDGE-NEGATIVE-INFINITY)
        (DO () ((OR (= I1 LEN1) (LESS-THAN? LO (SVREF KEYS1 I1)))) (INCF I1)))
      (UNLESS (EQ HI HEDGE-POSITIVE-INFINITY)
        (DO ()
            ((OR (= I1 LEN1) (LESS-THAN? (SVREF KEYS1 (1- LEN1)) HI)))
          (DECF LEN1)))
      (DO ((KEYS NIL)
           (VALS NIL))
          ((OR (= I1 LEN1) (= I2 LEN2))
           (AND KEYS
                (CONS (COERCE (NREVERSE KEYS) 'SIMPLE-VECTOR)
                      (COERCE (NREVERSE VALS) 'SIMPLE-VECTOR))))
        (LET ((KEY1 (SVREF KEYS1 I1))
              (KEY2 (SVREF KEYS2 I2))
              ((COMP (COMPARE KEY1 KEY2))))
          (ECASE COMP
            ((:EQUAL)
             (PUSH KEY1 KEYS)
             (PUSH (FUNCALL VAL-FN (SVREF VALS1 I1) (SVREF VALS2 I2)) VALS)
             (INCF I1)
             (INCF I2))
            ((:LESS) (INCF I1))
            ((:GREATER) (INCF I2))
            ((:UNEQUAL) (INCF I1) (INCF I2)))))))

[fset/Code/wb-trees.lisp:4863]
  (DEFUN VECTOR-PAIR-RESTRICT (MAP-PR SET-VEC LO HI)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE CONS MAP-PR)
             (TYPE SIMPLE-VECTOR SET-VEC))
    (LET ((MAP-KEYS (THE SIMPLE-VECTOR (CAR MAP-PR)))
          (MAP-VALS (THE SIMPLE-VECTOR (CDR MAP-PR)))
          (I1 0)
          (I2 0)
          ((LEN1 (LENGTH MAP-KEYS)) (LEN2 (LENGTH SET-VEC))))
      (DECLARE (TYPE FIXNUM I1 I2 LEN1 LEN2))
      (UNLESS (EQ LO HEDGE-NEGATIVE-INFINITY)
        (DO ()
            ((OR (= I1 LEN1) (LESS-THAN? LO (SVREF MAP-KEYS I1))))
          (INCF I1))
        (DO ()
            ((OR (= I2 LEN2) (LESS-THAN? LO (SVREF SET-VEC I2))))
          (INCF I2)))
      (UNLESS (EQ HI HEDGE-POSITIVE-INFINITY)
        (DO ()
            ((OR (= I1 LEN1) (LESS-THAN? (SVREF MAP-KEYS (1- LEN1)) HI)))
          (DECF LEN1))
        (DO ()
            ((OR (= I2 LEN2) (LESS-THAN? (SVREF SET-VEC (1- LEN2)) HI)))
          (DECF LEN2)))
      (DO ((KEYS NIL)
           (VALS NIL))
          ((OR (= I1 LEN1) (= I2 LEN2))
           (AND KEYS
                (CONS (COERCE (NREVERSE KEYS) 'SIMPLE-VECTOR)
                      (COERCE (NREVERSE VALS) 'SIMPLE-VECTOR))))
        (LET ((K (SVREF MAP-KEYS I1))
              (E (SVREF SET-VEC I2))
              ((COMP (COMPARE K E))))
          (ECASE COMP
            (:EQUAL
             (PUSH K KEYS)
             (PUSH (SVREF MAP-VALS I1) VALS)
             (INCF I1)
             (INCF I2))
            (:LESS (INCF I1))
            (:GREATER (INCF I2))
            (:UNEQUAL (INCF I1) (INCF I2)))))))

[fset/Code/wb-trees.lisp:4906]
  (DEFUN VECTOR-PAIR-RESTRICT-NOT (MAP-PR SET-VEC LO HI)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE CONS MAP-PR)
             (TYPE SIMPLE-VECTOR SET-VEC))
    (LET ((MAP-KEYS (THE SIMPLE-VECTOR (CAR MAP-PR)))
          (MAP-VALS (THE SIMPLE-VECTOR (CDR MAP-PR)))
          (I1 0)
          (I2 0)
          ((LEN1 (LENGTH MAP-KEYS)) (LEN2 (LENGTH SET-VEC))))
      (DECLARE (TYPE FIXNUM I1 I2 LEN1 LEN2))
      (UNLESS (EQ LO HEDGE-NEGATIVE-INFINITY)
        (DO ()
            ((OR (= I1 LEN1) (LESS-THAN? LO (SVREF MAP-KEYS I1))))
          (INCF I1))
        (DO ()
            ((OR (= I2 LEN2) (LESS-THAN? LO (SVREF SET-VEC I2))))
          (INCF I2)))
      (UNLESS (EQ HI HEDGE-POSITIVE-INFINITY)
        (DO ()
            ((OR (= I1 LEN1) (LESS-THAN? (SVREF MAP-KEYS (1- LEN1)) HI)))
          (DECF LEN1))
        (DO ()
            ((OR (= I2 LEN2) (LESS-THAN? (SVREF SET-VEC (1- LEN2)) HI)))
          (DECF LEN2)))
      (DO ((KEYS NIL)
           (VALS NIL))
          ((OR (= I1 LEN1) (= I2 LEN2))
           (DO ()
               ((= I1 LEN1))
             (PUSH (SVREF MAP-KEYS I1) KEYS)
             (PUSH (SVREF MAP-VALS I1) VALS)
             (INCF I1))
           (AND KEYS
                (CONS (COERCE (NREVERSE KEYS) 'SIMPLE-VECTOR)
                      (COERCE (NREVERSE VALS) 'SIMPLE-VECTOR))))
        (LET ((K (SVREF MAP-KEYS I1))
              (E (SVREF SET-VEC I2))
              ((COMP (COMPARE K E))))
          (ECASE COMP
            (:EQUAL (INCF I1) (INCF I2))
            (:LESS (PUSH K KEYS) (PUSH (SVREF MAP-VALS I1) VALS) (INCF I1))
            (:GREATER (INCF I2))
            (:UNEQUAL
             (PUSH K KEYS)
             (PUSH (SVREF MAP-VALS I1) VALS)
             (INCF I1)
             (INCF I2)))))))

[fset/Code/wb-trees.lisp:5020]
  (DEFUN WB-MAP-TREE-ITERATOR-CANONICALIZE (ITER)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LOOP
     (LET ((SP (SVREF ITER 0))
           ((NODE (SVREF ITER SP)) (IDX (SVREF ITER (1+ SP)))))
       (DECLARE (FIXNUM SP IDX))
       (COND
        ((NULL NODE)
         (IF (= SP 1)
             (RETURN)
             (PROGN
              (DECF SP 2)
              (SETF (SVREF ITER 0) SP)
              (INCF (THE FIXNUM (SVREF ITER (1+ SP)))))))
        ((CONSP NODE)
         (COND ((< IDX (LENGTH (THE SIMPLE-ARRAY (CAR NODE)))) (RETURN))
               ((= SP 1) (SETF (SVREF ITER 1) NIL) (RETURN))
               (T (DECF SP 2) (SETF (SVREF ITER 0) SP)
                (INCF (THE FIXNUM (SVREF ITER (1+ SP)))))))
        ((= IDX 0)
         (UNLESS (< (+ SP 3) (LENGTH ITER))
           (ERROR
            "Internal FSet error: iterator stack overflow.  Please report this bug."))
         (INCF SP 2) (SETF (SVREF ITER 0) SP)
         (SETF (SVREF ITER SP) (WB-MAP-TREE-NODE-LEFT NODE))
         (SETF (SVREF ITER (1+ SP)) 0))
        ((= IDX (1+ (MAP-KEY-SIZE (WB-MAP-TREE-NODE-KEY NODE))))
         (SETF (SVREF ITER SP) (WB-MAP-TREE-NODE-RIGHT NODE))
         (SETF (SVREF ITER (1+ SP)) 0))
        (T (RETURN)))))
    ITER)

[fset/Code/wb-trees.lisp:5058]
  (DEFUN WB-MAP-TREE-ITERATOR-DONE? (ITER)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (NULL (SVREF ITER (SVREF ITER 0))))

[fset/Code/wb-trees.lisp:5062]
  (DEFUN WB-MAP-TREE-ITERATOR-GET (ITER)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((SP (SVREF ITER 0))
          ((NODE (SVREF ITER SP)) (IDX (SVREF ITER (1+ SP)))))
      (DECLARE (FIXNUM IDX))
      (IF (NULL NODE)
          (VALUES NIL NIL NIL)
          (PROGN
           (INCF (THE FIXNUM (SVREF ITER (1+ SP))))
           (WB-MAP-TREE-ITERATOR-CANONICALIZE ITER)
           (IF (CONSP NODE)
               (VALUES (SVREF (CAR NODE) IDX) (SVREF (CDR NODE) IDX) T)
               (LET ((KEY (WB-MAP-TREE-NODE-KEY NODE)))
                 (IF (EQUIVALENT-MAP? KEY)
                     (LET ((PR (NTH (1- IDX) (EQUIVALENT-MAP-ALIST KEY))))
                       (VALUES (CAR PR) (CDR PR) T))
                     (VALUES KEY (WB-MAP-TREE-NODE-VALUE NODE) T))))))))

[fset/Code/wb-trees.lisp:5085]
  (DEFUN EQUIVALENT-MAP-UNION
         (KEY1 VAL1 KEY2 VAL2
          &OPTIONAL (VAL-FN #'(LAMBDA (V1 V2) (DECLARE (IGNORE V1)) V2)))
    "Both `key1' and `key2' may be single values (representing a single key/value
pair) or `Equivalent-Map's of key/value pairs.  That is, if `key1' is a
`Equivalent-Map', `val1' is ignored, and similarly for `key2' and `val2'.
Returns one or more new key/value pairs in which the \"2\" pairs override
the \"1\" pairs.  If the result is a single pair, it's returned as two values;
otherwise one value is returned, which is an `Equivalent-Map'."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE FUNCTION VAL-FN))
    (IF (EQUIVALENT-MAP? KEY1)
        (IF (EQUIVALENT-MAP? KEY2)
            (LET ((ALIST1 (EQUIVALENT-MAP-ALIST KEY1))
                  (ALIST2 (EQUIVALENT-MAP-ALIST KEY2))
                  ((RESULT NIL)))
              (DECLARE (TYPE LIST ALIST1 ALIST2))
              (DOLIST (PR1 ALIST1)
                (LET ((PR2 (FIND (CAR PR1) ALIST2 :TEST #'EQUAL? :KEY #'CAR)))
                  (IF PR2
                      (PUSH
                       (CONS (CAR PR1) (FUNCALL VAL-FN (CDR PR1) (CDR PR2)))
                       RESULT)
                      (PUSH PR1 RESULT))))
              (DOLIST (PR2 ALIST2)
                (LET ((PR1 (FIND (CAR PR2) ALIST1 :TEST #'EQUAL? :KEY #'CAR)))
                  (WHEN (NULL PR1) (PUSH PR2 RESULT))))
              (MAKE-EQUIVALENT-MAP RESULT))
            (LET ((ALIST1 (EQUIVALENT-MAP-ALIST KEY1))
                  ((PR1 (FIND KEY2 ALIST1 :TEST #'EQUAL? :KEY #'CAR))))
              (DECLARE (TYPE LIST ALIST1))
              (WHEN PR1
                (SETQ ALIST1 (REMOVE PR1 ALIST1))
                (SETQ VAL2 (FUNCALL VAL-FN (CDR PR1) VAL2)))
              (MAKE-EQUIVALENT-MAP (CONS (CONS KEY2 VAL2) ALIST1))))
        (IF (EQUIVALENT-MAP? KEY2)
            (LET ((ALIST2 (EQUIVALENT-MAP-ALIST KEY2))
                  ((PR2 (FIND KEY1 ALIST2 :TEST #'EQUAL? :KEY #'CAR))))
              (DECLARE (TYPE LIST ALIST2))
              (WHEN PR2
                (SETQ ALIST2 (REMOVE PR2 ALIST2))
                (SETQ VAL1 (FUNCALL VAL-FN VAL1 (CDR PR2))))
              (MAKE-EQUIVALENT-MAP (CONS (CONS KEY1 VAL1) ALIST2)))
            (IF (EQUAL? KEY1 KEY2)
                (VALUES KEY1 (FUNCALL VAL-FN VAL1 VAL2))
                (MAKE-EQUIVALENT-MAP
                 (LIST (CONS KEY1 VAL1) (CONS KEY2 VAL2)))))))

[fset/Code/wb-trees.lisp:5133]
  (DEFUN EQUIVALENT-MAP-INTERSECT (KEY1 VAL1 KEY2 VAL2 VAL-FN)
    "Both `key1' and `key2' may be single values (representing a single key/value
pair) or `Equivalent-Map's of key/value pairs.  That is, if `key1' is a
`Equivalent-Map', `val1' is ignored, and similarly for `key2' and `val2'.
If the intersection is nonnull, returns two or three values: if it is a
single pair, returns true, the key, and the value; if it is more than one
pair, returns true and an `Equivalent-Map' of the pairs.  If the intersection
is null, returns false."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE FUNCTION VAL-FN))
    (IF (EQUIVALENT-MAP? KEY1)
        (IF (EQUIVALENT-MAP? KEY2)
            (LET ((ALIST1 (EQUIVALENT-MAP-ALIST KEY1))
                  (ALIST2 (EQUIVALENT-MAP-ALIST KEY2))
                  (RESULT NIL))
              (DECLARE (TYPE LIST ALIST1 ALIST2))
              (DOLIST (PR1 ALIST1)
                (LET ((PR2 (FIND (CAR PR1) ALIST2 :TEST #'EQUAL? :KEY #'CAR)))
                  (WHEN PR2
                    (PUSH (CONS (CAR PR1) (FUNCALL VAL-FN (CDR PR1) (CDR PR2)))
                          RESULT))))
              (AND RESULT
                   (IF (CDR RESULT)
                       (VALUES T (MAKE-EQUIVALENT-MAP RESULT))
                       (VALUES T (CAAR RESULT) (CDAR RESULT)))))
            (LET ((ALIST1 (EQUIVALENT-MAP-ALIST KEY1))
                  ((PR1 (FIND KEY2 ALIST1 :TEST #'EQUAL? :KEY #'CAR))))
              (DECLARE (TYPE LIST ALIST1))
              (AND PR1 (VALUES T KEY2 (FUNCALL VAL-FN (CDR PR1) VAL2)))))
        (IF (EQUIVALENT-MAP? KEY2)
            (LET ((ALIST2 (EQUIVALENT-MAP-ALIST KEY2))
                  ((PR2 (FIND KEY1 ALIST2 :TEST #'EQUAL? :KEY #'CAR))))
              (DECLARE (TYPE LIST ALIST2))
              (AND PR2 (VALUES T KEY1 (FUNCALL VAL-FN VAL1 (CDR PR2)))))
            (AND (EQUAL? KEY1 KEY2)
                 (VALUES T KEY1 (FUNCALL VAL-FN VAL1 VAL2))))))

[fset/Code/wb-trees.lisp:5203]
  (DEFUN EQUIVALENT-MAP-LESS (EQVM KEY)
    "Removes the pair associated with `key' from `eqvm', an `Equivalent-Map'.  If
the result is a single pair, it's returned as two values; otherwise one value
is returned, which is an `Equivalent-Map'."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((ALIST (EQUIVALENT-MAP-ALIST EQVM))
          ((PR (ASSOC KEY ALIST :TEST #'EQUAL?))))
      (IF PR
          (LET ((RESULT (REMOVE PR ALIST)))
            (DECLARE (TYPE LIST RESULT))
            (IF (= (LENGTH RESULT) 1)
                (VALUES (CAAR RESULT) (CDAR RESULT))
                (MAKE-EQUIVALENT-MAP RESULT)))
          EQVM)))

[fset/Code/wb-trees.lisp:5218]
  (DEFUN EQUIVALENT-MAP-RESTRICT (KEY VAL SET-ELT)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (IF (EQUIVALENT-MAP? KEY)
        (LET ((ALIST1 (EQUIVALENT-MAP-ALIST KEY))
              (MEMS2
               (IF (EQUIVALENT-SET? SET-ELT)
                   (EQUIVALENT-SET-MEMBERS SET-ELT)
                   (LIST SET-ELT))))
          (LET ((RESULT
                 (REMOVE-IF-NOT
                  #'(LAMBDA (PR) (MEMBER (CAR PR) MEMS2 :TEST #'EQUAL?))
                  ALIST1)))
            (COND ((NULL RESULT) NIL)
                  ((NULL (CDR RESULT)) (VALUES T (CAAR RESULT) (CDAR RESULT)))
                  (T (VALUES T (MAKE-EQUIVALENT-MAP RESULT) NIL)))))
        (IF (EQUIVALENT-SET? SET-ELT)
            (AND (MEMBER KEY (EQUIVALENT-SET-MEMBERS SET-ELT) :TEST #'EQUAL?)
                 (VALUES T KEY VAL))
            (AND (EQUAL? KEY SET-ELT) (VALUES T KEY VAL)))))

[fset/Code/wb-trees.lisp:5238]
  (DEFUN EQUIVALENT-MAP-RESTRICT-NOT (KEY VAL SET-ELT)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (IF (EQUIVALENT-MAP? KEY)
        (LET ((ALIST1 (EQUIVALENT-MAP-ALIST KEY))
              (MEMS2
               (IF (EQUIVALENT-SET? SET-ELT)
                   (EQUIVALENT-SET-MEMBERS SET-ELT)
                   (LIST SET-ELT))))
          (LET ((RESULT
                 (REMOVE-IF
                  #'(LAMBDA (PR) (MEMBER (CAR PR) MEMS2 :TEST #'EQUAL?))
                  ALIST1)))
            (COND ((NULL RESULT) NIL)
                  ((NULL (CDR RESULT)) (VALUES T (CAAR RESULT) (CDAR RESULT)))
                  (T (VALUES T (MAKE-EQUIVALENT-MAP RESULT) NIL)))))
        (IF (EQUIVALENT-SET? SET-ELT)
            (AND
             (NOT (MEMBER KEY (EQUIVALENT-SET-MEMBERS SET-ELT) :TEST #'EQUAL?))
             (VALUES T KEY VAL))
            (AND (NOT (EQUAL? KEY SET-ELT)) (VALUES T KEY VAL)))))

[fset/Code/wb-trees.lisp:5258]
  (DEFUN EQUIVALENT-MAP-COMPARE (KEY1 VAL1 KEY2 VAL2 VAL-FN)
    "Compares two pairs where the key of either or both may be an `Equivalent-Map'."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE FUNCTION VAL-FN))
    (LET ((COMP (COMPARE KEY1 KEY2)))
      (IF (OR (EQ COMP ':LESS) (EQ COMP ':GREATER))
          COMP
          (IF (EQUIVALENT-MAP? KEY1)
              (IF (EQUIVALENT-MAP? KEY2)
                  (LET ((MEMS1 (EQUIVALENT-MAP-ALIST KEY1))
                        (MEMS2 (EQUIVALENT-MAP-ALIST KEY2))
                        ((LEN1 (LENGTH MEMS1)) (LEN2 (LENGTH MEMS2))))
                    (COND ((< LEN1 LEN2) ':GREATER) ((> LEN1 LEN2) ':LESS)
                          ((EVERY
                            #'(LAMBDA (PR1)
                                (LET ((PR2
                                       (ASSOC (CAR PR1) MEMS2 :TEST #'EQUAL?)))
                                  (AND PR2 (EQUAL? (CDR PR1) (CDR PR2)))))
                            MEMS1)
                           ':EQUAL)
                          (T
                           (LET ((SET1
                                  (REDUCE #'WB-SET-TREE-WITH
                                          (MAPCAR #'CDR MEMS1) :INITIAL-VALUE
                                          NIL))
                                 (SET2
                                  (REDUCE #'WB-SET-TREE-WITH
                                          (MAPCAR #'CDR MEMS2) :INITIAL-VALUE
                                          NIL))
                                 ((COMP (WB-SET-TREE-COMPARE SET1 SET2))))
                             (IF (EQ COMP ':EQUAL)
                                 ':UNEQUAL
                                 COMP)))))
                  ':LESS)
              (IF (EQUIVALENT-MAP? KEY2)
                  ':GREATER
                  (LET ((VAL-COMP (FUNCALL VAL-FN VAL1 VAL2)))
                    (IF (NOT (EQ VAL-COMP ':EQUAL))
                        VAL-COMP
                        COMP)))))))

[fset/Code/wb-trees.lisp:5353]
  (DEFUN WB-SEQ-TREE-SIZE (TREE)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-SEQ-TREE TREE))
    (COND ((NULL TREE) 0) ((STRINGP TREE) (LENGTH TREE))
          ((SIMPLE-VECTOR-P TREE) (LENGTH TREE))
          (T (WB-SEQ-TREE-NODE-SIZE TREE))))

[fset/Code/wb-trees.lisp:5362]
  (DEFUN WB-SEQ-TREE-SUBSCRIPT (TREE IDX)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-SEQ-TREE TREE)
             (TYPE FIXNUM IDX))
    (COND ((NULL TREE) NIL)
          ((STRINGP TREE)
           (AND (>= IDX 0) (< IDX (LENGTH TREE)) (VALUES T (SCHAR TREE IDX))))
          ((SIMPLE-VECTOR-P TREE)
           (AND (>= IDX 0) (< IDX (LENGTH TREE)) (VALUES T (SVREF TREE IDX))))
          (T
           (LET ((LEFT (WB-SEQ-TREE-NODE-LEFT TREE))
                 ((LEFT-SIZE (WB-SEQ-TREE-SIZE LEFT))))
             (IF (< IDX LEFT-SIZE)
                 (WB-SEQ-TREE-SUBSCRIPT LEFT IDX)
                 (WB-SEQ-TREE-SUBSCRIPT (WB-SEQ-TREE-NODE-RIGHT TREE)
                  (- IDX LEFT-SIZE)))))))

[fset/Code/wb-trees.lisp:5385]
  (DEFUN WB-SEQ-TREE-INSERT (TREE IDX VALUE)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-SEQ-TREE TREE)
             (TYPE FIXNUM IDX))
    (COND
     ((NULL TREE)
      (IF (CHARACTERP VALUE)
          (STRING VALUE)
          (VECTOR VALUE)))
     ((STRINGP TREE)
      (IF (CHARACTERP VALUE)
          (IF (< (LENGTH TREE) *WB-TREE-MAX-STRING-LENGTH*)
              (STRING-INSERT TREE IDX VALUE)
              (IF (< (* IDX 2) (LENGTH TREE))
                  (MAKE-WB-SEQ-TREE-NODE
                   (STRING-SUBSEQ-INSERT TREE 0 IDX IDX VALUE)
                   (STRING-SUBSEQ TREE IDX))
                  (MAKE-WB-SEQ-TREE-NODE (STRING-SUBSEQ TREE 0 IDX)
                   (STRING-SUBSEQ-INSERT TREE IDX (LENGTH TREE) 0 VALUE))))
          (IF (< (LENGTH TREE) *WB-TREE-MAX-VECTOR-LENGTH*)
              (VECTOR-INSERT-FROM-STRING TREE IDX VALUE)
              (LET ((LEFT (AND (> IDX 0) (STRING-SUBSEQ TREE 0 IDX)))
                    (RIGHT
                     (AND (< IDX (LENGTH TREE)) (STRING-SUBSEQ TREE IDX))))
                (DECLARE (TYPE (OR SIMPLE-STRING NULL) LEFT RIGHT))
                (IF (< (LENGTH-NV LEFT) (LENGTH-NV RIGHT))
                    (MAKE-WB-SEQ-TREE-NODE
                     (VECTOR-INSERT (COERCE LEFT 'SIMPLE-VECTOR) IDX VALUE)
                     RIGHT)
                    (MAKE-WB-SEQ-TREE-NODE LEFT
                     (VECTOR-INSERT (COERCE RIGHT 'SIMPLE-VECTOR) 0
                      VALUE)))))))
     ((SIMPLE-VECTOR-P TREE)
      (IF (< (LENGTH TREE) *WB-TREE-MAX-VECTOR-LENGTH*)
          (VECTOR-INSERT TREE IDX VALUE)
          (IF (< (* IDX 2) (LENGTH TREE))
              (MAKE-WB-SEQ-TREE-NODE
               (VECTOR-SUBSEQ-INSERT TREE 0 IDX IDX VALUE)
               (VECTOR-SUBSEQ TREE IDX))
              (MAKE-WB-SEQ-TREE-NODE (VECTOR-SUBSEQ TREE 0 IDX)
               (VECTOR-SUBSEQ-INSERT TREE IDX (LENGTH TREE) 0 VALUE)))))
     (T
      (LET ((LEFT (WB-SEQ-TREE-NODE-LEFT TREE))
            ((LEFT-SIZE (WB-SEQ-TREE-SIZE LEFT)))
            (RIGHT (WB-SEQ-TREE-NODE-RIGHT TREE)))
        (IF (< IDX LEFT-SIZE)
            (WB-SEQ-TREE-BUILD-NODE (WB-SEQ-TREE-INSERT LEFT IDX VALUE) RIGHT)
            (WB-SEQ-TREE-BUILD-NODE LEFT
             (WB-SEQ-TREE-INSERT RIGHT (- IDX LEFT-SIZE) VALUE)))))))

[fset/Code/wb-trees.lisp:5433]
  (DEFUN STRING-INSERT (STR IDX CH)
    "Returns a new string like `str' but with `ch' inserted at `idx'.  Careful --
does no bounds checking on `str', which it assumes is simple."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE SIMPLE-STRING STR)
             (TYPE FIXNUM IDX))
    (LET ((LEN (LENGTH STR))
          ((NEW-STR
            (MAKE-STRING (1+ LEN) :ELEMENT-TYPE
                         (IF (AND (TYPEP STR 'BASE-STRING)
                                  (TYPEP CH 'BASE-CHAR))
                             'BASE-CHAR
                             'CHARACTER)))))
      (DOTIMES (I IDX) (SETF (SCHAR NEW-STR I) (SCHAR STR I)))
      (SETF (SCHAR NEW-STR IDX) CH)
      (DOTIMES (I (- LEN IDX))
        (SETF (SCHAR NEW-STR (+ IDX I 1)) (SCHAR STR (+ IDX I))))
      NEW-STR))

[fset/Code/wb-trees.lisp:5454]
  (DEFUN VECTOR-INSERT-FROM-STRING (STR IDX VAL)
    "Returns a new vector like `str' (a string) but with `val' inserted at `idx'.
Careful -- does no bounds checking on `str', which it assumes is simple."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE SIMPLE-STRING STR)
             (TYPE FIXNUM IDX))
    (LET ((LEN (LENGTH STR)) ((NEW-VEC (MAKE-ARRAY (1+ LEN)))))
      (DOTIMES (I IDX) (SETF (SVREF NEW-VEC I) (SCHAR STR I)))
      (SETF (SVREF NEW-VEC IDX) VAL)
      (DOTIMES (I (- LEN IDX))
        (SETF (SVREF NEW-VEC (+ IDX I 1)) (SCHAR STR (+ IDX I))))
      NEW-VEC))

[fset/Code/wb-trees.lisp:5471]
  (DEFUN STRING-SUBSEQ (STR START &OPTIONAL (END (LENGTH STR)))
    "Returns a subsequence of `str' between `start' and `end'.  Careful -- does
no bounds checking on `str', which it assumes is simple."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE SIMPLE-STRING STR)
             (TYPE FIXNUM START END))
    (LET ((LEN (- END START))
          ((NEW-STR
            (MAKE-STRING LEN :ELEMENT-TYPE
                         (IF (TYPEP STR 'BASE-STRING)
                             'BASE-CHAR
                             'CHARACTER)))))
      (DOTIMES (I LEN) (SETF (SCHAR NEW-STR I) (SCHAR STR (+ I START))))
      NEW-STR))

[fset/Code/wb-trees.lisp:5487]
  (DEFUN STRING-SUBSEQ-INSERT (STR START END IDX CH)
    "Takes the subsequence of `str' from `start' to `end', then at `idx' within
the result, inserts `ch', returning the new string."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE SIMPLE-STRING STR)
             (TYPE FIXNUM START END IDX))
    (LET ((LEN (- END START))
          ((NEW-STR
            (MAKE-STRING (1+ LEN) :ELEMENT-TYPE
                         (IF (AND (TYPEP STR 'BASE-STRING)
                                  (TYPEP CH 'BASE-CHAR))
                             'BASE-CHAR
                             'CHARACTER)))))
      (DOTIMES (I IDX) (SETF (SCHAR NEW-STR I) (SCHAR STR (+ I START))))
      (SETF (SCHAR NEW-STR IDX) CH)
      (DOTIMES (I (- LEN IDX))
        (SETF (SCHAR NEW-STR (+ IDX I 1)) (SCHAR STR (+ IDX I START))))
      NEW-STR))

[fset/Code/wb-trees.lisp:5508]
  (DEFUN VECTOR-SUBSEQ-INSERT (VEC START END IDX VAL)
    "Takes the subsequence of `vec' from `start' to `end', then at `idx' within
the result, inserts `val', returning the new vector."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE SIMPLE-VECTOR VEC)
             (TYPE FIXNUM START END IDX))
    (LET ((LEN (- END START)) ((NEW-VEC (MAKE-ARRAY (1+ LEN)))))
      (DOTIMES (I IDX) (SETF (SVREF NEW-VEC I) (SVREF VEC (+ I START))))
      (SETF (SVREF NEW-VEC IDX) VAL)
      (DOTIMES (I (- LEN IDX))
        (SETF (SVREF NEW-VEC (+ IDX I 1)) (SVREF VEC (+ IDX I START))))
      NEW-VEC))

[fset/Code/wb-trees.lisp:5526]
  (DEFUN WB-SEQ-TREE-REMOVE (TREE IDX)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-SEQ-TREE TREE)
             (TYPE FIXNUM IDX))
    (COND ((NULL TREE) NIL) ((STRINGP TREE) (STRING-REMOVE-AT TREE IDX))
          ((SIMPLE-VECTOR-P TREE) (VECTOR-REMOVE-AT TREE IDX))
          (T
           (LET ((LEFT (WB-SEQ-TREE-NODE-LEFT TREE))
                 ((LEFT-SIZE (WB-SEQ-TREE-SIZE LEFT)))
                 (RIGHT (WB-SEQ-TREE-NODE-RIGHT TREE)))
             (IF (< IDX LEFT-SIZE)
                 (WB-SEQ-TREE-BUILD-NODE (WB-SEQ-TREE-REMOVE LEFT IDX) RIGHT)
                 (WB-SEQ-TREE-BUILD-NODE LEFT
                  (WB-SEQ-TREE-REMOVE RIGHT (- IDX LEFT-SIZE))))))))

[fset/Code/wb-trees.lisp:5544]
  (DEFUN STRING-REMOVE-AT (STR IDX)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE SIMPLE-STRING STR)
             (TYPE FIXNUM IDX))
    (LET ((LEN (LENGTH STR))
          ((NEW-STR
            (MAKE-STRING (1- LEN) :ELEMENT-TYPE
                         (IF (TYPEP STR 'BASE-STRING)
                             'BASE-CHAR
                             'CHARACTER)))))
      (DOTIMES (I IDX) (SETF (SCHAR NEW-STR I) (SCHAR STR I)))
      (DOTIMES (I (- LEN IDX 1))
        (SETF (SCHAR NEW-STR (+ IDX I)) (SCHAR STR (+ IDX I 1))))
      NEW-STR))

[fset/Code/wb-trees.lisp:5562]
  (DEFUN WB-SEQ-TREE-WITH (TREE IDX VALUE)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-SEQ-TREE TREE)
             (TYPE FIXNUM IDX))
    (COND ((NULL TREE) (ERROR "This case shouldn't happen"))
          ((STRINGP TREE)
           (IF (CHARACTERP VALUE)
               (STRING-UPDATE TREE IDX VALUE)
               (VECTOR-UPDATE-FROM-STRING TREE IDX VALUE)))
          ((SIMPLE-VECTOR-P TREE) (VECTOR-UPDATE TREE IDX VALUE))
          (T
           (LET ((LEFT (WB-SEQ-TREE-NODE-LEFT TREE))
                 ((LEFT-SIZE (WB-SEQ-TREE-SIZE LEFT)))
                 (RIGHT (WB-SEQ-TREE-NODE-RIGHT TREE)))
             (IF (< IDX LEFT-SIZE)
                 (MAKE-WB-SEQ-TREE-NODE (WB-SEQ-TREE-WITH LEFT IDX VALUE)
                  RIGHT)
                 (MAKE-WB-SEQ-TREE-NODE LEFT
                  (WB-SEQ-TREE-WITH RIGHT (- IDX LEFT-SIZE) VALUE)))))))

[fset/Code/wb-trees.lisp:5584]
  (DEFUN STRING-UPDATE (STR IDX CH)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE SIMPLE-STRING STR)
             (TYPE FIXNUM IDX))
    (LET ((LEN (LENGTH STR))
          ((NEW-STR
            (MAKE-STRING LEN :ELEMENT-TYPE
                         (IF (AND (TYPEP STR 'BASE-STRING)
                                  (TYPEP CH 'BASE-CHAR))
                             'BASE-CHAR
                             'CHARACTER)))))
      (DOTIMES (I LEN) (SETF (SCHAR NEW-STR I) (SCHAR STR I)))
      (SETF (SCHAR NEW-STR IDX) CH)
      NEW-STR))

[fset/Code/wb-trees.lisp:5600]
  (DEFUN VECTOR-UPDATE-FROM-STRING (STR IDX VALUE)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE SIMPLE-STRING STR)
             (TYPE FIXNUM IDX))
    (LET ((LEN (LENGTH STR)) ((NEW-VEC (MAKE-ARRAY LEN))))
      (DOTIMES (I LEN) (SETF (SVREF NEW-VEC I) (SCHAR STR I)))
      (SETF (SVREF NEW-VEC IDX) VALUE)
      NEW-VEC))

[fset/Code/wb-trees.lisp:5614]
  (DEFUN WB-SEQ-TREE-SUBSEQ (TREE START END)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-SEQ-TREE TREE)
             (TYPE FIXNUM START END))
    (COND ((OR (NULL TREE) (>= START END)) NIL)
          ((SIMPLE-VECTOR-P TREE)
           (IF (AND (= START 0) (= END (LENGTH TREE)))
               TREE
               (VECTOR-SUBSEQ TREE START END)))
          ((STRINGP TREE)
           (IF (AND (= START 0) (= END (LENGTH TREE)))
               TREE
               (STRING-SUBSEQ TREE START END)))
          (T
           (LET ((LEFT (WB-SEQ-TREE-NODE-LEFT TREE))
                 ((LEFT-SIZE (WB-SEQ-TREE-SIZE LEFT)))
                 (RIGHT (WB-SEQ-TREE-NODE-RIGHT TREE))
                 ((RIGHT-SIZE (WB-SEQ-TREE-SIZE RIGHT))
                  ((NEW-LEFT
                    (IF (AND (= START 0) (<= LEFT-SIZE END))
                        LEFT
                        (WB-SEQ-TREE-SUBSEQ LEFT START (MIN END LEFT-SIZE))))
                   (NEW-RIGHT
                    (IF (AND (<= START LEFT-SIZE)
                             (= (+ LEFT-SIZE RIGHT-SIZE) END))
                        RIGHT
                        (WB-SEQ-TREE-SUBSEQ RIGHT
                         (MAX 0 (THE FIXNUM (- START LEFT-SIZE)))
                         (- END LEFT-SIZE)))))))
             (IF (AND (EQ NEW-LEFT LEFT) (EQ NEW-RIGHT RIGHT))
                 TREE
                 (WB-SEQ-TREE-CONCAT NEW-LEFT NEW-RIGHT))))))

[fset/Code/wb-trees.lisp:5658]
  (DEFUN WB-SEQ-TREE-FROM-VECTOR (VEC)
    (DECLARE (OPTIMIZE (SPEED 1) (SAFETY 1))
             (TYPE VECTOR VEC))
    (AND (> (LENGTH VEC) 0)
         (LET ((LEN (LENGTH VEC))
               ((NPIECES
                 (CEILING LEN
                          (IF (STRINGP VEC)
                              *WB-TREE-MAX-STRING-LENGTH*
                              *WB-TREE-MAX-VECTOR-LENGTH*)))
                ((PIECE-LEN REMAINDER (FLOOR LEN NPIECES)))))
           (DECLARE (TYPE FIXNUM NPIECES PIECE-LEN REMAINDER))
           (DO ((IPIECE 0 (1+ IPIECE))
                (BASE 0)
                (STACK NIL))
               ((= IPIECE NPIECES)
                (DO ()
                    ((NULL (CDR STACK)))
                  (LET ((RIGHT (POP STACK)) (LEFT (POP STACK)))
                    (PUSH (MAKE-WB-SEQ-TREE-NODE LEFT RIGHT) STACK)))
                (CAR STACK))
             (DECLARE (TYPE FIXNUM IPIECE BASE))
             (LET ((PIECE-LEN
                    (IF (< IPIECE REMAINDER)
                        (1+ PIECE-LEN)
                        PIECE-LEN))
                   ((PIECE
                     (COND
                      ((GMAP :AND #'BASE-CHAR-P
                        (:VECTOR VEC :START BASE :STOP (+ BASE PIECE-LEN)))
                       (LET ((STR
                              (MAKE-STRING PIECE-LEN :ELEMENT-TYPE 'BASE-CHAR)))
                         (DOTIMES (I PIECE-LEN)
                           (SETF (SCHAR STR I) (AREF VEC (+ BASE I))))
                         STR))
                      ((GMAP :AND #'(LAMBDA (X) (TYPEP X 'CHARACTER))
                        (:VECTOR VEC :START BASE :STOP (+ BASE PIECE-LEN)))
                       (LET ((STR
                              (MAKE-STRING PIECE-LEN :ELEMENT-TYPE 'CHARACTER)))
                         (DOTIMES (I PIECE-LEN)
                           (SETF (CHAR STR I) (AREF VEC (+ BASE I))))
                         STR))
                      ((SIMPLE-VECTOR-P VEC)
                       (VECTOR-SUBSEQ VEC BASE (+ BASE PIECE-LEN)))
                      (T (SUBSEQ VEC BASE (+ BASE PIECE-LEN)))))))
               (PUSH PIECE STACK)
               (INCF BASE PIECE-LEN)
               (DO ((I IPIECE (ASH I -1)))
                   ((EVENP I))
                 (DECLARE (TYPE FIXNUM I))
                 (LET ((RIGHT (POP STACK)) (LEFT (POP STACK)))
                   (PUSH (MAKE-WB-SEQ-TREE-NODE LEFT RIGHT) STACK))))))))

[fset/Code/wb-trees.lisp:5711]
  (DEFUN WB-SEQ-TREE-TO-VECTOR (TREE)
    (LET ((RESULT (MAKE-ARRAY (WB-SEQ-TREE-SIZE TREE))))
      (LABELS ((FILLR (TREE RESULT IDX)
                 (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
                          (FIXNUM IDX))
                 (COND
                  ((STRINGP TREE)
                   (DOTIMES (I (LENGTH (THE SIMPLE-STRING TREE)))
                     (SETF (SVREF RESULT (+ IDX I)) (SCHAR TREE I))))
                  ((SIMPLE-VECTOR-P TREE)
                   (DOTIMES (I (LENGTH TREE))
                     (SETF (SVREF RESULT (+ IDX I)) (SVREF TREE I))))
                  (T
                   (LET ((LEFT (WB-SEQ-TREE-NODE-LEFT TREE)))
                     (FILLR LEFT RESULT IDX)
                     (FILLR (WB-SEQ-TREE-NODE-RIGHT TREE) RESULT
                      (+ IDX (WB-SEQ-TREE-SIZE LEFT))))))))
        (FILLR TREE RESULT 0)
        RESULT)))

[fset/Code/wb-trees.lisp:5730]
  (DEFUN WB-SEQ-TREE-TO-STRING (TREE)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (IF (NULL TREE)
        ""
        (LABELS ((ELEMENT-TYPE (TREE)
                   (COND ((NULL TREE) 'BASE-CHAR)
                         ((VECTORP TREE)
                          (COND ((TYPEP TREE 'BASE-STRING) 'BASE-CHAR)
                                ((STRINGP TREE) 'CHARACTER)
                                (T
                                 (ERROR 'TYPE-ERROR :DATUM
                                        (FIND-IF-NOT #'CHARACTERP TREE)
                                        :EXPECTED-TYPE 'CHARACTER))))
                         (T
                          (LET ((LEFT
                                 (ELEMENT-TYPE (WB-SEQ-TREE-NODE-LEFT TREE)))
                                (RIGHT
                                 (ELEMENT-TYPE (WB-SEQ-TREE-NODE-RIGHT TREE))))
                            (DECLARE (IGNORABLE LEFT RIGHT))
                            (COND
                             ((OR (EQ LEFT 'CHARACTER) (EQ RIGHT 'CHARACTER))
                              'CHARACTER)
                             (T 'BASE-CHAR)))))))
          (LET ((ELT-TYPE (ELEMENT-TYPE TREE)))
            (LET ((RESULT
                   (MAKE-STRING (WB-SEQ-TREE-SIZE TREE) :ELEMENT-TYPE
                                ELT-TYPE)))
              (LABELS ((FILLR (TREE RESULT IDX)
                         (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
                                  (FIXNUM IDX))
                         (COND
                          ((STRINGP TREE)
                           (DOTIMES (I (LENGTH (THE SIMPLE-STRING TREE)))
                             (SETF (SCHAR RESULT (+ IDX I)) (SCHAR TREE I))))
                          (T
                           (LET ((LEFT (WB-SEQ-TREE-NODE-LEFT TREE)))
                             (FILLR LEFT RESULT IDX)
                             (FILLR (WB-SEQ-TREE-NODE-RIGHT TREE) RESULT
                              (+ IDX (WB-SEQ-TREE-SIZE LEFT))))))))
                (FILLR TREE RESULT 0)
                RESULT))))))

[fset/Code/wb-trees.lisp:5774]
  (DEFUN WB-SEQ-TREE-FROM-LIST (LST)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE LIST LST))
    (AND LST
         (LET ((LEN (LENGTH LST))
               ((NPIECES (CEILING LEN *WB-TREE-MAX-VECTOR-LENGTH*))
                ((PIECE-LEN REMAINDER (FLOOR LEN NPIECES)))))
           (DECLARE (TYPE FIXNUM NPIECES PIECE-LEN REMAINDER))
           (DO ((IPIECE 0 (1+ IPIECE))
                (STACK NIL))
               ((= IPIECE NPIECES)
                (DO ()
                    ((NULL (CDR STACK)))
                  (LET ((RIGHT (POP STACK)) (LEFT (POP STACK)))
                    (PUSH (MAKE-WB-SEQ-TREE-NODE LEFT RIGHT) STACK)))
                (CAR STACK))
             (DECLARE (TYPE FIXNUM IPIECE))
             (LET ((PIECE-LEN
                    (IF (< IPIECE REMAINDER)
                        (1+ PIECE-LEN)
                        PIECE-LEN))
                   ((PIECE
                     (COND
                      ((GMAP :AND
                        #'(LAMBDA (X Y)
                            (DECLARE (IGNORE Y))
                            (TYPEP X 'BASE-CHAR))
                        (:LIST LST) (:INDEX 0 PIECE-LEN))
                       (LET ((STR
                              (MAKE-STRING PIECE-LEN :ELEMENT-TYPE 'BASE-CHAR)))
                         (DOTIMES (I PIECE-LEN) (SETF (SCHAR STR I) (POP LST)))
                         STR))
                      ((GMAP :AND
                        #'(LAMBDA (X Y)
                            (DECLARE (IGNORE Y))
                            (TYPEP X 'CHARACTER))
                        (:LIST LST) (:INDEX 0 PIECE-LEN))
                       (LET ((STR
                              (MAKE-STRING PIECE-LEN :ELEMENT-TYPE 'CHARACTER)))
                         (DOTIMES (I PIECE-LEN) (SETF (CHAR STR I) (POP LST)))
                         STR))
                      (T
                       (LET ((VEC (MAKE-ARRAY PIECE-LEN)))
                         (DOTIMES (I PIECE-LEN) (SETF (SVREF VEC I) (POP LST)))
                         VEC))))))
               (PUSH PIECE STACK)
               (DO ((I IPIECE (ASH I -1)))
                   ((EVENP I))
                 (DECLARE (TYPE FIXNUM I))
                 (LET ((RIGHT (POP STACK)) (LEFT (POP STACK)))
                   (PUSH (MAKE-WB-SEQ-TREE-NODE LEFT RIGHT) STACK))))))))

[fset/Code/wb-trees.lisp:5824]
  (DEFUN WB-SEQ-TREE-TO-LIST (TREE)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (IF (OR (NULL TREE) (VECTORP TREE))
        (COERCE TREE 'LIST)
        (LABELS ((BUILD (TREE RESULT)
                   (COND ((NULL TREE) RESULT)
                         ((VECTORP TREE) (NCONC (COERCE TREE 'LIST) RESULT))
                         (T
                          (BUILD (WB-SEQ-TREE-NODE-LEFT TREE)
                           (BUILD (WB-SEQ-TREE-NODE-RIGHT TREE) RESULT))))))
          (BUILD TREE NIL))))

[fset/Code/wb-trees.lisp:5859]
  (DEFUN WB-SEQ-TREE-COMPARE-RNG (TREE1 BASE1 TREE2 BASE2 LO HI)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-SEQ-TREE TREE1 TREE2)
             (TYPE FIXNUM BASE1 BASE2 LO HI))
    (COND ((AND (EQ TREE1 TREE2) (= BASE1 BASE2)) ':EQUAL) ((= LO HI) ':EQUAL)
          ((AND (STRINGP TREE1) (STRINGP TREE2))
           (OR
            (GMAP :OR
             #'(LAMBDA (CH1 CH2)
                 (COND ((CHAR< CH1 CH2) ':LESS) ((CHAR> CH1 CH2) ':GREATER)))
             (:SIMPLE-STRING TREE1 :START (- LO BASE1) :STOP (- HI BASE1))
             (:SIMPLE-STRING TREE2 :START (- LO BASE2) :STOP (- HI BASE2)))
            ':EQUAL))
          ((AND (VECTORP TREE1) (VECTORP TREE2))
           (LET ((UNEQUAL? NIL))
             (OR
              (GMAP :OR
               #'(LAMBDA (VAL1 VAL2)
                   (LET ((COMP (COMPARE VAL1 VAL2)))
                     (WHEN (EQ COMP ':UNEQUAL) (SETQ UNEQUAL? T))
                     (AND (OR (EQ COMP ':LESS) (EQ COMP ':GREATER)) COMP)))
               (:VECTOR TREE1 :START (- LO BASE1) :STOP (- HI BASE1))
               (:VECTOR TREE2 :START (- LO BASE2) :STOP (- HI BASE2)))
              (IF UNEQUAL?
                  ':UNEQUAL
                  ':EQUAL))))
          ((OR (STRINGP TREE1) (SIMPLE-VECTOR-P TREE1))
           (LET ((REV-COMP
                  (WB-SEQ-TREE-COMPARE-RNG TREE2 BASE2 TREE1 BASE1 LO HI)))
             (ECASE REV-COMP
               (:LESS ':GREATER)
               (:GREATER ':LESS)
               ((:EQUAL :UNEQUAL) REV-COMP))))
          (T
           (LET ((LEFT1 (WB-SEQ-TREE-NODE-LEFT TREE1))
                 ((LEFT1-SIZE (THE FIXNUM (WB-SEQ-TREE-SIZE LEFT1)))
                  ((NEW-MID (THE FIXNUM (+ BASE1 LEFT1-SIZE)))
                   ((LEFT1A BASE1A (WB-SEQ-TREE-TRIM LEFT1 BASE1 LO NEW-MID))
                    (TREE2A BASE2A (WB-SEQ-TREE-TRIM TREE2 BASE2 LO NEW-MID))
                    ((LEFT-COMP
                      (WB-SEQ-TREE-COMPARE-RNG LEFT1A BASE1A TREE2A BASE2A LO
                       NEW-MID)))))))
             (IF (OR (EQ LEFT-COMP ':LESS) (EQ LEFT-COMP ':GREATER))
                 LEFT-COMP
                 (LET ((RIGHT1A
                        BASE1A
                        (WB-SEQ-TREE-TRIM (WB-SEQ-TREE-NODE-RIGHT TREE1)
                         NEW-MID NEW-MID HI))
                       (TREE2A
                        BASE2A
                        (WB-SEQ-TREE-TRIM TREE2 BASE2 NEW-MID HI))
                       ((RIGHT-COMP
                         (WB-SEQ-TREE-COMPARE-RNG RIGHT1A BASE1A TREE2A BASE2A
                          NEW-MID HI))))
                   (IF (NOT (EQ RIGHT-COMP ':EQUAL))
                       RIGHT-COMP
                       LEFT-COMP)))))))

[fset/Code/wb-trees.lisp:5926]
  (DEFUN VECTOR-SEQ-TO-SET (VEC LO HI)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE SIMPLE-VECTOR VEC)
             (TYPE FIXNUM LO HI))
    (COND ((= LO HI) NIL) ((= HI (1+ LO)) (VECTOR (SVREF VEC LO)))
          (T
           (LET ((MID (ASH (+ LO HI) -1)))
             (WB-SET-TREE-UNION (VECTOR-SEQ-TO-SET VEC LO MID)
              (VECTOR-SEQ-TO-SET VEC MID HI))))))

[fset/Code/wb-trees.lisp:5938]
  (DEFUN STRING-SEQ-TO-SET (VEC LO HI)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE SIMPLE-STRING VEC)
             (TYPE FIXNUM LO HI))
    (COND ((= LO HI) NIL) ((= HI (1+ LO)) (VECTOR (SCHAR VEC LO)))
          (T
           (LET ((MID (ASH (+ LO HI) -1)))
             (WB-SET-TREE-UNION (STRING-SEQ-TO-SET VEC LO MID)
              (STRING-SEQ-TO-SET VEC MID HI))))))

[fset/Code/wb-trees.lisp:5954]
  (DEFUN WB-SEQ-TREE-CONCAT (LEFT RIGHT)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-SEQ-TREE LEFT RIGHT))
    (COND ((NULL LEFT) RIGHT) ((NULL RIGHT) LEFT)
          ((AND (WB-SEQ-TREE-NODE? LEFT)
                (> (WB-SEQ-TREE-SIZE LEFT)
                   (* (WB-SEQ-TREE-SIZE RIGHT) WB-TREE-BALANCE-FACTOR)))
           (WB-SEQ-TREE-BUILD-NODE (WB-SEQ-TREE-NODE-LEFT LEFT)
            (WB-SEQ-TREE-CONCAT (WB-SEQ-TREE-NODE-RIGHT LEFT) RIGHT)))
          ((AND (WB-SEQ-TREE-NODE? RIGHT)
                (> (WB-SEQ-TREE-SIZE RIGHT)
                   (* (WB-SEQ-TREE-SIZE LEFT) WB-TREE-BALANCE-FACTOR)))
           (WB-SEQ-TREE-BUILD-NODE
            (WB-SEQ-TREE-CONCAT LEFT (WB-SEQ-TREE-NODE-LEFT RIGHT))
            (WB-SEQ-TREE-NODE-RIGHT RIGHT)))
          (T (WB-SEQ-TREE-BUILD-NODE LEFT RIGHT))))

[fset/Code/wb-trees.lisp:5974]
  (DEFUN WB-SEQ-TREE-BUILD-NODE (LEFT RIGHT)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-SEQ-TREE LEFT RIGHT))
    (COND
     ((AND (OR (NULL LEFT) (STRINGP LEFT)) (OR (NULL RIGHT) (STRINGP RIGHT))
           (< (+ (LENGTH-NV LEFT) (LENGTH-NV RIGHT))
              *WB-TREE-MAX-STRING-LENGTH*))
      (IF (AND LEFT RIGHT)
          (CONCATENATE
           (IF (AND (TYPEP LEFT 'BASE-STRING) (TYPEP RIGHT 'BASE-STRING))
               'BASE-STRING
               'STRING)
           (THE STRING LEFT) (THE STRING RIGHT))
          (OR LEFT RIGHT)))
     ((AND (OR (NULL LEFT) (SIMPLE-VECTOR-P LEFT))
           (OR (NULL RIGHT) (SIMPLE-VECTOR-P RIGHT)))
      (IF (< (+ (LENGTH-NV LEFT) (LENGTH-NV RIGHT))
             *WB-TREE-MAX-VECTOR-LENGTH*)
          (CONCATENATE 'SIMPLE-VECTOR LEFT RIGHT)
          (MAKE-WB-SEQ-TREE-NODE LEFT RIGHT)))
     (T
      (LET ((SIZL (WB-SEQ-TREE-SIZE LEFT)) (SIZR (WB-SEQ-TREE-SIZE RIGHT)))
        (COND
         ((AND (WB-SEQ-TREE-NODE? LEFT)
               (> SIZL (* SIZR WB-TREE-BALANCE-FACTOR)))
          (LET ((LL (WB-SEQ-TREE-NODE-LEFT LEFT))
                (RL (WB-SEQ-TREE-NODE-RIGHT LEFT)))
            (IF (OR (NULL RL) (SIMPLE-STRING-P RL) (SIMPLE-VECTOR-P RL)
                    (<= (WB-SEQ-TREE-SIZE RL) (WB-SEQ-TREE-SIZE LL)))
                (MAKE-WB-SEQ-TREE-NODE LL (WB-SEQ-TREE-BUILD-NODE RL RIGHT))
                (MAKE-WB-SEQ-TREE-NODE
                 (WB-SEQ-TREE-BUILD-NODE LL (WB-SEQ-TREE-NODE-LEFT RL))
                 (WB-SEQ-TREE-BUILD-NODE (WB-SEQ-TREE-NODE-RIGHT RL) RIGHT)))))
         ((AND (WB-SEQ-TREE-NODE? RIGHT)
               (> SIZR (* SIZL WB-TREE-BALANCE-FACTOR)))
          (LET ((LR (WB-SEQ-TREE-NODE-LEFT RIGHT))
                (RR (WB-SEQ-TREE-NODE-RIGHT RIGHT)))
            (IF (OR (NULL LR) (SIMPLE-STRING-P LR) (SIMPLE-VECTOR-P LR)
                    (<= (WB-SEQ-TREE-SIZE LR) (WB-SEQ-TREE-SIZE RR)))
                (MAKE-WB-SEQ-TREE-NODE (WB-SEQ-TREE-BUILD-NODE LEFT LR) RR)
                (MAKE-WB-SEQ-TREE-NODE
                 (WB-SEQ-TREE-BUILD-NODE LEFT (WB-SEQ-TREE-NODE-LEFT LR))
                 (WB-SEQ-TREE-BUILD-NODE (WB-SEQ-TREE-NODE-RIGHT LR) RR)))))
         (T (MAKE-WB-SEQ-TREE-NODE LEFT RIGHT)))))))

[fset/Code/wb-trees.lisp:6022]
  (DEFUN WB-SEQ-TREE-TRIM (TREE BASE LO HI)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE WB-SEQ-TREE TREE)
             (TYPE FIXNUM BASE LO HI))
    (IF (OR (NULL TREE) (STRINGP TREE) (SIMPLE-VECTOR-P TREE))
        (VALUES TREE BASE)
        (LET ((NODE-RANK
               (THE FIXNUM
                    (+ BASE (WB-SEQ-TREE-SIZE (WB-SEQ-TREE-NODE-LEFT TREE))))))
          (IF (>= NODE-RANK LO)
              (IF (< NODE-RANK HI)
                  (VALUES TREE BASE)
                  (WB-SEQ-TREE-TRIM (WB-SEQ-TREE-NODE-LEFT TREE) BASE LO HI))
              (WB-SEQ-TREE-TRIM (WB-SEQ-TREE-NODE-RIGHT TREE) NODE-RANK LO
               HI)))))

[fset/Code/wb-trees.lisp:6164]
  (DEFUN WB-SEQ-TREE-ITERATOR-CANONICALIZE (ITER)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LOOP
     (LET ((SP (SVREF ITER 0))
           ((NODE (SVREF ITER SP)) (IDX (SVREF ITER (1+ SP)))))
       (DECLARE (FIXNUM SP IDX))
       (COND
        ((NULL NODE)
         (IF (= SP 1)
             (RETURN)
             (PROGN
              (DECF SP 2)
              (SETF (SVREF ITER 0) SP)
              (INCF (THE FIXNUM (SVREF ITER (1+ SP)))))))
        ((SIMPLE-STRING-P NODE)
         (COND ((< IDX (LENGTH NODE)) (RETURN))
               ((= SP 1) (SETF (SVREF ITER 1) NIL) (RETURN))
               (T (DECF SP 2) (SETF (SVREF ITER 0) SP)
                (INCF (THE FIXNUM (SVREF ITER (1+ SP)))))))
        ((SIMPLE-VECTOR-P NODE)
         (COND ((< IDX (LENGTH NODE)) (RETURN))
               ((= SP 1) (SETF (SVREF ITER 1) NIL) (RETURN))
               (T (DECF SP 2) (SETF (SVREF ITER 0) SP)
                (INCF (THE FIXNUM (SVREF ITER (1+ SP)))))))
        ((= IDX 0)
         (UNLESS (< (+ SP 3) (LENGTH ITER))
           (ERROR
            "Internal FSet error: iterator stack overflow.  Please report this bug."))
         (INCF SP 2) (SETF (SVREF ITER 0) SP)
         (SETF (SVREF ITER SP) (WB-SEQ-TREE-NODE-LEFT NODE))
         (SETF (SVREF ITER (1+ SP)) 0))
        (T (SETF (SVREF ITER SP) (WB-SEQ-TREE-NODE-RIGHT NODE))
         (SETF (SVREF ITER (1+ SP)) 0)))))
    ITER)

[fset/Code/wb-trees.lisp:6211]
  (DEFUN WB-SEQ-TREE-ITERATOR-DONE? (ITER)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (NULL (SVREF ITER (SVREF ITER 0))))

[fset/Code/wb-trees.lisp:6215]
  (DEFUN WB-SEQ-TREE-ITERATOR-GET (ITER)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((SP (SVREF ITER 0))
          ((NODE (SVREF ITER SP)) (IDX (SVREF ITER (1+ SP)))))
      (DECLARE (FIXNUM IDX))
      (IF (NULL NODE)
          (VALUES NIL NIL)
          (PROGN
           (INCF (THE FIXNUM (SVREF ITER (1+ SP))))
           (WB-SEQ-TREE-ITERATOR-CANONICALIZE ITER)
           (VALUES
            (IF (SIMPLE-STRING-P NODE)
                (SCHAR NODE IDX)
                (SVREF NODE IDX))
            T)))))

[fxml/runes/characters.lisp:86]
  (DEFINLINE WHITE-SPACE-RUNE-P (CHAR)
   (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
   (CASE (CHAR-CODE CHAR) ((NIL 10 13 NIL) T) (OTHERWISE NIL)))

[fxml/runes/encodings.lisp:241]
  (DEFMETHOD DECODE-SEQUENCE
             ((ENCODING (EQL :UTF-8)) IN IN-START IN-END OUT OUT-START OUT-END
              EOF?)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) IN)
             (TYPE (SIMPLE-ARRAY NIL (*)) OUT)
             (TYPE FIXNUM IN-START IN-END OUT-START OUT-END))
    (LET ((WPTR OUT-START) (RPTR IN-START) BYTE0)
      (MACROLET ((PUT (X)
                   (ECLECTOR.READER:QUASIQUOTE
                    ((LAMBDA (X)
                       (WHEN (OR (<= 55296 X 56319) (<= 56320 X 57343))
                         (XERROR "surrogate encoded in UTF-8: #x~X." X))
                       (COND
                        ((OR (%> X 1114111) (EQL X 65534) (EQL X 65535))
                         (XERROR "not a valid code point: #x~X" X))
                        (T (SETF (AREF OUT WPTR) X) (SETF WPTR (%+ WPTR 1)))))
                     (ECLECTOR.READER:UNQUOTE X))))
                 (PUT1 (X)
                   (ECLECTOR.READER:QUASIQUOTE
                    (PROGN
                     (SETF (AREF OUT WPTR) (ECLECTOR.READER:UNQUOTE X))
                     (SETF WPTR (%+ WPTR 1))))))
        (LOOP (WHEN (%= (+ WPTR 1) OUT-END) (RETURN))
              (WHEN (%>= RPTR IN-END) (RETURN))
              (SETQ BYTE0 (AREF IN RPTR))
              (COND
               ((= BYTE0 13)
                (COND
                 ((>= (%+ RPTR 1) IN-END)
                  (COND (EOF? (PUT 10) (SETF RPTR (%+ RPTR 1))) (T (RETURN))))
                 ((= (AREF IN (%+ RPTR 1)) 10) (SETF RPTR (%+ RPTR 1)))
                 (T (PUT 10) (SETF RPTR (%+ RPTR 1)))))
               ((%<= BYTE0 127) (PUT1 BYTE0) (SETF RPTR (%+ RPTR 1)))
               ((%<= BYTE0 191)
                (XERROR "Corrupted UTF-8 input (initial byte was #b~8,'0B)"
                 BYTE0)
                (SETF RPTR (%+ RPTR 1)))
               ((%<= BYTE0 223)
                (COND
                 ((<= (%+ RPTR 2) IN-END)
                  (PUT
                   (DPB (LDB (BYTE 5 0) BYTE0) (BYTE 5 6)
                        (DPB (LDB (BYTE 6 0) (AREF IN (%+ RPTR 1))) (BYTE 6 0)
                             0)))
                  (SETF RPTR (%+ RPTR 2)))
                 (T (RETURN))))
               ((%<= BYTE0 239)
                (COND
                 ((<= (%+ RPTR 3) IN-END)
                  (PUT
                   (DPB (LDB (BYTE 4 0) BYTE0) (BYTE 4 12)
                        (DPB (LDB (BYTE 6 0) (AREF IN (%+ 1 RPTR))) (BYTE 6 6)
                             (DPB (LDB (BYTE 6 0) (AREF IN (%+ 2 RPTR)))
                                  (BYTE 6 0) 0))))
                  (SETF RPTR (%+ RPTR 3)))
                 (T (RETURN))))
               ((%<= BYTE0 247)
                (COND
                 ((<= (%+ RPTR 4) IN-END)
                  (PUT
                   (DPB (LDB (BYTE 3 0) BYTE0) (BYTE 3 18)
                        (DPB (LDB (BYTE 6 0) (AREF IN (%+ 1 RPTR))) (BYTE 6 12)
                             (DPB (LDB (BYTE 6 0) (AREF IN (%+ 2 RPTR)))
                                  (BYTE 6 6)
                                  (DPB (LDB (BYTE 6 0) (AREF IN (%+ 3 RPTR)))
                                       (BYTE 6 0) 0)))))
                  (SETF RPTR (%+ RPTR 4)))
                 (T (RETURN))))
               ((%<= BYTE0 251)
                (COND
                 ((<= (%+ RPTR 5) IN-END)
                  (PUT
                   (DPB (LDB (BYTE 2 0) BYTE0) (BYTE 2 24)
                        (DPB (LDB (BYTE 6 0) (AREF IN (%+ 1 RPTR))) (BYTE 6 18)
                             (DPB (LDB (BYTE 6 0) (AREF IN (%+ 2 RPTR)))
                                  (BYTE 6 12)
                                  (DPB (LDB (BYTE 6 0) (AREF IN (%+ 3 RPTR)))
                                       (BYTE 6 6)
                                       (DPB
                                        (LDB (BYTE 6 0) (AREF IN (%+ 4 RPTR)))
                                        (BYTE 6 0) 0))))))
                  (SETF RPTR (%+ RPTR 5)))
                 (T (RETURN))))
               ((%<= BYTE0 253)
                (COND
                 ((<= (%+ RPTR 6) IN-END)
                  (PUT
                   (DPB (LDB (BYTE 1 0) BYTE0) (BYTE 1 30)
                        (DPB (LDB (BYTE 6 0) (AREF IN (%+ 1 RPTR))) (BYTE 6 24)
                             (DPB (LDB (BYTE 6 0) (AREF IN (%+ 2 RPTR)))
                                  (BYTE 6 18)
                                  (DPB (LDB (BYTE 6 0) (AREF IN (%+ 3 RPTR)))
                                       (BYTE 6 12)
                                       (DPB
                                        (LDB (BYTE 6 0) (AREF IN (%+ 4 RPTR)))
                                        (BYTE 6 6)
                                        (DPB
                                         (LDB (BYTE 6 0) (AREF IN (%+ 5 RPTR)))
                                         (BYTE 6 0) 0)))))))
                  (SETF RPTR (%+ RPTR 6)))
                 (T (RETURN))))
               (T
                (XERROR "Corrupted UTF-8 input (initial byte was #b~8,'0B)"
                 BYTE0)))))
      (VALUES WPTR RPTR)))

[fxml/runes/encodings.lisp:371]
  (DEFMETHOD DECODE-SEQUENCE
             ((ENCODING SIMPLE-8-BIT-ENCODING) IN IN-START IN-END OUT OUT-START
              OUT-END EOF?)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) IN)
             (TYPE (SIMPLE-ARRAY NIL (*)) OUT)
             (TYPE FIXNUM IN-START IN-END OUT-START OUT-END))
    (LET ((WPTR OUT-START)
          (RPTR IN-START)
          (BYTE 0)
          (TABLE (SLOT-VALUE ENCODING 'TABLE)))
      (DECLARE (TYPE FIXNUM WPTR RPTR)
               (TYPE (UNSIGNED-BYTE 8) BYTE)
               (TYPE (SIMPLE-ARRAY NIL (*)) TABLE))
      (LOOP (WHEN (%= WPTR OUT-END) (RETURN))
            (WHEN (%>= RPTR IN-END) (RETURN))
            (SETQ BYTE (AREF IN RPTR))
            (COND
             ((= BYTE 13)
              (COND
               ((>= (%+ RPTR 1) IN-END)
                (COND
                 (EOF? (SETF (AREF OUT WPTR) 10) (SETF WPTR (%+ WPTR 1))
                  (SETF RPTR (%+ RPTR 1)))
                 (T (RETURN))))
               ((= (AREF IN (%+ RPTR 1)) 10) (SETF RPTR (%+ RPTR 1)))
               (T (SETF (AREF OUT WPTR) 10) (SETF WPTR (%+ WPTR 1))
                (SETF RPTR (%+ RPTR 1)))))
             (T (SETF (AREF OUT WPTR) (AREF TABLE BYTE))
              (SETF WPTR (%+ WPTR 1)) (SETF RPTR (%+ RPTR 1)))))
      (VALUES WPTR RPTR)))

[fxml/runes/xstream.lisp:69]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (DEFPARAMETER *FAST* '(OPTIMIZE (SPEED 3) (SAFETY 0))))

[fxml/stp/element.lisp:423]
  (DEFUN CHECK-URI-LIKE (NEWVAL)
    (DECLARE (OPTIMIZE SPEED (SAFETY 0)))
    (CHECK-TYPE NEWVAL STRING)
    (WHEN
        (SOME
         (LAMBDA (C)
           (LET ((CODE (CHAR-CODE C)))
             (OR (> CODE 126)
                 (AND (< CODE 32) (NOT (EQL CODE 9)) (NOT (EQL CODE 10))
                      (NOT (EQL CODE 13))))))
         NEWVAL)
      (STP-ERROR "invalid characters in URI")))

[fxml/xml/rod-hashtable.lisp:59]
  (DEFINLINE ROD=** (X Y START1 END1 START2 END2)
   (DECLARE (ALEXANDRIA:ARRAY-INDEX START1 START2)
            (ALEXANDRIA:ARRAY-LENGTH END1 END2)
            (OPTIMIZE SPEED (SAFETY 1) (DEBUG 0)))
   (AND (%= (%- END1 START1) (%- END2 START2))
        (LOOP FOR I OF-TYPE ALEXANDRIA:ARRAY-INDEX FROM START1 BELOW END1
              AND J OF-TYPE ALEXANDRIA:ARRAY-INDEX FROM START2
              UNLESS (RUNE= (%RUNE X I) (%RUNE Y J))
              DO (RETURN NIL)
              FINALLY (RETURN T))))

[fxml/xml/rod-hashtable.lisp:73]
  (DEFUN ROD-HASH-GET
         (HASHTABLE ROD
          &OPTIONAL (START 0) (END (LENGTH ROD))
          (HASH (ROD-HASH ROD START END)))
    (DECLARE (TYPE (SIMPLE-ARRAY RUNE (*)) ROD)
             (TYPE (AND UNSIGNED-BYTE FIXNUM) HASH)
             (OPTIMIZE SPEED (SAFETY 1) (DEBUG 0)))
    (LET ((J (HASH-INDEX HASH (ROD-HASHTABLE-SIZE HASHTABLE))))
      (DOLIST
          (Q (SVREF (ROD-HASHTABLE-TABLE HASHTABLE) J) (VALUES NIL NIL NIL))
        (DECLARE (TYPE CONS Q))
        (WHEN
            (ROD=** (CAR Q) ROD 0
             (LENGTH (THE (SIMPLE-ARRAY RUNE (*)) (CAR Q))) START END)
          (RETURN (VALUES (CDR Q) T (CAR Q)))))))

[fxml/xml/rod-hashtable.lisp:91]
  (DEFUN ROD-HASH-SET
         (NEW-VALUE HASHTABLE ROD
          &OPTIONAL (START 0) (END (LENGTH ROD))
          (HASH (ROD-HASH ROD START END)))
    (DECLARE (TYPE STRING ROD)
             (TYPE (AND UNSIGNED-BYTE FIXNUM) HASH)
             (OPTIMIZE SPEED (SAFETY 1) (DEBUG 0)))
    (LET ((J (HASH-INDEX HASH (ROD-HASHTABLE-SIZE HASHTABLE))) (KEY NIL))
      (DOLIST
          (Q (SVREF (ROD-HASHTABLE-TABLE HASHTABLE) J)
             (PROGN
              (SETF KEY (ROD-SUBSEQ* ROD START END))
              (PUSH (CONS KEY NEW-VALUE)
                    (AREF (ROD-HASHTABLE-TABLE HASHTABLE) J))))
        (WHEN (ROD=* (CAR Q) ROD :START2 START :END2 END)
          (SETF KEY (CAR Q))
          (SETF (CDR Q) NEW-VALUE)
          (RETURN)))
      (VALUES NEW-VALUE KEY)))

[fxml/xml/xml-parse.lisp:93]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (DEFPARAMETER *FAST*
      '(OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0) (COMPILATION-SPEED 0)
        (SPACE 0))))

[fxml/xml/xml-parse.lisp:3375]
  (DEFMACRO READ-DATA-UNTIL*
            ((PREDICATE INPUT RES RES-START RES-END) &BODY BODY)
    "Read data from `input' until `predicate' applied to the read char
   turns true. Then execute `body' with `res', `res-start', `res-end'
   bound to denote a subsequence (of RUNEs) containing the read portion.
   The rune upon which `predicate' turned true is neither consumed from
   the stream, nor included in `res'.

   Keep the predicate short, this it may be included more than once into
   the macro's expansion."
    (LET ((INPUT-VAR (GENSYM)) (COLLECT (GENSYM)) (C (GENSYM)))
      (ECLECTOR.READER:QUASIQUOTE
       (LOCALLY
        (DECLARE (OPTIMIZE (SAFETY 1) (DEBUG 0)))
        (LET (((ECLECTOR.READER:UNQUOTE INPUT-VAR)
               (ECLECTOR.READER:UNQUOTE INPUT)))
          (MULTIPLE-VALUE-BIND
              ((ECLECTOR.READER:UNQUOTE RES)
               (ECLECTOR.READER:UNQUOTE RES-START)
               (ECLECTOR.READER:UNQUOTE RES-END))
              (WITH-RUNE-COLLECTOR/RAW ((ECLECTOR.READER:UNQUOTE COLLECT))
               (LOOP
                (LET (((ECLECTOR.READER:UNQUOTE C)
                       (PEEK-RUNE (ECLECTOR.READER:UNQUOTE INPUT-VAR))))
                  (COND ((EQ (ECLECTOR.READER:UNQUOTE C) :EOF) (RETURN))
                        ((FUNCALL (ECLECTOR.READER:UNQUOTE PREDICATE)
                                  (ECLECTOR.READER:UNQUOTE C))
                         (RETURN))
                        (T
                         ((ECLECTOR.READER:UNQUOTE COLLECT)
                          (ECLECTOR.READER:UNQUOTE C))
                         (CONSUME-RUNE
                          (ECLECTOR.READER:UNQUOTE INPUT-VAR)))))))
            (LOCALLY (ECLECTOR.READER:UNQUOTE-SPLICING BODY))))))))

[fxml/xml/xml-parse.lisp:3416]
  (DEFUN READ-CDATA (INPUT)
    (READ-DATA-UNTIL*
     ((LAMBDA (RUNE)
        (DECLARE (TYPE RUNE RUNE))
        (WHEN
            (AND (%RUNE< RUNE U+0020)
                 (NOT
                  (OR (%RUNE= RUNE U+0009) (%RUNE= RUNE U+000A)
                      (%RUNE= RUNE U+000D))))
          (WF-ERROR INPUT "code point invalid: ~A" RUNE))
        (OR (%RUNE= RUNE <) (%RUNE= RUNE &)))
      INPUT SOURCE START END)
     (LOCALLY
      (DECLARE (TYPE (SIMPLE-ARRAY RUNE (*)) SOURCE)
               (TYPE UFIXNUM START)
               (TYPE UFIXNUM END)
               (OPTIMIZE (SPEED 3) (SAFETY 0)))
      (LET ((RES (MAKE-ARRAY (%- END START) :ELEMENT-TYPE 'RUNE)))
        (DECLARE (TYPE (SIMPLE-ARRAY RUNE (*)) RES))
        (LET ((I (%- END START)))
          (DECLARE (TYPE UFIXNUM I))
          (LOOP (SETF I (- I 1))
                (SETF (%RUNE RES I) (%RUNE SOURCE (THE UFIXNUM (+ I START))))
                (WHEN (= I 0) (RETURN))))
        RES))))

[fxml/xml/xml-parse.lisp:3452]
  (DEFUN FIND-INTERNAL-ENTITY-EXPANSION (NAME)
    (WITH-ZSTREAM (ZINPUT)
     (WITH-RUNE-COLLECTOR-3 (COLLECT)
      (LABELS ((MUFFLE (INPUT)
                (LET (C)
                  (LOOP (SETF C (READ-RUNE INPUT))
                        (COND ((EQ C :EOF) (RETURN))
                              ((RUNE= C &) (SETF C (PEEK-RUNE INPUT))
                               (COND ((EQL C :EOF) (EOX INPUT))
                                     ((RUNE= C NIL
                                       (LET ((C
                                              (READ-CHARACTER-REFERENCE INPUT)))
                                         (%PUT-UNICODE-CHAR C COLLECT)))
                                      (T
                                       (UNLESS (NAME-START-RUNE-P C)
                                         (WF-ERROR ZINPUT
                                          "Expecting name after &."))
                                       (LET ((NAME (READ-NAME-TOKEN INPUT)))
                                         (SETF C (READ-RUNE INPUT))
                                         (CHECK-RUNE INPUT C |;|)
                                         (RECURSE-ON-ENTITY ZINPUT NAME
                                          :GENERAL
                                          (LAMBDA (ZINPUT)
                                            (MUFFLE
                                             (CAR
                                              (ZSTREAM-INPUT-STACK
                                               ZINPUT)))))))))
                               ((RUNE= C <) (WF-ERROR ZINPUT "unexpected #/<"))
                               ((SPACE-RUNE-P C) (COLLECT SPACE))
                               ((NOT (DATA-RUNE-P C))
                                (WF-ERROR ZINPUT "illegal char: ~S." C))
                               (T (COLLECT C)))))))
               (DECLARE (DYNAMIC-EXTENT (FUNCTION MUFFLE)))
               (RECURSE-ON-ENTITY ZINPUT NAME :GENERAL
                (LAMBDA (ZINPUT)
                  (MUFFLE (CAR (ZSTREAM-INPUT-STACK ZINPUT)))))))))
    (DEFUN RESOLVE-ENTITY (NAME HANDLER DTD)
      (LET ((*VALIDATE* NIL))
        (IF (GET-ENTITY-DEFINITION NAME :GENERAL DTD :ERRORP NIL)
            (LET* ((*CTX* (MAKE-CONTEXT :HANDLER HANDLER :DTD DTD))
                   (*DATA-BEHAVIOUR* :DOC))
              (WITH-ZSTREAM (INPUT)
               (WITH-SCRATCH-PADS NIL
                (RECURSE-ON-ENTITY INPUT NAME :GENERAL
                 (LAMBDA (INPUT)
                   (PROG1
                       (ETYPECASE (CHECKED-GET-ENTDEF NAME :GENERAL)
                         (INTERNAL-ENTDEF (P/CONTENT INPUT))
                         (EXTERNAL-ENTDEF (P/EXT-PARSED-ENT INPUT)))
                     (UNLESS (EQ (PEEK-TOKEN INPUT) :EOF)
                       (WF-ERROR INPUT "Trailing garbage. - ~S"
                        (PEEK-TOKEN INPUT)))))))))
            NIL)))
    (DEFUN READ-ATT-VALUE-2 (INPUT)
      (LET ((DELIM (READ-RUNE INPUT)))
        (WHEN (EQL DELIM :EOF) (EOX INPUT))
        (UNLESS (MEMBER DELIM '(|"| |'|) :TEST #'EQL)
          (WF-ERROR INPUT
           "Bad attribute value delimiter ~S, must be either #\\\" or #\\'."
           (RUNE-CHAR DELIM)))
        (WITH-RUNE-COLLECTOR-4 (COLLECT COLLECT-ALL)
         (LOOP
          (LET ((C (READ-RUNE INPUT)))
            (COND ((EQ C :EOF) (EOX INPUT "EOF")) ((RUNE= C DELIM) (RETURN))
                  ((RUNE= C <)
                   (WITH-SIMPLE-RESTART (CONTINUE "Omit it")
                     (WF-ERROR INPUT "'<' not allowed in attribute values")))
                  ((RUNE= & C)
                   (MULTIPLE-VALUE-BIND (KIND SEM)
                       (READ-ENTITY-LIKE INPUT)
                     (ECASE KIND
                       (:CHARACTER-REFERENCE (%PUT-UNICODE-CHAR SEM COLLECT))
                       (:ENTITY-REFERENCE
                        (LET* ((EXP (INTERNAL-ENTITY-EXPANSION SEM))
                               (N (LENGTH EXP)))
                          (DECLARE (TYPE (SIMPLE-ARRAY RUNE (*)) EXP))
                          (LOOP FOR I FROM 0 BELOW N
                                DO (COLLECT (%RUNE EXP I)))))
                       (:NON-REFERENCE
                        (WITH-SIMPLE-ROD (SEM) (COLLECT #\&)
                         (COLLECT-ALL SEM))))))
                  ((SPACE-RUNE-P C) (COLLECT U+0020)) (T (COLLECT C))))))))
    (DEFUN NC-NAME-P (NAME)
      (AND (PLUSP (LENGTH NAME)) (NAME-START-RUNE-P (RUNE NAME 0))
           (NOTANY #'(LAMBDA (RUNE) (RUNE= |:| RUNE)) NAME)))
    (SERAPEUM:-> SPLIT-QNAME (STRING)
                 (VALUES (OR STRING NULL) STRING &OPTIONAL))
    (DEFUN SPLIT-QNAME (QNAME)
      (DECLARE
       (TYPE #S(FORMGREP:SYMREF :NAME "SIMPLE-ROD" :QUALIFIER "FXML.RUNES")
        QNAME)
       (OPTIMIZE SPEED (SAFETY 1) (DEBUG 0)))
      (LET ((POS (POSITION |:| QNAME)))
        (IF POS
            (LET ((PREFIX (SUBSEQ QNAME 0 POS))
                  (LOCAL-NAME (SUBSEQ QNAME (1+ POS))))
              (WHEN (ZEROP POS) (WF-ERROR NIL "empty namespace prefix"))
              (IF (NC-NAME-P LOCAL-NAME)
                  (VALUES PREFIX LOCAL-NAME)
                  (WF-ERROR NIL "~S is not a valid NcName."
                   (ROD-STRING LOCAL-NAME))))
            (VALUES NIL QNAME))))
    (DEFUN DECODE-QNAME (QNAME)
      "decode-qname name => namespace-uri, prefix, local-name"
      (DECLARE
       (TYPE #S(FORMGREP:SYMREF :NAME "SIMPLE-ROD" :QUALIFIER "FXML.RUNES")
        QNAME))
      (MULTIPLE-VALUE-BIND (PREFIX LOCAL-NAME)
          (SPLIT-QNAME QNAME)
        (LET ((URI (FIND-NAMESPACE-BINDING PREFIX)))
          (IF URI
              (VALUES URI PREFIX LOCAL-NAME)
              (VALUES NIL NIL QNAME)))))
    (DEFUN FIND-NAMESPACE-BINDING (PREFIX)
      (CDR
       (OR
        (ASSOC
         (OR PREFIX ") *namespace-bindings* :test #'rod=)
           (undeclared-namespace prefix))))

;; FIXME: Should probably be refactored by adding :start and :end to rod=/rod-equal
(defun rod-starts-with (prefix rod)
  (and (<= (length prefix) (length rod))
       (dotimes (i (length prefix) t)
         (unless (rune= (rune prefix i) (rune rod i))
           (return nil)))))

(defun xmlns-attr-p (attr-name)
  (rod-starts-with #.(string-rod "
             XMLNS ") attr-name))

(defun attrname->prefix (attrname)
  (if (< 5 (length attrname))
      (subseq attrname 6)
      nil))

(defun find-namespace-declarations (attributes)
  (loop
    for attribute in attributes
    for qname = (fxml.sax:attribute-qname attribute)
    when (xmlns-attr-p qname)
      collect (cons (attrname->prefix qname) (fxml.sax:attribute-value attribute))))

(defun declare-namespaces (attributes)
  (let ((ns-decls (find-namespace-declarations attributes)))
    (dolist (ns-decl ns-decls)
      (with-simple-restart (continue "
             IGNORE NAMESPACE DECLARATION ")
        ;; check some namespace validity constraints
        (let ((prefix (car ns-decl))
              (uri (cdr ns-decl)))
          (cond
            ((and (rod= prefix #"
             XML ")
                  (not (rod= uri #"
             #S(FORMGREP:SYMREF
                :NAME "//WWW.W3.ORG/XML/1998/NAMESPACE"
                :QUALIFIER "HTTP")
             ")))
             (wf-error nil
                       "
             ATTEMPT TO REBIND THE PREFIX |"XML"| TO ~S. " (mu uri)))
            ((and (rod= uri #"
             #S(FORMGREP:SYMREF
                :NAME "//WWW.W3.ORG/XML/1998/NAMESPACE"
                :QUALIFIER "HTTP")
             ")
                  (not (rod= prefix #"
             XML ")))
             (wf-error nil
                       "
             THE NAMESPACE ~ URI
             #S(FORMGREP:SYMREF
                :NAME "//WWW.W3.ORG/XML/1998/NAMESPACE\""
                :QUALIFIER "\"HTTP")
             MAY NOT ~ BE BOUND TO THE PREFIX ~S ONLY |"XML"| IS LEGAL. "
                       (mu prefix)))
            ((and (rod= prefix #"
             XMLNS ")
                  (rod= uri #"
             #S(FORMGREP:SYMREF
                :NAME "//WWW.W3.ORG/2000/XMLNS/"
                :QUALIFIER "HTTP")
             "))
             (wf-error nil
                       "
             ATTEMPT TO BIND THE PREFIX |"XMLNS"| TO ITS PREDEFINED ~ URI
             #S(FORMGREP:SYMREF
                :NAME "//WWW.W3.ORG/2000/XMLNS/\""
                :QUALIFIER "\"HTTP")
             WHICH IS ~ FORBIDDEN FOR NO GOOD REASON. "))
            ((rod= prefix #"
             XMLNS ")
             (wf-error nil
                       "
             ATTEMPT TO BIND THE PREFIX |"XMLNS"| TO THE URI ~S ~ BUT IT MAY
             NOT BE DECLARED. " (mu uri)))
            ((rod= uri #"
             #S(FORMGREP:SYMREF
                :NAME "//WWW.W3.ORG/2000/XMLNS/"
                :QUALIFIER "HTTP")
             ")
             (wf-error nil
                       "
             THE NAMESPACE URI
             #S(FORMGREP:SYMREF
                :NAME "//WWW.W3.ORG/2000/XMLNS/\""
                :QUALIFIER "\"HTTP")
             MAY ~ NOT BE BOUND TO PREFIX ~S (OR ANY OTHER) . " (mu prefix)))
            ((and (rod= uri #"))))))

[fxml/xml/xml-parse.lisp:3564]
  (DEFUN SPLIT-QNAME (QNAME)
    (DECLARE
     (TYPE #S(FORMGREP:SYMREF :NAME "SIMPLE-ROD" :QUALIFIER "FXML.RUNES")
      QNAME)
     (OPTIMIZE SPEED (SAFETY 1) (DEBUG 0)))
    (LET ((POS (POSITION |:| QNAME)))
      (IF POS
          (LET ((PREFIX (SUBSEQ QNAME 0 POS))
                (LOCAL-NAME (SUBSEQ QNAME (1+ POS))))
            (WHEN (ZEROP POS) (WF-ERROR NIL "empty namespace prefix"))
            (IF (NC-NAME-P LOCAL-NAME)
                (VALUES PREFIX LOCAL-NAME)
                (WF-ERROR NIL "~S is not a valid NcName."
                 (ROD-STRING LOCAL-NAME))))
          (VALUES NIL QNAME))))

[gbbopen/source/gbbopen/test/basic-tests.lisp:90]
  (DEFUN FORMAT-TICKS (TICKS)
    (FORMAT T "~6,2f seconds"
            (LOCALLY (DECLARE (OPTIMIZE (SPEED 0) (SAFETY 3))) (/ TICKS NIL))))

[gbbopen/source/tools/timing/cl-timing.lisp:135]
  (DEFUN FORMAT-TICKS (TICKS)
    (FORMAT T "~,2f seconds"
            (LOCALLY (DECLARE (OPTIMIZE (SPEED 0) (SAFETY 3))) (/ TICKS NIL))))

[gsll/solve-minimize-fit/simulated-annealing.lisp:201]
  (DEFUN TRIVIAL-EXAMPLE-ENERGY (STATE)
    (LET ((X (#S(FORMGREP:SYMREF :NAME "AREF" :QUALIFIER "GRID") STATE 0)))
      (DECLARE (TYPE DOUBLE-FLOAT X)
               (OPTIMIZE (SPEED 3) (SAFETY 1)))
      (* (EXP (- (EXPT (1- X) 2))) (SIN (* 8 X)))))

[gsll/solve-minimize-fit/simulated-annealing.lisp:206]
  (DEFUN TRIVIAL-EXAMPLE-STEP (RNG-MPOINTER STATE STEP-SIZE)
    (DECLARE (TYPE DOUBLE-FLOAT STEP-SIZE)
             (OPTIMIZE (SPEED 3) (SAFETY 1))
             (IGNORE RNG-MPOINTER)
             (SPECIAL CL-GENERATOR))
    (SYMBOL-MACROLET ((X
                       (#S(FORMGREP:SYMREF :NAME "AREF" :QUALIFIER "GRID")
                        STATE 0)))
      (LET ((RAND (SAMPLE CL-GENERATOR :UNIFORM)))
        (DECLARE (TYPE DOUBLE-FLOAT RAND))
        (SETF X
                (+ (THE DOUBLE-FLOAT X)
                   (- (* 2.0d0 RAND STEP-SIZE) STEP-SIZE))))))

[gsll/solve-minimize-fit/simulated-annealing.lisp:219]
  (DEFUN TRIVIAL-EXAMPLE-METRIC (STATE1 STATE2)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (ABS
     (-
      (THE DOUBLE-FLOAT
           (#S(FORMGREP:SYMREF :NAME "AREF" :QUALIFIER "GRID") STATE1 0))
      (THE DOUBLE-FLOAT
           (#S(FORMGREP:SYMREF :NAME "AREF" :QUALIFIER "GRID") STATE2 0)))))

[hyperluminal-mem/mem/box/string-ascii.lisp:48]
  (DEFUN %MWRITE-ASCII-STRING (PTR INDEX STRING N-CHARS)
    "Write the first N-CHARS single-byte characters of STRING into the memory starting at (PTR+INDEX). Return T."
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0))
             (TYPE MADDRESS PTR)
             (TYPE MEM-SIZE INDEX)
             (TYPE ASCII-STRING STRING)
             (TYPE UFIXNUM N-CHARS))
    (LET* ((N-CHARS-REMAINDER (NTH-VALUE 1 (TRUNCATE N-CHARS +MSIZEOF-WORD+)))
           (N-CHARS-TRUNCATE (- N-CHARS N-CHARS-REMAINDER)))
      (DECLARE (TYPE UFIXNUM N-CHARS-REMAINDER N-CHARS-TRUNCATE))
      (MACROLET ((ASCII-CHAR-TO-WORD (CHAR-FUNC I)
                   (ECLECTOR.READER:QUASIQUOTE
                    (THE MEM-BYTE
                         (CHAR-CODE
                          ((ECLECTOR.READER:UNQUOTE CHAR-FUNC) STRING
                           (THE FIXNUM (ECLECTOR.READER:UNQUOTE I)))))))
                 (ASCII-CHARS-TO-WORD (CHAR-FUNC I)
                   (ECLECTOR.READER:QUASIQUOTE
                    (LOGIOR
                     (ECLECTOR.READER:UNQUOTE-SPLICING
                      (LOOP FOR J BELOW +MSIZEOF-WORD+
                            COLLECT (ECLECTOR.READER:QUASIQUOTE
                                     (THE MEM-WORD
                                          (ASH
                                           (ASCII-CHAR-TO-WORD
                                            (ECLECTOR.READER:UNQUOTE CHAR-FUNC)
                                            (+ (ECLECTOR.READER:UNQUOTE I)
                                               (ECLECTOR.READER:UNQUOTE J)))
                                           (ECLECTOR.READER:UNQUOTE
                                            (* J +MEM-BYTE/BITS+))))))))))
                 (LOOP-WRITE (CHAR-FUNC)
                   (WITH-GENSYMS (I WORD)
                    (ECLECTOR.READER:QUASIQUOTE
                     (PROGN
                      (LET (((ECLECTOR.READER:UNQUOTE I) 0))
                        (DECLARE (TYPE UFIXNUM (ECLECTOR.READER:UNQUOTE I)))
                        (LOOP WHILE (< (ECLECTOR.READER:UNQUOTE I)
                                       N-CHARS-TRUNCATE)
                              DO (LET (((ECLECTOR.READER:UNQUOTE WORD)
                                        (ASCII-CHARS-TO-WORD
                                         (ECLECTOR.READER:UNQUOTE CHAR-FUNC)
                                         (ECLECTOR.READER:UNQUOTE I))))
                                   (DECLARE
                                    (TYPE MEM-WORD
                                     (ECLECTOR.READER:UNQUOTE WORD)))
                                   (MSET-WORD PTR INDEX
                                    (ECLECTOR.READER:UNQUOTE WORD))
                                   (INCF-MEM-SIZE INDEX)
                                   (INCF (ECLECTOR.READER:UNQUOTE I)
                                         +MSIZEOF-WORD+))))
                      (UNLESS (ZEROP N-CHARS-REMAINDER)
                        (LET (((ECLECTOR.READER:UNQUOTE WORD) 0))
                          (DECLARE
                           (TYPE MEM-WORD (ECLECTOR.READER:UNQUOTE WORD)))
                          (LOOP FOR (ECLECTOR.READER:UNQUOTE
                                     I) FROM 0 BELOW N-CHARS-REMAINDER
                                DO (SETF (ECLECTOR.READER:UNQUOTE WORD)
                                           (LOGIOR
                                            (ECLECTOR.READER:UNQUOTE WORD)
                                            (THE MEM-WORD
                                                 (ASH
                                                  (ASCII-CHAR-TO-WORD
                                                   (ECLECTOR.READER:UNQUOTE
                                                    CHAR-FUNC)
                                                   (+
                                                    (ECLECTOR.READER:UNQUOTE I)
                                                    N-CHARS-TRUNCATE))
                                                  (*
                                                   (ECLECTOR.READER:UNQUOTE I)
                                                   +MEM-BYTE/BITS+))))))
                          (MSET-WORD PTR INDEX
                           (ECLECTOR.READER:UNQUOTE WORD)))))))))
        (IF (TYPEP STRING 'SIMPLE-STRING)
            (LOOP-WRITE SCHAR)
            (LOOP-WRITE CHAR))))
    T)

[hyperluminal-mem/mem/box/string-ascii.lisp:128]
  (DEFUN %MREAD-ASCII-STRING (PTR INDEX N-CHARS)
    "Read (END-START) single-byte characters from the memory starting at (PTR+INDEX)
and write them into RESULT-STRING. Return RESULT-STRING and number of words
actually read as multiple values.

ABI: characters are read from memory using the compact, single-byte representation.
For this reason only codes in the range 0 ... +most-positive-byte+ can be read
(typically 0 ... 255)"
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0))
             (TYPE MADDRESS PTR)
             (TYPE MEM-SIZE INDEX)
             (TYPE UFIXNUM N-CHARS))
    (LET* ((N-CHARS-REMAINDER (NTH-VALUE 1 (TRUNCATE N-CHARS +MSIZEOF-WORD+)))
           (N-CHARS-TRUNCATE (- N-CHARS N-CHARS-REMAINDER))
           (RESULT
            (MAKE-STRING N-CHARS :ELEMENT-TYPE +HLMEM/BASE-CHAR>=ASCII
                         'BASE-CHAR -HLMEM/BASE-CHAR>=ASCII 'CHARACTER)))
      (DECLARE (TYPE UFIXNUM N-CHARS-REMAINDER N-CHARS-TRUNCATE))
      (MACROLET ((WORD-TO-ASCII-CHAR (WORD)
                   (ECLECTOR.READER:QUASIQUOTE
                    (THE ASCII-CHAR
                         (CODE-CHAR
                          (LOGAND (ECLECTOR.READER:UNQUOTE WORD)
                                  +ASCII-CHAR/MASK+)))))
                 (WORD-TO-ASCII-CHARS (WORD CHAR-FUNC I)
                   (ECLECTOR.READER:QUASIQUOTE
                    (PROGN
                     (ECLECTOR.READER:UNQUOTE-SPLICING
                      (LOOP FOR J BELOW +MSIZEOF-WORD+
                            COLLECT (ECLECTOR.READER:QUASIQUOTE
                                     (SETF ((ECLECTOR.READER:UNQUOTE CHAR-FUNC)
                                            RESULT
                                            (+ (ECLECTOR.READER:UNQUOTE I)
                                               (ECLECTOR.READER:UNQUOTE J)))
                                             (WORD-TO-ASCII-CHAR
                                              (ASH
                                               (ECLECTOR.READER:UNQUOTE WORD)
                                               (-
                                                (* (ECLECTOR.READER:UNQUOTE J)
                                                   +MEM-BYTE/BITS+)))))))))))
                 (LOOP-READ (CHAR-FUNC)
                   (WITH-GENSYMS (I WORD)
                    (ECLECTOR.READER:QUASIQUOTE
                     (PROGN
                      (LET (((ECLECTOR.READER:UNQUOTE I) 0))
                        (DECLARE (TYPE UFIXNUM (ECLECTOR.READER:UNQUOTE I)))
                        (LOOP WHILE (< (ECLECTOR.READER:UNQUOTE I)
                                       N-CHARS-TRUNCATE)
                              DO (LET (((ECLECTOR.READER:UNQUOTE WORD)
                                        (MGET-WORD PTR INDEX)))
                                   (DECLARE
                                    (TYPE MEM-WORD
                                     (ECLECTOR.READER:UNQUOTE WORD)))
                                   (INCF-MEM-SIZE INDEX)
                                   (WORD-TO-ASCII-CHARS
                                    (ECLECTOR.READER:UNQUOTE WORD)
                                    (ECLECTOR.READER:UNQUOTE CHAR-FUNC)
                                    (ECLECTOR.READER:UNQUOTE I))
                                   (INCF (ECLECTOR.READER:UNQUOTE I)
                                         +MSIZEOF-WORD+))))
                      (UNLESS (ZEROP N-CHARS-REMAINDER)
                        (LET (((ECLECTOR.READER:UNQUOTE WORD)
                               (MGET-WORD PTR INDEX)))
                          (DECLARE
                           (TYPE MEM-WORD (ECLECTOR.READER:UNQUOTE WORD)))
                          (LOOP FOR (ECLECTOR.READER:UNQUOTE
                                     I) FROM 0 BELOW N-CHARS-REMAINDER
                                DO (SETF ((ECLECTOR.READER:UNQUOTE CHAR-FUNC)
                                          RESULT
                                          (+ (ECLECTOR.READER:UNQUOTE I)
                                             N-CHARS-TRUNCATE))
                                           (WORD-TO-ASCII-CHAR
                                            (ECLECTOR.READER:UNQUOTE
                                             WORD))) (SETF (ECLECTOR.READER:UNQUOTE
                                                            WORD)
                                                             (ASH
                                                              (ECLECTOR.READER:UNQUOTE
                                                               WORD)
                                                              (-
                                                               +MEM-BYTE/BITS+)))))))))))
        (LOOP-READ SCHAR))
      RESULT))

[hyperluminal-mem/mem/box/string-utf-8.lisp:28]
  (DEFUN MSIZE-BOX/STRING-UTF-8 (INDEX STRING)
    "Return the number of words needed to store STRING in memory, not including BOX header."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 1))
             (TYPE STRING STRING)
             (TYPE MEM-SIZE INDEX))
    +HLMEM/CHARACTER=UTF-8
    (LET ((N-BYTES (LENGTH STRING)))
      (MEM-SIZE+ INDEX 1 (CEILING N-BYTES +MSIZEOF-WORD+)))
    -HLMEM/CHARACTER=UTF-8
    (LET ((N-BYTES 0))
      (DECLARE (TYPE UFIXNUM N-BYTES))
      (MACROLET ((%COUNT-UTF-8-BYTES ()
                   (ECLECTOR.READER:QUASIQUOTE
                    (LOOP FOR CH ACROSS STRING
                          FOR CODE = (CHAR-CODE CH)
                          DO (INCF (THE FIXNUM N-BYTES) +HLMEM/CHARACTER=UTF-16
                                   (COND ((<= CODE 127) 1) ((<= CODE 2047) 2)
                                         ((<= 55296 CODE 56319) 4)
                                         ((<= 56320 CODE 57343) 0) (T 3))
                                   -HLMEM/CHARACTER=UTF-16
                                   (COND ((<= CODE 127) 1) ((<= CODE 2047) 2)
                                         ((<= CODE 65535) 3) (T 4)))))))
        (COND ((TYPEP STRING '(SIMPLE-ARRAY CHARACTER)) (%COUNT-UTF-8-BYTES))
              -HLMEM/BASE-CHAR<=ASCII
              ((TYPEP STRING '(SIMPLE-ARRAY BASE-CHAR)) (%COUNT-UTF-8-BYTES))
              (T (%COUNT-UTF-8-BYTES))))
      (MEM-SIZE+ INDEX 1 (CEILING N-BYTES +MSIZEOF-WORD+))))

[hyperluminal-mem/mem/box/string-utf-8.lisp:84]
  (DEFUN %MWRITE-STRING-UTF-8 (PTR INDEX END-INDEX STRING N-CHARS)
    "Write characters from string STRING to the memory starting at (PTR+INDEX).
Return the number of words actually written.

ABI: characters will be stored using UTF-8 encoding."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 1))
             (TYPE MADDRESS PTR)
             (TYPE MEM-SIZE INDEX END-INDEX)
             (TYPE STRING STRING)
             (TYPE UFIXNUM N-CHARS))
    (CHECK-MEM-OVERRUN PTR INDEX END-INDEX
     (FIXNUM+ 1 (CEILING N-CHARS +MSIZEOF-WORD+)))
    (LET ((SAVE-INDEX INDEX) (N-CODEPOINTS 0))
      (DECLARE (TYPE MEM-SIZE N-CODEPOINTS))
      (INCF-MEM-SIZE INDEX)
      (MACROLET ((%UTF-8-BYTE (CH)
                   (WITH-GENSYM CODE
                    (ECLECTOR.READER:QUASIQUOTE
                     (LET (((ECLECTOR.READER:UNQUOTE CODE)
                            (CHAR-CODE (ECLECTOR.READER:UNQUOTE CH))))
                       (INCF N-CODEPOINTS
                             (IF (%UTF-8-IS-FIRST-BYTE?
                                  (ECLECTOR.READER:UNQUOTE CODE))
                                 1
                                 0))
                       (THE (UNSIGNED-BYTE 8)
                            (ECLECTOR.READER:UNQUOTE CODE))))))
                 (%UTF-8-CHARS-TO-WORD (&REST CHARS)
                   (ECLECTOR.READER:QUASIQUOTE
                    (LOGIOR
                     (ECLECTOR.READER:UNQUOTE-SPLICING
                      (LOOP FOR CH IN CHARS
                            FOR SHIFT = 0 THEN (FIXNUM+ SHIFT 8)
                            COLLECT (ECLECTOR.READER:QUASIQUOTE
                                     (ASH
                                      (%UTF-8-BYTE
                                       (ECLECTOR.READER:UNQUOTE CH))
                                      (ECLECTOR.READER:UNQUOTE SHIFT))))))))
                 (%UTF-8-STRING-CHARS-TO-WORD (CHAR-FUNC START-OFFSET)
                   (ECLECTOR.READER:QUASIQUOTE
                    (%UTF-8-CHARS-TO-WORD
                     (ECLECTOR.READER:UNQUOTE-SPLICING
                      (LOOP FOR I BELOW +MSIZEOF-WORD+
                            COLLECT (ECLECTOR.READER:QUASIQUOTE
                                     ((ECLECTOR.READER:UNQUOTE CHAR-FUNC)
                                      STRING
                                      (THE UFIXNUM
                                           (+
                                            (ECLECTOR.READER:UNQUOTE
                                             START-OFFSET)
                                            (ECLECTOR.READER:UNQUOTE
                                             I))))))))))
                 (%MWRITE-UTF-8-WORDS-UNROLLED (CHAR-FUNC)
                   (ECLECTOR.READER:QUASIQUOTE
                    (LET ((I 0) (BULK-END (FIXNUM- N-CHARS +MSIZEOF-WORD+)))
                      (DECLARE (TYPE UFIXNUM I))
                      (LOOP WHILE (< I BULK-END)
                            DO (LET ((WORD
                                      (THE MEM-WORD
                                           (%UTF-8-STRING-CHARS-TO-WORD
                                            (ECLECTOR.READER:UNQUOTE CHAR-FUNC)
                                            I))))
                                 (MSET-WORD PTR INDEX WORD)
                                 (INCF I +MSIZEOF-WORD+)
                                 (INCF-MEM-SIZE INDEX)))
                      (WHEN (< I N-CHARS)
                        (LET ((WORD 0) (SHIFT 0))
                          (DECLARE (TYPE MEM-WORD WORD)
                                   (TYPE (INTEGER 0 NIL) SHIFT))
                          (LOOP WHILE (< I N-CHARS)
                                DO (SETF WORD
                                           (LOGIOR WORD
                                                   (THE MEM-WORD
                                                        (ASH
                                                         (%UTF-8-BYTE
                                                          ((ECLECTOR.READER:UNQUOTE
                                                            CHAR-FUNC)
                                                           STRING I))
                                                         SHIFT)))) (INCF
                                                                    I) (INCF
                                                                        SHIFT
                                                                        8))
                          (MSET-WORD PTR INDEX WORD)
                          (INCF-MEM-SIZE INDEX))))))
                 (%MWRITE-UTF-8-WORDS (CHAR-FUNC)
                   (ECLECTOR.READER:QUASIQUOTE
                    (LET ((I 0))
                      (DECLARE (TYPE UFIXNUM I))
                      (LOOP WHILE (< I N-CHARS)
                            DO (LET ((END (MIN +MSIZEOF-WORD+ N-CHARS))
                                     (WORD 0)
                                     (SHIFT 0))
                                 (DECLARE (TYPE MEM-WORD WORD)
                                          (TYPE (INTEGER 0 NIL) SHIFT))
                                 (LOOP WHILE (< I END)
                                       DO (SETF WORD
                                                  (LOGIOR WORD
                                                          (THE MEM-WORD
                                                               (ASH
                                                                (%UTF-8-BYTE
                                                                 ((ECLECTOR.READER:UNQUOTE
                                                                   CHAR-FUNC)
                                                                  STRING I))
                                                                SHIFT)))) (INCF
                                                                           I) (INCF
                                                                               SHIFT
                                                                               8))
                                 (MSET-WORD PTR INDEX WORD)
                                 (INCF-MEM-SIZE INDEX)))))))
        (COND
         ((TYPEP STRING '(SIMPLE-ARRAY CHARACTER))
          (%MWRITE-UTF-8-WORDS-UNROLLED SCHAR))
         -HLMEM/BASE-CHAR<=ASCII
         ((TYPEP STRING '(SIMPLE-ARRAY BASE-CHAR))
          (%MWRITE-UTF-8-WORDS-UNROLLED SCHAR))
         (T (%MWRITE-UTF-8-WORDS CHAR))))
      (MSET-INT PTR SAVE-INDEX N-CODEPOINTS)
      INDEX))

[hyperluminal-mem/mem/box/string-utf-8.lisp:180]
  (DEFUN %MWRITE-STRING-UTF-8 (PTR INDEX END-INDEX STRING N-CHARS)
    "Write characters from string STRING to the memory starting at (PTR+INDEX).
Return the number of words actually written.

ABI: characters will be stored using UTF-8 encoding."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 1))
             (TYPE MADDRESS PTR)
             (TYPE MEM-SIZE INDEX END-INDEX)
             (TYPE STRING STRING)
             (TYPE UFIXNUM N-CHARS))
    (LET ((SAVE-INDEX INDEX)
          (I 0)
          +HLMEM/CHARACTER=UTF-16
          (N-CODEPOINTS 0)
          (WORD 0)
          (WORD-BITS 0)
          (WORD-BITS-LEFT +MEM-WORD/BITS+))
      (DECLARE (TYPE MEM-SIZE SAVE-INDEX)
               (TYPE FIXNUM I +HLMEM/CHARACTER=UTF-16 N-CODEPOINTS)
               (TYPE (INTEGER 0 NIL) WORD-BITS)
               (TYPE (INTEGER 1 NIL) WORD-BITS-LEFT))
      (INCF-MEM-SIZE INDEX)
      (MACROLET ((%MWRITE-UTF-8-WORDS (CHAR-FUNC)
                   (ECLECTOR.READER:QUASIQUOTE
                    (LOOP WHILE (< I N-CHARS)
                          DO (LET ((CODE
                                    (CHAR-CODE
                                     ((ECLECTOR.READER:UNQUOTE CHAR-FUNC)
                                      STRING I))))
                               (INCF (THE FIXNUM I))
                               (WHEN +HLMEM/CHARACTER=UTF-16
                                 (NOT (%CODE-IS-LOW-SURROGATE CODE))
                                 +HLMEM/CHARACTER=UTF-16
                                 T
                                 (MULTIPLE-VALUE-BIND (NEXT NEXT-BITS)
                                     (%CODEPOINT->UTF-8-WORD
                                      +HLMEM/CHARACTER=UTF-16
                                      (%UTF-16->CODEPOINT CODE STRING
                                       (ECLECTOR.READER:UNQUOTE CHAR-FUNC) I
                                       N-CHARS)
                                      -HLMEM/CHARACTER=UTF-16 CODE)
                                   (DECLARE (TYPE MEM-WORD WORD NEXT)
                                            (TYPE (INTEGER 0 32) NEXT-BITS))
                                   +HLMEM/CHARACTER=UTF-16
                                   (INCF N-CODEPOINTS)
                                   (SETF WORD
                                           (LOGIOR WORD
                                                   (LOGAND +MEM-WORD/MASK+
                                                           (ASH NEXT
                                                                WORD-BITS)))
                                         WORD-BITS-LEFT
                                           (- +MEM-WORD/BITS+ WORD-BITS))
                                   (WHEN (>= NEXT-BITS WORD-BITS-LEFT)
                                     (CHECK-MEM-OVERRUN PTR INDEX END-INDEX 1)
                                     (MSET-WORD PTR INDEX WORD)
                                     (SETF INDEX (MEM-SIZE+1 INDEX)
                                           WORD (ASH NEXT (- WORD-BITS-LEFT))
                                           WORD-BITS
                                             (- NEXT-BITS WORD-BITS-LEFT)
                                           NEXT 0
                                           NEXT-BITS 0))
                                   (INCF WORD-BITS NEXT-BITS))))))))
        (COND
         ((TYPEP STRING '(SIMPLE-ARRAY CHARACTER)) (%MWRITE-UTF-8-WORDS SCHAR))
         -HLMEM/BASE-CHAR<=ASCII
         ((TYPEP STRING '(SIMPLE-ARRAY BASE-CHAR)) (%MWRITE-UTF-8-WORDS SCHAR))
         (T (%MWRITE-UTF-8-WORDS CHAR))))
      (UNLESS (ZEROP WORD-BITS)
        (CHECK-MEM-OVERRUN PTR INDEX END-INDEX 1)
        (MSET-WORD PTR INDEX WORD)
        (INCF-MEM-SIZE INDEX))
      (MSET-INT PTR SAVE-INDEX +HLMEM/CHARACTER=UTF-16 N-CODEPOINTS
       -HLMEM/CHARACTER=UTF-16 N-CHARS)
      INDEX))

[hyperluminal-mem/mem/ffi-late.lisp:69]
  (DEFUN MEMSET-WORDS (PTR START-INDEX N-WORDS FILL-WORD)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 1))
             (TYPE MADDRESS PTR)
             (TYPE MEM-WORD FILL-WORD)
             (TYPE MEM-SIZE START-INDEX N-WORDS))
    (SYMBOL-MACROLET ((I START-INDEX) (END END-INDEX))
      +HLMEM/FAST-MEMSET
      (FAST-MEMSET-WORDS PTR I N-WORDS FILL-WORD)
      -HLMEM/FAST-MEMSET
      (PROGN
       +
       (AND HLMEM/FAST-MEM (OR X86 X86-64))
       (PROGN
        (LOOP WHILE (>= N-WORDS 8)
              DO (FAST-MSET-WORD FILL-WORD PTR I :OFFSET
                  (* 0 +MSIZEOF-WORD+)) (FAST-MSET-WORD FILL-WORD PTR I :OFFSET
                                         (* 1 +MSIZEOF-WORD+)) (FAST-MSET-WORD
                                                                FILL-WORD PTR I
                                                                :OFFSET
                                                                (* 2
                                                                   +MSIZEOF-WORD+)) (FAST-MSET-WORD
                                                                                     FILL-WORD
                                                                                     PTR
                                                                                     I
                                                                                     :OFFSET
                                                                                     (*
                                                                                      3
                                                                                      +MSIZEOF-WORD+)) (FAST-MSET-WORD
                                                                                                        FILL-WORD
                                                                                                        PTR
                                                                                                        I
                                                                                                        :OFFSET
                                                                                                        (*
                                                                                                         4
                                                                                                         +MSIZEOF-WORD+)) (FAST-MSET-WORD
                                                                                                                           FILL-WORD
                                                                                                                           PTR
                                                                                                                           I
                                                                                                                           :OFFSET
                                                                                                                           (*
                                                                                                                            5
                                                                                                                            +MSIZEOF-WORD+)) (FAST-MSET-WORD
                                                                                                                                              FILL-WORD
                                                                                                                                              PTR
                                                                                                                                              I
                                                                                                                                              :OFFSET
                                                                                                                                              (*
                                                                                                                                               6
                                                                                                                                               +MSIZEOF-WORD+)) (FAST-MSET-WORD
                                                                                                                                                                 FILL-WORD
                                                                                                                                                                 PTR
                                                                                                                                                                 I
                                                                                                                                                                 :OFFSET
                                                                                                                                                                 (*
                                                                                                                                                                  7
                                                                                                                                                                  +MSIZEOF-WORD+)) (INCF-MEM-SIZE
                                                                                                                                                                                    I
                                                                                                                                                                                    8) (DECF-MEM-SIZE
                                                                                                                                                                                        N-WORDS
                                                                                                                                                                                        8))
        (LOOP WHILE (> N-WORDS 0)
              DO (FAST-MSET-WORD FILL-WORD PTR I) (INCF-MEM-SIZE
                                                   I) (DECF-MEM-SIZE N-WORDS)))
       -
       (AND HLMEM/FAST-MEM (OR X86 X86-64))
       (PROGN
        (LOOP WHILE (>= N-WORDS 4)
              DO (LET ((I1 (MEM-SIZE+ I 1))
                       (I2 (MEM-SIZE+ I 2))
                       (I3 (MEM-SIZE+ I 3)))
                   (MSET-WORD PTR I FILL-WORD)
                   (MSET-WORD PTR I1 FILL-WORD)
                   (MSET-WORD PTR I2 FILL-WORD)
                   (MSET-WORD PTR I3 FILL-WORD)
                   (INCF-MEM-SIZE I 4)
                   (DECF-MEM-SIZE N-WORDS 4)))
        (LOOP WHILE (> N-WORDS 0)
              DO (MSET-WORD PTR I FILL-WORD) (INCF-MEM-SIZE I) (DECF-MEM-SIZE
                                                                N-WORDS))))))

[hyperluminal-mem/mem/float.lisp:34]
  (DEFUN SFLOAT-BITS (VALUE PTR BYTE-OFFSET)
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3))
             (TYPE SINGLE-FLOAT VALUE)
             (TYPE MADDRESS PTR)
             (TYPE MEM-WORD BYTE-OFFSET)
             (IGNORABLE PTR BYTE-OFFSET))
    (THE (UNSIGNED-BYTE 32)
         (#S(FORMGREP:SYMREF :NAME "SINGLE-FLOAT-BITS" :QUALIFIER "CCL")
          VALUE))
    (THE (UNSIGNED-BYTE 32) (LOGAND NIL (SB-KERNEL:SINGLE-FLOAT-BITS VALUE))))

[hyperluminal-mem/mem/float.lisp:52]
  (DEFUN MAKE-SFLOAT (BITS)
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3))
             (TYPE (UNSIGNED-BYTE 32) BITS))
    (#S(FORMGREP:SYMREF
        :NAME "HOST-SINGLE-FLOAT-FROM-UNSIGNED-BYTE-32"
        :QUALIFIER "CCL")
     BITS)
    (SB-KERNEL:MAKE-SINGLE-FLOAT (THE (SIGNED-BYTE 32) BITS)))

[hyperluminal-mem/mem/float.lisp:64]
  (DEFUN DFLOAT-BITS (VALUE PTR BYTE-OFFSET)
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3))
             (TYPE DOUBLE-FLOAT VALUE)
             (TYPE MADDRESS PTR)
             (TYPE MEM-WORD BYTE-OFFSET)
             (IGNORABLE PTR BYTE-OFFSET))
    (#S(FORMGREP:SYMREF :NAME "DOUBLE-FLOAT-BITS" :QUALIFIER "CCL") VALUE)
    (VALUES (LOGAND (SB-KERNEL:DOUBLE-FLOAT-HIGH-BITS VALUE) 4294967295)
            (SB-KERNEL:DOUBLE-FLOAT-LOW-BITS VALUE)))

[hyperluminal-mem/mem/float.lisp:87]
  (DEFUN MAKE-DFLOAT (HI LO)
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3)))
    (#S(FORMGREP:SYMREF :NAME "DOUBLE-FLOAT-FROM-BITS" :QUALIFIER "CCL") HI LO)
    (SB-KERNEL:MAKE-DOUBLE-FLOAT (THE (SIGNED-BYTE 32) HI) LO))

[hyperluminal-mem/mem/int.lisp:40]
  (DEFMACRO MWORD=>MEM-INT (WORD)
    +HLMEM/MWORD=>MEM-INT
    (ECLECTOR.READER:QUASIQUOTE
     ((ECLECTOR.READER:UNQUOTE (GET-FEATURE :HLMEM/MWORD=>MEM-INT))
      (ECLECTOR.READER:UNQUOTE WORD)))
    -HLMEM/MWORD=>MEM-INT
    (WITH-GENSYM X
     (ECLECTOR.READER:QUASIQUOTE
      (LOCALLY
       (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3)))
       (LET (((ECLECTOR.READER:UNQUOTE X) (ECLECTOR.READER:UNQUOTE WORD)))
         (THE MEM-INT
              (- (LOGAND +MEM-INT/VALUE-MASK+ (ECLECTOR.READER:UNQUOTE X))
                 (LOGAND +MEM-INT/SIGN-MASK+ (ECLECTOR.READER:UNQUOTE X)))))))))

[hyperluminal-mem/mem/int.lisp:88]
  (DEFUN MSET-INT (PTR INDEX VALUE)
    "Write mem-int VALUE into the memory at (PTR+INDEX)"
    (DECLARE (TYPE MADDRESS PTR)
             (TYPE MEM-SIZE INDEX)
             (TYPE MEM-INT VALUE)
             (OPTIMIZE (SAFETY 0) (SPEED 3)))
    (MSET-WORD PTR INDEX (MEM-INT=>MWORD VALUE))
    T)

[hyperluminal-mem/mem/native-mem.lisp:66]
  (EVAL-ALWAYS
   (DEFUN %DETECT-BITS-PER-WORD ()
     (DECLARE (OPTIMIZE (SPEED 0) (SAFETY 3)))
     (LET ((BITS-PER-WORD 1))
       (FLET ((DONE (C)
                (DECLARE (IGNORABLE C))
                (#S(FORMGREP:SYMREF :NAME "DEBUG" :QUALIFIER "LOG") C)
                (RETURN-FROM %DETECT-BITS-PER-WORD BITS-PER-WORD)))
         (WITH-MEM-WORDS (P 1)
          (LOOP FOR I = 1 THEN (LOGIOR (ASH I 1) 1)
                FOR BITS = 1 THEN (1+ BITS)
                DO (HANDLER-CASE
                    (PROGN
                     (#S(FORMGREP:SYMREF :NAME "DEBUG" :QUALIFIER "LOG")
                      "(i #x~X) (bits ~D) ..." I BITS)
                     (%MSET-T I :WORD P)
                     (LET ((J (%MGET-T :WORD P)))
                       (#S(FORMGREP:SYMREF :NAME "DEBUG" :QUALIFIER "LOG")
                        " read back: #x~X ..." J)
                       (UNLESS (EQL I J)
                         (ERROR
                          "reading value '~S' stored in a CPU word returned '~S'"
                          I J))
                       (#S(FORMGREP:SYMREF :NAME "DEBUG" :QUALIFIER "LOG")
                        "ok"))
                     (SETF BITS-PER-WORD BITS))
                    (SIMPLE-ERROR (C) (DONE C)) (TYPE-ERROR (C) (DONE C))))))))
   (DEFUN BINARY-SEARCH-PRED (LOW HIGH PRED)
     "find the largest integer in range LO...(1- HI) that satisfies PRED.
Assumes that (funcall PRED LOw) = T and (funcall PRED HIGH) = NIL."
     (DECLARE (TYPE INTEGER LOW HIGH)
              (TYPE FUNCTION PRED))
     (LOOP FOR DELTA = (- HIGH LOW)
           WHILE (> DELTA 1)
           DO (LET ((MIDDLE (+ LOW (ASH DELTA -1))))
                (IF (FUNCALL PRED MIDDLE)
                    (SETF LOW MIDDLE)
                    (SETF HIGH MIDDLE))))
     LOW)
   (DEFUN FIND-MOST-POSITIVE-PRED (PRED)
     "find the largest positive integer that satisfies PRED."
     (DECLARE (TYPE FUNCTION PRED))
     (UNLESS (FUNCALL PRED 1) (RETURN-FROM FIND-MOST-POSITIVE-PRED 0))
     (LET ((N 1))
       (LOOP FOR NEXT = (ASH N 1)
             WHILE (FUNCALL PRED NEXT)
             DO (SETF N NEXT))
       (BINARY-SEARCH-PRED N (ASH N 1) PRED)))
   (DEFUN %IS-CHAR-CODE? (CODE TYPE)
     (DECLARE (OPTIMIZE (SPEED 0) (SAFETY 3))
              (TYPE INTEGER CODE)
              (TYPE SYMBOL TYPE))
     (HANDLER-CASE
      (LET ((CH (CODE-CHAR CODE)))
        (AND (TYPEP CH TYPE) (EQL CODE (CHAR-CODE CH))))
      (CONDITION NIL NIL)))
   (DEFUN %DETECT-MOST-POSITIVE-CHARACTER ()
     (FIND-MOST-POSITIVE-PRED (LAMBDA (N) (%IS-CHAR-CODE? N 'CHARACTER))))
   (DEFUN %DETECT-MOST-POSITIVE-BASE-CHAR ()
     (FIND-MOST-POSITIVE-PRED (LAMBDA (N) (%IS-CHAR-CODE? N 'BASE-CHAR)))))

[hyperluminal-mem/mem/unboxed.lisp:130]
  (DEFUN MREAD-WORD (PTR WORD-INDEX)
    (DECLARE
     (OPTIMIZE (SPACE 0) (COMPILATION-SPEED 0) (SAFETY 0) (DEBUG 1) (SPEED 3))
     (TYPE MADDRESS PTR)
     (TYPE MEM-SIZE WORD-INDEX))
    (THE MEM-WORD (MGET-WORD PTR WORD-INDEX)))

[hyperluminal-mem/mem/unboxed.lisp:137]
  (DEFUN MWRITE-WORD (PTR WORD-INDEX VALUE)
    (DECLARE
     (OPTIMIZE (SPACE 0) (COMPILATION-SPEED 0) (SAFETY 0) (DEBUG 1) (SPEED 3))
     (TYPE MADDRESS PTR)
     (TYPE MEM-SIZE WORD-INDEX)
     (TYPE MEM-WORD VALUE))
    (MSET-WORD PTR WORD-INDEX VALUE)
    VALUE)

[hyperluminal-mem/mem/unboxed.lisp:378]
  (DEFUN MSET-UNBOXED (PTR INDEX VALUE)
    "Try to write an unboxed value to memory store. Supported types are:
boolean, unbound slots, character and medium-size integers
(on 64bit architectures can also write single-floats).

Return T on success, or NIL if VALUE is a pointer or must be boxed."
    (DECLARE (TYPE MADDRESS PTR)
             (TYPE MEM-SIZE INDEX)
             (OPTIMIZE (SAFETY 0) (SPEED 3)))
    (LET ((TAG +MEM-TAG/SYMBOL+) (VID +MEM-SYM/NIL+))
      (DECLARE (TYPE MEM-TAG TAG)
               (TYPE MEM-VID VID))
      (COND + (OR HLMEM/MEM-INT>FIXNUM HLMEM/MEM-INT=FIXNUM)
            ((TYPEP VALUE 'FIXNUM)
             (RETURN-FROM MSET-UNBOXED
               (MSET-INT PTR INDEX (THE FIXNUM VALUE))))
            ((CHARACTERP VALUE)
             (SETF TAG +MEM-TAG/CHARACTER+
                   VID (CHAR-CODE VALUE)))
            ((EQ VALUE NIL)) ((EQ VALUE T) (SETF VID +MEM-SYM/T+))
            ((EQ VALUE +UNBOUND-TVAR+) (SETF VID +MEM-SYM/UNBOUND+))
            -HLMEM/MEM-INT=FIXNUM
            ((TYPEP VALUE 'MEM-INT)
             (RETURN-FROM MSET-UNBOXED (MSET-INT PTR INDEX VALUE)))
            ((TYPEP VALUE 'RATIO)
             (LET ((NUMERATOR (NUMERATOR VALUE))
                   (DENOMINATOR (DENOMINATOR VALUE)))
               (WHEN
                   (AND (TYPEP NUMERATOR 'MEM-INT) (TYPEP DENOMINATOR 'MEM-INT)
                        (<= NIL NUMERATOR +MEM-RATIO/NUMERATOR/MASK+)
                        (<= 1 DENOMINATOR NIL))
                 (MSET-WORD PTR INDEX (%RATIO-TO-WORD NUMERATOR DENOMINATOR))
                 (RETURN-FROM MSET-UNBOXED T))
               (RETURN-FROM MSET-UNBOXED NIL)))
            +HLMEM/SFLOAT/INLINE
            ((TYPEP VALUE 'SINGLE-FLOAT)
             (MSET-TAG-AND-VID PTR INDEX +MEM-TAG/SFLOAT+ 0)
             (MSET-FLOAT/INLINE :SFLOAT PTR INDEX VALUE)
             (RETURN-FROM MSET-UNBOXED T))
            +HLMEM/DFLOAT/INLINE
            ((TYPEP VALUE 'DOUBLE-FLOAT)
             (MSET-TAG-AND-VID PTR INDEX +MEM-TAG/DFLOAT+ 0)
             (MSET-FLOAT/INLINE :DFLOAT PTR INDEX VALUE)
             (RETURN-FROM MSET-UNBOXED T))
            (T
             (LET ((REF-VID (GETHASH VALUE +SYMBOLS-TABLE+)))
               (IF REF-VID
                   (SETF VID REF-VID)
                   (RETURN-FROM MSET-UNBOXED NIL)))))
      (MSET-TAG-AND-VID PTR INDEX TAG VID)))

[hyperluminal-mem/mem/unboxed.lisp:478]
  (DEFUN MGET-UNBOXED (PTR INDEX)
    "Try to read an unboxed value (boolean, unbound slot, character or mem-int)
from memory store (on 64 bit architectures, also single-floats are unboxed)
and return it.

If memory contains a pointer or a boxed value, return their value and fulltag
as multiple values."
    (DECLARE (TYPE MADDRESS PTR)
             (TYPE MEM-SIZE INDEX)
             (OPTIMIZE (SAFETY 0) (SPEED 3)))
    (LET ((WORD (MGET-WORD PTR INDEX)))
      (WHEN (%WORD-IS-MEM-INT WORD)
        (RETURN-FROM MGET-UNBOXED (MWORD=>MEM-INT WORD)))
      (LET ((TAG (%TO-TAG WORD)) (VID (%TO-VID WORD)))
        (CASE TAG
          (()
           (CASE WORD
             (() NIL)
             (() T)
             (() +UNBOUND-TVAR+)
             (OTHERWISE
              (IF (<= +MEM-SYMS/FIRST+ VID +MEM-SYMS/LAST+)
                  (SVREF +SYMBOLS-VECTOR+ (- VID +MEM-SYMS/FIRST+))
                  (VALUES VID TAG)))))
          (() (CODE-CHAR (LOGAND VID +CHARACTER/MASK+)))
          ((NIL NIL) (%WORD-TO-RATIO WORD))
          +HLMEM/SFLOAT/INLINE
          (() (MGET-FLOAT/INLINE :SFLOAT PTR INDEX))
          +HLMEM/DFLOAT/INLINE
          (() (MGET-FLOAT/INLINE :DFLOAT PTR INDEX))
          (OTHERWISE (VALUES VID TAG))))))

[hyperluminal-mem/mem/unicode.lisp:51]
  (PROGN
   (DECLAIM (INLINE %CODEPOINT->CHARACTER))
   (DEFUN %CODEPOINT->CHARACTER (CODE)
     "Convert Unicode codepoint to a character"
     (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 1))
              (TYPE FIXNUM CODE))
     (CODE-CHAR (LOGAND CODE +CHARACTER/MASK+))))

[hyperluminal-mem/mem/unicode.lisp:65]
  (PROGN
   (DEFMACRO %UTF-16->CODEPOINT (CODE STRING CHAR-FUNC I N-CHARS)
     "Convert utf-16 CODE to Unicode codepoint. If CODE is a high-surrogate,
check next char in STRING: if it's a low-surrogate, consume it,
otherwise assume a low-surrogate equal #xDC00.
In any case, convert the code or the high/low surrogate pair to a codepoint."
     (WITH-GENSYMS (HI LO)
      (ECLECTOR.READER:QUASIQUOTE
       (LET (((ECLECTOR.READER:UNQUOTE HI) (ECLECTOR.READER:UNQUOTE CODE)))
         (IF (%CODE-IS-HIGH-SURROGATE (ECLECTOR.READER:UNQUOTE HI))
             (LET (((ECLECTOR.READER:UNQUOTE LO)
                    (IF (< (ECLECTOR.READER:UNQUOTE I)
                           (ECLECTOR.READER:UNQUOTE N-CHARS))
                        (CHAR-CODE
                         ((ECLECTOR.READER:UNQUOTE CHAR-FUNC)
                          (ECLECTOR.READER:UNQUOTE STRING)
                          (ECLECTOR.READER:UNQUOTE I)))
                        0)))
               (IF (%CODE-IS-LOW-SURROGATE (ECLECTOR.READER:UNQUOTE LO))
                   (INCF (THE FIXNUM (ECLECTOR.READER:UNQUOTE I)))
                   (SETF (ECLECTOR.READER:UNQUOTE LO) 56320))
               (+ (ASH (ECLECTOR.READER:UNQUOTE HI) 10)
                  (ECLECTOR.READER:UNQUOTE LO) -56613888))
             (ECLECTOR.READER:UNQUOTE HI))))))
   (DECLAIM (INLINE %CODEPOINT->UTF-16))
   (DEFUN %CODEPOINT->UTF-16 (CODE)
     "Convert Unicode codepoint to one or two UTF-16 characters"
     (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 1))
              (TYPE FIXNUM CODE))
     (IF (<= CODE 65535)
         (CODE-CHAR CODE)
         (VALUES (CODE-CHAR (+ (ASH CODE -10) 55232))
                 (CODE-CHAR (+ (LOGAND CODE 1023) 56320))))))

[hyperluminal-mem/mem/unicode.lisp:97]
  (DEFUN %CODEPOINT->UTF-8-WORD (N)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 1))
             (TYPE CODEPOINT N))
    (LET ((WORD N) (BITS 8))
      (DECLARE (TYPE (UNSIGNED-BYTE 32) WORD)
               (TYPE (MEMBER 8 16 24 32) BITS))
      (COND ((<= N 127))
            ((<= N 2047)
             (SETF WORD
                     (LOGIOR 32960 (ASH (LOGAND N 63) 8)
                             (ASH (LOGAND N 1984) -6))
                   BITS 16))
            ((<= N 65535)
             (SETF WORD
                     (LOGIOR 8421600 (ASH (LOGAND N 63) 16)
                             (ASH (LOGAND N 4032) 2)
                             (ASH (LOGAND N 61440) -12))
                   BITS 24))
            (T
             (SETF WORD
                     (LOGIOR 2155905264 (ASH (LOGAND N 63) 24)
                             (ASH (LOGAND N 4032) 10)
                             (ASH (LOGAND N 258048) -4)
                             (ASH (LOGAND N 1835008) -18))
                   BITS 32)))
      (VALUES WORD BITS)))

[hyperluminal-mem/mem/unicode.lisp:136]
  (DEFUN %UTF-8-IS-SINGLE-BYTE? (BYTE)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 1))
             (TYPE (UNSIGNED-BYTE 8) BYTE))
    (<= BYTE 127))

[hyperluminal-mem/mem/unicode.lisp:142]
  (DEFUN %UTF-8-IS-FIRST-BYTE? (BYTE)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 1))
             (TYPE (UNSIGNED-BYTE 8) BYTE))
    (OR (<= BYTE 127) (>= BYTE 192)))

[hyperluminal-mem/mem/unicode.lisp:149]
  (DEFUN %UTF-8-FIRST-BYTE->LENGTH (BYTE)
    "Return the expected length, in bytes, of a UTF-8 multi-byte sequence
given its first byte. Return 0 if BYTE is not a valid first byte for UTF-8 sequences"
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 1))
             (TYPE (UNSIGNED-BYTE 8) BYTE))
    (COND ((<= BYTE 127) 1) ((<= BYTE 191) 0) ((<= BYTE 223) 2)
          ((<= BYTE 239) 3) ((<= BYTE 247) 4) (T 0)))

[hyperluminal-mem/mem/unicode.lisp:165]
  (DEFUN %UTF-8-WORD->CODEPOINT (WORD)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 1))
             (TYPE MEM-WORD WORD))
    (LET ((N 0) (BITS 8) (BYTE0 (LOGAND 255 WORD)))
      (DECLARE (TYPE CODEPOINT N)
               (TYPE (MEMBER BITS 8 16 24 32 BITS)))
      (COND ((<= BYTE0 127) (SETF N BYTE0))
            ((<= BYTE0 191) (INVALID-UTF8-ERROR BYTE0))
            ((<= BYTE0 223)
             (SETF N
                     (LOGIOR (ASH (LOGAND 16128 WORD) -8)
                             (ASH (LOGAND 31 WORD) 6))
                   BITS 16))
            ((<= BYTE0 239)
             (SETF N
                     (LOGIOR (ASH (LOGAND 4128768 WORD) -16)
                             (ASH (LOGAND 16128 WORD) -2)
                             (ASH (LOGAND 15 WORD) 12))
                   BITS 24))
            ((<= BYTE0 247)
             (SETF N
                     (LOGIOR (ASH (LOGAND 1056964608 WORD) -24)
                             (ASH (LOGAND 4128768 WORD) -10)
                             (ASH (LOGAND 16128 WORD) 4)
                             (ASH (LOGAND 7 WORD) 18))
                   BITS 32))
            (T (INVALID-UTF8-ERROR BYTE0)))
      (VALUES (THE CODEPOINT N) BITS)))

[incudine/contrib/cl-lilv/cffi-lilv.lisp:19]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (DEFVAR *STANDARD-OPTIMIZE-SETTINGS* '(OPTIMIZE SPEED (SAFETY 0)))
    (CFFI:DEFINE-FOREIGN-LIBRARY LILV
      (:DARWIN "liblilv-0.dylib")
      (:UNIX "liblilv-0.so")
      (:CYGWIN "cyglilv-0.dll")
      (T (:DEFAULT "liblilv-0")))
    (DEFUN LOAD-LILV-LIBRARY () (CFFI:USE-FOREIGN-LIBRARY LILV))
    (UNLESS (CFFI:FOREIGN-LIBRARY-LOADED-P 'LILV) (LOAD-LILV-LIBRARY)))

[incudine/contrib/cl-portmidi/cffi-portmidi.lisp:19]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (DEFVAR *STANDARD-OPTIMIZE-SETTINGS* '(OPTIMIZE SPEED (SAFETY 0)))
    (CFFI:DEFINE-FOREIGN-LIBRARY PORTMIDI
      (:DARWIN "libportmidi.dylib")
      (:UNIX "libportmidi.so")
      (:CYGWIN "cygportmidi-0.dll")
      (T (:DEFAULT "libportmidi")))
    (DEFUN LOAD-PORTMIDI-LIBRARY () (CFFI:USE-FOREIGN-LIBRARY PORTMIDI))
    (UNLESS (CFFI:FOREIGN-LIBRARY-LOADED-P 'PORTMIDI) (LOAD-PORTMIDI-LIBRARY)))

[incudine/contrib/cl-portmidi/example.lisp:15]
  (LET ((PM-STATE NIL)
        (RECV-FUNCTION
         (LAMBDA (TIME MSG)
           (MULTIPLE-VALUE-BIND (STATUS DATA1 DATA2)
               (#S(FORMGREP:SYMREF :NAME "DECODE-MESSAGE" :QUALIFIER "PM") MSG)
             (FORMAT T "TIME ~D STATUS ~D DATA1 ~D DATA2 ~D~%" TIME STATUS
                     DATA1 DATA2)
             (FORCE-OUTPUT)))))
    (DECLARE (TYPE BOOLEAN PM-STATE)
             (TYPE FUNCTION RECV-FUNCTION))
    (DEFUN RECV-START (STREAM)
      (DECLARE (OPTIMIZE SPEED (SAFETY 0))
               (TYPE #S(FORMGREP:SYMREF :NAME "STREAM" :QUALIFIER "PM")
                STREAM))
      (#S(FORMGREP:SYMREF :NAME "WITH-RECEIVER" :QUALIFIER "PM")
       (PM-STATE STREAM MSG TIME) (FUNCALL RECV-FUNCTION TIME MSG)))
    (DEFUN SET-RECV-FUNCTION (FN)
      (DECLARE (TYPE FUNCTION FN))
      (SETF RECV-FUNCTION FN))
    (DEFUN RECV-STOP () (SETF PM-STATE NIL) (RECV-STATUS))
    (DEFUN RECV-STATUS ()
      (IF PM-STATE
          :RUNNING
          :STOPPED)))

[incudine/contrib/cl-portmidi/portmidi.lisp:262]
  (DEFUN INPUT-STREAM-SYSEX-OCTETS (STREAM &OPTIONAL OCTETS (START 0))
    "Return the vector of octets stored in the buffer of the PortMidi
input STREAM and the MIDI SysEx message size.

Create a new vector if OCTETS is NIL (default).

START specifies an offset into OCTETS and marks the beginning position
of that vector."
    (DECLARE (TYPE INPUT-STREAM STREAM)
             (TYPE (OR (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) NULL) OCTETS)
             (TYPE NON-NEGATIVE-FIXNUM START))
    (WITH-INPUT-SYSEX-EVENT (PTR STREAM)
     (LET ((REMAIN (INPUT-STREAM-EVENTS-REMAIN STREAM)))
       (DECLARE (TYPE NON-NEGATIVE-FIXNUM REMAIN)
                (OPTIMIZE SPEED (SAFETY 0)))
       (WHEN (> REMAIN 0)
         (LET* ((BUTLAST-EVENTS (1- REMAIN))
                (LAST32
                 (CFFI:MEM-AREF
                  (CFFI-SYS:INC-POINTER PTR (THE FIXNUM (* 8 BUTLAST-EVENTS)))
                  :UINT32))
                (I (MAX 1 (ASH (INTEGER-LENGTH LAST32) -3)))
                (TAIL-SIZE I)
                (SIZE (+ (* 4 BUTLAST-EVENTS) TAIL-SIZE)))
           (DECLARE (TYPE NON-NEGATIVE-FIXNUM BUTLAST-EVENTS SIZE))
           (WHEN (<= SIZE DEFAULT-SYSEX-BUFFER-SIZE)
             (MULTIPLE-VALUE-BIND (BUF START SIZE)
                 (IF OCTETS
                     (VALUES OCTETS START (MIN (- (LENGTH OCTETS) START) SIZE))
                     (VALUES (MAKE-ARRAY SIZE :ELEMENT-TYPE '(UNSIGNED-BYTE 8))
                             0 SIZE))
               (DECLARE (TYPE NON-NEGATIVE-FIXNUM START SIZE))
               (CFFI-SYS:WITH-POINTER-TO-VECTOR-DATA (APTR BUF)
                 (IF (> START 0)
                     (CFFI:INCF-POINTER APTR START))
                 (LOOP FOR I OF-TYPE FIXNUM FROM 0
                       FOR J OF-TYPE FIXNUM BELOW (* 2 BUTLAST-EVENTS) BY 2
                       DO (SETF (CFFI:MEM-AREF APTR :INT32 I)
                                  (CFFI:MEM-AREF PTR :INT32 J))
                       FINALLY (LOOP FOR K BELOW TAIL-SIZE
                                     FOR M FROM (* I 4) BELOW SIZE
                                     WITH LAST-PTR = (CFFI:MEM-APTR PTR :INT32
                                                                    J)
                                     DO (SETF (CFFI:MEM-AREF APTR :CHAR M)
                                                (CFFI:MEM-AREF LAST-PTR :CHAR
                                                               K)))))
               (VALUES BUF SIZE))))))))

[incudine/src/analysis/pvbuffer.lisp:638]
  (DEFUN STFT-LOOP (PVBUF OBJ START FRAMES)
    (DECLARE (TYPE PVBUFFER PVBUF)
             (TYPE
              (OR #S(FORMGREP:SYMREF :NAME "BUFFER" :QUALIFIER "INCUDINE")
                  #S(FORMGREP:SYMREF :NAME "STREAM" :QUALIFIER "SOUNDFILE"))
              OBJ)
             (TYPE NON-NEGATIVE-FIXNUM START FRAMES))
    (LET* ((BLOCK-SIZE (PVBUFFER-BLOCK-SIZE PVBUF))
           (CHANNELS (PVBUFFER-CHANNELS PVBUF))
           (HOP-SIZE (PVBUFFER-HOP-SIZE PVBUF))
           (NORMALIZED-P (PVBUFFER-NORMALIZED-P PVBUF))
           (ZERO-PHASE-WINDOW-P (PVBUFFER-ZERO-PHASE-WINDOW-P PVBUF))
           (WINDOW-HALF-SIZE (- (ASH (PVBUFFER-WINDOW-SIZE PVBUF) -1)))
           (STEP (* +FOREIGN-SAMPLE-SIZE+ BLOCK-SIZE))
           (FFT (MAKE-FFT-FROM-PVBUFFER PVBUF)))
      (DECLARE (TYPE NON-NEGATIVE-FIXNUM BLOCK-SIZE STEP)
               (TYPE FIXNUM WINDOW-HALF-SIZE)
               (OPTIMIZE SPEED (SAFETY 0)))
      (UNWIND-PROTECT
          (LOOP FOR CHAN BELOW CHANNELS
                WITH J OF-TYPE FIXNUM = 0
                DO (IF (#S(FORMGREP:SYMREF
                           :NAME "BUFFER-P"
                           :QUALIFIER "INCUDINE")
                        OBJ)
                       (SETF J (* CHANNELS (1- START)))
                       (SETF (#S(FORMGREP:SYMREF
                                 :NAME "POSITION"
                                 :QUALIFIER "SOUNDFILE")
                              OBJ)
                               START)) (LOOP FOR FRAME BELOW FRAMES
                                             DO (#S(FORMGREP:SYMREF
                                                    :NAME "MSG"
                                                    :QUALIFIER "INCUDINE.UTIL")
                                                 DEBUG
                                                 "[STFT] channel ~D, frame ~D"
                                                 CHAN
                                                 FRAME) (LOOP REPEAT HOP-SIZE
                                                              DO (SETF (FFT-INPUT
                                                                        FFT)
                                                                         (IF (#S(FORMGREP:SYMREF
                                                                                 :NAME "BUFFER-P"
                                                                                 :QUALIFIER "INCUDINE")
                                                                              OBJ)
                                                                             (#S(FORMGREP:SYMREF
                                                                                 :NAME "BUFFER-VALUE"
                                                                                 :QUALIFIER "INCUDINE")
                                                                              OBJ
                                                                              (THE
                                                                               NON-NEGATIVE-FIXNUM
                                                                               (+
                                                                                (THE
                                                                                 NON-NEGATIVE-FIXNUM
                                                                                 (INCF
                                                                                  J
                                                                                  CHANNELS))
                                                                                CHAN)))
                                                                             (#S(FORMGREP:SYMREF
                                                                                 :NAME "READ-NEXT"
                                                                                 :QUALIFIER "SOUNDFILE")
                                                                              OBJ
                                                                              CHAN)))) (WHEN
                                                                                           ZERO-PHASE-WINDOW-P
                                                                                         (CIRCULAR-SHIFT
                                                                                          FFT
                                                                                          WINDOW-HALF-SIZE)) (COMPUTE-FFT
                                                                                                              FFT) (LOOP FOR I BELOW BLOCK-SIZE
                                                                                                                         DO (SETF (SMP-REF
                                                                                                                                   (CFFI-SYS:INC-POINTER
                                                                                                                                    (CFFI:MEM-AREF
                                                                                                                                     (PVBUFFER-DATA-PTR
                                                                                                                                      PVBUF)
                                                                                                                                     :POINTER
                                                                                                                                     CHAN)
                                                                                                                                    (THE
                                                                                                                                     NON-NEGATIVE-FIXNUM
                                                                                                                                     (*
                                                                                                                                      FRAME
                                                                                                                                      STEP)))
                                                                                                                                   I)
                                                                                                                                    (IF NORMALIZED-P
                                                                                                                                        (*
                                                                                                                                         (PVBUFFER-SCALE-FACTOR
                                                                                                                                          PVBUF)
                                                                                                                                         (SMP-REF
                                                                                                                                          (FFT-OUTPUT-BUFFER
                                                                                                                                           FFT)
                                                                                                                                          I))
                                                                                                                                        (SMP-REF
                                                                                                                                         (FFT-OUTPUT-BUFFER
                                                                                                                                          FFT)
                                                                                                                                         I))))))
        (FREE FFT))
      PVBUF))

[incudine/src/config.lisp:315]
  (DEFVAR *STANDARD-OPTIMIZE-SETTINGS* '(OPTIMIZE SPEED (SAFETY 0)))

[incudine/src/edf-sched.lisp:468]
  (DEFUN %POUR-ON-RT-HEAP (HEAP END-ACTION)
    (DECLARE (TYPE HEAP HEAP)
             (TYPE FUNCTION END-ACTION)
             (OPTIMIZE SPEED (SAFETY 0)))
    (FLET ((THE-END ()
             (REMOVE-FLUSH-PENDING-HOOK END-ACTION)
             (#S(FORMGREP:SYMREF :NAME "NRT-FUNCALL" :QUALIFIER "INCUDINE")
              END-ACTION)))
      (LET ((RT-HEAP *HEAP*) (*HEAP* HEAP))
        (DECLARE (SPECIAL *HEAP*))
        (LOOP WHILE (AND (> (HEAP-NEXT-NODE HEAP) +ROOT-NODE+)
                         (>=
                          (+
                           (THE SAMPLE
                                (#S(FORMGREP:SYMREF
                                    :NAME "NOW"
                                    :QUALIFIER "INCUDINE")))
                           (SAMPLE 0.5))
                          (+ (NODE-TIME (HEAP-NODE +ROOT-NODE+))
                             (HEAP-TIME-OFFSET HEAP))))
              DO (LET ((CURR-NODE (GET-HEAP)))
                   (DECLARE (TYPE NODE CURR-NODE))
                   (WITH-RT-HEAP (RT-HEAP) (CALL-NODE-FUNCTION CURR-NODE))))
        (COND ((HEAP-EMPTY-P) (WITH-RT-HEAP (RT-HEAP) (THE-END)))
              ((= (HEAP-COUNT) 1)
               (WITH-RT-NEXT-NODE (NEXT-NODE TIME HEAP RT-HEAP) (THE-END)))
              (T
               (WITH-RT-NEXT-NODE (NEXT-NODE TIME HEAP RT-HEAP)
                (SCHEDULE-AT
                 (1+
                  (THE SAMPLE
                       (#S(FORMGREP:SYMREF
                           :NAME "NOW"
                           :QUALIFIER "INCUDINE"))))
                 #'%POUR-ON-RT-HEAP (LIST HEAP END-ACTION)))))
        (VALUES))))

[incudine/src/logger.lisp:126]
  (DEFUN %MSG (TYPE CONTROL-STRING ARGS)
    (DECLARE (TYPE (MEMBER ERROR WARN INFO DEBUG) TYPE)
             (TYPE STRING CONTROL-STRING)
             (OPTIMIZE SPEED (SAFETY 0)))
    (WHEN (LOGGER-ACTIVE-P TYPE)
      (FRESH-LINE *LOGGER-STREAM*)
      (WHEN *LOGGER-TIME* (FUNCALL *LOGGER-TIME-FUNCTION*))
      (UNLESS (EQ TYPE 'INFO) (PRINC (FORMAT NIL "~A: " TYPE) *LOGGER-STREAM*))
      (APPLY #'FORMAT *LOGGER-STREAM* CONTROL-STRING ARGS)
      (TERPRI *LOGGER-STREAM*)
      (WHEN *LOGGER-FORCE-OUTPUT-P* (FORCE-OUTPUT *LOGGER-STREAM*))))

[incudine/src/logger.lisp:141]
  (DEFUN %NRT-MSG (TYPE CONTROL-STRING &REST ARGS)
    (DECLARE (TYPE (MEMBER ERROR WARN INFO DEBUG) TYPE)
             (TYPE STRING CONTROL-STRING)
             (OPTIMIZE SPEED (SAFETY 0)))
    (WHEN (LOGGER-ACTIVE-P TYPE)
      (FLET ((LOGGING ()
               (%MSG TYPE CONTROL-STRING ARGS)))
        (IF (RT-THREAD-P)
            (#S(FORMGREP:SYMREF :NAME "NRT-FUNCALL" :QUALIFIER "INCUDINE")
             #'LOGGING)
            (LOGGING)))))

[incudine/src/vug/codegen.lisp:1260]
  (DEFUN OPTIMIZE-VALUE (LIST QUALITY)
    (DECLARE
     (TYPE (MEMBER COMPILATION-SPEED DEBUG SAFETY SPACE SPEED) QUALITY))
    (DOLIST (Q LIST 0)
      (WHEN
          (EQ QUALITY
              (IF (CONSP Q)
                  (FIRST Q)
                  Q))
        (RETURN
         (IF (CONSP Q)
             (SECOND Q)
             3)))))

[incudine/tests/play-function.lisp:5]
  (LET ((X 0))
    (DECLARE (FIXNUM X))
    (DEFUN NOISE-FUNC-INIT (NODE) (SETF X 12345) NODE)
    (DEFUN NOISE-FUNC-TEST ()
      (DECLARE (OPTIMIZE SPEED (SAFETY 0)))
      (SETF X (LOGAND (+ 17711 (* X 9227465)) 16777215))
      (INCF (AUDIO-OUT 0) (* (- X 8388607) 1.0d-7))
      (VALUES)))

[incudine/tests/play-function.lisp:20]
  (DEFUN SIMPLE-LP ()
    (DECLARE (OPTIMIZE SPEED (SAFETY 0)))
    (LET ((IN (AUDIO-OUT 0)))
      (SETF (AUDIO-OUT 0) (* 0.5 (+ (BUS 0) IN)))
      (SETF (BUS 0) IN)
      (VALUES)))

[incudine/tests/play-function.lisp:27]
  (LET ((AMP 0) (CURRENT-NODE NIL))
    (DECLARE (TYPE FIXNUM AMP)
             (TYPE (OR NODE NULL) CURRENT-NODE))
    (DEFUN SINOSC-FUNC-INIT (NODE) (SETF AMP 0) (SETF CURRENT-NODE NODE))
    (DEFUN SINOSC-FUNC-TEST ()
      (DECLARE (OPTIMIZE SPEED (SAFETY 0)))
      (OUT
       (* AMP 2.0d-10 AMP
          (SIN
           (THE MAYBE-LIMITED-SAMPLE
                (* +TWOPI+ 441 *SAMPLE-DURATION* (NOW))))))
      (IF (>= AMP (SAMPLE->FIXNUM *SAMPLE-RATE*))
          (REINIT CURRENT-NODE)
          (INCF AMP))
      (VALUES)))

[informatimago/common-lisp/cesarum/list.lisp:619]
  (DEFUN HASHED-INTERSECTION (SET1 SET2)
    "
AUTHORS: Paul F. Dietz <dietz@dls.net>
         Thomas A. Russ <tar@sevak.isi.edu>
"
    (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0))
             (LIST SET1 SET2))
    (LET ((TABLE (MAKE-HASH-TABLE :SIZE (LENGTH SET2))) (RESULT NIL))
      (DOLIST (E SET2) (SETF (GETHASH E TABLE) T))
      (DOLIST (E SET1)
        (WHEN (GETHASH E TABLE) (PUSH E RESULT) (SETF (GETHASH E TABLE) NIL)))
      RESULT))

[informatimago/small-cl-pgms/miscellaneous/clisp-server.lisp:67]
  (DEFCONSTANT *RCL-EXPORTS*
    '(&ALLOW-OTHER-KEYS &AUX &BODY &ENVIRONMENT &KEY &OPTIONAL &REST &WHOLE
      *COMPILE-FILE-PATHNAME* *COMPILE-FILE-TRUENAME* *COMPILE-PRINT*
      *COMPILE-VERBOSE* *DEFAULT-PATHNAME-DEFAULTS* *ERROR-OUTPUT* *FEATURES*
      *GENSYM-COUNTER* *LOAD-PRINT* *LOAD-VERBOSE* *MACROEXPAND-HOOK* *PACKAGE*
      *PRINT-ARRAY* *PRINT-BASE* *PRINT-CASE* *PRINT-CIRCLE* *PRINT-ESCAPE*
      *PRINT-GENSYM* *PRINT-LENGTH* *PRINT-LEVEL* *PRINT-LINES*
      *PRINT-MISER-WIDTH* *PRINT-PPRINT-DISPATCH* *PRINT-PRETTY* *PRINT-RADIX*
      *PRINT-READABLY* *PRINT-RIGHT-MARGIN* *RANDOM-STATE* *STANDARD-INPUT*
      *STANDARD-OUTPUT* * ** *** + ++ +++ - / // /// = /= < <= > >= 1+ 1- ABORT
      ABS ACONS ACOS ACOSH ADD-METHOD ADJOIN ADJUST-ARRAY ADJUSTABLE-ARRAY-P
      ALLOCATE-INSTANCE ALPHA-CHAR-P ALPHANUMERICP AND APPEND APPLY APROPOS
      APROPOS-LIST AREF ARITHMETIC-ERROR ARITHMETIC-ERROR-OPERANDS
      ARITHMETIC-ERROR-OPERATION ARRAY ARRAY-DIMENSION ARRAY-DIMENSION-LIMIT
      ARRAY-DIMENSIONS ARRAY-DISPLACEMENT ARRAY-ELEMENT-TYPE
      ARRAY-HAS-FILL-POINTER-P ARRAY-IN-BOUNDS-P ARRAY-RANK ARRAY-RANK-LIMIT
      ARRAY-ROW-MAJOR-INDEX ARRAY-TOTAL-SIZE ARRAY-TOTAL-SIZE-LIMIT ARRAYP ASH
      ASIN ASINH ASSERT ASSOC ASSOC-IF ASSOC-IF-NOT ATAN ATANH ATOM BASE-CHAR
      BASE-STRING BIGNUM BIT BIT-AND BIT-ANDC1 BIT-ANDC2 BIT-EQV BIT-IOR
      BIT-NAND BIT-NOR BIT-NOT BIT-ORC1 BIT-ORC2 BIT-VECTOR BIT-VECTOR-P
      BIT-XOR BLOCK BOOLE BOOLE-1 BOOLE-2 BOOLE-AND BOOLE-ANDC1 BOOLE-ANDC2
      BOOLE-C1 BOOLE-C2 BOOLE-CLR BOOLE-EQV BOOLE-IOR BOOLE-NAND BOOLE-NOR
      BOOLE-ORC1 BOOLE-ORC2 BOOLE-SET BOOLE-XOR BOOLEAN BOTH-CASE-P BOUNDP
      BREAK BROADCAST-STREAM BROADCAST-STREAM-STREAMS BUILT-IN-CLASS BUTLAST
      BYTE BYTE-POSITION BYTE-SIZE CAAAAR CAAADR CAAAR CAADAR CAADDR CAADR CAAR
      CADAAR CADADR CADAR CADDAR CADDDR CADDR CADR CALL-ARGUMENTS-LIMIT
      CALL-METHOD CALL-NEXT-METHOD CAR CASE CATCH CCASE CDAAAR CDAADR CDAAR
      CDADAR CDADDR CDADR CDAR CDDAAR CDDADR CDDAR CDDDAR CDDDDR CDDDR CDDR CDR
      CEILING CELL-ERROR CELL-ERROR-NAME CERROR CHANGE-CLASS CHAR CHAR-CODE
      CHAR-CODE-LIMIT CHAR-DOWNCASE CHAR-EQUAL CHAR-GREATERP CHAR-INT
      CHAR-LESSP CHAR-NAME CHAR-NOT-EQUAL CHAR-NOT-GREATERP CHAR-NOT-LESSP
      CHAR-UPCASE CHAR/= CHAR< CHAR<= CHAR= CHAR> CHAR>= CHARACTER CHARACTERP
      CHECK-TYPE CIS CLASS CLASS-NAME CLASS-OF CLEAR-INPUT CLEAR-OUTPUT CLOSE
      CLRHASH CODE-CHAR COERCE COMPILATION-SPEED COMPILE COMPILE-FILE
      COMPILE-FILE-PATHNAME COMPILED-FUNCTION COMPILED-FUNCTION-P
      COMPILER-MACRO COMPILER-MACRO-FUNCTION COMPLEMENT COMPLEX COMPLEXP
      COMPUTE-APPLICABLE-METHODS COMPUTE-RESTARTS CONCATENATE
      CONCATENATED-STREAM CONCATENATED-STREAM-STREAMS COND CONDITION CONJUGATE
      CONS CONSP CONSTANTLY CONSTANTP CONTINUE CONTROL-ERROR COPY-ALIST
      COPY-LIST COPY-PPRINT-DISPATCH COPY-READTABLE COPY-SEQ COPY-STRUCTURE
      COPY-SYMBOL COPY-TREE COS COSH COUNT COUNT-IF COUNT-IF-NOT CTYPECASE
      DEBUG DECF DECLAIM DECLARATION DECLARE DECODE-FLOAT DECODE-UNIVERSAL-TIME
      DEFCLASS DEFCONSTANT DEFGENERIC DEFINE-COMPILER-MACRO DEFINE-CONDITION
      DEFINE-METHOD-COMBINATION DEFINE-MODIFY-MACRO DEFINE-SETF-EXPANDER
      DEFINE-SYMBOL-MACRO DEFMACRO DEFMETHOD DEFPACKAGE DEFPARAMETER DEFSETF
      DEFSTRUCT DEFTYPE DEFUN DEFVAR DELETE DELETE-DUPLICATES DELETE-IF
      DELETE-IF-NOT DELETE-PACKAGE DENOMINATOR DEPOSIT-FIELD DESCRIBE
      DESCRIBE-OBJECT DESTRUCTURING-BIND DIGIT-CHAR DIGIT-CHAR-P
      DIRECTORY-NAMESTRING DISASSEMBLE DIVISION-BY-ZERO DO DO* DO-ALL-SYMBOLS
      DO-EXTERNAL-SYMBOLS DO-SYMBOLS DOCUMENTATION DOLIST DOTIMES DOUBLE-FLOAT
      DOUBLE-FLOAT-EPSILON DOUBLE-FLOAT-NEGATIVE-EPSILON DPB DYNAMIC-EXTENT
      ECASE ECHO-STREAM ECHO-STREAM-INPUT-STREAM ECHO-STREAM-OUTPUT-STREAM
      EIGHTH ELT ENCODE-UNIVERSAL-TIME END-OF-FILE ENDP ENOUGH-NAMESTRING
      ENSURE-GENERIC-FUNCTION EQ EQL EQUAL EQUALP ERROR ETYPECASE EVAL-WHEN
      EVENP EVERY EXP EXPORT EXPT EXTENDED-CHAR FBOUNDP FCEILING FDEFINITION
      FFLOOR FIFTH FILE-AUTHOR FILE-ERROR FILE-ERROR-PATHNAME FILE-LENGTH
      FILE-NAMESTRING FILE-POSITION FILE-STREAM FILE-STRING-LENGTH
      FILE-WRITE-DATE FILL FILL-POINTER FIND FIND-CLASS FIND-IF FIND-IF-NOT
      FIND-METHOD FIND-PACKAGE FIND-RESTART FINISH-OUTPUT FIRST FIXNUM FLET
      FLOAT FLOAT-DIGITS FLOAT-PRECISION FLOAT-RADIX FLOAT-SIGN
      FLOATING-POINT-INEXACT FLOATING-POINT-INVALID-OPERATION
      FLOATING-POINT-OVERFLOW FLOATING-POINT-UNDERFLOW FLOATP FLOOR FMAKUNBOUND
      FORCE-OUTPUT FORMAT FORMATTER FOURTH FRESH-LINE FROUND FTRUNCATE FTYPE
      FUNCALL FUNCTION FUNCTION-KEYWORDS FUNCTION-LAMBDA-EXPRESSION FUNCTIONP
      GCD GENERIC-FUNCTION GENSYM GENTEMP GET GET-DECODED-TIME
      GET-DISPATCH-MACRO-CHARACTER GET-INTERNAL-REAL-TIME GET-INTERNAL-RUN-TIME
      GET-MACRO-CHARACTER GET-OUTPUT-STREAM-STRING GET-PROPERTIES
      GET-SETF-EXPANSION GET-UNIVERSAL-TIME GETF GETHASH GO GRAPHIC-CHAR-P
      HANDLER-BIND HANDLER-CASE HASH-TABLE HASH-TABLE-COUNT HASH-TABLE-P
      HASH-TABLE-REHASH-SIZE HASH-TABLE-REHASH-THRESHOLD HASH-TABLE-SIZE
      HASH-TABLE-TEST HOST-NAMESTRING IDENTITY IF IGNORABLE IGNORE
      IGNORE-ERRORS IMAGPART IMPORT INCF INITIALIZE-INSTANCE INLINE
      INPUT-STREAM-P INTEGER INTEGER-DECODE-FLOAT INTEGER-LENGTH INTEGERP
      INTERACTIVE-STREAM-P INTERNAL-TIME-UNITS-PER-SECOND INTERSECTION
      INVALID-METHOD-ERROR INVOKE-DEBUGGER INVOKE-RESTART
      INVOKE-RESTART-INTERACTIVELY ISQRT KEYWORD KEYWORDP LABELS LAMBDA
      LAMBDA-LIST-KEYWORDS LAMBDA-PARAMETERS-LIMIT LAST LCM LDB LDB-TEST LDIFF
      LEAST-NEGATIVE-DOUBLE-FLOAT LEAST-NEGATIVE-LONG-FLOAT
      LEAST-NEGATIVE-NORMALIZED-DOUBLE-FLOAT
      LEAST-NEGATIVE-NORMALIZED-LONG-FLOAT
      LEAST-NEGATIVE-NORMALIZED-SHORT-FLOAT
      LEAST-NEGATIVE-NORMALIZED-SINGLE-FLOAT LEAST-NEGATIVE-SHORT-FLOAT
      LEAST-NEGATIVE-SINGLE-FLOAT LEAST-POSITIVE-DOUBLE-FLOAT
      LEAST-POSITIVE-LONG-FLOAT LEAST-POSITIVE-NORMALIZED-DOUBLE-FLOAT
      LEAST-POSITIVE-NORMALIZED-LONG-FLOAT
      LEAST-POSITIVE-NORMALIZED-SHORT-FLOAT
      LEAST-POSITIVE-NORMALIZED-SINGLE-FLOAT LEAST-POSITIVE-SHORT-FLOAT
      LEAST-POSITIVE-SINGLE-FLOAT LENGTH LET LET* LISP-IMPLEMENTATION-TYPE
      LISP-IMPLEMENTATION-VERSION LIST LIST* LIST-ALL-PACKAGES LIST-LENGTH
      LISTEN LISTP LOAD-LOGICAL-PATHNAME-TRANSLATIONS LOAD-TIME-VALUE LOCALLY
      LOG LOGAND LOGANDC1 LOGANDC2 LOGBITP LOGCOUNT LOGEQV LOGICAL-PATHNAME
      LOGICAL-PATHNAME-TRANSLATIONS LOGIOR LOGNAND LOGNOR LOGNOT LOGORC1
      LOGORC2 LOGTEST LOGXOR LONG-FLOAT LONG-FLOAT-EPSILON
      LONG-FLOAT-NEGATIVE-EPSILON LONG-SITE-NAME LOOP LOOP-FINISH LOWER-CASE-P
      MACHINE-INSTANCE MACHINE-TYPE MACHINE-VERSION MACRO-FUNCTION MACROEXPAND
      MACROEXPAND-1 MACROLET MAKE-ARRAY MAKE-BROADCAST-STREAM
      MAKE-CONCATENATED-STREAM MAKE-CONDITION MAKE-DISPATCH-MACRO-CHARACTER
      MAKE-ECHO-STREAM MAKE-HASH-TABLE MAKE-INSTANCE MAKE-INSTANCES-OBSOLETE
      MAKE-LIST MAKE-LOAD-FORM MAKE-LOAD-FORM-SAVING-SLOTS MAKE-METHOD
      MAKE-RANDOM-STATE MAKE-SEQUENCE MAKE-STRING MAKE-STRING-INPUT-STREAM
      MAKE-STRING-OUTPUT-STREAM MAKE-SYMBOL MAKE-SYNONYM-STREAM
      MAKE-TWO-WAY-STREAM MAKUNBOUND MAP MAP-INTO MAPC MAPCAN MAPCAR MAPCON
      MAPHASH MAPL MAPLIST MASK-FIELD MAX MEMBER MEMBER-IF MEMBER-IF-NOT MERGE
      METHOD METHOD-COMBINATION METHOD-COMBINATION-ERROR METHOD-QUALIFIERS MIN
      MINUSP MISMATCH MOD MOST-NEGATIVE-DOUBLE-FLOAT MOST-NEGATIVE-FIXNUM
      MOST-NEGATIVE-LONG-FLOAT MOST-NEGATIVE-SHORT-FLOAT
      MOST-NEGATIVE-SINGLE-FLOAT MOST-POSITIVE-DOUBLE-FLOAT
      MOST-POSITIVE-FIXNUM MOST-POSITIVE-LONG-FLOAT MOST-POSITIVE-SHORT-FLOAT
      MOST-POSITIVE-SINGLE-FLOAT MUFFLE-WARNING MULTIPLE-VALUE-BIND
      MULTIPLE-VALUE-CALL MULTIPLE-VALUE-LIST MULTIPLE-VALUE-PROG1
      MULTIPLE-VALUE-SETQ MULTIPLE-VALUES-LIMIT NAME-CHAR NBUTLAST NCONC
      NEXT-METHOD-P NIL NINTERSECTION NINTH NO-APPLICABLE-METHOD NO-NEXT-METHOD
      NOT NOTANY NOTEVERY NOTINLINE NRECONC NREVERSE NSET-DIFFERENCE
      NSET-EXCLUSIVE-OR NSTRING-CAPITALIZE NSTRING-DOWNCASE NSTRING-UPCASE
      NSUBLIS NSUBST NSUBST-IF NSUBST-IF-NOT NSUBSTITUTE NSUBSTITUTE-IF
      NSUBSTITUTE-IF-NOT NTH NTH-VALUE NTHCDR NULL NUMBER NUMBERP NUMERATOR
      NUNION ODDP OPEN-STREAM-P OPTIMIZE OR OTHERWISE OUTPUT-STREAM-P PACKAGE
      PACKAGE-ERROR PACKAGE-ERROR-PACKAGE PACKAGE-NAME PACKAGE-NICKNAMES
      PACKAGE-SHADOWING-SYMBOLS PACKAGE-USE-LIST PACKAGE-USED-BY-LIST PACKAGEP
      PAIRLIS PARSE-ERROR PARSE-INTEGER PARSE-NAMESTRING PATHNAME
      PATHNAME-DEVICE PATHNAME-DIRECTORY PATHNAME-HOST PATHNAME-MATCH-P
      PATHNAME-NAME PATHNAME-TYPE PATHNAME-VERSION PATHNAMEP PEEK-CHAR PHASE PI
      PLUSP POP POSITION POSITION-IF POSITION-IF-NOT PPRINT PPRINT-DISPATCH
      PPRINT-EXIT-IF-LIST-EXHAUSTED PPRINT-FILL PPRINT-INDENT PPRINT-LINEAR
      PPRINT-LOGICAL-BLOCK PPRINT-NEWLINE PPRINT-POP PPRINT-TAB PPRINT-TABULAR
      PRIN1 PRIN1-TO-STRING PRINC PRINC-TO-STRING PRINT PRINT-NOT-READABLE
      PRINT-NOT-READABLE-OBJECT PRINT-OBJECT PRINT-UNREADABLE-OBJECT PROCLAIM
      PROG PROG* PROG1 PROG2 PROGN PROGRAM-ERROR PROGV PROVIDE PSETF PSETQ PUSH
      PUSHNEW QUOTE RANDOM RANDOM-STATE RANDOM-STATE-P RASSOC RASSOC-IF
      RASSOC-IF-NOT RATIO RATIONAL RATIONALIZE RATIONALP READ READ-BYTE
      READ-CHAR READ-CHAR-NO-HANG READ-DELIMITED-LIST READ-FROM-STRING
      READ-LINE READ-PRESERVING-WHITESPACE READ-SEQUENCE READER-ERROR READTABLE
      READTABLE-CASE READTABLEP REAL REALP REALPART REDUCE
      REINITIALIZE-INSTANCE REM REMF REMHASH REMOVE REMOVE-DUPLICATES REMOVE-IF
      REMOVE-IF-NOT REMOVE-METHOD REMPROP RENAME-FILE RENAME-PACKAGE REPLACE
      REQUIRE REST RESTART RESTART-BIND RESTART-CASE RESTART-NAME RETURN
      RETURN-FROM REVAPPEND REVERSE ROOM ROTATEF ROUND ROW-MAJOR-AREF RPLACA
      RPLACD SAFETY SATISFIES SBIT SCALE-FLOAT SCHAR SEARCH SECOND SEQUENCE
      SERIOUS-CONDITION SET SET-DIFFERENCE SET-DISPATCH-MACRO-CHARACTER
      SET-EXCLUSIVE-OR SET-MACRO-CHARACTER SET-PPRINT-DISPATCH
      SET-SYNTAX-FROM-CHAR SETF SETQ SEVENTH SHADOW SHADOWING-IMPORT
      SHARED-INITIALIZE SHIFTF SHORT-FLOAT SHORT-FLOAT-EPSILON
      SHORT-FLOAT-NEGATIVE-EPSILON SHORT-SITE-NAME SIGNAL SIGNED-BYTE SIGNUM
      SIMPLE-ARRAY SIMPLE-BASE-STRING SIMPLE-BIT-VECTOR SIMPLE-BIT-VECTOR-P
      SIMPLE-CONDITION SIMPLE-CONDITION-FORMAT-ARGUMENTS
      SIMPLE-CONDITION-FORMAT-CONTROL SIMPLE-ERROR SIMPLE-STRING
      SIMPLE-STRING-P SIMPLE-TYPE-ERROR SIMPLE-VECTOR SIMPLE-VECTOR-P
      SIMPLE-WARNING SIN SINGLE-FLOAT SINGLE-FLOAT-EPSILON
      SINGLE-FLOAT-NEGATIVE-EPSILON SINH SIXTH SLEEP SLOT-BOUNDP SLOT-EXISTS-P
      SLOT-MAKUNBOUND SLOT-MISSING SLOT-UNBOUND SLOT-VALUE SOFTWARE-TYPE
      SOFTWARE-VERSION SOME SORT SPACE SPECIAL SPECIAL-OPERATOR-P SPEED SQRT
      STABLE-SORT STANDARD STANDARD-CHAR STANDARD-CHAR-P STANDARD-CLASS
      STANDARD-GENERIC-FUNCTION STANDARD-METHOD STANDARD-OBJECT STEP
      STORAGE-CONDITION STORE-VALUE STREAM STREAM-ELEMENT-TYPE STREAM-ERROR
      STREAM-ERROR-STREAM STREAM-EXTERNAL-FORMAT STREAMP STRING
      STRING-CAPITALIZE STRING-DOWNCASE STRING-EQUAL STRING-GREATERP
      STRING-LEFT-TRIM STRING-LESSP STRING-NOT-EQUAL STRING-NOT-GREATERP
      STRING-NOT-LESSP STRING-RIGHT-TRIM STRING-STREAM STRING-TRIM
      STRING-UPCASE STRING/= STRING< STRING<= STRING= STRING> STRING>= STRINGP
      STRUCTURE STRUCTURE-CLASS STRUCTURE-OBJECT STYLE-WARNING SUBLIS SUBSEQ
      SUBSETP SUBST SUBST-IF SUBST-IF-NOT SUBSTITUTE SUBSTITUTE-IF
      SUBSTITUTE-IF-NOT SUBTYPEP SVREF SXHASH SYMBOL SYMBOL-FUNCTION
      SYMBOL-MACROLET SYMBOL-NAME SYMBOL-PACKAGE SYMBOL-PLIST SYMBOL-VALUE
      SYMBOLP SYNONYM-STREAM SYNONYM-STREAM-SYMBOL T TAGBODY TAILP TAN TANH
      TENTH TERPRI THE THIRD THROW TIME TRACE TRANSLATE-LOGICAL-PATHNAME
      TRANSLATE-PATHNAME TREE-EQUAL TRUENAME TRUNCATE TWO-WAY-STREAM
      TWO-WAY-STREAM-INPUT-STREAM TWO-WAY-STREAM-OUTPUT-STREAM TYPE TYPE-ERROR
      TYPE-ERROR-DATUM TYPE-ERROR-EXPECTED-TYPE TYPE-OF TYPECASE TYPEP
      UNBOUND-SLOT UNBOUND-SLOT-INSTANCE UNBOUND-VARIABLE UNDEFINED-FUNCTION
      UNEXPORT UNINTERN UNION UNLESS UNREAD-CHAR UNSIGNED-BYTE UNTRACE
      UNUSE-PACKAGE UNWIND-PROTECT UPDATE-INSTANCE-FOR-DIFFERENT-CLASS
      UPDATE-INSTANCE-FOR-REDEFINED-CLASS UPGRADED-ARRAY-ELEMENT-TYPE
      UPGRADED-COMPLEX-PART-TYPE UPPER-CASE-P USE-PACKAGE USE-VALUE
      USER-HOMEDIR-PATHNAME VALUES VALUES-LIST VARIABLE VECTOR VECTOR-POP
      VECTOR-PUSH VECTOR-PUSH-EXTEND VECTORP WARN WARNING WHEN WILD-PATHNAME-P
      WITH-ACCESSORS WITH-COMPILATION-UNIT WITH-CONDITION-RESTARTS
      WITH-HASH-TABLE-ITERATOR WITH-INPUT-FROM-STRING WITH-OUTPUT-TO-STRING
      WITH-SIMPLE-RESTART WITH-SLOTS WITH-STANDARD-IO-SYNTAX WRITE WRITE-BYTE
      WRITE-CHAR WRITE-LINE WRITE-SEQUENCE WRITE-STRING WRITE-TO-STRING
      Y-OR-N-P YES-OR-NO-P ZEROP))

[informatimago/tools/asdf.lisp:976]
  (EVAL-WHEN (:LOAD-TOPLEVEL :COMPILE-TOPLEVEL :EXECUTE)
    (DEFUN FROB-SUBSTRINGS (STRING SUBSTRINGS &OPTIONAL FROB)
      "for each substring in SUBSTRINGS, find occurrences of it within STRING
that don't use parts of matched occurrences of previous strings, and
FROB them, that is to say, remove them if FROB is NIL,
replace by FROB if FROB is a STRING, or if FROB is a FUNCTION,
call FROB with the match and a function that emits a string in the output.
Return a string made of the parts not omitted or emitted by FROB."
      (DECLARE (OPTIMIZE (SPEED 0) (SAFETY 0) (DEBUG 3)))
      (LET ((LENGTH (LENGTH STRING)) (STREAM NIL))
        (LABELS ((EMIT-STRING (X &OPTIONAL (START 0) (END (LENGTH X)))
                   (WHEN (< START END)
                     (UNLESS STREAM (SETF STREAM (MAKE-STRING-OUTPUT-STREAM)))
                     (WRITE-STRING X STREAM :START START :END END)))
                 (EMIT-SUBSTRING (START END)
                   (WHEN (AND (ZEROP START) (= END LENGTH))
                     (RETURN-FROM FROB-SUBSTRINGS STRING))
                   (EMIT-STRING STRING START END))
                 (RECURSE (SUBSTRINGS START END)
                   (COND ((>= START END))
                         ((NULL SUBSTRINGS) (EMIT-SUBSTRING START END))
                         (T
                          (LET* ((SUB-SPEC (FIRST SUBSTRINGS))
                                 (SUB
                                  (IF (CONSP SUB-SPEC)
                                      (CAR SUB-SPEC)
                                      SUB-SPEC))
                                 (FUN
                                  (IF (CONSP SUB-SPEC)
                                      (CDR SUB-SPEC)
                                      FROB))
                                 (FOUND
                                  (SEARCH SUB STRING :START2 START :END2 END))
                                 (MORE (REST SUBSTRINGS)))
                            (COND
                             (FOUND (RECURSE MORE START FOUND)
                              (ETYPECASE FUN
                                (NULL)
                                (STRING (EMIT-STRING FUN))
                                (FUNCTION (FUNCALL FUN SUB #'EMIT-STRING)))
                              (RECURSE SUBSTRINGS (+ FOUND (LENGTH SUB)) END))
                             (T (RECURSE MORE START END))))))))
          (RECURSE SUBSTRINGS 0 LENGTH))
        (IF STREAM
            (GET-OUTPUT-STREAM-STRING STREAM)
            "")))
    (DEFMACRO COMPATFMT (FORMAT)
      (FROB-SUBSTRINGS FORMAT
       (ECLECTOR.READER:QUASIQUOTE
        ("~3i~_"
         (ECLECTOR.READER:UNQUOTE-SPLICING '("~@<" "~@;" "~@:>" "~:>")))))))

[informatimago/tools/asdf.lisp:4967]
  (WITH-UPGRADABILITY NIL
   (DEFVAR *OPTIMIZATION-SETTINGS*
     NIL
     "Optimization settings to be used by PROCLAIM-OPTIMIZATION-SETTINGS")
   (DEFVAR *PREVIOUS-OPTIMIZATION-SETTINGS*
     NIL
     "Optimization settings saved by PROCLAIM-OPTIMIZATION-SETTINGS")
   (DEFPARAMETER +OPTIMIZATION-VARIABLES+
     (OR
      '(#S(FORMGREP:SYMREF :NAME "*SPEED*" :QUALIFIER "SYSTEM")
        #S(FORMGREP:SYMREF :NAME "*SPACE*" :QUALIFIER "SYSTEM")
        #S(FORMGREP:SYMREF :NAME "*SAFETY*" :QUALIFIER "SYSTEM")
        #S(FORMGREP:SYMREF :NAME "*DEBUG*" :QUALIFIER "SYSTEM"))
      'NIL
      '(#S(FORMGREP:SYMREF :NAME "*NX-SPEED*" :QUALIFIER "CCL")
        #S(FORMGREP:SYMREF :NAME "*NX-SPACE*" :QUALIFIER "CCL")
        #S(FORMGREP:SYMREF :NAME "*NX-SAFETY*" :QUALIFIER "CCL")
        #S(FORMGREP:SYMREF :NAME "*NX-DEBUG*" :QUALIFIER "CCL")
        #S(FORMGREP:SYMREF :NAME "*NX-CSPEED*" :QUALIFIER "CCL"))
      '(#S(FORMGREP:SYMREF :NAME "*DEFAULT-COOKIE*" :QUALIFIER "C")) NIL
      (UNLESS (USE-ECL-BYTE-COMPILER-P)
        '(#S(FORMGREP:SYMREF :NAME "*SPEED*" :QUALIFIER "C")
          #S(FORMGREP:SYMREF :NAME "*SPACE*" :QUALIFIER "C")
          #S(FORMGREP:SYMREF :NAME "*SAFETY*" :QUALIFIER "C")
          #S(FORMGREP:SYMREF :NAME "*DEBUG*" :QUALIFIER "C")))
      '(#S(FORMGREP:SYMREF :NAME "*SPEED*" :QUALIFIER "COMPILER")
        #S(FORMGREP:SYMREF :NAME "*SPACE*" :QUALIFIER "COMPILER")
        #S(FORMGREP:SYMREF :NAME "*COMPILER-NEW-SAFETY*" :QUALIFIER "COMPILER")
        #S(FORMGREP:SYMREF :NAME "*DEBUG*" :QUALIFIER "COMPILER"))
      '(#S(FORMGREP:SYMREF :NAME "*OPTIMIZATION-LEVEL*" :QUALIFIER "COMPILER"))
      '(#S(FORMGREP:SYMREF :NAME "*SPEED*" :QUALIFIER "SI")
        #S(FORMGREP:SYMREF :NAME "*SPACE*" :QUALIFIER "SI")
        #S(FORMGREP:SYMREF :NAME "*SAFETY*" :QUALIFIER "SI")
        #S(FORMGREP:SYMREF :NAME "*DEBUG*" :QUALIFIER "SI"))
      '(SB-C::*POLICY*)))
   (DEFUN GET-OPTIMIZATION-SETTINGS ()
     "Get current compiler optimization settings, ready to PROCLAIM again"
     (#S(FORMGREP:SYMREF :NAME "OPTIMIZE" :QUALIFIER "CLEAVIR-ENV")
      (#S(FORMGREP:SYMREF :NAME "OPTIMIZE-INFO" :QUALIFIER "CLEAVIR-ENV")
       #S(FORMGREP:SYMREF :NAME "*CLASP-ENV*" :QUALIFIER "CLASP-CLEAVIR")))
     (LET ((SETTINGS
            '(SPEED SPACE SAFETY DEBUG COMPILATION-SPEED
              #S(FORMGREP:SYMREF :NAME "BREVITY" :QUALIFIER "C"))))
       NIL))
   (DEFUN PROCLAIM-OPTIMIZATION-SETTINGS ()
     "Proclaim the optimization settings in *OPTIMIZATION-SETTINGS*"
     (PROCLAIM
      (ECLECTOR.READER:QUASIQUOTE
       (OPTIMIZE (ECLECTOR.READER:UNQUOTE-SPLICING *OPTIMIZATION-SETTINGS*))))
     (LET ((SETTINGS (GET-OPTIMIZATION-SETTINGS)))
       (UNLESS (EQUAL *PREVIOUS-OPTIMIZATION-SETTINGS* SETTINGS)
         (SETF *PREVIOUS-OPTIMIZATION-SETTINGS* SETTINGS))))
   (DEFMACRO WITH-OPTIMIZATION-SETTINGS
             ((&OPTIONAL (SETTINGS *OPTIMIZATION-SETTINGS*)) &BODY BODY)
     (LET ((PREVIOUS-SETTINGS (GENSYM "PREVIOUS-SETTINGS"))
           (RESET-SETTINGS (GENSYM "RESET-SETTINGS")))
       (ECLECTOR.READER:QUASIQUOTE
        (LET* (((ECLECTOR.READER:UNQUOTE PREVIOUS-SETTINGS)
                (GET-OPTIMIZATION-SETTINGS))
               ((ECLECTOR.READER:UNQUOTE RESET-SETTINGS)
                (REVERSE (ECLECTOR.READER:UNQUOTE PREVIOUS-SETTINGS))))
          (ECLECTOR.READER:UNQUOTE-SPLICING
           (WHEN SETTINGS
             (ECLECTOR.READER:QUASIQUOTE
              ((PROCLAIM
                (ECLECTOR.READER:QUASIQUOTE
                 (OPTIMIZE
                  (ECLECTOR.READER:UNQUOTE-SPLICING
                   (ECLECTOR.READER:UNQUOTE SETTINGS)))))))))
          (UNWIND-PROTECT (PROGN (ECLECTOR.READER:UNQUOTE-SPLICING BODY))
            (PROCLAIM
             (ECLECTOR.READER:QUASIQUOTE
              (OPTIMIZE
               (ECLECTOR.READER:UNQUOTE-SPLICING
                (ECLECTOR.READER:UNQUOTE RESET-SETTINGS)))))))))))

[introspect-environment/default.lisp:36]
  (DEFUN POLICY-QUALITY (QUALITY &OPTIONAL ENV)
    "This implementation is not supported; this function doesn't know how to query an environment for optimize declaration information, and so returns 1 for all qualities for all environments."
    (DECLARE (IGNORE ENV))
    (UNLESS (MEMBER QUALITY '(SPEED SAFETY SPACE DEBUG COMPILATION-SPEED))
      (ERROR "Unknown policy quality ~s" QUALITY))
    1)

[introspect-environment/default.lisp:44]
  (DEFMACRO POLICY (EXPR &OPTIONAL ENV)
    "This implementation is not supported; this macro treats all optimization qualities as being 1 at all times."
    (DECLARE (IGNORE ENV))
    (ECLECTOR.READER:QUASIQUOTE
     (SYMBOL-MACROLET ((SPEED 1)
                       (SAFETY 1)
                       (SPACE 1)
                       (DEBUG 1)
                       (COMPILATION-SPEED 1))
       (ECLECTOR.READER:UNQUOTE EXPR))))

[iolib/src/syscalls/ffi-functions-unix.lisp:8]
  (EVAL-WHEN (:COMPILE-TOPLEVEL)
    (DECLAIM (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))))

[iolib/src/syscalls/unix-syscall-path-strings.lisp:21]
  (DEFUN SSTRING-TO-CSTRING (SSTRING C-PTR)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (LET ((INDEX 0))
      (FLET ((OUTPUT-OCTET (OCTET)
               (SETF (CFFI:MEM-AREF C-PTR :UNSIGNED-CHAR INDEX) OCTET)
               (INCF INDEX)))
        (DECLARE (INLINE OUTPUT-OCTET))
        (LOOP :WITH LEN := (LENGTH SSTRING)
              :WITH END-OFFSET := (1- LEN)
              :FOR I :BELOW LEN
              :FOR CODE := (CHAR-CODE (CHAR SSTRING I))
              :DO (COND
                   ((ZEROP CODE)
                    (IF (= I END-OFFSET)
                        (OUTPUT-OCTET 0)
                        (OUTPUT-OCTET (CHAR-CODE (CHAR SSTRING (INCF I))))))
                   ((< CODE 128) (OUTPUT-OCTET CODE))
                   ((< CODE 2048)
                    (OUTPUT-OCTET (LOGIOR 192 (LDB (BYTE 5 6) CODE)))
                    (OUTPUT-OCTET (LOGIOR 128 (LDB (BYTE 6 0) CODE))))
                   ((< CODE 65536)
                    (OUTPUT-OCTET (LOGIOR 224 (LDB (BYTE 4 12) CODE)))
                    (OUTPUT-OCTET (LOGIOR 128 (LDB (BYTE 6 6) CODE)))
                    (OUTPUT-OCTET (LOGIOR 128 (LDB (BYTE 6 0) CODE))))
                   ((< CODE 1114112)
                    (OUTPUT-OCTET (LOGIOR 240 (LDB (BYTE 3 18) CODE)))
                    (OUTPUT-OCTET (LOGIOR 128 (LDB (BYTE 6 12) CODE)))
                    (OUTPUT-OCTET (LOGIOR 128 (LDB (BYTE 6 6) CODE)))
                    (OUTPUT-OCTET (LOGIOR 128 (LDB (BYTE 6 0) CODE)))))
              :FINALLY (OUTPUT-OCTET 0))
        (VALUES C-PTR INDEX))))

[iolib/src/syscalls/unix-syscall-path-strings.lisp:55]
  (DEFUN COUNT-SSTRING-OCTETS (SSTRING)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (LOOP :WITH LEN := (LENGTH SSTRING)
          :WITH END-OFFSET := (1- LEN)
          :FOR I :BELOW LEN
          :FOR CODE := (CHAR-CODE (CHAR SSTRING I))
          :SUM (COND ((ZEROP CODE) (WHEN (< I END-OFFSET) (INCF I)) 1)
                     ((< CODE 128) 1) ((< CODE 2048) 2) ((< CODE 65536) 3)
                     ((< CODE 1114112) 4))))

[iolib/src/syscalls/unix-syscall-path-strings.lisp:88]
  (DEFUN UTF8-EXTRA-BYTES (CODE)
    (DECLARE (TYPE (UNSIGNED-BYTE 8) CODE)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (DECLARE (IGNORABLE CODE))
    0)

[iolib/src/syscalls/unix-syscall-path-strings.lisp:120]
  (DEFUN OFFSETS-FROM-UTF8 (EXTRA-BYTES)
    (DECLARE (TYPE (MOD 4) EXTRA-BYTES)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (LET ((VEC
           (LOAD-TIME-VALUE
            (COERCE #(0 12416 925824 63447168)
                    '(SIMPLE-ARRAY (UNSIGNED-BYTE 26) (4))))))
      (AREF (THE (SIMPLE-ARRAY (UNSIGNED-BYTE 26) (4)) VEC) EXTRA-BYTES)))

[iolib/src/syscalls/unix-syscall-path-strings.lisp:129]
  (DEFUN LEGAL-UTF8-CSTRING (PTR START LEN)
    (DECLARE (TYPE CSTR-OFFSET START LEN)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (LET ((END (+ START LEN)) (SRCHR (MEM-AREF PTR :UNSIGNED-CHAR START)) C)
      (WHEN (>= SRCHR 244) (RETURN* NIL))
      (FLET ((GETCH ()
               (MEM-AREF PTR :UNSIGNED-CHAR
                (DECF (THE (UNSIGNED-BYTE 17) END)))))
        (DECLARE (INLINE GETCH))
        (WHEN (= LEN 4) (SETF C (GETCH)) (UNLESS (<= 128 C 191) (RETURN* NIL)))
        (WHEN (>= LEN 3)
          (SETF C (GETCH))
          (UNLESS (<= 128 C 191) (RETURN* NIL)))
        (WHEN (>= LEN 2)
          (SETF C (GETCH))
          (UNLESS (<= 0 C 191) (RETURN* NIL))
          (CASE SRCHR
            (224 (WHEN (< C 160) (RETURN* NIL)))
            (237 (WHEN (> C 159) (RETURN* NIL)))
            (240 (WHEN (< C 144) (RETURN* NIL)))
            (T (WHEN (< C 128) (RETURN* NIL)))))
        (WHEN (>= LEN 1) (WHEN (<= 128 SRCHR 193) (RETURN* NIL)))
        (WHEN (> SRCHR 244) (RETURN* NIL))
        T)))

[iolib/src/syscalls/unix-syscall-path-strings.lisp:154]
  (DEFUN CSTRING-TO-SSTRING (C-PTR &OPTIONAL (C-LEN (1+ +CSTRING-PATH-MAX+)))
    (DECLARE (TYPE CSTR-OFFSET C-LEN)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (LET ((INDEX 0) (SINDEX 0) (SSTRING (MAKE-STRING (* 2 C-LEN))))
      (DECLARE (TYPE CSTR-OFFSET INDEX SINDEX))
      (FLET ((INPUT-CHAR ()
               (PROG1 (MEM-AREF C-PTR :UNSIGNED-CHAR INDEX) (INCF INDEX)))
             (OUTPUT-CHAR (CHAR)
               (SETF (CHAR SSTRING SINDEX) CHAR)
               (INCF SINDEX))
             (OUTPUT-CODE (CODE)
               (SETF (CHAR SSTRING SINDEX) (CODE-CHAR CODE))
               (INCF SINDEX)))
        (DECLARE (INLINE INPUT-CHAR OUTPUT-CHAR OUTPUT-CODE))
        (LOOP :FOR BYTE0 := (MEM-AREF C-PTR :UNSIGNED-CHAR INDEX)
              :UNTIL (OR (>= INDEX C-LEN) (ZEROP BYTE0))
              :DO (BLOCK DECODE-ONE-CHAR
                    (LET* ((CODE 0)
                           (EXTRA-BYTES (MIN (UTF8-EXTRA-BYTES BYTE0)))
                           (LEGALP
                            (AND
                             (LEGAL-UTF8-CSTRING C-PTR INDEX (1+ EXTRA-BYTES))
                             (< EXTRA-BYTES (- C-LEN INDEX)))))
                      (DECLARE (TYPE (MOD 4) EXTRA-BYTES)
                               (TYPE (UNSIGNED-BYTE 27) CODE))
                      (LABELS ((FINISH-SEQ (EXTRA-BYTES)
                                 (COND
                                  (LEGALP
                                   (DECF CODE
                                         (THE (UNSIGNED-BYTE 26)
                                              (OFFSETS-FROM-UTF8 EXTRA-BYTES)))
                                   (OUTPUT-CODE CODE))
                                  (T (OUTPUT-CHAR #\?) (OUTPUT-CODE CODE))))
                               (LEGALCHK ()
                                 (UNLESS LEGALP
                                   (FINISH-SEQ 0)
                                   (RETURN-FROM DECODE-ONE-CHAR))))
                        (WHEN (>= EXTRA-BYTES 3)
                          (SETF CODE (ASH (+ CODE (INPUT-CHAR)) 6))
                          (LEGALCHK))
                        (WHEN (>= EXTRA-BYTES 2)
                          (SETF CODE (ASH (+ CODE (INPUT-CHAR)) 6))
                          (LEGALCHK))
                        (WHEN (>= EXTRA-BYTES 1)
                          (SETF CODE (ASH (+ CODE (INPUT-CHAR)) 6))
                          (LEGALCHK))
                        (WHEN (>= EXTRA-BYTES 0)
                          (SETF CODE (ASH (+ CODE (INPUT-CHAR)) 0))
                          (LEGALCHK))
                        (FINISH-SEQ EXTRA-BYTES))))))
      (SHRINK-VECTOR SSTRING SINDEX)))

[ironclad/src/ciphers/aria.lisp:397]
  (DEFUN ARIA-PROCESS-BLOCK (IN IN-START OUT OUT-START KEYS ROUNDS)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) IN OUT)
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 32) (68)) KEYS)
             (TYPE FIXNUM IN-START OUT-START ROUNDS)
             (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (DEBUG 0)))
    (LET ((X0 (UB32REF/BE IN IN-START))
          (X1 (UB32REF/BE IN (+ IN-START 4)))
          (X2 (UB32REF/BE IN (+ IN-START 8)))
          (X3 (UB32REF/BE IN (+ IN-START 12))))
      (DECLARE (TYPE (UNSIGNED-BYTE 32) X0 X1 X2 X3))
      (ARIA-KXL X0 X1 X2 X3 KEYS 0)
      (ARIA-FO X0 X1 X2 X3)
      (ARIA-KXL X0 X1 X2 X3 KEYS 1)
      (ARIA-FE X0 X1 X2 X3)
      (ARIA-KXL X0 X1 X2 X3 KEYS 2)
      (ARIA-FO X0 X1 X2 X3)
      (ARIA-KXL X0 X1 X2 X3 KEYS 3)
      (ARIA-FE X0 X1 X2 X3)
      (ARIA-KXL X0 X1 X2 X3 KEYS 4)
      (ARIA-FO X0 X1 X2 X3)
      (ARIA-KXL X0 X1 X2 X3 KEYS 5)
      (ARIA-FE X0 X1 X2 X3)
      (ARIA-KXL X0 X1 X2 X3 KEYS 6)
      (ARIA-FO X0 X1 X2 X3)
      (ARIA-KXL X0 X1 X2 X3 KEYS 7)
      (ARIA-FE X0 X1 X2 X3)
      (ARIA-KXL X0 X1 X2 X3 KEYS 8)
      (ARIA-FO X0 X1 X2 X3)
      (ARIA-KXL X0 X1 X2 X3 KEYS 9)
      (ARIA-FE X0 X1 X2 X3)
      (ARIA-KXL X0 X1 X2 X3 KEYS 10)
      (ARIA-FO X0 X1 X2 X3)
      (ARIA-KXL X0 X1 X2 X3 KEYS 11)
      (WHEN (> ROUNDS 12)
        (ARIA-FE X0 X1 X2 X3)
        (ARIA-KXL X0 X1 X2 X3 KEYS 12)
        (ARIA-FO X0 X1 X2 X3)
        (ARIA-KXL X0 X1 X2 X3 KEYS 13))
      (WHEN (> ROUNDS 14)
        (ARIA-FE X0 X1 X2 X3)
        (ARIA-KXL X0 X1 X2 X3 KEYS 14)
        (ARIA-FO X0 X1 X2 X3)
        (ARIA-KXL X0 X1 X2 X3 KEYS 15))
      (SETF X0
              (LOGXOR (MOD32ASH (AREF +ARIA-X1+ (ARIA-BRF X0 3)) 24)
                      (LOGAND (MOD32ASH (AREF +ARIA-X2+ (ARIA-BRF X0 2)) 8)
                              16711680)
                      (LOGAND (MOD32ASH (AREF +ARIA-S1+ (ARIA-BRF X0 1)) 8)
                              65280)
                      (LOGAND (AREF +ARIA-S2+ (ARIA-BRF X0 0)) 255))
            X1
              (LOGXOR (MOD32ASH (AREF +ARIA-X1+ (ARIA-BRF X1 3)) 24)
                      (LOGAND (MOD32ASH (AREF +ARIA-X2+ (ARIA-BRF X1 2)) 8)
                              16711680)
                      (LOGAND (MOD32ASH (AREF +ARIA-S1+ (ARIA-BRF X1 1)) 8)
                              65280)
                      (LOGAND (AREF +ARIA-S2+ (ARIA-BRF X1 0)) 255))
            X2
              (LOGXOR (MOD32ASH (AREF +ARIA-X1+ (ARIA-BRF X2 3)) 24)
                      (LOGAND (MOD32ASH (AREF +ARIA-X2+ (ARIA-BRF X2 2)) 8)
                              16711680)
                      (LOGAND (MOD32ASH (AREF +ARIA-S1+ (ARIA-BRF X2 1)) 8)
                              65280)
                      (LOGAND (AREF +ARIA-S2+ (ARIA-BRF X2 0)) 255))
            X3
              (LOGXOR (MOD32ASH (AREF +ARIA-X1+ (ARIA-BRF X3 3)) 24)
                      (LOGAND (MOD32ASH (AREF +ARIA-X2+ (ARIA-BRF X3 2)) 8)
                              16711680)
                      (LOGAND (MOD32ASH (AREF +ARIA-S1+ (ARIA-BRF X3 1)) 8)
                              65280)
                      (LOGAND (AREF +ARIA-S2+ (ARIA-BRF X3 0)) 255)))
      (CASE ROUNDS
        ((12) (ARIA-KXL X0 X1 X2 X3 KEYS 12))
        ((14) (ARIA-KXL X0 X1 X2 X3 KEYS 14))
        ((16) (ARIA-KXL X0 X1 X2 X3 KEYS 16)))
      (SETF (UB32REF/BE OUT OUT-START) X0
            (UB32REF/BE OUT (+ OUT-START 4)) X1
            (UB32REF/BE OUT (+ OUT-START 8)) X2
            (UB32REF/BE OUT (+ OUT-START 12)) X3))
    (VALUES))

[ironclad/src/ciphers/camellia.lisp:317]
  (DEFUN CAMELLIA-FEISTEL (DATA DATA-START KEYS KEYS-START KEY-OFFSET)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 32) (*)) DATA KEYS)
             (TYPE FIXNUM DATA-START KEYS-START KEY-OFFSET)
             (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (DEBUG 0)))
    (MACROLET ((SBOX1 (N)
                 (ECLECTOR.READER:QUASIQUOTE
                  (AREF +CAMELLIA-SBOX1+
                        (LOGAND (ECLECTOR.READER:UNQUOTE N) 255))))
               (SBOX2 (N)
                 (ECLECTOR.READER:QUASIQUOTE
                  (AREF +CAMELLIA-SBOX2+
                        (LOGAND (ECLECTOR.READER:UNQUOTE N) 255))))
               (SBOX3 (N)
                 (ECLECTOR.READER:QUASIQUOTE
                  (AREF +CAMELLIA-SBOX3+
                        (LOGAND (ECLECTOR.READER:UNQUOTE N) 255))))
               (SBOX4 (N)
                 (ECLECTOR.READER:QUASIQUOTE
                  (AREF +CAMELLIA-SBOX4+
                        (LOGAND (ECLECTOR.READER:UNQUOTE N) 255)))))
      (LET ((D 0) (U 0) (S1 0) (S2 0))
        (DECLARE (TYPE (UNSIGNED-BYTE 32) D U S1 S2))
        (SETF S1 (LOGXOR (AREF DATA DATA-START) (AREF KEYS KEYS-START))
              U
                (LOGXOR (SBOX4 S1) (SBOX3 (MOD32ASH S1 -8))
                        (SBOX2 (MOD32ASH S1 -16)) (SBOX1 (MOD32ASH S1 -24)))
              S2
                (LOGXOR (AREF DATA (+ DATA-START 1))
                        (AREF KEYS (+ KEYS-START 1)))
              D
                (LOGXOR (SBOX1 S2) (SBOX4 (MOD32ASH S2 -8))
                        (SBOX3 (MOD32ASH S2 -16)) (SBOX2 (MOD32ASH S2 -24))))
        (SETF (AREF DATA (+ DATA-START 2))
                (LOGXOR (AREF DATA (+ DATA-START 2)) D U)
              (AREF DATA (+ DATA-START 3))
                (LOGXOR (AREF DATA (+ DATA-START 3)) D U (ROR32 U 8)))
        (SETF S1
                (LOGXOR (AREF DATA (+ DATA-START 2))
                        (AREF KEYS (+ KEYS-START KEY-OFFSET)))
              U
                (LOGXOR (SBOX4 S1) (SBOX3 (MOD32ASH S1 -8))
                        (SBOX2 (MOD32ASH S1 -16)) (SBOX1 (MOD32ASH S1 -24)))
              S2
                (LOGXOR (AREF DATA (+ DATA-START 3))
                        (AREF KEYS (+ KEYS-START KEY-OFFSET 1)))
              D
                (LOGXOR (SBOX1 S2) (SBOX4 (MOD32ASH S2 -8))
                        (SBOX3 (MOD32ASH S2 -16)) (SBOX2 (MOD32ASH S2 -24))))
        (SETF (AREF DATA DATA-START) (LOGXOR (AREF DATA DATA-START) D U)
              (AREF DATA (+ DATA-START 1))
                (LOGXOR (AREF DATA (+ DATA-START 1)) D U (ROR32 U 8)))
        (VALUES))))

[ironclad/src/ciphers/cipher.lisp:52]
  (DEFMACRO WITH-WORDS
            (
             ((&REST WORD-VARS)
              ARRAY
              INITIAL-OFFSET
              &KEY
              (SIZE 4)
              (BIG-ENDIAN T))
             &BODY BODY)
    (LET ((REF-SYM (UBREF-FUN-NAME (* SIZE 8) BIG-ENDIAN))
          (N-BYTES (* (LENGTH WORD-VARS) SIZE)))
      (FLET ((GENERATE-FETCHES (N-FETCHES)
               (LOOP FOR OFFSET FROM 0 BY SIZE BELOW (* N-FETCHES SIZE)
                     COLLECT (ECLECTOR.READER:QUASIQUOTE
                              ((ECLECTOR.READER:UNQUOTE REF-SYM)
                               (ECLECTOR.READER:UNQUOTE ARRAY)
                               (+ (ECLECTOR.READER:UNQUOTE INITIAL-OFFSET)
                                  (ECLECTOR.READER:UNQUOTE OFFSET)))))))
        (ECLECTOR.READER:QUASIQUOTE
         (MULTIPLE-VALUE-BIND (ECLECTOR.READER:UNQUOTE WORD-VARS)
             (LET ((LENGTH (LENGTH (ECLECTOR.READER:UNQUOTE ARRAY))))
               (COND
                ((<= (ECLECTOR.READER:UNQUOTE INITIAL-OFFSET)
                     (- LENGTH (ECLECTOR.READER:UNQUOTE N-BYTES)))
                 (ECLECTOR.READER:UNQUOTE
                  (IF (AND (MEMBER :SBCL *FEATURES*) (= SIZE 4)
                           (OR (AND BIG-ENDIAN (MEMBER :BIG-ENDIAN *FEATURES*))
                               (AND (NOT BIG-ENDIAN)
                                    (MEMBER :LITTLE-ENDIAN *FEATURES*))))
                      (ECLECTOR.READER:QUASIQUOTE
                       (IF (LOGTEST (ECLECTOR.READER:UNQUOTE INITIAL-OFFSET)
                                    (1- (ECLECTOR.READER:UNQUOTE SIZE)))
                           (LOCALLY
                            (DECLARE (OPTIMIZE (SAFETY 0)))
                            (VALUES
                             (ECLECTOR.READER:UNQUOTE-SPLICING
                              (GENERATE-FETCHES (LENGTH WORD-VARS)))))
                           (LET ((WORD-OFFSET
                                  (TRUNCATE
                                   (ECLECTOR.READER:UNQUOTE INITIAL-OFFSET) 4)))
                             (VALUES
                              (ECLECTOR.READER:UNQUOTE-SPLICING
                               (LOOP FOR OFFSET FROM 0 BELOW (LENGTH WORD-VARS)
                                     COLLECT (ECLECTOR.READER:QUASIQUOTE
                                              (SB-KERNEL:%VECTOR-RAW-BITS
                                               (ECLECTOR.READER:UNQUOTE ARRAY)
                                               (+ WORD-OFFSET
                                                  (ECLECTOR.READER:UNQUOTE
                                                   OFFSET))))))))))
                      (ECLECTOR.READER:QUASIQUOTE
                       (LOCALLY
                        (DECLARE (OPTIMIZE (SAFETY 0)))
                        (VALUES
                         (ECLECTOR.READER:UNQUOTE-SPLICING
                          (GENERATE-FETCHES (LENGTH WORD-VARS)))))))))
                (T
                 (VALUES
                  (ECLECTOR.READER:UNQUOTE-SPLICING
                   (GENERATE-FETCHES (LENGTH WORD-VARS)))))))
           (DECLARE
            (TYPE (UNSIGNED-BYTE (ECLECTOR.READER:UNQUOTE (* SIZE 8)))
             (ECLECTOR.READER:UNQUOTE-SPLICING WORD-VARS)))
           (MACROLET ((STORE-WORDS (BUFFER BUFFER-OFFSET &REST WORD-VARS)
                        (LOOP FOR WORD-VAR IN WORD-VARS
                              FOR OFFSET FROM 0 BY (ECLECTOR.READER:UNQUOTE
                                                    SIZE)
                              COLLECT (ECLECTOR.READER:QUASIQUOTE
                                       (SETF ((ECLECTOR.READER:UNQUOTE
                                               '(ECLECTOR.READER:UNQUOTE
                                                 REF-SYM))
                                              (ECLECTOR.READER:UNQUOTE BUFFER)
                                              (+
                                               (ECLECTOR.READER:UNQUOTE
                                                BUFFER-OFFSET)
                                               (ECLECTOR.READER:UNQUOTE
                                                OFFSET)))
                                               (ECLECTOR.READER:UNQUOTE
                                                WORD-VAR))) INTO STORES
                              FINALLY (RETURN
                                       (ECLECTOR.READER:QUASIQUOTE
                                        (PROGN
                                         (ECLECTOR.READER:UNQUOTE-SPLICING
                                          STORES)))))))
             (ECLECTOR.READER:UNQUOTE-SPLICING BODY)))))))

[ironclad/src/ciphers/kalyna.lisp:2341]
  (DEFUN KALYNA-MAKE-ODD-KEY (N EK EK-START OK OK-START)
    (DECLARE (TYPE (INTEGER 0 8) N)
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (*)) EK OK)
             (TYPE (INTEGER 0 144) EK-START OK-START)
             (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (MACROLET ((M (A B C D E)
                 (ECLECTOR.READER:QUASIQUOTE
                  (SETF (AREF OK (+ OK-START (ECLECTOR.READER:UNQUOTE A)))
                          (LOGIOR
                           (MOD64ASH
                            (AREF EK (+ EK-START (ECLECTOR.READER:UNQUOTE B)))
                            (ECLECTOR.READER:UNQUOTE C))
                           (MOD64ASH
                            (AREF EK (+ EK-START (ECLECTOR.READER:UNQUOTE D)))
                            (ECLECTOR.READER:UNQUOTE E)))))))
      (ECASE N
        (2 (M 0 1 8 0 -56) (M 1 0 8 1 -56))
        (4 (M 0 2 40 1 -24) (M 1 3 40 2 -24) (M 2 0 40 3 -24) (M 3 1 40 0 -24))
        (8
         (M 0 3 40 2 -24)
         (M 1 4 40 3 -24)
         (M 2 5 40 4 -24)
         (M 3 6 40 5 -24)
         (M 4 7 40 6 -24)
         (M 5 0 40 7 -24)
         (M 6 1 40 0 -24)
         (M 7 2 40 1 -24))))
    (VALUES))

[ironclad/src/ciphers/kalyna.lisp:2361]
  (DEFUN KALYNA-SWAP-BLOCKS (N K)
    (DECLARE (TYPE (INTEGER 0 8) N)
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (*)) K)
             (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (ECASE N
      (2 (ROTATEF (AREF K 0) (AREF K 1)))
      (4 (ROTATEF (AREF K 0) (AREF K 1) (AREF K 2) (AREF K 3)))
      (8
       (ROTATEF (AREF K 0) (AREF K 1) (AREF K 2) (AREF K 3) (AREF K 4)
                (AREF K 5) (AREF K 6) (AREF K 7))))
    (VALUES))

[ironclad/src/ciphers/kalyna.lisp:2390]
  (DEFUN KALYNA-G0128 (X Y)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (*)) X Y)
             (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (MACROLET ((M (A B C)
                 (ECLECTOR.READER:QUASIQUOTE
                  (AREF +KALYNA-T+ (ECLECTOR.READER:UNQUOTE A)
                        (LOGAND
                         (MOD64ASH (AREF X (ECLECTOR.READER:UNQUOTE B))
                          (ECLECTOR.READER:UNQUOTE C))
                         255)))))
      (SETF (AREF Y 0)
              (LOGXOR (M 0 0 0) (M 1 0 -8) (M 2 0 -16) (M 3 0 -24) (M 4 1 -32)
                      (M 5 1 -40) (M 6 1 -48) (M 7 1 -56)))
      (SETF (AREF Y 1)
              (LOGXOR (M 0 1 0) (M 1 1 -8) (M 2 1 -16) (M 3 1 -24) (M 4 0 -32)
                      (M 5 0 -40) (M 6 0 -48) (M 7 0 -56))))
    (VALUES))

[ironclad/src/ciphers/kalyna.lisp:2404]
  (DEFUN KALYNA-GL128 (X Y Y-START K K-START)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (*)) X Y K)
             (TYPE (INTEGER 0 30) Y-START K-START)
             (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (MACROLET ((M (A B C)
                 (ECLECTOR.READER:QUASIQUOTE
                  (AREF +KALYNA-T+ (ECLECTOR.READER:UNQUOTE A)
                        (LOGAND
                         (MOD64ASH (AREF X (ECLECTOR.READER:UNQUOTE B))
                          (ECLECTOR.READER:UNQUOTE C))
                         255)))))
      (SETF (AREF Y (+ Y-START 0))
              (MOD64+ (AREF K (+ K-START 0))
               (LOGXOR (M 0 0 0) (M 1 0 -8) (M 2 0 -16) (M 3 0 -24) (M 4 1 -32)
                       (M 5 1 -40) (M 6 1 -48) (M 7 1 -56))))
      (SETF (AREF Y (+ Y-START 1))
              (MOD64+ (AREF K (+ K-START 1))
               (LOGXOR (M 0 1 0) (M 1 1 -8) (M 2 1 -16) (M 3 1 -24) (M 4 0 -32)
                       (M 5 0 -40) (M 6 0 -48) (M 7 0 -56)))))
    (VALUES))

[ironclad/src/ciphers/kalyna.lisp:2421]
  (DEFUN KALYNA-IMC128 (X X-START)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (*)) X)
             (TYPE (INTEGER 0 30) X-START)
             (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (MACROLET ((M (A B C D)
                 (ECLECTOR.READER:QUASIQUOTE
                  (AREF +KALYNA-IT+ (ECLECTOR.READER:UNQUOTE A)
                        (AREF +KALYNA-S+ (ECLECTOR.READER:UNQUOTE B)
                              (LOGAND
                               (MOD64ASH
                                (AREF X
                                      (+ X-START (ECLECTOR.READER:UNQUOTE C)))
                                (ECLECTOR.READER:UNQUOTE D))
                               255))))))
      (SETF (AREF X (+ X-START 0))
              (LOGXOR (M 0 0 0 0) (M 1 1 0 -8) (M 2 2 0 -16) (M 3 3 0 -24)
                      (M 4 0 0 -32) (M 5 1 0 -40) (M 6 2 0 -48) (M 7 3 0 -56)))
      (SETF (AREF X (+ X-START 1))
              (LOGXOR (M 0 0 1 0) (M 1 1 1 -8) (M 2 2 1 -16) (M 3 3 1 -24)
                      (M 4 0 1 -32) (M 5 1 1 -40) (M 6 2 1 -48)
                      (M 7 3 1 -56))))
    (VALUES))

[ironclad/src/ciphers/kalyna.lisp:2440]
  (DEFUN KALYNA-IG128 (X Y K K-START)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (*)) X Y K)
             (TYPE (INTEGER 0 30) K-START)
             (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (MACROLET ((M (A B C)
                 (ECLECTOR.READER:QUASIQUOTE
                  (AREF +KALYNA-IT+ (ECLECTOR.READER:UNQUOTE A)
                        (LOGAND
                         (MOD64ASH (AREF X (ECLECTOR.READER:UNQUOTE B))
                          (ECLECTOR.READER:UNQUOTE C))
                         255)))))
      (SETF (AREF Y 0)
              (LOGXOR (AREF K (+ K-START 0)) (M 0 0 0) (M 1 0 -8) (M 2 0 -16)
                      (M 3 0 -24) (M 4 1 -32) (M 5 1 -40) (M 6 1 -48)
                      (M 7 1 -56)))
      (SETF (AREF Y 1)
              (LOGXOR (AREF K (+ K-START 1)) (M 0 1 0) (M 1 1 -8) (M 2 1 -16)
                      (M 3 1 -24) (M 4 0 -32) (M 5 0 -40) (M 6 0 -48)
                      (M 7 0 -56))))
    (VALUES))

[ironclad/src/ciphers/kalyna.lisp:2457]
  (DEFUN KALYNA-IGL128 (X Y K K-START)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (*)) X Y K)
             (TYPE (INTEGER 0 30) K-START)
             (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (MACROLET ((M (A B C D)
                 (ECLECTOR.READER:QUASIQUOTE
                  (MOD64ASH
                   (AREF +KALYNA-IS+ (ECLECTOR.READER:UNQUOTE A)
                         (LOGAND
                          (MOD64ASH (AREF X (ECLECTOR.READER:UNQUOTE B))
                           (ECLECTOR.READER:UNQUOTE C))
                          255))
                   (ECLECTOR.READER:UNQUOTE D)))))
      (SETF (AREF Y 0)
              (MOD64-
               (LOGXOR (M 0 0 0 0) (M 1 0 -8 8) (M 2 0 -16 16) (M 3 0 -24 24)
                       (M 0 1 -32 32) (M 1 1 -40 40) (M 2 1 -48 48)
                       (M 3 1 -56 56))
               (AREF K (+ K-START 0))))
      (SETF (AREF Y 1)
              (MOD64-
               (LOGXOR (M 0 1 0 0) (M 1 1 -8 8) (M 2 1 -16 16) (M 3 1 -24 24)
                       (M 0 0 -32 32) (M 1 0 -40 40) (M 2 0 -48 48)
                       (M 3 0 -56 56))
               (AREF K (+ K-START 1)))))
    (VALUES))

[ironclad/src/ciphers/kalyna.lisp:2477]
  (DEFUN KALYNA-G128 (X Y K K-START)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (*)) X Y K)
             (TYPE (INTEGER 0 30) K-START)
             (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (MACROLET ((M (A B C)
                 (ECLECTOR.READER:QUASIQUOTE
                  (AREF +KALYNA-T+ (ECLECTOR.READER:UNQUOTE A)
                        (LOGAND
                         (MOD64ASH (AREF X (ECLECTOR.READER:UNQUOTE B))
                          (ECLECTOR.READER:UNQUOTE C))
                         255)))))
      (SETF (AREF Y 0)
              (LOGXOR (AREF K (+ K-START 0)) (M 0 0 0) (M 1 0 -8) (M 2 0 -16)
                      (M 3 0 -24) (M 4 1 -32) (M 5 1 -40) (M 6 1 -48)
                      (M 7 1 -56)))
      (SETF (AREF Y 1)
              (LOGXOR (AREF K (+ K-START 1)) (M 0 1 0) (M 1 1 -8) (M 2 1 -16)
                      (M 3 1 -24) (M 4 0 -32) (M 5 0 -40) (M 6 0 -48)
                      (M 7 0 -56))))
    (VALUES))

[ironclad/src/ciphers/kalyna.lisp:2711]
  (DEFUN KALYNA-G0256 (X Y)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (*)) X Y)
             (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (MACROLET ((M (A B C)
                 (ECLECTOR.READER:QUASIQUOTE
                  (AREF +KALYNA-T+ (ECLECTOR.READER:UNQUOTE A)
                        (LOGAND
                         (MOD64ASH (AREF X (ECLECTOR.READER:UNQUOTE B))
                          (ECLECTOR.READER:UNQUOTE C))
                         255)))))
      (SETF (AREF Y 0)
              (LOGXOR (M 0 0 0) (M 1 0 -8) (M 2 3 -16) (M 3 3 -24) (M 4 2 -32)
                      (M 5 2 -40) (M 6 1 -48) (M 7 1 -56)))
      (SETF (AREF Y 1)
              (LOGXOR (M 0 1 0) (M 1 1 -8) (M 2 0 -16) (M 3 0 -24) (M 4 3 -32)
                      (M 5 3 -40) (M 6 2 -48) (M 7 2 -56)))
      (SETF (AREF Y 2)
              (LOGXOR (M 0 2 0) (M 1 2 -8) (M 2 1 -16) (M 3 1 -24) (M 4 0 -32)
                      (M 5 0 -40) (M 6 3 -48) (M 7 3 -56)))
      (SETF (AREF Y 3)
              (LOGXOR (M 0 3 0) (M 1 3 -8) (M 2 2 -16) (M 3 2 -24) (M 4 1 -32)
                      (M 5 1 -40) (M 6 0 -48) (M 7 0 -56))))
    (VALUES))

[ironclad/src/ciphers/kalyna.lisp:2731]
  (DEFUN KALYNA-GL256 (X Y Y-START K K-START)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (*)) X Y K)
             (TYPE (INTEGER 0 76) Y-START K-START)
             (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (MACROLET ((M (A B C)
                 (ECLECTOR.READER:QUASIQUOTE
                  (AREF +KALYNA-T+ (ECLECTOR.READER:UNQUOTE A)
                        (LOGAND
                         (MOD64ASH (AREF X (ECLECTOR.READER:UNQUOTE B))
                          (ECLECTOR.READER:UNQUOTE C))
                         255)))))
      (SETF (AREF Y (+ Y-START 0))
              (MOD64+ (AREF K (+ K-START 0))
               (LOGXOR (M 0 0 0) (M 1 0 -8) (M 2 3 -16) (M 3 3 -24) (M 4 2 -32)
                       (M 5 2 -40) (M 6 1 -48) (M 7 1 -56))))
      (SETF (AREF Y (+ Y-START 1))
              (MOD64+ (AREF K (+ K-START 1))
               (LOGXOR (M 0 1 0) (M 1 1 -8) (M 2 0 -16) (M 3 0 -24) (M 4 3 -32)
                       (M 5 3 -40) (M 6 2 -48) (M 7 2 -56))))
      (SETF (AREF Y (+ Y-START 2))
              (MOD64+ (AREF K (+ K-START 2))
               (LOGXOR (M 0 2 0) (M 1 2 -8) (M 2 1 -16) (M 3 1 -24) (M 4 0 -32)
                       (M 5 0 -40) (M 6 3 -48) (M 7 3 -56))))
      (SETF (AREF Y (+ Y-START 3))
              (MOD64+ (AREF K (+ K-START 3))
               (LOGXOR (M 0 3 0) (M 1 3 -8) (M 2 2 -16) (M 3 2 -24) (M 4 1 -32)
                       (M 5 1 -40) (M 6 0 -48) (M 7 0 -56)))))
    (VALUES))

[ironclad/src/ciphers/kalyna.lisp:2756]
  (DEFUN KALYNA-IMC256 (X X-START)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (*)) X)
             (TYPE (INTEGER 0 76) X-START)
             (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (MACROLET ((M (A B C D)
                 (ECLECTOR.READER:QUASIQUOTE
                  (AREF +KALYNA-IT+ (ECLECTOR.READER:UNQUOTE A)
                        (AREF +KALYNA-S+ (ECLECTOR.READER:UNQUOTE B)
                              (LOGAND
                               (MOD64ASH
                                (AREF X
                                      (+ X-START (ECLECTOR.READER:UNQUOTE C)))
                                (ECLECTOR.READER:UNQUOTE D))
                               255))))))
      (SETF (AREF X (+ X-START 0))
              (LOGXOR (M 0 0 0 0) (M 1 1 0 -8) (M 2 2 0 -16) (M 3 3 0 -24)
                      (M 4 0 0 -32) (M 5 1 0 -40) (M 6 2 0 -48) (M 7 3 0 -56)))
      (SETF (AREF X (+ X-START 1))
              (LOGXOR (M 0 0 1 0) (M 1 1 1 -8) (M 2 2 1 -16) (M 3 3 1 -24)
                      (M 4 0 1 -32) (M 5 1 1 -40) (M 6 2 1 -48) (M 7 3 1 -56)))
      (SETF (AREF X (+ X-START 2))
              (LOGXOR (M 0 0 2 0) (M 1 1 2 -8) (M 2 2 2 -16) (M 3 3 2 -24)
                      (M 4 0 2 -32) (M 5 1 2 -40) (M 6 2 2 -48) (M 7 3 2 -56)))
      (SETF (AREF X (+ X-START 3))
              (LOGXOR (M 0 0 3 0) (M 1 1 3 -8) (M 2 2 3 -16) (M 3 3 3 -24)
                      (M 4 0 3 -32) (M 5 1 3 -40) (M 6 2 3 -48)
                      (M 7 3 3 -56))))
    (VALUES))

[ironclad/src/ciphers/kalyna.lisp:2781]
  (DEFUN KALYNA-IG256 (X Y K K-START)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (*)) X Y K)
             (TYPE (INTEGER 0 76) K-START)
             (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (MACROLET ((M (A B C)
                 (ECLECTOR.READER:QUASIQUOTE
                  (AREF +KALYNA-IT+ (ECLECTOR.READER:UNQUOTE A)
                        (LOGAND
                         (MOD64ASH (AREF X (ECLECTOR.READER:UNQUOTE B))
                          (ECLECTOR.READER:UNQUOTE C))
                         255)))))
      (SETF (AREF Y 0)
              (LOGXOR (AREF K (+ K-START 0)) (M 0 0 0) (M 1 0 -8) (M 2 1 -16)
                      (M 3 1 -24) (M 4 2 -32) (M 5 2 -40) (M 6 3 -48)
                      (M 7 3 -56)))
      (SETF (AREF Y 1)
              (LOGXOR (AREF K (+ K-START 1)) (M 0 1 0) (M 1 1 -8) (M 2 2 -16)
                      (M 3 2 -24) (M 4 3 -32) (M 5 3 -40) (M 6 0 -48)
                      (M 7 0 -56)))
      (SETF (AREF Y 2)
              (LOGXOR (AREF K (+ K-START 2)) (M 0 2 0) (M 1 2 -8) (M 2 3 -16)
                      (M 3 3 -24) (M 4 0 -32) (M 5 0 -40) (M 6 1 -48)
                      (M 7 1 -56)))
      (SETF (AREF Y 3)
              (LOGXOR (AREF K (+ K-START 3)) (M 0 3 0) (M 1 3 -8) (M 2 0 -16)
                      (M 3 0 -24) (M 4 1 -32) (M 5 1 -40) (M 6 2 -48)
                      (M 7 2 -56))))
    (VALUES))

[ironclad/src/ciphers/kalyna.lisp:2806]
  (DEFUN KALYNA-IGL256 (X Y K K-START)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (*)) X Y K)
             (TYPE (INTEGER 0 76) K-START)
             (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (MACROLET ((M (A B C D)
                 (ECLECTOR.READER:QUASIQUOTE
                  (MOD64ASH
                   (AREF +KALYNA-IS+ (ECLECTOR.READER:UNQUOTE A)
                         (LOGAND
                          (MOD64ASH (AREF X (ECLECTOR.READER:UNQUOTE B))
                           (ECLECTOR.READER:UNQUOTE C))
                          255))
                   (ECLECTOR.READER:UNQUOTE D)))))
      (SETF (AREF Y 0)
              (MOD64-
               (LOGXOR (M 0 0 0 0) (M 1 0 -8 8) (M 2 1 -16 16) (M 3 1 -24 24)
                       (M 0 2 -32 32) (M 1 2 -40 40) (M 2 3 -48 48)
                       (M 3 3 -56 56))
               (AREF K (+ K-START 0))))
      (SETF (AREF Y 1)
              (MOD64-
               (LOGXOR (M 0 1 0 0) (M 1 1 -8 8) (M 2 2 -16 16) (M 3 2 -24 24)
                       (M 0 3 -32 32) (M 1 3 -40 40) (M 2 0 -48 48)
                       (M 3 0 -56 56))
               (AREF K (+ K-START 1))))
      (SETF (AREF Y 2)
              (MOD64-
               (LOGXOR (M 0 2 0 0) (M 1 2 -8 8) (M 2 3 -16 16) (M 3 3 -24 24)
                       (M 0 0 -32 32) (M 1 0 -40 40) (M 2 1 -48 48)
                       (M 3 1 -56 56))
               (AREF K (+ K-START 2))))
      (SETF (AREF Y 3)
              (MOD64-
               (LOGXOR (M 0 3 0 0) (M 1 3 -8 8) (M 2 0 -16 16) (M 3 0 -24 24)
                       (M 0 1 -32 32) (M 1 1 -40 40) (M 2 2 -48 48)
                       (M 3 2 -56 56))
               (AREF K (+ K-START 3)))))
    (VALUES))

[ironclad/src/ciphers/kalyna.lisp:2834]
  (DEFUN KALYNA-G256 (X Y K K-START)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (*)) X Y K)
             (TYPE (INTEGER 0 76) K-START)
             (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (MACROLET ((M (A B C)
                 (ECLECTOR.READER:QUASIQUOTE
                  (AREF +KALYNA-T+ (ECLECTOR.READER:UNQUOTE A)
                        (LOGAND
                         (MOD64ASH (AREF X (ECLECTOR.READER:UNQUOTE B))
                          (ECLECTOR.READER:UNQUOTE C))
                         255)))))
      (SETF (AREF Y 0)
              (LOGXOR (AREF K (+ K-START 0)) (M 0 0 0) (M 1 0 -8) (M 2 3 -16)
                      (M 3 3 -24) (M 4 2 -32) (M 5 2 -40) (M 6 1 -48)
                      (M 7 1 -56)))
      (SETF (AREF Y 1)
              (LOGXOR (AREF K (+ K-START 1)) (M 0 1 0) (M 1 1 -8) (M 2 0 -16)
                      (M 3 0 -24) (M 4 3 -32) (M 5 3 -40) (M 6 2 -48)
                      (M 7 2 -56)))
      (SETF (AREF Y 2)
              (LOGXOR (AREF K (+ K-START 2)) (M 0 2 0) (M 1 2 -8) (M 2 1 -16)
                      (M 3 1 -24) (M 4 0 -32) (M 5 0 -40) (M 6 3 -48)
                      (M 7 3 -56)))
      (SETF (AREF Y 3)
              (LOGXOR (AREF K (+ K-START 3)) (M 0 3 0) (M 1 3 -8) (M 2 2 -16)
                      (M 3 2 -24) (M 4 1 -32) (M 5 1 -40) (M 6 0 -48)
                      (M 7 0 -56))))
    (VALUES))

[ironclad/src/ciphers/kalyna.lisp:3101]
  (DEFUN KALYNA-G0512 (X Y)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (*)) X Y)
             (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (MACROLET ((M (A B C)
                 (ECLECTOR.READER:QUASIQUOTE
                  (AREF +KALYNA-T+ (ECLECTOR.READER:UNQUOTE A)
                        (LOGAND
                         (MOD64ASH (AREF X (ECLECTOR.READER:UNQUOTE B))
                          (ECLECTOR.READER:UNQUOTE C))
                         255)))))
      (SETF (AREF Y 0)
              (LOGXOR (M 0 0 0) (M 1 7 -8) (M 2 6 -16) (M 3 5 -24) (M 4 4 -32)
                      (M 5 3 -40) (M 6 2 -48) (M 7 1 -56)))
      (SETF (AREF Y 1)
              (LOGXOR (M 0 1 0) (M 1 0 -8) (M 2 7 -16) (M 3 6 -24) (M 4 5 -32)
                      (M 5 4 -40) (M 6 3 -48) (M 7 2 -56)))
      (SETF (AREF Y 2)
              (LOGXOR (M 0 2 0) (M 1 1 -8) (M 2 0 -16) (M 3 7 -24) (M 4 6 -32)
                      (M 5 5 -40) (M 6 4 -48) (M 7 3 -56)))
      (SETF (AREF Y 3)
              (LOGXOR (M 0 3 0) (M 1 2 -8) (M 2 1 -16) (M 3 0 -24) (M 4 7 -32)
                      (M 5 6 -40) (M 6 5 -48) (M 7 4 -56)))
      (SETF (AREF Y 4)
              (LOGXOR (M 0 4 0) (M 1 3 -8) (M 2 2 -16) (M 3 1 -24) (M 4 0 -32)
                      (M 5 7 -40) (M 6 6 -48) (M 7 5 -56)))
      (SETF (AREF Y 5)
              (LOGXOR (M 0 5 0) (M 1 4 -8) (M 2 3 -16) (M 3 2 -24) (M 4 1 -32)
                      (M 5 0 -40) (M 6 7 -48) (M 7 6 -56)))
      (SETF (AREF Y 6)
              (LOGXOR (M 0 6 0) (M 1 5 -8) (M 2 4 -16) (M 3 3 -24) (M 4 2 -32)
                      (M 5 1 -40) (M 6 0 -48) (M 7 7 -56)))
      (SETF (AREF Y 7)
              (LOGXOR (M 0 7 0) (M 1 6 -8) (M 2 5 -16) (M 3 4 -24) (M 4 3 -32)
                      (M 5 2 -40) (M 6 1 -48) (M 7 0 -56))))
    (VALUES))

[ironclad/src/ciphers/kalyna.lisp:3133]
  (DEFUN KALYNA-GL512 (X Y Y-START K K-START)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (*)) X Y K)
             (TYPE (INTEGER 0 152) Y-START K-START)
             (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (MACROLET ((M (A B C)
                 (ECLECTOR.READER:QUASIQUOTE
                  (AREF +KALYNA-T+ (ECLECTOR.READER:UNQUOTE A)
                        (LOGAND
                         (MOD64ASH (AREF X (ECLECTOR.READER:UNQUOTE B))
                          (ECLECTOR.READER:UNQUOTE C))
                         255)))))
      (SETF (AREF Y (+ Y-START 0))
              (MOD64+ (AREF K (+ K-START 0))
               (LOGXOR (M 0 0 0) (M 1 7 -8) (M 2 6 -16) (M 3 5 -24) (M 4 4 -32)
                       (M 5 3 -40) (M 6 2 -48) (M 7 1 -56))))
      (SETF (AREF Y (+ Y-START 1))
              (MOD64+ (AREF K (+ K-START 1))
               (LOGXOR (M 0 1 0) (M 1 0 -8) (M 2 7 -16) (M 3 6 -24) (M 4 5 -32)
                       (M 5 4 -40) (M 6 3 -48) (M 7 2 -56))))
      (SETF (AREF Y (+ Y-START 2))
              (MOD64+ (AREF K (+ K-START 2))
               (LOGXOR (M 0 2 0) (M 1 1 -8) (M 2 0 -16) (M 3 7 -24) (M 4 6 -32)
                       (M 5 5 -40) (M 6 4 -48) (M 7 3 -56))))
      (SETF (AREF Y (+ Y-START 3))
              (MOD64+ (AREF K (+ K-START 3))
               (LOGXOR (M 0 3 0) (M 1 2 -8) (M 2 1 -16) (M 3 0 -24) (M 4 7 -32)
                       (M 5 6 -40) (M 6 5 -48) (M 7 4 -56))))
      (SETF (AREF Y (+ Y-START 4))
              (MOD64+ (AREF K (+ K-START 4))
               (LOGXOR (M 0 4 0) (M 1 3 -8) (M 2 2 -16) (M 3 1 -24) (M 4 0 -32)
                       (M 5 7 -40) (M 6 6 -48) (M 7 5 -56))))
      (SETF (AREF Y (+ Y-START 5))
              (MOD64+ (AREF K (+ K-START 5))
               (LOGXOR (M 0 5 0) (M 1 4 -8) (M 2 3 -16) (M 3 2 -24) (M 4 1 -32)
                       (M 5 0 -40) (M 6 7 -48) (M 7 6 -56))))
      (SETF (AREF Y (+ Y-START 6))
              (MOD64+ (AREF K (+ K-START 6))
               (LOGXOR (M 0 6 0) (M 1 5 -8) (M 2 4 -16) (M 3 3 -24) (M 4 2 -32)
                       (M 5 1 -40) (M 6 0 -48) (M 7 7 -56))))
      (SETF (AREF Y (+ Y-START 7))
              (MOD64+ (AREF K (+ K-START 7))
               (LOGXOR (M 0 7 0) (M 1 6 -8) (M 2 5 -16) (M 3 4 -24) (M 4 3 -32)
                       (M 5 2 -40) (M 6 1 -48) (M 7 0 -56)))))
    (VALUES))

[ironclad/src/ciphers/kalyna.lisp:3174]
  (DEFUN KALYNA-IMC512 (X X-START)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (*)) X)
             (TYPE (INTEGER 0 152) X-START)
             (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (MACROLET ((M (A B C D)
                 (ECLECTOR.READER:QUASIQUOTE
                  (AREF +KALYNA-IT+ (ECLECTOR.READER:UNQUOTE A)
                        (AREF +KALYNA-S+ (ECLECTOR.READER:UNQUOTE B)
                              (LOGAND
                               (MOD64ASH
                                (AREF X
                                      (+ X-START (ECLECTOR.READER:UNQUOTE C)))
                                (ECLECTOR.READER:UNQUOTE D))
                               255))))))
      (SETF (AREF X (+ X-START 0))
              (LOGXOR (M 0 0 0 0) (M 1 1 0 -8) (M 2 2 0 -16) (M 3 3 0 -24)
                      (M 4 0 0 -32) (M 5 1 0 -40) (M 6 2 0 -48) (M 7 3 0 -56)))
      (SETF (AREF X (+ X-START 1))
              (LOGXOR (M 0 0 1 0) (M 1 1 1 -8) (M 2 2 1 -16) (M 3 3 1 -24)
                      (M 4 0 1 -32) (M 5 1 1 -40) (M 6 2 1 -48) (M 7 3 1 -56)))
      (SETF (AREF X (+ X-START 2))
              (LOGXOR (M 0 0 2 0) (M 1 1 2 -8) (M 2 2 2 -16) (M 3 3 2 -24)
                      (M 4 0 2 -32) (M 5 1 2 -40) (M 6 2 2 -48) (M 7 3 2 -56)))
      (SETF (AREF X (+ X-START 3))
              (LOGXOR (M 0 0 3 0) (M 1 1 3 -8) (M 2 2 3 -16) (M 3 3 3 -24)
                      (M 4 0 3 -32) (M 5 1 3 -40) (M 6 2 3 -48) (M 7 3 3 -56)))
      (SETF (AREF X (+ X-START 4))
              (LOGXOR (M 0 0 4 0) (M 1 1 4 -8) (M 2 2 4 -16) (M 3 3 4 -24)
                      (M 4 0 4 -32) (M 5 1 4 -40) (M 6 2 4 -48) (M 7 3 4 -56)))
      (SETF (AREF X (+ X-START 5))
              (LOGXOR (M 0 0 5 0) (M 1 1 5 -8) (M 2 2 5 -16) (M 3 3 5 -24)
                      (M 4 0 5 -32) (M 5 1 5 -40) (M 6 2 5 -48) (M 7 3 5 -56)))
      (SETF (AREF X (+ X-START 6))
              (LOGXOR (M 0 0 6 0) (M 1 1 6 -8) (M 2 2 6 -16) (M 3 3 6 -24)
                      (M 4 0 6 -32) (M 5 1 6 -40) (M 6 2 6 -48) (M 7 3 6 -56)))
      (SETF (AREF X (+ X-START 7))
              (LOGXOR (M 0 0 7 0) (M 1 1 7 -8) (M 2 2 7 -16) (M 3 3 7 -24)
                      (M 4 0 7 -32) (M 5 1 7 -40) (M 6 2 7 -48)
                      (M 7 3 7 -56))))
    (VALUES))

[ironclad/src/ciphers/kalyna.lisp:3211]
  (DEFUN KALYNA-IG512 (X Y K K-START)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (*)) X Y K)
             (TYPE (INTEGER 0 152) K-START)
             (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (MACROLET ((M (A B C)
                 (ECLECTOR.READER:QUASIQUOTE
                  (AREF +KALYNA-IT+ (ECLECTOR.READER:UNQUOTE A)
                        (LOGAND
                         (MOD64ASH (AREF X (ECLECTOR.READER:UNQUOTE B))
                          (ECLECTOR.READER:UNQUOTE C))
                         255)))))
      (SETF (AREF Y 0)
              (LOGXOR (AREF K (+ K-START 0)) (M 0 0 0) (M 1 1 -8) (M 2 2 -16)
                      (M 3 3 -24) (M 4 4 -32) (M 5 5 -40) (M 6 6 -48)
                      (M 7 7 -56)))
      (SETF (AREF Y 1)
              (LOGXOR (AREF K (+ K-START 1)) (M 0 1 0) (M 1 2 -8) (M 2 3 -16)
                      (M 3 4 -24) (M 4 5 -32) (M 5 6 -40) (M 6 7 -48)
                      (M 7 0 -56)))
      (SETF (AREF Y 2)
              (LOGXOR (AREF K (+ K-START 2)) (M 0 2 0) (M 1 3 -8) (M 2 4 -16)
                      (M 3 5 -24) (M 4 6 -32) (M 5 7 -40) (M 6 0 -48)
                      (M 7 1 -56)))
      (SETF (AREF Y 3)
              (LOGXOR (AREF K (+ K-START 3)) (M 0 3 0) (M 1 4 -8) (M 2 5 -16)
                      (M 3 6 -24) (M 4 7 -32) (M 5 0 -40) (M 6 1 -48)
                      (M 7 2 -56)))
      (SETF (AREF Y 4)
              (LOGXOR (AREF K (+ K-START 4)) (M 0 4 0) (M 1 5 -8) (M 2 6 -16)
                      (M 3 7 -24) (M 4 0 -32) (M 5 1 -40) (M 6 2 -48)
                      (M 7 3 -56)))
      (SETF (AREF Y 5)
              (LOGXOR (AREF K (+ K-START 5)) (M 0 5 0) (M 1 6 -8) (M 2 7 -16)
                      (M 3 0 -24) (M 4 1 -32) (M 5 2 -40) (M 6 3 -48)
                      (M 7 4 -56)))
      (SETF (AREF Y 6)
              (LOGXOR (AREF K (+ K-START 6)) (M 0 6 0) (M 1 7 -8) (M 2 0 -16)
                      (M 3 1 -24) (M 4 2 -32) (M 5 3 -40) (M 6 4 -48)
                      (M 7 5 -56)))
      (SETF (AREF Y 7)
              (LOGXOR (AREF K (+ K-START 7)) (M 0 7 0) (M 1 0 -8) (M 2 1 -16)
                      (M 3 2 -24) (M 4 3 -32) (M 5 4 -40) (M 6 5 -48)
                      (M 7 6 -56))))
    (VALUES))

[ironclad/src/ciphers/kalyna.lisp:3252]
  (DEFUN KALYNA-IGL512 (X Y K K-START)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (*)) X Y K)
             (TYPE (INTEGER 0 152) K-START)
             (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (MACROLET ((M (A B C D)
                 (ECLECTOR.READER:QUASIQUOTE
                  (MOD64ASH
                   (AREF +KALYNA-IS+ (ECLECTOR.READER:UNQUOTE A)
                         (LOGAND
                          (MOD64ASH (AREF X (ECLECTOR.READER:UNQUOTE B))
                           (ECLECTOR.READER:UNQUOTE C))
                          255))
                   (ECLECTOR.READER:UNQUOTE D)))))
      (SETF (AREF Y 0)
              (MOD64-
               (LOGXOR (M 0 0 0 0) (M 1 1 -8 8) (M 2 2 -16 16) (M 3 3 -24 24)
                       (M 0 4 -32 32) (M 1 5 -40 40) (M 2 6 -48 48)
                       (M 3 7 -56 56))
               (AREF K (+ K-START 0))))
      (SETF (AREF Y 1)
              (MOD64-
               (LOGXOR (M 0 1 0 0) (M 1 2 -8 8) (M 2 3 -16 16) (M 3 4 -24 24)
                       (M 0 5 -32 32) (M 1 6 -40 40) (M 2 7 -48 48)
                       (M 3 0 -56 56))
               (AREF K (+ K-START 1))))
      (SETF (AREF Y 2)
              (MOD64-
               (LOGXOR (M 0 2 0 0) (M 1 3 -8 8) (M 2 4 -16 16) (M 3 5 -24 24)
                       (M 0 6 -32 32) (M 1 7 -40 40) (M 2 0 -48 48)
                       (M 3 1 -56 56))
               (AREF K (+ K-START 2))))
      (SETF (AREF Y 3)
              (MOD64-
               (LOGXOR (M 0 3 0 0) (M 1 4 -8 8) (M 2 5 -16 16) (M 3 6 -24 24)
                       (M 0 7 -32 32) (M 1 0 -40 40) (M 2 1 -48 48)
                       (M 3 2 -56 56))
               (AREF K (+ K-START 3))))
      (SETF (AREF Y 4)
              (MOD64-
               (LOGXOR (M 0 4 0 0) (M 1 5 -8 8) (M 2 6 -16 16) (M 3 7 -24 24)
                       (M 0 0 -32 32) (M 1 1 -40 40) (M 2 2 -48 48)
                       (M 3 3 -56 56))
               (AREF K (+ K-START 4))))
      (SETF (AREF Y 5)
              (MOD64-
               (LOGXOR (M 0 5 0 0) (M 1 6 -8 8) (M 2 7 -16 16) (M 3 0 -24 24)
                       (M 0 1 -32 32) (M 1 2 -40 40) (M 2 3 -48 48)
                       (M 3 4 -56 56))
               (AREF K (+ K-START 5))))
      (SETF (AREF Y 6)
              (MOD64-
               (LOGXOR (M 0 6 0 0) (M 1 7 -8 8) (M 2 0 -16 16) (M 3 1 -24 24)
                       (M 0 2 -32 32) (M 1 3 -40 40) (M 2 4 -48 48)
                       (M 3 5 -56 56))
               (AREF K (+ K-START 6))))
      (SETF (AREF Y 7)
              (MOD64-
               (LOGXOR (M 0 7 0 0) (M 1 0 -8 8) (M 2 1 -16 16) (M 3 2 -24 24)
                       (M 0 3 -32 32) (M 1 4 -40 40) (M 2 5 -48 48)
                       (M 3 6 -56 56))
               (AREF K (+ K-START 7)))))
    (VALUES))

[ironclad/src/ciphers/kalyna.lisp:3296]
  (DEFUN KALYNA-G512 (X Y K K-START)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (*)) X Y K)
             (TYPE (INTEGER 0 152) K-START)
             (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (MACROLET ((M (A B C)
                 (ECLECTOR.READER:QUASIQUOTE
                  (AREF +KALYNA-T+ (ECLECTOR.READER:UNQUOTE A)
                        (LOGAND
                         (MOD64ASH (AREF X (ECLECTOR.READER:UNQUOTE B))
                          (ECLECTOR.READER:UNQUOTE C))
                         255)))))
      (SETF (AREF Y 0)
              (LOGXOR (AREF K (+ K-START 0)) (M 0 0 0) (M 1 7 -8) (M 2 6 -16)
                      (M 3 5 -24) (M 4 4 -32) (M 5 3 -40) (M 6 2 -48)
                      (M 7 1 -56)))
      (SETF (AREF Y 1)
              (LOGXOR (AREF K (+ K-START 1)) (M 0 1 0) (M 1 0 -8) (M 2 7 -16)
                      (M 3 6 -24) (M 4 5 -32) (M 5 4 -40) (M 6 3 -48)
                      (M 7 2 -56)))
      (SETF (AREF Y 2)
              (LOGXOR (AREF K (+ K-START 2)) (M 0 2 0) (M 1 1 -8) (M 2 0 -16)
                      (M 3 7 -24) (M 4 6 -32) (M 5 5 -40) (M 6 4 -48)
                      (M 7 3 -56)))
      (SETF (AREF Y 3)
              (LOGXOR (AREF K (+ K-START 3)) (M 0 3 0) (M 1 2 -8) (M 2 1 -16)
                      (M 3 0 -24) (M 4 7 -32) (M 5 6 -40) (M 6 5 -48)
                      (M 7 4 -56)))
      (SETF (AREF Y 4)
              (LOGXOR (AREF K (+ K-START 4)) (M 0 4 0) (M 1 3 -8) (M 2 2 -16)
                      (M 3 1 -24) (M 4 0 -32) (M 5 7 -40) (M 6 6 -48)
                      (M 7 5 -56)))
      (SETF (AREF Y 5)
              (LOGXOR (AREF K (+ K-START 5)) (M 0 5 0) (M 1 4 -8) (M 2 3 -16)
                      (M 3 2 -24) (M 4 1 -32) (M 5 0 -40) (M 6 7 -48)
                      (M 7 6 -56)))
      (SETF (AREF Y 6)
              (LOGXOR (AREF K (+ K-START 6)) (M 0 6 0) (M 1 5 -8) (M 2 4 -16)
                      (M 3 3 -24) (M 4 2 -32) (M 5 1 -40) (M 6 0 -48)
                      (M 7 7 -56)))
      (SETF (AREF Y 7)
              (LOGXOR (AREF K (+ K-START 7)) (M 0 7 0) (M 1 6 -8) (M 2 5 -16)
                      (M 3 4 -24) (M 4 3 -32) (M 5 2 -40) (M 6 1 -48)
                      (M 7 0 -56))))
    (VALUES))

[ironclad/src/ciphers/modes.lisp:77]
  (DEFUN INCREMENT-COUNTER-BLOCK (BLOCK N)
    (DECLARE (TYPE SIMPLE-OCTET-VECTOR BLOCK)
             (TYPE (MOD NIL) N)
             (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (LOOP WITH CARRY OF-TYPE (MOD NIL) = N
          WITH
          SUM OF-TYPE (UNSIGNED-BYTE 16) = 0
          FOR I OF-TYPE FIXNUM FROM (1- (LENGTH BLOCK)) DOWNTO 0
          DO (SETF SUM (+ (AREF BLOCK I) (LOGAND CARRY 255))
                   (AREF BLOCK I) (LOGAND SUM 255)
                   CARRY (+ (ASH CARRY -8) (ASH SUM -8)))
          UNTIL (ZEROP CARRY)))

[ironclad/src/ciphers/modes.lisp:90]
  (DEFUN INCREMENT-COUNTER-BLOCK-1 (SIZE BLOCK)
    (DECLARE (TYPE INDEX SIZE)
             (TYPE SIMPLE-OCTET-VECTOR BLOCK)
             (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (INC-COUNTER-BLOCK SIZE BLOCK))

[ironclad/src/ciphers/modes.lisp:104]
  (DEFUN DECREMENT-COUNTER-BLOCK (BLOCK N)
    (DECLARE (TYPE SIMPLE-OCTET-VECTOR BLOCK)
             (TYPE (MOD NIL) N)
             (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (LOOP WITH CARRY OF-TYPE (MOD NIL) = N
          WITH SUB OF-TYPE FIXNUM = 0
          FOR I OF-TYPE FIXNUM FROM (1- (LENGTH BLOCK)) DOWNTO 0
          DO (SETF SUB (- (AREF BLOCK I) (LOGAND CARRY 255))
                   (AREF BLOCK I) (LOGAND SUB 255)
                   CARRY
                     (+ (ASH CARRY -8)
                        (IF (MINUSP SUB)
                            1
                            0)))
          UNTIL (ZEROP CARRY)))

[ironclad/src/ciphers/serpent.lisp:450]
  (DEFUN SERPENT-GENERATE-SUBKEYS (KEY)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 32) (8)) KEY)
             (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (DEBUG 0)))
    (LET ((SUBKEYS (MAKE-ARRAY '(33 4) :ELEMENT-TYPE '(UNSIGNED-BYTE 32)))
          (W (COPY-SEQ KEY))
          (WS (MAKE-ARRAY 4 :ELEMENT-TYPE '(UNSIGNED-BYTE 32)))
          (WT (MAKE-ARRAY 4 :ELEMENT-TYPE '(UNSIGNED-BYTE 32)))
          (T0 0)
          (T1 0)
          (T2 0)
          (T3 0)
          (T4 0))
      (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 32) (33 4)) SUBKEYS)
               (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 32) (8)) W)
               (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 32) (4)) WS WT)
               (TYPE (UNSIGNED-BYTE 32) T0 T1 T2 T3 T4))
      (MACROLET ((EXPAND-KEY4 (WO R)
                   (ECLECTOR.READER:QUASIQUOTE
                    (SETF (AREF (ECLECTOR.READER:UNQUOTE WO) 0)
                            (ROL32
                             (LOGXOR
                              (AREF W
                                    (ECLECTOR.READER:UNQUOTE (MOD (+ R 0) 8)))
                              (AREF W
                                    (ECLECTOR.READER:UNQUOTE (MOD (+ R 3) 8)))
                              (AREF W
                                    (ECLECTOR.READER:UNQUOTE (MOD (+ R 5) 8)))
                              (AREF W
                                    (ECLECTOR.READER:UNQUOTE (MOD (+ R 7) 8)))
                              +SERPENT-PHI+ (ECLECTOR.READER:UNQUOTE (+ R 0)))
                             11)
                          (AREF W (ECLECTOR.READER:UNQUOTE (MOD (+ R 0) 8)))
                            (AREF (ECLECTOR.READER:UNQUOTE WO) 0)
                          (AREF (ECLECTOR.READER:UNQUOTE WO) 1)
                            (ROL32
                             (LOGXOR
                              (AREF W
                                    (ECLECTOR.READER:UNQUOTE (MOD (+ R 1) 8)))
                              (AREF W
                                    (ECLECTOR.READER:UNQUOTE (MOD (+ R 4) 8)))
                              (AREF W
                                    (ECLECTOR.READER:UNQUOTE (MOD (+ R 6) 8)))
                              (AREF W
                                    (ECLECTOR.READER:UNQUOTE (MOD (+ R 0) 8)))
                              +SERPENT-PHI+ (ECLECTOR.READER:UNQUOTE (+ R 1)))
                             11)
                          (AREF W (ECLECTOR.READER:UNQUOTE (MOD (+ R 1) 8)))
                            (AREF (ECLECTOR.READER:UNQUOTE WO) 1)
                          (AREF (ECLECTOR.READER:UNQUOTE WO) 2)
                            (ROL32
                             (LOGXOR
                              (AREF W
                                    (ECLECTOR.READER:UNQUOTE (MOD (+ R 2) 8)))
                              (AREF W
                                    (ECLECTOR.READER:UNQUOTE (MOD (+ R 5) 8)))
                              (AREF W
                                    (ECLECTOR.READER:UNQUOTE (MOD (+ R 7) 8)))
                              (AREF W
                                    (ECLECTOR.READER:UNQUOTE (MOD (+ R 1) 8)))
                              +SERPENT-PHI+ (ECLECTOR.READER:UNQUOTE (+ R 2)))
                             11)
                          (AREF W (ECLECTOR.READER:UNQUOTE (MOD (+ R 2) 8)))
                            (AREF (ECLECTOR.READER:UNQUOTE WO) 2)
                          (AREF (ECLECTOR.READER:UNQUOTE WO) 3)
                            (ROL32
                             (LOGXOR
                              (AREF W
                                    (ECLECTOR.READER:UNQUOTE (MOD (+ R 3) 8)))
                              (AREF W
                                    (ECLECTOR.READER:UNQUOTE (MOD (+ R 6) 8)))
                              (AREF W
                                    (ECLECTOR.READER:UNQUOTE (MOD (+ R 0) 8)))
                              (AREF W
                                    (ECLECTOR.READER:UNQUOTE (MOD (+ R 2) 8)))
                              +SERPENT-PHI+ (ECLECTOR.READER:UNQUOTE (+ R 3)))
                             11)
                          (AREF W (ECLECTOR.READER:UNQUOTE (MOD (+ R 3) 8)))
                            (AREF (ECLECTOR.READER:UNQUOTE WO) 3))))
                 (MAKE-SUBKEYS ()
                   (LOOP FOR I FROM 0 TO 15
                         FOR SBOX-A = (READ-FROM-STRING
                                       (FORMAT NIL "serpent-sbox~d"
                                               (MOD (- 3 (* 2 I)) 8)))
                         FOR SBOX-B = (READ-FROM-STRING
                                       (FORMAT NIL "serpent-sbox~d"
                                               (MOD (- 2 (* 2 I)) 8)))
                         APPEND (LIST
                                 (ECLECTOR.READER:QUASIQUOTE
                                  (EXPAND-KEY4 WS
                                   (ECLECTOR.READER:UNQUOTE (* 8 I))))
                                 (ECLECTOR.READER:QUASIQUOTE
                                  (EXPAND-KEY4 WT
                                   (ECLECTOR.READER:UNQUOTE (+ (* 8 I) 4))))
                                 (ECLECTOR.READER:QUASIQUOTE
                                  (SETF T0 (AREF WS 0)
                                        T1 (AREF WS 1)
                                        T2 (AREF WS 2)
                                        T3 (AREF WS 3)))
                                 (ECLECTOR.READER:QUASIQUOTE
                                  ((ECLECTOR.READER:UNQUOTE SBOX-A) T0 T1 T2 T3
                                   (AREF WS 0) (AREF WS 1) (AREF WS 2)
                                   (AREF WS 3) T4))
                                 (ECLECTOR.READER:QUASIQUOTE
                                  (SETF (AREF SUBKEYS
                                              (ECLECTOR.READER:UNQUOTE (* 2 I))
                                              0)
                                          (AREF WS 0)
                                        (AREF SUBKEYS
                                              (ECLECTOR.READER:UNQUOTE (* 2 I))
                                              1)
                                          (AREF WS 1)
                                        (AREF SUBKEYS
                                              (ECLECTOR.READER:UNQUOTE (* 2 I))
                                              2)
                                          (AREF WS 2)
                                        (AREF SUBKEYS
                                              (ECLECTOR.READER:UNQUOTE (* 2 I))
                                              3)
                                          (AREF WS 3)))
                                 (ECLECTOR.READER:QUASIQUOTE
                                  (SETF T0 (AREF WT 0)
                                        T1 (AREF WT 1)
                                        T2 (AREF WT 2)
                                        T3 (AREF WT 3)))
                                 (ECLECTOR.READER:QUASIQUOTE
                                  ((ECLECTOR.READER:UNQUOTE SBOX-B) T0 T1 T2 T3
                                   (AREF WT 0) (AREF WT 1) (AREF WT 2)
                                   (AREF WT 3) T4))
                                 (ECLECTOR.READER:QUASIQUOTE
                                  (SETF (AREF SUBKEYS
                                              (ECLECTOR.READER:UNQUOTE
                                               (1+ (* 2 I)))
                                              0)
                                          (AREF WT 0)
                                        (AREF SUBKEYS
                                              (ECLECTOR.READER:UNQUOTE
                                               (1+ (* 2 I)))
                                              1)
                                          (AREF WT 1)
                                        (AREF SUBKEYS
                                              (ECLECTOR.READER:UNQUOTE
                                               (1+ (* 2 I)))
                                              2)
                                          (AREF WT 2)
                                        (AREF SUBKEYS
                                              (ECLECTOR.READER:UNQUOTE
                                               (1+ (* 2 I)))
                                              3)
                                          (AREF WT 3)))) INTO FORMS
                         FINALLY (RETURN
                                  (ECLECTOR.READER:QUASIQUOTE
                                   (PROGN
                                    (ECLECTOR.READER:UNQUOTE-SPLICING
                                     FORMS)))))))
        (MAKE-SUBKEYS)
        (EXPAND-KEY4 WS 128)
        (SETF T0 (AREF WS 0)
              T1 (AREF WS 1)
              T2 (AREF WS 2)
              T3 (AREF WS 3))
        (SERPENT-SBOX3 T0 T1 T2 T3 (AREF WS 0) (AREF WS 1) (AREF WS 2)
         (AREF WS 3) T4)
        (SETF (AREF SUBKEYS 32 0) (AREF WS 0)
              (AREF SUBKEYS 32 1) (AREF WS 1)
              (AREF SUBKEYS 32 2) (AREF WS 2)
              (AREF SUBKEYS 32 3) (AREF WS 3))
        SUBKEYS)))

[ironclad/src/ciphers/sosemanuk.lisp:536]
  (DEFUN SOSEMANUK-COMPUTE-BLOCK (STATE STATE-R BUFFER)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 32) (*)) STATE STATE-R)
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (80)) BUFFER)
             (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (DEBUG 0)))
    (LET ((S0 (AREF STATE 0))
          (S1 (AREF STATE 1))
          (S2 (AREF STATE 2))
          (S3 (AREF STATE 3))
          (S4 (AREF STATE 4))
          (S5 (AREF STATE 5))
          (S6 (AREF STATE 6))
          (S7 (AREF STATE 7))
          (S8 (AREF STATE 8))
          (S9 (AREF STATE 9))
          (R1 (AREF STATE-R 0))
          (R2 (AREF STATE-R 1))
          (U0 0)
          (U1 0)
          (U2 0)
          (U3 0)
          (U4 0)
          (V0 0)
          (V1 0)
          (V2 0)
          (V3 0))
      (DECLARE (TYPE (UNSIGNED-BYTE 32) S0 S1 S2 S3 S4 S5 S6 S7 S8 S9 R1 R2)
               (TYPE (UNSIGNED-BYTE 32) U0 U1 U2 U3 U4 V0 V1 V2 V3))
      (MACROLET ((MUL-A (X)
                   (ECLECTOR.READER:QUASIQUOTE
                    (LOGXOR (MOD32ASH (ECLECTOR.READER:UNQUOTE X) 8)
                            (AREF +SOSEMANUK-MUL-A+
                                  (MOD32ASH (ECLECTOR.READER:UNQUOTE X)
                                   -24)))))
                 (MUL-G (X)
                   (ECLECTOR.READER:QUASIQUOTE
                    (LOGXOR (MOD32ASH (ECLECTOR.READER:UNQUOTE X) -8)
                            (AREF +SOSEMANUK-MUL-IA+
                                  (LOGAND (ECLECTOR.READER:UNQUOTE X) 255)))))
                 (XMUX (C X Y)
                   (ECLECTOR.READER:QUASIQUOTE
                    (IF (ZEROP (LOGAND (ECLECTOR.READER:UNQUOTE C) 1))
                        (ECLECTOR.READER:UNQUOTE X)
                        (LOGXOR (ECLECTOR.READER:UNQUOTE X)
                                (ECLECTOR.READER:UNQUOTE Y)))))
                 (FSM (X1 X8)
                   (ECLECTOR.READER:QUASIQUOTE
                    (LET ((TT 0) (OR1 0))
                      (DECLARE (TYPE (UNSIGNED-BYTE 32) TT OR1))
                      (SETF TT
                              (XMUX R1
                               (SOSEMANUK-MKNAME "s"
                                (ECLECTOR.READER:UNQUOTE X1))
                               (SOSEMANUK-MKNAME "s"
                                (ECLECTOR.READER:UNQUOTE X8)))
                            OR1 R1
                            R1 (MOD32+ R2 TT)
                            TT (MOD32* OR1 1415926535)
                            R2 (ROL32 TT 7)))))
                 (LRU (X0 X3 X9 DD)
                   (ECLECTOR.READER:QUASIQUOTE
                    (SETF (ECLECTOR.READER:UNQUOTE DD)
                            (SOSEMANUK-MKNAME "s" (ECLECTOR.READER:UNQUOTE X0))
                          (SOSEMANUK-MKNAME "s" (ECLECTOR.READER:UNQUOTE X0))
                            (LOGXOR
                             (MUL-A
                              (SOSEMANUK-MKNAME "s"
                               (ECLECTOR.READER:UNQUOTE X0)))
                             (MUL-G
                              (SOSEMANUK-MKNAME "s"
                               (ECLECTOR.READER:UNQUOTE X3)))
                             (SOSEMANUK-MKNAME "s"
                              (ECLECTOR.READER:UNQUOTE X9))))))
                 (CC1 (X9 EE)
                   (ECLECTOR.READER:QUASIQUOTE
                    (SETF (ECLECTOR.READER:UNQUOTE EE)
                            (LOGXOR
                             (MOD32+
                              (SOSEMANUK-MKNAME "s"
                               (ECLECTOR.READER:UNQUOTE X9))
                              R1)
                             R2))))
                 (STP (X0 X1 X3 X8 X9 DD EE)
                   (ECLECTOR.READER:QUASIQUOTE
                    (PROGN
                     (FSM (ECLECTOR.READER:UNQUOTE X1)
                      (ECLECTOR.READER:UNQUOTE X8))
                     (LRU (ECLECTOR.READER:UNQUOTE X0)
                      (ECLECTOR.READER:UNQUOTE X3) (ECLECTOR.READER:UNQUOTE X9)
                      (ECLECTOR.READER:UNQUOTE DD))
                     (CC1 (ECLECTOR.READER:UNQUOTE X9)
                      (ECLECTOR.READER:UNQUOTE EE)))))
                 (SRD (S X0 X1 X2 X3 OOFF)
                   (ECLECTOR.READER:QUASIQUOTE
                    (PROGN
                     ((ECLECTOR.READER:UNQUOTE S) U0 U1 U2 U3 U4)
                     (SETF (UB32REF/LE BUFFER (ECLECTOR.READER:UNQUOTE OOFF))
                             (LOGXOR
                              (SOSEMANUK-MKNAME "u"
                               (ECLECTOR.READER:UNQUOTE X0))
                              V0)
                           (UB32REF/LE BUFFER
                            (ECLECTOR.READER:UNQUOTE (+ OOFF 4)))
                             (LOGXOR
                              (SOSEMANUK-MKNAME "u"
                               (ECLECTOR.READER:UNQUOTE X1))
                              V1)
                           (UB32REF/LE BUFFER
                            (ECLECTOR.READER:UNQUOTE (+ OOFF 8)))
                             (LOGXOR
                              (SOSEMANUK-MKNAME "u"
                               (ECLECTOR.READER:UNQUOTE X2))
                              V2)
                           (UB32REF/LE BUFFER
                            (ECLECTOR.READER:UNQUOTE (+ OOFF 12)))
                             (LOGXOR
                              (SOSEMANUK-MKNAME "u"
                               (ECLECTOR.READER:UNQUOTE X3))
                              V3))))))
        (STP 0 1 3 8 9 V0 U0)
        (STP 1 2 4 9 0 V1 U1)
        (STP 2 3 5 0 1 V2 U2)
        (STP 3 4 6 1 2 V3 U3)
        (SRD SOSEMANUK-S2 2 3 1 4 0)
        (STP 4 5 7 2 3 V0 U0)
        (STP 5 6 8 3 4 V1 U1)
        (STP 6 7 9 4 5 V2 U2)
        (STP 7 8 0 5 6 V3 U3)
        (SRD SOSEMANUK-S2 2 3 1 4 16)
        (STP 8 9 1 6 7 V0 U0)
        (STP 9 0 2 7 8 V1 U1)
        (STP 0 1 3 8 9 V2 U2)
        (STP 1 2 4 9 0 V3 U3)
        (SRD SOSEMANUK-S2 2 3 1 4 32)
        (STP 2 3 5 0 1 V0 U0)
        (STP 3 4 6 1 2 V1 U1)
        (STP 4 5 7 2 3 V2 U2)
        (STP 5 6 8 3 4 V3 U3)
        (SRD SOSEMANUK-S2 2 3 1 4 48)
        (STP 6 7 9 4 5 V0 U0)
        (STP 7 8 0 5 6 V1 U1)
        (STP 8 9 1 6 7 V2 U2)
        (STP 9 0 2 7 8 V3 U3)
        (SRD SOSEMANUK-S2 2 3 1 4 64)
        (SETF (AREF STATE 0) S0
              (AREF STATE 1) S1
              (AREF STATE 2) S2
              (AREF STATE 3) S3
              (AREF STATE 4) S4
              (AREF STATE 5) S5
              (AREF STATE 6) S6
              (AREF STATE 7) S7
              (AREF STATE 8) S8
              (AREF STATE 9) S9
              (AREF STATE-R 0) R1
              (AREF STATE-R 1) R2)))
    (VALUES))

[ironclad/src/common.lisp:28]
  (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 0)
         (DEBUG 0))
        (#S(FORMGREP:SYMREF :NAME "OPTIMIZE-INTERFACE" :QUALIFIER "EXT")
         (SAFETY 1) (DEBUG 1)))))

[ironclad/src/common.lisp:29]
  (DEFUN BURN-BABY-BURN ()
    '(OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0) (COMPILATION-SPEED 0)))

[ironclad/src/common.lisp:33]
  (DEFUN HOLD-ME-BACK ()
    '(DECLARE
      (OPTIMIZE (SPEED 3) (SPACE 0) (COMPILATION-SPEED 0) (SAFETY 0) (DEBUG 0))
      (#S(FORMGREP:SYMREF :NAME "OPTIMIZE-INTERFACE" :QUALIFIER "EXT")
       (SAFETY 1) (DEBUG 1))))

[ironclad/src/digests/blake2.lisp:64]
  (DEFUN BLAKE2-ROUNDS (STATE INPUT START OFFSET FINAL)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (8)) STATE)
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) INPUT)
             (TYPE FIXNUM START)
             (TYPE (UNSIGNED-BYTE 128) OFFSET)
             (TYPE BOOLEAN FINAL)
             (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (DEBUG 0)))
    (MACROLET ((BLAKE2-MIXING (VA VB VC VD X Y)
                 (ECLECTOR.READER:QUASIQUOTE
                  (SETF (ECLECTOR.READER:UNQUOTE VA)
                          (MOD64+
                           (MOD64+ (ECLECTOR.READER:UNQUOTE VA)
                            (ECLECTOR.READER:UNQUOTE VB))
                           (ECLECTOR.READER:UNQUOTE X))
                        (ECLECTOR.READER:UNQUOTE VD)
                          (ROR64
                           (LOGXOR (ECLECTOR.READER:UNQUOTE VD)
                                   (ECLECTOR.READER:UNQUOTE VA))
                           32)
                        (ECLECTOR.READER:UNQUOTE VC)
                          (MOD64+ (ECLECTOR.READER:UNQUOTE VC)
                           (ECLECTOR.READER:UNQUOTE VD))
                        (ECLECTOR.READER:UNQUOTE VB)
                          (ROR64
                           (LOGXOR (ECLECTOR.READER:UNQUOTE VB)
                                   (ECLECTOR.READER:UNQUOTE VC))
                           24)
                        (ECLECTOR.READER:UNQUOTE VA)
                          (MOD64+
                           (MOD64+ (ECLECTOR.READER:UNQUOTE VA)
                            (ECLECTOR.READER:UNQUOTE VB))
                           (ECLECTOR.READER:UNQUOTE Y))
                        (ECLECTOR.READER:UNQUOTE VD)
                          (ROR64
                           (LOGXOR (ECLECTOR.READER:UNQUOTE VD)
                                   (ECLECTOR.READER:UNQUOTE VA))
                           16)
                        (ECLECTOR.READER:UNQUOTE VC)
                          (MOD64+ (ECLECTOR.READER:UNQUOTE VC)
                           (ECLECTOR.READER:UNQUOTE VD))
                        (ECLECTOR.READER:UNQUOTE VB)
                          (ROR64
                           (LOGXOR (ECLECTOR.READER:UNQUOTE VB)
                                   (ECLECTOR.READER:UNQUOTE VC))
                           63)))))
      (LET ((V0 (AREF STATE 0))
            (V1 (AREF STATE 1))
            (V2 (AREF STATE 2))
            (V3 (AREF STATE 3))
            (V4 (AREF STATE 4))
            (V5 (AREF STATE 5))
            (V6 (AREF STATE 6))
            (V7 (AREF STATE 7))
            (V8 (AREF +BLAKE2-IV+ 0))
            (V9 (AREF +BLAKE2-IV+ 1))
            (V10 (AREF +BLAKE2-IV+ 2))
            (V11 (AREF +BLAKE2-IV+ 3))
            (V12 (AREF +BLAKE2-IV+ 4))
            (V13 (AREF +BLAKE2-IV+ 5))
            (V14 (AREF +BLAKE2-IV+ 6))
            (V15 (AREF +BLAKE2-IV+ 7))
            (M
             (MAKE-ARRAY 16 :ELEMENT-TYPE '(UNSIGNED-BYTE 64) :INITIAL-ELEMENT
                         0)))
        (DECLARE
         (TYPE (UNSIGNED-BYTE 64) V0 V1 V2 V3 V4 V5 V6 V7 V8 V9 V10 V11 V12 V13
          V14 V15)
         (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (16)) M)
         (DYNAMIC-EXTENT M))
        (SETF V12 (LOGXOR V12 (LDB (BYTE 64 0) OFFSET))
              V13 (LOGXOR V13 (LDB (BYTE 64 64) OFFSET)))
        (WHEN FINAL (SETF V14 (LOGXOR V14 18446744073709551615)))
        (DOTIMES-UNROLLED (I 16)
         (SETF (AREF M I) (UB64REF/LE INPUT (+ START (* I 8)))))
        (DOTIMES-UNROLLED (I +BLAKE2-ROUNDS+)
         (BLAKE2-MIXING V0 V4 V8 V12 (AREF M (AREF +BLAKE2-SIGMA+ I 0))
          (AREF M (AREF +BLAKE2-SIGMA+ I 1)))
         (BLAKE2-MIXING V1 V5 V9 V13 (AREF M (AREF +BLAKE2-SIGMA+ I 2))
          (AREF M (AREF +BLAKE2-SIGMA+ I 3)))
         (BLAKE2-MIXING V2 V6 V10 V14 (AREF M (AREF +BLAKE2-SIGMA+ I 4))
          (AREF M (AREF +BLAKE2-SIGMA+ I 5)))
         (BLAKE2-MIXING V3 V7 V11 V15 (AREF M (AREF +BLAKE2-SIGMA+ I 6))
          (AREF M (AREF +BLAKE2-SIGMA+ I 7)))
         (BLAKE2-MIXING V0 V5 V10 V15 (AREF M (AREF +BLAKE2-SIGMA+ I 8))
          (AREF M (AREF +BLAKE2-SIGMA+ I 9)))
         (BLAKE2-MIXING V1 V6 V11 V12 (AREF M (AREF +BLAKE2-SIGMA+ I 10))
          (AREF M (AREF +BLAKE2-SIGMA+ I 11)))
         (BLAKE2-MIXING V2 V7 V8 V13 (AREF M (AREF +BLAKE2-SIGMA+ I 12))
          (AREF M (AREF +BLAKE2-SIGMA+ I 13)))
         (BLAKE2-MIXING V3 V4 V9 V14 (AREF M (AREF +BLAKE2-SIGMA+ I 14))
          (AREF M (AREF +BLAKE2-SIGMA+ I 15))))
        (SETF (AREF STATE 0) (LOGXOR (AREF STATE 0) V0 V8)
              (AREF STATE 1) (LOGXOR (AREF STATE 1) V1 V9)
              (AREF STATE 2) (LOGXOR (AREF STATE 2) V2 V10)
              (AREF STATE 3) (LOGXOR (AREF STATE 3) V3 V11)
              (AREF STATE 4) (LOGXOR (AREF STATE 4) V4 V12)
              (AREF STATE 5) (LOGXOR (AREF STATE 5) V5 V13)
              (AREF STATE 6) (LOGXOR (AREF STATE 6) V6 V14)
              (AREF STATE 7) (LOGXOR (AREF STATE 7) V7 V15))))
    (VALUES))

[ironclad/src/digests/blake2.lisp:192]
  (DEFUN BLAKE2-UPDATE (STATE INPUT START END FINAL)
    (DECLARE (TYPE BLAKE2 STATE)
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) INPUT)
             (TYPE FIXNUM START END)
             (TYPE BOOLEAN FINAL)
             (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (DEBUG 0)))
    (LET ((BLAKE2-STATE (BLAKE2-STATE STATE))
          (OFFSET (BLAKE2-OFFSET STATE))
          (BUFFER (BLAKE2-BUFFER STATE))
          (BUFFER-INDEX (BLAKE2-BUFFER-INDEX STATE))
          (LENGTH (- END START))
          (N 0))
      (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (8)) BLAKE2-STATE)
               (TYPE (UNSIGNED-BYTE 128) OFFSET)
               (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (128)) BUFFER)
               (TYPE (INTEGER 0 128) BUFFER-INDEX)
               (TYPE FIXNUM LENGTH N))
      (SETF N (MIN LENGTH (- +BLAKE2-BLOCK-SIZE+ BUFFER-INDEX)))
      (REPLACE BUFFER INPUT :START1 BUFFER-INDEX :START2 START :END2
               (+ START N))
      (UNLESS FINAL (INCF OFFSET N))
      (INCF BUFFER-INDEX N)
      (INCF START N)
      (DECF LENGTH N)
      (WHEN
          (AND (= BUFFER-INDEX +BLAKE2-BLOCK-SIZE+) (OR FINAL (PLUSP LENGTH)))
        (BLAKE2-ROUNDS BLAKE2-STATE BUFFER 0 OFFSET FINAL)
        (SETF BUFFER-INDEX 0))
      (UNLESS FINAL
        (LOOP UNTIL (<= LENGTH +BLAKE2-BLOCK-SIZE+)
              DO (INCF OFFSET +BLAKE2-BLOCK-SIZE+) (BLAKE2-ROUNDS BLAKE2-STATE
                                                    INPUT START OFFSET
                                                    NIL) (INCF START
                                                               +BLAKE2-BLOCK-SIZE+) (DECF
                                                                                     LENGTH
                                                                                     +BLAKE2-BLOCK-SIZE+)))
      (WHEN (PLUSP LENGTH)
        (REPLACE BUFFER INPUT :END1 LENGTH :START2 START)
        (INCF OFFSET LENGTH)
        (INCF BUFFER-INDEX LENGTH))
      (SETF (BLAKE2-OFFSET STATE) OFFSET
            (BLAKE2-BUFFER-INDEX STATE) BUFFER-INDEX)
      (VALUES)))

[ironclad/src/digests/blake2s.lisp:62]
  (DEFUN BLAKE2S-ROUNDS (STATE INPUT START OFFSET FINAL)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 32) (8)) STATE)
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) INPUT)
             (TYPE FIXNUM START)
             (TYPE (UNSIGNED-BYTE 64) OFFSET)
             (TYPE BOOLEAN FINAL)
             (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (DEBUG 0)))
    (MACROLET ((BLAKE2S-MIXING (VA VB VC VD X Y)
                 (ECLECTOR.READER:QUASIQUOTE
                  (MULTIPLE-VALUE-SETQ
                      ((ECLECTOR.READER:UNQUOTE VA)
                       (ECLECTOR.READER:UNQUOTE VB)
                       (ECLECTOR.READER:UNQUOTE VC)
                       (ECLECTOR.READER:UNQUOTE VD))
                    (FAST-BLAKE2S-MIXING (ECLECTOR.READER:UNQUOTE VA)
                     (ECLECTOR.READER:UNQUOTE VB) (ECLECTOR.READER:UNQUOTE VC)
                     (ECLECTOR.READER:UNQUOTE VD) (ECLECTOR.READER:UNQUOTE X)
                     (ECLECTOR.READER:UNQUOTE Y))))))
      (LET ((V0 (AREF STATE 0))
            (V1 (AREF STATE 1))
            (V2 (AREF STATE 2))
            (V3 (AREF STATE 3))
            (V4 (AREF STATE 4))
            (V5 (AREF STATE 5))
            (V6 (AREF STATE 6))
            (V7 (AREF STATE 7))
            (V8 (AREF +BLAKE2S-IV+ 0))
            (V9 (AREF +BLAKE2S-IV+ 1))
            (V10 (AREF +BLAKE2S-IV+ 2))
            (V11 (AREF +BLAKE2S-IV+ 3))
            (V12 (AREF +BLAKE2S-IV+ 4))
            (V13 (AREF +BLAKE2S-IV+ 5))
            (V14 (AREF +BLAKE2S-IV+ 6))
            (V15 (AREF +BLAKE2S-IV+ 7))
            (M
             (MAKE-ARRAY 16 :ELEMENT-TYPE '(UNSIGNED-BYTE 32) :INITIAL-ELEMENT
                         0)))
        (DECLARE
         (TYPE (UNSIGNED-BYTE 32) V0 V1 V2 V3 V4 V5 V6 V7 V8 V9 V10 V11 V12 V13
          V14 V15)
         (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 32) (16)) M)
         (DYNAMIC-EXTENT M))
        (SETF V12 (LOGXOR V12 (LDB (BYTE 32 0) OFFSET))
              V13 (LOGXOR V13 (LDB (BYTE 32 32) OFFSET)))
        (WHEN FINAL (SETF V14 (LOGXOR V14 4294967295)))
        (DOTIMES-UNROLLED (I 16)
         (SETF (AREF M I) (UB32REF/LE INPUT (+ START (* I 4)))))
        (DOTIMES-UNROLLED (I +BLAKE2S-ROUNDS+)
         (BLAKE2S-MIXING V0 V4 V8 V12 (AREF M (AREF +BLAKE2S-SIGMA+ I 0))
          (AREF M (AREF +BLAKE2S-SIGMA+ I 1)))
         (BLAKE2S-MIXING V1 V5 V9 V13 (AREF M (AREF +BLAKE2S-SIGMA+ I 2))
          (AREF M (AREF +BLAKE2S-SIGMA+ I 3)))
         (BLAKE2S-MIXING V2 V6 V10 V14 (AREF M (AREF +BLAKE2S-SIGMA+ I 4))
          (AREF M (AREF +BLAKE2S-SIGMA+ I 5)))
         (BLAKE2S-MIXING V3 V7 V11 V15 (AREF M (AREF +BLAKE2S-SIGMA+ I 6))
          (AREF M (AREF +BLAKE2S-SIGMA+ I 7)))
         (BLAKE2S-MIXING V0 V5 V10 V15 (AREF M (AREF +BLAKE2S-SIGMA+ I 8))
          (AREF M (AREF +BLAKE2S-SIGMA+ I 9)))
         (BLAKE2S-MIXING V1 V6 V11 V12 (AREF M (AREF +BLAKE2S-SIGMA+ I 10))
          (AREF M (AREF +BLAKE2S-SIGMA+ I 11)))
         (BLAKE2S-MIXING V2 V7 V8 V13 (AREF M (AREF +BLAKE2S-SIGMA+ I 12))
          (AREF M (AREF +BLAKE2S-SIGMA+ I 13)))
         (BLAKE2S-MIXING V3 V4 V9 V14 (AREF M (AREF +BLAKE2S-SIGMA+ I 14))
          (AREF M (AREF +BLAKE2S-SIGMA+ I 15))))
        (SETF (AREF STATE 0) (LOGXOR (AREF STATE 0) V0 V8)
              (AREF STATE 1) (LOGXOR (AREF STATE 1) V1 V9)
              (AREF STATE 2) (LOGXOR (AREF STATE 2) V2 V10)
              (AREF STATE 3) (LOGXOR (AREF STATE 3) V3 V11)
              (AREF STATE 4) (LOGXOR (AREF STATE 4) V4 V12)
              (AREF STATE 5) (LOGXOR (AREF STATE 5) V5 V13)
              (AREF STATE 6) (LOGXOR (AREF STATE 6) V6 V14)
              (AREF STATE 7) (LOGXOR (AREF STATE 7) V7 V15))))
    (VALUES))

[ironclad/src/digests/blake2s.lisp:205]
  (DEFUN BLAKE2S-UPDATE (STATE INPUT START END FINAL)
    (DECLARE (TYPE BLAKE2S STATE)
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) INPUT)
             (TYPE FIXNUM START END)
             (TYPE BOOLEAN FINAL)
             (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (DEBUG 0)))
    (LET ((BLAKE2S-STATE (BLAKE2S-STATE STATE))
          (OFFSET (BLAKE2S-OFFSET STATE))
          (BUFFER (BLAKE2S-BUFFER STATE))
          (BUFFER-INDEX (BLAKE2S-BUFFER-INDEX STATE))
          (LENGTH (- END START))
          (N 0))
      (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 32) (8)) BLAKE2S-STATE)
               (TYPE (UNSIGNED-BYTE 64) OFFSET)
               (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (64)) BUFFER)
               (TYPE (INTEGER 0 64) BUFFER-INDEX)
               (TYPE FIXNUM LENGTH N))
      (SETF N (MIN LENGTH (- +BLAKE2S-BLOCK-SIZE+ BUFFER-INDEX)))
      (REPLACE BUFFER INPUT :START1 BUFFER-INDEX :START2 START :END2
               (+ START N))
      (UNLESS FINAL (INCF OFFSET N))
      (INCF BUFFER-INDEX N)
      (INCF START N)
      (DECF LENGTH N)
      (WHEN
          (AND (= BUFFER-INDEX +BLAKE2S-BLOCK-SIZE+) (OR FINAL (PLUSP LENGTH)))
        (BLAKE2S-ROUNDS BLAKE2S-STATE BUFFER 0 OFFSET FINAL)
        (SETF BUFFER-INDEX 0))
      (UNLESS FINAL
        (LOOP UNTIL (<= LENGTH +BLAKE2S-BLOCK-SIZE+)
              DO (INCF OFFSET +BLAKE2S-BLOCK-SIZE+) (BLAKE2S-ROUNDS
                                                     BLAKE2S-STATE INPUT START
                                                     OFFSET NIL) (INCF START
                                                                       +BLAKE2S-BLOCK-SIZE+) (DECF
                                                                                              LENGTH
                                                                                              +BLAKE2S-BLOCK-SIZE+)))
      (WHEN (PLUSP LENGTH)
        (REPLACE BUFFER INPUT :END1 LENGTH :START2 START)
        (INCF OFFSET LENGTH)
        (INCF BUFFER-INDEX LENGTH))
      (SETF (BLAKE2S-OFFSET STATE) OFFSET
            (BLAKE2S-BUFFER-INDEX STATE) BUFFER-INDEX)
      (VALUES)))

[ironclad/src/digests/digest.lisp:42]
  (DEFUN STORE-DATA-LENGTH (BLOCK LENGTH OFFSET &OPTIONAL BIG-ENDIAN-P)
    (LET ((LO
           (IF BIG-ENDIAN-P
               (1+ OFFSET)
               OFFSET))
          (HI
           (IF BIG-ENDIAN-P
               OFFSET
               (1+ OFFSET))))
      (COND ((SB-INT:FIXNUMP LENGTH) (SETF (AREF BLOCK LO) LENGTH))
            (T
             (LOCALLY
              (DECLARE (OPTIMIZE (SAFETY 0))
                       (TYPE BIGNUM LENGTH))
              (COND
               ((= (SB-BIGNUM:%BIGNUM-LENGTH LENGTH) 1)
                (SETF (AREF BLOCK LO) (SB-BIGNUM:%BIGNUM-REF LENGTH 0)))
               (T
                (SETF (AREF BLOCK LO) (SB-BIGNUM:%BIGNUM-REF LENGTH 0)
                      (AREF BLOCK HI) (SB-BIGNUM:%BIGNUM-REF LENGTH 1)))))))
      (COND
       ((#S(FORMGREP:SYMREF :NAME "FIXNUMP" :QUALIFIER "EXT") LENGTH)
        (SETF (AREF BLOCK LO) LENGTH))
       (T
        (LOCALLY
         (DECLARE (OPTIMIZE (SAFETY 0))
                  (TYPE
                   #S(FORMGREP:SYMREF :NAME "BIGNUM-TYPE" :QUALIFIER "BIGNUM")
                   LENGTH))
         (COND
          ((=
            (#S(FORMGREP:SYMREF :NAME "%BIGNUM-LENGTH" :QUALIFIER "BIGNUM")
             LENGTH)
            1)
           (SETF (AREF BLOCK LO)
                   (#S(FORMGREP:SYMREF :NAME "%BIGNUM-REF" :QUALIFIER "BIGNUM")
                    LENGTH 0)))
          (T
           (SETF (AREF BLOCK LO)
                   (#S(FORMGREP:SYMREF :NAME "%BIGNUM-REF" :QUALIFIER "BIGNUM")
                    LENGTH 0)
                 (AREF BLOCK HI)
                   (#S(FORMGREP:SYMREF :NAME "%BIGNUM-REF" :QUALIFIER "BIGNUM")
                    LENGTH 1)))))))))

[ironclad/src/digests/groestl.lisp:1085]
  (DEFUN GROESTL-RND512P (X Y R)
    "Compute a round in P (short variants)."
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (NIL)) X Y)
             (TYPE (UNSIGNED-BYTE 64) R)
             (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (DEBUG 0)))
    (SETF (AREF X 0) (LOGXOR (AREF X 0) 0 R)
          (AREF X 1) (LOGXOR (AREF X 1) 1152921504606846976 R)
          (AREF X 2) (LOGXOR (AREF X 2) 2305843009213693952 R)
          (AREF X 3) (LOGXOR (AREF X 3) 3458764513820540928 R)
          (AREF X 4) (LOGXOR (AREF X 4) 4611686018427387904 R)
          (AREF X 5) (LOGXOR (AREF X 5) 5764607523034234880 R)
          (AREF X 6) (LOGXOR (AREF X 6) 6917529027641081856 R)
          (AREF X 7) (LOGXOR (AREF X 7) 8070450532247928832 R))
    (GROESTL-COLUMN X Y 0 0 1 2 3 4 5 6 7)
    (GROESTL-COLUMN X Y 1 1 2 3 4 5 6 7 0)
    (GROESTL-COLUMN X Y 2 2 3 4 5 6 7 0 1)
    (GROESTL-COLUMN X Y 3 3 4 5 6 7 0 1 2)
    (GROESTL-COLUMN X Y 4 4 5 6 7 0 1 2 3)
    (GROESTL-COLUMN X Y 5 5 6 7 0 1 2 3 4)
    (GROESTL-COLUMN X Y 6 6 7 0 1 2 3 4 5)
    (GROESTL-COLUMN X Y 7 7 0 1 2 3 4 5 6)
    (VALUES))

[ironclad/src/digests/groestl.lisp:1113]
  (DEFUN GROESTL-RND512Q (X Y R)
    "Compute a round in Q (short variants)."
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (NIL)) X Y)
             (TYPE (UNSIGNED-BYTE 64) R)
             (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (DEBUG 0)))
    (SETF (AREF X 0) (LOGXOR (AREF X 0) 18446744073709551615 R)
          (AREF X 1) (LOGXOR (AREF X 1) 18446744073709551599 R)
          (AREF X 2) (LOGXOR (AREF X 2) 18446744073709551583 R)
          (AREF X 3) (LOGXOR (AREF X 3) 18446744073709551567 R)
          (AREF X 4) (LOGXOR (AREF X 4) 18446744073709551551 R)
          (AREF X 5) (LOGXOR (AREF X 5) 18446744073709551535 R)
          (AREF X 6) (LOGXOR (AREF X 6) 18446744073709551519 R)
          (AREF X 7) (LOGXOR (AREF X 7) 18446744073709551503 R))
    (GROESTL-COLUMN X Y 0 1 3 5 7 0 2 4 6)
    (GROESTL-COLUMN X Y 1 2 4 6 0 1 3 5 7)
    (GROESTL-COLUMN X Y 2 3 5 7 1 2 4 6 0)
    (GROESTL-COLUMN X Y 3 4 6 0 2 3 5 7 1)
    (GROESTL-COLUMN X Y 4 5 7 1 3 4 6 0 2)
    (GROESTL-COLUMN X Y 5 6 0 2 4 5 7 1 3)
    (GROESTL-COLUMN X Y 6 7 1 3 5 6 0 2 4)
    (GROESTL-COLUMN X Y 7 0 2 4 6 7 1 3 5)
    (VALUES))

[ironclad/src/digests/groestl.lisp:1141]
  (DEFUN GROESTL-RND1024P (X Y R)
    "Compute a round in P (long variants)."
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (NIL)) X Y)
             (TYPE (UNSIGNED-BYTE 64) R)
             (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (DEBUG 0)))
    (SETF (AREF X 0) (LOGXOR (AREF X 0) 0 R)
          (AREF X 1) (LOGXOR (AREF X 1) 1152921504606846976 R)
          (AREF X 2) (LOGXOR (AREF X 2) 2305843009213693952 R)
          (AREF X 3) (LOGXOR (AREF X 3) 3458764513820540928 R)
          (AREF X 4) (LOGXOR (AREF X 4) 4611686018427387904 R)
          (AREF X 5) (LOGXOR (AREF X 5) 5764607523034234880 R)
          (AREF X 6) (LOGXOR (AREF X 6) 6917529027641081856 R)
          (AREF X 7) (LOGXOR (AREF X 7) 8070450532247928832 R)
          (AREF X 8) (LOGXOR (AREF X 8) 9223372036854775808 R)
          (AREF X 9) (LOGXOR (AREF X 9) 10376293541461622784 R)
          (AREF X 10) (LOGXOR (AREF X 10) 11529215046068469760 R)
          (AREF X 11) (LOGXOR (AREF X 11) 12682136550675316736 R)
          (AREF X 12) (LOGXOR (AREF X 12) 13835058055282163712 R)
          (AREF X 13) (LOGXOR (AREF X 13) 14987979559889010688 R)
          (AREF X 14) (LOGXOR (AREF X 14) 16140901064495857664 R)
          (AREF X 15) (LOGXOR (AREF X 15) 17293822569102704640 R))
    (GROESTL-COLUMN X Y 15 15 0 1 2 3 4 5 10)
    (GROESTL-COLUMN X Y 14 14 15 0 1 2 3 4 9)
    (GROESTL-COLUMN X Y 13 13 14 15 0 1 2 3 8)
    (GROESTL-COLUMN X Y 12 12 13 14 15 0 1 2 7)
    (GROESTL-COLUMN X Y 11 11 12 13 14 15 0 1 6)
    (GROESTL-COLUMN X Y 10 10 11 12 13 14 15 0 5)
    (GROESTL-COLUMN X Y 9 9 10 11 12 13 14 15 4)
    (GROESTL-COLUMN X Y 8 8 9 10 11 12 13 14 3)
    (GROESTL-COLUMN X Y 7 7 8 9 10 11 12 13 2)
    (GROESTL-COLUMN X Y 6 6 7 8 9 10 11 12 1)
    (GROESTL-COLUMN X Y 5 5 6 7 8 9 10 11 0)
    (GROESTL-COLUMN X Y 4 4 5 6 7 8 9 10 15)
    (GROESTL-COLUMN X Y 3 3 4 5 6 7 8 9 14)
    (GROESTL-COLUMN X Y 2 2 3 4 5 6 7 8 13)
    (GROESTL-COLUMN X Y 1 1 2 3 4 5 6 7 12)
    (GROESTL-COLUMN X Y 0 0 1 2 3 4 5 6 11)
    (VALUES))

[ironclad/src/digests/groestl.lisp:1185]
  (DEFUN GROESTL-RND1024Q (X Y R)
    "Compute a round in Q (long variants)."
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (NIL)) X Y)
             (TYPE (UNSIGNED-BYTE 64) R)
             (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (DEBUG 0)))
    (SETF (AREF X 0) (LOGXOR (AREF X 0) 18446744073709551615 R)
          (AREF X 1) (LOGXOR (AREF X 1) 18446744073709551599 R)
          (AREF X 2) (LOGXOR (AREF X 2) 18446744073709551583 R)
          (AREF X 3) (LOGXOR (AREF X 3) 18446744073709551567 R)
          (AREF X 4) (LOGXOR (AREF X 4) 18446744073709551551 R)
          (AREF X 5) (LOGXOR (AREF X 5) 18446744073709551535 R)
          (AREF X 6) (LOGXOR (AREF X 6) 18446744073709551519 R)
          (AREF X 7) (LOGXOR (AREF X 7) 18446744073709551503 R)
          (AREF X 8) (LOGXOR (AREF X 8) 18446744073709551487 R)
          (AREF X 9) (LOGXOR (AREF X 9) 18446744073709551471 R)
          (AREF X 10) (LOGXOR (AREF X 10) 18446744073709551455 R)
          (AREF X 11) (LOGXOR (AREF X 11) 18446744073709551439 R)
          (AREF X 12) (LOGXOR (AREF X 12) 18446744073709551423 R)
          (AREF X 13) (LOGXOR (AREF X 13) 18446744073709551407 R)
          (AREF X 14) (LOGXOR (AREF X 14) 18446744073709551391 R)
          (AREF X 15) (LOGXOR (AREF X 15) 18446744073709551375 R))
    (GROESTL-COLUMN X Y 15 0 2 4 10 15 1 3 5)
    (GROESTL-COLUMN X Y 14 15 1 3 9 14 0 2 4)
    (GROESTL-COLUMN X Y 13 14 0 2 8 13 15 1 3)
    (GROESTL-COLUMN X Y 12 13 15 1 7 12 14 0 2)
    (GROESTL-COLUMN X Y 11 12 14 0 6 11 13 15 1)
    (GROESTL-COLUMN X Y 10 11 13 15 5 10 12 14 0)
    (GROESTL-COLUMN X Y 9 10 12 14 4 9 11 13 15)
    (GROESTL-COLUMN X Y 8 9 11 13 3 8 10 12 14)
    (GROESTL-COLUMN X Y 7 8 10 12 2 7 9 11 13)
    (GROESTL-COLUMN X Y 6 7 9 11 1 6 8 10 12)
    (GROESTL-COLUMN X Y 5 6 8 10 0 5 7 9 11)
    (GROESTL-COLUMN X Y 4 5 7 9 15 4 6 8 10)
    (GROESTL-COLUMN X Y 3 4 6 8 14 3 5 7 9)
    (GROESTL-COLUMN X Y 2 3 5 7 13 2 4 6 8)
    (GROESTL-COLUMN X Y 1 2 4 6 12 1 3 5 7)
    (GROESTL-COLUMN X Y 0 1 3 5 11 0 2 4 6)
    (VALUES))

[ironclad/src/digests/groestl.lisp:1229]
  (DEFUN GROESTL-F512 (STATE INPUT START)
    "The compression function (short variants)."
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (NIL)) STATE)
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) INPUT)
             (TYPE (UNSIGNED-BYTE 64) START)
             (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (DEBUG 0)))
    (LET ((Y (MAKE-ARRAY NIL :ELEMENT-TYPE '(UNSIGNED-BYTE 64)))
          (Z (MAKE-ARRAY NIL :ELEMENT-TYPE '(UNSIGNED-BYTE 64)))
          (OUTQ (MAKE-ARRAY NIL :ELEMENT-TYPE '(UNSIGNED-BYTE 64)))
          (INP (MAKE-ARRAY NIL :ELEMENT-TYPE '(UNSIGNED-BYTE 64))))
      (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (NIL)) Y Z OUTQ INP)
               (DYNAMIC-EXTENT Y Z OUTQ INP))
      (DOTIMES (I +GROESTL-COLS-512+)
        (DECLARE (TYPE (INTEGER 0 NIL) I))
        (LET ((N (UB64REF/BE INPUT (+ START (* 8 I)))))
          (DECLARE (TYPE (UNSIGNED-BYTE 64) N))
          (SETF (AREF Z I) N
                (AREF INP I) (LOGXOR (AREF STATE I) N))))
      (GROESTL-RND512Q Z Y 0)
      (LOOP FOR I FROM 1 BELOW (1- +GROESTL-ROUNDS-512+) BY 2
            DO (GROESTL-RND512Q Y Z I) (GROESTL-RND512Q Z Y (1+ I)))
      (GROESTL-RND512Q Y OUTQ (1- +GROESTL-ROUNDS-512+))
      (GROESTL-RND512P INP Z 0)
      (LOOP FOR I OF-TYPE FIXNUM FROM 1 BELOW (1- +GROESTL-ROUNDS-512+) BY 2
            DO (GROESTL-RND512P Z Y (ASH I 56)) (GROESTL-RND512P Y Z
                                                 (ASH (1+ I) 56)))
      (GROESTL-RND512P Z Y (ASH (1- +GROESTL-ROUNDS-512+) 56))
      (DOTIMES (I +GROESTL-COLS-512+)
        (DECLARE (TYPE (INTEGER 0 NIL) I))
        (SETF (AREF STATE I) (LOGXOR (AREF STATE I) (AREF OUTQ I) (AREF Y I))))
      (VALUES)))

[ironclad/src/digests/groestl.lisp:1270]
  (DEFUN GROESTL-F1024 (STATE INPUT START)
    "The compression function (long variants)."
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (NIL)) STATE)
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) INPUT)
             (TYPE (UNSIGNED-BYTE 64) START)
             (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (DEBUG 0)))
    (LET ((Y (MAKE-ARRAY NIL :ELEMENT-TYPE '(UNSIGNED-BYTE 64)))
          (Z (MAKE-ARRAY NIL :ELEMENT-TYPE '(UNSIGNED-BYTE 64)))
          (OUTQ (MAKE-ARRAY NIL :ELEMENT-TYPE '(UNSIGNED-BYTE 64)))
          (INP (MAKE-ARRAY NIL :ELEMENT-TYPE '(UNSIGNED-BYTE 64))))
      (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (NIL)) Y Z OUTQ INP)
               (DYNAMIC-EXTENT Y Z OUTQ INP))
      (DOTIMES (I +GROESTL-COLS-1024+)
        (DECLARE (TYPE (INTEGER 0 NIL) I))
        (LET ((N (UB64REF/BE INPUT (+ START (* 8 I)))))
          (DECLARE (TYPE (UNSIGNED-BYTE 64) N))
          (SETF (AREF Z I) N
                (AREF INP I) (LOGXOR (AREF STATE I) N))))
      (GROESTL-RND1024Q Z Y 0)
      (LOOP FOR I FROM 1 BELOW (1- +GROESTL-ROUNDS-1024+) BY 2
            DO (GROESTL-RND1024Q Y Z I) (GROESTL-RND1024Q Z Y (1+ I)))
      (GROESTL-RND1024Q Y OUTQ (1- +GROESTL-ROUNDS-1024+))
      (GROESTL-RND1024P INP Z 0)
      (LOOP FOR I OF-TYPE FIXNUM FROM 1 BELOW (1- +GROESTL-ROUNDS-1024+) BY 2
            DO (GROESTL-RND1024P Z Y (ASH I 56)) (GROESTL-RND1024P Y Z
                                                  (ASH (1+ I) 56)))
      (GROESTL-RND1024P Z Y (ASH (1- +GROESTL-ROUNDS-1024+) 56))
      (DOTIMES (I +GROESTL-COLS-1024+)
        (DECLARE (TYPE (INTEGER 0 NIL) I))
        (SETF (AREF STATE I) (LOGXOR (AREF STATE I) (AREF OUTQ I) (AREF Y I))))
      (VALUES)))

[ironclad/src/digests/groestl.lisp:1382]
  (DEFUN GROESTL-UPDATE (STATE INPUT START END)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) INPUT)
             (TYPE (UNSIGNED-BYTE 64) START END)
             (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (DEBUG 0)))
    (LET* ((GROESTL-STATE (GROESTL-STATE STATE))
           (BUFFER (GROESTL-BUFFER STATE))
           (BUFFER-INDEX (GROESTL-BUFFER-INDEX STATE))
           (BLOCK-COUNTER (GROESTL-BLOCK-COUNTER STATE))
           (BLOCK-SIZE (LENGTH BUFFER))
           (TRANSFORM
            (IF (= BLOCK-SIZE +GROESTL-SIZE-512+)
                #'GROESTL-F512
                #'GROESTL-F1024))
           (LENGTH (- END START))
           (N 0))
      (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (*)) GROESTL-STATE)
               (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) BUFFER)
               (TYPE (INTEGER 0 NIL) BLOCK-SIZE BUFFER-INDEX N)
               (TYPE (UNSIGNED-BYTE 64) LENGTH))
      (SETF N (MIN LENGTH (- BLOCK-SIZE BUFFER-INDEX)))
      (REPLACE BUFFER INPUT :START1 BUFFER-INDEX :START2 START :END2
               (+ START N))
      (INCF BUFFER-INDEX N)
      (INCF START N)
      (DECF LENGTH N)
      (WHEN (= BUFFER-INDEX BLOCK-SIZE)
        (FUNCALL TRANSFORM GROESTL-STATE BUFFER 0)
        (SETF BUFFER-INDEX 0)
        (INCF BLOCK-COUNTER))
      (LOOP UNTIL (< LENGTH BLOCK-SIZE)
            DO (FUNCALL TRANSFORM GROESTL-STATE INPUT START) (INCF
                                                              BLOCK-COUNTER) (INCF
                                                                              START
                                                                              BLOCK-SIZE) (DECF
                                                                                           LENGTH
                                                                                           BLOCK-SIZE))
      (WHEN (PLUSP LENGTH)
        (REPLACE BUFFER INPUT :END1 LENGTH :START2 START)
        (SETF BUFFER-INDEX LENGTH))
      (SETF (GROESTL-BLOCK-COUNTER STATE) BLOCK-COUNTER
            (GROESTL-BUFFER-INDEX STATE) BUFFER-INDEX)
      (VALUES)))

[ironclad/src/digests/groestl.lisp:1432]
  (DEFUN GROESTL-FINALIZE (STATE DIGEST DIGEST-START)
    (LET* ((DIGEST-LENGTH (DIGEST-LENGTH STATE))
           (GROESTL-STATE (GROESTL-STATE STATE))
           (BUFFER (GROESTL-BUFFER STATE))
           (BUFFER-INDEX (GROESTL-BUFFER-INDEX STATE))
           (BLOCK-COUNTER (GROESTL-BLOCK-COUNTER STATE))
           (BLOCK-SIZE (LENGTH BUFFER))
           (TRANSFORM
            (IF (= BLOCK-SIZE +GROESTL-SIZE-512+)
                #'GROESTL-F512
                #'GROESTL-F1024)))
      (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (*)) GROESTL-STATE)
               (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) BUFFER)
               (TYPE (INTEGER 0 NIL) BLOCK-SIZE BUFFER-INDEX)
               (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (DEBUG 0)))
      (SETF (AREF BUFFER BUFFER-INDEX) 128)
      (INCF BUFFER-INDEX)
      (WHEN (> BUFFER-INDEX (- BLOCK-SIZE +GROESTL-LENGTH-FIELD-LENGTH+))
        (FILL BUFFER 0 :START BUFFER-INDEX)
        (FUNCALL TRANSFORM GROESTL-STATE BUFFER 0)
        (INCF BLOCK-COUNTER)
        (SETF BUFFER-INDEX 0))
      (FILL BUFFER 0 :START BUFFER-INDEX)
      (SETF BUFFER-INDEX (- BLOCK-SIZE +GROESTL-LENGTH-FIELD-LENGTH+))
      (INCF BLOCK-COUNTER)
      (SETF (UB64REF/BE BUFFER BUFFER-INDEX) BLOCK-COUNTER)
      (FUNCALL TRANSFORM GROESTL-STATE BUFFER 0)
      (IF (= BLOCK-SIZE +GROESTL-SIZE-512+)
          (LET ((TEMP (COPY-SEQ GROESTL-STATE))
                (Y
                 (MAKE-ARRAY +GROESTL-COLS-512+ :ELEMENT-TYPE
                             '(UNSIGNED-BYTE 64)))
                (Z
                 (MAKE-ARRAY +GROESTL-COLS-512+ :ELEMENT-TYPE
                             '(UNSIGNED-BYTE 64))))
            (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (NIL)) TEMP Y Z)
                     (DYNAMIC-EXTENT TEMP Y Z))
            (GROESTL-RND512P TEMP Z 0)
            (LOOP FOR I FROM 1 BELOW (1- +GROESTL-ROUNDS-512+) BY 2
                  DO (GROESTL-RND512P Z Y (ASH I 56)) (GROESTL-RND512P Y Z
                                                       (ASH (1+ I) 56)))
            (GROESTL-RND512P Z TEMP (ASH (1- +GROESTL-ROUNDS-512+) 56))
            (DOTIMES (I +GROESTL-COLS-512+)
              (SETF (AREF GROESTL-STATE I)
                      (LOGXOR (AREF GROESTL-STATE I) (AREF TEMP I)))))
          (LET ((TEMP (COPY-SEQ GROESTL-STATE))
                (Y
                 (MAKE-ARRAY +GROESTL-COLS-1024+ :ELEMENT-TYPE
                             '(UNSIGNED-BYTE 64)))
                (Z
                 (MAKE-ARRAY +GROESTL-COLS-1024+ :ELEMENT-TYPE
                             '(UNSIGNED-BYTE 64))))
            (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (NIL)) TEMP Y Z)
                     (DYNAMIC-EXTENT TEMP Y Z))
            (GROESTL-RND1024P TEMP Y 0)
            (LOOP FOR I FROM 1 BELOW (1- +GROESTL-ROUNDS-1024+) BY 2
                  DO (GROESTL-RND1024P Y Z (ASH I 56)) (GROESTL-RND1024P Z Y
                                                        (ASH (1+ I) 56)))
            (GROESTL-RND1024P Y TEMP (ASH (1- +GROESTL-ROUNDS-1024+) 56))
            (DOTIMES (I +GROESTL-COLS-1024+)
              (SETF (AREF GROESTL-STATE I)
                      (LOGXOR (AREF GROESTL-STATE I) (AREF TEMP I))))))
      (LET ((OUTPUT (MAKE-ARRAY BLOCK-SIZE :ELEMENT-TYPE '(UNSIGNED-BYTE 8))))
        (DOTIMES (I (LENGTH GROESTL-STATE))
          (SETF (UB64REF/BE OUTPUT (* I 8)) (AREF GROESTL-STATE I)))
        (REPLACE DIGEST OUTPUT :START1 DIGEST-START :START2
                 (- BLOCK-SIZE DIGEST-LENGTH))
        DIGEST)))

[ironclad/src/digests/jh.lisp:236]
  (DEFUN JH-E8 (S)
    "The bijective function."
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (16)) S)
             (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (DEBUG 0)))
    (LET ((CONSTANTS (LOAD-TIME-VALUE +JH-ROUND-CONSTANTS+ T))
          (V0 (AREF S 0))
          (V1 (AREF S 1))
          (V2 (AREF S 2))
          (V3 (AREF S 3))
          (V4 (AREF S 4))
          (V5 (AREF S 5))
          (V6 (AREF S 6))
          (V7 (AREF S 7))
          (V8 (AREF S 8))
          (V9 (AREF S 9))
          (V10 (AREF S 10))
          (V11 (AREF S 11))
          (V12 (AREF S 12))
          (V13 (AREF S 13))
          (V14 (AREF S 14))
          (V15 (AREF S 15))
          (T0 0)
          (T1 0))
      (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (168)) CONSTANTS)
               (TYPE (UNSIGNED-BYTE 64) V0 V1 V2 V3 V4 V5 V6 V7 V8 V9 V10 V11
                V12 V13 V14 V15 T0 T1))
      (DO ((ROUND 0 (+ ROUND 7)))
          ((= ROUND +JH-ROUNDS+))
        (DECLARE (TYPE (INTEGER 0 42) ROUND))
        (MACROLET ((CONSTANT (I J)
                     (ECLECTOR.READER:QUASIQUOTE
                      (AREF CONSTANTS
                            (+ (* 4 (ECLECTOR.READER:UNQUOTE I))
                               (ECLECTOR.READER:UNQUOTE J)))))
                   (SUB-ROUND (I)
                     (LET ((SWAP
                            (ECASE I
                              ((0) 'JH-SWAP-1)
                              ((1) 'JH-SWAP-2)
                              ((2) 'JH-SWAP-4)
                              ((3) 'JH-SWAP-8)
                              ((4) 'JH-SWAP-16)
                              ((5) 'JH-SWAP-32)
                              ((6) NIL))))
                       (ECLECTOR.READER:QUASIQUOTE
                        (PROGN
                         (JH-SS V0 V4 V8 V12 V2 V6 V10 V14
                          (CONSTANT (+ ROUND (ECLECTOR.READER:UNQUOTE I)) 0)
                          (CONSTANT (+ ROUND (ECLECTOR.READER:UNQUOTE I)) 2) T0
                          T1)
                         (JH-L V0 V4 V8 V12 V2 V6 V10 V14)
                         (ECLECTOR.READER:UNQUOTE
                          (WHEN SWAP
                            (ECLECTOR.READER:QUASIQUOTE
                             ((ECLECTOR.READER:UNQUOTE SWAP) V2))))
                         (ECLECTOR.READER:UNQUOTE
                          (WHEN SWAP
                            (ECLECTOR.READER:QUASIQUOTE
                             ((ECLECTOR.READER:UNQUOTE SWAP) V6))))
                         (ECLECTOR.READER:UNQUOTE
                          (WHEN SWAP
                            (ECLECTOR.READER:QUASIQUOTE
                             ((ECLECTOR.READER:UNQUOTE SWAP) V10))))
                         (ECLECTOR.READER:UNQUOTE
                          (WHEN SWAP
                            (ECLECTOR.READER:QUASIQUOTE
                             ((ECLECTOR.READER:UNQUOTE SWAP) V14))))
                         (JH-SS V1 V5 V9 V13 V3 V7 V11 V15
                          (CONSTANT (+ ROUND (ECLECTOR.READER:UNQUOTE I)) 1)
                          (CONSTANT (+ ROUND (ECLECTOR.READER:UNQUOTE I)) 3) T0
                          T1)
                         (JH-L V1 V5 V9 V13 V3 V7 V11 V15)
                         (ECLECTOR.READER:UNQUOTE
                          (WHEN SWAP
                            (ECLECTOR.READER:QUASIQUOTE
                             ((ECLECTOR.READER:UNQUOTE SWAP) V3))))
                         (ECLECTOR.READER:UNQUOTE
                          (WHEN SWAP
                            (ECLECTOR.READER:QUASIQUOTE
                             ((ECLECTOR.READER:UNQUOTE SWAP) V7))))
                         (ECLECTOR.READER:UNQUOTE
                          (WHEN SWAP
                            (ECLECTOR.READER:QUASIQUOTE
                             ((ECLECTOR.READER:UNQUOTE SWAP) V11))))
                         (ECLECTOR.READER:UNQUOTE
                          (WHEN SWAP
                            (ECLECTOR.READER:QUASIQUOTE
                             ((ECLECTOR.READER:UNQUOTE SWAP) V15)))))))))
          (SUB-ROUND 0)
          (SUB-ROUND 1)
          (SUB-ROUND 2)
          (SUB-ROUND 3)
          (SUB-ROUND 4)
          (SUB-ROUND 5)
          (SUB-ROUND 6)
          (ROTATEF V2 V3)
          (ROTATEF V6 V7)
          (ROTATEF V10 V11)
          (ROTATEF V14 V15)))
      (SETF (AREF S 0) V0
            (AREF S 1) V1
            (AREF S 2) V2
            (AREF S 3) V3
            (AREF S 4) V4
            (AREF S 5) V5
            (AREF S 6) V6
            (AREF S 7) V7
            (AREF S 8) V8
            (AREF S 9) V9
            (AREF S 10) V10
            (AREF S 11) V11
            (AREF S 12) V12
            (AREF S 13) V13
            (AREF S 14) V14
            (AREF S 15) V15)
      (VALUES)))

[ironclad/src/digests/kupyna.lisp:22]
  (DEFUN KUPYNA-G256 (X Y)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (*)) X Y)
             (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (MACROLET ((M (A B C)
                 (ECLECTOR.READER:QUASIQUOTE
                  (AREF +KUPYNA-T+ (ECLECTOR.READER:UNQUOTE A)
                        (LOGAND
                         (MOD64ASH (AREF X (ECLECTOR.READER:UNQUOTE B))
                          (ECLECTOR.READER:UNQUOTE C))
                         255)))))
      (SETF (AREF Y 0)
              (LOGXOR (M 0 0 0) (M 1 7 -8) (M 2 6 -16) (M 3 5 -24) (M 4 4 -32)
                      (M 5 3 -40) (M 6 2 -48) (M 7 1 -56)))
      (SETF (AREF Y 1)
              (LOGXOR (M 0 1 0) (M 1 0 -8) (M 2 7 -16) (M 3 6 -24) (M 4 5 -32)
                      (M 5 4 -40) (M 6 3 -48) (M 7 2 -56)))
      (SETF (AREF Y 2)
              (LOGXOR (M 0 2 0) (M 1 1 -8) (M 2 0 -16) (M 3 7 -24) (M 4 6 -32)
                      (M 5 5 -40) (M 6 4 -48) (M 7 3 -56)))
      (SETF (AREF Y 3)
              (LOGXOR (M 0 3 0) (M 1 2 -8) (M 2 1 -16) (M 3 0 -24) (M 4 7 -32)
                      (M 5 6 -40) (M 6 5 -48) (M 7 4 -56)))
      (SETF (AREF Y 4)
              (LOGXOR (M 0 4 0) (M 1 3 -8) (M 2 2 -16) (M 3 1 -24) (M 4 0 -32)
                      (M 5 7 -40) (M 6 6 -48) (M 7 5 -56)))
      (SETF (AREF Y 5)
              (LOGXOR (M 0 5 0) (M 1 4 -8) (M 2 3 -16) (M 3 2 -24) (M 4 1 -32)
                      (M 5 0 -40) (M 6 7 -48) (M 7 6 -56)))
      (SETF (AREF Y 6)
              (LOGXOR (M 0 6 0) (M 1 5 -8) (M 2 4 -16) (M 3 3 -24) (M 4 2 -32)
                      (M 5 1 -40) (M 6 0 -48) (M 7 7 -56)))
      (SETF (AREF Y 7)
              (LOGXOR (M 0 7 0) (M 1 6 -8) (M 2 5 -16) (M 3 4 -24) (M 4 3 -32)
                      (M 5 2 -40) (M 6 1 -48) (M 7 0 -56))))
    (VALUES))

[ironclad/src/digests/kupyna.lisp:54]
  (DEFUN KUPYNA-ROUND-P256 (X Y N)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (*)) X Y)
             (TYPE (UNSIGNED-BYTE 64) N)
             (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (DOTIMES-UNROLLED (I 8)
     (SETF (AREF X I) (LOGXOR (AREF X I) (MOD64ASH I 4) N)))
    (KUPYNA-G256 X Y)
    (VALUES))

[ironclad/src/digests/kupyna.lisp:64]
  (DEFUN KUPYNA-ROUND-Q256 (X Y N)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (*)) X Y)
             (TYPE (UNSIGNED-BYTE 64) N)
             (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (DOTIMES-UNROLLED (I 8)
     (SETF (AREF X I)
             (MOD64+ (AREF X I)
              (LOGXOR 67818912035696883
                      (MOD64ASH (LOGXOR (MOD64* (- 7 I) 16) (LOGAND N 255))
                       56)))))
    (KUPYNA-G256 X Y)
    (VALUES))

[ironclad/src/digests/kupyna.lisp:77]
  (DEFUN KUPYNA-OUTPUT-TRANSFORM256 (H)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (*)) H)
             (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (LET ((T1 (MAKE-ARRAY 8 :ELEMENT-TYPE '(UNSIGNED-BYTE 64)))
          (T2 (MAKE-ARRAY 8 :ELEMENT-TYPE '(UNSIGNED-BYTE 64))))
      (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (8)) T1 T2)
               (DYNAMIC-EXTENT T1 T2))
      (REPLACE T1 H)
      (LOOP FOR R FROM 0 BELOW 10 BY 2
            DO (KUPYNA-ROUND-P256 T1 T2 R) (KUPYNA-ROUND-P256 T2 T1 (1+ R)))
      (DOTIMES (I 8) (SETF (AREF H I) (LOGXOR (AREF H I) (AREF T1 I)))))
    (VALUES))

[ironclad/src/digests/kupyna.lisp:92]
  (DEFUN KUPYNA-TRANSFORM256 (H M START)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (16)) H)
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) M)
             (TYPE INDEX START)
             (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (LET ((AP1 (MAKE-ARRAY 8 :ELEMENT-TYPE '(UNSIGNED-BYTE 64)))
          (AQ1 (MAKE-ARRAY 8 :ELEMENT-TYPE '(UNSIGNED-BYTE 64)))
          (AP2 (MAKE-ARRAY 8 :ELEMENT-TYPE '(UNSIGNED-BYTE 64)))
          (AQ2 (MAKE-ARRAY 8 :ELEMENT-TYPE '(UNSIGNED-BYTE 64))))
      (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (8)) AP1 AQ1 AP2 AQ2)
               (DYNAMIC-EXTENT AP1 AQ1 AP2 AQ2))
      (DOTIMES (I 8)
        (SETF (AREF AQ1 I) (UB64REF/LE M (+ START (* 8 I)))
              (AREF AP1 I) (LOGXOR (AREF H I) (AREF AQ1 I))))
      (LOOP FOR R FROM 0 BELOW 10 BY 2
            DO (KUPYNA-ROUND-P256 AP1 AP2 R) (KUPYNA-ROUND-P256 AP2 AP1
                                              (1+ R)) (KUPYNA-ROUND-Q256 AQ1
                                                       AQ2
                                                       R) (KUPYNA-ROUND-Q256
                                                           AQ2 AQ1 (1+ R)))
      (DOTIMES (I 8)
        (SETF (AREF H I) (LOGXOR (AREF H I) (AREF AP1 I) (AREF AQ1 I)))))
    (VALUES))

[ironclad/src/digests/kupyna.lisp:121]
  (DEFUN KUPYNA-G512 (X Y)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (*)) X Y)
             (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (MACROLET ((M (A B C)
                 (ECLECTOR.READER:QUASIQUOTE
                  (AREF +KUPYNA-T+ (ECLECTOR.READER:UNQUOTE A)
                        (LOGAND
                         (MOD64ASH (AREF X (ECLECTOR.READER:UNQUOTE B))
                          (ECLECTOR.READER:UNQUOTE C))
                         255)))))
      (SETF (AREF Y 0)
              (LOGXOR (M 0 0 0) (M 1 15 -8) (M 2 14 -16) (M 3 13 -24)
                      (M 4 12 -32) (M 5 11 -40) (M 6 10 -48) (M 7 5 -56)))
      (SETF (AREF Y 1)
              (LOGXOR (M 0 1 0) (M 1 0 -8) (M 2 15 -16) (M 3 14 -24)
                      (M 4 13 -32) (M 5 12 -40) (M 6 11 -48) (M 7 6 -56)))
      (SETF (AREF Y 2)
              (LOGXOR (M 0 2 0) (M 1 1 -8) (M 2 0 -16) (M 3 15 -24)
                      (M 4 14 -32) (M 5 13 -40) (M 6 12 -48) (M 7 7 -56)))
      (SETF (AREF Y 3)
              (LOGXOR (M 0 3 0) (M 1 2 -8) (M 2 1 -16) (M 3 0 -24) (M 4 15 -32)
                      (M 5 14 -40) (M 6 13 -48) (M 7 8 -56)))
      (SETF (AREF Y 4)
              (LOGXOR (M 0 4 0) (M 1 3 -8) (M 2 2 -16) (M 3 1 -24) (M 4 0 -32)
                      (M 5 15 -40) (M 6 14 -48) (M 7 9 -56)))
      (SETF (AREF Y 5)
              (LOGXOR (M 0 5 0) (M 1 4 -8) (M 2 3 -16) (M 3 2 -24) (M 4 1 -32)
                      (M 5 0 -40) (M 6 15 -48) (M 7 10 -56)))
      (SETF (AREF Y 6)
              (LOGXOR (M 0 6 0) (M 1 5 -8) (M 2 4 -16) (M 3 3 -24) (M 4 2 -32)
                      (M 5 1 -40) (M 6 0 -48) (M 7 11 -56)))
      (SETF (AREF Y 7)
              (LOGXOR (M 0 7 0) (M 1 6 -8) (M 2 5 -16) (M 3 4 -24) (M 4 3 -32)
                      (M 5 2 -40) (M 6 1 -48) (M 7 12 -56)))
      (SETF (AREF Y 8)
              (LOGXOR (M 0 8 0) (M 1 7 -8) (M 2 6 -16) (M 3 5 -24) (M 4 4 -32)
                      (M 5 3 -40) (M 6 2 -48) (M 7 13 -56)))
      (SETF (AREF Y 9)
              (LOGXOR (M 0 9 0) (M 1 8 -8) (M 2 7 -16) (M 3 6 -24) (M 4 5 -32)
                      (M 5 4 -40) (M 6 3 -48) (M 7 14 -56)))
      (SETF (AREF Y 10)
              (LOGXOR (M 0 10 0) (M 1 9 -8) (M 2 8 -16) (M 3 7 -24) (M 4 6 -32)
                      (M 5 5 -40) (M 6 4 -48) (M 7 15 -56)))
      (SETF (AREF Y 11)
              (LOGXOR (M 0 11 0) (M 1 10 -8) (M 2 9 -16) (M 3 8 -24)
                      (M 4 7 -32) (M 5 6 -40) (M 6 5 -48) (M 7 0 -56)))
      (SETF (AREF Y 12)
              (LOGXOR (M 0 12 0) (M 1 11 -8) (M 2 10 -16) (M 3 9 -24)
                      (M 4 8 -32) (M 5 7 -40) (M 6 6 -48) (M 7 1 -56)))
      (SETF (AREF Y 13)
              (LOGXOR (M 0 13 0) (M 1 12 -8) (M 2 11 -16) (M 3 10 -24)
                      (M 4 9 -32) (M 5 8 -40) (M 6 7 -48) (M 7 2 -56)))
      (SETF (AREF Y 14)
              (LOGXOR (M 0 14 0) (M 1 13 -8) (M 2 12 -16) (M 3 11 -24)
                      (M 4 10 -32) (M 5 9 -40) (M 6 8 -48) (M 7 3 -56)))
      (SETF (AREF Y 15)
              (LOGXOR (M 0 15 0) (M 1 14 -8) (M 2 13 -16) (M 3 12 -24)
                      (M 4 11 -32) (M 5 10 -40) (M 6 9 -48) (M 7 4 -56))))
    (VALUES))

[ironclad/src/digests/kupyna.lisp:177]
  (DEFUN KUPYNA-ROUND-P512 (X Y N)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (*)) X Y)
             (TYPE (UNSIGNED-BYTE 64) N)
             (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (DOTIMES-UNROLLED (I 16)
     (SETF (AREF X I) (LOGXOR (AREF X I) (MOD64ASH I 4) N)))
    (KUPYNA-G512 X Y)
    (VALUES))

[ironclad/src/digests/kupyna.lisp:187]
  (DEFUN KUPYNA-ROUND-Q512 (X Y N)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (*)) X Y)
             (TYPE (UNSIGNED-BYTE 64) N)
             (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (DOTIMES-UNROLLED (I 16)
     (SETF (AREF X I)
             (MOD64+ (AREF X I)
              (LOGXOR 67818912035696883
                      (MOD64ASH (LOGXOR (MOD64* (- 15 I) 16) (LOGAND N 255))
                       56)))))
    (KUPYNA-G512 X Y)
    (VALUES))

[ironclad/src/digests/kupyna.lisp:200]
  (DEFUN KUPYNA-OUTPUT-TRANSFORM512 (H)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (*)) H)
             (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (LET ((T1 (MAKE-ARRAY 16 :ELEMENT-TYPE '(UNSIGNED-BYTE 64)))
          (T2 (MAKE-ARRAY 16 :ELEMENT-TYPE '(UNSIGNED-BYTE 64))))
      (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (16)) T1 T2)
               (DYNAMIC-EXTENT T1 T2))
      (REPLACE T1 H)
      (LOOP FOR R FROM 0 BELOW 14 BY 2
            DO (KUPYNA-ROUND-P512 T1 T2 R) (KUPYNA-ROUND-P512 T2 T1 (1+ R)))
      (DOTIMES (I 16) (SETF (AREF H I) (LOGXOR (AREF H I) (AREF T1 I)))))
    (VALUES))

[ironclad/src/digests/kupyna.lisp:215]
  (DEFUN KUPYNA-TRANSFORM512 (H M START)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (16)) H)
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) M)
             (TYPE INDEX START)
             (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (LET ((AP1 (MAKE-ARRAY 16 :ELEMENT-TYPE '(UNSIGNED-BYTE 64)))
          (AQ1 (MAKE-ARRAY 16 :ELEMENT-TYPE '(UNSIGNED-BYTE 64)))
          (AP2 (MAKE-ARRAY 16 :ELEMENT-TYPE '(UNSIGNED-BYTE 64)))
          (AQ2 (MAKE-ARRAY 16 :ELEMENT-TYPE '(UNSIGNED-BYTE 64))))
      (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (16)) AP1 AQ1 AP2 AQ2)
               (DYNAMIC-EXTENT AP1 AQ1 AP2 AQ2))
      (DOTIMES (I 16)
        (SETF (AREF AQ1 I) (UB64REF/LE M (+ START (* 8 I)))
              (AREF AP1 I) (LOGXOR (AREF H I) (AREF AQ1 I))))
      (LOOP FOR R FROM 0 BELOW 14 BY 2
            DO (KUPYNA-ROUND-P512 AP1 AP2 R) (KUPYNA-ROUND-P512 AP2 AP1
                                              (1+ R)) (KUPYNA-ROUND-Q512 AQ1
                                                       AQ2
                                                       R) (KUPYNA-ROUND-Q512
                                                           AQ2 AQ1 (1+ R)))
      (DOTIMES (I 16)
        (SETF (AREF H I) (LOGXOR (AREF H I) (AREF AP1 I) (AREF AQ1 I)))))
    (VALUES))

[ironclad/src/digests/md5-lispworks-int32.lisp:36]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (DEFUN %OPTIMIZATION-SETTINGS ()
      '(OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0) (FLOAT 0)))
    (DEFUN %OPTIMIZATION-SETTINGS/NO-FIXNUM-SAFETY ()
      '(OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0) (FLOAT 0)
        (#S(FORMGREP:SYMREF :NAME "FIXNUM-SAFETY" :QUALIFIER "HCL") 0)))
    (DEFMACRO ASSEMBLE-UB32 (A B C D)
      "Assemble an ub32 value from the given (unsigned-byte 8) values,
where a is the intended low-order byte and d the high-order byte."
      (ECLECTOR.READER:QUASIQUOTE
       (#S(FORMGREP:SYMREF :NAME "INT32-LOGIOR" :QUALIFIER "SYS")
        (#S(FORMGREP:SYMREF :NAME "INT32<<" :QUALIFIER "SYS")
         (ECLECTOR.READER:UNQUOTE D) 24)
        (#S(FORMGREP:SYMREF :NAME "INT32-LOGIOR" :QUALIFIER "SYS")
         (#S(FORMGREP:SYMREF :NAME "INT32<<" :QUALIFIER "SYS")
          (ECLECTOR.READER:UNQUOTE C) 16)
         (#S(FORMGREP:SYMREF :NAME "INT32-LOGIOR" :QUALIFIER "SYS")
          (#S(FORMGREP:SYMREF :NAME "INT32<<" :QUALIFIER "SYS")
           (ECLECTOR.READER:UNQUOTE B) 8)
          (ECLECTOR.READER:UNQUOTE A))))))
    (DEFMACRO MAKE-UB32-VECTOR (LENGTH &REST ARGS)
      (ECLECTOR.READER:QUASIQUOTE
       (#S(FORMGREP:SYMREF :NAME "MAKE-SIMPLE-INT32-VECTOR" :QUALIFIER "SYS")
        (ECLECTOR.READER:UNQUOTE LENGTH)
        (ECLECTOR.READER:UNQUOTE-SPLICING ARGS))))
    (DEFPARAMETER *T*
      (MAKE-UB32-VECTOR 64 :INITIAL-CONTENTS
       (FLET ((INT32-UNSIGNED-TO-SIGNED (UNSIGNED)
                (DPB (LDB (BYTE 32 0) UNSIGNED) (BYTE 32 0)
                     (IF (LOGBITP 31 UNSIGNED)
                         -1
                         0))))
         (LOOP FOR I FROM 1 TO 64
               COLLECT (INT32-UNSIGNED-TO-SIGNED
                        (TRUNCATE
                         (* 4294967296 (ABS (SIN (FLOAT I 0.0d0)))))))))))

[ironclad/src/digests/md5-lispworks-int32.lisp:38]
  (DEFUN %OPTIMIZATION-SETTINGS ()
    '(OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0) (FLOAT 0)))

[ironclad/src/digests/md5-lispworks-int32.lisp:41]
  (DEFUN %OPTIMIZATION-SETTINGS/NO-FIXNUM-SAFETY ()
    '(OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0) (FLOAT 0)
      (#S(FORMGREP:SYMREF :NAME "FIXNUM-SAFETY" :QUALIFIER "HCL") 0)))

[ironclad/src/digests/sha3.lisp:70]
  (DEFUN GET-KECCAK-ROUND-CONSTANT (I)
    (DECLARE (TYPE (INTEGER 0 23) I)
             (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (DEBUG 0)))
    (LET ((CONSTANTS (LOAD-TIME-VALUE +KECCAK-ROUND-CONSTANTS+ T)))
      (DECLARE (TYPE (SIMPLE-ARRAY KECCAK-LANE (24)) CONSTANTS))
      (AREF CONSTANTS I)))

[ironclad/src/digests/sha3.lisp:79]
  (DEFUN MAKE-KECCAK-STATE ()
    (DECLARE (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (DEBUG 0)))
    (MAKE-ARRAY NIL :ELEMENT-TYPE 'KECCAK-LANE :INITIAL-ELEMENT 0))

[ironclad/src/digests/sha3.lisp:88]
  (DEFUN KECCAK-STATE-MERGE-INPUT (STATE BIT-RATE INPUT START)
    (DECLARE (TYPE KECCAK-STATE STATE)
             (TYPE (INTEGER 0 1600) BIT-RATE)
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) INPUT)
             (TYPE FIXNUM START)
             (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (DEBUG 0)))
    (LET ((RATE-BYTES (TRUNCATE BIT-RATE 8)))
      (DECLARE (TYPE (INTEGER 0 200) RATE-BYTES))
      (DOTIMES (Y +KECCAK-STATE-ROWS+)
        (DOTIMES (X +KECCAK-STATE-COLUMNS+)
          (LET* ((ELEMENT (+ (THE FIXNUM (* Y +KECCAK-STATE-COLUMNS+)) X))
                 (OFFSET (* ELEMENT +KECCAK-LANE-BYTE-WIDTH+))
                 (INDEX (THE FIXNUM (+ START OFFSET))))
            (WHEN (>= OFFSET RATE-BYTES)
              (RETURN-FROM KECCAK-STATE-MERGE-INPUT))
            (SETF (AREF STATE ELEMENT) (LOGXOR (AREF STATE ELEMENT))))))))

[ironclad/src/digests/sha3.lisp:208]
  (DEFUN KECCAK-ROUNDS (STATE)
    (DECLARE (TYPE KECCAK-STATE STATE)
             (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (DEBUG 0)))
    (WITH-KECCAK-STATE-ACCESSORS (STATE)
     (WITH-TEMP-KECCAK-STATE (B)
      (WITH-TEMP-KECCAK-ROWS (C D)
       (DOTIMES (I NIL)
         (DOTIMES-UNROLLED (X +KECCAK-STATE-COLUMNS+)
          (SETF (TEMP-ROW-AREF C X)
                  (LOGXOR (STATE-AREF STATE X 0) (STATE-AREF STATE X 1)
                          (STATE-AREF STATE X 2) (STATE-AREF STATE X 3)
                          (STATE-AREF STATE X 4))))
         (DOTIMES-UNROLLED (X +KECCAK-STATE-COLUMNS+)
          (SETF (TEMP-ROW-AREF D X)
                  (LOGXOR
                   (TEMP-ROW-AREF C
                    (MOD (+ +KECCAK-STATE-COLUMNS+ (1- X))
                         +KECCAK-STATE-COLUMNS+))
                   (ROL64 (TEMP-ROW-AREF C (MOD (1+ X) +KECCAK-STATE-COLUMNS+))
                    1))))
         (DOTIMES-UNROLLED (X +KECCAK-STATE-COLUMNS+)
          (DOTIMES-UNROLLED (Y +KECCAK-STATE-ROWS+)
           (SETF (STATE-AREF STATE X Y)
                   (LOGXOR (STATE-AREF STATE X Y) (TEMP-ROW-AREF D X)))))
         (DOTIMES-UNROLLED (X +KECCAK-STATE-COLUMNS+)
          (DOTIMES-UNROLLED (Y +KECCAK-STATE-ROWS+)
           (SETF (TEMP-STATE-AREF B Y
                  (MOD (+ (* 2 X) (* 3 Y)) +KECCAK-STATE-ROWS+))
                   (ROL64 (STATE-AREF STATE X Y)
                    (GET-KECCAK-ROTATE-OFFSET X Y)))))
         (DOTIMES-UNROLLED (X +KECCAK-STATE-COLUMNS+)
          (DOTIMES-UNROLLED (Y +KECCAK-STATE-ROWS+)
           (SETF (STATE-AREF STATE X Y)
                   (LOGXOR (TEMP-STATE-AREF B X Y)
                           (LOGANDC1
                            (TEMP-STATE-AREF B
                             (MOD (1+ X) +KECCAK-STATE-COLUMNS+) Y)
                            (TEMP-STATE-AREF B
                             (MOD (+ X 2) +KECCAK-STATE-COLUMNS+) Y))))))
         (SETF (STATE-AREF STATE 0 0)
                 (LOGXOR (STATE-AREF STATE 0 0)
                         (GET-KECCAK-ROUND-CONSTANT I)))))))
    (VALUES))

[ironclad/src/digests/sha3.lisp:387]
  (DEFUN SHA3-UPDATE (STATE VECTOR START END)
    (DECLARE (TYPE SHA3 STATE)
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) VECTOR)
             (TYPE FIXNUM START END)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LET* ((KECCAK-STATE (SHA3-STATE STATE))
           (BUFFER (SHA3-BUFFER STATE))
           (BUFFER-INDEX (SHA3-BUFFER-INDEX STATE))
           (BIT-RATE (SHA3-BIT-RATE STATE))
           (RATE-BYTES (TRUNCATE BIT-RATE 8)))
      (DECLARE (TYPE KECCAK-STATE KECCAK-STATE)
               (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (200)) BUFFER)
               (TYPE (INTEGER 0 199) BUFFER-INDEX)
               (TYPE (INTEGER 0 1600) BIT-RATE)
               (TYPE (INTEGER 0 200) RATE-BYTES))
      (UNLESS (ZEROP BUFFER-INDEX)
        (LET ((REMAINDER (- RATE-BYTES BUFFER-INDEX)) (LENGTH (- END START)))
          (DECLARE (TYPE FIXNUM REMAINDER LENGTH))
          (REPLACE BUFFER VECTOR :START1 BUFFER-INDEX :END1 RATE-BYTES :START2
                   START :END2 END)
          (WHEN (< LENGTH REMAINDER)
            (INCF (SHA3-BUFFER-INDEX STATE) LENGTH)
            (RETURN-FROM SHA3-UPDATE))
          (KECCAK-STATE-MERGE-INPUT KECCAK-STATE BIT-RATE BUFFER 0)
          (KECCAK-ROUNDS KECCAK-STATE)
          (SETF (SHA3-BUFFER-INDEX STATE) 0)
          (SETF START (+ START REMAINDER))))
      (LOOP FOR BLOCK-OFFSET OF-TYPE FIXNUM FROM START BELOW
            END BY RATE-BYTES
            DO (COND
                ((<= (+ BLOCK-OFFSET RATE-BYTES) END)
                 (KECCAK-STATE-MERGE-INPUT KECCAK-STATE BIT-RATE VECTOR
                  BLOCK-OFFSET)
                 (KECCAK-ROUNDS KECCAK-STATE))
                (T
                 (REPLACE BUFFER VECTOR :START1 0 :END1 RATE-BYTES :START2
                          BLOCK-OFFSET :END2 END)
                 (SETF (SHA3-BUFFER-INDEX STATE) (- END BLOCK-OFFSET))))))
    (VALUES))

[ironclad/src/digests/sha3.lisp:432]
  (DEFUN SHA3-FINALIZE (STATE DIGEST DIGEST-START)
    (DECLARE (TYPE SHA3 STATE)
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) DIGEST)
             (TYPE INTEGER DIGEST-START)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LET ((PADDING-TYPE
           (TYPECASE STATE
             (SHAKE128 :XOF)
             (SHAKE256 :XOF)
             (KECCAK/224 :KECCAK)
             (KECCAK/256 :KECCAK)
             (KECCAK/384 :KECCAK)
             (KECCAK :KECCAK)
             (T :SHA3)))
          (KECCAK-STATE (SHA3-STATE STATE))
          (BUFFER (SHA3-BUFFER STATE))
          (BUFFER-INDEX (SHA3-BUFFER-INDEX STATE))
          (BIT-RATE (SHA3-BIT-RATE STATE))
          (OUTPUT-BYTE-LENGTH (DIGEST-LENGTH STATE))
          OUTPUT)
      (DECLARE (TYPE KECCAK-STATE KECCAK-STATE)
               (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (200)) BUFFER)
               (TYPE (INTEGER 0 199) BUFFER-INDEX)
               (TYPE (INTEGER 0 1600) BIT-RATE)
               (TYPE (INTEGER 0 64) OUTPUT-BYTE-LENGTH))
      (KECCAK-STATE-MERGE-INPUT KECCAK-STATE BIT-RATE
       (PAD-MESSAGE-TO-WIDTH (SUBSEQ BUFFER 0 BUFFER-INDEX) BIT-RATE
        PADDING-TYPE)
       0)
      (KECCAK-ROUNDS KECCAK-STATE)
      (SETF (SHA3-BUFFER-INDEX STATE) 0)
      (SETF OUTPUT
              (KECCAK-STATE-EXTRACT-OUTPUT KECCAK-STATE OUTPUT-BYTE-LENGTH))
      (REPLACE DIGEST OUTPUT :START1 DIGEST-START :END2 OUTPUT-BYTE-LENGTH)
      DIGEST))

[ironclad/src/digests/sm3.lisp:73]
  (DEFUN SM3-HASH (STATE DATA START)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 32) (8)) STATE)
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) DATA)
             (TYPE FIXNUM START)
             (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (DEBUG 0)))
    (LET ((A (AREF STATE 0))
          (B (AREF STATE 1))
          (C (AREF STATE 2))
          (D (AREF STATE 3))
          (E (AREF STATE 4))
          (F (AREF STATE 5))
          (G (AREF STATE 6))
          (H (AREF STATE 7))
          (W00 (UB32REF/BE DATA START))
          (W01 (UB32REF/BE DATA (+ START 4)))
          (W02 (UB32REF/BE DATA (+ START 8)))
          (W03 (UB32REF/BE DATA (+ START 12)))
          (W04 (UB32REF/BE DATA (+ START 16)))
          (W05 (UB32REF/BE DATA (+ START 20)))
          (W06 (UB32REF/BE DATA (+ START 24)))
          (W07 (UB32REF/BE DATA (+ START 28)))
          (W08 (UB32REF/BE DATA (+ START 32)))
          (W09 (UB32REF/BE DATA (+ START 36)))
          (W10 (UB32REF/BE DATA (+ START 40)))
          (W11 (UB32REF/BE DATA (+ START 44)))
          (W12 (UB32REF/BE DATA (+ START 48)))
          (W13 (UB32REF/BE DATA (+ START 52)))
          (W14 (UB32REF/BE DATA (+ START 56)))
          (W15 (UB32REF/BE DATA (+ START 60))))
      (DECLARE (TYPE (UNSIGNED-BYTE 32) A B C D E F G H)
               (TYPE (UNSIGNED-BYTE 32) W00 W01 W02 W03 W04 W05 W06 W07)
               (TYPE (UNSIGNED-BYTE 32) W08 W09 W10 W11 W12 W13 W14 W15))
      (SM3-R1 A B C D E F G H 2043430169 W00 (LOGXOR W00 W04))
      (SETF W00 (SM3-EE W00 W07 W13 W03 W10))
      (SM3-R1 D A B C H E F G 4086860338 W01 (LOGXOR W01 W05))
      (SETF W01 (SM3-EE W01 W08 W14 W04 W11))
      (SM3-R1 C D A B G H E F 3878753381 W02 (LOGXOR W02 W06))
      (SETF W02 (SM3-EE W02 W09 W15 W05 W12))
      (SM3-R1 B C D A F G H E 3462539467 W03 (LOGXOR W03 W07))
      (SETF W03 (SM3-EE W03 W10 W00 W06 W13))
      (SM3-R1 A B C D E F G H 2630111639 W04 (LOGXOR W04 W08))
      (SETF W04 (SM3-EE W04 W11 W01 W07 W14))
      (SM3-R1 D A B C H E F G 965255983 W05 (LOGXOR W05 W09))
      (SETF W05 (SM3-EE W05 W12 W02 W08 W15))
      (SM3-R1 C D A B G H E F 1930511966 W06 (LOGXOR W06 W10))
      (SETF W06 (SM3-EE W06 W13 W03 W09 W00))
      (SM3-R1 B C D A F G H E 3861023932 W07 (LOGXOR W07 W11))
      (SETF W07 (SM3-EE W07 W14 W04 W10 W01))
      (SM3-R1 A B C D E F G H 3427080569 W08 (LOGXOR W08 W12))
      (SETF W08 (SM3-EE W08 W15 W05 W11 W02))
      (SM3-R1 D A B C H E F G 2559193843 W09 (LOGXOR W09 W13))
      (SETF W09 (SM3-EE W09 W00 W06 W12 W03))
      (SM3-R1 C D A B G H E F 823420391 W10 (LOGXOR W10 W14))
      (SETF W10 (SM3-EE W10 W01 W07 W13 W04))
      (SM3-R1 B C D A F G H E 1646840782 W11 (LOGXOR W11 W15))
      (SETF W11 (SM3-EE W11 W02 W08 W14 W05))
      (SM3-R1 A B C D E F G H 3293681564 W12 (LOGXOR W12 W00))
      (SETF W12 (SM3-EE W12 W03 W09 W15 W06))
      (SM3-R1 D A B C H E F G 2292395833 W13 (LOGXOR W13 W01))
      (SETF W13 (SM3-EE W13 W04 W10 W00 W07))
      (SM3-R1 C D A B G H E F 289824371 W14 (LOGXOR W14 W02))
      (SETF W14 (SM3-EE W14 W05 W11 W01 W08))
      (SM3-R1 B C D A F G H E 579648742 W15 (LOGXOR W15 W03))
      (SETF W15 (SM3-EE W15 W06 W12 W02 W09))
      (SM3-R2 A B C D E F G H 2643098247 W00 (LOGXOR W00 W04))
      (SETF W00 (SM3-EE W00 W07 W13 W03 W10))
      (SM3-R2 D A B C H E F G 991229199 W01 (LOGXOR W01 W05))
      (SETF W01 (SM3-EE W01 W08 W14 W04 W11))
      (SM3-R2 C D A B G H E F 1982458398 W02 (LOGXOR W02 W06))
      (SETF W02 (SM3-EE W02 W09 W15 W05 W12))
      (SM3-R2 B C D A F G H E 3964916796 W03 (LOGXOR W03 W07))
      (SETF W03 (SM3-EE W03 W10 W00 W06 W13))
      (SM3-R2 A B C D E F G H 3634866297 W04 (LOGXOR W04 W08))
      (SETF W04 (SM3-EE W04 W11 W01 W07 W14))
      (SM3-R2 D A B C H E F G 2974765299 W05 (LOGXOR W05 W09))
      (SETF W05 (SM3-EE W05 W12 W02 W08 W15))
      (SM3-R2 C D A B G H E F 1654563303 W06 (LOGXOR W06 W10))
      (SETF W06 (SM3-EE W06 W13 W03 W09 W00))
      (SM3-R2 B C D A F G H E 3309126606 W07 (LOGXOR W07 W11))
      (SETF W07 (SM3-EE W07 W14 W04 W10 W01))
      (SM3-R2 A B C D E F G H 2323285917 W08 (LOGXOR W08 W12))
      (SETF W08 (SM3-EE W08 W15 W05 W11 W02))
      (SM3-R2 D A B C H E F G 351604539 W09 (LOGXOR W09 W13))
      (SETF W09 (SM3-EE W09 W00 W06 W12 W03))
      (SM3-R2 C D A B G H E F 703209078 W10 (LOGXOR W10 W14))
      (SETF W10 (SM3-EE W10 W01 W07 W13 W04))
      (SM3-R2 B C D A F G H E 1406418156 W11 (LOGXOR W11 W15))
      (SETF W11 (SM3-EE W11 W02 W08 W14 W05))
      (SM3-R2 A B C D E F G H 2812836312 W12 (LOGXOR W12 W00))
      (SETF W12 (SM3-EE W12 W03 W09 W15 W06))
      (SM3-R2 D A B C H E F G 1330705329 W13 (LOGXOR W13 W01))
      (SETF W13 (SM3-EE W13 W04 W10 W00 W07))
      (SM3-R2 C D A B G H E F 2661410658 W14 (LOGXOR W14 W02))
      (SETF W14 (SM3-EE W14 W05 W11 W01 W08))
      (SM3-R2 B C D A F G H E 1027854021 W15 (LOGXOR W15 W03))
      (SETF W15 (SM3-EE W15 W06 W12 W02 W09))
      (SM3-R2 A B C D E F G H 2055708042 W00 (LOGXOR W00 W04))
      (SETF W00 (SM3-EE W00 W07 W13 W03 W10))
      (SM3-R2 D A B C H E F G 4111416084 W01 (LOGXOR W01 W05))
      (SETF W01 (SM3-EE W01 W08 W14 W04 W11))
      (SM3-R2 C D A B G H E F 3927864873 W02 (LOGXOR W02 W06))
      (SETF W02 (SM3-EE W02 W09 W15 W05 W12))
      (SM3-R2 B C D A F G H E 3560762451 W03 (LOGXOR W03 W07))
      (SETF W03 (SM3-EE W03 W10 W00 W06 W13))
      (SM3-R2 A B C D E F G H 2826557607 W04 (LOGXOR W04 W08))
      (SETF W04 (SM3-EE W04 W11 W01 W07 W14))
      (SM3-R2 D A B C H E F G 1358147919 W05 (LOGXOR W05 W09))
      (SETF W05 (SM3-EE W05 W12 W02 W08 W15))
      (SM3-R2 C D A B G H E F 2716295838 W06 (LOGXOR W06 W10))
      (SETF W06 (SM3-EE W06 W13 W03 W09 W00))
      (SM3-R2 B C D A F G H E 1137624381 W07 (LOGXOR W07 W11))
      (SETF W07 (SM3-EE W07 W14 W04 W10 W01))
      (SM3-R2 A B C D E F G H 2275248762 W08 (LOGXOR W08 W12))
      (SETF W08 (SM3-EE W08 W15 W05 W11 W02))
      (SM3-R2 D A B C H E F G 255530229 W09 (LOGXOR W09 W13))
      (SETF W09 (SM3-EE W09 W00 W06 W12 W03))
      (SM3-R2 C D A B G H E F 511060458 W10 (LOGXOR W10 W14))
      (SETF W10 (SM3-EE W10 W01 W07 W13 W04))
      (SM3-R2 B C D A F G H E 1022120916 W11 (LOGXOR W11 W15))
      (SETF W11 (SM3-EE W11 W02 W08 W14 W05))
      (SM3-R2 A B C D E F G H 2044241832 W12 (LOGXOR W12 W00))
      (SETF W12 (SM3-EE W12 W03 W09 W15 W06))
      (SM3-R2 D A B C H E F G 4088483664 W13 (LOGXOR W13 W01))
      (SETF W13 (SM3-EE W13 W04 W10 W00 W07))
      (SM3-R2 C D A B G H E F 3882000033 W14 (LOGXOR W14 W02))
      (SETF W14 (SM3-EE W14 W05 W11 W01 W08))
      (SM3-R2 B C D A F G H E 3469032771 W15 (LOGXOR W15 W03))
      (SETF W15 (SM3-EE W15 W06 W12 W02 W09))
      (SM3-R2 A B C D E F G H 2643098247 W00 (LOGXOR W00 W04))
      (SETF W00 (SM3-EE W00 W07 W13 W03 W10))
      (SM3-R2 D A B C H E F G 991229199 W01 (LOGXOR W01 W05))
      (SETF W01 (SM3-EE W01 W08 W14 W04 W11))
      (SM3-R2 C D A B G H E F 1982458398 W02 (LOGXOR W02 W06))
      (SETF W02 (SM3-EE W02 W09 W15 W05 W12))
      (SM3-R2 B C D A F G H E 3964916796 W03 (LOGXOR W03 W07))
      (SETF W03 (SM3-EE W03 W10 W00 W06 W13))
      (SM3-R2 A B C D E F G H 3634866297 W04 (LOGXOR W04 W08))
      (SM3-R2 D A B C H E F G 2974765299 W05 (LOGXOR W05 W09))
      (SM3-R2 C D A B G H E F 1654563303 W06 (LOGXOR W06 W10))
      (SM3-R2 B C D A F G H E 3309126606 W07 (LOGXOR W07 W11))
      (SM3-R2 A B C D E F G H 2323285917 W08 (LOGXOR W08 W12))
      (SM3-R2 D A B C H E F G 351604539 W09 (LOGXOR W09 W13))
      (SM3-R2 C D A B G H E F 703209078 W10 (LOGXOR W10 W14))
      (SM3-R2 B C D A F G H E 1406418156 W11 (LOGXOR W11 W15))
      (SM3-R2 A B C D E F G H 2812836312 W12 (LOGXOR W12 W00))
      (SM3-R2 D A B C H E F G 1330705329 W13 (LOGXOR W13 W01))
      (SM3-R2 C D A B G H E F 2661410658 W14 (LOGXOR W14 W02))
      (SM3-R2 B C D A F G H E 1027854021 W15 (LOGXOR W15 W03))
      (SETF (AREF STATE 0) (LOGXOR (AREF STATE 0) A)
            (AREF STATE 1) (LOGXOR (AREF STATE 1) B)
            (AREF STATE 2) (LOGXOR (AREF STATE 2) C)
            (AREF STATE 3) (LOGXOR (AREF STATE 3) D)
            (AREF STATE 4) (LOGXOR (AREF STATE 4) E)
            (AREF STATE 5) (LOGXOR (AREF STATE 5) F)
            (AREF STATE 6) (LOGXOR (AREF STATE 6) G)
            (AREF STATE 7) (LOGXOR (AREF STATE 7) H))))

[ironclad/src/digests/streebog.lisp:1099]
  (DEFUN STREEBOG-AX (I J)
    (DECLARE (TYPE (INTEGER 0 7) I)
             (TYPE (INTEGER 0 255) J)
             (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (DEBUG 0)))
    (LET ((CONSTANTS (LOAD-TIME-VALUE +STREEBOG-AX+ T)))
      (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (8 256)) CONSTANTS))
      (AREF CONSTANTS I J)))

[ironclad/src/digests/streebog.lisp:1149]
  (DEFUN STREEBOG-ADD512 (X Y R)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (8)) X Y R)
             (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (DEBUG 0)))
    (LET ((CF 0) (OF 0) (TMP 0))
      (DECLARE (TYPE (UNSIGNED-BYTE 8) CF OF)
               (TYPE (UNSIGNED-BYTE 64) TMP))
      (DOTIMES (I 8)
        (SETF TMP (MOD64+ (AREF X I) (AREF Y I)))
        (SETF OF
                (IF (< TMP (AREF X I))
                    1
                    0))
        (SETF TMP (MOD64+ TMP CF))
        (WHEN (AND (PLUSP CF) (ZEROP TMP)) (SETF OF 1))
        (SETF CF OF)
        (SETF (AREF R I) TMP)))
    (VALUES))

[ironclad/src/digests/streebog.lisp:1167]
  (DEFUN STREEBOG-G (H N M)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (8)) H N M)
             (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (DEBUG 0)))
    (LET ((KI
           (MAKE-ARRAY 8 :ELEMENT-TYPE '(UNSIGNED-BYTE 64) :INITIAL-ELEMENT 0))
          (DATA
           (MAKE-ARRAY 8 :ELEMENT-TYPE '(UNSIGNED-BYTE 64) :INITIAL-ELEMENT 0)))
      (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (8)) KI DATA)
               (DYNAMIC-EXTENT KI DATA))
      (STREEBOG-XLPS H N DATA)
      (REPLACE KI DATA)
      (STREEBOG-XLPS KI M DATA)
      (DOTIMES (I 11) (STREEBOG-ROUND I KI DATA))
      (STREEBOG-XLPS KI
       (THE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (8)) (AREF +STREEBOG-C+ 11)) KI)
      (STREEBOG-X KI DATA DATA)
      (STREEBOG-X DATA H DATA)
      (STREEBOG-X DATA M H))
    (VALUES))

[ironclad/src/digests/streebog.lisp:1240]
  (DEFUN STREEBOG-STAGE2 (STATE DATA START)
    (DECLARE (TYPE STREEBOG STATE)
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) DATA)
             (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (DEBUG 0)))
    (LET ((TMP (MAKE-ARRAY 8 :ELEMENT-TYPE '(UNSIGNED-BYTE 64)))
          (H (STREEBOG-H STATE))
          (N (STREEBOG-N STATE))
          (SIGMA (STREEBOG-SIGMA STATE)))
      (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (8)) TMP H N SIGMA)
               (DYNAMIC-EXTENT TMP))
      (DOTIMES (I 8) (SETF (AREF TMP I) (UB64REF/LE DATA (+ START (* I 8)))))
      (STREEBOG-G H N TMP)
      (STREEBOG-ADD512 N +STREEBOG-BUFFER512+ N)
      (STREEBOG-ADD512 SIGMA TMP SIGMA))
    (VALUES))

[ironclad/src/digests/streebog.lisp:1257]
  (DEFUN STREEBOG-PAD (STATE)
    (DECLARE (TYPE STREEBOG STATE)
             (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (DEBUG 0)))
    (LET ((BUFFER (STREEBOG-BUFFER STATE))
          (BUFFER-INDEX (STREEBOG-BUFFER-INDEX STATE)))
      (WHEN (< BUFFER-INDEX 64)
        (FILL BUFFER 0 :START BUFFER-INDEX)
        (SETF (AREF BUFFER BUFFER-INDEX) 1)))
    (VALUES))

[ironclad/src/digests/streebog.lisp:1267]
  (DEFUN STREEBOG-STAGE3 (STATE)
    (DECLARE (TYPE STREEBOG STATE)
             (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (DEBUG 0)))
    (LET ((BUFFER (STREEBOG-BUFFER STATE))
          (BUFFER-INDEX (STREEBOG-BUFFER-INDEX STATE))
          (H (STREEBOG-H STATE))
          (N (STREEBOG-N STATE))
          (SIGMA (STREEBOG-SIGMA STATE))
          (BUF
           (MAKE-ARRAY 8 :ELEMENT-TYPE '(UNSIGNED-BYTE 64) :INITIAL-ELEMENT 0))
          (TMP (MAKE-ARRAY 8 :ELEMENT-TYPE '(UNSIGNED-BYTE 64))))
      (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (64)) BUFFER)
               (TYPE (INTEGER 0 64) BUFFER-INDEX)
               (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (8)) H N SIGMA BUF TMP)
               (DYNAMIC-EXTENT BUF TMP))
      (SETF (AREF BUF 0) (ASH BUFFER-INDEX 3))
      (STREEBOG-PAD STATE)
      (DOTIMES (I 8) (SETF (AREF TMP I) (UB64REF/LE BUFFER (* I 8))))
      (STREEBOG-G H N TMP)
      (STREEBOG-ADD512 N BUF N)
      (STREEBOG-ADD512 SIGMA TMP SIGMA)
      (STREEBOG-G H +STREEBOG-BUFFER0+ N)
      (STREEBOG-G H +STREEBOG-BUFFER0+ SIGMA))
    (VALUES))

[ironclad/src/macs/cmac.lisp:58]
  (DEFUN UPDATE-CMAC (CMAC SEQUENCE &KEY (START 0) (END (LENGTH SEQUENCE)))
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) SEQUENCE)
             (TYPE INDEX START END)
             (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (DEBUG 0)))
    (LET* ((CIPHER (CMAC-CIPHER CMAC))
           (ENCRYPTION-FUNCTION (ENCRYPT-FUNCTION CIPHER))
           (BUFFER (CMAC-BUFFER CMAC))
           (BUFFER-INDEX (CMAC-BUFFER-INDEX CMAC))
           (BLOCK-LENGTH (LENGTH BUFFER))
           (REMAINING (- END START)))
      (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) BUFFER))
      (WHEN (< 0 BUFFER-INDEX BLOCK-LENGTH)
        (DOTIMES (I (MIN REMAINING (- BLOCK-LENGTH BUFFER-INDEX)))
          (SETF (AREF BUFFER BUFFER-INDEX)
                  (LOGXOR (AREF BUFFER BUFFER-INDEX) (AREF SEQUENCE START)))
          (INCF BUFFER-INDEX)
          (INCF START)
          (DECF REMAINING)))
      (WHEN (AND (= BUFFER-INDEX BLOCK-LENGTH) (PLUSP REMAINING))
        (FUNCALL ENCRYPTION-FUNCTION CIPHER BUFFER 0 BUFFER 0)
        (SETF BUFFER-INDEX 0))
      (LOOP WHILE (> REMAINING BLOCK-LENGTH)
            DO (XOR-BLOCK BLOCK-LENGTH BUFFER 0 SEQUENCE START BUFFER
                0) (FUNCALL ENCRYPTION-FUNCTION CIPHER BUFFER 0 BUFFER 0) (INCF
                                                                           START
                                                                           BLOCK-LENGTH) (DECF
                                                                                          REMAINING
                                                                                          BLOCK-LENGTH))
      (LOOP WHILE (PLUSP REMAINING)
            DO (SETF (AREF BUFFER BUFFER-INDEX)
                       (LOGXOR (AREF BUFFER BUFFER-INDEX)
                               (AREF SEQUENCE START))) (INCF
                                                        BUFFER-INDEX) (INCF
                                                                       START) (DECF
                                                                               REMAINING))
      (SETF (CMAC-BUFFER-INDEX CMAC) BUFFER-INDEX)
      (VALUES)))

[ironclad/src/macs/gmac.lisp:49]
  (DEFUN GMAC-SWAP-16 (DATA)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (16)) DATA)
             (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (DEBUG 0)))
    (LET ((X (UB64REF/BE DATA 8)))
      (DECLARE (TYPE (UNSIGNED-BYTE 64) X))
      (SETF (UB64REF/LE DATA 8) (UB64REF/BE DATA 0)
            (UB64REF/LE DATA 0) X))
    (VALUES))

[ironclad/src/macs/gmac.lisp:166]
  (DEFUN GMAC-MUL (ACCUMULATOR KEY)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (16)) ACCUMULATOR)
             (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (DEBUG 0)))
    (IF (PCLMULQDQ-SUPPORTED-P)
        (GMAC-MUL-FAST ACCUMULATOR KEY)
        (LET ((X 0) (Z0 0) (Z1 0) (B 0))
          (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (128 2 2)) KEY)
                   (TYPE (UNSIGNED-BYTE 8) X)
                   (TYPE (UNSIGNED-BYTE 64) Z0 Z1)
                   (TYPE BIT B))
          (DOTIMES-UNROLLED (I 16) (SETF X (AREF ACCUMULATOR I))
           (DOTIMES-UNROLLED (J 8)
            (SETF B (LOGAND (ASH X (- J 7)) 1)
                  Z0 (LOGXOR Z0 (AREF KEY (+ (* I 8) J) B 0))
                  Z1 (LOGXOR Z1 (AREF KEY (+ (* I 8) J) B 1)))))
          (SETF (UB64REF/BE ACCUMULATOR 0) Z0
                (UB64REF/BE ACCUMULATOR 8) Z1)))
    (VALUES))

[ironclad/src/macs/gmac.lisp:191]
  (DEFUN UPDATE-GMAC (MAC DATA &KEY (START 0) (END (LENGTH DATA)))
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) DATA)
             (TYPE INDEX START END)
             (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (DEBUG 0)))
    (LET ((ACCUMULATOR (GMAC-ACCUMULATOR MAC))
          (KEY (GMAC-KEY MAC))
          (TOTAL-LENGTH (GMAC-TOTAL-LENGTH MAC))
          (BUFFER (GMAC-BUFFER MAC))
          (BUFFER-LENGTH (GMAC-BUFFER-LENGTH MAC))
          (REMAINING (- END START)))
      (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (16)) ACCUMULATOR BUFFER)
               (TYPE (UNSIGNED-BYTE 64) TOTAL-LENGTH)
               (TYPE (INTEGER 0 16) BUFFER-LENGTH)
               (TYPE INDEX REMAINING))
      (WHEN (PLUSP BUFFER-LENGTH)
        (LET ((N (MIN REMAINING (- 16 BUFFER-LENGTH))))
          (DECLARE (TYPE (INTEGER 0 16) N))
          (REPLACE BUFFER DATA :START1 BUFFER-LENGTH :START2 START :END2
                   (+ START N))
          (INCF BUFFER-LENGTH N)
          (INCF START N)
          (DECF REMAINING N)))
      (WHEN (= BUFFER-LENGTH 16)
        (WHEN (PCLMULQDQ-SUPPORTED-P) (GMAC-SWAP-16 BUFFER))
        (XOR-BLOCK 16 ACCUMULATOR 0 BUFFER 0 ACCUMULATOR 0)
        (GMAC-MUL ACCUMULATOR KEY)
        (INCF TOTAL-LENGTH 16)
        (SETF BUFFER-LENGTH 0))
      (IF (PCLMULQDQ-SUPPORTED-P)
          (LOOP WHILE (> REMAINING 16)
                DO (SETF (UB64REF/LE BUFFER 8) (UB64REF/BE DATA START)
                         (UB64REF/LE BUFFER 0)
                           (UB64REF/BE DATA (+ START 8))) (XOR-BLOCK 16
                                                           ACCUMULATOR 0 BUFFER
                                                           0 ACCUMULATOR
                                                           0) (GMAC-MUL
                                                               ACCUMULATOR
                                                               KEY) (INCF
                                                                     TOTAL-LENGTH
                                                                     16) (INCF
                                                                          START
                                                                          16) (DECF
                                                                               REMAINING
                                                                               16))
          (LOOP WHILE (> REMAINING 16)
                DO (XOR-BLOCK 16 ACCUMULATOR 0 DATA START ACCUMULATOR
                    0) (GMAC-MUL ACCUMULATOR KEY) (INCF TOTAL-LENGTH 16) (INCF
                                                                          START
                                                                          16) (DECF
                                                                               REMAINING
                                                                               16)))
      (WHEN (PLUSP REMAINING)
        (REPLACE BUFFER DATA :START1 0 :START2 START :END2 END)
        (SETF BUFFER-LENGTH REMAINING))
      (SETF (GMAC-TOTAL-LENGTH MAC) TOTAL-LENGTH
            (GMAC-BUFFER-LENGTH MAC) BUFFER-LENGTH)
      (VALUES)))

[ironclad/src/macs/poly1305.lisp:53]
  (DEFUN POLY1305-PROCESS-FULL-BLOCKS
         (ACCUMULATOR R DATA START REMAINING FINAL)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 32) (5)) ACCUMULATOR)
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 32) (4)) R)
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) DATA)
             (TYPE INDEX START REMAINING)
             (TYPE BOOLEAN FINAL)
             (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (DEBUG 0)))
    (LET* ((HIBIT
            (IF FINAL
                0
                1))
           (H0 (AREF ACCUMULATOR 0))
           (H1 (AREF ACCUMULATOR 1))
           (H2 (AREF ACCUMULATOR 2))
           (H3 (AREF ACCUMULATOR 3))
           (H4 (AREF ACCUMULATOR 4))
           (R0 (AREF R 0))
           (R1 (AREF R 1))
           (R2 (AREF R 2))
           (R3 (AREF R 3))
           (RR0 (MOD32* (MOD32ASH R0 -2) 5))
           (RR1 (MOD32+ (MOD32ASH R1 -2) R1))
           (RR2 (MOD32+ (MOD32ASH R2 -2) R2))
           (RR3 (MOD32+ (MOD32ASH R3 -2) R3)))
      (DECLARE
       (TYPE (UNSIGNED-BYTE 32) HIBIT H0 H1 H2 H3 H4 R0 R1 R2 R3 RR0 RR1 RR2
        RR3))
      (LOOP WHILE (>= REMAINING 16)
            DO (MULTIPLE-VALUE-SETQ (H0 H1 H2 H3 H4)
                 (POLY1305-PROCESS-BLOCK H0 H1 H2 H3 H4 R0 R1 R2 R3 RR0 RR1 RR2
                  RR3 HIBIT DATA START)) (INCF START 16) (DECF REMAINING 16))
      (SETF (AREF ACCUMULATOR 0) H0
            (AREF ACCUMULATOR 1) H1
            (AREF ACCUMULATOR 2) H2
            (AREF ACCUMULATOR 3) H3
            (AREF ACCUMULATOR 4) H4)
      (VALUES START REMAINING)))

[ironclad/src/macs/poly1305.lisp:136]
  (DEFUN UPDATE-POLY1305 (MAC DATA &KEY (START 0) (END (LENGTH DATA)))
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) DATA)
             (TYPE FIXNUM START END)
             (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 1) (DEBUG 0)))
    (LET ((BUFFER (POLY1305-BUFFER MAC))
          (BUFFER-LENGTH (POLY1305-BUFFER-LENGTH MAC))
          (ACCUMULATOR (POLY1305-ACCUMULATOR MAC))
          (R (POLY1305-R MAC))
          (REMAINING (- END START)))
      (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (16)) BUFFER)
               (TYPE (INTEGER 0 16) BUFFER-LENGTH)
               (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 32) (5)) ACCUMULATOR)
               (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 32) (4)) R)
               (TYPE FIXNUM REMAINING))
      (WHEN (PLUSP BUFFER-LENGTH)
        (LET ((N (MIN REMAINING (- 16 BUFFER-LENGTH))))
          (DECLARE (TYPE (INTEGER 0 16) N))
          (REPLACE BUFFER DATA :START1 BUFFER-LENGTH :START2 START :END2
                   (+ START N))
          (INCF BUFFER-LENGTH N)
          (INCF START N)
          (DECF REMAINING N)))
      (WHEN (= BUFFER-LENGTH 16)
        (POLY1305-PROCESS-FULL-BLOCKS ACCUMULATOR R BUFFER 0 16 NIL)
        (SETF BUFFER-LENGTH 0))
      (MULTIPLE-VALUE-SETQ (START REMAINING)
        (POLY1305-PROCESS-FULL-BLOCKS ACCUMULATOR R DATA START REMAINING NIL))
      (WHEN (PLUSP REMAINING)
        (REPLACE BUFFER DATA :START1 0 :START2 START :END2 END)
        (SETF BUFFER-LENGTH REMAINING))
      (SETF (POLY1305-BUFFER-LENGTH MAC) BUFFER-LENGTH)
      (VALUES)))

[ironclad/src/macs/siphash.lisp:83]
  (DEFUN SIPHASH-COMPRESS (STATE DATA START REMAINING DATA-LENGTH N-ROUNDS)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (4)) STATE)
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) DATA)
             (TYPE FIXNUM START REMAINING DATA-LENGTH N-ROUNDS)
             (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (DEBUG 0)))
    (LET ((V0 (AREF STATE 0))
          (V1 (AREF STATE 1))
          (V2 (AREF STATE 2))
          (V3 (AREF STATE 3)))
      (DECLARE (TYPE (UNSIGNED-BYTE 64) V0 V1 V2 V3))
      (DO ((M 0))
          ((< REMAINING 8))
        (DECLARE (TYPE (UNSIGNED-BYTE 64) M))
        (SETF M (UB64REF/LE DATA START))
        (SETF V3 (LOGXOR V3 M))
        (DOTIMES (I N-ROUNDS) (SIPHASH-ROUND V0 V1 V2 V3))
        (SETF V0 (LOGXOR V0 M))
        (INCF START 8)
        (INCF DATA-LENGTH 8)
        (DECF REMAINING 8))
      (SETF (AREF STATE 0) V0
            (AREF STATE 1) V1
            (AREF STATE 2) V2
            (AREF STATE 3) V3)
      (VALUES START REMAINING DATA-LENGTH)))

[ironclad/src/macs/siphash.lisp:110]
  (DEFUN SIPHASH-FINALIZE (STATE N-ROUNDS TAG)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (4)) STATE)
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) TAG)
             (TYPE FIXNUM N-ROUNDS)
             (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (DEBUG 0)))
    (LET ((DIGEST-LENGTH (LENGTH TAG))
          (V0 (AREF STATE 0))
          (V1 (AREF STATE 1))
          (V2 (AREF STATE 2))
          (V3 (AREF STATE 3)))
      (DECLARE (TYPE FIXNUM DIGEST-LENGTH)
               (TYPE (UNSIGNED-BYTE 64) V0 V1 V2 V3))
      (SETF V2
              (LOGXOR V2
                      (IF (= DIGEST-LENGTH 16)
                          238
                          255)))
      (DOTIMES (I N-ROUNDS) (SIPHASH-ROUND V0 V1 V2 V3))
      (SETF (UB64REF/LE TAG 0) (LOGXOR V0 V1 V2 V3))
      (WHEN (= DIGEST-LENGTH 16)
        (SETF V1 (LOGXOR V1 221))
        (DOTIMES (I N-ROUNDS) (SIPHASH-ROUND V0 V1 V2 V3))
        (SETF (UB64REF/LE TAG 8) (LOGXOR V0 V1 V2 V3)))
      (VALUES)))

[ironclad/src/macs/siphash.lisp:133]
  (DEFUN UPDATE-SIPHASH (MAC DATA &KEY (START 0) (END (LENGTH DATA)))
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) DATA)
             (TYPE FIXNUM START END)
             (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 1) (DEBUG 0)))
    (LET ((BUFFER (SIPHASH-BUFFER MAC))
          (BUFFER-LENGTH (SIPHASH-BUFFER-LENGTH MAC))
          (STATE (SIPHASH-STATE MAC))
          (N-ROUNDS (SIPHASH-COMPRESSION-ROUNDS MAC))
          (DATA-LENGTH (SIPHASH-DATA-LENGTH MAC))
          (REMAINING (- END START)))
      (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (8)) BUFFER)
               (TYPE (INTEGER 0 8) BUFFER-LENGTH)
               (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 64) (4)) STATE)
               (TYPE FIXNUM N-ROUNDS DATA-LENGTH REMAINING))
      (WHEN (PLUSP BUFFER-LENGTH)
        (LET ((N (MIN REMAINING (- 8 BUFFER-LENGTH))))
          (DECLARE (TYPE (INTEGER 0 8) N))
          (REPLACE BUFFER DATA :START1 BUFFER-LENGTH :START2 START :END2
                   (+ START N))
          (INCF BUFFER-LENGTH N)
          (INCF START N)
          (INCF DATA-LENGTH N)
          (DECF REMAINING N)))
      (WHEN (= BUFFER-LENGTH 8)
        (SIPHASH-COMPRESS STATE BUFFER 0 8 DATA-LENGTH N-ROUNDS)
        (SETF BUFFER-LENGTH 0))
      (MULTIPLE-VALUE-SETQ (START REMAINING DATA-LENGTH)
        (SIPHASH-COMPRESS STATE DATA START REMAINING DATA-LENGTH N-ROUNDS))
      (WHEN (PLUSP REMAINING)
        (REPLACE BUFFER DATA :START1 0 :START2 START :END2 END)
        (INCF DATA-LENGTH REMAINING)
        (SETF BUFFER-LENGTH REMAINING))
      (SETF (SIPHASH-DATA-LENGTH MAC) DATA-LENGTH)
      (SETF (SIPHASH-BUFFER-LENGTH MAC) BUFFER-LENGTH)
      (VALUES)))

[ironclad/src/math.lisp:4]
  (DEFUN EGCD (A B)
    "Extended Euclidean algorithm, aka extended greatest common
denominator."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0))
             (TYPE INTEGER A B))
    (ASSERT (AND (>= A 0) (>= B 0)))
    (DO ((Q 0)
         (C A (- D (* Q C)))
         (D B C)
         (U_C 1 (- U_D (* Q U_C)))
         (V_C 0 (- V_D (* Q V_C)))
         (U_D 0 U_C)
         (V_D 1 V_C))
        ((= C 0) (VALUES D U_D V_D))
      (SETQ Q (FLOOR D C))))

[ironclad/src/math.lisp:58]
  (DEFUN POWER-MOD-TAB (B K M)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET* ((L (ASH 1 (1- K)))
           (TAB (MAKE-ARRAY L :ELEMENT-TYPE 'INTEGER :INITIAL-ELEMENT 1))
           (BI B)
           (BB (MOD (* B B) M)))
      (SETF (SVREF TAB 0) B)
      (DO ((I 1 (1+ I)))
          ((= I L) TAB)
        (SETQ BI (MOD (* BI BB) M))
        (SETF (SVREF TAB I) BI))))

[ironclad/src/math.lisp:70]
  (DEFUN POWER-MOD (B E M)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (COND ((ZEROP E) (MOD 1 M))
          ((TYPEP E 'FIXNUM)
           (DO ((RES 1))
               (NIL)
             (WHEN (LOGBITP 0 E)
               (SETQ RES (MOD (* RES B) M))
               (WHEN (= 1 E) (RETURN RES)))
             (SETQ E (ASH E -1)
                   B (MOD (* B B) M))))
          (T
           (LET* ((L (INTEGER-LENGTH E))
                  (K
                   (COND ((< L 65) 3) ((< L 161) 4) ((< L 385) 5) ((< L 897) 6)
                         (T 7)))
                  (TAB (POWER-MOD-TAB B K M))
                  (RES 1)
                  S
                  U
                  TMP)
             (DO ((I (1- L)))
                 ((< I 0) RES)
               (COND
                ((LOGBITP I E) (SETQ S (MAX (1+ (- I K)) 0))
                 (DO () ((LOGBITP S E)) (INCF S)) (SETQ TMP (1+ (- I S)))
                 (DOTIMES (H TMP) (SETQ RES (MOD (* RES RES) M)))
                 (SETQ U (LDB (BYTE TMP S) E))
                 (UNLESS (= U 0)
                   (SETQ RES (MOD (* RES (SVREF TAB (ASH U -1))) M)))
                 (SETQ I (1- S)))
                (T (SETQ RES (MOD (* RES RES) M)) (DECF I))))))))

[ironclad/src/math.lisp:106]
  (DEFUN MILLER-RABIN-DECOMPOSITION (N)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DO ((K 1 (1+ K))
         (Q (ASH N -1) (ASH Q -1)))
        ((LOGBITP 0 Q) (VALUES Q K))))

[ironclad/src/math.lisp:113]
  (DEFUN MILLER-RABIN-KERNEL (N Q K &OPTIONAL X)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (UNLESS X (SETQ X (+ (STRONG-RANDOM (- N 2)) 2)))
    (LET ((Y (POWER-MOD X Q N)) (MINUS1 (1- N)))
      (IF (OR (= Y 1) (= Y MINUS1))
          T
          (DO ((J 1 (1+ J)))
              ((= J K))
            (SETQ Y (POWER-MOD Y 2 N))
            (WHEN (= Y MINUS1) (RETURN T))
            (WHEN (= Y 1) (RETURN))))))

[ironclad/src/math.lisp:128]
  (DEFUN LUCAS-SEQUENCE (K P N)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((UH 1) (VL 2) (VH P) (S 0) L)
      (DO () ((LOGBITP 0 K)) (SETQ K (ASH K -1)) (SETQ S (1+ S)))
      (SETQ L (INTEGER-LENGTH K))
      (DO ((J (1- L) (1- J)))
          ((= 0 J))
        (IF (LOGBITP J K)
            (PROGN
             (SETQ UH (MOD (* UH VH) N))
             (SETQ VL (MOD (- (* VH VL) P) N))
             (SETQ VH (MOD (- (* VH VH) 2) N)))
            (PROGN
             (SETQ UH (MOD (1- (* UH VL)) N))
             (SETQ VH (MOD (- (* VH VL) P) N))
             (SETQ VL (MOD (- (* VL VL) 2) N)))))
      (SETQ UH (MOD (1- (* UH VL)) N))
      (SETQ VL (MOD (- (* VH VL) P) N))
      (DOTIMES (J S)
        (SETQ UH (MOD (* UH VL) N))
        (SETQ VL (MOD (- (* VL VL) 2) N)))
      UH))

[ironclad/src/math.lisp:154]
  (DEFUN PRIMEP-LUCAS (N)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((B 3))
      (LOOP UNTIL (= (JACOBI (- (* B B) 4) N) -1)
            DO (INCF B))
      (ZEROP (LUCAS-SEQUENCE (1+ N) B N))))

[ironclad/src/math.lisp:164]
  (DEFUN MODULAR-INVERSE (N MODULUS)
    "Returns M such that N * M mod MODULUS = 1"
    (DECLARE (TYPE (INTEGER 1 *) MODULUS))
    (DECLARE (TYPE (INTEGER 0 *) N))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (WHEN (OR (ZEROP N) (AND (EVENP N) (EVENP MODULUS)))
      (RETURN-FROM MODULAR-INVERSE 0))
    (LOOP WITH R1 OF-TYPE INTEGER = N
          AND R2 OF-TYPE INTEGER = MODULUS
          AND U1 OF-TYPE INTEGER = 1
          AND U2 OF-TYPE INTEGER = 0
          AND Q OF-TYPE INTEGER = 0
          AND R OF-TYPE INTEGER = 0
          UNTIL (ZEROP R2)
          DO (PROGN
              (MULTIPLE-VALUE-SETQ (Q R) (FLOOR R1 R2))
              (SETF R1 R2
                    R2 R)
              (DECF U1 (* Q U2))
              (ROTATEF U1 U2))
          FINALLY (RETURN
                   (LET ((INVERSE U1))
                     (WHEN (MINUSP INVERSE)
                       (SETF INVERSE (MOD INVERSE MODULUS)))
                     (IF (ZEROP (MOD (* N INVERSE) MODULUS))
                         0
                         INVERSE)))))

[ironclad/src/math.lisp:192]
  (DEFUN MODULAR-INVERSE-WITH-BLINDING (N MODULUS)
    "As modular-inverse, but mask N with a blinding factor before
computing the modular inverse."
    (DECLARE (TYPE (INTEGER 1 *) MODULUS))
    (DECLARE (TYPE (INTEGER 0 *) N))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LET* ((B
            (LOOP FOR B = (+ 1 (STRONG-RANDOM (- MODULUS 1)))
                  UNTIL (= 1 (GCD B MODULUS))
                  FINALLY (RETURN B)))
           (X (MOD (* N B) MODULUS))
           (Y (MODULAR-INVERSE X MODULUS)))
      (MOD (* Y B) MODULUS)))

[ironclad/src/math.lisp:205]
  (DEFUN EXPT-MOD (N EXPONENT MODULUS)
    "As (mod (expt n exponent) modulus), but more efficient (Montgomery ladder)."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0))
             (TYPE INTEGER N EXPONENT MODULUS))
    (ASSERT (<= 0 EXPONENT MODULUS))
    (ASSERT (> MODULUS 1))
    (DO ((R0 1)
         (R1 N)
         (I (1- (INTEGER-LENGTH MODULUS)) (1- I)))
        ((MINUSP I) R0)
      (DECLARE (TYPE FIXNUM I)
               (TYPE INTEGER R0 R1))
      (IF (LOGBITP I EXPONENT)
          (SETF R0 (MOD (* R0 R1) MODULUS)
                R1 (MOD (* R1 R1) MODULUS))
          (SETF R1 (MOD (* R0 R1) MODULUS)
                R0 (MOD (* R0 R0) MODULUS)))))

[ironclad/src/opt/sbcl/cpu-features.lisp:14]
  (DEFUN AES-NI-SUPPORTED-P ()
    (DECLARE (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (IF AES-NI-SUPPORT-KNOWN-P
        AES-NI-SUPPORTED-P
        (SETF AES-NI-SUPPORT-KNOWN-P T
              AES-NI-SUPPORTED-P (AES-NI-SUPPORT-P))))

[ironclad/src/opt/sbcl/cpu-features.lisp:29]
  (DEFUN PCLMULQDQ-SUPPORTED-P ()
    (DECLARE (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (IF PCLMULQDQ-SUPPORT-KNOWN-P
        PCLMULQDQ-SUPPORTED-P
        (SETF PCLMULQDQ-SUPPORT-KNOWN-P T
              PCLMULQDQ-SUPPORTED-P (PCLMULQDQ-SUPPORT-P))))

[ironclad/src/public-key/curve25519.lisp:40]
  (DEFUN CURVE25519-DOUBLE-AND-ADD (X1 Z1 X2 Z2 X3)
    "Point doubling and addition on curve25519 curve."
    (DECLARE (TYPE INTEGER X1 Z1 X2 Z2 X3)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LET* ((T1 (MOD (+ X1 Z1) +CURVE25519-P+))
           (T2 (MOD (* T1 T1) +CURVE25519-P+))
           (T3 (MOD (- X1 Z1) +CURVE25519-P+))
           (T4 (MOD (* T3 T3) +CURVE25519-P+))
           (T5 (MOD (- T2 T4) +CURVE25519-P+))
           (T6 (MOD (+ X2 Z2) +CURVE25519-P+))
           (T7 (MOD (- X2 Z2) +CURVE25519-P+))
           (T8 (MOD (* T1 T7) +CURVE25519-P+))
           (T9 (MOD (* T3 T6) +CURVE25519-P+))
           (T10 (MOD (+ T8 T9) +CURVE25519-P+))
           (T11 (MOD (- T8 T9) +CURVE25519-P+))
           (X4 (MOD (* T2 T4) +CURVE25519-P+))
           (T12 (MOD (* T5 +CURVE25519-A24+) +CURVE25519-P+))
           (T13 (MOD (+ T4 T12) +CURVE25519-P+))
           (Z4 (MOD (* T5 T13) +CURVE25519-P+))
           (X5 (MOD (* T10 T10) +CURVE25519-P+))
           (T14 (MOD (* T11 T11) +CURVE25519-P+))
           (Z5 (MOD (* X3 T14) +CURVE25519-P+)))
      (DECLARE
       (TYPE INTEGER T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 X4 Z4 X5
        Z5))
      (VALUES X4 Z4 X5 Z5)))

[ironclad/src/public-key/curve25519.lisp:65]
  (DEFMETHOD EC-SCALAR-MULT ((P CURVE25519-POINT) N)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0))
             (TYPE INTEGER N))
    (WITH-SLOTS (X Z)
        P
      (DECLARE (TYPE INTEGER X Z))
      (ASSERT (= 1 Z))
      (DO ((X1 1)
           (Z1 0)
           (X2 X)
           (Z2 1)
           (I 254 (1- I)))
          ((MINUSP I) (MAKE-INSTANCE 'CURVE25519-POINT :X X1 :Z Z1))
        (DECLARE (TYPE INTEGER X1 Z1 X2 Z2)
                 (TYPE FIXNUM I))
        (IF (LOGBITP I N)
            (MULTIPLE-VALUE-SETQ (X2 Z2 X1 Z1)
              (CURVE25519-DOUBLE-AND-ADD X2 Z2 X1 Z1 X))
            (MULTIPLE-VALUE-SETQ (X1 Z1 X2 Z2)
              (CURVE25519-DOUBLE-AND-ADD X1 Z1 X2 Z2 X))))))

[ironclad/src/public-key/curve25519.lisp:89]
  (DEFMETHOD EC-DECODE-SCALAR ((KIND (EQL :CURVE25519)) OCTETS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LET ((X
           (LDB (BYTE (1- +CURVE25519-BITS+) 0)
                (OCTETS-TO-INTEGER OCTETS :BIG-ENDIAN NIL))))
      (SETF (LDB (BYTE 3 0) X) 0)
      (SETF (LDB (BYTE 1 (- +CURVE25519-BITS+ 2)) X) 1)
      X))

[ironclad/src/public-key/curve25519.lisp:97]
  (DEFMETHOD EC-ENCODE-POINT ((P CURVE25519-POINT))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (WITH-SLOTS (X Z)
        P
      (DECLARE (TYPE INTEGER X Z))
      (LET ((X1 (MOD (* X (EC-SCALAR-INV :CURVE25519 Z)) +CURVE25519-P+)))
        (EC-ENCODE-SCALAR :CURVE25519 X1))))

[ironclad/src/public-key/curve25519.lisp:104]
  (DEFMETHOD EC-DECODE-POINT ((KIND (EQL :CURVE25519)) OCTETS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LET ((X
           (LDB (BYTE (1- +CURVE25519-BITS+) 0)
                (OCTETS-TO-INTEGER OCTETS :BIG-ENDIAN NIL))))
      (MAKE-INSTANCE 'CURVE25519-POINT :X X :Z 1)))

[ironclad/src/public-key/curve25519.lisp:110]
  (DEFUN CURVE25519-PUBLIC-KEY (SK)
    "Compute the public key associated to the private key SK."
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) SK)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LET* ((S (EC-DECODE-SCALAR :CURVE25519 SK))
           (P (EC-SCALAR-MULT +CURVE25519-G+ S)))
      (EC-ENCODE-POINT P)))

[ironclad/src/public-key/curve448.lisp:40]
  (DEFUN CURVE448-DOUBLE-AND-ADD (X1 Z1 X2 Z2 X3)
    "Point doubling and addition on curve448 curve."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0))
             (TYPE INTEGER X1 Z1 X2 Z2 X3))
    (LET* ((T1 (MOD (+ X1 Z1) +CURVE448-P+))
           (T2 (MOD (- X1 Z1) +CURVE448-P+))
           (T3 (MOD (- X2 Z2) +CURVE448-P+))
           (T4 (MOD (* T1 T3) +CURVE448-P+))
           (T5 (MOD (+ X2 Z2) +CURVE448-P+))
           (T6 (MOD (* T2 T5) +CURVE448-P+))
           (T7 (MOD (- T4 T6) +CURVE448-P+))
           (T8 (MOD (* T7 T7) +CURVE448-P+))
           (Z5 (MOD (* X3 T8) +CURVE448-P+))
           (T9 (MOD (+ T4 T6) +CURVE448-P+))
           (X5 (MOD (* T9 T9) +CURVE448-P+))
           (T10 (MOD (* T1 T1) +CURVE448-P+))
           (T11 (MOD (* T2 T2) +CURVE448-P+))
           (X4 (MOD (* T10 T11) +CURVE448-P+))
           (T12 (MOD (- T10 T11) +CURVE448-P+))
           (T13 (MOD (* T12 +CURVE448-A24+) +CURVE448-P+))
           (T14 (MOD (+ T13 T10) +CURVE448-P+))
           (Z4 (MOD (* T14 T12) +CURVE448-P+)))
      (DECLARE
       (TYPE INTEGER T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 T13 T14 X4 Z4 X5
        Z5))
      (VALUES X4 Z4 X5 Z5)))

[ironclad/src/public-key/curve448.lisp:65]
  (DEFMETHOD EC-SCALAR-MULT ((P CURVE448-POINT) N)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0))
             (TYPE INTEGER N))
    (WITH-SLOTS (X Z)
        P
      (DECLARE (TYPE INTEGER X Z))
      (ASSERT (= 1 Z))
      (DO ((X1 1)
           (Z1 0)
           (X2 X)
           (Z2 1)
           (I 447 (1- I)))
          ((MINUSP I) (MAKE-INSTANCE 'CURVE448-POINT :X X1 :Z Z1))
        (DECLARE (TYPE INTEGER X1 Z1 X2 Z2)
                 (TYPE FIXNUM I))
        (IF (LOGBITP I N)
            (MULTIPLE-VALUE-SETQ (X2 Z2 X1 Z1)
              (CURVE448-DOUBLE-AND-ADD X2 Z2 X1 Z1 X))
            (MULTIPLE-VALUE-SETQ (X1 Z1 X2 Z2)
              (CURVE448-DOUBLE-AND-ADD X1 Z1 X2 Z2 X))))))

[ironclad/src/public-key/curve448.lisp:89]
  (DEFMETHOD EC-DECODE-SCALAR ((KIND (EQL :CURVE448)) OCTETS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LET ((X
           (LDB (BYTE +CURVE448-BITS+ 0)
                (OCTETS-TO-INTEGER OCTETS :BIG-ENDIAN NIL))))
      (SETF (LDB (BYTE 2 0) X) 0)
      (SETF (LDB (BYTE 1 (1- +CURVE448-BITS+)) X) 1)
      X))

[ironclad/src/public-key/curve448.lisp:97]
  (DEFMETHOD EC-ENCODE-POINT ((P CURVE448-POINT))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (WITH-SLOTS (X Z)
        P
      (DECLARE (TYPE INTEGER X Z))
      (LET ((X1 (MOD (* X (EC-SCALAR-INV :CURVE448 Z)) +CURVE448-P+)))
        (EC-ENCODE-SCALAR :CURVE448 X1))))

[ironclad/src/public-key/curve448.lisp:104]
  (DEFMETHOD EC-DECODE-POINT ((KIND (EQL :CURVE448)) OCTETS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LET ((X
           (LDB (BYTE +CURVE448-BITS+ 0)
                (OCTETS-TO-INTEGER OCTETS :BIG-ENDIAN NIL))))
      (MAKE-INSTANCE 'CURVE448-POINT :X X :Z 1)))

[ironclad/src/public-key/curve448.lisp:110]
  (DEFUN CURVE448-PUBLIC-KEY (SK)
    "Compute the public key associated to the private key SK."
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) SK)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LET* ((S (EC-DECODE-SCALAR :CURVE448 SK))
           (P (EC-SCALAR-MULT +CURVE448-G+ S)))
      (EC-ENCODE-POINT P)))

[ironclad/src/public-key/ed25519.lisp:50]
  (DEFUN ED25519-RECOVER-X (Y)
    "Recover the X coordinate of a point on ed25519 curve from the Y coordinate."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0))
             (TYPE INTEGER Y))
    (LET* ((U (MOD (1- (* Y Y)) +ED25519-Q+))
           (V (MOD (1+ (* +ED25519-D+ (1+ U))) +ED25519-Q+))
           (V3 (MOD (* V V V) +ED25519-Q+))
           (UV3 (MOD (* U V3) +ED25519-Q+))
           (UV7 (MOD (* UV3 V3 V) +ED25519-Q+))
           (X
            (MOD (* UV3 (EXPT-MOD UV7 (/ (- +ED25519-Q+ 5) 8) +ED25519-Q+))
                 +ED25519-Q+)))
      (DECLARE (TYPE INTEGER U V V3 UV3 UV7 X))
      (UNLESS (= U (MOD (* V X X) +ED25519-Q+))
        (SETF X (MOD (* X +ED25519-I+) +ED25519-Q+)))
      (UNLESS (EVENP X) (SETF X (- +ED25519-Q+ X)))
      X))

[ironclad/src/public-key/ed25519.lisp:67]
  (DEFMETHOD EC-ADD ((P ED25519-POINT) (Q ED25519-POINT))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (WITH-SLOTS ((X1 X) (Y1 Y) (Z1 Z) (W1 W))
        P
      (DECLARE (TYPE INTEGER X1 Y1 Z1 W1))
      (WITH-SLOTS ((X2 X) (Y2 Y) (Z2 Z) (W2 W))
          Q
        (DECLARE (TYPE INTEGER X2 Y2 Z2 W2))
        (LET* ((A (MOD (* (- Y1 X1) (- Y2 X2)) +ED25519-Q+))
               (B (MOD (* (+ Y1 X1) (+ Y2 X2)) +ED25519-Q+))
               (I (MOD (* W1 W2) +ED25519-Q+))
               (C (MOD (* 2 I +ED25519-D+) +ED25519-Q+))
               (D (MOD (* 2 Z1 Z2) +ED25519-Q+))
               (E (MOD (- B A) +ED25519-Q+))
               (F (MOD (- D C) +ED25519-Q+))
               (G (MOD (+ D C) +ED25519-Q+))
               (H (MOD (+ B A) +ED25519-Q+))
               (X3 (MOD (* E F) +ED25519-Q+))
               (Y3 (MOD (* G H) +ED25519-Q+))
               (Z3 (MOD (* F G) +ED25519-Q+))
               (W3 (MOD (* E H) +ED25519-Q+)))
          (DECLARE (TYPE INTEGER A B C D E F G H I X3 Y3 Z3 W3))
          (MAKE-INSTANCE 'ED25519-POINT :X X3 :Y Y3 :Z Z3 :W W3)))))

[ironclad/src/public-key/ed25519.lisp:89]
  (DEFMETHOD EC-DOUBLE ((P ED25519-POINT))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (WITH-SLOTS ((X1 X) (Y1 Y) (Z1 Z))
        P
      (DECLARE (TYPE INTEGER X1 Y1 Z1))
      (LET* ((A (MOD (* X1 X1) +ED25519-Q+))
             (B (MOD (* Y1 Y1) +ED25519-Q+))
             (C (MOD (* 2 Z1 Z1) +ED25519-Q+))
             (D (MOD (+ X1 Y1) +ED25519-Q+))
             (I (MOD (* D D) +ED25519-Q+))
             (H (MOD (+ A B) +ED25519-Q+))
             (E (MOD (- H I) +ED25519-Q+))
             (G (MOD (- A B) +ED25519-Q+))
             (F (MOD (+ C G) +ED25519-Q+))
             (X2 (MOD (* E F) +ED25519-Q+))
             (Y2 (MOD (* G H) +ED25519-Q+))
             (Z2 (MOD (* F G) +ED25519-Q+))
             (W2 (MOD (* E H) +ED25519-Q+)))
        (DECLARE (TYPE INTEGER A B C D E F G H I X2 Y2 Z2 W2))
        (MAKE-INSTANCE 'ED25519-POINT :X X2 :Y Y2 :Z Z2 :W W2))))

[ironclad/src/public-key/ed25519.lisp:109]
  (DEFMETHOD EC-SCALAR-MULT ((P ED25519-POINT) E)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0))
             (TYPE INTEGER E))
    (DO ((R0 +ED25519-POINT-AT-INFINITY+)
         (R1 P)
         (I 254 (1- I)))
        ((MINUSP I) R0)
      (DECLARE (TYPE ED25519-POINT R0 R1)
               (TYPE FIXNUM I))
      (IF (LOGBITP I E)
          (SETF R0 (EC-ADD R0 R1)
                R1 (EC-DOUBLE R1))
          (SETF R1 (EC-ADD R0 R1)
                R0 (EC-DOUBLE R0)))))

[ironclad/src/public-key/ed25519.lisp:125]
  (DEFMETHOD EC-POINT-ON-CURVE-P ((P ED25519-POINT))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (WITH-SLOTS (X Y Z W)
        P
      (DECLARE (TYPE INTEGER X Y Z W))
      (LET* ((XX (MOD (* X X) +ED25519-Q+))
             (YY (MOD (* Y Y) +ED25519-Q+))
             (ZZ (MOD (* Z Z) +ED25519-Q+))
             (WW (MOD (* W W) +ED25519-Q+))
             (A (MOD (- YY XX) +ED25519-Q+))
             (B (MOD (+ ZZ (* +ED25519-D+ WW)) +ED25519-Q+)))
        (DECLARE (TYPE INTEGER XX YY ZZ WW A B))
        (ZEROP (MOD (- A B) +ED25519-Q+)))))

[ironclad/src/public-key/ed25519.lisp:138]
  (DEFMETHOD EC-POINT-EQUAL ((P ED25519-POINT) (Q ED25519-POINT))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (WITH-SLOTS ((X1 X) (Y1 Y) (Z1 Z))
        P
      (DECLARE (TYPE INTEGER X1 Y1 Z1))
      (WITH-SLOTS ((X2 X) (Y2 Y) (Z2 Z))
          Q
        (DECLARE (TYPE INTEGER X2 Y2 Z2))
        (AND (ZEROP (MOD (- (* X1 Z2) (* X2 Z1)) +ED25519-Q+))
             (ZEROP (MOD (- (* Y1 Z2) (* Y2 Z1)) +ED25519-Q+))))))

[ironclad/src/public-key/ed25519.lisp:153]
  (DEFMETHOD EC-ENCODE-POINT ((P ED25519-POINT))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (WITH-SLOTS (X Y Z)
        P
      (DECLARE (TYPE INTEGER X Y Z))
      (LET* ((INVZ (EC-SCALAR-INV :ED25519 Z))
             (X (MOD (* X INVZ) +ED25519-Q+))
             (Y (MOD (* Y INVZ) +ED25519-Q+)))
        (DECLARE (TYPE INTEGER X Y INVZ))
        (SETF (LDB (BYTE 1 (- +ED25519-BITS+ 1)) Y) (LDB (BYTE 1 0) X))
        (EC-ENCODE-SCALAR :ED25519 Y))))

[ironclad/src/public-key/ed25519.lisp:164]
  (DEFMETHOD EC-DECODE-POINT ((KIND (EQL :ED25519)) OCTETS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LET* ((Y (EC-DECODE-SCALAR :ED25519 OCTETS))
           (B (LDB (BYTE 1 (- +ED25519-BITS+ 1)) Y)))
      (DECLARE (TYPE INTEGER Y)
               (TYPE FIXNUM B))
      (SETF (LDB (BYTE 1 (- +ED25519-BITS+ 1)) Y) 0)
      (LET ((X (ED25519-RECOVER-X Y)))
        (DECLARE (TYPE INTEGER X))
        (UNLESS (= (LDB (BYTE 1 0) X) B) (SETF X (- +ED25519-Q+ X)))
        (LET* ((W (MOD (* X Y) +ED25519-Q+))
               (P (MAKE-INSTANCE 'ED25519-POINT :X X :Y Y :Z 1 :W W)))
          (DECLARE (TYPE INTEGER W)
                   (TYPE ED25519-POINT P))
          (IF (EC-POINT-ON-CURVE-P P)
              P
              (ERROR 'INVALID-CURVE-POINT :KIND 'ED25519))))))

[ironclad/src/public-key/ed25519.lisp:183]
  (DEFUN ED25519-HASH (&REST MESSAGES)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LET ((DIGEST (MAKE-DIGEST :SHA512)))
      (DOLIST (M MESSAGES) (UPDATE-DIGEST DIGEST M))
      (PRODUCE-DIGEST DIGEST)))

[ironclad/src/public-key/ed25519.lisp:190]
  (DEFUN ED25519-PUBLIC-KEY (SK)
    "Compute the public key associated to the private key SK."
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) SK)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LET ((H (ED25519-HASH SK)))
      (SETF H (SUBSEQ H 0 (/ +ED25519-BITS+ 8)))
      (SETF (LDB (BYTE 3 0) (ELT H 0)) 0)
      (SETF (LDB (BYTE 2 6) (ELT H (- (/ +ED25519-BITS+ 8) 1))) 1)
      (LET ((A (EC-DECODE-SCALAR :ED25519 H)))
        (EC-ENCODE-POINT (EC-SCALAR-MULT +ED25519-B+ A)))))

[ironclad/src/public-key/ed25519.lisp:223]
  (DEFUN ED25519-SIGN (M SK PK)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) M SK PK)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LET ((H (ED25519-HASH SK)))
      (SETF (LDB (BYTE 3 0) (ELT H 0)) 0)
      (SETF (LDB (BYTE 2 6) (ELT H (- (/ +ED25519-BITS+ 8) 1))) 1)
      (LET* ((A (EC-DECODE-SCALAR :ED25519 (SUBSEQ H 0 (/ +ED25519-BITS+ 8))))
             (RH
              (ED25519-HASH
               (SUBSEQ H (/ +ED25519-BITS+ 8) (/ +ED25519-BITS+ 4)) M))
             (RI (MOD (EC-DECODE-SCALAR :ED25519 RH) +ED25519-L+))
             (R (EC-SCALAR-MULT +ED25519-B+ RI))
             (RP (EC-ENCODE-POINT R))
             (K
              (MOD (EC-DECODE-SCALAR :ED25519 (ED25519-HASH RP PK M))
                   +ED25519-L+))
             (S (MOD (+ (* K A) RI) +ED25519-L+)))
        (DECLARE (TYPE INTEGER A RI K S)
                 (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) RH)
                 (TYPE ED25519-POINT R))
        (MAKE-SIGNATURE :ED25519 :R RP :S (EC-ENCODE-SCALAR :ED25519 S)))))

[ironclad/src/public-key/ed25519.lisp:241]
  (DEFUN ED25519-VERIFY (S M PK)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) S M PK)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (UNLESS (= (LENGTH S) (/ +ED25519-BITS+ 4))
      (ERROR 'INVALID-SIGNATURE-LENGTH :KIND 'ED25519))
    (UNLESS (= (LENGTH PK) (/ +ED25519-BITS+ 8))
      (ERROR 'INVALID-PUBLIC-KEY-LENGTH :KIND 'ED25519))
    (LET* ((SIGNATURE-ELEMENTS (DESTRUCTURE-SIGNATURE :ED25519 S))
           (R (GETF SIGNATURE-ELEMENTS :R))
           (RP (EC-DECODE-POINT :ED25519 R))
           (S (EC-DECODE-SCALAR :ED25519 (GETF SIGNATURE-ELEMENTS :S)))
           (A (EC-DECODE-POINT :ED25519 PK))
           (H
            (MOD (EC-DECODE-SCALAR :ED25519 (ED25519-HASH R PK M))
                 +ED25519-L+))
           (RES1 (EC-SCALAR-MULT +ED25519-B+ S))
           (RES2 (EC-ADD RP (EC-SCALAR-MULT A H))))
      (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) R)
               (TYPE INTEGER S H)
               (TYPE ED25519-POINT RP A RES1 RES2))
      (AND (< S +ED25519-L+) (EC-POINT-EQUAL RES1 RES2))))

[ironclad/src/public-key/ed448.lisp:44]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (DEFUN ED448-DOM (X Y)
      (DECLARE (TYPE (UNSIGNED-BYTE 8) X)
               (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) Y)
               (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
      (WHEN (> (LENGTH Y) 255)
        (ERROR 'IRONCLAD-ERROR :FORMAT-CONTROL "The Y array is to big."))
      (CONCATENATE '(SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*))
                   (MAP 'VECTOR #'CHAR-CODE "SigEd448") (VECTOR X)
                   (VECTOR (LENGTH Y)) Y)))

[ironclad/src/public-key/ed448.lisp:63]
  (DEFUN ED448-RECOVER-X (Y)
    "Recover the X coordinate of a point on ed448 curve from the Y coordinate."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0))
             (TYPE INTEGER Y))
    (LET* ((U (MOD (1- (* Y Y)) +ED448-Q+))
           (V (MOD (1- (* +ED448-D+ (1+ U))) +ED448-Q+))
           (UV (MOD (* U V) +ED448-Q+))
           (U3V (MOD (* U U UV) +ED448-Q+))
           (U5V3 (MOD (* U3V UV UV) +ED448-Q+))
           (X
            (MOD (* U3V (EXPT-MOD U5V3 (/ (- +ED448-Q+ 3) 4) +ED448-Q+))
                 +ED448-Q+)))
      (DECLARE (TYPE INTEGER U V UV U3V U5V3 X))
      (UNLESS (EVENP X) (SETF X (- +ED448-Q+ X)))
      X))

[ironclad/src/public-key/ed448.lisp:78]
  (DEFMETHOD EC-ADD ((P ED448-POINT) (Q ED448-POINT))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (WITH-SLOTS ((X1 X) (Y1 Y) (Z1 Z))
        P
      (DECLARE (TYPE INTEGER X1 Y1 Z1))
      (WITH-SLOTS ((X2 X) (Y2 Y) (Z2 Z))
          Q
        (DECLARE (TYPE INTEGER X2 Y2 Z2))
        (LET* ((A (MOD (* Z1 Z2) +ED448-Q+))
               (B (MOD (* A A) +ED448-Q+))
               (C (MOD (* X1 X2) +ED448-Q+))
               (D (MOD (* Y1 Y2) +ED448-Q+))
               (K (MOD (* C D) +ED448-Q+))
               (E (MOD (* +ED448-D+ K) +ED448-Q+))
               (F (MOD (- B E) +ED448-Q+))
               (G (MOD (+ B E) +ED448-Q+))
               (H (MOD (* (+ X1 Y1) (+ X2 Y2)) +ED448-Q+))
               (I (MOD (* A F) +ED448-Q+))
               (J (MOD (* A G) +ED448-Q+))
               (X3 (MOD (* I (- H C D)) +ED448-Q+))
               (Y3 (MOD (* J (- D C)) +ED448-Q+))
               (Z3 (MOD (* F G) +ED448-Q+)))
          (DECLARE (TYPE INTEGER A B C D E F G H I J K X3 Y3 Z3))
          (MAKE-INSTANCE 'ED448-POINT :X X3 :Y Y3 :Z Z3)))))

[ironclad/src/public-key/ed448.lisp:101]
  (DEFMETHOD EC-DOUBLE ((P ED448-POINT))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (WITH-SLOTS ((X1 X) (Y1 Y) (Z1 Z))
        P
      (DECLARE (TYPE INTEGER X1 Y1 Z1))
      (LET* ((A (MOD (+ X1 Y1) +ED448-Q+))
             (B (MOD (* A A) +ED448-Q+))
             (C (MOD (* X1 X1) +ED448-Q+))
             (D (MOD (* Y1 Y1) +ED448-Q+))
             (E (MOD (+ C D) +ED448-Q+))
             (F (MOD (* Z1 Z1) +ED448-Q+))
             (G (MOD (- E (* 2 F)) +ED448-Q+))
             (X2 (MOD (* (- B E) G) +ED448-Q+))
             (Y2 (MOD (* (- C D) E) +ED448-Q+))
             (Z2 (MOD (* E G) +ED448-Q+)))
        (DECLARE (TYPE INTEGER A B C D E F G X2 Y2 Z2))
        (MAKE-INSTANCE 'ED448-POINT :X X2 :Y Y2 :Z Z2))))

[ironclad/src/public-key/ed448.lisp:118]
  (DEFMETHOD EC-SCALAR-MULT ((P ED448-POINT) E)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0))
             (TYPE INTEGER E))
    (DO ((R0 +ED448-POINT-AT-INFINITY+)
         (R1 P)
         (I 447 (1- I)))
        ((MINUSP I) R0)
      (DECLARE (TYPE ED448-POINT R0 R1)
               (TYPE FIXNUM I))
      (IF (LOGBITP I E)
          (SETF R0 (EC-ADD R0 R1)
                R1 (EC-DOUBLE R1))
          (SETF R1 (EC-ADD R0 R1)
                R0 (EC-DOUBLE R0)))))

[ironclad/src/public-key/ed448.lisp:134]
  (DEFMETHOD EC-POINT-ON-CURVE-P ((P ED448-POINT))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (WITH-SLOTS (X Y Z)
        P
      (DECLARE (TYPE INTEGER X Y Z))
      (LET* ((XX (MOD (* X X) +ED448-Q+))
             (YY (MOD (* Y Y) +ED448-Q+))
             (ZZ (MOD (* Z Z) +ED448-Q+))
             (ZZZZ (MOD (* ZZ ZZ) +ED448-Q+))
             (A (MOD (* ZZ (+ YY XX)) +ED448-Q+))
             (B (MOD (+ ZZZZ (* +ED448-D+ XX YY)) +ED448-Q+)))
        (DECLARE (TYPE INTEGER XX YY ZZ ZZZZ A B))
        (ZEROP (MOD (- A B) +ED448-Q+)))))

[ironclad/src/public-key/ed448.lisp:147]
  (DEFMETHOD EC-POINT-EQUAL ((P ED448-POINT) (Q ED448-POINT))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (WITH-SLOTS ((X1 X) (Y1 Y) (Z1 Z))
        P
      (DECLARE (TYPE INTEGER X1 Y1 Z1))
      (WITH-SLOTS ((X2 X) (Y2 Y) (Z2 Z))
          Q
        (DECLARE (TYPE INTEGER X2 Y2 Z2))
        (AND (ZEROP (MOD (- (* X1 Z2) (* X2 Z1)) +ED448-Q+))
             (ZEROP (MOD (- (* Y1 Z2) (* Y2 Z1)) +ED448-Q+))))))

[ironclad/src/public-key/ed448.lisp:162]
  (DEFMETHOD EC-ENCODE-POINT ((P ED448-POINT))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (WITH-SLOTS (X Y Z)
        P
      (DECLARE (TYPE INTEGER X Y Z))
      (LET* ((INVZ (EC-SCALAR-INV :ED448 Z))
             (X (MOD (* X INVZ) +ED448-Q+))
             (Y (MOD (* Y INVZ) +ED448-Q+)))
        (DECLARE (TYPE INTEGER X Y))
        (SETF (LDB (BYTE 1 (- +ED448-BITS+ 1)) Y) (LDB (BYTE 1 0) X))
        (EC-ENCODE-SCALAR :ED448 Y))))

[ironclad/src/public-key/ed448.lisp:173]
  (DEFMETHOD EC-DECODE-POINT ((KIND (EQL :ED448)) OCTETS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LET* ((Y (EC-DECODE-SCALAR :ED448 OCTETS))
           (B (LDB (BYTE 1 (- +ED448-BITS+ 1)) Y)))
      (SETF (LDB (BYTE 1 (- +ED448-BITS+ 1)) Y) 0)
      (LET ((X (ED448-RECOVER-X Y)))
        (DECLARE (TYPE INTEGER X))
        (UNLESS (= (LDB (BYTE 1 0) X) B) (SETF X (- +ED448-Q+ X)))
        (LET ((P (MAKE-INSTANCE 'ED448-POINT :X X :Y Y :Z 1)))
          (IF (EC-POINT-ON-CURVE-P P)
              P
              (ERROR 'INVALID-CURVE-POINT :KIND 'ED448))))))

[ironclad/src/public-key/ed448.lisp:187]
  (DEFUN ED448-HASH (&REST MESSAGES)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LET ((DIGEST (MAKE-DIGEST :SHAKE256 :OUTPUT-LENGTH 114)))
      (DOLIST (M MESSAGES) (UPDATE-DIGEST DIGEST M))
      (PRODUCE-DIGEST DIGEST)))

[ironclad/src/public-key/ed448.lisp:226]
  (DEFUN ED448-SIGN (M SK PK)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) M SK PK)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LET ((H (ED448-HASH SK)))
      (SETF (LDB (BYTE 2 0) (ELT H 0)) 0)
      (SETF (LDB (BYTE 1 7) (ELT H (- (CEILING +ED448-BITS+ 8) 2))) 1)
      (SETF (ELT H (- (CEILING +ED448-BITS+ 8) 1)) 0)
      (LET* ((A
              (EC-DECODE-SCALAR :ED448 (SUBSEQ H 0 (CEILING +ED448-BITS+ 8))))
             (RH
              (ED448-HASH +ED448-DOM+
               (SUBSEQ H (CEILING +ED448-BITS+ 8) (CEILING +ED448-BITS+ 4)) M))
             (RI (MOD (EC-DECODE-SCALAR :ED448 RH) +ED448-L+))
             (R (EC-SCALAR-MULT +ED448-B+ RI))
             (RP (EC-ENCODE-POINT R))
             (K
              (MOD (EC-DECODE-SCALAR :ED448 (ED448-HASH +ED448-DOM+ RP PK M))
                   +ED448-L+))
             (S (MOD (+ (* K A) RI) +ED448-L+)))
        (MAKE-SIGNATURE :ED448 :R RP :S (EC-ENCODE-SCALAR :ED448 S)))))

[ironclad/src/public-key/ed448.lisp:242]
  (DEFUN ED448-VERIFY (S M PK)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) S M PK)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (UNLESS (= (LENGTH S) (CEILING +ED448-BITS+ 4))
      (ERROR 'INVALID-SIGNATURE-LENGTH :KIND 'ED448))
    (UNLESS (= (LENGTH PK) (CEILING +ED448-BITS+ 8))
      (ERROR 'INVALID-PUBLIC-KEY-LENGTH :KIND 'ED448))
    (LET* ((SIGNATURE-ELEMENTS (DESTRUCTURE-SIGNATURE :ED448 S))
           (R (GETF SIGNATURE-ELEMENTS :R))
           (RP (EC-DECODE-POINT :ED448 R))
           (S (EC-DECODE-SCALAR :ED448 (GETF SIGNATURE-ELEMENTS :S)))
           (A (EC-DECODE-POINT :ED448 PK))
           (H
            (MOD (EC-DECODE-SCALAR :ED448 (ED448-HASH +ED448-DOM+ R PK M))
                 +ED448-L+))
           (RES1 (EC-SCALAR-MULT +ED448-B+ S))
           (RES2 (EC-ADD RP (EC-SCALAR-MULT A H))))
      (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) R)
               (TYPE INTEGER S H)
               (TYPE ED448-POINT RP A RES1 RES2))
      (AND (< S +ED448-L+) (EC-POINT-EQUAL RES1 RES2))))

[ironclad/src/public-key/public-key.lisp:28]
  (DEFUN OCTETS-TO-INTEGER (OCTET-VEC &KEY (START 0) END (BIG-ENDIAN T) N-BITS)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) OCTET-VEC)
             (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 1) (DEBUG 0)))
    (LET ((END (OR END (LENGTH OCTET-VEC))))
      (MULTIPLE-VALUE-BIND (N-BITS N-BYTES)
          (LET ((SIZE (- END START)))
            (IF N-BITS
                (VALUES N-BITS (MIN (CEILING N-BITS 8) SIZE))
                (VALUES (* 8 SIZE) SIZE)))
        (LET ((SUM
               (IF BIG-ENDIAN
                   (LOOP WITH
                         SUM = 0
                         FOR I FROM (- END N-BYTES) BELOW
                         END
                         DO (SETF SUM (+ (ASH SUM 8) (AREF OCTET-VEC I)))
                         FINALLY (RETURN SUM))
                   (LOOP FOR I FROM START BELOW (+ START N-BYTES)
                         FOR J FROM 0 BY 8
                         SUM (ASH (AREF OCTET-VEC I) J)))))
          (LDB (BYTE N-BITS 0) SUM)))))

[ironclad/src/public-key/public-key.lisp:47]
  (DEFUN INTEGER-TO-OCTETS (BIGNUM &KEY N-BITS (BIG-ENDIAN T))
    (DECLARE (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 1) (DEBUG 0)))
    (LET* ((N-BITS (OR N-BITS (INTEGER-LENGTH BIGNUM)))
           (BIGNUM (LDB (BYTE N-BITS 0) BIGNUM))
           (N-BYTES (CEILING N-BITS 8))
           (OCTET-VEC (MAKE-ARRAY N-BYTES :ELEMENT-TYPE '(UNSIGNED-BYTE 8))))
      (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) OCTET-VEC))
      (IF BIG-ENDIAN
          (LOOP FOR I FROM (1- N-BYTES) DOWNTO 0
                FOR INDEX FROM 0
                DO (SETF (AREF OCTET-VEC INDEX) (LDB (BYTE 8 (* I 8)) BIGNUM))
                FINALLY (RETURN OCTET-VEC))
          (LOOP FOR I FROM 0 BELOW N-BYTES
                FOR BYTE FROM 0 BY 8
                DO (SETF (AREF OCTET-VEC I) (LDB (BYTE 8 BYTE) BIGNUM))
                FINALLY (RETURN OCTET-VEC)))))

[ironclad/src/public-key/secp256k1.lisp:49]
  (DEFMETHOD EC-POINT-EQUAL ((P SECP256K1-POINT) (Q SECP256K1-POINT))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (WITH-SLOTS ((X1 X) (Y1 Y) (Z1 Z))
        P
      (DECLARE (TYPE INTEGER X1 Y1 Z1))
      (WITH-SLOTS ((X2 X) (Y2 Y) (Z2 Z))
          Q
        (DECLARE (TYPE INTEGER X2 Y2 Z2))
        (LET ((Z1Z1 (MOD (* Z1 Z1) +SECP256K1-P+))
              (Z2Z2 (MOD (* Z2 Z2) +SECP256K1-P+)))
          (AND (ZEROP (MOD (- (* X1 Z2Z2) (* X2 Z1Z1)) +SECP256K1-P+))
               (ZEROP
                (MOD (- (* Y1 Z2Z2 Z2) (* Y2 Z1Z1 Z1)) +SECP256K1-P+)))))))

[ironclad/src/public-key/secp256k1.lisp:60]
  (DEFMETHOD EC-DOUBLE ((P SECP256K1-POINT))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (WITH-SLOTS ((X1 X) (Y1 Y) (Z1 Z))
        P
      (DECLARE (TYPE INTEGER X1 Y1 Z1))
      (IF (ZEROP Z1)
          +SECP256K1-POINT-AT-INFINITY+
          (LET* ((A (MOD (* X1 X1) +SECP256K1-P+))
                 (B (MOD (* Y1 Y1) +SECP256K1-P+))
                 (C (MOD (* B B) +SECP256K1-P+))
                 (X1+B (MOD (+ X1 B) +SECP256K1-P+))
                 (D (MOD (* 2 (- (* X1+B X1+B) A C)) +SECP256K1-P+))
                 (E (MOD (* 3 A) +SECP256K1-P+))
                 (F (MOD (* E E) +SECP256K1-P+))
                 (X2 (MOD (- F (* 2 D)) +SECP256K1-P+))
                 (Y2 (MOD (- (* E (- D X2)) (* 8 C)) +SECP256K1-P+))
                 (Z2 (MOD (* 2 Y1 Z1) +SECP256K1-P+)))
            (MAKE-INSTANCE 'SECP256K1-POINT :X X2 :Y Y2 :Z Z2)))))

[ironclad/src/public-key/secp256k1.lisp:78]
  (DEFMETHOD EC-ADD ((P SECP256K1-POINT) (Q SECP256K1-POINT))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (WITH-SLOTS ((X1 X) (Y1 Y) (Z1 Z))
        P
      (DECLARE (TYPE INTEGER X1 Y1 Z1))
      (WITH-SLOTS ((X2 X) (Y2 Y) (Z2 Z))
          Q
        (DECLARE (TYPE INTEGER X2 Y2 Z2))
        (COND ((ZEROP Z1) Q) ((ZEROP Z2) P)
              (T
               (LET* ((Z1Z1 (MOD (* Z1 Z1) +SECP256K1-P+))
                      (Z2Z2 (MOD (* Z2 Z2) +SECP256K1-P+))
                      (U1 (MOD (* X1 Z2Z2) +SECP256K1-P+))
                      (U2 (MOD (* X2 Z1Z1) +SECP256K1-P+))
                      (S1 (MOD (* Y1 Z2 Z2Z2) +SECP256K1-P+))
                      (S2 (MOD (* Y2 Z1 Z1Z1) +SECP256K1-P+)))
                 (IF (= U1 U2)
                     (IF (= S1 S2)
                         (EC-DOUBLE P)
                         +SECP256K1-POINT-AT-INFINITY+)
                     (LET* ((H (MOD (- U2 U1) +SECP256K1-P+))
                            (I (MOD (* 4 H H) +SECP256K1-P+))
                            (J (MOD (* H I) +SECP256K1-P+))
                            (R (MOD (* 2 (- S2 S1)) +SECP256K1-P+))
                            (V (MOD (* U1 I) +SECP256K1-P+))
                            (X3 (MOD (- (* R R) J (* 2 V)) +SECP256K1-P+))
                            (Y3
                             (MOD (- (* R (- V X3)) (* 2 S1 J)) +SECP256K1-P+))
                            (Z1+Z2 (MOD (+ Z1 Z2) +SECP256K1-P+))
                            (Z3
                             (MOD (* (- (* Z1+Z2 Z1+Z2) Z1Z1 Z2Z2) H)
                                  +SECP256K1-P+)))
                       (MAKE-INSTANCE 'SECP256K1-POINT :X X3 :Y Y3 :Z
                                      Z3)))))))))

[ironclad/src/public-key/secp256k1.lisp:111]
  (DEFMETHOD EC-SCALAR-MULT ((P SECP256K1-POINT) E)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0))
             (TYPE INTEGER E))
    (DO ((R0 +SECP256K1-POINT-AT-INFINITY+)
         (R1 P)
         (I (1- +SECP256K1-BITS+) (1- I)))
        ((MINUSP I) R0)
      (DECLARE (TYPE SECP256K1-POINT R0 R1)
               (TYPE FIXNUM I))
      (IF (LOGBITP I E)
          (SETF R0 (EC-ADD R0 R1)
                R1 (EC-DOUBLE R1))
          (SETF R1 (EC-ADD R0 R1)
                R0 (EC-DOUBLE R0)))))

[ironclad/src/public-key/secp256k1.lisp:127]
  (DEFMETHOD EC-POINT-ON-CURVE-P ((P SECP256K1-POINT))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (WITH-SLOTS (X Y Z)
        P
      (DECLARE (TYPE INTEGER X Y Z))
      (LET* ((Y2 (MOD (* Y Y) +SECP256K1-P+))
             (X3 (MOD (* X X X) +SECP256K1-P+))
             (Z3 (MOD (* Z Z Z) +SECP256K1-P+))
             (Z6 (MOD (* Z3 Z3) +SECP256K1-P+))
             (A (MOD (+ X3 (* +SECP256K1-B+ Z6)) +SECP256K1-P+)))
        (DECLARE (TYPE INTEGER Y2 X3 Z3 Z6 A))
        (ZEROP (MOD (- Y2 A) +SECP256K1-P+)))))

[ironclad/src/public-key/secp256k1.lisp:145]
  (DEFMETHOD EC-ENCODE-POINT ((P SECP256K1-POINT))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (WITH-SLOTS (X Y Z)
        P
      (DECLARE (TYPE INTEGER X Y Z))
      (WHEN (ZEROP Z)
        (ERROR 'IRONCLAD-ERROR :FORMAT-CONTROL
               "The point at infinity can't be encoded."))
      (LET* ((INVZ (EC-SCALAR-INV :SECP256K1 Z))
             (INVZ2 (MOD (* INVZ INVZ) +SECP256K1-P+))
             (INVZ3 (MOD (* INVZ2 INVZ) +SECP256K1-P+))
             (X (MOD (* X INVZ2) +SECP256K1-P+))
             (Y (MOD (* Y INVZ3) +SECP256K1-P+)))
        (CONCATENATE '(SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) (VECTOR 4)
                     (EC-ENCODE-SCALAR :SECP256K1 X)
                     (EC-ENCODE-SCALAR :SECP256K1 Y)))))

[ironclad/src/public-key/secp256k1.lisp:162]
  (DEFMETHOD EC-DECODE-POINT ((KIND (EQL :SECP256K1)) OCTETS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (CASE (AREF OCTETS 0)
      ((2 3)
       (IF (= (LENGTH OCTETS) (1+ (/ +SECP256K1-BITS+ 8)))
           (LET* ((X-BYTES (SUBSEQ OCTETS 1 (1+ (/ +SECP256K1-BITS+ 8))))
                  (X (EC-DECODE-SCALAR :SECP256K1 X-BYTES))
                  (Y-SIGN (- (AREF OCTETS 0) 2))
                  (Y2 (MOD (+ (* X X X) +SECP256K1-B+) +SECP256K1-P+))
                  (Y (EXPT-MOD Y2 +SECP256K1-I+ +SECP256K1-P+))
                  (Y
                   (IF (= (LOGAND Y 1) Y-SIGN)
                       Y
                       (- +SECP256K1-P+ Y)))
                  (P (MAKE-INSTANCE 'SECP256K1-POINT :X X :Y Y :Z 1)))
             (IF (EC-POINT-ON-CURVE-P P)
                 P
                 (ERROR 'INVALID-CURVE-POINT :KIND 'SECP256K1)))
           (ERROR 'INVALID-CURVE-POINT :KIND 'SECP256K1)))
      ((4)
       (IF (= (LENGTH OCTETS) (1+ (/ +SECP256K1-BITS+ 4)))
           (LET* ((X-BYTES (SUBSEQ OCTETS 1 (1+ (/ +SECP256K1-BITS+ 8))))
                  (X (EC-DECODE-SCALAR :SECP256K1 X-BYTES))
                  (Y-BYTES (SUBSEQ OCTETS (1+ (/ +SECP256K1-BITS+ 8))))
                  (Y (EC-DECODE-SCALAR :SECP256K1 Y-BYTES))
                  (P (MAKE-INSTANCE 'SECP256K1-POINT :X X :Y Y :Z 1)))
             (IF (EC-POINT-ON-CURVE-P P)
                 P
                 (ERROR 'INVALID-CURVE-POINT :KIND 'SECP256K1)))
           (ERROR 'INVALID-CURVE-POINT :KIND 'SECP256K1)))
      (T (ERROR 'INVALID-CURVE-POINT :KIND 'SECP256K1))))

[ironclad/src/public-key/secp256k1.lisp:226]
  (DEFMETHOD SIGN-MESSAGE
             ((KEY SECP256K1-PRIVATE-KEY) MESSAGE
              &KEY (START 0) END &ALLOW-OTHER-KEYS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LET* ((END (MIN (OR END (LENGTH MESSAGE)) (/ +SECP256K1-BITS+ 8)))
           (SK (EC-DECODE-SCALAR :SECP256K1 (SECP256K1-KEY-X KEY)))
           (K (GENERATE-SIGNATURE-NONCE KEY MESSAGE))
           (INVK (MODULAR-INVERSE-WITH-BLINDING K +SECP256K1-L+))
           (R (EC-SCALAR-MULT +SECP256K1-G+ K))
           (X (SUBSEQ (EC-ENCODE-POINT R) 1 (1+ (/ +SECP256K1-BITS+ 8))))
           (R (EC-DECODE-SCALAR :SECP256K1 X))
           (R (MOD R +SECP256K1-L+))
           (H (SUBSEQ MESSAGE START END))
           (E (EC-DECODE-SCALAR :SECP256K1 H))
           (S (MOD (* INVK (+ E (* SK R))) +SECP256K1-L+)))
      (IF (NOT (OR (ZEROP R) (ZEROP S)))
          (MAKE-SIGNATURE :SECP256K1 :R (EC-ENCODE-SCALAR :SECP256K1 R) :S
           (EC-ENCODE-SCALAR :SECP256K1 S))
          (SIGN-MESSAGE KEY MESSAGE :START START :END END))))

[ironclad/src/public-key/secp256k1.lisp:245]
  (DEFMETHOD VERIFY-SIGNATURE
             ((KEY SECP256K1-PUBLIC-KEY) MESSAGE SIGNATURE
              &KEY (START 0) END &ALLOW-OTHER-KEYS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (UNLESS (= (LENGTH SIGNATURE) (/ +SECP256K1-BITS+ 4))
      (ERROR 'INVALID-SIGNATURE-LENGTH :KIND 'SECP256K1))
    (LET* ((END (MIN (OR END (LENGTH MESSAGE)) (/ +SECP256K1-BITS+ 8)))
           (PK (EC-DECODE-POINT :SECP256K1 (SECP256K1-KEY-Y KEY)))
           (SIGNATURE-ELEMENTS (DESTRUCTURE-SIGNATURE :SECP256K1 SIGNATURE))
           (R (EC-DECODE-SCALAR :SECP256K1 (GETF SIGNATURE-ELEMENTS :R)))
           (S (EC-DECODE-SCALAR :SECP256K1 (GETF SIGNATURE-ELEMENTS :S)))
           (H (SUBSEQ MESSAGE START END))
           (E (EC-DECODE-SCALAR :SECP256K1 H))
           (W (MODULAR-INVERSE-WITH-BLINDING S +SECP256K1-L+))
           (U1 (MOD (* E W) +SECP256K1-L+))
           (U2 (MOD (* R W) +SECP256K1-L+))
           (RP
            (EC-ADD (EC-SCALAR-MULT +SECP256K1-G+ U1) (EC-SCALAR-MULT PK U2)))
           (X (SUBSEQ (EC-ENCODE-POINT RP) 1 (1+ (/ +SECP256K1-BITS+ 8))))
           (V (EC-DECODE-SCALAR :SECP256K1 X))
           (V (MOD V +SECP256K1-L+)))
      (AND (< R +SECP256K1-L+) (< S +SECP256K1-L+) (= V R))))

[ironclad/src/public-key/secp256r1.lisp:49]
  (DEFMETHOD EC-POINT-EQUAL ((P SECP256R1-POINT) (Q SECP256R1-POINT))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (WITH-SLOTS ((X1 X) (Y1 Y) (Z1 Z))
        P
      (DECLARE (TYPE INTEGER X1 Y1 Z1))
      (WITH-SLOTS ((X2 X) (Y2 Y) (Z2 Z))
          Q
        (DECLARE (TYPE INTEGER X2 Y2 Z2))
        (LET ((Z1Z1 (MOD (* Z1 Z1) +SECP256R1-P+))
              (Z2Z2 (MOD (* Z2 Z2) +SECP256R1-P+)))
          (AND (ZEROP (MOD (- (* X1 Z2Z2) (* X2 Z1Z1)) +SECP256R1-P+))
               (ZEROP
                (MOD (- (* Y1 Z2Z2 Z2) (* Y2 Z1Z1 Z1)) +SECP256R1-P+)))))))

[ironclad/src/public-key/secp256r1.lisp:60]
  (DEFMETHOD EC-DOUBLE ((P SECP256R1-POINT))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (WITH-SLOTS ((X1 X) (Y1 Y) (Z1 Z))
        P
      (DECLARE (TYPE INTEGER X1 Y1 Z1))
      (IF (ZEROP Z1)
          +SECP256R1-POINT-AT-INFINITY+
          (LET* ((XX (MOD (* X1 X1) +SECP256R1-P+))
                 (YY (MOD (* Y1 Y1) +SECP256R1-P+))
                 (YYYY (MOD (* YY YY) +SECP256R1-P+))
                 (ZZ (MOD (* Z1 Z1) +SECP256R1-P+))
                 (X1+YY (MOD (+ X1 YY) +SECP256R1-P+))
                 (Y1+Z1 (MOD (+ Y1 Z1) +SECP256R1-P+))
                 (S (MOD (* 2 (- (* X1+YY X1+YY) XX YYYY)) +SECP256R1-P+))
                 (M (MOD (* 3 (- XX (* ZZ ZZ))) +SECP256R1-P+))
                 (U (MOD (- (* M M) (* 2 S)) +SECP256R1-P+))
                 (X2 U)
                 (Y2 (MOD (- (* M (- S U)) (* 8 YYYY)) +SECP256R1-P+))
                 (Z2 (MOD (- (* Y1+Z1 Y1+Z1) YY ZZ) +SECP256R1-P+)))
            (MAKE-INSTANCE 'SECP256R1-POINT :X X2 :Y Y2 :Z Z2)))))

[ironclad/src/public-key/secp256r1.lisp:80]
  (DEFMETHOD EC-ADD ((P SECP256R1-POINT) (Q SECP256R1-POINT))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (WITH-SLOTS ((X1 X) (Y1 Y) (Z1 Z))
        P
      (DECLARE (TYPE INTEGER X1 Y1 Z1))
      (WITH-SLOTS ((X2 X) (Y2 Y) (Z2 Z))
          Q
        (DECLARE (TYPE INTEGER X2 Y2 Z2))
        (COND ((ZEROP Z1) Q) ((ZEROP Z2) P)
              (T
               (LET* ((Z1Z1 (MOD (* Z1 Z1) +SECP256R1-P+))
                      (Z2Z2 (MOD (* Z2 Z2) +SECP256R1-P+))
                      (U1 (MOD (* X1 Z2Z2) +SECP256R1-P+))
                      (U2 (MOD (* X2 Z1Z1) +SECP256R1-P+))
                      (S1 (MOD (* Y1 Z2 Z2Z2) +SECP256R1-P+))
                      (S2 (MOD (* Y2 Z1 Z1Z1) +SECP256R1-P+)))
                 (IF (= U1 U2)
                     (IF (= S1 S2)
                         (EC-DOUBLE P)
                         +SECP256R1-POINT-AT-INFINITY+)
                     (LET* ((H (MOD (- U2 U1) +SECP256R1-P+))
                            (I (MOD (* 4 H H) +SECP256R1-P+))
                            (J (MOD (* H I) +SECP256R1-P+))
                            (R (MOD (* 2 (- S2 S1)) +SECP256R1-P+))
                            (V (MOD (* U1 I) +SECP256R1-P+))
                            (X3 (MOD (- (* R R) J (* 2 V)) +SECP256R1-P+))
                            (Y3
                             (MOD (- (* R (- V X3)) (* 2 S1 J)) +SECP256R1-P+))
                            (Z1+Z2 (MOD (+ Z1 Z2) +SECP256R1-P+))
                            (Z3
                             (MOD (* (- (* Z1+Z2 Z1+Z2) Z1Z1 Z2Z2) H)
                                  +SECP256R1-P+)))
                       (MAKE-INSTANCE 'SECP256R1-POINT :X X3 :Y Y3 :Z
                                      Z3)))))))))

[ironclad/src/public-key/secp256r1.lisp:113]
  (DEFMETHOD EC-SCALAR-MULT ((P SECP256R1-POINT) E)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0))
             (TYPE INTEGER E))
    (DO ((R0 +SECP256R1-POINT-AT-INFINITY+)
         (R1 P)
         (I (1- +SECP256R1-BITS+) (1- I)))
        ((MINUSP I) R0)
      (DECLARE (TYPE SECP256R1-POINT R0 R1)
               (TYPE FIXNUM I))
      (IF (LOGBITP I E)
          (SETF R0 (EC-ADD R0 R1)
                R1 (EC-DOUBLE R1))
          (SETF R1 (EC-ADD R0 R1)
                R0 (EC-DOUBLE R0)))))

[ironclad/src/public-key/secp256r1.lisp:129]
  (DEFMETHOD EC-POINT-ON-CURVE-P ((P SECP256R1-POINT))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (WITH-SLOTS (X Y Z)
        P
      (DECLARE (TYPE INTEGER X Y Z))
      (LET* ((Y2 (MOD (* Y Y) +SECP256R1-P+))
             (X3 (MOD (* X X X) +SECP256R1-P+))
             (Z2 (MOD (* Z Z) +SECP256R1-P+))
             (Z4 (MOD (* Z2 Z2) +SECP256R1-P+))
             (Z6 (MOD (* Z4 Z2) +SECP256R1-P+))
             (A (MOD (+ X3 (* -3 X Z4) (* +SECP256R1-B+ Z6)) +SECP256R1-P+)))
        (DECLARE (TYPE INTEGER Y2 X3 Z2 Z4 Z6 A))
        (ZEROP (MOD (- Y2 A) +SECP256R1-P+)))))

[ironclad/src/public-key/secp256r1.lisp:148]
  (DEFMETHOD EC-ENCODE-POINT ((P SECP256R1-POINT))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (WITH-SLOTS (X Y Z)
        P
      (DECLARE (TYPE INTEGER X Y Z))
      (WHEN (ZEROP Z)
        (ERROR 'IRONCLAD-ERROR :FORMAT-CONTROL
               "The point at infinity can't be encoded."))
      (LET* ((INVZ (EC-SCALAR-INV :SECP256R1 Z))
             (INVZ2 (MOD (* INVZ INVZ) +SECP256R1-P+))
             (INVZ3 (MOD (* INVZ2 INVZ) +SECP256R1-P+))
             (X (MOD (* X INVZ2) +SECP256R1-P+))
             (Y (MOD (* Y INVZ3) +SECP256R1-P+)))
        (CONCATENATE '(SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) (VECTOR 4)
                     (EC-ENCODE-SCALAR :SECP256R1 X)
                     (EC-ENCODE-SCALAR :SECP256R1 Y)))))

[ironclad/src/public-key/secp256r1.lisp:165]
  (DEFMETHOD EC-DECODE-POINT ((KIND (EQL :SECP256R1)) OCTETS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (CASE (AREF OCTETS 0)
      ((2 3)
       (IF (= (LENGTH OCTETS) (1+ (/ +SECP256R1-BITS+ 8)))
           (LET* ((X-BYTES (SUBSEQ OCTETS 1 (1+ (/ +SECP256R1-BITS+ 8))))
                  (X (EC-DECODE-SCALAR :SECP256R1 X-BYTES))
                  (Y-SIGN (- (AREF OCTETS 0) 2))
                  (Y2 (MOD (+ (* X X X) (* -3 X) +SECP256R1-B+) +SECP256R1-P+))
                  (Y (EXPT-MOD Y2 +SECP256R1-I+ +SECP256R1-P+))
                  (Y
                   (IF (= (LOGAND Y 1) Y-SIGN)
                       Y
                       (- +SECP256R1-P+ Y)))
                  (P (MAKE-INSTANCE 'SECP256R1-POINT :X X :Y Y :Z 1)))
             (IF (EC-POINT-ON-CURVE-P P)
                 P
                 (ERROR 'INVALID-CURVE-POINT :KIND 'SECP256R1)))
           (ERROR 'INVALID-CURVE-POINT :KIND 'SECP256R1)))
      ((4)
       (IF (= (LENGTH OCTETS) (1+ (/ +SECP256R1-BITS+ 4)))
           (LET* ((X-BYTES (SUBSEQ OCTETS 1 (1+ (/ +SECP256R1-BITS+ 8))))
                  (X (EC-DECODE-SCALAR :SECP256R1 X-BYTES))
                  (Y-BYTES (SUBSEQ OCTETS (1+ (/ +SECP256R1-BITS+ 8))))
                  (Y (EC-DECODE-SCALAR :SECP256R1 Y-BYTES))
                  (P (MAKE-INSTANCE 'SECP256R1-POINT :X X :Y Y :Z 1)))
             (IF (EC-POINT-ON-CURVE-P P)
                 P
                 (ERROR 'INVALID-CURVE-POINT :KIND 'SECP256R1)))
           (ERROR 'INVALID-CURVE-POINT :KIND 'SECP256R1)))
      (T (ERROR 'INVALID-CURVE-POINT :KIND 'SECP256R1))))

[ironclad/src/public-key/secp256r1.lisp:229]
  (DEFMETHOD SIGN-MESSAGE
             ((KEY SECP256R1-PRIVATE-KEY) MESSAGE
              &KEY (START 0) END &ALLOW-OTHER-KEYS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LET* ((END (MIN (OR END (LENGTH MESSAGE)) (/ +SECP256R1-BITS+ 8)))
           (SK (EC-DECODE-SCALAR :SECP256R1 (SECP256R1-KEY-X KEY)))
           (K (GENERATE-SIGNATURE-NONCE KEY MESSAGE))
           (INVK (MODULAR-INVERSE-WITH-BLINDING K +SECP256R1-L+))
           (R (EC-SCALAR-MULT +SECP256R1-G+ K))
           (X (SUBSEQ (EC-ENCODE-POINT R) 1 (1+ (/ +SECP256R1-BITS+ 8))))
           (R (EC-DECODE-SCALAR :SECP256R1 X))
           (R (MOD R +SECP256R1-L+))
           (H (SUBSEQ MESSAGE START END))
           (E (EC-DECODE-SCALAR :SECP256R1 H))
           (S (MOD (* INVK (+ E (* SK R))) +SECP256R1-L+)))
      (IF (NOT (OR (ZEROP R) (ZEROP S)))
          (MAKE-SIGNATURE :SECP256R1 :R (EC-ENCODE-SCALAR :SECP256R1 R) :S
           (EC-ENCODE-SCALAR :SECP256R1 S))
          (SIGN-MESSAGE KEY MESSAGE :START START :END END))))

[ironclad/src/public-key/secp256r1.lisp:248]
  (DEFMETHOD VERIFY-SIGNATURE
             ((KEY SECP256R1-PUBLIC-KEY) MESSAGE SIGNATURE
              &KEY (START 0) END &ALLOW-OTHER-KEYS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (UNLESS (= (LENGTH SIGNATURE) (/ +SECP256R1-BITS+ 4))
      (ERROR 'INVALID-SIGNATURE-LENGTH :KIND 'SECP256R1))
    (LET* ((END (MIN (OR END (LENGTH MESSAGE)) (/ +SECP256R1-BITS+ 8)))
           (PK (EC-DECODE-POINT :SECP256R1 (SECP256R1-KEY-Y KEY)))
           (SIGNATURE-ELEMENTS (DESTRUCTURE-SIGNATURE :SECP256R1 SIGNATURE))
           (R (EC-DECODE-SCALAR :SECP256R1 (GETF SIGNATURE-ELEMENTS :R)))
           (S (EC-DECODE-SCALAR :SECP256R1 (GETF SIGNATURE-ELEMENTS :S)))
           (H (SUBSEQ MESSAGE START END))
           (E (EC-DECODE-SCALAR :SECP256R1 H))
           (W (MODULAR-INVERSE-WITH-BLINDING S +SECP256R1-L+))
           (U1 (MOD (* E W) +SECP256R1-L+))
           (U2 (MOD (* R W) +SECP256R1-L+))
           (RP
            (EC-ADD (EC-SCALAR-MULT +SECP256R1-G+ U1) (EC-SCALAR-MULT PK U2)))
           (X (SUBSEQ (EC-ENCODE-POINT RP) 1 (1+ (/ +SECP256R1-BITS+ 8))))
           (V (EC-DECODE-SCALAR :SECP256R1 X))
           (V (MOD V +SECP256R1-L+)))
      (AND (< R +SECP256R1-L+) (< S +SECP256R1-L+) (= V R))))

[ironclad/src/public-key/secp384r1.lisp:49]
  (DEFMETHOD EC-POINT-EQUAL ((P SECP384R1-POINT) (Q SECP384R1-POINT))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (WITH-SLOTS ((X1 X) (Y1 Y) (Z1 Z))
        P
      (DECLARE (TYPE INTEGER X1 Y1 Z1))
      (WITH-SLOTS ((X2 X) (Y2 Y) (Z2 Z))
          Q
        (DECLARE (TYPE INTEGER X2 Y2 Z2))
        (LET ((Z1Z1 (MOD (* Z1 Z1) +SECP384R1-P+))
              (Z2Z2 (MOD (* Z2 Z2) +SECP384R1-P+)))
          (AND (ZEROP (MOD (- (* X1 Z2Z2) (* X2 Z1Z1)) +SECP384R1-P+))
               (ZEROP
                (MOD (- (* Y1 Z2Z2 Z2) (* Y2 Z1Z1 Z1)) +SECP384R1-P+)))))))

[ironclad/src/public-key/secp384r1.lisp:60]
  (DEFMETHOD EC-DOUBLE ((P SECP384R1-POINT))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (WITH-SLOTS ((X1 X) (Y1 Y) (Z1 Z))
        P
      (DECLARE (TYPE INTEGER X1 Y1 Z1))
      (IF (ZEROP Z1)
          +SECP384R1-POINT-AT-INFINITY+
          (LET* ((XX (MOD (* X1 X1) +SECP384R1-P+))
                 (YY (MOD (* Y1 Y1) +SECP384R1-P+))
                 (YYYY (MOD (* YY YY) +SECP384R1-P+))
                 (ZZ (MOD (* Z1 Z1) +SECP384R1-P+))
                 (X1+YY (MOD (+ X1 YY) +SECP384R1-P+))
                 (Y1+Z1 (MOD (+ Y1 Z1) +SECP384R1-P+))
                 (S (MOD (* 2 (- (* X1+YY X1+YY) XX YYYY)) +SECP384R1-P+))
                 (M (MOD (* 3 (- XX (* ZZ ZZ))) +SECP384R1-P+))
                 (U (MOD (- (* M M) (* 2 S)) +SECP384R1-P+))
                 (X2 U)
                 (Y2 (MOD (- (* M (- S U)) (* 8 YYYY)) +SECP384R1-P+))
                 (Z2 (MOD (- (* Y1+Z1 Y1+Z1) YY ZZ) +SECP384R1-P+)))
            (MAKE-INSTANCE 'SECP384R1-POINT :X X2 :Y Y2 :Z Z2)))))

[ironclad/src/public-key/secp384r1.lisp:80]
  (DEFMETHOD EC-ADD ((P SECP384R1-POINT) (Q SECP384R1-POINT))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (WITH-SLOTS ((X1 X) (Y1 Y) (Z1 Z))
        P
      (DECLARE (TYPE INTEGER X1 Y1 Z1))
      (WITH-SLOTS ((X2 X) (Y2 Y) (Z2 Z))
          Q
        (DECLARE (TYPE INTEGER X2 Y2 Z2))
        (COND ((ZEROP Z1) Q) ((ZEROP Z2) P)
              (T
               (LET* ((Z1Z1 (MOD (* Z1 Z1) +SECP384R1-P+))
                      (Z2Z2 (MOD (* Z2 Z2) +SECP384R1-P+))
                      (U1 (MOD (* X1 Z2Z2) +SECP384R1-P+))
                      (U2 (MOD (* X2 Z1Z1) +SECP384R1-P+))
                      (S1 (MOD (* Y1 Z2 Z2Z2) +SECP384R1-P+))
                      (S2 (MOD (* Y2 Z1 Z1Z1) +SECP384R1-P+)))
                 (IF (= U1 U2)
                     (IF (= S1 S2)
                         (EC-DOUBLE P)
                         +SECP384R1-POINT-AT-INFINITY+)
                     (LET* ((H (MOD (- U2 U1) +SECP384R1-P+))
                            (I (MOD (* 4 H H) +SECP384R1-P+))
                            (J (MOD (* H I) +SECP384R1-P+))
                            (R (MOD (* 2 (- S2 S1)) +SECP384R1-P+))
                            (V (MOD (* U1 I) +SECP384R1-P+))
                            (X3 (MOD (- (* R R) J (* 2 V)) +SECP384R1-P+))
                            (Y3
                             (MOD (- (* R (- V X3)) (* 2 S1 J)) +SECP384R1-P+))
                            (Z1+Z2 (MOD (+ Z1 Z2) +SECP384R1-P+))
                            (Z3
                             (MOD (* (- (* Z1+Z2 Z1+Z2) Z1Z1 Z2Z2) H)
                                  +SECP384R1-P+)))
                       (MAKE-INSTANCE 'SECP384R1-POINT :X X3 :Y Y3 :Z
                                      Z3)))))))))

[ironclad/src/public-key/secp384r1.lisp:113]
  (DEFMETHOD EC-SCALAR-MULT ((P SECP384R1-POINT) E)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0))
             (TYPE INTEGER E))
    (DO ((R0 +SECP384R1-POINT-AT-INFINITY+)
         (R1 P)
         (I (1- +SECP384R1-BITS+) (1- I)))
        ((MINUSP I) R0)
      (DECLARE (TYPE SECP384R1-POINT R0 R1)
               (TYPE FIXNUM I))
      (IF (LOGBITP I E)
          (SETF R0 (EC-ADD R0 R1)
                R1 (EC-DOUBLE R1))
          (SETF R1 (EC-ADD R0 R1)
                R0 (EC-DOUBLE R0)))))

[ironclad/src/public-key/secp384r1.lisp:129]
  (DEFMETHOD EC-POINT-ON-CURVE-P ((P SECP384R1-POINT))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (WITH-SLOTS (X Y Z)
        P
      (DECLARE (TYPE INTEGER X Y Z))
      (LET* ((Y2 (MOD (* Y Y) +SECP384R1-P+))
             (X3 (MOD (* X X X) +SECP384R1-P+))
             (Z2 (MOD (* Z Z) +SECP384R1-P+))
             (Z4 (MOD (* Z2 Z2) +SECP384R1-P+))
             (Z6 (MOD (* Z4 Z2) +SECP384R1-P+))
             (A (MOD (+ X3 (* -3 X Z4) (* +SECP384R1-B+ Z6)) +SECP384R1-P+)))
        (DECLARE (TYPE INTEGER Y2 X3 Z2 Z4 Z6 A))
        (ZEROP (MOD (- Y2 A) +SECP384R1-P+)))))

[ironclad/src/public-key/secp384r1.lisp:148]
  (DEFMETHOD EC-ENCODE-POINT ((P SECP384R1-POINT))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (WITH-SLOTS (X Y Z)
        P
      (DECLARE (TYPE INTEGER X Y Z))
      (WHEN (ZEROP Z)
        (ERROR 'IRONCLAD-ERROR :FORMAT-CONTROL
               "The point at infinity can't be encoded."))
      (LET* ((INVZ (EC-SCALAR-INV :SECP384R1 Z))
             (INVZ2 (MOD (* INVZ INVZ) +SECP384R1-P+))
             (INVZ3 (MOD (* INVZ2 INVZ) +SECP384R1-P+))
             (X (MOD (* X INVZ2) +SECP384R1-P+))
             (Y (MOD (* Y INVZ3) +SECP384R1-P+)))
        (CONCATENATE '(SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) (VECTOR 4)
                     (EC-ENCODE-SCALAR :SECP384R1 X)
                     (EC-ENCODE-SCALAR :SECP384R1 Y)))))

[ironclad/src/public-key/secp384r1.lisp:165]
  (DEFMETHOD EC-DECODE-POINT ((KIND (EQL :SECP384R1)) OCTETS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (CASE (AREF OCTETS 0)
      ((2 3)
       (IF (= (LENGTH OCTETS) (1+ (/ +SECP384R1-BITS+ 8)))
           (LET* ((X-BYTES (SUBSEQ OCTETS 1 (1+ (/ +SECP384R1-BITS+ 8))))
                  (X (EC-DECODE-SCALAR :SECP384R1 X-BYTES))
                  (Y-SIGN (- (AREF OCTETS 0) 2))
                  (Y2 (MOD (+ (* X X X) (* -3 X) +SECP384R1-B+) +SECP384R1-P+))
                  (Y (EXPT-MOD Y2 +SECP384R1-I+ +SECP384R1-P+))
                  (Y
                   (IF (= (LOGAND Y 1) Y-SIGN)
                       Y
                       (- +SECP384R1-P+ Y)))
                  (P (MAKE-INSTANCE 'SECP384R1-POINT :X X :Y Y :Z 1)))
             (IF (EC-POINT-ON-CURVE-P P)
                 P
                 (ERROR 'INVALID-CURVE-POINT :KIND 'SECP384R1)))
           (ERROR 'INVALID-CURVE-POINT :KIND 'SECP384R1)))
      ((4)
       (IF (= (LENGTH OCTETS) (1+ (/ +SECP384R1-BITS+ 4)))
           (LET* ((X-BYTES (SUBSEQ OCTETS 1 (1+ (/ +SECP384R1-BITS+ 8))))
                  (X (EC-DECODE-SCALAR :SECP384R1 X-BYTES))
                  (Y-BYTES (SUBSEQ OCTETS (1+ (/ +SECP384R1-BITS+ 8))))
                  (Y (EC-DECODE-SCALAR :SECP384R1 Y-BYTES))
                  (P (MAKE-INSTANCE 'SECP384R1-POINT :X X :Y Y :Z 1)))
             (IF (EC-POINT-ON-CURVE-P P)
                 P
                 (ERROR 'INVALID-CURVE-POINT :KIND 'SECP384R1)))
           (ERROR 'INVALID-CURVE-POINT :KIND 'SECP384R1)))
      (T (ERROR 'INVALID-CURVE-POINT :KIND 'SECP384R1))))

[ironclad/src/public-key/secp384r1.lisp:229]
  (DEFMETHOD SIGN-MESSAGE
             ((KEY SECP384R1-PRIVATE-KEY) MESSAGE
              &KEY (START 0) END &ALLOW-OTHER-KEYS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LET* ((END (MIN (OR END (LENGTH MESSAGE)) (/ +SECP384R1-BITS+ 8)))
           (SK (EC-DECODE-SCALAR :SECP384R1 (SECP384R1-KEY-X KEY)))
           (K (GENERATE-SIGNATURE-NONCE KEY MESSAGE))
           (INVK (MODULAR-INVERSE-WITH-BLINDING K +SECP384R1-L+))
           (R (EC-SCALAR-MULT +SECP384R1-G+ K))
           (X (SUBSEQ (EC-ENCODE-POINT R) 1 (1+ (/ +SECP384R1-BITS+ 8))))
           (R (EC-DECODE-SCALAR :SECP384R1 X))
           (R (MOD R +SECP384R1-L+))
           (H (SUBSEQ MESSAGE START END))
           (E (EC-DECODE-SCALAR :SECP384R1 H))
           (S (MOD (* INVK (+ E (* SK R))) +SECP384R1-L+)))
      (IF (NOT (OR (ZEROP R) (ZEROP S)))
          (MAKE-SIGNATURE :SECP384R1 :R (EC-ENCODE-SCALAR :SECP384R1 R) :S
           (EC-ENCODE-SCALAR :SECP384R1 S))
          (SIGN-MESSAGE KEY MESSAGE :START START :END END))))

[ironclad/src/public-key/secp384r1.lisp:248]
  (DEFMETHOD VERIFY-SIGNATURE
             ((KEY SECP384R1-PUBLIC-KEY) MESSAGE SIGNATURE
              &KEY (START 0) END &ALLOW-OTHER-KEYS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (UNLESS (= (LENGTH SIGNATURE) (/ +SECP384R1-BITS+ 4))
      (ERROR 'INVALID-SIGNATURE-LENGTH :KIND 'SECP384R1))
    (LET* ((END (MIN (OR END (LENGTH MESSAGE)) (/ +SECP384R1-BITS+ 8)))
           (PK (EC-DECODE-POINT :SECP384R1 (SECP384R1-KEY-Y KEY)))
           (SIGNATURE-ELEMENTS (DESTRUCTURE-SIGNATURE :SECP384R1 SIGNATURE))
           (R (EC-DECODE-SCALAR :SECP384R1 (GETF SIGNATURE-ELEMENTS :R)))
           (S (EC-DECODE-SCALAR :SECP384R1 (GETF SIGNATURE-ELEMENTS :S)))
           (H (SUBSEQ MESSAGE START END))
           (E (EC-DECODE-SCALAR :SECP384R1 H))
           (W (MODULAR-INVERSE-WITH-BLINDING S +SECP384R1-L+))
           (U1 (MOD (* E W) +SECP384R1-L+))
           (U2 (MOD (* R W) +SECP384R1-L+))
           (RP
            (EC-ADD (EC-SCALAR-MULT +SECP384R1-G+ U1) (EC-SCALAR-MULT PK U2)))
           (X (SUBSEQ (EC-ENCODE-POINT RP) 1 (1+ (/ +SECP384R1-BITS+ 8))))
           (V (EC-DECODE-SCALAR :SECP384R1 X))
           (V (MOD V +SECP384R1-L+)))
      (AND (< R +SECP384R1-L+) (< S +SECP384R1-L+) (= V R))))

[ironclad/src/public-key/secp521r1.lisp:49]
  (DEFMETHOD EC-POINT-EQUAL ((P SECP521R1-POINT) (Q SECP521R1-POINT))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (WITH-SLOTS ((X1 X) (Y1 Y) (Z1 Z))
        P
      (DECLARE (TYPE INTEGER X1 Y1 Z1))
      (WITH-SLOTS ((X2 X) (Y2 Y) (Z2 Z))
          Q
        (DECLARE (TYPE INTEGER X2 Y2 Z2))
        (LET ((Z1Z1 (MOD (* Z1 Z1) +SECP521R1-P+))
              (Z2Z2 (MOD (* Z2 Z2) +SECP521R1-P+)))
          (AND (ZEROP (MOD (- (* X1 Z2Z2) (* X2 Z1Z1)) +SECP521R1-P+))
               (ZEROP
                (MOD (- (* Y1 Z2Z2 Z2) (* Y2 Z1Z1 Z1)) +SECP521R1-P+)))))))

[ironclad/src/public-key/secp521r1.lisp:60]
  (DEFMETHOD EC-DOUBLE ((P SECP521R1-POINT))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (WITH-SLOTS ((X1 X) (Y1 Y) (Z1 Z))
        P
      (DECLARE (TYPE INTEGER X1 Y1 Z1))
      (IF (ZEROP Z1)
          +SECP521R1-POINT-AT-INFINITY+
          (LET* ((XX (MOD (* X1 X1) +SECP521R1-P+))
                 (YY (MOD (* Y1 Y1) +SECP521R1-P+))
                 (YYYY (MOD (* YY YY) +SECP521R1-P+))
                 (ZZ (MOD (* Z1 Z1) +SECP521R1-P+))
                 (X1+YY (MOD (+ X1 YY) +SECP521R1-P+))
                 (Y1+Z1 (MOD (+ Y1 Z1) +SECP521R1-P+))
                 (S (MOD (* 2 (- (* X1+YY X1+YY) XX YYYY)) +SECP521R1-P+))
                 (M (MOD (* 3 (- XX (* ZZ ZZ))) +SECP521R1-P+))
                 (U (MOD (- (* M M) (* 2 S)) +SECP521R1-P+))
                 (X2 U)
                 (Y2 (MOD (- (* M (- S U)) (* 8 YYYY)) +SECP521R1-P+))
                 (Z2 (MOD (- (* Y1+Z1 Y1+Z1) YY ZZ) +SECP521R1-P+)))
            (MAKE-INSTANCE 'SECP521R1-POINT :X X2 :Y Y2 :Z Z2)))))

[ironclad/src/public-key/secp521r1.lisp:80]
  (DEFMETHOD EC-ADD ((P SECP521R1-POINT) (Q SECP521R1-POINT))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (WITH-SLOTS ((X1 X) (Y1 Y) (Z1 Z))
        P
      (DECLARE (TYPE INTEGER X1 Y1 Z1))
      (WITH-SLOTS ((X2 X) (Y2 Y) (Z2 Z))
          Q
        (DECLARE (TYPE INTEGER X2 Y2 Z2))
        (COND ((ZEROP Z1) Q) ((ZEROP Z2) P)
              (T
               (LET* ((Z1Z1 (MOD (* Z1 Z1) +SECP521R1-P+))
                      (Z2Z2 (MOD (* Z2 Z2) +SECP521R1-P+))
                      (U1 (MOD (* X1 Z2Z2) +SECP521R1-P+))
                      (U2 (MOD (* X2 Z1Z1) +SECP521R1-P+))
                      (S1 (MOD (* Y1 Z2 Z2Z2) +SECP521R1-P+))
                      (S2 (MOD (* Y2 Z1 Z1Z1) +SECP521R1-P+)))
                 (IF (= U1 U2)
                     (IF (= S1 S2)
                         (EC-DOUBLE P)
                         +SECP521R1-POINT-AT-INFINITY+)
                     (LET* ((H (MOD (- U2 U1) +SECP521R1-P+))
                            (I (MOD (* 4 H H) +SECP521R1-P+))
                            (J (MOD (* H I) +SECP521R1-P+))
                            (R (MOD (* 2 (- S2 S1)) +SECP521R1-P+))
                            (V (MOD (* U1 I) +SECP521R1-P+))
                            (X3 (MOD (- (* R R) J (* 2 V)) +SECP521R1-P+))
                            (Y3
                             (MOD (- (* R (- V X3)) (* 2 S1 J)) +SECP521R1-P+))
                            (Z1+Z2 (MOD (+ Z1 Z2) +SECP521R1-P+))
                            (Z3
                             (MOD (* (- (* Z1+Z2 Z1+Z2) Z1Z1 Z2Z2) H)
                                  +SECP521R1-P+)))
                       (MAKE-INSTANCE 'SECP521R1-POINT :X X3 :Y Y3 :Z
                                      Z3)))))))))

[ironclad/src/public-key/secp521r1.lisp:113]
  (DEFMETHOD EC-SCALAR-MULT ((P SECP521R1-POINT) E)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0))
             (TYPE INTEGER E))
    (DO ((R0 +SECP521R1-POINT-AT-INFINITY+)
         (R1 P)
         (I (1- +SECP521R1-BITS+) (1- I)))
        ((MINUSP I) R0)
      (DECLARE (TYPE SECP521R1-POINT R0 R1)
               (TYPE FIXNUM I))
      (IF (LOGBITP I E)
          (SETF R0 (EC-ADD R0 R1)
                R1 (EC-DOUBLE R1))
          (SETF R1 (EC-ADD R0 R1)
                R0 (EC-DOUBLE R0)))))

[ironclad/src/public-key/secp521r1.lisp:129]
  (DEFMETHOD EC-POINT-ON-CURVE-P ((P SECP521R1-POINT))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (WITH-SLOTS (X Y Z)
        P
      (DECLARE (TYPE INTEGER X Y Z))
      (LET* ((Y2 (MOD (* Y Y) +SECP521R1-P+))
             (X3 (MOD (* X X X) +SECP521R1-P+))
             (Z2 (MOD (* Z Z) +SECP521R1-P+))
             (Z4 (MOD (* Z2 Z2) +SECP521R1-P+))
             (Z6 (MOD (* Z4 Z2) +SECP521R1-P+))
             (A (MOD (+ X3 (* -3 X Z4) (* +SECP521R1-B+ Z6)) +SECP521R1-P+)))
        (DECLARE (TYPE INTEGER Y2 X3 Z2 Z4 Z6 A))
        (ZEROP (MOD (- Y2 A) +SECP521R1-P+)))))

[ironclad/src/public-key/secp521r1.lisp:148]
  (DEFMETHOD EC-ENCODE-POINT ((P SECP521R1-POINT))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (WITH-SLOTS (X Y Z)
        P
      (DECLARE (TYPE INTEGER X Y Z))
      (WHEN (ZEROP Z)
        (ERROR 'IRONCLAD-ERROR :FORMAT-CONTROL
               "The point at infinity can't be encoded."))
      (LET* ((INVZ (EC-SCALAR-INV :SECP521R1 Z))
             (INVZ2 (MOD (* INVZ INVZ) +SECP521R1-P+))
             (INVZ3 (MOD (* INVZ2 INVZ) +SECP521R1-P+))
             (X (MOD (* X INVZ2) +SECP521R1-P+))
             (Y (MOD (* Y INVZ3) +SECP521R1-P+)))
        (CONCATENATE '(SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) (VECTOR 4)
                     (EC-ENCODE-SCALAR :SECP521R1 X)
                     (EC-ENCODE-SCALAR :SECP521R1 Y)))))

[ironclad/src/public-key/secp521r1.lisp:165]
  (DEFMETHOD EC-DECODE-POINT ((KIND (EQL :SECP521R1)) OCTETS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (CASE (AREF OCTETS 0)
      ((2 3)
       (IF (= (LENGTH OCTETS) (1+ (CEILING +SECP521R1-BITS+ 8)))
           (LET* ((X-BYTES (SUBSEQ OCTETS 1 (1+ (CEILING +SECP521R1-BITS+ 8))))
                  (X (EC-DECODE-SCALAR :SECP521R1 X-BYTES))
                  (Y-SIGN (- (AREF OCTETS 0) 2))
                  (Y2 (MOD (+ (* X X X) (* -3 X) +SECP521R1-B+) +SECP521R1-P+))
                  (Y (EXPT-MOD Y2 +SECP521R1-I+ +SECP521R1-P+))
                  (Y
                   (IF (= (LOGAND Y 1) Y-SIGN)
                       Y
                       (- +SECP521R1-P+ Y)))
                  (P (MAKE-INSTANCE 'SECP521R1-POINT :X X :Y Y :Z 1)))
             (IF (EC-POINT-ON-CURVE-P P)
                 P
                 (ERROR 'INVALID-CURVE-POINT :KIND 'SECP521R1)))
           (ERROR 'INVALID-CURVE-POINT :KIND 'SECP521R1)))
      ((4)
       (IF (= (LENGTH OCTETS) (1+ (* 2 (CEILING +SECP521R1-BITS+ 8))))
           (LET* ((X-BYTES (SUBSEQ OCTETS 1 (1+ (CEILING +SECP521R1-BITS+ 8))))
                  (X (EC-DECODE-SCALAR :SECP521R1 X-BYTES))
                  (Y-BYTES (SUBSEQ OCTETS (1+ (CEILING +SECP521R1-BITS+ 8))))
                  (Y (EC-DECODE-SCALAR :SECP521R1 Y-BYTES))
                  (P (MAKE-INSTANCE 'SECP521R1-POINT :X X :Y Y :Z 1)))
             (IF (EC-POINT-ON-CURVE-P P)
                 P
                 (ERROR 'INVALID-CURVE-POINT :KIND 'SECP521R1)))
           (ERROR 'INVALID-CURVE-POINT :KIND 'SECP521R1)))
      (T (ERROR 'INVALID-CURVE-POINT :KIND 'SECP521R1))))

[ironclad/src/public-key/secp521r1.lisp:229]
  (DEFMETHOD SIGN-MESSAGE
             ((KEY SECP521R1-PRIVATE-KEY) MESSAGE
              &KEY (START 0) END &ALLOW-OTHER-KEYS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LET* ((END (MIN (OR END (LENGTH MESSAGE)) (CEILING +SECP521R1-BITS+ 8)))
           (SK (EC-DECODE-SCALAR :SECP521R1 (SECP521R1-KEY-X KEY)))
           (K (GENERATE-SIGNATURE-NONCE KEY MESSAGE))
           (INVK (MODULAR-INVERSE-WITH-BLINDING K +SECP521R1-L+))
           (R (EC-SCALAR-MULT +SECP521R1-G+ K))
           (X (SUBSEQ (EC-ENCODE-POINT R) 1 (1+ (CEILING +SECP521R1-BITS+ 8))))
           (R (EC-DECODE-SCALAR :SECP521R1 X))
           (R (MOD R +SECP521R1-L+))
           (H (SUBSEQ MESSAGE START END))
           (E (EC-DECODE-SCALAR :SECP521R1 H))
           (S (MOD (* INVK (+ E (* SK R))) +SECP521R1-L+)))
      (IF (NOT (OR (ZEROP R) (ZEROP S)))
          (MAKE-SIGNATURE :SECP521R1 :R (EC-ENCODE-SCALAR :SECP521R1 R) :S
           (EC-ENCODE-SCALAR :SECP521R1 S))
          (SIGN-MESSAGE KEY MESSAGE :START START :END END))))

[ironclad/src/public-key/secp521r1.lisp:248]
  (DEFMETHOD VERIFY-SIGNATURE
             ((KEY SECP521R1-PUBLIC-KEY) MESSAGE SIGNATURE
              &KEY (START 0) END &ALLOW-OTHER-KEYS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (UNLESS (= (LENGTH SIGNATURE) (* 2 (CEILING +SECP521R1-BITS+ 8)))
      (ERROR 'INVALID-SIGNATURE-LENGTH :KIND 'SECP521R1))
    (LET* ((END (MIN (OR END (LENGTH MESSAGE)) (CEILING +SECP521R1-BITS+ 8)))
           (PK (EC-DECODE-POINT :SECP521R1 (SECP521R1-KEY-Y KEY)))
           (SIGNATURE-ELEMENTS (DESTRUCTURE-SIGNATURE :SECP521R1 SIGNATURE))
           (R (EC-DECODE-SCALAR :SECP521R1 (GETF SIGNATURE-ELEMENTS :R)))
           (S (EC-DECODE-SCALAR :SECP521R1 (GETF SIGNATURE-ELEMENTS :S)))
           (H (SUBSEQ MESSAGE START END))
           (E (EC-DECODE-SCALAR :SECP521R1 H))
           (W (MODULAR-INVERSE-WITH-BLINDING S +SECP521R1-L+))
           (U1 (MOD (* E W) +SECP521R1-L+))
           (U2 (MOD (* R W) +SECP521R1-L+))
           (RP
            (EC-ADD (EC-SCALAR-MULT +SECP521R1-G+ U1) (EC-SCALAR-MULT PK U2)))
           (X
            (SUBSEQ (EC-ENCODE-POINT RP) 1 (1+ (CEILING +SECP521R1-BITS+ 8))))
           (V (EC-DECODE-SCALAR :SECP521R1 X))
           (V (MOD V +SECP521R1-L+)))
      (AND (< R +SECP521R1-L+) (< S +SECP521R1-L+) (= V R))))

[ironclad/src/util.lisp:10]
  (DEFUN BYTE-ARRAY-TO-HEX-STRING
         (VECTOR &KEY (START 0) END (ELEMENT-TYPE 'BASE-CHAR))
    "Return a string containing the hexadecimal representation of the
subsequence of VECTOR between START and END.  ELEMENT-TYPE controls
the element-type of the returned string."
    (DECLARE (TYPE (VECTOR (UNSIGNED-BYTE 8)) VECTOR)
             (TYPE FIXNUM START)
             (TYPE (OR NULL FIXNUM) END)
             (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (LET* ((END (OR END (LENGTH VECTOR)))
           (LENGTH (- END START))
           (HEXDIGITS NIL))
      (LOOP WITH STRING = (ECASE ELEMENT-TYPE
                            (BASE-CHAR
                             (MAKE-STRING (* LENGTH 2) :ELEMENT-TYPE
                                          'BASE-CHAR))
                            (CHARACTER
                             (MAKE-STRING (* LENGTH 2) :ELEMENT-TYPE
                                          'CHARACTER)))
            FOR I FROM START BELOW
            END
            FOR J FROM 0 BELOW (* LENGTH 2) BY 2
            DO (LET ((BYTE (AREF VECTOR I)))
                 (DECLARE (OPTIMIZE (SAFETY 0)))
                 (SETF (AREF STRING J) (AREF HEXDIGITS (LDB (BYTE 4 4) BYTE))
                       (AREF STRING (1+ J))
                         (AREF HEXDIGITS (LDB (BYTE 4 0) BYTE))))
            FINALLY (RETURN STRING))))

[ironclad/src/util.lisp:57]
  (DEFUN ASCII-STRING-TO-BYTE-ARRAY (STRING &KEY (START 0) END)
    "Convert STRING to a (VECTOR (UNSIGNED-BYTE 8)).  It is an error if
STRING contains any character whose CHAR-CODE is greater than 255."
    (DECLARE (TYPE STRING STRING)
             (TYPE FIXNUM START)
             (TYPE (OR NULL FIXNUM) END)
             (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (LET* ((LENGTH (LENGTH STRING))
           (VEC (MAKE-ARRAY LENGTH :ELEMENT-TYPE '(UNSIGNED-BYTE 8)))
           (END (OR END LENGTH)))
      (LOOP FOR I FROM START BELOW
            END
            DO (LET ((BYTE (CHAR-CODE (CHAR STRING I))))
                 (UNLESS (< BYTE 256)
                   (ERROR 'IRONCLAD-ERROR :FORMAT-CONTROL
                          "~A is not an ASCII character" :FORMAT-ARGUMENTS
                          (LIST (CHAR STRING I))))
                 (SETF (AREF VEC I) BYTE))
            FINALLY (RETURN VEC))))

[iterate/iterate-test.lisp:133]
  (DEFTEST LOCALLY.2
   (ITERATE (FOR I IN '(1 2 3)) (REPEAT 2)
    (LOCALLY (DECLARE (OPTIMIZE SAFETY)) (DECLARE (FIXNUM I)) (COLLECT I)))
   (1 2))

[iterate/iterate-test.lisp:1089]
  (DEFTEST COLLECT.TYPE.STRING.1
   (LOCALLY
    (DECLARE (OPTIMIZE SAFETY (DEBUG 2) (SPEED 0) (SPACE 1)))
    (ITER (DECLARE (ITERATE:DECLARE-VARIABLES))
     (FOR S IN-VECTOR '#(|a| |b| |cD|))
     (COLLECT (CHAR (SYMBOL-NAME S) 0) :RESULT-TYPE STRING)))
   "abc")

[iterate/iterate-test.lisp:1108]
  (DEFTEST COLLECT.TYPE.VECTOR.1
   (LOCALLY
    (DECLARE (OPTIMIZE SAFETY (DEBUG 2) (SPEED 0) (SPACE 1)))
    (ITER (DECLARE (ITERATE:DECLARE-VARIABLES))
     (FOR S IN-VECTOR '#(|a| |b| |cD|))
     (COLLECT (CHAR (SYMBOL-NAME S) 0) :RESULT-TYPE VECTOR)))
   #(#\a #\b #\c))

[iterate/iterate-test.lisp:1481]
  (DEFTEST CODE-MOVEMENT.DECLARE.1
   (HANDLER-CASE
    (MACROEXPAND
     '(ITER (FOR I FROM 1 TO 10)
       (LET ((Y I))
         (DECLARE (OPTIMIZE SAFETY))
         (AFTER-EACH (PRINC Y)))))
    (ERROR NIL T) (:NO-ERROR (F X) (DECLARE (IGNORE F X)) NIL))
   T)

[iterate/iterate-test.lisp:1491]
  (DEFTEST CODE-MOVEMENT.DECLARE.2
   (HANDLER-CASE
    (MACROEXPAND
     '(ITER (FOR I FROM 1 TO 10)
       (LET ((SAFETY I))
         (AFTER-EACH
          (LET ()
            (DECLARE (OPTIMIZE SAFETY))
            (PRINC I))))))
    (ERROR NIL T) (:NO-ERROR (F X) (DECLARE (IGNORE F X)) NIL))
   NIL)

[iterate/iterate.lisp:3160]
  (DEFUN RETURN-COLLECTION-CODE
         (
          &KEY VARIABLE EXPRESSION START-OPERATION END-OPERATION ONE-ELEMENT
          TEST (PLACE 'END) (RESULT-TYPE 'LIST))
    (WHEN (QUOTED? RESULT-TYPE) (SETQ RESULT-TYPE (SECOND RESULT-TYPE)))
    (WHEN (QUOTED? PLACE) (SETQ PLACE (SECOND PLACE)))
    (LET ((PLACE-STRING
           (LOCALLY (DECLARE (OPTIMIZE SAFETY)) (SYMBOL-NAME PLACE))))
      (COND ((STRING= PLACE-STRING '#:END) (SETQ PLACE 'END))
            ((OR (STRING= PLACE-STRING '#:START)
                 (STRING= PLACE-STRING '#:BEGINNING))
             (SETQ PLACE 'START))
            (T
             (CLAUSE-ERROR "~a is neither 'start', 'beginning' nor 'end'"
              PLACE))))
    (LET* ((COLLECT-VAR-SPEC (OR VARIABLE *RESULT-VAR*))
           (COLLECT-VAR (EXTRACT-VAR COLLECT-VAR-SPEC))
           (ENTRY
            (MAKE-ACCUM-VAR-BINDING COLLECT-VAR-SPEC NIL :COLLECT :TYPE
             (IF (EQ RESULT-TYPE 'LIST)
                 'LIST
                 (ECLECTOR.READER:QUASIQUOTE
                  (OR LIST (ECLECTOR.READER:UNQUOTE RESULT-TYPE))))))
           (END-POINTER (THIRD ENTRY))
           (PREV-RESULT-TYPE (FOURTH ENTRY)))
      (COND
       ((NULL END-POINTER)
        (IF (EQ PLACE 'END)
            (SETQ END-POINTER
                    (MAKE-VAR-AND-BINDING 'END-POINTER NIL :TYPE 'LIST)))
        (SETF (CDDR ENTRY) (LIST END-POINTER RESULT-TYPE)))
       (T
        (IF (NOT (EQUAL RESULT-TYPE PREV-RESULT-TYPE))
            (CLAUSE-ERROR "Result type ~a doesn't match ~a" RESULT-TYPE
             PREV-RESULT-TYPE))))
      (LET* ((EXPR (WALK-EXPR EXPRESSION))
             (OP-EXPR
              (IF (EQ PLACE 'START)
                  (IF (NULL START-OPERATION)
                      EXPR
                      (MAKE-APPLICATION START-OPERATION EXPR COLLECT-VAR))
                  (IF (NULL END-OPERATION)
                      EXPR
                      (MAKE-APPLICATION END-OPERATION COLLECT-VAR EXPR)))))
        (IF (EQ PLACE 'START)
            (RETURN-CODE :BODY
             (ECLECTOR.READER:QUASIQUOTE
              ((SETQ (ECLECTOR.READER:UNQUOTE COLLECT-VAR)
                       (ECLECTOR.READER:UNQUOTE OP-EXPR))))
             :FINAL
             (UNLESS (EQ RESULT-TYPE 'LIST)
               (ECLECTOR.READER:QUASIQUOTE
                ((SETQ (ECLECTOR.READER:UNQUOTE COLLECT-VAR)
                         (COERCE (ECLECTOR.READER:UNQUOTE COLLECT-VAR)
                                 '(ECLECTOR.READER:UNQUOTE RESULT-TYPE)))))))
            (WITH-TEMPORARY TEMP-VAR
             (LET* ((UPDATE-CODE
                     (ECLECTOR.READER:QUASIQUOTE
                      (IF (ECLECTOR.READER:UNQUOTE COLLECT-VAR)
                          (SETF (CDR (ECLECTOR.READER:UNQUOTE END-POINTER))
                                  (ECLECTOR.READER:UNQUOTE TEMP-VAR))
                          (SETQ (ECLECTOR.READER:UNQUOTE COLLECT-VAR)
                                  (ECLECTOR.READER:UNQUOTE TEMP-VAR)))))
                    (MAIN-CODE
                     (COND
                      ((NOT ONE-ELEMENT)
                       (ECLECTOR.READER:QUASIQUOTE
                        ((IF (SETQ (ECLECTOR.READER:UNQUOTE TEMP-VAR)
                                     (ECLECTOR.READER:UNQUOTE OP-EXPR))
                             (SETQ (ECLECTOR.READER:UNQUOTE END-POINTER)
                                     (LAST
                                      (ECLECTOR.READER:UNQUOTE
                                       UPDATE-CODE)))))))
                      (TEST
                       (ECLECTOR.READER:QUASIQUOTE
                        ((WHEN
                             (ECLECTOR.READER:UNQUOTE
                              (MAKE-APPLICATION TEST COLLECT-VAR EXPR))
                           (SETQ (ECLECTOR.READER:UNQUOTE TEMP-VAR)
                                   (ECLECTOR.READER:UNQUOTE OP-EXPR))
                           (SETQ (ECLECTOR.READER:UNQUOTE END-POINTER)
                                   (ECLECTOR.READER:UNQUOTE UPDATE-CODE))))))
                      (T
                       (ECLECTOR.READER:QUASIQUOTE
                        ((SETQ (ECLECTOR.READER:UNQUOTE TEMP-VAR)
                                 (ECLECTOR.READER:UNQUOTE OP-EXPR))
                         (SETQ (ECLECTOR.READER:UNQUOTE END-POINTER)
                                 (ECLECTOR.READER:UNQUOTE UPDATE-CODE))))))))
               (RETURN-CODE :BODY
                (ECLECTOR.READER:QUASIQUOTE
                 ((PROGN
                   (ECLECTOR.READER:UNQUOTE-SPLICING MAIN-CODE)
                   (ECLECTOR.READER:UNQUOTE COLLECT-VAR))))
                :FINAL
                (IF (EQ RESULT-TYPE 'LIST)
                    NIL
                    (ECLECTOR.READER:QUASIQUOTE
                     ((SETQ (ECLECTOR.READER:UNQUOTE COLLECT-VAR)
                              (COERCE (ECLECTOR.READER:UNQUOTE COLLECT-VAR)
                                      '(ECLECTOR.READER:UNQUOTE
                                        RESULT-TYPE)))))))))))))

[jonathan/src/decode.lisp:48]
  (DEFUN PARSE
         (STRING
          &KEY (AS :PLIST) JUNK-ALLOWED KEYWORDS-TO-READ KEYWORD-NORMALIZER
          NORMALIZE-ALL EXCLUDE-NORMALIZE-KEYS
          (UNESCAPE-UNICODE-ESCAPE-SEQUENCE T))
    (DECLARE (TYPE SIMPLE-STRING STRING)
             (TYPE (OR NULL FUNCTION) KEYWORD-NORMALIZER)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0) (SPACE 0)))
    (LET* ((AS-ALIST (EQ AS :ALIST))
           (AS-JSOWN (EQ AS :JSOWN))
           (AS-HASH-TABLE (EQ AS :HASH-TABLE))
           (*INNER-NEST-P* NIL))
      (WITH-VECTOR-PARSING (STRING)
       (MACROLET ((WITH-ALLOWED-LAST-CHARACTER
                      ((&KEY CHAR BLOCK (RETURN-VALUE T)) &BODY BODY)
                    (LET* ((ALLOWED-LAST-CHARACTER-BLOCK
                            (GENSYM "allowed-last-character-block")))
                      (ECLECTOR.READER:QUASIQUOTE
                       (BLOCK
                           (ECLECTOR.READER:UNQUOTE
                            ALLOWED-LAST-CHARACTER-BLOCK)
                         (TAGBODY
                           (RETURN-FROM
                               (ECLECTOR.READER:UNQUOTE
                                ALLOWED-LAST-CHARACTER-BLOCK)
                             (PROGN (ECLECTOR.READER:UNQUOTE-SPLICING BODY)))
                          :EOF
                           (OR
                            (AND JUNK-ALLOWED
                                 (RETURN-FROM
                                     (ECLECTOR.READER:UNQUOTE
                                      (OR BLOCK ALLOWED-LAST-CHARACTER-BLOCK))
                                   (ECLECTOR.READER:UNQUOTE RETURN-VALUE)))
                            (ECLECTOR.READER:UNQUOTE
                             (IF CHAR
                                 (ECLECTOR.READER:QUASIQUOTE
                                  (IF (EQ (ECLECTOR.READER:UNQUOTE CHAR)
                                          (CURRENT))
                                      (RETURN-FROM
                                          (ECLECTOR.READER:UNQUOTE
                                           (OR BLOCK
                                               ALLOWED-LAST-CHARACTER-BLOCK))
                                        (ECLECTOR.READER:UNQUOTE RETURN-VALUE))
                                      (ERROR '<JONATHAN-UNEXPECTED-EOF-ERROR>
                                             :OBJECT STRING)))
                                 (ECLECTOR.READER:QUASIQUOTE
                                  (ERROR '<JONATHAN-UNEXPECTED-EOF-ERROR>
                                         :OBJECT STRING))))))))))
                  (SKIP-SPACES ()
                    (ECLECTOR.READER:QUASIQUOTE
                     (SKIP* #\  #\Newline #\Tab #\Return)))
                  (WITH-SKIP-SPACES (&BODY BODY)
                    (ECLECTOR.READER:QUASIQUOTE
                     (PROGN
                      (SKIP-SPACES)
                      (PROG1 (PROGN (ECLECTOR.READER:UNQUOTE-SPLICING BODY))
                        (SKIP-SPACES)))))
                  (SKIP?-OR-EOF (CHAR)
                    (ECLECTOR.READER:QUASIQUOTE
                     (WITH-ALLOWED-LAST-CHARACTER
                      (:CHAR (ECLECTOR.READER:UNQUOTE CHAR))
                      (OR (SKIP? (ECLECTOR.READER:UNQUOTE CHAR))
                          (WHEN (EOFP) (GO :EOF))))))
                  (MATCH-AND-RETURN (STRING BLOCK VALUE)
                    (ECLECTOR.READER:QUASIQUOTE
                     (MATCH-CASE
                      ((ECLECTOR.READER:UNQUOTE STRING)
                       (RETURN-FROM (ECLECTOR.READER:UNQUOTE BLOCK)
                         (ECLECTOR.READER:UNQUOTE VALUE)))
                      (OTHERWISE
                       (OR
                        (AND JUNK-ALLOWED
                             (RETURN-FROM (ECLECTOR.READER:UNQUOTE BLOCK)
                               (ECLECTOR.READER:UNQUOTE VALUE)))
                        (ERROR '<JONATHAN-INCOMPLETE-JSON-ERROR> :OBJECT
                               STRING))))))
                  (EMPTY-OBJECT ()
                    (ECLECTOR.READER:QUASIQUOTE
                     (IF AS-HASH-TABLE
                         (MAKE-HASH-TABLE :TEST #'EQUAL)
                         *EMPTY-OBJECT-VALUE*)))
                  (EXCLUDE-NORMALIZE-KEY-P (KEY)
                    (ECLECTOR.READER:QUASIQUOTE
                     (AND EXCLUDE-NORMALIZE-KEYS
                          (MEMBER (ECLECTOR.READER:UNQUOTE KEY)
                                  EXCLUDE-NORMALIZE-KEYS :TEST #'EQUAL)
                          T))))
         (LABELS ((DISPATCH (&OPTIONAL SKIP-P FORCE-READ-P)
                    (SKIP-SPACES)
                    (MATCH-CASE
                     ("{"
                      (RETURN-FROM DISPATCH (READ-OBJECT SKIP-P FORCE-READ-P)))
                     ("\"" (RETURN-FROM DISPATCH (READ-STRING SKIP-P)))
                     ("[" (RETURN-FROM DISPATCH (READ-ARRAY SKIP-P)))
                     ("t" (MATCH-AND-RETURN "rue" DISPATCH T))
                     ("f" (MATCH-AND-RETURN "alse" DISPATCH *FALSE-VALUE*))
                     ("n" (MATCH-AND-RETURN "ull" DISPATCH *NULL-VALUE*))
                     (OTHERWISE
                      (OR
                       (AND (INTEGER-CHAR-P (CURRENT))
                            (RETURN-FROM DISPATCH (READ-NUMBER SKIP-P)))
                       (ERROR '<JONATHAN-INCOMPLETE-JSON-ERROR> :OBJECT
                              STRING)))))
                  (READ-OBJECT (&OPTIONAL SKIP-P FORCE-READ-P)
                    (SKIP-SPACES)
                    (LOOP INITIALLY (WITH-ALLOWED-LAST-CHARACTER
                                     (:CHAR #\} :BLOCK READ-OBJECT
                                      :RETURN-VALUE (EMPTY-OBJECT))
                                     (OR (AND (EOFP) (GO :EOF))
                                         (AND (SKIP? #\})
                                              (RETURN-FROM READ-OBJECT
                                                (EMPTY-OBJECT)))))
                          WITH RESULT = (WHEN AS-HASH-TABLE
                                          (MAKE-HASH-TABLE :TEST
                                                           #'EQUAL)) AS KEY = (PROGN
                                                                               (ADVANCE*)
                                                                               (LET ((STRING
                                                                                      (READ-STRING
                                                                                       SKIP-P)))
                                                                                 (COND
                                                                                  (SKIP-P
                                                                                   NIL)
                                                                                  ((OR
                                                                                    (NOT
                                                                                     (OR
                                                                                      KEYWORD-NORMALIZER
                                                                                      KEYWORDS-TO-READ))
                                                                                    FORCE-READ-P
                                                                                    (AND
                                                                                     (NOT
                                                                                      NORMALIZE-ALL)
                                                                                     *INNER-NEST-P*))
                                                                                   STRING)
                                                                                  (KEYWORD-NORMALIZER
                                                                                   (FUNCALL
                                                                                    KEYWORD-NORMALIZER
                                                                                    STRING))
                                                                                  (T
                                                                                   (WHEN
                                                                                       (MEMBER
                                                                                        STRING
                                                                                        KEYWORDS-TO-READ
                                                                                        :TEST
                                                                                        #'STRING=)
                                                                                     STRING))))) AS VALUE = (AND
                                                                                                             (WITH-SKIP-SPACES
                                                                                                              (ADVANCE*))
                                                                                                             (LET ((*INNER-NEST-P*
                                                                                                                    T))
                                                                                                               (DISPATCH
                                                                                                                (NOT
                                                                                                                 KEY)
                                                                                                                (EXCLUDE-NORMALIZE-KEY-P
                                                                                                                 KEY))))
                          WHEN KEY
                          DO (COND
                              ((OR AS-ALIST AS-JSOWN)
                               (PUSH (CONS KEY VALUE) RESULT))
                              (AS-HASH-TABLE (SETF (GETHASH KEY RESULT) VALUE))
                              (T
                               (SETQ RESULT
                                       (NCONC (LIST (MAKE-KEYWORD KEY) VALUE)
                                              RESULT))))
                          UNTIL (AND (NOT (WITH-SKIP-SPACES (SKIP? #\,)))
                                     (SKIP?-OR-EOF #\}))
                          FINALLY (RETURN-FROM READ-OBJECT
                                    (IF AS-JSOWN
                                        (CONS :OBJ RESULT)
                                        RESULT))))
                  (READ-STRING (&OPTIONAL SKIP-P)
                    (LET ((START (POS))
                          (ESCAPED-COUNT 0)
                          (UNICODE-COUNT 0)
                          (SURROGATE-COUNT 0)
                          (UNICODE-CHARS NIL))
                      (DECLARE (TYPE FIXNUM START ESCAPED-COUNT UNICODE-COUNT))
                      (WITH-ALLOWED-LAST-CHARACTER (:CHAR #\")
                       (SKIP-WHILE
                        (LAMBDA (C)
                          (OR
                           (AND (CHAR= C #\\) (INCF ESCAPED-COUNT)
                                (PROG1 (ADVANCE*)
                                  (WHEN
                                      (AND UNESCAPE-UNICODE-ESCAPE-SEQUENCE
                                           (CHAR= (CURRENT) #\u))
                                    (LET ((PAIR (READ-UNICODE-ESCAPE-SEQUENCE)))
                                      (SETQ UNICODE-CHARS
                                              (APPEND UNICODE-CHARS
                                                      (LIST PAIR)))
                                      (INCF UNICODE-COUNT)
                                      (WHEN (CDR PAIR)
                                        (INCF ESCAPED-COUNT)
                                        (INCF UNICODE-COUNT)
                                        (INCF SURROGATE-COUNT))))))
                           (CHAR/= C #\")))))
                      (PROG1
                          (UNLESS SKIP-P
                            (IF (= ESCAPED-COUNT 0)
                                (SUBSEQ STRING START (POS))
                                (PARSE-STRING-WITH-ESCAPING START ESCAPED-COUNT
                                 UNICODE-COUNT SURROGATE-COUNT UNICODE-CHARS)))
                        (ADVANCE*))))
                  (READ-UNICODE-ESCAPE-SEQUENCE ()
                    "Returns a pair like (char . is-surrogate-p) where
                    is-surrogate-p is `t' if char is a surrogate unicode symbol and
                    `nil' otherwise."
                    (ADVANCE*)
                    (LET ((CHAR-CODE
                           (PARSE-INTEGER (SUBSEQ STRING (POS) (+ (POS) 4))
                                          :RADIX 16)))
                      (IF (AND (>= CHAR-CODE 55296) (<= CHAR-CODE 56319))
                          (PROGN
                           (ADVANCE* 4)
                           (UNLESS
                               (AND (CHAR= (CURRENT) #\\) (ADVANCE*)
                                    (CHAR= (CURRENT) #\u))
                             (ERROR '<JONATHAN-WITHOUT-TAIL-SURROGATE-ERROR>))
                           (ADVANCE*)
                           (LET ((TAIL-CODE
                                  (PARSE-INTEGER
                                   (SUBSEQ STRING (POS) (+ (POS) 4)) :RADIX
                                   16)))
                             (UNLESS
                                 (AND (>= TAIL-CODE 56320)
                                      (<= TAIL-CODE 57343))
                               (ERROR
                                '<JONATHAN-WITHOUT-TAIL-SURROGATE-ERROR>))
                             (CONS
                              (CODE-CHAR
                               (+ 65536 (ASH (- CHAR-CODE 55296) 10)
                                  (- TAIL-CODE 56320)))
                              T)))
                          (CONS (CODE-CHAR CHAR-CODE) NIL))))
                  (PARSE-STRING-WITH-ESCAPING
                      (START ESCAPED-COUNT UNICODE-COUNT SURROGATE-COUNT
                       UNICODE-CHARS)
                    (DECLARE (TYPE FIXNUM START ESCAPED-COUNT))
                    (LOOP WITH RESULT = (MAKE-STRING
                                         (- (POS) START ESCAPED-COUNT
                                            (* UNICODE-COUNT 4)
                                            SURROGATE-COUNT))
                          WITH RESULT-INDEX = 0
                          WITH ESCAPED-P
                          FOR INDEX FROM START BELOW (POS)
                          FOR CHAR = (CHAR STRING INDEX)
                          IF ESCAPED-P
                          DO (SETF ESCAPED-P NIL) (SETF (CHAR RESULT
                                                              RESULT-INDEX)
                                                          (CASE CHAR
                                                            (#\b #\Backspace)
                                                            (#\f #\Newline)
                                                            (#\n #\Newline)
                                                            (#\r #\Return)
                                                            (#\t #\Tab)
                                                            (#\u
                                                             (IF UNESCAPE-UNICODE-ESCAPE-SEQUENCE
                                                                 (LET ((PAIR
                                                                        (POP
                                                                         UNICODE-CHARS)))
                                                                   (IF (CDR
                                                                        PAIR)
                                                                       (INCF
                                                                        INDEX
                                                                        10)
                                                                       (INCF
                                                                        INDEX
                                                                        4))
                                                                   (CAR PAIR))
                                                                 #\u))
                                                            (T CHAR))) (INCF
                                                                        RESULT-INDEX) (WHEN
                                                                                          (ZEROP
                                                                                           (DECF
                                                                                            ESCAPED-COUNT))
                                                                                        (RETURN-FROM
                                                                                            PARSE-STRING-WITH-ESCAPING
                                                                                          (REPLACE
                                                                                           RESULT
                                                                                           (THE
                                                                                            (SIMPLE-ARRAY
                                                                                             CHARACTER
                                                                                             (*))
                                                                                            (SUBSEQ
                                                                                             STRING
                                                                                             (1+
                                                                                              INDEX)))
                                                                                           :START1
                                                                                           RESULT-INDEX))) ELSE
                          IF (CHAR= CHAR #\\)
                          DO (SETF ESCAPED-P T) ELSE
                          DO (SETF (CHAR RESULT RESULT-INDEX) CHAR) (INCF
                                                                     RESULT-INDEX)
                          FINALLY (RETURN RESULT)))
                  (READ-ARRAY (&OPTIONAL SKIP-P)
                    (SKIP-SPACES)
                    (OR
                     (LOOP UNTIL (SKIP?-OR-EOF #\])
                           COLLECT (DISPATCH SKIP-P)
                           DO (WITH-SKIP-SPACES (SKIP? #\,)))
                     *EMPTY-ARRAY-VALUE*))
                  (READ-NUMBER (&OPTIONAL SKIP-P)
                    (IF SKIP-P
                        (TAGBODY
                          (SKIP-WHILE INTEGER-CHAR-P)
                          (WHEN (SKIP? #\.) (SKIP-WHILE INTEGER-CHAR-P))
                         :EOF
                          (RETURN-FROM READ-NUMBER))
                        (BIND (NUM-STR (SKIP-WHILE INTEGER-CHAR-P))
                         (LET ((NUM (THE FIXNUM (PARSE-INTEGER NUM-STR)))
                               (NEG
                                (THE BOOLEAN (CHAR= #\- (SCHAR NUM-STR 0)))))
                           (WHEN (WITH-ALLOWED-LAST-CHARACTER NIL (SKIP? #\.))
                             (SETQ NUM
                                     (BLOCK NIL
                                       (LET ((REST-START (THE FIXNUM (POS))))
                                         (BIND
                                          (REST-NUM-STR
                                           (SKIP-WHILE INTEGER-CHAR-P))
                                          (LET* ((REST-NUM
                                                  (PARSE-INTEGER REST-NUM-STR))
                                                 (DIGITS-LEN
                                                  (THE FIXNUM
                                                       (- (POS) REST-START)))
                                                 (BITS-LEN
                                                  (THE FIXNUM
                                                       (+ DIGITS-LEN
                                                          (LENGTH NUM-STR)
                                                          (IF NEG
                                                              -1
                                                              0))))
                                                 (SIGNIFICAND
                                                  (CONVERT-SIGNIFICAND
                                                   DIGITS-LEN BITS-LEN
                                                   REST-NUM)))
                                            (RETURN
                                             (IF NEG
                                                 (- NUM SIGNIFICAND)
                                                 (+ NUM SIGNIFICAND)))))))))
                           (WHEN
                               (WITH-ALLOWED-LAST-CHARACTER NIL
                                (SKIP? #\e #\E))
                             (SETQ NUM
                                     (BLOCK NIL
                                       (BIND
                                        (EXP-NUM-STR
                                         (SKIP-WHILE
                                          (LAMBDA (CHAR)
                                            (OR (INTEGER-CHAR-P CHAR)
                                                (CHAR= CHAR #\+)))))
                                        (LET ((EXP-NUM
                                               (THE FIXNUM
                                                    (PARSE-INTEGER
                                                     EXP-NUM-STR))))
                                          (RETURN
                                           (* NUM
                                              (IF (< EXP-NUM 0)
                                                  (FLOAT (EXPT 10 EXP-NUM))
                                                  (EXPT 10 EXP-NUM)))))))))
                           (RETURN-FROM READ-NUMBER (THE FIXNUM NUM))))))
                  (CONVERT-SIGNIFICAND (DIGITS-LEN BITS-LEN REST-NUM)
                    (COND
                     ((> DIGITS-LEN 20)
                      (COERCE (/ REST-NUM (EXPT 10 DIGITS-LEN))
                              (IF (< 8 BITS-LEN)
                                  'DOUBLE-FLOAT
                                  'SINGLE-FLOAT)))
                     ((< 8 BITS-LEN) (* REST-NUM (AREF NIL DIGITS-LEN)))
                     ((* REST-NUM (AREF NIL DIGITS-LEN))))))
           (DECLARE
            (INLINE READ-OBJECT READ-STRING READ-UNICODE-ESCAPE-SEQUENCE
             PARSE-STRING-WITH-ESCAPING READ-ARRAY READ-NUMBER))
           (SKIP-SPACES)
           (RETURN-FROM PARSE (DISPATCH)))))))

[jonathan/src/encode.lisp:45]
  (DEFUN %WRITE-STRING (STRING)
    (DECLARE (TYPE SIMPLE-STRING STRING)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (IF *OCTETS*
        (LOOP FOR C ACROSS STRING
              DO (FAST-WRITE-BYTE (CHAR-CODE C) *STREAM*))
        (WRITE-STRING STRING *STREAM*))
    NIL)

[jonathan/src/encode.lisp:57]
  (DEFUN %WRITE-CHAR (CHAR)
    (DECLARE (TYPE CHARACTER CHAR)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (IF *OCTETS*
        (FAST-WRITE-BYTE (CHAR-CODE CHAR) *STREAM*)
        (WRITE-CHAR CHAR *STREAM*))
    NIL)

[jonathan/src/encode.lisp:66]
  (DEFUN STRING-TO-JSON (STRING)
    (DECLARE (TYPE SIMPLE-STRING STRING)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (MACROLET ((ESCAPE (CHAR PAIRS)
                 (DECLARE (TYPE LIST PAIRS))
                 (LET* ((SORTED (SORT (COPY-LIST PAIRS) #'CHAR<= :KEY #'CAR))
                        (MIN-CHAR (CAAR SORTED))
                        (MAX-CHAR (CAAR (LAST SORTED))))
                   (ECLECTOR.READER:QUASIQUOTE
                    (IF (AND
                         (CHAR<= (ECLECTOR.READER:UNQUOTE CHAR)
                                 (ECLECTOR.READER:UNQUOTE MAX-CHAR))
                         (CHAR>= (ECLECTOR.READER:UNQUOTE CHAR)
                                 (ECLECTOR.READER:UNQUOTE MIN-CHAR)))
                        (COND
                         (ECLECTOR.READER:UNQUOTE-SPLICING
                          (MAPCAR
                           #'(LAMBDA (PAIR)
                               (ECLECTOR.READER:QUASIQUOTE
                                ((CHAR= (ECLECTOR.READER:UNQUOTE CHAR)
                                        (ECLECTOR.READER:UNQUOTE (CAR PAIR)))
                                 (%WRITE-STRING
                                  (ECLECTOR.READER:UNQUOTE (CDR PAIR))))))
                           PAIRS))
                         (T (%WRITE-CHAR (ECLECTOR.READER:UNQUOTE CHAR))))
                        (%WRITE-CHAR (ECLECTOR.READER:UNQUOTE CHAR)))))))
      (%WRITE-CHAR #\")
      (LOOP FOR CHAR OF-TYPE CHARACTER ACROSS STRING
            DO (ESCAPE CHAR
                ((#\Newline . "\\n") (#\Return . "\\r") (#\Tab . "\\t")
                 (#\" . "\\\"") (#\\ . "\\\\"))))
      (%WRITE-CHAR #\")))

[jonathan/src/encode.lisp:172]
  (DEFUN ALIST-TO-JSON (LIST)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (WITH-OBJECT
     (LOOP FOR (KEY . VALUE) IN LIST
           DO (WRITE-KEY-VALUE KEY VALUE))))

[jonathan/src/encode.lisp:179]
  (DEFUN PLIST-TO-JSON (LIST)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (WITH-OBJECT
     (LOOP FOR (KEY VALUE) ON LIST BY #'CDDR
           DO (WRITE-KEY-VALUE KEY VALUE))))

[jonathan/src/encode.lisp:186]
  (DEFUN LIST-TO-JSON (LIST)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (WITH-ARRAY
     (LOOP FOR ITEM IN LIST
           DO (WRITE-ITEM ITEM))))

[jonathan/src/encode.lisp:194]
  (DEFUN TO-JSON (OBJ &KEY (OCTETS *OCTETS*) (FROM *FROM*))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (LET ((*STREAM*
           (IF OCTETS
               (MAKE-OUTPUT-BUFFER :OUTPUT :VECTOR)
               (MAKE-STRING-OUTPUT-STREAM)))
          (*OCTETS* OCTETS)
          (*FROM* FROM))
      (%TO-JSON OBJ)
      (IF OCTETS
          (FINISH-OUTPUT-BUFFER *STREAM*)
          (GET-OUTPUT-STREAM-STRING *STREAM*))))

[journal/src/journal.lisp:202]
  (DEFUN GETF* (LIST INDICATOR &OPTIONAL DEFAULT)
    (DECLARE (TYPE LIST LIST)
             (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
    (DO ((PLIST LIST (CDDR PLIST)))
        ((NULL PLIST) DEFAULT)
      (WHEN (EQ (CAR PLIST) INDICATOR) (RETURN (CADR PLIST)))))

[jsown/reader.lisp:3]
  (EVAL-WHEN (:COMPILE-TOPLEVEL)
    (DECLAIM (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0))))

[jsown/writer.lisp:3]
  (EVAL-WHEN (:COMPILE-TOPLEVEL)
    (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 3) (SAFETY 0))))

[kmrcl/btree.lisp:19]
  (DEFMACRO DEF-STRING-TRICMP (FN SIMPLE)
    "Defines a string tri-valued compare function.
Can choose optimized version for simple-string."
    (ECLECTOR.READER:QUASIQUOTE
     (DEFUN (ECLECTOR.READER:UNQUOTE FN) (A B)
       (ECLECTOR.READER:UNQUOTE
        (FORMAT NIL "Compares two ~Astrings. Returns (VALUES CMP MAX-MATCHED). ~
CMP is -1 if a<b, 0 if a=b, +1 if b>a. ~
MAX-MATCHED is maximum numbers of letters of A ~
successfully compared."
                (IF SIMPLE
                    "simple "
                    "")))
       (DECLARE
        (ECLECTOR.READER:UNQUOTE
         (IF SIMPLE
             (QUOTE (SIMPLE-STRING A B))
             (QUOTE (STRING A B))))
        (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0) (COMPILATION-SPEED 0)
         (SPACE 0)))
       (LET ((ALEN (LENGTH A)) (BLEN (LENGTH B)))
         (DECLARE (FIXNUM ALEN BLEN))
         (DOTIMES (I ALEN)
           (DECLARE (FIXNUM I))
           (WHEN (>= I BLEN)
             (RETURN-FROM (ECLECTOR.READER:UNQUOTE FN) (VALUES 1 I)))
           (LET ((AC
                  ((ECLECTOR.READER:UNQUOTE
                    (IF SIMPLE
                        'SCHAR
                        'CHAR))
                   A I))
                 (BC
                  ((ECLECTOR.READER:UNQUOTE
                    (IF SIMPLE
                        'SCHAR
                        'CHAR))
                   B I)))
             (COND
              ((CHAR-LESSP AC BC)
               (RETURN-FROM (ECLECTOR.READER:UNQUOTE FN) (VALUES -1 I)))
              ((CHAR-GREATERP AC BC)
               (RETURN-FROM (ECLECTOR.READER:UNQUOTE FN) (VALUES 1 I))))))
         (WHEN (= ALEN BLEN)
           (RETURN-FROM (ECLECTOR.READER:UNQUOTE FN) (VALUES 0 ALEN)))
         (VALUES -1 ALEN)))))

[kmrcl/btree.lisp:77]
  (DEFUN SORTED-VECTOR-FIND (KEY-VAL SORTED-VECTOR &KEY TEST KEY TRACE)
    "Finds index of element in sorted vector using a binary tree search. ~
Order log2(N). Returns (VALUES POS LAST-VALUE LAST-POS COUNT).
POS is NIL if not found."
    (DECLARE
     (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0) (COMPILATION-SPEED 0)))
    (UNLESS TEST
      (SETQ TEST
              (ETYPECASE KEY-VAL
                (SIMPLE-STRING #'SIMPLE-STRING-TRICMP)
                (STRING #'STRING-TRICMP)
                (COMPLEX #'COMPLEX-NUMBER-TRICMP)
                (NUMBER #'NUMBER-TRICMP))))
    (WHEN (ZEROP (LENGTH SORTED-VECTOR))
      (RETURN-FROM SORTED-VECTOR-FIND (VALUES NIL NIL NIL 0)))
    (DO* ((LEN (LENGTH SORTED-VECTOR))
          (LAST (1- LEN))
          (POS (FLOOR LEN 2))
          (LAST-WIDTH 0 WIDTH)
          (LAST2-WIDTH LAST-WIDTH LAST-WIDTH)
          (WIDTH (1+ (CEILING POS 2)) (CEILING WIDTH 2))
          (COUNT 1 (1+ COUNT))
          (CUR-RAW (AREF SORTED-VECTOR POS) (AREF SORTED-VECTOR POS))
          (CUR (IF KEY
                   (FUNCALL KEY CUR-RAW)
                   CUR-RAW)
               (IF KEY
                   (FUNCALL KEY CUR-RAW)
                   CUR-RAW))
          (CMP (FUNCALL TEST KEY-VAL CUR) (FUNCALL TEST KEY-VAL CUR)))
         ((OR (ZEROP CMP) (= 1 LAST2-WIDTH))
          (WHEN TRACE
            (FORMAT TRACE "~A ~A ~A ~A ~A~%" CUR POS WIDTH LAST-WIDTH CMP))
          (VALUES
           (IF (ZEROP CMP)
               POS
               NIL)
           CUR-RAW POS COUNT))
      (DECLARE (FIXNUM LEN LAST POS LAST-WIDTH WIDTH COUNT CMP))
      (WHEN TRACE
        (FORMAT TRACE "~A ~A ~A ~A ~A~%" CUR POS WIDTH LAST-WIDTH CMP))
      (CASE CMP
        (-1 (DECF POS WIDTH) (WHEN (MINUSP POS) (SETQ POS 0)))
        (1 (INCF POS WIDTH) (WHEN (> POS LAST) (SETQ POS LAST))))))

[kmrcl/buff-input.lisp:19]
  (EVAL-WHEN (:COMPILE-TOPLEVEL)
    (DECLAIM (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0))))

[kmrcl/buff-input.lisp:151]
  (LET ((LINEBUFFER
         (MAKE-ARRAY +MAX-LINE+ :ELEMENT-TYPE 'CHARACTER :FILL-POINTER 0)))
    (DEFUN READ-BUFFERED-LINE (STRM EOF)
      "Read a line from astream into a vector buffer"
      (DECLARE (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0)))
      (LET ((POS 0) (DONE NIL))
        (DECLARE (FIXNUM POS)
                 (TYPE BOOLEAN DONE))
        (SETF (FILL-POINTER LINEBUFFER) 0)
        (DO ((C (READ-CHAR STRM NIL +EOF-CHAR+)
                (READ-CHAR STRM NIL +EOF-CHAR+)))
            (DONE
             (PROGN
              (UNLESS (EQL C +EOF-CHAR+) (UNREAD-CHAR C STRM))
              (IF (EQL C +EOF-CHAR+)
                  EOF
                  LINEBUFFER)))
          (DECLARE (CHARACTER C))
          (COND ((>= POS +MAX-LINE+) (WARN "Line overflow") (SETF DONE T))
                ((CHAR= C #\Newline)
                 (WHEN (PLUSP POS) (SETF (FILL-POINTER LINEBUFFER) (1- POS)))
                 (SETF DONE T))
                ((CHAR= +EOF-CHAR+) (SETF DONE T))
                (T (SETF (CHAR LINEBUFFER POS) C) (INCF POS)))))))

[kmrcl/byte-stream.lisp:212]
  (PROGN
   (DEFCLASS EXTENDABLE-BUFFER-OUTPUT-STREAM
             (#S(FORMGREP:SYMREF
                 :NAME "BUFFER-OUTPUT-SIMPLE-STREAM"
                 :QUALIFIER "EXCL"))
             NIL)
   (DEFUN MAKE-BYTE-ARRAY-OUTPUT-STREAM ()
     "Returns an Output stream which will accumulate all output given it for
   the benefit of the function Get-Output-Stream-Data."
     (MAKE-INSTANCE 'EXTENDABLE-BUFFER-OUTPUT-STREAM :BUFFER
                    (MAKE-ARRAY 128 :ELEMENT-TYPE '(UNSIGNED-BYTE 8))
                    :EXTERNAL-FORM :OCTETS))
   (DEFUN GET-OUTPUT-STREAM-DATA (STREAM)
     "Returns an array of all data sent to a stream made by
Make-Byte-Array-Output-Stream since the last call to this function
and clears buffer."
     (PROG1 (DUMP-OUTPUT-STREAM-DATA STREAM) (FILE-POSITION STREAM 0)))
   (DEFUN DUMP-OUTPUT-STREAM-DATA (STREAM)
     "Returns an array of all data sent to a stream made by
Make-Byte-Array-Output-Stream since the last call to this function."
     (FORCE-OUTPUT STREAM)
     (LET* ((LENGTH (FILE-POSITION STREAM))
            (RESULT (MAKE-ARRAY LENGTH :ELEMENT-TYPE '(UNSIGNED-BYTE 8))))
       (REPLACE RESULT
                (SLOT-VALUE STREAM
                            '#S(FORMGREP:SYMREF
                                :NAME "BUFFER"
                                :QUALIFIER "EXCL")))
       RESULT))
   (#S(FORMGREP:SYMREF :NAME "WITHOUT-PACKAGE-LOCKS" :QUALIFIER "EXCL")
    (DEFMETHOD #S(FORMGREP:SYMREF :NAME "DEVICE-EXTEND" :QUALIFIER "EXCL")
               ((STREAM EXTENDABLE-BUFFER-OUTPUT-STREAM) NEED ACTION)
      (DECLARE (IGNORE ACTION))
      (LET* ((LEN (FILE-POSITION STREAM))
             (NEW-LEN (MAX (+ LEN NEED) (* 2 LEN)))
             (OLD-BUF
              (SLOT-VALUE STREAM
                          '#S(FORMGREP:SYMREF
                              :NAME "BUFFER"
                              :QUALIFIER "EXCL")))
             (NEW-BUF (MAKE-ARRAY NEW-LEN :ELEMENT-TYPE '(UNSIGNED-BYTE 8))))
        (DECLARE (FIXNUM LEN)
                 (OPTIMIZE (SPEED 3) (SAFETY 0)))
        (DOTIMES (I LEN) (SETF (AREF NEW-BUF I) (AREF OLD-BUF I)))
        (SETF (SLOT-VALUE STREAM
                          '#S(FORMGREP:SYMREF
                              :NAME "BUFFER"
                              :QUALIFIER "EXCL"))
                NEW-BUF)
        (SETF (SLOT-VALUE STREAM
                          '#S(FORMGREP:SYMREF
                              :NAME "BUFFER-PTR"
                              :QUALIFIER "EXCL"))
                NEW-LEN))
      T)))

[kmrcl/color.lisp:33]
  (DEFUN HSV->RGB (H S V)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (WHEN (ZEROP S) (RETURN-FROM HSV->RGB (VALUES V V V)))
    (WHILE (MINUSP H) (INCF H 360))
    (WHILE (>= H 360) (DECF H 360))
    (LET ((H-POS (/ H 60)))
      (MULTIPLE-VALUE-BIND (H-INT H-FRAC)
          (TRUNCATE H-POS)
        (DECLARE (FIXNUM H-INT))
        (LET ((P (* V (- 1 S)))
              (Q (* V (- 1 (* S H-FRAC))))
              (T_ (* V (- 1 (* S (- 1 H-FRAC)))))
              R
              G
              B)
          (COND
           ((ZEROP H-INT)
            (SETF R V
                  G T_
                  B P))
           ((= 1 H-INT)
            (SETF R Q
                  G V
                  B P))
           ((= 2 H-INT)
            (SETF R P
                  G V
                  B T_))
           ((= 3 H-INT)
            (SETF R P
                  G Q
                  B V))
           ((= 4 H-INT)
            (SETF R T_
                  G P
                  B V))
           ((= 5 H-INT)
            (SETF R V
                  G P
                  B Q)))
          (VALUES R G B)))))

[kmrcl/color.lisp:79]
  (DEFUN HSV255->RGB255 (H S V)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (COMPILATION-SPEED 0)))
    (WHEN (ZEROP S) (RETURN-FROM HSV255->RGB255 (VALUES V V V)))
    (LOCALLY
     (DECLARE (TYPE FIXNUM H S V))
     (WHILE (MINUSP H) (INCF H 360))
     (WHILE (>= H 360) (DECF H 360))
     (LET ((H-POS (/ H 60)))
       (MULTIPLE-VALUE-BIND (H-INT H-FRAC)
           (TRUNCATE H-POS)
         (DECLARE (FIXNUM H-INT))
         (LET* ((FS (/ S 255))
                (FV (/ V 255))
                (P (ROUND (* 255 FV (- 1 FS))))
                (Q (ROUND (* 255 FV (- 1 (* FS H-FRAC)))))
                (T_ (ROUND (* 255 FV (- 1 (* FS (- 1 H-FRAC))))))
                R
                G
                B)
           (COND
            ((ZEROP H-INT)
             (SETF R V
                   G T_
                   B P))
            ((= 1 H-INT)
             (SETF R Q
                   G V
                   B P))
            ((= 2 H-INT)
             (SETF R P
                   G V
                   B T_))
            ((= 3 H-INT)
             (SETF R P
                   G Q
                   B V))
            ((= 4 H-INT)
             (SETF R T_
                   G P
                   B V))
            ((= 5 H-INT)
             (SETF R V
                   G P
                   B Q)))
           (VALUES R G B))))))

[kmrcl/color.lisp:130]
  (DEFUN RGB->HSV (R G B)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET* ((MIN (MIN R G B))
           (MAX (MAX R G B))
           (DELTA (- MAX MIN))
           (V MAX)
           (S 0)
           (H NIL))
      (WHEN (PLUSP MAX) (SETQ S (/ DELTA MAX)))
      (WHEN (PLUSP DELTA)
        (SETQ H
                (* 60
                   (COND ((= MAX R) (/ (- G B) DELTA))
                         ((= MAX G) (+ 2 (/ (- B R) DELTA)))
                         (T (+ 4 (/ (- R G) DELTA))))))
        (WHEN (MINUSP H) (INCF H 360)))
      (VALUES H S V)))

[kmrcl/color.lisp:153]
  (DEFUN RGB255->HSV255 (R G B)
    "Integer convert from rgb from 0-255 -> h from 0-360 and sv from 0-255"
    (DECLARE (FIXNUM R G B)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (COMPILATION-SPEED 0)))
    (LET* ((MIN (MIN R G B))
           (MAX (MAX R G B))
           (DELTA (- MAX MIN))
           (V MAX)
           (S 0)
           (H NIL))
      (DECLARE (FIXNUM MIN MAX DELTA V S)
               (TYPE (OR NULL FIXNUM) H))
      (WHEN (PLUSP MAX) (SETQ S (ROUND (THE FIXNUM (* 255 DELTA)) MAX)))
      (WHEN (PLUSP DELTA)
        (SETQ H
                (COND
                 ((= MAX R)
                  (ROUND (THE FIXNUM (* 60 (THE FIXNUM (- G B)))) DELTA))
                 ((= MAX G)
                  (THE FIXNUM
                       (+ 120
                          (ROUND (THE FIXNUM (* 60 (THE FIXNUM (- B R))))
                                 DELTA))))
                 (T
                  (THE FIXNUM
                       (+ 240
                          (ROUND (THE FIXNUM (* 60 (THE FIXNUM (- R G))))
                                 DELTA))))))
        (WHEN (MINUSP H) (INCF H 360)))
      (VALUES H S V)))

[kmrcl/color.lisp:186]
  (DEFUN HSV-EQUAL (H1 S1 V1 H2 S2 V2 &KEY (LIMIT 0.001))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (COMPILATION-SPEED 0)))
    (FLET ((~= (A B)
             (COND ((AND (NULL A) (NULL B)) T) ((OR (NULL A) (NULL B)) NIL)
                   (T (< (ABS (- A B)) LIMIT)))))
      (COND ((AND (~= 0 V1) (~= 0 V2)) T)
            ((OR (NULL H1) (NULL H2))
             (WHEN (AND (~= 0 S1) (~= 0 S2) (~= V1 V2)) T))
            (T (WHEN (~= H1 H2) (~= S1 S2) (~= V1 V2) T)))))

[kmrcl/color.lisp:206]
  (DEFUN HSV255-EQUAL (H1 S1 V1 H2 S2 V2 &KEY (LIMIT 1))
    (DECLARE (TYPE FIXNUM S1 V1 S2 V2 LIMIT)
             (TYPE (OR NULL FIXNUM) H1 H2)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (COMPILATION-SPEED 0)))
    (FLET ((~= (A B)
             (DECLARE (TYPE (OR NULL FIXNUM) A B))
             (COND ((AND (NULL A) (NULL B)) T) ((OR (NULL A) (NULL B)) NIL)
                   (T (<= (ABS (THE FIXNUM (- A B))) LIMIT)))))
      (COND ((AND (~= 0 V1) (~= 0 V2)) T)
            ((OR (NULL H1) (NULL H2))
             (WHEN (AND (~= 0 S1) (~= 0 S2) (~= V1 V2)) T))
            (T (WHEN (~= H1 H2) (~= S1 S2) (~= V1 V2) T)))))

[kmrcl/color.lisp:248]
  (DEFUN HSV255-SIMILAR
         (H1 S1 V1 H2 S2 V2
          &KEY (HUE-RANGE 15) (VALUE-RANGE 50) (SATURATION-RANGE 50)
          (GRAY-LIMIT 75) (BLACK-LIMIT 75))
    "Returns T if two HSV values are similar."
    (DECLARE
     (FIXNUM S1 V1 S2 V2 HUE-RANGE VALUE-RANGE SATURATION-RANGE GRAY-LIMIT
      BLACK-LIMIT)
     (TYPE (OR NULL FIXNUM) H1 H2)
     (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (COMPILATION-SPEED 0)))
    (COND ((AND (<= V1 BLACK-LIMIT) (<= V2 BLACK-LIMIT)) T)
          ((AND (<= S1 GRAY-LIMIT) (<= S2 GRAY-LIMIT))
           (WHEN (<= (ABS (- V1 V2)) VALUE-RANGE) T))
          (T
           (WHEN
               (AND (<= (ABS (HUE-DIFFERENCE-FIXNUM H1 H2)) HUE-RANGE)
                    (<= (ABS (- V1 V2)) VALUE-RANGE)
                    (<= (ABS (- S1 S2)) SATURATION-RANGE))
             T))))

[kmrcl/io.lisp:74]
  (DEFUN PRINT-N-CHARS (CHAR N STREAM)
    (DECLARE (FIXNUM N)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0)))
    (DOTIMES (I N) (DECLARE (FIXNUM I)) (WRITE-CHAR CHAR STREAM)))

[kmrcl/io.lisp:80]
  (DEFUN PRINT-N-STRINGS (STR N STREAM)
    (DECLARE (FIXNUM N)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0)))
    (DOTIMES (I N) (DECLARE (FIXNUM I)) (WRITE-STRING STR STREAM)))

[kmrcl/io.lisp:329]
  (DEFMACRO DEF-UNSIGNED-INT-IO (LEN R-NAME W-NAME &KEY (BIG-ENDIAN NIL))
    "Defines read and write functions for an unsigned integer with LEN bytes from STREAM."
    (WHEN (< LEN 1) (ERROR "Number of bytes must be greater than 0.~%"))
    (LET ((ENDIAN-STRING
           (IF BIG-ENDIAN
               "big"
               "little")))
      (ECLECTOR.READER:QUASIQUOTE
       (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
         (DEFUN (ECLECTOR.READER:UNQUOTE R-NAME) (STREAM)
           (ECLECTOR.READER:UNQUOTE
            (FORMAT NIL "Reads an ~A byte unsigned integer (~A-endian)." LEN
                    ENDIAN-STRING))
           (DECLARE
            (OPTIMIZE (SPEED 3) (COMPILATION-SPEED 0) (SAFETY 0) (SPACE 0)
             (DEBUG 0))
            (TYPE STREAM STREAM))
           (LET ((VAL 0))
             (DECLARE
              (TYPE
               (ECLECTOR.READER:UNQUOTE
                (IF (< (EXPT 256 LEN) MOST-POSITIVE-FIXNUM)
                    (QUOTE FIXNUM)
                    (ECLECTOR.READER:QUASIQUOTE
                     (INTEGER 0
                      (ECLECTOR.READER:UNQUOTE (1- (EXPT 256 LEN)))))))
               VAL))
             (ECLECTOR.READER:UNQUOTE-SPLICING
              (LOOP FOR I FROM 1 UPTO LEN
                    COLLECT (ECLECTOR.READER:QUASIQUOTE
                             (SETF (LDB
                                    (BYTE 8
                                          (ECLECTOR.READER:UNQUOTE
                                           (*
                                            (IF BIG-ENDIAN
                                                (1- I)
                                                (- LEN I))
                                            8)))
                                    VAL)
                                     (READ-BYTE STREAM)))))
             VAL))
         (DEFUN (ECLECTOR.READER:UNQUOTE W-NAME)
                (VAL STREAM &KEY (BOUNDS-CHECK T))
           (ECLECTOR.READER:UNQUOTE
            (FORMAT NIL
                    "Writes an ~A byte unsigned integer as binary to STREAM (~A-endian)."
                    LEN ENDIAN-STRING))
           (DECLARE
            (OPTIMIZE (SPEED 3) (COMPILATION-SPEED 0) (SAFETY 0) (SPACE 0)
             (DEBUG 0))
            (TYPE STREAM STREAM)
            (ECLECTOR.READER:UNQUOTE
             (IF (< (EXPT 256 LEN) MOST-POSITIVE-FIXNUM)
                 (QUOTE (TYPE FIXNUM VAL))
                 (QUOTE (TYPE INTEGER VAL)))))
           (WHEN BOUNDS-CHECK
             (WHEN (>= VAL (ECLECTOR.READER:UNQUOTE (EXPT 256 LEN)))
               (ERROR "Number ~D is too large to fit in ~D bytes.~%" VAL
                      (ECLECTOR.READER:UNQUOTE LEN)))
             (WHEN (MINUSP VAL)
               (ERROR "Number ~D can't be written as unsigned integer." VAL)))
           (LOCALLY
            (DECLARE
             (TYPE (INTEGER 0 (ECLECTOR.READER:UNQUOTE (1- (EXPT 256 LEN))))
              VAL))
            (ECLECTOR.READER:UNQUOTE-SPLICING
             (LOOP FOR I FROM 1 UPTO LEN
                   COLLECT (ECLECTOR.READER:QUASIQUOTE
                            (WRITE-BYTE
                             (LDB
                              (BYTE 8
                                    (ECLECTOR.READER:UNQUOTE
                                     (*
                                      (IF BIG-ENDIAN
                                          (1- I)
                                          (- LEN I))
                                      8)))
                              VAL)
                             STREAM)))))
           VAL)
         NIL))))

[kmrcl/strings.lisp:29]
  (DEFUN COUNT-STRING-WORDS (STR)
    (DECLARE (SIMPLE-STRING STR)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0)))
    (LET ((N-WORDS 0) (IN-WORD NIL))
      (DECLARE (FIXNUM N-WORDS))
      (DO* ((LEN (LENGTH STR))
            (I 0 (1+ I)))
           ((= I LEN) N-WORDS)
        (DECLARE (FIXNUM I))
        (IF (ALPHANUMERICP (SCHAR STR I))
            (UNLESS IN-WORD (INCF N-WORDS) (SETQ IN-WORD T))
            (SETQ IN-WORD NIL)))))

[kmrcl/strings.lisp:45]
  (DEFUN POSITION-CHAR (CHAR STRING START MAX)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0))
             (FIXNUM START MAX)
             (SIMPLE-STRING STRING))
    (DO* ((I START (1+ I)))
         ((= I MAX) NIL)
      (DECLARE (FIXNUM I))
      (WHEN (CHAR= CHAR (SCHAR STRING I)) (RETURN I))))

[kmrcl/strings.lisp:53]
  (DEFUN POSITION-NOT-CHAR (CHAR STRING START MAX)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0))
             (FIXNUM START MAX)
             (SIMPLE-STRING STRING))
    (DO* ((I START (1+ I)))
         ((= I MAX) NIL)
      (DECLARE (FIXNUM I))
      (WHEN (CHAR/= CHAR (SCHAR STRING I)) (RETURN I))))

[kmrcl/strings.lisp:61]
  (DEFUN DELIMITED-STRING-TO-LIST
         (STRING &OPTIONAL (SEPARATOR #\ ) SKIP-TERMINAL)
    "split a string with delimiter"
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (COMPILATION-SPEED 0))
             (TYPE STRING STRING)
             (TYPE CHARACTER SEPARATOR))
    (DO* ((LEN (LENGTH STRING))
          (OUTPUT 'NIL)
          (POS 0)
          (END (POSITION-CHAR SEPARATOR STRING POS LEN)
               (POSITION-CHAR SEPARATOR STRING POS LEN)))
         ((NULL END)
          (IF (< POS LEN)
              (PUSH (SUBSEQ STRING POS) OUTPUT)
              (WHEN (OR (NOT SKIP-TERMINAL) (ZEROP LEN)) (PUSH "" OUTPUT)))
          (NREVERSE OUTPUT))
      (DECLARE (TYPE FIXNUM POS LEN)
               (TYPE (OR NULL FIXNUM) END))
      (PUSH (SUBSEQ STRING POS END) OUTPUT)
      (SETQ POS (1+ END))))

[kmrcl/strings.lisp:87]
  (DEFUN STRING-INVERT (STR)
    "Invert case of a string"
    (DECLARE (OPTIMIZE (SPEED 3) (COMPILATION-SPEED 0) (DEBUG 0) (SAFETY 0))
             (SIMPLE-STRING STR))
    (LET ((UP NIL) (DOWN NIL))
      (BLOCK SKIP
        (LOOP FOR CHAR OF-TYPE CHARACTER ACROSS STR
              DO (COND
                  ((UPPER-CASE-P CHAR)
                   (IF DOWN
                       (RETURN-FROM SKIP STR)
                       (SETF UP T)))
                  ((LOWER-CASE-P CHAR)
                   (IF UP
                       (RETURN-FROM SKIP STR)
                       (SETF DOWN T)))))
        (IF UP
            (STRING-DOWNCASE STR)
            (STRING-UPCASE STR)))))

[kmrcl/strings.lisp:157]
  (DEFUN IS-CHAR-WHITESPACE (C)
    (DECLARE (CHARACTER C)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (OR (CHAR= C #\ ) (CHAR= C #\Tab) (CHAR= C #\Return) (CHAR= C #\Newline)
        (CHAR= C #\?) (CHAR= C #\?)))

[kmrcl/strings.lisp:177]
  (DEFUN REPLACED-STRING-LENGTH (STR REPL-ALIST)
    (DECLARE (SIMPLE-STRING STR)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0)))
    (DO* ((I 0 (1+ I))
          (ORIG-LEN (LENGTH STR))
          (NEW-LEN ORIG-LEN))
         ((= I ORIG-LEN) NEW-LEN)
      (DECLARE (FIXNUM I ORIG-LEN NEW-LEN))
      (LET* ((C (CHAR STR I)) (MATCH (ASSOC C REPL-ALIST :TEST #'CHAR=)))
        (DECLARE (CHARACTER C))
        (WHEN MATCH
          (INCF NEW-LEN (1- (LENGTH (THE SIMPLE-STRING (CDR MATCH)))))))))

[kmrcl/strings.lisp:192]
  (DEFUN SUBSTITUTE-CHARS-STRINGS (STR REPL-ALIST)
    "Replace all instances of a chars with a string. repl-alist is an assoc
list of characters and replacement strings."
    (DECLARE (SIMPLE-STRING STR)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0)))
    (DO* ((ORIG-LEN (LENGTH STR))
          (NEW-STRING (MAKE-STRING (REPLACED-STRING-LENGTH STR REPL-ALIST)))
          (SPOS 0 (1+ SPOS))
          (DPOS 0))
         ((>= SPOS ORIG-LEN) NEW-STRING)
      (DECLARE (FIXNUM SPOS DPOS)
               (SIMPLE-STRING NEW-STRING))
      (LET* ((C (CHAR STR SPOS)) (MATCH (ASSOC C REPL-ALIST :TEST #'CHAR=)))
        (DECLARE (CHARACTER C))
        (IF MATCH
            (LET* ((SUBST (CDR MATCH)) (LEN (LENGTH SUBST)))
              (DECLARE (FIXNUM LEN)
                       (SIMPLE-STRING SUBST))
              (DOTIMES (J LEN)
                (DECLARE (FIXNUM J))
                (SETF (CHAR NEW-STRING DPOS) (CHAR SUBST J))
                (INCF DPOS)))
            (PROGN (SETF (CHAR NEW-STRING DPOS) C) (INCF DPOS))))))

[kmrcl/strings.lisp:227]
  (DEFUN USB8-ARRAY-TO-STRING (VEC &KEY (START 0) END)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) VEC)
             (FIXNUM START))
    (UNLESS END (SETQ END (LENGTH VEC)))
    (LET* ((LEN (- END START)) (STR (MAKE-STRING LEN)))
      (DECLARE (FIXNUM LEN)
               (SIMPLE-STRING STR)
               (OPTIMIZE (SPEED 3) (SAFETY 0)))
      (DO ((I 0 (1+ I)))
          ((= I LEN) STR)
        (DECLARE (FIXNUM I))
        (SETF (SCHAR STR I) (CODE-CHAR (AREF VEC (THE FIXNUM (+ I START))))))))

[kmrcl/strings.lisp:261]
  (DEFUN PRINT-SEPARATED-STRINGS (STRM SEPARATOR &REST LISTS)
    (DECLARE
     (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0) (COMPILATION-SPEED 0)))
    (DO* ((REST-LISTS LISTS (CDR REST-LISTS))
          (LIST (CAR REST-LISTS) (CAR REST-LISTS))
          (LAST-LIST (ONLY-NULL-LIST-ELEMENTS-P (CDR REST-LISTS))
                     (ONLY-NULL-LIST-ELEMENTS-P (CDR REST-LISTS))))
         ((NULL REST-LISTS) STRM)
      (DO* ((LST LIST (CDR LST))
            (ELEM (CAR LST) (CAR LST))
            (LAST-ELEM (NULL (CDR LST)) (NULL (CDR LST))))
           ((NULL LST))
        (WRITE-STRING ELEM STRM)
        (UNLESS (AND LAST-ELEM LAST-LIST) (WRITE-STRING SEPARATOR STRM)))))

[kmrcl/strings.lisp:277]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (DEFMACRO DEF-PREFIXED-NUMBER-STRING (FN-NAME TYPE &OPTIONAL DOC)
      (ECLECTOR.READER:QUASIQUOTE
       (DEFUN (ECLECTOR.READER:UNQUOTE FN-NAME) (NUM PCHAR LEN)
         (ECLECTOR.READER:UNQUOTE-SPLICING (WHEN (STRINGP DOC) (LIST DOC)))
         (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0))
                  (FIXNUM LEN)
                  ((ECLECTOR.READER:UNQUOTE TYPE) NUM))
         (WHEN PCHAR (INCF LEN))
         (DO* ((ZERO-CODE (CHAR-CODE #\0))
               (RESULT (MAKE-STRING LEN :INITIAL-ELEMENT #\0))
               (MINUS? (MINUSP NUM))
               (VAL (IF MINUS?
                        (- NUM)
                        NUM)
                    (NTH-VALUE 0 (FLOOR VAL 10)))
               (POS (1- LEN) (1- POS))
               (MOD (MOD VAL 10) (MOD VAL 10)))
              ((OR (ZEROP VAL) (MINUSP POS))
               (WHEN PCHAR (SETF (SCHAR RESULT 0) PCHAR))
               (WHEN MINUS?
                 (SETF (SCHAR RESULT
                              (IF PCHAR
                                  1
                                  0))
                         #\-))
               RESULT)
           (DECLARE ((ECLECTOR.READER:UNQUOTE TYPE) VAL)
                    (FIXNUM MOD ZERO-CODE POS)
                    (BOOLEAN MINUS?)
                    (SIMPLE-STRING RESULT))
           (SETF (SCHAR RESULT POS)
                   (CODE-CHAR (THE FIXNUM (+ ZERO-CODE MOD)))))))))

[kmrcl/strings.lisp:312]
  (DEFUN INTEGER-STRING (NUM LEN)
    "Outputs a string of LEN digit with an optional initial character PCHAR.
Leading zeros are present."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0))
             (TYPE FIXNUM LEN)
             (TYPE INTEGER NUM))
    (DO* ((ZERO-CODE (CHAR-CODE #\0))
          (RESULT (MAKE-STRING LEN :INITIAL-ELEMENT #\0))
          (MINUS? (MINUSP NUM))
          (VAL (IF MINUS?
                   (- 0 NUM)
                   NUM)
               (NTH-VALUE 0 (FLOOR VAL 10)))
          (POS (1- LEN) (1- POS))
          (MOD (MOD VAL 10) (MOD VAL 10)))
         ((OR (ZEROP VAL) (MINUSP POS))
          (WHEN MINUS? (SETF (SCHAR RESULT 0) #\-))
          RESULT)
      (DECLARE (FIXNUM MOD ZERO-CODE POS)
               (SIMPLE-STRING RESULT)
               (INTEGER VAL))
      (SETF (SCHAR RESULT POS) (CODE-CHAR (+ ZERO-CODE MOD)))))

[kmrcl/strings.lisp:331]
  (DEFUN FAST-STRING-SEARCH (SUBSTR STR SUBSTR-LENGTH STARTPOS ENDPOS)
    "Optimized search for a substring in a simple-string"
    (DECLARE (SIMPLE-STRING SUBSTR STR)
             (FIXNUM SUBSTR-LENGTH STARTPOS ENDPOS)
             (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0)))
    (DO* ((POS STARTPOS (1+ POS))
          (LASTPOS (- ENDPOS SUBSTR-LENGTH)))
         ((> POS LASTPOS) NIL)
      (DECLARE (FIXNUM POS LASTPOS))
      (DO ((I 0 (1+ I)))
          ((= I SUBSTR-LENGTH) (RETURN-FROM FAST-STRING-SEARCH POS))
        (DECLARE (FIXNUM I))
        (UNLESS (CHAR= (SCHAR STR (+ I POS)) (SCHAR SUBSTR I)) (RETURN NIL)))))

[kmrcl/strings.lisp:347]
  (DEFUN STRING-DELIMITED-STRING-TO-LIST (STR SUBSTR)
    "splits a string delimited by substr into a list of strings"
    (DECLARE (SIMPLE-STRING STR SUBSTR)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (COMPILATION-SPEED 0)
              (DEBUG 0)))
    (DO* ((SUBSTR-LEN (LENGTH SUBSTR))
          (STRLEN (LENGTH STR))
          (OUTPUT 'NIL)
          (POS 0)
          (END (FAST-STRING-SEARCH SUBSTR STR SUBSTR-LEN POS STRLEN)
               (FAST-STRING-SEARCH SUBSTR STR SUBSTR-LEN POS STRLEN)))
         ((NULL END)
          (WHEN (< POS STRLEN) (PUSH (SUBSEQ STR POS) OUTPUT))
          (NREVERSE OUTPUT))
      (DECLARE (FIXNUM STRLEN SUBSTR-LEN POS)
               (TYPE (OR FIXNUM NULL) END))
      (PUSH (SUBSEQ STR POS END) OUTPUT)
      (SETQ POS (+ END SUBSTR-LEN))))

[kmrcl/strings.lisp:367]
  (DEFUN STRING-TO-LIST-SKIP-DELIMITER (STR &OPTIONAL (DELIM #\ ))
    "Return a list of strings, delimited by spaces, skipping spaces."
    (DECLARE (SIMPLE-STRING STR)
             (OPTIMIZE (SPEED 0) (SPACE 0) (SAFETY 0)))
    (DO* ((RESULTS 'NIL)
          (END (LENGTH STR))
          (I (POSITION-NOT-CHAR DELIM STR 0 END)
             (POSITION-NOT-CHAR DELIM STR J END))
          (J (WHEN I (POSITION-CHAR DELIM STR I END))
             (WHEN I (POSITION-CHAR DELIM STR I END))))
         ((OR (NULL I) (NULL J))
          (WHEN (AND I (< I END)) (PUSH (SUBSEQ STR I END) RESULTS))
          (NREVERSE RESULTS))
      (DECLARE (FIXNUM END)
               (TYPE (OR FIXNUM NULL) I J))
      (PUSH (SUBSEQ STR I J) RESULTS)))

[kmrcl/strings.lisp:389]
  (DEFUN COUNT-STRING-CHAR (S C)
    "Return a count of the number of times a character appears in a string"
    (DECLARE (SIMPLE-STRING S)
             (CHARACTER C)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DO ((LEN (LENGTH S))
         (I 0 (1+ I))
         (COUNT 0))
        ((= I LEN) COUNT)
      (DECLARE (FIXNUM I LEN COUNT))
      (WHEN (CHAR= (SCHAR S I) C) (INCF COUNT))))

[kmrcl/strings.lisp:402]
  (DEFUN COUNT-STRING-CHAR-IF (PRED S)
    "Return a count of the number of times a predicate is true
for characters in a string"
    (DECLARE (SIMPLE-STRING S)
             (TYPE (OR FUNCTION SYMBOL) PRED)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0)))
    (DO ((LEN (LENGTH S))
         (I 0 (1+ I))
         (COUNT 0))
        ((= I LEN) COUNT)
      (DECLARE (FIXNUM I LEN COUNT))
      (WHEN (FUNCALL PRED (SCHAR S I)) (INCF COUNT))))

[kmrcl/strings.lisp:449]
  (DEFUN ENCODE-URI-STRING (QUERY)
    "Escape non-alphanumeric characters for URI fields"
    (DECLARE (SIMPLE-STRING QUERY)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0)))
    (DO* ((COUNT (COUNT-STRING-CHAR-IF #'NON-ALPHANUMERICP QUERY))
          (LEN (LENGTH QUERY))
          (NEW-LEN (+ LEN (* 2 COUNT)))
          (STR (MAKE-STRING NEW-LEN))
          (SPOS 0 (1+ SPOS))
          (DPOS 0 (1+ DPOS)))
         ((= SPOS LEN) STR)
      (DECLARE (FIXNUM COUNT LEN NEW-LEN SPOS DPOS)
               (SIMPLE-STRING STR))
      (LET ((CH (SCHAR QUERY SPOS)))
        (IF (NON-ALPHANUMERICP CH)
            (LET ((C (CHAR-CODE CH)))
              (SETF (SCHAR STR DPOS) #\%)
              (INCF DPOS)
              (SETF (SCHAR STR DPOS) (HEXCHAR (LOGAND (ASH C -4) 15)))
              (INCF DPOS)
              (SETF (SCHAR STR DPOS) (HEXCHAR (LOGAND C 15))))
            (SETF (SCHAR STR DPOS) CH)))))

[kmrcl/strings.lisp:472]
  (DEFUN DECODE-URI-STRING (QUERY)
    "Unescape non-alphanumeric characters for URI fields"
    (DECLARE (SIMPLE-STRING QUERY)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0)))
    (DO* ((COUNT (COUNT-STRING-CHAR QUERY #\%))
          (LEN (LENGTH QUERY))
          (NEW-LEN (- LEN (* 2 COUNT)))
          (STR (MAKE-STRING NEW-LEN))
          (SPOS 0 (1+ SPOS))
          (DPOS 0 (1+ DPOS)))
         ((= SPOS LEN) STR)
      (DECLARE (FIXNUM COUNT LEN NEW-LEN SPOS DPOS)
               (SIMPLE-STRING STR))
      (LET ((CH (SCHAR QUERY SPOS)))
        (IF (CHAR= #\% CH)
            (LET ((C1 (CHARHEX (SCHAR QUERY (1+ SPOS))))
                  (C2 (CHARHEX (SCHAR QUERY (+ SPOS 2)))))
              (DECLARE (FIXNUM C1 C2))
              (SETF (SCHAR STR DPOS) (CODE-CHAR (LOGIOR C2 (ASH C1 4))))
              (INCF SPOS 2))
            (SETF (SCHAR STR DPOS) CH)))))

[kmrcl/strings.lisp:648]
  (DEFUN SPLIT-ALPHANUMERIC-STRING (STRING)
    "Separates a string at any non-alphanumeric chararacter"
    (DECLARE (SIMPLE-STRING STRING)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (FLET ((IS-SEP (CHAR)
             (DECLARE (CHARACTER CHAR))
             (AND (NON-ALPHANUMERICP CHAR) (NOT (CHAR= #\_ CHAR)))))
      (LET ((TOKENS NIL))
        (DO* ((TOKEN-START (POSITION-IF-NOT #'IS-SEP STRING)
                           (WHEN TOKEN-END
                             (POSITION-IF-NOT #'IS-SEP STRING :START
                                              (1+ TOKEN-END))))
              (TOKEN-END (WHEN TOKEN-START
                           (POSITION-IF #'IS-SEP STRING :START TOKEN-START))
                         (WHEN TOKEN-START
                           (POSITION-IF #'IS-SEP STRING :START TOKEN-START))))
             ((NULL TOKEN-START) (NREVERSE TOKENS))
          (PUSH (SUBSEQ STRING TOKEN-START TOKEN-END) TOKENS)))))

[kmrcl/strings.lisp:670]
  (DEFUN TRIM-NON-ALPHANUMERIC (WORD)
    "Strip non-alphanumeric characters from beginning and end of a word."
    (DECLARE (SIMPLE-STRING WORD)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0)))
    (LET* ((START 0) (LEN (LENGTH WORD)) (END LEN))
      (DECLARE (FIXNUM START END LEN))
      (DO ((DONE NIL))
          ((OR DONE (= START END)))
        (IF (ALPHANUMERICP (SCHAR WORD START))
            (SETQ DONE T)
            (INCF START)))
      (WHEN (> END START)
        (DO ((DONE NIL))
            ((OR DONE (= START END)))
          (IF (ALPHANUMERICP (SCHAR WORD (1- END)))
              (SETQ DONE T)
              (DECF END))))
      (IF (OR (PLUSP START) (/= LEN END))
          (SUBSEQ WORD START END)
          WORD)))

[kmrcl/strings.lisp:694]
  (DEFUN COLLAPSE-WHITESPACE (S)
    "Convert multiple whitespace characters to a single space character."
    (DECLARE (SIMPLE-STRING S)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (WITH-OUTPUT-TO-STRING (STREAM)
      (DO ((POS 0 (1+ POS))
           (IN-WHITE NIL)
           (LEN (LENGTH S)))
          ((= POS LEN))
        (DECLARE (FIXNUM POS LEN))
        (LET ((C (SCHAR S POS)))
          (DECLARE (CHARACTER C))
          (COND
           ((#S(FORMGREP:SYMREF :NAME "IS-CHAR-WHITESPACE" :QUALIFIER "KL") C)
            (UNLESS IN-WHITE (WRITE-CHAR #\  STREAM)) (SETQ IN-WHITE T))
           (T (SETQ IN-WHITE NIL) (WRITE-CHAR C STREAM)))))))

[kmrcl/web-utils.lisp:69]
  (DEFUN DECODE-URI-QUERY-STRING (S)
    "Decode a URI query string field"
    (DECLARE (SIMPLE-STRING S)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0)))
    (DO* ((OLD-LEN (LENGTH S))
          (NEW-LEN (- OLD-LEN (* 2 (THE FIXNUM (COUNT-STRING-CHAR S #\%)))))
          (NEW (MAKE-STRING NEW-LEN))
          (P-OLD 0)
          (P-NEW 0 (1+ P-NEW)))
         ((= P-NEW NEW-LEN) NEW)
      (DECLARE (SIMPLE-STRING NEW)
               (FIXNUM P-OLD P-NEW OLD-LEN NEW-LEN))
      (LET ((C (SCHAR S P-OLD)))
        (WHEN (CHAR= C #\+) (SETQ C #\ ))
        (CASE C
          (#\%
           (UNLESS (>= OLD-LEN (+ P-OLD 3))
             (ERROR "#% not followed by enough characters"))
           (SETF (SCHAR NEW P-NEW)
                   (CODE-CHAR
                    (PARSE-INTEGER (SUBSEQ S (1+ P-OLD) (+ P-OLD 3)) :RADIX
                                   16)))
           (INCF P-OLD 3))
          (T (SETF (SCHAR NEW P-NEW) C) (INCF P-OLD))))))

[kmrcl/xml-utils.lisp:22]
  (DEFUN FIND-START-TAG (TAG TAGLEN XMLSTR START END)
    "Searches for the start of a tag in an xmlstring. Returns STARTPOS ATTRIBUTE-LIST)"
    (DECLARE (SIMPLE-STRING TAG XMLSTR)
             (FIXNUM TAGLEN START END)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0)))
    (DO* ((SEARCH-STR (CONCATENATE 'STRING "<" TAG))
          (SEARCH-LEN (1+ TAGLEN))
          (BRACKETPOS (FAST-STRING-SEARCH SEARCH-STR XMLSTR SEARCH-LEN START
                       END)
                      (FAST-STRING-SEARCH SEARCH-STR XMLSTR SEARCH-LEN START
                       END)))
         ((NULL BRACKETPOS) NIL)
      (LET* ((ENDTAG (+ BRACKETPOS 1 TAGLEN))
             (CHAR-AFTER-TAG (SCHAR XMLSTR ENDTAG)))
        (WHEN (OR (CHAR= #\> CHAR-AFTER-TAG) (CHAR= #\  CHAR-AFTER-TAG))
          (IF (CHAR= #\> CHAR-AFTER-TAG)
              (RETURN-FROM FIND-START-TAG (VALUES (1+ ENDTAG) NIL))
              (LET ((ENDBRACK (POSITION-CHAR #\> XMLSTR (1+ ENDTAG) END)))
                (IF ENDBRACK
                    (RETURN-FROM FIND-START-TAG
                      (VALUES (1+ ENDBRACK)
                              (STRING-TO-LIST-SKIP-DELIMITER
                               (SUBSEQ XMLSTR ENDTAG ENDBRACK))))
                    (VALUES NIL NIL)))))
        (SETQ START ENDTAG))))

[kmrcl/xml-utils.lisp:82]
  (DEFUN WRITE-CDATA (STR S)
    (DECLARE (SIMPLE-STRING STR)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0)))
    (UNLESS STR (RETURN-FROM WRITE-CDATA NIL))
    (DO ((LEN (LENGTH STR))
         (I 0 (1+ I)))
        ((= I LEN) STR)
      (DECLARE (FIXNUM I LEN))
      (LET ((C (SCHAR STR I)))
        (CASE C
          (#\< (WRITE-STRING "&lt;" S))
          (#\& (WRITE-STRING "&amp;" S))
          (T (WRITE-CHAR C S))))))

[let-over-lambda/let-over-lambda.lisp:285]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :EXECUTE :LOAD-TOPLEVEL)
    (DEFUN |#`-reader| (STREAM SUB-CHAR NUMARG)
      (DECLARE (IGNORE SUB-CHAR))
      (UNLESS NUMARG (SETQ NUMARG 1))
      (ECLECTOR.READER:QUASIQUOTE
       (LAMBDA
           (ECLECTOR.READER:UNQUOTE
            (LOOP FOR I FROM 1 TO NUMARG COLLECT (SYMB 'A I)))
         (ECLECTOR.READER:UNQUOTE
          (FUNCALL (GET-MACRO-CHARACTER #\`) STREAM NIL)))))
    (DEFUN |#f-reader| (STREAM SUB-CHAR NUMARG)
      (DECLARE (IGNORE STREAM SUB-CHAR))
      (SETQ NUMARG (OR NUMARG 3))
      (UNLESS (<= NUMARG 3) (ERROR "Bad value for #f: ~a" NUMARG))
      (ECLECTOR.READER:QUASIQUOTE
       (DECLARE
        (OPTIMIZE (SPEED (ECLECTOR.READER:UNQUOTE NUMARG))
         (SAFETY (ECLECTOR.READER:UNQUOTE (- 3 NUMARG)))))))
    (DEFREADTABLE LOL-SYNTAX (:MERGE :STANDARD)
     (:DISPATCH-MACRO-CHAR #\# #\" #'|#"-reader|)
     (:DISPATCH-MACRO-CHAR #\# #\> #'|#>-reader|)
     (:DISPATCH-MACRO-CHAR #\# #\~ #'|#~-reader|)
     (:DISPATCH-MACRO-CHAR #\# #\` #'|#`-reader|)
     (:DISPATCH-MACRO-CHAR #\# #\f #'|#f-reader|)))

[let-over-lambda/t/let-over-lambda.lisp:77]
  (DEFTEST SHARP-F-TEST
   (IS ''(DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    "Default numarg SHARP-F expands correctly.")
   (IS ''(DECLARE (OPTIMIZE (SPEED 0) (SAFETY 3)))
    "Numarg = 3 SHARP-F expands correctly.")
   (IS 'NIL
    '((DECLARE (OPTIMIZE (SPEED 1) (SAFETY 2)))
      (DECLARE (OPTIMIZE (SPEED 2) (SAFETY 1))))
    "SHARP-F correctly expands into rarely used compiler options."))

[lift/dev/measuring.lisp:3]
  (EVAL-WHEN (:COMPILE-TOPLEVEL) (DECLAIM (OPTIMIZE (SPEED 3) (SAFETY 1))))

[lift/dev/prototypes.lisp:213]
  (DEFMETHOD PROTOTYPE-EXISTS-P (THING)
    (HANDLER-CASE
     (LET ((CREATOR-METHOD
            (COMPUTE-APPLICABLE-METHODS #'PROTOTYPE-OF (LIST THING))))
       (WHEN CREATOR-METHOD
         (LET ((X (PROTOTYPE-OF THING)))
           (DECLARE (OPTIMIZE (SAFETY 3) (DEBUG 3) (SPEED 0) (SPACE 0)))
           X
           (VALUES T))))
     (ERROR (C) (INSPECT C) NIL)))

[linear-programming/src/simplex.lisp:337]
  (DEFUN N-PIVOT-ROW (TABLEAU ENTERING-COL CHANGING-ROW)
    "Destructively applies a single pivot to the table."
    (DECLARE (OPTIMIZE (SPEED 3))
             (TYPE FIXNUM ENTERING-COL CHANGING-ROW))
    (LET* ((MATRIX (TABLEAU-MATRIX TABLEAU))
           (ROW-COUNT (ARRAY-DIMENSION MATRIX 0))
           (COL-COUNT (ARRAY-DIMENSION MATRIX 1)))
      (LET ((ROW-SCALE (AREF MATRIX CHANGING-ROW ENTERING-COL)))
        (ITER
         (DECLARE (ITERATE:DECLARE-VARIABLES)
                  (OPTIMIZE (SPEED 3) (SAFETY 0)))
         (FOR (THE FIXNUM C) FROM 0 BELOW COL-COUNT)
         (SETF (AREF MATRIX CHANGING-ROW C)
                 (/ (AREF MATRIX CHANGING-ROW C) ROW-SCALE))))
      (ITER
       (DECLARE (ITERATE:DECLARE-VARIABLES)
                (OPTIMIZE (SPEED 3) (SAFETY 0)))
       (FOR (THE FIXNUM R) FROM 0 BELOW ROW-COUNT)
       (UNLESS (= R CHANGING-ROW)
         (LET ((SCALE (AREF MATRIX R ENTERING-COL)))
           (ITER
            (DECLARE (ITERATE:DECLARE-VARIABLES)
                     (OPTIMIZE (SPEED 3) (SAFETY 0)))
            (FOR (THE FIXNUM C) FROM 0 BELOW COL-COUNT)
            (DECF (AREF MATRIX R C)
                  (* SCALE (AREF MATRIX CHANGING-ROW C))))))))
    (SETF (AREF (TABLEAU-BASIS-COLUMNS TABLEAU) CHANGING-ROW) ENTERING-COL)
    TABLEAU)

[lisp-interface-library/pure/fmim-implementation.lisp:20]
  (DEFUN TRIE-CHECK-INVARIANT (TRIE POSITION KEY)
    (DECLARE (OPTIMIZE (SPEED 1) (SAFETY 3) (DEBUG 3)))
    (CHECK-TYPE POSITION (UNSIGNED-BYTE))
    (CHECK-TYPE KEY (UNSIGNED-BYTE))
    (ASSERT (ZEROP (LDB (BYTE POSITION 0) KEY)))
    (UNLESS (ZEROP POSITION)
      (ETYPECASE TRIE
        (TRIE-SKIP
         (LET ((PBITS (NODE-PREFIX-BITS TRIE)) (PLEN (NODE-PREFIX-LENGTH TRIE)))
           (CHECK-TYPE PBITS (UNSIGNED-BYTE))
           (CHECK-TYPE PLEN (INTEGER 1 *))
           (ASSERT (<= (INTEGER-LENGTH PBITS) PLEN))
           (ASSERT (<= PLEN POSITION))
           (LET ((POS (- POSITION PLEN)))
             (TRIE-CHECK-INVARIANT (BOX-REF TRIE) POS
              (DPB PBITS (BYTE PLEN POS) KEY)))))
        (TRIE-BRANCH
         (LET ((POS (1- POSITION)))
           (TRIE-CHECK-INVARIANT (LEFT TRIE) POS KEY)
           (TRIE-CHECK-INVARIANT (RIGHT TRIE) POS (DPB 1 (BYTE 1 POS) KEY))))))
    (VALUES))

[lisp-interface-library/transform/classify.lisp:14]
  (DECLAIM (OPTIMIZE (SPEED 1) (SAFETY 3) (DEBUG 3)))

[lisp-interface-library/transform/classify.lisp:18]
  (DEFMACRO DEFINE-CLASSIFIED-METHOD
            (CLASS INTERFACE CLASS-GF INTERFACE-GF
             &KEY INTERFACE-ARGUMENT
             (EXTRACT-INTERFACE (FIRST (ENSURE-LIST INTERFACE-ARGUMENT)))
             (INTERFACE-KEYWORD :INTERFACE) (VALUE-KEYWORD :VALUE)
             (WRAP
              (ECLECTOR.READER:QUASIQUOTE
               (MAKE-INSTANCE '(ECLECTOR.READER:UNQUOTE CLASS))))
             (UNWRAP (ECLECTOR.READER:QUASIQUOTE (BOX-REF))) (GENERICP T))
    (DECLARE (OPTIMIZE (SPEED 1) (SAFETY 3) (DEBUG 3)))
    (NEST
     (LET* ((GF-OPTIONS (INTERFACE-GF-OPTIONS INTERFACE INTERFACE-GF))
            (LAMBDA-LIST (GETF GF-OPTIONS :LAMBDA-LIST))
            (RESULTS (GETF GF-OPTIONS :VALUES))
            (EFFECTS (GETF GF-OPTIONS :EFFECTS)))
       (ASSERT GF-OPTIONS)
       (ASSERT LAMBDA-LIST))
     (WHEN EFFECTS)
     (MULTIPLE-VALUE-BIND
         (CLASS-LAMBDA-LIST CLASS-IGNORABLES CLASS-INVOKER CLASS-ARGUMENTS
          CLASS-MAPPINGS)
         (LAMBDA-LIST-MIMICKER LAMBDA-LIST)
       (DECLARE (IGNORE CLASS-INVOKER CLASS-ARGUMENTS CLASS-MAPPINGS)))
     (MULTIPLE-VALUE-BIND
         (INTERFACE-LAMBDA-LIST INTERFACE-IGNORABLES INTERFACE-INVOKER
          INTERFACE-ARGUMENTS INTERFACE-MAPPINGS)
         (LAMBDA-LIST-MIMICKER LAMBDA-LIST T)
       (DECLARE (IGNORE INTERFACE-IGNORABLES INTERFACE-MAPPINGS)))
     (MULTIPLE-VALUE-BIND
         (CLASS-REQUIRED CLASS-OPTIONALS CLASS-REST CLASS-KEYS
          CLASS-ALLOW-OTHER-KEYS CLASS-AUX)
         (ALEXANDRIA:PARSE-ORDINARY-LAMBDA-LIST CLASS-LAMBDA-LIST)
       (DECLARE (IGNORE CLASS-KEYS CLASS-ALLOW-OTHER-KEYS CLASS-AUX)))
     (MULTIPLE-VALUE-BIND
         (INTERFACE-REQUIRED INTERFACE-OPTIONALS INTERFACE-REST INTERFACE-KEYS
          INTERFACE-ALLOW-OTHER-KEYS INTERFACE-AUX)
         (ALEXANDRIA:PARSE-ORDINARY-LAMBDA-LIST INTERFACE-LAMBDA-LIST)
       (DECLARE
        (IGNORE INTERFACE-KEYS INTERFACE-ALLOW-OTHER-KEYS INTERFACE-AUX)))
     (MULTIPLE-VALUE-BIND
         (INTERFACE-RESULTS-LAMBDA-LIST INTERFACE-RESULTS-IGNORABLES
          INTERFACE-RESULTS-INVOKER INTERFACE-RESULTS-ARGUMENTS
          INTERFACE-RESULTS-MAPPINGS)
         (LAMBDA-LIST-MIMICKER RESULTS T)
       (DECLARE
        (IGNORE INTERFACE-RESULTS-INVOKER INTERFACE-RESULTS-ARGUMENTS
         INTERFACE-RESULTS-MAPPINGS)))
     (MULTIPLE-VALUE-BIND
         (CLASS-RESULTS-LAMBDA-LIST CLASS-RESULTS-IGNORABLES
          CLASS-RESULTS-INVOKER CLASS-RESULTS-ARGUMENTS CLASS-RESULTS-MAPPINGS)
         (LAMBDA-LIST-MIMICKER RESULTS T)
       (DECLARE (IGNORE CLASS-RESULTS-IGNORABLES CLASS-RESULTS-MAPPINGS)))
     (MULTIPLE-VALUE-BIND
         (INTERFACE-RESULTS-REQUIRED INTERFACE-RESULTS-OPTIONALS
          INTERFACE-RESULTS-REST INTERFACE-RESULTS-KEYS
          INTERFACE-RESULTS-ALLOW-OTHER-KEYS INTERFACE-RESULTS-AUX)
         (ALEXANDRIA:PARSE-ORDINARY-LAMBDA-LIST INTERFACE-RESULTS-LAMBDA-LIST)
       (DECLARE
        (IGNORE INTERFACE-RESULTS-KEYS INTERFACE-RESULTS-ALLOW-OTHER-KEYS
         INTERFACE-RESULTS-AUX)))
     (MULTIPLE-VALUE-BIND
         (CLASS-RESULTS-REQUIRED CLASS-RESULTS-OPTIONALS CLASS-RESULTS-REST
          CLASS-RESULTS-KEYS CLASS-RESULTS-ALLOW-OTHER-KEYS CLASS-RESULTS-AUX)
         (ALEXANDRIA:PARSE-ORDINARY-LAMBDA-LIST CLASS-RESULTS-LAMBDA-LIST)
       (DECLARE
        (IGNORE CLASS-RESULTS-KEYS CLASS-RESULTS-ALLOW-OTHER-KEYS
         CLASS-RESULTS-AUX)))
     (LET ((FIRST-OBJECT-INDEX
            (FIRST (FIND-IF #'INTEGERP EFFECTS :KEY 'CAR)))))
     (MULTIPLE-VALUE-BIND (EXTRA-ARGUMENTS INTERFACE-EXPRESSION)
         (IF FIRST-OBJECT-INDEX
             (VALUES NIL
                     (ECLECTOR.READER:QUASIQUOTE
                      (CLASS-INTERFACE
                       (ECLECTOR.READER:UNQUOTE
                        (NTH FIRST-OBJECT-INDEX CLASS-REQUIRED)))))
             (VALUES
              (WHEN INTERFACE-ARGUMENT
                (ECLECTOR.READER:QUASIQUOTE
                 ((ECLECTOR.READER:UNQUOTE INTERFACE-ARGUMENT))))
              EXTRACT-INTERFACE))
       (ASSERT INTERFACE-EXPRESSION))
     (LET ((INTERFACE-VAR (FIRST INTERFACE-REQUIRED))
           (LIN (LENGTH INTERFACE-REQUIRED))
           (LCIN (LENGTH CLASS-REQUIRED))
           (LOUT (LENGTH INTERFACE-RESULTS-REQUIRED))
           (LCOUT (LENGTH CLASS-RESULTS-REQUIRED)))
       (ASSERT (PLUSP LIN))
       (ASSERT (= LIN LCIN))
       (ASSERT (= LOUT LCOUT))
       (ASSERT (= (LENGTH INTERFACE-OPTIONALS) (LENGTH CLASS-OPTIONALS)))
       (ASSERT (EQ (AND INTERFACE-REST T) (AND CLASS-REST T))))
     (LOOP :FOR (IN OUT) :IN EFFECTS
           :WHEN (INTEGERP IN)
           :COLLECT (LIST IN OUT) :INTO EFFECTIVE-INPUTS
           :END
           :WHEN (INTEGERP OUT)
           :COLLECT (LIST OUT IN) :INTO EFFECTIVE-OUTPUTS
           :END
           :FINALLY)
     (RETURN)
     (LET* ((REQUIRED-INPUT-BINDINGS
             (LOOP :FOR (IN NIL) :IN EFFECTIVE-INPUTS
                   :FOR SIV = (NTH IN CLASS-REQUIRED)
                   :FOR PIV = (NTH IN INTERFACE-REQUIRED)
                   :COLLECT (ECLECTOR.READER:QUASIQUOTE
                             ((ECLECTOR.READER:UNQUOTE PIV)
                              ((ECLECTOR.READER:UNQUOTE-SPLICING UNWRAP)
                               (ECLECTOR.READER:UNQUOTE SIV))))))
            (REQUIRED-OUTPUT-BINDINGS
             (LOOP :FOR (OUT NIL) :IN EFFECTIVE-OUTPUTS
                   :FOR EIOR = (NTH OUT INTERFACE-RESULTS-REQUIRED)
                   :COLLECT (ECLECTOR.READER:QUASIQUOTE
                             ((ECLECTOR.READER:UNQUOTE
                               (NTH OUT CLASS-RESULTS-REQUIRED))
                              ((ECLECTOR.READER:UNQUOTE-SPLICING WRAP)
                               (ECLECTOR.READER:UNQUOTE-SPLICING
                                (WHEN INTERFACE-KEYWORD
                                  (ECLECTOR.READER:QUASIQUOTE
                                   ((ECLECTOR.READER:UNQUOTE INTERFACE-KEYWORD)
                                    (ECLECTOR.READER:UNQUOTE INTERFACE-VAR)))))
                               (ECLECTOR.READER:UNQUOTE-SPLICING
                                (WHEN VALUE-KEYWORD
                                  (ECLECTOR.READER:QUASIQUOTE
                                   ((ECLECTOR.READER:UNQUOTE VALUE-KEYWORD)))))
                               (ECLECTOR.READER:UNQUOTE EIOR))))))
            (INEFFECTIVE-CLASS-INPUTS
             (LOOP :FOR I :FROM 1 :BELOW LIN
                   :FOR V :IN (REST CLASS-REQUIRED)
                   :UNLESS (FIND I EFFECTIVE-INPUTS :KEY 'FIRST)
                   :COLLECT V))
            (INEFFECTIVE-INTERFACE-INPUTS
             (LOOP :FOR I :FROM 1 :BELOW LIN
                   :FOR V :IN (REST INTERFACE-REQUIRED)
                   :UNLESS (FIND I EFFECTIVE-INPUTS :KEY 'FIRST)
                   :COLLECT V))
            (INEFFECTIVE-CLASS-OUTPUTS
             (LOOP :FOR I :BELOW LOUT
                   :FOR V :IN CLASS-RESULTS-REQUIRED
                   :UNLESS (FIND I EFFECTIVE-OUTPUTS :KEY 'FIRST)
                   :COLLECT V))
            (INEFFECTIVE-INTERFACE-OUTPUTS
             (LOOP :FOR I :BELOW LOUT
                   :FOR V :IN INTERFACE-RESULTS-REQUIRED
                   :UNLESS (FIND I EFFECTIVE-OUTPUTS :KEY 'FIRST)
                   :COLLECT V))
            (INTERFACE-ARGUMENT-BINDINGS
             (APPEND
              (ECLECTOR.READER:QUASIQUOTE
               (((ECLECTOR.READER:UNQUOTE INTERFACE-VAR)
                 (ECLECTOR.READER:UNQUOTE INTERFACE-EXPRESSION))))
              REQUIRED-INPUT-BINDINGS
              (LOOP :FOR III :IN INEFFECTIVE-INTERFACE-INPUTS
                    :FOR ICI :IN INEFFECTIVE-CLASS-INPUTS
                    :COLLECT (ECLECTOR.READER:QUASIQUOTE
                              ((ECLECTOR.READER:UNQUOTE III)
                               (ECLECTOR.READER:UNQUOTE ICI))))
              (LOOP :FOR (IO NIL IOP) :IN INTERFACE-OPTIONALS
                    :FOR (CO NIL COP) :IN CLASS-OPTIONALS
                    :APPEND (ECLECTOR.READER:QUASIQUOTE
                             (((ECLECTOR.READER:UNQUOTE IO)
                               (ECLECTOR.READER:UNQUOTE CO))
                              ((ECLECTOR.READER:UNQUOTE IOP)
                               (ECLECTOR.READER:UNQUOTE COP)))))
              (WHEN INTERFACE-REST
                (ECLECTOR.READER:QUASIQUOTE
                 (((ECLECTOR.READER:UNQUOTE INTERFACE-REST)
                   (ECLECTOR.READER:UNQUOTE CLASS-REST)))))))
            (CLASS-RESULTS-BINDINGS
             (APPEND REQUIRED-OUTPUT-BINDINGS
                     (LOOP :FOR IIO :IN INEFFECTIVE-INTERFACE-OUTPUTS
                           :FOR ICO :IN INEFFECTIVE-CLASS-OUTPUTS
                           :COLLECT (ECLECTOR.READER:QUASIQUOTE
                                     ((ECLECTOR.READER:UNQUOTE ICO)
                                      (ECLECTOR.READER:UNQUOTE IIO))))
                     (LOOP :FOR (IRO NIL IROP) :IN INTERFACE-RESULTS-OPTIONALS
                           :FOR (CRO NIL CROP) :IN CLASS-RESULTS-OPTIONALS
                           :APPEND (ECLECTOR.READER:QUASIQUOTE
                                    (((ECLECTOR.READER:UNQUOTE CRO)
                                      (ECLECTOR.READER:UNQUOTE IRO))
                                     ((ECLECTOR.READER:UNQUOTE CROP)
                                      (ECLECTOR.READER:UNQUOTE IROP)))))
                     (WHEN CLASS-RESULTS-REST
                       (ECLECTOR.READER:QUASIQUOTE
                        (((ECLECTOR.READER:UNQUOTE CLASS-RESULTS-REST)
                          (ECLECTOR.READER:UNQUOTE
                           INTERFACE-RESULTS-REST)))))))))
     (ECLECTOR.READER:QUASIQUOTE
      ((ECLECTOR.READER:UNQUOTE
        (IF GENERICP
            'DEFMETHOD
            'DEFUN))
       (ECLECTOR.READER:UNQUOTE CLASS-GF)
       ((ECLECTOR.READER:UNQUOTE-SPLICING EXTRA-ARGUMENTS)
        (ECLECTOR.READER:UNQUOTE-SPLICING
         (IF GENERICP
             (LOOP :FOR X :IN (REST CLASS-LAMBDA-LIST)
                   :FOR I :FROM 1
                   :COLLECT (IF (FIND I EFFECTIVE-INPUTS :KEY 'FIRST)
                                (ECLECTOR.READER:QUASIQUOTE
                                 ((ECLECTOR.READER:UNQUOTE X)
                                  (ECLECTOR.READER:UNQUOTE CLASS)))
                                X))
             (REST CLASS-LAMBDA-LIST))))
       (DECLARE (IGNORE (ECLECTOR.READER:UNQUOTE-SPLICING CLASS-IGNORABLES)))
       (LET* ((ECLECTOR.READER:UNQUOTE-SPLICING INTERFACE-ARGUMENT-BINDINGS))
         (MULTIPLE-VALUE-BIND
             ((ECLECTOR.READER:UNQUOTE-SPLICING INTERFACE-RESULTS-LAMBDA-LIST))
             ((ECLECTOR.READER:UNQUOTE INTERFACE-INVOKER)
              '(ECLECTOR.READER:UNQUOTE INTERFACE-GF)
              (ECLECTOR.READER:UNQUOTE INTERFACE-VAR)
              (ECLECTOR.READER:UNQUOTE-SPLICING (REST INTERFACE-ARGUMENTS)))
           (LET* ((ECLECTOR.READER:UNQUOTE-SPLICING CLASS-RESULTS-BINDINGS))
             ((ECLECTOR.READER:UNQUOTE CLASS-RESULTS-INVOKER) #'VALUES
              (ECLECTOR.READER:UNQUOTE-SPLICING CLASS-RESULTS-ARGUMENTS)))))))))

[lisp-interface-library/transform/linearize.lisp:14]
  (DECLAIM (OPTIMIZE (SPEED 1) (SAFETY 3) (DEBUG 3)))

[lisp-interface-library/transform/mutating-map.lisp:15]
  (DECLAIM (OPTIMIZE (SPEED 1) (SAFETY 3) (DEBUG 3)))

[lisp-interface-library/transform/mutating.lisp:14]
  (DECLAIM (OPTIMIZE (SPEED 1) (SAFETY 3) (DEBUG 3)))

[lispbuilder/lispbuilder-sdl-gfx/examples/metaballs.lisp:78]
  (DEFUN SET-RADIUS (MBALL STRENGTH IVAL)
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (SPACE 1))
             (TYPE FIXNUM STRENGTH)
             (TYPE FLOAT IVAL))
    (SETF (METABALL-R MBALL)
            (#S(FORMGREP:SYMREF :NAME "CAST" :QUALIFIER "SDL") FLOAT
             (SQRT (/ STRENGTH IVAL))))
    (SETF (METABALL-SQR MBALL)
            (#S(FORMGREP:SYMREF :NAME "CAST" :QUALIFIER "SDL") FLOAT
             (/ (METABALL-R MBALL) (/ 256 64)))))

[lispbuilder/lispbuilder-sdl-gfx/examples/metaballs.lisp:86]
  (DEFUN SET-STRENGTH (MBALL S)
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (SPACE 1))
             (TYPE FIXNUM S))
    (SETF (METABALL-STRENGTH MBALL) S)
    (SET-RADIUS MBALL (METABALL-STRENGTH MBALL) (METABALL-ISO-VALUE MBALL)))

[lispbuilder/lispbuilder-sdl-gfx/examples/metaballs.lisp:92]
  (DEFUN SET-CENTER-TO (MBALL X Y)
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (SPACE 1))
             (TYPE FIXNUM X Y))
    (SETF (METABALL-CENTER-X MBALL) X
          (METABALL-CENTER-Y MBALL) Y))

[lispbuilder/lispbuilder-sdl-gfx/examples/metaballs.lisp:98]
  (DEFUN GET-FIELD-AT (MBALL X Y)
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (SPACE 1))
             (TYPE FIXNUM X Y))
    (LET ((DX (- (METABALL-CENTER-X MBALL) X))
          (DY (- (METABALL-CENTER-Y MBALL) Y)))
      (DECLARE (TYPE FIXNUM DX DY))
      (#S(FORMGREP:SYMREF :NAME "CAST" :QUALIFIER "SDL") FLOAT
       (/ (METABALL-STRENGTH MBALL) (+ (* DX DX) (* DY DY) 0.01)))))

[lispbuilder/lispbuilder-sdl-gfx/examples/metaballs.lisp:107]
  (DEFUN SQUARE-COORDS (MBALL X Y)
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (SPACE 1))
             (TYPE FIXNUM X Y))
    (SETF (METABALL-CENTER-I MBALL)
            (#S(FORMGREP:SYMREF :NAME "CAST" :QUALIFIER "SDL") FLOAT
             (COERCE (/ (METABALL-CENTER-X MBALL) X) 'FLOAT)))
    (SETF (METABALL-CENTER-J MBALL)
            (#S(FORMGREP:SYMREF :NAME "CAST" :QUALIFIER "SDL") FLOAT
             (COERCE (/ (METABALL-CENTER-Y MBALL) Y) 'FLOAT))))

[lispbuilder/lispbuilder-sdl-gfx/examples/metaballs.lisp:115]
  (DEFUN GET-SQUARE-COORDS-I (MBALL X Y)
    (DECLARE (IGNORE Y))
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (SPACE 1))
             (TYPE FIXNUM X Y))
    (SETF (METABALL-CENTER-I MBALL)
            (#S(FORMGREP:SYMREF :NAME "CAST" :QUALIFIER "SDL") FLOAT
             (COERCE (/ (METABALL-CENTER-X MBALL) X) 'FLOAT))))

[lispbuilder/lispbuilder-sdl-gfx/examples/metaballs.lisp:122]
  (DEFUN GET-SQUARE-COORDS-J (MBALL X Y)
    (DECLARE (IGNORE X))
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (SPACE 1))
             (TYPE FIXNUM X Y))
    (SETF (METABALL-CENTER-J MBALL)
            (#S(FORMGREP:SYMREF :NAME "CAST" :QUALIFIER "SDL") FLOAT
             (COERCE (/ (METABALL-CENTER-Y MBALL) Y) 'FLOAT))))

[lispbuilder/lispbuilder-sdl-gfx/examples/metaballs.lisp:129]
  (DEFUN NEW-METABALL (ISO-V &KEY (CX 0) (CY 0) STRENGTH)
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (SPACE 1))
             (TYPE FLOAT ISO-V)
             (TYPE FIXNUM CX CY STRENGTH))
    (LET ((MBALL
           (MAKE-METABALL :STRENGTH 30000 :ISO-VALUE ISO-V :CENTER-X CX
            :CENTER-Y CY)))
      (SET-RADIUS MBALL 30000 ISO-V)
      (SET-STRENGTH MBALL STRENGTH)
      MBALL))

[lispbuilder/lispbuilder-sdl-gfx/examples/metaballs.lisp:138]
  (DEFUN INIT-META-GRID (GRID COL ROW)
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (SPACE 1))
             (TYPE FIXNUM ROW COL))
    (DOTIMES (J ROW) (DOTIMES (I COL) (SETF (AREF GRID I J) 0))))

[lispbuilder/lispbuilder-sdl-gfx/examples/metaballs.lisp:145]
  (DEFUN DRAW-GRID (COL ROW X-RESOLUTION Y-RESOLUTION COLOR SURFACE)
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (SPACE 1))
             (TYPE FIXNUM COL ROW X-RESOLUTION Y-RESOLUTION)
             (TYPE VECTOR COLOR))
    (LOOP FOR X FROM 0 TO COL
          FOR X-POS = (* X X-RESOLUTION)
          DO (#S(FORMGREP:SYMREF :NAME "DRAW-VLINE" :QUALIFIER "SDL-GFX") X-POS
              0 (* Y-RESOLUTION ROW) :SURFACE SURFACE :COLOR COLOR))
    (LOOP FOR Y FROM 0 TO ROW
          FOR Y-POS = (* Y Y-RESOLUTION)
          DO (#S(FORMGREP:SYMREF :NAME "DRAW-HLINE" :QUALIFIER "SDL-GFX") 0
              (* X-RESOLUTION COL) Y-POS :SURFACE SURFACE :COLOR COLOR)))

[lispbuilder/lispbuilder-sdl-gfx/examples/metaballs.lisp:160]
  (DEFUN DRAW-META-CENTER (MANAGER META-BALLS COLOR SURFACE)
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (SPACE 1)))
    (LET ((I 0.0)
          (J 0.0)
          (X-RESOLUTION (MMANAGER-X-RES MANAGER))
          (Y-RESOLUTION (MMANAGER-Y-RES MANAGER)))
      (DECLARE (TYPE FLOAT I J)
               (TYPE FIXNUM X-RESOLUTION Y-RESOLUTION))
      (DOLIST (METABALL META-BALLS)
        (WHEN
            (AND (>= (METABALL-CENTER-X METABALL) 0)
                 (< (METABALL-CENTER-X METABALL)
                    (MMANAGER-SCREEN-WIDTH MANAGER))
                 (>= (METABALL-CENTER-Y METABALL) 0)
                 (< (METABALL-CENTER-Y METABALL)
                    (MMANAGER-SCREEN-HEIGHT MANAGER)))
          (SETF I (GET-SQUARE-COORDS-I METABALL X-RESOLUTION Y-RESOLUTION))
          (SETF J (GET-SQUARE-COORDS-J METABALL X-RESOLUTION Y-RESOLUTION))
          (#S(FORMGREP:SYMREF :NAME "DRAW-LINE" :QUALIFIER "SDL-GFX")
           (#S(FORMGREP:SYMREF :NAME "POINT" :QUALIFIER "SDL") :X
            (#S(FORMGREP:SYMREF :NAME "CAST-TO-INT" :QUALIFIER "SDL")
             (* I X-RESOLUTION))
            :Y
            (#S(FORMGREP:SYMREF :NAME "CAST-TO-INT" :QUALIFIER "SDL")
             (* J Y-RESOLUTION)))
           (#S(FORMGREP:SYMREF :NAME "POINT" :QUALIFIER "SDL") :X
            (#S(FORMGREP:SYMREF :NAME "CAST-TO-INT" :QUALIFIER "SDL")
             (* (+ I 1) X-RESOLUTION))
            :Y
            (#S(FORMGREP:SYMREF :NAME "CAST-TO-INT" :QUALIFIER "SDL")
             (* (+ J 1) Y-RESOLUTION)))
           :SURFACE SURFACE :COLOR COLOR)
          (#S(FORMGREP:SYMREF :NAME "DRAW-LINE" :QUALIFIER "SDL-GFX")
           (#S(FORMGREP:SYMREF :NAME "POINT" :QUALIFIER "SDL") :X
            (#S(FORMGREP:SYMREF :NAME "CAST-TO-INT" :QUALIFIER "SDL")
             (* (+ I 1) X-RESOLUTION))
            :Y
            (#S(FORMGREP:SYMREF :NAME "CAST-TO-INT" :QUALIFIER "SDL")
             (* J Y-RESOLUTION)))
           (#S(FORMGREP:SYMREF :NAME "POINT" :QUALIFIER "SDL") :X
            (#S(FORMGREP:SYMREF :NAME "CAST-TO-INT" :QUALIFIER "SDL")
             (* I X-RESOLUTION))
            :Y
            (#S(FORMGREP:SYMREF :NAME "CAST-TO-INT" :QUALIFIER "SDL")
             (* (+ J 1) Y-RESOLUTION)))
           :SURFACE SURFACE :COLOR COLOR)))))

[lispbuilder/lispbuilder-sdl-gfx/examples/metaballs.lisp:199]
  (DEFUN RENDER-LOOP (MANAGER META-BALLS COLOR SURFACE)
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (SPACE 1)))
    (SETF (MMANAGER-VISCOSITY MANAGER)
            (#S(FORMGREP:SYMREF :NAME "CAST" :QUALIFIER "SDL") FLOAT
             (+ (* 0.5 (MMANAGER-D-VISCOSITY MANAGER))
                (MMANAGER-MIN-VISCOSITY MANAGER))))
    (LET ((GRID-SIZE-Y (MMANAGER-GRID-SIZE-Y MANAGER))
          (GRID-SIZE-X (MMANAGER-GRID-SIZE-X MANAGER))
          (X-RESOLUTION (MMANAGER-X-RES MANAGER))
          (Y-RESOLUTION (MMANAGER-Y-RES MANAGER))
          (ISO-VALUE (MMANAGER-ISO-VALUE MANAGER))
          (VISCOSITY (MMANAGER-VISCOSITY MANAGER))
          (SQUARE-FLAG (MMANAGER-SQUARE-FLAG MANAGER))
          (META-GRID (MMANAGER-META-GRID MANAGER))
          (OFFSET (MMANAGER-OFFSET MANAGER))
          (LINE (MMANAGER-LINE MANAGER))
          (SQUARE-EDGE (MMANAGER-SQUARE-EDGE MANAGER)))
      (DECLARE (TYPE FIXNUM GRID-SIZE-Y GRID-SIZE-X X-RESOLUTION Y-RESOLUTION)
               (TYPE FLOAT ISO-VALUE VISCOSITY)
               (TYPE (ARRAY FIXNUM *) SQUARE-FLAG OFFSET LINE SQUARE-EDGE)
               (TYPE (ARRAY FLOAT *) META-GRID))
      (LOOP FOR Y FROM 0 BELOW GRID-SIZE-Y
            DO (LOOP FOR X FROM 0 BELOW GRID-SIZE-X
                     DO (LET ((META-GRID-TARGET 0.0))
                          (DECLARE (TYPE FLOAT META-GRID-TARGET))
                          (SETF (AREF SQUARE-FLAG X Y) 0)
                          (DOLIST (META-BALL META-BALLS)
                            (INCF META-GRID-TARGET
                                  (GET-FIELD-AT META-BALL (* X-RESOLUTION X)
                                   (* Y-RESOLUTION Y))))
                          (INCF (AREF META-GRID X Y)
                                (#S(FORMGREP:SYMREF
                                    :NAME "CAST"
                                    :QUALIFIER "SDL")
                                 FLOAT
                                 (/ (- META-GRID-TARGET (AREF META-GRID X Y))
                                    VISCOSITY))))))
      (LET ((SCAN-IMIN 0)
            (SCAN-IMAX (MMANAGER-X-SQUARES MANAGER))
            (SCAN-JMIN 0)
            (SCAN-JMAX (MMANAGER-Y-SQUARES MANAGER)))
        (DECLARE (TYPE FIXNUM SCAN-IMIN SCAN-IMAX SCAN-JMIN SCAN-JMAX))
        (LOOP FOR J FROM SCAN-JMIN BELOW SCAN-JMAX
              DO (LOOP FOR I FROM SCAN-IMIN BELOW SCAN-IMAX
                       DO (LET ((SQUARE-IDX 0)
                                (VAL1 0.0)
                                (VAL2 0.0)
                                (TEMP 0.0)
                                (ISO-P1-X 0)
                                (ISO-P1-Y 0)
                                (ISO-P2-X 0)
                                (ISO-P2-Y 0)
                                (P1-IDX 0)
                                (P2-IDX 0))
                            (DECLARE
                             (TYPE FIXNUM ISO-P1-X ISO-P1-Y ISO-P2-X ISO-P2-Y
                              P1-IDX P2-IDX)
                             (TYPE FLOAT TEMP VAL1 VAL1))
                            (UNLESS (= (AREF SQUARE-FLAG I J) 1)
                              (WHEN (< (AREF META-GRID I J) ISO-VALUE)
                                (SETF SQUARE-IDX (LOGIOR SQUARE-IDX 1)))
                              (WHEN (< (AREF META-GRID (+ I 1) J) ISO-VALUE)
                                (SETF SQUARE-IDX (LOGIOR SQUARE-IDX 2)))
                              (WHEN
                                  (< (AREF META-GRID (+ I 1) (+ J 1))
                                     ISO-VALUE)
                                (SETF SQUARE-IDX (LOGIOR SQUARE-IDX 4)))
                              (WHEN (< (AREF META-GRID I (+ J 1)) ISO-VALUE)
                                (SETF SQUARE-IDX (LOGIOR SQUARE-IDX 8)))
                              (UNLESS (OR (= SQUARE-IDX 0) (= SQUARE-IDX 15))
                                (LET ((N 0) (EDGE-1-IDX 0) (EDGE-2-IDX 0))
                                  (DECLARE
                                   (TYPE FIXNUM N EDGE-1-IDX EDGE-2-IDX))
                                  (DO ()
                                      ((= -1 (AREF LINE SQUARE-IDX N)))
                                    (SETF EDGE-1-IDX (AREF LINE SQUARE-IDX N))
                                    (INCF N)
                                    (SETF EDGE-2-IDX (AREF LINE SQUARE-IDX N))
                                    (INCF N)
                                    (SETF P1-IDX
                                            (AREF SQUARE-EDGE EDGE-1-IDX 0)
                                          P2-IDX
                                            (AREF SQUARE-EDGE EDGE-1-IDX 1))
                                    (SETF VAL1
                                            (AREF META-GRID
                                                  (+ I (AREF OFFSET P1-IDX 0))
                                                  (+ J (AREF OFFSET P1-IDX 1)))
                                          VAL2
                                            (AREF META-GRID
                                                  (+ I (AREF OFFSET P2-IDX 0))
                                                  (+ J
                                                     (AREF OFFSET P2-IDX 1))))
                                    (IF (NOT (= (- VAL2 VAL1) 0))
                                        (SETF TEMP
                                                (#S(FORMGREP:SYMREF
                                                    :NAME "CAST"
                                                    :QUALIFIER "SDL")
                                                 FLOAT
                                                 (/ (- ISO-VALUE VAL1)
                                                    (- VAL2 VAL1))))
                                        (SETF TEMP 0.5))
                                    (SETF ISO-P1-X
                                            (#S(FORMGREP:SYMREF
                                                :NAME "CAST-TO-INT"
                                                :QUALIFIER "SDL")
                                             (* X-RESOLUTION
                                                (+
                                                 (* TEMP
                                                    (-
                                                     (+ I
                                                        (AREF OFFSET P2-IDX 0))
                                                     (+ I
                                                        (AREF OFFSET P1-IDX
                                                              0))))
                                                 (+ I
                                                    (AREF OFFSET P1-IDX 0))))))
                                    (SETF ISO-P1-Y
                                            (#S(FORMGREP:SYMREF
                                                :NAME "CAST-TO-INT"
                                                :QUALIFIER "SDL")
                                             (* Y-RESOLUTION
                                                (+
                                                 (* TEMP
                                                    (-
                                                     (+ J
                                                        (AREF OFFSET P2-IDX 1))
                                                     (+ J
                                                        (AREF OFFSET P1-IDX
                                                              1))))
                                                 (+ J
                                                    (AREF OFFSET P1-IDX 1))))))
                                    (SETF P1-IDX
                                            (AREF SQUARE-EDGE EDGE-2-IDX 0)
                                          P2-IDX
                                            (AREF SQUARE-EDGE EDGE-2-IDX 1))
                                    (SETF VAL1
                                            (AREF META-GRID
                                                  (+ I (AREF OFFSET P1-IDX 0))
                                                  (+ J (AREF OFFSET P1-IDX 1)))
                                          VAL2
                                            (AREF META-GRID
                                                  (+ I (AREF OFFSET P2-IDX 0))
                                                  (+ J
                                                     (AREF OFFSET P2-IDX 1))))
                                    (IF (NOT (= (- VAL2 VAL1) 0))
                                        (SETF TEMP
                                                (#S(FORMGREP:SYMREF
                                                    :NAME "CAST"
                                                    :QUALIFIER "SDL")
                                                 FLOAT
                                                 (/ (- ISO-VALUE VAL1)
                                                    (- VAL2 VAL1))))
                                        (SETF TEMP 0.5))
                                    (SETF ISO-P2-X
                                            (#S(FORMGREP:SYMREF
                                                :NAME "CAST-TO-INT"
                                                :QUALIFIER "SDL")
                                             (* X-RESOLUTION
                                                (+
                                                 (* TEMP
                                                    (-
                                                     (+ I
                                                        (AREF OFFSET P2-IDX 0))
                                                     (+ I
                                                        (AREF OFFSET P1-IDX
                                                              0))))
                                                 (+ I
                                                    (AREF OFFSET P1-IDX 0))))))
                                    (SETF ISO-P2-Y
                                            (#S(FORMGREP:SYMREF
                                                :NAME "CAST-TO-INT"
                                                :QUALIFIER "SDL")
                                             (* Y-RESOLUTION
                                                (+
                                                 (* TEMP
                                                    (-
                                                     (+ J
                                                        (AREF OFFSET P2-IDX 1))
                                                     (+ J
                                                        (AREF OFFSET P1-IDX
                                                              1))))
                                                 (+ J
                                                    (AREF OFFSET P1-IDX 1))))))
                                    (#S(FORMGREP:SYMREF
                                        :NAME "DRAW-LINE"
                                        :QUALIFIER "SDL-GFX")
                                     (#S(FORMGREP:SYMREF
                                         :NAME "POINT"
                                         :QUALIFIER "SDL")
                                      :X ISO-P1-X :Y ISO-P1-Y)
                                     (#S(FORMGREP:SYMREF
                                         :NAME "POINT"
                                         :QUALIFIER "SDL")
                                      :X ISO-P2-X :Y ISO-P2-Y)
                                     :COLOR COLOR :SURFACE SURFACE)
                                    (SETF (AREF SQUARE-FLAG I J) 1)))))))))))

[lispbuilder/lispbuilder-sdl-gfx/examples/random_circles.lisp:10]
  (LET* ((FRAME-VALUES 600)
         (FRAME-TIMES
          (MAKE-ARRAY FRAME-VALUES :INITIAL-ELEMENT 0 :ELEMENT-TYPE 'FIXNUM))
         (FRAME-TIME-LAST 0)
         (FRAME-COUNT 0))
    (DECLARE (TYPE FIXNUM FRAME-VALUES FRAME-TIME-LAST FRAME-COUNT))
    (DEFUN FPS-INIT ()
      (SETF FRAME-COUNT 0
            FRAME-TIME-LAST
              (#S(FORMGREP:SYMREF :NAME "SDL-GET-TICKS" :QUALIFIER "SDL")))
      (DOTIMES (I FRAME-VALUES) (SETF (AREF FRAME-TIMES I) 0)))
    (DEFUN DISPLAY-FPS (SURFACE)
      (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (SPACE 1)))
      (LET ((GET-TICKS
             (#S(FORMGREP:SYMREF :NAME "SDL-GET-TICKS" :QUALIFIER "SDL")))
            (FRAMES-PER-SECOND 0.0))
        (DECLARE (TYPE FIXNUM GET-TICKS)
                 (TYPE FLOAT FRAMES-PER-SECOND))
        (SETF (AREF FRAME-TIMES FRAME-COUNT) (- GET-TICKS FRAME-TIME-LAST))
        (SETF FRAME-TIME-LAST GET-TICKS)
        (INCF FRAME-COUNT)
        (WHEN (>= FRAME-COUNT FRAME-VALUES)
          (SETF FRAME-COUNT 0)
          (DOTIMES (I FRAME-VALUES)
            (INCF FRAMES-PER-SECOND (AREF FRAME-TIMES I)))
          (SETF FRAMES-PER-SECOND
                  (THE FLOAT (/ 1000 (/ FRAMES-PER-SECOND FRAME-VALUES))))
          (#S(FORMGREP:SYMREF :NAME "FILL-SURFACE" :QUALIFIER "SDL")
           (#S(FORMGREP:SYMREF :NAME "COLOR" :QUALIFIER "SDL")) :SURFACE
           SURFACE :UPDATE-P T)
          (#S(FORMGREP:SYMREF :NAME "DRAW-STRING-*" :QUALIFIER "SDL-GFX")
           (FORMAT NIL "fps : ~d" (COERCE FRAMES-PER-SECOND 'FLOAT)) 0 0
           :SURFACE SURFACE :COLOR
           #S(FORMGREP:SYMREF :NAME "*WHITE*" :QUALIFIER "SDL")))
        SURFACE)))

[lispbuilder/lispbuilder-sdl/examples/mandelbrot.lisp:22]
  (DEFUN UPDATE-MANDELBROT-DRAW (WIDTH HEIGHT SX SY SW SH X0 Y0 X1 Y1)
    "draw mandelbrot from screen position sx,sy to the extent by sw,sh (width height)"
    (DECLARE (TYPE SINGLE-FLOAT X0 Y0 X1 Y1)
             (TYPE FIXNUM WIDTH HEIGHT SX SY SW SH)
             (OPTIMIZE (SAFETY 3) (SPEED 1)))
    (LET ((SURFACE-FP
           (#S(FORMGREP:SYMREF :NAME "FP" :QUALIFIER "SDL")
            #S(FORMGREP:SYMREF :NAME "*DEFAULT-DISPLAY*" :QUALIFIER "SDL"))))
      (#S(FORMGREP:SYMREF :NAME "WITH-PIXEL" :QUALIFIER "SDL") (PIX SURFACE-FP)
       (#S(FORMGREP:SYMREF :NAME "WITH-COLOR" :QUALIFIER "SDL")
        (COL (#S(FORMGREP:SYMREF :NAME "COLOR" :QUALIFIER "SDL")))
        (LOOP FOR Y FROM SY BELOW (+ SY SH)
              DO (LOOP FOR X FROM SX BELOW (+ SX SW)
                       DO (LOOP WITH A = (COMPLEX
                                          (FLOAT
                                           (+ (* (/ (- X1 X0) WIDTH) X) X0))
                                          (FLOAT
                                           (+ (* (/ (- Y1 Y0) HEIGHT) Y) Y0)))
                                FOR Z = A THEN (+ (* Z Z) A)
                                FOR C FROM 60 ABOVE 0
                                WHILE (< (ABS Z) 2)
                                FINALLY (#S(FORMGREP:SYMREF
                                            :NAME "WRITE-PIXEL"
                                            :QUALIFIER "SDL")
                                         PIX X Y
                                         (#S(FORMGREP:SYMREF
                                             :NAME "SDL-MAP-RGB"
                                             :QUALIFIER "SDL-CFFI")
                                          (#S(FORMGREP:SYMREF
                                              :NAME "PIXEL-FORMAT"
                                              :QUALIFIER "SDL-BASE")
                                           SURFACE-FP)
                                          (MOD (* 13 (THE FIXNUM C)) 256)
                                          (MOD (* 7 (THE FIXNUM C)) 256)
                                          (MOD (* 2 (THE FIXNUM C))
                                               256))))))))))

[lispbuilder/lispbuilder-sdl/examples/metaballs.lisp:78]
  (DEFUN SET-RADIUS (MBALL STRENGTH IVAL)
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (SPACE 1))
             (TYPE (AND FIXNUM (INTEGER 0)) STRENGTH)
             (TYPE (REAL 0.0) IVAL))
    (SETF (METABALL-R MBALL)
            (#S(FORMGREP:SYMREF :NAME "CAST" :QUALIFIER "SDL") FLOAT
             (SQRT (/ STRENGTH IVAL))))
    (SETF (METABALL-SQR MBALL)
            (#S(FORMGREP:SYMREF :NAME "CAST" :QUALIFIER "SDL") FLOAT
             (/ (METABALL-R MBALL) (/ 256 64)))))

[lispbuilder/lispbuilder-sdl/examples/metaballs.lisp:86]
  (DEFUN SET-STRENGTH (MBALL S)
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (SPACE 1))
             (TYPE FIXNUM S))
    (SETF (METABALL-STRENGTH MBALL) S)
    (SET-RADIUS MBALL (METABALL-STRENGTH MBALL) (METABALL-ISO-VALUE MBALL)))

[lispbuilder/lispbuilder-sdl/examples/metaballs.lisp:92]
  (DEFUN SET-CENTER-TO (MBALL X Y)
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (SPACE 1))
             (TYPE FIXNUM X Y))
    (SETF (METABALL-CENTER-X MBALL) X
          (METABALL-CENTER-Y MBALL) Y))

[lispbuilder/lispbuilder-sdl/examples/metaballs.lisp:98]
  (DEFUN GET-FIELD-AT (MBALL X Y)
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (SPACE 1))
             (TYPE FIXNUM X Y))
    (LET ((DX (- (METABALL-CENTER-X MBALL) X))
          (DY (- (METABALL-CENTER-Y MBALL) Y)))
      (DECLARE (TYPE FIXNUM DX DY))
      (#S(FORMGREP:SYMREF :NAME "CAST" :QUALIFIER "SDL") FLOAT
       (/ (METABALL-STRENGTH MBALL) (+ (* DX DX) (* DY DY) 0.01)))))

[lispbuilder/lispbuilder-sdl/examples/metaballs.lisp:107]
  (DEFUN SQUARE-COORDS (MBALL X Y)
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (SPACE 1))
             (TYPE FIXNUM X Y))
    (SETF (METABALL-CENTER-I MBALL)
            (#S(FORMGREP:SYMREF :NAME "CAST" :QUALIFIER "SDL") FLOAT
             (COERCE (/ (METABALL-CENTER-X MBALL) X) 'FLOAT)))
    (SETF (METABALL-CENTER-J MBALL)
            (#S(FORMGREP:SYMREF :NAME "CAST" :QUALIFIER "SDL") FLOAT
             (COERCE (/ (METABALL-CENTER-Y MBALL) Y) 'FLOAT))))

[lispbuilder/lispbuilder-sdl/examples/metaballs.lisp:115]
  (DEFUN GET-SQUARE-COORDS-I (MBALL X Y)
    (DECLARE (IGNORE Y))
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (SPACE 1))
             (TYPE FIXNUM X Y))
    (SETF (METABALL-CENTER-I MBALL)
            (#S(FORMGREP:SYMREF :NAME "CAST" :QUALIFIER "SDL") FLOAT
             (COERCE (/ (METABALL-CENTER-X MBALL) X) 'FLOAT))))

[lispbuilder/lispbuilder-sdl/examples/metaballs.lisp:122]
  (DEFUN GET-SQUARE-COORDS-J (MBALL X Y)
    (DECLARE (IGNORE X))
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (SPACE 1))
             (TYPE FIXNUM X Y))
    (SETF (METABALL-CENTER-J MBALL)
            (#S(FORMGREP:SYMREF :NAME "CAST" :QUALIFIER "SDL") FLOAT
             (COERCE (/ (METABALL-CENTER-Y MBALL) Y) 'FLOAT))))

[lispbuilder/lispbuilder-sdl/examples/metaballs.lisp:129]
  (DEFUN NEW-METABALL (ISO-V &KEY (CX 0) (CY 0) STRENGTH)
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (SPACE 1))
             (TYPE FLOAT ISO-V)
             (TYPE FIXNUM CX CY STRENGTH))
    (LET ((MBALL
           (MAKE-METABALL :STRENGTH 30000 :ISO-VALUE ISO-V :CENTER-X CX
            :CENTER-Y CY)))
      (SET-RADIUS MBALL 30000 ISO-V)
      (SET-STRENGTH MBALL STRENGTH)
      MBALL))

[lispbuilder/lispbuilder-sdl/examples/metaballs.lisp:138]
  (DEFUN INIT-META-GRID (GRID COL ROW)
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (SPACE 1))
             (TYPE FIXNUM ROW COL))
    (DOTIMES (J ROW) (DOTIMES (I COL) (SETF (AREF GRID I J) 0))))

[lispbuilder/lispbuilder-sdl/examples/metaballs.lisp:145]
  (DEFUN DRAW-GRID (COL ROW X-RESOLUTION Y-RESOLUTION COLOR SURFACE)
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (SPACE 1))
             (TYPE FIXNUM COL ROW X-RESOLUTION Y-RESOLUTION)
             (TYPE VECTOR COLOR))
    (LOOP FOR X FROM 0 TO COL
          FOR X-POS = (* X X-RESOLUTION)
          DO (#S(FORMGREP:SYMREF :NAME "DRAW-VLINE" :QUALIFIER "SDL") X-POS 0
              (* Y-RESOLUTION ROW) :SURFACE SURFACE :COLOR COLOR))
    (LOOP FOR Y FROM 0 TO ROW
          FOR Y-POS = (* Y Y-RESOLUTION)
          DO (#S(FORMGREP:SYMREF :NAME "DRAW-HLINE" :QUALIFIER "SDL") 0
              (* X-RESOLUTION COL) Y-POS :SURFACE SURFACE :COLOR COLOR)))

[lispbuilder/lispbuilder-sdl/examples/metaballs.lisp:160]
  (DEFUN DRAW-META-CENTER (MANAGER META-BALLS COLOR SURFACE)
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (SPACE 1)))
    (LET ((I 0.0)
          (J 0.0)
          (X-RESOLUTION (MMANAGER-X-RES MANAGER))
          (Y-RESOLUTION (MMANAGER-Y-RES MANAGER)))
      (DECLARE (TYPE FLOAT I J)
               (TYPE FIXNUM X-RESOLUTION Y-RESOLUTION))
      (DOLIST (METABALL META-BALLS)
        (WHEN
            (AND (>= (METABALL-CENTER-X METABALL) 0)
                 (< (METABALL-CENTER-X METABALL)
                    (MMANAGER-SCREEN-WIDTH MANAGER))
                 (>= (METABALL-CENTER-Y METABALL) 0)
                 (< (METABALL-CENTER-Y METABALL)
                    (MMANAGER-SCREEN-HEIGHT MANAGER)))
          (SETF I (GET-SQUARE-COORDS-I METABALL X-RESOLUTION Y-RESOLUTION))
          (SETF J (GET-SQUARE-COORDS-J METABALL X-RESOLUTION Y-RESOLUTION))
          (#S(FORMGREP:SYMREF :NAME "DRAW-LINE-*" :QUALIFIER "SDL")
           (#S(FORMGREP:SYMREF :NAME "CAST-TO-INT" :QUALIFIER "SDL")
            (* I X-RESOLUTION))
           (#S(FORMGREP:SYMREF :NAME "CAST-TO-INT" :QUALIFIER "SDL")
            (* J Y-RESOLUTION))
           (#S(FORMGREP:SYMREF :NAME "CAST-TO-INT" :QUALIFIER "SDL")
            (* (+ I 1) X-RESOLUTION))
           (#S(FORMGREP:SYMREF :NAME "CAST-TO-INT" :QUALIFIER "SDL")
            (* (+ J 1) Y-RESOLUTION))
           :SURFACE SURFACE :COLOR COLOR)
          (#S(FORMGREP:SYMREF :NAME "DRAW-LINE-*" :QUALIFIER "SDL")
           (#S(FORMGREP:SYMREF :NAME "CAST-TO-INT" :QUALIFIER "SDL")
            (* (+ I 1) X-RESOLUTION))
           (#S(FORMGREP:SYMREF :NAME "CAST-TO-INT" :QUALIFIER "SDL")
            (* J Y-RESOLUTION))
           (#S(FORMGREP:SYMREF :NAME "CAST-TO-INT" :QUALIFIER "SDL")
            (* I X-RESOLUTION))
           (#S(FORMGREP:SYMREF :NAME "CAST-TO-INT" :QUALIFIER "SDL")
            (* (+ J 1) Y-RESOLUTION))
           :SURFACE SURFACE :COLOR COLOR)))))

[lispbuilder/lispbuilder-sdl/examples/metaballs.lisp:199]
  (DEFUN RENDER-LOOP (MANAGER META-BALLS COLOR SURFACE)
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3) (SPACE 1)))
    (SETF (MMANAGER-VISCOSITY MANAGER)
            (#S(FORMGREP:SYMREF :NAME "CAST" :QUALIFIER "SDL") FLOAT
             (+ (* 0.5 (MMANAGER-D-VISCOSITY MANAGER))
                (MMANAGER-MIN-VISCOSITY MANAGER))))
    (LET ((GRID-SIZE-Y (MMANAGER-GRID-SIZE-Y MANAGER))
          (GRID-SIZE-X (MMANAGER-GRID-SIZE-X MANAGER))
          (X-RESOLUTION (MMANAGER-X-RES MANAGER))
          (Y-RESOLUTION (MMANAGER-Y-RES MANAGER))
          (ISO-VALUE (MMANAGER-ISO-VALUE MANAGER))
          (VISCOSITY (MMANAGER-VISCOSITY MANAGER))
          (SQUARE-FLAG (MMANAGER-SQUARE-FLAG MANAGER))
          (META-GRID (MMANAGER-META-GRID MANAGER))
          (OFFSET (MMANAGER-OFFSET MANAGER))
          (LINE (MMANAGER-LINE MANAGER))
          (SQUARE-EDGE (MMANAGER-SQUARE-EDGE MANAGER)))
      (DECLARE (TYPE FIXNUM GRID-SIZE-Y GRID-SIZE-X X-RESOLUTION Y-RESOLUTION)
               (TYPE (REAL 0.0) ISO-VALUE VISCOSITY)
               (TYPE (ARRAY FIXNUM *) SQUARE-FLAG OFFSET LINE SQUARE-EDGE)
               (TYPE (ARRAY FLOAT *) META-GRID))
      (LOOP FOR Y FROM 0 BELOW GRID-SIZE-Y
            DO (LOOP FOR X FROM 0 BELOW GRID-SIZE-X
                     DO (LET ((META-GRID-TARGET 0.0))
                          (DECLARE (TYPE FLOAT META-GRID-TARGET))
                          (SETF (AREF SQUARE-FLAG X Y) 0)
                          (DOLIST (META-BALL META-BALLS)
                            (INCF META-GRID-TARGET
                                  (GET-FIELD-AT META-BALL (* X-RESOLUTION X)
                                   (* Y-RESOLUTION Y))))
                          (INCF (AREF META-GRID X Y)
                                (#S(FORMGREP:SYMREF
                                    :NAME "CAST"
                                    :QUALIFIER "SDL")
                                 FLOAT
                                 (/
                                  (- META-GRID-TARGET
                                     (THE FLOAT (AREF META-GRID X Y)))
                                  VISCOSITY))))))
      (LET ((SCAN-IMIN 0)
            (SCAN-IMAX (MMANAGER-X-SQUARES MANAGER))
            (SCAN-JMIN 0)
            (SCAN-JMAX (MMANAGER-Y-SQUARES MANAGER)))
        (DECLARE (TYPE FIXNUM SCAN-IMIN SCAN-IMAX SCAN-JMIN SCAN-JMAX))
        (LOOP FOR J FROM SCAN-JMIN BELOW SCAN-JMAX
              DO (LOOP FOR I FROM SCAN-IMIN BELOW SCAN-IMAX
                       DO (LET ((SQUARE-IDX 0)
                                (VAL1 0.0)
                                (VAL2 0.0)
                                (TEMP 0.0)
                                (ISO-P1-X 0)
                                (ISO-P1-Y 0)
                                (ISO-P2-X 0)
                                (ISO-P2-Y 0)
                                (P1-IDX 0)
                                (P2-IDX 0))
                            (DECLARE
                             (TYPE FIXNUM ISO-P1-X ISO-P1-Y ISO-P2-X ISO-P2-Y
                              P1-IDX P2-IDX)
                             (TYPE FLOAT TEMP VAL1 VAL2))
                            (UNLESS (= (AREF SQUARE-FLAG I J) 1)
                              (WHEN (< (AREF META-GRID I J) ISO-VALUE)
                                (SETF SQUARE-IDX (LOGIOR SQUARE-IDX 1)))
                              (WHEN (< (AREF META-GRID (+ I 1) J) ISO-VALUE)
                                (SETF SQUARE-IDX (LOGIOR SQUARE-IDX 2)))
                              (WHEN
                                  (< (AREF META-GRID (+ I 1) (+ J 1))
                                     ISO-VALUE)
                                (SETF SQUARE-IDX (LOGIOR SQUARE-IDX 4)))
                              (WHEN (< (AREF META-GRID I (+ J 1)) ISO-VALUE)
                                (SETF SQUARE-IDX (LOGIOR SQUARE-IDX 8)))
                              (UNLESS (OR (= SQUARE-IDX 0) (= SQUARE-IDX 15))
                                (LET ((N 0) (EDGE-1-IDX 0) (EDGE-2-IDX 0))
                                  (DECLARE
                                   (TYPE FIXNUM N EDGE-1-IDX EDGE-2-IDX))
                                  (DO ()
                                      ((= -1 (AREF LINE SQUARE-IDX N)))
                                    (SETF EDGE-1-IDX (AREF LINE SQUARE-IDX N))
                                    (INCF N)
                                    (SETF EDGE-2-IDX (AREF LINE SQUARE-IDX N))
                                    (INCF N)
                                    (SETF P1-IDX
                                            (AREF SQUARE-EDGE EDGE-1-IDX 0)
                                          P2-IDX
                                            (AREF SQUARE-EDGE EDGE-1-IDX 1))
                                    (SETF VAL1
                                            (AREF META-GRID
                                                  (+ I (AREF OFFSET P1-IDX 0))
                                                  (+ J (AREF OFFSET P1-IDX 1)))
                                          VAL2
                                            (AREF META-GRID
                                                  (+ I (AREF OFFSET P2-IDX 0))
                                                  (+ J
                                                     (AREF OFFSET P2-IDX 1))))
                                    (IF (NOT (= (- VAL2 VAL1) 0))
                                        (SETF TEMP
                                                (#S(FORMGREP:SYMREF
                                                    :NAME "CAST"
                                                    :QUALIFIER "SDL")
                                                 FLOAT
                                                 (/ (- ISO-VALUE VAL1)
                                                    (- VAL2 VAL1))))
                                        (SETF TEMP 0.5))
                                    (SETF ISO-P1-X
                                            (#S(FORMGREP:SYMREF
                                                :NAME "CAST-TO-INT"
                                                :QUALIFIER "SDL")
                                             (* X-RESOLUTION
                                                (+
                                                 (* TEMP
                                                    (-
                                                     (+ I
                                                        (AREF OFFSET P2-IDX 0))
                                                     (+ I
                                                        (AREF OFFSET P1-IDX
                                                              0))))
                                                 (+ I
                                                    (AREF OFFSET P1-IDX 0))))))
                                    (SETF ISO-P1-Y
                                            (#S(FORMGREP:SYMREF
                                                :NAME "CAST-TO-INT"
                                                :QUALIFIER "SDL")
                                             (* Y-RESOLUTION
                                                (+
                                                 (* TEMP
                                                    (-
                                                     (+ J
                                                        (AREF OFFSET P2-IDX 1))
                                                     (+ J
                                                        (AREF OFFSET P1-IDX
                                                              1))))
                                                 (+ J
                                                    (AREF OFFSET P1-IDX 1))))))
                                    (SETF P1-IDX
                                            (AREF SQUARE-EDGE EDGE-2-IDX 0)
                                          P2-IDX
                                            (AREF SQUARE-EDGE EDGE-2-IDX 1))
                                    (SETF VAL1
                                            (AREF META-GRID
                                                  (+ I (AREF OFFSET P1-IDX 0))
                                                  (+ J (AREF OFFSET P1-IDX 1)))
                                          VAL2
                                            (AREF META-GRID
                                                  (+ I (AREF OFFSET P2-IDX 0))
                                                  (+ J
                                                     (AREF OFFSET P2-IDX 1))))
                                    (IF (NOT (= (- VAL2 VAL1) 0))
                                        (SETF TEMP
                                                (#S(FORMGREP:SYMREF
                                                    :NAME "CAST"
                                                    :QUALIFIER "SDL")
                                                 FLOAT
                                                 (/ (- ISO-VALUE VAL1)
                                                    (- VAL2 VAL1))))
                                        (SETF TEMP 0.5))
                                    (SETF ISO-P2-X
                                            (#S(FORMGREP:SYMREF
                                                :NAME "CAST-TO-INT"
                                                :QUALIFIER "SDL")
                                             (* X-RESOLUTION
                                                (+
                                                 (* TEMP
                                                    (-
                                                     (+ I
                                                        (AREF OFFSET P2-IDX 0))
                                                     (+ I
                                                        (AREF OFFSET P1-IDX
                                                              0))))
                                                 (+ I
                                                    (AREF OFFSET P1-IDX 0))))))
                                    (SETF ISO-P2-Y
                                            (#S(FORMGREP:SYMREF
                                                :NAME "CAST-TO-INT"
                                                :QUALIFIER "SDL")
                                             (* Y-RESOLUTION
                                                (+
                                                 (* TEMP
                                                    (-
                                                     (+ J
                                                        (AREF OFFSET P2-IDX 1))
                                                     (+ J
                                                        (AREF OFFSET P1-IDX
                                                              1))))
                                                 (+ J
                                                    (AREF OFFSET P1-IDX 1))))))
                                    (#S(FORMGREP:SYMREF
                                        :NAME "DRAW-LINE-*"
                                        :QUALIFIER "SDL")
                                     ISO-P1-X ISO-P1-Y ISO-P2-X ISO-P2-Y :COLOR
                                     COLOR :SURFACE SURFACE)
                                    (SETF (AREF SQUARE-FLAG I J) 1)))))))))))

[lispbuilder/lispbuilder-sdl/glue-cl-vectors/glue-cl-vectors.lisp:11]
  (DEFUN IMAGE-PUT-PIXEL
         (IMAGE
          &OPTIONAL (COLOR #(0 0 0)) (OPACITY 1.0)
          (ALPHA-FUNCTION :NORMALIZED))
    (CHECK-TYPE IMAGE SDL-SURFACE)
    (LET ((WIDTH (WIDTH IMAGE)) (HEIGHT (HEIGHT IMAGE)))
      (CASE ALPHA-FUNCTION
        (:NORMALIZED
         (SETF ALPHA-FUNCTION
                 #'#S(FORMGREP:SYMREF
                      :NAME "ALPHA/NORMALIZED"
                      :QUALIFIER "AA-MISC")))
        (:EVEN-ODD
         (SETF ALPHA-FUNCTION
                 #'#S(FORMGREP:SYMREF
                      :NAME "ALPHA/EVEN-ODD"
                      :QUALIFIER "AA-MISC"))))
      (IF (/= OPACITY 1.0)
          (LAMBDA (X Y ALPHA)
            (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
            (WHEN (AND (<= 0 X (1- WIDTH)) (<= 0 Y (1- HEIGHT)))
              (SETF ALPHA (FUNCALL ALPHA-FUNCTION ALPHA))
              (#S(FORMGREP:SYMREF :NAME "WITH-PIXEL" :QUALIFIER "SDL-BASE")
               (PX (FP IMAGE))
               (MULTIPLE-VALUE-BIND (RGBA R G B A)
                   (#S(FORMGREP:SYMREF
                       :NAME "READ-PIXEL"
                       :QUALIFIER "SDL-BASE")
                    PX X Y)
                 (DECLARE (IGNORE RGBA A))
                 (#S(FORMGREP:SYMREF :NAME "WRITE-PIXEL" :QUALIFIER "SDL-BASE")
                  PX X Y
                  (#S(FORMGREP:SYMREF :NAME "MAP-COLOR-*" :QUALIFIER "SDL")
                   (#S(FORMGREP:SYMREF
                       :NAME "BLEND-VALUE"
                       :QUALIFIER "AA-MISC")
                    R (AREF COLOR 0) (FLOOR (* OPACITY ALPHA)))
                   (#S(FORMGREP:SYMREF
                       :NAME "BLEND-VALUE"
                       :QUALIFIER "AA-MISC")
                    G (AREF COLOR 1) (FLOOR (* OPACITY ALPHA)))
                   (#S(FORMGREP:SYMREF
                       :NAME "BLEND-VALUE"
                       :QUALIFIER "AA-MISC")
                    B (AREF COLOR 2) (FLOOR (* OPACITY ALPHA)))
                   NIL IMAGE))))))
          (LAMBDA (X Y ALPHA)
            (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
            (WHEN (AND (<= 0 X (1- WIDTH)) (<= 0 Y (1- HEIGHT)))
              (SETF ALPHA (FUNCALL ALPHA-FUNCTION ALPHA))
              (#S(FORMGREP:SYMREF :NAME "WITH-PIXEL" :QUALIFIER "SDL-BASE")
               (PX (FP IMAGE))
               (MULTIPLE-VALUE-BIND (RGBA R G B A)
                   (#S(FORMGREP:SYMREF
                       :NAME "READ-PIXEL"
                       :QUALIFIER "SDL-BASE")
                    PX X Y)
                 (DECLARE (IGNORE RGBA A))
                 (#S(FORMGREP:SYMREF :NAME "WRITE-PIXEL" :QUALIFIER "SDL-BASE")
                  PX X Y
                  (#S(FORMGREP:SYMREF :NAME "MAP-COLOR-*" :QUALIFIER "SDL")
                   (#S(FORMGREP:SYMREF
                       :NAME "BLEND-VALUE"
                       :QUALIFIER "AA-MISC")
                    R (AREF COLOR 0) ALPHA)
                   (#S(FORMGREP:SYMREF
                       :NAME "BLEND-VALUE"
                       :QUALIFIER "AA-MISC")
                    G (AREF COLOR 1) ALPHA)
                   (#S(FORMGREP:SYMREF
                       :NAME "BLEND-VALUE"
                       :QUALIFIER "AA-MISC")
                    B (AREF COLOR 2) ALPHA)
                   NIL IMAGE)))))))))

[lispbuilder/lispbuilder-sdl/glue-cl-vectors/glue-cl-vectors.lisp:56]
  (DEFUN IMAGE-PUT-SPAN
         (IMAGE
          &OPTIONAL (COLOR #(0 0 0)) (OPACITY 1.0)
          (ALPHA-FUNCTION :NORMALIZED))
    (CHECK-TYPE IMAGE SDL-SURFACE)
    (LET ((WIDTH (WIDTH IMAGE)) (HEIGHT (HEIGHT IMAGE)))
      (CASE ALPHA-FUNCTION
        (:NORMALIZED
         (SETF ALPHA-FUNCTION
                 #'#S(FORMGREP:SYMREF
                      :NAME "ALPHA/NORMALIZED"
                      :QUALIFIER "AA-MISC")))
        (:EVEN-ODD
         (SETF ALPHA-FUNCTION
                 #'#S(FORMGREP:SYMREF
                      :NAME "ALPHA/EVEN-ODD"
                      :QUALIFIER "AA-MISC"))))
      (IF (/= OPACITY 1.0)
          (LAMBDA (X1 X2 Y ALPHA)
            (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
            (WHEN (AND (< X1 WIDTH) (> X2 0) (<= 0 Y (1- HEIGHT)))
              (SETF ALPHA (FUNCALL ALPHA-FUNCTION ALPHA))
              (LOOP FOR X FROM (MAX 0 X1) BELOW (MIN X2 WIDTH)
                    DO (#S(FORMGREP:SYMREF
                           :NAME "WITH-PIXEL"
                           :QUALIFIER "SDL-BASE")
                        (PX (FP IMAGE))
                        (MULTIPLE-VALUE-BIND (RGBA R G B A)
                            (#S(FORMGREP:SYMREF
                                :NAME "READ-PIXEL"
                                :QUALIFIER "SDL-BASE")
                             PX X Y)
                          (DECLARE (IGNORE RGBA A))
                          (#S(FORMGREP:SYMREF
                              :NAME "WRITE-PIXEL"
                              :QUALIFIER "SDL-BASE")
                           PX X Y
                           (#S(FORMGREP:SYMREF
                               :NAME "MAP-COLOR-*"
                               :QUALIFIER "SDL")
                            (#S(FORMGREP:SYMREF
                                :NAME "BLEND-VALUE"
                                :QUALIFIER "AA-MISC")
                             R (AREF COLOR 0) (FLOOR (* OPACITY ALPHA)))
                            (#S(FORMGREP:SYMREF
                                :NAME "BLEND-VALUE"
                                :QUALIFIER "AA-MISC")
                             G (AREF COLOR 1) (FLOOR (* OPACITY ALPHA)))
                            (#S(FORMGREP:SYMREF
                                :NAME "BLEND-VALUE"
                                :QUALIFIER "AA-MISC")
                             B (AREF COLOR 2) (FLOOR (* OPACITY ALPHA)))
                            NIL IMAGE)))))))
          (LAMBDA (X1 X2 Y ALPHA)
            (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
            (WHEN (AND (< X1 WIDTH) (> X2 0) (<= 0 Y (1- HEIGHT)))
              (SETF ALPHA (FUNCALL ALPHA-FUNCTION ALPHA))
              (LOOP FOR X FROM (MAX 0 X1) BELOW (MIN X2 WIDTH)
                    DO (#S(FORMGREP:SYMREF
                           :NAME "WITH-PIXEL"
                           :QUALIFIER "SDL-BASE")
                        (PX (FP IMAGE))
                        (MULTIPLE-VALUE-BIND (RGBA R G B A)
                            (#S(FORMGREP:SYMREF
                                :NAME "READ-PIXEL"
                                :QUALIFIER "SDL-BASE")
                             PX X Y)
                          (DECLARE (IGNORE RGBA A))
                          (#S(FORMGREP:SYMREF
                              :NAME "WRITE-PIXEL"
                              :QUALIFIER "SDL-BASE")
                           PX X Y
                           (#S(FORMGREP:SYMREF
                               :NAME "MAP-COLOR-*"
                               :QUALIFIER "SDL")
                            (#S(FORMGREP:SYMREF
                                :NAME "BLEND-VALUE"
                                :QUALIFIER "AA-MISC")
                             R (AREF COLOR 0) ALPHA)
                            (#S(FORMGREP:SYMREF
                                :NAME "BLEND-VALUE"
                                :QUALIFIER "AA-MISC")
                             G (AREF COLOR 1) ALPHA)
                            (#S(FORMGREP:SYMREF
                                :NAME "BLEND-VALUE"
                                :QUALIFIER "AA-MISC")
                             B (AREF COLOR 2) ALPHA)
                            NIL IMAGE))))))))))

[lispbuilder/lispbuilder-sdl/sdl/drawing-primitives.lisp:860]
  (DEFUN _DRAW-FILLED-CIRCLE-*_
         (X0 Y0 R
          &KEY (SURFACE *DEFAULT-SURFACE*) (COLOR *DEFAULT-COLOR*)
          (STROKE-COLOR NIL) (ALPHA NIL))
    "Draws a filled circle of [COLOR](#color) to [SURFACE](#surface).

##### Parameters

* `X0` and `Y0` specify the center coordinate of the circle, of type `INTEGER`.
* `R` is the circle radius, of type `INTEGER`.
* `:SURFACE` is the target [SURFACE](#surface).
* `:COLOR` is the line color, of [COLOR](#color) or [COLOR-A](#color-a).
* `:STROKE-COLOR` when not `NIL` will draw a `1` pixel line of color `COLOR` around the perimiter of the box.
* `:ALPHA` when between `0` and `255` is used as the alpha transparency value when blitting the rectangle onto `SURFACE`.
*Note:* An intermediate surface is created, the rectangle is drawn onto this intermediate surface and then this surface
is blitted to `SURFACE`.

##### Packages

* Also supported in _LISPBUILDER-SDL-GFX_"
    (DECLARE (TYPE FIXNUM X0 Y0 R)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (UNLESS SURFACE (SETF SURFACE *DEFAULT-DISPLAY*))
    (CHECK-TYPE SURFACE SDL-SURFACE)
    (CHECK-TYPE COLOR COLOR)
    (IF STROKE-COLOR
        (CHECK-TYPE STROKE-COLOR COLOR))
    (LET ((SURF
           (IF ALPHA
               (CREATE-SURFACE (THE FIXNUM (1+ (THE FIXNUM (* R 2))))
                (THE FIXNUM (1+ (THE FIXNUM (* R 2)))) :ALPHA ALPHA
                :PIXEL-ALPHA (A COLOR))
               SURFACE)))
      (LET ((X0
             (IF ALPHA
                 R
                 X0))
            (Y0
             (IF ALPHA
                 R
                 Y0)))
        (DECLARE (TYPE FIXNUM X0 Y0))
        (LET ((F (- 1 R)) (DDF-X 0) (DDF-Y (THE FIXNUM (* -2 R))))
          (DECLARE (TYPE FIXNUM F DDF-X DDF-Y))
          (WITH-RECTANGLE (TEMPLATE (RECTANGLE))
           (_DRAW-VLINE_ X0 (THE FIXNUM (+ Y0 R)) (THE FIXNUM (- Y0 R)) :COLOR
            COLOR :SURFACE SURF :CLIPPING NIL :TEMPLATE TEMPLATE)
           (_DRAW-HLINE_ (THE FIXNUM (+ X0 R)) (THE FIXNUM (- X0 R)) Y0 :COLOR
            COLOR :SURFACE SURF :CLIPPING NIL :TEMPLATE TEMPLATE))
          (DO ((X 0)
               (Y R))
              ((<= Y X))
            (DECLARE (TYPE FIXNUM X Y))
            (WHEN (>= F 0) (DECF Y) (INCF DDF-Y 2) (INCF F DDF-Y))
            (INCF X)
            (INCF DDF-X 2)
            (INCF F (1+ DDF-X))
            (WITH-RECTANGLE (TEMPLATE (RECTANGLE))
             (_DRAW-HLINE_ (THE FIXNUM (+ X0 X)) (THE FIXNUM (- X0 X))
              (THE FIXNUM (+ Y0 Y)) :COLOR COLOR :SURFACE SURF :CLIPPING NIL
              :TEMPLATE TEMPLATE)
             (_DRAW-HLINE_ (THE FIXNUM (+ X0 X)) (THE FIXNUM (- X0 X))
              (THE FIXNUM (- Y0 Y)) :COLOR COLOR :SURFACE SURF :CLIPPING NIL
              :TEMPLATE TEMPLATE)
             (_DRAW-HLINE_ (THE FIXNUM (+ X0 Y)) (THE FIXNUM (- X0 Y))
              (THE FIXNUM (+ Y0 X)) :COLOR COLOR :SURFACE SURF :CLIPPING NIL
              :TEMPLATE TEMPLATE)
             (_DRAW-HLINE_ (THE FIXNUM (+ X0 Y)) (THE FIXNUM (- X0 Y))
              (THE FIXNUM (- Y0 X)) :COLOR COLOR :SURFACE SURF :CLIPPING NIL
              :TEMPLATE TEMPLATE)))
          (WHEN STROKE-COLOR
            (_DRAW-CIRCLE-*_ X0 Y0 R :SURFACE SURF :COLOR STROKE-COLOR))))
      (WHEN ALPHA
        (DRAW-SURFACE-AT-* SURF (THE FIXNUM (- X0 R)) (THE FIXNUM (- Y0 R))
         :SURFACE SURFACE)
        (FREE SURF)))
    SURFACE)

[lispbuilder/lispbuilder-sdl/sdl/drawing-primitives.lisp:1371]
  (DEFUN _ROTATE-SURFACE_
         (DEGREES
          &KEY (SURFACE *DEFAULT-SURFACE*) (FREE NIL) (ZOOM 1) (SMOOTH NIL))
    "Returns a new [SURFACE](#surface) rotated to `DEGREES`.

##### Parameters

* `DEGREES` is the rotation in degrees.
* `:SURFACE` is the surface to rotate [SURFACE](#surface).
* `:FREE` when `T` will free `SURFACE`.
* `:ZOOM` is the scaling factor.
* `:SMOOTH` when `T` will anti-aliase the new surface.

##### Packages

* Also supported in _LISPBUILDER-SDL-GFX_
* _LISPBUILDER-SDL_ supports rotations of only `0`, `90`, `180`, or `270` degrees.
_LISPBUILDER-SDL-GFX_ supports any rotation.
* _LISPBUILDER-SDL_ ignores `:SMOOTH`. _LISPBUILDER-SDL-GFX_ supports `:SMOOTH`.
* _LISPBUILDER-SDL_ ignores `:ZOOM`. _LISPBUILDER-SDL-GFX_ supports `:ZOOM`.
* _LISPBUILDER-SDL-GFX_ ignores `:FREE`."
    (DECLARE (IGNORE ZOOM SMOOTH)
             (TYPE FIXNUM DEGREES)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (UNLESS (MEMBER DEGREES '(0 90 180 270))
      (ERROR
       "ERROR, ROTATE-SURFACE: degrees ~A is not one of 0, 90, 180 or 270"
       DEGREES))
    (IF (= 0 DEGREES)
        (LET ((NEW-SURF (COPY-SURFACE :SURFACE SURFACE)))
          (WHEN FREE (FREE SURFACE))
          NEW-SURF)
        (LET* ((EVEN (EVENP (/ DEGREES 90)))
               (W (WIDTH SURFACE))
               (H (HEIGHT SURFACE))
               (NEW-W
                (IF EVEN
                    W
                    H))
               (NEW-H
                (IF EVEN
                    H
                    W)))
          (DECLARE (TYPE FIXNUM W H NEW-W NEW-H))
          (WITH-SURFACES
           ((SRC SURFACE FREE)
            (DST
             (MAKE-INSTANCE 'SURFACE :USING-SURFACE SURFACE :WIDTH NEW-W
                            :HEIGHT NEW-H :BPP (BIT-DEPTH SURFACE)
                            :ENABLE-ALPHA (ALPHA-ENABLED-P SURFACE)
                            :ENABLE-COLOR-KEY (COLOR-KEY-ENABLED-P SURFACE)
                            :ALPHA
                            (WHEN (ALPHA-ENABLED-P SURFACE) (ALPHA SURFACE))
                            :COLOR-KEY
                            (WHEN (COLOR-KEY-ENABLED-P SURFACE)
                              (COLOR-KEY SURFACE))
                            :PIXEL-ALPHA (PIXEL-ALPHA-ENABLED-P SURFACE))
             NIL))
           (LET ((NEW-X
                  (CASE DEGREES
                    (90
                     #'(LAMBDA (X Y)
                         (DECLARE (IGNORE X)
                                  (TYPE FIXNUM X Y))
                         (THE FIXNUM
                              (+ (THE FIXNUM (1- NEW-W))
                                 (THE FIXNUM (- 0 Y))))))
                    (180
                     #'(LAMBDA (X Y)
                         (DECLARE (IGNORE Y)
                                  (TYPE FIXNUM X Y))
                         (THE FIXNUM
                              (+ (THE FIXNUM (1- NEW-W))
                                 (THE FIXNUM (- 0 X))))))
                    (270
                     #'(LAMBDA (X Y)
                         (DECLARE (IGNORE X)
                                  (TYPE FIXNUM X Y))
                         Y))
                    (OTHERWISE
                     #'(LAMBDA (X Y)
                         (DECLARE (IGNORE Y)
                                  (TYPE FIXNUM X Y))
                         X))))
                 (NEW-Y
                  (CASE DEGREES
                    (90
                     #'(LAMBDA (X Y)
                         (DECLARE (IGNORE Y)
                                  (TYPE FIXNUM X Y))
                         X))
                    (180
                     #'(LAMBDA (X Y)
                         (DECLARE (IGNORE X)
                                  (TYPE FIXNUM X Y))
                         (THE FIXNUM
                              (+ (THE FIXNUM (1- NEW-H))
                                 (THE FIXNUM (- 0 Y))))))
                    (270
                     #'(LAMBDA (X Y)
                         (DECLARE (IGNORE Y)
                                  (TYPE FIXNUM X Y))
                         (THE FIXNUM
                              (+ (THE FIXNUM (1- NEW-H))
                                 (THE FIXNUM (- 0 X))))))
                    (OTHERWISE
                     #'(LAMBDA (X Y)
                         (DECLARE (IGNORE X)
                                  (TYPE FIXNUM X Y))
                         Y)))))
             (DECLARE (TYPE FIXNUM W H))
             (WITH-PIXELS ((SRC (FP SRC)) (DST (FP DST)))
              (LOOP :FOR X :FROM 0 :TO (1- W)
                    :DO (LOOP :FOR Y :FROM 0 :TO (1- H)
                              :DO (WRITE-PIXEL DST (FUNCALL NEW-X X Y)
                                   (FUNCALL NEW-Y X Y)
                                   (READ-PIXEL SRC X Y))))))
           DST))))

[lla/misc/benchmark.lisp:27]
  (DEFUN DOIT (A V)
    (DECLARE
     (OPTIMIZE (COMPILATION-SPEED 0) (DEBUG 0) (SAFETY 0) (SPACE 0) (SPEED 3)))
    (DECLARE (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT (* *)) A)
             (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT (*)) V))
    (DESTRUCTURING-BIND
        (ROWS COLUMNS)
        (ARRAY-DIMENSIONS A)
      (DECLARE (TYPE FIXNUM ROWS COLUMNS))
      (LET ((RESULT (MAKE-ARRAY ROWS :ELEMENT-TYPE 'DOUBLE-FLOAT)))
        (DOTIMES (ROW ROWS)
          (LET ((SUM 0.0d0))
            (DOTIMES (COLUMN COLUMNS)
              (INCF SUM (* (AREF A ROW COLUMN) (AREF V COLUMN))))
            (SETF (AREF RESULT ROW) SUM)))
        RESULT)))

[lla/misc/benchmark.lisp:102]
  (DEFUN TRANSPOSE-TO-MEMORY1 (MATRIX POINTER)
    "Specialized for double-float."
    (DECLARE (OPTIMIZE SPEED (SAFETY 0)))
    (CHECK-TYPE MATRIX (SIMPLE-ARRAY DOUBLE-FLOAT (* *)))
    (DESTRUCTURING-BIND
        (NROW NCOL)
        (ARRAY-DIMENSIONS MATRIX)
      (LET ((INDEX 0))
        (DECLARE (TYPE FIXNUM INDEX)
                 (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT (* *)) MATRIX))
        (LOOP FOR COL-INDEX FIXNUM BELOW NCOL
              DO (LOOP FOR ROW-INDEX FIXNUM BELOW NROW
                       DO (SETF (CFFI:MEM-AREF POINTER :DOUBLE INDEX)
                                  (AREF MATRIX ROW-INDEX COL-INDEX)) (INCF
                                                                      INDEX))))))

[lla/src/foreign-memory.lisp:121]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (DEFUN EXPAND-SPECIFICATIONS% (CLAUSE SPECIFICATIONS)
      "Expand specifications using (clause internal-type element-type)."
      (ECLECTOR.READER:QUASIQUOTE
       (COND
        (ECLECTOR.READER:UNQUOTE-SPLICING
         (MAPCAN
          (LAMBDA+ ((INTERNAL-TYPE &REST ELEMENT-TYPES))
           (MAPCAR
            (LAMBDA (ELEMENT-TYPE) (FUNCALL CLAUSE INTERNAL-TYPE ELEMENT-TYPE))
            ELEMENT-TYPES))
          SPECIFICATIONS))
        (T (ERROR 'LLA-INTERNAL-ERROR :MESSAGE "Unhandled case.")))))
    (DEFUN ALL-TO-SPECIFICATIONS% ()
      "Return an optimization specification for all functions that copy to foreign memory."
      '((NIL LLA-SINGLE *) (NIL LLA-SINGLE LLA-DOUBLE *)
        (NIL LLA-SINGLE LLA-DOUBLE LLA-COMPLEX-SINGLE *)
        (NIL LLA-SINGLE LLA-DOUBLE LLA-COMPLEX-SINGLE LLA-COMPLEX-DOUBLE *)
        (NIL LLA-INTEGER *)))
    (DEFUN ALL-FROM-SPECIFICATIONS% ()
      "Return an optimization specification for all functions that copy from foreign memory."
      '((NIL LLA-SINGLE *) (NIL LLA-DOUBLE *) (NIL LLA-COMPLEX-SINGLE *)
        (NIL LLA-COMPLEX-DOUBLE *) (NIL LLA-INTEGER *)))
    (DEFMACRO ARRAY-CLAUSE%
              ((ARRAY INTERNAL-TYPE CLAUSE-ELEMENT-TYPE CLAUSE-INTERNAL-TYPE)
               &BODY BODY)
      "Macro that generates a lambda form that can bed used in EXPAND-SPECIFICATIONS%."
      (WITH-GENSYMS (GENERIC? ARRAY-TYPE)
       (ECLECTOR.READER:QUASIQUOTE
        (LAMBDA
            ((ECLECTOR.READER:UNQUOTE CLAUSE-INTERNAL-TYPE)
             (ECLECTOR.READER:UNQUOTE CLAUSE-ELEMENT-TYPE))
          (LET* (((ECLECTOR.READER:UNQUOTE GENERIC?)
                  (EQ (ECLECTOR.READER:UNQUOTE CLAUSE-ELEMENT-TYPE) '*))
                 ((ECLECTOR.READER:UNQUOTE ARRAY-TYPE)
                  (ECLECTOR.READER:QUASIQUOTE
                   ((ECLECTOR.READER:UNQUOTE
                     (IF (ECLECTOR.READER:UNQUOTE GENERIC?)
                         'ARRAY
                         'SIMPLE-ARRAY))
                    (ECLECTOR.READER:UNQUOTE
                     (ECLECTOR.READER:UNQUOTE CLAUSE-ELEMENT-TYPE))
                    *))))
            (ECLECTOR.READER:QUASIQUOTE
             ((AND
               (TYPEP
                (ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE ARRAY))
                '(ECLECTOR.READER:UNQUOTE
                  (ECLECTOR.READER:UNQUOTE ARRAY-TYPE)))
               (=
                (ECLECTOR.READER:UNQUOTE
                 '(ECLECTOR.READER:UNQUOTE INTERNAL-TYPE))
                (ECLECTOR.READER:UNQUOTE
                 (ECLECTOR.READER:UNQUOTE CLAUSE-INTERNAL-TYPE))))
              (LOCALLY
               (DECLARE
                (ECLECTOR.READER:UNQUOTE-SPLICING
                 (UNLESS (ECLECTOR.READER:UNQUOTE GENERIC?)
                   (QUOTE ((OPTIMIZE SPEED (SAFETY 0))))))
                (TYPE
                 (ECLECTOR.READER:UNQUOTE (ECLECTOR.READER:UNQUOTE ARRAY-TYPE))
                 (ECLECTOR.READER:UNQUOTE
                  (QUOTE (ECLECTOR.READER:UNQUOTE ARRAY)))))
               (ECLECTOR.READER:UNQUOTE
                (ECLECTOR.READER:UNQUOTE-SPLICING BODY)))))))))))

[local-time/src/local-time.lisp:1071]
  (PROGN
   (#S(FORMGREP:SYMREF :NAME "DEFINE-C-TYPEDEF" :QUALIFIER "FLI") TIME-T :LONG)
   (#S(FORMGREP:SYMREF :NAME "DEFINE-C-TYPEDEF" :QUALIFIER "FLI") SUSECONDS-T
    :LONG :INT)
   (#S(FORMGREP:SYMREF :NAME "DEFINE-C-STRUCT" :QUALIFIER "FLI") TIMEVAL
    (TV-SEC TIME-T) (TV-USEC SUSECONDS-T))
   (#S(FORMGREP:SYMREF :NAME "DEFINE-FOREIGN-FUNCTION" :QUALIFIER "FLI")
    (GETTIMEOFDAY/FFI "gettimeofday")
    ((TV (:POINTER (:STRUCT TIMEVAL))) (TZ :POINTER)) :RESULT-TYPE :INT)
   (DEFUN LISPWORKS-GETTIMEOFDAY ()
     (DECLARE (OPTIMIZE SPEED (SAFETY 1)))
     (#S(FORMGREP:SYMREF :NAME "WITH-DYNAMIC-FOREIGN-OBJECTS" :QUALIFIER "FLI")
      ((TV (:STRUCT TIMEVAL)))
      (LET ((RET
             (GETTIMEOFDAY/FFI TV
              #S(FORMGREP:SYMREF :NAME "*NULL-POINTER*" :QUALIFIER "FLI"))))
        (ASSERT (ZEROP RET) NIL "gettimeofday failed")
        (LET ((SECS
               (#S(FORMGREP:SYMREF :NAME "FOREIGN-SLOT-VALUE" :QUALIFIER "FLI")
                TV 'TV-SEC :TYPE 'TIME-T :OBJECT-TYPE '(:STRUCT TIMEVAL)))
              (USECS
               (#S(FORMGREP:SYMREF :NAME "FOREIGN-SLOT-VALUE" :QUALIFIER "FLI")
                TV 'TV-USEC :TYPE 'SUSECONDS-T :OBJECT-TYPE
                '(:STRUCT TIMEVAL))))
          (VALUES SECS (* 1000 USECS)))))))

[log4cl/src/logger.lisp:494]
  (DEFUN EXPAND-LOG-WITH-LEVEL (ENV LEVEL ARGS)
    "Returns a FORM that is used as an expansion of log-nnnnn macros"
    (DECLARE (TYPE FIXNUM LEVEL)
             (TYPE LIST ARGS))
    (WITH-PACKAGE-NAMING-CONFIGURATION (*PACKAGE*)
     (MULTIPLE-VALUE-BIND (LOGGER-FORM ARGS)
         (RESOLVE-LOGGER-FORM *PACKAGE* ENV ARGS)
       (LET* ((LOGGER-SYMBOL (GENSYM "logger"))
              (LOG-STMT (GENSYM "log-stmt"))
              (STREAM (GENSYM "stream"))
              (CONST-LOGGER
               (WHEN (CONSTANTP LOGGER-FORM)
                 (LET ((LOGGER (EVAL LOGGER-FORM)))
                   (WHEN (TYPEP LOGGER 'LOGGER) LOGGER))))
              (CHECK-TYPE
               (UNLESS CONST-LOGGER
                 (ECLECTOR.READER:QUASIQUOTE
                  (OR (TYPEP (ECLECTOR.READER:UNQUOTE LOGGER-SYMBOL) 'LOGGER)
                      (ERROR 'TYPE-ERROR :EXPECTED-TYPE 'LOGGER :DATUM
                             (ECLECTOR.READER:UNQUOTE LOGGER-SYMBOL))))))
              (PKG-HINT
               (LET ((SYM (INTERN (SYMBOL-NAME PACKAGE-REF-SYM) *PACKAGE*)))
                 (WHEN SYM
                   (ECLECTOR.READER:QUASIQUOTE
                    (SYMBOL-PACKAGE '(ECLECTOR.READER:UNQUOTE SYM)))))))
         (IF ARGS
             (ECLECTOR.READER:QUASIQUOTE
              (LET (((ECLECTOR.READER:UNQUOTE LOGGER-SYMBOL)
                     (ECLECTOR.READER:UNQUOTE LOGGER-FORM)))
                (DECLARE (MUFFLE-CONDITIONS COMPILER-NOTE))
                (WHEN
                    (LOCALLY
                     (DECLARE (OPTIMIZE (SAFETY 0) (DEBUG 0) (SPEED 3)))
                     (ECLECTOR.READER:UNQUOTE-SPLICING
                      (WHEN CHECK-TYPE (LIST CHECK-TYPE)))
                     (IS-ENABLED-FOR (ECLECTOR.READER:UNQUOTE LOGGER-SYMBOL)
                      (ECLECTOR.READER:UNQUOTE LEVEL)))
                  (FLET (((ECLECTOR.READER:UNQUOTE LOG-STMT)
                             ((ECLECTOR.READER:UNQUOTE STREAM))
                           (DECLARE
                            (TYPE STREAM (ECLECTOR.READER:UNQUOTE STREAM)))
                           (FORMAT (ECLECTOR.READER:UNQUOTE STREAM)
                                   (ECLECTOR.READER:UNQUOTE-SPLICING ARGS))))
                    (DECLARE
                     (DYNAMIC-EXTENT
                      (FUNCTION (ECLECTOR.READER:UNQUOTE LOG-STMT))))
                    (LOCALLY
                     (DECLARE (OPTIMIZE (SAFETY 0) (DEBUG 0) (SPEED 3)))
                     (LOG-WITH-LOGGER (ECLECTOR.READER:UNQUOTE LOGGER-SYMBOL)
                      (ECLECTOR.READER:UNQUOTE LEVEL)
                      #'(ECLECTOR.READER:UNQUOTE LOG-STMT)
                      (ECLECTOR.READER:UNQUOTE PKG-HINT)))))
                (VALUES)))
             (ECLECTOR.READER:QUASIQUOTE
              (LET (((ECLECTOR.READER:UNQUOTE LOGGER-SYMBOL)
                     (ECLECTOR.READER:UNQUOTE LOGGER-FORM)))
                (LOCALLY
                 (DECLARE (OPTIMIZE (SAFETY 0) (DEBUG 0) (SPEED 3)))
                 (ECLECTOR.READER:UNQUOTE-SPLICING
                  (WHEN CHECK-TYPE (LIST CHECK-TYPE)))
                 (IS-ENABLED-FOR (ECLECTOR.READER:UNQUOTE LOGGER-SYMBOL)
                  (ECLECTOR.READER:UNQUOTE LEVEL))))))))))

[log4cl/src/logger.lisp:847]
  (DEFUN LOG-EVENT-TIME ()
    "Returns the universal time of the current log event"
    (LOCALLY
     (DECLARE (OPTIMIZE (SAFETY 0) (DEBUG 0) (SPEED 3)))
     (OR *LOG-EVENT-TIME* (SETQ *LOG-EVENT-TIME* (GET-UNIVERSAL-TIME)))))

[lparallel/bench/suite.lisp:177]
  (DEFUN FIB-LET (N)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (IF (< N 2)
        N
        (LET ((A (FIB-LET (- N 1))) (B (FIB-LET (- N 2))))
          (+ A B))))

[lparallel/bench/suite.lisp:185]
  (DEFPUN FIB-PLET (N) (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
   (IF (< N 2)
       N
       (PLET ((A (FIB-PLET (- N 1))) (B (FIB-PLET (- N 2)))) (+ A B))))

[lparallel/bench/suite.lisp:193]
  (DEFPUN FIB-PLET-IF (N) (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
   (IF (< N 2)
       N
       (PLET-IF (> N 15) ((A (FIB-PLET-IF (- N 1))) (B (FIB-PLET-IF (- N 2))))
        (+ A B))))

[lparallel/bench/suite.lisp:229]
  (DEFMACRO DEFINE-MM (NAME DEF XLET)
    (ECLECTOR.READER:QUASIQUOTE
     ((ECLECTOR.READER:UNQUOTE DEF) (ECLECTOR.READER:UNQUOTE NAME) (N M1 M2 M3)
      (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
      (LABELS ((COMPUTE-ENTRY (ROW COL)
                 (LABELS ((COMPUTE-LOOP (I J SUM)
                            (IF (>= J 0)
                                (COMPUTE-LOOP (- I 1) (- J N)
                                 (+ SUM (* (AREF M1 I) (AREF M2 J))))
                                (SETF (AREF M3 (+ I 1 COL)) SUM))))
                   (COMPUTE-LOOP (+ ROW N -1) (+ (* N (1- N)) COL) 0)))
               (COMPUTE-COLS-BETWEEN (ROW I J)
                 (IF (= I J)
                     (COMPUTE-ENTRY ROW I)
                     (LET ((MID (FLOOR (+ I J) 2)))
                       ((ECLECTOR.READER:UNQUOTE XLET)
                        ((HALF1 (COMPUTE-COLS-BETWEEN ROW I MID))
                         (HALF2 (COMPUTE-COLS-BETWEEN ROW (+ MID 1) J)))
                        HALF1 HALF2))))
               (COMPUTE-ROWS-BETWEEN (I J)
                 (IF (= I J)
                     (COMPUTE-COLS-BETWEEN (* I N) 0 (- N 1))
                     (LET ((MID (FLOOR (+ I J) 2)))
                       ((ECLECTOR.READER:UNQUOTE XLET)
                        ((HALF1 (COMPUTE-ROWS-BETWEEN I MID))
                         (HALF2 (COMPUTE-ROWS-BETWEEN (+ MID 1) J)))
                        HALF1 HALF2)))))
        (COMPUTE-ROWS-BETWEEN 0 (1- N))))))

[lparallel/src/util/config.lisp:34]
  (PROGN
   (DEFVAR *NORMAL-OPTIMIZE*
     '(OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1) (COMPILATION-SPEED 0)))
   (DEFVAR *FULL-OPTIMIZE*
     '(OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0) (COMPILATION-SPEED 0))))

[lparallel/src/util/config.lisp:50]
  (PROGN
   (DEFVAR *NORMAL-OPTIMIZE*
     '(OPTIMIZE (SPEED 0) (SAFETY 3) (DEBUG 3) (SPACE 0)
       (COMPILATION-SPEED 0)))
   (DEFVAR *FULL-OPTIMIZE*
     '(OPTIMIZE (SPEED 0) (SAFETY 3) (DEBUG 3) (SPACE 0)
       (COMPILATION-SPEED 0))))

[magicl/src/bindings/allegro/blas-cffi.lisp:3]
  (DECLAIM (OPTIMIZE (SPEED 0) SAFETY DEBUG COMPILATION-SPEED))

[magicl/src/bindings/allegro/expokit-cffi.lisp:3]
  (DECLAIM (OPTIMIZE (SPEED 0) SAFETY DEBUG COMPILATION-SPEED))

[magicl/src/bindings/allegro/lapack00-cffi.lisp:3]
  (DECLAIM (OPTIMIZE (SPEED 0) SAFETY DEBUG COMPILATION-SPEED))

[magicl/src/bindings/allegro/lapack01-cffi.lisp:3]
  (DECLAIM (OPTIMIZE (SPEED 0) SAFETY DEBUG COMPILATION-SPEED))

[magicl/src/bindings/allegro/lapack02-cffi.lisp:3]
  (DECLAIM (OPTIMIZE (SPEED 0) SAFETY DEBUG COMPILATION-SPEED))

[magicl/src/bindings/allegro/lapack03-cffi.lisp:3]
  (DECLAIM (OPTIMIZE (SPEED 0) SAFETY DEBUG COMPILATION-SPEED))

[magicl/src/bindings/allegro/lapack04-cffi.lisp:3]
  (DECLAIM (OPTIMIZE (SPEED 0) SAFETY DEBUG COMPILATION-SPEED))

[magicl/src/bindings/allegro/lapack05-cffi.lisp:3]
  (DECLAIM (OPTIMIZE (SPEED 0) SAFETY DEBUG COMPILATION-SPEED))

[magicl/src/bindings/allegro/lapack06-cffi.lisp:3]
  (DECLAIM (OPTIMIZE (SPEED 0) SAFETY DEBUG COMPILATION-SPEED))

[magicl/src/bindings/allegro/lapack07-cffi.lisp:3]
  (DECLAIM (OPTIMIZE (SPEED 0) SAFETY DEBUG COMPILATION-SPEED))

[magicl/src/bindings/blas-cffi.lisp:3]
  (DECLAIM (OPTIMIZE (SPEED 0) SAFETY DEBUG COMPILATION-SPEED))

[magicl/src/bindings/expokit-cffi.lisp:3]
  (DECLAIM (OPTIMIZE (SPEED 0) SAFETY DEBUG COMPILATION-SPEED))

[magicl/src/bindings/lapack00-cffi.lisp:3]
  (DECLAIM (OPTIMIZE (SPEED 0) SAFETY DEBUG COMPILATION-SPEED))

[magicl/src/bindings/lapack01-cffi.lisp:3]
  (DECLAIM (OPTIMIZE (SPEED 0) SAFETY DEBUG COMPILATION-SPEED))

[magicl/src/bindings/lapack02-cffi.lisp:3]
  (DECLAIM (OPTIMIZE (SPEED 0) SAFETY DEBUG COMPILATION-SPEED))

[magicl/src/bindings/lapack03-cffi.lisp:3]
  (DECLAIM (OPTIMIZE (SPEED 0) SAFETY DEBUG COMPILATION-SPEED))

[magicl/src/bindings/lapack04-cffi.lisp:3]
  (DECLAIM (OPTIMIZE (SPEED 0) SAFETY DEBUG COMPILATION-SPEED))

[magicl/src/bindings/lapack05-cffi.lisp:3]
  (DECLAIM (OPTIMIZE (SPEED 0) SAFETY DEBUG COMPILATION-SPEED))

[magicl/src/bindings/lapack06-cffi.lisp:3]
  (DECLAIM (OPTIMIZE (SPEED 0) SAFETY DEBUG COMPILATION-SPEED))

[magicl/src/bindings/lapack07-cffi.lisp:3]
  (DECLAIM (OPTIMIZE (SPEED 0) SAFETY DEBUG COMPILATION-SPEED))

[magicl/src/extensions/blas/arithmetic.lisp:77]
  (MACROLET ((DEF-+ (TENSOR-TYPE SCALAR-TYPE FUNCTION)
               (ECLECTOR.READER:QUASIQUOTE
                (DEFMETHOD .+-BLAS
                           ((SOURCE1 (ECLECTOR.READER:UNQUOTE TENSOR-TYPE))
                            (SOURCE2 (ECLECTOR.READER:UNQUOTE TENSOR-TYPE))
                            &OPTIONAL TARGET)
                  (WITH-COMPATIBILITY-TEST
                   ((ECLECTOR.READER:UNQUOTE TENSOR-TYPE))
                   (#S(FORMGREP:SYMREF
                       :NAME "WITH-EXPECTATIONS"
                       :QUALIFIER "POLICY-COND")
                    (> SPEED SAFETY)
                    ((ASSERTION (EQUALP (SHAPE SOURCE1) (SHAPE SOURCE2)))))
                   (LET ((SOURCE1
                          (IF (EQ TARGET SOURCE1)
                              (DEEP-COPY-TENSOR SOURCE1)
                              SOURCE1))
                         (SOURCE2 (COPY-TO/W-SAME-LAYOUT SOURCE2 TARGET)))
                     ((ECLECTOR.READER:UNQUOTE FUNCTION)
                      (#S(FORMGREP:SYMREF :NAME "SIZE" :QUALIFIER "MAGICL")
                       SOURCE2)
                      (COERCE 1 '(ECLECTOR.READER:UNQUOTE SCALAR-TYPE))
                      (#S(FORMGREP:SYMREF :NAME "STORAGE" :QUALIFIER "MAGICL")
                       SOURCE1)
                      1
                      (#S(FORMGREP:SYMREF :NAME "STORAGE" :QUALIFIER "MAGICL")
                       SOURCE2)
                      1)
                     SOURCE2))))))
    (DEF-+ MATRIX/SINGLE-FLOAT SINGLE-FLOAT
     #S(FORMGREP:SYMREF :NAME "%SAXPY" :QUALIFIER "MAGICL.BLAS-CFFI"))
    (DEF-+ MATRIX/DOUBLE-FLOAT DOUBLE-FLOAT
     #S(FORMGREP:SYMREF :NAME "%DAXPY" :QUALIFIER "MAGICL.BLAS-CFFI"))
    (DEF-+ VECTOR/SINGLE-FLOAT SINGLE-FLOAT
     #S(FORMGREP:SYMREF :NAME "%SAXPY" :QUALIFIER "MAGICL.BLAS-CFFI"))
    (DEF-+ VECTOR/DOUBLE-FLOAT DOUBLE-FLOAT
     #S(FORMGREP:SYMREF :NAME "%DAXPY" :QUALIFIER "MAGICL.BLAS-CFFI")))

[magicl/src/extensions/blas/arithmetic.lisp:101]
  (MACROLET ((DEF-- (TENSOR-TYPE SCALAR-TYPE FUNCTION)
               (ECLECTOR.READER:QUASIQUOTE
                (DEFMETHOD .--BLAS
                           ((SOURCE1 (ECLECTOR.READER:UNQUOTE TENSOR-TYPE))
                            (SOURCE2 (ECLECTOR.READER:UNQUOTE TENSOR-TYPE))
                            &OPTIONAL TARGET)
                  (WITH-COMPATIBILITY-TEST
                   ((ECLECTOR.READER:UNQUOTE TENSOR-TYPE))
                   (#S(FORMGREP:SYMREF
                       :NAME "WITH-EXPECTATIONS"
                       :QUALIFIER "POLICY-COND")
                    (> SPEED SAFETY)
                    ((ASSERTION (EQUALP (SHAPE SOURCE1) (SHAPE SOURCE2)))))
                   (LET ((SOURCE2
                          (IF (EQ TARGET SOURCE2)
                              (DEEP-COPY-TENSOR SOURCE2)
                              SOURCE2))
                         (SOURCE1 (COPY-TO/W-SAME-LAYOUT SOURCE1 TARGET)))
                     ((ECLECTOR.READER:UNQUOTE FUNCTION)
                      (#S(FORMGREP:SYMREF :NAME "SIZE" :QUALIFIER "MAGICL")
                       SOURCE2)
                      (COERCE -1 '(ECLECTOR.READER:UNQUOTE SCALAR-TYPE))
                      (#S(FORMGREP:SYMREF :NAME "STORAGE" :QUALIFIER "MAGICL")
                       SOURCE2)
                      1
                      (#S(FORMGREP:SYMREF :NAME "STORAGE" :QUALIFIER "MAGICL")
                       SOURCE1)
                      1)
                     SOURCE1))))))
    (DEF-- MATRIX/SINGLE-FLOAT SINGLE-FLOAT
     #S(FORMGREP:SYMREF :NAME "%SAXPY" :QUALIFIER "MAGICL.BLAS-CFFI"))
    (DEF-- MATRIX/DOUBLE-FLOAT DOUBLE-FLOAT
     #S(FORMGREP:SYMREF :NAME "%DAXPY" :QUALIFIER "MAGICL.BLAS-CFFI"))
    (DEF-- VECTOR/SINGLE-FLOAT SINGLE-FLOAT
     #S(FORMGREP:SYMREF :NAME "%SAXPY" :QUALIFIER "MAGICL.BLAS-CFFI"))
    (DEF-- VECTOR/DOUBLE-FLOAT DOUBLE-FLOAT
     #S(FORMGREP:SYMREF :NAME "%DAXPY" :QUALIFIER "MAGICL.BLAS-CFFI")))

[magicl/src/extensions/blas/arithmetic.lisp:126]
  (MACROLET ((DEF-OP (NAME TENSOR-TYPE SCALAR-TYPE FUNCTION)
               (ECLECTOR.READER:QUASIQUOTE
                (DEFMETHOD (ECLECTOR.READER:UNQUOTE NAME)
                           ((SOURCE1 (ECLECTOR.READER:UNQUOTE TENSOR-TYPE))
                            (SOURCE2 (ECLECTOR.READER:UNQUOTE TENSOR-TYPE))
                            &OPTIONAL TARGET)
                  (DECLARE (OPTIMIZE (SPEED 3)))
                  (WITH-COMPATIBILITY-TEST
                   ((ECLECTOR.READER:UNQUOTE TENSOR-TYPE))
                   (#S(FORMGREP:SYMREF
                       :NAME "WITH-EXPECTATIONS"
                       :QUALIFIER "POLICY-COND")
                    (> SPEED SAFETY)
                    ((ASSERTION (EQUALP (SHAPE SOURCE1) (SHAPE SOURCE2)))))
                   (LET ((TARGET
                          (OR TARGET
                              (EMPTY (SHAPE SOURCE1) :TYPE
                               '(ECLECTOR.READER:UNQUOTE SCALAR-TYPE)))))
                     (LET ((TARGET-ST
                            (#S(FORMGREP:SYMREF
                                :NAME "STORAGE"
                                :QUALIFIER "MAGICL")
                             TARGET))
                           (SOURCE1-ST
                            (#S(FORMGREP:SYMREF
                                :NAME "STORAGE"
                                :QUALIFIER "MAGICL")
                             SOURCE1))
                           (SOURCE2-ST
                            (#S(FORMGREP:SYMREF
                                :NAME "STORAGE"
                                :QUALIFIER "MAGICL")
                             SOURCE2)))
                       (DECLARE
                        (TYPE
                         (SIMPLE-ARRAY (ECLECTOR.READER:UNQUOTE SCALAR-TYPE))
                         TARGET-ST SOURCE1-ST SOURCE2-ST))
                       (MAP-INTO TARGET-ST #'(ECLECTOR.READER:UNQUOTE FUNCTION)
                                 SOURCE1-ST SOURCE2-ST))
                     TARGET))))))
    (DEF-OP .*-BLAS MATRIX/SINGLE-FLOAT SINGLE-FLOAT *)
    (DEF-OP .*-BLAS MATRIX/DOUBLE-FLOAT DOUBLE-FLOAT *)
    (DEF-OP ./-BLAS MATRIX/SINGLE-FLOAT SINGLE-FLOAT /)
    (DEF-OP ./-BLAS MATRIX/DOUBLE-FLOAT DOUBLE-FLOAT /)
    (DEF-OP .*-BLAS VECTOR/SINGLE-FLOAT SINGLE-FLOAT *)
    (DEF-OP .*-BLAS VECTOR/DOUBLE-FLOAT DOUBLE-FLOAT *)
    (DEF-OP ./-BLAS VECTOR/SINGLE-FLOAT SINGLE-FLOAT /)
    (DEF-OP ./-BLAS VECTOR/DOUBLE-FLOAT DOUBLE-FLOAT /))

[magicl/src/extensions/common/ptr-ref.lisp:4]
  (DEFGENERIC PTR-REF
      (M BASE I J)
    (:DOCUMENTATION
     "Accessor method for the pointer to the element in the I-th row and J-th column of a matrix M, assuming zero indexing.")
    (:METHOD
     ((M #S(FORMGREP:SYMREF :NAME "MATRIX" :QUALIFIER "MAGICL")) BASE I J)
     (#S(FORMGREP:SYMREF :NAME "WITH-EXPECTATIONS" :QUALIFIER "POLICY-COND")
      (> SPEED SAFETY)
      ((ASSERTION
        (#S(FORMGREP:SYMREF :NAME "VALID-INDEX-P" :QUALIFIER "MAGICL")
         (LIST I J)
         (#S(FORMGREP:SYMREF :NAME "SHAPE" :QUALIFIER "MAGICL") M))))
      (LET ((TYPE
             (#S(FORMGREP:SYMREF :NAME "ELEMENT-TYPE" :QUALIFIER "MAGICL") M)))
        (LET ((IDX
               (APPLY
                (ECASE
                    (#S(FORMGREP:SYMREF :NAME "LAYOUT" :QUALIFIER "MAGICL") M)
                  (:COLUMN-MAJOR
                   #'#S(FORMGREP:SYMREF
                        :NAME "MATRIX-COLUMN-MAJOR-INDEX"
                        :QUALIFIER "MAGICL"))
                  (:ROW-MAJOR
                   #'#S(FORMGREP:SYMREF
                        :NAME "MATRIX-ROW-MAJOR-INDEX"
                        :QUALIFIER "MAGICL")))
                I J (#S(FORMGREP:SYMREF :NAME "SHAPE" :QUALIFIER "MAGICL") M))))
          (COND ((SUBTYPEP TYPE 'SINGLE-FLOAT) (CFFI:MEM-APTR BASE :FLOAT IDX))
                ((SUBTYPEP TYPE 'DOUBLE-FLOAT)
                 (CFFI:MEM-APTR BASE :DOUBLE IDX))
                ((SUBTYPEP TYPE '(COMPLEX SINGLE-FLOAT))
                 (CFFI:MEM-APTR BASE :FLOAT (* 2 IDX)))
                ((SUBTYPEP TYPE '(COMPLEX DOUBLE-FLOAT))
                 (CFFI:MEM-APTR BASE :DOUBLE (* 2 IDX)))
                (T (ERROR "Incompatible element type ~a." TYPE))))))))

[magicl/src/extensions/lapack/lapack-csd.lisp:44]
  (DEFMETHOD CSD-2X2-BASIC
             ((UNITARY-MATRIX-2X2 MATRIX/COMPLEX-DOUBLE-FLOAT) P Q)
    "Returns the Cosine-Sine decomposition of an equipartitioned UNITARY-MATRIX-2x2. The values of P and Q are assumed to be equal to one and ignored. See the documentation of LAPACK-CSD for details about the returned values."
    (DECLARE
     (VALUES MATRIX/COMPLEX-DOUBLE-FLOAT MATRIX/COMPLEX-DOUBLE-FLOAT
             MATRIX/COMPLEX-DOUBLE-FLOAT MATRIX/COMPLEX-DOUBLE-FLOAT LIST)
     (IGNORABLE P Q)
     (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0) (SPACE 0)))
    (LET* ((DATA
            (#S(FORMGREP:SYMREF :NAME "STORAGE" :QUALIFIER "MAGICL")
             UNITARY-MATRIX-2X2))
           (A1 (AREF DATA 0))
           (A2 (AREF DATA 1))
           (A3 (AREF DATA 2))
           (A4 (AREF DATA 3))
           (C (ABS A1))
           (U1 (CIS (PHASE A1)))
           (S (ABS A2))
           (U2 (CIS (PHASE A2))))
      (DECLARE (TYPE (SIMPLE-ARRAY (COMPLEX DOUBLE-FLOAT) (4)) DATA)
               (TYPE (DOUBLE-FLOAT -1.0d0 1.0d0) C S)
               (TYPE (COMPLEX DOUBLE-FLOAT) U1 U2)
               (DYNAMIC-EXTENT C S U1 U2))
      (LET ((V2H
             (CONJUGATE
              (/ 1.0d0 (- (* C (CONJUGATE U2) A4) (* S (CONJUGATE U1) A3)))))
            (MU1 (EMPTY '(1 1) :TYPE '(COMPLEX DOUBLE-FLOAT)))
            (MU2 (EMPTY '(1 1) :TYPE '(COMPLEX DOUBLE-FLOAT)))
            (MV1H (EMPTY '(1 1) :TYPE '(COMPLEX DOUBLE-FLOAT)))
            (MV2H (EMPTY '(1 1) :TYPE '(COMPLEX DOUBLE-FLOAT))))
        (MACROLET ((MATRIX-1X1-DATA (MATRIX)
                     (ECLECTOR.READER:QUASIQUOTE
                      (THE (SIMPLE-ARRAY (COMPLEX DOUBLE-FLOAT) (1))
                           (#S(FORMGREP:SYMREF
                               :NAME "STORAGE"
                               :QUALIFIER "MAGICL")
                            (ECLECTOR.READER:UNQUOTE MATRIX))))))
          (SETF (AREF (MATRIX-1X1-DATA MU1) 0) U1
                (AREF (MATRIX-1X1-DATA MU2) 0) U2
                (AREF (MATRIX-1X1-DATA MV1H) 0) #C(1.0d0 0.0d0)
                (AREF (MATRIX-1X1-DATA MV2H) 0) V2H))
        (VALUES MU1 MU2 MV1H MV2H (LIST (ATAN S C))))))

[magicl/src/extensions/lapack/lapack-templates.lisp:12]
  (DEFUN GENERATE-LAPACK-MULT-FOR-TYPE
         (MATRIX-CLASS VECTOR-CLASS TYPE MATRIX-MATRIX-FUNCTION
          MATRIX-VECTOR-FUNCTION)
    (ECLECTOR.READER:QUASIQUOTE
     (PROGN
      (DEFMETHOD MULT-EXTENSION
                 ((A (ECLECTOR.READER:UNQUOTE MATRIX-CLASS))
                  (B (ECLECTOR.READER:UNQUOTE MATRIX-CLASS))
                  &KEY TARGET (ALPHA (ECLECTOR.READER:UNQUOTE (COERCE 1 TYPE)))
                  (BETA (ECLECTOR.READER:UNQUOTE (COERCE 0 TYPE))) (TRANSA :N)
                  (TRANSB :N))
        (#S(FORMGREP:SYMREF :NAME "WITH-EXPECTATIONS" :QUALIFIER "POLICY-COND")
         (> SPEED SAFETY)
         ((TYPE (MEMBER NIL :N :T :C) TRANSA)
          (TYPE (MEMBER NIL :N :T :C) TRANSB))
         (LET* ((M
                 (IF (EQ :N TRANSA)
                     (NROWS A)
                     (NCOLS A)))
                (K
                 (IF (EQ :N TRANSA)
                     (NCOLS A)
                     (NROWS A)))
                (N
                 (IF (EQ :N TRANSB)
                     (NCOLS B)
                     (NROWS B)))
                (BROWS
                 (IF (EQ :N TRANSB)
                     (NROWS B)
                     (NCOLS B))))
           (#S(FORMGREP:SYMREF
               :NAME "WITH-EXPECTATIONS"
               :QUALIFIER "POLICY-COND")
            (> SPEED SAFETY)
            ((ASSERTION (= K BROWS))
             (ASSERTION (OR (NOT TARGET) (EQUAL (SHAPE TARGET) (LIST M N)))))
            (LET ((TA
                   (IF (EQL :ROW-MAJOR (LAYOUT A))
                       (CASE TRANSA
                         (:N :T)
                         (:T :N)
                         (:C
                          (ERROR
                           "Specifying TRANSA to be :C is not allowed if A is ROW-MAJOR")))
                       TRANSA))
                  (TB
                   (IF (EQL :ROW-MAJOR (LAYOUT B))
                       (CASE TRANSB
                         (:N :T)
                         (:T :N)
                         (:C
                          (ERROR
                           "Specifying TRANSB to be :C is not allowed if B is ROW-MAJOR")))
                       TRANSB))
                  (TARGET
                   (OR TARGET
                       (EMPTY (LIST M N) :TYPE
                        '(ECLECTOR.READER:UNQUOTE TYPE)))))
              ((ECLECTOR.READER:UNQUOTE MATRIX-MATRIX-FUNCTION)
               (ECASE TA (:T "T") (:C "C") (:N "N"))
               (ECASE TB (:T "T") (:C "C") (:N "N")) M N K ALPHA
               (#S(FORMGREP:SYMREF :NAME "STORAGE" :QUALIFIER "MAGICL") A)
               (IF (EQL :N TA)
                   M
                   K)
               (#S(FORMGREP:SYMREF :NAME "STORAGE" :QUALIFIER "MAGICL") B)
               (IF (EQL :N TB)
                   K
                   N)
               BETA
               (#S(FORMGREP:SYMREF :NAME "STORAGE" :QUALIFIER "MAGICL") TARGET)
               M)
              TARGET)))))
      (DEFMETHOD MULT-EXTENSION
                 ((A (ECLECTOR.READER:UNQUOTE MATRIX-CLASS))
                  (X (ECLECTOR.READER:UNQUOTE VECTOR-CLASS))
                  &KEY TARGET (ALPHA (ECLECTOR.READER:UNQUOTE (COERCE 1 TYPE)))
                  (BETA (ECLECTOR.READER:UNQUOTE (COERCE 0 TYPE))) (TRANSA :N)
                  TRANSB)
        (#S(FORMGREP:SYMREF :NAME "WITH-EXPECTATIONS" :QUALIFIER "POLICY-COND")
         (> SPEED SAFETY)
         ((TYPE (MEMBER NIL :N :T :C) TRANSA) (ASSERTION (NULL TRANSB)))
         (LET* ((M-OP
                 (IF (EQ :N TRANSA)
                     (NROWS A)
                     (NCOLS A)))
                (N-OP
                 (IF (EQ :N TRANSA)
                     (NCOLS A)
                     (NROWS A))))
           (#S(FORMGREP:SYMREF
               :NAME "WITH-EXPECTATIONS"
               :QUALIFIER "POLICY-COND")
            (> SPEED SAFETY)
            ((ASSERTION (= N-OP (SIZE X)))
             (ASSERTION (OR (NOT TARGET) (EQUAL (SHAPE TARGET) (LIST M-OP)))))
            (LET ((TA
                   (IF (EQL :ROW-MAJOR (LAYOUT A))
                       (CASE TRANSA
                         (:N :T)
                         (:T :N)
                         (:C
                          (ERROR
                           "Specifying TRANS to be :C is not allowed if A is ROW-MAJOR")))
                       TRANSA))
                  (TARGET
                   (OR TARGET
                       (EMPTY (LIST M-OP) :TYPE
                        '(ECLECTOR.READER:UNQUOTE TYPE)))))
              ((ECLECTOR.READER:UNQUOTE MATRIX-VECTOR-FUNCTION)
               (ECASE TA (:T "T") (:C "C") (:N "N"))
               (IF (EQL :COLUMN-MAJOR (LAYOUT A))
                   (NROWS A)
                   (NCOLS A))
               (IF (EQL :COLUMN-MAJOR (LAYOUT A))
                   (NCOLS A)
                   (NROWS A))
               ALPHA
               (#S(FORMGREP:SYMREF :NAME "STORAGE" :QUALIFIER "MAGICL") A)
               (IF (EQL :COLUMN-MAJOR (LAYOUT A))
                   (NROWS A)
                   (NCOLS A))
               (#S(FORMGREP:SYMREF :NAME "STORAGE" :QUALIFIER "MAGICL") X) 1
               BETA
               (#S(FORMGREP:SYMREF :NAME "STORAGE" :QUALIFIER "MAGICL") TARGET)
               1)
              TARGET))))))))

[magicl/src/extensions/lapack/lapack-templates.lisp:246]
  (DEFUN GENERATE-LAPACK-EIG-FOR-TYPE
         (CLASS TYPE EIG-FUNCTION &OPTIONAL REAL-TYPE)
    (ECLECTOR.READER:QUASIQUOTE
     (DEFMETHOD LAPACK-EIG ((M (ECLECTOR.READER:UNQUOTE CLASS)))
       (#S(FORMGREP:SYMREF :NAME "WITH-EXPECTATIONS" :QUALIFIER "POLICY-COND")
        (> SPEED SAFETY) ((ASSERTION (SQUARE-MATRIX-P M)))
        (LET ((ROWS (NROWS M)) (COLS (NCOLS M)) (A-TENSOR (DEEP-COPY-TENSOR M)))
          (WHEN (EQL :ROW-MAJOR (LAYOUT M)) (TRANSPOSE! A-TENSOR))
          (LET ((JOBVL "N")
                (JOBVR "V")
                (A
                 (#S(FORMGREP:SYMREF :NAME "STORAGE" :QUALIFIER "MAGICL")
                  A-TENSOR))
                (ECLECTOR.READER:UNQUOTE-SPLICING
                 (IF REAL-TYPE
                     (ECLECTOR.READER:QUASIQUOTE
                      ((W
                        (MAKE-ARRAY ROWS :ELEMENT-TYPE
                                    '(ECLECTOR.READER:UNQUOTE TYPE)))))
                     (ECLECTOR.READER:QUASIQUOTE
                      ((WR
                        (MAKE-ARRAY ROWS :ELEMENT-TYPE
                                    '(ECLECTOR.READER:UNQUOTE TYPE)))
                       (WI
                        (MAKE-ARRAY ROWS :ELEMENT-TYPE
                                    '(ECLECTOR.READER:UNQUOTE TYPE)))))))
                (VL
                 (MAKE-ARRAY ROWS :ELEMENT-TYPE
                             '(ECLECTOR.READER:UNQUOTE TYPE)))
                (VR
                 (MAKE-ARRAY (* ROWS ROWS) :ELEMENT-TYPE
                             '(ECLECTOR.READER:UNQUOTE TYPE)))
                (LWORK -1)
                (INFO 0)
                (ECLECTOR.READER:UNQUOTE-SPLICING
                 (WHEN REAL-TYPE
                   (ECLECTOR.READER:QUASIQUOTE
                    ((RWORK
                      (MAKE-ARRAY (* 2 ROWS) :ELEMENT-TYPE
                                  '(ECLECTOR.READER:UNQUOTE REAL-TYPE))))))))
            (LET ((WORK
                   (MAKE-ARRAY (MAX 1 LWORK) :ELEMENT-TYPE
                               '(ECLECTOR.READER:UNQUOTE TYPE))))
              ((ECLECTOR.READER:UNQUOTE EIG-FUNCTION) JOBVL JOBVR ROWS A ROWS
               (ECLECTOR.READER:UNQUOTE-SPLICING
                (IF REAL-TYPE
                    (ECLECTOR.READER:QUASIQUOTE (W))
                    (ECLECTOR.READER:QUASIQUOTE (WR WI))))
               VL 1 VR ROWS WORK LWORK
               (ECLECTOR.READER:UNQUOTE-SPLICING
                (WHEN REAL-TYPE (ECLECTOR.READER:QUASIQUOTE (RWORK))))
               INFO)
              (SETF LWORK (TRUNCATE (REALPART (ROW-MAJOR-AREF WORK 0))))
              (SETF WORK
                      (MAKE-ARRAY (MAX 1 LWORK) :ELEMENT-TYPE
                                  '(ECLECTOR.READER:UNQUOTE TYPE)))
              ((ECLECTOR.READER:UNQUOTE EIG-FUNCTION) JOBVL JOBVR ROWS A ROWS
               (ECLECTOR.READER:UNQUOTE-SPLICING
                (IF REAL-TYPE
                    (ECLECTOR.READER:QUASIQUOTE (W))
                    (ECLECTOR.READER:QUASIQUOTE (WR WI))))
               VL 1 VR ROWS WORK LWORK
               (ECLECTOR.READER:UNQUOTE-SPLICING
                (WHEN REAL-TYPE (ECLECTOR.READER:QUASIQUOTE (RWORK))))
               INFO)
              (VALUES
               (COERCE
                (ECLECTOR.READER:UNQUOTE-SPLICING
                 (IF REAL-TYPE
                     (ECLECTOR.READER:QUASIQUOTE (W))
                     (ECLECTOR.READER:QUASIQUOTE (WR))))
                'LIST)
               (FROM-ARRAY VR (LIST ROWS COLS) :INPUT-LAYOUT
                :COLUMN-MAJOR)))))))))

[magicl/src/extensions/lapack/lapack-templates.lisp:278]
  (DEFUN GENERATE-LAPACK-HERMITIAN-EIG-FOR-TYPE
         (CLASS TYPE EIG-FUNCTION REAL-TYPE)
    (ECLECTOR.READER:QUASIQUOTE
     (DEFMETHOD LAPACK-HERMITIAN-EIG ((M (ECLECTOR.READER:UNQUOTE CLASS)))
       (#S(FORMGREP:SYMREF :NAME "WITH-EXPECTATIONS" :QUALIFIER "POLICY-COND")
        (> SPEED SAFETY)
        ((ASSERTION (SQUARE-MATRIX-P M)) (ASSERTION (HERMITIAN-MATRIX-P M)))
        (LET ((ROWS (NROWS M)) (A-TENSOR (DEEP-COPY-TENSOR M)))
          (WHEN (EQL :ROW-MAJOR (LAYOUT M)) (TRANSPOSE! A-TENSOR))
          (LET ((JOBZ "V")
                (UPLO "U")
                (N ROWS)
                (A
                 (#S(FORMGREP:SYMREF :NAME "STORAGE" :QUALIFIER "MAGICL")
                  A-TENSOR))
                (LDA ROWS)
                (W
                 (MAKE-ARRAY ROWS :ELEMENT-TYPE
                             '(ECLECTOR.READER:UNQUOTE REAL-TYPE)))
                (WORK
                 (MAKE-ARRAY 1 :ELEMENT-TYPE '(ECLECTOR.READER:UNQUOTE TYPE)))
                (LWORK -1)
                (RWORK
                 (MAKE-ARRAY (- (* 3 ROWS) 2) :ELEMENT-TYPE
                             '(ECLECTOR.READER:UNQUOTE REAL-TYPE)))
                (INFO 0))
            ((ECLECTOR.READER:UNQUOTE EIG-FUNCTION) JOBZ UPLO N A LDA W WORK
             LWORK RWORK INFO)
            (SETF LWORK (TRUNCATE (REALPART (ROW-MAJOR-AREF WORK 0))))
            (SETF WORK
                    (MAKE-ARRAY (MAX 1 LWORK) :ELEMENT-TYPE
                                '(ECLECTOR.READER:UNQUOTE TYPE)))
            ((ECLECTOR.READER:UNQUOTE EIG-FUNCTION) JOBZ UPLO N A LDA W WORK
             LWORK RWORK INFO)
            (VALUES (COERCE W 'LIST) A-TENSOR)))))))

[magicl/src/extensions/lapack/lapack-templates.lisp:305]
  (DEFUN GENERATE-LAPACK-QL-QR-RQ-LQ-FOR-TYPE
         (CLASS TYPE QL-FUNCTION QR-FUNCTION RQ-FUNCTION LQ-FUNCTION
          QL-Q-FUNCTION QR-Q-FUNCTION RQ-Q-FUNCTION LQ-Q-FUNCTION)
    (ECLECTOR.READER:QUASIQUOTE
     (PROGN
      (DEFMETHOD QR-EXTENSION ((M (ECLECTOR.READER:UNQUOTE CLASS)))
        (#S(FORMGREP:SYMREF :NAME "WITH-EXPECTATIONS" :QUALIFIER "POLICY-COND")
         (> SPEED SAFETY) ((ASSERTION (<= (NCOLS M) (NROWS M))))
         (LET ((ROWS (NROWS M)) (COLS (NCOLS M)))
           (MULTIPLE-VALUE-BIND (A TAU)
               (LAPACK-QR M)
             (LET* ((R (UPPER-TRIANGULAR A :SQUARE T)) (Q (LAPACK-QR-Q A TAU)))
               (DOTIMES (J COLS)
                 (LET ((DIAG-ELT (TREF R J J)))
                   (ASSERT (ZEROP (IMAGPART DIAG-ELT)) NIL
                           "Diagonal element R_~D~D=~A is not real" J J
                           DIAG-ELT)
                   (SETF DIAG-ELT (REALPART DIAG-ELT))
                   (WHEN (MINUSP DIAG-ELT)
                     (DOTIMES (I ROWS)
                       (WHEN (<= J I (1- COLS))
                         (SETF (TREF R J I) (- (TREF R J I))))
                       (SETF (TREF Q I J) (- (TREF Q I J)))))))
               (VALUES Q R))))))
      (DEFMETHOD QL-EXTENSION ((M (ECLECTOR.READER:UNQUOTE CLASS)))
        (#S(FORMGREP:SYMREF :NAME "WITH-EXPECTATIONS" :QUALIFIER "POLICY-COND")
         (> SPEED SAFETY) ((ASSERTION (<= (NCOLS M) (NROWS M))))
         (LET ((ROWS (NROWS M)) (COLS (NCOLS M)))
           (MULTIPLE-VALUE-BIND (A TAU)
               (LAPACK-QL M)
             (LET* ((L (LOWER-TRIANGULAR A :SQUARE T)) (Q (LAPACK-QL-Q A TAU)))
               (DOTIMES (J COLS)
                 (LET ((DIAG-ELT (TREF L J J)))
                   (ASSERT (ZEROP (IMAGPART DIAG-ELT)) NIL
                           "Diagonal element L_~D~D=~A is not real" J J
                           DIAG-ELT)
                   (SETF DIAG-ELT (REALPART DIAG-ELT))
                   (WHEN (MINUSP DIAG-ELT)
                     (DOTIMES (I ROWS)
                       (WHEN (<= I J) (SETF (TREF L J I) (- (TREF L J I))))
                       (SETF (TREF Q I J) (- (TREF Q I J)))))))
               (VALUES Q L))))))
      (DEFMETHOD RQ-EXTENSION ((M (ECLECTOR.READER:UNQUOTE CLASS)))
        (#S(FORMGREP:SYMREF :NAME "WITH-EXPECTATIONS" :QUALIFIER "POLICY-COND")
         (> SPEED SAFETY) ((ASSERTION (>= (NCOLS M) (NROWS M))))
         (LET ((ROWS (NROWS M)) (COLS (NCOLS M)))
           (MULTIPLE-VALUE-BIND (A TAU)
               (LAPACK-RQ M)
             (LET* ((R (UPPER-TRIANGULAR A :SQUARE T)) (Q (LAPACK-RQ-Q A TAU)))
               (DOTIMES (I ROWS)
                 (LET ((DIAG-ELT (TREF R I I)))
                   (ASSERT (ZEROP (IMAGPART DIAG-ELT)) NIL
                           "Diagonal element R_~D~D=~A is not real" I I
                           DIAG-ELT)
                   (SETF DIAG-ELT (REALPART DIAG-ELT))
                   (WHEN (MINUSP DIAG-ELT)
                     (DOTIMES (J COLS)
                       (WHEN (<= J I) (SETF (TREF R J I) (- (TREF R J I))))
                       (SETF (TREF Q I J) (- (TREF Q I J)))))))
               (VALUES R Q))))))
      (DEFMETHOD LQ-EXTENSION ((M (ECLECTOR.READER:UNQUOTE CLASS)))
        (#S(FORMGREP:SYMREF :NAME "WITH-EXPECTATIONS" :QUALIFIER "POLICY-COND")
         (> SPEED SAFETY) ((ASSERTION (>= (NCOLS M) (NROWS M))))
         (LET ((ROWS (NROWS M)) (COLS (NCOLS M)))
           (MULTIPLE-VALUE-BIND (A TAU)
               (LAPACK-LQ M)
             (LET* ((L (LOWER-TRIANGULAR A :SQUARE T)) (Q (LAPACK-LQ-Q A TAU)))
               (DOTIMES (I ROWS)
                 (LET ((DIAG-ELT (TREF L I I)))
                   (ASSERT (ZEROP (IMAGPART DIAG-ELT)) NIL
                           "Diagonal element L_~D~D=~A is not real" I I
                           DIAG-ELT)
                   (SETF DIAG-ELT (REALPART DIAG-ELT))
                   (WHEN (MINUSP DIAG-ELT)
                     (DOTIMES (J COLS)
                       (WHEN (<= I J (1- ROWS))
                         (SETF (TREF L J I) (- (TREF L J I))))
                       (SETF (TREF Q I J) (- (TREF Q I J)))))))
               (VALUES L Q))))))
      (DEFMETHOD LAPACK-QR ((M (ECLECTOR.READER:UNQUOTE CLASS)))
        (LET* ((ROWS (NROWS M))
               (COLS (NCOLS M))
               (A-TENSOR (DEEP-COPY-TENSOR M))
               (A
                (#S(FORMGREP:SYMREF :NAME "STORAGE" :QUALIFIER "MAGICL")
                 A-TENSOR))
               (LWORK -1)
               (INFO 0))
          (WHEN (EQL :ROW-MAJOR (LAYOUT M)) (TRANSPOSE! A-TENSOR))
          (LET ((LDA ROWS)
                (TAU
                 (MAKE-ARRAY (MIN ROWS COLS) :ELEMENT-TYPE
                             '(ECLECTOR.READER:UNQUOTE TYPE)))
                (WORK
                 (MAKE-ARRAY (MAX 1 LWORK) :ELEMENT-TYPE
                             '(ECLECTOR.READER:UNQUOTE TYPE))))
            ((ECLECTOR.READER:UNQUOTE QR-FUNCTION) ROWS COLS A LDA TAU WORK
             LWORK INFO)
            (SETF LWORK (ROUND (REALPART (AREF WORK 0))))
            (SETF WORK
                    (MAKE-ARRAY (MAX 1 LWORK) :ELEMENT-TYPE
                                '(ECLECTOR.READER:UNQUOTE TYPE)))
            ((ECLECTOR.READER:UNQUOTE QR-FUNCTION) ROWS COLS A LDA TAU WORK
             LWORK INFO)
            (VALUES A-TENSOR
                    (FROM-ARRAY TAU (LIST (MIN ROWS COLS)) :TYPE
                     '(ECLECTOR.READER:UNQUOTE TYPE) :INPUT-LAYOUT
                     :COLUMN-MAJOR)))))
      (DEFMETHOD LAPACK-QL ((M (ECLECTOR.READER:UNQUOTE CLASS)))
        (LET* ((ROWS (NROWS M))
               (COLS (NCOLS M))
               (A-TENSOR (DEEP-COPY-TENSOR M))
               (A
                (#S(FORMGREP:SYMREF :NAME "STORAGE" :QUALIFIER "MAGICL")
                 A-TENSOR))
               (LWORK -1)
               (INFO 0))
          (WHEN (EQL :ROW-MAJOR (LAYOUT M)) (TRANSPOSE! A-TENSOR))
          (LET ((LDA ROWS)
                (TAU
                 (MAKE-ARRAY (MIN ROWS COLS) :ELEMENT-TYPE
                             '(ECLECTOR.READER:UNQUOTE TYPE)))
                (WORK
                 (MAKE-ARRAY (MAX 1 LWORK) :ELEMENT-TYPE
                             '(ECLECTOR.READER:UNQUOTE TYPE))))
            ((ECLECTOR.READER:UNQUOTE QL-FUNCTION) ROWS COLS A LDA TAU WORK
             LWORK INFO)
            (SETF LWORK (ROUND (REALPART (AREF WORK 0))))
            (SETF WORK
                    (MAKE-ARRAY (MAX 1 LWORK) :ELEMENT-TYPE
                                '(ECLECTOR.READER:UNQUOTE TYPE)))
            ((ECLECTOR.READER:UNQUOTE QL-FUNCTION) ROWS COLS A LDA TAU WORK
             LWORK INFO)
            (VALUES A-TENSOR
                    (FROM-ARRAY TAU (LIST (MIN ROWS COLS)) :TYPE
                     '(ECLECTOR.READER:UNQUOTE TYPE) :INPUT-LAYOUT
                     :COLUMN-MAJOR)))))
      (DEFMETHOD LAPACK-RQ ((M (ECLECTOR.READER:UNQUOTE CLASS)))
        (LET* ((ROWS (NROWS M))
               (COLS (NCOLS M))
               (A-TENSOR (DEEP-COPY-TENSOR M))
               (A
                (#S(FORMGREP:SYMREF :NAME "STORAGE" :QUALIFIER "MAGICL")
                 A-TENSOR))
               (LWORK -1)
               (INFO 0))
          (WHEN (EQL :ROW-MAJOR (LAYOUT M)) (TRANSPOSE! A-TENSOR))
          (LET ((LDA ROWS)
                (TAU
                 (MAKE-ARRAY (MIN ROWS COLS) :ELEMENT-TYPE
                             '(ECLECTOR.READER:UNQUOTE TYPE)))
                (WORK
                 (MAKE-ARRAY (MAX 1 LWORK) :ELEMENT-TYPE
                             '(ECLECTOR.READER:UNQUOTE TYPE))))
            ((ECLECTOR.READER:UNQUOTE RQ-FUNCTION) ROWS COLS A LDA TAU WORK
             LWORK INFO)
            (SETF LWORK (ROUND (REALPART (AREF WORK 0))))
            (SETF WORK
                    (MAKE-ARRAY (MAX 1 LWORK) :ELEMENT-TYPE
                                '(ECLECTOR.READER:UNQUOTE TYPE)))
            ((ECLECTOR.READER:UNQUOTE RQ-FUNCTION) ROWS COLS A LDA TAU WORK
             LWORK INFO)
            (VALUES A-TENSOR
                    (FROM-ARRAY TAU (LIST (MIN ROWS COLS)) :TYPE
                     '(ECLECTOR.READER:UNQUOTE TYPE) :INPUT-LAYOUT
                     :COLUMN-MAJOR)))))
      (DEFMETHOD LAPACK-LQ ((M (ECLECTOR.READER:UNQUOTE CLASS)))
        (LET* ((ROWS (NROWS M))
               (COLS (NCOLS M))
               (A-TENSOR (DEEP-COPY-TENSOR M))
               (A
                (#S(FORMGREP:SYMREF :NAME "STORAGE" :QUALIFIER "MAGICL")
                 A-TENSOR))
               (LWORK -1)
               (INFO 0))
          (WHEN (EQL :ROW-MAJOR (LAYOUT M)) (TRANSPOSE! A-TENSOR))
          (LET ((LDA ROWS)
                (TAU
                 (MAKE-ARRAY (MIN ROWS COLS) :ELEMENT-TYPE
                             '(ECLECTOR.READER:UNQUOTE TYPE)))
                (WORK
                 (MAKE-ARRAY (MAX 1 LWORK) :ELEMENT-TYPE
                             '(ECLECTOR.READER:UNQUOTE TYPE))))
            ((ECLECTOR.READER:UNQUOTE LQ-FUNCTION) ROWS COLS A LDA TAU WORK
             LWORK INFO)
            (SETF LWORK (ROUND (REALPART (AREF WORK 0))))
            (SETF WORK
                    (MAKE-ARRAY (MAX 1 LWORK) :ELEMENT-TYPE
                                '(ECLECTOR.READER:UNQUOTE TYPE)))
            ((ECLECTOR.READER:UNQUOTE LQ-FUNCTION) ROWS COLS A LDA TAU WORK
             LWORK INFO)
            (VALUES A-TENSOR
                    (FROM-ARRAY TAU (LIST (MIN ROWS COLS)) :TYPE
                     '(ECLECTOR.READER:UNQUOTE TYPE) :INPUT-LAYOUT
                     :COLUMN-MAJOR)))))
      (DEFMETHOD LAPACK-QR-Q ((M (ECLECTOR.READER:UNQUOTE CLASS)) TAU)
        (LET ((M (NROWS M))
              (N (NCOLS M))
              (A (#S(FORMGREP:SYMREF :NAME "STORAGE" :QUALIFIER "MAGICL") M))
              (K (SIZE TAU))
              (ATAU
               (#S(FORMGREP:SYMREF :NAME "STORAGE" :QUALIFIER "MAGICL") TAU))
              (LWORK -1)
              (INFO 0))
          (LET ((LDA M)
                (WORK
                 (MAKE-ARRAY (MAX 1 LWORK) :ELEMENT-TYPE
                             '(ECLECTOR.READER:UNQUOTE TYPE))))
            ((ECLECTOR.READER:UNQUOTE QR-Q-FUNCTION) M N K A LDA ATAU WORK
             LWORK INFO)
            (SETF LWORK (ROUND (REALPART (AREF WORK 0))))
            (SETF WORK
                    (MAKE-ARRAY (MAX 1 LWORK) :ELEMENT-TYPE
                                '(ECLECTOR.READER:UNQUOTE TYPE)))
            ((ECLECTOR.READER:UNQUOTE QR-Q-FUNCTION) M N K A LDA ATAU WORK
             LWORK INFO)
            (FROM-ARRAY A (LIST M K) :INPUT-LAYOUT :COLUMN-MAJOR))))
      (DEFMETHOD LAPACK-QL-Q ((M (ECLECTOR.READER:UNQUOTE CLASS)) TAU)
        (LET ((M (NROWS M))
              (N (NCOLS M))
              (A (#S(FORMGREP:SYMREF :NAME "STORAGE" :QUALIFIER "MAGICL") M))
              (K (SIZE TAU))
              (ATAU
               (#S(FORMGREP:SYMREF :NAME "STORAGE" :QUALIFIER "MAGICL") TAU))
              (LWORK -1)
              (INFO 0))
          (LET ((LDA M)
                (WORK
                 (MAKE-ARRAY (MAX 1 LWORK) :ELEMENT-TYPE
                             '(ECLECTOR.READER:UNQUOTE TYPE))))
            ((ECLECTOR.READER:UNQUOTE QL-Q-FUNCTION) M N K A LDA ATAU WORK
             LWORK INFO)
            (SETF LWORK (ROUND (REALPART (AREF WORK 0))))
            (SETF WORK
                    (MAKE-ARRAY (MAX 1 LWORK) :ELEMENT-TYPE
                                '(ECLECTOR.READER:UNQUOTE TYPE)))
            ((ECLECTOR.READER:UNQUOTE QL-Q-FUNCTION) M N K A LDA ATAU WORK
             LWORK INFO)
            (FROM-ARRAY A (LIST M N) :INPUT-LAYOUT :COLUMN-MAJOR))))
      (DEFMETHOD LAPACK-RQ-Q ((M (ECLECTOR.READER:UNQUOTE CLASS)) TAU)
        (LET ((M (NROWS M))
              (N (NCOLS M))
              (A (#S(FORMGREP:SYMREF :NAME "STORAGE" :QUALIFIER "MAGICL") M))
              (K (SIZE TAU))
              (ATAU
               (#S(FORMGREP:SYMREF :NAME "STORAGE" :QUALIFIER "MAGICL") TAU))
              (LWORK -1)
              (INFO 0))
          (LET ((LDA M)
                (WORK
                 (MAKE-ARRAY (MAX 1 LWORK) :ELEMENT-TYPE
                             '(ECLECTOR.READER:UNQUOTE TYPE))))
            ((ECLECTOR.READER:UNQUOTE RQ-Q-FUNCTION) M N K A LDA ATAU WORK
             LWORK INFO)
            (SETF LWORK (ROUND (REALPART (AREF WORK 0))))
            (SETF WORK
                    (MAKE-ARRAY (MAX 1 LWORK) :ELEMENT-TYPE
                                '(ECLECTOR.READER:UNQUOTE TYPE)))
            ((ECLECTOR.READER:UNQUOTE RQ-Q-FUNCTION) M N K A LDA ATAU WORK
             LWORK INFO)
            (FROM-ARRAY A (LIST M N) :INPUT-LAYOUT :COLUMN-MAJOR))))
      (DEFMETHOD LAPACK-LQ-Q ((M (ECLECTOR.READER:UNQUOTE CLASS)) TAU)
        (LET ((M (NROWS M))
              (N (NCOLS M))
              (A (#S(FORMGREP:SYMREF :NAME "STORAGE" :QUALIFIER "MAGICL") M))
              (K (SIZE TAU))
              (ATAU
               (#S(FORMGREP:SYMREF :NAME "STORAGE" :QUALIFIER "MAGICL") TAU))
              (LWORK -1)
              (INFO 0))
          (LET ((LDA M)
                (WORK
                 (MAKE-ARRAY (MAX 1 LWORK) :ELEMENT-TYPE
                             '(ECLECTOR.READER:UNQUOTE TYPE))))
            ((ECLECTOR.READER:UNQUOTE LQ-Q-FUNCTION) M N K A LDA ATAU WORK
             LWORK INFO)
            (SETF LWORK (ROUND (REALPART (AREF WORK 0))))
            (SETF WORK
                    (MAKE-ARRAY (MAX 1 LWORK) :ELEMENT-TYPE
                                '(ECLECTOR.READER:UNQUOTE TYPE)))
            ((ECLECTOR.READER:UNQUOTE LQ-Q-FUNCTION) M N K A LDA ATAU WORK
             LWORK INFO)
            (FROM-ARRAY A (LIST M N) :INPUT-LAYOUT :COLUMN-MAJOR)))))))

[magicl/src/generate-interface/generate-interface.lisp:13]
  (DECLAIM (OPTIMIZE (SAFETY 3) (DEBUG 3) (SPEED 1)))

[magicl/src/generate-interface/generate-interface.lisp:447]
  (DEFUN GENERATE-BINDINGS-FILE
         (FILENAME PACKAGE-NAME BINDINGS &OPTIONAL (OUTDIR *OUTDIR*))
    "This does the bulk of the work in getting things automagically
done, and is used by generate-blas-bindings etc to automagically do
the CFFI binding file."
    (LET ((*PRINT-PRETTY* T))
      (WITH-OPEN-FILE
          (F (MAKE-PATHNAME :NAME FILENAME :TYPE "lisp" :DEFAULTS OUTDIR)
           :DIRECTION :OUTPUT :IF-EXISTS :SUPERSEDE)
        (MULTIPLE-VALUE-BIND
            (SECOND MINUTE HOUR DATE MONTH YEAR DAY-OF-WEEK DST-P TZ)
            (GET-DECODED-TIME)
          (DECLARE (IGNORE DAY-OF-WEEK DST-P))
          (FORMAT F
                  ";;;; Generated on ~d/~2,'0d/~d at ~2,'0d:~2,'0d:~2,'0d (UTC~@d)."
                  MONTH DATE YEAR HOUR MINUTE SECOND (- TZ)))
        (TERPRI F)
        (TERPRI F)
        (PRIN1
         (ECLECTOR.READER:QUASIQUOTE
          (DECLAIM (OPTIMIZE (SPEED 0) SAFETY DEBUG COMPILATION-SPEED)))
         F)
        (TERPRI F)
        (TERPRI F)
        (PRIN1
         (ECLECTOR.READER:QUASIQUOTE
          (IN-PACKAGE (ECLECTOR.READER:UNQUOTE PACKAGE-NAME)))
         F)
        (TERPRI F)
        (TERPRI F)
        (DOLIST (FORM BINDINGS)
          (COND
           ((EQ 'CFFI:DEFCFUN (CAR FORM))
            (LET ((NAME (CADADR FORM)))
              (DECLARE (IGNORE NAME))
              (PRIN1 FORM F)
              (TERPRI F)
              (TERPRI F)))
           ((EQ 'DEFUN (CAR FORM))
            (LET ((NAME (CADR FORM)))
              (DECLARE (IGNORE NAME))
              (PRIN1 FORM F)
              (TERPRI F)
              (TERPRI F)))
           (T (PRIN1 FORM F) (TERPRI F) (TERPRI F))))
        (WRITE-LINE ";;; End of file." F)
        NIL)))

[magicl/src/high-level/abstract-tensor.lisp:54]
  (DEFGENERIC LISP-ARRAY
      (TENSOR &OPTIONAL TARGET)
    (:DOCUMENTATION "Return a lisp array containing the data from the tensor

If TARGET is specified then the contents of the tensor are copied into the array.
In the event TARGET is not specified, the result may return an array sharing memory with the input tensor.")
    (:METHOD ((TENSOR ABSTRACT-TENSOR) &OPTIONAL TARGET)
     (#S(FORMGREP:SYMREF :NAME "WITH-EXPECTATIONS" :QUALIFIER "POLICY-COND")
      (> SPEED SAFETY)
      ((ASSERTION
        (OR (NULL TARGET)
            (AND (= (ORDER TENSOR) (ARRAY-RANK TARGET))
                 (EQUAL (SHAPE TENSOR) (ARRAY-DIMENSIONS TARGET))))))
      (LET ((ARR
             (OR TARGET
                 (MAKE-ARRAY (SHAPE TENSOR) :ELEMENT-TYPE
                             (ELEMENT-TYPE TENSOR)))))
        (MAP-INDEXES (SHAPE TENSOR)
         (LAMBDA (&REST POS)
           (LET ((VAL (APPLY #'TREF TENSOR POS)))
             (APPLY #'(SETF AREF) VAL ARR POS))))
        ARR))))

[magicl/src/high-level/abstract-tensor.lisp:99]
  (DEFGENERIC MAP-TO
      (FUNCTION SOURCE TARGET)
    (:DOCUMENTATION
     "Map elements of SOURCE by replacing the corresponding element of TARGET the output of FUNCTION on the source element")
    (:METHOD (#'FUNCTION (SOURCE ABSTRACT-TENSOR) (TARGET ABSTRACT-TENSOR))
     (#S(FORMGREP:SYMREF :NAME "WITH-EXPECTATIONS" :QUALIFIER "POLICY-COND")
      (> SPEED SAFETY) ((ASSERTION (EQUALP (SHAPE SOURCE) (SHAPE TARGET))))
      (MAP-INDEXES (SHAPE SOURCE)
       (LAMBDA (&REST DIMS)
         (APPLY #'(SETF TREF) (FUNCALL FUNCTION (APPLY #'TREF SOURCE DIMS))
                TARGET DIMS))))))

[magicl/src/high-level/abstract-tensor.lisp:142]
  (DEFGENERIC SLICE
      (TENSOR FROM TO)
    (:DOCUMENTATION
     "Slice a tensor from FROM to TO, returning a new tensor with the contained elements")
    (:METHOD ((TENSOR ABSTRACT-TENSOR) FROM TO)
     (DECLARE (TYPE SEQUENCE FROM TO))
     (#S(FORMGREP:SYMREF :NAME "WITH-EXPECTATIONS" :QUALIFIER "POLICY-COND")
      (> SPEED SAFETY)
      ((ASSERTION
        (AND (VALID-INDEX-P FROM (SHAPE TENSOR))
             (EVERY #'< FROM (SHAPE TENSOR))))
       (ASSERTION
        (AND (= (ORDER TENSOR) (LENGTH TO)) (VALID-SHAPE-P TO)
             (EVERY #'<= TO (SHAPE TENSOR))))
       (ASSERTION (EVERY #'<= FROM TO)))
      (LET* ((DIMS (MAPCAR #'- TO FROM))
             (TARGET
              (EMPTY DIMS :LAYOUT (LAYOUT TENSOR) :TYPE (ELEMENT-TYPE TENSOR))))
        (MAP-INDEXES DIMS
         (LAMBDA (&REST DIMS)
           (SETF (APPLY #'TREF TARGET DIMS)
                   (APPLY #'TREF TENSOR (MAPCAR #'+ DIMS FROM)))))
        TARGET))))

[magicl/src/high-level/abstract-tensor.lisp:163]
  (DEFGENERIC SLICE-TO
      (SOURCE FROM TO TARGET OFFSET)
    (:DOCUMENTATION
     "Slice the tensor SOURCE from FROM to TO, storing results in TARGET with the prescribed OFFSET.")
    (:METHOD ((SOURCE ABSTRACT-TENSOR) FROM TO (TARGET ABSTRACT-TENSOR) OFFSET)
     (DECLARE (TYPE SEQUENCE FROM TO))
     (#S(FORMGREP:SYMREF :NAME "WITH-EXPECTATIONS" :QUALIFIER "POLICY-COND")
      (> SPEED SAFETY)
      ((ASSERTION
        (AND (VALID-INDEX-P FROM (SHAPE SOURCE))
             (EVERY #'< FROM (SHAPE SOURCE))))
       (ASSERTION
        (AND (= (ORDER SOURCE) (LENGTH TO)) (VALID-SHAPE-P TO)
             (EVERY #'<= TO (SHAPE SOURCE))))
       (ASSERTION (EVERY #'<= FROM TO))
       (ASSERTION (EQUALP (ELEMENT-TYPE SOURCE) (ELEMENT-TYPE TARGET)))
       (ASSERTION
        (AND
         (EVERY #'<=
                (MAPCAR (LAMBDA (OFF TO FROM) (+ OFF (- TO FROM))) OFFSET TO
                        FROM)
                (SHAPE TARGET)))))
      (LET ((DIMS (MAPCAR #'- TO FROM)))
        (MAP-INDEXES DIMS
         (LAMBDA (&REST DIMS)
           (SETF (APPLY #'TREF TARGET (MAPCAR #'+ DIMS OFFSET))
                   (APPLY #'TREF SOURCE (MAPCAR #'+ DIMS FROM)))))
        TARGET))))

[magicl/src/high-level/abstract-tensor.lisp:187]
  (DEFGENERIC BINARY-OPERATOR
      (FUNCTION SOURCE1 SOURCE2 &OPTIONAL TARGET)
    (:DOCUMENTATION
     "Perform a binary operator on tensors elementwise, optionally storing the result in TARGET.
If TARGET is not specified then a new tensor is created with the same element type as the first source tensor")
    (:METHOD
     (#'FUNCTION (SOURCE1 ABSTRACT-TENSOR) (SOURCE2 ABSTRACT-TENSOR) &OPTIONAL
      TARGET)
     (#S(FORMGREP:SYMREF :NAME "WITH-EXPECTATIONS" :QUALIFIER "POLICY-COND")
      (> SPEED SAFETY) ((ASSERTION (EQUALP (SHAPE SOURCE1) (SHAPE SOURCE2))))
      (LET ((TARGET (OR TARGET (COPY-TENSOR SOURCE1))))
        (MAP-INDEXES (SHAPE SOURCE1)
         (LAMBDA (&REST DIMS)
           (APPLY #'(SETF TREF)
                  (FUNCALL FUNCTION (APPLY #'TREF SOURCE1 DIMS)
                           (APPLY #'TREF SOURCE2 DIMS))
                  TARGET DIMS)))
        TARGET))))

[magicl/src/high-level/constructors.lisp:10]
  (DEFUN EMPTY (SHAPE &KEY (TYPE *DEFAULT-TENSOR-TYPE*) LAYOUT)
    "Create a tensor without intializing the contents of the storage

If TYPE is not specified then *DEFAULT-TENSOR-TYPE* is used.
LAYOUT specifies the internal storage representation ordering of the returned tensor.
The tensor specialized on the specified SHAPE and TYPE."
    (#S(FORMGREP:SYMREF :NAME "WITH-EXPECTATIONS" :QUALIFIER "POLICY-COND")
     (> SPEED SAFETY) ((TYPE SHAPE SHAPE))
     (LET ((TENSOR-TYPE (INFER-TENSOR-TYPE TYPE SHAPE NIL)))
       (MAKE-TENSOR TENSOR-TYPE SHAPE :LAYOUT LAYOUT))))

[magicl/src/high-level/constructors.lisp:21]
  (DEFUN CONST (CONST SHAPE &KEY TYPE LAYOUT)
    "Create a tensor with the specified SHAPE with each element being set to CONST

If TYPE is not specified then it is inferred from the type of CONST.
LAYOUT specifies the internal storage representation ordering of the returned tensor.
The tensor is specialized on SHAPE and TYPE."
    (#S(FORMGREP:SYMREF :NAME "WITH-EXPECTATIONS" :QUALIFIER "POLICY-COND")
     (> SPEED SAFETY) ((TYPE SHAPE SHAPE))
     (LET ((TENSOR-CLASS (INFER-TENSOR-TYPE TYPE SHAPE CONST)))
       (MAKE-TENSOR TENSOR-CLASS SHAPE :LAYOUT LAYOUT :INITIAL-ELEMENT CONST))))

[magicl/src/high-level/constructors.lisp:32]
  (DEFUN RAND (SHAPE &KEY (TYPE *DEFAULT-TENSOR-TYPE*) LAYOUT DISTRIBUTION)
    "Create tensor with random elements from DISTRIBUTION

DISTRIBUTION is a function with no arguments which returns a value for the element.
If DISTRIBUTION is not specified then a uniform distribution on [0,1] (or [0,1] + [0,1]i for complex types) is used.
If TYPE is not specified then *DEFAULT-TENSOR-TYPE* is used.
LAYOUT specifies the internal storage representation ordering of the returned tensor.
The tensor is specialized on SHAPE and TYPE."
    (#S(FORMGREP:SYMREF :NAME "WITH-EXPECTATIONS" :QUALIFIER "POLICY-COND")
     (> SPEED SAFETY) ((TYPE SHAPE SHAPE))
     (LET* ((TENSOR-CLASS (INFER-TENSOR-TYPE TYPE SHAPE NIL))
            (RAND-FUNCTION
             (OR DISTRIBUTION
                 (COND
                  ((SUBTYPEP TYPE 'COMPLEX)
                   (LAMBDA () (COMPLEX (RANDOM 1.0d0) (RANDOM 1.0d0))))
                  (T (LAMBDA () (RANDOM 1.0d0))))))
            (F
             (LAMBDA (&REST REST)
               (DECLARE (IGNORE REST))
               (COERCE (FUNCALL RAND-FUNCTION) TYPE))))
       (INTO! F (MAKE-TENSOR TENSOR-CLASS SHAPE :LAYOUT LAYOUT)))))

[magicl/src/high-level/constructors.lisp:118]
  (DEFUN FROM-ARRAY
         (ARRAY SHAPE
          &KEY (TYPE (ARRAY-ELEMENT-TYPE ARRAY)) (LAYOUT :ROW-MAJOR)
          (INPUT-LAYOUT :ROW-MAJOR))
    "Create a tensor from ARRAY, calling ADJUST-ARRAY on ARRAY to flatten to a 1-dimensional array of length equal to the product of the elements in SHAPE

If TYPE is not specified then it is inferred from the element type of ARRAY.
LAYOUT specifies the internal storage representation ordering of the returned tensor.
INPUT-LAYOUT specifies the layout of ARRAY.
The tensor is specialized on SHAPE and TYPE."
    (#S(FORMGREP:SYMREF :NAME "WITH-EXPECTATIONS" :QUALIFIER "POLICY-COND")
     (> SPEED SAFETY) ((TYPE SHAPE SHAPE))
     (LET* ((TENSOR-CLASS (INFER-TENSOR-TYPE TYPE SHAPE NIL))
            (STORAGE-SIZE (REDUCE #'* SHAPE))
            (ARRAY-DIMS (ARRAY-DIMENSIONS ARRAY)))
       (MULTIPLE-VALUE-BIND (STORAGE FINALIZER)
           (ALLOCATE STORAGE-SIZE :ELEMENT-TYPE TYPE)
         (LET ((INDEX-FUNCTION
                (IF (EQ LAYOUT ':ROW-MAJOR)
                    #'ROW-MAJOR-INDEX
                    #'COLUMN-MAJOR-INDEX))
               (INPUT-INDEX-FUNCTION
                (IF (EQ INPUT-LAYOUT ':ROW-MAJOR)
                    #'ROW-MAJOR-INDEX
                    #'COLUMN-MAJOR-INDEX)))
           (COND
            ((NOT (CDR ARRAY-DIMS))
             (MAP-INDEXES SHAPE
              (LAMBDA (&REST POS)
                (SETF (AREF STORAGE (FUNCALL INDEX-FUNCTION POS SHAPE))
                        (AREF ARRAY
                              (FUNCALL INPUT-INDEX-FUNCTION POS SHAPE))))))
            (T
             (MAP-INDEXES SHAPE
              (LAMBDA (&REST POS)
                (SETF (AREF STORAGE (FUNCALL INDEX-FUNCTION POS SHAPE))
                        (APPLY #'AREF ARRAY POS)))))))
         (LET ((TENSOR
                (MAKE-TENSOR TENSOR-CLASS SHAPE :STORAGE STORAGE :LAYOUT
                 LAYOUT)))
           (FINALIZE TENSOR FINALIZER)
           TENSOR)))))

[magicl/src/high-level/constructors.lisp:160]
  (DEFUN FROM-STORAGE (STORAGE SHAPE &KEY LAYOUT)
    "Create a tensor with the specified STORAGE and SHAPE.

This shares STORAGE; mutate at your own peril!

LAYOUT specifies the internal storage representation ordering of the returned tensor."
    (#S(FORMGREP:SYMREF :NAME "WITH-EXPECTATIONS" :QUALIFIER "POLICY-COND")
     (> SPEED SAFETY)
     ((TYPE SHAPE SHAPE) (ASSERTION (= 1 (ARRAY-RANK STORAGE)))
      (ASSERTION (= (REDUCE #'* SHAPE) (ARRAY-TOTAL-SIZE STORAGE))))
     (LET* ((TENSOR-TYPE
             (INFER-TENSOR-TYPE (ARRAY-ELEMENT-TYPE STORAGE) SHAPE NIL))
            (TENSOR (MAKE-TENSOR TENSOR-TYPE SHAPE :LAYOUT LAYOUT)))
       (SETF (STORAGE TENSOR) STORAGE)
       TENSOR)))

[magicl/src/high-level/constructors.lisp:176]
  (DEFUN FROM-LIST (LIST SHAPE &KEY TYPE LAYOUT (INPUT-LAYOUT :ROW-MAJOR))
    "Create a tensor with the elements of LIST, placing in layout INPUT-LAYOUT

If INPUT-LAYOUT is not specified then row-major is assumed.

If TYPE is not specified then it is inferred from the type of the first element of LIST.
LAYOUT specifies the internal storage representation ordering of the returned tensor.
The tensor is specialized on SHAPE and TYPE."
    (LET ((LEN (LENGTH LIST)))
      (#S(FORMGREP:SYMREF :NAME "WITH-EXPECTATIONS" :QUALIFIER "POLICY-COND")
       (> SPEED SAFETY)
       ((TYPE SHAPE SHAPE) (ASSERTION (= LEN (REDUCE #'* SHAPE))))
       (LET* ((TENSOR-CLASS (INFER-TENSOR-TYPE TYPE SHAPE (FIRST LIST)))
              (TENSOR (MAKE-TENSOR TENSOR-CLASS SHAPE :LAYOUT LAYOUT))
              (INDEX-FUNCTION
               (IF (EQ INPUT-LAYOUT ':ROW-MAJOR)
                   #'FROM-ROW-MAJOR-INDEX
                   #'FROM-COLUMN-MAJOR-INDEX)))
         (DOTIMES (I LEN TENSOR)
           (SETF (APPLY #'TREF TENSOR (FUNCALL INDEX-FUNCTION I SHAPE))
                   (POP LIST)))))))

[magicl/src/high-level/constructors.lisp:279]
  (DEFUN RANDOM-UNITARY
         (SHAPE
          &KEY
          (TYPE
           (ECLECTOR.READER:QUASIQUOTE
            (COMPLEX (ECLECTOR.READER:UNQUOTE *DEFAULT-TENSOR-TYPE*)))))
    "Generate a uniformly random element of U(n)."
    (#S(FORMGREP:SYMREF :NAME "WITH-EXPECTATIONS" :QUALIFIER "POLICY-COND")
     (> SPEED SAFETY) ((ASSERTION (SQUARE-SHAPE-P SHAPE)))
     (MULTIPLE-VALUE-BIND (Q R)
         (QR (RANDOM-NORMAL SHAPE :TYPE TYPE))
       (LET ((D (DIAG R)))
         (SETF D
                 (MAP 'LIST (LAMBDA (DI) (/ DI (SQRT (* DI (CONJUGATE DI)))))
                      D))
         (@ Q (FUNCALL #'FROM-DIAG D))))))

[magicl/src/high-level/matrix.lisp:32]
  (DEFMACRO DEFMATRIX (NAME TYPE TENSOR-CLASS)
    "Define a new matrix subclass with the specified NAME and element TYPE,
compatible with TENSOR-CLASS, as well as the abstract-tensor methods
required not specified by the generic MATRIX class (MAKE-TENSOR,
ELEMENT-TYPE, CAST, COPY-TENSOR, DEEP-COPY-TENSOR, TREF, SETF TREF)"
    (LET ((CONSTRUCTOR-SYM (INTERN (FORMAT NIL "MAKE-~:@(~A~)" NAME)))
          (COPY-SYM (INTERN (FORMAT NIL "COPY-~:@(~A~)" NAME)))
          (STORAGE-SYM (INTERN (FORMAT NIL "~:@(~A~)-STORAGE" NAME))))
      (ECLECTOR.READER:QUASIQUOTE
       (PROGN
        (DEFSTRUCT
            ((ECLECTOR.READER:UNQUOTE NAME) (:INCLUDE MATRIX)
             (:CONSTRUCTOR (ECLECTOR.READER:UNQUOTE CONSTRUCTOR-SYM)
              (NROWS NCOLS SIZE LAYOUT STORAGE))
             (:COPIER (ECLECTOR.READER:UNQUOTE COPY-SYM)))
          (STORAGE NIL :TYPE (MATRIX-STORAGE (ECLECTOR.READER:UNQUOTE TYPE))))
        (DECLAIM (FREEZE-TYPE (ECLECTOR.READER:UNQUOTE NAME)))
        (SET-PPRINT-DISPATCH '(ECLECTOR.READER:UNQUOTE NAME) 'PPRINT-MATRIX)
        (DEFMETHOD STORAGE ((M (ECLECTOR.READER:UNQUOTE NAME)))
          ((ECLECTOR.READER:UNQUOTE STORAGE-SYM) M))
        (DEFMETHOD (SETF STORAGE)
                   (NEW-VALUE (M (ECLECTOR.READER:UNQUOTE NAME)))
          (SETF ((ECLECTOR.READER:UNQUOTE STORAGE-SYM) M) NEW-VALUE))
        (DEFMETHOD ELEMENT-TYPE ((M (ECLECTOR.READER:UNQUOTE NAME)))
          (DECLARE (IGNORE M))
          '(ECLECTOR.READER:UNQUOTE TYPE))
        (DEFMETHOD MAKE-TENSOR
                   ((CLASS (EQL '(ECLECTOR.READER:UNQUOTE NAME))) SHAPE
                    &KEY INITIAL-ELEMENT LAYOUT STORAGE)
          (DECLARE (TYPE LIST SHAPE)
                   (OPTIMIZE (SPEED 3) (SAFETY 0)))
          (#S(FORMGREP:SYMREF
              :NAME "WITH-EXPECTATIONS"
              :QUALIFIER "POLICY-COND")
           (> SPEED SAFETY)
           ((TYPE SHAPE SHAPE) (ASSERTION (= 2 (LENGTH SHAPE))))
           (LET ((ROWS (FIRST SHAPE)) (COLS (SECOND SHAPE)))
             (DECLARE (TYPE FIXNUM ROWS COLS))
             (LET ((SIZE (THE FIXNUM (* ROWS COLS))))
               (MULTIPLE-VALUE-BIND (ACTUAL-STORAGE FINALIZER)
                   (OR STORAGE
                       (ALLOCATE SIZE :ELEMENT-TYPE
                        '(ECLECTOR.READER:UNQUOTE TYPE) :INITIAL-ELEMENT
                        INITIAL-ELEMENT))
                 (LET ((MATRIX
                        (FUNCALL #'(ECLECTOR.READER:UNQUOTE CONSTRUCTOR-SYM)
                                 ROWS COLS SIZE (OR LAYOUT :COLUMN-MAJOR)
                                 ACTUAL-STORAGE)))
                   (FINALIZE MATRIX FINALIZER)
                   MATRIX))))))
        (DEFMETHOD CAST
                   ((TENSOR (ECLECTOR.READER:UNQUOTE NAME))
                    (CLASS (EQL '(ECLECTOR.READER:UNQUOTE NAME))))
          (DECLARE (IGNORE CLASS))
          TENSOR)
        (DEFMETHOD CAST :BEFORE
                   ((TENSOR (ECLECTOR.READER:UNQUOTE TENSOR-CLASS))
                    (CLASS (EQL '(ECLECTOR.READER:UNQUOTE NAME))))
          (DECLARE (IGNORE CLASS))
          (ASSERT (= 2 (ORDER TENSOR)) NIL
                  "Cannot change non-2 dimensional tensor to matrix."))
        (DEFMETHOD CAST
                   ((TENSOR (ECLECTOR.READER:UNQUOTE TENSOR-CLASS))
                    (CLASS (EQL '(ECLECTOR.READER:UNQUOTE NAME))))
          (DECLARE (IGNORE CLASS))
          (MAKE-TENSOR '(ECLECTOR.READER:UNQUOTE NAME) (SHAPE TENSOR) :STORAGE
           (STORAGE TENSOR) :LAYOUT (LAYOUT TENSOR)))
        (DEFMETHOD CAST
                   ((TENSOR (ECLECTOR.READER:UNQUOTE NAME))
                    (CLASS (EQL '(ECLECTOR.READER:UNQUOTE TENSOR-CLASS))))
          (DECLARE (IGNORE CLASS))
          (MAKE-TENSOR '(ECLECTOR.READER:UNQUOTE TENSOR-CLASS) (SHAPE TENSOR)
           :STORAGE (STORAGE TENSOR) :LAYOUT (LAYOUT TENSOR)))
        (DEFMETHOD COPY-TENSOR ((M (ECLECTOR.READER:UNQUOTE NAME)) &REST ARGS)
          (DECLARE (IGNORE ARGS))
          (LET ((NEW-M ((ECLECTOR.READER:UNQUOTE COPY-SYM) M)))
            (MULTIPLE-VALUE-BIND (STORAGE FINALIZER)
                (ALLOCATE (MATRIX-SIZE M) :ELEMENT-TYPE (ELEMENT-TYPE M))
              (SETF ((ECLECTOR.READER:UNQUOTE STORAGE-SYM) NEW-M) STORAGE)
              (FINALIZE NEW-M FINALIZER))
            NEW-M))
        (DEFMETHOD DEEP-COPY-TENSOR
                   ((M (ECLECTOR.READER:UNQUOTE NAME)) &REST ARGS)
          (DECLARE (IGNORE ARGS))
          (LET ((NEW-M (COPY-TENSOR M)))
            (DOTIMES (I (MATRIX-SIZE M))
              (SETF (AREF ((ECLECTOR.READER:UNQUOTE STORAGE-SYM) NEW-M) I)
                      (AREF ((ECLECTOR.READER:UNQUOTE STORAGE-SYM) M) I)))
            NEW-M))
        (DEFMETHOD TREF ((MATRIX (ECLECTOR.READER:UNQUOTE NAME)) &REST POS)
          (DECLARE (DYNAMIC-EXTENT POS)
                   (OPTIMIZE (SPEED 3) (SAFETY 1)))
          (LET ((NUMROWS (MATRIX-NROWS MATRIX)) (NUMCOLS (MATRIX-NCOLS MATRIX)))
            (DECLARE (TYPE FIXNUM NUMROWS NUMCOLS))
            (#S(FORMGREP:SYMREF
                :NAME "WITH-EXPECTATIONS"
                :QUALIFIER "POLICY-COND")
             (> SPEED SAFETY)
             ((ASSERTION (VALID-MATRIX-INDEX-P POS NUMROWS NUMCOLS)))
             (LET ((ROW (FIRST POS)) (COL (SECOND POS)))
               (DECLARE (TYPE FIXNUM ROW COL))
               (LET ((INDEX
                      (ECASE (MATRIX-LAYOUT MATRIX)
                        (:ROW-MAJOR (+ COL (THE FIXNUM (* ROW NUMCOLS))))
                        (:COLUMN-MAJOR (+ ROW (THE FIXNUM (* COL NUMROWS)))))))
                 (DECLARE (TYPE ALEXANDRIA:ARRAY-INDEX INDEX))
                 (AREF ((ECLECTOR.READER:UNQUOTE STORAGE-SYM) MATRIX)
                       INDEX))))))
        (DEFMETHOD (SETF TREF)
                   (NEW-VALUE (MATRIX (ECLECTOR.READER:UNQUOTE NAME))
                    &REST POS)
          (DECLARE (DYNAMIC-EXTENT POS)
                   (OPTIMIZE (SPEED 3) (SAFETY 1)))
          (LET ((NUMROWS (MATRIX-NROWS MATRIX)) (NUMCOLS (MATRIX-NCOLS MATRIX)))
            (DECLARE (TYPE ALEXANDRIA:NON-NEGATIVE-FIXNUM NUMROWS NUMCOLS))
            (#S(FORMGREP:SYMREF
                :NAME "WITH-EXPECTATIONS"
                :QUALIFIER "POLICY-COND")
             (> SPEED SAFETY)
             ((ASSERTION (VALID-MATRIX-INDEX-P POS NUMROWS NUMCOLS)))
             (LET ((ROW (FIRST POS)) (COL (SECOND POS)))
               (DECLARE (TYPE ALEXANDRIA:NON-NEGATIVE-FIXNUM ROW COL))
               (LET ((INDEX
                      (ECASE (MATRIX-LAYOUT MATRIX)
                        (:ROW-MAJOR (+ COL (THE FIXNUM (* ROW NUMCOLS))))
                        (:COLUMN-MAJOR (+ ROW (THE FIXNUM (* COL NUMROWS)))))))
                 (DECLARE (TYPE ALEXANDRIA:ARRAY-INDEX INDEX))
                 (SETF (AREF ((ECLECTOR.READER:UNQUOTE STORAGE-SYM) MATRIX)
                             INDEX)
                         (COERCE NEW-VALUE
                                 '(ECLECTOR.READER:UNQUOTE TYPE))))))))
        (DEFMETHOD INTO!
                   ((FUNCTION FUNCTION)
                    (MATRIX (ECLECTOR.READER:UNQUOTE NAME)))
          (LET ((INDEX 0) (STORAGE (STORAGE MATRIX)))
            (IF (EQL :ROW-MAJOR (LAYOUT MATRIX))
                (LOOP :FOR J :BELOW (NROWS MATRIX)
                      :DO (LOOP :FOR I :BELOW (NCOLS MATRIX)
                                :DO (SETF (AREF STORAGE INDEX)
                                            (COERCE (FUNCALL FUNCTION J I)
                                                    '(ECLECTOR.READER:UNQUOTE
                                                      TYPE))) (INCF INDEX)))
                (LOOP :FOR J :BELOW (NCOLS MATRIX)
                      :DO (LOOP :FOR I :BELOW (NROWS MATRIX)
                                :DO (SETF (AREF STORAGE INDEX)
                                            (COERCE (FUNCALL FUNCTION I J)
                                                    '(ECLECTOR.READER:UNQUOTE
                                                      TYPE))) (INCF INDEX))))
            MATRIX))))))

[magicl/src/high-level/matrix.lisp:250]
  (DEFMETHOD (SETF SHAPE) (NEW-VALUE (M MATRIX))
    (#S(FORMGREP:SYMREF :NAME "WITH-EXPECTATIONS" :QUALIFIER "POLICY-COND")
     (> SPEED SAFETY)
     ((TYPE SHAPE NEW-VALUE) (ASSERTION (= 2 (LENGTH NEW-VALUE))))
     (SETF (MATRIX-NROWS M) (FIRST NEW-VALUE)
           (MATRIX-NCOLS M) (SECOND NEW-VALUE))))

[magicl/src/high-level/matrix.lisp:315]
  (DEFINE-EXTENSIBLE-FUNCTION (BLOCK-MATRIX BLOCK-MATRIX-LISP) (BLOCKS SHAPE)
   (:DOCUMENTATION
    "Construct a matrix a list of blocks. Here SHAPE denotes the number of blocks in each row and column.")
   (:METHOD (BLOCKS SHAPE)
    (LET ((LEN (LENGTH BLOCKS)))
      (#S(FORMGREP:SYMREF :NAME "WITH-EXPECTATIONS" :QUALIFIER "POLICY-COND")
       (> SPEED SAFETY)
       ((TYPE SHAPE SHAPE) (ASSERTION (= 2 (LENGTH SHAPE)))
        (ASSERTION (= LEN (REDUCE #'* SHAPE))))
       (LET ((BLOCK-ROWS
              (LOOP :WITH NCOLS := (SECOND SHAPE)
                    :AND TAIL := BLOCKS
                    :WHILE TAIL
                    :COLLECT (HSTACK
                              (LOOP :FOR ELTS :ON TAIL
                                    :FOR I :BELOW NCOLS
                                    :COLLECT (FIRST ELTS)
                                    :FINALLY (SETF TAIL ELTS))))))
         (VSTACK BLOCK-ROWS))))))

[magicl/src/high-level/matrix.lisp:441]
  (DEFINE-EXTENSIBLE-FUNCTION (DIAG DIAG-LISP) (MATRIX)
   (:DOCUMENTATION "Get a list of the diagonal elements of MATRIX")
   (:METHOD ((MATRIX MATRIX))
    (#S(FORMGREP:SYMREF :NAME "WITH-EXPECTATIONS" :QUALIFIER "POLICY-COND")
     (> SPEED SAFETY) ((ASSERTION (SQUARE-MATRIX-P MATRIX)))
     (LET ((ROWS (NROWS MATRIX)))
       (LOOP :FOR I :BELOW ROWS
             :COLLECT (TREF MATRIX I I))))))

[magicl/src/high-level/matrix.lisp:450]
  (DEFINE-EXTENSIBLE-FUNCTION (TRACE TRACE-LISP) (MATRIX)
   (:DOCUMENTATION "Get the trace of MATRIX (sum of diagonals)")
   (:METHOD ((MATRIX MATRIX))
    (#S(FORMGREP:SYMREF :NAME "WITH-EXPECTATIONS" :QUALIFIER "POLICY-COND")
     (> SPEED SAFETY) ((ASSERTION (SQUARE-MATRIX-P MATRIX)))
     (LOOP :FOR I :BELOW (NROWS MATRIX)
           :SUM (TREF MATRIX I I)))))

[magicl/src/high-level/matrix.lisp:458]
  (DEFINE-EXTENSIBLE-FUNCTION (DET DET-LISP) (MATRIX)
   (:DOCUMENTATION "Compute the determinant of a square matrix MATRIX")
   (:METHOD ((MATRIX MATRIX))
    (#S(FORMGREP:SYMREF :NAME "WITH-EXPECTATIONS" :QUALIFIER "POLICY-COND")
     (> SPEED SAFETY) ((ASSERTION (SQUARE-MATRIX-P MATRIX)))
     (LET ((D 1))
       (MULTIPLE-VALUE-BIND (A IPIV)
           (LU MATRIX)
         (DOTIMES (I (NROWS MATRIX)) (SETQ D (* D (TREF A I I))))
         (DOTIMES (I (SIZE IPIV))
           (UNLESS (= (1+ I) (TREF IPIV I)) (SETQ D (- D))))
         D)))))

[magicl/src/high-level/specialize-constructor.lisp:8]
  (DEFUN INFER-TENSOR-TYPE (TYPE SHAPE VAL)
    (DECLARE (TYPE LIST SHAPE)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (IF TYPE
        (CASE (LENGTH SHAPE)
          (1
           (COND
            ((OR (EQ TYPE 'SINGLE-FLOAT) (SUBTYPEP TYPE 'SINGLE-FLOAT))
             'VECTOR/SINGLE-FLOAT)
            ((OR (EQ TYPE 'DOUBLE-FLOAT) (SUBTYPEP TYPE 'DOUBLE-FLOAT))
             'VECTOR/DOUBLE-FLOAT)
            ((OR (EQUAL TYPE '(COMPLEX SINGLE-FLOAT))
                 (SUBTYPEP TYPE '(COMPLEX SINGLE-FLOAT)))
             'VECTOR/COMPLEX-SINGLE-FLOAT)
            ((OR (EQUAL TYPE '(COMPLEX DOUBLE-FLOAT))
                 (SUBTYPEP TYPE '(COMPLEX DOUBLE-FLOAT)))
             'VECTOR/COMPLEX-DOUBLE-FLOAT)
            ((OR (EQUAL TYPE '(SIGNED-BYTE 32))
                 (SUBTYPEP TYPE '(SIGNED-BYTE 32)))
             'VECTOR/INT32)
            (T (ERROR "no compatible tensor constructor for type ~a" TYPE))))
          (2
           (COND
            ((OR (EQ TYPE 'SINGLE-FLOAT) (SUBTYPEP TYPE 'SINGLE-FLOAT))
             'MATRIX/SINGLE-FLOAT)
            ((OR (EQ TYPE 'DOUBLE-FLOAT) (SUBTYPEP TYPE 'DOUBLE-FLOAT))
             'MATRIX/DOUBLE-FLOAT)
            ((OR (EQUAL TYPE '(COMPLEX SINGLE-FLOAT))
                 (SUBTYPEP TYPE '(COMPLEX SINGLE-FLOAT)))
             'MATRIX/COMPLEX-SINGLE-FLOAT)
            ((OR (EQUAL TYPE '(COMPLEX DOUBLE-FLOAT))
                 (SUBTYPEP TYPE '(COMPLEX DOUBLE-FLOAT)))
             'MATRIX/COMPLEX-DOUBLE-FLOAT)
            ((OR (EQUAL TYPE '(SIGNED-BYTE 32))
                 (SUBTYPEP TYPE '(SIGNED-BYTE 32)))
             'MATRIX/INT32)
            (T (ERROR "no compatible tensor constructor for type ~a" TYPE))))
          (T
           (COND
            ((OR (EQ TYPE 'SINGLE-FLOAT) (SUBTYPEP TYPE 'SINGLE-FLOAT))
             'TENSOR/SINGLE-FLOAT)
            ((OR (EQ TYPE 'DOUBLE-FLOAT) (SUBTYPEP TYPE 'DOUBLE-FLOAT))
             'TENSOR/DOUBLE-FLOAT)
            ((OR (EQUAL TYPE '(COMPLEX SINGLE-FLOAT))
                 (SUBTYPEP TYPE '(COMPLEX SINGLE-FLOAT)))
             'TENSOR/COMPLEX-SINGLE-FLOAT)
            ((OR (EQUAL TYPE '(COMPLEX DOUBLE-FLOAT))
                 (SUBTYPEP TYPE '(COMPLEX DOUBLE-FLOAT)))
             'TENSOR/COMPLEX-DOUBLE-FLOAT)
            ((OR (EQUAL TYPE '(SIGNED-BYTE 32))
                 (SUBTYPEP TYPE '(SIGNED-BYTE 32)))
             'TENSOR/INT32)
            (T (ERROR "no compatible tensor constructor for type ~a" TYPE)))))
        (CASE (LENGTH SHAPE)
          (1
           (ETYPECASE VAL
             (SINGLE-FLOAT 'VECTOR/SINGLE-FLOAT)
             (DOUBLE-FLOAT 'VECTOR/DOUBLE-FLOAT)
             ((COMPLEX SINGLE-FLOAT) 'VECTOR/COMPLEX-SINGLE-FLOAT)
             ((COMPLEX DOUBLE-FLOAT) 'VECTOR/COMPLEX-DOUBLE-FLOAT)
             ((SIGNED-BYTE 32) 'VECTOR/INT32)))
          (2
           (ETYPECASE VAL
             (SINGLE-FLOAT 'MATRIX/SINGLE-FLOAT)
             (DOUBLE-FLOAT 'MATRIX/DOUBLE-FLOAT)
             ((COMPLEX SINGLE-FLOAT) 'MATRIX/COMPLEX-SINGLE-FLOAT)
             ((COMPLEX DOUBLE-FLOAT) 'MATRIX/COMPLEX-DOUBLE-FLOAT)
             ((SIGNED-BYTE 32) 'MATRIX/INT32)))
          (T
           (ETYPECASE VAL
             (SINGLE-FLOAT 'TENSOR/SINGLE-FLOAT)
             (DOUBLE-FLOAT 'TENSOR/DOUBLE-FLOAT)
             ((COMPLEX SINGLE-FLOAT) 'TENSOR/COMPLEX-SINGLE-FLOAT)
             ((COMPLEX DOUBLE-FLOAT) 'TENSOR/COMPLEX-DOUBLE-FLOAT)
             ((SIGNED-BYTE 32) 'TENSOR/INT32))))))

[magicl/src/high-level/tensor.lisp:34]
  (DEFMACRO DEFTENSOR (NAME TYPE)
    "Define a new tensor subclass with the specified NAME and element
TYPE as well as the abstract-tensor methods required not specified by
the generic TENSOR class (MAKE-TENSOR, ELEMENT-TYPE, CAST,
COPY-TENSOR, DEEP-COPY-TENSOR, TREF, SETF TREF)"
    (LET ((CONSTRUCTOR-SYM (INTERN (FORMAT NIL "MAKE-~:@(~A~)-STRUCT" NAME)))
          (COPY-SYM (INTERN (FORMAT NIL "COPY-~:@(~A~)" NAME)))
          (STORAGE-SYM (INTERN (FORMAT NIL "~:@(~A~)-STORAGE" NAME))))
      (ECLECTOR.READER:QUASIQUOTE
       (PROGN
        (DEFSTRUCT
            ((ECLECTOR.READER:UNQUOTE NAME) (:INCLUDE TENSOR)
             (:CONSTRUCTOR (ECLECTOR.READER:UNQUOTE CONSTRUCTOR-SYM)
              (ORDER SHAPE SIZE LAYOUT STORAGE))
             (:COPIER (ECLECTOR.READER:UNQUOTE COPY-SYM)))
          (STORAGE NIL :TYPE (TENSOR-STORAGE (ECLECTOR.READER:UNQUOTE TYPE))))
        (DECLAIM (FREEZE-TYPE (ECLECTOR.READER:UNQUOTE NAME)))
        (SET-PPRINT-DISPATCH '(ECLECTOR.READER:UNQUOTE NAME) 'PPRINT-TENSOR)
        (DEFMETHOD STORAGE ((M (ECLECTOR.READER:UNQUOTE NAME)))
          ((ECLECTOR.READER:UNQUOTE STORAGE-SYM) M))
        (DEFMETHOD (SETF STORAGE)
                   (NEW-VALUE (M (ECLECTOR.READER:UNQUOTE NAME)))
          (SETF ((ECLECTOR.READER:UNQUOTE STORAGE-SYM) M) NEW-VALUE))
        (DEFMETHOD ELEMENT-TYPE ((M (ECLECTOR.READER:UNQUOTE NAME)))
          (DECLARE (IGNORE M))
          '(ECLECTOR.READER:UNQUOTE TYPE))
        (DEFMETHOD MAKE-TENSOR
                   ((CLASS (EQL '(ECLECTOR.READER:UNQUOTE NAME))) SHAPE
                    &KEY INITIAL-ELEMENT LAYOUT STORAGE)
          (#S(FORMGREP:SYMREF
              :NAME "WITH-EXPECTATIONS"
              :QUALIFIER "POLICY-COND")
           (> SPEED SAFETY) ((TYPE SHAPE SHAPE))
           (LET ((SIZE (REDUCE #'* SHAPE)))
             (MULTIPLE-VALUE-BIND (ACTUAL-STORAGE FINALIZER)
                 (OR STORAGE
                     (ALLOCATE SIZE :ELEMENT-TYPE
                      '(ECLECTOR.READER:UNQUOTE TYPE) :INITIAL-ELEMENT
                      INITIAL-ELEMENT))
               (LET ((TENSOR
                      (FUNCALL #'(ECLECTOR.READER:UNQUOTE CONSTRUCTOR-SYM)
                               (LENGTH SHAPE) SHAPE SIZE
                               (OR LAYOUT :COLUMN-MAJOR) ACTUAL-STORAGE)))
                 (FINALIZE TENSOR FINALIZER)
                 TENSOR)))))
        (DEFMETHOD CAST
                   ((TENSOR (ECLECTOR.READER:UNQUOTE NAME))
                    (CLASS (EQL '(ECLECTOR.READER:UNQUOTE NAME))))
          (DECLARE (IGNORE CLASS))
          TENSOR)
        (DEFMETHOD COPY-TENSOR ((M (ECLECTOR.READER:UNQUOTE NAME)) &REST ARGS)
          (DECLARE (IGNORE ARGS))
          (LET ((NEW-M ((ECLECTOR.READER:UNQUOTE COPY-SYM) M)))
            (MULTIPLE-VALUE-BIND (STORAGE FINALIZER)
                (ALLOCATE (TENSOR-SIZE M) :ELEMENT-TYPE (ELEMENT-TYPE M))
              (SETF ((ECLECTOR.READER:UNQUOTE STORAGE-SYM) NEW-M) STORAGE)
              (FINALIZE NEW-M FINALIZER))
            NEW-M))
        (DEFMETHOD DEEP-COPY-TENSOR
                   ((M (ECLECTOR.READER:UNQUOTE NAME)) &REST ARGS)
          (DECLARE (IGNORE ARGS))
          (LET ((NEW-M (COPY-TENSOR M)))
            (DOTIMES (I (TENSOR-SIZE M))
              (SETF (AREF ((ECLECTOR.READER:UNQUOTE STORAGE-SYM) NEW-M) I)
                      (AREF ((ECLECTOR.READER:UNQUOTE STORAGE-SYM) M) I)))
            NEW-M))
        (DEFMETHOD TREF ((TENSOR (ECLECTOR.READER:UNQUOTE NAME)) &REST POS)
          (#S(FORMGREP:SYMREF
              :NAME "WITH-EXPECTATIONS"
              :QUALIFIER "POLICY-COND")
           (> SPEED SAFETY)
           ((ASSERTION (VALID-INDEX-P POS (TENSOR-SHAPE TENSOR))))
           (LET ((INDEX
                  (CASE (TENSOR-LAYOUT TENSOR)
                    (:ROW-MAJOR (ROW-MAJOR-INDEX POS (TENSOR-SHAPE TENSOR)))
                    (:COLUMN-MAJOR
                     (COLUMN-MAJOR-INDEX POS (TENSOR-SHAPE TENSOR))))))
             (AREF ((ECLECTOR.READER:UNQUOTE STORAGE-SYM) TENSOR) INDEX))))
        (DEFMETHOD (SETF TREF)
                   (NEW-VALUE (TENSOR (ECLECTOR.READER:UNQUOTE NAME))
                    &REST POS)
          (#S(FORMGREP:SYMREF
              :NAME "WITH-EXPECTATIONS"
              :QUALIFIER "POLICY-COND")
           (> SPEED SAFETY)
           ((ASSERTION (VALID-INDEX-P POS (TENSOR-SHAPE TENSOR))))
           (LET ((INDEX
                  (CASE (TENSOR-LAYOUT TENSOR)
                    (:ROW-MAJOR (ROW-MAJOR-INDEX POS (TENSOR-SHAPE TENSOR)))
                    (:COLUMN-MAJOR
                     (COLUMN-MAJOR-INDEX POS (TENSOR-SHAPE TENSOR))))))
             (SETF (AREF ((ECLECTOR.READER:UNQUOTE STORAGE-SYM) TENSOR) INDEX)
                     NEW-VALUE))))))))

[magicl/src/high-level/tensor.lisp:131]
  (DEFGENERIC RESHAPE
      (TENSOR SHAPE)
    (:DOCUMENTATION "Change the shape of the tensor.
WARNING: This method acts differently depending on the layout of the tensor. Do not expect row-major to act the same as column-major.")
    (:METHOD ((TENSOR TENSOR) SHAPE)
     (#S(FORMGREP:SYMREF :NAME "WITH-EXPECTATIONS" :QUALIFIER "POLICY-COND")
      (> SPEED SAFETY)
      ((ASSERTION (= (TENSOR-SIZE TENSOR) (REDUCE #'* SHAPE))))
      (SETF (TENSOR-SHAPE TENSOR) SHAPE)
      (SETF (TENSOR-ORDER TENSOR) (LENGTH SHAPE)) (SPECIALIZE-TENSOR TENSOR)))
    (:METHOD ((TENSOR ABSTRACT-TENSOR) SHAPE)
     (RESHAPE (GENERALIZE-TENSOR TENSOR) SHAPE)))

[magicl/src/high-level/util.lisp:17]
  (DEFUN MATRIX-ROW-MAJOR-INDEX (ROW COL NUMROWS NUMCOLS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (IGNORE NUMROWS)
             (TYPE FIXNUM ROW COL NUMCOLS)
             (VALUES FIXNUM))
    (+ COL (THE FIXNUM (* ROW NUMCOLS))))

[magicl/src/high-level/util.lisp:25]
  (DEFUN MATRIX-COLUMN-MAJOR-INDEX (ROW COL NUMROWS NUMCOLS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (IGNORE NUMCOLS)
             (TYPE FIXNUM ROW COL NUMROWS)
             (VALUES FIXNUM))
    (+ ROW (THE FIXNUM (* COL NUMROWS))))

[magicl/src/high-level/util.lisp:32]
  (DEFUN ROW-MAJOR-INDEX (POS DIMS)
    (DECLARE (TYPE INDEX POS)
             (TYPE SHAPE DIMS)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (IF (AND (CDR DIMS) (NOT (CDDR DIMS)))
        (MATRIX-ROW-MAJOR-INDEX (FIRST POS) (SECOND POS) (FIRST DIMS)
         (SECOND DIMS))
        (LOOP :FOR I :OF-TYPE FIXNUM IN POS
              :FOR D :OF-TYPE FIXNUM IN DIMS
              :FOR ACC :OF-TYPE FIXNUM := I :THEN (+ I (THE FIXNUM (* D ACC)))
              :FINALLY (RETURN ACC))))

[magicl/src/high-level/vector.lisp:21]
  (DEFMACRO DEFVECTOR (NAME TYPE TENSOR-CLASS)
    "Define a new vector subclass with the specified NAME and element TYPE,
compatible with TENSOR-CLASS, as well as the abstract-tensor methods
required not specified by the generic VECTOR class (MAKE-TENSOR,
ELEMENT-TYPE, CAST, COPY-TENSOR, DEEP-COPY-TENSOR, TREF, SETF TREF)"
    (LET ((CONSTRUCTOR-SYM (INTERN (FORMAT NIL "MAKE-~:@(~A~)" NAME)))
          (COPY-SYM (INTERN (FORMAT NIL "COPY-~:@(~A~)" NAME)))
          (STORAGE-SYM (INTERN (FORMAT NIL "~:@(~A~)-STORAGE" NAME))))
      (ECLECTOR.READER:QUASIQUOTE
       (PROGN
        (DEFSTRUCT
            ((ECLECTOR.READER:UNQUOTE NAME) (:INCLUDE VECTOR)
             (:CONSTRUCTOR (ECLECTOR.READER:UNQUOTE CONSTRUCTOR-SYM)
              (SIZE STORAGE))
             (:COPIER (ECLECTOR.READER:UNQUOTE COPY-SYM)))
          (STORAGE NIL :TYPE (VECTOR-STORAGE (ECLECTOR.READER:UNQUOTE TYPE))))
        (DECLAIM (FREEZE-TYPE (ECLECTOR.READER:UNQUOTE NAME)))
        (SET-PPRINT-DISPATCH '(ECLECTOR.READER:UNQUOTE NAME) 'PPRINT-VECTOR)
        (DEFMETHOD STORAGE ((V (ECLECTOR.READER:UNQUOTE NAME)))
          ((ECLECTOR.READER:UNQUOTE STORAGE-SYM) V))
        (DEFMETHOD (SETF STORAGE)
                   (NEW-VALUE (V (ECLECTOR.READER:UNQUOTE NAME)))
          (SETF ((ECLECTOR.READER:UNQUOTE STORAGE-SYM) V) NEW-VALUE))
        (DEFMETHOD ELEMENT-TYPE ((V (ECLECTOR.READER:UNQUOTE NAME)))
          (DECLARE (IGNORE V))
          '(ECLECTOR.READER:UNQUOTE TYPE))
        (DEFMETHOD MAKE-TENSOR
                   ((CLASS (EQL '(ECLECTOR.READER:UNQUOTE NAME))) SHAPE
                    &KEY INITIAL-ELEMENT LAYOUT STORAGE)
          (DECLARE (IGNORE LAYOUT))
          (#S(FORMGREP:SYMREF
              :NAME "WITH-EXPECTATIONS"
              :QUALIFIER "POLICY-COND")
           (> SPEED SAFETY)
           ((TYPE SHAPE SHAPE) (ASSERTION (= 1 (LENGTH SHAPE))))
           (LET ((SIZE (REDUCE #'* SHAPE)))
             (MULTIPLE-VALUE-BIND (ACTUAL-STORAGE FINALIZER)
                 (OR STORAGE
                     (ALLOCATE SIZE :ELEMENT-TYPE
                      '(ECLECTOR.READER:UNQUOTE TYPE) :INITIAL-ELEMENT
                      INITIAL-ELEMENT))
               (LET ((VECTOR
                      (FUNCALL #'(ECLECTOR.READER:UNQUOTE CONSTRUCTOR-SYM) SIZE
                               ACTUAL-STORAGE)))
                 (FINALIZE VECTOR FINALIZER)
                 VECTOR)))))
        (DEFMETHOD CAST
                   ((TENSOR (ECLECTOR.READER:UNQUOTE NAME))
                    (CLASS (EQL '(ECLECTOR.READER:UNQUOTE NAME))))
          (DECLARE (IGNORE CLASS))
          TENSOR)
        (DEFMETHOD CAST :BEFORE
                   ((TENSOR (ECLECTOR.READER:UNQUOTE TENSOR-CLASS))
                    (CLASS (EQL '(ECLECTOR.READER:UNQUOTE NAME))))
          (DECLARE (IGNORE CLASS))
          (ASSERT (= 1 (ORDER TENSOR)) NIL
                  "Cannot change non-1 dimensional tensor to vector."))
        (DEFMETHOD CAST
                   ((TENSOR (ECLECTOR.READER:UNQUOTE TENSOR-CLASS))
                    (CLASS (EQL '(ECLECTOR.READER:UNQUOTE NAME))))
          (DECLARE (IGNORE CLASS))
          (MAKE-TENSOR '(ECLECTOR.READER:UNQUOTE NAME) (SHAPE TENSOR) :STORAGE
           (STORAGE TENSOR)))
        (DEFMETHOD CAST
                   ((TENSOR (ECLECTOR.READER:UNQUOTE NAME))
                    (CLASS (EQL '(ECLECTOR.READER:UNQUOTE TENSOR-CLASS))))
          (DECLARE (IGNORE CLASS))
          (MAKE-TENSOR '(ECLECTOR.READER:UNQUOTE TENSOR-CLASS) (SHAPE TENSOR)
           :STORAGE (STORAGE TENSOR)))
        (DEFMETHOD COPY-TENSOR ((M (ECLECTOR.READER:UNQUOTE NAME)) &REST ARGS)
          (DECLARE (IGNORE ARGS))
          (LET ((NEW-M ((ECLECTOR.READER:UNQUOTE COPY-SYM) M)))
            (MULTIPLE-VALUE-BIND (STORAGE FINALIZER)
                (ALLOCATE (VECTOR-SIZE M) :ELEMENT-TYPE (ELEMENT-TYPE M))
              (SETF ((ECLECTOR.READER:UNQUOTE STORAGE-SYM) NEW-M) STORAGE)
              (FINALIZE NEW-M FINALIZER))
            NEW-M))
        (DEFMETHOD DEEP-COPY-TENSOR
                   ((M (ECLECTOR.READER:UNQUOTE NAME)) &REST ARGS)
          (DECLARE (IGNORE ARGS))
          (LET ((NEW-M (COPY-TENSOR M)))
            (DOTIMES (I (VECTOR-SIZE M))
              (SETF (AREF ((ECLECTOR.READER:UNQUOTE STORAGE-SYM) NEW-M) I)
                      (AREF ((ECLECTOR.READER:UNQUOTE STORAGE-SYM) M) I)))
            NEW-M))
        (DEFMETHOD TREF ((VECTOR (ECLECTOR.READER:UNQUOTE NAME)) &REST POS)
          (#S(FORMGREP:SYMREF
              :NAME "WITH-EXPECTATIONS"
              :QUALIFIER "POLICY-COND")
           (> SPEED SAFETY)
           ((ASSERTION (VALID-INDEX-P POS (LIST (VECTOR-SIZE VECTOR)))))
           (AREF ((ECLECTOR.READER:UNQUOTE STORAGE-SYM) VECTOR) (FIRST POS))))
        (DEFMETHOD (SETF TREF)
                   (NEW-VALUE (VECTOR (ECLECTOR.READER:UNQUOTE NAME))
                    &REST POS)
          (#S(FORMGREP:SYMREF
              :NAME "WITH-EXPECTATIONS"
              :QUALIFIER "POLICY-COND")
           (> SPEED SAFETY)
           ((ASSERTION (VALID-INDEX-P POS (LIST (VECTOR-SIZE VECTOR)))))
           (SETF (AREF ((ECLECTOR.READER:UNQUOTE STORAGE-SYM) VECTOR)
                       (FIRST POS))
                   NEW-VALUE)))))))

[magicl/src/high-level/vector.lisp:150]
  (DEFMETHOD (SETF SHAPE) (NEW-VALUE (VECTOR VECTOR))
    (#S(FORMGREP:SYMREF :NAME "WITH-EXPECTATIONS" :QUALIFIER "POLICY-COND")
     (> SPEED SAFETY)
     ((TYPE SHAPE NEW-VALUE) (ASSERTION (= 1 (LENGTH NEW-VALUE))))
     (SETF (VECTOR-SIZE VECTOR) (FIRST NEW-VALUE))))

[magicl/src/high-level/vector.lisp:156]
  (DEFINE-EXTENSIBLE-FUNCTION (DOT DOT-LISP) (VECTOR1 VECTOR2)
   (:DOCUMENTATION
    "Compute the dot product of two vectors. For complex vectors, this conjugates the second argument.")
   (:METHOD ((VECTOR1 VECTOR) (VECTOR2 VECTOR))
    (#S(FORMGREP:SYMREF :NAME "WITH-EXPECTATIONS" :QUALIFIER "POLICY-COND")
     (> SPEED SAFETY) ((ASSERTION (= (SIZE VECTOR1) (SIZE VECTOR2))))
     (LOOP :FOR I :BELOW (SIZE VECTOR1)
           :SUM (* (TREF VECTOR1 I) (CONJUGATE (TREF VECTOR2 I)))))))

[manardb/src/struct.lisp:49]
  (DEFUN-SPEEDY MPTR-TAG (MPTR)
   (DECLARE (TYPE MPTR MPTR)
            (OPTIMIZE (SAFETY 0)))
   (THE MTAG (LOGAND MPTR (1- (ASH 1 +MTAG-BITS+)))))

[manardb/src/struct.lisp:54]
  (DEFUN-SPEEDY MPTR-INDEX (MPTR)
   (DECLARE (TYPE MPTR MPTR)
            (OPTIMIZE (SAFETY 0)))
   (THE MINDEX (ASH MPTR (- +MTAG-BITS+))))

[manardb/src/transaction.lisp:157]
  (DEFUN TRANSACT (&KEY BODY ON-RESTART MESSAGE)
    (DECLARE (DYNAMIC-EXTENT BODY ON-RESTART MESSAGE)
             (OPTIMIZE SAFETY DEBUG))
    (CLOSE-ALL-MMAPS)
    (ASSERT (NOT *STORED-SYMBOLS*))
    (LET ((TMPDIR (TMPDIR)) *STORED-SYMBOLS* (*MMAP-MAY-ALLOCATE* T))
      (UNWIND-PROTECT
          (TAGBODY
           RESTART
            (CLOSE-ALL-MMAPS)
            (HANDLER-BIND ((ERROR
                            (LAMBDA (ERR)
                              (WARN
                               "Copying mmap files from directory ~A to ~A as part of transaction ~A failed: ~A"
                               (MAINDIR) TMPDIR MESSAGE ERR)
                              (SLEEP
                               (RANDOM
                                *TRANSACTION-COPY-FAIL-RESTART-SLEEP*)))))
              (COPY-ALL-MMAPS (MAINDIR) TMPDIR))
            (LET ((*MMAP-PATHNAME-DEFAULTS* TMPDIR))
              (CHECK-SCHEMA)
              (OPEN-ALL-MMAPS)
              (RETURN-FROM TRANSACT
                (MULTIPLE-VALUE-PROG1 (FUNCALL BODY)
                  (LET ((VERSION (DIR-VERSION TMPDIR)))
                    (SETF (DIR-VERSION TMPDIR)
                            (BUILD-VERSION (1+ (FIRST VERSION))))
                    (HANDLER-CASE
                     (PROGN
                      (REPLACE-ALL-MMAPS TMPDIR (MAINDIR) VERSION)
                      (SETF TMPDIR NIL))
                     (ERROR (ERR)
                            (WARN "Restarting manardb transaction ~A: ~A"
                                  MESSAGE ERR)
                            (FUNCALL ON-RESTART) (GO RESTART))))))))
        (WHEN TMPDIR
          (IGNORE-ERRORS
           (#S(FORMGREP:SYMREF
               :NAME "DELETE-DIRECTORY-AND-FILES"
               :QUALIFIER "OSICAT")
            TMPDIR)))
        (CLOSE-ALL-MMAPS))))

[matlisp/src/utilities/macros.lisp:3]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (DEFMACRO USING-GENSYMS ((DECL (&REST SYMS) &OPTIONAL GENSYMS) &BODY BODY)
      (ECLECTOR.READER:QUASIQUOTE
       (LET (((ECLECTOR.READER:UNQUOTE DECL)
              (ZIP
               '(ECLECTOR.READER:UNQUOTE
                 (MAPCAR #'(LAMBDA (X) (GENSYM (SYMBOL-NAME X))) SYMS))
               (LIST (ECLECTOR.READER:UNQUOTE-SPLICING SYMS)))))
         (DESTRUCTURING-BIND
             ((ECLECTOR.READER:UNQUOTE-SPLICING SYMS))
             (MAPCAR #'CAR (ECLECTOR.READER:UNQUOTE DECL))
           (ECLECTOR.READER:UNQUOTE
            (APPEND
             (IF GENSYMS
                 (ECLECTOR.READER:QUASIQUOTE
                  (WITH-GENSYMS ((ECLECTOR.READER:UNQUOTE-SPLICING GENSYMS))))
                 (ECLECTOR.READER:QUASIQUOTE (PROGN)))
             BODY))))))
    (DEFMACRO BINDING-GENSYMS ((MNAME &OPTIONAL (FNAME (GENSYM))) &BODY BODY)
      (ECLECTOR.READER:QUASIQUOTE
       (WITH-MEMOIZATION NIL
        (MEMOIZING
         (FLET (((ECLECTOR.READER:UNQUOTE FNAME) (X)
                  (GENSYM (SYMBOL-NAME X))))
           (MACROLET (((ECLECTOR.READER:UNQUOTE MNAME) (X)
                        (ECLECTOR.READER:QUASIQUOTE
                         ((ECLECTOR.READER:UNQUOTE
                           '(ECLECTOR.READER:UNQUOTE FNAME))
                          '(ECLECTOR.READER:UNQUOTE X)))))
             (ECLECTOR.READER:UNQUOTE-SPLICING BODY)))))))
    (DEFMACRO SET-SLOTS (OBJ &REST DECL)
      (WITH-GENSYMS (G)
       (ECLECTOR.READER:QUASIQUOTE
        (LET (((ECLECTOR.READER:UNQUOTE G) (ECLECTOR.READER:UNQUOTE OBJ)))
          (SETF (ECLECTOR.READER:UNQUOTE-SPLICING
                 (ITER (FOR X IN DECL)
                  (APPENDING
                   (EMATCH X
                    ((TYPE SYMBOL)
                     (ECLECTOR.READER:QUASIQUOTE
                      ((SLOT-VALUE (ECLECTOR.READER:UNQUOTE G)
                                   '(ECLECTOR.READER:UNQUOTE X))
                       (ECLECTOR.READER:UNQUOTE X))))
                    ((LIST SLOT VALUE)
                     (ECLECTOR.READER:QUASIQUOTE
                      ((SLOT-VALUE (ECLECTOR.READER:UNQUOTE G)
                                   '(ECLECTOR.READER:UNQUOTE SLOT))
                       (ECLECTOR.READER:UNQUOTE VALUE)))))))))
          (ECLECTOR.READER:UNQUOTE G)))))
    (DEFMACRO ZIPRM ((R M) &BODY ARGS)
      "
  Does reduce-map on @arg{args}.

  Example:
  @lisp
  > (macroexpand-1
       `(ziprm (and =) (a b c) (1 2 3)))
  => (AND (= A 1) (= B 2) (= C 3))
  @end lisp
  "
      (ECLECTOR.READER:QUASIQUOTE
       ((ECLECTOR.READER:UNQUOTE R)
        (ECLECTOR.READER:UNQUOTE-SPLICING
         (APPLY #'MAPCAR #'(LAMBDA (&REST ATOMS) (CONS M ATOMS))
                (MAPCAR #'ENSURE-LIST ARGS))))))
    (FLET ((CART-CASE-MACROFUNCTION (VARS CASES APPEND)
             (LET ((DECL (ZIPSYM VARS)))
               (ECLECTOR.READER:QUASIQUOTE
                (LET ((ECLECTOR.READER:UNQUOTE-SPLICING DECL))
                  (COND
                   (ECLECTOR.READER:UNQUOTE-SPLICING
                    (MAPCAR
                     #'(LAMBDA (CLAUSE)
                         (ECLECTOR.READER:QUASIQUOTE
                          ((AND
                            (ECLECTOR.READER:UNQUOTE-SPLICING
                             (MAPCAR
                              #'(LAMBDA (X)
                                  (IF (CONSP (SECOND X))
                                      (ECLECTOR.READER:QUASIQUOTE
                                       (OR
                                        (ECLECTOR.READER:UNQUOTE-SPLICING
                                         (MAPCAR
                                          #'(LAMBDA (U)
                                              (ECLECTOR.READER:QUASIQUOTE
                                               (EQL
                                                (ECLECTOR.READER:UNQUOTE
                                                 (FIRST X))
                                                '(ECLECTOR.READER:UNQUOTE U))))
                                          (SECOND X)))))
                                      (ECLECTOR.READER:QUASIQUOTE
                                       (EQL (ECLECTOR.READER:UNQUOTE (FIRST X))
                                            '(ECLECTOR.READER:UNQUOTE
                                              (SECOND X))))))
                              (REMOVE T
                                      (ZIP (MAPCAR #'CAR DECL) (FIRST CLAUSE))
                                      :KEY #'SECOND))))
                           (ECLECTOR.READER:UNQUOTE-SPLICING (CDR CLAUSE)))))
                     CASES))
                   (ECLECTOR.READER:UNQUOTE-SPLICING APPEND)))))))
      (DEFMACRO CART-CASE ((&REST VARS) &BODY CASES)
        (CART-CASE-MACROFUNCTION VARS CASES NIL))
      (DEFMACRO CART-ECASE ((&REST VARS) &BODY CASES)
        (CART-CASE-MACROFUNCTION VARS CASES
         (ECLECTOR.READER:QUASIQUOTE
          ((T (ERROR "cart-ecase: Case failure.")))))))
    (FLET ((CART-TYPECASE-FN (VARS CASES APPEND)
             (LET* ((DECL (ZIPSYM VARS)))
               (ECLECTOR.READER:QUASIQUOTE
                (LET ((ECLECTOR.READER:UNQUOTE-SPLICING DECL))
                  (COND
                   (ECLECTOR.READER:UNQUOTE-SPLICING
                    (MAPCAR
                     #'(LAMBDA (CLAUSE)
                         (ECLECTOR.READER:QUASIQUOTE
                          ((ZIPRM (AND TYPEP)
                            (ECLECTOR.READER:UNQUOTE (MAPCAR #'CAR DECL))
                            (ECLECTOR.READER:UNQUOTE
                             (MAPCAR
                              #'(LAMBDA (X)
                                  (ECLECTOR.READER:QUASIQUOTE
                                   '(ECLECTOR.READER:UNQUOTE X)))
                              (FIRST CLAUSE))))
                           (LOCALLY
                            (DECLARE
                             (ECLECTOR.READER:UNQUOTE-SPLICING
                              (MAPCAR
                               (FUNCTION
                                (LAMBDA (X Y)
                                  (ECLECTOR.READER:QUASIQUOTE
                                   (TYPE (ECLECTOR.READER:UNQUOTE X)
                                    (ECLECTOR.READER:UNQUOTE Y)))))
                               (FIRST CLAUSE) (MAPCAR (FUNCTION CAR) DECL))))
                            (ECLECTOR.READER:UNQUOTE-SPLICING (CDR CLAUSE))))))
                     CASES))
                   (ECLECTOR.READER:UNQUOTE-SPLICING APPEND)))))))
      (DEFMACRO CART-TYPECASE (VARS &BODY CASES)
        (CART-TYPECASE-FN VARS CASES NIL))
      (DEFMACRO CART-ETYPECASE (VARS &BODY CASES)
        (CART-TYPECASE-FN VARS CASES
         (ECLECTOR.READER:QUASIQUOTE
          ((T (ERROR "cart-etypecase: Case failure.")))))))
    (DEFMACRO VALUES-N (N &REST VALUES)
      (USING-GENSYMS (DECL (N))
       (LABELS ((MAKE-CD (I RETS VRETS)
                  (ECLECTOR.READER:QUASIQUOTE
                   ((LET (((ECLECTOR.READER:UNQUOTE (FIRST (CAR RETS)))
                           (ECLECTOR.READER:UNQUOTE
                            (MAPTREE '(VALUES-N :PREVIOUS)
                             #'(LAMBDA (X)
                                 (MATCH X ((LIST* 'VALUES-N _) X)
                                  ((LAMBDA-LIST :PREVIOUS &OPTIONAL
                                    (IDX (- I 2)))
                                   (ASSERT (< -1 IDX (LENGTH VRETS)) NIL
                                           'INVALID-ARGUMENTS)
                                   (ELT (REVERSE VRETS) IDX))))
                             (SECOND (CAR RETS))))))
                      (ECLECTOR.READER:UNQUOTE
                       (RECURSIVE-APPEND
                        (WHEN (CDR RETS)
                          (ECLECTOR.READER:QUASIQUOTE
                           (IF (> (ECLECTOR.READER:UNQUOTE N)
                                  (ECLECTOR.READER:UNQUOTE I))
                               (ECLECTOR.READER:UNQUOTE-SPLICING
                                (MAKE-CD (1+ I) (CDR RETS)
                                 (CONS (CAAR RETS) VRETS))))))
                        (ECLECTOR.READER:QUASIQUOTE
                         (VALUES
                          (ECLECTOR.READER:UNQUOTE-SPLICING (REVERSE VRETS))
                          (ECLECTOR.READER:UNQUOTE (CAAR RETS)))))))))))
         (ECLECTOR.READER:QUASIQUOTE
          (LET ((ECLECTOR.READER:UNQUOTE-SPLICING DECL))
            (WHEN (> (ECLECTOR.READER:UNQUOTE N) 0)
              (ECLECTOR.READER:UNQUOTE-SPLICING
               (MAKE-CD 1 (ZIPSYM VALUES) NIL))))))))
    (DEFMACRO LETV* (BINDINGS &BODY BODY)
      "
  This macro extends the syntax of let* to handle multiple values and destructuring bind,
  it also handles type declarations. The declarations list @arg{vars} is similar to that in let:
  look at the below examples.

  Examples:
  @lisp
  > (macroexpand-1 `(letv* ((x 2 :type fixnum)
			    ((a &optional (c 2)) b (values (list 1) 3) :type (fixnum &optional (t)) t))
		      t))
  => (LET ((X 2))
	   (DECLARE (TYPE FIXNUM X))
       (MULTIPLE-VALUE-BIND (#:G1120 B) (VALUES (LIST 1) 3)
	 (DECLARE (TYPE T B))
	 (DESTRUCTURING-BIND (A &OPTIONAL (C 2)) #:G1120
	   (DECLARE (TYPE FIXNUM A)
		    (TYPE T C))
	   (LOCALLY T))))
  @end lisp
  "
      (LET ((CONSY (GENSYM "consy")))
        (LABELS ((TYPEDECL (SYMS ALIST)
                   (LET ((DECLS
                          (REMOVE-IF #'NULL
                                     (MAPCAR
                                      #'(LAMBDA (S)
                                          (LET ((TS (ASSOC S ALIST)))
                                            (WHEN TS
                                              (IF (SECOND TS)
                                                  (ECLECTOR.READER:QUASIQUOTE
                                                   (TYPE
                                                    (ECLECTOR.READER:UNQUOTE
                                                     (SECOND TS))
                                                    (ECLECTOR.READER:UNQUOTE
                                                     S)))
                                                  (ECLECTOR.READER:QUASIQUOTE
                                                   (IGNORE
                                                    (ECLECTOR.READER:UNQUOTE
                                                     S)))))))
                                      SYMS))))
                     (WHEN DECLS
                       (ECLECTOR.READER:QUASIQUOTE
                        ((DECLARE
                          (ECLECTOR.READER:UNQUOTE-SPLICING DECLS))))))))
          (APPLY #'RECURSIVE-APPEND
                 (APPEND
                  (MAPCAN
                   #'(LAMBDA (X)
                       (DESTRUCTURING-BIND
                           (BIND EXPR TYPE)
                           (LET ((TPOS (POSITION :TYPE X)) (LEN (LENGTH X)))
                             (LIST
                              (DECONSIFY (SUBSEQ X 0 (1- (OR TPOS LEN))) CONSY)
                              (NTH (1- (OR TPOS LEN)) X)
                              (WHEN TPOS
                                (DECONSIFY (NTHCDR (1+ TPOS) X) CONSY))))
                         (LET ((FLT (REMOVE CONSY (FLATTEN BIND))))
                           (ASSERT
                            (= (LENGTH FLT) (LENGTH (REMOVE-DUPLICATES FLT)))
                            NIL "Duplicates present in binding ~a" FLT))
                         (IF (EQUAL BIND '(NIL))
                             (ECLECTOR.READER:QUASIQUOTE
                              ((PROGN (ECLECTOR.READER:UNQUOTE EXPR))))
                             (LET* ((TYPA
                                     (MAPTREE T
                                      #'(LAMBDA (X)
                                          (IF (ATOM (CAR X))
                                              (UNLESS
                                                  (OR (EQL (CAR X) CONSY)
                                                      (MEMBER (CAR X)
                                                              LAMBDA-LIST-KEYWORDS))
                                                (LIST X))
                                              (VALUES X
                                                      #'(LAMBDA (MF X)
                                                          (APPLY #'APPEND
                                                                 (MAPCAR MF
                                                                         X))))))
                                      (ZIPTREE BIND TYPE)))
                                    (VSYMS
                                     (MAPCAR
                                      #'(LAMBDA (X)
                                          (IF (LISTP X)
                                              (LET ((G (GENSYM)))
                                                (LIST G
                                                      (ECLECTOR.READER:QUASIQUOTE
                                                       (DESTRUCTURING-BIND
                                                           (
                                                            ECLECTOR.READER:UNQUOTE
                                                            (RECONSIFY
                                                             X
                                                             CONSY))
                                                           (ECLECTOR.READER:UNQUOTE
                                                            G)
                                                         (ECLECTOR.READER:UNQUOTE-SPLICING
                                                          (TYPEDECL (FLATTEN X)
                                                           TYPA))))))
                                              (LIST X)))
                                      BIND)))
                               (LIST*
                                (RECURSIVE-APPEND
                                 (IF (> (LENGTH BIND) 1)
                                     (ECLECTOR.READER:QUASIQUOTE
                                      (MULTIPLE-VALUE-BIND
                                          ((ECLECTOR.READER:UNQUOTE-SPLICING
                                            (MAPCAR #'CAR VSYMS)))
                                          (ECLECTOR.READER:UNQUOTE EXPR)))
                                     (ECLECTOR.READER:QUASIQUOTE
                                      (LET (((ECLECTOR.READER:UNQUOTE-SPLICING
                                              (MAPCAR #'CAR VSYMS))
                                             (ECLECTOR.READER:UNQUOTE
                                              EXPR))))))
                                 (CAR (TYPEDECL (MAPCAR #'CAR VSYMS) TYPA)))
                                (REMOVE-IF #'NULL (MAPCAR #'CADR VSYMS)))))))
                   BINDINGS)
                  (ECLECTOR.READER:QUASIQUOTE
                   ((LOCALLY (ECLECTOR.READER:UNQUOTE-SPLICING BODY)))))))))
    (FLET ((LET-TYPED-EXPANSION (EXPR)
             (EMATCH EXPR
              ((LAMBDA-LIST LETSYM BINDINGS &BODY
                (OR (LIST* (LIST* 'DECLARE DECLARES) BODY) BODY))
               (ECLECTOR.READER:QUASIQUOTE
                ((ECLECTOR.READER:UNQUOTE LETSYM)
                 ((ECLECTOR.READER:UNQUOTE-SPLICING
                   (MAPCAR
                    #'(LAMBDA (X)
                        (EMATCH X
                         ((λLIST SYMBOL EXPRESSION &KEY (TYPE T TYPEP))
                          (WHEN TYPEP
                            (IF TYPE
                                (PUSH
                                 (ECLECTOR.READER:QUASIQUOTE
                                  (TYPE (ECLECTOR.READER:UNQUOTE TYPE)
                                   (ECLECTOR.READER:UNQUOTE SYMBOL)))
                                 DECLARES)
                                (PUSH
                                 (ECLECTOR.READER:QUASIQUOTE
                                  (IGNORE (ECLECTOR.READER:UNQUOTE TYPE)
                                   (ECLECTOR.READER:UNQUOTE SYMBOL)))
                                 DECLARES)))
                          (LIST SYMBOL EXPRESSION))
                         ((TYPE ATOM) X)))
                    BINDINGS)))
                 (ECLECTOR.READER:UNQUOTE-SPLICING
                  (WHEN DECLARES
                    (ECLECTOR.READER:QUASIQUOTE
                     ((DECLARE (ECLECTOR.READER:UNQUOTE-SPLICING DECLARES))))))
                 (ECLECTOR.READER:UNQUOTE-SPLICING BODY)))))))
      (DEFMACRO LET-TYPED (BINDINGS &BODY BODY)
        "
  This macro works basically like let, but also allows type-declarations
  with the key :type.

  Example:
  @lisp
  > (macroexpand-1
      `(let-typed ((x 1 :type fixnum))
	  (+ 1 x)))
  => (LET ((X 1))
	(DECLARE (TYPE FIXNUM X))
	(+ 1 X))
  @end lisp
  "
        (LET-TYPED-EXPANSION (LIST* 'LET BINDINGS BODY)))
      (DEFMACRO LET*-TYPED (BINDINGS &BODY BODY)
        "
  This macro works basically like let*, but also allows type-declarations
  with the key :type.

  Example:
  @lisp
  > (macroexpand-1
      `(let*-typed ((x 1 :type fixnum))
	  (+ 1 x)))
  => (LET* ((X 1))
	(DECLARE (TYPE FIXNUM X))
	(+ 1 X))
  @end lisp
  "
        (LET-TYPED-EXPANSION (LIST* 'LET* BINDINGS BODY))))
    (DEFMACRO DEFINLINE (NAME &BODY REST)
      "
  Creates a function and declaims them inline: short form for defining an inlined function.
  "
      (ECLECTOR.READER:QUASIQUOTE
       (PROGN
        (DECLAIM (INLINE (ECLECTOR.READER:UNQUOTE NAME)))
        (DEFUN (ECLECTOR.READER:UNQUOTE NAME)
               (ECLECTOR.READER:UNQUOTE-SPLICING REST)))))
    (DEFMACRO WITH-OPTIMIZATION ((&REST ARGS) &BODY BODY)
      "
  Macro creates a local environment with optimization declarations, and
  executes form.

  Example:
  @lisp
  > (macroexpand-1
      `(with-optimization (:speed 2 :safety 3)
	  (+ 1d0 2d0)))
  => (LOCALLY (DECLARE (OPTIMIZE (SPEED 2) (SAFETY 3))) (+ 1.0d0 2.0d0))
  @end lisp
  "
      (DESTRUCTURING-BIND
          (DECL+ BODY)
          (TRIVIA.LEVEL2:MATCH BODY
            ((LIST* (LIST* 'DECLARE DECL) BODY) (LIST DECL BODY))
            (_ (LIST NIL BODY)))
        (ECLECTOR.READER:QUASIQUOTE
         (LOCALLY
          (DECLARE
           (OPTIMIZE
            (ECLECTOR.READER:UNQUOTE-SPLICING
             (TRIVIA.LEVEL2:EMATCH ARGS
               ((LAMBDA-LIST &KEY SPEED SAFETY SPACE DEBUG)
                (REMOVE NIL
                        (MAPCAR
                         (FUNCTION
                          (LAMBDA (NAME VAL)
                            (IF VAL
                                (ECLECTOR.READER:QUASIQUOTE
                                 ((ECLECTOR.READER:UNQUOTE NAME)
                                  (ECLECTOR.READER:UNQUOTE VAL))))))
                         (ECLECTOR.READER:QUASIQUOTE
                          (SPEED SAFETY SPACE DEBUG))
                         (LIST SPEED SAFETY SPACE DEBUG)))))))
           (ECLECTOR.READER:UNQUOTE-SPLICING DECL+))
          (ECLECTOR.READER:UNQUOTE-SPLICING BODY)))))
    (DEFMACRO VERY-QUICKLY (&BODY FORMS)
      "
  Macro which encloses @arg{forms} inside
  (declare (optimize (speed 3) (safety 0) (space 0)))
  "
      (ECLECTOR.READER:QUASIQUOTE
       (WITH-OPTIMIZATION (:SAFETY 3)
        (ECLECTOR.READER:UNQUOTE-SPLICING FORMS))))
    (DEFMACRO EVAL-EVERY (&BODY FORMS)
      (ECLECTOR.READER:QUASIQUOTE
       (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
         (ECLECTOR.READER:UNQUOTE-SPLICING FORMS))))
    (DEFMACRO WITH-MEMOIZATION
              (
               (&OPTIONAL
                (HASH-TABLE
                 (ECLECTOR.READER:QUASIQUOTE (MAKE-HASH-TABLE :TEST 'EQUAL))))
               &BODY BODY
               &AUX CACHE NEED-HASHTABLEP)
      (WITH-GENSYMS (TABLE VALUE EXISTS-P ARGS)
       (LABELS ((TRANSFORMER (X)
                  (EMATCH X ((LIST* (OR 'WITH-MEMOIZATION 'QUOTE) _) X)
                   ((LIST* 'MEMOIZING BODY)
                    (EMATCH BODY
                     ((LIST
                       (LAMBDA-LIST 'LET BINDINGS &BODY
                        (OR (LIST* (AND (LIST* 'DECLARE _) DECL-P) BODY) BODY)
                        &AUX
                        (DECLARES
                         (IF DECL-P
                             (LIST DECL-P)))
                        (ID (GENSYM "memo-"))))
                      (SETF NEED-HASHTABLEP T)
                      (ECLECTOR.READER:QUASIQUOTE
                       (LET ((ECLECTOR.READER:UNQUOTE-SPLICING BINDINGS))
                         (ECLECTOR.READER:UNQUOTE-SPLICING DECLARES)
                         (VALUES-LIST
                          (GETHASH!
                           (LIST '(ECLECTOR.READER:UNQUOTE ID)
                                 (ECLECTOR.READER:UNQUOTE-SPLICING
                                  (MAPCAR #'CAR BINDINGS)))
                           (ECLECTOR.READER:UNQUOTE TABLE)
                           (MULTIPLE-VALUE-LIST
                            (PROGN
                             (ECLECTOR.READER:UNQUOTE-SPLICING BODY))))))))
                     ((LIST
                       (LAMBDA-LIST (AND DEF (OR 'DEFUN 'DEFMETHOD)) NAME
                        FUNC-ARGS &BODY
                        (OR (LIST* (AND (LIST* 'DECLARE _) DECL-P) BODY) BODY)
                        &AUX
                        (DECLARES
                         (IF DECL-P
                             (LIST DECL-P)))
                        (ID (GENSYM "memo-"))))
                      (SETF NEED-HASHTABLEP T)
                      (ASSERT
                       (NOT
                        (INTERSECTION '(&REST &ALLOW-OTHER-KEYS) FUNC-ARGS))
                       NIL
                       "can't memoize functions with &rest, &allow-other-keys in their defining lambda-lists")
                      (ECLECTOR.READER:QUASIQUOTE
                       ((ECLECTOR.READER:UNQUOTE DEF)
                        (ECLECTOR.READER:UNQUOTE NAME)
                        ((ECLECTOR.READER:UNQUOTE-SPLICING FUNC-ARGS))
                        (ECLECTOR.READER:UNQUOTE-SPLICING DECLARES)
                        (VALUES-LIST
                         (GETHASH!
                          (LIST '(ECLECTOR.READER:UNQUOTE ID)
                                (ECLECTOR.READER:UNQUOTE-SPLICING
                                 (MAPCAR #'(LAMBDA (X) (FIRST (ENSURE-LIST X)))
                                         (SET-DIFFERENCE FUNC-ARGS
                                                         LAMBDA-LIST-KEYWORDS))))
                          (ECLECTOR.READER:UNQUOTE TABLE)
                          (MULTIPLE-VALUE-LIST
                           (PROGN
                            (ECLECTOR.READER:UNQUOTE-SPLICING BODY))))))))
                     ((LIST
                       (LAMBDA-LIST (AND DEF (OR 'LABELS 'FLET)) DEFINITIONS
                        &BODY BODY))
                      (SETF NEED-HASHTABLEP T)
                      (ECLECTOR.READER:QUASIQUOTE
                       ((ECLECTOR.READER:UNQUOTE DEF)
                        ((ECLECTOR.READER:UNQUOTE-SPLICING
                          (MAPCAR
                           #'(LAMBDA (X)
                               (CDR
                                (TRANSFORMER
                                 (ECLECTOR.READER:QUASIQUOTE
                                  (MEMOIZING
                                   (DEFUN (ECLECTOR.READER:UNQUOTE-SPLICING
                                           X)))))))
                           DEFINITIONS)))
                        (ECLECTOR.READER:UNQUOTE-SPLICING BODY))))
                     ((LAMBDA-LIST CODE &KEY (TYPE T TYPEP) (GLOBAL NIL)
                       (BIND (GENSYM)) &AUX (BOUNDP (GENSYM)))
                      (IF GLOBAL
                          (IF-LET
                           ((CV
                             (RASSOC CODE CACHE :KEY #'FIRST :TEST #'EQUAL)))
                           (FIRST CV)
                           (VALUES
                            (LIST* BIND CODE
                                   (IF TYPEP
                                       (ECLECTOR.READER:QUASIQUOTE
                                        (:TYPE
                                         (ECLECTOR.READER:UNQUOTE TYPE)))))
                            #'(LAMBDA (F DECL)
                                (PUSH
                                 (LIST* (FIRST DECL) (FUNCALL F (SECOND DECL))
                                        (CDDR DECL))
                                 CACHE)
                                (FIRST DECL))))
                          (PROGN
                           (PUSH (LIST BIND NIL) CACHE)
                           (PUSH (LIST BOUNDP NIL) CACHE)
                           (ECLECTOR.READER:QUASIQUOTE
                            (THE (ECLECTOR.READER:UNQUOTE TYPE)
                                 (IF (ECLECTOR.READER:UNQUOTE BOUNDP)
                                     (ECLECTOR.READER:UNQUOTE BIND)
                                     (SETF (ECLECTOR.READER:UNQUOTE BOUNDP) T
                                           (ECLECTOR.READER:UNQUOTE BIND)
                                             (ECLECTOR.READER:UNQUOTE
                                              CODE)))))))
                      (ERROR "don't know how to memoize ~a" CODE)))))))
         (LET ((TRANSFORMED-BODY
                (MAPTREE '(MEMOIZING WITH-MEMOIZATION QUOTE) #'TRANSFORMER
                 BODY)))
           (ECLECTOR.READER:QUASIQUOTE
            (LET*-TYPED
             ((ECLECTOR.READER:UNQUOTE-SPLICING
               (IF NEED-HASHTABLEP
                   (ECLECTOR.READER:QUASIQUOTE
                    (((ECLECTOR.READER:UNQUOTE TABLE)
                      (ECLECTOR.READER:UNQUOTE HASH-TABLE))))))
              (ECLECTOR.READER:UNQUOTE-SPLICING (REVERSE CACHE)))
             (ECLECTOR.READER:UNQUOTE-SPLICING TRANSFORMED-BODY)))))))
    (DEFMACRO MEMOIZING (&REST BODY)
      (ERROR "Found un-expanded memoization block."))
    (DEFMACRO RECURSE-MAADI (X MATCH &BODY DISPATCHERS)
      (ASSERT (EQL (FIRST MATCH) :MATCH) NIL "invalid dispatch name")
      (LET ((MACROS
             (MAPCAR
              #'(LAMBDA (X)
                  (LIST*
                   (THE (AND KEYWORD (NOT (MEMBER :AND :OR :* :NOT :|.|)))
                        (CAR X))
                   (GENSYM "dispatch") (CDR X)))
              (LIST* MATCH DISPATCHERS))))
        (LABELS ((RECURSE (P)
                   (COND
                    ((AND (LISTP P)
                          (MEMBER (CAR P)
                                  (LIST* :AND :OR :* :NOT :|.|
                                         (MAPCAR #'CAR (CDR MACROS)))))
                     (CASE (CAR P)
                       (:AND
                        (ECLECTOR.READER:QUASIQUOTE
                         (AND
                          (ECLECTOR.READER:UNQUOTE-SPLICING
                           (MAPCAR #'RECURSE (CDR P))))))
                       (:OR
                        (ECLECTOR.READER:QUASIQUOTE
                         (OR
                          (ECLECTOR.READER:UNQUOTE-SPLICING
                           (MAPCAR #'RECURSE (CDR P))))))
                       ((:* :NOT)
                        (DESTRUCTURING-BIND
                            (TERM CLAUSE)
                            P
                          (ECLECTOR.READER:QUASIQUOTE
                           (NOT
                            (ECLECTOR.READER:UNQUOTE
                             (IF (EQL TERM :*)
                                 (ECLECTOR.READER:QUASIQUOTE
                                  (DO ()
                                      ((NOT
                                        (ECLECTOR.READER:UNQUOTE
                                         (RECURSE CLAUSE))))))
                                 (RECURSE CLAUSE)))))))
                       (:|.|
                        (ECLECTOR.READER:QUASIQUOTE
                         (LOCALLY (ECLECTOR.READER:UNQUOTE-SPLICING (CDR P)))))
                       (T
                        (ECLECTOR.READER:QUASIQUOTE
                         ((ECLECTOR.READER:UNQUOTE
                           (SECOND (ASSOC (CAR P) MACROS)))
                          (ECLECTOR.READER:UNQUOTE-SPLICING (CDR P)))))))
                    (T
                     (ECLECTOR.READER:QUASIQUOTE
                      ((ECLECTOR.READER:UNQUOTE (SECOND (ASSOC :MATCH MACROS)))
                       (ECLECTOR.READER:UNQUOTE P)))))))
          (ECLECTOR.READER:QUASIQUOTE
           (MACROLET ((ECLECTOR.READER:UNQUOTE-SPLICING
                          (MAPCAR (FUNCTION CDR) MACROS)
                        ))
             (ECLECTOR.READER:UNQUOTE (RECURSE X)))))))
    (DEFMACRO REC (NAME ARGS &BODY BODY)
      (LET ((KEYPOS
             (OR
              (POSITION-IF #'(LAMBDA (X) (MEMBER X LAMBDA-LIST-KEYWORDS)) ARGS)
              (LENGTH ARGS))))
        (ECLECTOR.READER:QUASIQUOTE
         (LABELS (((ECLECTOR.READER:UNQUOTE NAME)
                      (
                       (ECLECTOR.READER:UNQUOTE-SPLICING
                        (MAPCAR #'FIRST (SUBSEQ ARGS 0 KEYPOS)))
                       (ECLECTOR.READER:UNQUOTE-SPLICING (SUBSEQ ARGS KEYPOS)))
                    (ECLECTOR.READER:UNQUOTE-SPLICING BODY)))
           ((ECLECTOR.READER:UNQUOTE NAME)
            (ECLECTOR.READER:UNQUOTE-SPLICING
             (MAPCAR #'SECOND (SUBSEQ ARGS 0 KEYPOS))))))))
    (DEFMACRO GETHASH! (KEY TABLE DEFAULT)
      (USING-GENSYMS (DECL (KEY TABLE) (VALUE EXISTS-P))
       (ECLECTOR.READER:QUASIQUOTE
        (LET ((ECLECTOR.READER:UNQUOTE-SPLICING DECL))
          (LETV*
           (((ECLECTOR.READER:UNQUOTE VALUE) (ECLECTOR.READER:UNQUOTE EXISTS-P)
             (GETHASH (ECLECTOR.READER:UNQUOTE KEY)
                      (ECLECTOR.READER:UNQUOTE TABLE))))
           (IF (ECLECTOR.READER:UNQUOTE EXISTS-P)
               (VALUES (ECLECTOR.READER:UNQUOTE VALUE) T)
               (SETF (GETHASH (ECLECTOR.READER:UNQUOTE KEY)
                              (ECLECTOR.READER:UNQUOTE TABLE))
                       (ECLECTOR.READER:UNQUOTE DEFAULT)))))))))

[matlisp/src/utilities/macros.lisp:207]
  (DEFMACRO WITH-OPTIMIZATION ((&REST ARGS) &BODY BODY)
    "
  Macro creates a local environment with optimization declarations, and
  executes form.

  Example:
  @lisp
  > (macroexpand-1
      `(with-optimization (:speed 2 :safety 3)
	  (+ 1d0 2d0)))
  => (LOCALLY (DECLARE (OPTIMIZE (SPEED 2) (SAFETY 3))) (+ 1.0d0 2.0d0))
  @end lisp
  "
    (DESTRUCTURING-BIND
        (DECL+ BODY)
        (TRIVIA.LEVEL2:MATCH BODY
          ((LIST* (LIST* 'DECLARE DECL) BODY) (LIST DECL BODY))
          (_ (LIST NIL BODY)))
      (ECLECTOR.READER:QUASIQUOTE
       (LOCALLY
        (DECLARE
         (OPTIMIZE
          (ECLECTOR.READER:UNQUOTE-SPLICING
           (TRIVIA.LEVEL2:EMATCH ARGS
             ((LAMBDA-LIST &KEY SPEED SAFETY SPACE DEBUG)
              (REMOVE NIL
                      (MAPCAR
                       (FUNCTION
                        (LAMBDA (NAME VAL)
                          (IF VAL
                              (ECLECTOR.READER:QUASIQUOTE
                               ((ECLECTOR.READER:UNQUOTE NAME)
                                (ECLECTOR.READER:UNQUOTE VAL))))))
                       (ECLECTOR.READER:QUASIQUOTE (SPEED SAFETY SPACE DEBUG))
                       (LIST SPEED SAFETY SPACE DEBUG)))))))
         (ECLECTOR.READER:UNQUOTE-SPLICING DECL+))
        (ECLECTOR.READER:UNQUOTE-SPLICING BODY)))))

[matlisp/src/utilities/string.lisp:3]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (DECLAIM (INLINE STRING+))
    (DEFUN STRING+ (&REST STRINGS)
      (APPLY #'CONCATENATE (CONS 'STRING STRINGS)))
    (DEFUN STRING-JOIN (ATOM &REST STRINGS)
      (LET ((RET NIL)
            (ATOM
             (IF (CHARACTERP ATOM)
                 (STRING ATOM)
                 ATOM)))
        (DOLIST (STR STRINGS) (SETF RET (STRING+ RET (WHEN RET ATOM) STR)))
        RET))
    (DEFUN FILE->STRING (PATH)
      "Sucks up an entire file from PATH into a freshly-allocated string,
returning two values: the string and the number of bytes read."
      (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3)))
      (WITH-OPEN-FILE (S PATH :EXTERNAL-FORMAT :ISO8859-1)
        (LET* ((LEN (FILE-LENGTH S))
               (DATA (MAKE-ARRAY LEN :ELEMENT-TYPE 'STANDARD-CHAR)))
          (VALUES DATA (READ-SEQUENCE DATA S)))))
    (DEFUN FILE->STRING (PATH)
      "Sucks up an entire file from PATH into a freshly-allocated string,
returning two values: the string and the number of bytes read."
      (LET* ((FSIZE (WITH-OPEN-FILE (S PATH) (FILE-LENGTH S)))
             (DATA (MAKE-ARRAY FSIZE :ELEMENT-TYPE 'STANDARD-CHAR))
             (FD (SB-POSIX:OPEN (TRANSLATE-LOGICAL-PATHNAME PATH) 0)))
        (UNWIND-PROTECT (SB-POSIX:READ FD (SB-SYS:VECTOR-SAP DATA) FSIZE)
          (SB-POSIX:CLOSE FD))
        (VALUES DATA FSIZE)))
    (DECLAIM (INLINE SPLIT-SEQ))
    (DEFUN SPLIT-SEQ (TEST SEQO &KEY MAX-CUTS)
      "Split a sequence, wherever the given character occurs."
      (LET ((SEQ (ETYPECASE SEQO (VECTOR SEQO) (LIST (COERCE SEQO 'VECTOR))))
            (SPLIT-LIST NIL)
            (SPLIT-COUNT 0)
            (DELETES NIL))
        (LABELS ((LEFT-SPLIT (PREV I)
                   (IF (NOT DELETES)
                       (WHEN (< PREV I)
                         (PUSH (SUBSEQ SEQ PREV I) SPLIT-LIST)
                         (INCF SPLIT-COUNT))
                       (DO ((DLST DELETES (OR (CDR DLST) (CONS (1- PREV) T)))
                            (PELE I (CAR DLST))
                            (RET NIL))
                           ((EQL DLST T)
                            (PROGN
                             (SETF DELETES NIL)
                             (WHEN RET
                               (PUSH (APPLY #'STRING+ RET) SPLIT-LIST)
                               (INCF SPLIT-COUNT))))
                         (LET ((ELE (CAR DLST)))
                           (WHEN (< (1+ ELE) PELE)
                             (PUSH (SUBSEQ SEQ (1+ ELE) PELE) RET)))))))
          (LOOP :FOR I :FROM 0 :TO (LENGTH SEQ)
                :WITH LEN := (LENGTH SEQ)
                :WITH PREV := 0
                :DO (LET ((CMD NIL))
                      (COND
                       ((OR (= I LEN) (AND MAX-CUTS (>= SPLIT-COUNT MAX-CUTS)))
                        (LEFT-SPLIT PREV LEN) (RETURN))
                       ((SETF CMD (FUNCALL TEST (AREF SEQ I)))
                        (CASE CMD
                          (:LEFT (LEFT-SPLIT PREV (1+ I)) (SETF PREV (1+ I)))
                          (:RIGHT (LEFT-SPLIT PREV I) (SETF PREV I))
                          (:KEEP
                           (LEFT-SPLIT PREV I)
                           (PUSH (STRING (AREF SEQ I)) SPLIT-LIST)
                           (INCF SPLIT-COUNT)
                           (SETF PREV (1+ I)))
                          (:DELETE (PUSH I DELETES))
                          (T (LEFT-SPLIT PREV I) (SETF PREV (1+ I)))))))))
        (VALUES
         (LET ((RET (NREVERSE SPLIT-LIST)))
           (ETYPECASE SEQO
             (VECTOR RET)
             (LIST (MAPCAR #'(LAMBDA (X) (COERCE X 'LIST)) RET))))
         (1- SPLIT-COUNT))))
    (DEFUN SPLITLINES (STRING)
      "Split the given string wherever the Carriage-return occurs."
      (SPLIT-SEQ #'(LAMBDA (X) (OR (CHAR= X #\Newline) (CHAR= X #\Return)))
       STRING)))

[matlisp/src/utilities/string.lisp:16]
  (DEFUN FILE->STRING (PATH)
    "Sucks up an entire file from PATH into a freshly-allocated string,
returning two values: the string and the number of bytes read."
    (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3)))
    (WITH-OPEN-FILE (S PATH :EXTERNAL-FORMAT :ISO8859-1)
      (LET* ((LEN (FILE-LENGTH S))
             (DATA (MAKE-ARRAY LEN :ELEMENT-TYPE 'STANDARD-CHAR)))
        (VALUES DATA (READ-SEQUENCE DATA S)))))

[maxima-code/archive/src/dump-excl.lisp:15]
  (PROCLAIM '(OPTIMIZE (SPEED 3) (SAFETY 0)))

[maxima-code/archive/src/init_max1.lisp:14]
  (PROCLAIM '(OPTIMIZE (SAFETY 0) (SPEED 3) (SPACE 0)))

[maxima-code/archive/src/serror.lisp:14]
  (EVAL-WHEN (COMPILE) (PROCLAIM '(OPTIMIZE (SAFETY 2) (SPEED 2) (SPACE 2))))

[maxima-code/share/affine/sysdef.lisp:10]
  (SETF (GET :AFFINE :MAKE)
          '(AMACROS (DUMMY-GC) (:PROGN (PROCLAIM '(OPTIMIZE (SAFETY 2))))
            POLYBAS SPARSEMAT (AQUOTIENT NEW-RAT) POLYA
            (NDOTSIMP POLYB POLYSMP SUB-PROJ POLYC POLYD) SHEAFA SHEAFB SHEAFC
            DIM-3 NDOTSIMP MODSIMP))

[maxima-code/share/contrib/Grobner/grobner.lisp:91]
  (DECLAIM (OPTIMIZE (SPEED 3) (SAFETY 1)))

[maxima-code/share/contrib/Grobner/grobner.lisp:980]
  (DECLAIM (OPTIMIZE (SPEED 3) (SAFETY 1)))

[maxima-code/share/contrib/altsimp/altsimp.lisp:111]
  (DECLAIM (OPTIMIZE (SPEED 3) (SAFETY 0)))

[maxima-code/share/contrib/chebformax.lisp:32]
  (DEFUN $CHEB_CALL (A X)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (DOUBLE-FLOAT X))
    (COND
     ((EQ (CAAR A) '$CHEBSERIES)
      (LET* ((BJ2 0.0d0) (BJ1 0.0d0) (BJ0 0.0d0))
        (DECLARE (DOUBLE-FLOAT BJ2 BJ1 BJ0))
        (SETF A (REVERSE (CDR A)))
        (LOOP WHILE (CDR A)
              DO (SETF BJ0
                         (+ (* 2.0d0 X BJ1) (- BJ2)
                            (THE DOUBLE-FLOAT (POP A)))) (SETF BJ2 BJ1
                                                               BJ1 BJ0))
        (+ (* X BJ1) (* 0.5d0 (POP A)) (- BJ2))))
     (T (ERROR "expecting chebseries,not ~s" A))))

[maxima-code/share/contrib/elliptic_curves/elliptic_curves.lisp:691]
  (DEFUN EC-SET-DIV-POLY-MOD (CAP N RED A B P)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (WHEN (< N 4) (SETQ N 4))
    (LET ((AA (* A A))
          (CUB
           (COND ((= 0 A) (LIST 3 1 0 B)) ((= 0 B) (LIST 3 1 1 A))
                 (T (LIST 3 1 1 A 0 B))))
          (PSI
           (SETF *EC-PSI*
                   (MAKE-ARRAY (+ CAP 3) :ELEMENT-TYPE 'LIST :INITIAL-ELEMENT
                               NIL)))
          (PSI2
           (SETF *EC-PSI2*
                   (MAKE-ARRAY (+ CAP 3) :ELEMENT-TYPE 'LIST :INITIAL-ELEMENT
                               NIL)))
          (PSI3
           (SETF *EC-PSI3*
                   (MAKE-ARRAY (+ CAP 3) :ELEMENT-TYPE 'LIST :INITIAL-ELEMENT
                               NIL))))
      (SETF *EC-POLY* (GF-NRED CUB RED)
            *EC-POLY2* (GF-SQ *EC-POLY* RED)
            *EC-PSI-RED* RED
            (SVREF PSI 1) (LIST 0 1)
            (SVREF PSI 2) (LIST 0 2)
            (SVREF PSI 3)
              (GF-NRED (GF-MOD (LIST 4 3 2 (* 6 A) 1 (* 12 B) 0 (- AA))) RED)
            (SVREF PSI2 1) (LIST 0 1)
            (SVREF PSI2 2) (LIST 0 (MOD 4 P))
            (SVREF PSI3 1) (LIST 0 1)
            (SVREF PSI3 2) (LIST 0 (MOD 8 P))
            (SVREF PSI 4)
              (GF-NRED
               (GF-MOD
                (LIST 6 4 4 (* 20 A) 3 (* 80 B) 2 (- (* 20 AA)) 1
                      (- (* 16 A B)) 0 (- (+ (* 32 B B) (* 4 A AA)))))
               RED)
            (SVREF PSI2 3) (GF-SQ (SVREF PSI 3) RED)
            (SVREF PSI3 3) (GF-TIMES (SVREF PSI 3) (SVREF PSI2 3) RED))
      (SETQ *EC-PSI-I* 4)
      (EC-SET-DIV-POLY-MOD1 N CAP)))

[maxima-code/share/contrib/elliptic_curves/elliptic_curves.lisp:725]
  (DEFUN EC-SET-PSI (I CAP)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((J (ASH I -1))
          (CUB2 *EC-POLY2*)
          (PSI *EC-PSI*)
          (PSI2 *EC-PSI2*)
          (PSI3 *EC-PSI3*)
          (RED *EC-PSI-RED*))
      (SETF (SVREF PSI I)
              (COND
               ((EVENP I)
                (UNLESS (= I CAP)
                  (SETF (SVREF PSI3 (1+ J))
                          (GF-KTIMES (SVREF PSI (1+ J)) (SVREF PSI2 (1+ J))
                           RED)))
                (GF-XCTIMES
                 (GF-KTIMES (SVREF PSI J)
                  (GF-PLUS
                   (GF-KTIMES (SVREF PSI (+ J 2)) (SVREF PSI2 (1- J)) RED)
                   (GF-NMINUS
                    (GF-KTIMES (SVREF PSI (- J 2)) (SVREF PSI2 (1+ J)) RED)))
                  RED)
                 *EC-INV2*))
               (T
                (UNLESS (= I CAP)
                  (SETF (SVREF PSI2 (+ J 2)) (GF-KSQ (SVREF PSI (+ J 2)) RED)))
                (IF (EVENP J)
                    (GF-PLUS
                     (GF-KTIMES
                      (GF-KTIMES (SVREF PSI (+ J 2)) (SVREF PSI3 J) RED) CUB2
                      RED)
                     (GF-NMINUS
                      (GF-KTIMES (SVREF PSI (1- J)) (SVREF PSI3 (1+ J)) RED)))
                    (GF-PLUS (GF-KTIMES (SVREF PSI (+ J 2)) (SVREF PSI3 J) RED)
                     (GF-NMINUS
                      (GF-KTIMES
                       (GF-KTIMES (SVREF PSI (1- J)) (SVREF PSI3 (1+ J)) RED)
                       CUB2 RED)))))))))

[maxima-code/share/contrib/elliptic_curves/elliptic_curves.lisp:766]
  (DEFUN GF-KTIMES (X Y RED)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (UNLESS (OR (NULL X) (NULL Y))
      (LET ((N (MAX (CAR X) (CAR Y))))
        (DECLARE (FIXNUM N))
        (COND ((< N 24) (GF-TIMES X Y RED))
              (T (WHEN (LOGBITP 0 N) (INCF N))
               (GF-NKTIMES (COPY-LIST X) (COPY-LIST Y) N RED))))))

[maxima-code/share/contrib/elliptic_curves/elliptic_curves.lisp:777]
  (DEFUN GF-NKTIMES (X Y N RED)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DECLARE (FIXNUM N))
    (COND ((< N 24) (GF-TIMES X Y RED))
          (T (WHEN (LOGBITP 0 N) (INCF N))
           (LET (X1 X0 Y1 Y0 Z1 Z0 ZZ (N/2 (ASH N -1)))
             (MULTIPLE-VALUE-SETQ (X1 X0) (GF-NSPLIT X N/2))
             (MULTIPLE-VALUE-SETQ (Y1 Y0) (GF-NSPLIT Y N/2))
             (SETQ Z1 (GF-TIMES X1 Y1 RED)
                   Z1
                     (GF-NPLUS (GF-NXETIMES (COPY-LIST Z1) N)
                      (GF-NMINUS (GF-NXETIMES Z1 N/2)))
                   Z0 (GF-TIMES X0 Y0 RED)
                   Z0
                     (GF-NPLUS (COPY-LIST Z0) (GF-NMINUS (GF-NXETIMES Z0 N/2)))
                   ZZ
                     (GF-NXETIMES
                      (GF-TIMES (GF-NPLUS X0 X1) (GF-NPLUS Y0 Y1) RED) N/2))
             (GF-NRED (GF-NPLUS (GF-NPLUS Z0 Z1) ZZ) RED)))))

[maxima-code/share/contrib/elliptic_curves/elliptic_curves.lisp:798]
  (DEFUN GF-KSQ (X RED)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (UNLESS (NULL X)
      (LET ((N (CAR X)))
        (DECLARE (FIXNUM N))
        (COND ((< N 16) (GF-SQ X RED))
              (T (WHEN (LOGBITP 0 N) (INCF N))
               (GF-NKSQ (COPY-LIST X) N RED))))))

[maxima-code/share/contrib/elliptic_curves/elliptic_curves.lisp:809]
  (DEFUN GF-NKSQ (X N RED)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DECLARE (FIXNUM N))
    (COND ((< N 16) (GF-SQ X RED))
          (T (WHEN (LOGBITP 0 N) (INCF N))
           (LET (Z1 Z0 ZZ (N/2 (ASH N -1)))
             (MULTIPLE-VALUE-SETQ (Z1 Z0) (GF-NSPLIT X N/2))
             (COND ((NULL Z1) (GF-NRED (GF-NKSQ Z0 N/2 RED) RED))
                   ((NULL Z0)
                    (GF-NRED (GF-NXETIMES (GF-NKSQ Z1 N/2 RED) N) RED))
                   (T
                    (SETQ ZZ (GF-XECTIMES (GF-TIMES Z1 Z0 RED) N/2 2)
                          Z0 (GF-NKSQ Z0 N/2 RED)
                          Z1 (GF-NXETIMES (GF-NKSQ Z1 N/2 RED) N))
                    (GF-NRED (GF-NPLUS (GF-NPLUS Z0 Z1) ZZ) RED)))))))

[maxima-code/share/contrib/elliptic_curves/elliptic_curves.lisp:829]
  (DEFUN GF-NSPLIT (X N)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DECLARE (FIXNUM N))
    (IF (NULL X)
        (VALUES NIL NIL)
        (PROG (R R0)
         A1
          (WHEN (< (THE FIXNUM (CAR X)) N) (RETURN (VALUES NIL X)))
          (RPLACA X (- (THE FIXNUM (CAR X)) N))
          (SETQ R (CDR X))
         A
          (WHEN (NULL (CDR R)) (RETURN (VALUES X NIL)))
          (WHEN (< (THE FIXNUM (CADR R)) N)
            (SETQ R0 (CDR R))
            (RPLACD R NIL)
            (RETURN (VALUES X R0)))
          (SETQ R (CDR R))
          (RPLACA R (- (THE FIXNUM (CAR R)) N))
          (SETQ R (CDR R))
          (GO A))))

[maxima-code/share/contrib/elliptic_curves/elliptic_curves.lisp:1027]
  (DEFUN GF-POW-SLIDING-WINDOW (X E RED)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET* ((L (INTEGER-LENGTH E))
           (K
            (COND ((<= L 64) 3) ((<= L 160) 4) ((<= L 384) 5) ((<= L 896) 6)
                  (T 7)))
           (TAB (GF-POW-SLIDING-WINDOW-TABLE X K RED))
           (RES (LIST 0 1))
           S
           U
           TMP)
      (DO ((I (1- L)))
          ((< I 0) RES)
        (COND
         ((LOGBITP I E) (SETQ S (MAX (1+ (- I K)) 0))
          (DO () ((LOGBITP S E)) (INCF S)) (SETQ TMP (1+ (- I S)))
          (DOTIMES (H TMP) (SETQ RES (GF-SQ RES RED)))
          (SETQ U (LDB (BYTE TMP S) E))
          (UNLESS (= U 0)
            (SETQ RES (GF-KTIMES RES (SVREF TAB (ASH U -1)) RED)))
          (SETQ I (1- S)))
         (T (SETQ RES (GF-SQ RES RED)) (DECF I))))))

[maxima-code/share/contrib/elliptic_curves/elliptic_curves.lisp:1052]
  (DEFUN GF-POW-SLIDING-WINDOW-TABLE (X K RED)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET* ((L (ASH 1 (1- K)))
           (TAB (MAKE-ARRAY L :ELEMENT-TYPE 'LIST :INITIAL-ELEMENT NIL))
           (XI X)
           (X2 (GF-SQ X RED)))
      (SETF (SVREF TAB 0) X)
      (DO ((I 1 (1+ I)))
          ((= I L) TAB)
        (SETQ XI (GF-KTIMES XI X2 RED))
        (SETF (SVREF TAB I) XI))))

[maxima-code/share/contrib/elliptic_curves/elliptic_curves.lisp:1792]
  (DEFUN EC-BINARY-PT-SEARCH (PT A)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((PX (CAR PT)) (PY (CADR PT)) X Y (M 0) AM)
      (DECLARE (FIXNUM M))
      (DO ((LO 0)
           (HI (1- (ARRAY-DIMENSION A 0))))
          ((< HI LO))
        (DECLARE (FIXNUM LO HI))
        (SETQ M (ASH (+ LO HI) -1)
              AM (SVREF A M)
              X (CAR AM))
        (COND ((< PX X) (SETQ HI (1- M))) ((> PX X) (SETQ LO (1+ M)))
              (T (SETQ Y (CADR AM))
               (COND ((< PY Y) (SETQ HI (1- M))) ((> PY Y) (SETQ LO (1+ M)))
                     (T (RETURN (CADDR AM)))))))))

[maxima-code/share/nelder_mead/la.lisp:54]
  (DEFUN QR-FACTORIZATION (MAT &KEY (WITH-Q T))
    (DECLARE (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT (* *)) MAT)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (WITH-MATRIX-DIMENSIONS (((M N) MAT))
     (LET ((Q
            (WHEN WITH-Q
              (LET ((PQ (MAKE-MATRIX M N)))
                (DECLARE (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT (* *)) PQ))
                (DOTIMES (I (MIN M N)) (SETF (AREF PQ I I) 1.0d0))
                PQ))))
       (LOOP FOR I FROM 0 BELOW (- M 1)
             DO (LOOP FOR J FROM (+ I 1) BELOW M
                      DO (LET ((A (AREF MAT I I)) (B (AREF MAT J I)))
                           (WHEN (/= B 0.0d0)
                             (LET* ((R (SQRT (+ (* A A) (* B B))))
                                    (C (/ A R))
                                    (S (/ B R)))
                               (LOOP FOR K FROM I BELOW M
                                     DO (LET ((OLDA (AREF MAT I K))
                                              (OLDB (AREF MAT J K)))
                                          (SETF (AREF MAT I K)
                                                  (+ (* C OLDA) (* S OLDB))
                                                (AREF MAT J K)
                                                  (+ (* (- S) OLDA)
                                                     (* C OLDB)))))
                               (WHEN WITH-Q
                                 (LET ((Q Q))
                                   (DECLARE
                                    (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT (* *)) Q))
                                   (LOOP FOR K FROM 0 BELOW M
                                         DO (LET ((OLDA (AREF Q K I))
                                                  (OLDB (AREF Q K J)))
                                              (SETF (AREF Q K I)
                                                      (+ (* C OLDA) (* S OLDB))
                                                    (AREF Q K J)
                                                      (+ (* (- S) OLDA)
                                                         (* C OLDB))))))))))))
       (VALUES MAT Q))))

[maxima-code/share/numeric/fft-core.lisp:168]
  (DEFUN FFT-R2-NN (X &KEY (INVERSE-FFT-P NIL))
    "Compute the FFT of X which MUST be a specialzed vector of complex
  double-float's whose length MUST be a power of 2.  If INVERSE-FFT-P
  is non-NIL, the inverse FFT is computed.  The scaling by 1/N is
  included in the inverse FFT.

  The contents of the input X may be destroyed."
    (DECLARE (TYPE (SIMPLE-ARRAY (COMPLEX DOUBLE-FLOAT) (*)) X))
    (LET* ((N (LENGTH X))
           (HALF-N (ASH N -1))
           (PAIRS-IN-GROUP (ASH N -1))
           (NUMBER-OF-GROUPS 1)
           (DISTANCE (ASH N -1))
           (NOT-SWITCH-INPUT T)
           (SINCOS
            (SINCOS-TABLE
             (#S(FORMGREP:SYMREF :NAME "LOG-BASE2" :QUALIFIER "MAXIMA-FFT")
              N)))
           (A X)
           (B (MAKE-ARRAY (LENGTH X) :ELEMENT-TYPE '(COMPLEX DOUBLE-FLOAT))))
      (DECLARE (FIXNUM N HALF-N PAIRS-IN-GROUP NUMBER-OF-GROUPS DISTANCE)
               (TYPE (SIMPLE-ARRAY (COMPLEX DOUBLE-FLOAT) (*)) A B SINCOS))
      (FLET ((FFT ()
               (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
               (LET ((INDEX 0))
                 (DECLARE (FIXNUM INDEX))
                 (DOTIMES (K NUMBER-OF-GROUPS)
                   (DECLARE (FIXNUM K))
                   (LET* ((JFIRST (* 2 K PAIRS-IN-GROUP))
                          (JLAST (+ JFIRST PAIRS-IN-GROUP -1))
                          (JTWIDDLE (* K PAIRS-IN-GROUP))
                          (W
                           (LET ((W (AREF SINCOS JTWIDDLE)))
                             (IF INVERSE-FFT-P
                                 (CONJUGATE W)
                                 W))))
                     (DECLARE (FIXNUM JFIRST JLAST JTWIDDLE)
                              (TYPE (COMPLEX DOUBLE-FLOAT) W))
                     (FORMAT T
                             "k = ~D, jfirst/last = ~D ~D jtwiddle = ~D dist ~D index ~D, W ~S~%"
                             K JFIRST JLAST JTWIDDLE DISTANCE INDEX W)
                     (LOOP FOR J OF-TYPE FIXNUM FROM JFIRST UPTO JLAST
                           DO (LET ((TEMP (* W (AREF A (+ J DISTANCE)))))
                                (SETF (AREF B INDEX) (+ (AREF A J) TEMP))
                                (SETF (AREF B (+ INDEX HALF-N))
                                        (- (AREF A J) TEMP))
                                (INCF INDEX))))))))
        (LOOP WHILE (< NUMBER-OF-GROUPS N)
              DO (FFT) (PROGN
                        (FORMAT T "number-of-groups = ~D~%" NUMBER-OF-GROUPS)
                        (FORMAT T "Output = ~S~%" B)) (ROTATEF A B) (SETF NOT-SWITCH-INPUT
                                                                            (NOT
                                                                             NOT-SWITCH-INPUT)) (SETF PAIRS-IN-GROUP
                                                                                                        (ASH
                                                                                                         PAIRS-IN-GROUP
                                                                                                         -1)) (SETF NUMBER-OF-GROUPS
                                                                                                                      (ASH
                                                                                                                       NUMBER-OF-GROUPS
                                                                                                                       1)) (SETF DISTANCE
                                                                                                                                   (ASH
                                                                                                                                    DISTANCE
                                                                                                                                    -1)))
        (IF INVERSE-FFT-P
            A
            (DOTIMES (K N A)
              (DECLARE (FIXNUM K)
                       (OPTIMIZE (SPEED 3) (SAFETY 0)))
              (LET ((W (AREF A K)))
                (SETF (AREF A K) (/ W N))))))))

[maxima-code/share/numeric/fft-interface.lisp:52]
  (DEFUN $REAL_FFT (INPUT)
    (MULTIPLE-VALUE-BIND (Z FROM-LISP INPUT-LENGTH)
        (#S(FORMGREP:SYMREF
            :NAME "FIND-RFFT-CONVERTERS"
            :QUALIFIER "MAXIMA-FFT")
         INPUT)
      (DECLARE (TYPE (SIMPLE-ARRAY (COMPLEX DOUBLE-FLOAT) (*)) Z))
      (UNLESS
          (= INPUT-LENGTH
             (ASH 1
                  (#S(FORMGREP:SYMREF
                      :NAME "LOG-BASE2"
                      :QUALIFIER "MAXIMA-FFT")
                   INPUT-LENGTH)))
        (MERROR "real_fft: size of input must be a power of 2, not ~M"
         INPUT-LENGTH))
      (LET* ((N (ASH (LENGTH Z) 1))
             (RESULT
              (MAKE-ARRAY (1+ (LENGTH Z)) :ELEMENT-TYPE
                          '(COMPLEX DOUBLE-FLOAT))))
        (WHEN (< N 3) (RETURN-FROM $REAL_FFT ($FFT INPUT)))
        (LOCALLY
         (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
         (SETF Z
                 (#S(FORMGREP:SYMREF :NAME "FFT-R2-NN" :QUALIFIER "MAXIMA-FFT")
                  Z))
         (SETF (AREF RESULT 0)
                 (COMPLEX
                  (* 0.5 (+ (REALPART (AREF Z 0)) (IMAGPART (AREF Z 0))))))
         (LET ((SINCOS
                (#S(FORMGREP:SYMREF
                    :NAME "SINCOS-TABLE"
                    :QUALIFIER "MAXIMA-FFT")
                 (#S(FORMGREP:SYMREF :NAME "LOG-BASE2" :QUALIFIER "MAXIMA-FFT")
                  N)))
               (N/2 (LENGTH Z)))
           (DECLARE (TYPE (SIMPLE-ARRAY (COMPLEX DOUBLE-FLOAT) (*)) SINCOS))
           (LOOP FOR K OF-TYPE FIXNUM FROM 1 BELOW (LENGTH Z)
                 DO (SETF (AREF RESULT K)
                            (* 0.25
                               (+ (+ (AREF Z K) (CONJUGATE (AREF Z (- N/2 K))))
                                  (* #C(0.0d0 -1.0d0) (AREF SINCOS K)
                                     (- (AREF Z K)
                                        (CONJUGATE (AREF Z (- N/2 K)))))))))
           (SETF (AREF RESULT (LENGTH Z))
                   (COMPLEX
                    (* 0.5 (- (REALPART (AREF Z 0)) (IMAGPART (AREF Z 0))))))))
        (FUNCALL FROM-LISP RESULT))))

[maxima-code/src/csimp2.lisp:543]
  (DEFUN GAMMA-LANCZOS (Z)
    (DECLARE (TYPE (COMPLEX FLONUM) Z)
             (OPTIMIZE (SAFETY 3)))
    (LET ((C
           (MAKE-ARRAY 15 :ELEMENT-TYPE 'FLONUM :INITIAL-CONTENTS
                       '(1.0 57.156235 -59.59796 14.136098 -0.49191383
                         3.399465e-5 4.652363e-5 -9.8374476e-5 1.580887e-4
                         -2.1026444e-4 2.1743962e-4 -1.643181e-4 8.441822e-5
                         -2.6190839e-5 3.6899182e-6))))
      (DECLARE (TYPE (SIMPLE-ARRAY FLONUM (15)) C))
      (COND
       ((MINUSP (REALPART Z))
        (/ (FLOAT PI) (* (- Z) (SIN (* (FLOAT PI) Z)) (GAMMA-LANCZOS (- Z)))))
       ((<= (ABS Z) (SQRT FLONUM-EPSILON)) (/ (GAMMA-LANCZOS (+ 1 Z)) Z))
       (T
        (LET* ((Z (- Z 1))
               (ZH (+ Z 1/2))
               (ZGH (+ ZH 607/128))
               (SS
                (DO ((SUM 0.0)
                     (PP (1- (LENGTH C)) (1- PP)))
                    ((< PP 1) SUM)
                  (INCF SUM (/ (AREF C PP) (+ Z PP))))))
          (LET ((RESULT
                 (IGNORE-ERRORS
                  (LET ((ZP (EXPT ZGH (/ ZH 2))))
                    (* (SQRT (FLOAT (* 2 PI))) (+ SS (AREF C 0))
                       (* (/ ZP (EXP ZGH)) ZP))))))
            (COND
             ((NULL RESULT)
              (MERROR
               (#S(FORMGREP:SYMREF :NAME "GETTEXT" :QUALIFIER "INTL")
                "gamma: overflow in GAMMA-LANCZOS.")))
             ((OR (FLOAT-NAN-P (REALPART RESULT))
                  (FLOAT-INF-P (REALPART RESULT)))
              (MERROR
               (#S(FORMGREP:SYMREF :NAME "GETTEXT" :QUALIFIER "INTL")
                "gamma: overflow in GAMMA-LANCZOS.")))
             (T RESULT))))))))

[maxima-code/src/gamma.lisp:1873]
  (DEFUN LOG-GAMMA-LANCZOS (Z)
    (DECLARE (TYPE (COMPLEX FLONUM) Z)
             (OPTIMIZE (SAFETY 3)))
    (LET ((C
           (MAKE-ARRAY 15 :ELEMENT-TYPE 'FLONUM :INITIAL-CONTENTS
                       '(1.0 57.156235 -59.59796 14.136098 -0.49191383
                         3.399465e-5 4.652363e-5 -9.8374476e-5 1.580887e-4
                         -2.1026444e-4 2.1743962e-4 -1.643181e-4 8.441822e-5
                         -2.6190839e-5 3.6899182e-6))))
      (DECLARE (TYPE (SIMPLE-ARRAY FLONUM (15)) C))
      (IF (MINUSP (REALPART Z))
          (LET ((Z (- Z)))
            (-
             (+
              (* (- (FLOAT PI)) (COMPLEX 0 1) (ABS (FLOOR (REALPART Z)))
                 (- 1 (ABS (SIGNUM (IMAGPART Z)))))
              (LOG (FLOAT PI)) (- (LOG (- Z)))
              (- (LOG (SIN (* (FLOAT PI) (- Z (FLOOR (REALPART Z)))))))
              (* (FLOAT PI) (COMPLEX 0 1) (FLOOR (REALPART Z))
                 (SIGNUM (IMAGPART Z))))
             (LOG-GAMMA-LANCZOS Z)))
          (LET* ((Z (- Z 1))
                 (ZH (+ Z 1/2))
                 (ZGH (+ ZH 607/128))
                 (LNZP (* (/ ZH 2) (LOG ZGH)))
                 (SS
                  (DO ((SUM 0.0)
                       (PP (1- (LENGTH C)) (1- PP)))
                      ((< PP 1) SUM)
                    (INCF SUM (/ (AREF C PP) (+ Z PP))))))
            (+ (LOG (SQRT (FLOAT (* 2 PI)))) (LOG (+ SS (AREF C 0)))
               (+ (- ZGH) (* 2 LNZP)))))))

[maxima-code/src/ifactor.lisp:728]
  (DEFUN POWER-MOD (B E M)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (COND ((ZEROP E) (MOD 1 M))
          ((TYPEP E 'FIXNUM)
           (DO ((RES 1))
               (NIL)
             (WHEN (LOGBITP 0 E)
               (SETQ RES (MOD (* RES B) M))
               (WHEN (= 1 E) (RETURN RES)))
             (SETQ E (ASH E -1)
                   B (MOD (* B B) M))))
          (T
           (LET* ((L (INTEGER-LENGTH E))
                  (K
                   (COND ((< L 65) 3) ((< L 161) 4) ((< L 385) 5) ((< L 897) 6)
                         (T 7)))
                  (TAB (POWER-MOD-TAB B K M))
                  (RES 1)
                  S
                  U
                  TMP)
             (DO ((I (1- L)))
                 ((< I 0) RES)
               (COND
                ((LOGBITP I E) (SETQ S (MAX (1+ (- I K)) 0))
                 (DO () ((LOGBITP S E)) (INCF S)) (SETQ TMP (1+ (- I S)))
                 (DOTIMES (H TMP) (SETQ RES (MOD (* RES RES) M)))
                 (SETQ U (LDB (BYTE TMP S) E))
                 (UNLESS (= U 0)
                   (SETQ RES (MOD (* RES (SVREF TAB (ASH U -1))) M)))
                 (SETQ I (1- S)))
                (T (SETQ RES (MOD (* RES RES) M)) (DECF I))))))))

[maxima-code/src/ifactor.lisp:764]
  (DEFUN POWER-MOD-TAB (B K M)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET* ((L (ASH 1 (1- K)))
           (TAB (MAKE-ARRAY L :ELEMENT-TYPE 'INTEGER :INITIAL-ELEMENT 1))
           (BI B)
           (BB (MOD (* B B) M)))
      (SETF (SVREF TAB 0) B)
      (DO ((I 1 (1+ I)))
          ((= I L) TAB)
        (SETQ BI (MOD (* BI BB) M))
        (SETF (SVREF TAB I) BI))))

[maxima-code/src/mdebug.lisp:3]
  (DECLAIM (OPTIMIZE (SAFETY 2) (SPACE 3)))

[maxima-code/src/numeric.lisp:836]
  (DEFUN = (NUMBER &REST MORE-NUMBERS)
    "Returns T if all of its arguments are numerically equal, NIL otherwise."
    (DECLARE (OPTIMIZE (SAFETY 2)))
    (DO ((NLIST MORE-NUMBERS (CDR NLIST)))
        ((ATOM NLIST) T)
      (DECLARE (LIST NLIST))
      (IF (NOT (TWO-ARG-= (CAR NLIST) NUMBER))
          (RETURN NIL))))

[maxima-code/src/numeric.lisp:846]
  (DEFUN /= (NUMBER &REST MORE-NUMBERS)
    "Returns T if no two of its arguments are numerically equal, NIL otherwise."
    (DECLARE (OPTIMIZE (SAFETY 2)))
    (DO* ((HEAD NUMBER (CAR NLIST))
          (NLIST MORE-NUMBERS (CDR NLIST)))
         ((ATOM NLIST) T)
      (DECLARE (LIST NLIST))
      (UNLESS
          (DO* ((NL NLIST (CDR NL)))
               ((ATOM NL) T)
            (DECLARE (LIST NL))
            (IF (TWO-ARG-= HEAD (CAR NL))
                (RETURN NIL)))
        (RETURN NIL))))

[maxima-code/src/numeric.lisp:862]
  (MACROLET ((FROB (OP)
               (LET ((METHOD
                      (INTERN
                       (CONCATENATE 'STRING (STRING '#:TWO-ARG-)
                                    (SYMBOL-NAME OP))))
                     (CL-FUN (FIND-SYMBOL (SYMBOL-NAME OP) :CL)))
                 (ECLECTOR.READER:QUASIQUOTE
                  (PROGN
                   (DEFMETHOD (ECLECTOR.READER:UNQUOTE METHOD)
                              ((A FLOAT) (B FLOAT))
                     ((ECLECTOR.READER:UNQUOTE CL-FUN) A B))
                   (DEFMETHOD (ECLECTOR.READER:UNQUOTE METHOD)
                              ((A FLOAT) (B RATIONAL))
                     ((ECLECTOR.READER:UNQUOTE CL-FUN) A B))
                   (DEFMETHOD (ECLECTOR.READER:UNQUOTE METHOD)
                              ((A RATIONAL) (B FLOAT))
                     ((ECLECTOR.READER:UNQUOTE CL-FUN) A B))
                   (DEFMETHOD (ECLECTOR.READER:UNQUOTE METHOD)
                              ((A RATIONAL) (B RATIONAL))
                     ((ECLECTOR.READER:UNQUOTE CL-FUN) A B))
                   (DEFUN (ECLECTOR.READER:UNQUOTE OP)
                          (NUMBER &REST MORE-NUMBERS)
                     "Returns T if its arguments are in strictly increasing order, NIL otherwise."
                     (DECLARE (OPTIMIZE (SAFETY 2)))
                     (DO* ((N NUMBER (CAR NLIST))
                           (NLIST MORE-NUMBERS (CDR NLIST)))
                          ((ATOM NLIST) T)
                       (DECLARE (LIST NLIST))
                       (IF (NOT
                            ((ECLECTOR.READER:UNQUOTE METHOD) N (CAR NLIST)))
                           (RETURN NIL)))))))))
    (FROB <)
    (FROB >)
    (FROB <=)
    (FROB >=))

[maxima-code/src/numeric.lisp:1307]
  (DEFUN MAX (NUMBER &REST MORE-NUMBERS)
    "Returns the greatest of its arguments."
    (DECLARE (OPTIMIZE (SAFETY 2))
             (TYPE (OR REAL BIGFLOAT) NUMBER))
    (DOLIST (REAL MORE-NUMBERS) (WHEN (> REAL NUMBER) (SETQ NUMBER REAL)))
    NUMBER)

[maxima-code/src/numeric.lisp:1316]
  (DEFUN MIN (NUMBER &REST MORE-NUMBERS)
    "Returns the least of its arguments."
    (DECLARE (OPTIMIZE (SAFETY 2))
             (TYPE (OR REAL BIGFLOAT) NUMBER))
    (DO ((NLIST MORE-NUMBERS (CDR NLIST))
         (RESULT (THE (OR REAL BIGFLOAT) NUMBER)))
        ((NULL NLIST) (RETURN RESULT))
      (DECLARE (LIST NLIST))
      (IF (< (CAR NLIST) RESULT)
          (SETQ RESULT (CAR NLIST)))))

[maxima-code/src/numerical/f2cl-lib.lisp:138]
  (DEFUN FIND-ARRAY-DATA (ARRAY)
    (DECLARE (TYPE (ARRAY * (*)) ARRAY))
    (LET ((OFFSET 0))
      (DECLARE (TYPE FIXNUM OFFSET)
               (OPTIMIZE (SPEED 3) (SAFETY 0)))
      (LOOP
       (MULTIPLE-VALUE-BIND (DISPLACED-TO INDEX-OFFSET)
           (ARRAY-DISPLACEMENT ARRAY)
         (WHEN (NULL DISPLACED-TO)
           (RETURN-FROM FIND-ARRAY-DATA (VALUES ARRAY OFFSET)))
         (INCF OFFSET INDEX-OFFSET)
         (SETF ARRAY DISPLACED-TO)))))

[maxima-code/src/numth.lisp:1520]
  (DEFUN F2-RED (A)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET* ((RED *F2-RED*) (ILEN (INTEGER-LENGTH RED)) (E 0))
      (DECLARE (FIXNUM E ILEN))
      (DO ()
          ((= A 0) 0)
        (SETQ E (- (INTEGER-LENGTH A) ILEN))
        (WHEN (< E 0) (RETURN A))
        (SETQ A (LOGXOR A (ASH RED E))))))

[maxima-code/src/numth.lisp:1531]
  (DEFUN F2-TIMES (A B)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET* ((ILEN (INTEGER-LENGTH B)) (A1 (ASH A (1- ILEN))) (AB A1))
      (DO ((I (- ILEN 2) (1- I))
           (K 0))
          ((< I 0) (F2-RED AB))
        (DECLARE (FIXNUM I K))
        (DECF K)
        (WHEN (LOGBITP I B)
          (SETQ A1 (ASH A1 K)
                AB (LOGXOR AB A1)
                K 0)))))

[maxima-code/src/numth.lisp:1545]
  (DEFUN F2-POW (A N)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (INTEGER N))
    (COND ((= N 0) 1) ((= A 0) 0)
          (T
           (DO (RES)
               (NIL)
             (WHEN (ODDP N)
               (SETQ RES
                       (IF RES
                           (F2-TIMES A RES)
                           A))
               (WHEN (= 1 N) (RETURN-FROM F2-POW RES)))
             (SETQ N (ASH N -1)
                   A (F2-TIMES A A))))))

[maxima-code/src/numth.lisp:1559]
  (DEFUN F2-INV (B)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (WHEN (= B 0)
      (GF-MERROR
       (#S(FORMGREP:SYMREF :NAME "GETTEXT" :QUALIFIER "INTL")
        "f2 arithmetic: Quotient by zero")))
    (LET ((B1 1) (A *F2-RED*) (A1 0) Q R)
      (DO ()
          ((= B 0) A1)
        (MULTIPLE-VALUE-SETQ (Q R) (F2-DIVIDE A B))
        (PSETF A B
               B R)
        (PSETF A1 B1
               B1 (LOGXOR (F2-TIMES Q B1) A1)))))

[maxima-code/src/numth.lisp:1570]
  (DEFUN F2-DIVIDE (A B)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (COND
     ((= B 0)
      (GF-MERROR
       (#S(FORMGREP:SYMREF :NAME "GETTEXT" :QUALIFIER "INTL")
        "f2 arithmetic: Quotient by zero")))
     ((= A 0) (VALUES 0 0))
     (T
      (LET ((ILEN (INTEGER-LENGTH B)) (E 0) (Q 0))
        (DECLARE (FIXNUM E ILEN))
        (DO ()
            ((= A 0) (VALUES Q 0))
          (SETQ E (- (INTEGER-LENGTH A) ILEN))
          (WHEN (< E 0) (RETURN (VALUES Q A)))
          (SETQ Q (LOGXOR Q (ASH 1 E)))
          (SETQ A (LOGXOR A (ASH B E))))))))

[maxima-code/src/numth.lisp:1771]
  (DEFUN GF-P2X-RED (P FUN)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET* ((MODULUS) (X (CAR (PREP1 P))))
      (UNLESS (AND (LISTP X) (EVERY #'NUMBERP (SETQ X (CDR X))))
        (GF-MERROR
         (#S(FORMGREP:SYMREF :NAME "GETTEXT" :QUALIFIER "INTL")
          "`~m': Not suitable as reduction polynomial: ~m")
         FUN P))
      (SETQ X (GF-MOD X))
      (UNLESS (AND (TYPEP (CAR X) 'FIXNUM) (PLUSP (CAR X)))
        (GF-MERROR
         (#S(FORMGREP:SYMREF :NAME "GETTEXT" :QUALIFIER "INTL")
          "`~m': The exponent must be a positive fixnum.")
         FUN))
      (UNLESS (EQL 1 (CADR X))
        (GF-MERROR
         (#S(FORMGREP:SYMREF :NAME "GETTEXT" :QUALIFIER "INTL")
          "`~m': A monic reduction polynomial is assumed.")
         FUN))
      X))

[maxima-code/src/numth.lisp:2139]
  (DEFUN GF-P2X (P)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (SETQ P
            (CAR
             (LET ((MODULUS))
               (PREP1 P))))
    (COND
     ((INTEGERP P)
      (COND ((= P 0) NIL)
            (T (SETQ P (GF-CMOD P))
             (IF (= P 0)
                 NIL
                 (LIST 0 P)))))
     (T (SETQ P (GF-MOD (CDR P)))
      (IF (TYPEP (CAR P) 'FIXNUM)
          P
          (GF-MERROR
           (#S(FORMGREP:SYMREF :NAME "GETTEXT" :QUALIFIER "INTL")
            "Exponents are limited to fixnums."))))))

[maxima-code/src/numth.lisp:2157]
  (DEFUN GF-P2X-RAW (P)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (SETQ P
            (CAR
             (LET ((MODULUS))
               (PREP1 P))))
    (COND
     ((INTEGERP P)
      (IF (= 0 P)
          NIL
          (LIST 0 P)))
     (T (SETQ P (CDR P))
      (UNLESS (EVERY #'NUMBERP P)
        (GF-MERROR
         (#S(FORMGREP:SYMREF :NAME "GETTEXT" :QUALIFIER "INTL")
          "gf: polynomials must be univariate.")))
      P)))

[maxima-code/src/numth.lisp:2168]
  (DEFUN GF-X2P (X)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (SETQ X
            (COND ((NULL X) 0)
                  ((= 0 (THE FIXNUM (CAR X))) (GF-CP2SMOD (CADR X)))
                  (T (GF-NP2SMOD X))))
    (IF (EQL $GF_RAT T)
        (GF-X2CRE X)
        (GF-DISREP X)))

[maxima-code/src/numth.lisp:2181]
  (DEFUN GF-X2CRE (X)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (IF (INTEGERP X)
        (ECLECTOR.READER:QUASIQUOTE
         ((ECLECTOR.READER:UNQUOTE *GF-RAT-HEADER*) (ECLECTOR.READER:UNQUOTE X)
          . 1))
        (ECLECTOR.READER:QUASIQUOTE
         ((ECLECTOR.READER:UNQUOTE *GF-RAT-HEADER*)
          (ECLECTOR.READER:UNQUOTE (CONS (CAAR (CDDDR *GF-RAT-HEADER*)) X))
          . 1))))

[maxima-code/src/numth.lisp:2187]
  (DEFUN GF-DISREP (X &OPTIONAL (VAR '$X))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (IF (INTEGERP X)
        X
        (MAYBE-CHAR-IS-FIXNUM-LET ((C 0))
         (DO ((NOT-PLUS? (NULL (CDDR X)))
              P
              (E 0))
             ((NULL X)
              (IF NOT-PLUS?
                  (CAR P)
                  (CONS '(MPLUS SIMP) P)))
           (DECLARE (FIXNUM E))
           (SETQ E (CAR X)
                 C (CADR X)
                 X (CDDR X)
                 P
                   (COND ((= 0 E) (CONS C P))
                         ((= 1 E)
                          (IF (= 1 C)
                              (CONS VAR P)
                              (CONS
                               (ECLECTOR.READER:QUASIQUOTE
                                ((MTIMES SIMP) (ECLECTOR.READER:UNQUOTE C)
                                 (ECLECTOR.READER:UNQUOTE VAR)))
                               P)))
                         ((= 1 C)
                          (CONS
                           (ECLECTOR.READER:QUASIQUOTE
                            ((MEXPT SIMP) (ECLECTOR.READER:UNQUOTE VAR)
                             (ECLECTOR.READER:UNQUOTE E)))
                           P))
                         (T
                          (CONS
                           (ECLECTOR.READER:QUASIQUOTE
                            ((MTIMES SIMP) (ECLECTOR.READER:UNQUOTE C)
                             ((MEXPT SIMP) (ECLECTOR.READER:UNQUOTE VAR)
                              (ECLECTOR.READER:UNQUOTE E))))
                           P))))))))

[maxima-code/src/numth.lisp:2239]
  (DEFUN GF-MOD (X)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (IF (NULL X)
        NIL
        (MAYBE-CHAR-IS-FIXNUM-LET ((C 0))
         (DO ((R X (CDDR R))
              RES)
             ((NULL R) (NREVERSE RES))
           (UNLESS (NUMBERP (CADR R))
             (GF-MERROR
              (#S(FORMGREP:SYMREF :NAME "GETTEXT" :QUALIFIER "INTL")
               "gf: polynomials must be univariate.")))
           (SETQ C (GF-CMOD (CADR R)))
           (UNLESS (= C 0) (SETQ RES (CONS C (CONS (CAR R) RES))))))))

[maxima-code/src/numth.lisp:2457]
  (DEFUN GF-XCTIMES (X C)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (MAYBE-CHAR-IS-FIXNUM-LET ((C C))
     (IF (OR (= 0 C) (NULL X))
         NIL
         (DO* ((RES (LIST (CAR X) (GF-CTIMES C (CADR X))))
               (R (CDR RES) (CDDR R))
               (RX (CDDR X) (CDDR RX)))
              ((NULL RX) RES)
           (RPLACD R (LIST (CAR RX) (GF-CTIMES C (CADR RX))))))))

[maxima-code/src/numth.lisp:2467]
  (DEFUN GF-NXCTIMES (X C)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (MAYBE-CHAR-IS-FIXNUM-LET ((C C))
     (IF (OR (= 0 C) (NULL X))
         NIL
         (DO ((R (CDR X) (CDDR R)))
             ((NULL R) X)
           (RPLACA R (GF-CTIMES C (CAR R)))))))

[maxima-code/src/numth.lisp:2477]
  (DEFUN GF-XECTIMES (X E C)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DECLARE (FIXNUM E))
    (MAYBE-CHAR-IS-FIXNUM-LET ((C C))
     (IF (OR (= 0 C) (NULL X))
         NIL
         (DO* ((RES (LIST (+ E (THE FIXNUM (CAR X))) (GF-CTIMES C (CADR X))))
               (R (CDR RES) (CDDR R))
               (RX (CDDR X) (CDDR RX)))
              ((NULL RX) RES)
           (RPLACD R
                   (LIST (+ E (THE FIXNUM (CAR RX)))
                         (GF-CTIMES C (CADR RX))))))))

[maxima-code/src/numth.lisp:2498]
  (DEFUN GF-MINUS (X)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (IF (OR (NULL X) (= 2 *GF-CHAR*))
        X
        (DO* ((RES (LIST (CAR X) (GF-CMINUS-B (CADR X))))
              (R (CDR RES) (CDDR R))
              (RX (CDDR X) (CDDR RX)))
             ((NULL RX) RES)
          (RPLACD R (LIST (CAR RX) (GF-CMINUS-B (CADR RX)))))))

[maxima-code/src/numth.lisp:2507]
  (DEFUN GF-NMINUS (X)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (IF (OR (NULL X) (= 2 *GF-CHAR*))
        X
        (DO ((R (CDR X) (CDDR R)))
            (NIL)
          (RPLACA R (GF-CMINUS-B (CAR R)))
          (WHEN (NULL (CDR R)) (RETURN X)))))

[maxima-code/src/numth.lisp:2524]
  (DEFUN GF-NPLUS (X Y)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (COND ((NULL X) Y) ((NULL Y) X)
          (T
           (MAYBE-CHAR-IS-FIXNUM-LET ((CY 0) (C 0))
            (PROG ((EX 0) (EY 0) R)
              (DECLARE (FIXNUM EX EY))
             A1
              (SETQ EX (CAR X)
                    EY (CAR Y)
                    CY (CADR Y))
              (COND
               ((> EY EX)
                (SETQ X (CONS EY (CONS CY X))
                      Y (CDDR Y)))
               ((= EY EX)
                (SETQ C (GF-CPLUS-B (CADR X) CY)
                      Y (CDDR Y))
                (COND
                 ((= 0 C) (WHEN (NULL (SETQ X (CDDR X))) (RETURN Y))
                  (WHEN (NULL Y) (RETURN X)) (GO A1))
                 (T (RPLACA (CDR X) C))))
               (T (SETQ R (CDR X)) (GO B)))
              (SETQ R (CDR X))
             A
              (WHEN (NULL Y) (RETURN X))
              (SETQ EY (CAR Y)
                    CY (CADR Y))
             B
              (WHILE (AND (CDR R) (> (THE FIXNUM (CADR R)) EY))
               (SETQ R (CDDR R)))
              (COND ((NULL (CDR R)) (RPLACD R Y) (RETURN X))
                    ((> EY (THE FIXNUM (CADR R)))
                     (RPLACD R (CONS EY (CONS CY (CDR R))))
                     (SETQ R (CDDR R)
                           Y (CDDR Y)))
                    (T
                     (SETQ C (GF-CPLUS-B (CADDR R) CY)
                           Y (CDDR Y))
                     (IF (= 0 C)
                         (RPLACD R (CDDDR R))
                         (RPLACA (SETQ R (CDDR R)) C))))
              (GO A))))))

[maxima-code/src/numth.lisp:2575]
  (DEFUN GF-NXYECPLUS (X Y E C)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (COND ((NULL Y) X) ((NULL X) (GF-XECTIMES Y E C))
          (T
           (MAYBE-CHAR-IS-FIXNUM-LET ((CY 0) (CC 0))
            (PROG ((E E) (EX 0) (EY 0) R)
              (DECLARE (FIXNUM E EX EY))
             A1
              (SETQ EY (+ (THE FIXNUM (CAR Y)) E)
                    CY (GF-CTIMES C (CADR Y))
                    EX (CAR X))
              (COND
               ((> EY EX)
                (SETQ X (CONS EY (CONS CY X))
                      Y (CDDR Y)))
               ((= EY EX)
                (SETQ CC (GF-CPLUS-B (CADR X) CY)
                      Y (CDDR Y))
                (COND
                 ((= 0 CC)
                  (WHEN (NULL (SETQ X (CDDR X))) (RETURN (GF-XECTIMES Y E C)))
                  (WHEN (NULL Y) (RETURN X)) (GO A1))
                 (T (RPLACA (CDR X) CC))))
               (T (SETQ R (CDR X)) (GO B)))
              (SETQ R (CDR X))
             A
              (WHEN (NULL Y) (RETURN X))
              (SETQ EY (+ (THE FIXNUM (CAR Y)) E)
                    CY (GF-CTIMES C (CADR Y)))
             B
              (WHEN (NULL (CDR R)) (GO D))
              (SETQ EX (CADR R))
              (COND
               ((> EY EX) (RPLACD R (CONS EY (CONS CY (CDR R))))
                (SETQ R (CDDR R)
                      Y (CDDR Y))
                (GO A))
               ((= EY EX) (SETQ CC (GF-CPLUS-B (CADDR R) CY))
                (IF (= 0 CC)
                    (RPLACD R (CDDDR R))
                    (RPLACA (SETQ R (CDDR R)) CC))
                (SETQ Y (CDDR Y)) (GO A))
               (T (SETQ R (CDDR R)) (GO B)))
             D
              (DO ()
                  ((NULL Y))
                (SETQ X
                        (NCONC X
                               (LIST (+ (THE FIXNUM (CAR Y)) E)
                                     (GF-CTIMES C (CADR Y))))
                      Y (CDDR Y)))
              (RETURN X))))))

[maxima-code/src/numth.lisp:2636]
  (DEFUN GF-TIMES (X Y RED)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (IF (OR (NULL X) (NULL Y))
        NIL
        (MAYBE-CHAR-IS-FIXNUM-LET ((C 0) (CX 0))
         (DO* ((RES (GF-XECTIMES Y (CAR X) (CADR X)))
               (R1 (CDR RES))
               RY
               (X (CDDR X) (CDDR X))
               (E 0)
               (EX 0))
              ((OR (NULL X) (NULL Y)) (GF-NRED RES RED))
           (DECLARE (FIXNUM E EX))
           (SETQ RY Y
                 EX (CAR X)
                 CX (CADR X)
                 E (+ EX (THE FIXNUM (CAR RY)))
                 C (GF-CTIMES (CADR RY) CX))
           (WHILE (AND (CDR R1) (< E (THE FIXNUM (CADR R1))))
            (SETQ R1 (CDDR R1)))
           (DO ((R R1))
               (NIL)
             (COND
              ((OR (NULL (CDR R)) (> E (THE FIXNUM (CADR R))))
               (RPLACD R (CONS E (CONS C (CDR R)))) (SETQ R (CDDR R)))
              ((= 0 (SETQ C (GF-CPLUS-B (CADDR R) C))) (RPLACD R (CDDDR R)))
              (T (RPLACA (SETQ R (CDDR R)) C)))
             (WHEN (NULL (SETQ RY (CDDR RY))) (RETURN))
             (SETQ E (+ EX (THE FIXNUM (CAR RY)))
                   C (GF-CTIMES (CADR RY) CX))
             (WHILE (AND (CDR R) (< E (THE FIXNUM (CADR R))))
              (SETQ R (CDDR R))))))))

[maxima-code/src/numth.lisp:2681]
  (DEFUN GF-SQ (X RED)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (COND ((NULL X) X)
          ((AND (NOT *EF-ARITH?*) (EQL *GF-CHAR* 2))
           (DO (RES)
               ((NULL X) (GF-NRED (NREVERSE RES) RED))
             (SETQ RES (CONS 1 (CONS (ASH (CAR X) 1) RES))
                   X (CDDR X))))
          (T
           (MAYBE-CHAR-IS-FIXNUM-LET ((CI 0) (*2CI 0) (C 0))
            (SETQ X (REVERSE X))
            (PROG (RES R ACC R1 (E 0) (EI 0))
              (DECLARE (FIXNUM E EI))
             A1
              (SETQ CI (CAR X)
                    EI (CADR X)
                    *2CI (GF-CPLUS-B CI CI)
                    RES (CONS (+ EI EI) (CONS (GF-CTIMES CI CI) RES))
                    R (CDR RES)
                    R1 ACC)
             A
              (WHEN (OR (NULL R1) (= 0 *2CI))
                (WHEN (NULL (SETQ X (CDDR X))) (RETURN (GF-NRED RES RED)))
                (SETQ ACC (CONS EI (CONS CI ACC)))
                (GO A1))
              (SETQ E (+ EI (THE FIXNUM (CAR R1)))
                    C (GF-CTIMES *2CI (CADR R1))
                    R1 (CDDR R1))
              (WHILE (< E (THE FIXNUM (CADR R))) (SETQ R (CDDR R)))
              (COND
               ((> E (THE FIXNUM (CADR R)))
                (RPLACD R (CONS E (CONS C (CDR R)))) (SETQ R (CDDR R)))
               (T (SETQ C (GF-CPLUS-B C (CADDR R)))
                (IF (= 0 C)
                    (RPLACD R (CDDDR R))
                    (RPLACA (SETQ R (CDDR R)) C))))
              (GO A))))))

[maxima-code/src/numth.lisp:2729]
  (DEFUN GF-POW (X N RED)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DECLARE (INTEGER N))
    (COND ((= 0 N) (LIST 0 1)) ((NULL X) NIL)
          (T
           (DO (RES)
               (NIL)
             (WHEN (ODDP N)
               (SETQ RES
                       (IF RES
                           (GF-TIMES X RES RED)
                           X))
               (WHEN (= 1 N) (RETURN-FROM GF-POW RES)))
             (SETQ N (ASH N -1)
                   X (GF-SQ X RED))))))

[maxima-code/src/numth.lisp:2754]
  (DEFUN *F-POW$ (X N RED P CARD X^P-POWERS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DECLARE (INTEGER N P CARD))
    (COND ((= 0 N) (LIST 0 1)) ((NULL X) NIL) ((>= N CARD) (GF-POW X N RED))
          (T
           (LET ((PROD (LIST 0 1)) (J 0) N-BASE-P Y)
             (DO (QUO
                  R)
                 ((= 0 N))
               (MULTIPLE-VALUE-SETQ (QUO R) (TRUNCATE N P))
               (PUSH R N-BASE-P)
               (SETQ N QUO))
             (DOLIST (NI (NREVERSE N-BASE-P))
               (SETQ Y (GF-COMPOSE (SVREF X^P-POWERS J) X RED)
                     Y (GF-POW Y NI RED)
                     PROD (GF-TIMES PROD Y RED)
                     J (1+ J)))
             PROD))))

[maxima-code/src/numth.lisp:2784]
  (DEFUN GF-NREM (X Y)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (WHEN (NULL Y)
      (GF-MERROR
       (#S(FORMGREP:SYMREF :NAME "GETTEXT" :QUALIFIER "INTL")
        "~m arithmetic: Quotient by zero")
       (IF *EF-ARITH?*
           "ef"
           "gf")))
    (IF (NULL X)
        X
        (MAYBE-CHAR-IS-FIXNUM-LET ((C 0) (LCX 0) (LCY-INV (GF-CINV (CADR Y))))
         (LET ((E 0) (LEY (CAR Y)))
           (DECLARE (FIXNUM E LEY))
           (SETQ LCY-INV (GF-CMINUS-B LCY-INV))
           (DO ((Y (CDDR Y)))
               ((NULL X) X)
             (SETQ E (- (THE FIXNUM (CAR X)) LEY))
             (WHEN (< E 0) (RETURN X))
             (SETQ LCX (CADR X)
                   C (GF-CTIMES LCX LCY-INV)
                   X (GF-NXYECPLUS (CDDR X) Y E C)))))))

[maxima-code/src/numth.lisp:2805]
  (DEFUN GF-NRED (X RED)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (IF (OR (NULL X) (NULL RED))
        X
        (LET ((E 0) (LE-RED (CAR RED)))
          (DECLARE (FIXNUM E LE-RED))
          (SETQ RED (CDDR RED))
          (DO ()
              ((NULL X) X)
            (SETQ E (- (THE FIXNUM (CAR X)) LE-RED))
            (WHEN (< E 0) (RETURN X))
            (SETQ X (GF-NXYECPLUS (CDDR X) RED E (GF-CMINUS-B (CADR X))))))))

[maxima-code/src/numth.lisp:2818]
  (DEFUN GF-GCD (X Y)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (COND ((NULL X) Y) ((NULL Y) X)
          (T
           (LET ((R NIL))
             (DO ()
                 ((NULL Y)
                  (IF (EQL 0 (CAR X))
                      (LIST 0 1)
                      (GF-XCTIMES X (GF-CINV (CADR X)))))
               (SETQ R (GF-REM X Y))
               (PSETF X Y
                      Y R))))))

[maxima-code/src/numth.lisp:2832]
  (DEFUN GF-GCDEX (X Y RED)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((X1 (LIST 0 1)) X2 Y1 (Y2 (LIST 0 1)) Q R)
      (DO ()
          ((NULL Y)
           (LET ((INV (GF-CINV (CADR X))))
             (MAPCAR #'(LAMBDA (A) (GF-XCTIMES A INV)) (LIST X1 X2 X))))
        (MULTIPLE-VALUE-SETQ (Q R) (GF-DIVIDE X Y))
        (PSETF X Y
               Y R)
        (PSETF Y1 (GF-NPLUS (GF-NMINUS (GF-TIMES Q Y1 RED)) X1)
               X1 Y1)
        (PSETF Y2 (GF-NPLUS (GF-NMINUS (GF-TIMES Q Y2 RED)) X2)
               X2 Y2))))

[maxima-code/src/numth.lisp:2852]
  (DEFUN GF-INV (Y RED)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (WHEN (NULL Y)
      (GF-MERROR
       (#S(FORMGREP:SYMREF :NAME "GETTEXT" :QUALIFIER "INTL")
        "~m arithmetic: Quotient by zero")
       (IF *EF-ARITH?*
           "ef"
           "gf")))
    (LET ((Y1 (LIST 0 1)) (X RED) X1 Q R)
      (SETQ Y (COPY-LIST Y))
      (DO ()
          ((NULL Y) (WHEN (= 0 (CAR X)) (GF-NXCTIMES X1 (GF-CINV (CADR X)))))
        (MULTIPLE-VALUE-SETQ (Q R) (GF-DIVIDE X Y))
        (PSETF X Y
               Y R)
        (PSETF X1 Y1
               Y1 (GF-NPLUS (GF-NMINUS (GF-TIMES Q Y1 RED)) X1)))))

[maxima-code/src/numth.lisp:2869]
  (DEFUN GF-DIVIDE (X Y)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (COND
     ((NULL Y)
      (GF-MERROR
       (#S(FORMGREP:SYMREF :NAME "GETTEXT" :QUALIFIER "INTL")
        "~m arithmetic: Quotient by zero")
       (IF *EF-ARITH?*
           "ef"
           "gf")))
     ((NULL X) (VALUES NIL NIL))
     (T
      (MAYBE-CHAR-IS-FIXNUM-LET ((C 0) (LCX 0) (LCYI (GF-CINV (CADR Y))))
       (LET ((E 0) (LEY (CAR Y)))
         (DECLARE (FIXNUM E LEY))
         (SETQ X (COPY-LIST X))
         (DO (Q
              (Y (CDDR Y)))
             ((NULL X) (VALUES (NREVERSE Q) X))
           (SETQ E (- (THE FIXNUM (CAR X)) LEY))
           (WHEN (< E 0) (RETURN (VALUES (NREVERSE Q) X)))
           (SETQ LCX (CADR X)
                 X (CDDR X)
                 C (GF-CTIMES LCX LCYI))
           (UNLESS (NULL Y) (SETQ X (GF-NXYECPLUS X Y E (GF-CMINUS-B C))))
           (SETQ Q (CONS C (CONS E Q)))))))))

[maxima-code/src/numth.lisp:2913]
  (DEFUN GF-X2N (X)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (IF (NULL X)
        0
        (MAYBE-CHAR-IS-FIXNUM-LET ((M *GF-CHAR*))
         (WHEN *EF-ARITH?* (SETQ M *GF-CARD*))
         (DO ((N 0))
             (NIL)
           (INCF N (CADR X))
           (IF (NULL (CDDR X))
               (RETURN (* N (EXPT M (THE FIXNUM (CAR X)))))
               (SETQ N
                       (* N
                          (EXPT M
                                (- (THE FIXNUM (CAR X))
                                   (THE FIXNUM (CADDR X)))))))
           (SETQ X (CDDR X))))))

[maxima-code/src/numth.lisp:2948]
  (DEFUN GF-N2X (N)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DECLARE (INTEGER N))
    (MAYBE-CHAR-IS-FIXNUM-LET ((R 0) (M *GF-CHAR*))
     (LET ((E 0))
       (DECLARE (FIXNUM E))
       (WHEN *EF-ARITH?* (SETQ M *GF-CARD*))
       (DO (X)
           ((= 0 N) X)
         (MULTIPLE-VALUE-SETQ (N R) (TRUNCATE N M))
         (UNLESS (= 0 R) (SETQ X (CONS E (CONS R X))))
         (INCF E)))))

[maxima-code/src/numth.lisp:2973]
  (DEFUN GF-X2L (X LEN)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DECLARE (FIXNUM LEN))
    (DO* ((E (IF X
                 (THE FIXNUM (CAR X))
                 0))
          (K (MAX E (1- LEN)) (1- K))
          L)
         ((< K 0) (NREVERSE L))
      (DECLARE (FIXNUM E K))
      (COND ((OR (NULL X) (> K E)) (PUSH 0 L))
            ((= K E) (PUSH (CADR X) L) (SETQ X (CDDR X))
             (UNLESS (NULL X) (SETQ E (THE FIXNUM (CAR X))))))))

[maxima-code/src/numth.lisp:3003]
  (DEFUN GF-L2X (L)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (SETQ L (REVERSE L))
    (MAYBE-CHAR-IS-FIXNUM-LET ((C 0))
     (LET ((E 0))
       (DECLARE (FIXNUM E))
       (DO (X)
           ((NULL L) X)
         (UNLESS (= 0 (SETQ C (CAR L))) (SETQ X (CONS E (CONS C X))))
         (SETQ L (CDR L))
         (INCF E)))))

[maxima-code/src/numth.lisp:3027]
  (DEFUN GF-L2N (L)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (MAYBE-CHAR-IS-FIXNUM-LET ((M *GF-CHAR*) (C1 (CAR L)) (C 0))
     (WHEN *EF-ARITH?* (SETQ M *GF-CARD*)) (SETQ L (REVERSE (CDR L)))
     (DO ((N 0)
          (B 1))
         ((NULL L) (+ (* C1 B) N))
       (DECLARE (INTEGER N B))
       (UNLESS (= 0 (SETQ C (CAR L))) (INCF N (* C B)))
       (SETQ B (* B M)
             L (CDR L)))))

[maxima-code/src/numth.lisp:3056]
  (DEFUN GF-N2L (N)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DECLARE (INTEGER N))
    (MAYBE-CHAR-IS-FIXNUM-LET ((M *GF-CHAR*) (R 0))
     (WHEN *EF-ARITH?* (SETQ M *GF-CARD*))
     (DO (L)
         ((= 0 N) L)
       (MULTIPLE-VALUE-SETQ (N R) (TRUNCATE N M))
       (SETQ L (CONS R L)))))

[maxima-code/src/numth.lisp:3065]
  (DEFUN GF-N2L-TWOARGS (N LEN)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DECLARE (INTEGER N)
             (FIXNUM LEN))
    (MAYBE-CHAR-IS-FIXNUM-LET ((M *GF-CHAR*) (R 0))
     (WHEN *EF-ARITH?* (SETQ M *GF-CARD*))
     (DO (L)
         ((= 0 LEN) L)
       (MULTIPLE-VALUE-SETQ (N R) (TRUNCATE N M))
       (SETQ L (CONS R L))
       (DECF LEN))))

[maxima-code/src/numth.lisp:3106]
  (DEFUN GF-IRR-P (Y Q N)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DECLARE (INTEGER Q)
             (FIXNUM N))
    (LET* ((*GF-CHAR* (CAR (CFACTORW Q)))
           (X (LIST 1 1))
           (MX (GF-MINUS X))
           (LC (CADR Y)))
      (UNLESS (= 1 LC) (SETQ Y (GF-XCTIMES Y (GF-CINV LC))))
      (DO ((I 1 (1+ I))
           (XQ X)
           (N2 (ASH N -1)))
          ((> I N2) T)
        (DECLARE (FIXNUM I N2))
        (SETQ XQ (GF-POW XQ Q Y))
        (UNLESS (= 0 (CAR (GF-GCD Y (GF-PLUS XQ MX)))) (RETURN)))))

[maxima-code/src/numth.lisp:3150]
  (DEFUN *F-IRR (Q N)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (WHEN (= 1 N) (RETURN-FROM *F-IRR (LIST 1 1)))
    (LET* ((INC (MIN $GF_COEFF_LIMIT Q)) (I-LIM (EXPT INC N)) X)
      (DO ((I 1 (1+ I)))
          ((>= I I-LIM)
           (GF-MERROR
            (#S(FORMGREP:SYMREF :NAME "GETTEXT" :QUALIFIER "INTL")
             "No irreducible polynomial found.~%~
                                    `gf_coeff_limit' might be too small.~%")))
        (SETQ X
                (LET ((*GF-CHAR* INC))
                  (GF-N2X I)))
        (WHEN (= 0 (CAR (LAST X 2)))
          (SETQ X (CONS N (CONS 1 X)))
          (WHEN (GF-IRR-P X Q N) (RETURN-FROM *F-IRR X))))))

[maxima-code/src/numth.lisp:3246]
  (DEFUN *F-PRIM-P-2 (X Q RED FS FS-BASE-Q X^Q-POWERS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (UNLESS (OR (= 2 *GF-CHAR*) (= -1 (GF-JACOBI X RED Q)))
      (RETURN-FROM *F-PRIM-P-2))
    (LET ((EXPONENT (CAR RED))
          (X+C? (AND (= (CAR X) 1) (= (CADR X) 1)))
          Y
          PROD
          -C
          Z)
      (DO ((I 0 (1+ I))
           (J 0 0)
           (LF (ARRAY-DIMENSION FS 0)))
          ((= I LF) T)
        (DECLARE (FIXNUM I J LF))
        (COND
         ((AND X+C? (CADR (SVREF FS I)))
          (SETQ -C
                  (IF (= 2 (LENGTH X))
                      0
                      (GF-CMINUS-B (CAR (LAST X))))
                Z (LIST 0 (GF-AT RED -C)))
          (WHEN (ODDP EXPONENT) (SETQ Z (GF-MINUS Z)))
          (SETQ Z (GF-POW Z (CADDR (SVREF FS I)) RED))
          (WHEN (OR (NULL Z) (EQUAL Z '(0 1))) (RETURN NIL)))
         (T (SETQ PROD (LIST 0 1))
          (DOLIST (AIJ (SVREF FS-BASE-Q I))
            (SETQ Y (GF-COMPOSE (SVREF X^Q-POWERS J) X RED)
                  Y (GF-POW Y AIJ RED)
                  PROD (GF-TIMES PROD Y RED)
                  J (1+ J)))
          (WHEN (OR (NULL PROD) (EQUAL PROD '(0 1))) (RETURN NIL)))))))

[maxima-code/src/numth.lisp:3295]
  (DEFUN GF-JACOBI (U V Q)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (IF (NULL (SETQ U (GF-REM U V)))
        0
        (LET* ((C (CADR U))
               (S
                (IF (EVENP (CAR V))
                    1
                    (GF-CJACOBI C))))
          (COND ((= 0 (CAR U)) S)
                (T (SETQ U (GF-XCTIMES U (GF-CINV C)))
                 (WHEN (EVERY #'ODDP (LIST (ASH (1- Q) -1) (CAR U) (CAR V)))
                   (SETQ S (NEG S)))
                 (* S (GF-JACOBI V U Q)))))))

[maxima-code/src/numth.lisp:3327]
  (DEFUN GF-COMPOSE (X Y RED)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (COND ((OR (NULL X) (NULL Y)) NIL) ((= 0 (CAR Y)) Y)
          ((= 0 (CAR X))
           (LET ((N (GF-AT Y (CADR X))))
             (IF (= 0 N)
                 NIL
                 (LIST 0 N))))
          (T
           (DO (RES)
               (NIL)
             (SETQ RES (GF-NPLUS RES (LIST 0 (CADR Y))))
             (WHEN (NULL (CDDR Y))
               (RETURN (GF-TIMES RES (GF-POW X (CAR Y) RED) RED)))
             (SETQ RES (GF-TIMES RES (GF-POW X (- (CAR Y) (CADDR Y)) RED) RED)
                   Y (CDDR Y))))))

[maxima-code/src/numth.lisp:3361]
  (DEFUN GF-AT (X N)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (IF (OR (NULL X) (INTEGERP X))
        X
        (MAYBE-CHAR-IS-FIXNUM-LET ((N N))
         (DO ((I 0)
              I1)
             (NIL)
           (SETQ I (GF-CPLUS-B I (CADR X)))
           (WHEN (NULL (CDDR X))
             (SETQ I1 (GF-CPOW N (THE FIXNUM (CAR X))))
             (RETURN (GF-CTIMES I I1)))
           (SETQ I1 (GF-CPOW N (- (THE FIXNUM (CAR X)) (THE FIXNUM (CADDR X))))
                 I (GF-CTIMES I I1)
                 X (CDDR X))))))

[maxima-code/src/numth.lisp:3407]
  (DEFUN *F-PRIM (INC E PRIM-P-FN)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (SETQ INC (MIN $GF_COEFF_LIMIT INC))
    (DO ((N INC (1+ N))
         (N-LIM (EXPT INC E))
         X)
        ((>= N N-LIM) (WHEN (= $GF_COEFF_LIMIT INC) '$UNKNOWN))
      (SETQ X
              (LET ((*GF-CHAR* INC))
                (GF-N2X N)))
      (COND ((= 2 (CADR X)) (SETQ N (1- (* (ASH N -1) INC))))
            ((FUNCALL PRIM-P-FN X) (RETURN X)))))

[maxima-code/src/numth.lisp:3431]
  (DEFUN *F-PRECOMP (Q-1 ORD FS-ORD)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET (FS-Q-1 FS-LIST ($INTFACLIM))
      (SETQ FS-Q-1 (SORT (GET-FACTOR-LIST Q-1) #'< :KEY #'CAR))
      (DOLIST (FJ FS-Q-1)
        (SETQ FS-ORD
                (REMOVE-IF #'(LAMBDA (SJ) (= (CAR FJ) (CAR SJ))) FS-ORD :COUNT
                           1)))
      (SETQ FS-Q-1
              (MAPCAR #'(LAMBDA (PE) (LIST (CAR PE) T (TRUNCATE Q-1 (CAR PE))))
                      FS-Q-1))
      (SETQ FS-ORD (MAPCAR #'(LAMBDA (PE) (LIST (CAR PE) NIL)) FS-ORD))
      (SETQ FS-LIST
              (MERGE 'LIST FS-Q-1 FS-ORD #'(LAMBDA (A B) (< (CAR A) (CAR B)))))
      (COND
       (*EF-ARITH?* (SETQ *EF-FSX* (APPLY #'VECTOR FS-LIST))
        (SETQ *EF-FSX-BASE-Q*
                (APPLY #'VECTOR
                       (MAPCAR
                        #'(LAMBDA (PE)
                            (NREVERSE (GF-N2L (TRUNCATE ORD (CAR PE)))))
                        FS-LIST)))
        (SETQ *EF-X^Q-POWERS* (GF-X^P-POWERS *GF-CARD* *EF-EXP* *EF-RED*)))
       (T (SETQ *GF-FSX* (APPLY #'VECTOR FS-LIST))
        (SETQ *GF-FSX-BASE-P*
                (APPLY #'VECTOR
                       (MAPCAR
                        #'(LAMBDA (PE)
                            (NREVERSE (GF-N2L (TRUNCATE ORD (CAR PE)))))
                        FS-LIST)))
        (SETQ *GF-X^P-POWERS* (GF-X^P-POWERS *GF-CHAR* *GF-EXP* *GF-RED*))))))

[maxima-code/src/numth.lisp:3464]
  (DEFUN GF-X^P-POWERS (Q N RED)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DECLARE (INTEGER Q)
             (FIXNUM N))
    (LET ((A (MAKE-ARRAY N :ELEMENT-TYPE 'LIST :INITIAL-ELEMENT NIL)))
      (SETF (SVREF A 0) (LIST 1 1))
      (DO ((J 1 (1+ J)))
          ((= J N) A)
        (DECLARE (FIXNUM J))
        (SETF (SVREF A J) (GF-POW (SVREF A (1- J)) Q RED)))))

[maxima-code/src/numth.lisp:3507]
  (DEFUN GF-PRIMPOLY-P (Y Q N)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DECLARE (FIXNUM N))
    (UNLESS (= 1 (CADR Y)) (RETURN-FROM GF-PRIMPOLY-P))
    (PROG* ((FS-Q (CFACTORW Q)) (*GF-CHAR* (CAR FS-Q))
            (*GF-EXP*
             (IF *EF-ARITH?*
                 (CADR FS-Q)
                 N))
            (Q-1 (1- Q)) FS-Q-1 (CONST (LAST Y 2)) ($INTFACLIM))
      (UNLESS (= 0 (CAR CONST)) (RETURN NIL))
      (SETQ CONST (CADR CONST))
      (WHEN (ODDP N) (SETQ CONST (GF-CMINUS-B CONST)))
      (UNLESS
          (IF (AND *EF-ARITH?* (> *GF-EXP* 1))
              (LET ((*EF-ARITH?*))
                (GF-PRIM-P (GF-N2X CONST)))
              (PROGN
               (SETQ FS-Q-1 (SORT (MAPCAR #'CAR (GET-FACTOR-LIST Q-1)) #'<))
               (ZN-PRIMROOT-P CONST Q Q-1 FS-Q-1)))
        (RETURN NIL))
      (WHEN (= N 1) (RETURN T))
      (UNLESS (GF-IRR-P Y Q N) (RETURN NIL))
      (LET (X^Q-POWERS R FS-R FS-R-BASE-Q)
        (SETQ X^Q-POWERS (GF-X^P-POWERS Q N Y)
              R (TRUNCATE (1- (EXPT Q N)) Q-1)
              FS-R (SORT (MAPCAR #'CAR (GET-FACTOR-LIST R)) #'<))
        (UNLESS FS-Q-1
          (SETQ FS-Q-1 (SORT (MAPCAR #'CAR (GET-FACTOR-LIST Q-1)) #'<)))
        (DOLIST (FJ FS-Q-1)
          (SETQ FS-R (DELETE-IF #'(LAMBDA (SJ) (= FJ SJ)) FS-R :COUNT 1)))
        (SETQ FS-R-BASE-Q
                (LET ((*GF-CHAR* Q))
                  (APPLY #'VECTOR
                         (MAPCAR
                          #'(LAMBDA (F) (NREVERSE (GF-N2L (TRUNCATE R F))))
                          FS-R))))
        (RETURN (GF-PRIMPOLY-P-EXIT Y FS-R-BASE-Q X^Q-POWERS)))))

[maxima-code/src/numth.lisp:3552]
  (DEFUN GF-PRIMPOLY-P-EXIT (Y FS-R-BASE-Q X^Q-POWERS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DO ((I 0 (1+ I))
         (J 0 0)
         (DIM (ARRAY-DIMENSION FS-R-BASE-Q 0))
         Z
         ZZ)
        ((= I DIM) T)
      (DECLARE (FIXNUM I J DIM))
      (SETQ ZZ (LIST 0 1))
      (DOLIST (AIJ (SVREF FS-R-BASE-Q I))
        (SETQ Z (GF-POW (SVREF X^Q-POWERS J) AIJ Y)
              ZZ (GF-TIMES ZZ Z Y)
              J (1+ J)))
      (WHEN (= 0 (CAR ZZ)) (RETURN NIL))))

[maxima-code/src/numth.lisp:3580]
  (DEFUN GF-PRIMPOLY (Q N)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DECLARE (FIXNUM N))
    (LET* ((FS-Q (CFACTORW Q))
           (*GF-CHAR* (CAR FS-Q))
           (*GF-EXP*
            (IF *EF-ARITH?*
                (CADR FS-Q)
                N))
           (Q-1 (1- Q))
           ($INTFACLIM)
           (FS-Q-1 (SORT (MAPCAR #'CAR (GET-FACTOR-LIST Q-1)) #'<))
           R
           FS-R
           FS-R-BASE-Q)
      (WHEN (= 1 N)
        (LET ((PRT
               (IF (= Q 2)
                   1
                   (ZN-PRIMROOT Q Q-1 FS-Q-1))))
          (RETURN-FROM GF-PRIMPOLY (LIST 1 1 0 (GF-CMINUS-B PRT)))))
      (SETQ R (TRUNCATE (1- (EXPT Q N)) Q-1)
            FS-R (SORT (MAPCAR #'CAR (GET-FACTOR-LIST R)) #'<))
      (DOLIST (FJ FS-Q-1)
        (SETQ FS-R (DELETE-IF #'(LAMBDA (SJ) (= FJ SJ)) FS-R :COUNT 1)))
      (SETQ FS-R-BASE-Q
              (LET ((*GF-CHAR* Q))
                (APPLY #'VECTOR
                       (MAPCAR
                        #'(LAMBDA (F) (NREVERSE (GF-N2L (TRUNCATE R F))))
                        FS-R))))
      (LET* ((INC (MIN $GF_COEFF_LIMIT Q)) (I-LIM (EXPT INC N)) X)
        (DO ((I (1+ INC) (1+ I)))
            ((>= I I-LIM)
             (GF-MERROR
              (#S(FORMGREP:SYMREF :NAME "GETTEXT" :QUALIFIER "INTL")
               "No primitive polynomial found.~%~
                                      `gf_coeff_limit' might be too small.~%")))
          (SETQ X
                  (LET ((*GF-CHAR* INC))
                    (GF-N2X I))
                X (CONS N (CONS 1 X)))
          (WHEN (GF-PRIMPOLY-P2 X *GF-CHAR* *GF-EXP* Q N FS-Q-1 FS-R-BASE-Q)
            (RETURN X))))))

[maxima-code/src/numth.lisp:3617]
  (DEFUN GF-PRIMPOLY-P2 (Y P E Q N FS-Q-1 FS-R-BASE-Q)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DECLARE (FIXNUM E N))
    (WHEN (= 1 (CADR Y))
      (PROG* ((*GF-CHAR* P) (*GF-EXP* E) (Q-1 (1- Q)) (CONST (LAST Y 2)))
        (UNLESS (= 0 (CAR CONST)) (RETURN NIL))
        (SETQ CONST (CADR CONST))
        (WHEN (ODDP N) (SETQ CONST (GF-CMINUS-B CONST)))
        (UNLESS
            (IF (AND *EF-ARITH?* (> *GF-EXP* 1))
                (LET ((*EF-ARITH?*))
                  (GF-PRIM-P (GF-N2X CONST)))
                (ZN-PRIMROOT-P CONST Q Q-1 FS-Q-1))
          (RETURN NIL))
        (UNLESS (GF-IRR-P Y Q N) (RETURN NIL))
        (RETURN (GF-PRIMPOLY-P-EXIT Y FS-R-BASE-Q (GF-X^P-POWERS Q N Y))))))

[maxima-code/src/numth.lisp:3747]
  (DEFUN GF-FACTOR (X Q)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((LC (CADR X)) Z)
      (UNLESS (= 1 LC) (SETQ X (GF-XCTIMES X (GF-CINV LC))))
      (IF (GF-IRR-P X Q (CAR X))
          (SETQ Z (LIST X 1))
          (LET ((SQFR (GF-SQUARE-FREE X)) E Y)
            (DOLIST (V SQFR)
              (SETQ E (CAR V)
                    Y (CADR V)
                    Y (GF-DISTINCT-DEGREE-FACTORS Y Q))
              (DOLIST (W Y)
                (SETQ Z (NCONC (GF-EQUAL-DEGREE-FACTORS W Q E) Z))))))
      (IF (= 1 LC)
          Z
          (CONS LC (CONS 1 Z)))))

[maxima-code/src/numth.lisp:3763]
  (DEFUN GF-DIFF (X)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (IF (NULL X)
        NIL
        (MAYBE-CHAR-IS-FIXNUM-LET ((M *GF-CHAR*))
         (DO ((RX X (CDDR RX))
              RES
              C)
             ((OR (NULL RX) (= 0 (CAR RX))) (NREVERSE RES))
           (SETQ C (GF-CTIMES (MOD (THE FIXNUM (CAR RX)) M) (CADR RX)))
           (WHEN (/= 0 C) (PUSH (1- (CAR RX)) RES) (PUSH C RES))))))

[maxima-code/src/numth.lisp:3780]
  (DEFUN GF-PTH-ROOT (X)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (MAYBE-CHAR-IS-FIXNUM-LET ((P *GF-CHAR*))
     (IF (NULL X)
         NIL
         (DO ((RX X (CDDR RX))
              RES
              C)
             ((NULL RX) (NREVERSE RES))
           (PUSH (TRUNCATE (THE FIXNUM (CAR RX)) P) RES)
           (SETQ C (CADR RX))
           (WHEN *EF-ARITH?* (SETQ C (EF-PTH-CROOT C)))
           (PUSH C RES)))))

[maxima-code/src/numth.lisp:3796]
  (DEFUN GF-SQUARE-FREE (X)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET (F FS (R (GF-DIFF X)) G)
      (COND
       ((EQUAL '(0 1) (SETQ G (GF-GCD X R)))
        (ECLECTOR.READER:QUASIQUOTE ((1 (ECLECTOR.READER:UNQUOTE X)))))
       (T
        (WHEN R
          (SETQ R (GF-DIVIDE X G)
                X G)
          (DO ((M 1 (1+ M)))
              ((EQUAL '(0 1) R))
            (DECLARE (FIXNUM M))
            (MULTIPLE-VALUE-SETQ (R F X) (GF-GCD-COFACTORS R X))
            (UNLESS (EQUAL '(0 1) F) (PUSH (LIST M F) FS))))
        (UNLESS (EQUAL '(0 1) X)
          (SETQ FS
                  (APPEND
                   (MAPCAR #'(LAMBDA (V) (RPLACA V (* (CAR V) *GF-CHAR*)))
                           (GF-SQUARE-FREE (GF-PTH-ROOT X)))
                   FS)))
        (NREVERSE FS)))))

[maxima-code/src/numth.lisp:3818]
  (DEFUN GF-DISTINCT-DEGREE-FACTORS (X Q)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((W '(1 1)) F FS (*GF-CHAR* (CAR (CFACTORW Q))))
      (DO ((N 1 (1+ N)))
          ((EQUAL '(0 1) X) FS)
        (DECLARE (FIXNUM N))
        (WHEN (> (ASH N 1) (CAR X))
          (SETQ FS (CONS (LIST X (CAR X)) FS))
          (RETURN))
        (SETQ W (GF-NRED W X)
              W (GF-POW W Q X)
              F (GF-GCD (GF-PLUS W (GF-NMINUS (LIST 1 1))) X))
        (UNLESS (EQUAL '(0 1) F)
          (SETQ FS (CONS (LIST F N) FS)
                X (GF-DIVIDE X F))))
      (NREVERSE FS)))

[maxima-code/src/numth.lisp:3852]
  (DEFUN GF-EQUAL-DEGREE-FACTORS (X-AND-D Q MULT)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET* ((X (CAR X-AND-D)) (D (CADR X-AND-D)) (N (CAR X)))
      (DECLARE (FIXNUM D N))
      (COND ((= N D) (LIST X MULT))
            (T
             (LET* ((P^K (CFACTORW Q))
                    (P (CAR P^K))
                    (K (CADR P^K))
                    (*GF-CHAR* P)
                    (F '(0 1))
                    (Q^N (EXPT Q N))
                    M
                    E
                    R
                    R^E)
               (IF (= 2 P)
                   (SETQ M (* K D))
                   (SETQ E (ASH (1- (EXPT Q D)) -1)))
               (DO ()
                   ((AND (NOT (EQUAL '(0 1) F)) (NOT (EQUAL X F))))
                 (SETQ R (GF-NONCONST-RANDOM Q Q^N)
                       F (GF-GCD X R))
                 (WHEN (EQUAL '(0 1) F)
                   (SETQ R^E
                           (IF (= 2 P)
                               (GF-TRACE-POLY-F2 R M X)
                               (GF-POW R E X)))
                   (SETQ F (GF-GCD X (GF-NPLUS R^E (GF-NMINUS (LIST 0 1)))))))
               (APPEND
                (GF-EQUAL-DEGREE-FACTORS (LIST (GF-DIVIDE X F) D) Q MULT)
                (GF-EQUAL-DEGREE-FACTORS (LIST F D) Q MULT)))))))

[maxima-code/src/numth.lisp:3959]
  (DEFUN GF-ORD (X ORD FS-ORD RED)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET (P (E 0) Z)
      (DECLARE (FIXNUM E))
      (DOLIST (PE FS-ORD ORD)
        (SETQ P (CAR PE)
              E (THE FIXNUM (CADR PE))
              ORD (TRUNCATE ORD (EXPT P E))
              Z (GF-POW$ X ORD RED))
        (DO ()
            ((EQUAL Z '(0 1)))
          (SETQ ORD (* ORD P))
          (WHEN (= E 1) (RETURN))
          (DECF E)
          (SETQ Z (GF-POW$ Z P RED))))))

[maxima-code/src/numth.lisp:3990]
  (DEFUN GF-GROUP-ORDER (Q RED)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET (NE-LIST Q^N (E 0) (ORD 1))
      (DECLARE (FIXNUM E))
      (DO ((X (GF-FACTOR RED Q)))
          ((NULL X))
        (PUSH (LIST (CAAR X) (CADR X)) NE-LIST)
        (SETQ X (CDDR X)))
      (DOLIST (A NE-LIST)
        (SETQ Q^N (EXPT Q (THE FIXNUM (CAR A)))
              E (THE FIXNUM (CADR A))
              ORD (* ORD (1- Q^N) (EXPT Q^N (THE FIXNUM (1- E))))))
      ORD))

[maxima-code/src/numth.lisp:4251]
  (DEFUN *F-MAYBE-NORMAL-BASIS (X X^Q-POWERS E RED)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DECLARE (FIXNUM E))
    (LET ((E-1 (- E 1)))
      (DECLARE (FIXNUM E-1))
      ($TRANSPOSE
       ($GENMATRIX
        #'(LAMBDA (I J)
            (DECLARE (FIXNUM I J))
            (SVREF
             (GF-X2ARRAY (GF-COMPOSE (SVREF X^Q-POWERS (1- I)) X RED) E-1)
             (1- J)))
        E E))))

[maxima-code/src/numth.lisp:4264]
  (DEFUN GF-X2ARRAY (X LEN)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DECLARE (FIXNUM LEN))
    (LET ((CS (MAKE-ARRAY (1+ LEN) :INITIAL-ELEMENT 0)))
      (DO ((K LEN))
          ((NULL X) CS)
        (DECLARE (FIXNUM K))
        (COND ((> K (THE FIXNUM (CAR X))) (DECF K))
              ((= K (THE FIXNUM (CAR X))) (SETF (SVREF CS (- LEN K)) (CADR X))
               (SETQ X (CDDR X)) (DECF K))
              (T (SETQ X (CDDR X)))))))

[maxima-code/src/numth.lisp:4578]
  (DEFUN *F-DLOG (A G RED ORD FS-ORD)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (COND ((OR (NULL A) (NULL G)) NIL) ((>= (CAR A) (CAR RED)) NIL)
          ((EQUAL '(0 1) A) 0) ((EQUAL G A) 1) ((NOT (GF-UNIT-P A RED)) NIL)
          (T
           (LET (P (E 0) ORD/P OM XP XK DLOGS MODS (G-INV (GF-INV G RED)))
             (DECLARE (FIXNUM E))
             (DOLIST (F FS-ORD)
               (SETQ P (CAR F)
                     E (CADR F)
                     ORD/P (TRUNCATE ORD P)
                     OM (GF-POW G ORD/P RED)
                     XP 0)
               (DO ((B A)
                    (K 0)
                    (PK 1)
                    (ACC G-INV)
                    (E1 (1- E)))
                   (NIL)
                 (DECLARE (FIXNUM K))
                 (SETQ XK (GF-DLOG-RHO-BRENT (GF-POW B ORD/P RED) OM P RED))
                 (INCF XP (* XK PK))
                 (INCF K)
                 (WHEN (= K E) (RETURN))
                 (SETQ ORD/P (TRUNCATE ORD/P P)
                       PK (* PK P))
                 (WHEN (/= XK 0) (SETQ B (GF-TIMES B (GF-POW ACC XK RED) RED)))
                 (WHEN (/= K E1) (SETQ ACC (GF-POW ACC P RED))))
               (PUSH (EXPT P E) MODS)
               (PUSH XP DLOGS))
             (CAR (CHINESE DLOGS MODS))))))

[maxima-code/src/numth.lisp:4610]
  (DEFUN GF-DLOG-F (B Y Z A G P RED)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((M (MOD (CADR B) 3)))
      (DECLARE (FIXNUM M))
      (COND
       ((= 0 M) (VALUES (GF-SQ B RED) (MOD (ASH Y 1) P) (MOD (ASH Z 1) P)))
       ((= 1 M) (VALUES (GF-TIMES G B RED) (MOD (+ Y 1) P) Z))
       (T (VALUES (GF-TIMES A B RED) Y (MOD (+ Z 1) P))))))

[maxima-code/src/numth.lisp:4656]
  (DEFUN GF-DLOG-RHO-BRENT (A G P RED)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (COND ((EQUAL '(0 1) A) 0) ((EQUAL G A) 1) ((EQUAL A (GF-SQ G RED)) 2)
          ((EQUAL '(0 1) (GF-TIMES A G RED)) (1- P))
          ((< P 32) (GF-DLOG-NAIVE A G RED))
          ((< P 1024) (GF-DLOG-BABY-GIANT A G P RED))
          (T
           (PROG ((B (LIST 0 1)) (Y 0) (Z 0) (BB (LIST 0 1)) (YY 0) (ZZ 0) DY
                  DZ)
            RHO
             (DO ((I 0)
                  (J 1))
                 (NIL)
               (DECLARE (FIXNUM I J))
               (MULTIPLE-VALUE-SETQ (B Y Z) (GF-DLOG-F B Y Z A G P RED))
               (WHEN (EQUAL B BB) (RETURN))
               (INCF I)
               (WHEN (= I J)
                 (SETQ J (1+ (ASH J 1)))
                 (SETQ BB B
                       YY Y
                       ZZ Z)))
             (SETQ DY (MOD (- YY Y) P)
                   DZ (MOD (- Z ZZ) P))
             (WHEN (= 1 (GCD DZ P)) (RETURN (ZN-QUO DY DZ P)))
             (SETQ Y 0
                   Z 0
                   B (LIST 0 1)
                   YY (1+ (RANDOM (1- P)))
                   ZZ (1+ (RANDOM (1- P)))
                   BB (GF-TIMES (GF-POW G YY RED) (GF-POW A ZZ RED) RED))
             (GO RHO)))))

[maxima-code/src/rand-mt19937.lisp:207]
  (DEFUN RANDOM-MT19937-UPDATE (STATE)
    (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 32) (627)) STATE)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((Y 0))
      (DECLARE (TYPE (UNSIGNED-BYTE 32) Y))
      (DO ((KK 3 (1+ KK)))
          ((>= KK (+ 3 (- MT19937-N MT19937-M))))
        (DECLARE (TYPE (MOD 628) KK))
        (SETF Y
                (LOGIOR (LOGAND (AREF STATE KK) MT19937-UPPER-MASK)
                        (LOGAND (AREF STATE (1+ KK)) MT19937-LOWER-MASK)))
        (SETF (AREF STATE KK)
                (LOGXOR (AREF STATE (+ KK MT19937-M)) (ASH Y -1)
                        (AREF STATE (LOGAND Y 1)))))
      (DO ((KK (+ (- MT19937-N MT19937-M) 3) (1+ KK)))
          ((>= KK (+ (1- MT19937-N) 3)))
        (DECLARE (TYPE (MOD 628) KK))
        (SETF Y
                (LOGIOR (LOGAND (AREF STATE KK) MT19937-UPPER-MASK)
                        (LOGAND (AREF STATE (1+ KK)) MT19937-LOWER-MASK)))
        (SETF (AREF STATE KK)
                (LOGXOR (AREF STATE (+ KK (- MT19937-M MT19937-N))) (ASH Y -1)
                        (AREF STATE (LOGAND Y 1)))))
      (SETF Y
              (LOGIOR
               (LOGAND (AREF STATE (+ 3 (1- MT19937-N))) MT19937-UPPER-MASK)
               (LOGAND (AREF STATE 3) MT19937-LOWER-MASK)))
      (SETF (AREF STATE (+ 3 (1- MT19937-N)))
              (LOGXOR (AREF STATE (+ 3 (1- MT19937-M))) (ASH Y -1)
                      (AREF STATE (LOGAND Y 1)))))
    (VALUES))

[maxima-code/src/rand-mt19937.lisp:234]
  (DEFUN RANDOM-CHUNK (STATE)
    (DECLARE (TYPE RANDOM-STATE STATE)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET* ((STATE (RANDOM-STATE-STATE STATE)) (K (AREF STATE 2)))
      (DECLARE (TYPE (MOD 628) K))
      (WHEN (= K MT19937-N) (RANDOM-MT19937-UPDATE STATE) (SETF K 0))
      (SETF (AREF STATE 2) (1+ K))
      (LET ((Y (AREF STATE (+ 3 K))))
        (DECLARE (TYPE (UNSIGNED-BYTE 32) Y))
        (SETF Y (LOGXOR Y (ASH Y -11)))
        (SETF Y (LOGXOR Y (ASH (LOGAND Y (ASH MT19937-B -7)) 7)))
        (SETF Y (LOGXOR Y (ASH (LOGAND Y (ASH MT19937-C -15)) 15)))
        (SETF Y (LOGXOR Y (ASH Y -18)))
        Y)))

[maxpc/input/list.lisp:10]
  (DEFMETHOD INPUT-EMPTY-P ((INPUT INDEX-LIST))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (NULL (THE LIST (INDEX-LIST-LIST INPUT))))

[maxpc/input/list.lisp:14]
  (DEFMETHOD INPUT-FIRST ((INPUT INDEX-LIST))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (CAR (THE LIST (INDEX-LIST-LIST INPUT))))

[maxpc/input/list.lisp:25]
  (DEFMETHOD INPUT-SEQUENCE ((INPUT INDEX-LIST) (LENGTH INTEGER))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (SUBSEQ (THE LIST (INDEX-LIST-LIST INPUT)) 0 LENGTH))

[maxpc/input/stream.lisp:32]
  (DEFMETHOD FILL-BUFFER ((BUFFER VECTOR) (STREAM STREAM))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (LET ((NEXT
           (CASE (ELEMENT-TYPE STREAM)
             (CHARACTER (READ-CHAR STREAM NIL 'EOF))
             (OTHERWISE (READ-BYTE STREAM NIL 'EOF)))))
      (UNLESS (EQ NEXT 'EOF)
        (VECTOR-PUSH-EXTEND NEXT BUFFER (THE FIXNUM *CHUNK-SIZE*)))))

[maxpc/input/stream.lisp:61]
  (DEFUN MAYBE-FILL-BUFFER (INPUT)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (LET ((POSITION (INDEX-POSITION INPUT))
          (BUFFER (INDEX-STREAM-BUFFER INPUT))
          (STREAM (INDEX-STREAM-STREAM INPUT)))
      (UNLESS
          (> (THE INDEX-POSITION (LENGTH (THE VECTOR BUFFER)))
             (THE INDEX-POSITION POSITION))
        (FILL-BUFFER BUFFER STREAM)))
    (VALUES))

[maxpc/input/stream.lisp:71]
  (DEFMETHOD INPUT-EMPTY-P ((INPUT INDEX-STREAM))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (MAYBE-FILL-BUFFER INPUT)
    (= (THE INDEX-POSITION (INDEX-POSITION INPUT))
       (THE INDEX-POSITION
            (IF *BOUND*
                (MIN (LENGTH (THE VECTOR (INDEX-STREAM-BUFFER INPUT)))
                     (THE INDEX-POSITION *BOUND*))
                (LENGTH (THE VECTOR (INDEX-STREAM-BUFFER INPUT)))))))

[maxpc/input/stream.lisp:81]
  (DEFMETHOD INPUT-FIRST ((INPUT INDEX-STREAM))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (MAYBE-FILL-BUFFER INPUT)
    (AREF (THE VECTOR (INDEX-STREAM-BUFFER INPUT))
          (THE INDEX-POSITION (INDEX-POSITION INPUT))))

[maxpc/input/stream.lisp:87]
  (DEFMETHOD INPUT-REST ((INPUT INDEX-STREAM))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (LET ((POSITION (INDEX-POSITION INPUT))
          (BUFFER (INDEX-STREAM-BUFFER INPUT))
          (STREAM (INDEX-STREAM-STREAM INPUT)))
      (LET ((NEXT-POSITION (1+ (THE INDEX-POSITION POSITION))))
        (MAKE-INDEX-STREAM :STREAM (THE STREAM STREAM) :BUFFER
         (THE VECTOR BUFFER) :POSITION (THE INDEX-POSITION NEXT-POSITION)))))

[maxpc/input/stream.lisp:100]
  (DEFMETHOD INPUT-SEQUENCE ((INPUT INDEX-STREAM) (LENGTH INTEGER))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (MAKE-ARRAY (THE INDEX-POSITION LENGTH) :ELEMENT-TYPE
                (INPUT-ELEMENT-TYPE INPUT) :DISPLACED-TO
                (INDEX-STREAM-BUFFER INPUT) :DISPLACED-INDEX-OFFSET
                (INDEX-POSITION INPUT)))

[maxpc/input/vector.lisp:20]
  (DEFMETHOD INPUT-EMPTY-P ((INPUT INDEX-VECTOR))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (= (THE INDEX-POSITION (INDEX-POSITION INPUT))
       (THE INDEX-POSITION (LENGTH (THE VECTOR (INDEX-VECTOR-VECTOR INPUT))))))

[maxpc/input/vector.lisp:25]
  (DEFMETHOD INPUT-FIRST ((INPUT INDEX-VECTOR))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (AREF (THE VECTOR (INDEX-VECTOR-VECTOR INPUT))
          (THE INDEX-POSITION (INDEX-POSITION INPUT))))

[maxpc/input/vector.lisp:30]
  (DEFMETHOD INPUT-FIRST ((INPUT INDEX-SIMPLE-VECTOR))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (AREF (THE SIMPLE-VECTOR (INDEX-VECTOR-VECTOR INPUT))
          (THE INDEX-POSITION (INDEX-POSITION INPUT))))

[maxpc/input/vector.lisp:35]
  (DEFMETHOD INPUT-FIRST ((INPUT INDEX-SIMPLE-STRING))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (AREF (THE SIMPLE-STRING (INDEX-VECTOR-VECTOR INPUT))
          (THE INDEX-POSITION (INDEX-POSITION INPUT))))

[maxpc/input/vector.lisp:40]
  (DEFMETHOD INPUT-REST ((INPUT INDEX-VECTOR))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (MAKE-INDEX-VECTOR :VECTOR (THE VECTOR (INDEX-VECTOR-VECTOR INPUT))
     :POSITION (1+ (THE INDEX-POSITION (INDEX-POSITION INPUT)))))

[maxpc/input/vector.lisp:46]
  (DEFMETHOD INPUT-REST ((INPUT INDEX-SIMPLE-VECTOR))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (MAKE-INDEX-SIMPLE-VECTOR :VECTOR
     (THE SIMPLE-VECTOR (INDEX-VECTOR-VECTOR INPUT)) :POSITION
     (1+ (THE INDEX-POSITION (INDEX-POSITION INPUT)))))

[maxpc/input/vector.lisp:52]
  (DEFMETHOD INPUT-REST ((INPUT INDEX-SIMPLE-STRING))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (MAKE-INDEX-SIMPLE-STRING :VECTOR
     (THE SIMPLE-STRING (INDEX-VECTOR-VECTOR INPUT)) :POSITION
     (1+ (THE INDEX-POSITION (INDEX-POSITION INPUT)))))

[maxpc/input/vector.lisp:61]
  (DEFMETHOD INPUT-SEQUENCE ((INPUT INDEX-VECTOR) (LENGTH INTEGER))
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (MAKE-ARRAY (THE INDEX-POSITION LENGTH) :ELEMENT-TYPE
                (INPUT-ELEMENT-TYPE INPUT) :DISPLACED-TO
                (INDEX-VECTOR-VECTOR INPUT) :DISPLACED-INDEX-OFFSET
                (INDEX-VECTOR-POSITION INPUT)))

[mcclim/Apps/Clouseau/src/objects/number.lisp:15]
  (DEFUN PRIME-FACTORS (INTEGER)
    (DECLARE (OPTIMIZE SPEED (DEBUG 1) (SAFETY 1))
             (TYPE (UNSIGNED-BYTE 32) INTEGER))
    (LET ((FACTORS 'NIL))
      (LABELS ((ADD-FACTOR (FACTOR)
                 (DECLARE (TYPE (UNSIGNED-BYTE 32) FACTOR))
                 (LET ((FIRST (FIRST FACTORS)))
                   (IF (OR (NULL FIRST)
                           (/= FACTOR (THE (UNSIGNED-BYTE 32) (CAR FIRST))))
                       (PUSH (CONS FACTOR 1) FACTORS)
                       (INCF (THE (UNSIGNED-BYTE 32) (CDR FIRST))))))
               (TRY (N D UPPER-BOUND)
                 (DECLARE (TYPE (UNSIGNED-BYTE 32) N D UPPER-BOUND))
                 (IF (> D UPPER-BOUND)
                     (ADD-FACTOR N)
                     (MULTIPLE-VALUE-BIND (QUOTIENT REMAINDER)
                         (TRUNCATE N D)
                       (COND ((ZEROP REMAINDER) (ADD-FACTOR D) (REC QUOTIENT))
                             (T
                              (TRY N
                               (IF (EVENP D)
                                   (1+ D)
                                   (+ D 2))
                               UPPER-BOUND))))))
               (REC (N)
                 (DECLARE (TYPE (UNSIGNED-BYTE 32) N))
                 (WHEN (>= N 2) (TRY N 2 (ISQRT N)))))
        (REC INTEGER))
      FACTORS))

[mcclim/Apps/Clouseau/test/smoke.lisp:54]
  (DEFUN ADD-AGES (X Y)
    "Add together two ages in a fast but unsafe manner"
    (DECLARE (TYPE (INTEGER 1 150) X Y)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 1)))
    (+ X Y))

[mcclim/Backends/CLX/cursor.lisp:30]
  (DEFUN MAKE-CURSOR-TABLE (PORT)
    (DECLARE (OPTIMIZE (SAFETY 3) (DEBUG 3) (SPEED 0) (SPACE 0)))
    (LET ((FONT
           (#S(FORMGREP:SYMREF :NAME "OPEN-FONT" :QUALIFIER "XLIB")
            (CLX-PORT-DISPLAY PORT) "cursor")))
      (LOOP FOR (SYMBOL CODE) IN *CLX-CURSOR-MAPPING*
            DO (SETF (GETHASH SYMBOL (CLX-PORT-CURSOR-TABLE PORT))
                       (#S(FORMGREP:SYMREF
                           :NAME "CREATE-GLYPH-CURSOR"
                           :QUALIFIER "XLIB")
                        :FOREGROUND
                        (#S(FORMGREP:SYMREF
                            :NAME "MAKE-COLOR"
                            :QUALIFIER "XLIB")
                         :RED 0.0 :GREEN 0.0 :BLUE 0.0)
                        :BACKGROUND
                        (#S(FORMGREP:SYMREF
                            :NAME "MAKE-COLOR"
                            :QUALIFIER "XLIB")
                         :RED 1.0 :GREEN 1.0 :BLUE 1.0)
                        :SOURCE-FONT FONT :SOURCE-CHAR CODE :MASK-FONT FONT
                        :MASK-CHAR (1+ CODE))))
      (#S(FORMGREP:SYMREF :NAME "CLOSE-FONT" :QUALIFIER "XLIB") FONT)))

[mcclim/Core/clim-basic/geometry/transforms.lisp:681]
  (DEFMETHOD TRANSFORMATION-TRANSFORMATOR
             ((TRANSFORMATION STANDARD-TRANSFORMATION)
              &OPTIONAL (INPUT-TYPE 'REAL))
    (MULTIPLE-VALUE-BIND (MXX MXY MYX MYY TX TY)
        (GET-TRANSFORMATION TRANSFORMATION)
      (LABELS ((S* (X Y)
                 (COND ((COORDINATE= 0 X) NIL) ((COORDINATE= 1 X) (LIST Y))
                       ((COORDINATE= -1 X)
                        (LIST
                         (ECLECTOR.READER:QUASIQUOTE
                          (- (ECLECTOR.READER:UNQUOTE Y)))))
                       ((LIST
                         (ECLECTOR.READER:QUASIQUOTE
                          (* (ECLECTOR.READER:UNQUOTE X)
                             (ECLECTOR.READER:UNQUOTE Y)))))))
               (S+ (ARGS)
                 (COND ((NULL ARGS) (COERCE 0 'COORDINATE))
                       ((NULL (CDR ARGS)) (CAR ARGS))
                       (T
                        (ECLECTOR.READER:QUASIQUOTE
                         (+ ECLECTOR.READER:UNQUOTE ARGS))))))
        (COMPILE NIL
                 (ECLECTOR.READER:QUASIQUOTE
                  (LAMBDA (X Y)
                    (DECLARE (IGNORABLE X Y)
                             (TYPE (ECLECTOR.READER:UNQUOTE INPUT-TYPE) X Y)
                             (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0)))
                    (VALUES
                     (ECLECTOR.READER:UNQUOTE
                      (S+
                       (NCONC (S* MXX 'X) (S* MXY 'Y)
                              (IF (COORDINATE/= 0 TX)
                                  (LIST TX)
                                  NIL))))
                     (ECLECTOR.READER:UNQUOTE
                      (S+
                       (NCONC (S* MYX 'X) (S* MYY 'Y)
                              (IF (COORDINATE/= 0 TY)
                                  (LIST TY)
                                  NIL)))))))))))

[mcclim/Core/system/resources.lisp:149]
  (DEFMACRO DEFRESOURCE
            (NAME PARAMETERS
             &KEY (CONSTRUCTOR (ERROR "~S argument is required" :CONSTRUCTOR))
             INITIALIZER DEINITIALIZER MATCHER INITIAL-COPIES)
    (CHECK-TYPE NAME SYMBOL)
    (LET ((PACK (SYMBOL-PACKAGE NAME)))
      (WHEN
          (OR (EQ PACK (FIND-PACKAGE :KEYWORD))
              (EQ PACK (FIND-PACKAGE :COMMON-LISP))
              (#S(FORMGREP:SYMREF
                  :NAME "PACKAGE-DEFINITION-LOCK"
                  :QUALIFIER "EXCL")
               PACK))
        (CERROR "Define resource ~S anyway"
                "Resource ~S cannot be defined, since its home package, ~S, is locked."
                NAME (PACKAGE-NAME PACK))))
    (LET ((PVARS NIL))
      (DOLIST (PARAMETER PARAMETERS)
        (COND ((MEMBER PARAMETER LAMBDA-LIST-KEYWORDS) NIL)
              ((SYMBOLP PARAMETER) (PUSHNEW PARAMETER PVARS))
              ((CONSP PARAMETER)
               (IF (CONSP (FIRST PARAMETER))
                   (PUSHNEW (SECOND (FIRST PARAMETER)) PVARS)
                   (PUSHNEW (FIRST PARAMETER) PVARS))
               (WHEN (THIRD PARAMETER) (PUSHNEW (THIRD PARAMETER) PVARS)))))
      (SETF PVARS (REVERSE PVARS))
      (LET ((PARAMETERS-NEEDED-P
             (OR (NULL MATCHER) (NOT (NULL DEINITIALIZER)))))
        (LABELS ((ALLOCATE-FRESH-EXPR (R.)
                   (LET ((RO. (GENSYM "RO.")))
                     (ECLECTOR.READER:QUASIQUOTE
                      (LET (((ECLECTOR.READER:UNQUOTE RO.)
                             (MAKE-RESOURCE-OBJECT :OBJECT
                              (ECLECTOR.READER:UNQUOTE CONSTRUCTOR) :LOCK
                              (LIST 1) :PARAMETERS
                              (ECLECTOR.READER:UNQUOTE
                               (IF PARAMETERS-NEEDED-P
                                   (ECLECTOR.READER:QUASIQUOTE
                                    (MAKE-LIST
                                     (ECLECTOR.READER:UNQUOTE (LENGTH PVARS))))
                                   'NIL)))))
                        (WITH-LOCK-HELD
                         ((RESOURCE-LOCK (ECLECTOR.READER:UNQUOTE R.)))
                         (PUSH (ECLECTOR.READER:UNQUOTE RO.)
                               (RESOURCE-OBJECTS
                                (ECLECTOR.READER:UNQUOTE R.))))
                        (ECLECTOR.READER:UNQUOTE RO.)))))
                 (MATCH-EXPR (RO.)
                   (LET ((Q. (GENSYM "Q.")))
                     (IF MATCHER
                         (ECLECTOR.READER:QUASIQUOTE
                          (LET (((ECLECTOR.READER:UNQUOTE NAME)
                                 (RESOURCE-OBJECT-OBJECT
                                  (ECLECTOR.READER:UNQUOTE RO.))))
                            (DECLARE
                             (IGNORABLE (ECLECTOR.READER:UNQUOTE NAME)))
                            (ECLECTOR.READER:UNQUOTE MATCHER)))
                         (ECLECTOR.READER:QUASIQUOTE
                          (LET (((ECLECTOR.READER:UNQUOTE Q.)
                                 (RESOURCE-OBJECT-PARAMETERS
                                  (ECLECTOR.READER:UNQUOTE RO.))))
                            (DECLARE (IGNORABLE (ECLECTOR.READER:UNQUOTE Q.)))
                            (AND
                             (ECLECTOR.READER:UNQUOTE-SPLICING
                              (LOOP FOR P IN PVARS
                                    COLLECT (ECLECTOR.READER:QUASIQUOTE
                                             (EQUAL
                                              (POP
                                               (ECLECTOR.READER:UNQUOTE Q.))
                                              (ECLECTOR.READER:UNQUOTE
                                               P)))))))))))
                 (FIND-EXPR (R.)
                   (LET ((RO. (GENSYM "$RO.")) (LOCK. (GENSYM "$LOCK.")))
                     (ECLECTOR.READER:QUASIQUOTE
                      (DOLIST
                          ((ECLECTOR.READER:UNQUOTE RO.)
                           (RESOURCE-OBJECTS (ECLECTOR.READER:UNQUOTE R.))
                           (ECLECTOR.READER:UNQUOTE (ALLOCATE-FRESH-EXPR R.)))
                        (DECLARE
                         (TYPE RESOURCE-OBJECT (ECLECTOR.READER:UNQUOTE RO.)))
                        (LET (((ECLECTOR.READER:UNQUOTE LOCK.)
                               (RESOURCE-OBJECT-LOCK
                                (ECLECTOR.READER:UNQUOTE RO.))))
                          (DECLARE (TYPE CONS (ECLECTOR.READER:UNQUOTE LOCK.)))
                          (WHEN
                              (= 0
                                 (THE FIXNUM
                                      (CAR (ECLECTOR.READER:UNQUOTE LOCK.))))
                            (RESOURCE-ATOMIC-INCF
                             (THE FIXNUM
                                  (CAR (ECLECTOR.READER:UNQUOTE LOCK.))))
                            (COND
                             ((AND
                               (= 1
                                  (THE FIXNUM
                                       (LOCALLY
                                        (DECLARE (OPTIMIZE (SAFETY 3)))
                                        (CAR
                                         (ECLECTOR.READER:UNQUOTE LOCK.)))))
                               (ECLECTOR.READER:UNQUOTE (MATCH-EXPR RO.)))
                              (RETURN (ECLECTOR.READER:UNQUOTE RO.)))
                             (T
                              (RESOURCE-ATOMIC-DECF
                               (THE FIXNUM
                                    (CAR
                                     (ECLECTOR.READER:UNQUOTE LOCK.))))))))))))
                 (ALLOCATOR ()
                   (LET ((R. (GENSYM "R."))
                         (RO. (GENSYM "RO."))
                         (FN.
                          (MAKE-SYMBOL
                           (WITH-STANDARD-IO-SYNTAX
                            (LET ((*PACKAGE* (FIND-PACKAGE :KEYWORD)))
                              (FORMAT NIL "ALLOCATOR for ~S" NAME))))))
                     (ECLECTOR.READER:QUASIQUOTE
                      (LABELS (((ECLECTOR.READER:UNQUOTE FN.)
                                   ((ECLECTOR.READER:UNQUOTE R.)
                                    (ECLECTOR.READER:UNQUOTE-SPLICING
                                     PARAMETERS))
                                 (LET (((ECLECTOR.READER:UNQUOTE RO.)
                                        (ECLECTOR.READER:UNQUOTE
                                         (FIND-EXPR R.))))
                                   (DECLARE
                                    (TYPE RESOURCE-OBJECT
                                     (ECLECTOR.READER:UNQUOTE RO.)))
                                   (ECLECTOR.READER:UNQUOTE
                                    (INSTALL-PARAMETERS-EXPR RO.))
                                   (LET (((ECLECTOR.READER:UNQUOTE NAME)
                                          (RESOURCE-OBJECT-OBJECT
                                           (ECLECTOR.READER:UNQUOTE RO.))))
                                     (DECLARE
                                      (IGNORABLE
                                       (ECLECTOR.READER:UNQUOTE NAME)))
                                     (ECLECTOR.READER:UNQUOTE INITIALIZER))
                                   (VALUES
                                    (RESOURCE-OBJECT-OBJECT
                                     (ECLECTOR.READER:UNQUOTE RO.))
                                    (ECLECTOR.READER:UNQUOTE RO.)))))
                        #'(ECLECTOR.READER:UNQUOTE FN.)))))
                 (INSTALL-PARAMETERS-EXPR (RO.)
                   (AND PARAMETERS-NEEDED-P
                        (LET ((Q. (GENSYM "Q.")))
                          (ECLECTOR.READER:QUASIQUOTE
                           (LET (((ECLECTOR.READER:UNQUOTE Q.)
                                  (RESOURCE-OBJECT-PARAMETERS
                                   (ECLECTOR.READER:UNQUOTE RO.))))
                             (DECLARE (IGNORABLE (ECLECTOR.READER:UNQUOTE Q.)))
                             (ECLECTOR.READER:UNQUOTE-SPLICING
                              (LOOP FOR P IN PVARS
                                    COLLECT (ECLECTOR.READER:QUASIQUOTE
                                             (SETF (CAR
                                                    (ECLECTOR.READER:UNQUOTE
                                                     Q.))
                                                     (ECLECTOR.READER:UNQUOTE
                                                      P)
                                                   (ECLECTOR.READER:UNQUOTE Q.)
                                                     (CDR
                                                      (ECLECTOR.READER:UNQUOTE
                                                       Q.)))))))))))
                 (DEALLOCATOR ()
                   (LET ((R. (GENSYM "R."))
                         (RO. (GENSYM "RO."))
                         (OBJ. (GENSYM "OBJ"))
                         (Q. (GENSYM "Q"))
                         (LOCK. (GENSYM "LOCK")))
                     (ECLECTOR.READER:QUASIQUOTE
                      (LAMBDA
                          ((ECLECTOR.READER:UNQUOTE R.)
                           (ECLECTOR.READER:UNQUOTE OBJ.)
                           &OPTIONAL (ECLECTOR.READER:UNQUOTE RO.))
                        (UNLESS (ECLECTOR.READER:UNQUOTE RO.)
                          (DO ((Q (RESOURCE-OBJECTS
                                   (THE RESOURCE (ECLECTOR.READER:UNQUOTE R.)))
                                  (CDR (THE CONS Q))))
                              ((NULL Q) (ERROR "Something corrupted."))
                            (LET ((RO (CAR (THE CONS Q))))
                              (DECLARE (TYPE RESOURCE-OBJECT RO))
                              (WHEN
                                  (EQ (ECLECTOR.READER:UNQUOTE OBJ.)
                                      (RESOURCE-OBJECT-OBJECT RO))
                                (SETF (ECLECTOR.READER:UNQUOTE RO.) RO)
                                (RETURN)))))
                        (LOCALLY
                         (DECLARE
                          (TYPE RESOURCE-OBJECT (ECLECTOR.READER:UNQUOTE RO.)))
                         (LET (((ECLECTOR.READER:UNQUOTE NAME)
                                (ECLECTOR.READER:UNQUOTE OBJ.)))
                           (DECLARE (IGNORABLE (ECLECTOR.READER:UNQUOTE NAME)))
                           (ECLECTOR.READER:UNQUOTE
                            (WHEN DEINITIALIZER
                              (ECLECTOR.READER:QUASIQUOTE
                               (DESTRUCTURING-BIND
                                   ((ECLECTOR.READER:UNQUOTE-SPLICING PVARS))
                                   (RESOURCE-OBJECT-PARAMETERS
                                    (ECLECTOR.READER:UNQUOTE RO.))
                                 (DECLARE
                                  (IGNORABLE
                                   (ECLECTOR.READER:UNQUOTE-SPLICING PVARS)))
                                 (ECLECTOR.READER:UNQUOTE DEINITIALIZER))))))
                         (ECLECTOR.READER:UNQUOTE
                          (IF (AND MATCHER (NOT (NULL DEINITIALIZER)))
                              (ECLECTOR.READER:QUASIQUOTE
                               (LET (((ECLECTOR.READER:UNQUOTE Q.)
                                      (RESOURCE-OBJECT-PARAMETERS
                                       (ECLECTOR.READER:UNQUOTE RO.))))
                                 (ECLECTOR.READER:UNQUOTE-SPLICING
                                  (LOOP REPEAT (LENGTH PVARS)
                                        COLLECT (ECLECTOR.READER:QUASIQUOTE
                                                 (SETF (CAR
                                                        (ECLECTOR.READER:UNQUOTE
                                                         Q.))
                                                         NIL
                                                       (ECLECTOR.READER:UNQUOTE
                                                        Q.)
                                                         (CDR
                                                          (ECLECTOR.READER:UNQUOTE
                                                           Q.))))))))
                              NIL))
                         (LET (((ECLECTOR.READER:UNQUOTE LOCK.)
                                (RESOURCE-OBJECT-LOCK
                                 (ECLECTOR.READER:UNQUOTE RO.))))
                           (RESOURCE-ATOMIC-DECF
                            (THE FIXNUM
                                 (CAR (ECLECTOR.READER:UNQUOTE LOCK.)))))))))))
          (LET* ((R. (GENSYM "R."))
                 (Q. (GENSYM "Q."))
                 (ALLOCATOR. (GENSYM "ALLOCATOR."))
                 (DEALLOCATOR. (GENSYM "DEALLOCATOR.")))
            (ECLECTOR.READER:QUASIQUOTE
             (PROGN
              (#S(FORMGREP:SYMREF :NAME "RECORD-SOURCE-FILE" :QUALIFIER "EXCL")
               '(ECLECTOR.READER:UNQUOTE NAME) :TYPE :RESOURCE-DEFINITION)
              (LET* (((ECLECTOR.READER:UNQUOTE ALLOCATOR.)
                      (ECLECTOR.READER:UNQUOTE (ALLOCATOR)))
                     ((ECLECTOR.READER:UNQUOTE DEALLOCATOR.)
                      (ECLECTOR.READER:UNQUOTE (DEALLOCATOR)))
                     ((ECLECTOR.READER:UNQUOTE R.)
                      (OR
                       (MAKE-RESOURCE :NAME '(ECLECTOR.READER:UNQUOTE NAME)
                        :OBJECTS NIL :LOCK
                        (MAKE-LOCK
                         (LET ((*PACKAGE* (FIND-PACKAGE :KEYWORD)))
                           (FORMAT NIL "Resource ~S"
                                   '(ECLECTOR.READER:UNQUOTE NAME))))))))
                (SETF (RESOURCE-ALLOCATOR (ECLECTOR.READER:UNQUOTE R.))
                        (ECLECTOR.READER:UNQUOTE ALLOCATOR.)
                      (RESOURCE-DEALLOCATOR (ECLECTOR.READER:UNQUOTE R.))
                        (ECLECTOR.READER:UNQUOTE DEALLOCATOR.))
                (ECLECTOR.READER:UNQUOTE
                 (WHEN INITIAL-COPIES
                   (ECLECTOR.READER:QUASIQUOTE
                    (PROGN
                     (DOTIMES
                         ((ECLECTOR.READER:UNQUOTE Q.)
                          (ECLECTOR.READER:UNQUOTE INITIAL-COPIES))
                       (FUNCALL (ECLECTOR.READER:UNQUOTE ALLOCATOR.)
                                (ECLECTOR.READER:UNQUOTE R.)))
                     (DOLIST
                         ((ECLECTOR.READER:UNQUOTE Q.)
                          (RESOURCE-OBJECTS (ECLECTOR.READER:UNQUOTE R.)))
                       (FUNCALL (ECLECTOR.READER:UNQUOTE DEALLOCATOR.)
                                (ECLECTOR.READER:UNQUOTE R.)
                                (RESOURCE-OBJECT-OBJECT
                                 (ECLECTOR.READER:UNQUOTE Q.))
                                (ECLECTOR.READER:UNQUOTE Q.)))))))
                (SETF (FIND-RESOURCE '(ECLECTOR.READER:UNQUOTE NAME))
                        (ECLECTOR.READER:UNQUOTE R.))
                '(ECLECTOR.READER:UNQUOTE NAME)))))))))

[mcclim/Experimental/pixel-format.lisp:34]
  (DEFPARAMETER *CODE-OPTIMIZATION*
    '(OPTIMIZE (SAFETY 0) (SPACE 0) (SPEED 3) (DEBUG 0))
    "Code optimization level within pixel translation code.")

[mcclim/Experimental/unzip/inflate.lisp:52]
  (DECLAIM (OPTIMIZE (SPEED 3) (SAFETY 3) (SPACE 0)))

[mcclim/Experimental/unzip/inflate.lisp:136]
  (DEFSUBST REVERSE-BYTE (N X)
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
            (TYPE (UNSIGNED-BYTE 16) X)
            (TYPE (INTEGER 0 16) N))
   (SETF X (LOGIOR (ASH (LOGAND X 43690) -1) (ASH (LOGAND X 21845) 1)))
   (SETF X (LOGIOR (ASH (LOGAND X 52428) -2) (ASH (LOGAND X 13107) 2)))
   (SETF X (LOGIOR (ASH (LOGAND X 61680) -4) (ASH (LOGAND X 3855) 4)))
   (SETF X (LOGIOR (ASH (LOGAND X 65280) -8) (ASH (LOGAND X 255) 8)))
   (ASH X (- N 16)))

[mcclim/Experimental/unzip/interface.lisp:96]
  (DEFMETHOD UPDATE-CHECKSUM ((SELF CRC32-CHECKSUM) BUF START END)
    (LET ((CRC (LOGXOR 4294967295 (SLOT-VALUE SELF 'CRC))))
      (DECLARE (TYPE FIXNUM START END)
               (TYPE (UNSIGNED-BYTE 32) CRC)
               (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) BUF)
               (OPTIMIZE (SPEED 3) (SAFETY 0)))
      (LET ((TABLE *CRC-TABLE*))
        (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 32) (256)) *CRC-TABLE*))
        (DO ((I START (+ I 1)))
            ((>= I END))
          (DECLARE (TYPE FIXNUM I))
          (SETF CRC
                  (LOGXOR (AREF TABLE (LOGAND 255 (LOGXOR CRC (AREF BUF I))))
                          (ASH CRC -8)))))
      (SETF (SLOT-VALUE SELF 'CRC) (LOGXOR 4294967295 CRC))))

[mcclim/Extensions/bitmap-formats/xpm.lisp:196]
  (DEFUN XPM-PARSE-COLOR (DATA CPP INDEX)
    (DECLARE (TYPE XPM-DATA-ARRAY DATA)
             (TYPE (INTEGER 1 4) CPP)
             (TYPE ARRAY-INDEX INDEX)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET* ((COLOR-TOKEN-END (THE ARRAY-INDEX (+ INDEX CPP)))
           (CODE (XPM-EXTRACT-COLOR-TOKEN DATA INDEX COLOR-TOKEN-END))
           (STRING-END (1- (XPM-EXIT-STRING DATA COLOR-TOKEN-END)))
           (COLOR (XPM-PARSE-COLOR-SPEC DATA COLOR-TOKEN-END STRING-END)))
      (DECLARE (TYPE ARRAY-INDEX COLOR-TOKEN-END STRING-END)
               (TYPE XPM-PIXCODE CODE))
      (UNLESS COLOR
        (ERROR "Color ~S does not parse."
               (MAP 'STRING #'CODE-CHAR
                    (SUBSEQ DATA COLOR-TOKEN-END STRING-END))))
      (VALUES CODE COLOR (1+ STRING-END))))

[mcclim/Extensions/bitmap-formats/xpm.lisp:218]
  (DEFUN XPM-PARSE-COLOR-SPEC (DATA START END)
    (DECLARE (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0))
             (TYPE XPM-DATA-ARRAY DATA)
             (TYPE ARRAY-INDEX START END))
    (LET ((ORIGINAL-START START)
          KEY
          LAST-WAS-KEY
          COLOR-TOKEN-START
          COLOR-TOKEN-END)
      (DECLARE (TYPE (OR NULL ARRAY-INDEX) COLOR-TOKEN-START COLOR-TOKEN-END)
               (TYPE (OR NULL (UNSIGNED-BYTE 8)) KEY))
      (FLET ((FIND-TOKEN (START END)
               (LET* ((P1
                       (POSITION-IF-NOT #'XPM-WHITE-SPACE-P DATA :START START
                                        :END END))
                      (P2
                       (AND P1
                            (OR
                             (POSITION-IF #'XPM-WHITE-SPACE-P DATA :START P1
                                          :END END)
                             END))))
                 (VALUES P1 P2)))
             (QUUX (KEY COLOR-TOKEN-START COLOR-TOKEN-END)
               (LET ((INK
                      (XPM-PARSE-SINGLE-COLOR KEY DATA COLOR-TOKEN-START
                       COLOR-TOKEN-END)))
                 (WHEN INK (RETURN-FROM XPM-PARSE-COLOR-SPEC INK))))
             (STRINGIZE ()
               (MAP 'STRING #'CODE-CHAR (SUBSEQ DATA ORIGINAL-START END))))
        (LOOP
         (MULTIPLE-VALUE-BIND (P1 P2)
             (FIND-TOKEN START END)
           (UNLESS P1
             (WHEN LAST-WAS-KEY
               (ERROR
                "Premature end of color line (no color present after key): ~S."
                (STRINGIZE)))
             (WHEN COLOR-TOKEN-START
               (QUUX KEY COLOR-TOKEN-START COLOR-TOKEN-END))
             (ERROR "We failed to parse a color out of ~S." (STRINGIZE)))
           (COND
            (LAST-WAS-KEY
             (SETF LAST-WAS-KEY NIL
                   COLOR-TOKEN-START P1
                   COLOR-TOKEN-END P2))
            ((XPM-KEY-P (ELT DATA P1))
             (WHEN COLOR-TOKEN-START
               (QUUX KEY COLOR-TOKEN-START COLOR-TOKEN-END))
             (SETF LAST-WAS-KEY T
                   COLOR-TOKEN-START NIL
                   COLOR-TOKEN-END NIL
                   KEY (ELT DATA P1)))
            (T
             (WHEN (NULL COLOR-TOKEN-START)
               (ERROR "Color not prefixed by a key: ~S." (STRINGIZE)))
             (SETF LAST-WAS-KEY NIL) (SETF COLOR-TOKEN-END P2)))
           (SETF START P2))))))

[mcclim/Extensions/render/image.lisp:24]
  (MACROLET ((DEFINE-COPY-IMAGE (NAME BACKWARDP)
               (ECLECTOR.READER:QUASIQUOTE
                (PROGN
                 (DECLAIM (INLINE (ECLECTOR.READER:UNQUOTE NAME)))
                 (DEFUN (ECLECTOR.READER:UNQUOTE NAME)
                        (SRC-ARRAY DST-ARRAY X1S Y1S X1D Y1D X2 Y2)
                   (DECLARE (TYPE IMAGE-INDEX X1S Y1S X1D Y1D X2 Y2)
                            (TYPE ARGB-PIXEL-ARRAY SRC-ARRAY DST-ARRAY)
                            (OPTIMIZE (SPEED 3) (SAFETY 1)))
                   (DO-REGIONS
                    ((SRC-J DEST-J Y1S Y1D Y2) (SRC-I DEST-I X1S X1D X2)
                     (ECLECTOR.READER:UNQUOTE-SPLICING
                      (WHEN BACKWARDP
                        (ECLECTOR.READER:QUASIQUOTE (:BACKWARD T)))))
                    (SETF (AREF DST-ARRAY DEST-J DEST-I)
                            (AREF SRC-ARRAY SRC-J SRC-I))))))))
    (DEFINE-COPY-IMAGE %COPY-IMAGE NIL)
    (DEFINE-COPY-IMAGE %COPY-IMAGE* T))

[mcclim/Extensions/render/image.lisp:70]
  (MACROLET ((DEFINE-BLEND-IMAGE (NAME BACKWARDP)
               (ECLECTOR.READER:QUASIQUOTE
                (PROGN
                 (DECLAIM (INLINE (ECLECTOR.READER:UNQUOTE NAME)))
                 (DEFUN (ECLECTOR.READER:UNQUOTE NAME)
                        (SRC-ARRAY DST-ARRAY X1S Y1S X1D Y1D X2 Y2)
                   (DECLARE (TYPE IMAGE-INDEX X1S Y1S X1D Y1D X2 Y2)
                            (TYPE ARGB-PIXEL-ARRAY SRC-ARRAY DST-ARRAY)
                            (OPTIMIZE (SPEED 3) (SAFETY 0)))
                   (DO-REGIONS
                    ((SRC-J DEST-J Y1S Y1D Y2) (SRC-I DEST-I X1S X1D X2)
                     (ECLECTOR.READER:UNQUOTE-SPLICING
                      (WHEN BACKWARDP
                        (ECLECTOR.READER:QUASIQUOTE (:BACKWARD T)))))
                    (LET-RGBA
                     ((R.FG G.FG B.FG A.FG) (AREF SRC-ARRAY SRC-J SRC-I))
                     (LET-RGBA
                      ((R.BG G.BG B.BG A.BG) (AREF DST-ARRAY DEST-J DEST-I))
                      (SETF (AREF DST-ARRAY DEST-J DEST-I)
                              (OCTET-BLEND-FUNCTION* R.FG G.FG B.FG A.FG R.BG
                               G.BG B.BG A.BG))))))))))
    (DEFINE-BLEND-IMAGE %BLEND-IMAGE NIL)
    (DEFINE-BLEND-IMAGE %BLEND-IMAGE* T))

[mcclim/Extensions/render/utilities.lisp:206]
  (DEFMACRO WITH-BRUSHES ((MASK) &BODY BODY)
    (LET ((DESIGNS
           '(COLOR OPACITY
             #S(FORMGREP:SYMREF :NAME "UNIFORM-COMPOSITUM" :QUALIFIER "CLIMI")
             STANDARD-FLIPPING-INK
             #S(FORMGREP:SYMREF :NAME "%RGBA-PATTERN" :QUALIFIER "CLIMI")
             OTHERWISE)))
      (ECLECTOR.READER:QUASIQUOTE
       (LOCALLY
        (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
        (MAXF X1 0)
        (MAXF Y1 0)
        (MINF X2 (ARRAY-DIMENSION IMAGE-ARRAY 1))
        (MINF Y2 (ARRAY-DIMENSION IMAGE-ARRAY 0))
        (TYPECASE DESIGN
          (BOUNDED-REGION
           (WITH-BOUNDING-RECTANGLE* (A B C D) DESIGN (MAXF X1 A) (MAXF Y1 B)
            (MINF X2 C) (MINF Y2 D)))
          (INDIRECT-INK (SETF DESIGN (INDIRECT-INK-INK DESIGN))))
        (WHEN
            (REGION-CONTAINS-REGION-P CLIPPING-REGION
             (MAKE-RECTANGLE* X1 Y1 X2 Y2))
          (SETF CLIPPING-REGION NIL))
        (SETF X1 (FLOOR X1)
              Y1 (FLOOR Y1)
              X2 (CEILING X2)
              Y2 (CEILING Y2))
        (LOCALLY
         (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
                  (TYPE IMAGE-INDEX X1 Y1 X2 Y2)
                  (TYPE (OR NULL REGION) CLIPPING-REGION))
         (TYPECASE DESIGN
           (ECLECTOR.READER:UNQUOTE-SPLICING
            (LOOP FOR TYPE IN DESIGNS
                  COLLECT (ECLECTOR.READER:QUASIQUOTE
                           ((ECLECTOR.READER:UNQUOTE TYPE)
                            (IF (NULL CLIPPING-REGION)
                                (WITH-BRUSH
                                 ((ECLECTOR.READER:UNQUOTE TYPE) NIL
                                  (ECLECTOR.READER:UNQUOTE MASK))
                                 (ECLECTOR.READER:UNQUOTE-SPLICING BODY))
                                (WITH-BRUSH
                                 ((ECLECTOR.READER:UNQUOTE TYPE) T
                                  (ECLECTOR.READER:UNQUOTE MASK))
                                 (ECLECTOR.READER:UNQUOTE-SPLICING BODY))))))))
         (MAKE-RECTANGLE* X1 Y1 X2 Y2))))))

[mcclim/Extensions/render/utilities.lisp:436]
  (DEFUN %VALS->RGBA (R G B &OPTIONAL (A 255))
    (DECLARE (TYPE OCTET R G B A)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LOGIOR (ASH A 24) (ASH R 16) (ASH G 8) (ASH B 0)))

[mcclim/Extensions/render/utilities.lisp:441]
  (DEFUN %RGBA->VALS (RGBA)
    (DECLARE (TYPE ARGB-PIXEL RGBA)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (VALUES (LDB (BYTE 8 16) RGBA) (LDB (BYTE 8 8) RGBA) (LDB (BYTE 8 0) RGBA)
            (LDB (BYTE 8 24) RGBA)))

[mcclim/Extensions/render/vectors.lisp:63]
  (DEFUN %AA-SCANLINE-SWEEP (SCANLINE FUNCTION START END)
    "Call FUNCTION for each pixel on the polygon covered by
SCANLINE. The pixels are scanned in increasing X. The sweep can
be limited to a range by START (included) or/and END (excluded)."
    (DECLARE (OPTIMIZE SPEED (DEBUG 0) (SAFETY 0) (SPACE 2))
             (TYPE (FUNCTION (FIXNUM FIXNUM FIXNUM) *) FUNCTION)
             (TYPE FIXNUM START END))
    (LET* ((X-MIN
            (MAX START
                 (#S(FORMGREP:SYMREF :NAME "CELL-X" :QUALIFIER "AA")
                  (FIRST SCANLINE))))
           (X-MAX X-MIN)
           (COVER 0)
           (Y
            (#S(FORMGREP:SYMREF :NAME "SCANLINE-Y" :QUALIFIER "AA") SCANLINE))
           (CELLS SCANLINE)
           (LAST-X NIL))
      (DECLARE (TYPE FIXNUM X-MIN X-MAX)
               (TYPE (OR NULL FIXNUM) LAST-X))
      (LOOP WHILE (AND CELLS
                       (<
                        (#S(FORMGREP:SYMREF :NAME "CELL-X" :QUALIFIER "AA")
                         (CAR CELLS))
                        START))
            DO (INCF COVER
                     (#S(FORMGREP:SYMREF :NAME "CELL-COVER" :QUALIFIER "AA")
                      (CAR CELLS))) (SETF LAST-X
                                            (#S(FORMGREP:SYMREF
                                                :NAME "CELL-X"
                                                :QUALIFIER "AA")
                                             (CAR CELLS))
                                          CELLS (CDR CELLS)))
      (DOLIST (CELL CELLS)
        (LET ((X (#S(FORMGREP:SYMREF :NAME "CELL-X" :QUALIFIER "AA") CELL)))
          (WHEN (AND LAST-X (> X (1+ LAST-X)))
            (LET ((ALPHA
                   (#S(FORMGREP:SYMREF :NAME "COMPUTE-ALPHA" :QUALIFIER "AA")
                    COVER 0)))
              (UNLESS (ZEROP ALPHA)
                (LET ((START-X (MAX START (1+ LAST-X))) (END-X (MIN END X)))
                  (MAXF X-MAX END-X)
                  (LOOP FOR IX FROM START-X BELOW END-X
                        DO (FUNCALL FUNCTION IX Y ALPHA))))))
          (WHEN (>= X END) (RETURN (VALUES X-MIN X-MAX)))
          (INCF COVER
                (#S(FORMGREP:SYMREF :NAME "CELL-COVER" :QUALIFIER "AA") CELL))
          (LET ((ALPHA
                 (#S(FORMGREP:SYMREF :NAME "COMPUTE-ALPHA" :QUALIFIER "AA")
                  COVER
                  (#S(FORMGREP:SYMREF :NAME "CELL-AREA" :QUALIFIER "AA")
                   CELL))))
            (UNLESS (ZEROP ALPHA) (FUNCALL FUNCTION X Y ALPHA)))
          (SETF LAST-X X)))
      (VALUES X-MIN X-MAX)))

[mcclim/Lisp-Dep/mp-acl.lisp:86]
  (DEFMACRO ATOMIC-INCF (PLACE)
    (ECLECTOR.READER:QUASIQUOTE
     (LOCALLY
      (DECLARE (OPTIMIZE (SAFETY 1) (SPEED 3)))
      (#S(FORMGREP:SYMREF :NAME "ATOMICALLY" :QUALIFIER "EXCL")
       (INCF (THE FIXNUM (ECLECTOR.READER:UNQUOTE PLACE)))))))

[mcclim/Lisp-Dep/mp-acl.lisp:90]
  (DEFMACRO ATOMIC-DECF (PLACE)
    (ECLECTOR.READER:QUASIQUOTE
     (LOCALLY
      (DECLARE (OPTIMIZE (SAFETY 1) (SPEED 3)))
      (#S(FORMGREP:SYMREF :NAME "ATOMICALLY" :QUALIFIER "EXCL")
       (DECF (THE FIXNUM (ECLECTOR.READER:UNQUOTE PLACE)))))))

[mcclim/Lisp-Dep/mp-lw.lisp:87]
  (DEFMACRO ATOMIC-INCF (PLACE)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (ECLECTOR.READER:QUASIQUOTE
     (#S(FORMGREP:SYMREF :NAME "WITHOUT-INTERRUPTS" :QUALIFIER "MP")
      (INCF (THE FIXNUM (ECLECTOR.READER:UNQUOTE PLACE))))))

[mcclim/Lisp-Dep/mp-lw.lisp:91]
  (DEFMACRO ATOMIC-DECF (PLACE)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (ECLECTOR.READER:QUASIQUOTE
     (#S(FORMGREP:SYMREF :NAME "WITHOUT-INTERRUPTS" :QUALIFIER "MP")
      (DECF (THE FIXNUM (ECLECTOR.READER:UNQUOTE PLACE))))))

[mcclim/Lisp-Dep/mp-sbcl.lisp:122]
  (DEFUN YIELD ()
    (DECLARE (OPTIMIZE SPEED (SAFETY 0)))
    (ALIEN-FUNCALL (EXTERN-ALIEN "sched_yield" #'INT))
    (VALUES))

[mcclim/Tools/clim-doc-convert.lisp:13]
  (DECLAIM (OPTIMIZE (SAFETY 3)))

[mcclim/Tools/clim-doc-convert.lisp:555]
  (DEFUN MAP-OVER-STRING (FUN STR)
    (ASSERT (TYPEP STR 'SIMPLE-STRING))
    (LOCALLY
     (DECLARE (TYPE SIMPLE-STRING STR)
              (OPTIMIZE (SPEED 3) (SAFETY 1)))
     (LET ((N (LENGTH STR)))
       (DECLARE (TYPE FIXNUM N))
       (DO ((I 0 (THE FIXNUM (+ I 1))))
           ((>= I N))
         (DECLARE (TYPE FIXNUM I))
         (LET ((C (SCHAR STR I)))
           (COND
            ((CHAR= C +UCS-ESCAPE+)
             (LET ((C
                    (PARSE-INTEGER STR :START (+ I 1) :END (+ I 5)
                                   :JUNK-ALLOWED NIL :RADIX 16)))
               (INCF I 4)
               (FUNCALL FUN C)))
            (T (FUNCALL FUN C))))))))

[mcclim/Tools/clim-doc-convert.lisp:819]
  (DEFUN DUMP-STRING (STR SINK)
    (DECLARE (OPTIMIZE (SAFETY 3)))
    (MAP-OVER-STRING
     (LAMBDA (C &AUX TR)
       (WHEN (CHARACTERP C) (SETQ C (CHAR-CODE C)))
       (COND ((= C NIL) (PRINC "&amp;" SINK)) ((= C NIL) (PRINC "&lt;" SINK))
             ((= C NIL) (PRINC "&gt;" SINK)) ((= C NIL) (PRINC "&nbsp;" SINK))
             ((<= 32 C 126) (WRITE-CHAR (CODE-CHAR C) SINK))
             ((AND *ASCII-TRANSLATE-P*
                   (SETQ TR (GETHASH C *ASCII-TRANSLATION*)))
              (DUMP-STRING TR SINK))
             (T (FORMAT SINK "&#~D;" C))))
     STR))

[md5/md5.lisp:138]
  (DEFUN F (X Y Z)
    (DECLARE (TYPE UB32 X Y Z)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0) (FLOAT 0)))
    (#S(FORMGREP:SYMREF :NAME "32BIT-LOGICAL-OR" :QUALIFIER "KERNEL")
     (#S(FORMGREP:SYMREF :NAME "32BIT-LOGICAL-AND" :QUALIFIER "KERNEL") X Y)
     (#S(FORMGREP:SYMREF :NAME "32BIT-LOGICAL-ANDC1" :QUALIFIER "KERNEL") X Z))
    (#S(FORMGREP:SYMREF :NAME "INT32-LOGIOR" :QUALIFIER "SYS")
     (#S(FORMGREP:SYMREF :NAME "INT32-LOGAND" :QUALIFIER "SYS") X Y)
     (#S(FORMGREP:SYMREF :NAME "INT32-LOGANDC1" :QUALIFIER "SYS") X Z)))

[md5/md5.lisp:149]
  (DEFUN G (X Y Z)
    (DECLARE (TYPE UB32 X Y Z)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0) (FLOAT 0)))
    (#S(FORMGREP:SYMREF :NAME "32BIT-LOGICAL-OR" :QUALIFIER "KERNEL")
     (#S(FORMGREP:SYMREF :NAME "32BIT-LOGICAL-AND" :QUALIFIER "KERNEL") X Z)
     (#S(FORMGREP:SYMREF :NAME "32BIT-LOGICAL-ANDC2" :QUALIFIER "KERNEL") Y Z))
    (#S(FORMGREP:SYMREF :NAME "INT32-LOGIOR" :QUALIFIER "SYS")
     (#S(FORMGREP:SYMREF :NAME "INT32-LOGAND" :QUALIFIER "SYS") X Z)
     (#S(FORMGREP:SYMREF :NAME "INT32-LOGANDC2" :QUALIFIER "SYS") Y Z)))

[md5/md5.lisp:160]
  (DEFUN H (X Y Z)
    (DECLARE (TYPE UB32 X Y Z)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0) (FLOAT 0)))
    (#S(FORMGREP:SYMREF :NAME "32BIT-LOGICAL-XOR" :QUALIFIER "KERNEL") X
     (#S(FORMGREP:SYMREF :NAME "32BIT-LOGICAL-XOR" :QUALIFIER "KERNEL") Y Z))
    (#S(FORMGREP:SYMREF :NAME "INT32-LOGXOR" :QUALIFIER "SYS") X
     (#S(FORMGREP:SYMREF :NAME "INT32-LOGXOR" :QUALIFIER "SYS") Y Z)))

[md5/md5.lisp:170]
  (DEFUN I (X Y Z)
    (DECLARE (TYPE UB32 X Y Z)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0) (FLOAT 0)))
    (#S(FORMGREP:SYMREF :NAME "32BIT-LOGICAL-XOR" :QUALIFIER "KERNEL") Y
     (#S(FORMGREP:SYMREF :NAME "32BIT-LOGICAL-ORC2" :QUALIFIER "KERNEL") X Z))
    (LW-INT32-NO-OVERFLOW
     (#S(FORMGREP:SYMREF :NAME "INT32-LOGXOR" :QUALIFIER "SYS") Y
      (#S(FORMGREP:SYMREF :NAME "INT32-LOGORC2" :QUALIFIER "SYS") X Z))))

[md5/md5.lisp:182]
  (DEFUN MOD32+ (A B)
    (DECLARE (TYPE UB32 A B)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0) (FLOAT 0)))
    (LW-INT32-NO-OVERFLOW
     (#S(FORMGREP:SYMREF :NAME "INT32+" :QUALIFIER "SYS") A B)))

[md5/md5.lisp:204]
  (DEFUN INT32>>LOGICAL (A S)
    (DECLARE (TYPE UB32 A)
             (TYPE (UNSIGNED-BYTE 5) S)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0) (FLOAT 0)))
    (IF (#S(FORMGREP:SYMREF :NAME "INT32-MINUSP" :QUALIFIER "SYS") A)
        (#S(FORMGREP:SYMREF :NAME "INT32-LOGANDC2" :QUALIFIER "SYS")
         (#S(FORMGREP:SYMREF :NAME "INT32>>" :QUALIFIER "SYS") A S)
         (#S(FORMGREP:SYMREF :NAME "INT32<<" :QUALIFIER "SYS") -1 (- 32 S)))
        (#S(FORMGREP:SYMREF :NAME "INT32>>" :QUALIFIER "SYS") A S)))

[md5/md5.lisp:213]
  (DEFUN ROL32 (A S)
    (DECLARE (TYPE UB32 A)
             (TYPE (UNSIGNED-BYTE 5) S)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0) (FLOAT 0)))
    (#S(FORMGREP:SYMREF :NAME "32BIT-LOGICAL-OR" :QUALIFIER "KERNEL")
     (#S(FORMGREP:SYMREF :NAME "SHIFT-TOWARDS-END" :QUALIFIER "KERNEL") A S)
     (#S(FORMGREP:SYMREF :NAME "SHIFT-TOWARDS-START" :QUALIFIER "KERNEL") A S)
     (ASH A (- S 32)))
    (SB-ROTATE-BYTE:ROTATE-BYTE S (BYTE 32 0) A)
    (#S(FORMGREP:SYMREF :NAME "INT32-LOGIOR" :QUALIFIER "SYS")
     (LW-INT32-NO-OVERFLOW
      (#S(FORMGREP:SYMREF :NAME "INT32<<" :QUALIFIER "SYS") A S))
     (INT32>>LOGICAL A (- 32 S))))

[md5/md5.lisp:300]
  (DEFUN INITIAL-MD5-REGS ()
    "Create the initial working state of an MD5 run."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0) (FLOAT 0)))
    (LET ((REGS (MAKE-UB32-VECTOR 4)))
      (DECLARE (TYPE MD5-REGS REGS))
      (SETF (MD5-REGS-A REGS) +MD5-MAGIC-A+
            (MD5-REGS-B REGS) +MD5-MAGIC-B+
            (MD5-REGS-C REGS) +MD5-MAGIC-C+
            (MD5-REGS-D REGS) +MD5-MAGIC-D+)
      REGS))

[md5/md5.lisp:317]
  (DEFUN UPDATE-MD5-BLOCK (REGS BLOCK)
    "This is the core part of the MD5 algorithm.  It takes a complete 16
word block of input, and updates the working state in A, B, C, and D
accordingly."
    (DECLARE (TYPE MD5-REGS REGS)
             (TYPE MD5-BLOCK BLOCK)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0) (FLOAT 0)))
    (LET ((A (MD5-REGS-A REGS))
          (B (MD5-REGS-B REGS))
          (C (MD5-REGS-C REGS))
          (D (MD5-REGS-D REGS)))
      (DECLARE (TYPE UB32 A B C D))
      (WITH-MD5-ROUND (F BLOCK) (A B C D 0 7 1) (D A B C 1 12 2)
       (C D A B 2 17 3) (B C D A 3 22 4) (A B C D 4 7 5) (D A B C 5 12 6)
       (C D A B 6 17 7) (B C D A 7 22 8) (A B C D 8 7 9) (D A B C 9 12 10)
       (C D A B 10 17 11) (B C D A 11 22 12) (A B C D 12 7 13)
       (D A B C 13 12 14) (C D A B 14 17 15) (B C D A 15 22 16))
      (WITH-MD5-ROUND (G BLOCK) (A B C D 1 5 17) (D A B C 6 9 18)
       (C D A B 11 14 19) (B C D A 0 20 20) (A B C D 5 5 21) (D A B C 10 9 22)
       (C D A B 15 14 23) (B C D A 4 20 24) (A B C D 9 5 25) (D A B C 14 9 26)
       (C D A B 3 14 27) (B C D A 8 20 28) (A B C D 13 5 29) (D A B C 2 9 30)
       (C D A B 7 14 31) (B C D A 12 20 32))
      (WITH-MD5-ROUND (H BLOCK) (A B C D 5 4 33) (D A B C 8 11 34)
       (C D A B 11 16 35) (B C D A 14 23 36) (A B C D 1 4 37) (D A B C 4 11 38)
       (C D A B 7 16 39) (B C D A 10 23 40) (A B C D 13 4 41) (D A B C 0 11 42)
       (C D A B 3 16 43) (B C D A 6 23 44) (A B C D 9 4 45) (D A B C 12 11 46)
       (C D A B 15 16 47) (B C D A 2 23 48))
      (WITH-MD5-ROUND (I BLOCK) (A B C D 0 6 49) (D A B C 7 10 50)
       (C D A B 14 15 51) (B C D A 5 21 52) (A B C D 12 6 53) (D A B C 3 10 54)
       (C D A B 10 15 55) (B C D A 1 21 56) (A B C D 8 6 57) (D A B C 15 10 58)
       (C D A B 6 15 59) (B C D A 13 21 60) (A B C D 4 6 61) (D A B C 11 10 62)
       (C D A B 2 15 63) (B C D A 9 21 64))
      (SETF (MD5-REGS-A REGS) (MOD32+ (MD5-REGS-A REGS) A)
            (MD5-REGS-B REGS) (MOD32+ (MD5-REGS-B REGS) B)
            (MD5-REGS-C REGS) (MOD32+ (MD5-REGS-C REGS) C)
            (MD5-REGS-D REGS) (MOD32+ (MD5-REGS-D REGS) D))
      REGS))

[md5/md5.lisp:361]
  (DEFUN FILL-BLOCK-UB8 (BLOCK BUFFER OFFSET)
    "Convert a complete 64 (unsigned-byte 8) input vector segment
starting from `offset' into the given 16 word MD5 block."
    (DECLARE (TYPE (INTEGER 0 NIL) OFFSET)
             (TYPE MD5-BLOCK BLOCK)
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) BUFFER)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0) (FLOAT 0)
              (#S(FORMGREP:SYMREF :NAME "FIXNUM-SAFETY" :QUALIFIER "HCL") 0)))
    (#S(FORMGREP:SYMREF :NAME "BIT-BASH-COPY" :QUALIFIER "KERNEL") BUFFER
     (+
      (* #S(FORMGREP:SYMREF :NAME "VECTOR-DATA-OFFSET" :QUALIFIER "VM")
         #S(FORMGREP:SYMREF :NAME "WORD-BITS" :QUALIFIER "VM"))
      (* OFFSET #S(FORMGREP:SYMREF :NAME "BYTE-BITS" :QUALIFIER "VM")))
     BLOCK
     (* #S(FORMGREP:SYMREF :NAME "VECTOR-DATA-OFFSET" :QUALIFIER "VM")
        #S(FORMGREP:SYMREF :NAME "WORD-BITS" :QUALIFIER "VM"))
     (* 64 #S(FORMGREP:SYMREF :NAME "BYTE-BITS" :QUALIFIER "VM")))
    (SB-KERNEL:%BYTE-BLT BUFFER OFFSET BLOCK 0 64))

[md5/md5.lisp:387]
  (DEFUN FILL-BLOCK-CHAR (BLOCK BUFFER OFFSET)
    "DEPRECATED: Convert a complete 64 character input string segment
starting from `offset' into the given 16 word MD5 block."
    (DECLARE (TYPE (INTEGER 0 NIL) OFFSET)
             (TYPE MD5-BLOCK BLOCK)
             (TYPE SIMPLE-STRING BUFFER)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0) (FLOAT 0)
              (#S(FORMGREP:SYMREF :NAME "FIXNUM-SAFETY" :QUALIFIER "HCL") 0)))
    (#S(FORMGREP:SYMREF :NAME "BIT-BASH-COPY" :QUALIFIER "KERNEL") BUFFER
     (+
      (* #S(FORMGREP:SYMREF :NAME "VECTOR-DATA-OFFSET" :QUALIFIER "VM")
         #S(FORMGREP:SYMREF :NAME "WORD-BITS" :QUALIFIER "VM"))
      (* OFFSET #S(FORMGREP:SYMREF :NAME "BYTE-BITS" :QUALIFIER "VM")))
     BLOCK
     (* #S(FORMGREP:SYMREF :NAME "VECTOR-DATA-OFFSET" :QUALIFIER "VM")
        #S(FORMGREP:SYMREF :NAME "WORD-BITS" :QUALIFIER "VM"))
     (* 64 #S(FORMGREP:SYMREF :NAME "BYTE-BITS" :QUALIFIER "VM"))))

[md5/md5.lisp:411]
  (DEFUN FILL-BLOCK (BLOCK BUFFER OFFSET)
    "Convert a complete 64 byte input vector segment into the given 16
word MD5 block.  This currently works on (unsigned-byte 8) and
character simple-arrays, via the functions `fill-block-ub8' and
`fill-block-char' respectively.  Note that it will not work correctly
on character simple-arrays if `char-code-limit' is greater than 256."
    (DECLARE (TYPE (INTEGER 0 NIL) OFFSET)
             (TYPE MD5-BLOCK BLOCK)
             (TYPE (SIMPLE-ARRAY * (*)) BUFFER)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0) (FLOAT 0)
              (#S(FORMGREP:SYMREF :NAME "FIXNUM-SAFETY" :QUALIFIER "HCL") 0)))
    (ETYPECASE BUFFER
      ((SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*))
       (FILL-BLOCK-UB8 BLOCK BUFFER OFFSET))
      (SIMPLE-STRING (FILL-BLOCK-CHAR BLOCK BUFFER OFFSET))))

[md5/md5.lisp:431]
  (DEFUN MD5REGS-DIGEST (REGS)
    "Create the final 16 byte message-digest from the MD5 working state
in `regs'.  Returns a (simple-array (unsigned-byte 8) (16))."
    (DECLARE
     (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0) (FLOAT 0)
      (#S(FORMGREP:SYMREF :NAME "FIXNUM-SAFETY" :QUALIFIER "HCL") 0))
     (TYPE MD5-REGS REGS))
    (LET ((RESULT (MAKE-ARRAY 16 :ELEMENT-TYPE '(UNSIGNED-BYTE 8))))
      (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (16)) RESULT))
      (MACROLET ((FROB (REG OFFSET)
                   (LET ((VAR (GENSYM)))
                     (ECLECTOR.READER:QUASIQUOTE
                      (LET (((ECLECTOR.READER:UNQUOTE VAR)
                             (LDB (BYTE 32 0)
                                  (#S(FORMGREP:SYMREF
                                      :NAME "INT32-TO-INTEGER"
                                      :QUALIFIER "SYS")
                                   (ECLECTOR.READER:UNQUOTE REG)))))
                        (DECLARE
                         (TYPE (UNSIGNED-BYTE 32)
                          (ECLECTOR.READER:UNQUOTE VAR)))
                        (SETF (AREF RESULT (ECLECTOR.READER:UNQUOTE OFFSET))
                                (LDB (BYTE 8 0) (ECLECTOR.READER:UNQUOTE VAR))
                              (AREF RESULT
                                    (ECLECTOR.READER:UNQUOTE (+ OFFSET 1)))
                                (LDB (BYTE 8 8) (ECLECTOR.READER:UNQUOTE VAR))
                              (AREF RESULT
                                    (ECLECTOR.READER:UNQUOTE (+ OFFSET 2)))
                                (LDB (BYTE 8 16) (ECLECTOR.READER:UNQUOTE VAR))
                              (AREF RESULT
                                    (ECLECTOR.READER:UNQUOTE (+ OFFSET 3)))
                                (LDB (BYTE 8 24)
                                     (ECLECTOR.READER:UNQUOTE VAR))))))))
        (FROB (MD5-REGS-A REGS) 0)
        (FROB (MD5-REGS-B REGS) 4)
        (FROB (MD5-REGS-C REGS) 8)
        (FROB (MD5-REGS-D REGS) 12))
      RESULT))

[md5/md5.lisp:457]
  (LOCALLY
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (SPACE 0) (DEBUG 1) (FLOAT 0)))
   (DEFSTRUCT (MD5-STATE (:CONSTRUCTOR MAKE-MD5-STATE NIL) (:COPIER))
     (REGS (INITIAL-MD5-REGS) :TYPE MD5-REGS :READ-ONLY T)
     (AMOUNT 0 :TYPE (UNSIGNED-BYTE 29))
     (BLOCK (MAKE-UB32-VECTOR 16) :READ-ONLY T :TYPE MD5-BLOCK)
     (BUFFER (MAKE-ARRAY 64 :ELEMENT-TYPE '(UNSIGNED-BYTE 8)) :READ-ONLY T
      :TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (64)))
     (BUFFER-INDEX 0 :TYPE (INTEGER 0 63))
     (FINALIZED-P NIL)))

[md5/md5.lisp:475]
  (DEFUN COPY-TO-BUFFER (FROM FROM-OFFSET COUNT BUFFER BUFFER-OFFSET)
    "Copy a partial segment from input vector `from' starting at
`from-offset' and copying `count' elements into the 64 byte buffer
starting at `buffer-offset'."
    (DECLARE
     (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0) (FLOAT 0)
      (#S(FORMGREP:SYMREF :NAME "FIXNUM-SAFETY" :QUALIFIER "HCL") 0))
     (TYPE (UNSIGNED-BYTE 29) FROM-OFFSET)
     (TYPE (INTEGER 0 63) COUNT BUFFER-OFFSET)
     (TYPE (SIMPLE-ARRAY * (*)) FROM)
     (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (64)) BUFFER))
    (#S(FORMGREP:SYMREF :NAME "BIT-BASH-COPY" :QUALIFIER "KERNEL") FROM
     (+
      (* #S(FORMGREP:SYMREF :NAME "VECTOR-DATA-OFFSET" :QUALIFIER "VM")
         #S(FORMGREP:SYMREF :NAME "WORD-BITS" :QUALIFIER "VM"))
      (* FROM-OFFSET #S(FORMGREP:SYMREF :NAME "BYTE-BITS" :QUALIFIER "VM")))
     BUFFER
     (+
      (* #S(FORMGREP:SYMREF :NAME "VECTOR-DATA-OFFSET" :QUALIFIER "VM")
         #S(FORMGREP:SYMREF :NAME "WORD-BITS" :QUALIFIER "VM"))
      (* BUFFER-OFFSET #S(FORMGREP:SYMREF :NAME "BYTE-BITS" :QUALIFIER "VM")))
     (* COUNT #S(FORMGREP:SYMREF :NAME "BYTE-BITS" :QUALIFIER "VM")))
    (SB-KERNEL:UB8-BASH-COPY FROM FROM-OFFSET BUFFER BUFFER-OFFSET COUNT))

[md5/md5.lisp:511]
  (DEFUN UPDATE-MD5-STATE
         (STATE SEQUENCE &KEY (START 0) (END (LENGTH SEQUENCE)))
    "Update the given md5-state from `sequence', which is either a
simple-string or a simple-array with element-type (unsigned-byte 8),
bounded by `start' and `end', which must be numeric bounding-indices.
Note that usage on simple-strings is DEPRECATED, since this will not
work correctly if `char-code-limit' is more than 256.  String input
should be converted to (unsigned-byte 8) simple-arrays with
external-format conversion routines beforehand."
    (DECLARE (TYPE MD5-STATE STATE)
             (TYPE (SIMPLE-ARRAY * (*)) SEQUENCE)
             (TYPE FIXNUM START END)
             (OPTIMIZE (SPEED 3) (SAFETY 1) (SPACE 0) (DEBUG 1) (FLOAT 0)
              (#S(FORMGREP:SYMREF :NAME "FIXNUM-SAFETY" :QUALIFIER "HCL") 0)))
    (LOCALLY
     (DECLARE (OPTIMIZE (SAFETY 0) (DEBUG 0)))
     (LET ((REGS (MD5-STATE-REGS STATE))
           (BLOCK (MD5-STATE-BLOCK STATE))
           (BUFFER (MD5-STATE-BUFFER STATE))
           (BUFFER-INDEX (MD5-STATE-BUFFER-INDEX STATE))
           (LENGTH (- END START)))
       (DECLARE (TYPE MD5-REGS REGS)
                (TYPE FIXNUM LENGTH)
                (TYPE (INTEGER 0 63) BUFFER-INDEX)
                (TYPE MD5-BLOCK BLOCK)
                (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (64)) BUFFER))
       (UNLESS (ZEROP BUFFER-INDEX)
         (LET ((AMOUNT (MIN (- 64 BUFFER-INDEX) LENGTH)))
           (DECLARE (TYPE (INTEGER 0 63) AMOUNT))
           (COPY-TO-BUFFER SEQUENCE START AMOUNT BUFFER BUFFER-INDEX)
           (SETQ START (THE FIXNUM (+ START AMOUNT)))
           (LET ((NEW-INDEX (+ BUFFER-INDEX AMOUNT)))
             (WHEN (= NEW-INDEX 64)
               (FILL-BLOCK-UB8 BLOCK BUFFER 0)
               (UPDATE-MD5-BLOCK REGS BLOCK)
               (SETQ NEW-INDEX 0))
             (WHEN (>= START END)
               (SETF (MD5-STATE-BUFFER-INDEX STATE) NEW-INDEX
                     (MD5-STATE-AMOUNT STATE)
                       (THE (UNSIGNED-BYTE 29)
                            (+ (MD5-STATE-AMOUNT STATE) LENGTH)))
               (RETURN-FROM UPDATE-MD5-STATE STATE)))))
       (ETYPECASE SEQUENCE
         ((SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*))
          (LOCALLY
           (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) SEQUENCE))
           (LOOP FOR OFFSET OF-TYPE (UNSIGNED-BYTE 29) FROM START BELOW
                 END BY 64
                 UNTIL (< (- END OFFSET) 64)
                 DO (FILL-BLOCK-UB8 BLOCK SEQUENCE OFFSET) (UPDATE-MD5-BLOCK
                                                            REGS BLOCK)
                 FINALLY (LET ((AMOUNT (- END OFFSET)))
                           (UNLESS (ZEROP AMOUNT)
                             (COPY-TO-BUFFER SEQUENCE OFFSET AMOUNT BUFFER 0))
                           (SETF (MD5-STATE-BUFFER-INDEX STATE) AMOUNT)))))
         (SIMPLE-STRING
          (LOCALLY
           (DECLARE (TYPE SIMPLE-STRING SEQUENCE))
           (LOOP FOR OFFSET OF-TYPE (UNSIGNED-BYTE 29) FROM START BELOW
                 END BY 64
                 UNTIL (< (- END OFFSET) 64)
                 DO (FILL-BLOCK-CHAR BLOCK SEQUENCE OFFSET) (UPDATE-MD5-BLOCK
                                                             REGS BLOCK)
                 FINALLY (LET ((AMOUNT (- END OFFSET)))
                           (UNLESS (ZEROP AMOUNT)
                             (COPY-TO-BUFFER SEQUENCE OFFSET AMOUNT BUFFER 0))
                           (SETF (MD5-STATE-BUFFER-INDEX STATE) AMOUNT))))))
       (SETF (MD5-STATE-AMOUNT STATE)
               (THE (UNSIGNED-BYTE 29) (+ (MD5-STATE-AMOUNT STATE) LENGTH)))
       STATE)))

[md5/md5.lisp:587]
  (DEFUN FINALIZE-MD5-STATE (STATE)
    "If the given md5-state has not already been finalized, finalize it,
by processing any remaining input in its buffer, with suitable padding
and appended bit-length, as specified by the MD5 standard.

The resulting MD5 message-digest is returned as an array of sixteen
(unsigned-byte 8) values.  Calling `update-md5-state' after a call to
`finalize-md5-state' results in unspecified behaviour."
    (DECLARE (TYPE MD5-STATE STATE)
             (OPTIMIZE (SPEED 3) (SAFETY 1) (SPACE 0) (DEBUG 1) (FLOAT 0)))
    (LOCALLY
     (DECLARE (OPTIMIZE (SAFETY 0) (DEBUG 0)))
     (OR (MD5-STATE-FINALIZED-P STATE)
         (LET ((REGS (MD5-STATE-REGS STATE))
               (BLOCK (MD5-STATE-BLOCK STATE))
               (BUFFER (MD5-STATE-BUFFER STATE))
               (BUFFER-INDEX (MD5-STATE-BUFFER-INDEX STATE))
               (TOTAL-LENGTH (* 8 (MD5-STATE-AMOUNT STATE))))
           (DECLARE (TYPE MD5-REGS REGS)
                    (TYPE (INTEGER 0 63) BUFFER-INDEX)
                    (TYPE MD5-BLOCK BLOCK)
                    (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) BUFFER))
           (SETF (AREF BUFFER BUFFER-INDEX) 128)
           (LOOP FOR INDEX OF-TYPE (INTEGER 0 64) FROM (1+
                                                        BUFFER-INDEX) BELOW 64
                 DO (SETF (AREF BUFFER INDEX) 0))
           (FILL-BLOCK-UB8 BLOCK BUFFER 0)
           (WHEN (>= BUFFER-INDEX 56)
             (UPDATE-MD5-BLOCK REGS BLOCK)
             (LOOP FOR INDEX OF-TYPE (INTEGER 0 16) FROM 0 BELOW 16
                   DO (SETF (UB32-AREF BLOCK INDEX) 0)))
           (SETF (UB32-AREF BLOCK 14) (LDB (BYTE 32 0) TOTAL-LENGTH))
           (UPDATE-MD5-BLOCK REGS BLOCK)
           (SETF (MD5-STATE-FINALIZED-P STATE) (MD5REGS-DIGEST REGS))))))

[md5/md5.lisp:634]
  (DEFUN MD5SUM-SEQUENCE (SEQUENCE &KEY (START 0) END)
    "Calculate the MD5 message-digest of data in `sequence', which should
be a 1d simple-array with element type (unsigned-byte 8).  On CMU CL
and SBCL non-simple and non-1d arrays with this element-type are also
supported.  Use with strings is DEPRECATED, since this will not work
correctly on implementations with `char-code-limit' > 256 and ignores
character-coding issues.  Use md5sum-string instead, or convert to the
required (unsigned-byte 8) format through other means before-hand."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 3) (SPACE 0) (DEBUG 1))
             (TYPE VECTOR SEQUENCE)
             (TYPE FIXNUM START))
    (LOCALLY
     (DECLARE (OPTIMIZE (SAFETY 1) (DEBUG 0)))
     (LET ((STATE (MAKE-MD5-STATE)))
       (DECLARE (TYPE MD5-STATE STATE))
       (LET ((END (OR END (LENGTH SEQUENCE))))
         (#S(FORMGREP:SYMREF :NAME "WITH-ARRAY-DATA" :QUALIFIER "LISP")
          ((DATA SEQUENCE) (REAL-START START) (REAL-END END))
          (DECLARE (IGNORE REAL-END))
          (UPDATE-MD5-STATE STATE DATA :START REAL-START :END
           (+ REAL-START (- END START)))))
       (LET ((END (OR END (LENGTH SEQUENCE))))
         (SB-KERNEL:WITH-ARRAY-DATA ((DATA SEQUENCE) (REAL-START START)
                                     (REAL-END END) :CHECK-FILL-POINTER T)
           (DECLARE (IGNORE REAL-END))
           (UPDATE-MD5-STATE STATE DATA :START REAL-START :END
            (+ REAL-START (- END START)))))
       (FINALIZE-MD5-STATE STATE))))

[md5/md5.lisp:669]
  (DEFUN MD5SUM-STRING (STRING &KEY (EXTERNAL-FORMAT :DEFAULT) (START 0) END)
    "Calculate the MD5 message-digest of the binary representation of
`string' (as octets) in the external format specified by
`external-format'. The boundaries `start' and `end' refer to character
positions in the string, not to octets in the resulting binary
representation.  The permissible external format specifiers are
determined by the underlying implementation."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 3) (SPACE 0) (DEBUG 1))
             (TYPE STRING STRING)
             (TYPE FIXNUM START)
             (IGNORABLE EXTERNAL-FORMAT))
    (LOCALLY
     (DECLARE (OPTIMIZE (SAFETY 1) (DEBUG 0)))
     (MD5SUM-SEQUENCE
      (#S(FORMGREP:SYMREF :NAME "STRING-TO-OCTETS" :QUALIFIER "STREAM") STRING
       :EXTERNAL-FORMAT EXTERNAL-FORMAT :START START :END END))
     (MD5SUM-SEQUENCE
      (STRING-TO-OCTETS STRING :EXTERNAL-FORMAT EXTERNAL-FORMAT :START START
                        :END END))
     (LET ((EXTERNAL-FORMAT
            (#S(FORMGREP:SYMREF :NAME "MERGE-EF-SPECS" :QUALIFIER "SYSTEM")
             EXTERNAL-FORMAT :UTF-8)))
       (IF (EQUAL
            (#S(FORMGREP:SYMREF
                :NAME "EXTERNAL-FORMAT-FOREIGN-TYPE"
                :QUALIFIER "EXTERNAL-FORMAT")
             EXTERNAL-FORMAT)
            '(UNSIGNED-BYTE 8))
           (MD5SUM-SEQUENCE
            (COERCE
             (#S(FORMGREP:SYMREF
                 :NAME "ENCODE-LISP-STRING"
                 :QUALIFIER "EXTERNAL-FORMAT")
              STRING EXTERNAL-FORMAT :START START :END END)
             '(SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*))))
           (ERROR "External Format ~S does not yield (unsigned-byte 8) vector!"
                  EXTERNAL-FORMAT)))
     (MD5SUM-SEQUENCE
      (#S(FORMGREP:SYMREF :NAME "ENCODE-STRING-TO-OCTETS" :QUALIFIER "CCL")
       STRING :EXTERNAL-FORMAT EXTERNAL-FORMAT :START START :END END))
     (MD5SUM-SEQUENCE
      (#S(FORMGREP:SYMREF :NAME "STRING-TO-OCTETS" :QUALIFIER "EXCL") STRING
       :EXTERNAL-FORMAT EXTERNAL-FORMAT :NULL-TERMINATE NIL :START START :END
       END))))

[md5/md5.lisp:726]
  (DEFUN MD5SUM-STREAM (STREAM)
    "Calculate an MD5 message-digest of the contents of `stream'.  Its
element-type has to be (unsigned-byte 8). Use on character streams is
DEPRECATED, as this will not work correctly on implementations with
`char-code-limit' > 256 and ignores character coding issues."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 3) (SPACE 0) (DEBUG 1)))
    (LOCALLY
     (DECLARE (OPTIMIZE (SAFETY 1) (DEBUG 0)))
     (LET ((STATE (MAKE-MD5-STATE)))
       (DECLARE (TYPE MD5-STATE STATE))
       (COND
        ((EQUAL (STREAM-ELEMENT-TYPE STREAM) '(UNSIGNED-BYTE 8))
         (LET ((BUFFER
                (MAKE-ARRAY +BUFFER-SIZE+ :ELEMENT-TYPE '(UNSIGNED-BYTE 8))))
           (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (NIL)) BUFFER))
           (LOOP FOR BYTES OF-TYPE BUFFER-INDEX = (READ-SEQUENCE BUFFER STREAM)
                 DO (UPDATE-MD5-STATE STATE BUFFER :END BYTES)
                 UNTIL (< BYTES +BUFFER-SIZE+)
                 FINALLY (RETURN (FINALIZE-MD5-STATE STATE)))))
        ((EQUAL (STREAM-ELEMENT-TYPE STREAM) 'CHARACTER)
         (LET ((BUFFER (MAKE-STRING +BUFFER-SIZE+)))
           (DECLARE (TYPE (SIMPLE-STRING NIL) BUFFER))
           (LOOP FOR BYTES OF-TYPE BUFFER-INDEX = (READ-SEQUENCE BUFFER STREAM)
                 DO (UPDATE-MD5-STATE STATE BUFFER :END BYTES)
                 UNTIL (< BYTES +BUFFER-SIZE+)
                 FINALLY (RETURN (FINALIZE-MD5-STATE STATE)))))
        (T
         (ERROR "Unsupported stream element-type ~S for stream ~S."
                (STREAM-ELEMENT-TYPE STREAM) STREAM))))))

[md5/md5.lisp:759]
  (DEFUN MD5SUM-FILE (PATHNAME)
    "Calculate the MD5 message-digest of the file specified by `pathname'."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 3) (SPACE 0) (DEBUG 1)))
    (WITH-OPEN-FILE (STREAM PATHNAME :ELEMENT-TYPE '(UNSIGNED-BYTE 8))
      (MD5SUM-STREAM STREAM)))

[metabang-bind/unit-tests/test-bind.lisp:229]
  (DEFUN X (C)
    (BIND (((:STRUCTURE/RW C- A B) C)) (DECLARE (FIXNUM A B))
     (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))) (+ A B)))

[metatilities-base/dev/l0-utils.lisp:169]
  (DEFUN NEARLY-ZERO-P (X &OPTIONAL (THRESHOLD 1.0e-4))
    "Returns true if `x` is within threshold of 0d0."
    (DECLARE (OPTIMIZE (SPEED 3) (SPACE 3) (DEBUG 0) (SAFETY 0))
             (DYNAMIC-EXTENT X THRESHOLD))
    (IF (< 0.0 X)
        (> THRESHOLD X)
        (> X THRESHOLD)))

[metatilities-base/dev/l0-utils.lisp:186]
  (DEFUN NEARLY-EQUAL-P (X Y THRESHOLD)
    "Returns true if x and y are within threshold of each other."
    (DECLARE (OPTIMIZE (SPEED 3) (SPACE 3) (DEBUG 0) (SAFETY 0))
             (DYNAMIC-EXTENT X Y THRESHOLD)
             (TYPE DOUBLE-FLOAT X Y THRESHOLD))
    (LET ((TEMP 0.0d0))
      (DECLARE (TYPE DOUBLE-FLOAT TEMP)
               (DYNAMIC-EXTENT TEMP))
      (COND ((> X Y) (SETF TEMP (THE DOUBLE-FLOAT (- X Y))) (< TEMP THRESHOLD))
            (T (SETF TEMP (THE DOUBLE-FLOAT (- Y X))) (< TEMP THRESHOLD)))))

[metatilities/dev/utilities/make-allocatable.lisp:98]
  (DEFMACRO MAKE-ALLOCATABLE
            (TYPE CLASS?
             &KEY INTERNAL-POINTER CREATION-FORM (INITIAL-ARRAY-SIZE 100)
             INIT-FORMS INIT-ARGS (ITEM-VAR (GENSYM "ITEM-")) (EXPORT? NIL))
    "Defines functions to make explicit storage management for particular objects
easier.  The required arguments are the name of the type and a boolean, telling
whether it is a class or structure.  For example, suppose your type is a
structure is named `foo,' and it was defined by a simple use of `defstruct,' so
that the creation-form is `make-foo' (see CLtL, 1st ed., pg. 311).  Class
instances work the same way.  This macro defines the following four things:

[Function] ALLOCATE-FOO &rest init-args
     called when you want a foo to use.  It either returns one you previously
freed or a newly-consed one.  `Init-args' are the formal parameters to the
allocate function.  They are defined by you, the user of `make-allocatable,' and
are only referenced by `init-forms' which are also defined by you.  The
`init-forms,' which is just a list of pieces of code, may also refer to the
allocated structure, which is bound to the symbol `item-var,' which is also
defined by you.  By default, both are nil, so `allocate-foo' just returns what
`make-foo' returns---an empty object.  Actually, when objects are allocated and
freed, their slots are not cleared, so the object may contain stuff left over
from previous uses.  However, if the `internal-pointer' feature is used, the
`internal-pointer' place will be set to nil.  The following illustrates most of
these features.

      (defstruct node
         name
         neighbors)

      (make-allocatable node nil
        :item-var new-node
        :internal-pointer node-neighbors
        :init-args (new-name)
        :init-forms ((setf (node-name new-node) new-name)))

      (defun allocate-a-bunch-of-nodes ()
         (dotimes (i 100)
             (allocate-node (format nil \"node-~d\" i))))

[Function] FREE-FOO x
     called when you are done using `x,' which should be an object of type
`foo.'

[Macro] WITH-FOO (foo &rest args) &body forms
     A macro that executes `forms' with symbol `foo' bound to a temporary
structure of type `foo.' Like an `allocate-foo' followed by `forms' followed by
`free-foo.' `Args' are init-args for `allocate-foo.'

[Function] CLEAR-FOO
     called if you want to clear the memory-management data-structures.  This
can be dangerous; don't use it unless you know what you're doing.

The preceding not only documents the four things defined by `make-allocatable,'
but also, by example, documents the naming scheme.

There are two data structures by which the freed structures can be stored: a
vector or an `internal-pointer' list.  The vector data structure is obvious, but
internal pointer lists may be unfamiliar.  Think back to the days when you coded
in Pascal or C.  If you wanted a list of structures, you didn't use cons cells,
you used a dedicated slot, usually called `next,' or some such.  Well, when
you've freed a structure, chances are there will be a slot that the allocatable
data structures can use as the ``next'' slot.  You tell it what slot to use by
giving the setfable accessor name, such as `foo-bar' if our `foo' structure has
a `bar' slot and the default conc-name.  The internal-pointer list has zero
storage overhead per freed structure, while the vector needs one element per
freed structure, with some additional for expansion.  Therefore, the
internal-pointer list is superior and should be used whenever possible.  (I
believe it would only be impossible if all slots have type constraints that are
incompatible with pointing to a structure of the same kind.) Should you decide
to use the vector data structure, the `initial-array-size' argument gives the
initial size of the vector.  The default is 100 elements.  The vector is grown
if it overflows during freeing a structure; obviously, this may take some time.

Finally, there is the function `utils:allocation-status,' which tells about the
memory management for each kind of structure that has been made allocatable.

This memory management also works for CLOS instances.  The difference is that
ALLOCATE-FOO function takes keyword arguments like `make-instance' and you may
not specify `init-forms,' since you should define an :after initialize-instance
method instead.  Therefore, this restriction gives up almost nothing."
    (LET* ((TYPE-NAME (STRING-UPCASE (STRING TYPE)))
           (VAR (FORM-SYMBOL "*FREE-" TYPE-NAME "*"))
           (COUNT-VAR (FORM-SYMBOL "*" TYPE-NAME "S-ALLOCATED*"))
           (ACTIV-VAR (FORM-SYMBOL "*TOTAL-" TYPE-NAME "-ACTIVITY*"))
           (FREE-LEN (FORM-SYMBOL "*N-FREE-" TYPE-NAME "*"))
           (ALLOC-FN* (FORM-SYMBOL "ALLOCATE-" TYPE-NAME "*"))
           (ALLOC-FN (FORM-SYMBOL "ALLOCATE-" TYPE-NAME))
           (FREE-FN (FORM-SYMBOL "FREE-" TYPE-NAME))
           (CLEAR-FN (FORM-SYMBOL "CLEAR-" TYPE-NAME))
           (WITH-FN (FORM-SYMBOL "WITH-" TYPE-NAME))
           (WITHS-FN (FORM-SYMBOL "WITH-" TYPE-NAME "S")))
      (WHEN (AND CLASS? (OR INIT-FORMS INIT-ARGS))
        (CERROR "ignore them"
                "For classes, init-forms and init-args shouldn't be used.")
        (SETF INIT-FORMS NIL
              INIT-ARGS NIL))
      (ECLECTOR.READER:QUASIQUOTE
       (PROGN
        (PUSHNEW '(ECLECTOR.READER:UNQUOTE TYPE) *ALLOCATED-TYPES*)
        (SETF (GET '(ECLECTOR.READER:UNQUOTE TYPE) :ALLOC-INFO)
                (MAKE-ALLOC-INFO '(ECLECTOR.READER:UNQUOTE COUNT-VAR)
                 '(ECLECTOR.READER:UNQUOTE ACTIV-VAR)
                 '(ECLECTOR.READER:UNQUOTE FREE-LEN)
                 '(ECLECTOR.READER:UNQUOTE ALLOC-FN)
                 '(ECLECTOR.READER:UNQUOTE ALLOC-FN*)
                 '(ECLECTOR.READER:UNQUOTE FREE-FN)))
        (DEFVAR (ECLECTOR.READER:UNQUOTE VAR)
          (ECLECTOR.READER:UNQUOTE
           (IF INTERNAL-POINTER
               NIL
               (ECLECTOR.READER:QUASIQUOTE
                (MAKE-ARRAY (ECLECTOR.READER:UNQUOTE INITIAL-ARRAY-SIZE)
                            :FILL-POINTER 0 :ADJUSTABLE T)))))
        (DEFVAR (ECLECTOR.READER:UNQUOTE COUNT-VAR) 0)
        (DEFVAR (ECLECTOR.READER:UNQUOTE ACTIV-VAR) 0)
        (DEFVAR (ECLECTOR.READER:UNQUOTE FREE-LEN) 0)
        (DEFUN (ECLECTOR.READER:UNQUOTE FREE-FN) (ARG)
          (ECLECTOR.READER:UNQUOTE
           (FORMAT NIL "Stores an object of type ~s for later re-use.  See ~s"
                   TYPE ALLOC-FN))
          (DECLARE (OPTIMIZE SPEED (SAFETY 0)))
          (DECF (ECLECTOR.READER:UNQUOTE COUNT-VAR))
          (INCF (ECLECTOR.READER:UNQUOTE FREE-LEN))
          (ECLECTOR.READER:UNQUOTE-SPLICING
           (IF INTERNAL-POINTER
               (ECLECTOR.READER:QUASIQUOTE
                ((PROGN
                  (SETF ((ECLECTOR.READER:UNQUOTE INTERNAL-POINTER) ARG)
                          (ECLECTOR.READER:UNQUOTE VAR))
                  (SETF (ECLECTOR.READER:UNQUOTE VAR) ARG))))
               (ECLECTOR.READER:QUASIQUOTE
                ((VECTOR-PUSH-EXTEND ARG (ECLECTOR.READER:UNQUOTE VAR))))))
          NIL)
        (PROCLAIM '(INLINE (ECLECTOR.READER:UNQUOTE ALLOC-FN*)))
        (DEFUN (ECLECTOR.READER:UNQUOTE ALLOC-FN*) (&REST INITARGS)
          (ECLECTOR.READER:UNQUOTE
           (FORMAT NIL "Allocates an empty object of type ~s.  Use ~s instead."
                   TYPE ALLOC-FN))
          (DECLARE (OPTIMIZE SPEED (SAFETY 0))
                   (ECLECTOR.READER:UNQUOTE-SPLICING
                    (WHEN (NOT CLASS?) (QUOTE ((IGNORE INITARGS))))))
          (INCF (ECLECTOR.READER:UNQUOTE COUNT-VAR))
          (INCF (ECLECTOR.READER:UNQUOTE ACTIV-VAR))
          (IF (= (ECLECTOR.READER:UNQUOTE FREE-LEN) 0)
              (ECLECTOR.READER:UNQUOTE
               (OR CREATION-FORM
                   (IF CLASS?
                       (ECLECTOR.READER:QUASIQUOTE
                        (APPLY #'MAKE-INSTANCE '(ECLECTOR.READER:UNQUOTE TYPE)
                               INITARGS))
                       (ECLECTOR.READER:QUASIQUOTE
                        ((ECLECTOR.READER:UNQUOTE
                          (FORM-SYMBOL "MAKE-" TYPE-NAME)))))))
              (ECLECTOR.READER:UNQUOTE
               (IF INTERNAL-POINTER
                   (ECLECTOR.READER:QUASIQUOTE
                    (LET ((OBJ (ECLECTOR.READER:UNQUOTE VAR)))
                      (DECF (ECLECTOR.READER:UNQUOTE FREE-LEN))
                      (SETF (ECLECTOR.READER:UNQUOTE VAR)
                              ((ECLECTOR.READER:UNQUOTE INTERNAL-POINTER)
                               (ECLECTOR.READER:UNQUOTE VAR)))
                      (SETF ((ECLECTOR.READER:UNQUOTE INTERNAL-POINTER) OBJ)
                              NIL)
                      (ECLECTOR.READER:UNQUOTE-SPLICING
                       (WHEN CLASS?
                         '((APPLY #'REALLOCATE-INSTANCE OBJ INITARGS))))
                      OBJ))
                   (ECLECTOR.READER:QUASIQUOTE
                    (PROGN
                     (DECF (ECLECTOR.READER:UNQUOTE FREE-LEN))
                     (LET ((OBJ (VECTOR-POP (ECLECTOR.READER:UNQUOTE VAR))))
                       (ECLECTOR.READER:UNQUOTE-SPLICING
                        (WHEN CLASS?
                          '((APPLY #'REALLOCATE-INSTANCE OBJ INITARGS))))
                       OBJ)))))))
        (ECLECTOR.READER:UNQUOTE
         (IF CLASS?
             (ECLECTOR.READER:QUASIQUOTE
              (DEFUN (ECLECTOR.READER:UNQUOTE ALLOC-FN) (&REST INIT-ARGS)
                (ECLECTOR.READER:UNQUOTE
                 (FORMAT NIL
                         "Allocates an object of type ~s; like `make-instance' but allows storage management."
                         TYPE))
                (DECLARE (OPTIMIZE SPEED (SAFETY 0)))
                (WITHOUT-INTERRUPTS
                 (APPLY #'(ECLECTOR.READER:UNQUOTE ALLOC-FN*) INIT-ARGS))))
             (ECLECTOR.READER:QUASIQUOTE
              (DEFUN (ECLECTOR.READER:UNQUOTE ALLOC-FN)
                     ((ECLECTOR.READER:UNQUOTE-SPLICING INIT-ARGS))
                (ECLECTOR.READER:UNQUOTE
                 (FORMAT NIL
                         "Allocates a structure of type ~s and initializes some slots."
                         TYPE))
                (DECLARE (OPTIMIZE SPEED (SAFETY 0)))
                (LET (((ECLECTOR.READER:UNQUOTE ITEM-VAR)
                       (WITHOUT-INTERRUPTS
                        ((ECLECTOR.READER:UNQUOTE ALLOC-FN*)))))
                  (ECLECTOR.READER:UNQUOTE-SPLICING INIT-FORMS)
                  (ECLECTOR.READER:UNQUOTE ITEM-VAR))))))
        (DEFUN (ECLECTOR.READER:UNQUOTE CLEAR-FN) ()
          (ECLECTOR.READER:UNQUOTE
           (FORMAT NIL "Resets the allocation data types of instances of ~s"
                   TYPE))
          (WHEN (PLUSP (ECLECTOR.READER:UNQUOTE COUNT-VAR))
            (WARN
             "There ~[~;is~:;are~] ~:*~d allocated ~a type~2:*~p in use. If ~:*~[~;it is~:;they are~]
freed (using ~*~a) you will probably get an error - not now, but someday and then forever."
             (ECLECTOR.READER:UNQUOTE COUNT-VAR)
             '(ECLECTOR.READER:UNQUOTE TYPE-NAME)
             '(ECLECTOR.READER:UNQUOTE FREE-FN)))
          (SETF (ECLECTOR.READER:UNQUOTE VAR)
                  (ECLECTOR.READER:UNQUOTE
                   (IF INTERNAL-POINTER
                       NIL
                       (ECLECTOR.READER:QUASIQUOTE
                        (MAKE-ARRAY
                         (ECLECTOR.READER:UNQUOTE INITIAL-ARRAY-SIZE)
                         :FILL-POINTER 0 :ADJUSTABLE T))))
                (ECLECTOR.READER:UNQUOTE COUNT-VAR) 0
                (ECLECTOR.READER:UNQUOTE ACTIV-VAR) 0
                (ECLECTOR.READER:UNQUOTE FREE-LEN) 0))
        (DEFMACRO (ECLECTOR.READER:UNQUOTE WITH-FN)
                  (((ECLECTOR.READER:UNQUOTE TYPE) &REST ARGS) &BODY BODY)
          (ECLECTOR.READER:UNQUOTE
           (FORMAT NIL
                   "Temporarily allocates an instance of ~s and frees it when body exits."
                   TYPE))
          (ECLECTOR.READER:QUASIQUOTE
           (LET (((ECLECTOR.READER:UNQUOTE (ECLECTOR.READER:UNQUOTE TYPE))
                  ((ECLECTOR.READER:UNQUOTE
                    '(ECLECTOR.READER:UNQUOTE ALLOC-FN))
                   (ECLECTOR.READER:UNQUOTE-SPLICING ARGS))))
             (UNWIND-PROTECT (PROGN (ECLECTOR.READER:UNQUOTE-SPLICING BODY))
               (WHEN (ECLECTOR.READER:UNQUOTE (ECLECTOR.READER:UNQUOTE TYPE))
                 ((ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE FREE-FN))
                  (ECLECTOR.READER:UNQUOTE
                   (ECLECTOR.READER:UNQUOTE TYPE))))))))
        (DEFMACRO (ECLECTOR.READER:UNQUOTE WITHS-FN)
                  ((&REST THINGS) &BODY BODY)
          (ECLECTOR.READER:UNQUOTE
           (FORMAT NIL "Like ~A only you can do a bunch at once..." WITH-FN))
          (COND
           ((NULL THINGS)
            (ECLECTOR.READER:QUASIQUOTE
             (PROGN (ECLECTOR.READER:UNQUOTE-SPLICING BODY))))
           (T
            (ECLECTOR.READER:QUASIQUOTE
             ((ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE WITH-FN))
              (ECLECTOR.READER:UNQUOTE (ENSURE-LIST (FIRST THINGS)))
              ((ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE WITHS-FN))
               (ECLECTOR.READER:UNQUOTE (REST THINGS))
               (ECLECTOR.READER:UNQUOTE-SPLICING BODY)))))))
        (ECLECTOR.READER:UNQUOTE-SPLICING
         (WHEN EXPORT?
           (ECLECTOR.READER:QUASIQUOTE
            ((EXPORT
              '((ECLECTOR.READER:UNQUOTE WITH-FN)
                (ECLECTOR.READER:UNQUOTE WITHS-FN)))))))
        '(ECLECTOR.READER:UNQUOTE TYPE)))))

[metatilities/dev/utilities/sequences.lisp:28]
  (DEFUN MAPCAN1 (FUN LIST)
    "Like MAPCAN, but for a single list.  Doesn't cons, and is reasonably
well optimized."
    (DECLARE (OPTIMIZE (SPEED 3) (COMPILATION-SPEED 0) (SAFETY 0)))
    (WHEN LIST
      (LET* ((ACC (FUNCALL FUN (CAR LIST))) (LAST ACC))
        (DOLIST (ELT (CDR LIST) ACC)
          (LET ((VAL (FUNCALL FUN ELT)))
            (NCONC LAST VAL)
            (WHEN VAL (SETF LAST VAL)))))))

[metatilities/dev/utilities/strings.lisp:32]
  (DEFUN SUBSTRING (STRING START &OPTIONAL END DOWNCASEP)
    (DECLARE (TYPE STRING STRING)
             (TYPE FIXNUM START)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET* ((END (OR END (LENGTH STRING))) (RV (MAKE-STRING (- END START))))
      (DECLARE (TYPE FIXNUM END))
      (DO ((R-INDEX START (1+ R-INDEX))
           (W-INDEX 0 (1+ W-INDEX)))
          ((>= R-INDEX END) RV)
        (DECLARE (TYPE FIXNUM R-INDEX W-INDEX))
        (SETF (CHAR RV W-INDEX)
                (LET ((C (CHAR STRING R-INDEX)))
                  (IF DOWNCASEP
                      (CHAR-DOWNCASE C)
                      C))))))

[metatilities/dev/utilities/strings.lisp:76]
  (DEFUN COLLECT-TO-CHAR (CHAR STRING &KEY (START 0) END DOWNCASEP)
    (DECLARE (TYPE STRING STRING)
             (TYPE FIXNUM START)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((END-INDEX
           (POSITION CHAR STRING :START START :END END :TEST #'CHAR=)))
      (WHEN END-INDEX
        (VALUES (SUBSTRING STRING START END-INDEX DOWNCASEP) END-INDEX))))

[metatilities/dev/utilities/strings.lisp:82]
  (DEFUN COLLECT-TO-NOT (CHAR STRING &KEY (START 0) END DOWNCASEP)
    (DECLARE (TYPE STRING STRING)
             (TYPE FIXNUM START)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((END-INDEX
           (POSITION CHAR STRING :START START :END END :TEST-NOT #'CHAR=)))
      (WHEN END-INDEX
        (VALUES (SUBSTRING STRING START END-INDEX DOWNCASEP) END-INDEX))))

[metatilities/dev/utilities/utilities.lisp:480]
  (DEFUN VERY-SMALL-NUMBER-P (NUMBER)
    (DECLARE (OPTIMIZE (SPEED 3) (SPACE 3) (DEBUG 0) (SAFETY 0)))
    (OR (AND (PLUSP NUMBER) (< NUMBER +VERY-SMALL-NUMBER+))
        (AND (MINUSP NUMBER) (> NUMBER (- +VERY-SMALL-NUMBER+)))
        (ZEROP NUMBER)))

[metatilities/dev/utilities/utilities.lisp:486]
  (DEFUN VERY-SMALL-NUMBER-P (NUMBER)
    (DECLARE (OPTIMIZE (SPEED 3) (SPACE 3) (DEBUG 0) (SAFETY 0))
             (TYPE REAL NUMBER))
    (< (ABS NUMBER) +VERY-SMALL-NUMBER+))

[metatilities/dev/utilities/views-and-windows.lisp:137]
  (DEFMETHOD VIEW-X/VIEW-Y->X/Y ((VIEW SCALED-VIEW-MIXIN) VIEW-X VIEW-Y)
    (DECLARE (OPTIMIZE (SPEED 3) (SPACE 3) (DEBUG 0) (SAFETY 0))
             (DOUBLE-FLOAT VIEW-X VIEW-Y)
             (DYNAMIC-EXTENT VIEW-X VIEW-Y))
    (LET ((LEFT-MARGIN (LEFT-MARGIN VIEW))
          (TOP-MARGIN (TOP-MARGIN VIEW))
          (SCALE-X (SCALE-X VIEW))
          (SCALE-Y (SCALE-Y VIEW)))
      (DECLARE (TYPE FIXNUM LEFT-MARGIN TOP-MARGIN)
               (DOUBLE-FLOAT SCALE-X SCALE-Y)
               (DYNAMIC-EXTENT LEFT-MARGIN TOP-MARGIN SCALE-X SCALE-Y))
      (VALUES (THE FIXNUM (+ LEFT-MARGIN (ROUND (* VIEW-X SCALE-X))))
              (THE FIXNUM (+ TOP-MARGIN (ROUND (* VIEW-Y SCALE-Y)))))))

[mgl-mat/src/mat.lisp:1897]
  (DEFUN GAUSSIAN-RANDOM-1 ()
    "Return a double float of zero mean and unit variance."
    (LOOP
     (LET* ((X1 (1- (* 2.0d0 (RANDOM 1.0d0))))
            (X2 (1- (* 2.0d0 (RANDOM 1.0d0))))
            (W (+ (* X1 X1) (* X2 X2))))
       (DECLARE (TYPE DOUBLE-FLOAT X1 X2)
                (TYPE DOUBLE-FLOAT W)
                (OPTIMIZE (SPEED 3)))
       (WHEN (< W 1.0d0)
         (RETURN
          (* X2
             (LOCALLY
              (DECLARE (OPTIMIZE (SAFETY 0)))
              (THE DOUBLE-FLOAT (SQRT (/ (* -2.0d0 (LOG W)) W))))))))))

[mgl-pax/src/document/hyperspec.lisp:3]
  (DEFPARAMETER *HYPERPSEC-ENTRIES*
    '((* FUNCTION "f_st") (* VARIABLE "v_stst") (** VARIABLE "v__stst")
      (*** VARIABLE "v__stst") (*BREAK-ON-SIGNALS* VARIABLE "v_break_")
      (*COMPILE-FILE-PATHNAME* VARIABLE "v_cmp_fi")
      (*COMPILE-FILE-TRUENAME* VARIABLE "v_cmp_fi")
      (*COMPILE-PRINT* VARIABLE "v_cmp_pr")
      (*COMPILE-VERBOSE* VARIABLE "v_cmp_pr") (*DEBUG-IO* VARIABLE "v_debug_")
      (*DEBUGGER-HOOK* VARIABLE "v_debugg")
      (*DEFAULT-PATHNAME-DEFAULTS* VARIABLE "v_defaul")
      (*ERROR-OUTPUT* VARIABLE "v_debug_") (*FEATURES* VARIABLE "v_featur")
      (*GENSYM-COUNTER* VARIABLE "v_gensym")
      (*LOAD-PATHNAME* VARIABLE "v_ld_pns") (*LOAD-PRINT* VARIABLE "v_ld_prs")
      (*LOAD-TRUENAME* VARIABLE "v_ld_pns")
      (*LOAD-VERBOSE* VARIABLE "v_ld_prs")
      (*MACROEXPAND-HOOK* VARIABLE "v_mexp_h") (*MODULES* VARIABLE "v_module")
      (*PACKAGE* VARIABLE "v_pkg") (*PRINT-ARRAY* VARIABLE "v_pr_ar")
      (*PRINT-BASE* VARIABLE "v_pr_bas") (*PRINT-CASE* VARIABLE "v_pr_cas")
      (*PRINT-CIRCLE* VARIABLE "v_pr_cir") (*PRINT-ESCAPE* VARIABLE "v_pr_esc")
      (*PRINT-GENSYM* VARIABLE "v_pr_gen") (*PRINT-LENGTH* VARIABLE "v_pr_lev")
      (*PRINT-LEVEL* VARIABLE "v_pr_lev") (*PRINT-LINES* VARIABLE "v_pr_lin")
      (*PRINT-MISER-WIDTH* VARIABLE "v_pr_mis")
      (*PRINT-PPRINT-DISPATCH* VARIABLE "v_pr_ppr")
      (*PRINT-PRETTY* VARIABLE "v_pr_pre") (*PRINT-RADIX* VARIABLE "v_pr_bas")
      (*PRINT-READABLY* VARIABLE "v_pr_rda")
      (*PRINT-RIGHT-MARGIN* VARIABLE "v_pr_rig")
      (*QUERY-IO* VARIABLE "v_debug_") (*RANDOM-STATE* VARIABLE "v_rnd_st")
      (*READ-BASE* VARIABLE "v_rd_bas")
      (*READ-DEFAULT-FLOAT-FORMAT* VARIABLE "v_rd_def")
      (*READ-EVAL* VARIABLE "v_rd_eva") (*READ-SUPPRESS* VARIABLE "v_rd_sup")
      (*READTABLE* VARIABLE "v_rdtabl") (*STANDARD-INPUT* VARIABLE "v_debug_")
      (*STANDARD-OUTPUT* VARIABLE "v_debug_")
      (*TERMINAL-IO* VARIABLE "v_termin") (*TRACE-OUTPUT* VARIABLE "v_debug_")
      (+ FUNCTION "f_pl") (+ VARIABLE "v_pl_plp") (++ VARIABLE "v_pl_plp")
      (+++ VARIABLE "v_pl_plp") (- FUNCTION "f__") (- VARIABLE "v__")
      (/ FUNCTION "f_sl") (/ VARIABLE "v_sl_sls") (// VARIABLE "v_sl_sls")
      (/// VARIABLE "v_sl_sls") (/= FUNCTION F_EQ_SLE) (1+ FUNCTION "f_1pl_1_")
      (1- FUNCTION "f_1pl_1_") (< FUNCTION "f_eq_sle") (<= FUNCTION "f_eq_sle")
      (= FUNCTION "f_eq_sle") (> FUNCTION "f_eq_sle") (>= FUNCTION "f_eq_sle")
      (ABORT FUNCTION "f_abortc") (ABORT RESTART "r_abort")
      (ABS FUNCTION "f_abs") (ACONS FUNCTION "f_acons")
      (ACOS FUNCTION "f_asin_") (ACOSH FUNCTION "f_sinh_")
      (ADD-METHOD FUNCTION "f_add_me") (ADJOIN FUNCTION "f_adjoin")
      (ADJUST-ARRAY FUNCTION "f_adjust")
      (ADJUSTABLE-ARRAY-P FUNCTION "f_adju_1")
      (ALLOCATE-INSTANCE FUNCTION "f_alloca")
      (ALPHA-CHAR-P FUNCTION "f_alpha_") (ALPHANUMERICP FUNCTION "f_alphan")
      (AND MACRO "m_and") (AND TYPE "t_and") (APPEND FUNCTION "f_append")
      (APPLY FUNCTION "f_apply") (APROPOS FUNCTION "f_apropo")
      (APROPOS-LIST FUNCTION "f_apropo") (AREF FUNCTION "f_aref")
      (ARITHMETIC-ERROR CONDITION "e_arithm")
      (ARITHMETIC-ERROR-OPERANDS FUNCTION "f_arithm")
      (ARITHMETIC-ERROR-OPERATION FUNCTION "f_arithm") (ARRAY TYPE "t_array")
      (ARRAY-DIMENSION FUNCTION "f_ar_dim")
      (ARRAY-DIMENSION-LIMIT CONSTANT "v_ar_dim")
      (ARRAY-DIMENSIONS FUNCTION "f_ar_d_1")
      (ARRAY-DISPLACEMENT FUNCTION "f_ar_dis")
      (ARRAY-ELEMENT-TYPE FUNCTION "f_ar_ele")
      (ARRAY-HAS-FILL-POINTER-P FUNCTION "f_ar_has")
      (ARRAY-IN-BOUNDS-P FUNCTION "f_ar_in_") (ARRAY-RANK FUNCTION "f_ar_ran")
      (ARRAY-RANK-LIMIT CONSTANT "v_ar_ran")
      (ARRAY-ROW-MAJOR-INDEX FUNCTION "f_ar_row")
      (ARRAY-TOTAL-SIZE FUNCTION "f_ar_tot")
      (ARRAY-TOTAL-SIZE-LIMIT CONSTANT "v_ar_tot") (ARRAYP FUNCTION "f_arrayp")
      (ASH FUNCTION "f_ash") (ASIN FUNCTION "f_asin_")
      (ASINH FUNCTION "f_sinh_") (ASSERT MACRO "m_assert")
      (ASSOC FUNCTION "f_assocc") (ASSOC-IF FUNCTION "f_assocc")
      (ASSOC-IF-NOT FUNCTION "f_assocc") (ATAN FUNCTION "f_asin_")
      (ATANH FUNCTION "f_sinh_") (ATOM FUNCTION "f_atom") (ATOM TYPE "t_atom")
      (BASE-CHAR TYPE "t_base_c") (BASE-STRING TYPE "t_base_s")
      (BIGNUM TYPE "t_bignum") (BIT FUNCTION "f_bt_sb") (BIT TYPE "t_bit")
      (BIT-AND FUNCTION "f_bt_and") (BIT-ANDC1 FUNCTION "f_bt_and")
      (BIT-ANDC2 FUNCTION "f_bt_and") (BIT-EQV FUNCTION "f_bt_and")
      (BIT-IOR FUNCTION "f_bt_and") (BIT-NAND FUNCTION "f_bt_and")
      (BIT-NOR FUNCTION "f_bt_and") (BIT-NOT FUNCTION "f_bt_and")
      (BIT-ORC1 FUNCTION "f_bt_and") (BIT-ORC2 FUNCTION "f_bt_and")
      (BIT-VECTOR TYPE "t_bt_vec") (BIT-VECTOR-P FUNCTION "f_bt_vec")
      (BIT-XOR FUNCTION "f_bt_and") (BLOCK OPERATOR "s_block")
      (BOOLE FUNCTION "f_boole") (BOOLE-1 CONSTANT "v_b_1_b")
      (BOOLE-2 CONSTANT "v_b_1_b") (BOOLE-AND CONSTANT "v_b_1_b")
      (BOOLE-ANDC1 CONSTANT "v_b_1_b") (BOOLE-ANDC2 CONSTANT "v_b_1_b")
      (BOOLE-C1 CONSTANT "v_b_1_b") (BOOLE-C2 CONSTANT "v_b_1_b")
      (BOOLE-CLR CONSTANT "v_b_1_b") (BOOLE-EQV CONSTANT "v_b_1_b")
      (BOOLE-IOR CONSTANT "v_b_1_b") (BOOLE-NAND CONSTANT "v_b_1_b")
      (BOOLE-NOR CONSTANT "v_b_1_b") (BOOLE-ORC1 CONSTANT "v_b_1_b")
      (BOOLE-ORC2 CONSTANT "v_b_1_b") (BOOLE-SET CONSTANT "v_b_1_b")
      (BOOLE-XOR CONSTANT "v_b_1_b") (BOOLEAN TYPE "t_ban")
      (BOTH-CASE-P FUNCTION "f_upper_") (BOUNDP FUNCTION "f_boundp")
      (BREAK FUNCTION "f_break") (BROADCAST-STREAM TYPE "t_broadc")
      (BROADCAST-STREAM-STREAMS FUNCTION "f_broadc")
      (BUILT-IN-CLASS TYPE "t_built_") (BUTLAST FUNCTION "f_butlas")
      (BYTE FUNCTION "f_by_by") (BYTE-POSITION FUNCTION "f_by_by")
      (BYTE-SIZE FUNCTION "f_by_by") (CAAAAR FUNCTION "f_car_c")
      (CAAADR FUNCTION "f_car_c") (CAAAR FUNCTION "f_car_c")
      (CAADAR FUNCTION "f_car_c") (CAADDR FUNCTION "f_car_c")
      (CAADR FUNCTION "f_car_c") (CAAR FUNCTION "f_car_c")
      (CADAAR FUNCTION "f_car_c") (CADADR FUNCTION "f_car_c")
      (CADAR FUNCTION "f_car_c") (CADDAR FUNCTION "f_car_c")
      (CADDDR FUNCTION "f_car_c") (CADDR FUNCTION "f_car_c")
      (CADR FUNCTION "f_car_c") (CALL-ARGUMENTS-LIMIT CONSTANT "v_call_a")
      (CALL-METHOD MACRO "m_call_m") (CALL-NEXT-METHOD FUNCTION "f_call_n")
      (CAR FUNCTION "f_car_c") (CASE MACRO "m_case_")
      (CATCH OPERATOR "s_catch") (CCASE MACRO "m_case_")
      (CDAAAR FUNCTION "f_car_c") (CDAADR FUNCTION "f_car_c")
      (CDAAR FUNCTION "f_car_c") (CDADAR FUNCTION "f_car_c")
      (CDADDR FUNCTION "f_car_c") (CDADR FUNCTION "f_car_c")
      (CDAR FUNCTION "f_car_c") (CDDAAR FUNCTION "f_car_c")
      (CDDADR FUNCTION "f_car_c") (CDDAR FUNCTION "f_car_c")
      (CDDDAR FUNCTION "f_car_c") (CDDDDR FUNCTION "f_car_c")
      (CDDDR FUNCTION "f_car_c") (CDDR FUNCTION "f_car_c")
      (CDR FUNCTION "f_car_c") (CEILING FUNCTION "f_floorc")
      (CELL-ERROR CONDITION "e_cell_e") (CELL-ERROR-NAME FUNCTION "f_cell_e")
      (CERROR FUNCTION "f_cerror") (CHANGE-CLASS FUNCTION "f_chg_cl")
      (CHAR FUNCTION "f_char_") (CHAR-CODE FUNCTION "f_char_c")
      (CHAR-CODE-LIMIT CONSTANT "v_char_c") (CHAR-DOWNCASE FUNCTION "f_char_u")
      (CHAR-EQUAL FUNCTION "f_chareq") (CHAR-GREATERP FUNCTION "f_chareq")
      (CHAR-INT FUNCTION "f_char_i") (CHAR-LESSP FUNCTION "f_chareq")
      (CHAR-NAME FUNCTION "f_char_n") (CHAR-NOT-EQUAL FUNCTION "f_chareq")
      (CHAR-NOT-GREATERP FUNCTION "f_chareq")
      (CHAR-NOT-LESSP FUNCTION "f_chareq") (CHAR-UPCASE FUNCTION "f_char_u")
      (CHAR/= FUNCTION "f_chareq") (CHAR< FUNCTION "f_chareq")
      (CHAR<= FUNCTION "f_chareq") (CHAR= FUNCTION "f_chareq")
      (CHAR> FUNCTION "f_chareq") (CHAR>= FUNCTION "f_chareq")
      (CHARACTER FUNCTION "f_ch") (CHARACTER CLASS "t_ch")
      (CHARACTERP FUNCTION "f_chp") (CHECK-TYPE MACRO "m_check_")
      (CIS FUNCTION "f_cis") (CLASS CLASS "t_class")
      (CLASS-NAME FUNCTION "f_class_") (CLASS-OF FUNCTION "f_clas_1")
      (CLEAR-INPUT FUNCTION "f_clear_") (CLEAR-OUTPUT FUNCTION "f_finish")
      (CLOSE FUNCTION "f_close") (CLRHASH FUNCTION "f_clrhas")
      (CODE-CHAR FUNCTION "f_code_c") (COERCE FUNCTION "f_coerce")
      (COMPILATION-SPEED DECLARATION "d_optimi") (COMPILE FUNCTION "f_cmp")
      (COMPILE-FILE FUNCTION "f_cmp_fi")
      (COMPILE-FILE-PATHNAME FUNCTION "f_cmp__1")
      (COMPILED-FUNCTION TYPE "t_cmpd_f")
      (COMPILED-FUNCTION-P FUNCTION "f_cmpd_f")
      (COMPILER-MACRO-FUNCTION FUNCTION "f_cmp_ma")
      (COMPLEMENT FUNCTION "f_comple") (COMPLEX FUNCTION "f_comp_2")
      (COMPLEX CLASS "t_comple") (COMPLEXP FUNCTION "f_comp_3")
      (COMPUTE-APPLICABLE-METHODS FUNCTION "f_comput")
      (COMPUTE-RESTARTS FUNCTION "f_comp_1") (CONCATENATE FUNCTION "f_concat")
      (CONCATENATED-STREAM TYPE "t_concat")
      (CONCATENATED-STREAM-STREAMS FUNCTION "f_conc_1") (COND MACRO "m_cond")
      (CONDITION CONDITION "e_cnd") (CONJUGATE FUNCTION "f_conjug")
      (CONS FUNCTION "f_cons") (CONS TYPE "t_cons") (CONSP FUNCTION "f_consp")
      (CONSTANTLY FUNCTION "f_cons_1") (CONSTANTP FUNCTION "f_consta")
      (CONTINUE FUNCTION "f_abortc") (CONTINUE RESTART "r_contin")
      (CONTROL-ERROR CONDITION "e_contro") (COPY-ALIST FUNCTION "f_cp_ali")
      (COPY-LIST FUNCTION "f_cp_lis")
      (COPY-PPRINT-DISPATCH FUNCTION "f_cp_ppr")
      (COPY-READTABLE FUNCTION "f_cp_rdt") (COPY-SEQ FUNCTION "f_cp_seq")
      (COPY-STRUCTURE FUNCTION "f_cp_stu") (COPY-SYMBOL FUNCTION "f_cp_sym")
      (COPY-TREE FUNCTION "f_cp_tre") (COS FUNCTION "f_sin_c")
      (COSH FUNCTION "f_sinh_") (COUNT FUNCTION "f_countc")
      (COUNT-IF FUNCTION "f_countc") (COUNT-IF-NOT FUNCTION "f_countc")
      (CTYPECASE MACRO "m_tpcase") (DEBUG DECLARATION "d_optimi")
      (DECF FUNCTION "m_incf_")
      (DECLAIM MACRO
               "m_declai")
      (DECLARATION DECLARATION "d_declar")
      (DECLARE OPERATOR
               "s_declar")
      (DECODE-FLOAT FUNCTION "f_dec_fl")
      (DECODE-UNIVERSAL-TIME FUNCTION "f_dec_un") (DEFCLASS MACRO "m_defcla")
      (DEFCONSTANT MACRO "m_defcon")
      (DEFGENERIC MACRO
          "m_defgen")
      (DEFINE-COMPILER-MACRO MACRO
          "m_define")
      (DEFINE-CONDITION MACRO
          "m_defi_5")
      (DEFINE-METHOD-COMBINATION MACRO
        "m_defi_4")
      (DEFINE-MODIFY-MACRO MACRO "m_defi_2")
      (DEFINE-SETF-EXPANDER MACRO "m_defi_3")
      (DEFINE-SYMBOL-MACRO MACRO "m_defi_1") (DEFMACRO MACRO "m_defmac")
      (DEFMETHOD MACRO "m_defmet")
      (DEFPACKAGE MACRO
        "m_defpkg")
      (DEFPARAMETER MACRO "m_defpar") (DEFSETF MACRO "m_defset")
      (DEFSTRUCT MACRO "m_defstr") (DEFTYPE MACRO "m_deftp")
      (DEFUN MACRO "m_defun") (DEFVAR MACRO "m_defpar")
      (DELETE FUNCTION "f_rm_rm") (DELETE-DUPLICATES FUNCTION "f_rm_dup")
      (DELETE-FILE FUNCTION "f_del_fi") (DELETE-IF FUNCTION "f_rm_rm")
      (DELETE-IF-NOT FUNCTION "f_rm_rm") (DELETE-PACKAGE FUNCTION "f_del_pk")
      (DENOMINATOR FUNCTION "f_numera") (DEPOSIT-FIELD FUNCTION "f_deposi")
      (DESCRIBE FUNCTION "f_descri") (DESCRIBE-OBJECT FUNCTION "f_desc_1")
      (DESTRUCTURING-BIND MACRO "m_destru") (DIGIT-CHAR FUNCTION "f_digit_")
      (DIGIT-CHAR-P FUNCTION "f_digi_1") (DIRECTORY FUNCTION "f_dir")
      (DIRECTORY-NAMESTRING FUNCTION "f_namest")
      (DISASSEMBLE FUNCTION "f_disass") (DIVISION-BY-ZERO CONDITION "e_divisi")
      (DO MACRO "m_do_do") (DO* MACRO "m_do_do")
      (DO-ALL-SYMBOLS MACRO "m_do_sym") (DO-EXTERNAL-SYMBOLS MACRO "m_do_sym")
      (DO-SYMBOLS MACRO "m_do_sym") (DOCUMENTATION GENERIC-FUNCTION "f_docume")
      (DOLIST MACRO "m_dolist") (DOTIMES MACRO "m_dotime")
      (DOUBLE-FLOAT TYPE "t_short_") (DOUBLE-FLOAT-EPSILON CONSTANT "v_short_")
      (DOUBLE-FLOAT-NEGATIVE-EPSILON CONSTANT "v_short_")
      (DPB FUNCTION "f_dpb") (DRIBBLE FUNCTION "f_dribbl")
      (DYNAMIC-EXTENT DECLARATION "d_dynami") (ECASE MACRO "m_case_")
      (ECHO-STREAM TYPE "t_echo_s")
      (ECHO-STREAM-INPUT-STREAM FUNCTION "f_echo_s")
      (ECHO-STREAM-OUTPUT-STREAM FUNCTION "f_echo_s") (ED FUNCTION "f_ed")
      (EIGHTH FUNCTION "f_firstc") (ELT FUNCTION "f_elt")
      (ENCODE-UNIVERSAL-TIME FUNCTION "f_encode")
      (END-OF-FILE CONDITION "e_end_of") (ENDP FUNCTION "f_endp")
      (ENOUGH-NAMESTRING FUNCTION "f_namest")
      (ENSURE-DIRECTORIES-EXIST FUNCTION "f_ensu_1")
      (ENSURE-GENERIC-FUNCTION FUNCTION "f_ensure") (EQ FUNCTION "f_eq")
      (EQL FUNCTION "f_eql") (EQL TYPE "t_eql") (EQUAL FUNCTION "f_equal")
      (EQUALP FUNCTION "f_equalp") (ERROR CONDITION "e_error")
      (ERROR FUNCTION "f_error") (ETYPECASE MACRO "m_tpcase")
      (EVAL FUNCTION "f_eval") (EVAL-WHEN OPERATOR "s_eval_w")
      (EVENP FUNCTION "f_evenpc") (EVERY FUNCTION "f_everyc")
      (EXP FUNCTION "f_exp_e") (EXPORT FUNCTION "f_export")
      (EXPT FUNCTION "f_exp_e") (EXTENDED-CHAR TYPE "t_extend")
      (FBOUNDP FUNCTION "f_fbound") (FCEILING FUNCTION "f_floorc")
      (FDEFINITION FUNCTION "f_fdefin") (FFLOOR FUNCTION "f_floorc")
      (FIFTH FUNCTION "f_firstc") (FILE-AUTHOR FUNCTION "f_file_a")
      (FILE-ERROR CONDITION "e_file_e")
      (FILE-ERROR-PATHNAME FUNCTION "f_file_e")
      (FILE-LENGTH FUNCTION "f_file_l") (FILE-NAMESTRING FUNCTION "f_namest")
      (FILE-POSITION FUNCTION "f_file_p") (FILE-STREAM TYPE "t_file_s")
      (FILE-STRING-LENGTH FUNCTION "f_file_s")
      (FILE-WRITE-DATE FUNCTION "f_file_w") (FILL FUNCTION "f_fill")
      (FILL-POINTER FUNCTION "f_fill_p") (FIND FUNCTION "f_find_")
      (FIND-ALL-SYMBOLS FUNCTION "f_find_a") (FIND-CLASS FUNCTION "f_find_c")
      (FIND-IF FUNCTION "f_find_") (FIND-IF-NOT FUNCTION "f_find_")
      (FIND-METHOD GENERIC-FUNCTION "f_find_m")
      (FIND-PACKAGE FUNCTION "f_find_p") (FIND-RESTART FUNCTION "f_find_r")
      (FIND-SYMBOL FUNCTION "f_find_s") (FINISH-OUTPUT FUNCTION "f_finish")
      (FIRST FUNCTION "f_firstc") (FIXNUM TYPE "t_fixnum")
      (FLET OPERATOR
        "s_flet_")
      (FLOAT FUNCTION "f_float") (FLOAT TYPE "t_float")
      (FLOAT-DIGITS FUNCTION "f_dec_fl") (FLOAT-PRECISION FUNCTION "f_dec_fl")
      (FLOAT-RADIX FUNCTION "f_dec_fl") (FLOAT-SIGN FUNCTION "f_dec_fl")
      (FLOATING-POINT-INEXACT CONDITION "e_floa_1")
      (FLOATING-POINT-INVALID-OPERATION CONDITION "e_floati")
      (FLOATING-POINT-OVERFLOW CONDITION "e_floa_2")
      (FLOATING-POINT-UNDERFLOW CONDITION "e_floa_3")
      (FLOATP FUNCTION "f_floatp") (FLOOR FUNCTION "f_floorc")
      (FMAKUNBOUND FUNCTION "f_fmakun") (FORCE-OUTPUT FUNCTION "f_finish")
      (FORMAT FUNCTION "f_format") (FORMATTER MACRO "m_format")
      (FOURTH FUNCTION "f_firstc") (FRESH-LINE FUNCTION "f_terpri")
      (FROUND FUNCTION "f_floorc") (FTRUNCATE FUNCTION "f_floorc")
      (FTYPE DECLARATION "d_ftype") (FUNCALL FUNCTION "f_funcal")
      (FUNCTION OPERATOR "s_fn") (FUNCTION TYPE "t_fn")
      (FUNCTION-KEYWORDS FUNCTION "f_fn_kwd")
      (FUNCTION-LAMBDA-EXPRESSION FUNCTION "f_fn_lam")
      (FUNCTIONP FUNCTION "f_fnp") (GCD FUNCTION "f_gcd")
      (GENERIC-FUNCTION CLASS "t_generi") (GENSYM FUNCTION "f_gensym")
      (GENTEMP FUNCTION "f_gentem") (GET FUNCTION "f_get")
      (GET-DECODED-TIME FUNCTION "f_get_un")
      (GET-DISPATCH-MACRO-CHARACTER FUNCTION "f_set__1")
      (GET-INTERNAL-REAL-TIME FUNCTION "f_get_in")
      (GET-INTERNAL-RUN-TIME FUNCTION "f_get__1")
      (GET-MACRO-CHARACTER FUNCTION "f_set_ma")
      (GET-OUTPUT-STREAM-STRING FUNCTION "f_get_ou")
      (GET-PROPERTIES FUNCTION "f_get_pr")
      (GET-SETF-EXPANSION FUNCTION "f_get_se")
      (GET-UNIVERSAL-TIME FUNCTION "f_get_un") (GETF FUNCTION "f_getf")
      (GETHASH FUNCTION "f_gethas") (GO OPERATOR "s_go")
      (GRAPHIC-CHAR-P FUNCTION "f_graphi")
      (HANDLER-BIND MACRO
        "m_handle")
      (HANDLER-CASE MACRO "m_hand_1") (HASH-TABLE TYPE "t_hash_t")
      (HASH-TABLE-COUNT FUNCTION "f_hash_1") (HASH-TABLE-P FUNCTION "f_hash_t")
      (HASH-TABLE-REHASH-SIZE FUNCTION "f_hash_2")
      (HASH-TABLE-REHASH-THRESHOLD FUNCTION "f_hash_3")
      (HASH-TABLE-SIZE FUNCTION "f_hash_4")
      (HASH-TABLE-TEST FUNCTION "f_hash_5")
      (HOST-NAMESTRING FUNCTION "f_namest") (IDENTITY FUNCTION "f_identi")
      (IF OPERATOR
          "s_if")
      (IGNORABLE DECLARATION "d_ignore") (IGNORE DECLARATION "d_ignore")
      (IGNORE-ERRORS MACRO "m_ignore") (IMAGPART FUNCTION "f_realpa")
      (IMPORT FUNCTION "f_import") (NIL MACRO "m_in_pkg")
      (INCF FUNCTION "m_incf_") (INITIALIZE-INSTANCE FUNCTION "f_init_i")
      (INLINE DECLARATION "d_inline") (INPUT-STREAM-P FUNCTION "f_in_stm")
      (INSPECT FUNCTION "f_inspec") (INTEGER TYPE "t_intege")
      (INTEGER-DECODE-FLOAT FUNCTION "f_dec_fl")
      (INTEGER-LENGTH FUNCTION "f_intege") (INTEGERP FUNCTION "f_inte_1")
      (INTERACTIVE-STREAM-P FUNCTION "f_intera") (INTERN FUNCTION "f_intern")
      (INTERNAL-TIME-UNITS-PER-SECOND CONSTANT "v_intern")
      (INTERSECTION FUNCTION "f_isec_")
      (INVALID-METHOD-ERROR FUNCTION "f_invali")
      (INVOKE-DEBUGGER FUNCTION "f_invoke")
      (INVOKE-RESTART FUNCTION "f_invo_1")
      (INVOKE-RESTART-INTERACTIVELY FUNCTION "f_invo_2")
      (ISQRT FUNCTION "f_sqrt_") (KEYWORD TYPE "t_kwd")
      (KEYWORDP FUNCTION "f_kwdp")
      (LABELS OPERATOR
        "s_flet_")
      (LAMBDA MACRO "m_lambda") (LAMBDA-LIST-KEYWORDS CONSTANT "v_lambda")
      (LAMBDA-PARAMETERS-LIMIT CONSTANT "v_lamb_1") (LAST FUNCTION "f_last")
      (LCM FUNCTION "f_lcm") (LDB FUNCTION "f_ldb")
      (LDB-TEST FUNCTION "f_ldb_te") (LDIFF FUNCTION "f_ldiffc")
      (LEAST-NEGATIVE-DOUBLE-FLOAT CONSTANT "v_most_1")
      (LEAST-NEGATIVE-LONG-FLOAT CONSTANT "v_most_1")
      (LEAST-NEGATIVE-NORMALIZED-DOUBLE-FLOAT CONSTANT "v_most_1")
      (LEAST-NEGATIVE-NORMALIZED-LONG-FLOAT CONSTANT "v_most_1")
      (LEAST-NEGATIVE-NORMALIZED-SHORT-FLOAT CONSTANT "v_most_1")
      (LEAST-NEGATIVE-NORMALIZED-SINGLE-FLOAT CONSTANT "v_most_1")
      (LEAST-NEGATIVE-SHORT-FLOAT CONSTANT "v_most_1")
      (LEAST-NEGATIVE-SINGLE-FLOAT CONSTANT "v_most_1")
      (LEAST-POSITIVE-DOUBLE-FLOAT CONSTANT "v_most_1")
      (LEAST-POSITIVE-LONG-FLOAT CONSTANT "v_most_1")
      (LEAST-POSITIVE-NORMALIZED-DOUBLE-FLOAT CONSTANT "v_most_1")
      (LEAST-POSITIVE-NORMALIZED-LONG-FLOAT CONSTANT "v_most_1")
      (LEAST-POSITIVE-NORMALIZED-SHORT-FLOAT CONSTANT "v_most_1")
      (LEAST-POSITIVE-NORMALIZED-SINGLE-FLOAT CONSTANT "v_most_1")
      (LEAST-POSITIVE-SHORT-FLOAT CONSTANT "v_most_1")
      (LEAST-POSITIVE-SINGLE-FLOAT CONSTANT "v_most_1")
      (LENGTH FUNCTION "f_length")
      (LET OPERATOR
        "s_let_l")
      (LET* OPERATOR
        "s_let_l")
      (LISP-IMPLEMENTATION-TYPE FUNCTION "f_lisp_i")
      (LISP-IMPLEMENTATION-VERSION FUNCTION "f_lisp_i")
      (LIST FUNCTION "f_list_") (LIST TYPE "t_list") (LIST* FUNCTION "f_list_")
      (LIST-ALL-PACKAGES FUNCTION "f_list_a") (LIST-LENGTH FUNCTION "f_list_l")
      (LISTEN FUNCTION "f_listen") (LISTP FUNCTION "f_listp")
      (LOAD FUNCTION "f_load")
      (LOAD-LOGICAL-PATHNAME-TRANSLATIONS FUNCTION "f_ld_log")
      (LOAD-TIME-VALUE OPERATOR "s_ld_tim") (LOCALLY OPERATOR "s_locall")
      (LOG FUNCTION "f_log") (LOGAND FUNCTION "f_logand")
      (LOGANDC1 FUNCTION "f_logand") (LOGANDC2 FUNCTION "f_logand")
      (LOGBITP FUNCTION "f_logbtp") (LOGCOUNT FUNCTION "f_logcou")
      (LOGEQV FUNCTION "f_logand") (LOGICAL-PATHNAME FUNCTION "f_logi_1")
      (LOGICAL-PATHNAME TYPE "t_logica")
      (LOGICAL-PATHNAME-TRANSLATIONS FUNCTION "f_logica")
      (LOGIOR FUNCTION "f_logand") (LOGNAND FUNCTION "f_logand")
      (LOGNOR FUNCTION "f_logand") (LOGNOT FUNCTION "f_logand")
      (LOGORC1 FUNCTION "f_logand") (LOGORC2 FUNCTION "f_logand")
      (LOGTEST FUNCTION "f_logtes") (LOGXOR FUNCTION "f_logand")
      (LONG-FLOAT TYPE "t_short_") (LONG-FLOAT-EPSILON CONSTANT "v_short_")
      (LONG-FLOAT-NEGATIVE-EPSILON CONSTANT "v_short_")
      (LONG-SITE-NAME FUNCTION "f_short_") (LOOP MACRO "m_loop")
      (LOOP-FINISH MACRO "m_loop_f") (LOWER-CASE-P FUNCTION "f_upper_")
      (MACHINE-INSTANCE FUNCTION "f_mach_i") (MACHINE-TYPE FUNCTION "f_mach_t")
      (MACHINE-VERSION FUNCTION "f_mach_v")
      (MACRO-FUNCTION FUNCTION "f_macro_") (MACROEXPAND FUNCTION "f_mexp_")
      (MACROEXPAND-1 FUNCTION "f_mexp_")
      (MACROLET OPERATOR
        "s_flet_")
      (MAKE-ARRAY FUNCTION "f_mk_ar")
      (MAKE-BROADCAST-STREAM FUNCTION "f_mk_bro")
      (MAKE-CONCATENATED-STREAM FUNCTION "f_mk_con")
      (MAKE-CONDITION FUNCTION "f_mk_cnd")
      (MAKE-DISPATCH-MACRO-CHARACTER FUNCTION "f_mk_dis")
      (MAKE-ECHO-STREAM FUNCTION "f_mk_ech")
      (MAKE-HASH-TABLE FUNCTION "f_mk_has") (MAKE-INSTANCE FUNCTION "f_mk_ins")
      (MAKE-INSTANCES-OBSOLETE FUNCTION "f_mk_i_1")
      (MAKE-LIST FUNCTION "f_mk_lis") (MAKE-LOAD-FORM FUNCTION "f_mk_ld_")
      (MAKE-LOAD-FORM-SAVING-SLOTS FUNCTION "f_mk_l_1")
      (MAKE-METHOD MACRO "m_call_m") (MAKE-PACKAGE FUNCTION "f_mk_pkg")
      (MAKE-PATHNAME FUNCTION "f_mk_pn")
      (MAKE-RANDOM-STATE FUNCTION "f_mk_rnd")
      (MAKE-SEQUENCE FUNCTION "f_mk_seq") (MAKE-STRING FUNCTION "f_mk_stg")
      (MAKE-STRING-INPUT-STREAM FUNCTION "f_mk_s_1")
      (MAKE-STRING-OUTPUT-STREAM FUNCTION "f_mk_s_2")
      (MAKE-SYMBOL FUNCTION "f_mk_sym")
      (MAKE-SYNONYM-STREAM FUNCTION "f_mk_syn")
      (MAKE-TWO-WAY-STREAM FUNCTION "f_mk_two")
      (MAKUNBOUND FUNCTION "f_makunb") (MAP FUNCTION "f_map")
      (MAP-INTO FUNCTION "f_map_in") (MAPC FUNCTION "f_mapc_")
      (MAPCAN FUNCTION "f_mapc_") (MAPCAR FUNCTION "f_mapc_")
      (MAPCON FUNCTION "f_mapc_") (MAPHASH FUNCTION "f_maphas")
      (MAPL FUNCTION "f_mapc_") (MAPLIST FUNCTION "f_mapc_")
      (MASK-FIELD FUNCTION "f_mask_f") (MAX FUNCTION "f_max_m")
      (MEMBER FUNCTION "t_mem_m") (MEMBER TYPE "t_member")
      (MEMBER-IF FUNCTION "f_mem_m") (MEMBER-IF-NOT FUNCTION "f_mem_m")
      (MERGE FUNCTION "f_merge") (MERGE-PATHNAMES FUNCTION "f_merge_")
      (METHOD TYPE "t_method") (METHOD-COMBINATION CLASS "t_meth_1")
      (METHOD-COMBINATION-ERROR FUNCTION "f_meth_1")
      (METHOD-QUALIFIERS FUNCTION "f_method") (MIN FUNCTION "f_max_m")
      (MINUSP FUNCTION "f_minusp") (MISMATCH FUNCTION "f_mismat")
      (MOD FUNCTION "f_mod_r") (MOD TYPE "t_mod")
      (MOST-NEGATIVE-DOUBLE-FLOAT CONSTANT "v_most_1")
      (MOST-NEGATIVE-FIXNUM CONSTANT "v_most_p")
      (MOST-NEGATIVE-LONG-FLOAT CONSTANT "v_most_1")
      (MOST-NEGATIVE-SHORT-FLOAT CONSTANT "v_most_1")
      (MOST-NEGATIVE-SINGLE-FLOAT CONSTANT "v_most_1")
      (MOST-POSITIVE-DOUBLE-FLOAT CONSTANT "v_most_1")
      (MOST-POSITIVE-FIXNUM CONSTANT "v_most_p")
      (MOST-POSITIVE-LONG-FLOAT CONSTANT "v_most_1")
      (MOST-POSITIVE-SHORT-FLOAT CONSTANT "v_most_1")
      (MOST-POSITIVE-SINGLE-FLOAT CONSTANT "v_most_1")
      (MUFFLE-WARNING FUNCTION "f_abortc") (MUFFLE-WARNING RESTART "r_muffle")
      (MULTIPLE-VALUE-BIND MACRO "m_multip")
      (MULTIPLE-VALUE-CALL OPERATOR "s_multip")
      (MULTIPLE-VALUE-LIST MACRO "m_mult_1")
      (MULTIPLE-VALUE-PROG1 OPERATOR "s_mult_1")
      (MULTIPLE-VALUE-SETQ MACRO "m_mult_2")
      (MULTIPLE-VALUES-LIMIT CONSTANT "v_multip")
      (NAME-CHAR FUNCTION "f_name_c") (NAMESTRING FUNCTION "f_namest")
      (NBUTLAST FUNCTION "f_butlas") (NCONC FUNCTION "f_nconc")
      (NEXT-METHOD-P FUNCTION "f_next_m") (NIL CONSTANT "v_nil")
      (NIL TYPE "t_nil") (NINTERSECTION FUNCTION "f_isec_")
      (NINTH FUNCTION "f_firstc") (NO-APPLICABLE-METHOD FUNCTION "f_no_app")
      (NO-NEXT-METHOD FUNCTION "f_no_nex") (NOT FUNCTION "f_not")
      (NOT TYPE "t_not") (NOTANY FUNCTION "f_everyc")
      (NOTEVERY FUNCTION "f_everyc") (NOTINLINE DECLARATION "d_inline")
      (NRECONC FUNCTION "f_revapp") (NREVERSE FUNCTION "f_revers")
      (NSET-DIFFERENCE FUNCTION "f_set_di")
      (NSET-EXCLUSIVE-OR FUNCTION "f_set_ex")
      (NSTRING-CAPITALIZE FUNCTION "f_stg_up")
      (NSTRING-DOWNCASE FUNCTION "f_stg_up")
      (NSTRING-UPCASE FUNCTION "f_stg_up") (NSUBLIS FUNCTION "f_sublis")
      (NSUBST FUNCTION "f_substc") (NSUBST-IF FUNCTION "f_substc")
      (NSUBST-IF-NOT FUNCTION "f_substc") (NSUBSTITUTE FUNCTION "f_sbs_s")
      (NSUBSTITUTE-IF FUNCTION "f_sbs_s")
      (NSUBSTITUTE-IF-NOT FUNCTION "f_sbs_s") (NTH FUNCTION "f_nth")
      (NTH-VALUE MACRO "m_nth_va") (NTHCDR FUNCTION "f_nthcdr")
      (NULL FUNCTION "f_null") (NULL TYPE "t_null") (NUMBER TYPE "t_number")
      (NUMBERP FUNCTION "f_nump") (NUMERATOR FUNCTION "f_numera")
      (NUNION FUNCTION "f_unionc") (ODDP FUNCTION "f_evenpc")
      (OPEN FUNCTION "f_open") (OPEN-STREAM-P FUNCTION "f_open_s")
      (OPTIMIZE DECLARATION "d_optimi") (OR MACRO "m_or") (OR TYPE "t_or")
      (OTHERWISE MACRO "m_case_") (OUTPUT-STREAM-P FUNCTION "f_in_stm")
      (PACKAGE TYPE "t_pkg") (PACKAGE-ERROR CONDITION "e_pkg_er")
      (PACKAGE-ERROR-PACKAGE FUNCTION "f_pkg_er")
      (PACKAGE-NAME FUNCTION "f_pkg_na")
      (PACKAGE-NICKNAMES FUNCTION "f_pkg_ni")
      (PACKAGE-SHADOWING-SYMBOLS FUNCTION "f_pkg_sh")
      (PACKAGE-USE-LIST FUNCTION "f_pkg_us")
      (PACKAGE-USED-BY-LIST FUNCTION "f_pkg__1") (PACKAGEP FUNCTION "f_pkgp")
      (PAIRLIS FUNCTION "f_pairli") (PARSE-ERROR CONDITION "e_parse_")
      (PARSE-INTEGER FUNCTION "f_parse_")
      (PARSE-NAMESTRING FUNCTION "f_pars_1") (PATHNAME FUNCTION "f_pn")
      (PATHNAME TYPE "t_pn") (PATHNAME-DEVICE FUNCTION "f_pn_hos")
      (PATHNAME-DIRECTORY FUNCTION "f_pn_hos")
      (PATHNAME-HOST FUNCTION "f_pn_hos")
      (PATHNAME-MATCH-P FUNCTION "f_pn_mat")
      (PATHNAME-NAME FUNCTION "f_pn_hos") (PATHNAME-TYPE FUNCTION "f_pn_hos")
      (PATHNAME-VERSION FUNCTION "f_pn_hos") (PATHNAMEP FUNCTION "f_pnp")
      (PEEK-CHAR FUNCTION "f_peek_c") (PHASE FUNCTION "f_phase")
      (PI CONSTANT "v_pi") (PLUSP FUNCTION "f_minusp") (POP MACRO "m_pop")
      (POSITION FUNCTION "f_pos_p") (POSITION-IF FUNCTION "f_pos_p")
      (POSITION-IF-NOT FUNCTION "f_pos_p") (PPRINT FUNCTION "f_wr_pr")
      (PPRINT-DISPATCH FUNCTION "f_ppr_di")
      (PPRINT-EXIT-IF-LIST-EXHAUSTED MACRO "m_ppr_ex")
      (PPRINT-FILL FUNCTION "f_ppr_fi") (PPRINT-INDENT FUNCTION "f_ppr_in")
      (PPRINT-LINEAR FUNCTION "f_ppr_fi")
      (PPRINT-LOGICAL-BLOCK MACRO "m_ppr_lo")
      (PPRINT-NEWLINE FUNCTION "f_ppr_nl") (PPRINT-POP MACRO "m_ppr_po")
      (PPRINT-TAB FUNCTION "f_ppr_ta") (PPRINT-TABULAR FUNCTION "f_ppr_fi")
      (PRIN1 FUNCTION "f_wr_pr") (PRIN1-TO-STRING FUNCTION "f_wr_to_")
      (PRINC FUNCTION "f_wr_pr") (PRINC-TO-STRING FUNCTION "f_wr_to_")
      (PRINT FUNCTION "f_wr_pr") (PRINT-NOT-READABLE CONDITION "e_pr_not")
      (PRINT-NOT-READABLE-OBJECT FUNCTION "f_pr_not")
      (PRINT-OBJECT GENERIC-FUNCTION "f_pr_obj")
      (PRINT-UNREADABLE-OBJECT MACRO "m_pr_unr")
      (PROBE-FILE FUNCTION "f_probe_") (PROCLAIM FUNCTION "f_procla")
      (PROG MACRO "m_prog_") (PROG* MACRO "m_prog_") (PROG1 MACRO "m_prog1c")
      (PROG2 MACRO "m_prog1c") (PROGN OPERATOR "s_progn")
      (PROGRAM-ERROR CONDITION "e_progra") (PROGV OPERATOR "s_progv")
      (PROVIDE FUNCTION "f_provid") (PSETF FUNCTION "m_setf_")
      (PSETQ MACRO "m_psetq") (PUSH MACRO "m_push") (PUSHNEW MACRO "m_pshnew")
      (QUOTE OPERATOR "s_quote") (RANDOM FUNCTION "f_random")
      (RANDOM-STATE TYPE "t_rnd_st") (RANDOM-STATE-P FUNCTION "f_rnd_st")
      (RASSOC FUNCTION "f_rassoc") (RASSOC-IF FUNCTION "f_rassoc")
      (RASSOC-IF-NOT FUNCTION "f_rassoc") (RATIO TYPE "t_ratio")
      (RATIONAL FUNCTION "f_ration") (RATIONAL TYPE "t_ration")
      (RATIONALIZE FUNCTION "f_ration") (RATIONALP FUNCTION "f_rati_1")
      (READ FUNCTION "f_rd_rd") (READ-BYTE FUNCTION "f_rd_by")
      (READ-CHAR FUNCTION "f_rd_cha") (READ-CHAR-NO-HANG FUNCTION "f_rd_c_1")
      (READ-DELIMITED-LIST FUNCTION "f_rd_del")
      (READ-FROM-STRING FUNCTION "f_rd_fro") (READ-LINE FUNCTION "f_rd_lin")
      (READ-PRESERVING-WHITESPACE FUNCTION "f_rd_rd")
      (READ-SEQUENCE FUNCTION "f_rd_seq") (READER-ERROR CONDITION "e_rder_e")
      (READTABLE TYPE "t_rdtabl") (READTABLE-CASE FUNCTION "f_rdtabl")
      (READTABLEP FUNCTION "f_rdta_1") (REAL TYPE "t_real")
      (REALP FUNCTION "f_realp") (REALPART FUNCTION "f_realpa")
      (REDUCE FUNCTION "f_reduce") (REINITIALIZE-INSTANCE FUNCTION "f_reinit")
      (REM FUNCTION "f_mod_r") (REMF MACRO "m_remf")
      (REMHASH FUNCTION "f_remhas") (REMOVE FUNCTION "f_rm_rm")
      (REMOVE-DUPLICATES FUNCTION "f_rm_dup") (REMOVE-IF FUNCTION "f_rm_rm")
      (REMOVE-IF-NOT FUNCTION "f_rm_rm") (REMOVE-METHOD FUNCTION "f_rm_met")
      (REMPROP FUNCTION "f_rempro") (RENAME-FILE FUNCTION "f_rn_fil")
      (RENAME-PACKAGE FUNCTION "f_rn_pkg") (REPLACE FUNCTION "f_replac")
      (REQUIRE FUNCTION "f_provid") (REST FUNCTION "f_rest")
      (RESTART TYPE "t_rst")
      (RESTART-BIND MACRO
        "m_rst_bi")
      (RESTART-CASE MACRO
        "m_rst_ca")
      (RESTART-NAME FUNCTION "f_rst_na") (RETURN MACRO "m_return")
      (RETURN-FROM OPERATOR "s_ret_fr") (REVAPPEND FUNCTION "f_revapp")
      (REVERSE FUNCTION "f_revers") (ROOM FUNCTION "f_room")
      (ROTATEF MACRO "m_rotate") (ROUND FUNCTION "f_floorc")
      (ROW-MAJOR-AREF FUNCTION "f_row_ma") (RPLACA FUNCTION "f_rplaca")
      (RPLACD FUNCTION "f_rplaca") (SAFETY DECLARATION "d_optimi")
      (SATISFIES TYPE "t_satisf") (SBIT FUNCTION "f_bt_sb")
      (SCALE-FLOAT FUNCTION "f_dec_fl") (SCHAR FUNCTION "f_char_")
      (SEARCH FUNCTION "f_search") (SECOND FUNCTION "f_firstc")
      (SEQUENCE TYPE "t_seq") (SERIOUS-CONDITION CONDITION "e_seriou")
      (SET FUNCTION "f_set") (SET-DIFFERENCE FUNCTION "f_set_di")
      (SET-DISPATCH-MACRO-CHARACTER FUNCTION "f_set__1")
      (SET-EXCLUSIVE-OR FUNCTION "f_set_ex")
      (SET-MACRO-CHARACTER FUNCTION "f_set_ma")
      (SET-PPRINT-DISPATCH FUNCTION "f_set_pp")
      (SET-SYNTAX-FROM-CHAR FUNCTION "f_set_sy") (SETF MACRO "m_setf")
      (SETQ OPERATOR "s_setq") (SEVENTH FUNCTION "f_firstc")
      (SHADOW FUNCTION "f_shadow") (SHADOWING-IMPORT FUNCTION "f_shdw_i")
      (SHARED-INITIALIZE FUNCTION "f_shared") (SHIFTF MACRO "m_shiftf")
      (SHORT-FLOAT TYPE "t_short_") (SHORT-FLOAT-EPSILON CONSTANT "v_short_")
      (SHORT-FLOAT-NEGATIVE-EPSILON CONSTANT "v_short_")
      (SHORT-SITE-NAME FUNCTION "f_short_") (SIGNAL FUNCTION "f_signal")
      (SIGNED-BYTE TYPE "t_sgn_by") (SIGNUM FUNCTION "f_signum")
      (SIMPLE-ARRAY TYPE "t_smp_ar") (SIMPLE-BASE-STRING TYPE "t_smp_ba")
      (SIMPLE-BIT-VECTOR TYPE "t_smp_bt")
      (SIMPLE-BIT-VECTOR-P FUNCTION "f_smp_bt")
      (SIMPLE-CONDITION CONDITION "e_smp_cn")
      (SIMPLE-CONDITION-FORMAT-ARGUMENTS FUNCTION "f_smp_cn")
      (SIMPLE-CONDITION-FORMAT-CONTROL FUNCTION "f_smp_cn")
      (SIMPLE-ERROR CONDITION "e_smp_er") (SIMPLE-STRING TYPE "t_smp_st")
      (SIMPLE-STRING-P FUNCTION "f_smp_st")
      (SIMPLE-TYPE-ERROR CONDITION "e_smp_tp") (SIMPLE-VECTOR TYPE "t_smp_ve")
      (SIMPLE-VECTOR-P FUNCTION "f_smp_ve")
      (SIMPLE-WARNING CONDITION "e_smp_wa") (SIN FUNCTION "f_sin_c")
      (SINGLE-FLOAT TYPE "t_short_") (SINGLE-FLOAT-EPSILON CONSTANT "v_short_")
      (SINGLE-FLOAT-NEGATIVE-EPSILON CONSTANT "v_short_")
      (SINH FUNCTION "f_sinh_") (SIXTH FUNCTION "f_firstc")
      (SLEEP FUNCTION "f_sleep") (SLOT-BOUNDP FUNCTION "f_slt_bo")
      (SLOT-EXISTS-P FUNCTION "f_slt_ex") (SLOT-MAKUNBOUND FUNCTION "f_slt_ma")
      (SLOT-MISSING FUNCTION "f_slt_mi") (SLOT-UNBOUND FUNCTION "f_slt_un")
      (SLOT-VALUE FUNCTION "f_slt_va") (SOFTWARE-TYPE FUNCTION "f_sw_tpc")
      (SOFTWARE-VERSION FUNCTION "f_sw_tpc") (SOME FUNCTION "f_everyc")
      (SORT FUNCTION "f_sort_") (SPACE DECLARATION "d_optimi")
      (SPECIAL DECLARATION "d_specia") (SPECIAL-OPERATOR-P FUNCTION "f_specia")
      (SPEED DECLARATION "d_optimi") (SQRT FUNCTION "f_sqrt_")
      (STABLE-SORT FUNCTION "f_sort_") (STANDARD-CHAR TYPE "t_std_ch")
      (STANDARD-CHAR-P FUNCTION "f_std_ch") (STANDARD-CLASS TYPE "t_std_cl")
      (STANDARD-GENERIC-FUNCTION TYPE "t_std_ge")
      (STANDARD-METHOD TYPE "t_std_me") (STANDARD-OBJECT TYPE "t_std_ob")
      (STEP MACRO "m_step") (STORAGE-CONDITION CONDITION "e_storag")
      (STORE-VALUE FUNCTION "f_abortc") (STORE-VALUE RESTART "r_store")
      (STREAM TYPE "t_stream") (STREAM-ELEMENT-TYPE FUNCTION "f_stm_el")
      (STREAM-ERROR CONDITION "e_stm_er")
      (STREAM-ERROR-STREAM FUNCTION "f_stm_er")
      (STREAM-EXTERNAL-FORMAT FUNCTION "f_stm_ex") (STREAMP FUNCTION "f_stmp")
      (STRING FUNCTION "f_string") (STRING TYPE "t_string")
      (STRING-CAPITALIZE FUNCTION "f_stg_up")
      (STRING-DOWNCASE FUNCTION "f_stg_up") (STRING-EQUAL FUNCTION "f_stgeq_")
      (STRING-GREATERP FUNCTION "f_stgeq_")
      (STRING-LEFT-TRIM FUNCTION "f_stg_tr") (STRING-LESSP FUNCTION "f_stgeq_")
      (STRING-NOT-EQUAL FUNCTION "f_stgeq_")
      (STRING-NOT-GREATERP FUNCTION "f_stgeq_")
      (STRING-NOT-LESSP FUNCTION "f_stgeq_")
      (STRING-RIGHT-TRIM FUNCTION "f_stg_tr") (STRING-STREAM TYPE "t_stg_st")
      (STRING-TRIM FUNCTION "f_stg_tr") (STRING-UPCASE FUNCTION "f_stg_up")
      (STRING/= FUNCTION "f_stgeq_") (STRING< FUNCTION "f_stgeq_")
      (STRING<= FUNCTION "f_stgeq_") (STRING= FUNCTION "f_stgeq_")
      (STRING> FUNCTION "f_stgeq_") (STRING>= FUNCTION "f_stgeq_")
      (STRINGP FUNCTION "f_stgp") (STRUCTURE-CLASS TYPE "t_stu_cl")
      (STRUCTURE-OBJECT TYPE "t_stu_ob") (STYLE-WARNING CONDITION "e_style_")
      (SUBLIS FUNCTION "f_sublis") (SUBSEQ FUNCTION "f_subseq")
      (SUBSETP FUNCTION "f_subset") (SUBST FUNCTION "f_substc")
      (SUBST-IF FUNCTION "f_substc") (SUBST-IF-NOT FUNCTION "f_substc")
      (SUBSTITUTE FUNCTION "f_sbs_s") (SUBSTITUTE-IF FUNCTION "f_sbs_s")
      (SUBSTITUTE-IF-NOT FUNCTION "f_sbs_s") (SUBTYPEP FUNCTION "f_subtpp")
      (SVREF FUNCTION "f_svref") (SXHASH FUNCTION "f_sxhash")
      (SYMBOL TYPE "t_symbol") (SYMBOL-FUNCTION FUNCTION "f_symb_1")
      (SYMBOL-MACROLET OPERATOR
        "s_symbol")
      (SYMBOL-NAME FUNCTION "f_symb_2") (SYMBOL-PACKAGE FUNCTION "f_symb_3")
      (SYMBOL-PLIST FUNCTION "f_symb_4") (SYMBOL-VALUE FUNCTION "f_symb_5")
      (SYMBOLP FUNCTION "f_symbol") (SYNONYM-STREAM TYPE "t_syn_st")
      (SYNONYM-STREAM-SYMBOL FUNCTION "f_syn_st") (T CONSTANT "v_t")
      (T TYPE "t_t") (TAGBODY OPERATOR "s_tagbod") (TAILP FUNCTION "f_ldiffc")
      (TAN FUNCTION "f_sin_c") (TANH FUNCTION "f_sinh_")
      (TENTH FUNCTION "f_firstc") (TERPRI FUNCTION "f_terpri")
      (THE OPERATOR "s_the") (THIRD FUNCTION "f_firstc")
      (THROW OPERATOR "s_throw") (TIME MACRO "m_time") (TRACE MACRO "m_tracec")
      (TRANSLATE-LOGICAL-PATHNAME FUNCTION "f_tr_log")
      (TRANSLATE-PATHNAME FUNCTION "f_tr_pn") (TREE-EQUAL FUNCTION "f_tree_e")
      (TRUENAME FUNCTION "f_tn") (TRUNCATE FUNCTION "f_floorc")
      (TWO-WAY-STREAM TYPE "t_two_wa")
      (TWO-WAY-STREAM-INPUT-STREAM FUNCTION "f_two_wa")
      (TWO-WAY-STREAM-OUTPUT-STREAM FUNCTION "f_two_wa")
      (TYPE DECLARATION "d_type") (TYPE-ERROR CONDITION "e_tp_err")
      (TYPE-ERROR-DATUM FUNCTION "f_tp_err")
      (TYPE-ERROR-EXPECTED-TYPE FUNCTION "f_tp_err")
      (TYPE-OF FUNCTION "f_tp_of") (TYPECASE MACRO "m_tpcase")
      (TYPEP FUNCTION "f_typep") (UNBOUND-SLOT CONDITION "e_unboun")
      (UNBOUND-SLOT-INSTANCE FUNCTION "f_unboun")
      (UNBOUND-VARIABLE CONDITION "e_unbo_1")
      (UNDEFINED-FUNCTION CONDITION "e_undefi") (UNEXPORT FUNCTION "f_unexpo")
      (UNINTERN FUNCTION "f_uninte") (UNION FUNCTION "f_unionc")
      (UNLESS MACRO "m_when_") (UNREAD-CHAR FUNCTION "f_unrd_c")
      (UNSIGNED-BYTE TYPE "t_unsgn_") (UNTRACE MACRO "m_tracec")
      (UNUSE-PACKAGE FUNCTION "f_unuse_") (UNWIND-PROTECT OPERATOR "s_unwind")
      (UPDATE-INSTANCE-FOR-DIFFERENT-CLASS FUNCTION "f_update")
      (UPDATE-INSTANCE-FOR-REDEFINED-CLASS FUNCTION "f_upda_1")
      (UPGRADED-ARRAY-ELEMENT-TYPE FUNCTION "f_upgr_1")
      (UPGRADED-COMPLEX-PART-TYPE FUNCTION "f_upgrad")
      (UPPER-CASE-P FUNCTION "f_upper_") (USE-PACKAGE FUNCTION "f_use_pk")
      (USE-VALUE FUNCTION "f_abortc") (USE-VALUE RESTART "r_use_va")
      (USER-HOMEDIR-PATHNAME FUNCTION "f_user_h") (VALUES FUNCTION "f_values")
      (VALUES TYPE "t_values") (VALUES-LIST FUNCTION "f_vals_l")
      (VECTOR FUNCTION "f_vector") (VECTOR TYPE "t_vector")
      (VECTOR-POP FUNCTION "f_vec_po") (VECTOR-PUSH FUNCTION "f_vec_ps")
      (VECTOR-PUSH-EXTEND FUNCTION "f_vec_ps") (VECTORP FUNCTION "f_vecp")
      (WARN FUNCTION "f_warn") (WARNING CONDITION "e_warnin")
      (WHEN MACRO "m_when_") (WILD-PATHNAME-P FUNCTION "f_wild_p")
      (WITH-ACCESSORS MACRO
          "m_w_acce")
      (WITH-COMPILATION-UNIT MACRO "m_w_comp")
      (WITH-CONDITION-RESTARTS MACRO
          "m_w_cnd_")
      (WITH-HASH-TABLE-ITERATOR MACRO "m_w_hash")
      (WITH-INPUT-FROM-STRING MACRO "m_w_in_f")
      (WITH-OPEN-FILE MACRO "m_w_open") (WITH-OPEN-STREAM MACRO "m_w_op_1")
      (WITH-OUTPUT-TO-STRING MACRO "m_w_out_")
      (WITH-PACKAGE-ITERATOR MACRO "m_w_pkg_")
      (WITH-SIMPLE-RESTART MACRO "m_w_smp_")
      (WITH-SLOTS MACRO
          "m_w_slts")
      (WITH-STANDARD-IO-SYNTAX MACRO "m_w_std_") (WRITE FUNCTION "f_wr_pr")
      (WRITE-BYTE FUNCTION "f_wr_by") (WRITE-CHAR FUNCTION "f_wr_cha")
      (WRITE-LINE FUNCTION "f_wr_stg") (WRITE-SEQUENCE FUNCTION "f_wr_seq")
      (WRITE-STRING FUNCTION "f_wr_stg") (WRITE-TO-STRING FUNCTION "f_wr_to_")
      (Y-OR-N-P FUNCTION "f_y_or_n") (YES-OR-NO-P FUNCTION "f_y_or_n")
      (ZEROP FUNCTION "f_zerop")))

[mgl-pax/src/navigate/locatives.lisp:811]
  (DEFVAR *ANSI-DECLARATIONS*
    '(COMPILATION-SPEED DEBUG DECLARATION DYNAMIC-EXTENT FTYPE IGNORABLE IGNORE
      INLINE NOTINLINE OPTIMIZE SAFETY SPACE SPECIAL SPEED TYPE))

[minheap/splay-heap.lisp:48]
  (DEFUN SEGMENT< (A B)
    (DECLARE (TYPE (OR NULL FIXNUM) A B)
             (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (COND ((NULL B) NIL) ((NULL A) T) (T (< (THE FIXNUM A) (THE FIXNUM B)))))

[minheap/splay-heap.lisp:60]
  (DEFUN SEGMENT> (A B)
    (DECLARE (TYPE (OR NULL FIXNUM) A B)
             (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (COND ((NULL A) NIL) ((NULL B) T) (T (> (THE FIXNUM A) (THE FIXNUM B)))))

[minheap/splay-heap.lisp:71]
  (DEFUN SPLAY-TREE-SPLAY (TREE SEGMENT)
    (DECLARE (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (WHEN TREE
      (LET ((MIDDLE (MAKE-SPLAY-NODE :LEFT NIL :RIGHT NIL)))
        (DECLARE (DYNAMIC-EXTENT MIDDLE))
        (LET ((LEFT MIDDLE) (RIGHT MIDDLE) TMP)
          (LOOP FOR CUR-SEG = (SPLAY-NODE-SEGMENT TREE)
                WHILE (AND CUR-SEG (/= (THE FIXNUM SEGMENT) CUR-SEG))
                DO (COND
                    ((SEGMENT< SEGMENT CUR-SEG)
                     (WHEN
                         (AND (SPLAY-NODE-LEFT TREE)
                              (SEGMENT< SEGMENT
                               (SPLAY-NODE-SEGMENT (SPLAY-NODE-LEFT TREE))))
                       (SETF TMP (SPLAY-NODE-LEFT TREE)
                             (SPLAY-NODE-LEFT TREE) (SPLAY-NODE-RIGHT TMP)
                             (SPLAY-NODE-RIGHT TMP) TREE
                             TREE TMP))
                     (UNLESS (SPLAY-NODE-LEFT TREE) (RETURN))
                     (SETF (SPLAY-NODE-LEFT RIGHT) TREE
                           RIGHT TREE
                           TREE (SPLAY-NODE-LEFT TREE)))
                    (T
                     (WHEN
                         (AND (SPLAY-NODE-RIGHT TREE)
                              (SEGMENT> SEGMENT
                               (SPLAY-NODE-SEGMENT (SPLAY-NODE-RIGHT TREE))))
                       (SETF TMP (SPLAY-NODE-RIGHT TREE)
                             (SPLAY-NODE-RIGHT TREE) (SPLAY-NODE-LEFT TMP)
                             (SPLAY-NODE-LEFT TMP) TREE
                             TREE TMP))
                     (UNLESS (SPLAY-NODE-RIGHT TREE) (RETURN))
                     (SETF (SPLAY-NODE-RIGHT LEFT) TREE
                           LEFT TREE
                           TREE (SPLAY-NODE-RIGHT TREE)))))
          (SETF (SPLAY-NODE-RIGHT LEFT) (SPLAY-NODE-LEFT TREE)
                (SPLAY-NODE-LEFT RIGHT) (SPLAY-NODE-RIGHT TREE)
                (SPLAY-NODE-LEFT TREE) (SPLAY-NODE-RIGHT MIDDLE)
                (SPLAY-NODE-RIGHT TREE) (SPLAY-NODE-LEFT MIDDLE))
          TREE))))

[minheap/splay-heap.lisp:116]
  (DEFUN SPLAY-TREE-INSERT (TREE SEGMENT ELEMENT &OPTIONAL (OVERWRITE NIL))
    (DECLARE (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (LET ((NEW (MAKE-SPLAY-NODE :SEGMENT SEGMENT :ELEMENT ELEMENT)))
      (IF (NULL TREE)
          (VALUES NEW T)
          (LET ((TREE (SPLAY-TREE-SPLAY TREE SEGMENT)))
            (COND
             ((SEGMENT< SEGMENT (SPLAY-NODE-SEGMENT TREE))
              (SETF (SPLAY-NODE-LEFT NEW) (SPLAY-NODE-LEFT TREE)
                    (SPLAY-NODE-RIGHT NEW) TREE
                    (SPLAY-NODE-LEFT TREE) NIL)
              (VALUES NEW T))
             ((SEGMENT> SEGMENT (SPLAY-NODE-SEGMENT TREE))
              (SETF (SPLAY-NODE-RIGHT NEW) (SPLAY-NODE-RIGHT TREE)
                    (SPLAY-NODE-LEFT NEW) TREE
                    (SPLAY-NODE-RIGHT TREE) NIL)
              (VALUES NEW T))
             (T (WHEN OVERWRITE (SETF (SPLAY-NODE-ELEMENT TREE) ELEMENT))
              (VALUES TREE NIL)))))))

[minheap/splay-heap.lisp:138]
  (DEFUN SPLAY-TREE-DELETE (TREE SEGMENT)
    (DECLARE (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0)))
    (WHEN TREE
      (LET ((TREE (SPLAY-TREE-SPLAY TREE SEGMENT)))
        (COND
         ((= (THE FIXNUM SEGMENT) (THE FIXNUM (SPLAY-NODE-SEGMENT TREE)))
          (IF (NULL (SPLAY-NODE-LEFT TREE))
              (VALUES (SPLAY-NODE-RIGHT TREE) T)
              (LET ((RESULT (SPLAY-TREE-SPLAY (SPLAY-NODE-LEFT TREE) SEGMENT)))
                (SETF (SPLAY-NODE-RIGHT RESULT) (SPLAY-NODE-RIGHT TREE))
                (VALUES RESULT T))))
         (T (VALUES TREE NIL))))))

[mu/accessors.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0) (COMPILATION-SPEED 0)))

[mu/lhstats.lisp:103]
  (EVAL-WHEN (:COMPILE-TOPLEVEL)
    (DECLAIM (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))))

[mu/lhstats.lisp:1405]
  (DEFUN GAMMA-INCOMPLETE (A X)
    "Adopted from CLASP 1.4.3, http://eksl-www.cs.umass.edu/clasp.html"
    (DECLARE (OPTIMIZE (SAFETY 3)))
    (SETQ A (COERCE A 'DOUBLE-FLOAT))
    (LET ((GLN (THE DOUBLE-FLOAT (GAMMA-LN A))))
      (WHEN (= X 0.0) (RETURN-FROM GAMMA-INCOMPLETE (VALUES 0.0d0 GLN)))
      (IF (< X (+ A 1.0d0))
          (LET* ((ITMAX 1000) (EPS 3.0d-7) (AP A) (SUM (/ 1.0d0 A)) (DEL SUM))
            (DECLARE (TYPE DOUBLE-FLOAT AP SUM DEL))
            (DOTIMES (I ITMAX)
              (INCF AP 1.0d0)
              (SETF DEL (* DEL (/ X AP)))
              (INCF SUM DEL)
              (IF (< (ABS DEL) (* EPS (ABS SUM)))
                  (LET ((RESULT
                         (UNDERFLOW-GOES-TO-ZERO
                          (* SUM (SAFE-EXP (- (* A (LOG X)) X GLN))))))
                    (RETURN-FROM GAMMA-INCOMPLETE (VALUES RESULT GLN)))))
            (ERROR "Series didn't converge:~%~
                  Either a=~s is too large, or ITMAX=~d is too small."
                   A ITMAX))
          (LET ((ITMAX 1000)
                (EPS 3.0e-7)
                (GOLD 0.0d0)
                (G 0.0d0)
                (FAC 1.0d0)
                (B1 1.0d0)
                (B0 0.0d0)
                (ANF 0.0d0)
                (ANA 0.0d0)
                (AN 0.0d0)
                (A1 X)
                (A0 1.0d0))
            (DECLARE (TYPE DOUBLE-FLOAT GOLD G FAC B1 B0 ANF ANA AN A1 A0))
            (DOTIMES (I ITMAX)
              (SETF AN (COERCE (1+ I) 'DOUBLE-FLOAT)
                    ANA (- AN A)
                    A0 (* FAC (+ A1 (* A0 ANA)))
                    B0 (* FAC (+ B1 (* B0 ANA)))
                    ANF (* FAC AN)
                    A1 (+ (* X A0) (* ANF A1))
                    B1 (+ (* X B0) (* ANF B1)))
              (UNLESS (ZEROP A1)
                (SETF FAC (/ 1.0d0 A1)
                      G (* B1 FAC))
                (IF (< (ABS (/ (- G GOLD) G)) EPS)
                    (LET ((RESULT
                           (UNDERFLOW-GOES-TO-ZERO
                            (* (SAFE-EXP (- (* A (LOG X)) X GLN)) G))))
                      (RETURN-FROM GAMMA-INCOMPLETE
                        (VALUES (- 1.0 RESULT) GLN)))
                    (SETF GOLD G))))
            (ERROR "Continued Fraction didn't converge:~%~
                  Either a=~s is too large, or ITMAX=~d is too small."
                   A ITMAX)))))

[mu/macros.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0) (COMPILATION-SPEED 0)))

[mu/misc.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0) (COMPILATION-SPEED 0)))

[mu/seq.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0) (COMPILATION-SPEED 0)))

[mu/stats.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0) (COMPILATION-SPEED 0)))

[mu/stats.lisp:234]
  (DEFUN GAMMA-INCOMPLETE (A X)
    "Adopted from CLASP 1.4.3, http://eksl-www.cs.umass.edu/clasp.html"
    (DECLARE (OPTIMIZE (SAFETY 3)))
    (SETQ A (COERCE A 'DOUBLE-FLOAT))
    (LET ((GLN (THE DOUBLE-FLOAT (GAMMA-LN A))))
      (WHEN (= X 0.0) (RETURN-FROM GAMMA-INCOMPLETE (VALUES 0.0d0 GLN)))
      (IF (< X (+ A 1.0d0))
          (LET* ((ITMAX 1000) (EPS 3.0d-7) (AP A) (SUM (/ 1.0d0 A)) (DEL SUM))
            (DECLARE (TYPE DOUBLE-FLOAT AP SUM DEL))
            (DOTIMES (I ITMAX)
              (INCF AP 1.0d0)
              (SETF DEL (* DEL (/ X AP)))
              (INCF SUM DEL)
              (IF (< (ABS DEL) (* EPS (ABS SUM)))
                  (LET ((RESULT
                         (UNDERFLOW-GOES-TO-ZERO
                          (* SUM (SAFE-EXP (- (* A (LOG X)) X GLN))))))
                    (RETURN-FROM GAMMA-INCOMPLETE (VALUES RESULT GLN)))))
            (ERROR "Series didn't converge:~%~
                  Either a=~s is too large, or ITMAX=~d is too small."
                   A ITMAX))
          (LET ((ITMAX 1000)
                (EPS 3.0e-7)
                (GOLD 0.0d0)
                (G 0.0d0)
                (FAC 1.0d0)
                (B1 1.0d0)
                (B0 0.0d0)
                (ANF 0.0d0)
                (ANA 0.0d0)
                (AN 0.0d0)
                (A1 X)
                (A0 1.0d0))
            (DECLARE (TYPE DOUBLE-FLOAT GOLD G FAC B1 B0 ANF ANA AN A1 A0))
            (DOTIMES (I ITMAX)
              (SETF AN (COERCE (1+ I) 'DOUBLE-FLOAT)
                    ANA (- AN A)
                    A0 (* FAC (+ A1 (* A0 ANA)))
                    B0 (* FAC (+ B1 (* B0 ANA)))
                    ANF (* FAC AN)
                    A1 (+ (* X A0) (* ANF A1))
                    B1 (+ (* X B0) (* ANF B1)))
              (UNLESS (ZEROP A1)
                (SETF FAC (/ 1.0d0 A1)
                      G (* B1 FAC))
                (IF (< (ABS (/ (- G GOLD) G)) EPS)
                    (LET ((RESULT
                           (UNDERFLOW-GOES-TO-ZERO
                            (* (SAFE-EXP (- (* A (LOG X)) X GLN)) G))))
                      (RETURN-FROM GAMMA-INCOMPLETE
                        (VALUES (- 1.0 RESULT) GLN)))
                    (SETF GOLD G))))
            (ERROR "Continued Fraction didn't converge:~%~
                  Either a=~s is too large, or ITMAX=~d is too small."
                   A ITMAX)))))

[mu/table.lisp:1]
  (DECLAIM (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 0) (COMPILATION-SPEED 0)))

[nibbles/vectors.lisp:108]
  (DEFUN IEEE-SINGLE-REF/BE (VECTOR INDEX)
    (#S(FORMGREP:SYMREF :NAME "MAKE-SINGLE-FLOAT" :QUALIFIER "SYSTEM")
     (SB32REF/BE VECTOR INDEX))
    (LET ((HIGH (UB16REF/BE VECTOR INDEX))
          (LOW (UB16REF/BE VECTOR (+ INDEX 2))))
      (#S(FORMGREP:SYMREF :NAME "SHORTS-TO-SINGLE-FLOAT" :QUALIFIER "EXCL")
       HIGH LOW))
    (#S(FORMGREP:SYMREF
        :NAME "HOST-SINGLE-FLOAT-FROM-UNSIGNED-BYTE-32"
        :QUALIFIER "CCL")
     (UB32REF/BE VECTOR INDEX))
    (#S(FORMGREP:SYMREF :NAME "MAKE-SINGLE-FLOAT" :QUALIFIER "KERNEL")
     (SB32REF/BE VECTOR INDEX))
    (LET* ((UB (UB32REF/BE VECTOR INDEX))
           (V
            (#S(FORMGREP:SYMREF
                :NAME "MAKE-TYPED-AREF-VECTOR"
                :QUALIFIER "SYS")
             4)))
      (DECLARE (OPTIMIZE (SPEED 3) (FLOAT 0) (SAFETY 0)))
      (DECLARE (DYNAMIC-EXTENT V))
      (SETF (#S(FORMGREP:SYMREF :NAME "TYPED-AREF" :QUALIFIER "SYS")
             '(UNSIGNED-BYTE 32) V 0)
              UB)
      (#S(FORMGREP:SYMREF :NAME "TYPED-AREF" :QUALIFIER "SYS") 'SINGLE-FLOAT V
       0))
    (SB-KERNEL:MAKE-SINGLE-FLOAT (SB32REF/BE VECTOR INDEX)))

[nibbles/vectors.lisp:132]
  (DEFUN IEEE-SINGLE-SET/BE (VECTOR INDEX VALUE)
    (PROGN
     (SETF (SB32REF/BE VECTOR INDEX)
             (#S(FORMGREP:SYMREF :NAME "SINGLE-FLOAT-BITS" :QUALIFIER "SYSTEM")
              VALUE))
     VALUE)
    (MULTIPLE-VALUE-BIND (HIGH LOW)
        (#S(FORMGREP:SYMREF :NAME "SINGLE-FLOAT-TO-SHORTS" :QUALIFIER "EXCL")
         VALUE)
      (SETF (UB16REF/BE VECTOR INDEX) HIGH
            (UB16REF/BE VECTOR (+ INDEX 2)) LOW)
      VALUE)
    (PROGN
     (SETF (UB32REF/BE VECTOR INDEX)
             (#S(FORMGREP:SYMREF :NAME "SINGLE-FLOAT-BITS" :QUALIFIER "CCL")
              VALUE))
     VALUE)
    (PROGN
     (SETF (SB32REF/BE VECTOR INDEX)
             (#S(FORMGREP:SYMREF :NAME "SINGLE-FLOAT-BITS" :QUALIFIER "KERNEL")
              VALUE))
     VALUE)
    (LET* ((V
            (#S(FORMGREP:SYMREF
                :NAME "MAKE-TYPED-AREF-VECTOR"
                :QUALIFIER "SYS")
             4)))
      (DECLARE (OPTIMIZE (SPEED 3) (FLOAT 0) (SAFETY 0)))
      (DECLARE (DYNAMIC-EXTENT V))
      (SETF (#S(FORMGREP:SYMREF :NAME "TYPED-AREF" :QUALIFIER "SYS")
             'SINGLE-FLOAT V 0)
              VALUE)
      (SETF (UB32REF/BE VECTOR INDEX)
              (#S(FORMGREP:SYMREF :NAME "TYPED-AREF" :QUALIFIER "SYS")
               '(UNSIGNED-BYTE 32) V 0))
      VALUE)
    (PROGN
     (SETF (SB32REF/BE VECTOR INDEX) (SB-KERNEL:SINGLE-FLOAT-BITS VALUE))
     VALUE))

[nibbles/vectors.lisp:168]
  (DEFUN IEEE-SINGLE-REF/LE (VECTOR INDEX)
    (#S(FORMGREP:SYMREF :NAME "MAKE-SINGLE-FLOAT" :QUALIFIER "SYSTEM")
     (SB32REF/LE VECTOR INDEX))
    (LET ((LOW (UB16REF/LE VECTOR INDEX))
          (HIGH (UB16REF/LE VECTOR (+ INDEX 2))))
      (#S(FORMGREP:SYMREF :NAME "SHORTS-TO-SINGLE-FLOAT" :QUALIFIER "EXCL")
       HIGH LOW))
    (#S(FORMGREP:SYMREF
        :NAME "HOST-SINGLE-FLOAT-FROM-UNSIGNED-BYTE-32"
        :QUALIFIER "CCL")
     (UB32REF/LE VECTOR INDEX))
    (#S(FORMGREP:SYMREF :NAME "MAKE-SINGLE-FLOAT" :QUALIFIER "KERNEL")
     (SB32REF/LE VECTOR INDEX))
    (LET* ((UB (UB32REF/LE VECTOR INDEX))
           (V
            (#S(FORMGREP:SYMREF
                :NAME "MAKE-TYPED-AREF-VECTOR"
                :QUALIFIER "SYS")
             4)))
      (DECLARE (OPTIMIZE (SPEED 3) (FLOAT 0) (SAFETY 0)))
      (DECLARE (DYNAMIC-EXTENT V))
      (SETF (#S(FORMGREP:SYMREF :NAME "TYPED-AREF" :QUALIFIER "SYS")
             '(UNSIGNED-BYTE 32) V 0)
              UB)
      (#S(FORMGREP:SYMREF :NAME "TYPED-AREF" :QUALIFIER "SYS") 'SINGLE-FLOAT V
       0))
    (SB-KERNEL:MAKE-SINGLE-FLOAT (SB32REF/LE VECTOR INDEX)))

[nibbles/vectors.lisp:193]
  (DEFUN IEEE-SINGLE-SET/LE (VECTOR INDEX VALUE)
    (PROGN
     (SETF (SB32REF/LE VECTOR INDEX)
             (#S(FORMGREP:SYMREF :NAME "SINGLE-FLOAT-BITS" :QUALIFIER "SYSTEM")
              VALUE))
     VALUE)
    (MULTIPLE-VALUE-BIND (HIGH LOW)
        (#S(FORMGREP:SYMREF :NAME "SINGLE-FLOAT-TO-SHORTS" :QUALIFIER "EXCL")
         VALUE)
      (SETF (UB16REF/LE VECTOR INDEX) LOW
            (UB16REF/LE VECTOR (+ INDEX 2)) HIGH)
      VALUE)
    (PROGN
     (SETF (UB32REF/LE VECTOR INDEX)
             (#S(FORMGREP:SYMREF :NAME "SINGLE-FLOAT-BITS" :QUALIFIER "CCL")
              VALUE))
     VALUE)
    (PROGN
     (SETF (SB32REF/LE VECTOR INDEX)
             (#S(FORMGREP:SYMREF :NAME "SINGLE-FLOAT-BITS" :QUALIFIER "KERNEL")
              VALUE))
     VALUE)
    (LET* ((V
            (#S(FORMGREP:SYMREF
                :NAME "MAKE-TYPED-AREF-VECTOR"
                :QUALIFIER "SYS")
             4)))
      (DECLARE (OPTIMIZE (SPEED 3) (FLOAT 0) (SAFETY 0)))
      (DECLARE (DYNAMIC-EXTENT V))
      (SETF (#S(FORMGREP:SYMREF :NAME "TYPED-AREF" :QUALIFIER "SYS")
             'SINGLE-FLOAT V 0)
              VALUE)
      (SETF (UB32REF/LE VECTOR INDEX)
              (#S(FORMGREP:SYMREF :NAME "TYPED-AREF" :QUALIFIER "SYS")
               '(UNSIGNED-BYTE 32) V 0))
      VALUE)
    (PROGN
     (SETF (SB32REF/LE VECTOR INDEX) (SB-KERNEL:SINGLE-FLOAT-BITS VALUE))
     VALUE))

[nibbles/vectors.lisp:229]
  (DEFUN IEEE-DOUBLE-REF/BE (VECTOR INDEX)
    (LET ((UPPER (SB32REF/BE VECTOR INDEX))
          (LOWER (UB32REF/BE VECTOR (+ INDEX 4))))
      (#S(FORMGREP:SYMREF :NAME "MAKE-DOUBLE-FLOAT" :QUALIFIER "SYSTEM")
       (LOGIOR (ASH UPPER 32) LOWER)))
    (LET ((U3 (UB16REF/BE VECTOR INDEX))
          (U2 (UB16REF/BE VECTOR (+ INDEX 2)))
          (U1 (UB16REF/BE VECTOR (+ INDEX 4)))
          (U0 (UB16REF/BE VECTOR (+ INDEX 6))))
      (#S(FORMGREP:SYMREF :NAME "SHORTS-TO-DOUBLE-FLOAT" :QUALIFIER "EXCL") U3
       U2 U1 U0))
    (LET ((UPPER (UB32REF/BE VECTOR INDEX))
          (LOWER (UB32REF/BE VECTOR (+ INDEX 4))))
      (#S(FORMGREP:SYMREF :NAME "DOUBLE-FLOAT-FROM-BITS" :QUALIFIER "CCL")
       UPPER LOWER))
    (LET ((UPPER (SB32REF/BE VECTOR INDEX))
          (LOWER (UB32REF/BE VECTOR (+ INDEX 4))))
      (#S(FORMGREP:SYMREF :NAME "MAKE-DOUBLE-FLOAT" :QUALIFIER "KERNEL") UPPER
       LOWER))
    (LET* ((UPPER (UB32REF/BE VECTOR INDEX))
           (LOWER (UB32REF/BE VECTOR (+ INDEX 4)))
           (V
            (#S(FORMGREP:SYMREF
                :NAME "MAKE-TYPED-AREF-VECTOR"
                :QUALIFIER "SYS")
             8)))
      (DECLARE (OPTIMIZE (SPEED 3) (FLOAT 0) (SAFETY 0)))
      (DECLARE (DYNAMIC-EXTENT V))
      (PROGN
       (SETF (#S(FORMGREP:SYMREF :NAME "TYPED-AREF" :QUALIFIER "SYS")
              '(UNSIGNED-BYTE 32) V 0)
               LOWER)
       (SETF (#S(FORMGREP:SYMREF :NAME "TYPED-AREF" :QUALIFIER "SYS")
              '(UNSIGNED-BYTE 32) V 4)
               UPPER))
      (#S(FORMGREP:SYMREF :NAME "TYPED-AREF" :QUALIFIER "SYS") 'DOUBLE-FLOAT V
       0))
    (LET ((UPPER (SB32REF/BE VECTOR INDEX))
          (LOWER (UB32REF/BE VECTOR (+ INDEX 4))))
      (SB-KERNEL:MAKE-DOUBLE-FLOAT UPPER LOWER)))

[nibbles/vectors.lisp:273]
  (DEFUN IEEE-DOUBLE-SET/BE (VECTOR INDEX VALUE)
    (PROGN
     (SETF (UB32REF/BE VECTOR INDEX)
             (#S(FORMGREP:SYMREF
                 :NAME "DOUBLE-FLOAT-HIGH-BITS"
                 :QUALIFIER "SYSTEM")
              VALUE)
           (UB32REF/BE VECTOR (+ INDEX 4))
             (#S(FORMGREP:SYMREF
                 :NAME "DOUBLE-FLOAT-LOW-BITS"
                 :QUALIFIER "SYSTEM")
              VALUE))
     VALUE)
    (MULTIPLE-VALUE-BIND (US3 US2 US1 US0)
        (#S(FORMGREP:SYMREF :NAME "DOUBLE-FLOAT-TO-SHORTS" :QUALIFIER "EXCL")
         VALUE)
      (SETF (UB16REF/BE VECTOR INDEX) US3
            (UB16REF/BE VECTOR (+ INDEX 2)) US2
            (UB16REF/BE VECTOR (+ INDEX 4)) US1
            (UB16REF/BE VECTOR (+ INDEX 6)) US0)
      VALUE)
    (MULTIPLE-VALUE-BIND (HIGH LOW)
        (#S(FORMGREP:SYMREF :NAME "DOUBLE-FLOAT-BITS" :QUALIFIER "CCL") VALUE)
      (SETF (UB32REF/BE VECTOR INDEX) HIGH
            (UB32REF/BE VECTOR (+ INDEX 4)) LOW)
      VALUE)
    (PROGN
     (SETF (SB32REF/BE VECTOR INDEX)
             (#S(FORMGREP:SYMREF
                 :NAME "DOUBLE-FLOAT-HIGH-BITS"
                 :QUALIFIER "KERNEL")
              VALUE)
           (UB32REF/BE VECTOR (+ INDEX 4))
             (#S(FORMGREP:SYMREF
                 :NAME "DOUBLE-FLOAT-LOW-BITS"
                 :QUALIFIER "KERNEL")
              VALUE))
     VALUE)
    (LET* ((V
            (#S(FORMGREP:SYMREF
                :NAME "MAKE-TYPED-AREF-VECTOR"
                :QUALIFIER "SYS")
             8)))
      (DECLARE (OPTIMIZE (SPEED 3) (FLOAT 0) (SAFETY 0)))
      (DECLARE (DYNAMIC-EXTENT V))
      (SETF (#S(FORMGREP:SYMREF :NAME "TYPED-AREF" :QUALIFIER "SYS")
             'DOUBLE-FLOAT V 0)
              VALUE)
      (PROGN
       (SETF (UB32REF/BE VECTOR INDEX)
               (#S(FORMGREP:SYMREF :NAME "TYPED-AREF" :QUALIFIER "SYS")
                '(UNSIGNED-BYTE 32) V 4)
             (UB32REF/BE VECTOR (+ INDEX 4))
               (#S(FORMGREP:SYMREF :NAME "TYPED-AREF" :QUALIFIER "SYS")
                '(UNSIGNED-BYTE 32) V 0)))
      VALUE)
    (PROGN
     (SETF (SB32REF/BE VECTOR INDEX) (SB-KERNEL:DOUBLE-FLOAT-HIGH-BITS VALUE)
           (UB32REF/BE VECTOR (+ INDEX 4))
             (SB-KERNEL:DOUBLE-FLOAT-LOW-BITS VALUE))
     VALUE))

[nibbles/vectors.lisp:323]
  (DEFUN IEEE-DOUBLE-REF/LE (VECTOR INDEX)
    (LET ((LOWER (UB32REF/LE VECTOR INDEX))
          (UPPER (SB32REF/LE VECTOR (+ INDEX 4))))
      (#S(FORMGREP:SYMREF :NAME "MAKE-DOUBLE-FLOAT" :QUALIFIER "SYSTEM")
       (LOGIOR (ASH UPPER 32) LOWER)))
    (LET ((U0 (UB16REF/LE VECTOR INDEX))
          (U1 (UB16REF/LE VECTOR (+ INDEX 2)))
          (U2 (UB16REF/LE VECTOR (+ INDEX 4)))
          (U3 (UB16REF/LE VECTOR (+ INDEX 6))))
      (#S(FORMGREP:SYMREF :NAME "SHORTS-TO-DOUBLE-FLOAT" :QUALIFIER "EXCL") U3
       U2 U1 U0))
    (LET ((LOWER (UB32REF/LE VECTOR INDEX))
          (UPPER (UB32REF/LE VECTOR (+ INDEX 4))))
      (#S(FORMGREP:SYMREF :NAME "DOUBLE-FLOAT-FROM-BITS" :QUALIFIER "CCL")
       UPPER LOWER))
    (LET ((LOWER (UB32REF/LE VECTOR INDEX))
          (UPPER (SB32REF/LE VECTOR (+ INDEX 4))))
      (#S(FORMGREP:SYMREF :NAME "MAKE-DOUBLE-FLOAT" :QUALIFIER "KERNEL") UPPER
       LOWER))
    (LET* ((LOWER (UB32REF/LE VECTOR INDEX))
           (UPPER (UB32REF/LE VECTOR (+ INDEX 4)))
           (V
            (#S(FORMGREP:SYMREF
                :NAME "MAKE-TYPED-AREF-VECTOR"
                :QUALIFIER "SYS")
             8)))
      (DECLARE (OPTIMIZE (SPEED 3) (FLOAT 0) (SAFETY 0)))
      (DECLARE (DYNAMIC-EXTENT V))
      (PROGN
       (SETF (#S(FORMGREP:SYMREF :NAME "TYPED-AREF" :QUALIFIER "SYS")
              '(UNSIGNED-BYTE 32) V 0)
               LOWER)
       (SETF (#S(FORMGREP:SYMREF :NAME "TYPED-AREF" :QUALIFIER "SYS")
              '(UNSIGNED-BYTE 32) V 4)
               UPPER))
      (#S(FORMGREP:SYMREF :NAME "TYPED-AREF" :QUALIFIER "SYS") 'DOUBLE-FLOAT V
       0))
    (LET ((LOWER (UB32REF/LE VECTOR INDEX))
          (UPPER (SB32REF/LE VECTOR (+ INDEX 4))))
      (SB-KERNEL:MAKE-DOUBLE-FLOAT UPPER LOWER)))

[nibbles/vectors.lisp:367]
  (DEFUN IEEE-DOUBLE-SET/LE (VECTOR INDEX VALUE)
    (PROGN
     (SETF (UB32REF/LE VECTOR INDEX)
             (#S(FORMGREP:SYMREF
                 :NAME "DOUBLE-FLOAT-LOW-BITS"
                 :QUALIFIER "SYSTEM")
              VALUE)
           (UB32REF/LE VECTOR (+ INDEX 4))
             (#S(FORMGREP:SYMREF
                 :NAME "DOUBLE-FLOAT-HIGH-BITS"
                 :QUALIFIER "SYSTEM")
              VALUE))
     VALUE)
    (MULTIPLE-VALUE-BIND (US3 US2 US1 US0)
        (#S(FORMGREP:SYMREF :NAME "DOUBLE-FLOAT-TO-SHORTS" :QUALIFIER "EXCL")
         VALUE)
      (SETF (UB16REF/LE VECTOR INDEX) US0
            (UB16REF/LE VECTOR (+ INDEX 2)) US1
            (UB16REF/LE VECTOR (+ INDEX 4)) US2
            (UB16REF/LE VECTOR (+ INDEX 6)) US3)
      VALUE)
    (MULTIPLE-VALUE-BIND (HIGH LOW)
        (#S(FORMGREP:SYMREF :NAME "DOUBLE-FLOAT-BITS" :QUALIFIER "CCL") VALUE)
      (SETF (UB32REF/LE VECTOR INDEX) LOW
            (UB32REF/LE VECTOR (+ INDEX 4)) HIGH)
      VALUE)
    (PROGN
     (SETF (UB32REF/LE VECTOR INDEX)
             (#S(FORMGREP:SYMREF
                 :NAME "DOUBLE-FLOAT-LOW-BITS"
                 :QUALIFIER "KERNEL")
              VALUE)
           (SB32REF/LE VECTOR (+ INDEX 4))
             (#S(FORMGREP:SYMREF
                 :NAME "DOUBLE-FLOAT-HIGH-BITS"
                 :QUALIFIER "KERNEL")
              VALUE))
     VALUE)
    (LET* ((V
            (#S(FORMGREP:SYMREF
                :NAME "MAKE-TYPED-AREF-VECTOR"
                :QUALIFIER "SYS")
             8)))
      (DECLARE (OPTIMIZE (SPEED 3) (FLOAT 0) (SAFETY 0)))
      (DECLARE (DYNAMIC-EXTENT V))
      (SETF (#S(FORMGREP:SYMREF :NAME "TYPED-AREF" :QUALIFIER "SYS")
             'DOUBLE-FLOAT V 0)
              VALUE)
      (PROGN
       (SETF (UB32REF/LE VECTOR INDEX)
               (#S(FORMGREP:SYMREF :NAME "TYPED-AREF" :QUALIFIER "SYS")
                '(UNSIGNED-BYTE 32) V 0)
             (UB32REF/LE VECTOR (+ INDEX 4))
               (#S(FORMGREP:SYMREF :NAME "TYPED-AREF" :QUALIFIER "SYS")
                '(UNSIGNED-BYTE 32) V 4)))
      VALUE)
    (PROGN
     (SETF (UB32REF/LE VECTOR INDEX) (SB-KERNEL:DOUBLE-FLOAT-LOW-BITS VALUE)
           (SB32REF/LE VECTOR (+ INDEX 4))
             (SB-KERNEL:DOUBLE-FLOAT-HIGH-BITS VALUE))
     VALUE))

[numcl/src/3arange.lisp:37]
  (DEFUN %ARANGE (START STOP STEP TYPE)
    (LET* ((LENGTH (MAX 0 (CEILING (- STOP START) STEP))))
      (DECLARE (FIXNUM LENGTH))
      (MULTIPLE-VALUE-BIND (A BASE)
          (%MAKE-ARRAY LENGTH :ELEMENT-TYPE TYPE)
        (LET ((TMP START))
          (DOTIMES (I LENGTH) (SETF (AREF BASE I) TMP) (INCF TMP STEP)))
        (SPECIALIZING (BASE) NIL (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
         (LOCALLY
          (DECLARE
           (DERIVE BASE TYPE (ARRAY-SUBTYPE-ELEMENT-TYPE TYPE) START STEP))
          (DOTIMES (I LENGTH)
            (SETF (AREF BASE I) START)
            (SETF START (+ START STEP)))))
        (SPECIALIZING (BASE START STEP) NIL
         (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
         (DOTIMES (I LENGTH)
           (SETF (AREF BASE I) START)
           (SETF START (+ START STEP))))
        (VALUES A BASE))))

[numcl/src/3einsum.lisp:470]
  (DEFUN EINSUM-LAMBDA (EINSUM-SPECS)
    "Takes a normalized-subscripts and returns a lambda form that iterates over it."
    (EMATCH EINSUM-SPECS
     ((EINSUM-SPECS I-SPECS O-SPECS I-OPTIONS O-OPTIONS ITER-SPECS TRANSFORMS)
      (LET ((I-AVARS (I-AVARS I-SPECS)) (O-AVARS (O-AVARS O-SPECS)))
        (ECLECTOR.READER:QUASIQUOTE
         (LAMBDA
             ((ECLECTOR.READER:UNQUOTE-SPLICING I-AVARS)
              &OPTIONAL (ECLECTOR.READER:UNQUOTE-SPLICING O-AVARS))
           (DECLARE (OPTIMIZE (SPEED 0) (SAFETY 3) (DEBUG 3)))
           (LET* (ECLECTOR.READER:UNQUOTE-SPLICING
                  (SHAPE-RESOLVER I-AVARS I-SPECS I-OPTIONS))
             (LET* (ECLECTOR.READER:UNQUOTE
                    (%OUTPUT-GENERATOR
                     O-SPECS
                     O-AVARS
                     I-SPECS
                     I-AVARS
                     TRANSFORMS))
               (LET* (ECLECTOR.READER:UNQUOTE-SPLICING
                      (SHAPE-RESOLVER O-AVARS O-SPECS O-OPTIONS T))
                 (LET (ECLECTOR.READER:UNQUOTE
                       (ITER
                        (FOR VAR IN (APPEND I-AVARS O-AVARS))
                        (COLLECTING
                         (ECLECTOR.READER:QUASIQUOTE
                          ((ECLECTOR.READER:UNQUOTE VAR)
                           (ARRAY-DISPLACEMENT
                            (ECLECTOR.READER:UNQUOTE VAR)))))))
                   (SPECIALIZING
                    ((ECLECTOR.READER:UNQUOTE-SPLICING I-AVARS)
                     (ECLECTOR.READER:UNQUOTE-SPLICING O-AVARS))
                    NIL (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
                    (DECLARE
                     (TYPE INDEX
                      (ECLECTOR.READER:UNQUOTE-SPLICING
                       (MAPCAR (FUNCTION ?) (REMOVE -1 ITER-SPECS)))))
                    (ECLECTOR.READER:UNQUOTE
                     (EINSUM-BODY *COMPILER* EINSUM-SPECS))))
                 (VALUES
                  (ECLECTOR.READER:UNQUOTE-SPLICING
                   (MAPCAR
                    (LAMBDA (VAR)
                      (ECLECTOR.READER:QUASIQUOTE
                       (ENSURE-SINGLETON (ECLECTOR.READER:UNQUOTE VAR))))
                    O-AVARS))))))))))))

[numcl/src/3einsum.lisp:611]
  (DEFUN FN3 (A I)
    (DECLARE ((BASE-ARRAY (UNSIGNED-BYTE 8) 100) A))
    (DECLARE ((UNSIGNED-BYTE 8) I))
    (PRINT (+ (AREF A I) (AREF A (+ I 1)) (AREF A (+ I 2))))
    (LET ((I 5))
      (PRINT (+ (AREF A I) (AREF A (+ I 1)) (AREF A (+ I 2)))))
    (WHEN (< I 98) (PRINT (+ (AREF A I) (AREF A (+ I 1)) (AREF A (+ I 2)))))
    (LOCALLY
     (DECLARE ((MOD 98) I))
     (PRINT (+ (AREF A I) (AREF A (+ I 1)) (AREF A (+ I 2)))))
    (LOCALLY
     (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
     (PRINT (+ (AREF A I) (AREF A (+ I 1)) (AREF A (+ I 2)))))
    (LOCALLY
     (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
     (PRINT
      (+ (ROW-MAJOR-AREF A I) (ROW-MAJOR-AREF A (+ I 1))
         (ROW-MAJOR-AREF A (+ I 2)))))
    A)

[numcl/src/4linear-algebra3.lisp:179]
  (DEFUN MATRIX-CHAIN-ORDER (DIMS N)
    (DECLARE (TYPE (SIMPLE-ARRAY SINGLE-FLOAT 1) DIMS)
             (TYPE (UNSIGNED-BYTE 31) N)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((COST
           (MAKE-ARRAY (LIST N N) :ELEMENT-TYPE 'SINGLE-FLOAT :INITIAL-ELEMENT
                       0.0))
          (INDEX
           (MAKE-ARRAY (LIST N N) :ELEMENT-TYPE 'FIXNUM :INITIAL-ELEMENT 0)))
      (ITER (DECLARE (ITERATE:DECLARE-VARIABLES)) (DECLARE (FIXNUM LEN))
       (FOR LEN FROM 2 TO N)
       (ITER (DECLARE (ITERATE:DECLARE-VARIABLES)) (DECLARE (FIXNUM I J))
        (FOR I TO (- N LEN)) (FOR J = (+ I LEN -1))
        (SETF (AREF COST I J) MOST-POSITIVE-SINGLE-FLOAT)
        (ITER (DECLARE (ITERATE:DECLARE-VARIABLES)) (DECLARE (FIXNUM K))
         (DECLARE (SINGLE-FLOAT C)) (FOR K FROM I BELOW J)
         (FOR C =
          (+ (AREF COST I K) (AREF COST (1+ K) J)
             (* (AREF DIMS I) (AREF DIMS (1+ K)) (AREF DIMS (1+ J)))))
         (WHEN (< C (AREF COST I J))
           (SETF (AREF COST I J) C)
           (SETF (AREF INDEX I J) K)))))
      INDEX))

[oclcl/examples/sph-cpu.lisp:96]
  (DEFUN NORM (X Y Z)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (SQRT (+ (* X X) (* Y Y) (* Z Z))))

[oclcl/examples/sph-cpu.lisp:237]
  (DEFUN OFFSET (NEIGHBOR-MAP I J K L)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((CAPACITY (NEIGHBOR-MAP-CAPACITY NEIGHBOR-MAP))
          (SIZE-X (NEIGHBOR-MAP-SIZE-X NEIGHBOR-MAP))
          (SIZE-Y (NEIGHBOR-MAP-SIZE-Y NEIGHBOR-MAP)))
      (DECLARE (TYPE FIXNUM CAPACITY SIZE-X SIZE-Y))
      (THE FIXNUM
           (+
            (THE FIXNUM
                 (* (1+ CAPACITY)
                    (THE FIXNUM (* SIZE-X (THE FIXNUM (* SIZE-Y K))))))
            (THE FIXNUM
                 (+ (THE FIXNUM (* (1+ CAPACITY) (THE FIXNUM (* SIZE-X J))))
                    (THE FIXNUM (+ (THE FIXNUM (* (1+ CAPACITY) I)) L))))))))

[oclcl/examples/sph-cpu.lisp:334]
  (DEFUN POLY6-KERNEL (DX DY DZ)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((R (NORM DX DY DZ)))
      (* (/ 315.0 (* 64.0 (FLOAT PI 0.0) (POW H 9)))
         (POW (- (* H H) (* R R)) 3))))

[oclcl/examples/sph-cpu.lisp:345]
  (DEFUN GRAD-SPIKY-KERNEL (DX DY DZ)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET* ((R (NORM DX DY DZ))
           (COEFF
            (* (/ -45.0 (* (FLOAT PI 0.0) (POW H 6))) (POW (- H R) 2)
               (/ 1.0 R))))
      (VALUES (* COEFF DX) (* COEFF DY) (* COEFF DZ))))

[oclcl/examples/sph-cpu.lisp:358]
  (DEFUN RAP-VISC-KERNEL (DX DY DZ)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((R (NORM DX DY DZ)))
      (* (/ 45.0 (* (FLOAT PI 0.0) (POW H 6))) (- H R))))

[oclcl/examples/sph-cpu.lisp:373]
  (DEFUN UPDATE-DENSITY (RHO POS N NEIGHBOR-MAP)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LOOP FOR I FROM 0 BELOW N
          DO (SETF (AREF RHO I) 0.0) (DO-NEIGHBORS (J NEIGHBOR-MAP POS I)
                                      (WITH-VEC3-AREF (XI YI ZI) (POS I)
                                       (WITH-VEC3-AREF (XJ YJ ZJ) (POS J)
                                        (LET* ((DX (* (- XI XJ) SIMSCALE))
                                               (DY (* (- YI YJ) SIMSCALE))
                                               (DZ (* (- ZI ZJ) SIMSCALE))
                                               (DR (NORM DX DY DZ)))
                                          (WHEN (<= DR H)
                                            (INCF (AREF RHO I)
                                                  (* PMASS
                                                     (POLY6-KERNEL DX DY
                                                      DZ))))))))))

[oclcl/examples/sph-cpu.lisp:409]
  (DEFUN PRESSURE-TERM (RHO PRS I J DX DY DZ)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (MULTIPLE-VALUE-BIND (X Y Z)
        (GRAD-SPIKY-KERNEL DX DY DZ)
      (LET ((COEFF
             (/ (* (- PMASS) (+ (AREF PRS I) (AREF PRS J)))
                (* 2.0 (AREF RHO J)))))
        (VALUES (* COEFF X) (* COEFF Y) (* COEFF Z)))))

[oclcl/examples/sph-cpu.lisp:425]
  (DEFUN VISCOSITY-TERM (VEL RHO I J DX DY DZ)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (WITH-VEC3-AREF (UI VI WI) (VEL I)
     (WITH-VEC3-AREF (UJ VJ WJ) (VEL J)
      (LET ((COEFF
             (* (/ (* VISC PMASS) (AREF RHO J)) (RAP-VISC-KERNEL DX DY DZ))))
        (VALUES (* COEFF (- UJ UI)) (* COEFF (- VJ VI)) (* COEFF (- WJ WI)))))))

[oclcl/examples/sph-cpu.lisp:444]
  (DEFUN UPDATE-FORCE (FORCE POS VEL RHO PRS N NEIGHBOR-MAP)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LOOP FOR I FROM 0 BELOW N
          DO (SET-VEC3-AREF FORCE I (VALUES 0.0 0.0 0.0)) (DO-NEIGHBORS
                                                           (J NEIGHBOR-MAP POS
                                                            I)
                                                           (WHEN (/= I J)
                                                             (WITH-VEC3-AREF
                                                              (XI YI ZI)
                                                              (POS I)
                                                              (WITH-VEC3-AREF
                                                               (XJ YJ ZJ)
                                                               (POS J)
                                                               (LET* ((DX
                                                                       (*
                                                                        (- XI
                                                                           XJ)
                                                                        SIMSCALE))
                                                                      (DY
                                                                       (*
                                                                        (- YI
                                                                           YJ)
                                                                        SIMSCALE))
                                                                      (DZ
                                                                       (*
                                                                        (- ZI
                                                                           ZJ)
                                                                        SIMSCALE))
                                                                      (DR
                                                                       (NORM DX
                                                                        DY DZ)))
                                                                 (WHEN
                                                                     (<= DR H)
                                                                   (INC-VEC3-AREF
                                                                    FORCE I
                                                                    (PRESSURE-TERM
                                                                     RHO PRS I
                                                                     J DX DY
                                                                     DZ))
                                                                   (INC-VEC3-AREF
                                                                    FORCE I
                                                                    (VISCOSITY-TERM
                                                                     VEL RHO I
                                                                     J DX DY
                                                                     DZ))))))))))

[opticl/cluster.lisp:15]
  (DEFUN L2-DISTANCE-3 (PIXEL1A PIXEL1B PIXEL1C PIXEL2A PIXEL2B PIXEL2C)
    (DECLARE (TYPE FIXNUM PIXEL1A PIXEL1B PIXEL1C PIXEL2A PIXEL2B PIXEL2C)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((D1 (- PIXEL1A PIXEL2A))
          (D2 (- PIXEL1B PIXEL2B))
          (D3 (- PIXEL1C PIXEL2C)))
      (DECLARE (TYPE FIXNUM D1 D2 D3))
      (THE FIXNUM
           (+ (THE FIXNUM (* D1 D1)) (THE FIXNUM (* D2 D2))
              (THE FIXNUM (* D3 D3))))))

[optima/src/runtime.lisp:3]
  (DEFUN %EQUAL (A B)
    "Equality function for comparing pattern constants."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0)))
    (OR (EQUAL A B)
        (COND ((AND (STRINGP A) (STRINGP B)) (STRING= A B))
              ((AND (CONSP A) (CONSP B))
               (AND (%EQUAL (CAR A) (CAR B)) (%EQUAL (CDR A) (CDR B)))))))

[optima/src/runtime.lisp:28]
  (DEFUN %SVREF (SIMPLE-VECTOR INDEX)
    "Safe SVREF."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0)))
    (WHEN (< INDEX (LENGTH SIMPLE-VECTOR)) (SVREF SIMPLE-VECTOR INDEX)))

[optima/src/runtime.lisp:34]
  (DEFUN %ASSOC (ITEM ALIST &KEY (TEST #'EQL))
    "Safe ASSOC."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0)))
    (LOOP (UNLESS (CONSP ALIST) (RETURN))
          (LET ((CONS (CAR ALIST)))
            (WHEN (AND (CONSP CONS) (FUNCALL TEST ITEM (CAR CONS)))
              (RETURN CONS)))
          (SETQ ALIST (CDR ALIST))))

[optima/src/runtime.lisp:45]
  (DEFUN %GET-PROPERTY (ITEM PLIST)
    "Safe GETF."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0)))
    (LOOP (UNLESS (CONSP PLIST) (RETURN))
          (LET ((CONS (CDR PLIST)))
            (UNLESS (CONSP CONS) (RETURN))
            (WHEN (EQL ITEM (CAR PLIST)) (RETURN (CDR PLIST)))
            (SETQ PLIST (CDR CONS)))))

[overlord/db.lisp:372]
  (DEFUN LOAD-LOG-DATA (LOG-FILE)
    "Load the data from LOG-FILE."
    (DECLARE (OPTIMIZE SAFETY DEBUG))
    (IF (NOT (FILE-EXISTS-P LOG-FILE))
        NO-LOG-DATA
        (TAGBODY
         :RETRY
          (RESTART-CASE (RETURN-FROM LOAD-LOG-DATA
                          (WITH-STANDARD-INPUT-SYNTAX
                           (LET* ((*READTABLE* DB-READTABLE)
                                  (RECORDS
                                   (WITH-INPUT-FROM-FILE
                                    (IN LOG-FILE :ELEMENT-TYPE 'CHARACTER)
                                    (LET ((EOF "eof"))
                                      (NLET REC ((RECORDS 'NIL))
                                       (LET ((DATA (READ IN NIL EOF)))
                                         (COND
                                          ((EQ DATA EOF) (NREVERSE RECORDS))
                                          ((TYPEP DATA 'LOG-RECORD)
                                           (REC (CONS DATA RECORDS)))
                                          (T
                                           (ERROR
                                            (DB-ERROR
                                             "Invalid database log entry: ~a"
                                             DATA)))))))))
                                  (MAPS (MAPCAR #'LOG-RECORD.DATA RECORDS))
                                  (MAP
                                   (REDUCE #'FSET:MAP-UNION MAPS :INITIAL-VALUE
                                           (FSET:EMPTY-MAP)))
                                  (MAP (STRIP-TOMBSTONES MAP)))
                             (MAKE-LOG-DATA :MAP MAP :MAP-COUNT
                              (LENGTH MAPS)))))
            (RETRY NIL :REPORT "Try loading the database again." (GO :RETRY))
            (TRUNCATE-DB NIL :REPORT
             "Treat the database as corrupt and discard it."
             (DELETE-FILE-IF-EXISTS LOG-FILE) NO-LOG-DATA)))))

[overlord/target.lisp:174]
  (DEFMACRO DEFCLASS (NAME SUPERS &BODY (SLOTS . OPTIONS))
    "Like `cl:defclass', but try to force slot types to be checked.
Works for SBCL, at least."
    (ECLECTOR.READER:QUASIQUOTE
     (LOCALLY
      (DECLARE (OPTIMIZE (SAFETY 3)))
      (DEFCLASS (ECLECTOR.READER:UNQUOTE NAME) (ECLECTOR.READER:UNQUOTE SUPERS)
                (ECLECTOR.READER:UNQUOTE SLOTS)
                (ECLECTOR.READER:UNQUOTE-SPLICING OPTIONS)))))

[overlord/util.lisp:96]
  (DEFMACRO DX-SXHASH (EXPR)
    "Like SXHASH, but try to stack-allocate EXPR."
    (WITH-UNIQUE-NAMES (TEMP)
     (ECLECTOR.READER:QUASIQUOTE
      (LET (((ECLECTOR.READER:UNQUOTE TEMP) (ECLECTOR.READER:UNQUOTE EXPR)))
        (DECLARE
         (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 0) (COMPILATION-SPEED 0)))
        (DECLARE (DYNAMIC-EXTENT (ECLECTOR.READER:UNQUOTE TEMP)))
        (SXHASH (ECLECTOR.READER:UNQUOTE TEMP))))))

[paiprolog/examples.lisp:665]
  (DEFEXAMPLES 10 "Low-Level Efficiency Issues"
   "The efficiency techniques of the previous chapter all involved fairly"
   "significant changes to an algorithm.  But what happens when you are already"
   "using the best imaginable algorithms, and performance is still a problem?"
   (:SECTION "10.1 Use Declarations")
   "Compare these functions with and without declarations:"
   ((DEFUN F (X Y)
      (DECLARE (FIXNUM X Y)
               (OPTIMIZE (SAFETY 0) (SPEED 3)))
      (THE FIXNUM (+ X Y)))
    @ 318)
   ((DEFUN G (X Y) (+ X Y))) "Here is the disassembled code for f and g:"
   ((DISASSEMBLE 'F)) ((DISASSEMBLE 'G) @ 319))

[parse-declarations/tests.lisp:60]
  (DEFPARAMETER *SAMPLE-DECLARATION-SPECIFIERS*
    '((OPTIMIZE (SPEED 3) (SAFETY 0)) (SPECIAL *A*) (INLINE F)
      (AUTHOR "Tobias C Rittweiler") (TYPE INTEGER X Y) (OPTIMIZE (DEBUG 0))
      (TYPE FIXNUM Z) ((STRING 512) OUTPUT)
      (TYPE (VECTOR UNSIGNED-BYTE 32) CHUNK) (QUUX *A*) (FLOAT *F*)
      (FTYPE (FUNCTION (NUMBER) FLOAT) F) (TYPE NIL ENV1 ENV2)))

[parse-declarations/tests.lisp:101]
  (DEFTEST DECLARATION-ENV.POLICY.1
   (ALEXANDRIA:SET-EQUAL (DECLARATION-ENV.POLICY *SAMPLE-DECLARATION-ENV*)
                         '((DEBUG 0) (SPEED 3) (SAFETY 0)) :TEST 'EQUAL)
   T)

[parse-declarations/tests.lisp:128]
  (DEFTEST MERGE-DECLARATION-ENVS.1
   (LET ((NEW-DECL-SPECS
          '((OPTIMIZE (SAFETY 2)) (NOTINLINE G)
            (FTYPE (FUNCTION (STRING) STRING) G))))
     (VALUES
      (DECLARATION-ENV=
       (MERGE-DECLARATION-ENVS *SAMPLE-DECLARATION-ENV*
        *SAMPLE-DECLARATION-ENV*)
       *SAMPLE-DECLARATION-ENV*)
      (DECLARATION-ENV=
       (MERGE-DECLARATION-ENVS *SAMPLE-DECLARATION-ENV*
        (PARSE-DECL-SPECS NEW-DECL-SPECS))
       (PARSE-DECL-SPECS
        (APPEND NEW-DECL-SPECS *SAMPLE-DECLARATION-SPECIFIERS*)))))
   T T)

[parse-declarations/tests.lisp:189]
  (DEFTEST FILTER-DECLARATION-ENV.2
   (VALUES
    (ALEXANDRIA:SET-EQUAL
     (BUILD-DECLARATIONS NIL
      (FILTER-DECLARATION-ENV *SAMPLE-DECLARATION-ENV* :INCLUDE :UNKNOWN))
     '((QUUX *A*) (AUTHOR "Tobias C Rittweiler")) :TEST 'EQUAL)
    (DECLARATION-ENV=
     (FILTER-DECLARATION-ENV *SAMPLE-DECLARATION-ENV* :INCLUDE :BOUND)
     (PARSE-DECL-SPECS
      '((FTYPE (FUNCTION (NUMBER) FLOAT) F) (TYPE NIL ENV1 ENV2)
        (TYPE FLOAT *F*) (TYPE (VECTOR UNSIGNED-BYTE 32) CHUNK)
        (TYPE (STRING 512) OUTPUT) (TYPE FIXNUM Z) (TYPE INTEGER X Y)
        (INLINE F) (SPECIAL *A*))))
    (ALEXANDRIA:SET-EQUAL
     (BUILD-DECLARATIONS NIL
      (FILTER-DECLARATION-ENV *SAMPLE-DECLARATION-ENV* :INCLUDE :FREE))
     '((OPTIMIZE (DEBUG 0)) (OPTIMIZE (SPEED 3) (SAFETY 0))) :TEST 'EQUAL)
    (ALEXANDRIA:SET-EQUAL
     (BUILD-DECLARATIONS NIL
      (FILTER-DECLARATION-ENV *SAMPLE-DECLARATION-ENV* :INCLUDE
       '(INLINE SPECIAL)))
     '((INLINE F) (SPECIAL *A*)) :TEST 'EQUAL))
   T T T T)

[parse-declarations/tests.lisp:219]
  (DEFTEST FILTER-DECLARATION-ENV.3
   (VALUES
    (DECLARATION-ENV=
     (FILTER-DECLARATION-ENV *SAMPLE-DECLARATION-ENV* :EXCLUDE :UNKNOWN)
     (MERGE-DECLARATION-ENVS
      (FILTER-DECLARATION-ENV *SAMPLE-DECLARATION-ENV* :INCLUDE :BOUND)
      (FILTER-DECLARATION-ENV *SAMPLE-DECLARATION-ENV* :INCLUDE :FREE)))
    (DECLARATION-ENV=
     (FILTER-DECLARATION-ENV *SAMPLE-DECLARATION-ENV* :EXCLUDE :BOUND)
     (MERGE-DECLARATION-ENVS
      (FILTER-DECLARATION-ENV *SAMPLE-DECLARATION-ENV* :INCLUDE :UNKNOWN)
      (FILTER-DECLARATION-ENV *SAMPLE-DECLARATION-ENV* :INCLUDE :FREE)))
    (DECLARATION-ENV=
     (FILTER-DECLARATION-ENV *SAMPLE-DECLARATION-ENV* :EXCLUDE :FREE)
     (MERGE-DECLARATION-ENVS
      (FILTER-DECLARATION-ENV *SAMPLE-DECLARATION-ENV* :INCLUDE :BOUND)
      (FILTER-DECLARATION-ENV *SAMPLE-DECLARATION-ENV* :INCLUDE :UNKNOWN)))
    (ALEXANDRIA:SET-EQUAL
     (BUILD-DECLARATIONS NIL
      (FILTER-DECLARATION-ENV *SAMPLE-DECLARATION-ENV* :EXCLUDE '(TYPE FTYPE)))
     '((QUUX *A*) (AUTHOR "Tobias C Rittweiler") (INLINE F) (SPECIAL *A*)
       (OPTIMIZE (DEBUG 0)) (OPTIMIZE (SPEED 3) (SAFETY 0)))
     :TEST 'EQUAL))
   T T T T)

[parse-float/parse-float.lisp:5]
  (EVAL-WHEN (:COMPILE-TOPLEVEL) (DECLAIM (OPTIMIZE (SPEED 3) (SAFETY 1))))

[parse-number/parse-number.lisp:63]
  (DEFUN WHITE-SPACE-P (X)
    "Is the given character a whitespace character?"
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE CHARACTER X))
    (AND (FIND X *WHITE-SPACE-CHARACTERS*) T))

[parse-number/parse-number.lisp:70]
  (DEFUN PARSE-INTEGER-AND-PLACES (STRING START END &KEY (RADIX 10))
    "Parse an integer and return a 'parsed-integer'. This is an object
   whose numerical value can be accessed with the function
   number-value and whose length can be accessed with the function
   place."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1))
             (TYPE STRING STRING)
             (TYPE FIXNUM START END RADIX))
    (MULTIPLE-VALUE-BIND (INTEGER END-POS)
        (IF (= START END)
            (VALUES 0 0)
            (PARSE-INTEGER STRING :START START :END END :RADIX RADIX))
      (LET ((RELEVANT-DIGITS
             (- END-POS START
                (LOOP :FOR POS :FROM (- END-POS 1) :DOWNTO START
                      :WHILE (MEMBER (CHAR STRING POS)
                                     *WHITE-SPACE-CHARACTERS*)
                      :COUNT 1))))
        (CONS INTEGER RELEVANT-DIGITS))))

[parse-number/parse-number.lisp:95]
  (DEFUN PARSE-INTEGERS (STRING START END SPLITTING-POINTS &KEY (RADIX 10))
    "Parse a string containing multiple integers where SPLITTING-POINTS
   is a list of locations where each location is inbetween
   consecutive integers. This will return a list of parsed-integers.
   The last parsed-integer will have a negative value for its length."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1))
             (TYPE STRING STRING)
             (TYPE FIXNUM START END RADIX))
    (VALUES-LIST
     (LOOP FOR LEFT = START THEN (1+ RIGHT)
           FOR POINT IN SPLITTING-POINTS
           FOR RIGHT = POINT
           COLLECT (PARSE-INTEGER-AND-PLACES STRING LEFT RIGHT :RADIX
                    RADIX) INTO INTEGERS
           FINALLY (RETURN
                    (NCONC INTEGERS
                           (LIST
                            (PARSE-INTEGER-AND-PLACES STRING LEFT END :RADIX
                             RADIX)))))))

[periods/parser.lisp:1]
  (DECLAIM (OPTIMIZE (DEBUG 3) (SAFETY 3) (SPEED 1) (SPACE 0)))

[periods/periods.lisp:44]
  (DECLAIM (OPTIMIZE (DEBUG 3) (SAFETY 3) (SPEED 1) (SPACE 0)))

[periods/strptime.lisp:1]
  (DECLAIM (OPTIMIZE (DEBUG 3) (SAFETY 3) (SPEED 1) (SPACE 0)))

[pg/md5.lisp:82]
  (DEFUN F (X Y Z)
    (DECLARE (TYPE UB32 X Y Z)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (#S(FORMGREP:SYMREF :NAME "32BIT-LOGICAL-OR" :QUALIFIER "KERNEL")
     (#S(FORMGREP:SYMREF :NAME "32BIT-LOGICAL-AND" :QUALIFIER "KERNEL") X Y)
     (#S(FORMGREP:SYMREF :NAME "32BIT-LOGICAL-ANDC1" :QUALIFIER "KERNEL") X Z)))

[pg/md5.lisp:91]
  (DEFUN G (X Y Z)
    (DECLARE (TYPE UB32 X Y Z)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (#S(FORMGREP:SYMREF :NAME "32BIT-LOGICAL-OR" :QUALIFIER "KERNEL")
     (#S(FORMGREP:SYMREF :NAME "32BIT-LOGICAL-AND" :QUALIFIER "KERNEL") X Z)
     (#S(FORMGREP:SYMREF :NAME "32BIT-LOGICAL-ANDC2" :QUALIFIER "KERNEL") Y Z)))

[pg/md5.lisp:100]
  (DEFUN H (X Y Z)
    (DECLARE (TYPE UB32 X Y Z)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (#S(FORMGREP:SYMREF :NAME "32BIT-LOGICAL-XOR" :QUALIFIER "KERNEL") X
     (#S(FORMGREP:SYMREF :NAME "32BIT-LOGICAL-XOR" :QUALIFIER "KERNEL") Y Z)))

[pg/md5.lisp:108]
  (DEFUN I (X Y Z)
    (DECLARE (TYPE UB32 X Y Z)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (#S(FORMGREP:SYMREF :NAME "32BIT-LOGICAL-XOR" :QUALIFIER "KERNEL") Y
     (#S(FORMGREP:SYMREF :NAME "32BIT-LOGICAL-ORC2" :QUALIFIER "KERNEL") X Z)))

[pg/md5.lisp:118]
  (DEFUN MOD32+ (A B)
    (DECLARE (TYPE UB32 A B)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LDB (BYTE 32 0) (+ A B)))

[pg/md5.lisp:134]
  (DEFUN ROL32 (A S)
    (DECLARE (TYPE UB32 A)
             (TYPE (UNSIGNED-BYTE 5) S)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (#S(FORMGREP:SYMREF :NAME "32BIT-LOGICAL-OR" :QUALIFIER "KERNEL")
     (#S(FORMGREP:SYMREF :NAME "SHIFT-TOWARDS-END" :QUALIFIER "KERNEL") A S)
     (#S(FORMGREP:SYMREF :NAME "SHIFT-TOWARDS-START" :QUALIFIER "KERNEL") A S)
     (ASH A (- S 32)))
    (SB-ROTATE-BYTE:ROTATE-BYTE S (BYTE 32 0) A))

[pg/md5.lisp:199]
  (DEFUN INITIAL-MD5-REGS ()
    "Create the initial working state of an MD5 run."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LET ((REGS (MAKE-ARRAY 4 :ELEMENT-TYPE '(UNSIGNED-BYTE 32))))
      (DECLARE (TYPE MD5-REGS REGS))
      (SETF (MD5-REGS-A REGS) +MD5-MAGIC-A+
            (MD5-REGS-B REGS) +MD5-MAGIC-B+
            (MD5-REGS-C REGS) +MD5-MAGIC-C+
            (MD5-REGS-D REGS) +MD5-MAGIC-D+)
      REGS))

[pg/md5.lisp:212]
  (DEFUN UPDATE-MD5-BLOCK (REGS BLOCK)
    "This is the core part of the MD5 algorithm.  It takes a complete 16
word block of input, and updates the working state in A, B, C, and D
accordingly."
    (DECLARE (TYPE MD5-REGS REGS)
             (TYPE (SIMPLE-ARRAY UB32 (16)) BLOCK)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (LET ((A (MD5-REGS-A REGS))
          (B (MD5-REGS-B REGS))
          (C (MD5-REGS-C REGS))
          (D (MD5-REGS-D REGS)))
      (DECLARE (TYPE UB32 A B C D))
      (WITH-MD5-ROUND (F BLOCK) (A B C D 0 7 1) (D A B C 1 12 2)
       (C D A B 2 17 3) (B C D A 3 22 4) (A B C D 4 7 5) (D A B C 5 12 6)
       (C D A B 6 17 7) (B C D A 7 22 8) (A B C D 8 7 9) (D A B C 9 12 10)
       (C D A B 10 17 11) (B C D A 11 22 12) (A B C D 12 7 13)
       (D A B C 13 12 14) (C D A B 14 17 15) (B C D A 15 22 16))
      (WITH-MD5-ROUND (G BLOCK) (A B C D 1 5 17) (D A B C 6 9 18)
       (C D A B 11 14 19) (B C D A 0 20 20) (A B C D 5 5 21) (D A B C 10 9 22)
       (C D A B 15 14 23) (B C D A 4 20 24) (A B C D 9 5 25) (D A B C 14 9 26)
       (C D A B 3 14 27) (B C D A 8 20 28) (A B C D 13 5 29) (D A B C 2 9 30)
       (C D A B 7 14 31) (B C D A 12 20 32))
      (WITH-MD5-ROUND (H BLOCK) (A B C D 5 4 33) (D A B C 8 11 34)
       (C D A B 11 16 35) (B C D A 14 23 36) (A B C D 1 4 37) (D A B C 4 11 38)
       (C D A B 7 16 39) (B C D A 10 23 40) (A B C D 13 4 41) (D A B C 0 11 42)
       (C D A B 3 16 43) (B C D A 6 23 44) (A B C D 9 4 45) (D A B C 12 11 46)
       (C D A B 15 16 47) (B C D A 2 23 48))
      (WITH-MD5-ROUND (I BLOCK) (A B C D 0 6 49) (D A B C 7 10 50)
       (C D A B 14 15 51) (B C D A 5 21 52) (A B C D 12 6 53) (D A B C 3 10 54)
       (C D A B 10 15 55) (B C D A 1 21 56) (A B C D 8 6 57) (D A B C 15 10 58)
       (C D A B 6 15 59) (B C D A 13 21 60) (A B C D 4 6 61) (D A B C 11 10 62)
       (C D A B 2 15 63) (B C D A 9 21 64))
      (SETF (MD5-REGS-A REGS) (MOD32+ (MD5-REGS-A REGS) A)
            (MD5-REGS-B REGS) (MOD32+ (MD5-REGS-B REGS) B)
            (MD5-REGS-C REGS) (MOD32+ (MD5-REGS-C REGS) C)
            (MD5-REGS-D REGS) (MOD32+ (MD5-REGS-D REGS) D))
      REGS))

[pg/md5.lisp:256]
  (DEFUN FILL-BLOCK (BLOCK BUFFER OFFSET)
    "Convert a complete 64 byte input vector segment into the given 16
word MD5 block.  This currently works on (unsigned-byte 8) and
character simple-arrays, via the functions `fill-block-ub8' and
`fill-block-char' respectively."
    (DECLARE (TYPE (INTEGER 0 NIL) OFFSET)
             (TYPE (SIMPLE-ARRAY UB32 (16)) BLOCK)
             (TYPE (SIMPLE-ARRAY * (*)) BUFFER)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (ETYPECASE BUFFER
      ((SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*))
       (FILL-BLOCK-UB8 BLOCK BUFFER OFFSET))
      (SIMPLE-STRING (FILL-BLOCK-CHAR BLOCK BUFFER OFFSET))))

[pg/md5.lisp:271]
  (DEFUN FILL-BLOCK-UB8 (BLOCK BUFFER OFFSET)
    "Convert a complete 64 (unsigned-byte 8) input vector segment
starting from offset into the given 16 word MD5 block."
    (DECLARE (TYPE (INTEGER 0 NIL) OFFSET)
             (TYPE (SIMPLE-ARRAY UB32 (16)) BLOCK)
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) BUFFER)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (#S(FORMGREP:SYMREF :NAME "BIT-BASH-COPY" :QUALIFIER "KERNEL") BUFFER
     (+
      (* #S(FORMGREP:SYMREF :NAME "VECTOR-DATA-OFFSET" :QUALIFIER "VM")
         #S(FORMGREP:SYMREF :NAME "WORD-BITS" :QUALIFIER "VM"))
      (* OFFSET #S(FORMGREP:SYMREF :NAME "BYTE-BITS" :QUALIFIER "VM")))
     BLOCK
     (* #S(FORMGREP:SYMREF :NAME "VECTOR-DATA-OFFSET" :QUALIFIER "VM")
        #S(FORMGREP:SYMREF :NAME "WORD-BITS" :QUALIFIER "VM"))
     (* 64 #S(FORMGREP:SYMREF :NAME "BYTE-BITS" :QUALIFIER "VM")))
    (SB-KERNEL:UB8-BASH-COPY BUFFER OFFSET BLOCK 0 64))

[pg/md5.lisp:296]
  (DEFUN FILL-BLOCK-CHAR (BLOCK BUFFER OFFSET)
    "Convert a complete 64 character input string segment starting from
offset into the given 16 word MD5 block."
    (DECLARE (TYPE (INTEGER 0 NIL) OFFSET)
             (TYPE (SIMPLE-ARRAY UB32 (16)) BLOCK)
             (TYPE SIMPLE-STRING BUFFER)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
    (#S(FORMGREP:SYMREF :NAME "BIT-BASH-COPY" :QUALIFIER "KERNEL") BUFFER
     (+
      (* #S(FORMGREP:SYMREF :NAME "VECTOR-DATA-OFFSET" :QUALIFIER "VM")
         #S(FORMGREP:SYMREF :NAME "WORD-BITS" :QUALIFIER "VM"))
      (* OFFSET #S(FORMGREP:SYMREF :NAME "BYTE-BITS" :QUALIFIER "VM")))
     BLOCK
     (* #S(FORMGREP:SYMREF :NAME "VECTOR-DATA-OFFSET" :QUALIFIER "VM")
        #S(FORMGREP:SYMREF :NAME "WORD-BITS" :QUALIFIER "VM"))
     (* 64 #S(FORMGREP:SYMREF :NAME "BYTE-BITS" :QUALIFIER "VM")))
    (SB-KERNEL:UB8-BASH-COPY BUFFER OFFSET BLOCK 0 64))

[pg/md5.lisp:324]
  (DEFUN MD5REGS-DIGEST (REGS)
    "Create the final 16 byte message-digest from the MD5 working state
in regs.  Returns a (simple-array (unsigned-byte 8) (16))."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0))
             (TYPE MD5-REGS REGS))
    (LET ((RESULT (MAKE-ARRAY 16 :ELEMENT-TYPE '(UNSIGNED-BYTE 8))))
      (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (16)) RESULT))
      (MACROLET ((FROB (REG OFFSET)
                   (LET ((VAR (GENSYM)))
                     (ECLECTOR.READER:QUASIQUOTE
                      (LET (((ECLECTOR.READER:UNQUOTE VAR)
                             (ECLECTOR.READER:UNQUOTE REG)))
                        (DECLARE (TYPE UB32 (ECLECTOR.READER:UNQUOTE VAR)))
                        (SETF (AREF RESULT (ECLECTOR.READER:UNQUOTE OFFSET))
                                (LDB (BYTE 8 0) (ECLECTOR.READER:UNQUOTE VAR))
                              (AREF RESULT
                                    (ECLECTOR.READER:UNQUOTE (+ OFFSET 1)))
                                (LDB (BYTE 8 8) (ECLECTOR.READER:UNQUOTE VAR))
                              (AREF RESULT
                                    (ECLECTOR.READER:UNQUOTE (+ OFFSET 2)))
                                (LDB (BYTE 8 16) (ECLECTOR.READER:UNQUOTE VAR))
                              (AREF RESULT
                                    (ECLECTOR.READER:UNQUOTE (+ OFFSET 3)))
                                (LDB (BYTE 8 24)
                                     (ECLECTOR.READER:UNQUOTE VAR))))))))
        (FROB (MD5-REGS-A REGS) 0)
        (FROB (MD5-REGS-B REGS) 4)
        (FROB (MD5-REGS-C REGS) 8)
        (FROB (MD5-REGS-D REGS) 12))
      RESULT))

[pg/md5.lisp:363]
  (DEFUN COPY-TO-BUFFER (FROM FROM-OFFSET COUNT BUFFER BUFFER-OFFSET)
    "Copy a partial segment from input vector from starting at
from-offset and copying count elements into the 64 byte buffer
starting at buffer-offset."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0))
             (TYPE (UNSIGNED-BYTE 29) FROM-OFFSET)
             (TYPE (INTEGER 0 63) COUNT BUFFER-OFFSET)
             (TYPE (SIMPLE-ARRAY * (*)) FROM)
             (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (64)) BUFFER))
    (#S(FORMGREP:SYMREF :NAME "BIT-BASH-COPY" :QUALIFIER "KERNEL") FROM
     (+
      (* #S(FORMGREP:SYMREF :NAME "VECTOR-DATA-OFFSET" :QUALIFIER "VM")
         #S(FORMGREP:SYMREF :NAME "WORD-BITS" :QUALIFIER "VM"))
      (* FROM-OFFSET #S(FORMGREP:SYMREF :NAME "BYTE-BITS" :QUALIFIER "VM")))
     BUFFER
     (+
      (* #S(FORMGREP:SYMREF :NAME "VECTOR-DATA-OFFSET" :QUALIFIER "VM")
         #S(FORMGREP:SYMREF :NAME "WORD-BITS" :QUALIFIER "VM"))
      (* BUFFER-OFFSET #S(FORMGREP:SYMREF :NAME "BYTE-BITS" :QUALIFIER "VM")))
     (* COUNT #S(FORMGREP:SYMREF :NAME "BYTE-BITS" :QUALIFIER "VM")))
    (SB-KERNEL:UB8-BASH-COPY FROM FROM-OFFSET BUFFER BUFFER-OFFSET COUNT))

[pg/md5.lisp:398]
  (DEFUN UPDATE-MD5-STATE
         (STATE SEQUENCE &KEY (START 0) (END (LENGTH SEQUENCE)))
    "Update the given md5-state from sequence, which is either a
simple-string or a simple-array with element-type (unsigned-byte 8),
bounded by start and end, which must be numeric bounding-indices."
    (DECLARE (TYPE MD5-STATE STATE)
             (TYPE (SIMPLE-ARRAY * (*)) SEQUENCE)
             (TYPE FIXNUM START END)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0))
             (#S(FORMGREP:SYMREF :NAME "OPTIMIZE-INTERFACE" :QUALIFIER "EXT")
              (SAFETY 1) (DEBUG 1)))
    (LET ((REGS (MD5-STATE-REGS STATE))
          (BLOCK (MD5-STATE-BLOCK STATE))
          (BUFFER (MD5-STATE-BUFFER STATE))
          (BUFFER-INDEX (MD5-STATE-BUFFER-INDEX STATE))
          (LENGTH (- END START)))
      (DECLARE (TYPE MD5-REGS REGS)
               (TYPE FIXNUM LENGTH)
               (TYPE (INTEGER 0 63) BUFFER-INDEX)
               (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 32) (16)) BLOCK)
               (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (64)) BUFFER))
      (UNLESS (ZEROP BUFFER-INDEX)
        (LET ((AMOUNT (MIN (- 64 BUFFER-INDEX) LENGTH)))
          (DECLARE (TYPE (INTEGER 0 63) AMOUNT))
          (COPY-TO-BUFFER SEQUENCE START AMOUNT BUFFER BUFFER-INDEX)
          (SETQ START (THE FIXNUM (+ START AMOUNT)))
          (WHEN (>= START END)
            (SETF (MD5-STATE-BUFFER-INDEX STATE) (+ BUFFER-INDEX AMOUNT))
            (RETURN-FROM UPDATE-MD5-STATE STATE)))
        (FILL-BLOCK-UB8 BLOCK BUFFER 0)
        (UPDATE-MD5-BLOCK REGS BLOCK))
      (ETYPECASE SEQUENCE
        ((SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*))
         (LOCALLY
          (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) SEQUENCE))
          (LOOP FOR OFFSET OF-TYPE (UNSIGNED-BYTE 29) FROM START BELOW
                END BY 64
                UNTIL (< (- END OFFSET) 64)
                DO (FILL-BLOCK-UB8 BLOCK SEQUENCE OFFSET) (UPDATE-MD5-BLOCK
                                                           REGS BLOCK)
                FINALLY (LET ((AMOUNT (- END OFFSET)))
                          (UNLESS (ZEROP AMOUNT)
                            (COPY-TO-BUFFER SEQUENCE OFFSET AMOUNT BUFFER 0))
                          (SETF (MD5-STATE-BUFFER-INDEX STATE) AMOUNT)))))
        (SIMPLE-STRING
         (LOCALLY
          (DECLARE (TYPE SIMPLE-STRING SEQUENCE))
          (LOOP FOR OFFSET OF-TYPE (UNSIGNED-BYTE 29) FROM START BELOW
                END BY 64
                UNTIL (< (- END OFFSET) 64)
                DO (FILL-BLOCK-CHAR BLOCK SEQUENCE OFFSET) (UPDATE-MD5-BLOCK
                                                            REGS BLOCK)
                FINALLY (LET ((AMOUNT (- END OFFSET)))
                          (UNLESS (ZEROP AMOUNT)
                            (COPY-TO-BUFFER SEQUENCE OFFSET AMOUNT BUFFER 0))
                          (SETF (MD5-STATE-BUFFER-INDEX STATE) AMOUNT))))))
      (SETF (MD5-STATE-AMOUNT STATE)
              (THE (UNSIGNED-BYTE 29) (+ (MD5-STATE-AMOUNT STATE) LENGTH)))
      STATE))

[pg/md5.lisp:462]
  (DEFUN FINALIZE-MD5-STATE (STATE)
    "If the given md5-state has not already been finalized, finalize it,
by processing any remaining input in its buffer, with suitable padding
and appended bit-length, as specified by the MD5 standard.

The resulting MD5 message-digest is returned as an array of sixteen
(unsigned-byte 8) values.  Calling `update-md5-state' after a call to
`finalize-md5-state' results in unspecified behaviour."
    (DECLARE (TYPE MD5-STATE STATE)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0))
             (#S(FORMGREP:SYMREF :NAME "OPTIMIZE-INTERFACE" :QUALIFIER "EXT")
              (SAFETY 1) (DEBUG 1)))
    (OR (MD5-STATE-FINALIZED-P STATE)
        (LET ((REGS (MD5-STATE-REGS STATE))
              (BLOCK (MD5-STATE-BLOCK STATE))
              (BUFFER (MD5-STATE-BUFFER STATE))
              (BUFFER-INDEX (MD5-STATE-BUFFER-INDEX STATE))
              (TOTAL-LENGTH (* 8 (MD5-STATE-AMOUNT STATE))))
          (DECLARE (TYPE MD5-REGS REGS)
                   (TYPE (INTEGER 0 63) BUFFER-INDEX)
                   (TYPE (SIMPLE-ARRAY UB32 (16)) BLOCK)
                   (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) BUFFER))
          (SETF (AREF BUFFER BUFFER-INDEX) 128)
          (LOOP FOR INDEX OF-TYPE (INTEGER 0 64) FROM (1+
                                                       BUFFER-INDEX) BELOW 64
                DO (SETF (AREF BUFFER INDEX) 0))
          (FILL-BLOCK-UB8 BLOCK BUFFER 0)
          (WHEN (>= BUFFER-INDEX 56)
            (UPDATE-MD5-BLOCK REGS BLOCK)
            (LOOP FOR INDEX OF-TYPE (INTEGER 0 16) FROM 0 BELOW 16
                  DO (SETF (AREF BLOCK INDEX) 0)))
          (SETF (AREF BLOCK 14) (LDB (BYTE 32 0) TOTAL-LENGTH))
          (UPDATE-MD5-BLOCK REGS BLOCK)
          (SETF (MD5-STATE-FINALIZED-P STATE) (MD5REGS-DIGEST REGS)))))

[pg/md5.lisp:509]
  (DEFUN MD5SUM-SEQUENCE (SEQUENCE &KEY (START 0) END)
    "Calculate the MD5 message-digest of data bounded by START and END
in SEQUENCE , which must be a vector with element-type (UNSIGNED-BYTE
8)."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 3) (SPACE 0) (DEBUG 1))
             (TYPE (VECTOR (UNSIGNED-BYTE 8)) SEQUENCE)
             (TYPE FIXNUM START))
    (LOCALLY
     (DECLARE (OPTIMIZE (SAFETY 1) (DEBUG 0)))
     (LET ((STATE (MAKE-MD5-STATE)))
       (DECLARE (TYPE MD5-STATE STATE))
       (#S(FORMGREP:SYMREF :NAME "WITH-ARRAY-DATA" :QUALIFIER "LISP")
        ((DATA SEQUENCE) (REAL-START START) (REAL-END END))
        (UPDATE-MD5-STATE STATE DATA :START REAL-START :END REAL-END))
       (SB-KERNEL:WITH-ARRAY-DATA ((DATA SEQUENCE) (REAL-START START)
                                   (REAL-END END))
         (UPDATE-MD5-STATE STATE DATA :START REAL-START :END REAL-END))
       (FINALIZE-MD5-STATE STATE))))

[pg/md5.lisp:532]
  (DEFUN MD5SUM-STRING (STRING &KEY (EXTERNAL-FORMAT :DEFAULT) (START 0) END)
    "Calculate the MD5 message-digest of the binary representation
of STRING (as octets) in EXTERNAL-FORMAT. The boundaries START
and END refer to character positions in the string, not to octets
in the resulting binary representation."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 3) (SPACE 0) (DEBUG 1))
             (TYPE STRING STRING)
             (TYPE FIXNUM START))
    (LOCALLY
     (DECLARE (OPTIMIZE (SAFETY 1) (DEBUG 0)))
     (MD5SUM-SEQUENCE
      (STRING-TO-OCTETS STRING :EXTERNAL-FORMAT EXTERNAL-FORMAT :START START
                        :END END))))

[pg/md5.lisp:553]
  (DEFUN MD5SUM-STREAM (STREAM)
    "Calculate an MD5 message-digest of the contents of STREAM, whose
element-type has to be (UNSIGNED-BYTE 8)."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 3) (SPACE 0) (DEBUG 1)))
    (DECLARE (TYPE STREAM STREAM))
    (LOCALLY
     (DECLARE (OPTIMIZE (SAFETY 1) (DEBUG 0)))
     (LET ((STATE (MAKE-MD5-STATE)))
       (DECLARE (TYPE MD5-STATE STATE))
       (COND
        ((EQUAL (STREAM-ELEMENT-TYPE STREAM) '(UNSIGNED-BYTE 8))
         (LET ((BUFFER
                (MAKE-ARRAY +BUFFER-SIZE+ :ELEMENT-TYPE '(UNSIGNED-BYTE 8))))
           (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (NIL)) BUFFER))
           (LOOP FOR BYTES OF-TYPE BUFFER-INDEX = (READ-SEQUENCE BUFFER STREAM)
                 DO (UPDATE-MD5-STATE STATE BUFFER :END BYTES)
                 UNTIL (< BYTES +BUFFER-SIZE+)
                 FINALLY (RETURN (FINALIZE-MD5-STATE STATE)))))
        ((EQUAL (STREAM-ELEMENT-TYPE STREAM) 'CHARACTER)
         (LET ((BUFFER (MAKE-STRING +BUFFER-SIZE+)))
           (DECLARE (TYPE (SIMPLE-STRING NIL) BUFFER))
           (LOOP FOR BYTES OF-TYPE BUFFER-INDEX = (READ-SEQUENCE BUFFER STREAM)
                 DO (UPDATE-MD5-STATE STATE BUFFER :END BYTES)
                 UNTIL (< BYTES +BUFFER-SIZE+)
                 FINALLY (RETURN (FINALIZE-MD5-STATE STATE)))))
        (T
         (ERROR "Unsupported stream element-type ~S for stream ~S."
                (STREAM-ELEMENT-TYPE STREAM) STREAM))))))

[pg/md5.lisp:586]
  (DEFUN MD5SUM-FILE (PATHNAME)
    "Calculate the MD5 message-digest of the file designated by
pathname."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 3) (SPACE 0) (DEBUG 1)))
    (LOCALLY
     (DECLARE (OPTIMIZE (SAFETY 1) (DEBUG 0)))
     (WITH-OPEN-FILE (STREAM PATHNAME :ELEMENT-TYPE '(UNSIGNED-BYTE 8))
       (MD5SUM-STREAM STREAM))))

[pg/parsers.lisp:39]
  (DECLAIM (OPTIMIZE (SPEED 3) (SAFETY 1)))

[pg/pg.lisp:55]
  (DECLAIM (OPTIMIZE (SPEED 3) (SAFETY 1)))

[pg/v3-protocol.lisp:7]
  (DECLAIM (OPTIMIZE (SPEED 3) (SAFETY 1)))

[piblington-snorkblather/lolcat.lisp:13]
  (DECLAIM
   (OPTIMIZE (SPEED 0) (SAFETY 3) (DEBUG 3) (SPACE 0) (COMPILATION-SPEED 0)))

[piblington-snorkblather/pipes.lisp:16]
  (DECLAIM
   (OPTIMIZE (SPEED 0) (SAFETY 3) (DEBUG 3) (SPACE 0) (COMPILATION-SPEED 0)))

[piblington-snorkblather/rain.lisp:195]
  (DEFUN NORMAL-DISTRIBUTION-1 ()
    "Slow old fashioned normal distribution."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (IF *HAS-LAST-ONE*
        (PROGN (SETF *HAS-LAST-ONE* NIL) *LAST-ONE*)
        (LET ((X1 0.0d0) (X2 0.0d0) (W 0.0d0) (Y1 0.0d0))
          (DECLARE (TYPE DOUBLE-FLOAT X1 X2 W Y1))
          (LOOP :DO (SETF X1 (* 2.0 (- (RANDOM 1.0d0) 1.0d0))
                          X2 (* 2.0 (- (RANDOM 1.0d0) 1.0d0))
                          W (+ (* X1 X1) (* X2 X2)))
                :WHILE (OR (> W 1) (= W 0)))
          (SETF W (SQRT (/ (* -2.0d0 (LOG W)) W))
                Y1 (* X1 W)
                *LAST-ONE* (* X2 W)
                *HAS-LAST-ONE* T)
          (THE DOUBLE-FLOAT Y1))))

[piblington-snorkblather/rain.lisp:225]
  (DEFUN NORMAL-DISTRIBUTION-2 ()
    "Draw a random number from N(0,1)."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (MUFFLE-CONDITIONS COMPILER-NOTE))
    (TAGBODY
     TOP
      (LET* ((U (RANDOM 1.0d0))
             (V (* 1.7156d0 (- (RANDOM 1.0d0) 0.5d0)))
             (X (- U 0.449871d0))
             (Y (+ (ABS V) 0.386595d0))
             (Q (+ (EXPT X 2) (* Y (- (* 0.196d0 Y) (* 0.25472d0 X))))))
        (IF (AND (> Q 0.27597d0)
                 (OR (> Q 0.27846d0)
                     (PLUSP (+ (EXPT V 2) (* 4 (EXPT U 2) (LOG U))))))
            (GO TOP)
            (RETURN-FROM NORMAL-DISTRIBUTION-2 (/ V U))))))

[piblington-snorkblather/tetris.lisp:35]
  (DECLAIM
   (OPTIMIZE (SPEED 0) (SAFETY 3) (DEBUG 3) (SPACE 0) (COMPILATION-SPEED 0)))

[pileup/pileup.lisp:35]
  (DEFSTRUCT
      (HEAP
       (:CONSTRUCTOR MAKE-HEAP
        (PREDICATE &KEY ((:NAME %NAME)) ((:SIZE %SIZE) 12) ((:KEY %KEY)) &AUX
         (%VECTOR (MAKE-HEAP-VECTOR %SIZE)) (%PREDICATE PREDICATE)
         (FAST-PRED
          (LOCALLY
           (DECLARE (MUFFLE-CONDITIONS COMPILER-NOTE))
           (IF %KEY
               (LAMBDA (X Y)
                 (DECLARE (FUNCTION %KEY %PREDICATE)
                          (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
                 (LET ((XX (FUNCALL %KEY X)) (YY (FUNCALL %KEY Y)))
                   (FUNCALL %PREDICATE XX YY)))
               %PREDICATE)))))
       (:CONSTRUCTOR MAKE-HEAP-USING-FAST-PRED
        (%PREDICATE FAST-PRED &KEY ((:NAME %NAME)) ((:SIZE %SIZE) 12) &AUX
         (%VECTOR (MAKE-HEAP-VECTOR %SIZE))))
       (:COPIER NIL) (:PREDICATE NIL))
    "A thread-safe binary heap.

Heap operations which need the heap to remain consistent heap lock it. Users
can also group multiple heap operations into atomic units using
WITH-LOCKED-HEAP.

Thread-safety is implemented using a single lock per heap. While Pileup heaps
are fine for threaded use, a more specialized solution is recommended when the
heap is highly contested between multiple threads.

Important: Pileup heaps are not asynch-unwind safe: asynchronous interrupts
causing non-local exits may leave the heap in an inconsistent state or lose
data. Do not use INTERRUPT-THREAD or asychronous timeouts with Pileup.

All slot names in HEAP are internal to the PILEUP package, so it is safe to
subclass using eg. DEFSTRUCT :INCLUDE, as long as only the exported operations
are used to accessor or modify heap state."
    (%NAME NIL)
    (%VECTOR (REQUIRED-ARGUMENT :VECTOR) :TYPE SIMPLE-VECTOR)
    (%COUNT 0 :TYPE ARRAY-INDEX)
    (%SIZE (REQUIRED-ARGUMENT :%SIZE) :TYPE ARRAY-INDEX)
    (%PREDICATE (REQUIRED-ARGUMENT :PREDICATE) :TYPE FUNCTION :READ-ONLY T)
    (%KEY NIL :TYPE (OR NULL FUNCTION) :READ-ONLY T)
    (FAST-PRED (REQUIRED-ARGUMENT :FAST-PRED) :TYPE FUNCTION :READ-ONLY T)
    (LOCK (SB-THREAD:MAKE-MUTEX :NAME "Heap Lock") :READ-ONLY T)
    (STATE :CLEAN :TYPE (MEMBER :CLEAN :DIRTY :TRAVERSE)))

[pileup/pileup.lisp:105]
  (MACROLET ((FAST (NAME)
               (LET ((TWO-ARG-NAME (SYMBOLICATE '#:TWO-ARG- NAME)))
                 (ECLECTOR.READER:QUASIQUOTE
                  (PROGN
                   (DEFUN (ECLECTOR.READER:UNQUOTE TWO-ARG-NAME) (X Y)
                     (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
                     (DECLARE (MUFFLE-CONDITIONS COMPILER-NOTE))
                     ((ECLECTOR.READER:UNQUOTE NAME) X Y))
                   (PUSHNEW
                    (CONS '(ECLECTOR.READER:UNQUOTE NAME)
                          '#'(ECLECTOR.READER:UNQUOTE TWO-ARG-NAME))
                    *TWO-ARG-PREDICATES* :TEST #'EQUAL))))))
    (FAST <)
    (FAST <=)
    (FAST >)
    (FAST >=))

[plexippus-xpath/xnum-ieee.lisp:76]
  (DEFUN XNUM-/ (A B)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (/ (FLOAT A 1.0d0) (FLOAT B 1.0d0)))

[plump/lexer.lisp:31]
  (DEFUN CONSUME ()
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (WHEN (< *INDEX* *LENGTH*)
      (PROG1 (AREF *STRING* *INDEX*)
        (FORMAT T "~a +~%" *INDEX*)
        (INCF *INDEX*))))

[plump/lexer.lisp:40]
  (DEFUN ADVANCE ()
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (WHEN (< *INDEX* *LENGTH*) (FORMAT T "~a +~%" *INDEX*) (INCF *INDEX*)))

[plump/lexer.lisp:48]
  (DEFUN UNREAD ()
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (WHEN (< 0 *INDEX*) (FORMAT T "~a -~%" *INDEX*) (DECF *INDEX*))
    *INDEX*)

[plump/lexer.lisp:57]
  (DEFUN PEEK ()
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (WHEN (< *INDEX* *LENGTH*)
      (FORMAT T "~a ?~%" *INDEX*)
      (AREF *STRING* *INDEX*)))

[plump/lexer.lisp:65]
  (DEFUN ADVANCE-N (N)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DECLARE (FIXNUM N))
    (FORMAT T "~a +~d~%" *INDEX* N)
    (INCF *INDEX* N)
    (WHEN (<= *LENGTH* *INDEX*) (SETF *INDEX* *LENGTH*))
    *INDEX*)

[plump/lexer.lisp:76]
  (DEFUN UNREAD-N (N)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DECLARE (FIXNUM N))
    (FORMAT T "~a -~d~%" *INDEX* N)
    (DECF *INDEX* N)
    (WHEN (< *INDEX* 0) (SETF *INDEX* 0))
    *INDEX*)

[pngload/src/decode.lisp:68]
  (DEFUN UNFILTER-ROW-SUB (Y DATA ROW-START ROW-BYTES PIXEL-BYTES)
    (DECLARE (TYPE UB8A1D DATA)
             (TYPE (AND FIXNUM (INTEGER 0)) Y ROW-START)
             (TYPE (AND FIXNUM (INTEGER 1)) ROW-BYTES PIXEL-BYTES)
             (IGNORE Y)
             (OPTIMIZE SPEED (SAFETY 0)))
    (LOOP :FOR X :FROM (THE FIXNUM (+ ROW-START PIXEL-BYTES)) :BELOW (THE
                                                                      FIXNUM
                                                                      (+
                                                                       ROW-START
                                                                       (1-
                                                                        ROW-BYTES)))
          :FOR A FIXNUM = (- X PIXEL-BYTES)
          :DO (SETF (AREF DATA X)
                      (LDB (BYTE 8 0) (+ (AREF DATA X) (AREF DATA A))))))

[pngload/src/decode.lisp:80]
  (DEFUN UNFILTER-ROW-UP (Y DATA ROW-START ROW-BYTES PIXEL-BYTES)
    (DECLARE (TYPE UB8A1D DATA)
             (TYPE (AND FIXNUM (INTEGER 0)) Y ROW-START)
             (TYPE (AND FIXNUM (INTEGER 1)) ROW-BYTES PIXEL-BYTES)
             (IGNORE PIXEL-BYTES)
             (OPTIMIZE SPEED (SAFETY 0)))
    (WHEN (PLUSP Y)
      (LOOP :FOR X FIXNUM :FROM ROW-START :BELOW (+ ROW-START (1- ROW-BYTES))
            :FOR A FIXNUM = (- X ROW-BYTES)
            :DO (SETF (AREF DATA X)
                        (LDB (BYTE 8 0) (+ (AREF DATA X) (AREF DATA A)))))))

[pngload/src/decode.lisp:92]
  (DEFUN UNFILTER-ROW-AVERAGE (Y DATA ROW-START ROW-BYTES PIXEL-BYTES)
    (DECLARE (TYPE UB8A1D DATA)
             (TYPE (AND FIXNUM (INTEGER 0)) Y ROW-START)
             (TYPE (AND FIXNUM (INTEGER 1)) ROW-BYTES PIXEL-BYTES)
             (OPTIMIZE SPEED (SAFETY 0)))
    (LOOP :FOR X FIXNUM :FROM ROW-START :BELOW (+ ROW-START (1- ROW-BYTES))
          :FOR A FIXNUM = (- X PIXEL-BYTES)
          :FOR B FIXNUM = (- X ROW-BYTES)
          :DO (SETF (AREF DATA X)
                      (LDB (BYTE 8 0)
                           (+ (AREF DATA X)
                              (FLOOR
                               (+
                                (IF (>= A ROW-START)
                                    (AREF DATA A)
                                    0)
                                (IF (PLUSP Y)
                                    (AREF DATA B)
                                    0))
                               2))))))

[pngload/src/decode.lisp:107]
  (DEFUN UNFILTER-ROW-PAETH (Y DATA ROW-START ROW-BYTES PIXEL-BYTES)
    (DECLARE (TYPE UB8A1D DATA)
             (TYPE (AND FIXNUM (INTEGER 0)) Y ROW-START)
             (TYPE (AND FIXNUM (INTEGER 1)) ROW-BYTES PIXEL-BYTES)
             (OPTIMIZE SPEED (SAFETY 0)))
    (IF (ZEROP Y)
        (UNFILTER-ROW-SUB Y DATA ROW-START ROW-BYTES PIXEL-BYTES)
        (LET ((TMP1 (+ ROW-START PIXEL-BYTES)))
          (DECLARE (FIXNUM TMP1))
          (LOOP :FOR X FIXNUM :FROM ROW-START :BELOW TMP1
                :DO (SETF (AREF DATA X)
                            (LDB (BYTE 8 0)
                                 (+ (AREF DATA X)
                                    (AREF DATA (- X ROW-BYTES))))))
          (LOOP :FOR X FIXNUM :FROM TMP1 :BELOW (+ ROW-START (1- ROW-BYTES))
                :DO (LET* ((A (- X PIXEL-BYTES))
                           (B (- X ROW-BYTES))
                           (C (- B PIXEL-BYTES))
                           (AV (AREF DATA A))
                           (BV (AREF DATA B))
                           (CV (AREF DATA C))
                           (P (- (+ AV BV) CV))
                           (PA (ABS (- P AV)))
                           (PB (ABS (- P BV)))
                           (PC (ABS (- P CV)))
                           (TMP2
                            (COND ((AND (<= PA PB) (<= PA PC)) AV)
                                  ((<= PB PC) BV) (T CV))))
                      (DECLARE (FIXNUM A B C AV BV CV P PA PB PC))
                      (SETF (AREF DATA X)
                              (LDB (BYTE 8 0) (+ (AREF DATA X) TMP2))))))))

[pngload/src/decode.lisp:197]
  (DEFMACRO COPY/8 (PNG)
    (DECLARE (IGNORE PNG))
    (ECLECTOR.READER:QUASIQUOTE
     (LOOP :FOR D FIXNUM :BELOW (ARRAY-TOTAL-SIZE DATA)
           :FOR S FIXNUM :BELOW (ARRAY-TOTAL-SIZE IMAGE-DATA)
           :DO (LOCALLY
                (DECLARE (OPTIMIZE SPEED (SAFETY 0)))
                (SETF (%ROW-MAJOR-AREF DATA D) (AREF IMAGE-DATA S))))))

[pngload/src/decode.lisp:205]
  (DEFMACRO COPY/8/FLIP (PNG)
    (ECLECTOR.READER:QUASIQUOTE
     (LET* ((WIDTH (WIDTH (ECLECTOR.READER:UNQUOTE PNG)))
            (HEIGHT (HEIGHT (ECLECTOR.READER:UNQUOTE PNG)))
            (CHANNELS (GET-IMAGE-RAW-CHANNELS (ECLECTOR.READER:UNQUOTE PNG)))
            (STRIDE (* CHANNELS WIDTH))
            (SSIZE (ARRAY-TOTAL-SIZE IMAGE-DATA))
            (DSIZE (ARRAY-TOTAL-SIZE DATA)))
       (DECLARE (FIXNUM SSIZE DSIZE)
                (TYPE (UNSIGNED-BYTE 34) STRIDE))
       (LOOP :FOR DY :BELOW HEIGHT
             :FOR SY :DOWNFROM (1- HEIGHT)
             :FOR D1 = (* DY STRIDE)
             :FOR S1 = (* SY STRIDE)
             :DO (ASSERT (<= 0 (+ D1 STRIDE) DSIZE)) (ASSERT
                                                      (<= 0 (+ S1 STRIDE)
                                                          SSIZE)) (LOCALLY
                                                                   (DECLARE
                                                                    (OPTIMIZE
                                                                     SPEED))
                                                                   (LOOP :FOR S FIXNUM :FROM S1 :BELOW SSIZE
                                                                         :FOR D FIXNUM :FROM D1 :BELOW DSIZE
                                                                         :REPEAT STRIDE
                                                                         :DO (LOCALLY
                                                                              (DECLARE
                                                                               (OPTIMIZE
                                                                                SPEED
                                                                                (SAFETY
                                                                                 0)))
                                                                              (SETF (%ROW-MAJOR-AREF
                                                                                     DATA
                                                                                     D)
                                                                                      (AREF
                                                                                       IMAGE-DATA
                                                                                       S)))))))))

[pngload/src/decode.lisp:228]
  (DEFMACRO COPY/16 (PNG)
    (DECLARE (IGNORE PNG))
    (ECLECTOR.READER:QUASIQUOTE
     (PROGN
      (ASSERT
       (OR (>= (ARRAY-TOTAL-SIZE IMAGE-DATA) (* 2 (ARRAY-TOTAL-SIZE DATA)))
           (ZEROP (MOD (ARRAY-TOTAL-SIZE IMAGE-DATA) 2))))
      (LOOP :FOR D :BELOW (ARRAY-TOTAL-SIZE DATA)
            :FOR S :BELOW (ARRAY-TOTAL-SIZE IMAGE-DATA) :BY 2
            :DO (LOCALLY
                 (DECLARE (OPTIMIZE SPEED (SAFETY 0)))
                 (SETF (%ROW-MAJOR-AREF DATA D)
                         (DPB (AREF IMAGE-DATA S) (BYTE 8 8)
                              (AREF IMAGE-DATA (1+ S)))))))))

[pngload/src/decode.lisp:241]
  (DEFMACRO COPY/16/FLIP (PNG)
    (ECLECTOR.READER:QUASIQUOTE
     (LET* ((WIDTH (WIDTH (ECLECTOR.READER:UNQUOTE PNG)))
            (HEIGHT (HEIGHT (ECLECTOR.READER:UNQUOTE PNG)))
            (CHANNELS (GET-IMAGE-RAW-CHANNELS (ECLECTOR.READER:UNQUOTE PNG)))
            (STRIDE (* CHANNELS WIDTH))
            (SSIZE (ARRAY-TOTAL-SIZE IMAGE-DATA))
            (DSIZE (ARRAY-TOTAL-SIZE DATA)))
       (DECLARE (FIXNUM SSIZE DSIZE)
                (TYPE (UNSIGNED-BYTE 34) STRIDE))
       (LOOP :FOR DY :BELOW HEIGHT
             :FOR SY :DOWNFROM (1- HEIGHT)
             :FOR D1 = (* DY STRIDE)
             :FOR S1 = (* SY STRIDE 2)
             :DO (ASSERT (<= 0 (+ D1 STRIDE) DSIZE)) (ASSERT
                                                      (<= 0
                                                          (+ S1 STRIDE STRIDE)
                                                          SSIZE)) (LOCALLY
                                                                   (DECLARE
                                                                    (OPTIMIZE
                                                                     SPEED))
                                                                   (LOOP :FOR S FIXNUM :FROM S1 :BELOW SSIZE :BY 2
                                                                         :FOR D FIXNUM :FROM D1 :BELOW DSIZE
                                                                         :REPEAT STRIDE
                                                                         :DO (LOCALLY
                                                                              (DECLARE
                                                                               (OPTIMIZE
                                                                                SPEED
                                                                                (SAFETY
                                                                                 0)))
                                                                              (SETF (%ROW-MAJOR-AREF
                                                                                     DATA
                                                                                     D)
                                                                                      (DPB
                                                                                       (AREF
                                                                                        IMAGE-DATA
                                                                                        S)
                                                                                       (BYTE
                                                                                        8
                                                                                        8)
                                                                                       (AREF
                                                                                        IMAGE-DATA
                                                                                        (1+
                                                                                         S)))))))))))

[pngload/src/decode.lisp:366]
  (DEFUN FLIP (PNG IMAGE)
    (LET ((W (WIDTH PNG)) (H (HEIGHT PNG)) (C (GET-IMAGE-CHANNELS PNG)))
      (LET ((STRIDE (* W C)) (END (ARRAY-TOTAL-SIZE IMAGE)))
        (ASSERT (PLUSP STRIDE))
        (MACROLET ((F (&KEY (OPT T))
                     (ECLECTOR.READER:QUASIQUOTE
                      (LOOP :FOR Y1 :BELOW (FLOOR H 2)
                            :FOR Y2 :DOWNFROM (1- H) :ABOVE 0
                            :DO (LOOP :FOR X1 :FROM (* Y1 STRIDE) :BELOW
                                      END
                                      :FOR X2 :FROM (* Y2 STRIDE) :BELOW
                                      END
                                      :REPEAT STRIDE
                                      :DO ((ECLECTOR.READER:UNQUOTE-SPLICING
                                            (IF OPT
                                                '(LOCALLY
                                                  (DECLARE
                                                   (OPTIMIZE SPEED
                                                    (SAFETY 0))))
                                                '(PROGN)))
                                           (ROTATEF (%ROW-MAJOR-AREF IMAGE X1)
                                                    (%ROW-MAJOR-AREF IMAGE
                                                     X2))))))))
          (TYPECASE IMAGE
            (UB8A3D (F))
            (UB8A2D (F))
            (UB8A1D (F))
            (UB16A3D (F))
            (UB16A2D (F))
            (UB16A1D (F))
            (T (F :OPT NIL)))))))

[portableaserve/acl-compat/acl-excl-common.lisp:188]
  (DEFMACRO FAST (&BODY FORMS)
    (ECLECTOR.READER:QUASIQUOTE
     (LOCALLY
      (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
      (ECLECTOR.READER:UNQUOTE-SPLICING FORMS))))

[portableaserve/acl-compat/acl-excl-corman.lisp:200]
  (DEFMACRO FAST (&BODY FORMS)
    (ECLECTOR.READER:QUASIQUOTE
     (LOCALLY
      (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
      (ECLECTOR.READER:UNQUOTE-SPLICING FORMS))))

[postmodern/cl-postgres/messages.lisp:128]
  (DEFUN PARSE-MESSAGE-BINARY-PARAMETERS (S NAME QUERY PARAMETERS)
    "Like parse-message but specifically when binary parameters are parsed."
    (DECLARE (TYPE STREAM S)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 1) (DEBUG 1)
              (COMPILATION-SPEED 0)))
    (LET ((LEN (LENGTH PARAMETERS)))
      (WRITE-UINT1 S 80)
      (WRITE-UINT4 S
       (+ 8 (* LEN 4) (ENC-BYTE-LENGTH QUERY) (ENC-BYTE-LENGTH NAME)))
      (WRITE-STR S NAME)
      (WRITE-STR S QUERY)
      (IF PARAMETERS
          (PROGN
           (WRITE-UINT2 S LEN)
           (LOOP FOR X IN PARAMETERS
                 DO (WRITE-UINT4 S (PARAM-TO-OID X))))
          (WRITE-UINT2 S 0))))

[postmodern/cl-postgres/package.lisp:279]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (DEFPARAMETER *OPTIMIZE*
      '(OPTIMIZE (SPEED 3) (SAFETY 1) (SPACE 1) (DEBUG 1)
        (COMPILATION-SPEED 0))))

[postmodern/cl-postgres/trivial-utf-8.lisp:10]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (DEFPARAMETER *OPTIMIZE*
      '(OPTIMIZE (SPEED 3) (SAFETY 1) (SPACE 0) (DEBUG 1)
        (COMPILATION-SPEED 0))))

[proc-parse/src/proc-parse.lisp:238]
  (DEFMACRO PARSING-MACROLET ((ELEM DATA P END) (&REST MACROS) &BODY BODY)
    (ECLECTOR.READER:QUASIQUOTE
     (MACROLET ((ADVANCE (&OPTIONAL (STEP 1))
                  (ECLECTOR.READER:QUASIQUOTE
                   (OR (ADVANCE* (ECLECTOR.READER:UNQUOTE STEP)) (GO :EOF))))
                (ADVANCE* (&OPTIONAL (STEP 1))
                  (ECLECTOR.READER:QUASIQUOTE
                   (LOCALLY
                    (DECLARE
                     (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)
                      (COMPILATION-SPEED 0)))
                    (INCF
                     (ECLECTOR.READER:UNQUOTE '(ECLECTOR.READER:UNQUOTE P))
                     (ECLECTOR.READER:UNQUOTE STEP))
                    (ECLECTOR.READER:UNQUOTE-SPLICING
                     (IF (EQL STEP 0)
                         NIL
                         (ECLECTOR.READER:QUASIQUOTE
                          ((IF (<=
                                (ECLECTOR.READER:UNQUOTE
                                 '(ECLECTOR.READER:UNQUOTE END))
                                (ECLECTOR.READER:UNQUOTE
                                 '(ECLECTOR.READER:UNQUOTE P)))
                               NIL
                               (PROGN
                                (SETQ (ECLECTOR.READER:UNQUOTE
                                       '(ECLECTOR.READER:UNQUOTE ELEM))
                                        (AREF
                                         (ECLECTOR.READER:UNQUOTE
                                          '(ECLECTOR.READER:UNQUOTE DATA))
                                         (ECLECTOR.READER:UNQUOTE
                                          '(ECLECTOR.READER:UNQUOTE P))))
                                T)))))))))
                (ADVANCE-TO (TO)
                  (ECLECTOR.READER:QUASIQUOTE
                   (OR (ADVANCE-TO* (ECLECTOR.READER:UNQUOTE TO)) (GO :EOF))))
                (ADVANCE-TO* (TO)
                  (ONCE-ONLY (TO)
                   (ECLECTOR.READER:QUASIQUOTE
                    (LOCALLY
                     (DECLARE
                      (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)
                       (COMPILATION-SPEED 0)))
                     (CHECK-TYPE (ECLECTOR.READER:UNQUOTE TO) FIXNUM)
                     (SETQ (ECLECTOR.READER:UNQUOTE
                            '(ECLECTOR.READER:UNQUOTE P))
                             (ECLECTOR.READER:UNQUOTE TO))
                     (IF (<=
                          (ECLECTOR.READER:UNQUOTE
                           '(ECLECTOR.READER:UNQUOTE END))
                          (ECLECTOR.READER:UNQUOTE
                           '(ECLECTOR.READER:UNQUOTE P)))
                         NIL
                         (PROGN
                          (SETQ (ECLECTOR.READER:UNQUOTE
                                 '(ECLECTOR.READER:UNQUOTE ELEM))
                                  (AREF
                                   (ECLECTOR.READER:UNQUOTE
                                    '(ECLECTOR.READER:UNQUOTE DATA))
                                   (ECLECTOR.READER:UNQUOTE
                                    '(ECLECTOR.READER:UNQUOTE P))))
                          T))))))
                (SKIP (&REST ELEMS)
                  (CHECK-SKIP-ELEMS ELEMS)
                  (ECLECTOR.READER:QUASIQUOTE
                   (LOCALLY
                    (DECLARE
                     (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)
                      (COMPILATION-SPEED 0)))
                    (IF (SKIP-CONDITIONS
                         (ECLECTOR.READER:UNQUOTE
                          '(ECLECTOR.READER:UNQUOTE ELEM))
                         (ECLECTOR.READER:UNQUOTE ELEMS))
                        (ADVANCE)
                        (ERROR 'MATCH-FAILED :ELEM
                               (ECLECTOR.READER:UNQUOTE
                                '(ECLECTOR.READER:UNQUOTE ELEM))
                               :EXPECTED '(ECLECTOR.READER:UNQUOTE ELEMS))))))
                (SKIP* (&REST ELEMS)
                  (CHECK-SKIP-ELEMS ELEMS)
                  (ECLECTOR.READER:QUASIQUOTE
                   (LOCALLY
                    (DECLARE
                     (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)
                      (COMPILATION-SPEED 0)))
                    (UNLESS (EOFP)
                      (LOOP
                       (UNLESS
                           (SKIP-CONDITIONS
                            (ECLECTOR.READER:UNQUOTE
                             '(ECLECTOR.READER:UNQUOTE ELEM))
                            (ECLECTOR.READER:UNQUOTE ELEMS))
                         (RETURN))
                       (OR (ADVANCE*) (GO :EOF)))))))
                (SKIP+ (&REST ELEMS)
                  (ECLECTOR.READER:QUASIQUOTE
                   (PROGN
                    (SKIP (ECLECTOR.READER:UNQUOTE-SPLICING ELEMS))
                    (SKIP* (ECLECTOR.READER:UNQUOTE-SPLICING ELEMS)))))
                (SKIP? (&REST ELEMS)
                  (CHECK-SKIP-ELEMS ELEMS)
                  (ECLECTOR.READER:QUASIQUOTE
                   (LOCALLY
                    (DECLARE
                     (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)
                      (COMPILATION-SPEED 0)))
                    (WHEN
                        (SKIP-CONDITIONS
                         (ECLECTOR.READER:UNQUOTE
                          '(ECLECTOR.READER:UNQUOTE ELEM))
                         (ECLECTOR.READER:UNQUOTE ELEMS))
                      (OR (ADVANCE*) (GO :EOF))))))
                (SKIP-UNTIL (FN)
                  (ECLECTOR.READER:QUASIQUOTE
                   (LOOP UNTIL (ECLECTOR.READER:UNQUOTE
                                (IF (SYMBOLP FN)
                                    (ECLECTOR.READER:QUASIQUOTE
                                     ((ECLECTOR.READER:UNQUOTE FN)
                                      (GET-ELEM
                                       (ECLECTOR.READER:UNQUOTE
                                        '(ECLECTOR.READER:UNQUOTE ELEM)))))
                                    (ECLECTOR.READER:QUASIQUOTE
                                     (FUNCALL (ECLECTOR.READER:UNQUOTE FN)
                                              (GET-ELEM
                                               (ECLECTOR.READER:UNQUOTE
                                                '(ECLECTOR.READER:UNQUOTE
                                                  ELEM)))))))
                         DO (OR (ADVANCE*) (GO :EOF)))))
                (SKIP-WHILE (FN)
                  (ECLECTOR.READER:QUASIQUOTE
                   (LOOP WHILE (ECLECTOR.READER:UNQUOTE
                                (IF (SYMBOLP FN)
                                    (ECLECTOR.READER:QUASIQUOTE
                                     ((ECLECTOR.READER:UNQUOTE FN)
                                      (GET-ELEM
                                       (ECLECTOR.READER:UNQUOTE
                                        '(ECLECTOR.READER:UNQUOTE ELEM)))))
                                    (ECLECTOR.READER:QUASIQUOTE
                                     (FUNCALL (ECLECTOR.READER:UNQUOTE FN)
                                              (GET-ELEM
                                               (ECLECTOR.READER:UNQUOTE
                                                '(ECLECTOR.READER:UNQUOTE
                                                  ELEM)))))))
                         DO (OR (ADVANCE*) (GO :EOF)))))
                (BIND ((SYMB &BODY BIND-FORMS) &BODY BODY)
                  (WITH-GENSYMS (START)
                   (ECLECTOR.READER:QUASIQUOTE
                    (LET (((ECLECTOR.READER:UNQUOTE START)
                           (ECLECTOR.READER:UNQUOTE
                            '(ECLECTOR.READER:UNQUOTE P))))
                      (TAGBODY
                        (ECLECTOR.READER:UNQUOTE-SPLICING BIND-FORMS)
                       :EOF)
                      (PROG1
                          (LET (((ECLECTOR.READER:UNQUOTE SYMB)
                                 (SUBSEQ*
                                  (ECLECTOR.READER:UNQUOTE
                                   '(ECLECTOR.READER:UNQUOTE DATA))
                                  (ECLECTOR.READER:UNQUOTE START)
                                  (ECLECTOR.READER:UNQUOTE
                                   '(ECLECTOR.READER:UNQUOTE P)))))
                            (ECLECTOR.READER:UNQUOTE-SPLICING BODY))
                        (WHEN (EOFP) (GO :EOF)))))))
                (%MATCH (&REST VECTORS)
                  (ECLECTOR.READER:QUASIQUOTE
                   (%MATCH-CASE
                    (ECLECTOR.READER:UNQUOTE-SPLICING
                     (LOOP FOR VEC IN VECTORS
                           COLLECT (ECLECTOR.READER:QUASIQUOTE
                                    ((ECLECTOR.READER:UNQUOTE VEC))))))))
                (MATCH (&REST VECTORS)
                  (ECLECTOR.READER:QUASIQUOTE
                   (BLOCK MATCH-BLOCK
                     (TAGBODY
                       (RETURN-FROM MATCH-BLOCK
                         (%MATCH (ECLECTOR.READER:UNQUOTE-SPLICING VECTORS)))
                      :MATCH-FAILED
                       (ERROR 'MATCH-FAILED :ELEM
                              (ECLECTOR.READER:UNQUOTE
                               '(ECLECTOR.READER:UNQUOTE ELEM)))))))
                (MATCH? (&REST VECTORS)
                  (WITH-GENSYMS (START START-ELEM)
                   (ECLECTOR.READER:QUASIQUOTE
                    (LET (((ECLECTOR.READER:UNQUOTE START)
                           (ECLECTOR.READER:UNQUOTE
                            '(ECLECTOR.READER:UNQUOTE P)))
                          ((ECLECTOR.READER:UNQUOTE START-ELEM)
                           (ECLECTOR.READER:UNQUOTE
                            '(ECLECTOR.READER:UNQUOTE ELEM))))
                      (BLOCK MATCH?-BLOCK
                        (TAGBODY
                          (%MATCH (ECLECTOR.READER:UNQUOTE-SPLICING VECTORS))
                          (RETURN-FROM MATCH?-BLOCK T)
                         :MATCH-FAILED
                          (SETQ (ECLECTOR.READER:UNQUOTE
                                 '(ECLECTOR.READER:UNQUOTE P))
                                  (ECLECTOR.READER:UNQUOTE START)
                                (ECLECTOR.READER:UNQUOTE
                                 '(ECLECTOR.READER:UNQUOTE ELEM))
                                  (ECLECTOR.READER:UNQUOTE START-ELEM))))))))
                (MATCH-I (&REST VECTORS)
                  (ECLECTOR.READER:QUASIQUOTE
                   (MATCH-I-CASE
                    (ECLECTOR.READER:UNQUOTE-SPLICING
                     (LOOP FOR VEC IN VECTORS
                           COLLECT (ECLECTOR.READER:QUASIQUOTE
                                    ((ECLECTOR.READER:UNQUOTE VEC))))))))
                (ECLECTOR.READER:UNQUOTE-SPLICING MACROS
                  ))
       (DECLARE (MUFFLE-CONDITIONS CODE-DELETION-NOTE))
       (LABELS ((EOFP ()
                  (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
                  (<= (ECLECTOR.READER:UNQUOTE END)
                      (ECLECTOR.READER:UNQUOTE P)))
                (CURRENT ()
                  (GET-ELEM (ECLECTOR.READER:UNQUOTE ELEM)))
                (PEEK (&KEY EOF-VALUE)
                  (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
                  (LET ((LEN (LENGTH (ECLECTOR.READER:UNQUOTE DATA))))
                    (DECLARE (TYPE FIXNUM LEN))
                    (IF (OR (EOFP)
                            (>= (ECLECTOR.READER:UNQUOTE P)
                                (- (ECLECTOR.READER:UNQUOTE END) 1))
                            (= (ECLECTOR.READER:UNQUOTE P) (- LEN 1)))
                        EOF-VALUE
                        (AREF (ECLECTOR.READER:UNQUOTE DATA)
                              (+ 1 (ECLECTOR.READER:UNQUOTE P))))))
                (POS ()
                  (THE FIXNUM (ECLECTOR.READER:UNQUOTE P))))
         (DECLARE (INLINE EOFP CURRENT POS))
         (ECLECTOR.READER:UNQUOTE-SPLICING BODY)))))

[puri/src.lisp:128]
  (DEFMETHOD POSITION-CHAR (CHAR (STRING STRING) START MAX)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0))
             (FIXNUM START MAX)
             (STRING STRING))
    (DO* ((I START (1+ I)))
         ((= I MAX) NIL)
      (DECLARE (FIXNUM I))
      (WHEN (CHAR= CHAR (CHAR STRING I)) (RETURN I))))

[puri/src.lisp:137]
  (DEFUN DELIMITED-STRING-TO-LIST
         (STRING &OPTIONAL (SEPARATOR #\ ) SKIP-TERMINAL)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (COMPILATION-SPEED 0))
             (TYPE STRING STRING)
             (TYPE CHARACTER SEPARATOR))
    (DO* ((LEN (LENGTH STRING))
          (OUTPUT 'NIL)
          (POS 0)
          (END (POSITION-CHAR SEPARATOR STRING POS LEN)
               (POSITION-CHAR SEPARATOR STRING POS LEN)))
         ((NULL END)
          (IF (< POS LEN)
              (PUSH (SUBSEQ STRING POS) OUTPUT)
              (WHEN (AND (PLUSP LEN) (NOT SKIP-TERMINAL)) (PUSH "" OUTPUT)))
          (NREVERSE OUTPUT))
      (DECLARE (TYPE FIXNUM POS LEN)
               (TYPE (OR NULL FIXNUM) END))
      (PUSH (SUBSEQ STRING POS END) OUTPUT)
      (SETQ POS (1+ END))))

[puri/src.lisp:1375]
  (DEFUN TIME-URI-MODULE ()
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (LET ((URI "http://www.franz.com/a/b;x;y;z/c/foo?bar=baz&xxx#foo")
          (URI2 "http://www.franz.com/a/b;x;y;z/c/%2ffoo?bar=baz&xxx#foo"))
      (GC T)
      (GC :TENURE)
      (GC :TENURE)
      (GC :TENURE)
      (FORMAT T "~&;;; starting timing testing 1...~%")
      (TIME (DOTIMES (I 100000) (PARSE-URI URI)))
      (GC T)
      (GC :TENURE)
      (GC :TENURE)
      (GC :TENURE)
      (FORMAT T "~&;;; starting timing testing 2...~%")
      (LET ((URI (PARSE-URI URI)))
        (TIME
         (DOTIMES (I 100000)
           (SETF (URI-STRING URI) NIL)
           (FORMAT NIL "~a" URI))))
      (GC T)
      (GC :TENURE)
      (GC :TENURE)
      (GC :TENURE)
      (FORMAT T "~&;;; starting timing testing 3...~%")
      (TIME
       (PROGN
        (DOTIMES (I 100000) (PARSE-URI URI2))
        (LET ((URI (PARSE-URI URI)))
          (DOTIMES (I 100000)
            (SETF (URI-STRING URI) NIL)
            (FORMAT NIL "~a" URI)))))))

[py4cl/src/import-export.lisp:77]
  (DEFMACRO DEFPYFUN
            (FUN-NAME
             &OPTIONAL PYMODULE-NAME
             &KEY (AS FUN-NAME) (LISP-FUN-NAME (LISPIFY-NAME AS))
             (LISP-PACKAGE *PACKAGE*) (SAFETY T))
    "Defines a function which calls python
Example
  (py4cl:pyexec \"import math\")
  (py4cl:defpyfun \"math.sqrt\")
  (math.sqrt 42) -> 6.4807405

Arguments:
  FUN-NAME: name of the function in python, before import
  PYMODULE-NAME: name of the module containing FUN-NAME
  AS: name of the function in python, after import
  LISP-FUN-NAME: name of the lisp symbol to which the function is bound*
  LISP-PACKAGE: package (not its name) in which LISP-FUN-NAME will be interned
  SAFETY: if T, adds an additional line in the function asking to import the
    package or function, so that the function works even after PYSTOP is called.
    However, this increases the overhead of stream communication, and therefore,
    can reduce speed."
    (ECLECTOR.READER:QUASIQUOTE
     (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
       (DEFPYFUN* '(ECLECTOR.READER:UNQUOTE FUN-NAME)
        '(ECLECTOR.READER:UNQUOTE PYMODULE-NAME) '(ECLECTOR.READER:UNQUOTE AS)
        '(ECLECTOR.READER:UNQUOTE LISP-FUN-NAME)
        '(ECLECTOR.READER:UNQUOTE LISP-PACKAGE)
        '(ECLECTOR.READER:UNQUOTE SAFETY)))))

[py4cl/src/import-export.lisp:103]
  (DEFUN DEFPYFUN*
         (FUN-NAME PYMODULE-NAME AS LISP-FUN-NAME LISP-PACKAGE SAFETY)
    (CHECK-TYPE FUN-NAME STRING)
    (CHECK-TYPE LISP-FUN-NAME STRING)
    (CHECK-TYPE LISP-PACKAGE PACKAGE)
    (PYTHON-START-IF-NOT-ALIVE)
    (RAW-PYEXEC "import inspect")
    (UNLESS (OR *CALLED-FROM-DEFPYMODULE* (BUILTIN-P PYMODULE-NAME))
      (RAW-PYEXEC
       (FUNCTION-RELOAD-STRING :PYMODULE-NAME PYMODULE-NAME :FUN-NAME FUN-NAME
        :AS AS)))
    (LET* ((FULLNAME
            (IF *CALLED-FROM-DEFPYMODULE*
                (CONCATENATE 'STRING PYMODULE-NAME "." FUN-NAME)
                (OR AS FUN-NAME)))
           (FUN-DOC (PYEVAL FULLNAME ".__doc__"))
           (FUN-SYMBOL (INTERN LISP-FUN-NAME LISP-PACKAGE)))
      (DESTRUCTURING-BIND
          (PARAMETER-LIST PASS-LIST)
          (GET-ARG-LIST FULLNAME (FIND-PACKAGE LISP-PACKAGE))
        (LET ((COMMON-CODE
               (ECLECTOR.READER:QUASIQUOTE
                (PROGN
                 (DEFUN (ECLECTOR.READER:UNQUOTE FUN-SYMBOL)
                        ((ECLECTOR.READER:UNQUOTE-SPLICING PARAMETER-LIST))
                   (ECLECTOR.READER:UNQUOTE (OR FUN-DOC "Python function"))
                   (ECLECTOR.READER:UNQUOTE (FIRST PASS-LIST))
                   (ECLECTOR.READER:UNQUOTE
                    (WHEN SAFETY
                      (IF (BUILTIN-P PYMODULE-NAME)
                          (ECLECTOR.READER:QUASIQUOTE
                           (PYTHON-START-IF-NOT-ALIVE))
                          (IF *CALLED-FROM-DEFPYMODULE*
                              (ECLECTOR.READER:QUASIQUOTE
                               (RAW-PYEXEC
                                (ECLECTOR.READER:UNQUOTE
                                 *FUNCTION-RELOAD-STRING*)))
                              (ECLECTOR.READER:QUASIQUOTE
                               (RAW-PYEXEC
                                (ECLECTOR.READER:UNQUOTE
                                 (FUNCTION-RELOAD-STRING :PYMODULE-NAME
                                  PYMODULE-NAME :FUN-NAME FUN-NAME :AS
                                  AS))))))))
                   (ECLECTOR.READER:UNQUOTE (SECOND PASS-LIST)))
                 (ECLECTOR.READER:UNQUOTE
                  (IF *CALLED-FROM-DEFPYMODULE*
                      (ECLECTOR.READER:QUASIQUOTE
                       (EXPORT '(ECLECTOR.READER:UNQUOTE FUN-SYMBOL)
                               (ECLECTOR.READER:UNQUOTE LISP-PACKAGE)))))))))
          (EVAL COMMON-CODE)))))

[py4cl/src/import-export.lisp:205]
  (DEFMACRO DEFPYMODULE
            (PYMODULE-NAME
             &OPTIONAL (IMPORT-SUBMODULES NIL)
             &KEY
             (LISP-PACKAGE
              (LISPIFY-NAME PYMODULE-NAME)
              LISP-PACKAGE-SUPPLIED-P)
             (RELOAD T) (SAFETY T) (CONTINUE-IGNORING-ERRORS T)
             (SILENT *DEFPYMODULE-SILENT-P*))
    "Import a python module (and its submodules) lisp-package Lisp package(s).
Example:
  (py4cl:defpymodule \"math\" :lisp-package \"M\")
  (m:sqrt 4)   ; => 2.0
\"Package already exists.\" is returned if the package exists and :RELOAD
is NIL.
Arguments:
  PYMODULE-NAME: name of the module in python, before importing
  IMPORT-SUBMODULES: leave nil for purposes of speed, if you won't use the
    submodules
  LISP-PACKAGE: lisp package, in which to intern (and export) the callables
  RELOAD: whether to redefine and reimport
  SAFETY: value of safety to pass to defpyfun; see defpyfun
  SILENT: prints \"status\" lines when NIL"
    (ECLECTOR.READER:QUASIQUOTE
     (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
       (DEFPYMODULE* '(ECLECTOR.READER:UNQUOTE PYMODULE-NAME)
        '(ECLECTOR.READER:UNQUOTE IMPORT-SUBMODULES)
        '(ECLECTOR.READER:UNQUOTE LISP-PACKAGE)
        '(ECLECTOR.READER:UNQUOTE LISP-PACKAGE-SUPPLIED-P)
        '(ECLECTOR.READER:UNQUOTE RELOAD) '(ECLECTOR.READER:UNQUOTE SAFETY)
        '(ECLECTOR.READER:UNQUOTE CONTINUE-IGNORING-ERRORS)
        '(ECLECTOR.READER:UNQUOTE SILENT)))))

[py4cl/src/import-export.lisp:236]
  (DEFUN DEFPYMODULE*
         (PYMODULE-NAME IMPORT-SUBMODULES LISP-PACKAGE LISP-PACKAGE-SUPPLIED-P
          RELOAD SAFETY CONTINUE-IGNORING-ERRORS SILENT)
    (CHECK-TYPE PYMODULE-NAME STRING)
    (CHECK-TYPE LISP-PACKAGE STRING)
    (LET ((PACKAGE (FIND-PACKAGE LISP-PACKAGE)))
      (IF PACKAGE
          (IF RELOAD
              (DELETE-PACKAGE PACKAGE)
              (RETURN-FROM DEFPYMODULE* "Package already exists."))))
    (PYTHON-START-IF-NOT-ALIVE)
    (RAW-PYEXEC "import inspect")
    (RAW-PYEXEC "import pkgutil")
    (LET ((*LISP-PACKAGE-SUPPLIED-P* LISP-PACKAGE-SUPPLIED-P)
          (*DEFPYMODULE-SILENT-P* SILENT))
      (MULTIPLE-VALUE-BIND (PACKAGE-IMPORT-STRING PACKAGE-IN-PYTHON)
          (PYMODULE-IMPORT-STRING PYMODULE-NAME LISP-PACKAGE)
        (RAW-PYEXEC PACKAGE-IMPORT-STRING)
        (UNLESS SILENT
          (FORMAT T "~&Defining ~D for accessing python package ~D...~%"
                  LISP-PACKAGE PACKAGE-IN-PYTHON))
        (HANDLER-BIND ((PYERROR
                        (LAMBDA (E)
                          (IF CONTINUE-IGNORING-ERRORS
                              (INVOKE-RESTART 'CONTINUE-IGNORING-ERRORS)
                              E))))
          (RESTART-CASE (LET* ((FUN-NAMES
                                (PYEVAL
                                 "tuple(name for name, fn in inspect.getmembers("
                                 PACKAGE-IN-PYTHON
                                 ", callable) if name[0] != '_')"))
                               (EXPORTING-PACKAGE
                                (OR (FIND-PACKAGE LISP-PACKAGE)
                                    (MAKE-PACKAGE LISP-PACKAGE :USE 'NIL)))
                               (FUN-SYMBOLS
                                (MAPCAR
                                 (LAMBDA (PYFUN-NAME)
                                   (FUN-SYMBOL PYFUN-NAME
                                    (CONCATENATE 'STRING PACKAGE-IN-PYTHON "."
                                                 PYFUN-NAME)
                                    LISP-PACKAGE))
                                 (IF (AND (STRINGP FUN-NAMES)
                                          (OR (STRING= "()" FUN-NAMES)
                                              (STRING= "None" FUN-NAMES)))
                                     (SETQ FUN-NAMES NIL)
                                     FUN-NAMES))))
                          (EXPORT FUN-SYMBOLS EXPORTING-PACKAGE)
                          (IF IMPORT-SUBMODULES
                              (DEFPYSUBMODULES PACKAGE-IN-PYTHON LISP-PACKAGE
                               CONTINUE-IGNORING-ERRORS)
                              (ITER (FOR FUN-NAME IN FUN-NAMES)
                               (FOR FUN-SYMBOL IN FUN-SYMBOLS)
                               (LET* ((*CALLED-FROM-DEFPYMODULE* T)
                                      (*FUNCTION-RELOAD-STRING*
                                       (FUNCTION-RELOAD-STRING :PYMODULE-NAME
                                        PYMODULE-NAME :LISP-PACKAGE
                                        LISP-PACKAGE :FUN-NAME FUN-NAME)))
                                 (DEFPYFUN* FUN-NAME PACKAGE-IN-PYTHON FUN-NAME
                                  (FORMAT NIL "~A" FUN-SYMBOL)
                                  EXPORTING-PACKAGE SAFETY))))
                          T)
            (CONTINUE-IGNORING-ERRORS NIL))))))

[quicklisp-controller/asdf.lisp:986]
  (EVAL-WHEN (:LOAD-TOPLEVEL :COMPILE-TOPLEVEL :EXECUTE)
    (DEFUN FROB-SUBSTRINGS (STRING SUBSTRINGS &OPTIONAL FROB)
      "for each substring in SUBSTRINGS, find occurrences of it within STRING
that don't use parts of matched occurrences of previous strings, and
FROB them, that is to say, remove them if FROB is NIL,
replace by FROB if FROB is a STRING, or if FROB is a FUNCTION,
call FROB with the match and a function that emits a string in the output.
Return a string made of the parts not omitted or emitted by FROB."
      (DECLARE (OPTIMIZE (SPEED 0) (SAFETY 0) (DEBUG 3)))
      (LET ((LENGTH (LENGTH STRING)) (STREAM NIL))
        (LABELS ((EMIT-STRING (X &OPTIONAL (START 0) (END (LENGTH X)))
                   (WHEN (< START END)
                     (UNLESS STREAM (SETF STREAM (MAKE-STRING-OUTPUT-STREAM)))
                     (WRITE-STRING X STREAM :START START :END END)))
                 (EMIT-SUBSTRING (START END)
                   (WHEN (AND (ZEROP START) (= END LENGTH))
                     (RETURN-FROM FROB-SUBSTRINGS STRING))
                   (EMIT-STRING STRING START END))
                 (RECURSE (SUBSTRINGS START END)
                   (COND ((>= START END))
                         ((NULL SUBSTRINGS) (EMIT-SUBSTRING START END))
                         (T
                          (LET* ((SUB-SPEC (FIRST SUBSTRINGS))
                                 (SUB
                                  (IF (CONSP SUB-SPEC)
                                      (CAR SUB-SPEC)
                                      SUB-SPEC))
                                 (FUN
                                  (IF (CONSP SUB-SPEC)
                                      (CDR SUB-SPEC)
                                      FROB))
                                 (FOUND
                                  (SEARCH SUB STRING :START2 START :END2 END))
                                 (MORE (REST SUBSTRINGS)))
                            (COND
                             (FOUND (RECURSE MORE START FOUND)
                              (ETYPECASE FUN
                                (NULL)
                                (STRING (EMIT-STRING FUN))
                                (FUNCTION (FUNCALL FUN SUB #'EMIT-STRING)))
                              (RECURSE SUBSTRINGS (+ FOUND (LENGTH SUB)) END))
                             (T (RECURSE MORE START END))))))))
          (RECURSE SUBSTRINGS 0 LENGTH))
        (IF STREAM
            (GET-OUTPUT-STREAM-STRING STREAM)
            "")))
    (DEFMACRO COMPATFMT (FORMAT)
      (FROB-SUBSTRINGS FORMAT
       (ECLECTOR.READER:QUASIQUOTE
        ("~3i~_"
         (ECLECTOR.READER:UNQUOTE-SPLICING '("~@<" "~@;" "~@:>" "~:>")))))))

[quicklisp-controller/asdf.lisp:5489]
  (WITH-UPGRADABILITY NIL
   (DEFVAR *OPTIMIZATION-SETTINGS*
     NIL
     "Optimization settings to be used by PROCLAIM-OPTIMIZATION-SETTINGS")
   (DEFVAR *PREVIOUS-OPTIMIZATION-SETTINGS*
     NIL
     "Optimization settings saved by PROCLAIM-OPTIMIZATION-SETTINGS")
   (DEFPARAMETER +OPTIMIZATION-VARIABLES+
     (OR
      '(#S(FORMGREP:SYMREF :NAME "*SPEED*" :QUALIFIER "SYSTEM")
        #S(FORMGREP:SYMREF :NAME "*SPACE*" :QUALIFIER "SYSTEM")
        #S(FORMGREP:SYMREF :NAME "*SAFETY*" :QUALIFIER "SYSTEM")
        #S(FORMGREP:SYMREF :NAME "*DEBUG*" :QUALIFIER "SYSTEM"))
      'NIL
      '(#S(FORMGREP:SYMREF :NAME "*NX-SPEED*" :QUALIFIER "CCL")
        #S(FORMGREP:SYMREF :NAME "*NX-SPACE*" :QUALIFIER "CCL")
        #S(FORMGREP:SYMREF :NAME "*NX-SAFETY*" :QUALIFIER "CCL")
        #S(FORMGREP:SYMREF :NAME "*NX-DEBUG*" :QUALIFIER "CCL")
        #S(FORMGREP:SYMREF :NAME "*NX-CSPEED*" :QUALIFIER "CCL"))
      '(#S(FORMGREP:SYMREF :NAME "*DEFAULT-COOKIE*" :QUALIFIER "C"))
      (UNLESS (USE-ECL-BYTE-COMPILER-P)
        '(#S(FORMGREP:SYMREF :NAME "*SPEED*" :QUALIFIER "C")
          #S(FORMGREP:SYMREF :NAME "*SPACE*" :QUALIFIER "C")
          #S(FORMGREP:SYMREF :NAME "*SAFETY*" :QUALIFIER "C")
          #S(FORMGREP:SYMREF :NAME "*DEBUG*" :QUALIFIER "C")))
      '(#S(FORMGREP:SYMREF :NAME "*SPEED*" :QUALIFIER "COMPILER")
        #S(FORMGREP:SYMREF :NAME "*SPACE*" :QUALIFIER "COMPILER")
        #S(FORMGREP:SYMREF :NAME "*COMPILER-NEW-SAFETY*" :QUALIFIER "COMPILER")
        #S(FORMGREP:SYMREF :NAME "*DEBUG*" :QUALIFIER "COMPILER"))
      '(#S(FORMGREP:SYMREF :NAME "*OPTIMIZATION-LEVEL*" :QUALIFIER "COMPILER"))
      '(#S(FORMGREP:SYMREF :NAME "*SPEED*" :QUALIFIER "SI")
        #S(FORMGREP:SYMREF :NAME "*SPACE*" :QUALIFIER "SI")
        #S(FORMGREP:SYMREF :NAME "*SAFETY*" :QUALIFIER "SI")
        #S(FORMGREP:SYMREF :NAME "*DEBUG*" :QUALIFIER "SI"))
      '(SB-C::*POLICY*)))
   (DEFUN GET-OPTIMIZATION-SETTINGS ()
     "Get current compiler optimization settings, ready to PROCLAIM again"
     (LET ((SETTINGS
            '(SPEED SPACE SAFETY DEBUG COMPILATION-SPEED
              #S(FORMGREP:SYMREF :NAME "BREVITY" :QUALIFIER "C"))))
       NIL))
   (DEFUN PROCLAIM-OPTIMIZATION-SETTINGS ()
     "Proclaim the optimization settings in *OPTIMIZATION-SETTINGS*"
     (PROCLAIM
      (ECLECTOR.READER:QUASIQUOTE
       (OPTIMIZE (ECLECTOR.READER:UNQUOTE-SPLICING *OPTIMIZATION-SETTINGS*))))
     (LET ((SETTINGS (GET-OPTIMIZATION-SETTINGS)))
       (UNLESS (EQUAL *PREVIOUS-OPTIMIZATION-SETTINGS* SETTINGS)
         (SETF *PREVIOUS-OPTIMIZATION-SETTINGS* SETTINGS))))
   (DEFMACRO WITH-OPTIMIZATION-SETTINGS
             ((&OPTIONAL (SETTINGS *OPTIMIZATION-SETTINGS*)) &BODY BODY)
     (LET ((PREVIOUS-SETTINGS (GENSYM "PREVIOUS-SETTINGS")))
       (ECLECTOR.READER:QUASIQUOTE
        (LET (((ECLECTOR.READER:UNQUOTE PREVIOUS-SETTINGS)
               (GET-OPTIMIZATION-SETTINGS)))
          (ECLECTOR.READER:UNQUOTE-SPLICING
           (WHEN SETTINGS
             (ECLECTOR.READER:QUASIQUOTE
              ((PROCLAIM
                (ECLECTOR.READER:QUASIQUOTE
                 (OPTIMIZE
                  (ECLECTOR.READER:UNQUOTE-SPLICING
                   (ECLECTOR.READER:UNQUOTE SETTINGS)))))))))
          (UNWIND-PROTECT (PROGN (ECLECTOR.READER:UNQUOTE-SPLICING BODY))
            (PROCLAIM
             (ECLECTOR.READER:QUASIQUOTE
              (OPTIMIZE
               (ECLECTOR.READER:UNQUOTE-SPLICING
                (ECLECTOR.READER:UNQUOTE PREVIOUS-SETTINGS)))))))))))

[quicklisp-controller/depcheck.lisp:229]
  (DEFUN MAIN (ARGV)
    (ALIEN-FUNCALL (EXTERN-ALIEN "disable_lossage_handler" #'VOID))
    (SETF *PRINT-PRETTY* NIL)
    (WHEN (EQUALP (SECOND ARGV) "--asdf-version")
      (FORMAT T "~A~%" (ASDF/UPGRADE:ASDF-VERSION))
      (EXIT :CODE 0))
    (WHEN (EQUALP (SECOND ARGV) "--sbcl-version")
      (FORMAT T "~A~%" (LISP-IMPLEMENTATION-VERSION))
      (EXIT :CODE 0))
    (WHEN (GETENV "DEPCHECK_HIDEBUG")
      (RESTRICT-COMPILER-POLICY 'DEBUG 3)
      (RESTRICT-COMPILER-POLICY 'SAFETY 3))
    (UNLESS (GETENV "DEPCHECK_DEBUG") (DISABLE-DEBUGGER))
    (SETENV "SBCL_HOME"
     (LOAD-TIME-VALUE (DIRECTORY-NAMESTRING SB-INT:*CORE-STRING*)))
    (SETF SB-SYS::*SBCL-HOMEDIR-PATHNAME* (SB-IMPL::%SBCL-HOMEDIR-PATHNAME))
    (SETENV "CC" "gcc")
    (EVAL *LOAD-OP-WRAPPER*)
    (WHEN (GETENV "DEPCHECK_FRESH_FASLS")
      (SET-FASL-OUTPUT-DIRECTORY
       (PATHNAME (FORMAT NIL "/tmp/depcheck/~D/" (GETPID)))))
    (DESTRUCTURING-BIND
        (INDEX PROJECT SYSTEM DEPENDENCY-FILE ERRORS-FILE
         &OPTIONAL *METADATA-REQUIRED-P*)
        (REST ARGV)
      (SETF *SYSTEMS* (LOAD-ASDF-SYSTEM-TABLE INDEX))
      (WITH-OPEN-FILE
          (*ERROR-OUTPUT* ERRORS-FILE :IF-EXISTS :SUPERSEDE :DIRECTION :OUTPUT)
        (UNWIND-PROTECT (MAGIC PROJECT SYSTEM DEPENDENCY-FILE)
          (IGNORE-ERRORS (CLOSE *ERROR-OUTPUT*))))
      (WHEN (PROBE-FILE DEPENDENCY-FILE) (DELETE-FILE ERRORS-FILE))))

[quickutil/quickutil-utilities/utilities/alexandria/functions.lisp:35]
  (DEFUTIL DISJOIN
   (:VERSION (1 . 0) :DEPENDS-ON ENSURE-FUNCTION :CATEGORY
    (ALEXANDRIA FUNCTIONAL ORTHOGONALITY))
   "Returns a function that applies each of `predicate` and
`more-predicate` functions in turn to its arguments, returning the
primary value of the first predicate that returns true, without
calling the remaining predicates. If none of the predicates returns
true, `nil` is returned."
   %%%>
   (DEFUN DISJOIN (PREDICATE &REST MORE-PREDICATES)
     %%DOC
     (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
     (LET ((PREDICATE (ENSURE-FUNCTION PREDICATE))
           (MORE-PREDICATES (MAPCAR #'ENSURE-FUNCTION MORE-PREDICATES)))
       (LAMBDA (&REST ARGUMENTS)
         (OR (APPLY PREDICATE ARGUMENTS)
             (SOME (LAMBDA (P) (DECLARE (TYPE FUNCTION P)) (APPLY P ARGUMENTS))
                   MORE-PREDICATES)))))
   %%%)

[quickutil/quickutil-utilities/utilities/alexandria/functions.lisp:80]
  (DEFUTIL COMPOSE
   (:VERSION (1 . 0) :DEPENDS-ON (ENSURE-FUNCTION MAKE-GENSYM-LIST) :CATEGORY
    (ALEXANDRIA FUNCTIONAL ORTHOGONALITY))
   "Returns a function composed of `function` and `more-functions` that applies its ;
arguments to to each in turn, starting from the rightmost of `more-functions`,
and then calling the next one with the primary value of the last."
   %%%>
   (DEFUN COMPOSE (FUNCTION &REST MORE-FUNCTIONS)
     %%DOC
     (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
     (REDUCE
      (LAMBDA (F G)
        (LET ((F (ENSURE-FUNCTION F)) (G (ENSURE-FUNCTION G)))
          (LAMBDA (&REST ARGUMENTS)
            (DECLARE (DYNAMIC-EXTENT ARGUMENTS))
            (FUNCALL F (APPLY G ARGUMENTS)))))
      MORE-FUNCTIONS :INITIAL-VALUE FUNCTION))
   (DEFINE-COMPILER-MACRO COMPOSE
       (FUNCTION &REST MORE-FUNCTIONS)
     (LABELS ((COMPOSE-1 (FUNS)
                (IF (CDR FUNS)
                    (ECLECTOR.READER:QUASIQUOTE
                     (FUNCALL (ECLECTOR.READER:UNQUOTE (CAR FUNS))
                              (ECLECTOR.READER:UNQUOTE
                               (COMPOSE-1 (CDR FUNS)))))
                    (ECLECTOR.READER:QUASIQUOTE
                     (APPLY (ECLECTOR.READER:UNQUOTE (CAR FUNS)) ARGUMENTS)))))
       (LET* ((ARGS (CONS FUNCTION MORE-FUNCTIONS))
              (FUNS (MAKE-GENSYM-LIST (LENGTH ARGS) "COMPOSE")))
         (ECLECTOR.READER:QUASIQUOTE
          (LET (ECLECTOR.READER:UNQUOTE
                (LOOP
                 FOR
                 F
                 IN
                 FUNS
                 FOR
                 ARG
                 IN
                 ARGS
                 COLLECT
                 (ECLECTOR.READER:QUASIQUOTE
                  ((ECLECTOR.READER:UNQUOTE F)
                   (ENSURE-FUNCTION (ECLECTOR.READER:UNQUOTE ARG))))))
            (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
            (LAMBDA (&REST ARGUMENTS)
              (DECLARE (DYNAMIC-EXTENT ARGUMENTS))
              (ECLECTOR.READER:UNQUOTE (COMPOSE-1 FUNS))))))))
   %%%)

[quickutil/quickutil-utilities/utilities/alexandria/functions.lisp:114]
  (DEFUTIL MULTIPLE-VALUE-COMPOSE
   (:VERSION (1 . 0) :DEPENDS-ON (ENSURE-FUNCTION MAKE-GENSYM-LIST) :CATEGORY
    (ALEXANDRIA FUNCTIONAL ORTHOGONALITY))
   "Returns a function composed of `function` and `more-functions` that applies
its arguments to each in turn, starting from the rightmost of
`more-functions`, and then calling the next one with all the return values of
the last."
   %%%>
   (DEFUN MULTIPLE-VALUE-COMPOSE (FUNCTION &REST MORE-FUNCTIONS)
     %%DOC
     (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
     (REDUCE
      (LAMBDA (F G)
        (LET ((F (ENSURE-FUNCTION F)) (G (ENSURE-FUNCTION G)))
          (LAMBDA (&REST ARGUMENTS)
            (DECLARE (DYNAMIC-EXTENT ARGUMENTS))
            (MULTIPLE-VALUE-CALL F (APPLY G ARGUMENTS)))))
      MORE-FUNCTIONS :INITIAL-VALUE FUNCTION))
   (DEFINE-COMPILER-MACRO MULTIPLE-VALUE-COMPOSE
       (FUNCTION &REST MORE-FUNCTIONS)
     (LABELS ((COMPOSE-1 (FUNS)
                (IF (CDR FUNS)
                    (ECLECTOR.READER:QUASIQUOTE
                     (MULTIPLE-VALUE-CALL (ECLECTOR.READER:UNQUOTE (CAR FUNS))
                       (ECLECTOR.READER:UNQUOTE (COMPOSE-1 (CDR FUNS)))))
                    (ECLECTOR.READER:QUASIQUOTE
                     (APPLY (ECLECTOR.READER:UNQUOTE (CAR FUNS)) ARGUMENTS)))))
       (LET* ((ARGS (CONS FUNCTION MORE-FUNCTIONS))
              (FUNS (MAKE-GENSYM-LIST (LENGTH ARGS) "MV-COMPOSE")))
         (ECLECTOR.READER:QUASIQUOTE
          (LET (ECLECTOR.READER:UNQUOTE (MAPCAR #'LIST FUNS ARGS))
            (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
            (LAMBDA (&REST ARGUMENTS)
              (DECLARE (DYNAMIC-EXTENT ARGUMENTS))
              (ECLECTOR.READER:UNQUOTE (COMPOSE-1 FUNS))))))))
   %%%)

[quickutil/quickutil-utilities/utilities/alexandria/functions.lisp:148]
  (DEFUTIL CURRY
   (:VERSION (1 . 0) :COMPILATION-DEPENDS-ON (ENSURE-FUNCTION MAKE-GENSYM-LIST)
    :CATEGORY (ALEXANDRIA FUNCTIONAL))
   "Returns a function that applies `arguments` and the arguments
it is called with to `function`."
   %%%>
   (DEFUN CURRY (FUNCTION &REST ARGUMENTS)
     %%DOC
     (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
     (LET ((FN (ENSURE-FUNCTION FUNCTION)))
       (LAMBDA (&REST MORE)
         (DECLARE (DYNAMIC-EXTENT MORE))
         (MULTIPLE-VALUE-CALL FN (VALUES-LIST ARGUMENTS) (VALUES-LIST MORE)))))
   (DEFINE-COMPILER-MACRO CURRY
       (FUNCTION &REST ARGUMENTS)
     (LET ((CURRIES (MAKE-GENSYM-LIST (LENGTH ARGUMENTS) "CURRY"))
           (FUN (GENSYM "FUN")))
       (ECLECTOR.READER:QUASIQUOTE
        (LET (((ECLECTOR.READER:UNQUOTE FUN)
               (ENSURE-FUNCTION (ECLECTOR.READER:UNQUOTE FUNCTION)))
              (ECLECTOR.READER:UNQUOTE-SPLICING
               (MAPCAR #'LIST CURRIES ARGUMENTS)))
          (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
          (LAMBDA (&REST MORE)
            (APPLY (ECLECTOR.READER:UNQUOTE FUN)
                   (ECLECTOR.READER:UNQUOTE-SPLICING CURRIES) MORE))))))
   %%%)

[quickutil/quickutil-utilities/utilities/alexandria/functions.lisp:173]
  (DEFUTIL RCURRY
   (:VERSION (1 . 0) :DEPENDS-ON ENSURE-FUNCTION :CATEGORY
    (ALEXANDRIA FUNCTIONAL))
   "Returns a function that applies the arguments it is called
with and `arguments` to `function`."
   %%%>
   (DEFUN RCURRY (FUNCTION &REST ARGUMENTS)
     %%DOC
     (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
     (LET ((FN (ENSURE-FUNCTION FUNCTION)))
       (LAMBDA (&REST MORE)
         (DECLARE (DYNAMIC-EXTENT MORE))
         (MULTIPLE-VALUE-CALL FN (VALUES-LIST MORE) (VALUES-LIST ARGUMENTS)))))
   %%%)

[quickutil/quickutil-utilities/utilities/alexandria/lists.lisp:3]
  (DEFUTIL SAFE-ENDP (:VERSION (1 . 0) :HIDDEN T :CATEGORY NIL) %%%>
   (DECLAIM (INLINE SAFE-ENDP))
   (DEFUN SAFE-ENDP (X) (DECLARE (OPTIMIZE SAFETY)) (ENDP X)) %%%)

[quickutil/quickutil-utilities/utilities/primes.lisp:4]
  (DEFUTIL PRIMES-BELOW (:VERSION (1 . 0) :CATEGORY MATH)
   "Return a sorted list of all primes below an integer `n`.

Examples:

    (primes-below 13) => (2 3 5 7 11)
    (primes-below -1) => NIL"
   %%%>
   (DEFUN %PRIMES-BELOW-FIXNUM (N)
     "%PRIMES-BELOW-FIXNUM is optimized PRIMES-BELOW for fixnum N."
     (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0))
              (FTYPE (FUNCTION (FIXNUM) LIST) %PRIMES-BELOW-FIXNUM)
              (TYPE FIXNUM N))
     (LET* ((SIEVE-BOUND (THE FIXNUM (ASH N -1)))
            (SIEVE
             (MAKE-ARRAY SIEVE-BOUND :ELEMENT-TYPE 'BIT :INITIAL-ELEMENT 0))
            (CROSS-LIMIT (THE FIXNUM (ASH (ISQRT N) -1))))
       (DECLARE (TYPE FIXNUM SIEVE-BOUND CROSS-LIMIT)
                (TYPE SIMPLE-BIT-VECTOR SIEVE))
       (LOOP :FOR I FIXNUM :FROM 1 :TO CROSS-LIMIT
             :DO (WHEN (ZEROP (THE BIT (SBIT SIEVE I)))
                   (LOOP :FOR J FIXNUM :FROM (THE FIXNUM
                                                  (ASH
                                                   (THE FIXNUM
                                                        (* I
                                                           (THE FIXNUM
                                                                (1+ I))))
                                                   1)) :BELOW SIEVE-BOUND :BY (THE
                                                                               FIXNUM
                                                                               (1+
                                                                                (THE
                                                                                 FIXNUM
                                                                                 (ASH
                                                                                  I
                                                                                  1))))
                         :DO (SETF (SBIT SIEVE J) 1))))
       (LOOP :FOR I FIXNUM :FROM 1 :BELOW SIEVE-BOUND
             :WHEN (ZEROP (THE BIT (SBIT SIEVE I)))
             :COLLECT (THE FIXNUM (1+ (THE FIXNUM (ASH I 1)))) :INTO ACC
             :FINALLY (RETURN (CONS 2 ACC)))))
   (DEFUN %PRIMES-BELOW-INTEGER (N)
     "%PRIMES-BELOW-INTEGER is optimized PRIMES-BELOW for integer N."
     (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0))
              (FTYPE (FUNCTION (UNSIGNED-BYTE) LIST) %PRIMES-BELOW-INTEGER)
              (UNSIGNED-BYTE N))
     (LET* ((SIEVE-BOUND (THE UNSIGNED-BYTE (ASH N -1)))
            (SIEVE
             (MAKE-ARRAY SIEVE-BOUND :ELEMENT-TYPE 'BIT :INITIAL-ELEMENT 0))
            (CROSS-LIMIT (THE UNSIGNED-BYTE (ASH (ISQRT N) -1))))
       (DECLARE (TYPE UNSIGNED-BYTE SIEVE-BOUND CROSS-LIMIT)
                (TYPE SIMPLE-BIT-VECTOR SIEVE))
       (LOOP :FOR I :OF-TYPE UNSIGNED-BYTE :FROM 1 :TO CROSS-LIMIT
             :DO (WHEN (ZEROP (SBIT SIEVE I))
                   (LOOP :FOR J :OF-TYPE UNSIGNED-BYTE :FROM (THE UNSIGNED-BYTE
                                                                  (ASH
                                                                   (THE
                                                                    UNSIGNED-BYTE
                                                                    (* I
                                                                       (THE
                                                                        UNSIGNED-BYTE
                                                                        (1+
                                                                         I))))
                                                                   1)) :BELOW SIEVE-BOUND :BY (THE
                                                                                               UNSIGNED-BYTE
                                                                                               (1+
                                                                                                (THE
                                                                                                 UNSIGNED-BYTE
                                                                                                 (ASH
                                                                                                  I
                                                                                                  1))))
                         :DO (SETF (SBIT SIEVE J) 1))))
       (LOOP :FOR I :OF-TYPE UNSIGNED-BYTE :FROM 1 :BELOW SIEVE-BOUND
             :WHEN (ZEROP (THE BIT (SBIT SIEVE I)))
             :COLLECT (THE UNSIGNED-BYTE
                           (1+ (THE UNSIGNED-BYTE (ASH I 1)))) :INTO ACC
             :FINALLY (RETURN (CONS 2 ACC)))))
   (DEFUN PRIMES-BELOW (N)
     %%DOC
     (CHECK-TYPE N INTEGER)
     (IF (<= N 2)
         NIL
         (TYPECASE N
           (FIXNUM (%PRIMES-BELOW-FIXNUM N))
           (BIGNUM (%PRIMES-BELOW-INTEGER N)))))
   %%%)

[quri/src/decode.lisp:18]
  (DEFUN HEXDIGIT-TO-INTEGER (CHAR)
    (DECLARE (TYPE CHARACTER CHAR)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((CODE (CHAR-CODE CHAR)))
      (DECLARE (TYPE FIXNUM CODE))
      (COND ((<= NIL CODE NIL) (- CODE NIL)) ((<= NIL CODE NIL) (- CODE NIL))
            ((<= NIL CODE NIL) (- CODE NIL)) (T (ERROR 'URL-DECODING-ERROR)))))

[quri/src/decode.lisp:32]
  (DEFUN URL-DECODE
         (DATA
          &KEY (ENCODING BABEL-ENCODINGS:*DEFAULT-CHARACTER-ENCODING*)
          (START 0) END (LENIENT NIL))
    (DECLARE (TYPE (OR STRING SIMPLE-BYTE-VECTOR) DATA)
             (TYPE INTEGER START)
             (OPTIMIZE (SPEED 3) (SAFETY 2)))
    (LET* ((END (OR END (LENGTH DATA)))
           (BUFFER (MAKE-ARRAY (- END START) :ELEMENT-TYPE '(UNSIGNED-BYTE 8)))
           (I 0)
           PARSING-ENCODED-PART)
      (DECLARE (TYPE INTEGER END I)
               (TYPE SIMPLE-BYTE-VECTOR BUFFER))
      (FLET ((WRITE-TO-BUFFER (BYTE)
               (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
               (SETF (AREF BUFFER I) BYTE)
               (INCF I)))
        (WITH-ARRAY-PARSING
         (CHAR P DATA START END (AND (NOT (STRINGP DATA)) #'CODE-CHAR))
         (PARSING
          (COND ((CHAR= CHAR #\%) (GONEXT))
                ((CHAR= CHAR #\+) (WRITE-TO-BUFFER NIL) (REDO))
                (T (WRITE-TO-BUFFER (CHAR-CODE CHAR)) (REDO))))
         (PARSING-ENCODED-PART (SETQ PARSING-ENCODED-PART CHAR) (GONEXT))
         (PARSING-ENCODED-PART-SECOND
          (HANDLER-BIND ((URL-DECODING-ERROR
                          (LAMBDA (ERROR)
                            (DECLARE (IGNORE ERROR))
                            (WHEN LENIENT
                              (WRITE-TO-BUFFER NIL)
                              (WRITE-TO-BUFFER
                               (CHAR-CODE PARSING-ENCODED-PART))
                              (WRITE-TO-BUFFER (CHAR-CODE CHAR))
                              (SETQ PARSING-ENCODED-PART NIL)
                              (GOTO PARSING)))))
            (WRITE-TO-BUFFER
             (+ (* 16 (HEXDIGIT-TO-INTEGER PARSING-ENCODED-PART))
                (HEXDIGIT-TO-INTEGER CHAR))))
          (SETQ PARSING-ENCODED-PART NIL) (GOTO PARSING))
         (:EOF (WHEN PARSING-ENCODED-PART (ERROR 'URL-DECODING-ERROR)))))
      (BABEL:OCTETS-TO-STRING BUFFER :END I :ENCODING ENCODING :ERRORP
                              (NOT LENIENT))))

[quri/src/decode.lisp:89]
  (DEFUN URL-DECODE-PARAMS
         (DATA
          &KEY (DELIMITER #\&)
          (ENCODING BABEL-ENCODINGS:*DEFAULT-CHARACTER-ENCODING*) (START 0) END
          (LENIENT NIL))
    (DECLARE (TYPE (OR STRING SIMPLE-BYTE-VECTOR) DATA)
             (TYPE INTEGER START)
             (TYPE CHARACTER DELIMITER)
             (OPTIMIZE (SPEED 3) (SAFETY 2)))
    (LET ((END (OR END (LENGTH DATA))) (START-MARK NIL) (=-MARK NIL))
      (DECLARE (TYPE INTEGER END))
      (COLLECTING
       (FLET ((COLLECT-PAIR (P)
                (TAGBODY
                  (HANDLER-BIND ((URL-DECODING-ERROR
                                  (LAMBDA (ERROR)
                                    (DECLARE (IGNORE ERROR))
                                    (WHEN LENIENT (GO CONTINUE)))))
                    (COLLECT
                     (CONS
                      (URL-DECODE DATA :ENCODING ENCODING :START START-MARK
                       :END =-MARK :LENIENT LENIENT)
                      (URL-DECODE DATA :ENCODING ENCODING :START (1+ =-MARK)
                       :END P :LENIENT LENIENT))))
                 CONTINUE)
                (SETQ START-MARK NIL
                      =-MARK NIL))
              (COLLECT-FIELD (P)
                (TAGBODY
                  (HANDLER-BIND ((URL-DECODING-ERROR
                                  (LAMBDA (ERROR)
                                    (DECLARE (IGNORE ERROR))
                                    (WHEN LENIENT (GO CONTINUE)))))
                    (COLLECT
                     (CONS
                      (URL-DECODE DATA :ENCODING ENCODING :START START-MARK
                       :END P :LENIENT LENIENT)
                      NIL)))
                 CONTINUE)
                (SETQ START-MARK NIL)))
         (WITH-ARRAY-PARSING
          (CHAR P DATA START END (AND (NOT (STRINGP DATA)) #'CODE-CHAR))
          (START (SETQ START-MARK P)
           (IF LENIENT
               (COND ((CHAR= CHAR #\=) (SETQ =-MARK P) (GOTO PARSING-VALUE))
                     ((CHAR= CHAR DELIMITER) (REDO)))
               (WHEN (OR (CHAR= CHAR #\=) (CHAR= CHAR DELIMITER))
                 (ERROR 'URI-MALFORMED-URLENCODED-STRING)))
           (GONEXT))
          (PARSING-FIELD
           (COND ((CHAR= CHAR #\=) (SETQ =-MARK P) (GONEXT))
                 ((CHAR= CHAR DELIMITER) (COLLECT-FIELD P) (GOTO START)))
           (REDO))
          (PARSING-VALUE
           (COND
            ((CHAR= CHAR #\=)
             (UNLESS LENIENT (ERROR 'URI-MALFORMED-URLENCODED-STRING)))
            ((CHAR= CHAR DELIMITER) (COLLECT-PAIR P) (GOTO START)))
           (REDO))
          (:EOF
           (COND (=-MARK (COLLECT-PAIR P)) (START-MARK (COLLECT-FIELD P)))))))))

[quri/src/domain.lisp:39]
  (DEFUN IPV4-ADDR-P (HOST)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 2))
             (MUFFLE-CONDITIONS COMPILER-NOTE))
    (CHECK-TYPE HOST STRING)
    (FLET ((READ-BYTE-STRING (STRING START)
             (DECLARE (TYPE FIXNUM START))
             (WHEN (<= (LENGTH STRING) START)
               (RETURN-FROM READ-BYTE-STRING NIL))
             (LET* ((END (+ START 2))
                    (ENDP (<= (1- (LENGTH STRING)) END))
                    (END
                     (IF ENDP
                         (1- (LENGTH STRING))
                         END))
                    (RES 0))
               (DECLARE (TYPE FIXNUM END RES))
               (DO ((I START (1+ I)))
                   ((< END I))
                 (DECLARE (TYPE FIXNUM I))
                 (UNLESS (CHAR<= #\0 (AREF STRING I) #\9)
                   (RETURN-FROM READ-BYTE-STRING
                     (IF (= I START)
                         NIL
                         (VALUES RES I NIL))))
                 (SETQ RES (+ (* RES 10) (- (CHAR-CODE (AREF STRING I)) 48))))
               (COND (ENDP (VALUES RES END T))
                     ((CHAR= (AREF STRING (1+ END)) #\.)
                      (VALUES RES (1+ END) NIL))))))
      (LET ((START 0))
        (DOTIMES (I 4 T)
          (MULTIPLE-VALUE-BIND (BYTE POS ENDP)
              (READ-BYTE-STRING HOST START)
            (UNLESS (TYPEP BYTE '(UNSIGNED-BYTE 8)) (RETURN NIL))
            (UNLESS (XOR ENDP (NOT (= I 3))) (RETURN NIL))
            (SETQ START (1+ POS)))))))

[quri/src/domain.lisp:87]
  (DEFUN IPV6-ADDR-P (HOST)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 2))
             (MUFFLE-CONDITIONS COMPILER-NOTE))
    (CHECK-TYPE HOST STRING)
    (WHEN (= (LENGTH HOST) 0) (RETURN-FROM IPV6-ADDR-P NIL))
    (LABELS ((READ-SECTION (STRING START &OPTIONAL READ-COLONS)
               (DECLARE (TYPE STRING STRING)
                        (TYPE FIXNUM START))
               (WHEN (<= (LENGTH STRING) START)
                 (RETURN-FROM READ-SECTION (VALUES START READ-COLONS T)))
               (WHEN (CHAR= (AREF STRING START) #\:)
                 (COND
                  ((<= (LENGTH STRING) (1+ START))
                   (RETURN-FROM READ-SECTION NIL))
                  ((CHAR= (AREF STRING (1+ START)) #\:)
                   (IF READ-COLONS
                       (RETURN-FROM READ-SECTION NIL)
                       (RETURN-FROM READ-SECTION
                         (READ-SECTION STRING (+ 2 START) T))))
                  (T (INCF START))))
               (LET* ((END (+ START 4))
                      (ENDP (<= (LENGTH STRING) END))
                      (END
                       (IF ENDP
                           (LENGTH STRING)
                           END)))
                 (DECLARE (TYPE FIXNUM END))
                 (DO ((I START (1+ I)))
                     ((= END I))
                   (LET ((CH (AREF STRING I)))
                     (COND
                      ((CHAR= CH #\:)
                       (RETURN-FROM READ-SECTION (VALUES I READ-COLONS NIL)))
                      ((OR (CHAR<= #\0 CH #\9) (CHAR<= #\a CH #\f)
                           (CHAR<= #\A CH #\F)))
                      (T (RETURN-FROM READ-SECTION NIL)))))
                 (IF ENDP
                     (VALUES END READ-COLONS ENDP)
                     (IF (CHAR= (AREF STRING END) #\:)
                         (VALUES END READ-COLONS ENDP)
                         NIL)))))
      (SETQ HOST (TRIM-BRACKETS HOST))
      (UNLESS HOST (RETURN-FROM IPV6-ADDR-P NIL))
      (LET ((START 0) (READ-COLONS-P NIL))
        (DOTIMES (I 8 T)
          (MULTIPLE-VALUE-BIND (E READ-COLONS ENDP)
              (READ-SECTION HOST START READ-COLONS-P)
            (UNLESS E (RETURN-FROM IPV6-ADDR-P NIL))
            (WHEN ENDP
              (WHEN (AND (NOT (= I 7)) (NOT READ-COLONS))
                (RETURN-FROM IPV6-ADDR-P NIL))
              (RETURN-FROM IPV6-ADDR-P T))
            (WHEN (AND (= I 7) (NOT ENDP)) (RETURN-FROM IPV6-ADDR-P NIL))
            (SETQ START E
                  READ-COLONS-P READ-COLONS))))))

[quri/src/encode.lisp:19]
  (DEFUN INTEGER-TO-HEXDIGIT (BYTE)
    (DECLARE (TYPE (UNSIGNED-BYTE 8) BYTE)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((RES (MAKE-STRING 2)))
      (MULTIPLE-VALUE-BIND (QUOTIENT REMAINDER)
          (FLOOR BYTE 16)
        (SETF (AREF RES 0) (AREF +HEXDIGIT-CHAR+ QUOTIENT)
              (AREF RES 1) (AREF +HEXDIGIT-CHAR+ REMAINDER)))
      RES))

[quri/src/encode.lisp:29]
  (DEFUN UNRESERVEDP (BYTE)
    (DECLARE (TYPE (UNSIGNED-BYTE 8) BYTE)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (OR (<= (CHAR-CODE #\A) BYTE (CHAR-CODE #\Z))
        (<= (CHAR-CODE #\a) BYTE (CHAR-CODE #\z))
        (<= (CHAR-CODE #\0) BYTE (CHAR-CODE #\9)) NIL))

[quri/src/encode.lisp:46]
  (DEFUN URL-ENCODE
         (DATA
          &KEY (ENCODING BABEL-ENCODINGS:*DEFAULT-CHARACTER-ENCODING*)
          (START 0) END SPACE-TO-PLUS)
    (DECLARE (TYPE (OR STRING SIMPLE-BYTE-VECTOR) DATA)
             (TYPE INTEGER START)
             (OPTIMIZE (SPEED 3) (SAFETY 2)))
    (LET* ((OCTETS
            (IF (STRINGP DATA)
                (BABEL:STRING-TO-OCTETS DATA :ENCODING ENCODING :START START
                                        :END END)
                DATA))
           (RES
            (MAKE-ARRAY (* (LENGTH OCTETS) 3) :ELEMENT-TYPE 'CHARACTER
                        :FILL-POINTER T))
           (I 0))
      (DECLARE (TYPE SIMPLE-BYTE-VECTOR OCTETS)
               (TYPE STRING RES)
               (TYPE INTEGER I))
      (LOOP FOR BYTE OF-TYPE (UNSIGNED-BYTE 8) ACROSS OCTETS
            DO (COND
                ((AND SPACE-TO-PLUS (= BYTE NIL)) (SETF (AREF RES I) #\+)
                 (INCF I))
                ((< BYTE NIL)
                 (LOCALLY
                  (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
                  (LET ((CONVERTED (AREF +BYTE-TO-STRING+ BYTE)))
                    (IF (ZEROP (LENGTH CONVERTED))
                        (PROGN (SETF (AREF RES I) (CODE-CHAR BYTE)) (INCF I))
                        (PROGN
                         (SETF (AREF RES I) #\%)
                         (INCF I)
                         (REPLACE RES CONVERTED :START1 I)
                         (INCF I 2))))))
                ((UNRESERVEDP BYTE) (SETF (AREF RES I) (CODE-CHAR BYTE))
                 (INCF I))
                (T (SETF (AREF RES I) #\%) (INCF I)
                 (REPLACE RES (INTEGER-TO-HEXDIGIT BYTE) :START1 I)
                 (INCF I 2))))
      (SETF (FILL-POINTER RES) I)
      RES))

[quri/src/parser.lisp:77]
  (DEFUN PARSE-URI-STRING (DATA &KEY (START 0) END)
    (DECLARE (TYPE SIMPLE-STRING DATA)
             (OPTIMIZE (SPEED 3) (SAFETY 2)))
    (LET (SCHEME
          USERINFO
          HOST
          PORT
          PATH
          QUERY
          FRAGMENT
          (PARSE-START START)
          (PARSE-END (OR END (LENGTH DATA))))
      (DECLARE (TYPE FIXNUM PARSE-START PARSE-END))
      (BLOCK NIL
        (FLET ((PARSE-FROM-PATH (DATA START)
                 (DECLARE (TYPE SIMPLE-STRING DATA)
                          (TYPE FIXNUM START))
                 (MULTIPLE-VALUE-BIND (DATA START END)
                     (PARSE-PATH-STRING DATA :START START :END PARSE-END)
                   (DECLARE (TYPE SIMPLE-STRING DATA)
                            (TYPE FIXNUM START END))
                   (UNLESS (= START END) (SETQ PATH (SUBSEQ DATA START END)))
                   (LET ((MAYBE-QUERY-START
                          (OR
                           (NTH-VALUE 1
                                      (PARSE-QUERY-STRING DATA :START END :END
                                       PARSE-END))
                           (1+ PARSE-END)))
                         (MAYBE-FRAGMENT-START
                          (OR
                           (NTH-VALUE 1
                                      (PARSE-FRAGMENT-STRING DATA :START END
                                       :END PARSE-END))
                           (1+ PARSE-END))))
                     (FLET ((PARSE-FRAGMENT (PATH-END)
                              (MULTIPLE-VALUE-BIND (DATA START END)
                                  (PARSE-FRAGMENT-STRING DATA :START
                                   (OR PATH-END END) :END PARSE-END)
                                (WHEN DATA
                                  (SETQ FRAGMENT
                                          (SUBSEQ (THE STRING DATA)
                                                  (THE FIXNUM START)
                                                  (THE FIXNUM END)))))))
                       (IF (< (THE FIXNUM MAYBE-QUERY-START)
                              (THE FIXNUM MAYBE-FRAGMENT-START))
                           (MULTIPLE-VALUE-BIND
                               (PARSED-DATA PATH-START PATH-END)
                               (PARSE-QUERY-STRING DATA :START END :END
                                PARSE-END)
                             (WHEN PARSED-DATA
                               (SETQ QUERY
                                       (SUBSEQ (THE STRING PARSED-DATA)
                                               (THE FIXNUM PATH-START)
                                               (THE FIXNUM PATH-END))))
                             (PARSE-FRAGMENT PATH-END))
                           (PARSE-FRAGMENT END)))))))
          (MULTIPLE-VALUE-BIND (PARSED-DATA START END GOT-SCHEME)
              (PARSE-SCHEME-STRING DATA :START PARSE-START :END PARSE-END)
            (IF PARSED-DATA
                (LOCALLY
                 (DECLARE (TYPE FIXNUM START END))
                 (SETQ SCHEME
                         (OR GOT-SCHEME
                             (STRING-DOWNCASE (SUBSEQ DATA START END))))
                 (INCF END))
                (SETQ SCHEME NIL
                      END PARSE-START))
            (LOCALLY
             (DECLARE (TYPE FIXNUM END))
             (UNLESS (= END PARSE-END)
               (MULTIPLE-VALUE-BIND
                   (PARSED-DATA USERINFO-START USERINFO-END HOST-START HOST-END
                    PORT-START PORT-END)
                   (PARSE-AUTHORITY-STRING DATA :START END :END PARSE-END)
                 (WHEN PARSED-DATA
                   (LOCALLY
                    (DECLARE (TYPE FIXNUM HOST-START HOST-END))
                    (WHEN USERINFO-START
                      (SETQ USERINFO
                              (SUBSEQ (THE STRING DATA)
                                      (THE FIXNUM USERINFO-START)
                                      (THE FIXNUM USERINFO-END))))
                    (UNLESS (= HOST-START HOST-END)
                      (SETQ HOST (SUBSEQ DATA HOST-START HOST-END)))
                    (COND
                     (PORT-START
                      (LOCALLY
                       (DECLARE (TYPE FIXNUM PORT-START PORT-END))
                       (UNLESS (= PORT-START PORT-END)
                         (HANDLER-CASE
                          (SETQ PORT
                                  (PARSE-INTEGER DATA :START
                                                 (THE FIXNUM PORT-START) :END
                                                 (THE FIXNUM PORT-END)))
                          (ERROR NIL
                                 (ERROR 'URI-INVALID-PORT :DATA DATA :POSITION
                                        PORT-START))))))
                     (SCHEME (SETQ PORT (SCHEME-DEFAULT-PORT SCHEME))))))
                 (LOCALLY
                  (DECLARE (OPTIMIZE (SAFETY 0)))
                  (PARSE-FROM-PATH DATA (OR PORT-END HOST-END END)))))))))
      (VALUES SCHEME USERINFO HOST PORT PATH QUERY FRAGMENT)))

[quri/src/parser.lisp:149]
  (DEFUN PARSE-URI-BYTE-VECTOR (DATA &KEY (START 0) END)
    (DECLARE (TYPE SIMPLE-BYTE-VECTOR DATA)
             (OPTIMIZE (SPEED 3) (SAFETY 2)))
    (LET (SCHEME
          USERINFO
          HOST
          PORT
          PATH
          QUERY
          FRAGMENT
          (PARSE-START START)
          (PARSE-END (OR END (LENGTH DATA))))
      (DECLARE (TYPE FIXNUM PARSE-START PARSE-END))
      (FLET ((SUBSEQ* (DATA &OPTIONAL (START 0) END)
               (DECLARE (TYPE SIMPLE-BYTE-VECTOR DATA))
               (VALUES (BABEL:OCTETS-TO-STRING DATA :START START :END END)))
             (PARSE-INTEGER-FROM-BV (DATA &KEY (START 0) END)
               (DECLARE (TYPE FIXNUM START END)
                        (OPTIMIZE (SPEED 3) (SAFETY 2)))
               (WHEN (= START END) (RETURN-FROM PARSE-INTEGER-FROM-BV NIL))
               (DO ((I START (1+ I))
                    (RES 0))
                   ((= I END) RES)
                 (DECLARE (TYPE FIXNUM I RES))
                 (LET ((CODE (AREF DATA I)))
                   (DECLARE (TYPE FIXNUM CODE)
                            (MUFFLE-CONDITIONS COMPILER-NOTE))
                   (UNLESS (<= NIL CODE NIL)
                     (ERROR 'URI-INVALID-PORT :DATA DATA :POSITION I))
                   (SETQ RES (+ (* RES 10) (- CODE NIL)))))))
        (BLOCK NIL
          (FLET ((PARSE-FROM-PATH (DATA START)
                   (DECLARE (TYPE SIMPLE-BYTE-VECTOR DATA)
                            (TYPE FIXNUM START))
                   (MULTIPLE-VALUE-BIND (DATA START END)
                       (PARSE-PATH-BYTE-VECTOR DATA :START START :END
                        PARSE-END)
                     (DECLARE (TYPE FIXNUM START END))
                     (UNLESS (= START END)
                       (SETQ PATH (SUBSEQ* DATA START END)))
                     (MULTIPLE-VALUE-BIND (PARSED-DATA PATH-START PATH-END)
                         (PARSE-QUERY-BYTE-VECTOR DATA :START END :END
                          PARSE-END)
                       (WHEN PARSED-DATA
                         (SETQ QUERY
                                 (SUBSEQ* PARSED-DATA (THE FIXNUM PATH-START)
                                  (THE FIXNUM PATH-END))))
                       (MULTIPLE-VALUE-BIND (DATA START END)
                           (PARSE-FRAGMENT-BYTE-VECTOR DATA :START
                            (OR PATH-END END) :END PARSE-END)
                         (WHEN DATA
                           (SETQ FRAGMENT
                                   (SUBSEQ* DATA (THE FIXNUM START)
                                    (THE FIXNUM END)))))))))
            (MULTIPLE-VALUE-BIND (PARSED-DATA START END GOT-SCHEME)
                (PARSE-SCHEME-BYTE-VECTOR DATA :START PARSE-START :END
                 PARSE-END)
              (IF PARSED-DATA
                  (LOCALLY
                   (DECLARE (TYPE FIXNUM START END))
                   (SETQ SCHEME
                           (OR GOT-SCHEME
                               (LET ((DATA-STR (MAKE-STRING (- END START))))
                                 (DO ((I START (1+ I))
                                      (J 0 (1+ J)))
                                     ((= I END) DATA-STR)
                                   (LET ((CODE (AREF DATA I)))
                                     (SETF (AREF DATA-STR J)
                                             (CODE-CHAR
                                              (IF (<= NIL CODE NIL)
                                                  (+ CODE 32)
                                                  CODE))))))))
                   (INCF END))
                  (SETQ SCHEME NIL
                        END PARSE-START))
              (LOCALLY
               (DECLARE (TYPE FIXNUM END))
               (UNLESS (= END PARSE-END)
                 (MULTIPLE-VALUE-BIND
                     (PARSED-DATA USERINFO-START USERINFO-END HOST-START
                      HOST-END PORT-START PORT-END)
                     (PARSE-AUTHORITY-BYTE-VECTOR DATA :START END :END
                      PARSE-END)
                   (WHEN PARSED-DATA
                     (LOCALLY
                      (DECLARE (TYPE SIMPLE-BYTE-VECTOR DATA)
                               (TYPE FIXNUM HOST-START HOST-END))
                      (WHEN USERINFO-START
                        (SETQ USERINFO
                                (SUBSEQ* DATA (THE FIXNUM USERINFO-START)
                                 (THE FIXNUM USERINFO-END))))
                      (UNLESS (= HOST-START HOST-END)
                        (SETQ HOST (SUBSEQ* DATA HOST-START HOST-END)))
                      (COND
                       (PORT-START
                        (SETQ PORT
                                (PARSE-INTEGER-FROM-BV DATA :START PORT-START
                                 :END PORT-END)))
                       (SCHEME (SETQ PORT (SCHEME-DEFAULT-PORT SCHEME))))))
                   (LOCALLY
                    (DECLARE (OPTIMIZE (SAFETY 0)))
                    (PARSE-FROM-PATH DATA
                     (OR PORT-END HOST-END (1+ END)))))))))))
      (VALUES SCHEME USERINFO HOST PORT PATH QUERY FRAGMENT)))

[quri/src/parser.lisp:235]
  (DEFMACRO DEFUN-WITH-ARRAY-PARSING
            (NAME (CHAR P DATA START END &REST OTHER-ARGS) &BODY BODY)
    (WITH-GENSYMS (ARGS TYPE FORM ENV)
     (FLET ((INTERN-PROPER-CASE (A B)
              (INTERN (FORMAT NIL "~:@(~a-~a~)" A B))))
       (LET ((FN-FOR-STRING (INTERN-PROPER-CASE NAME :STRING))
             (FN-FOR-BYTE-VECTOR (INTERN-PROPER-CASE NAME :BYTE-VECTOR)))
         (ECLECTOR.READER:QUASIQUOTE
          (PROGN
           (DEFUN (ECLECTOR.READER:UNQUOTE NAME)
                  ((ECLECTOR.READER:UNQUOTE DATA)
                   &REST (ECLECTOR.READER:UNQUOTE ARGS)
                   &KEY (ECLECTOR.READER:UNQUOTE START)
                   (ECLECTOR.READER:UNQUOTE END))
             (DECLARE
              (IGNORE (ECLECTOR.READER:UNQUOTE START)
               (ECLECTOR.READER:UNQUOTE END)))
             (ETYPECASE (ECLECTOR.READER:UNQUOTE DATA)
               (SIMPLE-STRING
                (APPLY
                 '(ECLECTOR.READER:UNQUOTE (INTERN-PROPER-CASE NAME :STRING))
                 DATA (ECLECTOR.READER:UNQUOTE ARGS)))
               (SIMPLE-BYTE-VECTOR
                (APPLY
                 '(ECLECTOR.READER:UNQUOTE
                   (INTERN-PROPER-CASE NAME :BYTE-VECTOR))
                 DATA (ECLECTOR.READER:UNQUOTE ARGS)))))
           (DEFINE-COMPILER-MACRO (ECLECTOR.READER:UNQUOTE NAME)
               (&WHOLE (ECLECTOR.READER:UNQUOTE FORM) &ENVIRONMENT
                (ECLECTOR.READER:UNQUOTE ENV) (ECLECTOR.READER:UNQUOTE DATA)
                &REST (ECLECTOR.READER:UNQUOTE ARGS))
             (DECLARE (IGNORE (ECLECTOR.READER:UNQUOTE ARGS)))
             (LET (((ECLECTOR.READER:UNQUOTE TYPE)
                    (COND
                     ((CONSTANTP (ECLECTOR.READER:UNQUOTE DATA))
                      (TYPE-OF (ECLECTOR.READER:UNQUOTE DATA)))
                     ((SYMBOLP (ECLECTOR.READER:UNQUOTE DATA))
                      (CDR
                       (ASSOC 'TYPE
                              (NTH-VALUE 2
                                         (VARIABLE-INFORMATION
                                          (ECLECTOR.READER:UNQUOTE DATA)
                                          (ECLECTOR.READER:UNQUOTE ENV)))))))))
               (COND
                ((NULL (ECLECTOR.READER:UNQUOTE TYPE))
                 (ECLECTOR.READER:UNQUOTE FORM))
                ((SUBTYPEP (ECLECTOR.READER:UNQUOTE TYPE) 'SIMPLE-STRING)
                 (ECLECTOR.READER:QUASIQUOTE
                  ((ECLECTOR.READER:UNQUOTE
                    '(ECLECTOR.READER:UNQUOTE FN-FOR-STRING))
                   (ECLECTOR.READER:UNQUOTE-SPLICING
                    (CDR (ECLECTOR.READER:UNQUOTE FORM))))))
                ((SUBTYPEP (ECLECTOR.READER:UNQUOTE TYPE) 'SIMPLE-BYTE-VECTOR)
                 (ECLECTOR.READER:QUASIQUOTE
                  ((ECLECTOR.READER:UNQUOTE
                    '(ECLECTOR.READER:UNQUOTE FN-FOR-BYTE-VECTOR))
                   (ECLECTOR.READER:UNQUOTE-SPLICING
                    (CDR (ECLECTOR.READER:UNQUOTE FORM))))))
                (T (ECLECTOR.READER:UNQUOTE FORM)))))
           (DEFUN (ECLECTOR.READER:UNQUOTE FN-FOR-STRING)
                  ((ECLECTOR.READER:UNQUOTE DATA)
                   &KEY ((ECLECTOR.READER:UNQUOTE START) 0)
                   ((ECLECTOR.READER:UNQUOTE END)
                    (LENGTH (ECLECTOR.READER:UNQUOTE DATA)))
                   (ECLECTOR.READER:UNQUOTE-SPLICING OTHER-ARGS))
             (DECLARE (TYPE SIMPLE-STRING (ECLECTOR.READER:UNQUOTE DATA))
                      (TYPE FIXNUM (ECLECTOR.READER:UNQUOTE START)
                       (ECLECTOR.READER:UNQUOTE END))
                      (OPTIMIZE (SPEED 3) (SAFETY 2)))
             (MACROLET ((CHAR=* (CHAR1 CHAR2)
                          (ECLECTOR.READER:QUASIQUOTE
                           (CHAR= (ECLECTOR.READER:UNQUOTE CHAR1)
                                  (ECLECTOR.READER:UNQUOTE CHAR2))))
                        (CHAR-CODE* (CHAR)
                          (ECLECTOR.READER:QUASIQUOTE
                           (CHAR-CODE (ECLECTOR.READER:UNQUOTE CHAR))))
                        (SCHEME-CHAR-P* (CHAR)
                          (ECLECTOR.READER:QUASIQUOTE
                           (SCHEME-CHAR-P (ECLECTOR.READER:UNQUOTE CHAR))))
                        (STANDARD-ALPHA-CHAR-P* (CHAR)
                          (ECLECTOR.READER:QUASIQUOTE
                           (STANDARD-ALPHA-CHAR-P
                            (ECLECTOR.READER:UNQUOTE CHAR)))))
               (BLOCK (ECLECTOR.READER:UNQUOTE NAME)
                 (WITH-STRING-PARSING
                  ((ECLECTOR.READER:UNQUOTE CHAR) (ECLECTOR.READER:UNQUOTE P)
                   (ECLECTOR.READER:UNQUOTE DATA)
                   (ECLECTOR.READER:UNQUOTE START)
                   (ECLECTOR.READER:UNQUOTE END))
                  (DECLARE (TYPE FIXNUM (ECLECTOR.READER:UNQUOTE P)))
                  (ECLECTOR.READER:UNQUOTE-SPLICING BODY)))))
           (DEFUN (ECLECTOR.READER:UNQUOTE FN-FOR-BYTE-VECTOR)
                  ((ECLECTOR.READER:UNQUOTE DATA)
                   &KEY ((ECLECTOR.READER:UNQUOTE START) 0)
                   ((ECLECTOR.READER:UNQUOTE END)
                    (LENGTH (ECLECTOR.READER:UNQUOTE DATA)))
                   (ECLECTOR.READER:UNQUOTE-SPLICING OTHER-ARGS))
             (DECLARE (TYPE SIMPLE-BYTE-VECTOR (ECLECTOR.READER:UNQUOTE DATA))
                      (TYPE FIXNUM (ECLECTOR.READER:UNQUOTE START)
                       (ECLECTOR.READER:UNQUOTE END))
                      (OPTIMIZE (SPEED 3) (SAFETY 2)))
             (MACROLET ((CHAR=* (BYTE CHAR)
                          (ECLECTOR.READER:QUASIQUOTE
                           (= (ECLECTOR.READER:UNQUOTE BYTE)
                              (ECLECTOR.READER:UNQUOTE (CHAR-CODE CHAR)))))
                        (CHAR-CODE* (BYTE)
                          BYTE)
                        (SCHEME-CHAR-P* (BYTE)
                          (ECLECTOR.READER:QUASIQUOTE
                           (SCHEME-BYTE-P (ECLECTOR.READER:UNQUOTE BYTE))))
                        (STANDARD-ALPHA-CHAR-P* (BYTE)
                          (ECLECTOR.READER:QUASIQUOTE
                           (STANDARD-ALPHA-BYTE-P
                            (ECLECTOR.READER:UNQUOTE BYTE)))))
               (BLOCK (ECLECTOR.READER:UNQUOTE NAME)
                 (WITH-BYTE-ARRAY-PARSING
                  ((ECLECTOR.READER:UNQUOTE CHAR) (ECLECTOR.READER:UNQUOTE P)
                   (ECLECTOR.READER:UNQUOTE DATA)
                   (ECLECTOR.READER:UNQUOTE START)
                   (ECLECTOR.READER:UNQUOTE END))
                  (DECLARE (TYPE FIXNUM (ECLECTOR.READER:UNQUOTE P)))
                  (ECLECTOR.READER:UNQUOTE-SPLICING BODY)))))))))))

[quri/src/parser.lisp:294]
  (DEFUN SCHEME-CHAR-P (CHAR)
    (DECLARE (TYPE CHARACTER CHAR)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (OR (STANDARD-ALPHANUMERIC-P CHAR) (CHAR= CHAR #\+) (CHAR= CHAR #\-)
        (CHAR= CHAR #\.)))

[quri/src/parser.lisp:302]
  (DEFUN SCHEME-BYTE-P (BYTE)
    (DECLARE (TYPE (UNSIGNED-BYTE 8) BYTE)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (OR (STANDARD-ALPHANUMERIC-BYTE-P BYTE) (= BYTE (CHAR-CODE #\+))
        (= BYTE (CHAR-CODE #\-)) (= BYTE (CHAR-CODE #\.))))

[quri/src/parser.lisp:445]
  (DEFUN PATH-CHAR-P (CHAR)
    (DECLARE (TYPE CHARACTER CHAR)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((BYTE (CHAR-CODE CHAR)))
      (AND (< BYTE 128) (OR (= (AREF +URI-CHAR+ BYTE) 1) (= BYTE NIL)))))

[quri/src/parser.lisp:453]
  (DEFUN PATH-BYTE-P (BYTE)
    (DECLARE (TYPE (UNSIGNED-BYTE 8) BYTE)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (OR (= (AREF +URI-CHAR+ BYTE) 1) (= BYTE (CHAR-CODE #\/))))

[quri/src/parser.lisp:459]
  (DEFUN QUERY-CHAR-P (CHAR)
    (DECLARE (TYPE CHARACTER CHAR)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (OR (PATH-CHAR-P CHAR) (CHAR= CHAR #\?)))

[quri/src/parser.lisp:465]
  (DEFUN QUERY-BYTE-P (BYTE)
    (DECLARE (TYPE (UNSIGNED-BYTE 8) BYTE)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (OR (PATH-BYTE-P BYTE) (= BYTE (CHAR-CODE #\?))))

[quri/src/parser.lisp:514]
  (DEFUN PARSE-PATH-STRING (DATA &KEY (START 0) (END (LENGTH DATA)))
    (DECLARE (TYPE SIMPLE-STRING DATA)
             (OPTIMIZE (SPEED 3) (SAFETY 2))
             (MUFFLE-CONDITIONS COMPILER-NOTE))
    (PARSE-UNTIL-STRING (#\? #\#) DATA :START START :END END))

[quri/src/parser.lisp:520]
  (DEFUN PARSE-PATH-BYTE-VECTOR (DATA &KEY (START 0) (END (LENGTH DATA)))
    (DECLARE (TYPE SIMPLE-BYTE-VECTOR DATA)
             (OPTIMIZE (SPEED 3) (SAFETY 2))
             (MUFFLE-CONDITIONS COMPILER-NOTE))
    (PARSE-UNTIL-BYTE-VECTOR (#\? #\#) DATA :START START :END END))

[quri/src/parser.lisp:545]
  (DEFUN PARSE-QUERY-STRING (DATA &KEY (START 0) (END (LENGTH DATA)))
    (DECLARE (TYPE SIMPLE-STRING DATA)
             (TYPE FIXNUM START END)
             (OPTIMIZE (SPEED 3) (SAFETY 2)))
    (LET ((?-POS (POSITION #\? DATA :START START :END END)))
      (WHEN ?-POS
        (PARSE-UNTIL-STRING (#\#) DATA :START (1+ (THE FIXNUM ?-POS)) :END
         END))))

[quri/src/parser.lisp:553]
  (DEFUN PARSE-QUERY-BYTE-VECTOR (DATA &KEY (START 0) (END (LENGTH DATA)))
    (DECLARE (TYPE SIMPLE-BYTE-VECTOR DATA)
             (TYPE FIXNUM START END)
             (OPTIMIZE (SPEED 3) (SAFETY 2)))
    (LET ((?-POS (POSITION NIL DATA :START START :END END)))
      (WHEN ?-POS
        (PARSE-UNTIL-BYTE-VECTOR (#\#) DATA :START (1+ (THE FIXNUM ?-POS)) :END
         END))))

[quri/src/parser.lisp:578]
  (DEFUN PARSE-FRAGMENT-STRING (DATA &KEY (START 0) (END (LENGTH DATA)))
    (DECLARE (TYPE SIMPLE-STRING DATA)
             (TYPE FIXNUM START END)
             (OPTIMIZE (SPEED 3) (SAFETY 2)))
    (LET ((|#-pos| (POSITION #\# DATA :START START :END END)))
      (WHEN |#-pos| (VALUES DATA (1+ (THE FIXNUM |#-pos|)) END))))

[quri/src/parser.lisp:588]
  (DEFUN PARSE-FRAGMENT-BYTE-VECTOR (DATA &KEY (START 0) (END (LENGTH DATA)))
    (DECLARE (TYPE SIMPLE-BYTE-VECTOR DATA)
             (TYPE FIXNUM START END)
             (OPTIMIZE (SPEED 3) (SAFETY 2)))
    (LET ((|#-pos| (POSITION #\# DATA :START START :END END :KEY #'CODE-CHAR)))
      (WHEN |#-pos| (VALUES DATA (1+ (THE FIXNUM |#-pos|)) END))))

[quri/src/util.lisp:21]
  (DEFUN STANDARD-ALPHA-CHAR-P (CHAR)
    (DECLARE (TYPE CHARACTER CHAR)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (STANDARD-ALPHA-BYTE-P (CHAR-CODE CHAR)))

[quri/src/util.lisp:26]
  (DEFUN STANDARD-ALPHA-BYTE-P (BYTE)
    (DECLARE (TYPE (UNSIGNED-BYTE 8) BYTE)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (OR (<= NIL BYTE NIL) (<= NIL BYTE NIL)))

[quri/src/util.lisp:32]
  (DEFUN STANDARD-ALPHANUMERIC-P (CHAR)
    (DECLARE (TYPE CHARACTER CHAR)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (OR (DIGIT-CHAR-P CHAR) (STANDARD-ALPHA-CHAR-P CHAR)))

[quri/src/util.lisp:38]
  (DEFUN STANDARD-ALPHANUMERIC-BYTE-P (BYTE)
    (DECLARE (TYPE (UNSIGNED-BYTE 8) BYTE)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (OR (<= NIL BYTE NIL) (STANDARD-ALPHA-BYTE-P BYTE)))

[quri/src/util.lisp:67]
  (DEFMACRO %WITH-ARRAY-PARSING
            ((ELEM P SEQ &OPTIONAL (START 0) END KEY) &BODY BODY)
    (WITH-GENSYMS (G-END NO-NEXT-STATE LAST KEY-FN)
     (LET ((EOF-EXISTS NIL))
       (ECLECTOR.READER:QUASIQUOTE
        (LET ((ECLECTOR.READER:UNQUOTE-SPLICING
               (AND KEY
                    (ECLECTOR.READER:QUASIQUOTE
                     (((ECLECTOR.READER:UNQUOTE KEY-FN)
                       (ECLECTOR.READER:UNQUOTE KEY))))))
              ((ECLECTOR.READER:UNQUOTE P) (ECLECTOR.READER:UNQUOTE START))
              ((ECLECTOR.READER:UNQUOTE G-END)
               (LOCALLY
                (DECLARE (MUFFLE-CONDITIONS COMPILER-NOTE))
                (OR (ECLECTOR.READER:UNQUOTE END)
                    (LENGTH (ECLECTOR.READER:UNQUOTE SEQ))))))
          (DECLARE
           (IGNORABLE (ECLECTOR.READER:UNQUOTE P)
            (ECLECTOR.READER:UNQUOTE G-END)))
          (ECLECTOR.READER:UNQUOTE-SPLICING
           (LOOP FOR (EXP . REST) ON BODY
                 WHILE (AND (LISTP EXP) (EQ (CAR EXP) 'DECLARE))
                 COLLECT EXP
                 DO (SETQ BODY REST)))
          (MACROLET ((GOTO (TAG &OPTIONAL (AMOUNT 1))
                       (ECLECTOR.READER:QUASIQUOTE
                        (LOCALLY
                         (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
                         (INCF
                          (ECLECTOR.READER:UNQUOTE
                           '(ECLECTOR.READER:UNQUOTE P))
                          (ECLECTOR.READER:UNQUOTE AMOUNT))
                         (ECLECTOR.READER:UNQUOTE-SPLICING
                          (IF (EQL AMOUNT 0)
                              NIL
                              (ECLECTOR.READER:QUASIQUOTE
                               ((WHEN
                                    (=
                                     (ECLECTOR.READER:UNQUOTE
                                      '(ECLECTOR.READER:UNQUOTE P))
                                     (ECLECTOR.READER:UNQUOTE
                                      '(ECLECTOR.READER:UNQUOTE G-END)))
                                  (GO :EOF))
                                (SETQ (ECLECTOR.READER:UNQUOTE
                                       '(ECLECTOR.READER:UNQUOTE ELEM))
                                        (ECLECTOR.READER:UNQUOTE
                                         '(ECLECTOR.READER:UNQUOTE
                                           (IF KEY
                                               (ECLECTOR.READER:QUASIQUOTE
                                                (IF (ECLECTOR.READER:UNQUOTE
                                                     KEY-FN)
                                                    (FUNCALL
                                                     (ECLECTOR.READER:UNQUOTE
                                                      KEY-FN)
                                                     (AREF
                                                      (ECLECTOR.READER:UNQUOTE
                                                       SEQ)
                                                      (ECLECTOR.READER:UNQUOTE
                                                       P)))
                                                    (AREF
                                                     (ECLECTOR.READER:UNQUOTE
                                                      SEQ)
                                                     (ECLECTOR.READER:UNQUOTE
                                                      P))))
                                               (ECLECTOR.READER:QUASIQUOTE
                                                (AREF
                                                 (ECLECTOR.READER:UNQUOTE SEQ)
                                                 (ECLECTOR.READER:UNQUOTE
                                                  P)))))))))))
                         (GO (ECLECTOR.READER:UNQUOTE TAG))))))
            (TAGBODY
              (WHEN
                  (= (ECLECTOR.READER:UNQUOTE P)
                     (ECLECTOR.READER:UNQUOTE G-END))
                (GO :EOF))
              (LOCALLY
               (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
               (SETQ (ECLECTOR.READER:UNQUOTE ELEM)
                       (ECLECTOR.READER:UNQUOTE-SPLICING
                        (IF KEY
                            (ECLECTOR.READER:QUASIQUOTE
                             ((IF (ECLECTOR.READER:UNQUOTE KEY-FN)
                                  (FUNCALL (ECLECTOR.READER:UNQUOTE KEY-FN)
                                           (AREF (ECLECTOR.READER:UNQUOTE SEQ)
                                                 (ECLECTOR.READER:UNQUOTE P)))
                                  (AREF (ECLECTOR.READER:UNQUOTE SEQ)
                                        (ECLECTOR.READER:UNQUOTE P)))))
                            (ECLECTOR.READER:QUASIQUOTE
                             ((AREF (ECLECTOR.READER:UNQUOTE SEQ)
                                    (ECLECTOR.READER:UNQUOTE P))))))))
              (ECLECTOR.READER:UNQUOTE-SPLICING
               (LOOP FOR (TAGPART . REST) ON BODY
                     FOR (TAG . PART) = TAGPART
                     IF (EQ TAG :EOF)
                     APPEND (PROGN
                             (SETF EOF-EXISTS T)
                             (ECLECTOR.READER:QUASIQUOTE
                              ((ECLECTOR.READER:UNQUOTE-SPLICING TAGPART)
                               (GO (ECLECTOR.READER:UNQUOTE LAST))))) ELSE
                     APPEND (LIST TAG
                                  (ECLECTOR.READER:QUASIQUOTE
                                   (MACROLET ((REDO (&OPTIONAL (AMOUNT 1))
                                                (ECLECTOR.READER:QUASIQUOTE
                                                 (GOTO
                                                  (ECLECTOR.READER:UNQUOTE
                                                   '(ECLECTOR.READER:UNQUOTE
                                                     TAG))
                                                  (ECLECTOR.READER:UNQUOTE
                                                   AMOUNT))))
                                              (GONEXT (&OPTIONAL (AMOUNT 1))
                                                (ECLECTOR.READER:QUASIQUOTE
                                                 (GOTO
                                                  (ECLECTOR.READER:UNQUOTE
                                                   '(ECLECTOR.READER:UNQUOTE
                                                     (OR (CAAR REST)
                                                         NO-NEXT-STATE)))
                                                  (ECLECTOR.READER:UNQUOTE
                                                   AMOUNT)))))
                                     (ECLECTOR.READER:UNQUOTE-SPLICING PART)
                                     (ERROR 'PARSING-END-UNEXPECTEDLY :STATE
                                            '(ECLECTOR.READER:UNQUOTE
                                              TAG)))))))
              (ECLECTOR.READER:UNQUOTE NO-NEXT-STATE)
              (ERROR 'NO-NEXT-STATE)
              (ECLECTOR.READER:UNQUOTE-SPLICING
               (IF EOF-EXISTS
                   NIL
                   '(:EOF)))
              (ECLECTOR.READER:UNQUOTE LAST))))))))

[ratmath/pipe.lisp:33]
  (DEFUN PIPE-REST (PIPE)
    "Analogous to the rest function except works on a pipe rather than list"
    (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
    (LET ((TAIL (SECOND PIPE)))
      (IF (FUNCTIONP TAIL)
          (SETF (SECOND PIPE) (EXPOSE TAIL))
          (SECOND PIPE))))

[ratmath/pipe.lisp:41]
  (DEFUN PIPE-TRANSFORM (PROCEDURE PIPE)
    "Runs procedure on each element of pipe; replacing each original element"
    (DECLARE (TYPE FUNCTION PROCEDURE)
             (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
    (IF (PIPE-ENDP PIPE)
        :EMPTY-PIPE
        (PIPE-CONS (FUNCALL PROCEDURE (PIPE-FIRST PIPE))
         (PIPE-TRANSFORM PROCEDURE (PIPE-REST PIPE)))))

[ratmath/pipe.lisp:49]
  (DEFUN PIPE-SINK (PIPE)
    "Exposes elements of pipe forever, ignoring the elements. Similar to pipe-mapc with a no-op
procedure.  Useful to provoke the pipeline processing of an infinite pipe."
    (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
    (UNLESS (PIPE-ENDP PIPE) (PIPE-SINK (PIPE-REST PIPE))))

[ratmath/pipe.lisp:55]
  (DEFUN PIPE-SINK-UNTIL (TEST PIPE)
    "Exposes elements of pipe until test returns t. When that happens, returns the (non-empty) pipe.
If the pipe goes empty, returns nil. The test procedure is called with the current element as arg."
    (DECLARE (TYPE FUNCTION TEST)
             (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
    (IF (PIPE-ENDP PIPE)
        :EMPTY-PIPE
        (IF (FUNCALL TEST (PIPE-FIRST PIPE))
            PIPE
            (PIPE-SINK-UNTIL TEST (PIPE-REST PIPE)))))

[ratmath/pipe.lisp:66]
  (DEFUN PIPE-APPEND (PIPE1 PIPE2)
    "Appends two pipes together"
    (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
    (IF (PIPE-ENDP PIPE1)
        PIPE2
        (PIPE-CONS (PIPE-FIRST PIPE1) (PIPE-APPEND (PIPE-REST PIPE1) PIPE2))))

[ratmath/pipe.lisp:75]
  (DEFUN PIPE-END-BEFORE (TEST PIPE)
    "Runs test on each element.  When it returns t, the pipe is truncated before that element"
    (DECLARE (TYPE FUNCTION TEST)
             (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
    (IF (PIPE-ENDP PIPE)
        :EMPTY-PIPE
        (LET ((X (PIPE-FIRST PIPE)))
          (IF (FUNCALL TEST X)
              :EMPTY-PIPE
              (PIPE-CONS X (PIPE-END-BEFORE TEST (PIPE-REST PIPE)))))))

[ratmath/pipe.lisp:85]
  (DEFUN PIPE-END-AFTER (TEST PIPE)
    "Runs test on each element.  When it returns t, the pipe is truncated after that element"
    (DECLARE (TYPE FUNCTION TEST)
             (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
    (IF (PIPE-ENDP PIPE)
        :EMPTY-PIPE
        (LET ((X (PIPE-FIRST PIPE)))
          (IF (FUNCALL TEST X)
              (LIST X :EMPTY-PIPE)
              (PIPE-CONS X (PIPE-END-AFTER TEST (PIPE-REST PIPE)))))))

[ratmath/pipe.lisp:96]
  (DEFUN PIPE-LAST (PIPE &OPTIONAL (N 1))
    (DECLARE (TYPE (AND FIXNUM (INTEGER 1 *)) N)
             (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
    (IF (PIPE-ENDP PIPE)
        :EMPTY-PIPE
        (LET (Q)
          (LABELS ((PIPE-LAST (PIPE &AUX (NEXT (PIPE-REST PIPE)))
                     (WHEN (= N (THE FIXNUM (FIFO-COUNT Q))) (FIFO-GET! Q))
                     (FIFO-PUT! Q PIPE)
                     (IF (PIPE-ENDP NEXT)
                         (FIFO-GET! Q)
                         (PIPE-LAST NEXT))))
            (PIPE-LAST PIPE)))))

[ratmath/pipe.lisp:107]
  (DEFUN PIPE-HEAD (PIPE &OPTIONAL (N 1))
    "Truncates a pipe after n (default: 1) elements"
    (DECLARE (TYPE FIXNUM N)
             (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
    (IF (OR (ZEROP N) (PIPE-ENDP PIPE))
        :EMPTY-PIPE
        (PIPE-CONS (PIPE-FIRST PIPE) (PIPE-HEAD (PIPE-REST PIPE) (1- N)))))

[ratmath/pipe.lisp:114]
  (DEFUN PIPE-TO-LIST (PIPE)
    "Returns a list from the given pipe input argument. Infinite recursion results if the pipe is
infinite."
    (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
    (IF (PIPE-ENDP PIPE)
        NIL
        (CONS (PIPE-FIRST PIPE) (PIPE-TO-LIST (PIPE-REST PIPE)))))

[ratmath/pipe.lisp:122]
  (DEFUN LIST-TO-PIPE (L)
    "Returns a pipe from a list input argument."
    (DECLARE (TYPE LIST L)
             (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
    (LABELS ((LIST-TO-PIPE (L)
               (IF (CDR L)
                   (PIPE-CONS (CAR L) (LIST-TO-PIPE (CDR L)))
                   (LIST (CAR L) :EMPTY-PIPE))))
      (IF (NULL L)
          :EMPTY-PIPE
          (LIST-TO-PIPE L))))

[ratmath/pipe.lisp:131]
  (DEFUN PIPE-UNIQ (PIPE &OPTIONAL (PAIR-UNIQ-P #'EQUAL) CARRY)
    "Removes duplicates according to optional predicate func. Only dups in sequence are removed."
    (DECLARE (TYPE FUNCTION PAIR-UNIQ-P)
             (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
    (COND
     ((PIPE-ENDP PIPE)
      (IF CARRY
          (LIST CARRY :EMPTY-PIPE)
          :EMPTY-PIPE))
     ((NULL CARRY) (PIPE-UNIQ (PIPE-REST PIPE) PAIR-UNIQ-P (PIPE-FIRST PIPE)))
     ((FUNCALL PAIR-UNIQ-P CARRY (PIPE-FIRST PIPE))
      (PIPE-UNIQ (PIPE-REST PIPE) PAIR-UNIQ-P (PIPE-FIRST PIPE)))
     (T
      (PIPE-CONS CARRY
       (PIPE-UNIQ (PIPE-REST PIPE) PAIR-UNIQ-P (PIPE-FIRST PIPE))))))

[ratmath/pipe.lisp:142]
  (DEFUN PIPE-MAPC (PROCEDURE PIPE)
    "Runs function on each element.  Returns nothing."
    (DECLARE (TYPE FUNCTION PROCEDURE)
             (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
    (UNLESS (PIPE-ENDP PIPE)
      (FUNCALL PROCEDURE (PIPE-FIRST PIPE))
      (PIPE-MAPC PROCEDURE (PIPE-REST PIPE))))

[ratmath/pipe.lisp:149]
  (DEFUN PIPE-FILTER (PROCEDURE PIPE)
    "If procedure returns t, that particular pipe element is removed from the sequence."
    (DECLARE (TYPE FUNCTION PROCEDURE)
             (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
    (IF (PIPE-ENDP PIPE)
        :EMPTY-PIPE
        (LET* ((X (PIPE-FIRST PIPE)) (RET (FUNCALL PROCEDURE X)))
          (IF RET
              (PIPE-FILTER PROCEDURE (PIPE-REST PIPE))
              (PIPE-CONS X (PIPE-FILTER PROCEDURE (PIPE-REST PIPE)))))))

[ratmath/pipe.lisp:160]
  (DEFUN PIPE-SIGNALER (PIPE)
    "For each condition object in pipe, set up some useful restarts and signal it.  If nothing
handles it, the default behavior is to ignore.  If the use-value restart is invoked, that value will
be returned as a pipe datum element."
    (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
    (IF (PIPE-ENDP PIPE)
        :EMPTY-PIPE
        (LET ((X (PIPE-FIRST PIPE)))
          (IF (SUBTYPEP (TYPE-OF X) 'CONDITION)
              (LET ((SIGRET
                     (RESTART-CASE (SIGNAL X)
                       (USE-VALUE (V) V)
                       (CONTINUE NIL NIL))))
                (IF SIGRET
                    (PIPE-CONS SIGRET (PIPE-SIGNALER (PIPE-REST PIPE)))
                    (PIPE-SIGNALER (PIPE-REST PIPE))))
              (PIPE-CONS X (PIPE-SIGNALER (PIPE-REST PIPE)))))))

[ratmath/pipe.lisp:180]
  (DEFUN PIPE-APPLY (PROCEDURE PIPE)
    "Runs procedure on every element as they are exposed, but does not transform the element."
    (DECLARE (TYPE FUNCTION PROCEDURE)
             (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
    (IF (PIPE-ENDP PIPE)
        :EMPTY-PIPE
        (PIPE-CONS
         (LET ((X (PIPE-FIRST PIPE)))
           (FUNCALL PROCEDURE X)
           X)
         (PIPE-APPLY PROCEDURE (PIPE-REST PIPE)))))

[ratmath/ratmath.lisp:53]
  (DEFUN TRUNCATE-WITHIN-INTERVAL (CF1 CF2)
    "Takes 2 continued-fraction-pipes and returns one that stops at the simplest rational inbetween"
    (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
    (IF (OR (PIPE-ENDP CF1) (PIPE-ENDP CF2))
        :EMPTY-PIPE
        (LET* ((A (PIPE-FIRST CF1))
               (B (PIPE-FIRST CF2))
               (AN (CAR A))
               (BN (CAR B)))
          (DECLARE (TYPE INTEGER AN BN))
          (IF (/= AN BN)
              (LIST (CONS (1+ (MIN AN BN)) (CONSTANTLY 0)) :EMPTY-PIPE)
              (PIPE-CONS A
               (TRUNCATE-WITHIN-INTERVAL (PIPE-REST CF1) (PIPE-REST CF2)))))))

[ratmath/ratmath.lisp:67]
  (DEFUN CONTINUED-FRACTION-PIPE (F)
    "Returns a pipe of continued fraction terms from the input rational arg."
    (DECLARE (TYPE RATIONAL F)
             (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
    (MULTIPLE-VALUE-BIND (Q R)
        (FLOOR F)
      (DECLARE (TYPE INTEGER Q)
               (TYPE RATIONAL R))
      (IF (ZEROP R)
          (LIST (CONS Q (CONSTANTLY 0)) :EMPTY-PIPE)
          (PIPE-CONS (CONS Q (ENCAPSULATE (REM (NUMERATOR R) (DENOMINATOR R))))
           (CONTINUED-FRACTION-PIPE (/ R))))))

[ratmath/ratmath.lisp:171]
  (DEFUN SEMI-CONVERGENT-CLOSEST-TO-LIM
         (CV LIMN LIMD &AUX (Q (CONVERGENT-Q CV)))
    "From a specific convergent, check semi-convergents for one below num/denom limits"
    (DECLARE (TYPE (OR NULL (INTEGER 1 *)) LIMN LIMD)
             (TYPE INTEGER Q)
             (TYPE CONVERGENT CV)
             (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
    (LABELS ((HALFQ-IS-OK-P (CV)
               (LET ((A-1 (EXPOSE (CONVERGENT-A CV)))
                     (A0 (EXPOSE (CDR (CONVERGENT-CF CV))))
                     (D-1 (CDR (CONVERGENT-R0 CV)))
                     (D-2 (CDR (CONVERGENT-R1 CV))))
                 (DECLARE (TYPE INTEGER A-1 A0 D-1 D-2))
                 (> (* D-2 A-1) (* A0 D-1)))))
      (LET ((NQO
             (MY-
              (MY-MIN
               (MY/ (MY- LIMD (CDR (CONVERGENT-R1 CV)))
                (CDR (CONVERGENT-R0 CV)))
               (MY/ (MY- LIMN (CAR (CONVERGENT-R1 CV)))
                (CAR (CONVERGENT-R0 CV))))
              Q))
            (FQO
             (IF (<= Q 1)
                 0
                 (- (CEILING (1+ Q) 2) Q))))
        (COND ((OR (NOT NQO) (>= NQO 0)) CV)
              ((>= NQO FQO) (MAKE-SEMI-CONVERGENT NQO CV))
              ((AND (EVENP Q) (HALFQ-IS-OK-P CV))
               (MAKE-SEMI-CONVERGENT (1- FQO) CV))
              (T (MAKE-SEMI-CONVERGENT FQO CV))))))

[ratmath/ratmath.lisp:196]
  (DEFUN CONVERGENTS-PIPE
         (CFS &OPTIONAL (R0 '(1 . 0)) (R1 '(0 . 1)) (A (CONSTANTLY 0)))
    "From a continued-fraction-pipe return a pipe of the resultant convergents."
    (DECLARE (TYPE CONS R0 R1)
             (TYPE FUNCTION A)
             (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
    (IF (PIPE-ENDP CFS)
        :EMPTY-PIPE
        (LET ((X (MAKE-CONVERGENT (PIPE-FIRST CFS) R0 R1 A))
              (NEXTA (CDR (PIPE-FIRST CFS))))
          (DECLARE (TYPE CONVERGENT X))
          (PIPE-CONS X
           (CONVERGENTS-PIPE (PIPE-REST CFS) (CONVERGENT-FRACT X) R0 NEXTA)))))

[ratmath/ratmath.lisp:206]
  (DEFMACRO BEST-CONVERGENT-TEST-FN (&REST ARGS)
    (DESTRUCTURING-BIND
        (&KEY LIMN LIMD &ALLOW-OTHER-KEYS)
        ARGS
      (LET ((N
             (ECLECTOR.READER:QUASIQUOTE
              (> (THE INTEGER (CONVERGENT-NUMERATOR CV))
                 (ECLECTOR.READER:UNQUOTE LIMN))))
            (D
             (ECLECTOR.READER:QUASIQUOTE
              (> (THE INTEGER (CONVERGENT-DENOMINATOR CV))
                 (ECLECTOR.READER:UNQUOTE LIMD)))))
        (ECLECTOR.READER:QUASIQUOTE
         (LAMBDA (CV)
           (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0))
                    (TYPE CONVERGENT CV))
           (ECLECTOR.READER:UNQUOTE-SPLICING
            (COND
             ((AND (NULL LIMN) (NULL LIMD))
              (ECLECTOR.READER:QUASIQUOTE ((DECLARE (IGNORE CV)) NIL)))
             ((AND (NULL LIMN) LIMD)
              (ECLECTOR.READER:QUASIQUOTE ((ECLECTOR.READER:UNQUOTE D))))
             ((AND LIMN (NULL LIMD))
              (ECLECTOR.READER:QUASIQUOTE ((ECLECTOR.READER:UNQUOTE N))))
             (T
              (ECLECTOR.READER:QUASIQUOTE
               ((OR (ECLECTOR.READER:UNQUOTE D)
                    (ECLECTOR.READER:UNQUOTE N))))))))))))

[ratmath/ratmath.lisp:218]
  (DEFUN BEST-CONVERGENT (ARG &KEY LIMN LIMD TEST-FN)
    "From a rationalized continued-fraction-pipe arg, returns best convergent honoring limits.
2nd value being the next best ignoring limits."
    (DECLARE (TYPE (OR NULL (INTEGER 1 *)) LIMN LIMD)
             (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
    (LABELS ((GET-END-P ()
               (COND (TEST-FN TEST-FN)
                     ((AND LIMN LIMD)
                      (BEST-CONVERGENT-TEST-FN :LIMD LIMD :LIMN LIMN))
                     (LIMD (BEST-CONVERGENT-TEST-FN :LIMD LIMD))
                     (LIMN (BEST-CONVERGENT-TEST-FN :LIMN LIMN))
                     (T (BEST-CONVERGENT-TEST-FN))))
             (SEMI-CONVERGENTS (CVS LIM-TEST-P &OPTIONAL PREV)
               (DECLARE (TYPE (FUNCTION (CONVERGENT) BOOLEAN) LIM-TEST-P)
                        (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
               (COND ((PIPE-ENDP CVS) (LIST PREV))
                     ((FUNCALL LIM-TEST-P (PIPE-FIRST CVS))
                      (LET ((SC
                             (SEMI-CONVERGENT-CLOSEST-TO-LIM (PIPE-FIRST CVS)
                              LIMN LIMD)))
                        (COND ((FUNCALL LIM-TEST-P SC) (LIST PREV SC))
                              ((LAST-SEMI-CONVERGENT-P SC)
                               (SEMI-CONVERGENTS (PIPE-REST CVS) LIM-TEST-P
                                SC))
                              (T (LIST SC (NEXT-SEMI-CONVERGENT SC))))))
                     (T
                      (SEMI-CONVERGENTS (PIPE-REST CVS) LIM-TEST-P
                       (PIPE-FIRST CVS)))))
             (NEXT-SEMI-CONVERGENT (C)
               (MAKE-SEMI-CONVERGENT (1+ (CONVERGENT-Q-OFFSET C)) C))
             (LAST-SEMI-CONVERGENT-P (C)
               (ZEROP (CONVERGENT-Q-OFFSET C))))
      (DECLARE (INLINE LAST-SEMI-CONVERGENT-P NEXT-SEMI-CONVERGENT GET-END-P)
               (FTYPE (FUNCTION (CONVERGENT) CONVERGENT) NEXT-SEMI-CONVERGENT)
               (FTYPE (FUNCTION (CONVERGENT) BOOLEAN) LAST-SEMI-CONVERGENT-P))
      (VALUES-LIST (SEMI-CONVERGENTS (CONVERGENTS-PIPE ARG) (GET-END-P)))))

[ratmath/ratmath.lisp:248]
  (LET ((CF0 (LIST (CONS 0 (CONSTANTLY 0)) :EMPTY-PIPE)))
    (DEFUN FAREY-PIPE (ORDER &KEY TEST-FN (FROM-CF CF0) (LIMN ORDER))
      "Returns a farey sequence; 2nd value is an encapsulated reverse sequence"
      (DECLARE (TYPE (INTEGER 1 *) ORDER)
               (TYPE (OR NULL (INTEGER 1 *)) LIMN)
               (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
      (LABELS ((FAREY (X DIR)
                 (DECLARE (TYPE BOOLEAN DIR)
                          (TYPE STERN-BROCOT X))
                 (IF (ZEROP (STERN-BROCOT-NUMERATOR X))
                     (IF DIR
                         :EMPTY-PIPE
                         (LET ((YR (/ 1 ORDER)))
                           (PIPE-CONS YR (FAREY (CALC-STERN-BROCOT YR) DIR))))
                     (LET* ((L
                             (IF DIR
                                 (STERN-BROCOT-RIGHT-PARENT X)
                                 (STERN-BROCOT-LEFT-PARENT X)))
                            (K
                             (MY-MIN
                              (MY/ (MY- LIMN (CAR L))
                               (STERN-BROCOT-NUMERATOR X))
                              (MY/ (MY- ORDER (CDR L))
                               (STERN-BROCOT-DENOMINATOR X))))
                            (Y
                             (CONS (+ (* (STERN-BROCOT-NUMERATOR X) K) (CAR L))
                                   (+ (* (STERN-BROCOT-DENOMINATOR X) K)
                                      (CDR L)))))
                       (COND ((OR (ZEROP (CDR Y)) (ZEROP (CAR Y))) :EMPTY-PIPE)
                             (T
                              (LET ((YR (/ (CAR Y) (CDR Y))))
                                (PIPE-CONS YR
                                 (FAREY (CALC-STERN-BROCOT YR) DIR))))))))
               (FAREY-START (A B DIR)
                 (IF (AND B
                          (EQ (< (CONVERGENT-RATIO A) (CONVERGENT-RATIO B))
                              (AND T DIR)))
                     (PIPE-CONS (CONVERGENT-RATIO A)
                      (FAREY (CONVERGENT-STERN-BROCOT A) DIR))
                     (FAREY (CONVERGENT-STERN-BROCOT A) DIR))))
        (MULTIPLE-VALUE-BIND (A B)
            (BEST-CONVERGENT FROM-CF :LIMD ORDER :LIMN LIMN :TEST-FN TEST-FN)
          (VALUES (FAREY-START A B NIL) (ENCAPSULATE (FAREY-START A B T)))))))

[ratmath/ratmath.lisp:306]
  (DEFUN RAT-PIPE (ARG &OPTIONAL (MULT 2))
    "Returns a pipe of best rational approximations for every power-of-mult numerator/denominator.  If
arg is not a number, assumes it is a continued fraction pipe."
    (DECLARE (TYPE (AND FIXNUM (INTEGER 2 *)) MULT)
             (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
    (LABELS ((EXPT-CONVERGENTS (CVS &OPTIONAL (LIMN 1) (LIMD 1))
               (DECLARE (TYPE (INTEGER 1 *) LIMN LIMD))
               (COND ((PIPE-ENDP CVS) :EMPTY-PIPE)
                     ((AND LIMD
                           (> (CONVERGENT-DENOMINATOR (PIPE-FIRST CVS)) LIMD))
                      (LET ((SC
                             (SEMI-CONVERGENT-CLOSEST-TO-LIM (PIPE-FIRST CVS)
                              LIMN LIMD))
                            (NEXT-LIMD (1- (* MULT (1+ LIMD)))))
                        (IF (<= (CONVERGENT-DENOMINATOR SC) LIMD)
                            (PIPE-CONS SC
                             (EXPT-CONVERGENTS CVS LIMN NEXT-LIMD))
                            (EXPT-CONVERGENTS CVS LIMN NEXT-LIMD))))
                     ((AND LIMN
                           (> (CONVERGENT-NUMERATOR (PIPE-FIRST CVS)) LIMN))
                      (LET ((SC
                             (SEMI-CONVERGENT-CLOSEST-TO-LIM (PIPE-FIRST CVS)
                              LIMN LIMD))
                            (NEXT-LIMN (1- (* MULT (1+ LIMN)))))
                        (IF (<= (CONVERGENT-NUMERATOR SC) LIMN)
                            (PIPE-CONS SC
                             (EXPT-CONVERGENTS CVS NEXT-LIMN LIMD))
                            (EXPT-CONVERGENTS CVS NEXT-LIMN LIMD))))
                     (T
                      (PIPE-CONS (PIPE-FIRST CVS)
                       (EXPT-CONVERGENTS (PIPE-REST CVS) LIMN LIMD)))))
             (CONVERGENTS-OF-EQUAL-BINARY-ORDER-P (CVA CVB)
               (AND
                (= (INTEGER-LENGTH (CONVERGENT-NUMERATOR CVA))
                   (INTEGER-LENGTH (CONVERGENT-NUMERATOR CVB)))
                (= (INTEGER-LENGTH (CONVERGENT-DENOMINATOR CVA))
                   (INTEGER-LENGTH (CONVERGENT-DENOMINATOR CVB)))))
             (CONVERGENTS-OF-EQUAL-ORDER-P (CVA CVB)
               (AND
                (= (FLOOR (LOG (1+ (CONVERGENT-NUMERATOR CVA)) MULT))
                   (FLOOR (LOG (1+ (CONVERGENT-NUMERATOR CVB)) MULT)))
                (= (FLOOR (LOG (CONVERGENT-DENOMINATOR CVA) MULT))
                   (FLOOR (LOG (CONVERGENT-DENOMINATOR CVB) MULT))))))
      (PIPE-TRANSFORM #'CONVERGENT-RATIO
       (PIPE-UNIQ
        (EXPT-CONVERGENTS
         (CONVERGENTS-PIPE
          (IF (REALP ARG)
              (CONTINUED-FRACTION-PIPE (RATIONAL ARG))
              (RATIONALIZE-CONTINUED-FRACTION-PIPE ARG))))
        (IF (= MULT 2)
            #'CONVERGENTS-OF-EQUAL-BINARY-ORDER-P
            #'CONVERGENTS-OF-EQUAL-ORDER-P)))))

[ratmath/ratmath.lisp:604]
  (DEFUN PARSE-INTERVAL (S)
    "Turns strings of rationals or floats into rational intervals. Infers interval radius from number
specification. e.g. 1.000 implies an interval of [.9995, 1.0005) whereas just 1 implies [.5, 1.5).
Exponent notation is also recognized; 1e3 is [500, 1500) whereas 1000 is [999.5, 1000.5). A rational
specified as 22/7 is converted as (43/14, 45/14)."
    (DECLARE (OPTIMIZE SPEED (SAFETY 0) (DEBUG 0)))
    (COND ((LISTP S) (MAPCAR #'PARSE-INTERVAL S)) ((NOT (STRINGP S)) S)
          (T
           (LET ((N 0) (D 1) NEG NEG-EXP (E 0))
             (DECLARE (TYPE (INTEGER 0 *) D E N)
                      (TYPE BOOLEAN NEG NEG-EXP))
             (LABELS ((DIGIT-VAL (C)
                        (POSITION C "0123456789"))
                      (EXP-DIGIT-P (C)
                        (FIND (CHAR-DOWNCASE C) "esdfl"))
                      (INITIAL (C)
                        (CASE C
                          (#\~ #'INITIAL1)
                          (#\- (SETF NEG T) #'GEN-NUM0)
                          (#\+ #'GEN-NUM0)
                          (T (GEN-NUM0 C))))
                      (INITIAL1 (C)
                        (CASE C
                          (#\- (SETF NEG T) #'GEN-NUM0)
                          (#\+ #'GEN-NUM0)
                          (T (GEN-NUM0 C))))
                      (GEN-NUM0 (C)
                        (UNLESS (DIGIT-CHAR-P C)
                          (RETURN-FROM PARSE-INTERVAL NIL))
                        (SETF N (DIGIT-VAL C))
                        #'GEN-NUM)
                      (GEN-NUM (C)
                        (COND
                         ((DIGIT-CHAR-P C) (SETF N (+ (DIGIT-VAL C) (* 10 N)))
                          #'GEN-NUM)
                         ((CHAR-EQUAL C #\.) #'GEN-NUM-POST-PT)
                         ((CHAR-EQUAL C #\/) #'GEN-DENOM0)
                         ((EXP-DIGIT-P C) #'GEN-EXP-?NEG)
                         (T (RETURN-FROM PARSE-INTERVAL NIL))))
                      (GEN-NUM-POST-PT (C)
                        (IF (EXP-DIGIT-P C)
                            #'GEN-EXP-?NEG
                            (PROGN
                             (UNLESS (DIGIT-CHAR-P C)
                               (RETURN-FROM PARSE-INTERVAL NIL))
                             (SETF N (+ (DIGIT-VAL C) (* 10 N)))
                             (SETF D (* D 10))
                             #'GEN-NUM-POST-PT)))
                      (GEN-DENOM0 (C)
                        (UNLESS (DIGIT-CHAR-P C)
                          (RETURN-FROM PARSE-INTERVAL NIL))
                        (SETF D (DIGIT-VAL C))
                        #'GEN-DENOM)
                      (GEN-DENOM (C)
                        (UNLESS (DIGIT-CHAR-P C)
                          (RETURN-FROM PARSE-INTERVAL NIL))
                        (SETF D (+ (DIGIT-VAL C) (* 10 D)))
                        #'GEN-DENOM)
                      (GEN-EXP-?NEG (C)
                        (CASE C
                          (#\- (SETF NEG-EXP T) #'GEN-EXP)
                          (#\+ #'GEN-EXP)
                          (T (GEN-EXP C))))
                      (GEN-EXP (C)
                        (UNLESS (DIGIT-CHAR-P C)
                          (RETURN-FROM PARSE-INTERVAL NIL))
                        (SETF E (+ (DIGIT-VAL C) (* 10 E)))
                        #'GEN-EXP))
               (DECLARE (TYPE STRING S))
               (LET ((STATE #'INITIAL))
                 (DECLARE (TYPE (FUNCTION (CHARACTER) FUNCTION) STATE))
                 (DOTIMES (I (LENGTH S))
                   (SETF STATE (FUNCALL STATE (CHAR S I))))
                 (WHEN
                     (NOT
                      (MEMBER STATE
                              (LIST #'GEN-NUM #'GEN-DENOM #'GEN-EXP
                                    #'GEN-NUM-POST-PT)))
                   (RETURN-FROM PARSE-INTERVAL NIL))
                 (LET ((X (/ N D)))
                   (DECLARE (TYPE RATIONAL X))
                   (WHEN NEG (SETF X (- X)))
                   (INTERVAL*
                    (EXPT 10
                          (IF NEG-EXP
                              (- E)
                              E))
                    (INTERVAL~ X :ABSTOL (/ (* 2 D)))))))))))

[roan/roan.lisp:517]
  (DEFUN %PERMUTE (FROM-BELLS BY-BELLS TO-BELLS)
    (DECLARE
     (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (COMPILATION-SPEED 0) (DEBUG 0)))
    (DECLARE (TYPE %BELLS-VECTOR FROM-BELLS BY-BELLS TO-BELLS))
    (DECLARE (INLINE MIN))
    (ITER (DECLARE (DECLARE-VARIABLES)) (FOR B :IN-VECTOR BY-BELLS)
     (DECLARE (TYPE BELL B)) (FOR I :FROM 0) (DECLARE (TYPE FIXNUM I))
     (SETF (AREF TO-BELLS I)
             (IF (< B (LENGTH FROM-BELLS))
                 (AREF FROM-BELLS B)
                 B)))
    (WHEN (> (LENGTH FROM-BELLS) (LENGTH BY-BELLS))
      (ITER (DECLARE (DECLARE-VARIABLES))
       (FOR I :FROM (LENGTH BY-BELLS) :BELOW (LENGTH FROM-BELLS))
       (SETF (AREF TO-BELLS I) (AREF FROM-BELLS I)))))

[roan/roan.lisp:533]
  (DEFUN %FILL-BELLS-VECTOR (FROM-BELLS TO-BELLS)
    (DECLARE
     (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (COMPILATION-SPEED 0) (DEBUG 0)))
    (DECLARE (TYPE %BELLS-VECTOR FROM-BELLS TO-BELLS))
    (DOTIMES (I (LENGTH FROM-BELLS))
      (DECLARE (TYPE FIXNUM I))
      (SETF (AREF TO-BELLS I) (AREF FROM-BELLS I)))
    (ITER (DECLARE (DECLARE-VARIABLES))
     (FOR I :FROM (LENGTH FROM-BELLS) :BELOW (LENGTH TO-BELLS))
     (DECLARE (TYPE BELL I)) (SETF (AREF TO-BELLS I) I)))

[roan/roan.lisp:545]
  (DEFUN PERMUTE (ROW &OPTIONAL (CHANGE NIL CHANGE-SUPPLIED) &REST CHANGES)
    "===lambda: (row &rest changes)
Permutes @var{row} by the @var{changes} in turn. That is, @var{row} is first permuted by
the first of the @var{changes}, then the resuling row is permuted by second of the
@var{changes}, and so on. Returns the row resulting from applying all the changes. So long
as one or more @var{changes} are supplied the returned @code{row} is always a freshly
created one: @var{row} and none of the @var{changes} are modified (as you'd expect, since
they are intended to be viewed as immutable). The @var{row} and all the @var{changes}
should be @code{row}s.

At each step of permuting a row by a change, if the row is of higher stage than the
change, only the first @var{stage} bells of the row are permuted, where @var{stage} is the
stage of the change, all the remaining bells of the row being unmoved. If the row is of
lower stage than the change, it is as if the row were extended with bells in their rounds'
positions for all the bells @var{stage} and above. Thus the result of each permuation step
is a @code{row} whose stage is the larger of those of the row and the change.

If no @var{changes} are supplied @code{row} is returned. Signals a @code{type-error} if
@var{row} or any of the @var{changes} are not @code{row}s.
@example
@group
 (permute !34256 !35264) @result{} !145362
 (permute !34125 !4321 !1342) @result{} !24315
 (permute !4321 !654321) @result{} !651234
 (let ((r !13572468))
   (list (eq (permute r) r)
         (equalp (permute r (rounds 8)) r)
         (eq (permute r (rounds 8)) r)))
     @result{} (t t nil)
@end group
@end example"
    (DECLARE
     (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (COMPILATION-SPEED 0) (DEBUG 0)))
    (CHECK-TYPE* ROW ROW)
    (UNLESS CHANGE-SUPPLIED (RETURN-FROM PERMUTE ROW))
    (CHECK-TYPE* CHANGE ROW)
    (LOCALLY
     (DECLARE (TYPE ROW ROW CHANGE)
              (INLINE MAX MAKE-ARRAY LENGTH))
     (LET ((ROW-BELLS (ROW-BELLS ROW)) (CHANGE-BELLS (ROW-BELLS CHANGE)))
       (DECLARE (TYPE %BELLS-VECTOR ROW-BELLS CHANGE-BELLS))
       (COND
        (CHANGES
         (LET ((RESULT-LENGTH
                (MAX (LENGTH ROW-BELLS) (LENGTH CHANGE-BELLS)
                     (REDUCE #'MAX CHANGES :KEY
                             #'(LAMBDA (X)
                                 (CHECK-TYPE* X ROW)
                                 (LENGTH (ROW-BELLS X)))))))
           (DECLARE (TYPE STAGE RESULT-LENGTH))
           (LET ((RESULT (MAKE-ARRAY RESULT-LENGTH :ELEMENT-TYPE 'BELL)))
             (DECLARE (TYPE %BELLS-VECTOR RESULT))
             (%FILL-BELLS-VECTOR ROW-BELLS RESULT)
             (LET ((SCRATCH (COPY-SEQ RESULT)))
               (DECLARE (TYPE %BELLS-VECTOR RESULT SCRATCH))
               (%PERMUTE ROW-BELLS CHANGE-BELLS RESULT)
               (DOLIST (C CHANGES)
                 (LOCALLY
                  (DECLARE (TYPE ROW C))
                  (LET ((C-BELLS (ROW-BELLS C)))
                    (DECLARE (TYPE %BELLS-VECTOR C-BELLS))
                    (ROTATEF RESULT SCRATCH)
                    (%PERMUTE SCRATCH C-BELLS RESULT)))))
             (%MAKE-ROW RESULT))))
        ((EQL (LENGTH ROW-BELLS) (LENGTH CHANGE-BELLS))
         (LET ((RESULT (MAKE-ARRAY (LENGTH ROW-BELLS) :ELEMENT-TYPE 'BELL)))
           (DECLARE (TYPE %BELLS-VECTOR RESULT))
           (DOTIMES (I (LENGTH CHANGE-BELLS))
             (DECLARE (TYPE FIXNUM I))
             (SETF (AREF RESULT I) (AREF ROW-BELLS (AREF CHANGE-BELLS I))))
           (%MAKE-ROW RESULT)))
        (T
         (LET ((RESULT
                (MAKE-ARRAY (MAX (LENGTH ROW-BELLS) (LENGTH CHANGE-BELLS))
                            :ELEMENT-TYPE 'BELL)))
           (DECLARE (TYPE %BELLS-VECTOR RESULT))
           (%FILL-BELLS-VECTOR ROW-BELLS RESULT)
           (%PERMUTE ROW-BELLS CHANGE-BELLS RESULT)
           (%MAKE-ROW RESULT)))))))

[roan/roan.lisp:842]
  (DEFUN PERMUTE-BY-INVERSE (ROW CHANGE)
    "Equivalent to @code{(permute @var{row} (inverse @var{change}))}. Signals a
@code{type-error} if either @var{row} or @var{change} is not a @code{row}.
@example
@group
 (permute-by-inverse !13456287 !45678123) @result{} !28713456
 (permute-by-inverse !54312 !2438756) @result{} !54137862
 (permute-by-inverse !762345 !4312) @result{} !6271345
@end group
@end example"
    (DECLARE
     (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (COMPILATION-SPEED 0) (DEBUG 0)))
    (CHECK-TYPE* ROW ROW)
    (CHECK-TYPE* CHANGE ROW)
    (LOCALLY
     (DECLARE (TYPE ROW ROW CHANGE)
              (INLINE MAX MAKE-ARRAY LENGTH))
     (LET* ((ROW-BELLS (ROW-BELLS ROW))
            (ROW-STAGE (LENGTH ROW-BELLS))
            (CHANGE-BELLS (ROW-BELLS CHANGE)))
       (DECLARE (TYPE %BELLS-VECTOR ROW-BELLS CHANGE-BELLS)
                (TYPE STAGE ROW-STAGE))
       (IF (EQL (LENGTH CHANGE-BELLS) ROW-STAGE)
           (LET ((RESULT (MAKE-ARRAY ROW-STAGE :ELEMENT-TYPE 'BELL)))
             (DECLARE (TYPE %BELLS-VECTOR RESULT))
             (DOTIMES (I ROW-STAGE)
               (DECLARE (TYPE FIXNUM I))
               (SETF (AREF RESULT (AREF CHANGE-BELLS I)) (AREF ROW-BELLS I)))
             (%MAKE-ROW RESULT))
           (LET ((RESULT
                  (MAKE-ARRAY (MAX ROW-STAGE (LENGTH CHANGE-BELLS))
                              :ELEMENT-TYPE 'BELL)))
             (DECLARE (TYPE %BELLS-VECTOR RESULT))
             (%FILL-BELLS-VECTOR ROW-BELLS RESULT)
             (DOTIMES (I (LENGTH CHANGE-BELLS))
               (DECLARE (TYPE FIXNUM I))
               (SETF (AREF RESULT (AREF CHANGE-BELLS I))
                       (IF (< I ROW-STAGE)
                           (AREF ROW-BELLS I)
                           I)))
             (%MAKE-ROW RESULT))))))

[roan/roan.lisp:1012]
  (DEFUN %IN-COURSE-P (ROW-BELLS)
    (DECLARE
     (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (COMPILATION-SPEED 0) (DEBUG 0))
     (TYPE %BELLS-VECTOR ROW-BELLS))
    (ITER (WITH BELLS := (COPY-SEQ ROW-BELLS))
     (DECLARE (TYPE %BELLS-VECTOR BELLS)) (WITH END := (LENGTH BELLS))
     (DECLARE (TYPE STAGE END)) (WITH I := 1) (DECLARE (FIXNUM I))
     (WITH RESULT := T) (WHILE (< I END))
     (COND ((EQL (AREF BELLS I) I) (INCF I))
           (T (ROTATEF (AREF BELLS I) (AREF BELLS (AREF BELLS I)))
            (SETF RESULT (NOT RESULT))))
     (FINALLY (RETURN RESULT))))

[roan/roan.lisp:1042]
  (DEFUN INVERSE (ROW)
    "Returns the inverse of the @code{row} @var{row}. That is, the @code{row}, @var{r}, such
that when @var{row} is permuted by @var{r}, the result is rounds. A theorem of group
theory implies also that when @var{r} is permuted by @var{row} the result will also be
rounds. Signals a @code{type-error} if @var{row} is not a @code{row}.
@example
@group
 (inverse !13427586) @result{} !14236857
 (inverse !14236857) @result{} !13427586
 (inverse !12436587) @result{} !12436587
 (inverse !12345678) @result{} !12345678
@end group
@end example"
    (DECLARE
     (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (COMPILATION-SPEED 0) (DEBUG 0)))
    (CHECK-TYPE* ROW ROW)
    (LOCALLY
     (DECLARE (TYPE ROW ROW)
              (INLINE LENGTH MAKE-ARRAY))
     (LET* ((BELLS (ROW-BELLS ROW))
            (STAGE (LENGTH BELLS))
            (RESULT (MAKE-ARRAY STAGE :ELEMENT-TYPE 'BELL)))
       (DECLARE (TYPE %BELLS-VECTOR BELLS RESULT)
                (TYPE STAGE STAGE))
       (DOTIMES (I STAGE)
         (DECLARE (TYPE FIXNUM I))
         (SETF (AREF RESULT (AREF BELLS I)) I))
       (%MAKE-ROW RESULT))))

[rt/rt.lisp:56]
  (DEFVAR *OPTIMIZATION-SETTINGS* '((SAFETY 3)))

[rtg-math/matrices/matrix2/consing.lisp:8]
  (DEFN-INLINE 0! NIL MAT2 (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
   (MAKE-ARRAY 4 :ELEMENT-TYPE (ECLECTOR.READER:QUASIQUOTE SINGLE-FLOAT)
               :INITIAL-ELEMENT 0.0))

[rtg-math/matrices/matrix2/consing.lisp:14]
  (DEFN MAKE
   ((A SINGLE-FLOAT) (B SINGLE-FLOAT) (C SINGLE-FLOAT) (D SINGLE-FLOAT)) MAT2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE 0!))
   (#S(FORMGREP:SYMREF :NAME "SET-COMPONENTS" :QUALIFIER "M2-N") A B C D (0!)))

[rtg-math/matrices/matrix2/consing.lisp:22]
  (DEFN-INLINE COPY-MAT2 ((MAT2 MAT2)) MAT2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 1)))
   (LET ((RESULT (MAKE-ARRAY 4 :ELEMENT-TYPE 'SINGLE-FLOAT)))
     (SETF (AREF RESULT 0) (AREF MAT2 0))
     (SETF (AREF RESULT 1) (AREF MAT2 1))
     (SETF (AREF RESULT 2) (AREF MAT2 2))
     (SETF (AREF RESULT 3) (AREF MAT2 3))
     RESULT))

[rtg-math/matrices/matrix2/consing.lisp:33]
  (DEFN IDENTITY NIL MAT2 (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE 1.0 0.0 0.0 1.0))

[rtg-math/matrices/matrix2/consing.lisp:41]
  (DEFN FROM-ROWS ((ROW-1 VEC2) (ROW-2 VEC2)) MAT2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE (X ROW-1) (Y ROW-1) (X ROW-2) (Y ROW-2)))

[rtg-math/matrices/matrix2/consing.lisp:48]
  (DEFN GET-ROWS ((MAT-A MAT2)) LIST
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LIST
    (#S(FORMGREP:SYMREF :NAME "MAKE" :QUALIFIER "V2") (MELM MAT-A 0 0)
     (MELM MAT-A 0 1))
    (#S(FORMGREP:SYMREF :NAME "MAKE" :QUALIFIER "V2") (MELM MAT-A 1 0)
     (MELM MAT-A 1 1))))

[rtg-math/matrices/matrix2/consing.lisp:57]
  (DEFN GET-ROW ((MAT-A MAT2) (ROW-NUM (INTEGER 0 1))) VEC2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (#S(FORMGREP:SYMREF :NAME "MAKE" :QUALIFIER "V2") (MELM MAT-A ROW-NUM 0)
    (MELM MAT-A ROW-NUM 1)))

[rtg-math/matrices/matrix2/consing.lisp:64]
  (DEFN FROM-COLUMNS ((COL-1 VEC2) (COL-2 VEC2)) MAT2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE (X COL-1) (X COL-2) (Y COL-1) (Y COL-2)))

[rtg-math/matrices/matrix2/consing.lisp:71]
  (DEFN GET-COLUMNS ((MAT-A MAT2)) LIST
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LIST (V! (MELM MAT-A 0 0) (MELM MAT-A 1 0))
         (V! (MELM MAT-A 0 1) (MELM MAT-A 1 1))))

[rtg-math/matrices/matrix2/consing.lisp:80]
  (DEFN GET-COLUMN ((MAT-A MAT2) (COL-NUM (INTEGER 0 1))) VEC2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (#S(FORMGREP:SYMREF :NAME "MAKE" :QUALIFIER "V2") (MELM MAT-A 0 COL-NUM)
    (MELM MAT-A 1 COL-NUM)))

[rtg-math/matrices/matrix2/consing.lisp:87]
  (DEFN |0P| ((MAT-A MAT2)) BOOLEAN
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (AND (= 0.0 (AREF MAT-A 0)) (= 0.0 (AREF MAT-A 1)) (= 0.0 (AREF MAT-A 2))
        (= 0.0 (AREF MAT-A 3))))

[rtg-math/matrices/matrix2/consing.lisp:96]
  (DEFN IDENTITYP ((MAT-A MAT2)) BOOLEAN
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (AND (= 1.0 (MELM MAT-A 0 0)) (= 0.0 (MELM MAT-A 0 1))
        (= 0.0 (MELM MAT-A 1 0)) (= 1.0 (MELM MAT-A 1 1))))

[rtg-math/matrices/matrix2/consing.lisp:103]
  (DEFN = ((MAT-A MAT2) (MAT-B MAT2)) BOOLEAN
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (AND (= (AREF MAT-A 0) (AREF MAT-B 0)) (= (AREF MAT-A 1) (AREF MAT-B 1))
        (= (AREF MAT-A 2) (AREF MAT-B 2)) (= (AREF MAT-A 3) (AREF MAT-B 3))))

[rtg-math/matrices/matrix2/consing.lisp:112]
  (DEFN TRANSPOSE ((MAT-A MAT2)) MAT2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE COPY-MAT2))
   (#S(FORMGREP:SYMREF :NAME "TRANSPOSE" :QUALIFIER "M2-N") (COPY-MAT2 MAT-A)))

[rtg-math/matrices/matrix2/consing.lisp:119]
  (DEFN ADJOINT ((MAT-A MAT2)) MAT2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE COPY-MAT2))
   (#S(FORMGREP:SYMREF :NAME "ADJOINT" :QUALIFIER "M2-N") (COPY-MAT2 MAT-A)))

[rtg-math/matrices/matrix2/consing.lisp:126]
  (DEFN TRACE ((MAT-A MAT2)) SINGLE-FLOAT
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (+ (MELM MAT-A 0 0) (MELM MAT-A 1 1)))

[rtg-math/matrices/matrix2/consing.lisp:132]
  (DEFN ROTATION-FROM-EULER ((ANGLE SINGLE-FLOAT)) MAT2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE 0!))
   (#S(FORMGREP:SYMREF :NAME "SET-ROTATION-FROM-EULER" :QUALIFIER "M2-N") (0!)
    ANGLE))

[rtg-math/matrices/matrix2/consing.lisp:139]
  (DEFN SCALE ((SCALE-VEC2 VEC2)) MAT2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE 0!))
   (#S(FORMGREP:SYMREF :NAME "SET-FROM-SCALE" :QUALIFIER "M2-N") (0!)
    SCALE-VEC2))

[rtg-math/matrices/matrix2/consing.lisp:146]
  (DEFN + ((MAT-A MAT2) (MAT-B MAT2)) MAT2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE (+ (AREF MAT-A 0) (AREF MAT-B 0)) (+ (AREF MAT-A 1) (AREF MAT-B 1))
    (+ (AREF MAT-A 2) (AREF MAT-B 2)) (+ (AREF MAT-A 3) (AREF MAT-B 3))))

[rtg-math/matrices/matrix2/consing.lisp:155]
  (DEFN - ((MAT-A MAT2) (MAT-B MAT2)) MAT2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE (- (AREF MAT-A 0) (AREF MAT-B 0)) (- (AREF MAT-A 1) (AREF MAT-B 1))
    (- (AREF MAT-A 2) (AREF MAT-B 2)) (- (AREF MAT-A 3) (AREF MAT-B 3))))

[rtg-math/matrices/matrix2/consing.lisp:164]
  (DEFN NEGATE ((MAT-A MAT2)) MAT2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE COPY-MAT2))
   (#S(FORMGREP:SYMREF :NAME "NEGATE" :QUALIFIER "M2-N") (COPY-MAT2 MAT-A)))

[rtg-math/matrices/matrix2/consing.lisp:171]
  (DEFN *V ((MAT-A MAT2) (VEC-A VEC2)) VEC2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (#S(FORMGREP:SYMREF :NAME "*V" :QUALIFIER "M2-N") MAT-A
    (#S(FORMGREP:SYMREF :NAME "COPY-VEC2" :QUALIFIER "V2") VEC-A)))

[rtg-math/matrices/matrix2/consing.lisp:177]
  (DEFN MROW*VEC2 ((VEC VEC2) (MAT-A MAT2)) VEC2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (#S(FORMGREP:SYMREF :NAME "MROW*VEC2" :QUALIFIER "M2-N")
    (#S(FORMGREP:SYMREF :NAME "COPY-VEC2" :QUALIFIER "V2") VEC) MAT-A))

[rtg-math/matrices/matrix2/consing.lisp:188]
  (DEFN %* ((MAT-A MAT2) (MAT-B MAT2)) MAT2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE
    (+ (* (MELM MAT-A 0 0) (MELM MAT-B 0 0))
       (* (MELM MAT-A 0 1) (MELM MAT-B 1 0)))
    (+ (* (MELM MAT-A 0 0) (MELM MAT-B 0 1))
       (* (MELM MAT-A 0 1) (MELM MAT-B 1 1)))
    (+ (* (MELM MAT-A 1 0) (MELM MAT-B 0 0))
       (* (MELM MAT-A 1 1) (MELM MAT-B 1 0)))
    (+ (* (MELM MAT-A 1 0) (MELM MAT-B 0 1))
       (* (MELM MAT-A 1 1) (MELM MAT-B 1 1)))))

[rtg-math/matrices/matrix2/consing.lisp:199]
  (DEFN * (&REST (MATRICES MAT2)) MAT2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (IF MATRICES
       (REDUCE
        #'#S(FORMGREP:SYMREF
             :NAME "*"
             :QUALIFIER "RTG-MATH.MATRIX2.NON-CONSING")
        MATRICES :INITIAL-VALUE (IDENTITY))
       (IDENTITY)))

[rtg-math/matrices/matrix2/consing.lisp:215]
  (DEFN *S ((MAT-A MAT2) (SCALAR SINGLE-FLOAT)) MAT2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE COPY-MAT2))
   (#S(FORMGREP:SYMREF :NAME "*S" :QUALIFIER "M2-N") (COPY-MAT2 MAT-A) SCALAR))

[rtg-math/matrices/matrix2/non-consing.lisp:5]
  (DEFN-INLINE SET-COMPONENTS
   ((C00 SINGLE-FLOAT) (C01 SINGLE-FLOAT) (C10 SINGLE-FLOAT) (C11 SINGLE-FLOAT)
    (MAT2-TO-MUTATE MAT2))
   MAT2 (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SETF (MELM MAT2-TO-MUTATE 0 0) C00) (SETF (MELM MAT2-TO-MUTATE 0 1) C01)
   (SETF (MELM MAT2-TO-MUTATE 1 0) C10) (SETF (MELM MAT2-TO-MUTATE 1 1) C11)
   MAT2-TO-MUTATE)

[rtg-math/matrices/matrix2/non-consing.lisp:17]
  (DEFN-INLINE COPY-COMPONENTS ((MAT MAT2) (COPY-FROM MAT2)) MAT2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SETF (MELM MAT 0 0) (MELM COPY-FROM 0 0))
   (SETF (MELM MAT 0 1) (MELM COPY-FROM 0 1))
   (SETF (MELM MAT 1 0) (MELM COPY-FROM 1 0))
   (SETF (MELM MAT 1 1) (MELM COPY-FROM 1 1)) MAT)

[rtg-math/matrices/matrix2/non-consing.lisp:27]
  (DEFN %* ((MAT-ACCUM MAT2) (TO-MULTIPLY-MAT MAT2)) MAT2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((A
          (+ (* (MELM MAT-ACCUM 0 0) (MELM TO-MULTIPLY-MAT 0 0))
             (* (MELM MAT-ACCUM 0 1) (MELM TO-MULTIPLY-MAT 1 0))))
         (B
          (+ (* (MELM MAT-ACCUM 1 0) (MELM TO-MULTIPLY-MAT 0 0))
             (* (MELM MAT-ACCUM 1 1) (MELM TO-MULTIPLY-MAT 1 0))))
         (C
          (+ (* (MELM MAT-ACCUM 0 0) (MELM TO-MULTIPLY-MAT 0 1))
             (* (MELM MAT-ACCUM 0 1) (MELM TO-MULTIPLY-MAT 1 1))))
         (D
          (+ (* (MELM MAT-ACCUM 1 0) (MELM TO-MULTIPLY-MAT 0 1))
             (* (MELM MAT-ACCUM 1 1) (MELM TO-MULTIPLY-MAT 1 1)))))
     (SETF (MELM MAT-ACCUM 0 0) A)
     (SETF (MELM MAT-ACCUM 0 1) B)
     (SETF (MELM MAT-ACCUM 1 0) C)
     (SETF (MELM MAT-ACCUM 1 1) D)
     MAT-ACCUM))

[rtg-math/matrices/matrix2/non-consing.lisp:55]
  (DEFN SET-FROM-ROWS ((MAT-TO-MUTATE MAT2) (ROW-1 VEC2) (ROW-2 VEC2)) MAT2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SET-COMPONENTS (X ROW-1) (Y ROW-1) (X ROW-2) (Y ROW-2) MAT-TO-MUTATE))

[rtg-math/matrices/matrix2/non-consing.lisp:65]
  (DEFN SET-FROM-COLUMNS ((MAT-TO-MUTATE MAT2) (COL-1 VEC2) (COL-2 VEC2)) MAT2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SET-COMPONENTS (X COL-1) (X COL-2) (Y COL-1) (Y COL-2) MAT-TO-MUTATE))

[rtg-math/matrices/matrix2/non-consing.lisp:75]
  (DEFN TRANSPOSE ((MAT-TO-TRANSPOSE MAT2)) MAT2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SET-COMPONENTS (MELM MAT-TO-TRANSPOSE 0 0) (MELM MAT-TO-TRANSPOSE 1 0)
    (MELM MAT-TO-TRANSPOSE 0 1) (MELM MAT-TO-TRANSPOSE 1 1) MAT-TO-TRANSPOSE))

[rtg-math/matrices/matrix2/non-consing.lisp:87]
  (DEFN ADJOINT ((MAT-TO-MUTATE MAT2)) MAT2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SET-COMPONENTS (MELM MAT-TO-MUTATE 1 1) (- (MELM MAT-TO-MUTATE 1 0))
    (- (MELM MAT-TO-MUTATE 0 1)) (MELM MAT-TO-MUTATE 0 0) MAT-TO-MUTATE))

[rtg-math/matrices/matrix2/non-consing.lisp:100]
  (DEFN SET-ROTATION-FROM-EULER ((MAT-TO-MUTATE MAT2) (ANGLE SINGLE-FLOAT))
   MAT2 (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((SA (SIN ANGLE)) (CA (COS ANGLE)))
     (SET-COMPONENTS CA (- SA) SA CA MAT-TO-MUTATE)))

[rtg-math/matrices/matrix2/non-consing.lisp:111]
  (DEFN SET-FROM-SCALE ((MAT-TO-MUTATE MAT2) (SCALE-VEC2 VEC2)) MAT2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SET-COMPONENTS (X SCALE-VEC2) 0.0 0.0 (Y SCALE-VEC2) MAT-TO-MUTATE))

[rtg-math/matrices/matrix2/non-consing.lisp:119]
  (DEFN + ((MAT-ACCUM MAT2) (MAT-B MAT2)) MAT2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (INCF (AREF MAT-ACCUM 0) (AREF MAT-B 0))
   (INCF (AREF MAT-ACCUM 1) (AREF MAT-B 1))
   (INCF (AREF MAT-ACCUM 2) (AREF MAT-B 2))
   (INCF (AREF MAT-ACCUM 3) (AREF MAT-B 3)) MAT-ACCUM)

[rtg-math/matrices/matrix2/non-consing.lisp:129]
  (DEFN - ((MAT-ACCUM MAT2) (MAT-B MAT2)) MAT2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (DECF (AREF MAT-ACCUM 0) (AREF MAT-B 0))
   (DECF (AREF MAT-ACCUM 1) (AREF MAT-B 1))
   (DECF (AREF MAT-ACCUM 2) (AREF MAT-B 2))
   (DECF (AREF MAT-ACCUM 3) (AREF MAT-B 3)) MAT-ACCUM)

[rtg-math/matrices/matrix2/non-consing.lisp:139]
  (DEFN NEGATE ((MAT-TO-NEGATE MAT2)) MAT2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SET-COMPONENTS (- (X MAT-TO-NEGATE)) (- (Y MAT-TO-NEGATE))
    (- (Z MAT-TO-NEGATE)) (- (W MAT-TO-NEGATE)) MAT-TO-NEGATE))

[rtg-math/matrices/matrix2/non-consing.lisp:149]
  (DEFN *V ((MAT-A MAT2) (VEC2-TO-MUTATE VEC2)) VEC2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (#S(FORMGREP:SYMREF :NAME "SET-COMPONENTS" :QUALIFIER "V2-N")
    (+ (* (X VEC2-TO-MUTATE) (MELM MAT-A 0 0))
       (* (Y VEC2-TO-MUTATE) (MELM MAT-A 0 1)))
    (+ (* (X VEC2-TO-MUTATE) (MELM MAT-A 1 0))
       (* (Y VEC2-TO-MUTATE) (MELM MAT-A 1 1)))
    VEC2-TO-MUTATE))

[rtg-math/matrices/matrix2/non-consing.lisp:159]
  (DEFN MROW*VEC2 ((VEC2-TO-MUTATE VEC2) (MAT-A MAT2)) VEC2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (#S(FORMGREP:SYMREF :NAME "SET-COMPONENTS" :QUALIFIER "V2-N")
    (+ (* (X VEC2-TO-MUTATE) (MELM MAT-A 0 0))
       (* (Y VEC2-TO-MUTATE) (MELM MAT-A 1 0)))
    (+ (* (X VEC2-TO-MUTATE) (MELM MAT-A 0 1))
       (* (Y VEC2-TO-MUTATE) (MELM MAT-A 1 1)))
    VEC2-TO-MUTATE))

[rtg-math/matrices/matrix2/non-consing.lisp:169]
  (DEFN *S ((MAT-TO-MUTATE MAT2) (SCALAR SINGLE-FLOAT)) MAT2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SET-COMPONENTS (* (MELM MAT-TO-MUTATE 0 0) SCALAR)
    (* (MELM MAT-TO-MUTATE 0 1) SCALAR) (* (MELM MAT-TO-MUTATE 1 0) SCALAR)
    (* (MELM MAT-TO-MUTATE 1 1) SCALAR) MAT-TO-MUTATE))

[rtg-math/matrices/matrix3/consing.lisp:8]
  (DEFN-INLINE 0! NIL MAT3 (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
   (MAKE-ARRAY 9 :ELEMENT-TYPE (ECLECTOR.READER:QUASIQUOTE SINGLE-FLOAT)
               :INITIAL-ELEMENT 0.0))

[rtg-math/matrices/matrix3/consing.lisp:14]
  (DEFN MAKE
   ((A SINGLE-FLOAT) (B SINGLE-FLOAT) (C SINGLE-FLOAT) (D SINGLE-FLOAT)
    (E SINGLE-FLOAT) (F SINGLE-FLOAT) (G SINGLE-FLOAT) (H SINGLE-FLOAT)
    (I SINGLE-FLOAT))
   MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE 0!))
   (#S(FORMGREP:SYMREF :NAME "SET-COMPONENTS" :QUALIFIER "M3-N") A B C D E F G
    H I (0!)))

[rtg-math/matrices/matrix3/consing.lisp:23]
  (DEFN-INLINE COPY-MAT3 ((MAT3 MAT3)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 1)))
   (LET ((RESULT (MAKE-ARRAY 9 :ELEMENT-TYPE 'SINGLE-FLOAT)))
     (DOTIMES (I 9) (SETF (AREF RESULT I) (AREF MAT3 I)))
     RESULT))

[rtg-math/matrices/matrix3/consing.lisp:32]
  (DEFN IDENTITY NIL MAT3 (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE 1.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 1.0))

[rtg-math/matrices/matrix3/consing.lisp:41]
  (DEFN FROM-ROWS ((ROW-1 VEC3) (ROW-2 VEC3) (ROW-3 VEC3)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE (X ROW-1) (Y ROW-1) (Z ROW-1) (X ROW-2) (Y ROW-2) (Z ROW-2) (X ROW-3)
    (Y ROW-3) (Z ROW-3)))

[rtg-math/matrices/matrix3/consing.lisp:49]
  (DEFN GET-ROWS ((MAT-A MAT3)) LIST
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LIST
    (#S(FORMGREP:SYMREF :NAME "MAKE" :QUALIFIER "V3") (MELM MAT-A 0 0)
     (MELM MAT-A 0 1) (MELM MAT-A 0 2))
    (#S(FORMGREP:SYMREF :NAME "MAKE" :QUALIFIER "V3") (MELM MAT-A 1 0)
     (MELM MAT-A 1 1) (MELM MAT-A 1 2))
    (#S(FORMGREP:SYMREF :NAME "MAKE" :QUALIFIER "V3") (MELM MAT-A 2 0)
     (MELM MAT-A 2 1) (MELM MAT-A 2 2))))

[rtg-math/matrices/matrix3/consing.lisp:63]
  (DEFN GET-ROW ((MAT-A MAT3) (ROW-NUM (INTEGER 0 3))) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (#S(FORMGREP:SYMREF :NAME "MAKE" :QUALIFIER "V3") (MELM MAT-A ROW-NUM 0)
    (MELM MAT-A ROW-NUM 1) (MELM MAT-A ROW-NUM 2)))

[rtg-math/matrices/matrix3/consing.lisp:71]
  (DEFN FROM-COLUMNS ((COL-1 VEC3) (COL-2 VEC3) (COL-3 VEC3)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE (X COL-1) (X COL-2) (X COL-3) (Y COL-1) (Y COL-2) (Y COL-3) (Z COL-1)
    (Z COL-2) (Z COL-3)))

[rtg-math/matrices/matrix3/consing.lisp:80]
  (DEFN GET-COLUMNS ((MAT-A MAT3)) LIST
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LIST (V! (MELM MAT-A 0 0) (MELM MAT-A 1 0) (MELM MAT-A 2 0))
         (V! (MELM MAT-A 0 1) (MELM MAT-A 1 1) (MELM MAT-A 2 1))
         (V! (MELM MAT-A 0 2) (MELM MAT-A 1 2) (MELM MAT-A 2 2))))

[rtg-math/matrices/matrix3/consing.lisp:94]
  (DEFN GET-COLUMN ((MAT-A MAT3) (COL-NUM (INTEGER 0 3))) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (#S(FORMGREP:SYMREF :NAME "MAKE" :QUALIFIER "V3") (MELM MAT-A 0 COL-NUM)
    (MELM MAT-A 1 COL-NUM) (MELM MAT-A 2 COL-NUM)))

[rtg-math/matrices/matrix3/consing.lisp:102]
  (DEFN |0P| ((MAT-A MAT3)) BOOLEAN
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LOOP :FOR I :BELOW 9
         :ALWAYS (= 0.0 (AREF MAT-A I))))

[rtg-math/matrices/matrix3/consing.lisp:108]
  (DEFN IDENTITYP ((MAT-A MAT3)) BOOLEAN
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (AND (= 0.0 (- (MELM MAT-A 0 0) 1.0)) (= 0.0 (- (MELM MAT-A 1 1) 1.0))
        (= 0.0 (- (MELM MAT-A 2 2) 1.0)) (= 0.0 (MELM MAT-A 0 1))
        (= 0.0 (MELM MAT-A 0 2)) (= 0.0 (MELM MAT-A 1 0))
        (= 0.0 (MELM MAT-A 1 2)) (= 0.0 (MELM MAT-A 2 0))
        (= 0.0 (MELM MAT-A 2 1))))

[rtg-math/matrices/matrix3/consing.lisp:122]
  (DEFN = ((MAT-A MAT3) (MAT-B MAT3)) BOOLEAN
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (AND (= (AREF MAT-A 0) (AREF MAT-B 0)) (= (AREF MAT-A 1) (AREF MAT-B 1))
        (= (AREF MAT-A 2) (AREF MAT-B 2)) (= (AREF MAT-A 3) (AREF MAT-B 3))
        (= (AREF MAT-A 4) (AREF MAT-B 4)) (= (AREF MAT-A 5) (AREF MAT-B 5))
        (= (AREF MAT-A 6) (AREF MAT-B 6)) (= (AREF MAT-A 7) (AREF MAT-B 7))
        (= (AREF MAT-A 8) (AREF MAT-B 8))))

[rtg-math/matrices/matrix3/consing.lisp:136]
  (DEFN DETERMINANT ((MAT-A MAT3)) SINGLE-FLOAT
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET* ((COFACTOR-0
           (- (* (MELM MAT-A 1 1) (MELM MAT-A 2 2))
              (* (MELM MAT-A 2 1) (MELM MAT-A 1 2))))
          (COFACTOR-3
           (- (* (MELM MAT-A 2 0) (MELM MAT-A 1 2))
              (* (MELM MAT-A 1 0) (MELM MAT-A 2 2))))
          (COFACTOR-6
           (- (* (MELM MAT-A 1 0) (MELM MAT-A 2 1))
              (* (MELM MAT-A 2 0) (MELM MAT-A 1 1)))))
     (+ (* (MELM MAT-A 0 0) COFACTOR-0) (* (MELM MAT-A 0 1) COFACTOR-3)
        (* (MELM MAT-A 0 2) COFACTOR-6))))

[rtg-math/matrices/matrix3/consing.lisp:152]
  (DEFN AFFINE-INVERSE ((MAT-A MAT3)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE COPY-MAT3))
   (#S(FORMGREP:SYMREF :NAME "AFFINE-INVERSE" :QUALIFIER "M3-N")
    (COPY-MAT3 MAT-A)))

[rtg-math/matrices/matrix3/consing.lisp:159]
  (DEFN TRANSPOSE ((MAT-A MAT3)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE COPY-MAT3))
   (#S(FORMGREP:SYMREF :NAME "TRANSPOSE" :QUALIFIER "M3-N") (COPY-MAT3 MAT-A)))

[rtg-math/matrices/matrix3/consing.lisp:166]
  (DEFN ADJOINT ((MAT-A MAT3)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE COPY-MAT3))
   (#S(FORMGREP:SYMREF :NAME "ADJOINT" :QUALIFIER "M3-N") (COPY-MAT3 MAT-A)))

[rtg-math/matrices/matrix3/consing.lisp:173]
  (DEFN TRACE ((MAT-A MAT3)) SINGLE-FLOAT
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (+ (MELM MAT-A 0 0) (MELM MAT-A 1 1) (MELM MAT-A 2 2)))

[rtg-math/matrices/matrix3/consing.lisp:183]
  (DEFN ROTATION-FROM-EULER ((VEC3-A VEC3)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE 0!))
   (#S(FORMGREP:SYMREF :NAME "SET-ROTATION-FROM-EULER" :QUALIFIER "M3-N") (0!)
    VEC3-A))

[rtg-math/matrices/matrix3/consing.lisp:190]
  (DEFN SCALE ((SCALE-VEC3 VEC3)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE 0!))
   (#S(FORMGREP:SYMREF :NAME "SET-FROM-SCALE" :QUALIFIER "M3-N") (0!)
    SCALE-VEC3))

[rtg-math/matrices/matrix3/consing.lisp:197]
  (DEFN ROTATION-X ((ANGLE SINGLE-FLOAT)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE 0!))
   (#S(FORMGREP:SYMREF :NAME "SET-FROM-ROTATION-X" :QUALIFIER "M3-N") (0!)
    ANGLE))

[rtg-math/matrices/matrix3/consing.lisp:204]
  (DEFN ROTATION-Y ((ANGLE SINGLE-FLOAT)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE 0!))
   (#S(FORMGREP:SYMREF :NAME "SET-FROM-ROTATION-Y" :QUALIFIER "M3-N") (0!)
    ANGLE))

[rtg-math/matrices/matrix3/consing.lisp:211]
  (DEFN ROTATION-Z ((ANGLE SINGLE-FLOAT)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE 0!))
   (#S(FORMGREP:SYMREF :NAME "SET-FROM-ROTATION-Z" :QUALIFIER "M3-N") (0!)
    ANGLE))

[rtg-math/matrices/matrix3/consing.lisp:218]
  (DEFN ROTATION-FROM-AXIS-ANGLE ((AXIS3 VEC3) (ANGLE SINGLE-FLOAT)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE 0!))
   (#S(FORMGREP:SYMREF :NAME "SET-ROTATION-FROM-AXIS-ANGLE" :QUALIFIER "M3-N")
    (0!) AXIS3 ANGLE))

[rtg-math/matrices/matrix3/consing.lisp:225]
  (DEFN GET-FIXED-ANGLES ((MAT-A MAT3)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET* ((SY (MELM MAT-A 0 2)))
     (DECLARE ((SINGLE-FLOAT -1.0 1.0) SY))
     (LET ((CY (SQRT (- 1.0 (* SY SY)))))
       (DECLARE (SINGLE-FLOAT CY))
       (IF (NOT (= 0.0 CY))
           (LET* ((FACTOR (/ 1.0 CY))
                  (SX (* FACTOR (- (MELM MAT-A 2 1))))
                  (CX (* FACTOR (MELM MAT-A 2 2)))
                  (SZ (* FACTOR (- (MELM MAT-A 1 0))))
                  (CZ (* FACTOR (MELM MAT-A 0 0))))
             (#S(FORMGREP:SYMREF :NAME "MAKE" :QUALIFIER "V3") (ATAN SX CX)
              (ATAN SY CY) (ATAN SZ CZ)))
           (LET* ((SZ 0.0) (CX 1.0) (SX (MELM MAT-A 1 2)) (CZ (MELM MAT-A 1 1)))
             (#S(FORMGREP:SYMREF :NAME "MAKE" :QUALIFIER "V3") (ATAN SX CX)
              (ATAN SY CY) (ATAN SZ CZ)))))))

[rtg-math/matrices/matrix3/consing.lisp:248]
  (DEFN GET-AXIS-ANGLE ((MAT-A MAT3)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET* ((C-A (* 0.5 (- (TRACE MAT-A) 1.0))))
     (DECLARE (TYPE (SINGLE-FLOAT -1.0 1.0) C-A))
     (LET ((ANGLE (ACOS C-A)))
       (COND ((= 0.0 ANGLE) (V! 1.0 0.0 0.0))
             ((< ANGLE
                 #S(FORMGREP:SYMREF
                    :NAME "+PI+"
                    :QUALIFIER "RTG-MATH.BASE-MATHS"))
              (LET ((AXIS
                     (V! (- (MELM MAT-A 1 2) (MELM MAT-A 2 1))
                      (- (MELM MAT-A 2 0) (MELM MAT-A 0 2))
                      (- (MELM MAT-A 0 1) (MELM MAT-A 1 0)))))
                (#S(FORMGREP:SYMREF :NAME "NORMALIZE" :QUALIFIER "V3-N")
                 AXIS)))
             (T
              (LET* ((I
                      (IF (> (MELM MAT-A 1 1) (MELM MAT-A 0 0))
                          1
                          (IF (> (MELM MAT-A 2 2) (MELM MAT-A 0 0))
                              2
                              0)))
                     (J (MOD (+ I 1) 3))
                     (K (MOD (+ J 1) 3))
                     (TMP-S
                      (+ 1.0
                         (- (MELM MAT-A I I) (MELM MAT-A J J)
                            (MELM MAT-A K K))))
                     (S (SQRT (THE (SINGLE-FLOAT 0.0 NIL) TMP-S)))
                     (RECIP (/ 1.0 S))
                     (RESULT (V! 0.0 0.0 0.0)))
                (SETF (AREF RESULT I) (* 0.5 S))
                (SETF (AREF RESULT J) (* RECIP (MELM MAT-A I J)))
                (SETF (AREF RESULT J) (* RECIP (MELM MAT-A K I)))
                RESULT))))))

[rtg-math/matrices/matrix3/consing.lisp:283]
  (DEFN + ((MAT-A MAT3) (MAT-B MAT3)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE 0!))
   (LET ((R (0!)))
     (DECLARE (MAT3 R))
     (LOOP :FOR I :BELOW 9
           :DO (SETF (AREF R I) (+ (AREF MAT-A I) (AREF MAT-B I))))
     R))

[rtg-math/matrices/matrix3/consing.lisp:294]
  (DEFN - ((MAT-A MAT3) (MAT-B MAT3)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE 0!))
   (LET ((R (0!)))
     (DECLARE (MAT3 R))
     (LOOP :FOR I :BELOW 9
           :DO (SETF (AREF R I) (- (AREF MAT-A I) (AREF MAT-B I))))
     R))

[rtg-math/matrices/matrix3/consing.lisp:305]
  (DEFN NEGATE ((MAT-A MAT3)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE COPY-MAT3))
   (#S(FORMGREP:SYMREF :NAME "NEGATE" :QUALIFIER "M3-N") (COPY-MAT3 MAT-A)))

[rtg-math/matrices/matrix3/consing.lisp:312]
  (DEFN *V ((MAT-A MAT3) (VEC-A VEC3)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (#S(FORMGREP:SYMREF :NAME "*V" :QUALIFIER "M3-N") MAT-A
    (#S(FORMGREP:SYMREF :NAME "COPY-VEC3" :QUALIFIER "V3") VEC-A)))

[rtg-math/matrices/matrix3/consing.lisp:318]
  (DEFN MROW*VEC3 ((VEC VEC3) (MAT-A MAT3)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (#S(FORMGREP:SYMREF :NAME "MROW*VEC3" :QUALIFIER "M3-N")
    (#S(FORMGREP:SYMREF :NAME "COPY-VEC3" :QUALIFIER "V3") VEC) MAT-A))

[rtg-math/matrices/matrix3/consing.lisp:324]
  (DEFN %* ((MAT-A MAT3) (MAT-B MAT3)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE
    (+ (* (MELM MAT-A 0 0) (MELM MAT-B 0 0))
       (* (MELM MAT-A 0 1) (MELM MAT-B 1 0))
       (* (MELM MAT-A 0 2) (MELM MAT-B 2 0)))
    (+ (* (MELM MAT-A 0 0) (MELM MAT-B 0 1))
       (* (MELM MAT-A 0 1) (MELM MAT-B 1 1))
       (* (MELM MAT-A 0 2) (MELM MAT-B 2 1)))
    (+ (* (MELM MAT-A 0 0) (MELM MAT-B 0 2))
       (* (MELM MAT-A 0 1) (MELM MAT-B 1 2))
       (* (MELM MAT-A 0 2) (MELM MAT-B 2 2)))
    (+ (* (MELM MAT-A 1 0) (MELM MAT-B 0 0))
       (* (MELM MAT-A 1 1) (MELM MAT-B 1 0))
       (* (MELM MAT-A 1 2) (MELM MAT-B 2 0)))
    (+ (* (MELM MAT-A 1 0) (MELM MAT-B 0 1))
       (* (MELM MAT-A 1 1) (MELM MAT-B 1 1))
       (* (MELM MAT-A 1 2) (MELM MAT-B 2 1)))
    (+ (* (MELM MAT-A 1 0) (MELM MAT-B 0 2))
       (* (MELM MAT-A 1 1) (MELM MAT-B 1 2))
       (* (MELM MAT-A 1 2) (MELM MAT-B 2 2)))
    (+ (* (MELM MAT-A 2 0) (MELM MAT-B 0 0))
       (* (MELM MAT-A 2 1) (MELM MAT-B 1 0))
       (* (MELM MAT-A 2 2) (MELM MAT-B 2 0)))
    (+ (* (MELM MAT-A 2 0) (MELM MAT-B 0 1))
       (* (MELM MAT-A 2 1) (MELM MAT-B 1 1))
       (* (MELM MAT-A 2 2) (MELM MAT-B 2 1)))
    (+ (* (MELM MAT-A 2 0) (MELM MAT-B 0 2))
       (* (MELM MAT-A 2 1) (MELM MAT-B 1 2))
       (* (MELM MAT-A 2 2) (MELM MAT-B 2 2)))))

[rtg-math/matrices/matrix3/consing.lisp:354]
  (DEFN * (&REST (MATRICES MAT3)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (IF MATRICES
       (REDUCE #'#S(FORMGREP:SYMREF :NAME "%*" :QUALIFIER "M3-N") MATRICES
               :INITIAL-VALUE (IDENTITY))
       (IDENTITY)))

[rtg-math/matrices/matrix3/consing.lisp:369]
  (DEFN *S ((MAT-A MAT3) (SCALAR SINGLE-FLOAT)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE COPY-MAT3))
   (#S(FORMGREP:SYMREF :NAME "*S" :QUALIFIER "M3-N") (COPY-MAT3 MAT-A) SCALAR))

[rtg-math/matrices/matrix3/consing.lisp:377]
  (DEFN-INLINE FROM-DIRECTION ((UP3 VEC3) (DIR3 VEC3)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET* ((ZAXIS (#S(FORMGREP:SYMREF :NAME "NORMALIZE" :QUALIFIER "V3") DIR3))
          (XAXIS
           (#S(FORMGREP:SYMREF :NAME "NORMALIZE" :QUALIFIER "V3-N")
            (#S(FORMGREP:SYMREF :NAME "CROSS" :QUALIFIER "V3") ZAXIS UP3)))
          (YAXIS
           (#S(FORMGREP:SYMREF :NAME "CROSS" :QUALIFIER "V3") XAXIS ZAXIS)))
     (#S(FORMGREP:SYMREF :NAME "MAKE" :QUALIFIER "M3") (X XAXIS) (X YAXIS)
      (- (X ZAXIS)) (Y XAXIS) (Y YAXIS) (- (Y ZAXIS)) (Z XAXIS) (Z YAXIS)
      (- (Z ZAXIS)))))

[rtg-math/matrices/matrix3/consing.lisp:389]
  (DEFN POINT-AT ((UP VEC3) (FROM3 VEC3) (TO3 VEC3)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE FROM-DIRECTION))
   (FROM-DIRECTION UP
    (#S(FORMGREP:SYMREF :NAME "-" :QUALIFIER "V3") TO3 FROM3)))

[rtg-math/matrices/matrix3/consing.lisp:397]
  (DEFN-INLINE LOOK-AT ((UP3 VEC3) (FROM3 VEC3) (TO3 VEC3)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET* ((ZAXIS
           (#S(FORMGREP:SYMREF :NAME "NORMALIZE" :QUALIFIER "V3-N")
            (#S(FORMGREP:SYMREF :NAME "-" :QUALIFIER "V3") TO3 FROM3)))
          (XAXIS
           (#S(FORMGREP:SYMREF :NAME "NORMALIZE" :QUALIFIER "V3-N")
            (#S(FORMGREP:SYMREF :NAME "CROSS" :QUALIFIER "V3") ZAXIS UP3)))
          (YAXIS
           (#S(FORMGREP:SYMREF :NAME "CROSS" :QUALIFIER "V3") XAXIS ZAXIS)))
     (#S(FORMGREP:SYMREF :NAME "MAKE" :QUALIFIER "M3") (X XAXIS) (Y XAXIS)
      (Z XAXIS) (X YAXIS) (Y YAXIS) (Z YAXIS) (- (X ZAXIS)) (- (Y ZAXIS))
      (- (Z ZAXIS)))))

[rtg-math/matrices/matrix3/non-consing.lisp:5]
  (DEFN-INLINE SET-COMPONENTS
   ((C00 SINGLE-FLOAT) (C01 SINGLE-FLOAT) (C02 SINGLE-FLOAT) (C10 SINGLE-FLOAT)
    (C11 SINGLE-FLOAT) (C12 SINGLE-FLOAT) (C20 SINGLE-FLOAT) (C21 SINGLE-FLOAT)
    (C22 SINGLE-FLOAT) (MAT3-TO-MUTATE MAT3))
   MAT3 (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SETF (MELM MAT3-TO-MUTATE 0 0) C00) (SETF (MELM MAT3-TO-MUTATE 0 1) C01)
   (SETF (MELM MAT3-TO-MUTATE 0 2) C02) (SETF (MELM MAT3-TO-MUTATE 1 0) C10)
   (SETF (MELM MAT3-TO-MUTATE 1 1) C11) (SETF (MELM MAT3-TO-MUTATE 1 2) C12)
   (SETF (MELM MAT3-TO-MUTATE 2 0) C20) (SETF (MELM MAT3-TO-MUTATE 2 1) C21)
   (SETF (MELM MAT3-TO-MUTATE 2 2) C22) MAT3-TO-MUTATE)

[rtg-math/matrices/matrix3/non-consing.lisp:23]
  (DEFN-INLINE COPY-COMPONENTS ((MAT MAT3) (COPY-FROM MAT3)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SETF (MELM MAT 0 0) (MELM COPY-FROM 0 0))
   (SETF (MELM MAT 0 1) (MELM COPY-FROM 0 1))
   (SETF (MELM MAT 0 2) (MELM COPY-FROM 0 2))
   (SETF (MELM MAT 1 0) (MELM COPY-FROM 1 0))
   (SETF (MELM MAT 1 1) (MELM COPY-FROM 1 1))
   (SETF (MELM MAT 1 2) (MELM COPY-FROM 1 2))
   (SETF (MELM MAT 2 0) (MELM COPY-FROM 2 0))
   (SETF (MELM MAT 2 1) (MELM COPY-FROM 2 1))
   (SETF (MELM MAT 2 2) (MELM COPY-FROM 2 2)) MAT)

[rtg-math/matrices/matrix3/non-consing.lisp:38]
  (DEFN %* ((MAT-ACCUM MAT3) (TO-MULTIPLY-MAT MAT3)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((MAT-A MAT-ACCUM) (MAT-B TO-MULTIPLY-MAT))
     (SET-COMPONENTS
      (+ (* (MELM MAT-A 0 0) (MELM MAT-B 0 0))
         (* (MELM MAT-A 0 1) (MELM MAT-B 1 0))
         (* (MELM MAT-A 0 2) (MELM MAT-B 2 0)))
      (+ (* (MELM MAT-A 0 0) (MELM MAT-B 0 1))
         (* (MELM MAT-A 0 1) (MELM MAT-B 1 1))
         (* (MELM MAT-A 0 2) (MELM MAT-B 2 1)))
      (+ (* (MELM MAT-A 0 0) (MELM MAT-B 0 2))
         (* (MELM MAT-A 0 1) (MELM MAT-B 1 2))
         (* (MELM MAT-A 0 2) (MELM MAT-B 2 2)))
      (+ (* (MELM MAT-A 1 0) (MELM MAT-B 0 0))
         (* (MELM MAT-A 1 1) (MELM MAT-B 1 0))
         (* (MELM MAT-A 1 2) (MELM MAT-B 2 0)))
      (+ (* (MELM MAT-A 1 0) (MELM MAT-B 0 1))
         (* (MELM MAT-A 1 1) (MELM MAT-B 1 1))
         (* (MELM MAT-A 1 2) (MELM MAT-B 2 1)))
      (+ (* (MELM MAT-A 1 0) (MELM MAT-B 0 2))
         (* (MELM MAT-A 1 1) (MELM MAT-B 1 2))
         (* (MELM MAT-A 1 2) (MELM MAT-B 2 2)))
      (+ (* (MELM MAT-A 2 0) (MELM MAT-B 0 0))
         (* (MELM MAT-A 2 1) (MELM MAT-B 1 0))
         (* (MELM MAT-A 2 2) (MELM MAT-B 2 0)))
      (+ (* (MELM MAT-A 2 0) (MELM MAT-B 0 1))
         (* (MELM MAT-A 2 1) (MELM MAT-B 1 1))
         (* (MELM MAT-A 2 2) (MELM MAT-B 2 1)))
      (+ (* (MELM MAT-A 2 0) (MELM MAT-B 0 2))
         (* (MELM MAT-A 2 1) (MELM MAT-B 1 2))
         (* (MELM MAT-A 2 2) (MELM MAT-B 2 2)))
      MAT-ACCUM)))

[rtg-math/matrices/matrix3/non-consing.lisp:84]
  (DEFN SET-FROM-ROWS
   ((MAT-TO-MUTATE MAT3) (ROW-1 VEC3) (ROW-2 VEC3) (ROW-3 VEC3)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SET-COMPONENTS (X ROW-1) (Y ROW-1) (Z ROW-1) (X ROW-2) (Y ROW-2) (Z ROW-2)
    (X ROW-3) (Y ROW-3) (Z ROW-3) MAT-TO-MUTATE))

[rtg-math/matrices/matrix3/non-consing.lisp:94]
  (DEFN SET-FROM-COLUMNS
   ((MAT-TO-MUTATE MAT3) (COL-1 VEC3) (COL-2 VEC3) (COL-3 VEC3)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SET-COMPONENTS (X COL-1) (X COL-2) (X COL-3) (Y COL-1) (Y COL-2) (Y COL-3)
    (Z COL-1) (Z COL-2) (Z COL-3) MAT-TO-MUTATE))

[rtg-math/matrices/matrix3/non-consing.lisp:104]
  (DEFN AFFINE-INVERSE ((MAT-TO-INVERT MAT3)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET* ((COFACTOR-0
           (- (* (MELM MAT-TO-INVERT 1 1) (MELM MAT-TO-INVERT 2 2))
              (* (MELM MAT-TO-INVERT 2 1) (MELM MAT-TO-INVERT 1 2))))
          (COFACTOR-3
           (- (* (MELM MAT-TO-INVERT 2 0) (MELM MAT-TO-INVERT 1 2))
              (* (MELM MAT-TO-INVERT 1 0) (MELM MAT-TO-INVERT 2 2))))
          (COFACTOR-6
           (- (* (MELM MAT-TO-INVERT 1 0) (MELM MAT-TO-INVERT 2 1))
              (* (MELM MAT-TO-INVERT 2 0) (MELM MAT-TO-INVERT 1 1))))
          (DET
           (+ (* (MELM MAT-TO-INVERT 0 0) COFACTOR-0)
              (* (MELM MAT-TO-INVERT 0 1) COFACTOR-3)
              (* (MELM MAT-TO-INVERT 0 2) COFACTOR-6))))
     (IF (= 0.0 DET)
         (ERROR "Matrix4 Inverse: Singular Matrix")
         (LET* ((INV-DET (/ 1.0 DET))
                (R00 (* INV-DET COFACTOR-0))
                (R10 (* INV-DET COFACTOR-3))
                (R20 (* INV-DET COFACTOR-6))
                (R01
                 (* INV-DET
                    (- (* (MELM MAT-TO-INVERT 2 1) (MELM MAT-TO-INVERT 0 2))
                       (* (MELM MAT-TO-INVERT 0 1) (MELM MAT-TO-INVERT 2 2)))))
                (R11
                 (* INV-DET
                    (- (* (MELM MAT-TO-INVERT 0 0) (MELM MAT-TO-INVERT 2 2))
                       (* (MELM MAT-TO-INVERT 2 0) (MELM MAT-TO-INVERT 0 2)))))
                (R21
                 (* INV-DET
                    (- (* (MELM MAT-TO-INVERT 2 0) (MELM MAT-TO-INVERT 0 1))
                       (* (MELM MAT-TO-INVERT 0 0) (MELM MAT-TO-INVERT 2 1)))))
                (R02
                 (* INV-DET
                    (- (* (MELM MAT-TO-INVERT 0 1) (MELM MAT-TO-INVERT 1 2))
                       (* (MELM MAT-TO-INVERT 1 1) (MELM MAT-TO-INVERT 0 2)))))
                (R12
                 (* INV-DET
                    (- (* (MELM MAT-TO-INVERT 1 0) (MELM MAT-TO-INVERT 0 2))
                       (* (MELM MAT-TO-INVERT 0 0) (MELM MAT-TO-INVERT 1 2)))))
                (R22
                 (* INV-DET
                    (- (* (MELM MAT-TO-INVERT 0 0) (MELM MAT-TO-INVERT 1 1))
                       (* (MELM MAT-TO-INVERT 1 0) (MELM MAT-TO-INVERT 0 1))))))
           (SET-COMPONENTS R00 R01 R02 R10 R11 R12 R20 R21 R22
            MAT-TO-INVERT)))))

[rtg-math/matrices/matrix3/non-consing.lisp:143]
  (DEFN TRANSPOSE ((MAT-TO-TRANSPOSE MAT3)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SET-COMPONENTS (MELM MAT-TO-TRANSPOSE 0 0) (MELM MAT-TO-TRANSPOSE 1 0)
    (MELM MAT-TO-TRANSPOSE 2 0) (MELM MAT-TO-TRANSPOSE 0 1)
    (MELM MAT-TO-TRANSPOSE 1 1) (MELM MAT-TO-TRANSPOSE 2 1)
    (MELM MAT-TO-TRANSPOSE 0 2) (MELM MAT-TO-TRANSPOSE 1 2)
    (MELM MAT-TO-TRANSPOSE 2 2) MAT-TO-TRANSPOSE))

[rtg-math/matrices/matrix3/non-consing.lisp:153]
  (DEFN ADJOINT ((MAT-TO-MUTATE MAT3)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SET-COMPONENTS
    (- (* (MELM MAT-TO-MUTATE 1 1) (MELM MAT-TO-MUTATE 2 2))
       (* (MELM MAT-TO-MUTATE 1 2) (MELM MAT-TO-MUTATE 2 1)))
    (- (* (MELM MAT-TO-MUTATE 0 2) (MELM MAT-TO-MUTATE 2 1))
       (* (MELM MAT-TO-MUTATE 0 1) (MELM MAT-TO-MUTATE 2 2)))
    (- (* (MELM MAT-TO-MUTATE 0 1) (MELM MAT-TO-MUTATE 1 2))
       (* (MELM MAT-TO-MUTATE 0 2) (MELM MAT-TO-MUTATE 1 1)))
    (- (* (MELM MAT-TO-MUTATE 1 2) (MELM MAT-TO-MUTATE 2 0))
       (* (MELM MAT-TO-MUTATE 1 0) (MELM MAT-TO-MUTATE 2 2)))
    (- (* (MELM MAT-TO-MUTATE 0 0) (MELM MAT-TO-MUTATE 2 2))
       (* (MELM MAT-TO-MUTATE 0 2) (MELM MAT-TO-MUTATE 2 0)))
    (- (* (MELM MAT-TO-MUTATE 0 2) (MELM MAT-TO-MUTATE 1 0))
       (* (MELM MAT-TO-MUTATE 0 0) (MELM MAT-TO-MUTATE 1 2)))
    (- (* (MELM MAT-TO-MUTATE 1 0) (MELM MAT-TO-MUTATE 2 1))
       (* (MELM MAT-TO-MUTATE 1 1) (MELM MAT-TO-MUTATE 2 0)))
    (- (* (MELM MAT-TO-MUTATE 0 1) (MELM MAT-TO-MUTATE 2 0))
       (* (MELM MAT-TO-MUTATE 0 0) (MELM MAT-TO-MUTATE 2 1)))
    (- (* (MELM MAT-TO-MUTATE 0 0) (MELM MAT-TO-MUTATE 1 1))
       (* (MELM MAT-TO-MUTATE 0 1) (MELM MAT-TO-MUTATE 1 0)))
    MAT-TO-MUTATE))

[rtg-math/matrices/matrix3/non-consing.lisp:178]
  (DEFN SET-ROTATION-FROM-EULER ((MAT-TO-MUTATE MAT3) (VEC3-A VEC3)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((X (X VEC3-A)) (Y (Y VEC3-A)) (Z (Z VEC3-A)))
     (LET ((SX (SIN X))
           (CX (COS X))
           (SY (SIN Y))
           (CY (COS Y))
           (SZ (SIN Z))
           (CZ (COS Z)))
       (SET-COMPONENTS (* CY CZ) (- (* CY SZ)) SY (+ (* SX SY CZ) (* CX SZ))
        (+ (- (* SX SX SZ)) (* CX CZ)) (- (* SX CY))
        (+ (- (* CX SY CZ)) (* SX SZ)) (+ (* CX SY SZ) (* SX CZ)) (* CX CY)
        MAT-TO-MUTATE))))

[rtg-math/matrices/matrix3/non-consing.lisp:199]
  (DEFN SET-FROM-SCALE ((MAT-TO-MUTATE MAT3) (SCALE-VEC3 VEC3)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SET-COMPONENTS (X SCALE-VEC3) 0.0 0.0 0.0 (Y SCALE-VEC3) 0.0 0.0 0.0
    (Z SCALE-VEC3) MAT-TO-MUTATE))

[rtg-math/matrices/matrix3/non-consing.lisp:208]
  (DEFN SET-FROM-ROTATION-X ((MAT-TO-MUTATE MAT3) (ANGLE SINGLE-FLOAT)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((S-A (SIN ANGLE)) (C-A (COS ANGLE)))
     (SET-COMPONENTS 1.0 0.0 0.0 0.0 C-A (- S-A) 0.0 S-A C-A MAT-TO-MUTATE)))

[rtg-math/matrices/matrix3/non-consing.lisp:219]
  (DEFN SET-FROM-ROTATION-Y ((MAT-TO-MUTATE MAT3) (ANGLE SINGLE-FLOAT)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((S-A (SIN ANGLE)) (C-A (COS ANGLE)))
     (SET-COMPONENTS C-A 0.0 S-A 0.0 1.0 0.0 (- S-A) 0.0 C-A MAT-TO-MUTATE)))

[rtg-math/matrices/matrix3/non-consing.lisp:230]
  (DEFN SET-FROM-ROTATION-Z ((MAT-TO-MUTATE MAT3) (ANGLE SINGLE-FLOAT)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((S-A (SIN ANGLE)) (C-A (COS ANGLE)))
     (SET-COMPONENTS C-A (- S-A) 0.0 S-A C-A 0.0 0.0 0.0 1.0 MAT-TO-MUTATE)))

[rtg-math/matrices/matrix3/non-consing.lisp:241]
  (DEFN SET-ROTATION-FROM-AXIS-ANGLE
   ((MAT-TO-MUTATE MAT3) (AXIS3 VEC3) (ANGLE SINGLE-FLOAT)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (COND
    ((#S(FORMGREP:SYMREF :NAME "=" :QUALIFIER "V3") AXIS3 (V! 1.0 0.0 0.0))
     (SET-FROM-ROTATION-X MAT-TO-MUTATE ANGLE))
    ((#S(FORMGREP:SYMREF :NAME "=" :QUALIFIER "V3") AXIS3 (V! 0.0 1.0 0.0))
     (SET-FROM-ROTATION-Y MAT-TO-MUTATE ANGLE))
    ((#S(FORMGREP:SYMREF :NAME "=" :QUALIFIER "V3") AXIS3 (V! 0.0 0.0 1.0))
     (SET-FROM-ROTATION-Z MAT-TO-MUTATE ANGLE))
    (T
     (LET ((C (COS ANGLE)) (S (SIN ANGLE)) (G (- 1.0 (COS ANGLE))))
       (LET* ((X (X AXIS3))
              (Y (Y AXIS3))
              (Z (Z AXIS3))
              (GXX (* G X X))
              (GXY (* G X Y))
              (GXZ (* G X Z))
              (GYY (* G Y Y))
              (GYZ (* G Y Z))
              (GZZ (* G Z Z)))
         (SET-COMPONENTS (+ GXX C) (- GXY (* S Z)) (+ GXZ (* S Y))
          (+ GXY (* S Z)) (+ GYY C) (- GYZ (* S X)) (- GXZ (* S Y))
          (+ GYZ (* S X)) (+ GZZ C) MAT-TO-MUTATE))))))

[rtg-math/matrices/matrix3/non-consing.lisp:267]
  (DEFN + ((MAT-ACCUM MAT3) (MAT-B MAT3)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LOOP :FOR I :BELOW 9
         :DO (INCF (AREF MAT-ACCUM I) (AREF MAT-B I)))
   MAT-ACCUM)

[rtg-math/matrices/matrix3/non-consing.lisp:275]
  (DEFN - ((MAT-ACCUM MAT3) (MAT-B MAT3)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LOOP :FOR I :BELOW 9
         :DO (DECF (AREF MAT-ACCUM I) (AREF MAT-B I)))
   MAT-ACCUM)

[rtg-math/matrices/matrix3/non-consing.lisp:283]
  (DEFN NEGATE ((MAT-TO-NEGATE MAT3)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LOOP :FOR I :BELOW 9
         :DO (SETF (AREF MAT-TO-NEGATE I) (- (AREF MAT-TO-NEGATE I))))
   MAT-TO-NEGATE)

[rtg-math/matrices/matrix3/non-consing.lisp:291]
  (DEFN *V ((MAT-A MAT3) (VEC3-TO-MUTATE VEC3)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (#S(FORMGREP:SYMREF :NAME "SET-COMPONENTS" :QUALIFIER "V3-N")
    (+ (* (X VEC3-TO-MUTATE) (MELM MAT-A 0 0))
       (* (Y VEC3-TO-MUTATE) (MELM MAT-A 0 1))
       (* (Z VEC3-TO-MUTATE) (MELM MAT-A 0 2)))
    (+ (* (X VEC3-TO-MUTATE) (MELM MAT-A 1 0))
       (* (Y VEC3-TO-MUTATE) (MELM MAT-A 1 1))
       (* (Z VEC3-TO-MUTATE) (MELM MAT-A 1 2)))
    (+ (* (X VEC3-TO-MUTATE) (MELM MAT-A 2 0))
       (* (Y VEC3-TO-MUTATE) (MELM MAT-A 2 1))
       (* (Z VEC3-TO-MUTATE) (MELM MAT-A 2 2)))
    VEC3-TO-MUTATE))

[rtg-math/matrices/matrix3/non-consing.lisp:306]
  (DEFN MROW*VEC3 ((VEC3-TO-MUTATE VEC3) (MAT-A MAT3)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (#S(FORMGREP:SYMREF :NAME "SET-COMPONENTS" :QUALIFIER "V3-N")
    (+ (* (X VEC3-TO-MUTATE) (MELM MAT-A 0 0))
       (* (Y VEC3-TO-MUTATE) (MELM MAT-A 1 0))
       (* (Z VEC3-TO-MUTATE) (MELM MAT-A 2 0)))
    (+ (* (X VEC3-TO-MUTATE) (MELM MAT-A 0 1))
       (* (Y VEC3-TO-MUTATE) (MELM MAT-A 1 1))
       (* (Z VEC3-TO-MUTATE) (MELM MAT-A 2 1)))
    (+ (* (X VEC3-TO-MUTATE) (MELM MAT-A 0 2))
       (* (Y VEC3-TO-MUTATE) (MELM MAT-A 1 2))
       (* (Z VEC3-TO-MUTATE) (MELM MAT-A 2 2)))
    VEC3-TO-MUTATE))

[rtg-math/matrices/matrix3/non-consing.lisp:323]
  (DEFN *S ((MAT-TO-MUTATE MAT3) (SCALAR SINGLE-FLOAT)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LOOP :FOR I :BELOW 9
         :DO (SETF (AREF MAT-TO-MUTATE I) (* SCALAR (AREF MAT-TO-MUTATE I))))
   MAT-TO-MUTATE)

[rtg-math/matrices/matrix4/common.lisp:5]
  (DEFN MELM ((MAT-A MAT4) (ROW (INTEGER 0 3)) (COL (INTEGER 0 3)))
   SINGLE-FLOAT "Provides access to data in the matrix by row
   and column number. The actual data is stored in a 1d list in
   column major order, but this abstraction means we only have
   to think in row major order which is how most mathematical
   texts and online tutorials choose to show matrices"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (AREF MAT-A (+ ROW (* COL 4))))

[rtg-math/matrices/matrix4/common.lisp:14]
  (DEFN (SETF MELM)
   ((VALUE SINGLE-FLOAT) (MAT-A MAT4) (ROW (INTEGER 0 3)) (COL (INTEGER 0 3)))
   SINGLE-FLOAT "Provides access to data in the matrix by row
   and column number. The actual data is stored in a 1d list in
   column major order, but this abstraction means we only have
   to think in row major order which is how most mathematical
   texts and online tutorials choose to show matrices"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SETF (AREF MAT-A (+ ROW (* COL 4))) VALUE))

[rtg-math/matrices/matrix4/common.lisp:40]
  (DEFN-INLINE MREF ((MAT-A MAT4) (COL (INTEGER 0 3)) (ROW (INTEGER 0 3)))
   SINGLE-FLOAT "Provides access to data in the matrix by row
   and column number. The actual data is stored in a 1d list in
   column major order, but this abstraction means we only have
   to think in row major order which is how most mathematical
   texts and online tutorials choose to show matrices"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (DECLARE (MAT4 MAT-A)
            (TYPE (INTEGER 0 3) ROW COL))
   (AREF MAT-A (+ ROW (* COL 4))))

[rtg-math/matrices/matrix4/common.lisp:54]
  (DEFN-INLINE (SETF MREF)
   ((VALUE SINGLE-FLOAT) (MAT-A MAT4) (COL (INTEGER 0 3)) (ROW (INTEGER 0 3)))
   SINGLE-FLOAT "Provides access to data in the matrix by row
   and column number. The actual data is stored in a 1d list in
   column major order, but this abstraction means we only have
   to think in row major order which is how most mathematical
   texts and online tutorials choose to show matrices"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SETF (AREF MAT-A (+ ROW (* COL 4))) VALUE))

[rtg-math/matrices/matrix4/common.lisp:84]
  (DEFN MINOR
   ((MAT-A MAT4) (ROW-0 (INTEGER 0 3)) (ROW-1 (INTEGER 0 3))
    (ROW-2 (INTEGER 0 3)) (COL-0 (INTEGER 0 3)) (COL-1 (INTEGER 0 3))
    (COL-2 (INTEGER 0 3)))
   SINGLE-FLOAT (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (+
    (* (MELM MAT-A ROW-0 COL-0)
       (- (* (MELM MAT-A ROW-1 COL-1) (MELM MAT-A ROW-2 COL-2))
          (* (MELM MAT-A ROW-2 COL-1) (MELM MAT-A ROW-1 COL-2))))
    (* (MELM MAT-A ROW-0 COL-2)
       (- (* (MELM MAT-A ROW-1 COL-0) (MELM MAT-A ROW-2 COL-1))
          (* (MELM MAT-A ROW-2 COL-0) (MELM MAT-A ROW-1 COL-1))))
    (-
     (* (MELM MAT-A ROW-0 COL-1)
        (- (* (MELM MAT-A ROW-1 COL-0) (MELM MAT-A ROW-2 COL-2))
           (* (MELM MAT-A ROW-2 COL-0) (MELM MAT-A ROW-1 COL-2)))))))

[rtg-math/matrices/matrix4/consing.lisp:5]
  (DEFN IDENTITY NIL MAT4 (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE-ARRAY 16 :ELEMENT-TYPE 'SINGLE-FLOAT :INITIAL-CONTENTS
               '(1.0 0.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 0.0
                 1.0)))

[rtg-math/matrices/matrix4/consing.lisp:13]
  (DEFN-INLINE 0! NIL MAT4 (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE-ARRAY 16 :ELEMENT-TYPE 'SINGLE-FLOAT :INITIAL-ELEMENT 0.0))

[rtg-math/matrices/matrix4/consing.lisp:19]
  (DEFN MAKE
   ((A SINGLE-FLOAT) (B SINGLE-FLOAT) (C SINGLE-FLOAT) (D SINGLE-FLOAT)
    (E SINGLE-FLOAT) (F SINGLE-FLOAT) (G SINGLE-FLOAT) (H SINGLE-FLOAT)
    (I SINGLE-FLOAT) (J SINGLE-FLOAT) (K SINGLE-FLOAT) (L SINGLE-FLOAT)
    (M SINGLE-FLOAT) (N SINGLE-FLOAT) (O SINGLE-FLOAT) (P SINGLE-FLOAT))
   MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE
             #S(FORMGREP:SYMREF :NAME "SET-COMPONENTS" :QUALIFIER "M4-N") 0!))
   (#S(FORMGREP:SYMREF :NAME "SET-COMPONENTS" :QUALIFIER "M4-N") A B C D E F G
    H I J K L M N O P (0!)))

[rtg-math/matrices/matrix4/consing.lisp:30]
  (DEFN-INLINE COPY-MAT4 ((MAT4 MAT4)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 1)))
   (LET ((RESULT (MAKE-ARRAY 16 :ELEMENT-TYPE 'SINGLE-FLOAT)))
     (DOTIMES (I 16) (SETF (AREF RESULT I) (AREF MAT4 I)))
     RESULT))

[rtg-math/matrices/matrix4/consing.lisp:39]
  (DEFN TO-MAT3 ((MAT4 MAT4)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (#S(FORMGREP:SYMREF :NAME "MAKE" :QUALIFIER "M3") (MELM MAT4 0 0)
    (MELM MAT4 0 1) (MELM MAT4 0 2) (MELM MAT4 1 0) (MELM MAT4 1 1)
    (MELM MAT4 1 2) (MELM MAT4 2 0) (MELM MAT4 2 1) (MELM MAT4 2 2)))

[rtg-math/matrices/matrix4/consing.lisp:47]
  (DEFN FROM-MAT3 ((M-A MAT3)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M3") M-A 0 0)
    (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M3") M-A 0 1)
    (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M3") M-A 0 2) 0.0
    (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M3") M-A 1 0)
    (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M3") M-A 1 1)
    (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M3") M-A 1 2) 0.0
    (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M3") M-A 2 0)
    (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M3") M-A 2 1)
    (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M3") M-A 2 2) 0.0 0.0 0.0 0.0
    1.0))

[rtg-math/matrices/matrix4/consing.lisp:56]
  (DEFN FROM-ROWS ((ROW-1 VEC4) (ROW-2 VEC4) (ROW-3 VEC4) (ROW-4 VEC4)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE (X ROW-1) (Y ROW-1) (Z ROW-1) (W ROW-1) (X ROW-2) (Y ROW-2) (Z ROW-2)
    (W ROW-2) (X ROW-3) (Y ROW-3) (Z ROW-3) (W ROW-3) (X ROW-4) (Y ROW-4)
    (Z ROW-4) (W ROW-4)))

[rtg-math/matrices/matrix4/consing.lisp:63]
  (DEFN FROM-ROWS-V3 ((ROW-1 VEC3) (ROW-2 VEC3) (ROW-3 VEC3)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE (X ROW-1) (Y ROW-1) (Z ROW-1) 0.0 (X ROW-2) (Y ROW-2) (Z ROW-2) 0.0
    (X ROW-3) (Y ROW-3) (Z ROW-3) 0.0 0.0 0.0 0.0 1.0))

[rtg-math/matrices/matrix4/consing.lisp:72]
  (DEFN GET-ROWS ((MAT-A MAT4)) LIST
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LIST
    (V! (MELM MAT-A 0 0) (MELM MAT-A 0 1) (MELM MAT-A 0 2) (MELM MAT-A 0 3))
    (V! (MELM MAT-A 1 0) (MELM MAT-A 1 1) (MELM MAT-A 1 2) (MELM MAT-A 1 3))
    (V! (MELM MAT-A 2 0) (MELM MAT-A 2 1) (MELM MAT-A 2 2) (MELM MAT-A 2 3))
    (V! (MELM MAT-A 3 0) (MELM MAT-A 3 1) (MELM MAT-A 3 2) (MELM MAT-A 3 3))))

[rtg-math/matrices/matrix4/consing.lisp:93]
  (DEFN GET-ROW ((MAT-A MAT4) (ROW-NUM (INTEGER 0 3))) VEC4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (#S(FORMGREP:SYMREF :NAME "MAKE" :QUALIFIER "V4") (MELM MAT-A ROW-NUM 0)
    (MELM MAT-A ROW-NUM 1) (MELM MAT-A ROW-NUM 2) (MELM MAT-A ROW-NUM 3)))

[rtg-math/matrices/matrix4/consing.lisp:103]
  (DEFN FROM-COLUMNS ((COL-1 VEC4) (COL-2 VEC4) (COL-3 VEC4) (COL-4 VEC4)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE (X COL-1) (X COL-2) (X COL-3) (X COL-4) (Y COL-1) (Y COL-2) (Y COL-3)
    (Y COL-4) (Z COL-1) (Z COL-2) (Z COL-3) (Z COL-4) (W COL-1) (W COL-2)
    (W COL-3) (W COL-4)))

[rtg-math/matrices/matrix4/consing.lisp:122]
  (DEFN FROM-COLUMNS-V3 ((COL-1 VEC3) (COL-2 VEC3) (COL-3 VEC3)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE (X COL-1) (X COL-2) (X COL-3) 0.0 (Y COL-1) (Y COL-2) (Y COL-3) 0.0
    (Z COL-1) (Z COL-2) (Z COL-3) 0.0 0.0 0.0 0.0 1.0))

[rtg-math/matrices/matrix4/consing.lisp:143]
  (DEFN GET-COLUMNS ((MAT-A MAT4)) LIST
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LIST
    (V! (MELM MAT-A 0 0) (MELM MAT-A 1 0) (MELM MAT-A 2 0) (MELM MAT-A 3 0))
    (V! (MELM MAT-A 0 1) (MELM MAT-A 1 1) (MELM MAT-A 2 1) (MELM MAT-A 3 1))
    (V! (MELM MAT-A 0 2) (MELM MAT-A 1 2) (MELM MAT-A 2 2) (MELM MAT-A 3 2))
    (V! (MELM MAT-A 0 3) (MELM MAT-A 1 3) (MELM MAT-A 2 3) (MELM MAT-A 3 3))))

[rtg-math/matrices/matrix4/consing.lisp:164]
  (DEFN GET-COLUMN ((MAT-A MAT4) (COL-NUM (INTEGER 0 3))) VEC4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (#S(FORMGREP:SYMREF :NAME "MAKE" :QUALIFIER "V4") (MELM MAT-A 0 COL-NUM)
    (MELM MAT-A 1 COL-NUM) (MELM MAT-A 2 COL-NUM) (MELM MAT-A 3 COL-NUM)))

[rtg-math/matrices/matrix4/consing.lisp:173]
  (DEFN |0P| ((MAT-A MAT4)) BOOLEAN
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LOOP :FOR I :BELOW 16
         :ALWAYS (= 0.0 (AREF MAT-A I))))

[rtg-math/matrices/matrix4/consing.lisp:179]
  (DEFN IDENTITYP ((MAT-A MAT4)) BOOLEAN
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (AND (= 0.0 (- (MELM MAT-A 0 0) 1.0)) (= 0.0 (- (MELM MAT-A 1 1) 1.0))
        (= 0.0 (- (MELM MAT-A 2 2) 1.0)) (= 0.0 (- (MELM MAT-A 3 3) 1.0))
        (= 0.0 (MELM MAT-A 0 1)) (= 0.0 (MELM MAT-A 0 2))
        (= 0.0 (MELM MAT-A 0 3)) (= 0.0 (MELM MAT-A 1 0))
        (= 0.0 (MELM MAT-A 1 2)) (= 0.0 (MELM MAT-A 1 3))
        (= 0.0 (MELM MAT-A 2 0)) (= 0.0 (MELM MAT-A 2 1))
        (= 0.0 (MELM MAT-A 2 3)) (= 0.0 (MELM MAT-A 3 0))
        (= 0.0 (MELM MAT-A 3 1)) (= 0.0 (MELM MAT-A 3 2))))

[rtg-math/matrices/matrix4/consing.lisp:200]
  (DEFN = ((MAT-A MAT4) (MAT-B MAT4)) BOOLEAN
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (AND (= (AREF MAT-A 0) (AREF MAT-B 0)) (= (AREF MAT-A 1) (AREF MAT-B 1))
        (= (AREF MAT-A 2) (AREF MAT-B 2)) (= (AREF MAT-A 3) (AREF MAT-B 3))
        (= (AREF MAT-A 4) (AREF MAT-B 4)) (= (AREF MAT-A 5) (AREF MAT-B 5))
        (= (AREF MAT-A 6) (AREF MAT-B 6)) (= (AREF MAT-A 7) (AREF MAT-B 7))
        (= (AREF MAT-A 8) (AREF MAT-B 8)) (= (AREF MAT-A 9) (AREF MAT-B 9))
        (= (AREF MAT-A 10) (AREF MAT-B 10)) (= (AREF MAT-A 11) (AREF MAT-B 11))
        (= (AREF MAT-A 12) (AREF MAT-B 12)) (= (AREF MAT-A 13) (AREF MAT-B 13))
        (= (AREF MAT-A 14) (AREF MAT-B 14))
        (= (AREF MAT-A 15) (AREF MAT-B 15))))

[rtg-math/matrices/matrix4/consing.lisp:221]
  (DEFN ADJOINT ((MAT-A MAT4)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE (MINOR MAT-A 1 2 3 1 2 3) (- (MINOR MAT-A 0 2 3 1 2 3))
    (MINOR MAT-A 0 1 3 1 2 3) (- (MINOR MAT-A 0 1 2 1 2 3))
    (- (MINOR MAT-A 1 2 3 0 2 3)) (MINOR MAT-A 0 2 3 0 2 3)
    (- (MINOR MAT-A 0 1 3 0 2 3)) (MINOR MAT-A 0 1 2 0 2 3)
    (MINOR MAT-A 1 2 3 0 1 3) (- (MINOR MAT-A 0 2 3 0 1 3))
    (MINOR MAT-A 0 1 3 0 1 3) (- (MINOR MAT-A 0 1 2 0 1 3))
    (- (MINOR MAT-A 1 2 3 0 1 2)) (MINOR MAT-A 0 2 3 0 1 2)
    (- (MINOR MAT-A 0 1 3 0 1 2)) (MINOR MAT-A 0 1 2 0 1 2)))

[rtg-math/matrices/matrix4/consing.lisp:245]
  (DEFN DETERMINANT ((MAT-A MAT4)) SINGLE-FLOAT
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (+ (* (MELM MAT-A 0 0) (MINOR MAT-A 1 2 3 1 2 3))
      (- (* (MELM MAT-A 0 1) (MINOR MAT-A 1 2 3 0 2 3)))
      (* (MELM MAT-A 0 2) (MINOR MAT-A 1 2 3 0 1 3))
      (- (* (MELM MAT-A 0 3) (MINOR MAT-A 1 2 3 0 1 2)))))

[rtg-math/matrices/matrix4/consing.lisp:254]
  (DEFN INVERSE ((MATRIX MAT4)) MAT4
   (LET ((DET (#S(FORMGREP:SYMREF :NAME "DETERMINANT" :QUALIFIER "M4") MATRIX)))
     (IF (= DET 0.0)
         (ERROR "Cannot invert matrix with zero determinant:~%  ~S" MATRIX)
         (MACROLET ((A (X Y Z)
                      (DECLARE (OPTIMIZE (SAFETY 3) (SPEED 0)))
                      (MULTIPLE-VALUE-BIND (R1 C1)
                          (TRUNCATE (- X 11) 10)
                        (MULTIPLE-VALUE-BIND (R2 C2)
                            (TRUNCATE (- Y 11) 10)
                          (MULTIPLE-VALUE-BIND (R3 C3)
                              (TRUNCATE (- Z 11) 10)
                            (ECLECTOR.READER:QUASIQUOTE
                             (*
                              (MELM MATRIX (ECLECTOR.READER:UNQUOTE R1)
                               (ECLECTOR.READER:UNQUOTE C1))
                              (MELM MATRIX (ECLECTOR.READER:UNQUOTE R2)
                               (ECLECTOR.READER:UNQUOTE C2))
                              (MELM MATRIX (ECLECTOR.READER:UNQUOTE R3)
                               (ECLECTOR.READER:UNQUOTE C3)))))))))
           (LET ((M
                  (MAKE
                   (- (+ (A 22 33 44) (A 23 34 42) (A 24 32 43)) (A 22 34 43)
                      (A 23 32 44) (A 24 33 42))
                   (- (+ (A 12 34 43) (A 13 32 44) (A 14 33 42)) (A 12 33 44)
                      (A 13 34 42) (A 14 32 43))
                   (- (+ (A 12 23 44) (A 13 24 42) (A 14 22 43)) (A 12 24 43)
                      (A 13 22 44) (A 14 23 42))
                   (- (+ (A 12 24 33) (A 13 22 34) (A 14 23 32)) (A 12 23 34)
                      (A 13 24 32) (A 14 22 33))
                   (- (+ (A 21 34 43) (A 23 31 44) (A 24 33 41)) (A 21 33 44)
                      (A 23 34 41) (A 24 31 43))
                   (- (+ (A 11 33 44) (A 13 34 41) (A 14 31 43)) (A 11 34 43)
                      (A 13 31 44) (A 14 33 41))
                   (- (+ (A 11 24 43) (A 13 21 44) (A 14 23 41)) (A 11 23 44)
                      (A 13 24 41) (A 14 21 43))
                   (- (+ (A 11 23 34) (A 13 24 31) (A 14 21 33)) (A 11 24 33)
                      (A 13 21 34) (A 14 23 31))
                   (- (+ (A 21 32 44) (A 22 34 41) (A 24 31 42)) (A 21 34 42)
                      (A 22 31 44) (A 24 32 41))
                   (- (+ (A 11 34 42) (A 12 31 44) (A 14 32 41)) (A 11 32 44)
                      (A 12 34 41) (A 14 31 42))
                   (- (+ (A 11 22 44) (A 12 24 41) (A 14 21 42)) (A 11 24 42)
                      (A 12 21 44) (A 14 22 41))
                   (- (+ (A 11 24 32) (A 12 21 34) (A 14 22 31)) (A 11 22 34)
                      (A 12 24 31) (A 14 21 32))
                   (- (+ (A 21 33 42) (A 22 31 43) (A 23 32 41)) (A 21 32 43)
                      (A 22 33 41) (A 23 31 42))
                   (- (+ (A 11 32 43) (A 12 33 41) (A 13 31 42)) (A 11 33 42)
                      (A 12 31 43) (A 13 32 41))
                   (- (+ (A 11 23 42) (A 12 21 43) (A 13 22 41)) (A 11 22 43)
                      (A 12 23 41) (A 13 21 42))
                   (- (+ (A 11 22 33) (A 12 23 31) (A 13 21 32)) (A 11 23 32)
                      (A 12 21 33) (A 13 22 31)))))
             (DOTIMES (I 4)
               (DOTIMES (J 4) (SETF (MELM M I J) (/ (MELM M I J) DET))))
             M)))))

[rtg-math/matrices/matrix4/consing.lisp:314]
  (DEFN AFFINE-INVERSE ((MAT-A MAT4)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE COPY-MAT4))
   (#S(FORMGREP:SYMREF :NAME "AFFINE-INVERSE" :QUALIFIER "M4-N")
    (COPY-MAT4 MAT-A)))

[rtg-math/matrices/matrix4/consing.lisp:322]
  (DEFN TRANSPOSE ((M-A MAT4)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE COPY-MAT4))
   (#S(FORMGREP:SYMREF :NAME "TRANSPOSE" :QUALIFIER "M4-N") (COPY-MAT4 M-A)))

[rtg-math/matrices/matrix4/consing.lisp:329]
  (DEFN TRANSLATION ((VEC-A (SIMPLE-ARRAY SINGLE-FLOAT))) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE 0!))
   (#S(FORMGREP:SYMREF :NAME "SET-FROM-TRANSLATION" :QUALIFIER "M4-N") (0!)
    VEC-A))

[rtg-math/matrices/matrix4/consing.lisp:336]
  (DEFN ROTATION-FROM-MAT3 ((M-A MAT3)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE 0!))
   (#S(FORMGREP:SYMREF :NAME "SET-FROM-MAT3" :QUALIFIER "M4-N") (0!) M-A))

[rtg-math/matrices/matrix4/consing.lisp:343]
  (DEFN ROTATION-FROM-EULER ((VEC3-A VEC3)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE 0!))
   (#S(FORMGREP:SYMREF :NAME "SET-ROTATION-FROM-EULER" :QUALIFIER "M4-N") (0!)
    VEC3-A))

[rtg-math/matrices/matrix4/consing.lisp:350]
  (DEFN SCALE ((SCALE-VEC3 VEC3)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE 0!))
   (#S(FORMGREP:SYMREF :NAME "SET-FROM-SCALE" :QUALIFIER "M4-N") (0!)
    SCALE-VEC3))

[rtg-math/matrices/matrix4/consing.lisp:357]
  (DEFN ROTATION-X ((ANGLE SINGLE-FLOAT)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE 0!))
   (#S(FORMGREP:SYMREF :NAME "SET-FROM-ROTATION-X" :QUALIFIER "M4-N") (0!)
    ANGLE))

[rtg-math/matrices/matrix4/consing.lisp:364]
  (DEFN ROTATION-Y ((ANGLE SINGLE-FLOAT)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE 0!))
   (#S(FORMGREP:SYMREF :NAME "SET-FROM-ROTATION-Y" :QUALIFIER "M4-N") (0!)
    ANGLE))

[rtg-math/matrices/matrix4/consing.lisp:371]
  (DEFN ROTATION-Z ((ANGLE SINGLE-FLOAT)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE 0!))
   (#S(FORMGREP:SYMREF :NAME "SET-FROM-ROTATION-Z" :QUALIFIER "M4-N") (0!)
    ANGLE))

[rtg-math/matrices/matrix4/consing.lisp:378]
  (DEFN ROTATION-FROM-AXIS-ANGLE ((AXIS3 VEC3) (ANGLE SINGLE-FLOAT)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE 0!))
   (#S(FORMGREP:SYMREF :NAME "SET-ROTATION-FROM-AXIS-ANGLE" :QUALIFIER "M4-N")
    (0!) AXIS3 ANGLE))

[rtg-math/matrices/matrix4/consing.lisp:387]
  (DEFN GET-FIXED-ANGLES ((MAT-A MAT4)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((SY (MELM MAT-A 0 2)))
     (DECLARE ((SINGLE-FLOAT -1.0 1.0) SY))
     (LET ((CY (SQRT (- 1.0 (* SY SY)))))
       (IF (= 0.0 CY)
           (LET ((SZ 0.0) (CZ 1.0) (SX (MELM MAT-A 2 1)) (CX (MELM MAT-A 1 1)))
             (#S(FORMGREP:SYMREF :NAME "MAKE" :QUALIFIER "V3") (ATAN SX CX)
              (ATAN SY CY) (ATAN SZ CZ)))
           (LET* ((FACTOR (/ 1.0 CY))
                  (SX (- (* FACTOR (MELM MAT-A 1 2))))
                  (CX (* FACTOR (MELM MAT-A 2 2)))
                  (SZ (- (* FACTOR (MELM MAT-A 0 1))))
                  (CZ (* FACTOR (MELM MAT-A 0 0))))
             (#S(FORMGREP:SYMREF :NAME "MAKE" :QUALIFIER "V3") (ATAN SX CX)
              (ATAN SY CY) (ATAN SZ CZ)))))))

[rtg-math/matrices/matrix4/consing.lisp:407]
  (DEFN TRACE ((MAT-A MAT4)) SINGLE-FLOAT
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (+ (MELM MAT-A 0 0) (MELM MAT-A 1 1) (MELM MAT-A 2 2) (MELM MAT-A 3 3)))

[rtg-math/matrices/matrix4/consing.lisp:419]
  (DEFN GET-AXIS-ANGLE ((MAT-A MAT4)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET* ((TRACE-A (+ (MELM MAT-A 0 0) (MELM MAT-A 1 1) (MELM MAT-A 2 2)))
          (COS-THETA (* 0.5 (- TRACE-A 1.0))))
     (DECLARE (TYPE (SINGLE-FLOAT -1.0 1.0) COS-THETA))
     (LET ((ANGLE (ACOS COS-THETA)))
       (COND ((= 0.0 ANGLE) (VALUES (V! 1.0 0.0 0.0) ANGLE))
             ((= 0.0
                 (-
                  #S(FORMGREP:SYMREF
                     :NAME "+PI+"
                     :QUALIFIER "RTG-MATH.BASE-MATHS")
                  ANGLE))
              (VALUES
               (#S(FORMGREP:SYMREF :NAME "NORMALIZE" :QUALIFIER "V3-N")
                (V! (- (MELM MAT-A 2 1) (MELM MAT-A 1 2))
                 (- (MELM MAT-A 0 2) (MELM MAT-A 2 0))
                 (- (MELM MAT-A 1 0) (MELM MAT-A 0 1))))
               ANGLE))
             (T
              (LABELS ((BIGGEST-TRACE (MATR)
                         (LET ((X 0))
                           (IF (> (MELM MATR 1 1) (MELM MATR 0 0))
                               (SETF X 1))
                           (IF (> (MELM MATR 2 2) (MELM MATR X X))
                               (SETF X 2))
                           X)))
                (LET* ((I (BIGGEST-TRACE MAT-A))
                       (J (MOD (+ I 1) 3))
                       (K (MOD (+ I 1) 3))
                       (TMP-S
                        (+ 1.0
                           (- (MELM MAT-A I I) (MELM MAT-A J J)
                              (MELM MAT-A K K))))
                       (S (THE (SINGLE-FLOAT 0.0 NIL) TMP-S))
                       (RECIP (/ 1.0 S)))
                  (VALUES
                   (V! (* 0.5 S) (* RECIP (AREF MAT-A (+ I (* 4 J))))
                    (* RECIP (AREF MAT-A (+ K (* 4 I)))))
                   ANGLE))))))))

[rtg-math/matrices/matrix4/consing.lisp:458]
  (DEFN + ((MAT-A MAT4) (MAT-B MAT4)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE 0!))
   (LET ((R (0!)))
     (LOOP :FOR I :BELOW 16
           :DO (SETF (AREF R I) (+ (AREF MAT-A I) (AREF MAT-B I))))
     R))

[rtg-math/matrices/matrix4/consing.lisp:468]
  (DEFN - ((MAT-A MAT4) (MAT-B MAT4)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE 0!))
   (LET ((R (0!)))
     (LOOP :FOR I :BELOW 16
           :DO (SETF (AREF R I) (- (AREF MAT-A I) (AREF MAT-B I))))
     R))

[rtg-math/matrices/matrix4/consing.lisp:478]
  (DEFN NEGATE ((MAT-A MAT4)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE 0!))
   (LET ((R (0!)))
     (LOOP :FOR I :BELOW 16
           :DO (SETF (AREF R I) (- (AREF MAT-A I))))
     R))

[rtg-math/matrices/matrix4/consing.lisp:487]
  (DEFN *S ((MAT-A MAT4) (SCALAR SINGLE-FLOAT)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE 0!))
   (LET ((RESULT (0!)))
     (LOOP :FOR I :BELOW 16
           :DO (SETF (AREF RESULT I) (* SCALAR (AREF MAT-A I))))
     RESULT))

[rtg-math/matrices/matrix4/consing.lisp:497]
  (DEFN *V ((MAT-A MAT4) (VEC4 VEC4)) VEC4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (#S(FORMGREP:SYMREF :NAME "*V" :QUALIFIER "M4-N") MAT-A
    (#S(FORMGREP:SYMREF :NAME "COPY-VEC4" :QUALIFIER "V4") VEC4)))

[rtg-math/matrices/matrix4/consing.lisp:501]
  (DEFN *V3 ((MAT-A MAT4) (VEC3 VEC3)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (#S(FORMGREP:SYMREF :NAME "*V3" :QUALIFIER "M4-N") MAT-A
    (#S(FORMGREP:SYMREF :NAME "COPY-VEC3" :QUALIFIER "V3") VEC3)))

[rtg-math/matrices/matrix4/consing.lisp:507]
  (DEFN MROW*VEC4 ((VEC VEC4) (MAT-A MAT4)) VEC4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (#S(FORMGREP:SYMREF :NAME "MROW*VEC4" :QUALIFIER "M4-N")
    (#S(FORMGREP:SYMREF :NAME "COPY-VEC4" :QUALIFIER "V4") VEC) MAT-A))

[rtg-math/matrices/matrix4/consing.lisp:513]
  (DEFN %* ((MAT-A MAT4) (MAT-B MAT4)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE
    (+ (* (MELM MAT-A 0 0) (MELM MAT-B 0 0))
       (* (MELM MAT-A 0 1) (MELM MAT-B 1 0))
       (* (MELM MAT-A 0 2) (MELM MAT-B 2 0))
       (* (MELM MAT-A 0 3) (MELM MAT-B 3 0)))
    (+ (* (MELM MAT-A 0 0) (MELM MAT-B 0 1))
       (* (MELM MAT-A 0 1) (MELM MAT-B 1 1))
       (* (MELM MAT-A 0 2) (MELM MAT-B 2 1))
       (* (MELM MAT-A 0 3) (MELM MAT-B 3 1)))
    (+ (* (MELM MAT-A 0 0) (MELM MAT-B 0 2))
       (* (MELM MAT-A 0 1) (MELM MAT-B 1 2))
       (* (MELM MAT-A 0 2) (MELM MAT-B 2 2))
       (* (MELM MAT-A 0 3) (MELM MAT-B 3 2)))
    (+ (* (MELM MAT-A 0 0) (MELM MAT-B 0 3))
       (* (MELM MAT-A 0 1) (MELM MAT-B 1 3))
       (* (MELM MAT-A 0 2) (MELM MAT-B 2 3))
       (* (MELM MAT-A 0 3) (MELM MAT-B 3 3)))
    (+ (* (MELM MAT-A 1 0) (MELM MAT-B 0 0))
       (* (MELM MAT-A 1 1) (MELM MAT-B 1 0))
       (* (MELM MAT-A 1 2) (MELM MAT-B 2 0))
       (* (MELM MAT-A 1 3) (MELM MAT-B 3 0)))
    (+ (* (MELM MAT-A 1 0) (MELM MAT-B 0 1))
       (* (MELM MAT-A 1 1) (MELM MAT-B 1 1))
       (* (MELM MAT-A 1 2) (MELM MAT-B 2 1))
       (* (MELM MAT-A 1 3) (MELM MAT-B 3 1)))
    (+ (* (MELM MAT-A 1 0) (MELM MAT-B 0 2))
       (* (MELM MAT-A 1 1) (MELM MAT-B 1 2))
       (* (MELM MAT-A 1 2) (MELM MAT-B 2 2))
       (* (MELM MAT-A 1 3) (MELM MAT-B 3 2)))
    (+ (* (MELM MAT-A 1 0) (MELM MAT-B 0 3))
       (* (MELM MAT-A 1 1) (MELM MAT-B 1 3))
       (* (MELM MAT-A 1 2) (MELM MAT-B 2 3))
       (* (MELM MAT-A 1 3) (MELM MAT-B 3 3)))
    (+ (* (MELM MAT-A 2 0) (MELM MAT-B 0 0))
       (* (MELM MAT-A 2 1) (MELM MAT-B 1 0))
       (* (MELM MAT-A 2 2) (MELM MAT-B 2 0))
       (* (MELM MAT-A 2 3) (MELM MAT-B 3 0)))
    (+ (* (MELM MAT-A 2 0) (MELM MAT-B 0 1))
       (* (MELM MAT-A 2 1) (MELM MAT-B 1 1))
       (* (MELM MAT-A 2 2) (MELM MAT-B 2 1))
       (* (MELM MAT-A 2 3) (MELM MAT-B 3 1)))
    (+ (* (MELM MAT-A 2 0) (MELM MAT-B 0 2))
       (* (MELM MAT-A 2 1) (MELM MAT-B 1 2))
       (* (MELM MAT-A 2 2) (MELM MAT-B 2 2))
       (* (MELM MAT-A 2 3) (MELM MAT-B 3 2)))
    (+ (* (MELM MAT-A 2 0) (MELM MAT-B 0 3))
       (* (MELM MAT-A 2 1) (MELM MAT-B 1 3))
       (* (MELM MAT-A 2 2) (MELM MAT-B 2 3))
       (* (MELM MAT-A 2 3) (MELM MAT-B 3 3)))
    (+ (* (MELM MAT-A 3 0) (MELM MAT-B 0 0))
       (* (MELM MAT-A 3 1) (MELM MAT-B 1 0))
       (* (MELM MAT-A 3 2) (MELM MAT-B 2 0))
       (* (MELM MAT-A 3 3) (MELM MAT-B 3 0)))
    (+ (* (MELM MAT-A 3 0) (MELM MAT-B 0 1))
       (* (MELM MAT-A 3 1) (MELM MAT-B 1 1))
       (* (MELM MAT-A 3 2) (MELM MAT-B 2 1))
       (* (MELM MAT-A 3 3) (MELM MAT-B 3 1)))
    (+ (* (MELM MAT-A 3 0) (MELM MAT-B 0 2))
       (* (MELM MAT-A 3 1) (MELM MAT-B 1 2))
       (* (MELM MAT-A 3 2) (MELM MAT-B 2 2))
       (* (MELM MAT-A 3 3) (MELM MAT-B 3 2)))
    (+ (* (MELM MAT-A 3 0) (MELM MAT-B 0 3))
       (* (MELM MAT-A 3 1) (MELM MAT-B 1 3))
       (* (MELM MAT-A 3 2) (MELM MAT-B 2 3))
       (* (MELM MAT-A 3 3) (MELM MAT-B 3 3)))))

[rtg-math/matrices/matrix4/consing.lisp:580]
  (DEFN * (&REST (MATRICES MAT4)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (IF MATRICES
       (REDUCE #'#S(FORMGREP:SYMREF :NAME "%*" :QUALIFIER "M4-N") MATRICES
               :INITIAL-VALUE (IDENTITY))
       (IDENTITY)))

[rtg-math/matrices/matrix4/consing.lisp:596]
  (DEFN PRINT-M4 ((M4 MAT4)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (FORMAT T
           "~%(m! ~s ~s ~s ~s~%    ~s ~s ~s ~s~%    ~s ~s ~s ~s~%    ~s ~s ~s ~s)"
           (MELM M4 0 0) (MELM M4 0 1) (MELM M4 0 2) (MELM M4 0 3)
           (MELM M4 1 0) (MELM M4 1 1) (MELM M4 1 2) (MELM M4 1 3)
           (MELM M4 2 0) (MELM M4 2 1) (MELM M4 2 2) (MELM M4 2 3)
           (MELM M4 3 0) (MELM M4 3 1) (MELM M4 3 2) (MELM M4 3 3))
   M4)

[rtg-math/matrices/matrix4/consing.lisp:618]
  (DEFN-INLINE FROM-DIRECTION ((UP3 VEC3) (DIR3 VEC3)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET* ((ZAXIS (#S(FORMGREP:SYMREF :NAME "NORMALIZE" :QUALIFIER "V3") DIR3))
          (XAXIS
           (#S(FORMGREP:SYMREF :NAME "NORMALIZE" :QUALIFIER "V3-N")
            (#S(FORMGREP:SYMREF :NAME "CROSS" :QUALIFIER "V3") ZAXIS UP3)))
          (YAXIS
           (#S(FORMGREP:SYMREF :NAME "CROSS" :QUALIFIER "V3") XAXIS ZAXIS)))
     (#S(FORMGREP:SYMREF :NAME "MAKE" :QUALIFIER "M4") (X XAXIS) (X YAXIS)
      (- (X ZAXIS)) 0.0 (Y XAXIS) (Y YAXIS) (- (Y ZAXIS)) 0.0 (Z XAXIS)
      (Z YAXIS) (- (Z ZAXIS)) 0.0 0.0 0.0 0.0 1.0)))

[rtg-math/matrices/matrix4/consing.lisp:631]
  (DEFN POINT-AT ((UP VEC3) (FROM3 VEC3) (TO3 VEC3)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE FROM-DIRECTION))
   (FROM-DIRECTION UP
    (#S(FORMGREP:SYMREF :NAME "-" :QUALIFIER "V3") TO3 FROM3)))

[rtg-math/matrices/matrix4/consing.lisp:639]
  (DEFN-INLINE LOOK-AT ((UP3 VEC3) (FROM3 VEC3) (TO3 VEC3)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET* ((ZAXIS
           (#S(FORMGREP:SYMREF :NAME "NORMALIZE" :QUALIFIER "V3-N")
            (#S(FORMGREP:SYMREF :NAME "-" :QUALIFIER "V3") TO3 FROM3)))
          (XAXIS
           (#S(FORMGREP:SYMREF :NAME "NORMALIZE" :QUALIFIER "V3-N")
            (#S(FORMGREP:SYMREF :NAME "CROSS" :QUALIFIER "V3") ZAXIS UP3)))
          (YAXIS
           (#S(FORMGREP:SYMREF :NAME "CROSS" :QUALIFIER "V3") XAXIS ZAXIS)))
     (#S(FORMGREP:SYMREF :NAME "MAKE" :QUALIFIER "M4") (X XAXIS) (Y XAXIS)
      (Z XAXIS)
      (- (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") XAXIS FROM3))
      (X YAXIS) (Y YAXIS) (Z YAXIS)
      (- (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") YAXIS FROM3))
      (- (X ZAXIS)) (- (Y ZAXIS)) (- (Z ZAXIS))
      (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") ZAXIS FROM3) 0.0 0.0 0.0
      1.0)))

[rtg-math/matrices/matrix4/non-consing.lisp:5]
  (DEFN-INLINE SET-COMPONENTS
   ((C00 SINGLE-FLOAT) (C01 SINGLE-FLOAT) (C02 SINGLE-FLOAT) (C03 SINGLE-FLOAT)
    (C10 SINGLE-FLOAT) (C11 SINGLE-FLOAT) (C12 SINGLE-FLOAT) (C13 SINGLE-FLOAT)
    (C20 SINGLE-FLOAT) (C21 SINGLE-FLOAT) (C22 SINGLE-FLOAT) (C23 SINGLE-FLOAT)
    (C30 SINGLE-FLOAT) (C31 SINGLE-FLOAT) (C32 SINGLE-FLOAT) (C33 SINGLE-FLOAT)
    (MAT4-TO-MUTATE MAT4))
   MAT4 (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SETF (MELM MAT4-TO-MUTATE 0 0) C00) (SETF (MELM MAT4-TO-MUTATE 0 1) C01)
   (SETF (MELM MAT4-TO-MUTATE 0 2) C02) (SETF (MELM MAT4-TO-MUTATE 0 3) C03)
   (SETF (MELM MAT4-TO-MUTATE 1 0) C10) (SETF (MELM MAT4-TO-MUTATE 1 1) C11)
   (SETF (MELM MAT4-TO-MUTATE 1 2) C12) (SETF (MELM MAT4-TO-MUTATE 1 3) C13)
   (SETF (MELM MAT4-TO-MUTATE 2 0) C20) (SETF (MELM MAT4-TO-MUTATE 2 1) C21)
   (SETF (MELM MAT4-TO-MUTATE 2 2) C22) (SETF (MELM MAT4-TO-MUTATE 2 3) C23)
   (SETF (MELM MAT4-TO-MUTATE 3 0) C30) (SETF (MELM MAT4-TO-MUTATE 3 1) C31)
   (SETF (MELM MAT4-TO-MUTATE 3 2) C32) (SETF (MELM MAT4-TO-MUTATE 3 3) C33)
   MAT4-TO-MUTATE)

[rtg-math/matrices/matrix4/non-consing.lisp:33]
  (DEFN-INLINE COPY-COMPONENTS ((MAT MAT4) (COPY-FROM MAT4)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SETF (MELM MAT 0 0) (MELM COPY-FROM 0 0))
   (SETF (MELM MAT 0 1) (MELM COPY-FROM 0 1))
   (SETF (MELM MAT 0 2) (MELM COPY-FROM 0 2))
   (SETF (MELM MAT 0 3) (MELM COPY-FROM 0 3))
   (SETF (MELM MAT 1 0) (MELM COPY-FROM 1 0))
   (SETF (MELM MAT 1 1) (MELM COPY-FROM 1 1))
   (SETF (MELM MAT 1 2) (MELM COPY-FROM 1 2))
   (SETF (MELM MAT 1 3) (MELM COPY-FROM 1 3))
   (SETF (MELM MAT 2 0) (MELM COPY-FROM 2 0))
   (SETF (MELM MAT 2 1) (MELM COPY-FROM 2 1))
   (SETF (MELM MAT 2 2) (MELM COPY-FROM 2 2))
   (SETF (MELM MAT 2 3) (MELM COPY-FROM 2 3))
   (SETF (MELM MAT 3 0) (MELM COPY-FROM 3 0))
   (SETF (MELM MAT 3 1) (MELM COPY-FROM 3 1))
   (SETF (MELM MAT 3 2) (MELM COPY-FROM 3 2))
   (SETF (MELM MAT 3 3) (MELM COPY-FROM 3 3)) MAT)

[rtg-math/matrices/matrix4/non-consing.lisp:55]
  (DEFN %* ((MAT-ACCUM MAT4) (TO-MULTIPLY-MAT MAT4)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((A
          (+ (* (MELM MAT-ACCUM 0 0) (MELM TO-MULTIPLY-MAT 0 0))
             (* (MELM MAT-ACCUM 0 1) (MELM TO-MULTIPLY-MAT 1 0))
             (* (MELM MAT-ACCUM 0 2) (MELM TO-MULTIPLY-MAT 2 0))
             (* (MELM MAT-ACCUM 0 3) (MELM TO-MULTIPLY-MAT 3 0))))
         (B
          (+ (* (MELM MAT-ACCUM 0 0) (MELM TO-MULTIPLY-MAT 0 1))
             (* (MELM MAT-ACCUM 0 1) (MELM TO-MULTIPLY-MAT 1 1))
             (* (MELM MAT-ACCUM 0 2) (MELM TO-MULTIPLY-MAT 2 1))
             (* (MELM MAT-ACCUM 0 3) (MELM TO-MULTIPLY-MAT 3 1))))
         (C
          (+ (* (MELM MAT-ACCUM 0 0) (MELM TO-MULTIPLY-MAT 0 2))
             (* (MELM MAT-ACCUM 0 1) (MELM TO-MULTIPLY-MAT 1 2))
             (* (MELM MAT-ACCUM 0 2) (MELM TO-MULTIPLY-MAT 2 2))
             (* (MELM MAT-ACCUM 0 3) (MELM TO-MULTIPLY-MAT 3 2))))
         (D
          (+ (* (MELM MAT-ACCUM 0 0) (MELM TO-MULTIPLY-MAT 0 3))
             (* (MELM MAT-ACCUM 0 1) (MELM TO-MULTIPLY-MAT 1 3))
             (* (MELM MAT-ACCUM 0 2) (MELM TO-MULTIPLY-MAT 2 3))
             (* (MELM MAT-ACCUM 0 3) (MELM TO-MULTIPLY-MAT 3 3))))
         (E
          (+ (* (MELM MAT-ACCUM 1 0) (MELM TO-MULTIPLY-MAT 0 0))
             (* (MELM MAT-ACCUM 1 1) (MELM TO-MULTIPLY-MAT 1 0))
             (* (MELM MAT-ACCUM 1 2) (MELM TO-MULTIPLY-MAT 2 0))
             (* (MELM MAT-ACCUM 1 3) (MELM TO-MULTIPLY-MAT 3 0))))
         (F
          (+ (* (MELM MAT-ACCUM 1 0) (MELM TO-MULTIPLY-MAT 0 1))
             (* (MELM MAT-ACCUM 1 1) (MELM TO-MULTIPLY-MAT 1 1))
             (* (MELM MAT-ACCUM 1 2) (MELM TO-MULTIPLY-MAT 2 1))
             (* (MELM MAT-ACCUM 1 3) (MELM TO-MULTIPLY-MAT 3 1))))
         (G
          (+ (* (MELM MAT-ACCUM 1 0) (MELM TO-MULTIPLY-MAT 0 2))
             (* (MELM MAT-ACCUM 1 1) (MELM TO-MULTIPLY-MAT 1 2))
             (* (MELM MAT-ACCUM 1 2) (MELM TO-MULTIPLY-MAT 2 2))
             (* (MELM MAT-ACCUM 1 3) (MELM TO-MULTIPLY-MAT 3 2))))
         (H
          (+ (* (MELM MAT-ACCUM 1 0) (MELM TO-MULTIPLY-MAT 0 3))
             (* (MELM MAT-ACCUM 1 1) (MELM TO-MULTIPLY-MAT 1 3))
             (* (MELM MAT-ACCUM 1 2) (MELM TO-MULTIPLY-MAT 2 3))
             (* (MELM MAT-ACCUM 1 3) (MELM TO-MULTIPLY-MAT 3 3))))
         (I
          (+ (* (MELM MAT-ACCUM 2 0) (MELM TO-MULTIPLY-MAT 0 0))
             (* (MELM MAT-ACCUM 2 1) (MELM TO-MULTIPLY-MAT 1 0))
             (* (MELM MAT-ACCUM 2 2) (MELM TO-MULTIPLY-MAT 2 0))
             (* (MELM MAT-ACCUM 2 3) (MELM TO-MULTIPLY-MAT 3 0))))
         (J
          (+ (* (MELM MAT-ACCUM 2 0) (MELM TO-MULTIPLY-MAT 0 1))
             (* (MELM MAT-ACCUM 2 1) (MELM TO-MULTIPLY-MAT 1 1))
             (* (MELM MAT-ACCUM 2 2) (MELM TO-MULTIPLY-MAT 2 1))
             (* (MELM MAT-ACCUM 2 3) (MELM TO-MULTIPLY-MAT 3 1))))
         (K
          (+ (* (MELM MAT-ACCUM 2 0) (MELM TO-MULTIPLY-MAT 0 2))
             (* (MELM MAT-ACCUM 2 1) (MELM TO-MULTIPLY-MAT 1 2))
             (* (MELM MAT-ACCUM 2 2) (MELM TO-MULTIPLY-MAT 2 2))
             (* (MELM MAT-ACCUM 2 3) (MELM TO-MULTIPLY-MAT 3 2))))
         (L
          (+ (* (MELM MAT-ACCUM 2 0) (MELM TO-MULTIPLY-MAT 0 3))
             (* (MELM MAT-ACCUM 2 1) (MELM TO-MULTIPLY-MAT 1 3))
             (* (MELM MAT-ACCUM 2 2) (MELM TO-MULTIPLY-MAT 2 3))
             (* (MELM MAT-ACCUM 2 3) (MELM TO-MULTIPLY-MAT 3 3))))
         (M
          (+ (* (MELM MAT-ACCUM 3 0) (MELM TO-MULTIPLY-MAT 0 0))
             (* (MELM MAT-ACCUM 3 1) (MELM TO-MULTIPLY-MAT 1 0))
             (* (MELM MAT-ACCUM 3 2) (MELM TO-MULTIPLY-MAT 2 0))
             (* (MELM MAT-ACCUM 3 3) (MELM TO-MULTIPLY-MAT 3 0))))
         (N
          (+ (* (MELM MAT-ACCUM 3 0) (MELM TO-MULTIPLY-MAT 0 1))
             (* (MELM MAT-ACCUM 3 1) (MELM TO-MULTIPLY-MAT 1 1))
             (* (MELM MAT-ACCUM 3 2) (MELM TO-MULTIPLY-MAT 2 1))
             (* (MELM MAT-ACCUM 3 3) (MELM TO-MULTIPLY-MAT 3 1))))
         (O
          (+ (* (MELM MAT-ACCUM 3 0) (MELM TO-MULTIPLY-MAT 0 2))
             (* (MELM MAT-ACCUM 3 1) (MELM TO-MULTIPLY-MAT 1 2))
             (* (MELM MAT-ACCUM 3 2) (MELM TO-MULTIPLY-MAT 2 2))
             (* (MELM MAT-ACCUM 3 3) (MELM TO-MULTIPLY-MAT 3 2))))
         (P
          (+ (* (MELM MAT-ACCUM 3 0) (MELM TO-MULTIPLY-MAT 0 3))
             (* (MELM MAT-ACCUM 3 1) (MELM TO-MULTIPLY-MAT 1 3))
             (* (MELM MAT-ACCUM 3 2) (MELM TO-MULTIPLY-MAT 2 3))
             (* (MELM MAT-ACCUM 3 3) (MELM TO-MULTIPLY-MAT 3 3)))))
     (SETF (MELM MAT-ACCUM 0 0) A)
     (SETF (MELM MAT-ACCUM 0 1) B)
     (SETF (MELM MAT-ACCUM 0 2) C)
     (SETF (MELM MAT-ACCUM 0 3) D)
     (SETF (MELM MAT-ACCUM 1 0) E)
     (SETF (MELM MAT-ACCUM 1 1) F)
     (SETF (MELM MAT-ACCUM 1 2) G)
     (SETF (MELM MAT-ACCUM 1 3) H)
     (SETF (MELM MAT-ACCUM 2 0) I)
     (SETF (MELM MAT-ACCUM 2 1) J)
     (SETF (MELM MAT-ACCUM 2 2) K)
     (SETF (MELM MAT-ACCUM 2 3) L)
     (SETF (MELM MAT-ACCUM 3 0) M)
     (SETF (MELM MAT-ACCUM 3 1) N)
     (SETF (MELM MAT-ACCUM 3 2) O)
     (SETF (MELM MAT-ACCUM 3 3) P)
     MAT-ACCUM))

[rtg-math/matrices/matrix4/non-consing.lisp:139]
  (DEFN * ((ACCUM-MAT MAT4) &REST (MAT4S MAT4)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (REDUCE #'%* MAT4S :INITIAL-VALUE ACCUM-MAT))

[rtg-math/matrices/matrix4/non-consing.lisp:152]
  (DEFN SET-FROM-MAT3 ((MAT-TO-MUTATE MAT4) (M-A MAT3)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SET-COMPONENTS (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M3") M-A 0 0)
    (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M3") M-A 0 1)
    (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M3") M-A 0 2) 0.0
    (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M3") M-A 1 0)
    (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M3") M-A 1 1)
    (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M3") M-A 1 2) 0.0
    (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M3") M-A 2 0)
    (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M3") M-A 2 1)
    (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M3") M-A 2 2) 0.0 0.0 0.0 0.0
    1.0 MAT-TO-MUTATE))

[rtg-math/matrices/matrix4/non-consing.lisp:163]
  (DEFN SET-FROM-ROWS
   ((MAT-TO-MUTATE MAT4) (ROW-1 VEC4) (ROW-2 VEC4) (ROW-3 VEC4) (ROW-4 VEC4))
   MAT4 (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SET-COMPONENTS (X ROW-1) (Y ROW-1) (Z ROW-1) (W ROW-1) (X ROW-2) (Y ROW-2)
    (Z ROW-2) (W ROW-2) (X ROW-3) (Y ROW-3) (Z ROW-3) (W ROW-3) (X ROW-4)
    (Y ROW-4) (Z ROW-4) (W ROW-4) MAT-TO-MUTATE))

[rtg-math/matrices/matrix4/non-consing.lisp:172]
  (DEFN SET-FROM-ROWS-V3
   ((MAT-TO-MUTATE MAT4) (ROW-1 VEC3) (ROW-2 VEC3) (ROW-3 VEC3)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SET-COMPONENTS (X ROW-1) (Y ROW-1) (Z ROW-1) 0.0 (X ROW-2) (Y ROW-2)
    (Z ROW-2) 0.0 (X ROW-3) (Y ROW-3) (Z ROW-3) 0.0 0.0 0.0 0.0 1.0
    MAT-TO-MUTATE))

[rtg-math/matrices/matrix4/non-consing.lisp:183]
  (DEFN SET-FROM-COLUMNS
   ((MAT-TO-MUTATE MAT4) (COL-1 VEC4) (COL-2 VEC4) (COL-3 VEC4) (COL-4 VEC4))
   MAT4 (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SET-COMPONENTS (X COL-1) (X COL-2) (X COL-3) (X COL-4) (Y COL-1) (Y COL-2)
    (Y COL-3) (Y COL-4) (Z COL-1) (Z COL-2) (Z COL-3) (Z COL-4) (W COL-1)
    (W COL-2) (W COL-3) (W COL-4) MAT-TO-MUTATE))

[rtg-math/matrices/matrix4/non-consing.lisp:204]
  (DEFN SET-FROM-COLUMNS-V3
   ((MAT-TO-MUTATE MAT4) (COL-1 VEC3) (COL-2 VEC3) (COL-3 VEC3)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SET-COMPONENTS (X COL-1) (X COL-2) (X COL-3) 0.0 (Y COL-1) (Y COL-2)
    (Y COL-3) 0.0 (Z COL-1) (Z COL-2) (Z COL-3) 0.0 0.0 0.0 0.0 1.0
    MAT-TO-MUTATE))

[rtg-math/matrices/matrix4/non-consing.lisp:227]
  (DEFN ADJOINT ((MAT-TO-MUTATE MAT4)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SET-COMPONENTS (MINOR MAT-TO-MUTATE 1 2 3 1 2 3)
    (- (MINOR MAT-TO-MUTATE 0 2 3 1 2 3)) (MINOR MAT-TO-MUTATE 0 1 3 1 2 3)
    (- (MINOR MAT-TO-MUTATE 0 1 2 1 2 3)) (- (MINOR MAT-TO-MUTATE 1 2 3 0 2 3))
    (MINOR MAT-TO-MUTATE 0 2 3 0 2 3) (- (MINOR MAT-TO-MUTATE 0 1 3 0 2 3))
    (MINOR MAT-TO-MUTATE 0 1 2 0 2 3) (MINOR MAT-TO-MUTATE 1 2 3 0 1 3)
    (- (MINOR MAT-TO-MUTATE 0 2 3 0 1 3)) (MINOR MAT-TO-MUTATE 0 1 3 0 1 3)
    (- (MINOR MAT-TO-MUTATE 0 1 2 0 1 3)) (- (MINOR MAT-TO-MUTATE 1 2 3 0 1 2))
    (MINOR MAT-TO-MUTATE 0 2 3 0 1 2) (- (MINOR MAT-TO-MUTATE 0 1 3 0 1 2))
    (MINOR MAT-TO-MUTATE 0 1 2 0 1 2) MAT-TO-MUTATE))

[rtg-math/matrices/matrix4/non-consing.lisp:253]
  (DEFN AFFINE-INVERSE ((MAT-TO-INVERT MAT4)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET* ((COFAC-0
           (- (* (MELM MAT-TO-INVERT 1 1) (MELM MAT-TO-INVERT 2 2))
              (* (MELM MAT-TO-INVERT 2 1) (MELM MAT-TO-INVERT 1 2))))
          (COFAC-4
           (- (* (MELM MAT-TO-INVERT 2 0) (MELM MAT-TO-INVERT 1 2))
              (* (MELM MAT-TO-INVERT 1 0) (MELM MAT-TO-INVERT 2 2))))
          (COFAC-8
           (- (* (MELM MAT-TO-INVERT 1 0) (MELM MAT-TO-INVERT 2 1))
              (* (MELM MAT-TO-INVERT 2 0) (MELM MAT-TO-INVERT 1 1))))
          (DET
           (+ (* (MELM MAT-TO-INVERT 0 0) COFAC-0)
              (* (MELM MAT-TO-INVERT 0 1) COFAC-4)
              (* (MELM MAT-TO-INVERT 0 2) COFAC-8))))
     (IF (= 0.0 DET)
         (ERROR "Matrix4 Inverse: Singular Matrix")
         (LET* ((INV-DET (/ 1.0 DET))
                (R00 (* INV-DET COFAC-0))
                (R10 (* INV-DET COFAC-4))
                (R20 (* INV-DET COFAC-8))
                (R01
                 (* INV-DET
                    (- (* (MELM MAT-TO-INVERT 2 1) (MELM MAT-TO-INVERT 0 2))
                       (* (MELM MAT-TO-INVERT 0 1) (MELM MAT-TO-INVERT 2 2)))))
                (R11
                 (* INV-DET
                    (- (* (MELM MAT-TO-INVERT 0 0) (MELM MAT-TO-INVERT 2 2))
                       (* (MELM MAT-TO-INVERT 2 0) (MELM MAT-TO-INVERT 0 2)))))
                (R21
                 (* INV-DET
                    (- (* (MELM MAT-TO-INVERT 2 0) (MELM MAT-TO-INVERT 0 1))
                       (* (MELM MAT-TO-INVERT 0 0) (MELM MAT-TO-INVERT 2 1)))))
                (R02
                 (* INV-DET
                    (- (* (MELM MAT-TO-INVERT 0 1) (MELM MAT-TO-INVERT 1 2))
                       (* (MELM MAT-TO-INVERT 1 1) (MELM MAT-TO-INVERT 0 2)))))
                (R12
                 (* INV-DET
                    (- (* (MELM MAT-TO-INVERT 1 0) (MELM MAT-TO-INVERT 0 2))
                       (* (MELM MAT-TO-INVERT 0 0) (MELM MAT-TO-INVERT 1 2)))))
                (R22
                 (* INV-DET
                    (- (* (MELM MAT-TO-INVERT 0 0) (MELM MAT-TO-INVERT 1 1))
                       (* (MELM MAT-TO-INVERT 1 0) (MELM MAT-TO-INVERT 0 1))))))
           (SET-COMPONENTS R00 R01 R02
            (- 0.0 (* (MELM MAT-TO-INVERT 0 0) (MELM MAT-TO-INVERT 0 3))
               (* (MELM MAT-TO-INVERT 0 1) (MELM MAT-TO-INVERT 1 3))
               (* (MELM MAT-TO-INVERT 0 2) (MELM MAT-TO-INVERT 2 3)))
            R10 R11 R12
            (- 0.0 (* (MELM MAT-TO-INVERT 1 0) (MELM MAT-TO-INVERT 0 3))
               (* (MELM MAT-TO-INVERT 1 1) (MELM MAT-TO-INVERT 1 3))
               (* (MELM MAT-TO-INVERT 1 2) (MELM MAT-TO-INVERT 2 3)))
            R20 R21 R22
            (- 0.0 (* (MELM MAT-TO-INVERT 2 0) (MELM MAT-TO-INVERT 0 3))
               (* (MELM MAT-TO-INVERT 2 1) (MELM MAT-TO-INVERT 1 3))
               (* (MELM MAT-TO-INVERT 2 2) (MELM MAT-TO-INVERT 2 3)))
            0.0 0.0 0.0 1.0 MAT-TO-INVERT)))))

[rtg-math/matrices/matrix4/non-consing.lisp:309]
  (DEFN TRANSPOSE ((MAT-TO-TRANSPOSE MAT4)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SET-COMPONENTS (MELM MAT-TO-TRANSPOSE 0 0) (MELM MAT-TO-TRANSPOSE 1 0)
    (MELM MAT-TO-TRANSPOSE 2 0) (MELM MAT-TO-TRANSPOSE 3 0)
    (MELM MAT-TO-TRANSPOSE 0 1) (MELM MAT-TO-TRANSPOSE 1 1)
    (MELM MAT-TO-TRANSPOSE 2 1) (MELM MAT-TO-TRANSPOSE 3 1)
    (MELM MAT-TO-TRANSPOSE 0 2) (MELM MAT-TO-TRANSPOSE 1 2)
    (MELM MAT-TO-TRANSPOSE 2 2) (MELM MAT-TO-TRANSPOSE 3 2)
    (MELM MAT-TO-TRANSPOSE 0 3) (MELM MAT-TO-TRANSPOSE 1 3)
    (MELM MAT-TO-TRANSPOSE 2 3) (MELM MAT-TO-TRANSPOSE 3 3) MAT-TO-TRANSPOSE))

[rtg-math/matrices/matrix4/non-consing.lisp:320]
  (DEFN SET-FROM-TRANSLATION
   ((MAT-TO-MUTATE MAT4) (VEC-A (SIMPLE-ARRAY SINGLE-FLOAT))) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SET-COMPONENTS 1.0 0.0 0.0 (X VEC-A) 0.0 1.0 0.0 (Y VEC-A) 0.0 0.0 1.0
    (Z VEC-A) 0.0 0.0 0.0 1.0 MAT-TO-MUTATE))

[rtg-math/matrices/matrix4/non-consing.lisp:332]
  (DEFN SET-ROTATION-FROM-EULER ((MAT-TO-MUTATE MAT4) (VEC3-A VEC3)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((X (X VEC3-A)) (Y (Y VEC3-A)) (Z (Z VEC3-A)))
     (LET ((SX (SIN X))
           (CX (COS X))
           (SY (SIN Y))
           (CY (COS Y))
           (SZ (SIN Z))
           (CZ (COS Z)))
       (SET-COMPONENTS (* CY CZ) (- (* CY SZ)) SY 0.0
        (+ (* SX SY CZ) (* CX SZ)) (- (* CX CZ) (* SX SY SZ)) (- (* SX CY)) 0.0
        (- (* SX SZ) (* CX SY CZ)) (+ (* CX SY SZ) (* SX CZ)) (* CX CY) 0.0 0.0
        0.0 0.0 1.0 MAT-TO-MUTATE))))

[rtg-math/matrices/matrix4/non-consing.lisp:361]
  (DEFN SET-FROM-SCALE ((MAT-TO-MUTATE MAT4) (SCALE-VEC3 VEC3)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SET-COMPONENTS (X SCALE-VEC3) 0.0 0.0 0.0 0.0 (Y SCALE-VEC3) 0.0 0.0 0.0
    0.0 (Z SCALE-VEC3) 0.0 0.0 0.0 0.0 1.0 MAT-TO-MUTATE))

[rtg-math/matrices/matrix4/non-consing.lisp:372]
  (DEFN SET-FROM-ROTATION-X ((MAT-TO-MUTATE MAT4) (ANGLE SINGLE-FLOAT)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((S-A (SIN ANGLE)) (C-A (COS ANGLE)))
     (SET-COMPONENTS 1.0 0.0 0.0 0.0 0.0 C-A (- S-A) 0.0 0.0 S-A C-A 0.0 0.0
      0.0 0.0 1.0 MAT-TO-MUTATE)))

[rtg-math/matrices/matrix4/non-consing.lisp:384]
  (DEFN SET-FROM-ROTATION-Y ((MAT-TO-MUTATE MAT4) (ANGLE SINGLE-FLOAT)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((S-A (SIN ANGLE)) (C-A (COS ANGLE)))
     (SET-COMPONENTS C-A 0.0 S-A 0.0 0.0 1.0 0.0 0.0 (- S-A) 0.0 C-A 0.0 0.0
      0.0 0.0 1.0 MAT-TO-MUTATE)))

[rtg-math/matrices/matrix4/non-consing.lisp:396]
  (DEFN SET-FROM-ROTATION-Z ((MAT-TO-MUTATE MAT4) (ANGLE SINGLE-FLOAT)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((S-A (SIN ANGLE)) (C-A (COS ANGLE)))
     (SET-COMPONENTS C-A (- S-A) 0.0 0.0 S-A C-A 0.0 0.0 0.0 0.0 1.0 0.0 0.0
      0.0 0.0 1.0 MAT-TO-MUTATE)))

[rtg-math/matrices/matrix4/non-consing.lisp:408]
  (DEFN SET-ROTATION-FROM-AXIS-ANGLE
   ((MAT-TO-MUTATE MAT4) (AXIS3 VEC3) (ANGLE SINGLE-FLOAT)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET* ((C (COS ANGLE)) (S (SIN ANGLE)) (G (- 1.0 C)))
     (LET* ((NAXIS3
             (#S(FORMGREP:SYMREF :NAME "NORMALIZE" :QUALIFIER "V3") AXIS3))
            (X (X NAXIS3))
            (Y (Y NAXIS3))
            (Z (Z NAXIS3))
            (GXX (* G X X))
            (GXY (* G X Y))
            (GXZ (* G X Z))
            (GYY (* G Y Y))
            (GYZ (* G Y Z))
            (GZZ (* G Z Z)))
       (SET-COMPONENTS (+ GXX C) (- GXY (* S Z)) (+ GXZ (* S Y)) 0.0
        (+ GXY (* S Z)) (+ GYY C) (- GYZ (* S X)) 0.0 (- GXZ (* S Y))
        (+ GYZ (* S X)) (+ GZZ C) 0.0 0.0 0.0 0.0 1.0 MAT-TO-MUTATE))))

[rtg-math/matrices/matrix4/non-consing.lisp:433]
  (DEFN + ((MAT-ACCUM MAT4) (MAT-B MAT4)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LOOP :FOR I :BELOW 16
         :DO (INCF (AREF MAT-ACCUM I) (AREF MAT-B I)))
   MAT-ACCUM)

[rtg-math/matrices/matrix4/non-consing.lisp:441]
  (DEFN - ((MAT-ACCUM MAT4) (MAT-B MAT4)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LOOP :FOR I :BELOW 16
         :DO (DECF (AREF MAT-ACCUM I) (AREF MAT-B I)))
   MAT-ACCUM)

[rtg-math/matrices/matrix4/non-consing.lisp:449]
  (DEFN NEGATE ((MAT-TO-NEGATE MAT4)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LOOP :FOR I :BELOW 16
         :DO (SETF (AREF MAT-TO-NEGATE I) (- (AREF MAT-TO-NEGATE I))))
   MAT-TO-NEGATE)

[rtg-math/matrices/matrix4/non-consing.lisp:457]
  (DEFN *S ((MAT-TO-MUTATE MAT4) (SCALAR SINGLE-FLOAT)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LOOP :FOR I :BELOW 16
         :DO (SETF (AREF MAT-TO-MUTATE I) (* SCALAR (AREF MAT-TO-MUTATE I))))
   MAT-TO-MUTATE)

[rtg-math/matrices/matrix4/non-consing.lisp:465]
  (DEFN *V ((MAT-A MAT4) (VEC4-TO-MUTATE VEC4)) VEC4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (#S(FORMGREP:SYMREF :NAME "SET-COMPONENTS" :QUALIFIER "V4-N")
    (+ (* (X VEC4-TO-MUTATE) (MELM MAT-A 0 0))
       (* (Y VEC4-TO-MUTATE) (MELM MAT-A 0 1))
       (* (Z VEC4-TO-MUTATE) (MELM MAT-A 0 2))
       (* (W VEC4-TO-MUTATE) (MELM MAT-A 0 3)))
    (+ (* (X VEC4-TO-MUTATE) (MELM MAT-A 1 0))
       (* (Y VEC4-TO-MUTATE) (MELM MAT-A 1 1))
       (* (Z VEC4-TO-MUTATE) (MELM MAT-A 1 2))
       (* (W VEC4-TO-MUTATE) (MELM MAT-A 1 3)))
    (+ (* (X VEC4-TO-MUTATE) (MELM MAT-A 2 0))
       (* (Y VEC4-TO-MUTATE) (MELM MAT-A 2 1))
       (* (Z VEC4-TO-MUTATE) (MELM MAT-A 2 2))
       (* (W VEC4-TO-MUTATE) (MELM MAT-A 2 3)))
    (+ (* (X VEC4-TO-MUTATE) (MELM MAT-A 3 0))
       (* (Y VEC4-TO-MUTATE) (MELM MAT-A 3 1))
       (* (Z VEC4-TO-MUTATE) (MELM MAT-A 3 2))
       (* (W VEC4-TO-MUTATE) (MELM MAT-A 3 3)))
    VEC4-TO-MUTATE))

[rtg-math/matrices/matrix4/non-consing.lisp:486]
  (DEFN *V3 ((MAT-A MAT4) (VEC3-TO-MUTATE VEC3)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (#S(FORMGREP:SYMREF :NAME "SET-COMPONENTS" :QUALIFIER "V3-N")
    (+ (* (MELM MAT-A 0 0) (X VEC3-TO-MUTATE))
       (* (MELM MAT-A 0 1) (Y VEC3-TO-MUTATE))
       (* (MELM MAT-A 0 2) (Z VEC3-TO-MUTATE)) (MELM MAT-A 0 3))
    (+ (* (MELM MAT-A 1 0) (X VEC3-TO-MUTATE))
       (* (MELM MAT-A 1 1) (Y VEC3-TO-MUTATE))
       (* (MELM MAT-A 1 2) (Z VEC3-TO-MUTATE)) (MELM MAT-A 1 3))
    (+ (* (MELM MAT-A 2 0) (X VEC3-TO-MUTATE))
       (* (MELM MAT-A 2 1) (Y VEC3-TO-MUTATE))
       (* (MELM MAT-A 2 2) (Z VEC3-TO-MUTATE)) (MELM MAT-A 2 3))
    VEC3-TO-MUTATE))

[rtg-math/matrices/matrix4/non-consing.lisp:505]
  (DEFN MROW*VEC4 ((VEC4-TO-MUTATE VEC4) (MAT-A MAT4)) VEC4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (#S(FORMGREP:SYMREF :NAME "SET-COMPONENTS" :QUALIFIER "V4-N")
    (+ (* (X VEC4-TO-MUTATE) (MELM MAT-A 0 0))
       (* (Y VEC4-TO-MUTATE) (MELM MAT-A 1 0))
       (* (Z VEC4-TO-MUTATE) (MELM MAT-A 2 0))
       (* (W VEC4-TO-MUTATE) (MELM MAT-A 3 0)))
    (+ (* (X VEC4-TO-MUTATE) (MELM MAT-A 0 1))
       (* (Y VEC4-TO-MUTATE) (MELM MAT-A 1 1))
       (* (Z VEC4-TO-MUTATE) (MELM MAT-A 2 1))
       (* (W VEC4-TO-MUTATE) (MELM MAT-A 3 1)))
    (+ (* (X VEC4-TO-MUTATE) (MELM MAT-A 0 2))
       (* (Y VEC4-TO-MUTATE) (MELM MAT-A 1 2))
       (* (Z VEC4-TO-MUTATE) (MELM MAT-A 2 2))
       (* (W VEC4-TO-MUTATE) (MELM MAT-A 3 2)))
    (+ (* (X VEC4-TO-MUTATE) (MELM MAT-A 0 3))
       (* (Y VEC4-TO-MUTATE) (MELM MAT-A 1 3))
       (* (Z VEC4-TO-MUTATE) (MELM MAT-A 2 3))
       (* (W VEC4-TO-MUTATE) (MELM MAT-A 3 3)))
    VEC4-TO-MUTATE))

[rtg-math/projection/orthographic/consing.lisp:5]
  (DEFN ORTHOGRAPHIC
   ((FRAME-WIDTH SINGLE-FLOAT) (FRAME-HEIGHT SINGLE-FLOAT) (NEAR SINGLE-FLOAT)
    (FAR SINGLE-FLOAT))
   MAT4 (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((LEFT (- (/ FRAME-WIDTH 2.0)))
         (RIGHT (/ FRAME-WIDTH 2.0))
         (TOP (/ FRAME-HEIGHT 2.0))
         (BOTTOM (- (/ FRAME-HEIGHT 2.0)))
         (RESULT (#S(FORMGREP:SYMREF :NAME "0!" :QUALIFIER "M4"))))
     (SETF (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M4") RESULT 0 0)
             (/ 2.0 (- RIGHT LEFT))
           (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M4") RESULT 1 1)
             (/ 2.0 (- TOP BOTTOM))
           (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M4") RESULT 0 3)
             (- (/ (+ RIGHT LEFT) (- RIGHT LEFT)))
           (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M4") RESULT 1 3)
             (- (/ (+ TOP BOTTOM) (- TOP BOTTOM)))
           (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M4") RESULT 2 2)
             (/ -2.0 (- FAR NEAR))
           (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M4") RESULT 2 3)
             (- (/ (+ FAR NEAR) (- FAR NEAR)))
           (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M4") RESULT 3 3) 1.0)
     RESULT))

[rtg-math/projection/orthographic/consing.lisp:23]
  (DEFN ORTHOGRAPHIC-V2
   ((FRAME-SIZE-V2 VEC2) (NEAR SINGLE-FLOAT) (FAR SINGLE-FLOAT)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (ORTHOGRAPHIC (X FRAME-SIZE-V2) (Y FRAME-SIZE-V2) NEAR FAR))

[rtg-math/projection/orthographic/non-consing.lisp:5]
  (DEFN ORTHOGRAPHIC
   ((MAT4-TO-MUTATE MAT4) (FRAME-WIDTH SINGLE-FLOAT)
    (FRAME-HEIGHT SINGLE-FLOAT) (NEAR SINGLE-FLOAT) (FAR SINGLE-FLOAT))
   MAT4 (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((LEFT (- (/ FRAME-WIDTH 2.0)))
         (RIGHT (/ FRAME-WIDTH 2.0))
         (TOP (/ FRAME-HEIGHT 2.0))
         (BOTTOM (- (/ FRAME-HEIGHT 2.0))))
     (#S(FORMGREP:SYMREF :NAME "SET-COMPONENTS" :QUALIFIER "M4-N")
      (/ 2.0 (- RIGHT LEFT)) 0.0 0.0 (- (/ (+ RIGHT LEFT) (- RIGHT LEFT))) 0.0
      (/ 2.0 (- TOP BOTTOM)) 0.0 (- (/ (+ TOP BOTTOM) (- TOP BOTTOM))) 0.0 0.0
      (/ -2.0 (- FAR NEAR)) (- (/ (+ FAR NEAR) (- FAR NEAR))) 0.0 0.0 0.0 1.0
      MAT4-TO-MUTATE)))

[rtg-math/projection/orthographic/non-consing.lisp:33]
  (DEFN ORTHOGRAPHIC-V2
   ((MAT4-TO-MUTATE MAT4) (FRAME-SIZE-V2 VEC2) (NEAR SINGLE-FLOAT)
    (FAR SINGLE-FLOAT))
   MAT4 (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (ORTHOGRAPHIC MAT4-TO-MUTATE (X FRAME-SIZE-V2) (Y FRAME-SIZE-V2) NEAR FAR))

[rtg-math/projection/perspective/consing.lisp:6]
  (DEFN PERSPECTIVE-RADIAN-FOV
   ((WIDTH SINGLE-FLOAT) (HEIGHT SINGLE-FLOAT) (NEAR SINGLE-FLOAT)
    (FAR SINGLE-FLOAT) (FOV SINGLE-FLOAT))
   MAT4 (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET* ((ASPECT (/ WIDTH HEIGHT))
          (TAN-HALF-FOV (TAN (/ FOV 2.0)))
          (RESULT (#S(FORMGREP:SYMREF :NAME "0!" :QUALIFIER "M4"))))
     (SETF (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M4") RESULT 0 0)
             (/ 1.0 (* ASPECT TAN-HALF-FOV))
           (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M4") RESULT 1 1)
             (/ 1.0 TAN-HALF-FOV)
           (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M4") RESULT 2 2)
             (- (/ (+ FAR NEAR) (- FAR NEAR)))
           (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M4") RESULT 2 3)
             (- (/ (* 2.0 FAR NEAR) (- FAR NEAR)))
           (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M4") RESULT 3 2) -1.0)
     RESULT))

[rtg-math/projection/perspective/consing.lisp:24]
  (DEFN PERSPECTIVE
   ((WIDTH SINGLE-FLOAT) (HEIGHT SINGLE-FLOAT) (NEAR SINGLE-FLOAT)
    (FAR SINGLE-FLOAT) (FOV-DEGREES SINGLE-FLOAT))
   MAT4 (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (PERSPECTIVE-RADIAN-FOV WIDTH HEIGHT NEAR FAR (RADIANS FOV-DEGREES)))

[rtg-math/projection/perspective/consing.lisp:31]
  (DEFN PERSPECTIVE-V2
   ((FRAME-SIZE-V2 VEC2) (NEAR SINGLE-FLOAT) (FAR SINGLE-FLOAT)
    (FOV-DEGREES SINGLE-FLOAT))
   MAT4 (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (PERSPECTIVE-RADIAN-FOV (X FRAME-SIZE-V2) (Y FRAME-SIZE-V2) NEAR FAR
    (RADIANS FOV-DEGREES)))

[rtg-math/projection/perspective/consing.lisp:39]
  (DEFN PERSPECTIVE-V2-RADIAN-FOV
   ((FRAME-SIZE-V2 VEC2) (NEAR SINGLE-FLOAT) (FAR SINGLE-FLOAT)
    (FOV-RADIANS SINGLE-FLOAT))
   MAT4 (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (PERSPECTIVE-RADIAN-FOV (X FRAME-SIZE-V2) (Y FRAME-SIZE-V2) NEAR FAR
    FOV-RADIANS))

[rtg-math/projection/perspective/non-consing.lisp:6]
  (DEFN PERSPECTIVE-RADIAN-FOV
   ((MAT-TO-MUTATE MAT4) (WIDTH SINGLE-FLOAT) (HEIGHT SINGLE-FLOAT)
    (NEAR SINGLE-FLOAT) (FAR SINGLE-FLOAT) (FOV SINGLE-FLOAT))
   MAT4 (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET* ((ASPECT (/ WIDTH HEIGHT))
          (TAN-HALF-FOV (TAN (/ FOV 2.0)))
          (RESULT (#S(FORMGREP:SYMREF :NAME "0!" :QUALIFIER "M4"))))
     (#S(FORMGREP:SYMREF :NAME "SET-COMPONENTS" :QUALIFIER "M4-N")
      (/ 1.0 (* ASPECT TAN-HALF-FOV)) 0.0 0.0 0.0 0.0 (/ 1.0 TAN-HALF-FOV) 0.0
      0.0 0.0 0.0 (- (/ (+ FAR NEAR) (- FAR NEAR)))
      (- (/ (* 2.0 FAR NEAR) (- FAR NEAR))) 0.0 0.0 -1.0 0.0 MAT-TO-MUTATE)
     RESULT))

[rtg-math/projection/perspective/non-consing.lisp:38]
  (DEFN PERSPECTIVE
   ((MAT-TO-MUTATE MAT4) (WIDTH SINGLE-FLOAT) (HEIGHT SINGLE-FLOAT)
    (NEAR SINGLE-FLOAT) (FAR SINGLE-FLOAT) (FOV-DEGREES SINGLE-FLOAT))
   MAT4 (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (PERSPECTIVE-RADIAN-FOV MAT-TO-MUTATE WIDTH HEIGHT NEAR FAR
    (RADIANS FOV-DEGREES)))

[rtg-math/projection/perspective/non-consing.lisp:47]
  (DEFN PERSPECTIVE-V2
   ((MAT-TO-MUTATE MAT4) (FRAME-SIZE-V2 VEC2) (NEAR SINGLE-FLOAT)
    (FAR SINGLE-FLOAT) (FOV-DEGREES SINGLE-FLOAT))
   MAT4 (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (PERSPECTIVE-RADIAN-FOV MAT-TO-MUTATE (X FRAME-SIZE-V2) (Y FRAME-SIZE-V2)
    NEAR FAR (RADIANS FOV-DEGREES)))

[rtg-math/projection/perspective/non-consing.lisp:57]
  (DEFN PERSPECTIVE-V2-RADIAN-FOV
   ((MAT-TO-MUTATE MAT4) (FRAME-SIZE-V2 VEC2) (NEAR SINGLE-FLOAT)
    (FAR SINGLE-FLOAT) (FOV-DEGREES SINGLE-FLOAT))
   MAT4 (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (PERSPECTIVE-RADIAN-FOV MAT-TO-MUTATE (X FRAME-SIZE-V2) (Y FRAME-SIZE-V2)
    NEAR FAR FOV-DEGREES))

[rtg-math/quaternions/common.lisp:5]
  (DEFN-INLINE W ((QUAT QUATERNION)) SINGLE-FLOAT
   "Returns the w component of the quaternion"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))) (AREF QUAT 0))

[rtg-math/quaternions/common.lisp:10]
  (DEFN-INLINE X ((QUAT QUATERNION)) SINGLE-FLOAT
   "Returns the x component of the quaternion"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))) (AREF QUAT 1))

[rtg-math/quaternions/common.lisp:15]
  (DEFN-INLINE Y ((QUAT QUATERNION)) SINGLE-FLOAT
   "Returns the y component of the quaternion"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))) (AREF QUAT 2))

[rtg-math/quaternions/common.lisp:20]
  (DEFN-INLINE Z ((QUAT QUATERNION)) SINGLE-FLOAT
   "Returns the z component of the quaternion"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))) (AREF QUAT 3))

[rtg-math/quaternions/common.lisp:25]
  (DEFN-INLINE (SETF W) ((VALUE SINGLE-FLOAT) (QUAT QUATERNION)) SINGLE-FLOAT
   "Returns the w component of the quaternion"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SETF (AREF QUAT 0) VALUE))

[rtg-math/quaternions/common.lisp:31]
  (DEFN-INLINE (SETF X) ((VALUE SINGLE-FLOAT) (QUAT QUATERNION)) SINGLE-FLOAT
   "Returns the x component of the quaternion"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SETF (AREF QUAT 1) VALUE))

[rtg-math/quaternions/common.lisp:37]
  (DEFN-INLINE (SETF Y) ((VALUE SINGLE-FLOAT) (QUAT QUATERNION)) SINGLE-FLOAT
   "Returns the y component of the quaternion"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SETF (AREF QUAT 2) VALUE))

[rtg-math/quaternions/common.lisp:43]
  (DEFN-INLINE (SETF Z) ((VALUE SINGLE-FLOAT) (QUAT QUATERNION)) SINGLE-FLOAT
   "Returns the z component of the quaternion"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SETF (AREF QUAT 3) VALUE))

[rtg-math/quaternions/common.lisp:51]
  (DEFN DOT ((QUAT-A QUATERNION) (QUAT-B QUATERNION)) SINGLE-FLOAT
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   "return the dot product of the quat-a and quat-b."
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (+ (* (W QUAT-A) (W QUAT-B)) (* (X QUAT-A) (X QUAT-B))
      (* (Y QUAT-A) (Y QUAT-B)) (* (Z QUAT-A) (Z QUAT-B))))

[rtg-math/quaternions/consing.lisp:5]
  (DEFN Q!
   ((W SINGLE-FLOAT) (X SINGLE-FLOAT) (Y SINGLE-FLOAT) (Z SINGLE-FLOAT))
   QUATERNION (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((Q
          (MAKE-ARRAY 4 :ELEMENT-TYPE
                      (ECLECTOR.READER:QUASIQUOTE SINGLE-FLOAT))))
     (SETF (AREF Q 0) W
           (AREF Q 1) X
           (AREF Q 2) Y
           (AREF Q 3) Z)
     Q))

[rtg-math/quaternions/consing.lisp:15]
  (DEFN MAKE
   ((W SINGLE-FLOAT) (X SINGLE-FLOAT) (Y SINGLE-FLOAT) (Z SINGLE-FLOAT))
   QUATERNION (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((Q
          (MAKE-ARRAY 4 :ELEMENT-TYPE
                      (ECLECTOR.READER:QUASIQUOTE SINGLE-FLOAT))))
     (SETF (AREF Q 0) W
           (AREF Q 1) X
           (AREF Q 2) Y
           (AREF Q 3) Z)
     Q))

[rtg-math/quaternions/consing.lisp:28]
  (DEFN ROTATE ((VEC3 VEC3) (QUAT QUATERNION)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET* ((V-MULT
           (* 2.0
              (+ (* (X QUAT) (AREF VEC3 0)) (* (Y QUAT) (AREF VEC3 1))
                 (* (Z QUAT) (AREF VEC3 2)))))
          (CROSS-MULT (* 2.0 (W QUAT)))
          (P-MULT (- (* CROSS-MULT (W QUAT)) 1.0)))
     (#S(FORMGREP:SYMREF :NAME "MAKE" :QUALIFIER "V3")
      (+ (* P-MULT (AREF VEC3 0)) (* V-MULT (X QUAT))
         (* CROSS-MULT
            (- (* (Y QUAT) (AREF VEC3 2)) (* (Z QUAT) (AREF VEC3 1)))))
      (+ (* P-MULT (AREF VEC3 1)) (* V-MULT (Y QUAT))
         (* CROSS-MULT
            (- (* (Z QUAT) (AREF VEC3 0)) (* (X QUAT) (AREF VEC3 2)))))
      (+ (* P-MULT (AREF VEC3 2)) (* V-MULT (Z QUAT))
         (* CROSS-MULT
            (- (* (X QUAT) (AREF VEC3 1)) (* (Y QUAT) (AREF VEC3 0))))))))

[rtg-math/quaternions/consing.lisp:51]
  (DEFN ROTATE-V4 ((VEC4 VEC4) (QUAT QUATERNION)) VEC4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET* ((V-MULT
           (* 2.0
              (+ (* (X QUAT) (AREF VEC4 0)) (* (Y QUAT) (AREF VEC4 1))
                 (* (Z QUAT) (AREF VEC4 2)))))
          (CROSS-MULT (* 2.0 (W QUAT)))
          (P-MULT (- (* CROSS-MULT (W QUAT)) 1.0)))
     (#S(FORMGREP:SYMREF :NAME "MAKE" :QUALIFIER "V4")
      (+ (* P-MULT (AREF VEC4 0)) (* V-MULT (X QUAT))
         (* CROSS-MULT
            (- (* (Y QUAT) (AREF VEC4 2)) (* (Z QUAT) (AREF VEC4 1)))))
      (+ (* P-MULT (AREF VEC4 1)) (* V-MULT (Y QUAT))
         (* CROSS-MULT
            (- (* (Z QUAT) (AREF VEC4 0)) (* (X QUAT) (AREF VEC4 2)))))
      (+ (* P-MULT (AREF VEC4 2)) (* V-MULT (Z QUAT))
         (* CROSS-MULT
            (- (* (X QUAT) (AREF VEC4 1)) (* (Y QUAT) (AREF VEC4 0)))))
      (AREF VEC4 3))))

[rtg-math/quaternions/consing.lisp:77]
  (DEFN-INLINE 0! NIL QUATERNION
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE-ARRAY 4 :ELEMENT-TYPE 'SINGLE-FLOAT :INITIAL-ELEMENT 0.0))

[rtg-math/quaternions/consing.lisp:81]
  (DEFN |0P| ((QUAT QUATERNION)) BOOLEAN
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((W (W QUAT)) (X (X QUAT)) (Y (Y QUAT)) (Z (Z QUAT)))
     (= 0.0 (+ (* W W) (* X X) (* Y Y) (* Z Z)))))

[rtg-math/quaternions/consing.lisp:86]
  (DEFN UNITP ((QUAT QUATERNION)) BOOLEAN
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((W (W QUAT)) (X (X QUAT)) (Y (Y QUAT)) (Z (Z QUAT)))
     (= 0.0 (- 1.0 (* W W) (* X X) (* Y Y) (* Z Z)))))

[rtg-math/quaternions/consing.lisp:91]
  (DEFN IDENTITY NIL QUATERNION
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))) (Q! 1.0 0.0 0.0 0.0))

[rtg-math/quaternions/consing.lisp:95]
  (DEFN IDENTITY-P ((QUAT QUATERNION)) BOOLEAN
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (AND (= 0.0 (- 1.0 (W QUAT))) (= 0.0 (X QUAT)) (= 0.0 (Y QUAT))
        (= 0.0 (Z QUAT))))

[rtg-math/quaternions/consing.lisp:102]
  (DEFN FROM-MAT3 ((MAT3 MAT3)) QUATERNION
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (#S(FORMGREP:SYMREF :NAME "FROM-MAT3" :QUALIFIER "Q-N") (0!) MAT3))

[rtg-math/quaternions/consing.lisp:106]
  (DEFN FROM-AXIS-ANGLE ((AXIS-VEC3 VEC3) (ANGLE SINGLE-FLOAT)) QUATERNION
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (#S(FORMGREP:SYMREF :NAME "FROM-AXIS-ANGLE" :QUALIFIER "Q-N") (0!) AXIS-VEC3
    ANGLE))

[rtg-math/quaternions/consing.lisp:110]
  (DEFN FROM-AXIES ((X-AXIES VEC3) (Y-AXIES VEC3) (Z-AXIES VEC3)) QUATERNION
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (FROM-MAT3
    (#S(FORMGREP:SYMREF :NAME "MAKE" :QUALIFIER "M3") (AREF X-AXIES 0)
     (AREF Y-AXIES 1) (AREF Z-AXIES 2) (AREF X-AXIES 0) (AREF Y-AXIES 1)
     (AREF Z-AXIES 2) (AREF X-AXIES 0) (AREF Y-AXIES 1) (AREF Z-AXIES 2))))

[rtg-math/quaternions/consing.lisp:118]
  (DEFN LOOK-AT ((UP3 VEC3) (FROM3 VEC3) (TO3 VEC3)) QUATERNION
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (FROM-MAT3
    (#S(FORMGREP:SYMREF :NAME "LOOK-AT" :QUALIFIER "M3") UP3 FROM3 TO3)))

[rtg-math/quaternions/consing.lisp:123]
  (DEFN POINT-AT ((UP3 VEC3) (FROM3 VEC3) (TO3 VEC3)) QUATERNION
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (FROM-MAT3
    (#S(FORMGREP:SYMREF :NAME "POINT-AT" :QUALIFIER "M3") UP3 FROM3 TO3)))

[rtg-math/quaternions/consing.lisp:128]
  (DEFN FROM-DIRECTION ((UP3 VEC3) (DIR3 VEC3)) QUATERNION
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (FROM-MAT3
    (#S(FORMGREP:SYMREF :NAME "FROM-DIRECTION" :QUALIFIER "M3") UP3 DIR3)))

[rtg-math/quaternions/consing.lisp:133]
  (DEFN TO-DIRECTION ((QUAT QUATERNION)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((V (#S(FORMGREP:SYMREF :NAME "MAKE" :QUALIFIER "V3") 0.0 0.0 -1.0)))
     (ROTATE V QUAT)))

[rtg-math/quaternions/consing.lisp:138]
  (DEFN TO-DIRECTION-VEC4 ((QUAT QUATERNION)) VEC4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((V
          (#S(FORMGREP:SYMREF :NAME "MAKE" :QUALIFIER "V4") 0.0 0.0 -1.0 0.0)))
     (ROTATE-V4 V QUAT)))

[rtg-math/quaternions/consing.lisp:143]
  (DEFN FROM-FIXED-ANGLES
   ((X-ROT SINGLE-FLOAT) (Y-ROT SINGLE-FLOAT) (Z-ROT SINGLE-FLOAT)) QUATERNION
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (#S(FORMGREP:SYMREF :NAME "FROM-FIXED-ANGLES" :QUALIFIER "Q-N") (0!) X-ROT
    Y-ROT Z-ROT))

[rtg-math/quaternions/consing.lisp:148]
  (DEFN FROM-FIXED-ANGLES-V3 ((ANGLES VEC3)) QUATERNION
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (FROM-FIXED-ANGLES (#S(FORMGREP:SYMREF :NAME "X" :QUALIFIER "V") ANGLES)
    (#S(FORMGREP:SYMREF :NAME "Y" :QUALIFIER "V") ANGLES)
    (#S(FORMGREP:SYMREF :NAME "Z" :QUALIFIER "V") ANGLES)))

[rtg-math/quaternions/consing.lisp:152]
  (DEFN MAGNITUDE ((QUAT QUATERNION)) SINGLE-FLOAT
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((W (W QUAT)) (X (X QUAT)) (Y (Y QUAT)) (Z (Z QUAT)))
     (SQRT (+ (* W W) (* X X) (* Y Y) (* Z Z)))))

[rtg-math/quaternions/consing.lisp:157]
  (DEFN NORM ((QUAT QUATERNION)) SINGLE-FLOAT
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((W (W QUAT)) (X (X QUAT)) (Y (Y QUAT)) (Z (Z QUAT)))
     (+ (* W W) (* X X) (* Y Y) (* Z Z))))

[rtg-math/quaternions/consing.lisp:162]
  (DEFN = ((Q1 QUATERNION) (Q2 QUATERNION)) BOOLEAN
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (AND (= 0.0 (- (W Q2) (W Q1))) (= 0.0 (- (X Q2) (X Q1)))
        (= 0.0 (- (Y Q2) (Y Q1))) (= 0.0 (- (Z Q2) (Z Q1)))))

[rtg-math/quaternions/consing.lisp:169]
  (DEFN /= ((Q1 QUATERNION) (Q2 QUATERNION)) BOOLEAN
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (NOT
    (OR (= 0.0 (- (W Q2) (W Q1))) (= 0.0 (- (X Q2) (X Q1)))
        (= 0.0 (- (Y Q2) (Y Q1))) (= 0.0 (- (Z Q2) (Z Q1))))))

[rtg-math/quaternions/consing.lisp:176]
  (DEFN COPY ((QUAT QUATERNION)) QUATERNION
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (Q! (W QUAT) (X QUAT) (Y QUAT) (Z QUAT)))

[rtg-math/quaternions/consing.lisp:180]
  (DEFN GET-AXIS-ANGLE ((QUAT QUATERNION)) LIST
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((W (W QUAT)))
     (DECLARE (TYPE (SINGLE-FLOAT -1.0 1.0) W))
     (LIST
      (LET ((LENGTH (SQRT (- 1.0 (* W W)))))
        (IF (= 0.0 LENGTH)
            (#S(FORMGREP:SYMREF :NAME "MAKE" :QUALIFIER "V3") 0.0 0.0 0.0)
            (LET ((LENGTH (/ 1.0 LENGTH)))
              (#S(FORMGREP:SYMREF :NAME "MAKE" :QUALIFIER "V3")
               (* LENGTH (X QUAT)) (* LENGTH (Y QUAT)) (* LENGTH (Z QUAT))))))
      (* 2.0 (ACOS W)))))

[rtg-math/quaternions/consing.lisp:194]
  (DEFN NORMALIZE ((QUAT QUATERNION)) QUATERNION
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((LENGTH-SQUARED (DOT QUAT QUAT)))
     (DECLARE ((SINGLE-FLOAT 0.0 NIL) LENGTH-SQUARED))
     (IF (= 0.0 LENGTH-SQUARED)
         (0!)
         (LET ((FACTOR (INV-SQRT LENGTH-SQUARED)))
           (Q! (* (W QUAT) FACTOR) (* (X QUAT) FACTOR) (* (Y QUAT) FACTOR)
            (* (Z QUAT) FACTOR))))))

[rtg-math/quaternions/consing.lisp:207]
  (DEFN QCONJUGATE ((QUAT QUATERNION)) QUATERNION
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (Q! (W QUAT) (- (X QUAT)) (- (Y QUAT)) (- (Z QUAT))))

[rtg-math/quaternions/consing.lisp:211]
  (DEFN CONJUGATE ((QUAT QUATERNION)) QUATERNION
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (Q! (W QUAT) (- (X QUAT)) (- (Y QUAT)) (- (Z QUAT))))

[rtg-math/quaternions/consing.lisp:215]
  (DEFN INVERSE ((QUAT QUATERNION)) QUATERNION
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((NORM (NORM QUAT)))
     (IF (= 0.0 NORM)
         (IDENTITY)
         (LET ((NORM-RECIP (/ 1.0 NORM)))
           (Q! (* NORM-RECIP (W QUAT)) (- (* NORM-RECIP (X QUAT)))
            (- (* NORM-RECIP (Y QUAT))) (- (* NORM-RECIP (Z QUAT))))))))

[rtg-math/quaternions/consing.lisp:228]
  (DEFN %+ ((QUAT-A QUATERNION) (QUAT-B QUATERNION)) QUATERNION
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (Q! (+ (W QUAT-A) (W QUAT-B)) (+ (X QUAT-A) (X QUAT-B))
    (+ (Y QUAT-A) (Y QUAT-B)) (+ (Z QUAT-A) (Z QUAT-B))))

[rtg-math/quaternions/consing.lisp:235]
  (DEFN + (&REST (QUATS QUATERNION)) QUATERNION
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (IF QUATS
       (LET ((W 0.0) (X 0.0) (Y 0.0) (Z 0.0))
         (DECLARE (SINGLE-FLOAT X Y Z W))
         (LOOP :FOR VEC :IN QUATS
               :DO (INCF W (W VEC)) (INCF X (X VEC)) (INCF Y (Y VEC)) (INCF Z
                                                                            (Z
                                                                             VEC)))
         (Q! W X Y Z))
       (IDENTITY)))

[rtg-math/quaternions/consing.lisp:256]
  (DEFN %- ((QUAT-A QUATERNION) (QUAT-B QUATERNION)) QUATERNION
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (Q! (- (W QUAT-A) (W QUAT-B)) (- (X QUAT-A) (X QUAT-B))
    (- (Y QUAT-A) (Y QUAT-B)) (- (Z QUAT-A) (Z QUAT-B))))

[rtg-math/quaternions/consing.lisp:263]
  (DEFN - ((QUAT QUATERNION) &REST (QUATS QUATERNION)) QUATERNION
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))) (ASSERT QUAT)
   (IF QUATS
       (LET ((X (X QUAT)) (Y (Y QUAT)) (Z (Z QUAT)) (W (W QUAT)))
         (DECLARE (SINGLE-FLOAT X Y Z W))
         (LOOP :FOR VEC :IN QUATS
               :DO (DECF X (X VEC)) (DECF Y (Y VEC)) (DECF Z (Z VEC)) (DECF W
                                                                            (W
                                                                             VEC)))
         (Q! X Y Z W))
       QUAT))

[rtg-math/quaternions/consing.lisp:285]
  (DEFN *S ((QUAT-A QUATERNION) (SCALAR SINGLE-FLOAT)) QUATERNION
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (Q! (* (W QUAT-A) SCALAR) (* (X QUAT-A) SCALAR) (* (Y QUAT-A) SCALAR)
    (* (Z QUAT-A) SCALAR)))

[rtg-math/quaternions/consing.lisp:294]
  (DEFN * ((QUAT-A QUATERNION) (QUAT-B QUATERNION)) QUATERNION
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (Q!
    (- (* (W QUAT-A) (W QUAT-B)) (* (X QUAT-A) (X QUAT-B))
       (* (Y QUAT-A) (Y QUAT-B)) (* (Z QUAT-A) (Z QUAT-B)))
    (-
     (+ (* (W QUAT-A) (X QUAT-B)) (* (X QUAT-A) (W QUAT-B))
        (* (Y QUAT-A) (Z QUAT-B)))
     (* (Z QUAT-A) (Y QUAT-B)))
    (-
     (+ (* (W QUAT-A) (Y QUAT-B)) (* (Y QUAT-A) (W QUAT-B))
        (* (Z QUAT-A) (X QUAT-B)))
     (* (X QUAT-A) (Z QUAT-B)))
    (-
     (+ (* (W QUAT-A) (Z QUAT-B)) (* (Z QUAT-A) (W QUAT-B))
        (* (X QUAT-A) (Y QUAT-B)))
     (* (Y QUAT-A) (X QUAT-B)))))

[rtg-math/quaternions/consing.lisp:315]
  (DEFN TO-MAT3 ((QUAT QUATERNION)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((W (W QUAT)) (X (X QUAT)) (Y (Y QUAT)) (Z (Z QUAT)))
     (LET ((X2 (+ X X)) (Y2 (+ Y Y)) (Z2 (+ Z Z)))
       (LET ((WX (* W X2))
             (WY (* W Y2))
             (WZ (* W Z2))
             (XX (* X X2))
             (XY (* X Y2))
             (XZ (* X Z2))
             (YY (* Y Y2))
             (YZ (* Y Z2))
             (ZZ (* Z Z2)))
         (#S(FORMGREP:SYMREF :NAME "MAKE" :QUALIFIER "M3") (- 1.0 (+ YY ZZ))
          (- XY WZ) (+ XZ WY) (+ XY WZ) (- 1.0 (+ XX ZZ)) (- YZ WX) (- XZ WY)
          (+ YZ WX) (- 1.0 (+ XX YY)))))))

[rtg-math/quaternions/consing.lisp:328]
  (DEFN TO-MAT4 ((QUAT QUATERNION)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((W (W QUAT)) (X (X QUAT)) (Y (Y QUAT)) (Z (Z QUAT)))
     (LET ((X2 (+ X X)) (Y2 (+ Y Y)) (Z2 (+ Z Z)))
       (LET ((WX (* W X2))
             (WY (* W Y2))
             (WZ (* W Z2))
             (XX (* X X2))
             (XY (* X Y2))
             (XZ (* X Z2))
             (YY (* Y Y2))
             (YZ (* Y Z2))
             (ZZ (* Z Z2)))
         (#S(FORMGREP:SYMREF :NAME "MAKE" :QUALIFIER "M4") (- 1.0 (+ YY ZZ))
          (- XY WZ) (+ XZ WY) 0.0 (+ XY WZ) (- 1.0 (+ XX ZZ)) (- YZ WX) 0.0
          (- XZ WY) (+ YZ WX) (- 1.0 (+ XX YY)) 0.0 0.0 0.0 0.0 1.0)))))

[rtg-math/quaternions/consing.lisp:344]
  (DEFN LERP ((START-QUAT QUATERNION) (END-QUAT QUATERNION) (POS SINGLE-FLOAT))
   QUATERNION (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((COS-ANGLE (DOT START-QUAT END-QUAT)))
     (IF (>= COS-ANGLE 0.0)
         (+ (*S END-QUAT POS) (*S START-QUAT (- 1.0 POS)))
         (+ (*S END-QUAT POS) (*S START-QUAT (- POS 1.0))))))

[rtg-math/quaternions/consing.lisp:387]
  (DEFN APPROX-SLERP
   ((START-QUAT QUATERNION) (END-QUAT QUATERNION) (POS SINGLE-FLOAT))
   QUATERNION (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET* ((COS-ANGLE (DOT START-QUAT END-QUAT))
          (FACTOR (EXPT (- 1.0 (* 0.7878088 COS-ANGLE)) 2.0))
          (K (* 0.5069269 FACTOR))
          (B (* 2.0 K))
          (C (* -3 K))
          (D (+ 1 K))
          (POS (+ (* POS (+ C (* B POS))) D)))
     (IF (> COS-ANGLE 0.0)
         (+ (*S END-QUAT POS) (*S START-QUAT (- 1.0 POS)))
         (+ (*S END-QUAT POS) (*S START-QUAT (- POS 1.0))))))

[rtg-math/quaternions/non-consing.lisp:5]
  (DEFN-INLINE SET-COMPONENTS
   ((W SINGLE-FLOAT) (X SINGLE-FLOAT) (Y SINGLE-FLOAT) (Z SINGLE-FLOAT)
    (QUAT QUATERNION))
   QUATERNION (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SETF (W QUAT) W
         (X QUAT) X
         (Y QUAT) Y
         (Z QUAT) Z)
   QUAT)

[rtg-math/quaternions/non-consing.lisp:17]
  (DEFN NORMALIZE ((QUAT-TO-MUTATE QUATERNION)) QUATERNION
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((LENGTH-SQUARED (DOT QUAT-TO-MUTATE QUAT-TO-MUTATE)))
     (DECLARE ((SINGLE-FLOAT 0.0 NIL) LENGTH-SQUARED))
     (IF (= 0.0 LENGTH-SQUARED)
         QUAT-TO-MUTATE
         (LET ((FACTOR (INV-SQRT LENGTH-SQUARED)))
           (SET-COMPONENTS (* (W QUAT-TO-MUTATE) FACTOR)
            (* (X QUAT-TO-MUTATE) FACTOR) (* (Y QUAT-TO-MUTATE) FACTOR)
            (* (Z QUAT-TO-MUTATE) FACTOR) QUAT-TO-MUTATE)))))

[rtg-math/quaternions/non-consing.lisp:33]
  (DEFN FROM-MAT3 ((QUAT-TO-MUTATE QUATERNION) (MAT3 MAT3)) QUATERNION
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((TRACE (#S(FORMGREP:SYMREF :NAME "TRACE" :QUALIFIER "M3") MAT3)))
     (IF (> TRACE 0.0)
         (LET* ((S (SQRT (+ TRACE 1.0))) (RECIP (/ 0.5 S)))
           (SET-COMPONENTS (* 0.5 S)
            (*
             (- (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M3") MAT3 2 1)
                (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M3") MAT3 1 2))
             RECIP)
            (*
             (- (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M3") MAT3 0 2)
                (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M3") MAT3 2 0))
             RECIP)
            (*
             (- (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M3") MAT3 1 0)
                (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M3") MAT3 0 1))
             RECIP)
            QUAT-TO-MUTATE))
         (LET* ((I
                 (IF (>
                      (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M3") MAT3 1
                       1)
                      (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M3") MAT3 0
                       0))
                     1
                     0))
                (I
                 (IF (>
                      (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M3") MAT3 2
                       2)
                      (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M3") MAT3 I
                       I))
                     2
                     I))
                (J (MOD (+ 1 I) 3))
                (K (MOD (+ 1 J) 3))
                (TMP-S
                 (+
                  (-
                   (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M3") MAT3 I I)
                   (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M3") MAT3 J J)
                   (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M3") MAT3 K K))
                  1.0))
                (S (SQRT (THE (SINGLE-FLOAT 0.0 NIL) TMP-S)))
                (RECIP (/ 0.5 S)))
           (SETF (W QUAT-TO-MUTATE)
                   (*
                    (-
                     (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M3") MAT3 K
                      J)
                     (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M3") MAT3 J
                      K))
                    RECIP))
           (SETF (AREF QUAT-TO-MUTATE (1+ I)) (* S 0.5))
           (SETF (AREF QUAT-TO-MUTATE (1+ J))
                   (*
                    (+
                     (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M3") MAT3 J
                      I)
                     (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M3") MAT3 I
                      J))
                    RECIP))
           (SETF (AREF QUAT-TO-MUTATE (1+ K))
                   (*
                    (+
                     (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M3") MAT3 K
                      I)
                     (#S(FORMGREP:SYMREF :NAME "MELM" :QUALIFIER "M3") MAT3 I
                      K))
                    RECIP))
           (NORMALIZE QUAT-TO-MUTATE)))))

[rtg-math/quaternions/non-consing.lisp:71]
  (DEFN FROM-AXIS-ANGLE
   ((QUAT-TO-MUTATE QUATERNION) (AXIS-VEC3 VEC3) (ANGLE SINGLE-FLOAT))
   QUATERNION (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((LENGTH
          (#S(FORMGREP:SYMREF :NAME "LENGTH-SQUARED" :QUALIFIER "V3")
           AXIS-VEC3)))
     (IF (= 0.0 LENGTH)
         (SET-COMPONENTS 1.0 0.0 0.0 0.0 QUAT-TO-MUTATE)
         (LET* ((HALF-ANGLE (/ ANGLE 2.0))
                (SIN-HALF-ANGLE (SIN HALF-ANGLE))
                (COS-HALF-ANGLE (COS HALF-ANGLE))
                (SCALE-FACTOR (/ SIN-HALF-ANGLE (SQRT LENGTH))))
           (SET-COMPONENTS COS-HALF-ANGLE (* SCALE-FACTOR (AREF AXIS-VEC3 0))
            (* SCALE-FACTOR (AREF AXIS-VEC3 1))
            (* SCALE-FACTOR (AREF AXIS-VEC3 2)) QUAT-TO-MUTATE)))))

[rtg-math/quaternions/non-consing.lisp:90]
  (DEFN FROM-FIXED-ANGLES-UNNORMALIZED
   ((QUAT-TO-MUTATE QUATERNION) (X-ROT SINGLE-FLOAT) (Y-ROT SINGLE-FLOAT)
    (Z-ROT SINGLE-FLOAT))
   QUATERNION (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET* ((X-ROT (/ X-ROT 2.0))
          (Y-ROT (/ Y-ROT 2.0))
          (Z-ROT (/ Z-ROT 2.0))
          (COS-X (COS X-ROT))
          (SIN-X (SIN X-ROT))
          (COS-Y (COS Y-ROT))
          (SIN-Y (SIN Y-ROT))
          (COS-Z (COS Z-ROT))
          (SIN-Z (SIN Z-ROT)))
     (SET-COMPONENTS (- (* COS-X COS-Y COS-Z) (* SIN-X SIN-Y SIN-Z))
      (- (* SIN-X COS-Y COS-Z) (* COS-X SIN-Y SIN-Z))
      (- (* COS-X SIN-Y COS-Z) (* SIN-X COS-Y SIN-Z))
      (- (* COS-X COS-Y SIN-Z) (* SIN-X SIN-Y COS-X)) QUAT-TO-MUTATE)))

[rtg-math/quaternions/non-consing.lisp:106]
  (DEFN FROM-FIXED-ANGLES
   ((QUAT-TO-MUTATE QUATERNION) (X-ROT SINGLE-FLOAT) (Y-ROT SINGLE-FLOAT)
    (Z-ROT SINGLE-FLOAT))
   QUATERNION (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (NORMALIZE
    (FROM-FIXED-ANGLES-UNNORMALIZED QUAT-TO-MUTATE X-ROT Y-ROT Z-ROT)))

[rtg-math/quaternions/non-consing.lisp:115]
  (DEFN CONJUGATE ((QUAT-TO-MUTATE QUATERNION)) QUATERNION
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SET-COMPONENTS (W QUAT-TO-MUTATE) (- (X QUAT-TO-MUTATE))
    (- (Y QUAT-TO-MUTATE)) (- (Z QUAT-TO-MUTATE)) QUAT-TO-MUTATE))

[rtg-math/quaternions/non-consing.lisp:125]
  (DEFN %+ ((ACCUM-QUAT QUATERNION) (TO-ADD-QUAT QUATERNION)) QUATERNION
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
   (INCF (AREF ACCUM-QUAT 0) (AREF TO-ADD-QUAT 0))
   (INCF (AREF ACCUM-QUAT 1) (AREF TO-ADD-QUAT 1))
   (INCF (AREF ACCUM-QUAT 2) (AREF TO-ADD-QUAT 2))
   (INCF (AREF ACCUM-QUAT 3) (AREF TO-ADD-QUAT 3)) ACCUM-QUAT)

[rtg-math/quaternions/non-consing.lisp:133]
  (DEFN + ((ACCUM-QUAT QUATERNION) &REST (QUATERNIONS QUATERNION)) QUATERNION
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LOOP :FOR QUAT :IN QUATERNIONS
         :DO (%+ ACCUM-QUAT QUAT))
   ACCUM-QUAT)

[rtg-math/quaternions/non-consing.lisp:147]
  (DEFN %- ((ACCUM-QUAT QUATERNION) (TO-ADD-QUAT QUATERNION)) QUATERNION
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (DECF (AREF ACCUM-QUAT 0) (AREF TO-ADD-QUAT 0))
   (DECF (AREF ACCUM-QUAT 1) (AREF TO-ADD-QUAT 1))
   (DECF (AREF ACCUM-QUAT 2) (AREF TO-ADD-QUAT 2))
   (DECF (AREF ACCUM-QUAT 2) (AREF TO-ADD-QUAT 3)) ACCUM-QUAT)

[rtg-math/quaternions/non-consing.lisp:155]
  (DEFN - ((ACCUM-QUAT QUATERNION) &REST (QUATERNIONS QUATERNION)) QUATERNION
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LOOP :FOR QUAT :IN QUATERNIONS
         :DO (%- ACCUM-QUAT QUAT))
   ACCUM-QUAT)

[rtg-math/quaternions/non-consing.lisp:169]
  (DEFN * ((QUAT-TO-MUTATE QUATERNION) (QUAT-B QUATERNION)) QUATERNION
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SET-COMPONENTS
    (- (* (W QUAT-TO-MUTATE) (W QUAT-B)) (* (X QUAT-TO-MUTATE) (X QUAT-B))
       (* (Y QUAT-TO-MUTATE) (Y QUAT-B)) (* (Z QUAT-TO-MUTATE) (Z QUAT-B)))
    (-
     (+ (* (W QUAT-TO-MUTATE) (X QUAT-B)) (* (X QUAT-TO-MUTATE) (W QUAT-B))
        (* (Y QUAT-TO-MUTATE) (Z QUAT-B)))
     (* (Z QUAT-TO-MUTATE) (Y QUAT-B)))
    (-
     (+ (* (W QUAT-TO-MUTATE) (Y QUAT-B)) (* (Y QUAT-TO-MUTATE) (W QUAT-B))
        (* (Z QUAT-TO-MUTATE) (X QUAT-B)))
     (* (X QUAT-TO-MUTATE) (Z QUAT-B)))
    (-
     (+ (* (W QUAT-TO-MUTATE) (Z QUAT-B)) (* (Z QUAT-TO-MUTATE) (W QUAT-B))
        (* (X QUAT-TO-MUTATE) (Y QUAT-B)))
     (* (Y QUAT-TO-MUTATE) (X QUAT-B)))
    QUAT-TO-MUTATE))

[rtg-math/quaternions/non-consing.lisp:191]
  (DEFN TO-MAT3 ((MAT-TO-MUTATE MAT3) (QUAT QUATERNION)) MAT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET* ((W (W QUAT))
          (X (X QUAT))
          (Y (Y QUAT))
          (Z (Z QUAT))
          (X2 (+ X X))
          (Y2 (+ Y Y))
          (Z2 (+ Z Z))
          (WX (* W X2))
          (WY (* W Y2))
          (WZ (* W Z2))
          (XX (* X X2))
          (XY (* X Y2))
          (XZ (* X Z2))
          (YY (* Y Y2))
          (YZ (* Y Z2))
          (ZZ (* Z Z2)))
     (#S(FORMGREP:SYMREF :NAME "SET-COMPONENTS" :QUALIFIER "M3-N")
      (- 1.0 (+ YY ZZ)) (- XY WZ) (+ XZ WY) (+ XY WZ) (- 1.0 (+ XX ZZ))
      (- YZ WX) (- XZ WY) (+ YZ WX) (- 1.0 (+ XX YY)) MAT-TO-MUTATE)))

[rtg-math/quaternions/non-consing.lisp:209]
  (DEFN TO-MAT4 ((MAT-TO-MUTATE MAT4) (QUAT QUATERNION)) MAT4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET* ((W (W QUAT))
          (X (X QUAT))
          (Y (Y QUAT))
          (Z (Z QUAT))
          (X2 (+ X X))
          (Y2 (+ Y Y))
          (Z2 (+ Z Z))
          (WX (* W X2))
          (WY (* W Y2))
          (WZ (* W Z2))
          (XX (* X X2))
          (XY (* X Y2))
          (XZ (* X Z2))
          (YY (* Y Y2))
          (YZ (* Y Z2))
          (ZZ (* Z Z2)))
     (#S(FORMGREP:SYMREF :NAME "SET-COMPONENTS" :QUALIFIER "M4-N")
      (- 1.0 (+ YY ZZ)) (- XY WZ) (+ XZ WY) 0.0 (+ XY WZ) (- 1.0 (+ XX ZZ))
      (- YZ WX) 0.0 (- XZ WY) (+ YZ WX) (- 1.0 (+ XX YY)) 0.0 0.0 0.0 0.0 1.0
      MAT-TO-MUTATE)))

[rtg-math/quaternions/non-consing.lisp:228]
  (DEFN ROTATE ((VEC3-TO-MUTATE VEC3) (QUAT QUATERNION)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET* ((V-MULT
           (* 2.0
              (+ (* (X QUAT) (AREF VEC3-TO-MUTATE 0))
                 (* (Y QUAT) (AREF VEC3-TO-MUTATE 1))
                 (* (Z QUAT) (AREF VEC3-TO-MUTATE 2)))))
          (CROSS-MULT (* 2.0 (W QUAT)))
          (P-MULT (- (* CROSS-MULT (W QUAT)) 1.0)))
     (#S(FORMGREP:SYMREF :NAME "SET-COMPONENTS" :QUALIFIER "V3-N")
      (+ (* P-MULT (AREF VEC3-TO-MUTATE 0)) (* V-MULT (X QUAT))
         (* CROSS-MULT
            (- (* (Y QUAT) (AREF VEC3-TO-MUTATE 2))
               (* (Z QUAT) (AREF VEC3-TO-MUTATE 1)))))
      (+ (* P-MULT (AREF VEC3-TO-MUTATE 1)) (* V-MULT (Y QUAT))
         (* CROSS-MULT
            (- (* (Z QUAT) (AREF VEC3-TO-MUTATE 0))
               (* (X QUAT) (AREF VEC3-TO-MUTATE 2)))))
      (+ (* P-MULT (AREF VEC3-TO-MUTATE 2)) (* V-MULT (Z QUAT))
         (* CROSS-MULT
            (- (* (X QUAT) (AREF VEC3-TO-MUTATE 1))
               (* (Y QUAT) (AREF VEC3-TO-MUTATE 0)))))
      VEC3-TO-MUTATE)))

[rtg-math/regions/aab/consing.lisp:3]
  (DEFN-INLINE MAXIMA ((AAB AXIS-ALIGNED-BOX)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (AXIS-ALIGNED-BOX-MAXIMA AAB))

[rtg-math/regions/aab/consing.lisp:7]
  (DEFN-INLINE MINIMA ((AAB AXIS-ALIGNED-BOX)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (AXIS-ALIGNED-BOX-MINIMA AAB))

[rtg-math/regions/aab/consing.lisp:13]
  (DEFN-INLINE MAKE ((MINIMA VEC3) (MAXIMA VEC3)) AXIS-ALIGNED-BOX
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE-AXIS-ALIGNED-BOX :MINIMA MINIMA :MAXIMA MAXIMA))

[rtg-math/regions/aab/consing.lisp:21]
  (DEFN FROM-POINTS ((LIST-OF-VEC3 LIST)) AXIS-ALIGNED-BOX
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))) (ASSERT LIST-OF-VEC3)
   (LET ((FIRST (FIRST LIST-OF-VEC3)))
     (DECLARE (VEC3 FIRST))
     (LET ((MAX-X (X FIRST))
           (MIN-X (X FIRST))
           (MAX-Y (Y FIRST))
           (MIN-Y (Y FIRST))
           (MAX-Z (Z FIRST))
           (MIN-Z (Z FIRST)))
       (DECLARE (SINGLE-FLOAT MAX-X MIN-X MAX-Y MIN-Y MAX-Z MIN-Z))
       (LOOP :FOR VEC :IN (REST LIST-OF-VEC3)
             :DO (LET ((VEC VEC))
                   (DECLARE (VEC3 VEC))
                   (SETF MAX-X (MAX MAX-X (X VEC)))
                   (SETF MIN-X (MIN MIN-X (X VEC)))
                   (SETF MAX-Y (MAX MAX-Y (Y VEC)))
                   (SETF MIN-Y (MIN MIN-Y (Y VEC)))
                   (SETF MAX-Z (MAX MAX-Z (Z VEC)))
                   (SETF MIN-Z (MIN MIN-Z (Z VEC)))))
       (MAKE-AXIS-ALIGNED-BOX :MINIMA (V! MIN-X MIN-Y MIN-Z) :MAXIMA
        (V! MAX-X MAX-Y MAX-Z)))))

[rtg-math/regions/aab/consing.lisp:53]
  (DEFN ADD-POINT ((AAB AXIS-ALIGNED-BOX) (POINT-V3 VEC3)) AXIS-ALIGNED-BOX
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (WITH-AAB (MINA MAXA) AAB
    (MAKE-AXIS-ALIGNED-BOX :MINIMA
     (#S(FORMGREP:SYMREF :NAME "MAKE" :QUALIFIER "V3")
      (MIN (X POINT-V3) (X MINA)) (MIN (Y POINT-V3) (Y MINA))
      (MIN (Z POINT-V3) (Z MINA)))
     :MAXIMA
     (V! (MAX (X POINT-V3) (X MAXA)) (MAX (Y POINT-V3) (Y MAXA))
      (MAX (Z POINT-V3) (Z MAXA))))))

[rtg-math/regions/aab/consing.lisp:66]
  (DEFN = ((AAB-0 AXIS-ALIGNED-BOX) (AAB-1 AXIS-ALIGNED-BOX)) BOOLEAN
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (WITH-AAB (MINA-0 MAXA-0) AAB-0
    (WITH-AAB (MINA-1 MAXA-1) AAB-1
     (AND (#S(FORMGREP:SYMREF :NAME "=" :QUALIFIER "V3") MINA-0 MINA-1)
          (#S(FORMGREP:SYMREF :NAME "=" :QUALIFIER "V3") MAXA-0 MAXA-1)))))

[rtg-math/regions/aab/consing.lisp:73]
  (DEFN-INLINE /= ((AAB-0 AXIS-ALIGNED-BOX) (AAB-1 AXIS-ALIGNED-BOX)) BOOLEAN
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))) (NOT (= AAB-0 AAB-1)))

[rtg-math/regions/aab/consing.lisp:79]
  (DEFN INTERSECTS-P ((AAB-0 AXIS-ALIGNED-BOX) (AAB-1 AXIS-ALIGNED-BOX))
   BOOLEAN (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (WITH-AAB (MINA-0 MAXA-0) AAB-0
    (WITH-AAB (MINA-1 MAXA-1) AAB-1
     (NOT
      (OR (> (X MINA-0) (X MAXA-1)) (> (X MINA-1) (X MAXA-0))
          (> (Y MINA-0) (Y MAXA-1)) (> (Y MINA-1) (Y MAXA-0))
          (> (Z MINA-0) (Z MAXA-1)) (> (Z MINA-1) (Z MAXA-0)))))))

[rtg-math/regions/aab/consing.lisp:90]
  (DEFN INTERSECTS-WITH-LINE3-P ((AAB AXIS-ALIGNED-BOX) (LINE3 LINE3)) BOOLEAN
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (WITH-AAB (MINA MAXA) AAB
    (LET ((DIR
           (#S(FORMGREP:SYMREF :NAME "DIRECTION" :QUALIFIER "LINE3") LINE3))
          (MAX-Q MOST-NEGATIVE-SINGLE-FLOAT)
          (MIN-R MOST-POSITIVE-SINGLE-FLOAT))
      (LOOP :FOR I :BELOW 3
            :DO (IF (SFZERO-P (AREF DIR I))
                    (WHEN
                        (OR
                         (<
                          (AREF
                           (#S(FORMGREP:SYMREF
                               :NAME "ORIGIN"
                               :QUALIFIER "LINE3")
                            LINE3)
                           I)
                          (AREF MINA I))
                         (>
                          (AREF
                           (#S(FORMGREP:SYMREF
                               :NAME "ORIGIN"
                               :QUALIFIER "LINE3")
                            LINE3)
                           I)
                          (AREF MAXA I)))
                      (RETURN-FROM INTERSECTS-WITH-LINE3-P NIL))
                    (LET* ((ORIG
                            (#S(FORMGREP:SYMREF
                                :NAME "ORIGIN"
                                :QUALIFIER "LINE3")
                             LINE3))
                           (Q (/ (- (AREF MINA I) (AREF ORIG I)) (AREF DIR I)))
                           (R (/ (- (AREF MAXA I) (AREF ORIG I)) (AREF DIR I))))
                      (WHEN (> Q R)
                        (LET ((TMP Q))
                          (SETF Q R
                                R TMP)))
                      (WHEN (> Q MAX-Q) (SETF MAX-Q Q))
                      (WHEN (< R MIN-R) (SETF MIN-R R))
                      (WHEN (> MAX-Q MIN-R)
                        (RETURN-FROM INTERSECTS-WITH-LINE3-P NIL))))
            :FINALLY (RETURN T)))))

[rtg-math/regions/aab/consing.lisp:123]
  (DEFN INTERSECTS-WITH-RAY3-P ((AAB AXIS-ALIGNED-BOX) (RAY3 RAY3)) BOOLEAN
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (WITH-AAB (MINA MAXA) AAB
    (LET ((DIR (#S(FORMGREP:SYMREF :NAME "DIRECTION" :QUALIFIER "RAY3") RAY3))
          (MAX-Q 0.0)
          (MIN-R MOST-POSITIVE-SINGLE-FLOAT))
      (LOOP :FOR I :BELOW 3
            :DO (IF (SFZERO-P (AREF DIR I))
                    (WHEN
                        (OR
                         (<
                          (AREF
                           (#S(FORMGREP:SYMREF
                               :NAME "ORIGIN"
                               :QUALIFIER "RAY3")
                            RAY3)
                           I)
                          (AREF MINA I))
                         (>
                          (AREF
                           (#S(FORMGREP:SYMREF
                               :NAME "ORIGIN"
                               :QUALIFIER "RAY3")
                            RAY3)
                           I)
                          (AREF MAXA I)))
                      (RETURN-FROM INTERSECTS-WITH-RAY3-P NIL))
                    (LET* ((ORIG
                            (#S(FORMGREP:SYMREF
                                :NAME "ORIGIN"
                                :QUALIFIER "RAY3")
                             RAY3))
                           (Q (/ (- (AREF MINA I) (AREF ORIG I)) (AREF DIR I)))
                           (R (/ (- (AREF MAXA I) (AREF ORIG I)) (AREF DIR I))))
                      (WHEN (> Q R)
                        (LET ((TMP Q))
                          (SETF Q R
                                R TMP)))
                      (WHEN (> Q MAX-Q) (SETF MAX-Q Q))
                      (WHEN (< R MIN-R) (SETF MIN-R R))
                      (WHEN (> MAX-Q MIN-R)
                        (RETURN-FROM INTERSECTS-WITH-RAY3-P NIL))))
            :FINALLY (RETURN T)))))

[rtg-math/regions/aab/consing.lisp:156]
  (DEFN INTERSECTS-WITH-LINE-SEGMENT-P
   ((AAB AXIS-ALIGNED-BOX) (LINE-SEG3 LINE-SEGMENT3)) BOOLEAN
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (WITH-AAB (MINA MAXA) AAB
    (LET ((DIR
           (#S(FORMGREP:SYMREF :NAME "DIRECTION" :QUALIFIER "LINE-SEG3")
            LINE-SEG3))
          (MAX-Q 0.0)
          (MIN-R MOST-POSITIVE-SINGLE-FLOAT))
      (LOOP :FOR I :BELOW 3
            :DO (IF (SFZERO-P (AREF DIR I))
                    (WHEN
                        (OR
                         (<
                          (AREF
                           (#S(FORMGREP:SYMREF
                               :NAME "END-POINT0"
                               :QUALIFIER "LINE-SEG3")
                            LINE-SEG3)
                           I)
                          (AREF MINA I))
                         (>
                          (AREF
                           (#S(FORMGREP:SYMREF
                               :NAME "END-POINT0"
                               :QUALIFIER "LINE-SEG3")
                            LINE-SEG3)
                           I)
                          (AREF MAXA I)))
                      (RETURN-FROM INTERSECTS-WITH-LINE-SEGMENT-P NIL))
                    (LET* ((ORIG
                            (#S(FORMGREP:SYMREF
                                :NAME "END-POINT0"
                                :QUALIFIER "LINE-SEG3")
                             LINE-SEG3))
                           (Q (/ (- (AREF MINA I) (AREF ORIG I)) (AREF DIR I)))
                           (R (/ (- (AREF MAXA I) (AREF ORIG I)) (AREF DIR I))))
                      (WHEN (> Q R)
                        (LET ((TMP Q))
                          (SETF Q R
                                R TMP)))
                      (WHEN (> Q MAX-Q) (SETF MAX-Q Q))
                      (WHEN (< R MIN-R) (SETF MIN-R R))
                      (WHEN (> MAX-Q MIN-R)
                        (RETURN-FROM INTERSECTS-WITH-LINE-SEGMENT-P NIL))))
            :FINALLY (RETURN T)))))

[rtg-math/regions/aab/non-consing.lisp:4]
  (DEFN MERGE-POINT ((AAB AXIS-ALIGNED-BOX) (POINT-V3 VEC3)) AXIS-ALIGNED-BOX
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (WITH-AAB (MINA MAXA) AAB
    (IF (< (X POINT-V3) (X MINA))
        (SETF (X MINA) (X POINT-V3))
        (WHEN (> (X POINT-V3) (X MAXA)) (SETF (X MAXA) (X POINT-V3))))
    (IF (< (Y POINT-V3) (Y MINA))
        (SETF (Y MINA) (Y POINT-V3))
        (WHEN (> (Y POINT-V3) (Y MAXA)) (SETF (Y MAXA) (Y POINT-V3))))
    (IF (< (Z POINT-V3) (Z MINA))
        (SETF (Z MINA) (Z POINT-V3))
        (WHEN (> (Z POINT-V3) (Z MAXA)) (SETF (Z MAXA) (Z POINT-V3))))
    AAB))

[rtg-math/regions/line-segment3/consing.lisp:5]
  (DEFN LINE-SEGMENT3-END-POINT1 ((LINE-SEG3 LINE-SEGMENT3)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (#S(FORMGREP:SYMREF :NAME "+" :QUALIFIER "V3")
    (LINE-SEGMENT3-END-POINT0 LINE-SEG3) (LINE-SEGMENT3-OFFSET LINE-SEG3)))

[rtg-math/regions/line-segment3/consing.lisp:10]
  (DEFN-INLINE END-POINT0 ((LINE-SEG3 LINE-SEGMENT3)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LINE-SEGMENT3-END-POINT0 LINE-SEG3))

[rtg-math/regions/line-segment3/consing.lisp:14]
  (DEFN-INLINE END-POINT1 ((LINE-SEG3 LINE-SEGMENT3)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LINE-SEGMENT3-END-POINT1 LINE-SEG3))

[rtg-math/regions/line-segment3/consing.lisp:18]
  (DEFN DIRECTION ((LINE-SEG3 LINE-SEGMENT3)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LINE-SEGMENT3-OFFSET LINE-SEG3))

[rtg-math/regions/line-segment3/consing.lisp:22]
  (DEFN MAKE ((END-POINT0 VEC3) (END-POINT1 VEC3)) LINE-SEGMENT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE-LINE-SEGMENT3 :END-POINT0 END-POINT0 :OFFSET
    (#S(FORMGREP:SYMREF :NAME "-" :QUALIFIER "V3") END-POINT1 END-POINT0)))

[rtg-math/regions/line-segment3/consing.lisp:27]
  (DEFN MAKE-FROM-POINT-OFFSET ((POINT-V3 VEC3) (OFFSET-V3 VEC3)) LINE-SEGMENT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE-LINE-SEGMENT3 :END-POINT0 POINT-V3 :OFFSET OFFSET-V3))

[rtg-math/regions/line-segment3/consing.lisp:34]
  (DEFN-INLINE = ((LINE-SEG3-A LINE-SEGMENT3) (LINE-SEG3-B LINE-SEGMENT3))
   BOOLEAN (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (AND
    (#S(FORMGREP:SYMREF :NAME "=" :QUALIFIER "V3") (END-POINT0 LINE-SEG3-A)
     (END-POINT0 LINE-SEG3-B))
    (#S(FORMGREP:SYMREF :NAME "=" :QUALIFIER "V3") (DIRECTION LINE-SEG3-A)
     (DIRECTION LINE-SEG3-B))))

[rtg-math/regions/line-segment3/consing.lisp:40]
  (DEFN /= ((LINE-SEG3-A LINE-SEGMENT3) (LINE-SEG3-B LINE-SEGMENT3)) BOOLEAN
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE =))
   (NOT (= LINE-SEG3-A LINE-SEG3-B)))

[rtg-math/regions/line-segment3/consing.lisp:48]
  (DEFN TRANSFORM-M3 ((MATRIX3 MAT3) (LINE-SEG3 LINE-SEGMENT3)) LINE-SEGMENT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE
    (#S(FORMGREP:SYMREF :NAME "*V" :QUALIFIER "M3") MATRIX3
     (END-POINT0 LINE-SEG3))
    (#S(FORMGREP:SYMREF :NAME "*V" :QUALIFIER "M3") MATRIX3
     (DIRECTION LINE-SEG3))))

[rtg-math/regions/line-segment3/consing.lisp:53]
  (DEFN TRANSFORM-Q ((QUAT QUATERNION) (LINE-SEG3 LINE-SEGMENT3)) LINE-SEGMENT3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE
    (#S(FORMGREP:SYMREF :NAME "ROTATE" :QUALIFIER "Q") (END-POINT0 LINE-SEG3)
     QUAT)
    (#S(FORMGREP:SYMREF :NAME "ROTATE" :QUALIFIER "Q") (DIRECTION LINE-SEG3)
     QUAT)))

[rtg-math/regions/line-segment3/consing.lisp:60]
  (DEFN LENGTH-SQUARED ((LINE-SEG3 LINE-SEGMENT3)) (SINGLE-FLOAT 0.0 NIL)
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (#S(FORMGREP:SYMREF :NAME "LENGTH-SQUARED" :QUALIFIER "V3")
    (LINE-SEGMENT3-OFFSET LINE-SEG3)))

[rtg-math/regions/line-segment3/consing.lisp:65]
  (DEFN LENGTH ((LINE-SEG3 LINE-SEGMENT3)) (SINGLE-FLOAT 0.0 NIL)
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (#S(FORMGREP:SYMREF :NAME "LENGTH" :QUALIFIER "V3")
    (LINE-SEGMENT3-OFFSET LINE-SEG3)))

[rtg-math/regions/line-segment3/consing.lisp:72]
  (DEFN %SEG-TO-SEG-INTERNALS
   ((LINE-SEG-A LINE-SEGMENT3) (LINE-SEG-B LINE-SEGMENT3))
   (VALUES VEC3 VEC3 VEC3 (SINGLE-FLOAT 0.0 NIL) (SINGLE-FLOAT 0.0 NIL))
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   "Returns: dir-a dir-b w0 tc sc"
   (LET* ((ORIG-A (END-POINT0 LINE-SEG-A))
          (ORIG-B (END-POINT0 LINE-SEG-B))
          (DIR-A (DIRECTION LINE-SEG-A))
          (DIR-B (DIRECTION LINE-SEG-B))
          (W0 (#S(FORMGREP:SYMREF :NAME "-" :QUALIFIER "V3") ORIG-A ORIG-B))
          (A (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR-A DIR-A))
          (B (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR-A DIR-B))
          (C (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR-B DIR-B))
          (D (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR-A W0))
          (E (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR-B W0))
          (DENOM (- (* A C) (* B B)))
          (SN 0.0)
          (SD 0.0)
          (TN 0.0)
          (TD 0.0)
          (TC 0.0)
          (SC 0.0))
     (IF (SFZERO-P DENOM)
         (SETF TD C
               SD C
               SN 0.0
               TN E)
         (PROGN
          (SETF TD DENOM
                SD DENOM
                SN (- (* B E) (* C D))
                TN (- (* A E) (* B D)))
          (IF (< SN 0.0)
              (SETF SN 0.0
                    TN E
                    TD C)
              (WHEN (> SN SD)
                (SETF SN SD
                      TN (+ E B)
                      TD C)))))
     (COND
      ((< TN 0.0) (SETF TC 0.0)
       (COND ((< (- D) 0.0) (SETF SC 0.0)) ((> (- D) A) (SETF SC 1.0))
             (T (SETF SC (/ (- D) A)))))
      ((> TN TD) (SETF TC 1.0)
       (COND ((< (+ (- D) B) 0.0) (SETF SC 0.0))
             ((> (+ (- D) B) A) (SETF SC 1.0))
             (T (SETF SC (/ (+ (- D) B) A)))))
      (T
       (SETF TC (/ TN TD)
             SC (/ SN SD))))
     (VALUES DIR-A DIR-B W0 TC SC)))

[rtg-math/regions/line-segment3/consing.lisp:154]
  (DEFN DISTANCE-SQUARED-TO-LINE-SEG3
   ((LINE-SEG-A LINE-SEGMENT3) (LINE-SEG-B LINE-SEGMENT3))
   (VALUES (SINGLE-FLOAT 0.0 NIL) (SINGLE-FLOAT 0.0 NIL)
           (SINGLE-FLOAT 0.0 NIL))
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MULTIPLE-VALUE-BIND (DIR-A DIR-B W0 TC SC)
       (%SEG-TO-SEG-INTERNALS LINE-SEG-A LINE-SEG-B)
     (LET ((WC
            (#S(FORMGREP:SYMREF :NAME "+" :QUALIFIER "V3") W0
             (#S(FORMGREP:SYMREF :NAME "*S" :QUALIFIER "V3") DIR-A SC)
             (#S(FORMGREP:SYMREF :NAME "*S" :QUALIFIER "V3") DIR-B TC))))
       (VALUES (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") WC WC) TC SC))))

[rtg-math/regions/line-segment3/consing.lisp:168]
  (DEFN DISTANCE-TO-LINE-SEG3
   ((LINE-SEG-A LINE-SEGMENT3) (LINE-SEG-B LINE-SEGMENT3))
   (VALUES SINGLE-FLOAT SINGLE-FLOAT SINGLE-FLOAT)
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MULTIPLE-VALUE-BIND (VAL T-C S-C)
       (DISTANCE-SQUARED-TO-LINE-SEG3 LINE-SEG-A LINE-SEG-B)
     (VALUES (SQRT VAL) T-C S-C)))

[rtg-math/regions/line-segment3/consing.lisp:178]
  (DEFN %SEG-TO-RAY-INTERNALS ((LINE-SEG3 LINE-SEGMENT3) (RAY3 RAY3))
   (VALUES VEC3 VEC3 VEC3 (SINGLE-FLOAT 0.0 NIL) (SINGLE-FLOAT 0.0 NIL))
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   "Returns: dir-a dir-b w0 tc sc"
   (LET* ((ORIG-A (END-POINT0 LINE-SEG3))
          (ORIG-B (#S(FORMGREP:SYMREF :NAME "ORIGIN" :QUALIFIER "RAY3") RAY3))
          (DIR-A (DIRECTION LINE-SEG3))
          (DIR-B
           (#S(FORMGREP:SYMREF :NAME "DIRECTION" :QUALIFIER "RAY3") RAY3))
          (W0 (#S(FORMGREP:SYMREF :NAME "-" :QUALIFIER "V3") ORIG-A ORIG-B))
          (A (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR-A DIR-A))
          (B (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR-A DIR-B))
          (C (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR-B DIR-B))
          (D (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR-A W0))
          (E (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR-B W0))
          (DENOM (- (* A C) (* B B)))
          (SN 0.0)
          (SD 0.0)
          (TN 0.0)
          (TD 0.0)
          (TC 0.0)
          (SC 0.0))
     (IF (SFZERO-P DENOM)
         (SETF TD C
               SD C
               SN 0.0
               TN E)
         (PROGN
          (SETF TD DENOM
                SD DENOM
                SN (- (* B E) (* C D))
                TN (- (* A E) (* B D)))
          (IF (< SN 0.0)
              (SETF SN 0.0
                    TN E
                    TD C)
              (WHEN (> SN SD)
                (SETF SN SD
                      TN (+ E B)
                      TD C)))))
     (IF (< TN 0.0)
         (PROGN
          (SETF TC 0.0)
          (COND ((< (- D) 0.0) (SETF SC 0.0)) ((> (- D) A) (SETF SC 1.0))
                (T (SETF SC (/ (- D) A)))))
         (SETF TC (/ TN TD)
               SC (/ SN SD)))
     (VALUES DIR-A DIR-B W0 TC SC)))

[rtg-math/regions/line-segment3/consing.lisp:246]
  (DEFN DISTANCE-SQUARED-TO-RAY3 ((LINE-SEG3 LINE-SEGMENT3) (RAY3 RAY3))
   (VALUES (SINGLE-FLOAT 0.0 NIL) (SINGLE-FLOAT 0.0 NIL)
           (SINGLE-FLOAT 0.0 NIL))
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MULTIPLE-VALUE-BIND (DIR-A DIR-B W0 TC SC)
       (%SEG-TO-RAY-INTERNALS LINE-SEG3 RAY3)
     (LET ((WC
            (#S(FORMGREP:SYMREF :NAME "+" :QUALIFIER "V3") W0
             (#S(FORMGREP:SYMREF :NAME "*S" :QUALIFIER "V3") DIR-A SC)
             (#S(FORMGREP:SYMREF :NAME "*S" :QUALIFIER "V3") DIR-B TC))))
       (VALUES (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") WC WC) TC SC))))

[rtg-math/regions/line-segment3/consing.lisp:261]
  (DEFN DISTANCE-TO-RAY3 ((LINE-SEG3 LINE-SEGMENT3) (RAY3 RAY3))
   (VALUES SINGLE-FLOAT SINGLE-FLOAT SINGLE-FLOAT)
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MULTIPLE-VALUE-BIND (VAL T-C S-C)
       (DISTANCE-SQUARED-TO-RAY3 LINE-SEG3 RAY3)
     (VALUES (SQRT VAL) T-C S-C)))

[rtg-math/regions/line-segment3/consing.lisp:269]
  (DEFN DISTANCE-SQUARED-TO-LINE3 ((LINE-SEG3 LINE-SEGMENT3) (LINE3 LINE3))
   (VALUES (SINGLE-FLOAT 0.0 NIL) (SINGLE-FLOAT 0.0 NIL)
           (SINGLE-FLOAT 0.0 NIL))
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET* ((ORIG-A (END-POINT0 LINE-SEG3))
          (ORIG-B
           (#S(FORMGREP:SYMREF :NAME "ORIGIN" :QUALIFIER "LINE3") LINE3))
          (DIR-A (DIRECTION LINE-SEG3))
          (DIR-B
           (#S(FORMGREP:SYMREF :NAME "DIRECTION" :QUALIFIER "LINE3") LINE3))
          (W0 (#S(FORMGREP:SYMREF :NAME "-" :QUALIFIER "V3") ORIG-A ORIG-B))
          (A (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR-A DIR-A))
          (B (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR-A DIR-B))
          (C (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR-B DIR-B))
          (D (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR-A W0))
          (E (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR-B W0))
          (DENOM (- (* A C) (* B B))))
     (IF (SFZERO-P DENOM)
         (LET* ((SC 0.0)
                (TC (/ E C))
                (WC
                 (#S(FORMGREP:SYMREF :NAME "-" :QUALIFIER "V3") W0
                  (#S(FORMGREP:SYMREF :NAME "*S" :QUALIFIER "V3") DIR-B TC))))
           (VALUES (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") WC WC) TC
                   SC))
         (LET ((TC 0.0) (SC 0.0) (SN (- (* B E) (* C D))))
           (COND
            ((< SN 0.0)
             (SETF SC 0.0
                   TC (/ E C)))
            ((> SN DENOM)
             (SETF SC 1.0
                   TC (/ (+ E B) C)))
            (T
             (SETF SC (/ SN DENOM)
                   TC (/ (- (* A E) (* B D)) DENOM))))
           (LET ((WC
                  (#S(FORMGREP:SYMREF :NAME "+" :QUALIFIER "V3") W0
                   (#S(FORMGREP:SYMREF :NAME "*S" :QUALIFIER "V3") DIR-A SC)
                   (#S(FORMGREP:SYMREF :NAME "*S" :QUALIFIER "V3") DIR-B TC))))
             (VALUES (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") WC WC) TC
                     SC))))))

[rtg-math/regions/line-segment3/consing.lisp:318]
  (DEFN DISTANCE-TO-LINE3 ((LINE-SEG3 LINE-SEGMENT3) (LINE3 LINE3))
   (VALUES (SINGLE-FLOAT 0.0 NIL) (SINGLE-FLOAT 0.0 NIL)
           (SINGLE-FLOAT 0.0 NIL))
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MULTIPLE-VALUE-BIND (VAL T-C S-C)
       (DISTANCE-SQUARED-TO-LINE3 LINE-SEG3 LINE3)
     (DECLARE ((SINGLE-FLOAT 0.0 NIL) VAL))
     (VALUES (SQRT VAL) T-C S-C)))

[rtg-math/regions/line-segment3/consing.lisp:330]
  (DEFN DISTANCE-SQUARED-TO-POINT ((LINE-SEG3 LINE-SEGMENT3) (POINT-V3 VEC3))
   (VALUES (SINGLE-FLOAT 0.0 NIL) (SINGLE-FLOAT 0.0 NIL))
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET* ((W
           (#S(FORMGREP:SYMREF :NAME "-" :QUALIFIER "V3") POINT-V3
            (END-POINT0 LINE-SEG3)))
          (DIR (DIRECTION LINE-SEG3))
          (PROJ (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") W DIR)))
     (IF (<= PROJ 0.0)
         (VALUES (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") W W) 0.0)
         (LET ((VSQ (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR DIR)))
           (IF (>= PROJ VSQ)
               (VALUES
                (+
                 (- (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") W W)
                    (* 2.0 PROJ))
                 VSQ)
                1.0)
               (LET ((TC (/ PROJ VSQ)))
                 (VALUES
                  (- (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") W W)
                     (* TC PROJ))
                  TC)))))))

[rtg-math/regions/line-segment3/consing.lisp:353]
  (DEFN DISTANCE-TO-POINT ((LINE-SEG3 LINE-SEGMENT3) (POINT-V3 VEC3))
   (VALUES SINGLE-FLOAT SINGLE-FLOAT)
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MULTIPLE-VALUE-BIND (VAL T-C)
       (DISTANCE-SQUARED-TO-POINT LINE-SEG3 POINT-V3)
     (DECLARE ((SINGLE-FLOAT 0.0 NIL) VAL))
     (VALUES (SQRT VAL) T-C)))

[rtg-math/regions/line-segment3/consing.lisp:363]
  (DEFN CLOSEST-LINE-SEGMENT-POINTS
   ((LINE-SEG-A LINE-SEGMENT3) (LINE-SEG-B LINE-SEGMENT3)) (VALUES VEC3 VEC3)
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MULTIPLE-VALUE-BIND (DIR-A DIR-B W0 TC SC)
       (%SEG-TO-SEG-INTERNALS LINE-SEG-A LINE-SEG-B)
     (DECLARE (IGNORE W0))
     (VALUES
      (#S(FORMGREP:SYMREF :NAME "+" :QUALIFIER "V3") (END-POINT0 LINE-SEG-A)
       (#S(FORMGREP:SYMREF :NAME "*S" :QUALIFIER "V3") DIR-A SC))
      (#S(FORMGREP:SYMREF :NAME "+" :QUALIFIER "V3") (END-POINT0 LINE-SEG-B)
       (#S(FORMGREP:SYMREF :NAME "*S" :QUALIFIER "V3") DIR-B TC)))))

[rtg-math/regions/line-segment3/consing.lisp:375]
  (DEFN CLOSEST-RAY-POINTS ((LINE-SEG-A LINE-SEGMENT3) (RAY3 RAY3))
   (VALUES VEC3 VEC3) (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MULTIPLE-VALUE-BIND (DIR-A DIR-B W0 TC SC)
       (%SEG-TO-RAY-INTERNALS LINE-SEG-A RAY3)
     (DECLARE (IGNORE W0))
     (VALUES
      (#S(FORMGREP:SYMREF :NAME "+" :QUALIFIER "V3") (END-POINT0 LINE-SEG-A)
       (#S(FORMGREP:SYMREF :NAME "*S" :QUALIFIER "V3") DIR-A SC))
      (#S(FORMGREP:SYMREF :NAME "+" :QUALIFIER "V3")
       (#S(FORMGREP:SYMREF :NAME "ORIGIN" :QUALIFIER "RAY3") RAY3)
       (#S(FORMGREP:SYMREF :NAME "*S" :QUALIFIER "V3") DIR-B TC)))))

[rtg-math/regions/line-segment3/consing.lisp:387]
  (DEFN CLOSEST-LINE-POINTS ((LINE-SEG3 LINE-SEGMENT3) (LINE3 LINE3))
   (VALUES VEC3 VEC3) (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET* ((ORIG-A (END-POINT0 LINE-SEG3))
          (ORIG-B
           (#S(FORMGREP:SYMREF :NAME "ORIGIN" :QUALIFIER "LINE3") LINE3))
          (DIR-A (DIRECTION LINE-SEG3))
          (DIR-B
           (#S(FORMGREP:SYMREF :NAME "DIRECTION" :QUALIFIER "LINE3") LINE3))
          (W0 (#S(FORMGREP:SYMREF :NAME "-" :QUALIFIER "V3") ORIG-A ORIG-B))
          (A (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR-A DIR-A))
          (B (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR-A DIR-B))
          (C (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR-B DIR-B))
          (D (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR-A W0))
          (E (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR-B W0))
          (DENOM (- (* A C) (* B B))))
     (IF (SFZERO-P DENOM)
         (VALUES ORIG-A
                 (#S(FORMGREP:SYMREF :NAME "+" :QUALIFIER "V3") ORIG-B
                  (#S(FORMGREP:SYMREF :NAME "*S" :QUALIFIER "V3") DIR-B
                   (/ E C))))
         (LET ((TC 0.0) (SC 0.0) (SN (- (* B E) (* C D))))
           (COND
            ((< SN 0.0)
             (SETF SC 0.0
                   TC (/ E C)))
            ((> SN DENOM)
             (SETF SC 1.0
                   TC (/ (+ E B) C)))
            (T
             (SETF SC (/ SN DENOM)
                   TC (/ (- (* A E) (* B D)) DENOM))))
           (VALUES
            (#S(FORMGREP:SYMREF :NAME "+" :QUALIFIER "V3") ORIG-A
             (#S(FORMGREP:SYMREF :NAME "*S" :QUALIFIER "V3") DIR-A SC))
            (#S(FORMGREP:SYMREF :NAME "+" :QUALIFIER "V3") ORIG-B
             (#S(FORMGREP:SYMREF :NAME "*S" :QUALIFIER "V3") DIR-B TC)))))))

[rtg-math/regions/line-segment3/consing.lisp:430]
  (DEFN CLOSEST-POINT ((LINE-SEG3 LINE-SEGMENT3) (POINT-V3 VEC3)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET* ((DIR (DIRECTION LINE-SEG3))
          (ORIG (END-POINT0 LINE-SEG3))
          (W (#S(FORMGREP:SYMREF :NAME "-" :QUALIFIER "V3") POINT-V3 ORIG))
          (PROJ (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") W DIR)))
     (IF (<= PROJ 0.0)
         ORIG
         (LET* ((VSQ (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR DIR)))
           (IF (>= PROJ VSQ)
               (#S(FORMGREP:SYMREF :NAME "+" :QUALIFIER "V3") ORIG DIR)
               (#S(FORMGREP:SYMREF :NAME "+" :QUALIFIER "V3") ORIG
                (#S(FORMGREP:SYMREF :NAME "*S" :QUALIFIER "V3") DIR
                 (/ PROJ VSQ))))))))

[rtg-math/regions/line3/consing.lisp:5]
  (DEFN-INLINE ORIGIN ((LINE3 LINE3)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))) (LINE3-ORIGIN LINE3))

[rtg-math/regions/line3/consing.lisp:9]
  (DEFN DIRECTION ((LINE3 LINE3)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))) (LINE3-DIRECTION LINE3))

[rtg-math/regions/line3/consing.lisp:13]
  (DEFN-INLINE MAKE ((ORIGIN-V3 VEC3) (DIRECTION-V3 VEC3)) LINE3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE-LINE3 :ORIGIN ORIGIN-V3 :DIRECTION
    (#S(FORMGREP:SYMREF :NAME "NORMALIZE" :QUALIFIER "V3") DIRECTION-V3)))

[rtg-math/regions/line3/consing.lisp:20]
  (DEFN TRANSFORM-M3 ((MATRIX3 MAT3) (LINE3 LINE3)) LINE3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE
    (#S(FORMGREP:SYMREF :NAME "*V" :QUALIFIER "M3") MATRIX3 (ORIGIN LINE3))
    (#S(FORMGREP:SYMREF :NAME "*V" :QUALIFIER "M3") MATRIX3 (DIRECTION LINE3))))

[rtg-math/regions/line3/consing.lisp:25]
  (DEFN TRANSFORM-Q ((QUAT QUATERNION) (LINE3 LINE3)) LINE3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE
    (#S(FORMGREP:SYMREF :NAME "ROTATE" :QUALIFIER "Q") (ORIGIN LINE3) QUAT)
    (#S(FORMGREP:SYMREF :NAME "ROTATE" :QUALIFIER "Q") (DIRECTION LINE3) QUAT)))

[rtg-math/regions/line3/consing.lisp:32]
  (DEFN-INLINE = ((LINE3-A LINE3) (LINE3-B LINE3)) BOOLEAN
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (AND
    (#S(FORMGREP:SYMREF :NAME "=" :QUALIFIER "V3") (ORIGIN LINE3-A)
     (ORIGIN LINE3-B))
    (#S(FORMGREP:SYMREF :NAME "=" :QUALIFIER "V3") (DIRECTION LINE3-A)
     (DIRECTION LINE3-B))))

[rtg-math/regions/line3/consing.lisp:37]
  (DEFN /= ((LINE3-A LINE3) (LINE3-B LINE3)) BOOLEAN
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE =))
   (NOT (= LINE3-A LINE3-B)))

[rtg-math/regions/line3/consing.lisp:44]
  (DEFN CLOSEST-POINT ((LINE3 LINE3) (POINT-V3 VEC3)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET* ((DIR (LINE3-DIRECTION LINE3))
          (W
           (#S(FORMGREP:SYMREF :NAME "-" :QUALIFIER "V3") POINT-V3
            (LINE3-ORIGIN LINE3)))
          (VSQ (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR DIR))
          (PROJ (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") W DIR)))
     (#S(FORMGREP:SYMREF :NAME "+" :QUALIFIER "V3") (LINE3-ORIGIN LINE3)
      (#S(FORMGREP:SYMREF :NAME "*S" :QUALIFIER "V3") DIR (/ PROJ VSQ)))))

[rtg-math/regions/line3/consing.lisp:53]
  (DEFN CLOSEST-LINE-POINTS ((LINE3-A LINE3) (LINE3-B LINE3))
   (VALUES VEC3 VEC3) (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET* ((W0
           (#S(FORMGREP:SYMREF :NAME "-" :QUALIFIER "V3")
            (LINE3-ORIGIN LINE3-A) (LINE3-ORIGIN LINE3-B)))
          (A
           (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3")
            (LINE3-DIRECTION LINE3-A) (LINE3-DIRECTION LINE3-A)))
          (B
           (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3")
            (LINE3-DIRECTION LINE3-A) (LINE3-DIRECTION LINE3-B)))
          (C
           (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3")
            (LINE3-DIRECTION LINE3-B) (LINE3-DIRECTION LINE3-B)))
          (D
           (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3")
            (LINE3-DIRECTION LINE3-A) W0))
          (E
           (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3")
            (LINE3-DIRECTION LINE3-B) W0))
          (DENOM (- (* A C) (* B B))))
     (IF (SFZERO-P DENOM)
         (LET ((P0 (LINE3-ORIGIN LINE3-A))
               (P1
                (#S(FORMGREP:SYMREF :NAME "+" :QUALIFIER "V3")
                 (LINE3-ORIGIN LINE3-B)
                 (#S(FORMGREP:SYMREF :NAME "*S" :QUALIFIER "V3")
                  (LINE3-DIRECTION LINE3-B) (/ E C)))))
           (VALUES P0 P1))
         (LET ((P0
                (#S(FORMGREP:SYMREF :NAME "+" :QUALIFIER "V3")
                 (LINE3-ORIGIN LINE3-A)
                 (#S(FORMGREP:SYMREF :NAME "*S" :QUALIFIER "V3")
                  (LINE3-DIRECTION LINE3-A) (/ (- (* B E) (* C D)) DENOM))))
               (P1
                (#S(FORMGREP:SYMREF :NAME "+" :QUALIFIER "V3")
                 (LINE3-ORIGIN LINE3-B)
                 (#S(FORMGREP:SYMREF :NAME "*S" :QUALIFIER "V3")
                  (LINE3-DIRECTION LINE3-B) (/ (- (* A E) (* B D)) DENOM)))))
           (VALUES P0 P1)))))

[rtg-math/regions/line3/consing.lisp:86]
  (DEFN DISTANCE-SQUARED-TO-POINT ((LINE3 LINE3) (POINT-V3 VEC3))
   (VALUES (SINGLE-FLOAT 0.0 NIL) (SINGLE-FLOAT 0.0 NIL))
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET* ((DIR (LINE3-DIRECTION LINE3))
          (W
           (#S(FORMGREP:SYMREF :NAME "-" :QUALIFIER "V3") POINT-V3
            (LINE3-ORIGIN LINE3)))
          (VSQ (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR DIR))
          (PROJ (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") W DIR)))
     (LET ((T-C (/ PROJ VSQ)))
       (VALUES
        (- (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") W W) (* T-C PROJ))
        T-C))))

[rtg-math/regions/line3/consing.lisp:98]
  (DEFN DISTANCE-TO-POINT ((LINE3 LINE3) (POINT-V3 VEC3))
   (VALUES SINGLE-FLOAT SINGLE-FLOAT)
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MULTIPLE-VALUE-BIND (VAL T-C)
       (DISTANCE-SQUARED-TO-POINT LINE3 POINT-V3)
     (VALUES (SQRT VAL) T-C)))

[rtg-math/regions/line3/consing.lisp:106]
  (DEFN DISTANCE-SQUARED-TO-LINE3 ((LINE3-A LINE3) (LINE3-B LINE3))
   (VALUES (SINGLE-FLOAT 0.0 NIL) (SINGLE-FLOAT 0.0 NIL)
           (SINGLE-FLOAT 0.0 NIL))
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET* ((DIR-A (LINE3-DIRECTION LINE3-A))
          (DIR-B (LINE3-DIRECTION LINE3-B))
          (ORIGIN-A (LINE3-ORIGIN LINE3-A))
          (ORIGIN-B (LINE3-ORIGIN LINE3-B))
          (W0
           (#S(FORMGREP:SYMREF :NAME "-" :QUALIFIER "V3") ORIGIN-A ORIGIN-B))
          (A (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR-A DIR-A))
          (B (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR-A DIR-B))
          (C (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR-B DIR-B))
          (D (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR-A W0))
          (E (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR-B W0))
          (DENOM (- (* A C) (* B B))))
     (IF (SFZERO-P DENOM)
         (LET* ((S-C 0.0)
                (T-C (/ E C))
                (WC
                 (#S(FORMGREP:SYMREF :NAME "-" :QUALIFIER "V3") W0
                  (#S(FORMGREP:SYMREF :NAME "*S" :QUALIFIER "V3") DIR-B T-C))))
           (VALUES (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") WC WC) T-C
                   S-C))
         (LET* ((S-C (/ (- (* B E) (* C D)) DENOM))
                (T-C (/ (- (* A E) (* B D)) DENOM))
                (WC
                 (#S(FORMGREP:SYMREF :NAME "+" :QUALIFIER "V3") W0
                  (#S(FORMGREP:SYMREF :NAME "-" :QUALIFIER "V3")
                   (#S(FORMGREP:SYMREF :NAME "*S" :QUALIFIER "V3") DIR-A S-C)
                   (#S(FORMGREP:SYMREF :NAME "*S" :QUALIFIER "V3") DIR-B
                    T-C)))))
           (VALUES (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") WC WC) T-C
                   S-C)))))

[rtg-math/regions/line3/consing.lisp:132]
  (DEFN DISTANCE-TO-LINE3 ((LINE3-A LINE3) (LINE3-B LINE3))
   (VALUES SINGLE-FLOAT SINGLE-FLOAT SINGLE-FLOAT)
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MULTIPLE-VALUE-BIND (VAL T-C S-C)
       (DISTANCE-SQUARED-TO-LINE3 LINE3-A LINE3-B)
     (VALUES (SQRT VAL) T-C S-C)))

[rtg-math/regions/ray3/consing.lisp:5]
  (DEFN-INLINE ORIGIN ((RAY3 RAY3)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))) (RAY3-ORIGIN RAY3))

[rtg-math/regions/ray3/consing.lisp:9]
  (DEFN DIRECTION ((RAY3 RAY3)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))) (RAY3-DIRECTION RAY3))

[rtg-math/regions/ray3/consing.lisp:13]
  (DEFN-INLINE MAKE ((ORIGIN-V3 VEC3) (DIRECTION-V3 VEC3)) RAY3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE-RAY3 :ORIGIN ORIGIN-V3 :DIRECTION
    (#S(FORMGREP:SYMREF :NAME "NORMALIZE" :QUALIFIER "V3") DIRECTION-V3)))

[rtg-math/regions/ray3/consing.lisp:20]
  (DEFN TRANSFORM-M3 ((MATRIX3 MAT3) (RAY3 RAY3)) RAY3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE (#S(FORMGREP:SYMREF :NAME "*V" :QUALIFIER "M3") MATRIX3 (ORIGIN RAY3))
    (#S(FORMGREP:SYMREF :NAME "*V" :QUALIFIER "M3") MATRIX3 (DIRECTION RAY3))))

[rtg-math/regions/ray3/consing.lisp:25]
  (DEFN TRANSFORM-Q ((QUAT QUATERNION) (RAY3 RAY3)) RAY3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE (#S(FORMGREP:SYMREF :NAME "ROTATE" :QUALIFIER "Q") (ORIGIN RAY3) QUAT)
    (#S(FORMGREP:SYMREF :NAME "ROTATE" :QUALIFIER "Q") (DIRECTION RAY3) QUAT)))

[rtg-math/regions/ray3/consing.lisp:32]
  (DEFN-INLINE = ((RAY3-A RAY3) (RAY3-B RAY3)) BOOLEAN
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (AND
    (#S(FORMGREP:SYMREF :NAME "=" :QUALIFIER "V3") (ORIGIN RAY3-A)
     (ORIGIN RAY3-B))
    (#S(FORMGREP:SYMREF :NAME "=" :QUALIFIER "V3") (DIRECTION RAY3-A)
     (DIRECTION RAY3-B))))

[rtg-math/regions/ray3/consing.lisp:37]
  (DEFN /= ((RAY3-A RAY3) (RAY3-B RAY3)) BOOLEAN
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))
            (INLINE =))
   (NOT (= RAY3-A RAY3-B)))

[rtg-math/regions/ray3/consing.lisp:44]
  (DEFN DISTANCE-SQUARED-TO-RAY3 ((RAY3-A RAY3) (RAY3-B RAY3))
   (VALUES (SINGLE-FLOAT 0.0 NIL) (SINGLE-FLOAT 0.0 NIL)
           (SINGLE-FLOAT 0.0 NIL))
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET* ((ORIG-A (RAY3-ORIGIN RAY3-A))
          (ORIG-B (RAY3-ORIGIN RAY3-B))
          (DIR-A (RAY3-DIRECTION RAY3-A))
          (DIR-B (RAY3-DIRECTION RAY3-B))
          (W0 (#S(FORMGREP:SYMREF :NAME "-" :QUALIFIER "V3") ORIG-A ORIG-B))
          (A (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR-A DIR-A))
          (B (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR-A DIR-B))
          (C (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR-B DIR-B))
          (D (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR-A W0))
          (E (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR-B W0))
          (DENOM (- (* A C) (* B B)))
          (SN 0.0)
          (SD 0.0)
          (TN 0.0)
          (TD 0.0))
     (IF (SFZERO-P DENOM)
         (SETF TD C
               SD C
               SN 0.0
               TN E)
         (PROGN
          (SETF TD DENOM
                SD DENOM
                SN (- (* B E) (* C D))
                TN (- (* A E) (* B D)))
          (WHEN (< SN 0.0)
            (SETF SN 0.0
                  TN E
                  TD C))))
     (LET* ((TNL0 (< TN 0.0))
            (TC
             (IF TNL0
                 0.0
                 (/ TN TD)))
            (SC
             (IF TNL0
                 (IF (< D 0.0)
                     0.0
                     (/ (- D) A))
                 (/ SN SD)))
            (WC
             (#S(FORMGREP:SYMREF :NAME "+" :QUALIFIER "V3") W0
              (#S(FORMGREP:SYMREF :NAME "-" :QUALIFIER "V3")
               (#S(FORMGREP:SYMREF :NAME "*S" :QUALIFIER "V3") DIR-A SC)
               (#S(FORMGREP:SYMREF :NAME "*S" :QUALIFIER "V3") DIR-B TC)))))
       (VALUES (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") WC WC) TC SC))))

[rtg-math/regions/ray3/consing.lisp:94]
  (DEFN DISTANCE-TO-RAY3 ((RAY3-A RAY3) (RAY3-B RAY3))
   (VALUES SINGLE-FLOAT SINGLE-FLOAT SINGLE-FLOAT)
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MULTIPLE-VALUE-BIND (VAL T-C S-C)
       (DISTANCE-SQUARED-TO-RAY3 RAY3-A RAY3-B)
     (VALUES (SQRT VAL) T-C S-C)))

[rtg-math/regions/ray3/consing.lisp:102]
  (DEFN DISTANCE-SQUARED-TO-LINE3 ((RAY3 RAY3) (LINE3 LINE3))
   (VALUES (SINGLE-FLOAT 0.0 NIL) (SINGLE-FLOAT 0.0 NIL)
           (SINGLE-FLOAT 0.0 NIL))
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET* ((RAY-ORIG (RAY3-ORIGIN RAY3))
          (LINE-ORIG
           (#S(FORMGREP:SYMREF :NAME "ORIGIN" :QUALIFIER "LINE3") LINE3))
          (RAY-DIR (RAY3-DIRECTION RAY3))
          (LINE-DIR
           (#S(FORMGREP:SYMREF :NAME "DIRECTION" :QUALIFIER "LINE3") LINE3))
          (W0
           (#S(FORMGREP:SYMREF :NAME "-" :QUALIFIER "V3") RAY-ORIG LINE-ORIG))
          (A (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") RAY-DIR RAY-DIR))
          (B
           (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") RAY-DIR LINE-DIR))
          (C
           (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") LINE-DIR LINE-DIR))
          (D (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") RAY-DIR W0))
          (E (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") LINE-DIR W0))
          (DENOM (- (* A C) (* B B))))
     (IF (SFZERO-P DENOM)
         (LET* ((SC 0.0)
                (TC (/ E C))
                (WC
                 (#S(FORMGREP:SYMREF :NAME "-" :QUALIFIER "V3") W0
                  (#S(FORMGREP:SYMREF :NAME "*S" :QUALIFIER "V3") LINE-DIR
                   TC))))
           (VALUES (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") WC WC) TC
                   SC))
         (LET ((TC 0.0) (SC 0.0) (SN (- (* B E) (* C D))))
           (COND
            ((< SN 0.0)
             (SETF SC 0.0
                   TC (/ E C)))
            ((> SN DENOM)
             (SETF SC 1.0
                   TC (/ (+ E B) C)))
            (T
             (SETF SC (/ SN DENOM)
                   TC (/ (- (* A E) (* B D)) DENOM))))
           (LET ((WC
                  (#S(FORMGREP:SYMREF :NAME "+" :QUALIFIER "V3") W0
                   (#S(FORMGREP:SYMREF :NAME "*S" :QUALIFIER "V3") RAY-DIR SC)
                   (#S(FORMGREP:SYMREF :NAME "*S" :QUALIFIER "V3") LINE-DIR
                    TC))))
             (VALUES (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") WC WC) TC
                     SC))))))

[rtg-math/regions/ray3/consing.lisp:143]
  (DEFN DISTANCE-TO-LINE3 ((RAY3 RAY3) (LINE3 LINE3))
   (VALUES (SINGLE-FLOAT 0.0 NIL) (SINGLE-FLOAT 0.0 NIL)
           (SINGLE-FLOAT 0.0 NIL))
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MULTIPLE-VALUE-BIND (VAL T-C S-C)
       (DISTANCE-SQUARED-TO-LINE3 RAY3 LINE3)
     (DECLARE ((SINGLE-FLOAT 0.0 NIL) VAL))
     (VALUES (SQRT VAL) T-C S-C)))

[rtg-math/regions/ray3/consing.lisp:155]
  (DEFN DISTANCE-SQUARED-TO-POINT ((RAY3 RAY3) (POINT-V3 VEC3))
   (VALUES (SINGLE-FLOAT 0.0 NIL) (SINGLE-FLOAT 0.0 NIL))
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET* ((DIR (RAY3-DIRECTION RAY3))
          (W
           (#S(FORMGREP:SYMREF :NAME "-" :QUALIFIER "V3") POINT-V3
            (RAY3-ORIGIN RAY3)))
          (PROJ
           (THE SINGLE-FLOAT
                (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") W DIR))))
     (IF (<= PROJ 0.0)
         (VALUES (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") W W) 0.0)
         (LET* ((VSQ (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR DIR))
                (T-C (/ PROJ VSQ)))
           (VALUES
            (- (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") W W)
               (* T-C PROJ))
            T-C)))))

[rtg-math/regions/ray3/consing.lisp:169]
  (DEFN DISTANCE-TO-POINT ((RAY3 RAY3) (POINT-V3 VEC3))
   (VALUES SINGLE-FLOAT SINGLE-FLOAT)
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MULTIPLE-VALUE-BIND (VAL T-C)
       (DISTANCE-SQUARED-TO-POINT RAY3 POINT-V3)
     (DECLARE ((SINGLE-FLOAT 0.0 NIL) VAL))
     (VALUES (SQRT VAL) T-C)))

[rtg-math/regions/ray3/consing.lisp:179]
  (DEFN CLOSEST-RAY-POINTS ((RAY3-A RAY3) (RAY3-B RAY3)) (VALUES VEC3 VEC3)
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET* ((ORIG-A (RAY3-ORIGIN RAY3-A))
          (ORIG-B (RAY3-ORIGIN RAY3-B))
          (DIR-A (RAY3-DIRECTION RAY3-A))
          (DIR-B (RAY3-DIRECTION RAY3-B))
          (W0 (#S(FORMGREP:SYMREF :NAME "-" :QUALIFIER "V3") ORIG-A ORIG-B))
          (A (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR-A DIR-A))
          (B (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR-A DIR-B))
          (C (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR-B DIR-B))
          (D (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR-A W0))
          (E (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR-B W0))
          (DENOM (- (* A C) (* B B))))
     (LET ((SN 0.0) (SD 0.0) (TN 0.0) (TD 0.0))
       (IF (SFZERO-P DENOM)
           (SETF TD C
                 SD C
                 SN 0.0
                 TN E)
           (PROGN
            (SETF TD DENOM
                  SD DENOM
                  SN (- (* B E) (* C D))
                  TN (- (* A E) (* B D)))
            (WHEN (< SN 0.0)
              (SETF SN 0.0
                    TN E
                    TD C))))
       (LET* ((TNL0 (< TN 0.0))
              (TC
               (IF TNL0
                   0.0
                   (/ TN TD)))
              (SC
               (IF TNL0
                   (IF (< D 0.0)
                       0.0
                       (/ (- D) A))
                   (/ SN SD))))
         (VALUES
          (#S(FORMGREP:SYMREF :NAME "+" :QUALIFIER "V3") ORIG-A
           (#S(FORMGREP:SYMREF :NAME "*S" :QUALIFIER "V3") DIR-A SC))
          (#S(FORMGREP:SYMREF :NAME "+" :QUALIFIER "V3") ORIG-B
           (#S(FORMGREP:SYMREF :NAME "*S" :QUALIFIER "V3") DIR-B TC)))))))

[rtg-math/regions/ray3/consing.lisp:220]
  (DEFN CLOSEST-POINT ((RAY3 RAY3) (POINT-V3 VEC3)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET* ((DIR (RAY3-DIRECTION RAY3))
          (ORIG (RAY3-ORIGIN RAY3))
          (W (#S(FORMGREP:SYMREF :NAME "-" :QUALIFIER "V3") POINT-V3 ORIG))
          (PROJ
           (THE SINGLE-FLOAT
                (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") W DIR))))
     (IF (<= PROJ 0.0)
         ORIG
         (LET* ((VSQ (#S(FORMGREP:SYMREF :NAME "DOT" :QUALIFIER "V3") DIR DIR)))
           (#S(FORMGREP:SYMREF :NAME "+" :QUALIFIER "V3") ORIG
            (#S(FORMGREP:SYMREF :NAME "*S" :QUALIFIER "V3") DIR
             (/ PROJ VSQ)))))))

[rtg-math/vectors/vector2/consing.lisp:5]
  (DEFN-INLINE MAKE ((X SINGLE-FLOAT) (Y SINGLE-FLOAT)) VEC2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (#S(FORMGREP:SYMREF :NAME "SET-COMPONENTS" :QUALIFIER "V2-N") X Y
    (MAKE-ARRAY 2 :ELEMENT-TYPE (ECLECTOR.READER:QUASIQUOTE SINGLE-FLOAT))))

[rtg-math/vectors/vector2/consing.lisp:11]
  (DEFN-INLINE COPY-VEC2 ((VEC2 VEC2)) VEC2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((VEC
          (MAKE-ARRAY 2 :ELEMENT-TYPE
                      (ECLECTOR.READER:QUASIQUOTE SINGLE-FLOAT))))
     (SETF (AREF VEC 0) (AREF VEC2 0)
           (AREF VEC 1) (AREF VEC2 1))
     VEC))

[rtg-math/vectors/vector2/consing.lisp:20]
  (DEFN |0P| ((VECTOR-A VEC2)) BOOLEAN
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (= 0.0 (+ (EXPT (AREF VECTOR-A 0) 2) (EXPT (AREF VECTOR-A 1) 2))))

[rtg-math/vectors/vector2/consing.lisp:27]
  (DEFN UNITP ((VECTOR-A VEC2)) BOOLEAN
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (= 0.0 (- 1.0 (+ (EXPT (AREF VECTOR-A 0) 2) (EXPT (AREF VECTOR-A 1) 2)))))

[rtg-math/vectors/vector2/consing.lisp:33]
  (DEFN = ((VECTOR-A VEC2) (VECTOR-B VEC2)) BOOLEAN
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (AND (= (AREF VECTOR-A 0) (AREF VECTOR-B 0))
        (= (AREF VECTOR-A 1) (AREF VECTOR-B 1))))

[rtg-math/vectors/vector2/consing.lisp:40]
  (DEFN +S ((VEC2 VEC2) (SCALAR SINGLE-FLOAT)) VEC2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE (+ (X VEC2) SCALAR) (+ (Y VEC2) SCALAR)))

[rtg-math/vectors/vector2/consing.lisp:47]
  (DEFN -S ((VEC2 VEC2) (SCALAR SINGLE-FLOAT)) VEC2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE (- (X VEC2) SCALAR) (- (Y VEC2) SCALAR)))

[rtg-math/vectors/vector2/consing.lisp:54]
  (DEFN %+ ((VECTOR-A VEC2) (VECTOR-B VEC2)) VEC2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE (+ (AREF VECTOR-A 0) (AREF VECTOR-B 0))
    (+ (AREF VECTOR-A 1) (AREF VECTOR-B 1))))

[rtg-math/vectors/vector2/consing.lisp:59]
  (DEFN + (&REST (VEC2S VEC2)) VEC2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (IF VEC2S
       (LET ((X 0.0) (Y 0.0))
         (DECLARE (SINGLE-FLOAT X Y))
         (LOOP :FOR VEC :IN VEC2S
               :DO (LET ((VEC VEC))
                     (DECLARE (VEC2 VEC))
                     (INCF X (X VEC))
                     (INCF Y (Y VEC))))
         (MAKE X Y))
       (MAKE 0.0 0.0)))

[rtg-math/vectors/vector2/consing.lisp:82]
  (DEFN %- ((VECTOR-A VEC2) (VECTOR-B VEC2)) VEC2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE (- (AREF VECTOR-A 0) (AREF VECTOR-B 0))
    (- (AREF VECTOR-A 1) (AREF VECTOR-B 1))))

[rtg-math/vectors/vector2/consing.lisp:87]
  (DEFN - ((VEC2 VEC2) &REST (VEC2S VEC2)) VEC2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))) (ASSERT VEC2)
   (IF VEC2S
       (LET ((X (X VEC2)) (Y (Y VEC2)))
         (DECLARE (SINGLE-FLOAT X Y))
         (LOOP :FOR VEC :IN VEC2S
               :DO (LET ((VEC VEC))
                     (DECLARE (VEC2 VEC))
                     (DECF X (X VEC))
                     (DECF Y (Y VEC))))
         (MAKE X Y))
       VEC2))

[rtg-math/vectors/vector2/consing.lisp:109]
  (DEFN * (&REST (VEC2S VEC2)) VEC2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (IF VEC2S
       (DESTRUCTURING-BIND
           (VEC2 . VEC2S)
           VEC2S
         (DECLARE (VEC2 VEC2))
         (LET ((X (X VEC2)) (Y (Y VEC2)))
           (DECLARE (SINGLE-FLOAT X Y))
           (LOOP :FOR VEC :IN VEC2S
                 :DO (LET ((VEC VEC))
                       (DECLARE (VEC2 VEC))
                       (SETF X (* X (X VEC)))
                       (SETF Y (* Y (Y VEC)))))
           (MAKE X Y)))
       (MAKE 1.0 1.0)))

[rtg-math/vectors/vector2/consing.lisp:139]
  (DEFN *S ((VECTOR-A VEC2) (A SINGLE-FLOAT)) VEC2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE (* (AREF VECTOR-A 0) A) (* (AREF VECTOR-A 1) A)))

[rtg-math/vectors/vector2/consing.lisp:163]
  (DEFN NEGATE ((VECTOR-A VEC2)) VEC2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE (- (AREF VECTOR-A 0)) (- (AREF VECTOR-A 1))))

[rtg-math/vectors/vector2/consing.lisp:169]
  (DEFN DOT ((VECTOR-A VEC2) (VECTOR-B VEC2)) SINGLE-FLOAT
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (+ (* (X VECTOR-A) (X VECTOR-B)) (* (Y VECTOR-A) (Y VECTOR-B))))

[rtg-math/vectors/vector2/consing.lisp:183]
  (DEFN LENGTH-SQUARED ((VECTOR-A VEC2)) (SINGLE-FLOAT 0.0 NIL)
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((X (X VECTOR-A)) (Y (Y VECTOR-A)))
     (+ (* X X) (* Y Y))))

[rtg-math/vectors/vector2/consing.lisp:192]
  (DEFN LENGTH ((VECTOR-A VEC2)) (SINGLE-FLOAT 0.0 NIL)
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SQRT (LENGTH-SQUARED VECTOR-A)))

[rtg-math/vectors/vector2/consing.lisp:199]
  (DEFN DISTANCE-SQUARED ((VECTOR-A VEC2) (VECTOR-B VEC2))
   (SINGLE-FLOAT 0.0 NIL) (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LENGTH-SQUARED (- VECTOR-B VECTOR-A)))

[rtg-math/vectors/vector2/consing.lisp:206]
  (DEFN DISTANCE ((VECTOR-A VEC2) (VECTOR-B VEC2)) (SINGLE-FLOAT 0.0 NIL)
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SQRT (DISTANCE-SQUARED VECTOR-A VECTOR-B)))

[rtg-math/vectors/vector2/consing.lisp:213]
  (DEFN ABS ((VECTOR-A VEC2)) VEC2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE (ABS (X VECTOR-A)) (ABS (Y VECTOR-A))))

[rtg-math/vectors/vector2/consing.lisp:219]
  (DEFN ABSOLUTE-DOT ((VECTOR-A VEC2) (VECTOR-B VEC2)) SINGLE-FLOAT
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (+ (ABS (* (AREF VECTOR-A 0) (AREF VECTOR-B 0)))
      (ABS (* (AREF VECTOR-A 1) (AREF VECTOR-B 1)))))

[rtg-math/vectors/vector2/consing.lisp:227]
  (DEFN NORMALIZE ((VECTOR-A VEC2)) VEC2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((LEN (LENGTH-SQUARED VECTOR-A)))
     (IF (= 0.0 LEN)
         VECTOR-A
         (*S VECTOR-A (INV-SQRT LEN)))))

[rtg-math/vectors/vector2/consing.lisp:236]
  (DEFN PERP-DOT ((VEC-A VEC2) (VEC-B VEC2)) SINGLE-FLOAT
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (- (* (X VEC-A) (Y VEC-B)) (* (Y VEC-A) (X VEC-B))))

[rtg-math/vectors/vector2/consing.lisp:242]
  (DEFN CROSS ((VEC-A VEC2) (VEC-B VEC2)) SINGLE-FLOAT
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (- (* (X VEC-A) (Y VEC-B)) (* (Y VEC-A) (X VEC-B))))

[rtg-math/vectors/vector2/consing.lisp:249]
  (DEFN LERP ((VECTOR-A VEC2) (VECTOR-B VEC2) (AMMOUNT SINGLE-FLOAT)) VEC2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (%+ (*S VECTOR-A (- 1.0 AMMOUNT)) (*S VECTOR-B AMMOUNT)))

[rtg-math/vectors/vector2/consing.lisp:255]
  (DEFN STABLE-LERP ((VECTOR-A VEC2) (VECTOR-B VEC2) (AMMOUNT SINGLE-FLOAT))
   VEC2 (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LERP VECTOR-A VECTOR-B AMMOUNT))

[rtg-math/vectors/vector2/consing.lisp:261]
  (DEFN BEZIER ((A1 VEC2) (A2 VEC2) (B1 VEC2) (B2 VEC2) (AMMOUNT SINGLE-FLOAT))
   VEC2 (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LERP (LERP A1 A2 AMMOUNT) (LERP B1 B2 AMMOUNT) AMMOUNT))

[rtg-math/vectors/vector2/consing.lisp:282]
  (DEFN FROM-ANGLE ((ANGLE SINGLE-FLOAT)) VEC2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((A (- ANGLE)))
     (MAKE (SIN A) (COS A))))

[rtg-math/vectors/vector2/consing.lisp:290]
  (DEFN ANGLE-FROM ((VEC-FROM VEC2) (VEC-TO VEC2)) SINGLE-FLOAT
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (ATAN (CROSS VEC-FROM VEC-TO) (DOT VEC-FROM VEC-TO)))

[rtg-math/vectors/vector2/consing.lisp:297]
  (DEFN ANGLE-BETWEEN ((VEC-A VEC2) (VEC-B VEC2)) SINGLE-FLOAT
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (ABS (ANGLE-FROM VEC-A VEC-B)))

[rtg-math/vectors/vector2/consing.lisp:305]
  (DEFN ROTATE ((VEC VEC2) (ANGLE SINGLE-FLOAT)) VEC2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (#S(FORMGREP:SYMREF :NAME "ROTATE" :QUALIFIER "V2-N") (COPY-VEC2 VEC) ANGLE))

[rtg-math/vectors/vector2/non-consing.lisp:5]
  (DEFN-INLINE SET-COMPONENTS ((X SINGLE-FLOAT) (Y SINGLE-FLOAT) (VEC VEC2))
   VEC2 (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SETF (X VEC) X
         (Y VEC) Y)
   VEC)

[rtg-math/vectors/vector2/non-consing.lisp:13]
  (DEFN-INLINE COPY-COMPONENTS ((VEC VEC2) (COPY-FROM VEC2)) VEC2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SETF (X VEC) (X COPY-FROM)
         (Y VEC) (Y COPY-FROM))
   VEC)

[rtg-math/vectors/vector2/non-consing.lisp:21]
  (DEFN +S ((VEC2 VEC2) (SCALAR SINGLE-FLOAT)) VEC2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))) (INCF (X VEC2) SCALAR)
   (INCF (Y VEC2) SCALAR) VEC2)

[rtg-math/vectors/vector2/non-consing.lisp:29]
  (DEFN -S ((VEC2 VEC2) (SCALAR SINGLE-FLOAT)) VEC2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))) (DECF (X VEC2) SCALAR)
   (DECF (Y VEC2) SCALAR) VEC2)

[rtg-math/vectors/vector2/non-consing.lisp:37]
  (DEFN %+ ((ACCUM-VEC VEC2) (TO-ADD-VEC VEC2)) VEC2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (INCF (AREF ACCUM-VEC 0) (AREF TO-ADD-VEC 0))
   (INCF (AREF ACCUM-VEC 1) (AREF TO-ADD-VEC 1)) ACCUM-VEC)

[rtg-math/vectors/vector2/non-consing.lisp:43]
  (DEFN + ((ACCUM-VEC VEC2) &REST (VEC2S VEC2)) VEC2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LOOP :FOR VEC :IN VEC2S
         :DO (%+ ACCUM-VEC VEC))
   ACCUM-VEC)

[rtg-math/vectors/vector2/non-consing.lisp:57]
  (DEFN %- ((ACCUM-VEC VEC2) (TO-ADD-VEC VEC2)) VEC2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (DECF (AREF ACCUM-VEC 0) (AREF TO-ADD-VEC 0))
   (DECF (AREF ACCUM-VEC 1) (AREF TO-ADD-VEC 1)) ACCUM-VEC)

[rtg-math/vectors/vector2/non-consing.lisp:63]
  (DEFN - ((ACCUM-VEC VEC2) &REST (VEC2S VEC2)) VEC2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LOOP :FOR VEC :IN VEC2S
         :DO (%- ACCUM-VEC VEC))
   ACCUM-VEC)

[rtg-math/vectors/vector2/non-consing.lisp:77]
  (DEFN %* ((ACCUM-VEC VEC2) (TO-MULT-VEC VEC2)) VEC2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SETF (AREF ACCUM-VEC 0) (* (AREF ACCUM-VEC 0) (AREF TO-MULT-VEC 0)))
   (SETF (AREF ACCUM-VEC 1) (* (AREF ACCUM-VEC 1) (AREF TO-MULT-VEC 1)))
   ACCUM-VEC)

[rtg-math/vectors/vector2/non-consing.lisp:83]
  (DEFN * ((ACCUM-VEC VEC2) &REST (VEC2S VEC2)) VEC2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LOOP :FOR VEC :IN VEC2S
         :DO (%* ACCUM-VEC VEC))
   ACCUM-VEC)

[rtg-math/vectors/vector2/non-consing.lisp:97]
  (DEFN *S ((VEC2 VEC2) (A SINGLE-FLOAT)) VEC2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SETF (X VEC2) (* (X VEC2) A)) (SETF (Y VEC2) (* (Y VEC2) A)) VEC2)

[rtg-math/vectors/vector2/non-consing.lisp:105]
  (DEFN /S ((VEC2 VEC2) (A SINGLE-FLOAT)) VEC2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SETF (X VEC2) (/ (X VEC2) A)) (SETF (Y VEC2) (/ (Y VEC2) A)) VEC2)

[rtg-math/vectors/vector2/non-consing.lisp:113]
  (DEFN / ((VEC2-A VEC2) (VEC2-B VEC2)) VEC2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SETF (X VEC2-A) (/ (X VEC2-A) (X VEC2-B)))
   (SETF (Y VEC2-A) (/ (Y VEC2-A) (Y VEC2-B))) VEC2-A)

[rtg-math/vectors/vector2/non-consing.lisp:121]
  (DEFN NEGATE ((VECTOR-A VEC2)) VEC2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SET-COMPONENTS (- (X VECTOR-A)) (- (Y VECTOR-A)) VECTOR-A))

[rtg-math/vectors/vector2/non-consing.lisp:129]
  (DEFN ROTATE ((VEC VEC2) (ANGLE SINGLE-FLOAT)) VEC2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((SA (SIN ANGLE)) (CA (COS ANGLE)) (X (X VEC)) (Y (Y VEC)))
     (SETF (X VEC) (+ (* X CA) (* Y SA))
           (Y VEC) (+ (* X (- SA)) (* Y CA)))
     VEC))

[rtg-math/vectors/vector2/non-consing.lisp:141]
  (DEFN NORMALIZE ((VECTOR-A VEC2)) VEC2
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET* ((X (X VECTOR-A)) (Y (Y VECTOR-A)) (LEN-SQR (+ (* X X) (* Y Y))))
     (IF (= 0.0 LEN-SQR)
         VECTOR-A
         (*S VECTOR-A (INV-SQRT LEN-SQR)))))

[rtg-math/vectors/vector3/consing.lisp:5]
  (DEFN-INLINE MAKE ((X SINGLE-FLOAT) (Y SINGLE-FLOAT) (Z SINGLE-FLOAT)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((VEC
          (MAKE-ARRAY 3 :ELEMENT-TYPE
                      (ECLECTOR.READER:QUASIQUOTE SINGLE-FLOAT))))
     (SETF (AREF VEC 0) X
           (AREF VEC 1) Y
           (AREF VEC 2) Z)
     VEC))

[rtg-math/vectors/vector3/consing.lisp:15]
  (DEFN-INLINE COPY-VEC3 ((VEC3 VEC3)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((VEC
          (MAKE-ARRAY 3 :ELEMENT-TYPE
                      (ECLECTOR.READER:QUASIQUOTE SINGLE-FLOAT))))
     (SETF (AREF VEC 0) (AREF VEC3 0)
           (AREF VEC 1) (AREF VEC3 1)
           (AREF VEC 2) (AREF VEC3 2))
     VEC))

[rtg-math/vectors/vector3/consing.lisp:25]
  (DEFN |0P| ((VECTOR-A VEC3)) BOOLEAN
   "Checks if the length of the vector is zero. As this is a
   floating point number it checks to see if the length is
   below a threshold set in the base-maths package"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (= 0.0
      (+ (EXPT (AREF VECTOR-A 0) 2) (EXPT (AREF VECTOR-A 1) 2)
         (EXPT (AREF VECTOR-A 2) 2))))

[rtg-math/vectors/vector3/consing.lisp:36]
  (DEFN UNITP ((VECTOR-A VEC3)) BOOLEAN
   "Checks if the vector is of unit length. As this is a
   floating point number it checks to see if the length is
   within the range of 1 + or - and threshold set in base-maths"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (= 0.0
      (- 1.0
         (+ (EXPT (AREF VECTOR-A 0) 2) (EXPT (AREF VECTOR-A 1) 2)
            (EXPT (AREF VECTOR-A 2) 2)))))

[rtg-math/vectors/vector3/consing.lisp:46]
  (DEFN = ((VECTOR-A VEC3) (VECTOR-B VEC3)) BOOLEAN
   "Returns either t if the two vectors are equal.
   Otherwise it returns nil."
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (AND (= (AREF VECTOR-A 0) (AREF VECTOR-B 0))
        (= (AREF VECTOR-A 1) (AREF VECTOR-B 1))
        (= (AREF VECTOR-A 2) (AREF VECTOR-B 2))))

[rtg-math/vectors/vector3/consing.lisp:56]
  (DEFN +S ((VEC3 VEC3) (SCALAR SINGLE-FLOAT)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE (+ (X VEC3) SCALAR) (+ (Y VEC3) SCALAR) (+ (Z VEC3) SCALAR)))

[rtg-math/vectors/vector3/consing.lisp:64]
  (DEFN -S ((VEC3 VEC3) (SCALAR SINGLE-FLOAT)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE (- (X VEC3) SCALAR) (- (Y VEC3) SCALAR) (- (Z VEC3) SCALAR)))

[rtg-math/vectors/vector3/consing.lisp:72]
  (DEFN + (&REST (VEC3S VEC3)) VEC3
   "takes any number of vectors and add them all together
   returning a new vector"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (IF VEC3S
       (LET ((X 0.0) (Y 0.0) (Z 0.0))
         (DECLARE (SINGLE-FLOAT X Y Z))
         (LOOP :FOR VEC :IN VEC3S
               :DO (LET ((VEC VEC))
                     (DECLARE (VEC3 VEC))
                     (INCF X (X VEC))
                     (INCF Y (Y VEC))
                     (INCF Z (Z VEC))))
         (MAKE X Y Z))
       (MAKE 0.0 0.0 0.0)))

[rtg-math/vectors/vector3/consing.lisp:97]
  (DEFN %+ ((VECTOR-A VEC3) (VECTOR-B VEC3)) VEC3
   "Add two vectors and return a new vector containing the result"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE (+ (AREF VECTOR-A 0) (AREF VECTOR-B 0))
    (+ (AREF VECTOR-A 1) (AREF VECTOR-B 1))
    (+ (AREF VECTOR-A 2) (AREF VECTOR-B 2))))

[rtg-math/vectors/vector3/consing.lisp:106]
  (DEFN - ((VEC3 VEC3) &REST (VEC3S VEC3)) VEC3
   "takes any number of vectors and add them all together
   returning a new vector"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))) (ASSERT VEC3)
   (IF VEC3S
       (LET ((X (X VEC3)) (Y (Y VEC3)) (Z (Z VEC3)))
         (DECLARE (SINGLE-FLOAT X Y Z))
         (LOOP :FOR VEC :IN VEC3S
               :DO (LET ((VEC VEC))
                     (DECLARE (VEC3 VEC))
                     (DECF X (X VEC))
                     (DECF Y (Y VEC))
                     (DECF Z (Z VEC))))
         (MAKE X Y Z))
       VEC3))

[rtg-math/vectors/vector3/consing.lisp:130]
  (DEFN %- ((VECTOR-A VEC3) (VECTOR-B VEC3)) VEC3
   "Subtract two vectors and return a new vector containing
   the result"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE (- (AREF VECTOR-A 0) (AREF VECTOR-B 0))
    (- (AREF VECTOR-A 1) (AREF VECTOR-B 1))
    (- (AREF VECTOR-A 2) (AREF VECTOR-B 2))))

[rtg-math/vectors/vector3/consing.lisp:140]
  (DEFN *S ((VECTOR-A VEC3) (A SINGLE-FLOAT)) VEC3 "Multiply vector by scalar"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE (* (AREF VECTOR-A 0) A) (* (AREF VECTOR-A 1) A)
    (* (AREF VECTOR-A 2) A)))

[rtg-math/vectors/vector3/consing.lisp:149]
  (DEFN * (&REST (VEC3S VEC3)) VEC3
   "takes any number of vectors and multiply them all together
   returning a new vector"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (IF VEC3S
       (DESTRUCTURING-BIND
           (VEC3 . VEC3S)
           VEC3S
         (DECLARE (VEC3 VEC3))
         (LET ((X (X VEC3)) (Y (Y VEC3)) (Z (Z VEC3)))
           (DECLARE (SINGLE-FLOAT X Y Z))
           (LOOP :FOR VEC :IN VEC3S
                 :DO (LET ((VEC VEC))
                       (DECLARE (VEC3 VEC))
                       (SETF X (* X (X VEC)))
                       (SETF Y (* Y (Y VEC)))
                       (SETF Z (* Z (Z VEC)))))
           (MAKE X Y Z)))
       (MAKE 1.0 1.0 1.0)))

[rtg-math/vectors/vector3/consing.lisp:176]
  (DEFN *V ((VECTOR-A VEC3) (VECTOR-B VEC3)) VEC3 "Multiplies components"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE (* (AREF VECTOR-A 0) (AREF VECTOR-B 0))
    (* (AREF VECTOR-A 1) (AREF VECTOR-B 1))
    (* (AREF VECTOR-A 2) (AREF VECTOR-B 2))))

[rtg-math/vectors/vector3/consing.lisp:185]
  (DEFN /S ((VECTOR-A VEC3) (A SINGLE-FLOAT)) VEC3
   "divide vector by scalar and return result as new vector"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((B (/ 1 A)))
     (MAKE (* (AREF VECTOR-A 0) B) (* (AREF VECTOR-A 1) B)
      (* (AREF VECTOR-A 2) B))))

[rtg-math/vectors/vector3/consing.lisp:195]
  (DEFN / ((VECTOR-A VEC3) (VECTOR-B VEC3)) VEC3 "Divides components"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE (/ (AREF VECTOR-A 0) (AREF VECTOR-B 0))
    (/ (AREF VECTOR-A 1) (AREF VECTOR-B 1))
    (/ (AREF VECTOR-A 2) (AREF VECTOR-B 2))))

[rtg-math/vectors/vector3/consing.lisp:204]
  (DEFN NEGATE ((VECTOR-A VEC3)) VEC3
   "Return a vector that is the negative of the vector passed in"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE (- (AREF VECTOR-A 0)) (- (AREF VECTOR-A 1)) (- (AREF VECTOR-A 2))))

[rtg-math/vectors/vector3/consing.lisp:213]
  (DEFN DOT ((VECTOR-A VEC3) (VECTOR-B VEC3)) SINGLE-FLOAT
   "Return the dot product of the vector-a and vector-b."
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (+ (* (AREF VECTOR-A 0) (AREF VECTOR-B 0))
      (* (AREF VECTOR-A 1) (AREF VECTOR-B 1))
      (* (AREF VECTOR-A 2) (AREF VECTOR-B 2))))

[rtg-math/vectors/vector3/consing.lisp:222]
  (DEFN FACE-FOREWARD ((VECTOR-A VEC3) (VECTOR-B VEC3)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (IF (> (DOT VECTOR-A VECTOR-B) 0)
       VECTOR-A
       (NEGATE VECTOR-A)))

[rtg-math/vectors/vector3/consing.lisp:230]
  (DEFN LENGTH-SQUARED ((VECTOR-A VEC3)) (SINGLE-FLOAT 0.0 NIL)
   "Return the squared length of the vector. A regular length
   is the square root of this value. The sqrt function is slow
   so if all thats needs doing is to compare lengths then always
   use the length squared function"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((X (X VECTOR-A)) (Y (Y VECTOR-A)) (Z (Z VECTOR-A)))
     (+ (* X X) (* Y Y) (* Z Z))))

[rtg-math/vectors/vector3/consing.lisp:244]
  (DEFN LENGTH ((VECTOR-A VEC3)) (SINGLE-FLOAT 0.0 NIL)
   "Returns the length of a vector
   If you only need to compare relative lengths then definately
   stick to length-squared as the sqrt is a slow operation."
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SQRT (LENGTH-SQUARED VECTOR-A)))

[rtg-math/vectors/vector3/consing.lisp:253]
  (DEFN DISTANCE-SQUARED ((VECTOR-A VEC3) (VECTOR-B VEC3))
   (SINGLE-FLOAT 0.0 NIL)
   "finds the squared distance between 2 points defined by vectors
   vector-a & vector-b"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LENGTH-SQUARED (- VECTOR-B VECTOR-A)))

[rtg-math/vectors/vector3/consing.lisp:262]
  (DEFN DISTANCE ((VECTOR-A VEC3) (VECTOR-B VEC3)) (SINGLE-FLOAT 0.0 NIL)
   "Return the distance between 2 points defined by vectors
   vector-a & vector-b. If comparing distances, use
   c-distance-squared as it desnt require a sqrt and thus is
   faster."
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SQRT (DISTANCE-SQUARED VECTOR-A VECTOR-B)))

[rtg-math/vectors/vector3/consing.lisp:273]
  (DEFN ABS ((VECTOR-A VEC3)) VEC3
   "Return the vec3 containing the abs of the original vec3's components."
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE (ABS (X VECTOR-A)) (ABS (Y VECTOR-A)) (ABS (Z VECTOR-A))))

[rtg-math/vectors/vector3/consing.lisp:282]
  (DEFN ABSOLUTE-DOT ((VECTOR-A VEC3) (VECTOR-B VEC3)) SINGLE-FLOAT
   "Return the absolute dot product of the vector-a and vector-b."
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (+ (ABS (* (AREF VECTOR-A 0) (AREF VECTOR-B 0)))
      (ABS (* (AREF VECTOR-A 1) (AREF VECTOR-B 1)))
      (ABS (* (AREF VECTOR-A 2) (AREF VECTOR-B 2)))))

[rtg-math/vectors/vector3/consing.lisp:291]
  (DEFN NORMALIZE ((VECTOR-A VEC3)) VEC3
   "This normalizes the vector, it makes sure a zero length
   vector won't throw an error."
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((LEN (LENGTH-SQUARED VECTOR-A)))
     (IF (= 0.0 LEN)
         VECTOR-A
         (*S VECTOR-A (INV-SQRT LEN)))))

[rtg-math/vectors/vector3/consing.lisp:302]
  (DEFN CROSS ((VEC-A VEC3) (VEC-B VEC3)) VEC3
   "Calculates the cross-product of 2 vectors, i.e. the vector
   that lies perpendicular to them both. The resultign vector
   will not be normalized."
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE (- (* (Y VEC-A) (Z VEC-B)) (* (Z VEC-A) (Y VEC-B)))
    (- (* (Z VEC-A) (X VEC-B)) (* (X VEC-A) (Z VEC-B)))
    (- (* (X VEC-A) (Y VEC-B)) (* (Y VEC-A) (X VEC-B)))))

[rtg-math/vectors/vector3/consing.lisp:345]
  (DEFN LERP ((VECTOR-A VEC3) (VECTOR-B VEC3) (AMMOUNT SINGLE-FLOAT)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (%+ (*S VECTOR-A (- 1.0 AMMOUNT)) (*S VECTOR-B AMMOUNT)))

[rtg-math/vectors/vector3/consing.lisp:350]
  (DEFN STABLE-LERP ((VECTOR-A VEC3) (VECTOR-B VEC3) (AMMOUNT SINGLE-FLOAT))
   VEC3 (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LERP VECTOR-A VECTOR-B AMMOUNT))

[rtg-math/vectors/vector3/consing.lisp:356]
  (DEFN BEZIER ((A1 VEC3) (A2 VEC3) (B1 VEC3) (B2 VEC3) (AMMOUNT SINGLE-FLOAT))
   VEC3 (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LERP (LERP A1 A2 AMMOUNT) (LERP B1 B2 AMMOUNT) AMMOUNT))

[rtg-math/vectors/vector3/non-consing.lisp:5]
  (DEFN-INLINE SET-COMPONENTS
   ((X SINGLE-FLOAT) (Y SINGLE-FLOAT) (Z SINGLE-FLOAT) (VEC VEC3)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SETF (X VEC) X
         (Y VEC) Y
         (Z VEC) Z)
   VEC)

[rtg-math/vectors/vector3/non-consing.lisp:15]
  (DEFN-INLINE COPY-COMPONENTS ((VEC VEC3) (COPY-FROM VEC3)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SETF (X VEC) (X COPY-FROM)
         (Y VEC) (Y COPY-FROM)
         (Z VEC) (Z COPY-FROM))
   VEC)

[rtg-math/vectors/vector3/non-consing.lisp:24]
  (DEFN +S ((VEC3 VEC3) (SCALAR SINGLE-FLOAT)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))) (INCF (X VEC3) SCALAR)
   (INCF (Y VEC3) SCALAR) (INCF (Z VEC3) SCALAR) VEC3)

[rtg-math/vectors/vector3/non-consing.lisp:33]
  (DEFN -S ((VEC3 VEC3) (SCALAR SINGLE-FLOAT)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))) (DECF (X VEC3) SCALAR)
   (DECF (Y VEC3) SCALAR) (DECF (Z VEC3) SCALAR) VEC3)

[rtg-math/vectors/vector3/non-consing.lisp:49]
  (DEFN + ((ACCUM-VEC VEC3) &REST (VEC3S VEC3)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LOOP :FOR VEC :IN VEC3S
         :DO (%+ ACCUM-VEC VEC))
   ACCUM-VEC)

[rtg-math/vectors/vector3/non-consing.lisp:63]
  (DEFN %- ((ACCUM-VEC VEC3) (TO-ADD-VEC VEC3)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (DECF (AREF ACCUM-VEC 0) (AREF TO-ADD-VEC 0))
   (DECF (AREF ACCUM-VEC 1) (AREF TO-ADD-VEC 1))
   (DECF (AREF ACCUM-VEC 2) (AREF TO-ADD-VEC 2)) ACCUM-VEC)

[rtg-math/vectors/vector3/non-consing.lisp:83]
  (DEFN %* ((ACCUM-VEC VEC3) (TO-MULT-VEC VEC3)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SETF (AREF ACCUM-VEC 0) (* (AREF ACCUM-VEC 0) (AREF TO-MULT-VEC 0)))
   (SETF (AREF ACCUM-VEC 1) (* (AREF ACCUM-VEC 1) (AREF TO-MULT-VEC 1)))
   (SETF (AREF ACCUM-VEC 2) (* (AREF ACCUM-VEC 2) (AREF TO-MULT-VEC 2)))
   ACCUM-VEC)

[rtg-math/vectors/vector3/non-consing.lisp:90]
  (DEFN * ((ACCUM-VEC VEC3) &REST (VEC3S VEC3)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LOOP :FOR VEC :IN VEC3S
         :DO (%* ACCUM-VEC VEC))
   ACCUM-VEC)

[rtg-math/vectors/vector3/non-consing.lisp:104]
  (DEFN *S ((VEC3 VEC3) (A SINGLE-FLOAT)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SETF (X VEC3) (* (X VEC3) A)) (SETF (Y VEC3) (* (Y VEC3) A))
   (SETF (Z VEC3) (* (Z VEC3) A)) VEC3)

[rtg-math/vectors/vector3/non-consing.lisp:113]
  (DEFN /S ((VEC3 VEC3) (A SINGLE-FLOAT)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SETF (X VEC3) (/ (X VEC3) A)) (SETF (Y VEC3) (/ (Y VEC3) A))
   (SETF (Z VEC3) (/ (Z VEC3) A)) VEC3)

[rtg-math/vectors/vector3/non-consing.lisp:122]
  (DEFN / ((VEC3-A VEC3) (VEC3-B VEC3)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SETF (X VEC3-A) (/ (X VEC3-A) (X VEC3-B)))
   (SETF (Y VEC3-A) (/ (Y VEC3-A) (Y VEC3-B)))
   (SETF (Z VEC3-A) (/ (Z VEC3-A) (Z VEC3-B))) VEC3-A)

[rtg-math/vectors/vector3/non-consing.lisp:131]
  (DEFN NEGATE ((VECTOR-A VEC3)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SET-COMPONENTS (- (X VECTOR-A)) (- (Y VECTOR-A)) (- (Z VECTOR-A)) VECTOR-A))

[rtg-math/vectors/vector3/non-consing.lisp:165]
  (DEFN NORMALIZE ((VECTOR-A VEC3)) VEC3
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET* ((X (X VECTOR-A))
          (Y (Y VECTOR-A))
          (Z (Z VECTOR-A))
          (LEN-SQR (+ (* X X) (* Y Y) (* Z Z))))
     (IF (= 0.0 LEN-SQR)
         VECTOR-A
         (*S VECTOR-A (INV-SQRT LEN-SQR)))))

[rtg-math/vectors/vector4/consing.lisp:5]
  (DEFN-INLINE MAKE
   ((X SINGLE-FLOAT) (Y SINGLE-FLOAT) (Z SINGLE-FLOAT) (W SINGLE-FLOAT)) VEC4
   "This takes 4 floats and give back a vector4, this is just an
   array but it specifies the array type and populates it.
   For speed reasons it will not accept integers so make sure
   you hand it floats."
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((VEC
          (MAKE-ARRAY 4 :ELEMENT-TYPE
                      (ECLECTOR.READER:QUASIQUOTE SINGLE-FLOAT))))
     (SETF (AREF VEC 0) X
           (AREF VEC 1) Y
           (AREF VEC 2) Z
           (AREF VEC 3) W)
     VEC))

[rtg-math/vectors/vector4/consing.lisp:21]
  (DEFN-INLINE COPY-VEC4 ((VEC4 VEC4)) VEC4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((VEC
          (MAKE-ARRAY 4 :ELEMENT-TYPE
                      (ECLECTOR.READER:QUASIQUOTE SINGLE-FLOAT))))
     (SETF (AREF VEC 0) (AREF VEC4 0)
           (AREF VEC 1) (AREF VEC4 1)
           (AREF VEC 2) (AREF VEC4 2)
           (AREF VEC 3) (AREF VEC4 3))
     VEC))

[rtg-math/vectors/vector4/consing.lisp:33]
  (DEFN |0P| ((VECTOR-A VEC4)) BOOLEAN
   "Checks if the length of the vector is zero. As this is a
   floating point number it checks to see if the length is
   below a threshold set in the base-maths package"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (= 0.0
      (+ (EXPT (AREF VECTOR-A 0) 2) (EXPT (AREF VECTOR-A 1) 2)
         (EXPT (AREF VECTOR-A 2) 2) (EXPT (AREF VECTOR-A 3) 2))))

[rtg-math/vectors/vector4/consing.lisp:45]
  (DEFN UNITP ((VECTOR-A VEC4)) BOOLEAN
   "Checks if the vector is of unit length. As this is a
   floating point number it checks to see if the length is
   within the range of 1 + or - and threshold set in base-maths"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (= 0.0
      (- 1.0
         (+ (EXPT (AREF VECTOR-A 0) 2) (EXPT (AREF VECTOR-A 1) 2)
            (EXPT (AREF VECTOR-A 2) 2) (EXPT (AREF VECTOR-A 3) 2)))))

[rtg-math/vectors/vector4/consing.lisp:57]
  (DEFN = ((VECTOR-A VEC4) (VECTOR-B VEC4)) BOOLEAN
   "Returns either t if the two vectors are equal.
   Otherwise it returns nil."
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (AND (= (AREF VECTOR-A 0) (AREF VECTOR-B 0))
        (= (AREF VECTOR-A 1) (AREF VECTOR-B 1))
        (= (AREF VECTOR-A 2) (AREF VECTOR-B 2))
        (= (AREF VECTOR-A 3) (AREF VECTOR-B 3))))

[rtg-math/vectors/vector4/consing.lisp:84]
  (DEFN + (&REST (VEC4S VEC4)) VEC4
   "takes any number of vectors and add them all together
   returning a new vector"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (IF VEC4S
       (LET ((X 0.0) (Y 0.0) (Z 0.0) (W 0.0))
         (DECLARE (SINGLE-FLOAT X Y Z W))
         (LOOP :FOR VEC :IN VEC4S
               :DO (LET ((VEC VEC))
                     (DECLARE (VEC4 VEC))
                     (INCF X (X VEC))
                     (INCF Y (Y VEC))
                     (INCF Z (Z VEC))
                     (INCF W (W VEC))))
         (MAKE X Y Z W))
       (MAKE 0.0 0.0 0.0 0.0)))

[rtg-math/vectors/vector4/consing.lisp:111]
  (DEFN %+ ((VECTOR-A VEC4) (VECTOR-B VEC4)) VEC4
   "Add two vectors and return a new vector containing the result"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE (+ (AREF VECTOR-A 0) (AREF VECTOR-B 0))
    (+ (AREF VECTOR-A 1) (AREF VECTOR-B 1))
    (+ (AREF VECTOR-A 2) (AREF VECTOR-B 2))
    (+ (AREF VECTOR-A 3) (AREF VECTOR-B 3))))

[rtg-math/vectors/vector4/consing.lisp:121]
  (DEFN - ((VEC4 VEC4) &REST (VEC4S VEC4)) VEC4
   "takes any number of vectors and add them all together
   returning a new vector"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))) (ASSERT VEC4)
   (IF VEC4S
       (LET ((X (X VEC4)) (Y (Y VEC4)) (Z (Z VEC4)) (W (W VEC4)))
         (DECLARE (SINGLE-FLOAT X Y Z W))
         (LOOP :FOR VEC :IN VEC4S
               :DO (LET ((VEC VEC))
                     (DECLARE (VEC4 VEC))
                     (DECF X (X VEC))
                     (DECF Y (Y VEC))
                     (DECF Z (Z VEC))
                     (DECF W (W VEC))))
         (MAKE X Y Z W))
       VEC4))

[rtg-math/vectors/vector4/consing.lisp:147]
  (DEFN %- ((VECTOR-A VEC4) (VECTOR-B VEC4)) VEC4
   "Subtract two vectors and return a new vector containing
   the result"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE (- (AREF VECTOR-A 0) (AREF VECTOR-B 0))
    (- (AREF VECTOR-A 1) (AREF VECTOR-B 1))
    (- (AREF VECTOR-A 2) (AREF VECTOR-B 2))
    (- (AREF VECTOR-A 3) (AREF VECTOR-B 3))))

[rtg-math/vectors/vector4/consing.lisp:158]
  (DEFN *S ((VECTOR-A VEC4) (A SINGLE-FLOAT)) VEC4 "Multiply vector by scalar"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE (* (AREF VECTOR-A 0) A) (* (AREF VECTOR-A 1) A)
    (* (AREF VECTOR-A 2) A) (* (AREF VECTOR-A 3) A)))

[rtg-math/vectors/vector4/consing.lisp:168]
  (DEFN * (&REST (VEC4S VEC4)) VEC4
   "takes any number of vectors and multiply them all together
   returning a new vector"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (IF VEC4S
       (DESTRUCTURING-BIND
           (VEC4 . VEC4S)
           VEC4S
         (DECLARE (VEC4 VEC4))
         (LET ((X (X VEC4)) (Y (Y VEC4)) (Z (Z VEC4)) (W (W VEC4)))
           (DECLARE (SINGLE-FLOAT X Y Z W))
           (LOOP :FOR VEC :IN VEC4S
                 :DO (LET ((VEC VEC))
                       (DECLARE (VEC4 VEC))
                       (SETF X (* X (X VEC)))
                       (SETF Y (* Y (Y VEC)))
                       (SETF Z (* Z (Z VEC)))
                       (SETF W (* W (W VEC)))))
           (MAKE X Y Z W)))
       (MAKE 1.0 1.0 1.0 1.0)))

[rtg-math/vectors/vector4/consing.lisp:197]
  (DEFN *V ((VECTOR-A VEC4) (VECTOR-B VEC4)) VEC4
   "Multiplies components, is not dot product, not sure what
   i'll need this for yet but hey!"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE (* (AREF VECTOR-A 0) (AREF VECTOR-B 0))
    (* (AREF VECTOR-A 1) (AREF VECTOR-B 1))
    (* (AREF VECTOR-A 2) (AREF VECTOR-B 2))
    (* (AREF VECTOR-A 3) (AREF VECTOR-B 3))))

[rtg-math/vectors/vector4/consing.lisp:208]
  (DEFN /S ((VECTOR-A VEC4) (A SINGLE-FLOAT)) VEC4
   "divide vector by scalar and return result as new vector"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((B (/ 1 A)))
     (MAKE (* (AREF VECTOR-A 0) B) (* (AREF VECTOR-A 1) B)
      (* (AREF VECTOR-A 2) B) (* (AREF VECTOR-A 3) B))))

[rtg-math/vectors/vector4/consing.lisp:219]
  (DEFN / ((VECTOR-A VEC4) (VECTOR-B VEC4)) VEC4
   "Divides components, not sure what, i'll need this for
   yet but hey!"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE (/ (AREF VECTOR-A 0) (AREF VECTOR-B 0))
    (/ (AREF VECTOR-A 1) (AREF VECTOR-B 1))
    (/ (AREF VECTOR-A 2) (AREF VECTOR-B 2))
    (/ (AREF VECTOR-A 3) (AREF VECTOR-B 3))))

[rtg-math/vectors/vector4/consing.lisp:230]
  (DEFN NEGATE ((VECTOR-A VEC4)) VEC4
   "Return a vector that is the negative of the vector passed in"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE (- (AREF VECTOR-A 0)) (- (AREF VECTOR-A 1)) (- (AREF VECTOR-A 2))
    (- (AREF VECTOR-A 3))))

[rtg-math/vectors/vector4/consing.lisp:240]
  (DEFN DOT ((VECTOR-A VEC4) (VECTOR-B VEC4)) SINGLE-FLOAT
   "return the dot product of the vector-a and vector-b."
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (+ (* (AREF VECTOR-A 0) (AREF VECTOR-B 0))
      (* (AREF VECTOR-A 1) (AREF VECTOR-B 1))
      (* (AREF VECTOR-A 2) (AREF VECTOR-B 2))
      (* (AREF VECTOR-A 3) (AREF VECTOR-B 3))))

[rtg-math/vectors/vector4/consing.lisp:250]
  (DEFN FACE-FOREWARD ((VECTOR-A VEC4) (VECTOR-B VEC4)) VEC4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (IF (> (PRINT (DOT VECTOR-A VECTOR-B)) 0)
       VECTOR-A
       (NEGATE VECTOR-A)))

[rtg-math/vectors/vector4/consing.lisp:258]
  (DEFN LENGTH-SQUARED ((VECTOR-A VEC4)) (SINGLE-FLOAT 0.0 NIL)
   "Return the squared length of the vector. A regular length
   is the square root of this value. The sqrt function is slow
   so if all thats needs doing is to compare lengths then always
   use the length squared function"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((X (X VECTOR-A)) (Y (Y VECTOR-A)) (Z (Z VECTOR-A)) (W (W VECTOR-A)))
     (+ (* X X) (* Y Y) (* Z Z) (* W W))))

[rtg-math/vectors/vector4/consing.lisp:273]
  (DEFN LENGTH ((VECTOR-A VEC4)) (SINGLE-FLOAT 0.0 NIL)
   "Returns the length of a vector
   If you only need to compare relative lengths then definately
   stick to length-squared as the sqrt is a slow operation."
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SQRT (LENGTH-SQUARED VECTOR-A)))

[rtg-math/vectors/vector4/consing.lisp:283]
  (DEFN DISTANCE-SQUARED ((VECTOR-A VEC4) (VECTOR-B VEC4))
   (SINGLE-FLOAT 0.0 NIL)
   "finds the squared distance between 2 points defined by vectors
   vector-a & vector-b"
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LENGTH-SQUARED (- VECTOR-B VECTOR-A)))

[rtg-math/vectors/vector4/consing.lisp:292]
  (DEFN DISTANCE ((VECTOR-A VEC4) (VECTOR-B VEC4)) (SINGLE-FLOAT 0.0 NIL)
   "Return the distance between 2 points defined by vectors
   vector-a & vector-b. If comparing distances, use
   c-distance-squared as it desnt require a sqrt and thus is
   faster."
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SQRT (DISTANCE-SQUARED VECTOR-A VECTOR-B)))

[rtg-math/vectors/vector4/consing.lisp:304]
  (DEFN ABS ((VECTOR-A VEC4)) VEC4
   "Return the vec4 containing the abs of the original vec4's components."
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (MAKE (ABS (X VECTOR-A)) (ABS (Y VECTOR-A)) (ABS (Y VECTOR-A))
    (ABS (Z VECTOR-A))))

[rtg-math/vectors/vector4/consing.lisp:312]
  (DEFN ABSOLUTE-DOT ((VECTOR-A VEC4) (VECTOR-B VEC4)) SINGLE-FLOAT
   "Return the absolute dot product of the vector-a and vector-b."
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (+ (ABS (* (AREF VECTOR-A 0) (AREF VECTOR-B 0)))
      (ABS (* (AREF VECTOR-A 1) (AREF VECTOR-B 1)))
      (ABS (* (AREF VECTOR-A 2) (AREF VECTOR-B 2)))
      (ABS (* (AREF VECTOR-A 3) (AREF VECTOR-B 3)))))

[rtg-math/vectors/vector4/consing.lisp:322]
  (DEFN NORMALIZE ((VECTOR-A VEC4)) VEC4
   "This normalizes the vector, it makes sure a zero length
   vector won't throw an error."
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET ((LEN (LENGTH-SQUARED VECTOR-A)))
     (IF (= 0.0 LEN)
         VECTOR-A
         (*S VECTOR-A (INV-SQRT LEN)))))

[rtg-math/vectors/vector4/consing.lisp:333]
  (DEFN LERP ((VECTOR-A VEC4) (VECTOR-B VEC4) (AMMOUNT SINGLE-FLOAT)) VEC4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (%+ (*S VECTOR-A (- 1.0 AMMOUNT)) (*S VECTOR-B AMMOUNT)))

[rtg-math/vectors/vector4/consing.lisp:339]
  (DEFN STABLE-LERP ((VECTOR-A VEC4) (VECTOR-B VEC4) (AMMOUNT SINGLE-FLOAT))
   VEC4 (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LERP VECTOR-A VECTOR-B AMMOUNT))

[rtg-math/vectors/vector4/consing.lisp:345]
  (DEFN BEZIER ((A1 VEC4) (A2 VEC4) (B1 VEC4) (B2 VEC4) (AMMOUNT SINGLE-FLOAT))
   VEC4 (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LERP (LERP A1 A2 AMMOUNT) (LERP B1 B2 AMMOUNT) AMMOUNT))

[rtg-math/vectors/vector4/non-consing.lisp:5]
  (DEFN-INLINE SET-COMPONENTS
   ((X SINGLE-FLOAT) (Y SINGLE-FLOAT) (Z SINGLE-FLOAT) (W SINGLE-FLOAT)
    (VEC VEC4))
   VEC4 (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SETF (X VEC) X
         (Y VEC) Y
         (Z VEC) Z
         (W VEC) W)
   VEC)

[rtg-math/vectors/vector4/non-consing.lisp:17]
  (DEFN-INLINE COPY-COMPONENTS ((VEC VEC4) (COPY-FROM VEC4)) VEC4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SETF (X VEC) (X COPY-FROM)
         (Y VEC) (Y COPY-FROM)
         (Z VEC) (Z COPY-FROM)
         (W VEC) (W COPY-FROM))
   VEC)

[rtg-math/vectors/vector4/non-consing.lisp:27]
  (DEFN +S ((VEC4 VEC4) (SCALAR SINGLE-FLOAT)) VEC4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))) (INCF (X VEC4) SCALAR)
   (INCF (Y VEC4) SCALAR) (INCF (Z VEC4) SCALAR) (INCF (W VEC4) SCALAR) VEC4)

[rtg-math/vectors/vector4/non-consing.lisp:37]
  (DEFN -S ((VEC4 VEC4) (SCALAR SINGLE-FLOAT)) VEC4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1))) (DECF (X VEC4) SCALAR)
   (DECF (Y VEC4) SCALAR) (DECF (Z VEC4) SCALAR) (DECF (W VEC4) SCALAR) VEC4)

[rtg-math/vectors/vector4/non-consing.lisp:47]
  (DEFN %+ ((ACCUM-VEC VEC4) (TO-ADD-VEC VEC4)) VEC4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (INCF (AREF ACCUM-VEC 0) (AREF TO-ADD-VEC 0))
   (INCF (AREF ACCUM-VEC 1) (AREF TO-ADD-VEC 1))
   (INCF (AREF ACCUM-VEC 2) (AREF TO-ADD-VEC 2))
   (INCF (AREF ACCUM-VEC 3) (AREF TO-ADD-VEC 3)) ACCUM-VEC)

[rtg-math/vectors/vector4/non-consing.lisp:55]
  (DEFN + ((ACCUM-VEC VEC4) &REST (VEC4S VEC4)) VEC4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LOOP :FOR VEC :IN VEC4S
         :DO (%+ ACCUM-VEC VEC))
   ACCUM-VEC)

[rtg-math/vectors/vector4/non-consing.lisp:69]
  (DEFN %- ((ACCUM-VEC VEC4) (TO-ADD-VEC VEC4)) VEC4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (DECF (AREF ACCUM-VEC 0) (AREF TO-ADD-VEC 0))
   (DECF (AREF ACCUM-VEC 1) (AREF TO-ADD-VEC 1))
   (DECF (AREF ACCUM-VEC 2) (AREF TO-ADD-VEC 2))
   (DECF (AREF ACCUM-VEC 3) (AREF TO-ADD-VEC 3)) ACCUM-VEC)

[rtg-math/vectors/vector4/non-consing.lisp:77]
  (DEFN - ((ACCUM-VEC VEC4) &REST (VEC4S VEC4)) VEC4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LOOP :FOR VEC :IN VEC4S
         :DO (%- ACCUM-VEC VEC))
   ACCUM-VEC)

[rtg-math/vectors/vector4/non-consing.lisp:91]
  (DEFN %* ((ACCUM-VEC VEC4) (TO-MULT-VEC VEC4)) VEC4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SETF (AREF ACCUM-VEC 0) (* (AREF ACCUM-VEC 0) (AREF TO-MULT-VEC 0)))
   (SETF (AREF ACCUM-VEC 1) (* (AREF ACCUM-VEC 1) (AREF TO-MULT-VEC 1)))
   (SETF (AREF ACCUM-VEC 2) (* (AREF ACCUM-VEC 2) (AREF TO-MULT-VEC 2)))
   (SETF (AREF ACCUM-VEC 3) (* (AREF ACCUM-VEC 3) (AREF TO-MULT-VEC 3)))
   ACCUM-VEC)

[rtg-math/vectors/vector4/non-consing.lisp:99]
  (DEFN * ((ACCUM-VEC VEC4) &REST (VEC4S VEC4)) VEC4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LOOP :FOR VEC :IN VEC4S
         :DO (%* ACCUM-VEC VEC))
   ACCUM-VEC)

[rtg-math/vectors/vector4/non-consing.lisp:113]
  (DEFN *S ((VEC4 VEC4) (A SINGLE-FLOAT)) VEC4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SETF (X VEC4) (* (X VEC4) A)) (SETF (Y VEC4) (* (Y VEC4) A))
   (SETF (Z VEC4) (* (Z VEC4) A)) (SETF (W VEC4) (* (W VEC4) A)) VEC4)

[rtg-math/vectors/vector4/non-consing.lisp:123]
  (DEFN /S ((VEC4 VEC4) (A SINGLE-FLOAT)) VEC4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SETF (X VEC4) (/ (X VEC4) A)) (SETF (Y VEC4) (/ (Y VEC4) A))
   (SETF (Z VEC4) (/ (Z VEC4) A)) (SETF (W VEC4) (/ (W VEC4) A)) VEC4)

[rtg-math/vectors/vector4/non-consing.lisp:133]
  (DEFN / ((VEC4-A VEC4) (VEC4-B VEC4)) VEC4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SETF (X VEC4-A) (/ (X VEC4-A) (X VEC4-B)))
   (SETF (Y VEC4-A) (/ (Y VEC4-A) (Y VEC4-B)))
   (SETF (Z VEC4-A) (/ (Z VEC4-A) (Z VEC4-B)))
   (SETF (W VEC4-A) (/ (W VEC4-A) (W VEC4-B))) VEC4-A)

[rtg-math/vectors/vector4/non-consing.lisp:143]
  (DEFN NEGATE ((VECTOR-A VEC4)) VEC4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (SET-COMPONENTS (- (X VECTOR-A)) (- (Y VECTOR-A)) (- (Z VECTOR-A))
    (- (W VECTOR-A)) VECTOR-A))

[rtg-math/vectors/vector4/non-consing.lisp:153]
  (DEFN NORMALIZE ((VECTOR-A VEC4)) VEC4
   (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
   (LET* ((X (X VECTOR-A))
          (Y (Y VECTOR-A))
          (Z (Z VECTOR-A))
          (W (W VECTOR-A))
          (LEN-SQR (+ (* X X) (* Y Y) (* Z Z) (* W W))))
     (IF (= 0.0 LEN-SQR)
         VECTOR-A
         (*S VECTOR-A (INV-SQRT LEN-SQR)))))

[rutils/core/iter.lisp:2996]
  (DEFUN RETURN-COLLECTION-CODE
         (
          &KEY VARIABLE EXPRESSION START-OPERATION END-OPERATION ONE-ELEMENT
          TEST (PLACE 'END) (RESULT-TYPE 'LIST))
    ""
    (WHEN (QUOTED? PLACE) (SETQ PLACE (SECOND PLACE)))
    (LET ((PLACE-STRING
           (LOCALLY (DECLARE (OPTIMIZE SAFETY)) (SYMBOL-NAME PLACE))))
      (COND ((STRING= PLACE-STRING '#:END) (SETQ PLACE 'END))
            ((OR (STRING= PLACE-STRING '#:START)
                 (STRING= PLACE-STRING '#:BEGINNING))
             (SETQ PLACE 'START))
            (T
             (CLAUSE-ERROR "~A is neither 'start', 'beginning' nor 'end'"
              PLACE))))
    (LET* ((COLLECT-VAR-SPEC (OR VARIABLE *RESULT-VAR*))
           (COLLECT-VAR (EXTRACT-VAR COLLECT-VAR-SPEC))
           (ENTRY
            (MAKE-ACCUM-VAR-BINDING COLLECT-VAR-SPEC NIL :COLLECT :TYPE
             (IF (EQ RESULT-TYPE 'LIST)
                 'LIST
                 (ECLECTOR.READER:QUASIQUOTE
                  (OR LIST (ECLECTOR.READER:UNQUOTE RESULT-TYPE))))))
           (END-POINTER (THIRD ENTRY))
           (PREV-RESULT-TYPE (FOURTH ENTRY)))
      (IF END-POINTER
          (UNLESS (EQUAL RESULT-TYPE PREV-RESULT-TYPE)
            (CLAUSE-ERROR "Result type ~A doesn't match ~A" RESULT-TYPE
             PREV-RESULT-TYPE))
          (PROGN
           (WHEN (EQ PLACE 'END)
             (SETQ END-POINTER
                     (MAKE-VAR-AND-BINDING 'END-POINTER NIL :TYPE 'LIST)))
           (SETF (CDDR ENTRY) (LIST END-POINTER RESULT-TYPE))))
      (LET* ((EXPR (WALK-EXPR EXPRESSION))
             (OP-EXPR
              (IF (EQ PLACE 'START)
                  (IF START-OPERATION
                      (MAKE-APPLICATION START-OPERATION EXPR COLLECT-VAR)
                      EXPR)
                  (IF END-OPERATION
                      (MAKE-APPLICATION END-OPERATION COLLECT-VAR EXPR)
                      EXPR))))
        (IF (EQ PLACE 'START)
            (RETURN-CODE :BODY
             (ECLECTOR.READER:QUASIQUOTE
              ((SETQ (ECLECTOR.READER:UNQUOTE COLLECT-VAR)
                       (ECLECTOR.READER:UNQUOTE OP-EXPR)))))
            (WITH-TEMPORARY TEMP-VAR
             (LET* ((UPDATE-CODE
                     (ECLECTOR.READER:QUASIQUOTE
                      (IF (ECLECTOR.READER:UNQUOTE COLLECT-VAR)
                          (SETF (CDR (ECLECTOR.READER:UNQUOTE END-POINTER))
                                  (ECLECTOR.READER:UNQUOTE TEMP-VAR))
                          (SETQ (ECLECTOR.READER:UNQUOTE COLLECT-VAR)
                                  (ECLECTOR.READER:UNQUOTE TEMP-VAR)))))
                    (MAIN-CODE
                     (COND
                      ((NOT ONE-ELEMENT)
                       (ECLECTOR.READER:QUASIQUOTE
                        ((WHEN
                             (SETQ (ECLECTOR.READER:UNQUOTE TEMP-VAR)
                                     (ECLECTOR.READER:UNQUOTE OP-EXPR))
                           (SETQ (ECLECTOR.READER:UNQUOTE END-POINTER)
                                   (LAST
                                    (ECLECTOR.READER:UNQUOTE UPDATE-CODE)))))))
                      (TEST
                       (ECLECTOR.READER:QUASIQUOTE
                        ((WHEN
                             (ECLECTOR.READER:UNQUOTE
                              (MAKE-APPLICATION TEST COLLECT-VAR EXPR))
                           (SETQ (ECLECTOR.READER:UNQUOTE TEMP-VAR)
                                   (ECLECTOR.READER:UNQUOTE OP-EXPR))
                           (SETQ (ECLECTOR.READER:UNQUOTE END-POINTER)
                                   (ECLECTOR.READER:UNQUOTE UPDATE-CODE))))))
                      (T
                       (ECLECTOR.READER:QUASIQUOTE
                        ((SETQ (ECLECTOR.READER:UNQUOTE TEMP-VAR)
                                 (ECLECTOR.READER:UNQUOTE OP-EXPR))
                         (SETQ (ECLECTOR.READER:UNQUOTE END-POINTER)
                                 (ECLECTOR.READER:UNQUOTE UPDATE-CODE))))))))
               (RETURN-CODE :BODY
                (ECLECTOR.READER:QUASIQUOTE
                 ((PROGN
                   (ECLECTOR.READER:UNQUOTE-SPLICING MAIN-CODE)
                   (ECLECTOR.READER:UNQUOTE COLLECT-VAR))))
                :FINAL
                (IF (EQ RESULT-TYPE 'LIST)
                    NIL
                    (ECLECTOR.READER:QUASIQUOTE
                     ((SETQ (ECLECTOR.READER:UNQUOTE COLLECT-VAR)
                              (COERCE (ECLECTOR.READER:UNQUOTE COLLECT-VAR)
                                      (ECLECTOR.READER:UNQUOTE
                                       RESULT-TYPE)))))))))))))

[salza2/adler32.lisp:33]
  (DEFUN ADLER32-UPDATE (ADLER-HIGH ADLER-LOW BUF START COUNT)
    (DECLARE (TYPE ARRAY-INDEX START COUNT)
             (TYPE (UNSIGNED-BYTE 16) ADLER-HIGH ADLER-LOW)
             (TYPE OCTET-VECTOR BUF)
             (OPTIMIZE SPEED (SAFETY 2)))
    (COND ((ZEROP COUNT) (VALUES ADLER-HIGH ADLER-LOW))
          (T
           (LET ((LENGTH COUNT) (I 0) (K 0) (S1 ADLER-LOW) (S2 ADLER-HIGH))
             (DECLARE (TYPE (INTEGER 0 16) K)
                      (TYPE ARRAY-INDEX I)
                      (TYPE (UNSIGNED-BYTE 16) LENGTH)
                      (TYPE (UNSIGNED-BYTE 32) S1 S2))
             (TAGBODY
              LOOP
               (SETF K (MIN LENGTH 16))
               (DECF LENGTH K)
              SUM
               (SETF S1 (+ (AREF BUF (LOGAND 65535 (+ START I))) S1))
               (SETF S2 (+ S1 S2))
               (DECF K)
               (INCF I)
               (UNLESS (ZEROP K) (GO SUM))
               (SETF S1 (MOD S1 +ADLER32-BASE+))
               (SETF S2 (MOD S2 +ADLER32-BASE+))
               (UNLESS (ZEROP LENGTH) (GO LOOP)))
             (VALUES S2 S1)))))

[salza2/chains.lisp:45]
  (DEFUN UPDATE-CHAINS (INPUT HASHES CHAINS START COUNT)
    (DECLARE (TYPE INPUT-BUFFER INPUT)
             (TYPE HASHES-BUFFER HASHES)
             (TYPE CHAINS-BUFFER CHAINS)
             (TYPE INPUT-INDEX START)
             (TYPE (INTEGER 0 32768) COUNT)
             (OPTIMIZE SPEED (SAFETY 2)))
    (WHEN (< COUNT 3) (RETURN-FROM UPDATE-CHAINS))
    (LET* ((HASH (HASH-VALUE INPUT START))
           (P0 START)
           (P1 (LOGAND (+ START 2) 65535)))
      (DECLARE (TYPE (INTEGER 0 3057705) HASH))
      (LOOP
       (LET ((HASH-INDEX (MOD8191 HASH)))
         (SETF (AREF CHAINS P0) (AREF HASHES HASH-INDEX))
         (SETF (AREF HASHES HASH-INDEX) P0)
         (SETF P1 (LOGAND (1+ P1) 65535))
         (DECF COUNT)
         (WHEN (= COUNT 2) (RETURN))
         (SETF HASH (- HASH (* (AREF INPUT P0) 11881)))
         (SETF HASH (* HASH 109))
         (SETF P0 (LOGAND (1+ P0) 65535))
         (SETF HASH (+ HASH (AREF INPUT P1)))))))

[sb-cga/vm.lisp:21]
  (DEFMACRO DEFINE-VM-FUN (NAME LAMBDA-LIST &BODY GENERIC-BODY)
    (MULTIPLE-VALUE-BIND (FORMS DECLARATIONS DOC)
        (ALEXANDRIA:PARSE-BODY GENERIC-BODY :DOCUMENTATION T)
      (DECLARE (IGNORABLE FORMS))
      (ECLECTOR.READER:QUASIQUOTE
       (PROGN
        (DEFUN (ECLECTOR.READER:UNQUOTE NAME)
               (ECLECTOR.READER:UNQUOTE LAMBDA-LIST)
          (ECLECTOR.READER:UNQUOTE-SPLICING (WHEN DOC (LIST DOC)))
          (ECLECTOR.READER:UNQUOTE-SPLICING DECLARATIONS)
          (DECLARE
           (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)
            (SB-C::RECOGNIZE-SELF-CALLS 0)))
          ((ECLECTOR.READER:UNQUOTE NAME)
           (ECLECTOR.READER:UNQUOTE-SPLICING LAMBDA-LIST)))))))

[sbcl-ir-visualizer/code/application.lisp:92]
  (#S(FORMGREP:SYMREF :NAME "DEFINE-APPLICATION-FRAME" :QUALIFIER "CLIM")
   IR-INSPECTOR NIL
   ((%FORM :ACCESSOR FORM)
    (%POLICY :ACCESSOR POLICY :INITFORM
     (LIST (LIST 'SPEED 1) (LIST 'SAFETY 1) (LIST 'DEBUG 1) (LIST 'SPACE 1)
           (LIST 'COMPILATION-SPEED 1)))
    (%OUTPUT :ACCESSOR OUTPUT :INITFORM NIL)
    (%DISASSEMBLY :ACCESSOR DISASSEMBLY :INITFORM NIL))
   (:PANES
    (FORM-EDITOR FORM-EDITOR :VALUE *EXAMPLE-LAMBDA-EXPRESSION*
     :VALUE-CHANGED-CALLBACK
     (LAMBDA (GADGET VALUE)
       (SETF (FORM
              (#S(FORMGREP:SYMREF :NAME "GADGET-CLIENT" :QUALIFIER "CLIM")
               GADGET))
               VALUE)))
    (SPEED
     (MAKE-OPTIMIZATION-QUALITY-PANE
      #S(FORMGREP:SYMREF :NAME "*APPLICATION-FRAME*" :QUALIFIER "CLIM") 'SPEED
      "Speed"))
    (SAFETY
     (MAKE-OPTIMIZATION-QUALITY-PANE
      #S(FORMGREP:SYMREF :NAME "*APPLICATION-FRAME*" :QUALIFIER "CLIM") 'SAFETY
      "Safety"))
    (DEBUG
     (MAKE-OPTIMIZATION-QUALITY-PANE
      #S(FORMGREP:SYMREF :NAME "*APPLICATION-FRAME*" :QUALIFIER "CLIM") 'DEBUG
      "Debug"))
    (SPACE
     (MAKE-OPTIMIZATION-QUALITY-PANE
      #S(FORMGREP:SYMREF :NAME "*APPLICATION-FRAME*" :QUALIFIER "CLIM") 'SPACE
      "Space"))
    (COMPILATION-SPEED
     (MAKE-OPTIMIZATION-QUALITY-PANE
      #S(FORMGREP:SYMREF :NAME "*APPLICATION-FRAME*" :QUALIFIER "CLIM")
      'COMPILATION-SPEED "Compilation Speed"))
    (SAFE
     (MAKE-OPTIMIZATION-BUTTON
      #S(FORMGREP:SYMREF :NAME "*APPLICATION-FRAME*" :QUALIFIER "CLIM") "Safe"
      '((SPEED 0) (SAFETY 3) (DEBUG 3) (SPACE 0) (COMPILATION-SPEED 0))
      :BACKGROUND #S(FORMGREP:SYMREF :NAME "+LIGHT-GREEN+" :QUALIFIER "CLIM")))
    (DEFAULT
     (MAKE-OPTIMIZATION-BUTTON
      #S(FORMGREP:SYMREF :NAME "*APPLICATION-FRAME*" :QUALIFIER "CLIM")
      "Default"
      '((SPEED 1) (SAFETY 1) (DEBUG 1) (SPACE 1) (COMPILATION-SPEED 1))))
    (FAST
     (MAKE-OPTIMIZATION-BUTTON
      #S(FORMGREP:SYMREF :NAME "*APPLICATION-FRAME*" :QUALIFIER "CLIM") "Fast"
      '((SPEED 3) (SAFETY 0) (DEBUG 0) (SPACE 0) (COMPILATION-SPEED 0))
      :BACKGROUND #S(FORMGREP:SYMREF :NAME "+SALMON+" :QUALIFIER "CLIM")))
    (IR #S(FORMGREP:SYMREF :NAME "INSPECTOR-PANE" :QUALIFIER "CLOUSEAU"))
    (OUTPUT OUTPUT-PANE :DISPLAY-FUNCTION 'DISPLAY-OUTPUT :END-OF-PAGE-ACTION
     :ALLOW)
    (DISASSEMBLY OUTPUT-PANE :DISPLAY-FUNCTION 'DISPLAY-DISASSEMBLY
     :END-OF-PAGE-ACTION :ALLOW))
   (:LAYOUTS
    (DEFAULT
     (#S(FORMGREP:SYMREF :NAME "SPACING" :QUALIFIER "CLIM") (:THICKNESS 4)
      (#S(FORMGREP:SYMREF :NAME "VERTICALLY" :QUALIFIER "CLIM") (:SPACING 8)
       (#S(FORMGREP:SYMREF :NAME "HORIZONTALLY" :QUALIFIER "CLIM") (:SPACING 8)
        (:FILL
         (#S(FORMGREP:SYMREF :NAME "LABELLING" :QUALIFIER "CLIM")
          (:LABEL "Lambda Expression") FORM-EDITOR))
        (#S(FORMGREP:SYMREF :NAME "VERTICALLY" :QUALIFIER "CLIM") (:SPACING 8)
         SPEED SAFETY DEBUG SPACE COMPILATION-SPEED
         (#S(FORMGREP:SYMREF :NAME "HORIZONTALLY" :QUALIFIER "CLIM")
          (:SPACING 8) SAFE DEFAULT FAST)
         :FILL))
       (:FILL
        (#S(FORMGREP:SYMREF
            :NAME "WITH-TAB-LAYOUT"
            :QUALIFIER "CLIM-TAB-LAYOUT")
         ('#S(FORMGREP:SYMREF :NAME "TAB-PAGE" :QUALIFIER "CLIM-TAB-LAYOUT"))
         ("Output"
          (#S(FORMGREP:SYMREF :NAME "SCROLLING" :QUALIFIER "CLIM") NIL OUTPUT))
         ("Intermediate Representation"
          (#S(FORMGREP:SYMREF :NAME "SCROLLING" :QUALIFIER "CLIM")
           (:SCROLL-BARS :BOTH) IR))
         ("Disassembly"
          (#S(FORMGREP:SYMREF :NAME "SCROLLING" :QUALIFIER "CLIM") NIL
           DISASSEMBLY))))))))
   (:MENU-BAR NIL) (:POINTER-DOCUMENTATION T)
   (:COMMAND-TABLE
    (IR-INSPECTOR-COMMAND-TABLE :INHERIT-FROM
     (#S(FORMGREP:SYMREF
         :NAME "INSPECTOR-COMMAND-TABLE"
         :QUALIFIER "CLOUSEAU"))))
   (:PRETTY-NAME
    (FORMAT NIL "IR Visualizer  ~A@~A" (LISP-IMPLEMENTATION-TYPE)
            (LISP-IMPLEMENTATION-VERSION))))

[sbcl-ir-visualizer/code/application.lisp:175]
  (DEFMETHOD (SETF POLICY) :AFTER ((NEW-VALUE T) (FRAME IR-INSPECTOR))
    (LABELS ((UPDATE-SLIDER (QUALITY)
               (LET ((SLIDER
                      (FIRST
                       (#S(FORMGREP:SYMREF
                           :NAME "SHEET-CHILDREN"
                           :QUALIFIER "CLIM")
                        (#S(FORMGREP:SYMREF
                            :NAME "FIND-PANE-NAMED"
                            :QUALIFIER "CLIM")
                         FRAME QUALITY)))))
                 (SETF (#S(FORMGREP:SYMREF
                           :NAME "GADGET-VALUE"
                           :QUALIFIER "CLIM")
                        SLIDER :VALUE-CHANGED-CALLBACK NIL)
                         (SECOND (FIND QUALITY NEW-VALUE :KEY #'FIRST))))))
      (MAP NIL #'UPDATE-SLIDER '(SPEED SAFETY DEBUG SPACE COMPILATION-SPEED)))
    (UPDATE FRAME (FORM FRAME) NEW-VALUE))

[sclf/sclf.lisp:1233]
  (DEFUN FORMAT-AMOUNT
         (NUMBER
          &KEY (DECIMALS 2) (ROUNDER #'ROUND) (COMMA *THOUSANDS-COMMA*)
          (COMMA-STANCE 3) (DECIMAL-POINT *DECIMAL-POINT*))
    "Return a string formatted as fixed decimal point number of DECIMALS
adding commas every COMMA-STANCE places before the decimal point."
    (DECLARE (TYPE NUMBER NUMBER)
             (TYPE FIXNUM DECIMALS COMMA-STANCE)
             (TYPE FUNCTION ROUNDER)
             (TYPE CHARACTER COMMA DECIMAL-POINT)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (LET* ((INT (FUNCALL ROUNDER (* NUMBER (EXPT 10 DECIMALS))))
           (NEGATIVE (< INT 0)))
      (DECLARE (INTEGER INT))
      (WHEN NEGATIVE (SETF INT (- INT)))
      (LET* ((DIGITS
              (MAX (1+ DECIMALS)
                   (1+
                    (IF (ZEROP INT)
                        0
                        (TRUNCATE (LOG INT 10))))))
             (STRING-LENGTH
              (+ DIGITS
                 (IF NEGATIVE
                     1
                     0)
                 (IF (ZEROP DECIMALS)
                     0
                     1)
                 (1- (CEILING (- DIGITS DECIMALS) COMMA-STANCE))))
             (STRING (MAKE-STRING STRING-LENGTH))
             (POS (1- STRING-LENGTH)))
        (DECLARE (TYPE FIXNUM POS DIGITS))
        (LABELS ((ADD-CHAR (CHAR)
                   (SETF (SCHAR STRING POS) CHAR)
                   (DECF POS))
                 (ADD-DIGIT ()
                   (ADD-CHAR (DIGIT-CHAR (MOD INT 10)))
                   (SETF INT (TRUNCATE INT 10))))
          (UNLESS (ZEROP DECIMALS)
            (LOOP FOR I FIXNUM FROM 0 BELOW DECIMALS
                  DO (ADD-DIGIT))
            (ADD-CHAR DECIMAL-POINT))
          (LOOP FOR I FIXNUM FROM 1
                DO (ADD-DIGIT)
                WHILE (>= POS
                          (IF NEGATIVE
                              1
                              0))
                WHEN (ZEROP (MOD I COMMA-STANCE))
                DO (ADD-CHAR COMMA))
          (WHEN NEGATIVE (ADD-CHAR #\-)))
        STRING)))

[screamer-plus/attic/screamer+.lisp:195]
  (EVAL-WHEN (COMPILE)
    (DECLAIM (OPTIMIZE (SPEED 3) (SAFETY 1) (SPACE 0) (DEBUG 0))))

[screamer-plus/screamer-plus.lisp:140]
  (EVAL-WHEN (:LOAD-TOPLEVEL :EXECUTE :COMPILE-TOPLEVEL)
    (DECLAIM (OPTIMIZE (SPEED 1) (SAFETY 3) (SPACE 0) (DEBUG 3))))

[scribble/stream-line-column.lisp:50]
  (DEFUN READ-STREAM-TO-POS (STREAM ENDPOS)
    (DECLARE (OPTIMIZE (SPEED 1) (SAFETY 3) (DEBUG 3)))
    (LOOP :WITH STARTPOS = (FILE-POSITION STREAM)
          :WITH MAXCHAR = (- ENDPOS STARTPOS)
          :WITH BUFFER = (MAKE-STRING MAXCHAR :INITIAL-ELEMENT #\_)
          :WITH INDEX = 0
          :UNTIL (ZEROP MAXCHAR)
          :DO (LET* ((X (CEILING MAXCHAR 2))
                     (I
                      (READ-SEQUENCE BUFFER STREAM :START INDEX :END
                                     (+ INDEX X))))
                (IF (= I INDEX)
                    (SETF MAXCHAR 0)
                    (LET ((P (FILE-POSITION STREAM)))
                      (IF (<= P ENDPOS)
                          (SETF INDEX I
                                STARTPOS P
                                MAXCHAR
                                  (MIN (- MAXCHAR X) (- ENDPOS STARTPOS)))
                          (PROGN
                           (FILE-POSITION STREAM STARTPOS)
                           (SETF MAXCHAR (1- X)))))))
          :FINALLY (RETURN (SUBSEQ BUFFER 0 INDEX))))

[sequence-iterators/extensible-sequences/tests/infrastructure.lisp:46]
  (DEFUN PRINTABLE-P (OBJ)
    "Returns T if obj can be printed to a string."
    (WITH-STANDARD-IO-SYNTAX
     (LET ((*PRINT-READABLY* NIL) (*PRINT-ESCAPE* NIL))
       (DECLARE (OPTIMIZE SAFETY))
       (HANDLER-CASE (AND (STRINGP (WRITE-TO-STRING OBJ)) T)
                     (CONDITION (C) (DECLARE (IGNORE C)) NIL)))))

[sequence-iterators/extensible-sequences/tests/infrastructure.lisp:55]
  (DEFMACRO SIGNALS-TYPE-ERROR
            (VAR DATUM-FORM FORM &KEY (SAFETY 3) (INLINE NIL))
    (LET ((LAMBDA-FORM
           (ECLECTOR.READER:QUASIQUOTE
            (LAMBDA ((ECLECTOR.READER:UNQUOTE VAR))
              (DECLARE (OPTIMIZE (SAFETY (ECLECTOR.READER:UNQUOTE SAFETY))))
              (ECLECTOR.READER:UNQUOTE FORM)))))
      (ECLECTOR.READER:QUASIQUOTE
       (LET (((ECLECTOR.READER:UNQUOTE VAR)
              (ECLECTOR.READER:UNQUOTE DATUM-FORM)))
         (DECLARE (OPTIMIZE SAFETY))
         (HANDLER-BIND ((WARNING 'MUFFLE-WARNING))
           (HANDLER-CASE
            (APPLY #'VALUES NIL
                   (MULTIPLE-VALUE-LIST
                    (FUNCALL
                     (ECLECTOR.READER:UNQUOTE
                      (COND
                       (INLINE
                        (ECLECTOR.READER:QUASIQUOTE
                         #'(ECLECTOR.READER:UNQUOTE LAMBDA-FORM)))
                       (*COMPILE-TESTS*
                        (ECLECTOR.READER:QUASIQUOTE
                         (COMPILE NIL '(ECLECTOR.READER:UNQUOTE LAMBDA-FORM))))
                       (T
                        (ECLECTOR.READER:QUASIQUOTE
                         (EVAL '(ECLECTOR.READER:UNQUOTE LAMBDA-FORM))))))
                     (ECLECTOR.READER:UNQUOTE VAR))))
            (TYPE-ERROR (C)
             (LET ((DATUM (TYPE-ERROR-DATUM C))
                   (EXPECTED-TYPE (TYPE-ERROR-EXPECTED-TYPE C)))
               (COND
                ((NOT (EQL (ECLECTOR.READER:UNQUOTE VAR) DATUM))
                 (LIST :DATUM-MISMATCH (ECLECTOR.READER:UNQUOTE VAR) DATUM))
                ((TYPEP DATUM EXPECTED-TYPE)
                 (LIST :IS-TYPEP DATUM EXPECTED-TYPE))
                (T (PRINTABLE-P C)))))))))))

[sequence-iterators/extensible-sequences/tests/infrastructure.lisp:94]
  (DEFMACRO CHECK-TYPE-ERROR (&BODY ARGS)
    (ECLECTOR.READER:QUASIQUOTE
     (LOCALLY
      (DECLARE (OPTIMIZE SAFETY))
      (CHECK-TYPE-ERROR* (ECLECTOR.READER:UNQUOTE-SPLICING ARGS)))))

[sequence-iterators/extensible-sequences/tests/infrastructure.lisp:97]
  (DEFMACRO SIGNALS-ERROR
            (FORM ERROR-NAME &KEY (SAFETY 3) (NAME NIL NAME-P) (INLINE NIL))
    (ECLECTOR.READER:QUASIQUOTE
     (HANDLER-BIND ((WARNING
                     #'(LAMBDA (C) (DECLARE (IGNORE C)) (MUFFLE-WARNING))))
       (PROCLAIM '(OPTIMIZE (SAFETY 3)))
       (HANDLER-CASE
        (APPLY #'VALUES NIL
               (MULTIPLE-VALUE-LIST
                (ECLECTOR.READER:UNQUOTE
                 (COND (INLINE FORM)
                       (*COMPILE-TESTS*
                        (ECLECTOR.READER:QUASIQUOTE
                         (FUNCALL
                          (COMPILE NIL
                                   '(LAMBDA ()
                                      (DECLARE
                                       (OPTIMIZE
                                        (SAFETY
                                         (ECLECTOR.READER:UNQUOTE SAFETY))))
                                      (ECLECTOR.READER:UNQUOTE FORM))))))
                       (T
                        (ECLECTOR.READER:QUASIQUOTE
                         (EVAL '(ECLECTOR.READER:UNQUOTE FORM))))))))
        ((ECLECTOR.READER:UNQUOTE ERROR-NAME) (C)
         (COND
          (ECLECTOR.READER:UNQUOTE-SPLICING
           (CASE ERROR-NAME
             (TYPE-ERROR
              (ECLECTOR.READER:QUASIQUOTE
               (((TYPEP (TYPE-ERROR-DATUM C) (TYPE-ERROR-EXPECTED-TYPE C))
                 (VALUES NIL
                         (LIST
                          (LIST 'TYPEP (LIST 'QUOTE (TYPE-ERROR-DATUM C))
                                (LIST 'QUOTE (TYPE-ERROR-EXPECTED-TYPE C)))
                          "==> true"))))))
             ((UNDEFINED-FUNCTION UNBOUND-VARIABLE)
              (AND NAME-P
                   (ECLECTOR.READER:QUASIQUOTE
                    (((NOT
                       (EQ (CELL-ERROR-NAME C)
                           '(ECLECTOR.READER:UNQUOTE NAME)))
                      (VALUES NIL
                              (LIST 'CELL-ERROR-NAME "==>"
                                    (CELL-ERROR-NAME C))))))))
             ((STREAM-ERROR END-OF-FILE READER-ERROR)
              (ECLECTOR.READER:QUASIQUOTE
               (((NOT (STREAMP (STREAM-ERROR-STREAM C)))
                 (VALUES NIL
                         (LIST 'STREAM-ERROR-STREAM "==>"
                               (STREAM-ERROR-STREAM C)))))))
             (FILE-ERROR
              (ECLECTOR.READER:QUASIQUOTE
               (((NOT (PATHNAMEP (PATHNAME (FILE-ERROR-PATHNAME C))))
                 (VALUES NIL
                         (LIST 'FILE-ERROR-PATHNAME "==>"
                               (FILE-ERROR-PATHNAME C)))))))
             (T NIL)))
          (T (PRINTABLE-P C))))))))

[sequence-iterators/extensible-sequences/tests/rt.lisp:45]
  (DEFVAR *OPTIMIZATION-SETTINGS* '((SAFETY 3)))

[sequence-iterators/extensible-sequences/tests/universe.lisp:42]
  (DEFPARAMETER *CONDITION-OBJECTS*
    (LOCALLY
     (DECLARE (OPTIMIZE SAFETY))
     (LOOP FOR TP IN *CONDITION-TYPES*
           APPEND (HANDLER-CASE (LIST (MAKE-CONDITION TP)) (ERROR NIL NIL)))))

[sequence-iterators/extensible-sequences/tests/universe.lisp:51]
  (DEFPARAMETER *PACKAGE-OBJECTS*
    (LOCALLY
     (DECLARE (OPTIMIZE SAFETY))
     (LOOP FOR PNAME IN *STANDARD-PACKAGE-NAMES*
           APPEND (HANDLER-CASE
                   (LET ((PKG (FIND-PACKAGE PNAME)))
                     (AND PKG (LIST PKG)))
                   (ERROR NIL NIL)))))

[sequence-iterators/extensible-sequences/tests/universe.lisp:159]
  (DEFUN TRY-TO-READ-CHARS (&REST NAMELIST)
    (DECLARE (OPTIMIZE SAFETY))
    (LOOP FOR NAME IN NAMELIST
          APPEND (HANDLER-CASE
                  (LIST (READ-FROM-STRING (CONCATENATE 'STRING "#\\" NAME)))
                  (ERROR NIL NIL))))

[sequence-iterators/extensible-sequences/tests/universe.lisp:257]
  (DEFPARAMETER *ARRAYS*
    (APPEND (LIST (MAKE-ARRAY '10)) (MAPCAR #'MAKE-ARRAY *ARRAY-DIMENSIONS*)
            (LOOP FOR TP IN '(FIXNUM FLOAT BIT CHARACTER BASE-CHAR
                              (SIGNED-BYTE 8) (UNSIGNED-BYTE 8))
                  FOR ELEMENT IN '(18 16.0 0 #\x #\y 127 200)
                  APPEND (LOOP FOR D IN *ARRAY-DIMENSIONS*
                               COLLECT (MAKE-ARRAY D :ELEMENT-TYPE TP
                                                   :INITIAL-ELEMENT ELEMENT)))
            (LOOP FOR I FROM 1 TO 64
                  APPEND (LIST
                          (MAKE-ARRAY 10 :ELEMENT-TYPE
                                      (ECLECTOR.READER:QUASIQUOTE
                                       (UNSIGNED-BYTE
                                        (ECLECTOR.READER:UNQUOTE I)))
                                      :INITIAL-ELEMENT 1)
                          (MAKE-ARRAY 10 :ELEMENT-TYPE
                                      (ECLECTOR.READER:QUASIQUOTE
                                       (SIGNED-BYTE
                                        (ECLECTOR.READER:UNQUOTE I)))
                                      :INITIAL-ELEMENT 0)))
            (LOOP FOR D IN *ARRAY-DIMENSIONS*
                  COLLECT (MAKE-ARRAY D :ADJUSTABLE T))
            (LOOP FOR D IN *ARRAY-DIMENSIONS*
                  FOR I FROM 1
                  COLLECT (MAKE-ARRAY D :DISPLACED-TO *DEFAULT-ARRAY-TARGET*
                                      :DISPLACED-INDEX-OFFSET I))
            (LIST #() #* #*00000 #*1010101010101101
                  (MAKE-ARRAY 10 :ELEMENT-TYPE 'BIT :INITIAL-CONTENTS
                              '(0 1 1 0 1 1 1 1 0 1) :FILL-POINTER 8)
                  (MAKE-ARRAY 5 :ELEMENT-TYPE 'BIT :DISPLACED-TO #*0111000110
                              :DISPLACED-INDEX-OFFSET 3)
                  (MAKE-ARRAY 10 :ELEMENT-TYPE 'BIT :INITIAL-CONTENTS
                              '(1 1 0 0 1 1 1 0 1 1) :ADJUSTABLE T))
            (LIST
             (MAKE-ARRAY '(10) :ELEMENT-TYPE '(INTEGER 0 (256))
                         :INITIAL-CONTENTS '(8 9 10 11 12 1 2 3 4 5))
             (MAKE-ARRAY '(10) :ELEMENT-TYPE '(INTEGER -128 (128))
                         :INITIAL-CONTENTS '(8 9 -10 11 -12 1 -2 -3 4 5))
             (MAKE-ARRAY '(6) :ELEMENT-TYPE '(INTEGER 0 (NIL))
                         :INITIAL-CONTENTS '(5 9 100 1312 23432 87))
             (MAKE-ARRAY '(4) :ELEMENT-TYPE '(INTEGER 0 (NIL))
                         :INITIAL-CONTENTS '(100000 231213 8123712 19))
             (MAKE-ARRAY '(4) :ELEMENT-TYPE '(INTEGER 0 (NIL))
                         :INITIAL-CONTENTS '(NIL 0 872312 10000000))
             (MAKE-ARRAY NIL :ELEMENT-TYPE '(INTEGER 0 (256)) :INITIAL-ELEMENT
                         14)
             (MAKE-ARRAY '(2 2) :ELEMENT-TYPE '(INTEGER 0 (256))
                         :INITIAL-CONTENTS '((34 98) (14 119))))
            (LIST
             (MAKE-ARRAY '(5) :ELEMENT-TYPE 'SHORT-FLOAT :INITIAL-CONTENTS
                         '(1.0 2.0 3.0 4.0 5.0))
             (MAKE-ARRAY '(5) :ELEMENT-TYPE 'SINGLE-FLOAT :INITIAL-CONTENTS
                         '(1.0 2.0 3.0 4.0 5.0))
             (MAKE-ARRAY '(5) :ELEMENT-TYPE 'DOUBLE-FLOAT :INITIAL-CONTENTS
                         '(1.0d0 2.0d0 3.0d0 4.0d0 5.0d0))
             (MAKE-ARRAY '(5) :ELEMENT-TYPE 'LONG-FLOAT :INITIAL-CONTENTS
                         '(1.0d0 2.0d0 3.0d0 4.0d0 5.0d0)))
            (LOCALLY
             (DECLARE (OPTIMIZE SAFETY))
             (HANDLER-CASE (LIST (MAKE-ARRAY '(0) :ELEMENT-TYPE NIL))
                           (ERROR NIL NIL)))))

[sequence-iterators/extensible-sequences/tests/universe.lisp:357]
  (DEFPARAMETER *PATHNAMES*
    (LOCALLY
     (DECLARE (OPTIMIZE SAFETY))
     (LOOP FOR FORM IN '((MAKE-PATHNAME :NAME "foo")
                         (MAKE-PATHNAME :NAME "FOO" :CASE :COMMON)
                         (MAKE-PATHNAME :NAME "bar")
                         (MAKE-PATHNAME :NAME "foo" :TYPE "txt")
                         (MAKE-PATHNAME :NAME "bar" :TYPE "txt")
                         (MAKE-PATHNAME :NAME "XYZ" :TYPE "TXT" :CASE :COMMON)
                         (MAKE-PATHNAME :NAME NIL) (MAKE-PATHNAME :NAME :WILD)
                         (MAKE-PATHNAME :NAME NIL :TYPE "txt")
                         (MAKE-PATHNAME :NAME :WILD :TYPE "txt")
                         (MAKE-PATHNAME :NAME :WILD :TYPE "TXT" :CASE :COMMON)
                         (MAKE-PATHNAME :NAME :WILD :TYPE "abc" :CASE :COMMON)
                         (MAKE-PATHNAME :DIRECTORY :WILD)
                         (MAKE-PATHNAME :TYPE :WILD)
                         (MAKE-PATHNAME :VERSION :WILD)
                         (MAKE-PATHNAME :VERSION :NEWEST))
           APPEND (IGNORE-ERRORS
                   (EVAL
                    (ECLECTOR.READER:QUASIQUOTE
                     (LIST (ECLECTOR.READER:UNQUOTE FORM))))))))

[sequence-iterators/extensible-sequences/tests/universe.lisp:378]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (LOCALLY
     (DECLARE (OPTIMIZE SAFETY))
     (IGNORE-ERRORS
      (SETF (LOGICAL-PATHNAME-TRANSLATIONS "CLTESTROOT")
              (ECLECTOR.READER:QUASIQUOTE
               (("**;*.*.*"
                 (ECLECTOR.READER:UNQUOTE
                  (MAKE-PATHNAME :DIRECTORY '(:ABSOLUTE :WILD-INFERIORS) :NAME
                                 :WILD :TYPE :WILD)))))))
     (IGNORE-ERRORS
      (SETF (LOGICAL-PATHNAME-TRANSLATIONS "CLTEST")
              (ECLECTOR.READER:QUASIQUOTE
               (("**;*.*.*"
                 (ECLECTOR.READER:UNQUOTE
                  (MAKE-PATHNAME :DIRECTORY
                                 (APPEND
                                  (PATHNAME-DIRECTORY
                                   (TRUENAME (MAKE-PATHNAME)))
                                  '(:WILD-INFERIORS))
                                 :NAME :WILD :TYPE :WILD)))))))))

[sequence-iterators/extensible-sequences/tests/universe.lisp:395]
  (DEFPARAMETER *LOGICAL-PATHNAMES*
    (LOCALLY
     (DECLARE (OPTIMIZE SAFETY))
     (APPEND (IGNORE-ERRORS (LIST (LOGICAL-PATHNAME "CLTESTROOT:"))))))

[sequence-iterators/sequence-iterators.lisp:493]
  (DEFUN REVERSED-LIST-OF-PTRS (LIST START END)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (LET ((RESULT NIL) (START (OR START 0)) (ENDP (NULL END)))
      (DECLARE (SEQUENCE-INDEX START))
      (LOOP FOR SUBLIST ON (NTHCDR START LIST)
            WHILE (OR ENDP (< START (THE SEQUENCE-INDEX END)))
            DO (PUSH SUBLIST RESULT) (INCF START)
            FINALLY (RETURN (VALUES RESULT START)))))

[sequence-iterators/sequence-iterators.lisp:523]
  (DEFUN %MAKE-SEQUENCE-ITERATOR (SEQUENCE &KEY START END FROM-END)
    "Returns an iterator thunk that returns three values: a boolean flag
that is true, if an element is returned, the current sequence index,
and the current sequence element."
    (DECLARE (OPTIMIZE (DEBUG 2)))
    (MACROLET ((ITERATOR-THUNK (&KEY ENDP INDEX ELT STEP)
                 (ECLECTOR.READER:QUASIQUOTE
                  #'(LAMBDA ()
                      (IF (ECLECTOR.READER:UNQUOTE ENDP)
                          (VALUES NIL NIL NIL)
                          (MULTIPLE-VALUE-PROG1
                              (VALUES T (ECLECTOR.READER:UNQUOTE ELT)
                                      (ECLECTOR.READER:UNQUOTE INDEX))
                            (ECLECTOR.READER:UNQUOTE STEP))))))
               (READER-THUNK (&KEY ENDP ELT)
                 (ECLECTOR.READER:QUASIQUOTE
                  (LOCALLY
                   (DECLARE (MUFFLE-CONDITIONS CODE-DELETION-NOTE))
                   #'(LAMBDA ()
                       (IF (ECLECTOR.READER:UNQUOTE ENDP)
                           (ERROR "Iterator exhausted")
                           (ECLECTOR.READER:UNQUOTE ELT))))))
               (WRITER-THUNK (&KEY ENDP SET TYPE)
                 (ECLECTOR.READER:QUASIQUOTE
                  (LOCALLY
                   (DECLARE (MUFFLE-CONDITIONS CODE-DELETION-NOTE))
                   #'(LAMBDA (NEW-ELT)
                       (ECLECTOR.READER:UNQUOTE
                        (WHEN TYPE
                          (ECLECTOR.READER:QUASIQUOTE
                           (CHECK-TYPE NEW-ELT
                                       (ECLECTOR.READER:UNQUOTE TYPE)))))
                       (IF (ECLECTOR.READER:UNQUOTE ENDP)
                           (ERROR "Iterator exhausted.")
                           (SETF (ECLECTOR.READER:UNQUOTE SET) NEW-ELT))))))
               (MAKE-RANDOM-ACCESS-ITERATOR
                   (SEQUENCE START END FROM-END &KEY ACCESSOR ELEMENT-TYPE)
                 (LET ((ACCESSOR (SECOND ACCESSOR))
                       (ELEMENT-TYPE (SECOND ELEMENT-TYPE)))
                   (ECLECTOR.READER:QUASIQUOTE
                    (LET ((SEQ (ECLECTOR.READER:UNQUOTE SEQUENCE))
                          (START (OR (ECLECTOR.READER:UNQUOTE START) 0))
                          (END
                           (OR (ECLECTOR.READER:UNQUOTE END)
                               (LENGTH SEQUENCE))))
                      (DECLARE (TYPE ARRAY-INDEX START)
                               (TYPE ARRAY-LENGTH END))
                      (IF (ECLECTOR.READER:UNQUOTE FROM-END)
                          (VALUES
                           (ITERATOR-THUNK :ENDP (= END START) :INDEX (1- END)
                            :ELT
                            ((ECLECTOR.READER:UNQUOTE ACCESSOR) SEQ (1- END))
                            :STEP (DECF END))
                           (READER-THUNK :ENDP NIL :ELT
                            ((ECLECTOR.READER:UNQUOTE ACCESSOR) SEQ END))
                           (WRITER-THUNK :ENDP NIL :SET
                            ((ECLECTOR.READER:UNQUOTE ACCESSOR) SEQ END) :TYPE
                            (ECLECTOR.READER:UNQUOTE ELEMENT-TYPE)))
                          (LET ((INDEX START))
                            (DECLARE (TYPE ARRAY-LENGTH INDEX))
                            (VALUES
                             (ITERATOR-THUNK :ENDP (= INDEX END) :INDEX INDEX
                              :ELT
                              ((ECLECTOR.READER:UNQUOTE ACCESSOR) SEQ INDEX)
                              :STEP (INCF INDEX))
                             (READER-THUNK :ENDP (= INDEX END) :ELT
                              ((ECLECTOR.READER:UNQUOTE ACCESSOR) SEQ
                               (1- INDEX)))
                             (WRITER-THUNK :ENDP NIL :SET
                              ((ECLECTOR.READER:UNQUOTE ACCESSOR) SEQ
                               (1- INDEX))
                              :TYPE
                              (ECLECTOR.READER:UNQUOTE ELEMENT-TYPE)))))))))
               (MAKE-SEQUENTIAL-ITERATOR (SEQUENCE START END FROM-END)
                 (ECLECTOR.READER:QUASIQUOTE
                  (IF (ECLECTOR.READER:UNQUOTE FROM-END)
                      (MULTIPLE-VALUE-BIND (PTRS END)
                          (REVERSED-LIST-OF-PTRS
                           (ECLECTOR.READER:UNQUOTE SEQUENCE)
                           (ECLECTOR.READER:UNQUOTE START)
                           (ECLECTOR.READER:UNQUOTE END))
                        (DECLARE (SEQUENCE-LENGTH END))
                        (LET ((STORAGE-PTR))
                          (VALUES
                           (ITERATOR-THUNK :ENDP (NULL PTRS) :INDEX (1- END)
                            :ELT (CAR (FIRST PTRS)) :STEP
                            (PROGN
                             (SETQ STORAGE-PTR (FIRST PTRS))
                             (POP PTRS)
                             (DECF END)))
                           (READER-THUNK :ENDP (NULL STORAGE-PTR) :ELT
                            (CAR STORAGE-PTR))
                           (WRITER-THUNK :ENDP (NULL STORAGE-PTR) :SET
                            (CAR STORAGE-PTR)))))
                      (LET* ((INDEX (OR START 0))
                             (SUBLIST (NTHCDR INDEX SEQUENCE))
                             (STORAGE-PTR))
                        (DECLARE (TYPE SEQUENCE-LENGTH INDEX))
                        (VALUES
                         (IF (NULL END)
                             (ITERATOR-THUNK :ENDP (NULL SUBLIST) :INDEX INDEX
                              :ELT (FIRST SUBLIST) :STEP
                              (PROGN
                               (SETQ STORAGE-PTR SUBLIST)
                               (POP SUBLIST)
                               (INCF INDEX)))
                             (ITERATOR-THUNK :ENDP
                              (>= INDEX (THE SEQUENCE-LENGTH END)) :INDEX INDEX
                              :ELT (FIRST SUBLIST) :STEP
                              (PROGN
                               (SETQ STORAGE-PTR SUBLIST)
                               (POP SUBLIST)
                               (INCF INDEX))))
                         (READER-THUNK :ENDP (NULL STORAGE-PTR) :ELT
                          (CAR STORAGE-PTR))
                         (WRITER-THUNK :ENDP (NULL STORAGE-PTR) :SET
                          (CAR STORAGE-PTR))))))))
      (ETYPECASE SEQUENCE
        (LIST
         (LOCALLY
          (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
          (MAKE-SEQUENTIAL-ITERATOR SEQUENCE START END FROM-END)))
        (SIMPLE-VECTOR
         (LOCALLY
          (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
          (MAKE-RANDOM-ACCESS-ITERATOR SEQUENCE START END FROM-END :ACCESSOR
           'SVREF)))
        (SIMPLE-STRING
         (LOCALLY
          (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
          (MAKE-RANDOM-ACCESS-ITERATOR SEQUENCE START END FROM-END :ACCESSOR
           'SCHAR :ELEMENT-TYPE 'CHARACTER)))
        (STRING
         (LOCALLY
          (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1))
                   (MUFFLE-CONDITIONS COMPILER-NOTE))
          (MAKE-RANDOM-ACCESS-ITERATOR SEQUENCE START END FROM-END :ACCESSOR
           'CHAR :ELEMENT-TYPE 'CHARACTER)))
        (VECTOR
         (LOCALLY
          (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1))
                   (MUFFLE-CONDITIONS COMPILER-NOTE))
          (MAKE-RANDOM-ACCESS-ITERATOR SEQUENCE START END FROM-END :ACCESSOR
           'AREF)))
        (SEQUENCE
         (MAKE-RANDOM-ACCESS-ITERATOR SEQUENCE START END FROM-END :ACCESSOR
          'ELT)))))

[sequence-iterators/tests/rt.lisp:44]
  (DEFVAR *OPTIMIZATION-SETTINGS* '((SAFETY 3)))

[serapeum/arrays.lisp:4]
  (DEFUN ARRAY-INDEX-ROW-MAJOR (ARRAY ROW-MAJOR-INDEX)
    "The inverse of ARRAY-ROW-MAJOR-INDEX.

Given an array and a row-major index, return a list of subscripts.

     (apply #'aref (array-index-row-major i))
     ≡ (array-row-major-aref i)"
    (DECLARE (ARRAY-INDEX ROW-MAJOR-INDEX)
             (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (NLET REC
     ((SUBS (LIST ROW-MAJOR-INDEX))
      (DIMS (REVERSE (REST (ARRAY-DIMENSIONS ARRAY)))))
     (IF (NULL DIMS)
         SUBS
         (MULTIPLE-VALUE-BIND (Q R)
             (TRUNCATE (THE ARRAY-INDEX (CAR SUBS))
                       (THE (INTEGER 0 NIL) (CAR DIMS)))
           (REC (CONS Q (RPLACA SUBS R)) (CDR DIMS))))))

[serapeum/control-flow.lisp:865]
  (DEFMACRO SORT-VALUES (PRED &REST VALUES)
    "Sort VALUES with PRED and return as multiple values.

Equivalent to

    (values-list (sort (list VALUES...) pred))

But with less consing, and potentially faster."
    (WITH-GENSYMS (GPRED)
     (ECLECTOR.READER:QUASIQUOTE
      (LET (((ECLECTOR.READER:UNQUOTE GPRED)
             (ENSURE-FUNCTION (ECLECTOR.READER:UNQUOTE PRED))))
        (DECLARE (IGNORABLE (ECLECTOR.READER:UNQUOTE GPRED))
                 (FUNCTION (ECLECTOR.READER:UNQUOTE GPRED))
                 (OPTIMIZE (SAFETY 1) (DEBUG 0) (COMPILATION-SPEED 0)))
        (ECLECTOR.READER:UNQUOTE
         (MATCH VALUES ((LIST) (ECLECTOR.READER:QUASIQUOTE (VALUES)))
          ((LIST X)
           (ECLECTOR.READER:QUASIQUOTE (VALUES (ECLECTOR.READER:UNQUOTE X))))
          (OTHERWISE
           (IF (<= (LENGTH VALUES) 8)
               (ECLECTOR.READER:QUASIQUOTE
                (SORT-VALUES/NETWORK (ECLECTOR.READER:UNQUOTE GPRED)
                 (ECLECTOR.READER:UNQUOTE-SPLICING VALUES)))
               (ECLECTOR.READER:QUASIQUOTE
                (SORT-VALUES/TEMP-VECTOR (ECLECTOR.READER:UNQUOTE GPRED)
                 (ECLECTOR.READER:UNQUOTE-SPLICING VALUES)))))))))))

[serapeum/files.lisp:126]
  (DEFUN FILE=/LOOP (FILE1 FILE2 &KEY (BUFFER-SIZE 4096))
    "Compare two files by looping over their contents using a buffer."
    (DECLARE (TYPE PATHNAME FILE1 FILE2)
             (TYPE ARRAY-LENGTH BUFFER-SIZE)
             (OPTIMIZE (SAFETY 1) (DEBUG 0) (COMPILATION-SPEED 0)))
    (FLET ((MAKE-BUFFER ()
             (MAKE-ARRAY BUFFER-SIZE :ELEMENT-TYPE 'OCTET :INITIAL-ELEMENT 0)))
      (DECLARE (INLINE MAKE-BUFFER))
      (WITH-OPEN-FILES
       ((FILE1 FILE1 :ELEMENT-TYPE 'OCTET :DIRECTION :INPUT)
        (FILE2 FILE2 :ELEMENT-TYPE 'OCTET :DIRECTION :INPUT))
       (AND (= (FILE-LENGTH FILE1) (FILE-LENGTH FILE2))
            (LOCALLY
             (DECLARE (OPTIMIZE SPEED))
             (LOOP WITH BUFFER1 = (MAKE-BUFFER)
                   WITH BUFFER2 = (MAKE-BUFFER)
                   FOR END1 = (READ-SEQUENCE BUFFER1 FILE1)
                   FOR END2 = (READ-SEQUENCE BUFFER2 FILE2)
                   UNTIL (OR (ZEROP END1) (ZEROP END2))
                   ALWAYS (AND (= END1 END2)
                               (OCTET-VECTOR= BUFFER1 BUFFER2 :END1 END1 :END2
                                END2))))))))

[serapeum/internal-definitions.lisp:105]
  (LOCALLY
   (DECLARE (OPTIMIZE SAFETY))
   (DEFCLASS INTERNAL-DEFINITIONS-ENV NIL
             ((VARS :TYPE LIST :INITFORM NIL)
              (VAR-ALIASES :TYPE LIST :INITFORM NIL)
              (DECLS :TYPE LIST :INITARG :DECLS)
              (HOISTED-VARS :TYPE LIST :INITFORM NIL)
              (LABELS :TYPE
                LIST
                :INITFORM
                NIL)
              (EXPRS :TYPE LIST :INITFORM NIL)
              (GLOBAL-SYMBOL-MACROS :TYPE LIST :INITFORM NIL)
              (ENV :TYPE T :INITARG :ENV :DOCUMENTATION
               "The Lisp environment."))
             (:DEFAULT-INITARGS :ENV NIL :DECLS NIL)))

[serapeum/internal-definitions.lisp:125]
  (LOCALLY
   (DECLARE (OPTIMIZE SAFETY))
   (DEFCLASS %BINDING NIL
             ((NAME :READER BINDING-NAME :INITARG :NAME :TYPE SYMBOL)
              (INIT :READER BINDING-INIT :INITARG :INIT :TYPE EXPR)))
   (DEFCLASS VAR (%BINDING) NIL)
   (DEFCLASS SYMBOL-MACRO (%BINDING) NIL)
   (DEFCLASS FUN (%BINDING) NIL)
   (DEFCLASS MACRO (%BINDING) NIL))

[serapeum/lists.lisp:99]
  (DEFUN IN (X &REST ITEMS)
    "Is X equal to any of ITEMS?

`(in x xs...)` is always equivalent to `(and (member x xs :test equal) t)`,
but `in` can sometimes compile to more efficient code when the
candidate matches are constant.

From Arc."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1))
             (DYNAMIC-EXTENT ITEMS))
    (LOOP FOR ITEM IN ITEMS
          WHEN (EQUAL X ITEM) RETURN T))

[serapeum/lists.lisp:127]
  (DEFUN MEMQ (ITEM LIST)
    "Like (member ... :test #'eq).
Should only be used for symbols."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0))
             (LIST LIST))
    (TAGBODY
     LOOP
      (WHEN LIST
        (UNLESS (EQ ITEM (FIRST LIST)) (SETF LIST (REST LIST)) (GO LOOP)))
      (RETURN-FROM MEMQ LIST)))

[serapeum/lists.lisp:349]
  (DEFUN LIST-MAP-FROM-END/BORDEAUX (FUN LIST &KEY START END)
    "Traverse LIST from the end, calling FUN on each item.

This uses the technique described by Durand and Strandh in their paper
presented at ECLS 2015, “Processing List Elements in Reverse Order.”"
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (COMPILATION-SPEED 0)))
    NIL
    (SYMBOL-MACROLET ((SMALL 10000) (BIG 100000000))
      (LABELS ((AUX1 (FUN LIST LENGTH)
                 (DECLARE (FIXNUM LENGTH)
                          (FUNCTION FUN))
                 (UNLESS (ZEROP LENGTH)
                   (AUX1 FUN (CDR LIST) (1- LENGTH))
                   (FUNCALL FUN (CAR LIST))))
               (AUX2 (FUN LIST LENGTH)
                 (DECLARE (FIXNUM LENGTH))
                 (IF (<= LENGTH SMALL)
                     (AUX1 FUN LIST LENGTH)
                     (PROGN
                      (AUX2 FUN (NTHCDR SMALL LIST) (- LENGTH SMALL))
                      (AUX1 FUN LIST SMALL))))
               (AUX3 (FUN LIST LENGTH)
                 (DECLARE (FIXNUM LENGTH))
                 (IF (< LENGTH BIG)
                     (AUX2 FUN LIST LENGTH)
                     (LET* ((N (ASH LENGTH -1)) (MIDDLE (NTHCDR N LIST)))
                       (PROGN
                        (AUX3 FUN MIDDLE (- LENGTH N))
                        (AUX2 FUN LIST N))))))
        (MULTIPLE-VALUE-BIND (LIST LENGTH)
            (LIST+LENGTH LIST START END)
          (DECLARE (FIXNUM LENGTH)
                   (LIST LIST))
          (AUX3 FUN LIST LENGTH)))))

[serapeum/macro-tools.lisp:419]
  (DEFUN POLICY-QUALITY (QUALITY &OPTIONAL ENV)
    "Query ENV for optimization declaration information.
Returns 1 when the environment cannot be accessed."
    (IF (FBOUNDP 'SB-CLTL2:DECLARATION-INFORMATION)
        (LET ((ALIST (FUNCALL 'SB-CLTL2:DECLARATION-INFORMATION 'OPTIMIZE ENV)))
          (OR (SECOND (ASSOC QUALITY ALIST))
              (ERROR "Unknown policy quality ~s" QUALITY)))
        (IF (MEMBER QUALITY '(SPEED SAFETY SPACE DEBUG COMPILATION-SPEED))
            1
            (ERROR "Unknown policy quality ~s" QUALITY))))

[serapeum/octets.lisp:68]
  (DEFUN OCTET-VECTOR=/UNSAFE (V1 V2 START1 END1 START2 END2)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0) (COMPILATION-SPEED 0))
             (TYPE OCTET-VECTOR V1 V2)
             (TYPE ARRAY-INDEX START1 START2)
             (TYPE ARRAY-LENGTH END1 END2))
    (AND (= (- END1 START1) (- END2 START2))
         (LOOP FOR I FROM START1 BELOW END1
               FOR J FROM START2 BELOW END2
               ALWAYS (EQL (AREF V1 I) (AREF V2 J)))))

[serapeum/range.lisp:3]
  (DEFCONST NO-BOUNDS-CHECKS
   '(DECLARE (OPTIMIZE (DEBUG 0) (SAFETY 0) (COMPILATION-SPEED 0))))

[serapeum/range.lisp:215]
  (DEFUN RANGE (START &OPTIONAL (STOP 0 STOP?) (STEP 1))
    "Return a (possibly specialized) vector of real numbers, starting from START.

With three arguments, return the integers in the interval [start,end)
whose difference from START is divisible by STEP.

START, STOP, and STEP can be any real number, except that if STOP is
greater than START, STEP must be positive, and if START is greater
than STOP, STEP must be negative.

The vector returned has the smallest element type that can represent
numbers in the given range. E.g. the range [0,256) will usually be
represented by a vector of octets, while the range [-10.0,10.0) will
be represented by a vector of single floats. The exact representation,
however, depends on your Lisp implementation.

STEP defaults to 1.

With two arguments, return all the steps in the interval [start,end).

With one argument, return all the steps in the interval [0,end)."
    (DECLARE (OPTIMIZE (DEBUG 0) (SAFETY 1))
             (MUFFLE-CONDITIONS CODE-DELETION-NOTE)
             (NOTINLINE COUNT-RANGE/1 COUNT-RANGE/2 COUNT-RANGE/3))
    (MULTIPLE-VALUE-BIND (START STOP)
        (IF STOP?
            (VALUES START STOP)
            (VALUES 0 START))
      (CHECK-RANGE START STOP STEP)
      (DISPATCH-CASE ((START REAL*) (STOP REAL*) (STEP REAL*))
       ((ARRAY-INDEX ARRAY-INDEX NON-NEGATIVE-INTEGER)
        (IF (<= START STOP)
            (COUNT-RANGE/3 START STOP STEP)
            (INTEGER-RANGE START STOP STEP)))
       ((NON-NEGATIVE-INTEGER NON-NEGATIVE-INTEGER NON-NEGATIVE-INTEGER)
        (INTEGER-RANGE START STOP STEP))
       ((INTEGER INTEGER INTEGER) (INTEGER-RANGE START STOP STEP))
       ((RATIO RATIONAL RATIONAL) (REAL-RANGE START STOP STEP))
       ((RATIONAL RATIO RATIONAL) (REAL-RANGE START STOP STEP))
       ((RATIONAL RATIONAL RATIO) (REAL-RANGE START STOP STEP))
       ((SINGLE-FLOAT SINGLE-FLOAT SINGLE-FLOAT)
        (SINGLE-FLOAT-RANGE START STOP STEP))
       ((DOUBLE-FLOAT DOUBLE-FLOAT DOUBLE-FLOAT)
        (DOUBLE-FLOAT-RANGE START STOP STEP))
       ((SHORT-FLOAT SHORT-FLOAT SHORT-FLOAT)
        (SHORT-FLOAT-RANGE START STOP STEP))
       ((LONG-FLOAT LONG-FLOAT LONG-FLOAT) (LONG-FLOAT-RANGE START STOP STEP))
       ((FLOAT FLOAT FLOAT) (FRANGE START STOP STEP))
       ((RATIONAL FLOAT FLOAT) (FRANGE START STOP STEP))
       ((RATIONAL FLOAT RATIONAL) (FRANGE START STOP STEP))
       ((RATIONAL RATIONAL FLOAT) (FRANGE START STOP STEP))
       ((FLOAT FLOAT RATIONAL) (FRANGE START STOP STEP))
       ((FLOAT RATIONAL FLOAT) (FRANGE START STOP STEP))
       ((FLOAT RATIONAL RATIONAL) (FRANGE START STOP STEP)))))

[serapeum/sequences.lisp:52]
  (DEFUN KEY-TEST (KEY TEST &OPTIONAL TEST-NOT)
    "Return a function of two arguments which uses KEY to extract the
part of the arguments to compare, and compares them using TEST."
    (DECLARE (OPTIMIZE (SAFETY 1) (DEBUG 0)))
    (LET ((KEY (CANONICALIZE-KEY KEY)) (TEST (CANONICALIZE-TEST TEST TEST-NOT)))
      (IF (EQL KEY #'IDENTITY)
          TEST
          (FBIND KEY
           (WITH-TWO-ARG-TEST (TEST) (LAMBDA (X Y) (TEST (KEY X) (KEY Y))))))))

[serapeum/sequences.lisp:119]
  (DEFUN MAP-SUBSEQ (FN SEQ &OPTIONAL START END FROM-END)
    "Helper function to map SEQ between START and END."
    (DECLARE (TYPE (OR NULL ARRAY-INDEX) START END)
             (OPTIMIZE (DEBUG 0) (SAFETY 1) (COMPILATION-SPEED 0)))
    (LET ((START (OR START 0)) (FN (ENSURE-FUNCTION FN)))
      (FBIND (FN)
       (SEQ-DISPATCH SEQ
        (IF (NULL END)
            (IF FROM-END
                (LIST-MAP-FROM-END/BORDEAUX FN SEQ :START START)
                (DOLIST (ITEM (NTHCDR START SEQ)) (FN ITEM)))
            (IF FROM-END
                (LIST-MAP-FROM-END/BORDEAUX FN SEQ :START START :END END)
                (LOOP FOR ITEM IN (NTHCDR START SEQ)
                      FOR I BELOW (- END START)
                      DO (FN ITEM))))
        (WITH-SUBTYPE-DISPATCH VECTOR
         (SIMPLE-BIT-VECTOR BIT-VECTOR (SIMPLE-ARRAY CHARACTER (*))
          SIMPLE-BASE-STRING)
         SEQ
         (LET ((END (OR END (LENGTH SEQ))))
           (IF FROM-END
               (LOOP FOR I DOWNFROM (1- END) TO START
                     DO (FN (VREF SEQ I)))
               (LOOP FOR I FROM START BELOW
                     END
                     DO (FN (VREF SEQ I))))))
        (LET ((END (OR END (LENGTH SEQ))))
          (IF FROM-END
              (LOOP FOR I DOWNFROM (1- END) TO START
                    DO (FN (ELT SEQ I)))
              (LOOP FOR I FROM START BELOW
                    END
                    DO (FN (ELT SEQ I)))))))))

[serapeum/sequences.lisp:1359]
  (DEFUN QUICKSELECT (A K LT)
    "Hoare's quickselect, as implemented by Wirth (\"FIND\"), with
  refinements by V. Zabrodsky (\"MODIFIND\")."
    (DECLARE (OPTIMIZE (DEBUG 0) (SAFETY 1)))
    (ASSERT (< K (LENGTH A)))
    (FBIND (LT)
     (WITH-VECTOR-DISPATCH NIL A
      (LOOP WITH N = (LENGTH A)
            WITH L OF-TYPE ARRAY-INDEX = 0
            WITH R OF-TYPE ARRAY-INDEX = (1- N)
            FOR X = (VREF A K)
            FOR I = L
            FOR J = R
            WHILE (< L R)
            DO (LOOP UNTIL (OR (< J K) (< K I))
                     DO (LOOP WHILE (LT (VREF A I) X)
                              DO (INCF I)) (LOOP WHILE (LT X (VREF A J))
                                                 DO (DECF J)) (ROTATEF
                                                               (VREF A I)
                                                               (VREF A
                                                                J)) (INCF
                                                                     I) (DECF
                                                                         J)) (WHEN
                                                                                 (<
                                                                                  J
                                                                                  K)
                                                                               (SETF L
                                                                                       I)) (WHEN
                                                                                               (<
                                                                                                K
                                                                                                I)
                                                                                             (SETF R
                                                                                                     J))
            FINALLY (RETURN (VREF A K))))))

[serapeum/sequences.lisp:1842]
  (DEFUN REPEAT-LIST (LIST N)
    (DECLARE (OPTIMIZE SPEED (SAFETY 0)))
    (IF (NULL LIST)
        NIL
        (LET ((N (ASSURE ARRAY-INDEX N)))
          (COLLECTING*
           (LOOP REPEAT N
                 DO (LOOP FOR ITEM IN LIST
                          DO (COLLECT ITEM)))))))

[serapeum/sequences.lisp:1851]
  (DEFUN REPEAT-VECTOR (VEC N)
    (DECLARE (TYPE VECTOR VEC)
             (OPTIMIZE (SAFETY 0) (DEBUG 0)))
    (WHEN (= (LENGTH VEC) 0)
      (RETURN-FROM REPEAT-VECTOR
        (MAKE-ARRAY 0 :ELEMENT-TYPE (ARRAY-ELEMENT-TYPE VEC))))
    (UNLESS (< (* (LENGTH VEC) N) ARRAY-DIMENSION-LIMIT)
      (ERROR "A vector of size ~a*~a is too big" (LENGTH VEC) N))
    (LET* ((LEN (LENGTH VEC)) (N N) (LEN-OUT (* LEN N)))
      (DECLARE (ARRAY-INDEX LEN N LEN-OUT))
      (WITH-SIMPLE-VECTOR-DISPATCH
       (SIMPLE-BIT-VECTOR (SIMPLE-ARRAY CHARACTER (*))) (VEC FROM TO)
       (LET ((OUT (MAKE-ARRAY LEN-OUT :ELEMENT-TYPE (ARRAY-ELEMENT-TYPE VEC))))
         (NLET REC ((N N) (OFFSET FROM)) (DECLARE (ARRAY-INDEX N OFFSET))
          (IF (ZEROP N)
              OUT
              (PROGN
               (REPLACE OUT VEC :START1 OFFSET :START2 FROM :END2 TO)
               (REC (1- N) (+ OFFSET LEN)))))))))

[serapeum/strings.lisp:624]
  (DEFUN ESCAPE/NO-ARG-PARSING (STRING TABLE START END STREAM)
    (DECLARE (STRING STRING)
             ((OR FUNCTION HASH-TABLE) TABLE)
             ((OR ARRAY-INDEX NULL) START)
             ((OR ARRAY-LENGTH NULL) END)
             (OPTIMIZE (DEBUG 0) (SAFETY 1) (COMPILATION-SPEED 0) (SPACE 0))
             (MUFFLE-CONDITIONS CODE-DELETION-NOTE))
    (LET ((START (OR START 0)) (END (OR END (LENGTH STRING))))
      (DECLARE (ARRAY-INDEX START)
               (ARRAY-LENGTH END))
      (WITH-STRING (STREAM STREAM)
       (WITH-TYPE-DISPATCH #'HASH-TABLE TABLE
        (WITH-STRING-DISPATCH NIL STRING
         (FLET ((REP (C)
                  (ETYPECASE TABLE
                    (FUNCTION (FUNCALL TABLE C))
                    (HASH-TABLE (GETHASH C TABLE)))))
           (DECLARE (INLINE REP))
           (NLET ESCAPE ((START START))
            (WHEN (< START END)
              (LET ((NEXT (POSITION-IF #'REP STRING :START START :END END)))
                (IF (NOT NEXT)
                    (WRITE-STRING STRING STREAM :START START :END END)
                    (PROGN
                     (WRITE-STRING STRING STREAM :START START :END NEXT)
                     (LET ((ESCAPE (REP (VREF STRING NEXT))))
                       (UNLESS (EMPTYP ESCAPE) (WRITE-STRING ESCAPE STREAM))
                       (ESCAPE (1+ NEXT))))))))))))))

[serapeum/strings.lisp:945]
  (DEFUN DIGIT-LENGTH (N &OPTIONAL (BASE *PRINT-BASE*))
    (DECLARE ((INTEGER 0 NIL) N)
             (OPTIMIZE SPEED (SAFETY 1)))
    (LET ((LEN 0))
      (DECLARE ((INTEGER 0 NIL) LEN))
      (LOOP FOR Q = (TRUNCATE N BASE)
            DO (INCF LEN)
            UNTIL (ZEROP (SETF N Q)))
      LEN))

[serapeum/strings.lisp:957]
  (DEFUN STRING+ (&REST ARGS)
    "Optimized function for building small strings.

Roughly equivalent to

    (let ((*print-pretty* nil))
     (format nil \"~@{~a}\" args...))

But may be more efficient when the arguments of certain simple
types (such as strings, characters, symbols, pathnames, and fixnums).

Note that unlike `princ', `string+' treats `nil' as the same as the
empty string:

    (string+ nil)
    => \"\"

    (string+ \"x\" nil)
    => \"x\"

This utility is inspired by the utility of the same name in Allegro."
    (DECLARE (DYNAMIC-EXTENT ARGS))
    (IF (NULL ARGS)
        ""
        (LET ((*PRINT-PRETTY* NIL))
          (LOCALLY
           (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
           (TAGBODY
            :USE-CONCAT
             (LET ((LEN 0)
                   (PRINT-BASE *PRINT-BASE*)
                   (INT-CHARS "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
               (DECLARE (ARRAY-LENGTH LEN)
                        ((INTEGER 2 36) PRINT-BASE))
               (DOLIST (X ARGS)
                 (TYPECASE-OF FIXED-PRINT-LENGTH-TYPE X
                  (STRING (INCF LEN (LENGTH X))) (CHARACTER (INCF LEN))
                  (PATHNAME
                   (WHEN-LET (NAMESTRING (NAMESTRING X))
                    (INCF LEN (LENGTH NAMESTRING))))
                  (NULL) (SYMBOL (INCF LEN (LENGTH (SYMBOL-NAME X))))
                  (FIXNUM (WHEN (MINUSP X) (INCF LEN))
                   (INCF LEN (DIGIT-LENGTH (ABS X))))
                  (OTHERWISE (GO :USE-STRING-STREAM))))
               (LET ((RESULT (MAKE-ARRAY LEN :ELEMENT-TYPE 'CHARACTER))
                     (START 0)
                     (PRINT-CASE *PRINT-CASE*))
                 (DECLARE (ARRAY-INDEX START)
                          ((SIMPLE-ARRAY CHARACTER (*)) RESULT))
                 (DOLIST (X ARGS)
                   (FLET ((ADD-CHAR (C)
                            (DECLARE (CHARACTER C))
                            (SETF (SCHAR RESULT START) C)
                            (INCF START))
                          (ADD-STRING (S)
                            (DECLARE (STRING S))
                            (WITH-STRING-DISPATCH NIL S
                             (REPLACE RESULT S :START1 START)
                             (INCF START (LENGTH S)))))
                     (ETYPECASE-OF FIXED-PRINT-LENGTH-TYPE X
                      (STRING (ADD-STRING X)) (CHARACTER (ADD-CHAR X))
                      (PATHNAME
                       (WHEN-LET (NAMESTRING (NAMESTRING X))
                        (ADD-STRING NAMESTRING)))
                      (NULL)
                      (SYMBOL
                       (IF (EQL PRINT-CASE :UPCASE)
                           (ADD-STRING (SYMBOL-NAME X))
                           (ADD-STRING (PRINC-TO-STRING X))))
                      (FIXNUM (WHEN (MINUSP X) (ADD-CHAR #\-))
                       (LET* ((X (ABS X)) (PTR (+ START (DIGIT-LENGTH X))))
                         (DECLARE (ARRAY-LENGTH PTR))
                         (COND ((EQL X 0) (ADD-CHAR #\0))
                               ((EQL X 1) (ADD-CHAR #\1))
                               (T
                                (LOOP
                                 (MULTIPLE-VALUE-BIND (Q R)
                                     (TRUNCATE X PRINT-BASE)
                                   (DECF PTR)
                                   (SETF (AREF RESULT PTR) (SCHAR INT-CHARS R))
                                   (INCF START)
                                   (WHEN (ZEROP (SETQ X Q)) (RETURN)))))))))))
                 (RETURN-FROM STRING+ RESULT)))
            :USE-STRING-STREAM
             (RETURN-FROM STRING+
               (WITH-OUTPUT-TO-STRING (S)
                 (DOLIST (ARG ARGS)
                   (TYPECASE ARG
                     (STRING (WRITE-STRING ARG S))
                     (CHARACTER (WRITE-CHAR ARG S))
                     (NULL)
                     (T (PRINC ARG S)))))))))))

[serapeum/tests/control-flow.lisp:326]
  (TEST ECOND (DECLARE (OPTIMIZE (SPEED 0) (SAFETY 3)))
   (LET ((N (RANDOM 10)))
     (SIGNALS ECOND-FAILURE (ECOND ((> N 10) (ASSERT NIL))))))

[serapeum/tests/lists.lisp:23]
  (TEST MAPPLY
   (WITH-NOTINLINE (MAPPLY)
    (IS
     (EQUAL
      (LOCALLY
       (DECLARE (OPTIMIZE (SPEED 0) (SAFETY 3) (DEBUG 3)))
       (MAPPLY #'CONS '((X 1) (Y 2))))
      '((X . 1) (Y . 2))))
    (IS
     (EQUAL (MAPPLY #'LIST '((A 1) (B 2)) '((C 3) (D 4)))
            '((A 1 C 3) (B 2 D 4))))))

[serapeum/tests/types.lisp:174]
  (TEST (WITH-TWO-ARG-TEST/HIGH-SAFETY :COMPILE-AT :RUN-TIME) NIL
   (IS-TRUE
    (FUNCALL
     (LAMBDA (X Y)
       (DECLARE (OPTIMIZE (SAFETY 3) (SPEED 0)))
       (LET ((MY-TEST #'EQL))
         (SERAPEUM:WITH-TWO-ARG-TEST (MY-TEST)
           (MY-TEST X Y))))
     1 1)))

[serapeum/types.lisp:384]
  (DEFMACRO WITH-TYPE-DECLARATIONS-TRUSTED (&ENVIRONMENT ENV (&KEY) &BODY BODY)
    (CASE UIOP/OS:*IMPLEMENTATION-TYPE*
      (:CCL
       (MULTIPLE-VALUE-BIND (SPEED SAFETY)
           (LET ((SPEED (POLICY-QUALITY 'SPEED ENV))
                 (SAFETY (POLICY-QUALITY 'SAFETY ENV)))
             (IF (AND (< SAFETY 3) (>= SPEED SAFETY))
                 (VALUES SPEED SAFETY)
                 (LET* ((SAFETY (MIN SAFETY 2)) (SPEED (MAX SPEED SAFETY)))
                   (VALUES SPEED SAFETY))))
         (ASSERT (AND (< SAFETY 3) (>= SPEED SAFETY)))
         (ECLECTOR.READER:QUASIQUOTE
          (LOCALLY
           (DECLARE
            (OPTIMIZE (SPEED (ECLECTOR.READER:UNQUOTE SPEED))
             (SAFETY (ECLECTOR.READER:UNQUOTE SAFETY))))
           (ECLECTOR.READER:UNQUOTE-SPLICING BODY)))))
      (:ECL
       (LET* ((CURRENT-SAFETY (POLICY-QUALITY 'SAFETY ENV))
              (CAPPED-SAFETY (MIN CURRENT-SAFETY 1)))
         (ECLECTOR.READER:QUASIQUOTE
          (LOCALLY
           (DECLARE
            (OPTIMIZE (SAFETY (ECLECTOR.READER:UNQUOTE CAPPED-SAFETY))))
           (ECLECTOR.READER:UNQUOTE-SPLICING BODY)))))
      (T
       (ECLECTOR.READER:QUASIQUOTE
        (PROGN (ECLECTOR.READER:UNQUOTE-SPLICING BODY))))))

[shcl/core/utility.lisp:33]
  (DEFMACRO OPTIMIZATION-SETTINGS ()
    "Declaims standard optimization settings.

Put this at the top of every file!"
    (ECLECTOR.READER:QUASIQUOTE
     (DECLAIM
      (OPTIMIZE (SPEED 0) (SAFETY 3) (SPACE 0) (DEBUG 3)
       (COMPILATION-SPEED 0)))))

[shcl/deps.lisp:21]
  (DECLAIM
   (OPTIMIZE (SPEED 0) (SAFETY 3) (SPACE 0) (DEBUG 3) (COMPILATION-SPEED 0)))

[shcl/make.lisp:19]
  (DECLAIM
   (OPTIMIZE (SPEED 0) (SAFETY 3) (SPACE 0) (DEBUG 3) (COMPILATION-SPEED 0)))

[shop3/jenkins/build-shop3.lisp:5]
  (DECLAIM (OPTIMIZE (SPEED 3) (SPACE 3) (SAFETY 3)))

[shop3/shop3/unification/unify.lisp:154]
  (DEFUN FIND-BINDING (TARGET BINDING-LIST)
    "Find and return the value of TARGET that's recorded in BINDING-LIST."
    (DECLARE (TYPE LIST BINDING-LIST)
             (INLINE BINDING-VAR)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LOOP FOR BINDING IN BINDING-LIST
          WHEN (EQ (BINDING-VAR BINDING) TARGET) RETURN BINDING))

[snek/src/bzspline.lisp:15]
  (DEFUN -DO-CALC (VPTS X SEG)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT) VPTS)
             (DOUBLE-FLOAT X)
             (FIXNUM SEG))
    (LET* ((|2X| (+ X X))
           (XE2 (* X X))
           (A (+ 1.0d0 (- |2X|) XE2))
           (B (+ |2X| (* -2.0d0 XE2)))
           (C XE2)
           (IA (* 4 SEG))
           (IB (+ IA 2))
           (IC (+ IA 4)))
      (DECLARE (DOUBLE-FLOAT |2X| XE2 A B C)
               (FIXNUM IA IB IC))
      (#S(FORMGREP:SYMREF :NAME "VEC" :QUALIFIER "VEC")
       (+ (* (AREF VPTS IA) A) (* (AREF VPTS IB) B) (* (AREF VPTS IC) C))
       (+ (* (AREF VPTS (1+ IA)) A) (* (AREF VPTS (1+ IB)) B)
          (* (AREF VPTS (1+ IC)) C)))))

[snek/src/bzspline.lisp:36]
  (DEFUN -GET-SEG
         (NS X
          &AUX (S (THE DOUBLE-FLOAT (COERCE (THE FIXNUM NS) 'DOUBLE-FLOAT))))
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (FIXNUM NS)
             (DOUBLE-FLOAT X S))
    (IF (>= X 1.0d0)
        (VALUES (1- NS) 1.0d0)
        (TRUNCATE (THE DOUBLE-FLOAT (* X S)))))

[snek/src/bzspline.lisp:45]
  (DEFUN -X-TO-PT (VPTS NS X)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT) VPTS)
             (FIXNUM NS)
             (DOUBLE-FLOAT X))
    (MULTIPLE-VALUE-BIND (SEG XLOC)
        (-GET-SEG NS X)
      (DECLARE (FIXNUM SEG)
               (DOUBLE-FLOAT XLOC))
      (-DO-CALC VPTS XLOC SEG)))

[snek/src/bzspline.lisp:54]
  (DEFUN POS (B X)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (BZSPL B)
             (DOUBLE-FLOAT X))
    (WITH-STRUCT (BZSPL- NS VPTS) B
     (DECLARE (FIXNUM NS)
              (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT) VPTS))
     (-X-TO-PT VPTS NS X)))

[snek/src/bzspline.lisp:83]
  (DEFUN -RESAPPEND (RES A AV)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (DOUBLE-FLOAT A)
             (#S(FORMGREP:SYMREF :NAME "VEC" :QUALIFIER "VEC") AV))
    (IF (OR (< (LENGTH RES) 1)
            (DESTRUCTURING-BIND
                (S _)
                (VECTOR-LAST RES)
              (DECLARE (DOUBLE-FLOAT S)
                       (IGNORE _))
              (> A S)))
        (VEXTEND (LIST A AV) RES)))

[snek/src/bzspline.lisp:91]
  (DEFUN -MIDSAMPLE (L R)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (DOUBLE-FLOAT L R))
    (LET* ((D (+ R L)) (S (* 0.05d0 (- R L))))
      (DECLARE (DOUBLE-FLOAT D S))
      (+ (* 0.5d0 D) (#S(FORMGREP:SYMREF :NAME "RND*" :QUALIFIER "RND") S))))

[snek/src/bzspline.lisp:98]
  (DEFUN -AREA (A B C)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (#S(FORMGREP:SYMREF :NAME "VEC" :QUALIFIER "VEC") A B C))
    (ABS
     (* 0.5d0
        (+
         (* (#S(FORMGREP:SYMREF :NAME "VEC-X" :QUALIFIER "VEC") A)
            (- (#S(FORMGREP:SYMREF :NAME "VEC-Y" :QUALIFIER "VEC") B)
               (#S(FORMGREP:SYMREF :NAME "VEC-Y" :QUALIFIER "VEC") C)))
         (* (#S(FORMGREP:SYMREF :NAME "VEC-X" :QUALIFIER "VEC") B)
            (- (#S(FORMGREP:SYMREF :NAME "VEC-Y" :QUALIFIER "VEC") C)
               (#S(FORMGREP:SYMREF :NAME "VEC-Y" :QUALIFIER "VEC") A)))
         (* (#S(FORMGREP:SYMREF :NAME "VEC-X" :QUALIFIER "VEC") C)
            (- (#S(FORMGREP:SYMREF :NAME "VEC-Y" :QUALIFIER "VEC") A)
               (#S(FORMGREP:SYMREF :NAME "VEC-Y" :QUALIFIER "VEC") B)))))))

[snek/src/bzspline.lisp:104]
  (DEFUN -ADAPTIVE-POS
         (NS VPTS LIM
          &KEY L R LV RV
          (RES
           (MAKE-ADJUSTABLE-VECTOR :TYPE
            '#S(FORMGREP:SYMREF :NAME "VEC" :QUALIFIER "VEC"))))
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT) VPTS)
             (VECTOR RES)
             (FIXNUM NS)
             (DOUBLE-FLOAT L R LIM))
    (LET* ((M (-MIDSAMPLE L R))
           (LV*
            (IF LV
                LV
                (-X-TO-PT VPTS NS L)))
           (RV*
            (IF RV
                RV
                (-X-TO-PT VPTS NS R)))
           (MV* (-X-TO-PT VPTS NS M))
           (A (-AREA LV* MV* RV*)))
      (DECLARE (DOUBLE-FLOAT M A)
               (#S(FORMGREP:SYMREF :NAME "VEC" :QUALIFIER "VEC") LV* RV* MV*))
      (IF (< A LIM)
          (PROGN (-RESAPPEND RES L LV*) (-RESAPPEND RES R RV*))
          (PROGN
           (-ADAPTIVE-POS NS VPTS LIM :L L :R M :LV LV* :RV MV* :RES RES)
           (-ADAPTIVE-POS NS VPTS LIM :L M :R R :LV MV* :RV RV :RES RES))))
    RES)

[snek/src/linear-path.lisp:12]
  (DEFUN -DIFF-SCALE (A B S)
    (DECLARE (OPTIMIZE (DEBUG 0) SPEED (SAFETY 0))
             (DOUBLE-FLOAT A B S))
    (/ (- B A) S))

[snek/src/linear-path.lisp:18]
  (DEFUN -GET-LEN (PTS I &AUX (II (* 2 I)))
    (DECLARE (OPTIMIZE (DEBUG 0) SPEED (SAFETY 0))
             (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT) PTS)
             (FIXNUM I II))
    (EXPT
     (+ (EXPT (- (AREF PTS (+ II 2)) (AREF PTS II)) 2.0d0)
        (EXPT (- (AREF PTS (+ II 3)) (AREF PTS (+ II 1))) 2.0d0))
     0.5d0))

[snek/src/linear-path.lisp:26]
  (DEFUN -SET-PATH-LENS (PTS LENS N)
    (DECLARE (OPTIMIZE (DEBUG 0) SPEED (SAFETY 0))
             (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT) PTS LENS)
             (FIXNUM N))
    (LOOP WITH TOT OF-TYPE DOUBLE-FLOAT = (LOOP FOR I OF-TYPE FIXNUM FROM 0 BELOW (1-
                                                                                   N)
                                                SUM (-GET-LEN PTS
                                                     I) INTO TOT OF-TYPE DOUBLE-FLOAT
                                                DO (SETF (AREF LENS (1+ I))
                                                           TOT)
                                                FINALLY (RETURN TOT))
          FOR I OF-TYPE FIXNUM FROM 1 BELOW N
          DO (SETF (AREF LENS I) (/ (AREF LENS I) TOT))))

[snek/src/linear-path.lisp:39]
  (DEFUN -FIND-SEG-IND (LENS F N)
    (DECLARE (OPTIMIZE (DEBUG 0) SPEED (SAFETY 0))
             (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT) LENS)
             (FIXNUM N)
             (DOUBLE-FLOAT F))
    (LOOP WITH L OF-TYPE FIXNUM = 0
          WITH R OF-TYPE FIXNUM = (- N 1)
          WITH MID OF-TYPE FIXNUM = 0
          UNTIL (<= (AREF LENS MID) F (AREF LENS (1+ MID)))
          DO (SETF MID (FLOOR (+ L R) 2)) (COND
                                           ((> F (AREF LENS MID))
                                            (SETF L (PROGN MID)))
                                           ((< F (AREF LENS MID))
                                            (SETF R (1+ MID))))
          FINALLY (RETURN (THE FIXNUM (1+ MID)))))

[snek/src/linear-path.lisp:54]
  (DEFUN -CALC-POS (PTS LENS N F)
    (DECLARE (OPTIMIZE (DEBUG 0) SPEED (SAFETY 0))
             (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT) PTS LENS)
             (FIXNUM N)
             (DOUBLE-FLOAT F))
    (LET* ((I (-FIND-SEG-IND LENS F N))
           (BI (* 2 I))
           (AI (- BI 2))
           (S
            (-DIFF-SCALE (AREF LENS (1- I)) F
             (- (AREF LENS I) (AREF LENS (1- I))))))
      (DECLARE (FIXNUM I AI BI)
               (DOUBLE-FLOAT S))
      (#S(FORMGREP:SYMREF :NAME "VEC" :QUALIFIER "VEC")
       (+ (AREF PTS AI) (* (- (AREF PTS BI) (AREF PTS AI)) S))
       (+ (AREF PTS (1+ AI)) (* (- (AREF PTS (1+ BI)) (AREF PTS (1+ AI))) S)))))

[snek/src/math.lisp:198]
  (DEFUN ON-LINE (P AA BB)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (LIST AA BB))
    (LOOP FOR A IN AA
          AND B IN BB
          COLLECT (+ A (* P (- B A)))))

[snek/src/sandpaint-extra.lisp:21]
  (DEFUN COPY-RGBA-ARRAY-TO-FROM (TARGET SOURCE SIZE)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT) TARGET SOURCE)
             (FIXNUM SIZE))
    (LOOP FOR I OF-TYPE FIXNUM FROM 0 BELOW (* SIZE SIZE 4)
          DO (SETF (AREF TARGET I) (THE DOUBLE-FLOAT (AREF SOURCE I)))))

[snek/src/sandpaint-extra.lisp:29]
  (DEFUN COPY-SCALE-RGBA-ARRAY-TO-FROM (TARGET SOURCE SCALE SIZE)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT) TARGET SOURCE)
             (FIXNUM SIZE))
    (LOOP FOR I OF-TYPE FIXNUM FROM 0 BELOW (* SIZE SIZE 4)
          DO (IF (<= (AREF SCALE I) 0)
                 (SETF (AREF TARGET I) (AREF SOURCE I))
                 (SETF (AREF TARGET I) (/ (AREF SOURCE I) (AREF SCALE I))))))

[snek/src/sandpaint-extra.lisp:51]
  (DEFUN CHROMATIC-ABERRATION (SAND &KEY MID (S 1.0d0))
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0)))
    (FORMAT T
            "WARN: CA is currently not working and will produce strange results.~%")
    (-DO-OP (SAND SIZE VALS INDFX :NAME "chromatic-aberration")
     (LABELS ((-CHANNEL-OPERATOR-OVER
                  (NEW-VALS NEW-COUNTS SX SY IX IY W CHANNEL)
                (WHEN
                    (AND (< -1 SX SIZE) (< -1 SY SIZE) (< -1 IX SIZE)
                         (< -1 IY SIZE))
                  (LET ((SIND (FUNCALL INDFX SX SY CHANNEL))
                        (IND (FUNCALL INDFX IX IY CHANNEL))
                        (IW (- 1.0d0 W)))
                    (IF (<= (AREF NEW-COUNTS IND) 0.0d0)
                        (SETF (AREF NEW-VALS IND) (* (AREF VALS SIND) W)
                              (AREF NEW-COUNTS IND) W)
                        (SETF (AREF NEW-VALS IND)
                                (+ (* (AREF VALS IND) IW)
                                   (* (AREF VALS SIND) W))
                              (AREF NEW-COUNTS IND)
                                (+ (AREF NEW-COUNTS IND) W))))))
              (-POINT-SAMPLE-CHANNEL (NEW-VALS NEW-COUNTS SX SY PT DX CHANNEL)
                (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
                         (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT) NEW-VALS)
                         (FIXNUM CHANNEL)
                         (#S(FORMGREP:SYMREF :NAME "VEC" :QUALIFIER "VEC") PT
                          DX))
                (LOOP FOR DPT IN (NVECSTEP 1 DX :END T)
                      DO (MULTIPLE-VALUE-BIND (IX IY FX FY)
                             (-FLOOR-FRACT
                              (#S(FORMGREP:SYMREF
                                  :NAME "IN-CIRC"
                                  :QUALIFIER "RND")
                               0.25d0 :XY
                               (#S(FORMGREP:SYMREF
                                   :NAME "ADD"
                                   :QUALIFIER "VEC")
                                PT DPT)))
                           (MULTIPLE-VALUE-BIND (W1 W2 W3 W4)
                               (-FRACT-OVERLAP FX FY)
                             (DECLARE (DOUBLE-FLOAT W1 W2 W3 W4))
                             (-CHANNEL-OPERATOR-OVER NEW-VALS NEW-COUNTS SX SY
                              IX IY W1 CHANNEL)
                             (-CHANNEL-OPERATOR-OVER NEW-VALS NEW-COUNTS SX SY
                              (+ IX 1) IY W2 CHANNEL)
                             (-CHANNEL-OPERATOR-OVER NEW-VALS NEW-COUNTS SX SY
                              IX (+ IY 1) W3 CHANNEL)
                             (-CHANNEL-OPERATOR-OVER NEW-VALS NEW-COUNTS SX SY
                              (+ IX 1) (+ IY 1) W4 CHANNEL))))))
       (LET ((CENTER
              (IF MID
                  MID
                  (#S(FORMGREP:SYMREF :NAME "VEC" :QUALIFIER "VEC")
                   (* 0.5d0 (SANDPAINT-SIZE SAND)))))
             (NEW-VALS (MAKE-RGBA-ARRAY SIZE :INIT 1.0d0))
             (NEW-COUNTS (MAKE-RGBA-ARRAY SIZE :INIT 0.0d0))
             (BASE-SIZE
              (/ S (#S(FORMGREP:SYMREF :NAME "DFLOAT" :QUALIFIER "MATH") SIZE)
                 2.0d0)))
         (COPY-RGBA-ARRAY-TO-FROM NEW-VALS VALS SIZE)
         (-SQUARE-LOOP (SX SY SIZE)
          (LET* ((PT
                  (#S(FORMGREP:SYMREF :NAME "ADD" :QUALIFIER "VEC")
                   #S(FORMGREP:SYMREF :NAME "*HALF*" :QUALIFIER "VEC")
                   (#S(FORMGREP:SYMREF :NAME "VEC-COERCE" :QUALIFIER "VEC") SX
                    SY)))
                 (DX
                  (#S(FORMGREP:SYMREF :NAME "SCALE" :QUALIFIER "VEC")
                   (#S(FORMGREP:SYMREF :NAME "SUB" :QUALIFIER "VEC") PT CENTER)
                   BASE-SIZE)))
            (-POINT-SAMPLE-CHANNEL NEW-VALS NEW-COUNTS SX SY PT DX 0)
            (-POINT-SAMPLE-CHANNEL NEW-VALS NEW-COUNTS SX SY PT
             (#S(FORMGREP:SYMREF :NAME "NEG" :QUALIFIER "VEC") DX) 2)))
         (COPY-SCALE-RGBA-ARRAY-TO-FROM VALS NEW-VALS NEW-COUNTS SIZE)))))

[snek/src/sandpaint-extra.lisp:120]
  (DEFUN RND-COPY-RECT (SAND N SX SY &KEY FROM TO)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0)))
    (-DO-OP (SAND SIZE VALS INDFX :NAME NIL)
     (LET ((ANGLE (#S(FORMGREP:SYMREF :NAME "RND*" :QUALIFIER "RND") PI)))
       (#S(FORMGREP:SYMREF :NAME "WITH-IN-BOX" :QUALIFIER "RND") (N SX SY PXY)
        (-INSIDE-FLOOR
         (SIZE
          (#S(FORMGREP:SYMREF :NAME "ADD" :QUALIFIER "VEC") TO
           (#S(FORMGREP:SYMREF :NAME "ROT" :QUALIFIER "VEC") PXY ANGLE))
          AX AY)
         (-INSIDE-FLOOR
          (SIZE (#S(FORMGREP:SYMREF :NAME "ADD" :QUALIFIER "VEC") FROM PXY) BX
           BY)
          (LET ((PA (FUNCALL INDFX AX AY 0)) (PB (FUNCALL INDFX BX BY 0)))
            (-SWAP VALS PA PB))))))))

[snek/src/sandpaint-flip-reflect.lisp:7]
  (DEFUN -SWAP (VALS I J)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT) VALS))
    (LET ((RI (AREF VALS I))
          (BI (AREF VALS (1+ I)))
          (GI (AREF VALS (+ I 2)))
          (AI (AREF VALS (+ I 3))))
      (DECLARE (DOUBLE-FLOAT RI BI GI AI))
      (SETF (AREF VALS I) (AREF VALS J)
            (AREF VALS (1+ I)) (AREF VALS (1+ J))
            (AREF VALS (+ I 2)) (AREF VALS (+ J 2))
            (AREF VALS (+ I 3)) (AREF VALS (+ J 3))
            (AREF VALS J) RI
            (AREF VALS (1+ J)) BI
            (AREF VALS (+ J 2)) GI
            (AREF VALS (+ J 3)) AI)))

[snek/src/sandpaint-flip-reflect.lisp:25]
  (DEFUN REFLECT-Y (SAND &KEY (ALPHA 1.0d0) (ALIGN T))
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0)))
    (-DO-OP (SAND SIZE VALS INDFX :NAME "reflect-y")
     (LET* ((PA
             (LIST
              (#S(FORMGREP:SYMREF :NAME "VEC" :QUALIFIER "VEC") 0.0d0
               (#S(FORMGREP:SYMREF :NAME "DFLOAT" :QUALIFIER "MATH") SIZE))
              #S(FORMGREP:SYMREF :NAME "*ZERO*" :QUALIFIER "VEC")))
            (PB
             (LIST
              (#S(FORMGREP:SYMREF :NAME "VEC" :QUALIFIER "VEC")
               (#S(FORMGREP:SYMREF :NAME "DFLOAT" :QUALIFIER "MATH") SIZE))
              (#S(FORMGREP:SYMREF :NAME "VEC" :QUALIFIER "VEC")
               (#S(FORMGREP:SYMREF :NAME "DFLOAT" :QUALIFIER "MATH") SIZE)
               0.0d0))))
       (LOOP WITH LS = (#S(FORMGREP:SYMREF :NAME "LINSPACE" :QUALIFIER "MATH")
                        SIZE 0.0d0 1.0d0 :END (NOT ALIGN))
             FOR I IN LS
             AND II FROM 0
             DO (LOOP WITH LINE = (LIST
                                   (#S(FORMGREP:SYMREF
                                       :NAME "ON-LINE*"
                                       :QUALIFIER "VEC")
                                    I PA)
                                   (#S(FORMGREP:SYMREF
                                       :NAME "ON-LINE*"
                                       :QUALIFIER "VEC")
                                    I PB))
                      FOR J IN LS
                      AND JJ FROM 0
                      DO (-PIX-OVERLAP INDFX VALS SIZE
                          (#S(FORMGREP:SYMREF
                              :NAME "ON-LINE*"
                              :QUALIFIER "VEC")
                           J LINE)
                          (-RGB-FROM VALS (FUNCALL INDFX JJ II 0) ALPHA)))))))

[snek/src/sandpaint-flip-reflect.lisp:39]
  (DEFUN REFLECT-X (SAND &KEY (ALPHA 1.0d0) (ALIGN T))
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0)))
    (-DO-OP (SAND SIZE VALS INDFX :NAME "reflect-x")
     (LET* ((PA
             (LIST #S(FORMGREP:SYMREF :NAME "*ZERO*" :QUALIFIER "VEC")
                   (#S(FORMGREP:SYMREF :NAME "VEC" :QUALIFIER "VEC")
                    (#S(FORMGREP:SYMREF :NAME "DFLOAT" :QUALIFIER "MATH") SIZE)
                    0.0d0)))
            (PB
             (LIST
              (#S(FORMGREP:SYMREF :NAME "VEC" :QUALIFIER "VEC") 0.0d0
               (#S(FORMGREP:SYMREF :NAME "DFLOAT" :QUALIFIER "MATH") SIZE))
              (#S(FORMGREP:SYMREF :NAME "VEC" :QUALIFIER "VEC")
               (#S(FORMGREP:SYMREF :NAME "DFLOAT" :QUALIFIER "MATH") SIZE)))))
       (LOOP WITH LS = (#S(FORMGREP:SYMREF :NAME "LINSPACE" :QUALIFIER "MATH")
                        SIZE 0.0d0 1.0d0 :END (NOT ALIGN))
             FOR I IN LS
             AND II FROM 0
             DO (LOOP WITH LINE = (LIST
                                   (#S(FORMGREP:SYMREF
                                       :NAME "ON-LINE*"
                                       :QUALIFIER "VEC")
                                    I PA)
                                   (#S(FORMGREP:SYMREF
                                       :NAME "ON-LINE*"
                                       :QUALIFIER "VEC")
                                    I PB))
                      FOR J IN LS
                      AND JJ FROM 0
                      DO (-PIX-OVERLAP INDFX VALS SIZE
                          (#S(FORMGREP:SYMREF
                              :NAME "ON-LINE*"
                              :QUALIFIER "VEC")
                           J LINE)
                          (-RGB-FROM VALS (FUNCALL INDFX (- SIZE II 1) JJ 0)
                           ALPHA)))))))

[snek/src/sandpaint-flip-reflect.lisp:53]
  (DEFUN FLIP-X (SAND)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0)))
    (-DO-OP (SAND SIZE VALS INDFX :NAME "flip-x")
     (LOOP FOR I FROM 0 BELOW SIZE
           DO (LOOP FOR J FROM 0 TO (/ SIZE 2)
                    DO (-SWAP VALS (FUNCALL INDFX J I)
                        (FUNCALL INDFX (- SIZE J 1) I))))))

[snek/src/sandpaint-flip-reflect.lisp:61]
  (DEFUN FLIP-Y (SAND)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0)))
    (-DO-OP (SAND SIZE VALS INDFX :NAME "flip-y")
     (LOOP FOR I FROM 0 BELOW SIZE
           DO (LOOP FOR J FROM 0 TO (/ SIZE 2)
                    DO (-SWAP VALS (FUNCALL INDFX I J)
                        (FUNCALL INDFX I (- SIZE J 1)))))))

[snek/src/sandpaint-flip-reflect.lisp:76]
  (DEFUN ROT (SAND DIR)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0)))
    (-DO-OP (SAND SIZE VALS INDFX :NAME "rot")
     (LET ((NEW-VALS (MAKE-RGBA-ARRAY SIZE :INIT 0.0d0)))
       (CASE DIR
         (:CW
          (-SQUARE-LOOP (I J SIZE)
           (-ROT VALS NEW-VALS (FUNCALL INDFX I J)
            (FUNCALL INDFX (- SIZE J 1) I))))
         (:CCW
          (-SQUARE-LOOP (I J SIZE)
           (-ROT VALS NEW-VALS (FUNCALL INDFX I J)
            (FUNCALL INDFX J (- SIZE I 1)))))
         (:TWICE
          (-SQUARE-LOOP (I J SIZE)
           (-ROT VALS NEW-VALS (FUNCALL INDFX I J)
            (FUNCALL INDFX (- SIZE I 1) (- SIZE J 1)))))
         (OTHERWISE (ERROR "use :cw :ccw or :twice")))
       (COPY-RGBA-ARRAY-TO-FROM VALS NEW-VALS SIZE))))

[snek/src/sandpaint.lisp:64]
  (DEFUN GET-IND-FX (SIZE)
    (DECLARE (FIXNUM SIZE))
    (LAMBDA (X Y &OPTIONAL (C 0))
      (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
               (FIXNUM X Y C))
      (+ C (THE FIXNUM (* 4 (THE FIXNUM (+ X (THE FIXNUM (* SIZE Y)))))))))

[snek/src/sandpaint.lisp:86]
  (DEFUN -RGB-FROM (VALS IND &OPTIONAL (A 1.0d0))
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (FIXNUM IND)
             (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT (*)) VALS))
    (#S(FORMGREP:SYMREF :NAME "RGB" :QUALIFIER "PIGMENT") (AREF VALS IND)
     (AREF VALS (1+ IND)) (AREF VALS (+ IND 2)) A))

[snek/src/sandpaint.lisp:111]
  (DEFUN -OPERATOR-OVER (INDFX VALS X Y FG)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (FUNCTION INDFX)
             (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT (*)) VALS)
             (FIXNUM X Y)
             (#S(FORMGREP:SYMREF :NAME "RGBA" :QUALIFIER "PIGMENT") FG))
    (#S(FORMGREP:SYMREF :NAME "WITH" :QUALIFIER "PIGMENT") (FG R G B A)
     (LET ((IND (FUNCALL INDFX X Y)) (IA (- 1.0d0 A)))
       (DECLARE (FIXNUM IND)
                (DOUBLE-FLOAT IA))
       (SETF (AREF VALS IND)
               (THE DOUBLE-FLOAT
                    (+
                     (THE DOUBLE-FLOAT
                          (* (THE DOUBLE-FLOAT (AREF VALS IND)) IA))
                     R))
             (AREF VALS (+ IND 1))
               (THE DOUBLE-FLOAT
                    (+
                     (THE DOUBLE-FLOAT
                          (* (THE DOUBLE-FLOAT (AREF VALS (+ IND 1))) IA))
                     G))
             (AREF VALS (+ IND 2))
               (THE DOUBLE-FLOAT
                    (+
                     (THE DOUBLE-FLOAT
                          (* (THE DOUBLE-FLOAT (AREF VALS (+ IND 2))) IA))
                     B))
             (AREF VALS (+ IND 3))
               (THE DOUBLE-FLOAT
                    (+
                     (THE DOUBLE-FLOAT
                          (* (THE DOUBLE-FLOAT (AREF VALS (+ IND 3))) IA))
                     A))))))

[snek/src/sandpaint.lisp:171]
  (DEFUN |-U8| (V)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (DOUBLE-FLOAT V))
    (COND ((> V 1.0d0) 255) ((< V 0.0d0) 0) (T (FLOOR (THE FLOAT (* 255 V))))))

[snek/src/sandpaint.lisp:178]
  (DEFUN -UI8 (V)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (FIXNUM V))
    (COND ((>= V 255) 1.0d0) ((< V 0) 0.0d0)
          (T
           (/ (#S(FORMGREP:SYMREF :NAME "DFLOAT" :QUALIFIER "MATH") V)
              255.0d0))))

[snek/src/sandpaint.lisp:186]
  (DEFUN |-U16| (V)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (DOUBLE-FLOAT V))
    (COND ((> V 1.0d0) 65535) ((< V 0.0d0) 0)
          (T (FLOOR (THE FLOAT (* 65535.0d0 V))))))

[snek/src/sandpaint.lisp:269]
  (DEFUN -FLOOR-FRACT (PT)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (#S(FORMGREP:SYMREF :NAME "VEC" :QUALIFIER "VEC") PT))
    (#S(FORMGREP:SYMREF :NAME "WITH-XY" :QUALIFIER "VEC") (PT X Y)
     (MULTIPLE-VALUE-BIND (IX FX)
         (FLOOR X)
       (DECLARE (FIXNUM IX)
                (DOUBLE-FLOAT FX))
       (MULTIPLE-VALUE-BIND (IY FY)
           (FLOOR Y)
         (DECLARE (FIXNUM IY)
                  (DOUBLE-FLOAT FY))
         (VALUES IX IY FX FY)))))

[snek/src/sandpaint.lisp:282]
  (DEFUN -FRACT-OVERLAP (X Y)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (DOUBLE-FLOAT X Y))
    (LET ((X2 (- 1 X)) (Y2 (- 1 Y)))
      (DECLARE (DOUBLE-FLOAT X2 Y2))
      (VALUES (* X2 Y2) (* X Y2) (* X2 Y) (* X Y))))

[snek/src/sandpaint.lisp:292]
  (DEFUN -PIX-OVERLAP (INDFX VALS SIZE PT FG)
    (DECLARE (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT) VALS)
             (FIXNUM SIZE)
             (FUNCTION INDFX)
             (#S(FORMGREP:SYMREF :NAME "VEC" :QUALIFIER "VEC") PT)
             (#S(FORMGREP:SYMREF :NAME "RGBA" :QUALIFIER "PIGMENT") FG))
    (#S(FORMGREP:SYMREF :NAME "WITH" :QUALIFIER "PIGMENT") (FG R G B A)
     (LABELS ((-OPERATOR-OVER-OVERLAP (IX IY S)
                (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
                         (FIXNUM IX IY)
                         (DOUBLE-FLOAT S))
                (WHEN (AND (< -1 IX SIZE) (< -1 IY SIZE))
                  (-OPERATOR-OVER INDFX VALS IX IY
                   (#S(FORMGREP:SYMREF :NAME "-MAKE-RGBA" :QUALIFIER "PIGMENT")
                    :R (* S R) :G (* S G) :B (* S B) :A (* S A))))))
       (MULTIPLE-VALUE-BIND (IX IY FX FY)
           (-FLOOR-FRACT PT)
         (MULTIPLE-VALUE-BIND (S1 S2 S3 S4)
             (-FRACT-OVERLAP FX FY)
           (DECLARE (DOUBLE-FLOAT S1 S2 S3 S4))
           (-OPERATOR-OVER-OVERLAP IX IY S1)
           (-OPERATOR-OVER-OVERLAP (+ IX 1) IY S2)
           (-OPERATOR-OVER-OVERLAP IX (+ IY 1) S3)
           (-OPERATOR-OVER-OVERLAP (+ IX 1) (+ IY 1) S4))))))

[snek/src/snek-extra.lisp:16]
  (DEFUN -DST2 (VERTS U V)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT) VERTS)
             (FIXNUM U V))
    (+
     (EXPT
      (- (THE DOUBLE-FLOAT (AREF VERTS (* 2 U)))
         (THE DOUBLE-FLOAT (AREF VERTS (* 2 V))))
      2.0d0)
     (EXPT
      (- (THE DOUBLE-FLOAT (AREF VERTS (1+ (* 2 U))))
         (THE DOUBLE-FLOAT (AREF VERTS (1+ (* 2 V)))))
      2.0d0)))

[snek/src/snek-extra.lisp:77]
  (DEFUN -IS-REL-NEIGH (VERTS U V NEAR)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT) VERTS)
             (FIXNUM U V)
             (VECTOR NEAR))
    (LOOP WITH D OF-TYPE DOUBLE-FLOAT = (-DST2 VERTS U V)
          FOR W OF-TYPE FIXNUM ACROSS NEAR
          IF (NOT
              (>
               (THE DOUBLE-FLOAT
                    (MAX (THE DOUBLE-FLOAT (-DST2 VERTS U W))
                         (THE DOUBLE-FLOAT (-DST2 VERTS V W))))
               D))
          SUMMING 1 INTO C OF-TYPE FIXNUM
          IF (> C 1)
          DO (RETURN-FROM -IS-REL-NEIGH NIL))
    T)

[snek/src/snek-extra.lisp:92]
  (DEFUN RELATIVE-NEIGHBORHOOD! (SNK RAD &KEY G)
    "
  find the relative neigborhood graph (limited by the radius rad) of verts in
  snk. the graph is made in grp g.
  "
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (SNEK SNK)
             (DOUBLE-FLOAT RAD))
    (LET ((C 0) (TESTED (MAKE-HASH-TABLE :TEST #'EQUAL)))
      (DECLARE (FIXNUM C))
      (ZWITH (SNK (MAX 5.0d0 RAD))
       (ITR-VERTS (SNK V :COLLECT NIL)
        (LOOP WITH VERTS OF-TYPE (SIMPLE-ARRAY DOUBLE-FLOAT) = (SNEK-VERTS SNK)
              WITH NEAR OF-TYPE VECTOR = (REMOVE-IF (LAMBDA (X) (= X V))
                                                    (VERTS-IN-RAD SNK
                                                     (GET-VERT SNK V) RAD))
              FOR U OF-TYPE FIXNUM ACROSS NEAR
              IF (< U V)
              DO (LET ((KEY (LIST U V)))
                   (IF (AND (NOT (GETHASH KEY TESTED))
                            (-IS-REL-NEIGH VERTS U V NEAR))
                       (WHEN (LADD-EDGE! SNK KEY :G G) (INCF C))
                       (SETF (GETHASH KEY TESTED) T))))))
      C))

[snek/src/vec.lisp:84]
  (DEFUN VEC (X &OPTIONAL Y)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (DOUBLE-FLOAT X))
    (IF Y
        (-MAKE-VEC :X X :Y Y)
        (-MAKE-VEC :X X :Y X)))

[snek/src/vec.lisp:133]
  (DEFUN -VROUND* (V)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (VEC V))
    (VALUES (ROUND (VEC-X V)) (ROUND (VEC-Y V))))

[snek/src/vec.lisp:139]
  (DEFUN -VFLOOR* (V)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (VEC V))
    (VALUES (FLOOR (VEC-X V)) (FLOOR (VEC-Y V))))

[snek/src/vec.lisp:152]
  (DEFUN VEC* (XY)
    "
  create (coerce) vec from list
  "
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (LIST XY))
    (DESTRUCTURING-BIND
        (X Y)
        (#S(FORMGREP:SYMREF :NAME "DFLOAT*" :QUALIFIER "MATH") XY)
      (DECLARE (DOUBLE-FLOAT X Y))
      (VEC X Y)))

[snek/src/vec.lisp:163]
  (DEFUN SARR-GET (A I &AUX (II (* 2 I)))
    "
  returns simple array (as 2d array) ind i.
  "
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (FIXNUM I II)
             (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT) A))
    (VEC (AREF A II) (AREF A (1+ II))))

[snek/src/vec.lisp:172]
  (DEFUN SARR-SET (A I V &AUX (II (* 2 I)))
    "
  set simple array (as 2d array) in i to vec v.
  returns v.
  "
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (VEC V)
             (FIXNUM I II)
             (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT) A))
    (SETF (AREF A II) (THE DOUBLE-FLOAT (VEC-X V))
          (AREF A (1+ II)) (THE DOUBLE-FLOAT (VEC-Y V)))
    V)

[snek/src/vec.lisp:188]
  (DEFUN COS-SIN (A)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (DOUBLE-FLOAT A))
    (VEC (COS A) (SIN A)))

[snek/src/vec.lisp:193]
  (DEFUN SIN-COS (A)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (DOUBLE-FLOAT A))
    (VEC (SIN A) (COS A)))

[snek/src/vec.lisp:198]
  (DEFUN ANGLE (V)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (VEC V))
    (WITH-XY ((NORM V) X Y) (ATAN Y X)))

[snek/src/vec.lisp:204]
  (DEFUN FROM (A B S)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (DOUBLE-FLOAT S)
             (VEC A B))
    (VEC (+ (VEC-X A) (* S (VEC-X B))) (+ (VEC-Y A) (* S (VEC-Y B)))))

[snek/src/vec.lisp:211]
  (DEFUN SCALE (A S)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (VEC A)
             (DOUBLE-FLOAT S))
    (VEC (* (VEC-X A) S) (* (VEC-Y A) S)))

[snek/src/vec.lisp:216]
  (DEFUN NEG (A)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (VEC A))
    (SCALE A -1.0d0))

[snek/src/vec.lisp:221]
  (DEFUN ISCALE (A S)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (VEC A)
             (DOUBLE-FLOAT S))
    (VEC (/ (VEC-X A) S) (/ (VEC-Y A) S)))

[snek/src/vec.lisp:227]
  (DEFUN SUB (A B)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (VEC A B))
    (VEC (- (VEC-X A) (VEC-X B)) (- (VEC-Y A) (VEC-Y B))))

[snek/src/vec.lisp:232]
  (DEFUN LSUB (AA BB)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (LIST AA BB))
    (MAPCAR (LAMBDA (A B) (DECLARE (TYPE VEC A B)) (SUB A B)) AA BB))

[snek/src/vec.lisp:237]
  (DEFUN LSUB* (AA B)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (LIST AA)
             (VEC B))
    (MAPCAR (LAMBDA (A) (DECLARE (TYPE VEC A)) (SUB A B)) AA))

[snek/src/vec.lisp:242]
  (DEFUN ISUB (A B)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (VEC A B))
    (VEC (- (VEC-X B) (VEC-X A)) (- (VEC-Y B) (VEC-Y A))))

[snek/src/vec.lisp:247]
  (DEFUN OP (FX A B)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (VEC A B))
    (VEC (FUNCALL FX (VEC-X A) (VEC-X B)) (FUNCALL FX (VEC-Y A) (VEC-Y B))))

[snek/src/vec.lisp:253]
  (DEFUN VABS (A)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (VEC A))
    (VEC (ABS (VEC-X A)) (ABS (VEC-Y A))))

[snek/src/vec.lisp:258]
  (DEFUN ADD (A B)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (VEC A B))
    (VEC (+ (VEC-X A) (VEC-X B)) (+ (VEC-Y A) (VEC-Y B))))

[snek/src/vec.lisp:263]
  (DEFUN LADD (AA BB)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (LIST AA BB))
    (MAPCAR (LAMBDA (A B) (DECLARE (TYPE VEC A B)) (ADD A B)) AA BB))

[snek/src/vec.lisp:268]
  (DEFUN LADD* (AA B)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (LIST AA)
             (VEC B))
    (MAPCAR (LAMBDA (A) (DECLARE (TYPE VEC A)) (ADD A B)) AA))

[snek/src/vec.lisp:273]
  (DEFUN LSCALE* (AA S)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (LIST AA)
             (DOUBLE-FLOAT S))
    (MAPCAR (LAMBDA (A) (DECLARE (TYPE VEC A)) (SCALE A S)) AA))

[snek/src/vec.lisp:278]
  (DEFUN MULT (A B)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (VEC A B))
    (VEC (* (VEC-X A) (VEC-X B)) (* (VEC-Y A) (VEC-Y B))))

[snek/src/vec.lisp:283]
  (DEFUN LMULT (AA BB)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (LIST AA BB))
    (MAPCAR (LAMBDA (A B) (DECLARE (TYPE VEC A B)) (MULT A B)) AA BB))

[snek/src/vec.lisp:288]
  (DEFUN LMULT* (AA B)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (LIST AA)
             (VEC B))
    (MAPCAR (LAMBDA (A) (DECLARE (TYPE VEC A)) (MULT A B)) AA))

[snek/src/vec.lisp:293]
  (DEFUN DOT (A B)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (VEC A B))
    (+ (* (VEC-X A) (VEC-X B)) (* (VEC-Y A) (VEC-Y B))))

[snek/src/vec.lisp:298]
  (DEFUN LDOT (AA BB)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (LIST AA BB))
    (MAPCAR (LAMBDA (A B) (DECLARE (TYPE VEC A B)) (DOT A B)) AA BB))

[snek/src/vec.lisp:303]
  (DEFUN DIV (A B)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (VEC A B))
    (VEC (/ (VEC-X A) (VEC-X B)) (/ (VEC-Y A) (VEC-Y B))))

[snek/src/vec.lisp:308]
  (DEFUN LDIV (AA BB)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (LIST AA BB))
    (MAPCAR (LAMBDA (A B) (DECLARE (TYPE VEC A B)) (DIV A B)) AA BB))

[snek/src/vec.lisp:313]
  (DEFUN LDIV* (AA B)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (LIST AA)
             (VEC B))
    (MAPCAR (LAMBDA (A) (DECLARE (TYPE VEC A)) (DIV A B)) AA))

[snek/src/vec.lisp:318]
  (DEFUN IDIV (A B)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (VEC A B))
    (VEC (/ (VEC-X B) (VEC-X A)) (/ (VEC-Y B) (VEC-Y A))))

[snek/src/vec.lisp:323]
  (DEFUN LEN2 (A)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (VEC A))
    (+ (EXPT (VEC-X A) 2) (EXPT (VEC-Y A) 2)))

[snek/src/vec.lisp:327]
  (DEFUN LEN (A)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (VEC A))
    (SQRT (LEN2 A)))

[snek/src/vec.lisp:332]
  (DEFUN MID (A B)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (VEC A B))
    (ISCALE (ADD A B) 2.0d0))

[snek/src/vec.lisp:337]
  (DEFUN LMID (AA)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (LIST AA))
    (LET ((N 1))
      (ISCALE
       (REDUCE (LAMBDA (A B) (DECLARE (TYPE VEC A B)) (INCF N) (ADD A B)) AA)
       (#S(FORMGREP:SYMREF :NAME "DFLOAT" :QUALIFIER "MATH") N))))

[snek/src/vec.lisp:345]
  (DEFUN DST2 (A B)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (VEC A B))
    (+ (EXPT (- (VEC-X A) (VEC-X B)) 2.0d0)
       (EXPT (- (VEC-Y A) (VEC-Y B)) 2.0d0)))

[snek/src/vec.lisp:349]
  (DEFUN DST (A B)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (VEC A B))
    (SQRT (DST2 A B)))

[snek/src/vec.lisp:354]
  (DEFUN DST* (AA)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (LIST AA))
    (DST (FIRST AA) (SECOND AA)))

[snek/src/vec.lisp:359]
  (DEFUN LDST (A B)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (LIST A B))
    (MAPCAR #'DST A B))

[snek/src/vec.lisp:364]
  (DEFUN LDST* (AA B)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (LIST AA)
             (VEC B))
    (LOOP FOR A OF-TYPE VEC IN AA
          COLLECT (DST A B)))

[snek/src/vec.lisp:369]
  (DEFUN NORM (A &KEY (S 1.0d0) (DEFAULT *ZERO*))
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (VEC A)
             (DOUBLE-FLOAT S))
    (LET ((L (LEN A)))
      (IF (> L 0.0d0)
          (SCALE A (/ S L))
          DEFAULT)))

[snek/src/vec.lisp:380]
  (DEFUN SUM (AA)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (LIST AA))
    (REDUCE (LAMBDA (A B) (DECLARE (VEC A B)) (ADD A B)) AA))

[snek/src/vec.lisp:518]
  (DEFUN ON-LINE (P A B)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (DOUBLE-FLOAT P)
             (VEC A B))
    (VEC (+ (VEC-X A) (* P (- (VEC-X B) (VEC-X A))))
     (+ (VEC-Y A) (* P (- (VEC-Y B) (VEC-Y A))))))

[snek/src/zonemap.lisp:48]
  (DEFUN MAKE (VERTS NUM-VERTS ZWIDTH)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (DOUBLE-FLOAT ZWIDTH)
             (FIXNUM NUM-VERTS)
             (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT) VERTS))
    (LET ((ZONE-TO-VERTS (MAKE-HASH-TABLE :TEST #'EQUAL)))
      (LOOP FOR V OF-TYPE FIXNUM FROM 0 BELOW NUM-VERTS
            DO (LET ((Z
                      (LIST (FLOOR (AREF VERTS (* 2 V)) ZWIDTH)
                            (FLOOR (AREF VERTS (1+ (* 2 V))) ZWIDTH))))
                 (DECLARE (LIST Z))
                 (MULTIPLE-VALUE-BIND (VALS EXISTS)
                     (GETHASH Z ZONE-TO-VERTS)
                   (WHEN (NOT EXISTS)
                     (SETF VALS (MAKE-ADJUSTABLE-VECTOR :TYPE 'FIXNUM)
                           (GETHASH Z ZONE-TO-VERTS) VALS))
                   (VEXTEND V VALS))))
      (-MAKE-ZMAP :ZWIDTH ZWIDTH :NUM-VERTS NUM-VERTS :ZONE-TO-VERTS
       ZONE-TO-VERTS)))

[snek/src/zonemap.lisp:96]
  (DEFUN VERTS-IN-RAD (ZM VERTS XY RAD)
    (DECLARE (OPTIMIZE (SAFETY 0) SPEED (DEBUG 0))
             (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT) VERTS)
             (ZMAP ZM)
             (#S(FORMGREP:SYMREF :NAME "VEC" :QUALIFIER "VEC") XY)
             (DOUBLE-FLOAT RAD))
    (LET ((INDS (MAKE-ADJUSTABLE-VECTOR :TYPE 'FIXNUM)))
      (DECLARE (VECTOR INDS))
      (WITH-VERTS-IN-RAD (ZM VERTS XY RAD V) (VEXTEND V INDS))
      INDS))

[specialized-function/demo.lisp:7]
  (DEFUN DOT-ORIGINAL (A B C)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (LOOP FOR AI ACROSS A
          FOR BI ACROSS B
          FOR I FIXNUM FROM 0
          DO (INCF C (* AI BI)))
    C)

[specialized-function/demo.lisp:17]
  (DEFUN DOT-SPECIALIZED (A B C)
    (SPECIALIZING (A B C) (:VERBOSE T)
     (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
     (LOOP FOR AI ACROSS A
           FOR BI ACROSS B
           FOR I FIXNUM FROM 0
           DO (INCF C (* AI BI)))
     C))

[specialized-function/demo.lisp:28]
  (DEFUN DOT-HANDTUNED (A B C)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0))
             ((SIMPLE-ARRAY SINGLE-FLOAT 1) A B)
             (SINGLE-FLOAT C))
    (LOOP FOR AI ACROSS A
          FOR BI ACROSS B
          FOR I FIXNUM FROM 0
          DO (INCF C (* AI BI)))
    C)

[specialized-function/example.lisp:70]
  (DEFUN DOT-ORIGINAL (A B C)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (LOOP FOR AI ACROSS A
          FOR BI ACROSS B
          FOR I FIXNUM FROM 0
          DO (INCF C (* AI BI)))
    C)

[specialized-function/example.lisp:79]
  (DEFUN DOT-SPECIALIZED (A B C)
    (SPECIALIZING (A B C) (:VERBOSE T)
     (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
     (LOOP FOR AI ACROSS A
           FOR BI ACROSS B
           FOR I FIXNUM FROM 0
           DO (INCF C (* AI BI)))
     C))

[specialized-function/example.lisp:90]
  (DEFUN DOT-HANDTUNED (A B C)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0))
             ((SIMPLE-ARRAY SINGLE-FLOAT 1) A B)
             (SINGLE-FLOAT C))
    (LOOP FOR AI ACROSS A
          FOR BI ACROSS B
          FOR I FIXNUM FROM 0
          DO (INCF C (* AI BI)))
    C)

[specialized-function/src/1common.lisp:331]
  (DEFMACRO SPECIALIZING
            (ARGS (&KEY VERBOSE TIME) &BODY DECL-AND-BODY &ENVIRONMENT ENV)
    (ASSERT (EVERY #'SYMBOLP ARGS))
    (ASSERT (TYPEP VERBOSE 'BOOLEAN))
    (WITH-GENSYMS (TABLE)
     (LET* ((LEXVARS (SET-DIFFERENCE (FIND-LEXICAL-VARIABLES ENV) ARGS))
            (LEXVARS-TYPES
             (MAPCAR
              (LAMBDA (VAR)
                (ASSOC 'TYPE
                       (NTH-VALUE 2 (SB-CLTL2:VARIABLE-INFORMATION VAR ENV))))
              LEXVARS))
            (WIDETAGS (MAKE-GENSYM-LIST (LENGTH ARGS))))
       (ECLECTOR.READER:QUASIQUOTE
        (LET (((ECLECTOR.READER:UNQUOTE TABLE)
               (LOAD-TIME-VALUE
                (TABLE (ECLECTOR.READER:UNQUOTE +TABLE-SIZE+))))
              (ECLECTOR.READER:UNQUOTE-SPLICING
               (MAPCAR
                (LAMBDA (VAR ARG)
                  (ECLECTOR.READER:QUASIQUOTE
                   ((ECLECTOR.READER:UNQUOTE VAR)
                    (WIDETAG (ECLECTOR.READER:UNQUOTE ARG)))))
                WIDETAGS ARGS)))
          (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
          (ECLECTOR.READER:UNQUOTE-SPLICING
           (ITER (FOR (V . REST) ON WIDETAGS)
            (FOR COMPILE-AND-SET =
             (ECLECTOR.READER:QUASIQUOTE
              (SETF (SYMBOL-FUNCTION 'LAST-SPECIALIZED-FUNCTION)
                      (COMPILE NIL
                               (SPECIALIZED-FUNCTION-FORM
                                '(ECLECTOR.READER:UNQUOTE ARGS)
                                '(ECLECTOR.READER:UNQUOTE LEXVARS)
                                '(ECLECTOR.READER:UNQUOTE LEXVARS-TYPES)
                                '(ECLECTOR.READER:UNQUOTE DECL-AND-BODY)
                                (LIST
                                 (ECLECTOR.READER:UNQUOTE-SPLICING ARGS)))))))
            (FOR DEFAULT =
             (COND
              (REST
               (ECLECTOR.READER:QUASIQUOTE
                (TABLE (ECLECTOR.READER:UNQUOTE +TABLE-SIZE+))))
              (VERBOSE
               (ECLECTOR.READER:QUASIQUOTE
                (LOCALLY
                 (DECLARE (OPTIMIZE (DEBUG 1) (SPEED 1) (SAFETY 1)))
                 (FORMAT T "~&~<; ~@;Specializing ~a to ~{~a~^ ~}~:>"
                         (LIST '(ECLECTOR.READER:UNQUOTE ARGS)
                               (MAPCAR #'UPGRADED-OBJECT-TYPE
                                       (LIST
                                        (ECLECTOR.READER:UNQUOTE-SPLICING
                                         ARGS)))))
                 (ECLECTOR.READER:UNQUOTE COMPILE-AND-SET))))
              (T COMPILE-AND-SET)))
            (COLLECTING
             (ECLECTOR.READER:QUASIQUOTE
              (SETF (ECLECTOR.READER:UNQUOTE TABLE)
                      (OR
                       (AREF
                        (THE (TABLE (ECLECTOR.READER:UNQUOTE +TABLE-SIZE+))
                             (ECLECTOR.READER:UNQUOTE TABLE))
                        (ECLECTOR.READER:UNQUOTE V))
                       (SETF (AREF
                              (THE
                               (TABLE (ECLECTOR.READER:UNQUOTE +TABLE-SIZE+))
                               (ECLECTOR.READER:UNQUOTE TABLE))
                              (ECLECTOR.READER:UNQUOTE V))
                               (ECLECTOR.READER:UNQUOTE DEFAULT))))))))
          ((ECLECTOR.READER:UNQUOTE
            (IF TIME
                'TIME
                'PROGN))
           (FUNCALL
            (THE
             (FUNCTION
              (ECLECTOR.READER:UNQUOTE
               (MAPCAR (CONSTANTLY T) (APPEND ARGS LEXVARS)))
              *)
             (ECLECTOR.READER:UNQUOTE TABLE))
            (ECLECTOR.READER:UNQUOTE-SPLICING ARGS)
            (ECLECTOR.READER:UNQUOTE-SPLICING LEXVARS))))))))

[spinneret/functions.lisp:76]
  (SERAPEUM:LOCAL*
    (DECLAIM (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0) (COMPILATION-SPEED 0)))
    (DECLAIM (INLINE CLOSE-INLINE CLOSE-BLOCK))
    (DEFUN OPEN-BLOCK (HTML PRETTY OPEN ATTRS)
      (WHEN PRETTY (FRESH-LINE HTML))
      (WRITE-STRING OPEN HTML)
      (WHEN ATTRS
        (IF PRETTY
            (FORMAT-ATTRIBUTES-PRETTY/BLOCK ATTRS HTML)
            (FORMAT-ATTRIBUTES-PLAIN ATTRS HTML)))
      (WRITE-CHAR #\> HTML))
    (DEFUN OPEN-PAR (HTML PRETTY OPEN ATTRS)
      (OPEN-BLOCK HTML PRETTY OPEN ATTRS))
    (DEFUN OPEN-INLINE (HTML PRETTY OPEN OFFSET ATTRS)
      (WHEN PRETTY (MAYBE-WRAP OFFSET HTML))
      (WRITE-STRING OPEN HTML)
      (WHEN ATTRS
        (IF PRETTY
            (FORMAT-ATTRIBUTES-PRETTY/INLINE ATTRS HTML)
            (FORMAT-ATTRIBUTES-PLAIN ATTRS HTML)))
      (WRITE-CHAR #\> HTML))
    (DEFUN BLOCK-BODY (HTML BODY PRETTY)
      (DECLARE (TYPE FUNCTION BODY))
      (WHEN PRETTY (ELASTIC-NEWLINE HTML))
      (LET ((*INDENT* (1+ *DEPTH*)))
        (WITHOUT-TRAILING-SPACE (FUNCALL BODY)))
      (WHEN (AND PRETTY (NOT *PRE*)) (TERPRI HTML)))
    (DEFUN INLINE-BODY (BODY)
      (DECLARE (TYPE FUNCTION BODY))
      (LET ((*INDENT* (1+ *DEPTH*)))
        (WITHOUT-TRAILING-SPACE (FUNCALL BODY)))
      (VALUES))
    (DEFUN PAR-BODY (BODY) (INLINE-BODY BODY))
    (DEFUN CLOSE-INLINE (HTML CLOSE NEEDS-CLOSE?)
      (WHEN NEEDS-CLOSE? (WRITE-STRING CLOSE HTML)))
    (DEFUN CLOSE-BLOCK (HTML CLOSE NEEDS-CLOSE?)
      (WHEN NEEDS-CLOSE? (WRITE-STRING CLOSE HTML)))
    (DEFUN CLOSE-PAR (HTML CLOSE NEEDS-CLOSE?)
      (WHEN NEEDS-CLOSE? (WRITE-STRING CLOSE HTML))
      (ELASTIC-NEWLINE HTML))
    (DEFUN PRINT-INLINE-TAG
           (HTML PRETTY STYLE OPEN OFFSET ATTRS EMPTY? BODY CLOSE NEEDS-CLOSE?)
      (WHEN (EQL STYLE :TREE)
        (RETURN-FROM PRINT-INLINE-TAG
          (PRINT-BLOCK-TAG HTML PRETTY STYLE OPEN ATTRS EMPTY? BODY CLOSE T)))
      (OPEN-INLINE HTML PRETTY OPEN OFFSET ATTRS)
      (UNLESS EMPTY? (INLINE-BODY BODY))
      (CLOSE-INLINE HTML CLOSE NEEDS-CLOSE?))
    (DEFUN PRINT-PAR-TAG
           (HTML PRETTY STYLE OPEN ATTRS EMPTY? BODY CLOSE NEEDS-CLOSE?)
      (WHEN (EQL STYLE :TREE)
        (RETURN-FROM PRINT-PAR-TAG
          (PRINT-BLOCK-TAG HTML PRETTY STYLE OPEN ATTRS EMPTY? BODY CLOSE T)))
      (OPEN-PAR HTML PRETTY OPEN ATTRS)
      (UNLESS EMPTY? (PAR-BODY BODY))
      (CLOSE-PAR HTML CLOSE NEEDS-CLOSE?))
    (DEFUN PRINT-BLOCK-TAG
           (HTML PRETTY STYLE OPEN ATTRS EMPTY? BODY CLOSE NEEDS-CLOSE?)
      (WHEN (EQL STYLE :TREE) (SETQ NEEDS-CLOSE? T))
      (OPEN-BLOCK HTML PRETTY OPEN ATTRS)
      (UNLESS EMPTY? (BLOCK-BODY HTML BODY PRETTY))
      (CLOSE-BLOCK HTML CLOSE NEEDS-CLOSE?))
    (PROGN
     (DEFUN CUSTOM-ELT-FN (OPEN CLOSE ATTRS BODY EMPTY?)
       (PRINT-BLOCK-TAG *HTML* *PRINT-PRETTY* *HTML-STYLE* OPEN ATTRS EMPTY?
        BODY CLOSE T))
     (DEFUN DYNAMIC-TAG* (TAG ATTRS BODY EMPTY?)
       "Dynamically select a tag at runtime.
Note that TAG must be a known tag."
       (LET* ((TAG
               (OR
                (AND-LET*
                 ((KW (FIND-KEYWORD (STRING-UPCASE TAG))) (TAG (VALID? KW))))
                (ERROR 'NO-SUCH-TAG :NAME TAG)))
              (OPEN (TAG-OPEN TAG))
              (CLOSE (TAG-CLOSE TAG))
              (*PRE* (OR *PRE* (AND (PREFORMATTED? TAG) T)))
              (*DEPTH* (1+ *DEPTH*))
              (*HTML-PATH* (CONS TAG *HTML-PATH*))
              (PRETTY *PRINT-PRETTY*)
              (STYLE *HTML-STYLE*))
         (DECLARE (DYNAMIC-EXTENT *HTML-PATH*))
         (COND
          ((INLINE? TAG)
           (PRINT-INLINE-TAG *HTML* PRETTY STYLE OPEN (LENGTH OPEN) ATTRS
            EMPTY? BODY CLOSE T))
          ((PARAGRAPH? TAG)
           (PRINT-PAR-TAG *HTML* PRETTY STYLE OPEN ATTRS EMPTY? BODY CLOSE T))
          (T
           (PRINT-BLOCK-TAG *HTML* PRETTY STYLE OPEN ATTRS EMPTY?
            (ASSURE FUNCTION BODY) CLOSE T)))
         (VALUES)))
     (DEFINE-ALL-TAGS)))

[spinneret/syntax.lisp:39]
  (DEFUN ESCAPE-STRING-CHAR (C)
    (DECLARE (CHARACTER C)
             (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 0)))
    (CASE C
      (#\& "&amp;")
      (() "&nbsp;")
      (#\< "&lt;")
      (#\> "&gt;")
      (#\" "&quot;")
      (#\' "&#39;")))

[st-json/st-json.lisp:17]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (DEFPARAMETER *OPTIMIZE*
      '(OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 1) (DEBUG 1)
        (COMPILATION-SPEED 0))))

[statistical-learning/source/club-drf/utils.lisp:4]
  (DEFUN DIVERSITY-MEASURE (TREE/LABELS-A TREE/LABELS-B)
    (BIND
     (((TREE-A . LABELS-A) TREE/LABELS-A) ((TREE-B . LABELS-B) TREE/LABELS-B))
     (DECLARE (IGNORE TREE-A TREE-B))
     (CHECK-TYPE LABELS-A
                 #S(FORMGREP:SYMREF
                    :NAME "DOUBLE-FLOAT-DATA-MATRIX"
                    :QUALIFIER "SL.DATA"))
     (CHECK-TYPE LABELS-B
                 #S(FORMGREP:SYMREF
                    :NAME "DOUBLE-FLOAT-DATA-MATRIX"
                    :QUALIFIER "SL.DATA"))
     (ASSERT
      (=
       (#S(FORMGREP:SYMREF :NAME "DATA-POINTS-COUNT" :QUALIFIER "SL.DATA")
        LABELS-A)
       (#S(FORMGREP:SYMREF :NAME "DATA-POINTS-COUNT" :QUALIFIER "SL.DATA")
        LABELS-B)))
     (ASSERT
      (=
       (#S(FORMGREP:SYMREF :NAME "ATTRIBUTES-COUNT" :QUALIFIER "SL.DATA")
        LABELS-A)
       (#S(FORMGREP:SYMREF :NAME "ATTRIBUTES-COUNT" :QUALIFIER "SL.DATA")
        LABELS-B)))
     (ITERATE
      (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
               (TYPE FIXNUM DATA-POINTS-COUNT ATTRIBUTES-COUNT DIFFERENT MAX-A
                MAX-B))
      (WITH DIFFERENT = 0)
      (WITH DATA-POINTS-COUNT =
       (#S(FORMGREP:SYMREF :NAME "DATA-POINTS-COUNT" :QUALIFIER "SL.DATA")
        LABELS-A))
      (WITH ATTRIBUTES-COUNT =
       (#S(FORMGREP:SYMREF :NAME "ATTRIBUTES-COUNT" :QUALIFIER "SL.DATA")
        LABELS-A))
      (FOR DATA-POINT FROM 0 BELOW DATA-POINTS-COUNT)
      (FOR MAX-A =
       (ITERATE (DECLARE (TYPE FIXNUM ATTRIBUTE))
        (FOR ATTRIBUTE FROM 0 BELOW ATTRIBUTES-COUNT)
        (FINDING ATTRIBUTE MAXIMIZING
         (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") LABELS-A
          DATA-POINT ATTRIBUTE))))
      (FOR MAX-B =
       (ITERATE (DECLARE (TYPE FIXNUM ATTRIBUTE))
        (FOR ATTRIBUTE FROM 0 BELOW ATTRIBUTES-COUNT)
        (FINDING ATTRIBUTE MAXIMIZING
         (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") LABELS-B
          DATA-POINT ATTRIBUTE))))
      (UNLESS (= MAX-A MAX-B) (INCF DIFFERENT))
      (FINALLY (RETURN (COERCE DIFFERENT 'SINGLE-FLOAT))))))

[statistical-learning/source/data/extras.lisp:5]
  (DEFUN IOTA-VECTOR (TOTAL-COUNT)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE FIXNUM TOTAL-COUNT))
    (LRET ((RESULT (MAKE-ARRAY TOTAL-COUNT :ELEMENT-TYPE 'FIXNUM)))
     (ITERATE (FOR I FROM 0 BELOW TOTAL-COUNT) (SETF (AREF RESULT I) I))))

[statistical-learning/source/data/extras.lisp:15]
  (DEFUN RESHUFFLE (VECTOR)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (ITERATE (DECLARE (TYPE FIXNUM LENGTH I)) (WITH LENGTH = (LENGTH VECTOR))
     (FOR I FROM (1- LENGTH) DOWNTO 0)
     (ROTATEF (AREF VECTOR I) (AREF VECTOR (+ I (RANDOM (- LENGTH I)))))
     (FINALLY (RETURN VECTOR))))

[statistical-learning/source/data/extras.lisp:29]
  (DEFUN SELECT-RANDOM-INDEXES (SELECTED-COUNT TOTAL-COUNT)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET* ((TABLE (MAKE-HASH-TABLE :SIZE TOTAL-COUNT))
           (LIMIT (MIN SELECTED-COUNT TOTAL-COUNT))
           (RESULT (MAKE-ARRAY LIMIT :ELEMENT-TYPE 'FIXNUM)))
      (ITERATE
       (DECLARE (TYPE FIXNUM I RANDOM-POSITION VALUE NEXT-VALUE LOWER-BOUND))
       (FOR I FROM 0 BELOW LIMIT) (FOR LOWER-BOUND = (- TOTAL-COUNT I))
       (FOR RANDOM-POSITION = (+ I (RANDOM LOWER-BOUND)))
       (FOR VALUE = (ENSURE (GETHASH I TABLE) I))
       (FOR NEXT-VALUE =
        (ENSURE (GETHASH RANDOM-POSITION TABLE) RANDOM-POSITION))
       (UNLESS (EQL I RANDOM-POSITION)
         (SETF (GETHASH I TABLE) NEXT-VALUE
               (GETHASH RANDOM-POSITION TABLE) VALUE))
       (SETF (AREF RESULT I) NEXT-VALUE) (FINALLY (RETURN RESULT)))))

[statistical-learning/source/data/functions.lisp:49]
  (DEFUN SAMPLE (DATA-MATRIX &KEY DATA-POINTS ATTRIBUTES)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (CHECK-DATA-POINTS DATA-MATRIX)
    (DISPATCH-DATA-MATRIX (DATA-MATRIX)
     (#S(FORMGREP:SYMREF :NAME "CASES" :QUALIFIER "CL-DS.UTILS")
      ((NULL ATTRIBUTES) (NULL DATA-POINTS))
      (WHEN (AND (NULL ATTRIBUTES) (NULL DATA-POINTS))
        (RETURN-FROM SAMPLE DATA-MATRIX))
      (ITERATE (DECLARE (TYPE FIXNUM I ATTRIBUTES-COUNT DATA-POINTS-COUNT))
       (WITH ATTRIBUTES-COUNT =
        (IF (NULL ATTRIBUTES)
            (ATTRIBUTES-COUNT DATA-MATRIX)
            (LENGTH ATTRIBUTES)))
       (WITH DATA-POINTS-COUNT =
        (IF (NULL DATA-POINTS)
            (DATA-POINTS-COUNT DATA-MATRIX)
            (LENGTH DATA-POINTS)))
       (WITH RESULT =
        (MAKE-DATA-MATRIX DATA-POINTS-COUNT ATTRIBUTES-COUNT 0.0d0
         (ARRAY-ELEMENT-TYPE DATA-MATRIX)))
       (FOR I FROM 0 BELOW DATA-POINTS-COUNT)
       (ITERATE (DECLARE (TYPE FIXNUM J)) (FOR J FROM 0 BELOW ATTRIBUTES-COUNT)
        (SETF (MREF RESULT I J)
                (MREF DATA-MATRIX
                 (IF (NULL DATA-POINTS)
                     I
                     (AREF DATA-POINTS I))
                 (IF (NULL ATTRIBUTES)
                     J
                     (AREF ATTRIBUTES J)))))
       (FINALLY (RETURN RESULT))))))

[statistical-learning/source/data/functions.lisp:94]
  (DEFUN MAP-DATA-MATRIX (FUNCTION DATA-MATRIX &OPTIONAL IN-PLACE)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (CHECK-TYPE DATA-MATRIX DOUBLE-FLOAT-DATA-MATRIX)
    (DISPATCH-DATA-MATRIX (DATA-MATRIX)
     (LRET
      ((RESULT
        (IF IN-PLACE
            DATA-MATRIX
            (MAKE-DATA-MATRIX (DATA-POINTS-COUNT DATA-MATRIX)
             (ATTRIBUTES-COUNT DATA-MATRIX)))))
      (ITERATE (DECLARE (TYPE FIXNUM I))
       (FOR I FROM 0 BELOW (ARRAY-TOTAL-SIZE DATA-MATRIX))
       (SETF (ROW-MAJOR-AREF RESULT I)
               (FUNCALL FUNCTION (ROW-MAJOR-AREF DATA-MATRIX I)))))))

[statistical-learning/source/data/functions.lisp:123]
  (DEFUN REDUCE-DATA-POINTS (FUNCTION DATA &KEY ATTRIBUTES DATA-POINTS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (ITERATE
     (DECLARE (TYPE FIXNUM I FIRST-POINT ATTRIBUTES-COUNT DATA-POINTS-COUNT)
              (TYPE DOUBLE-FLOAT-DATA-MATRIX RESULT))
     (WITH DATA-POINTS-COUNT =
      (IF (NULL DATA-POINTS)
          (DATA-POINTS-COUNT DATA)
          (LENGTH DATA-POINTS)))
     (WITH ATTRIBUTES-COUNT =
      (IF (NULL ATTRIBUTES)
          (ATTRIBUTES-COUNT DATA)
          (LENGTH ATTRIBUTES)))
     (WITH RESULT = (MAKE-DATA-MATRIX 1 ATTRIBUTES-COUNT))
     (WITH FIRST-POINT =
      (IF (NULL DATA-POINTS)
          0
          (LENGTH DATA-POINTS)))
     (FOR I FROM 0 BELOW ATTRIBUTES-COUNT)
     (FOR ATTRIBUTE =
      (IF (NULL ATTRIBUTES)
          I
          (AREF ATTRIBUTES I)))
     (SETF (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") RESULT 0 I)
             (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") DATA
              FIRST-POINT ATTRIBUTE))
     (ITERATE (DECLARE (TYPE FIXNUM J K))
      (FOR J FROM 1 BELOW DATA-POINTS-COUNT)
      (FOR K =
       (IF (NULL DATA-POINTS)
           J
           (AREF DATA-POINTS J)))
      (SETF (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") RESULT 0 I)
              (FUNCALL FUNCTION
                       (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA")
                        RESULT 0 I)
                       (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA")
                        DATA K ATTRIBUTE))))
     (FINALLY (RETURN RESULT))))

[statistical-learning/source/data/functions.lisp:163]
  (DEFUN MAXS (DATA &KEY DATA-POINTS ATTRIBUTES)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET* ((ATTRIBUTES-COUNT
            (IF (NULL ATTRIBUTES)
                (ATTRIBUTES-COUNT DATA)
                (LENGTH ATTRIBUTES)))
           (DATA-POINTS-COUNT
            (IF (NULL DATA-POINTS)
                (DATA-POINTS-COUNT DATA)
                (LENGTH DATA-POINTS)))
           (RESULT-MAX (MAKE-DATA-MATRIX 1 ATTRIBUTES-COUNT))
           (FIRST-POINT
            (IF (NULL DATA-POINTS)
                0
                (AREF DATA-POINTS 0))))
      (DECLARE (TYPE FIXNUM ATTRIBUTES-COUNT DATA-POINTS-COUNT FIRST-POINT)
               (TYPE
                #S(FORMGREP:SYMREF
                   :NAME "DOUBLE-FLOAT-DATA-MATRIX"
                   :QUALIFIER "SL.DATA")
                RESULT-MAX))
      (ITERATE (DECLARE (TYPE FIXNUM I ATTRIBUTE))
       (FOR I FROM 0 BELOW ATTRIBUTES-COUNT)
       (FOR ATTRIBUTE =
        (IF (NULL ATTRIBUTES)
            I
            (AREF ATTRIBUTES I)))
       (SETF (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") RESULT-MAX
              0 I)
               (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") DATA
                FIRST-POINT ATTRIBUTE)))
      (ITERATE (DECLARE (TYPE FIXNUM J K1))
       (FOR J FROM 1 BELOW DATA-POINTS-COUNT)
       (FOR K1 =
        (IF (NULL DATA-POINTS)
            J
            (AREF DATA-POINTS J)))
       (ITERATE (DECLARE (TYPE FIXNUM I1))
        (FOR I1 FROM 0 BELOW ATTRIBUTES-COUNT BY 1)
        (LET ((ATTRIBUTE
               (IF (NULL ATTRIBUTES)
                   I1
                   (AREF ATTRIBUTES I1))))
          (MAXF
           (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") RESULT-MAX 0
            I1)
           (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") DATA K1
            ATTRIBUTE))))
       (FINALLY (RETURN RESULT-MAX)))))

[statistical-learning/source/data/functions.lisp:204]
  (DEFUN MINS/MAXS (DATA &KEY DATA-POINTS ATTRIBUTES)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET* ((ATTRIBUTES-COUNT
            (IF (NULL ATTRIBUTES)
                (ATTRIBUTES-COUNT DATA)
                (LENGTH ATTRIBUTES)))
           (DATA-POINTS-COUNT
            (IF (NULL DATA-POINTS)
                (DATA-POINTS-COUNT DATA)
                (LENGTH DATA-POINTS)))
           (RESULT-MIN (MAKE-DATA-MATRIX 1 ATTRIBUTES-COUNT))
           (RESULT-MAX (MAKE-DATA-MATRIX 1 ATTRIBUTES-COUNT))
           (FIRST-POINT
            (IF (NULL DATA-POINTS)
                0
                (AREF DATA-POINTS 0))))
      (DECLARE (TYPE FIXNUM ATTRIBUTES-COUNT DATA-POINTS-COUNT FIRST-POINT)
               (TYPE
                #S(FORMGREP:SYMREF
                   :NAME "DOUBLE-FLOAT-DATA-MATRIX"
                   :QUALIFIER "SL.DATA")
                RESULT-MIN RESULT-MAX))
      (ITERATE (DECLARE (TYPE FIXNUM I ATTRIBUTE))
       (FOR I FROM 0 BELOW ATTRIBUTES-COUNT)
       (FOR ATTRIBUTE =
        (IF (NULL ATTRIBUTES)
            I
            (AREF ATTRIBUTES I)))
       (SETF (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") RESULT-MAX
              0 I)
               (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") DATA
                FIRST-POINT ATTRIBUTE)
             (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") RESULT-MIN
              0 I)
               (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") DATA
                FIRST-POINT ATTRIBUTE)))
      (ITERATE (DECLARE (TYPE FIXNUM J K1))
       (FOR J FROM 1 BELOW DATA-POINTS-COUNT)
       (FOR K1 =
        (IF (NULL DATA-POINTS)
            J
            (AREF DATA-POINTS J)))
       (ITERATE (DECLARE (TYPE FIXNUM I1))
        (FOR I1 FROM 0 BELOW ATTRIBUTES-COUNT BY 1)
        (LET* ((ATTRIBUTE
                (IF (NULL ATTRIBUTES)
                    I1
                    (AREF ATTRIBUTES I1)))
               (VALUE
                (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") DATA K1
                 ATTRIBUTE)))
          (MINF
           (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") RESULT-MIN 0
            I1)
           VALUE)
          (MAXF
           (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") RESULT-MAX 0
            I1)
           VALUE)))
       (FINALLY (RETURN (CONS RESULT-MIN RESULT-MAX))))))

[statistical-learning/source/data/functions.lisp:249]
  (DEFUN MINS (DATA &KEY DATA-POINTS ATTRIBUTES)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (LET* ((ATTRIBUTES-COUNT
            (IF (NULL ATTRIBUTES)
                (ATTRIBUTES-COUNT DATA)
                (LENGTH ATTRIBUTES)))
           (DATA-POINTS-COUNT
            (IF (NULL DATA-POINTS)
                (DATA-POINTS-COUNT DATA)
                (LENGTH DATA-POINTS)))
           (RESULT-MIN (MAKE-DATA-MATRIX 1 ATTRIBUTES-COUNT))
           (FIRST-POINT
            (IF (NULL DATA-POINTS)
                0
                (AREF DATA-POINTS 0))))
      (DECLARE (TYPE FIXNUM ATTRIBUTES-COUNT DATA-POINTS-COUNT FIRST-POINT)
               (TYPE
                #S(FORMGREP:SYMREF
                   :NAME "DOUBLE-FLOAT-DATA-MATRIX"
                   :QUALIFIER "SL.DATA")
                RESULT-MIN))
      (ITERATE (DECLARE (TYPE FIXNUM I ATTRIBUTE))
       (FOR I FROM 0 BELOW ATTRIBUTES-COUNT)
       (FOR ATTRIBUTE =
        (IF (NULL ATTRIBUTES)
            I
            (AREF ATTRIBUTES I)))
       (SETF (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") RESULT-MIN
              0 I)
               (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") DATA
                FIRST-POINT ATTRIBUTE)))
      (ITERATE (DECLARE (TYPE FIXNUM J K1))
       (FOR J FROM 1 BELOW DATA-POINTS-COUNT)
       (FOR K1 =
        (IF (NULL DATA-POINTS)
            J
            (AREF DATA-POINTS J)))
       (ITERATE (DECLARE (TYPE FIXNUM I1))
        (FOR I1 FROM 0 BELOW ATTRIBUTES-COUNT BY 1)
        (LET ((ATTRIBUTE
               (IF (NULL ATTRIBUTES)
                   I1
                   (AREF ATTRIBUTES I1))))
          (MINF
           (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") RESULT-MIN 0
            I1)
           (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") DATA K1
            ATTRIBUTE))))
       (FINALLY (RETURN RESULT-MIN)))))

[statistical-learning/source/data/functions.lisp:285]
  (DEFUN SPLIT (DATA-MATRIX LENGTH SPLIT-ARRAY POSITION SKIPPED-COLUMN)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 0)))
    (DISPATCH-DATA-MATRIX (DATA-MATRIX)
     (#S(FORMGREP:SYMREF :NAME "CASES" :QUALIFIER "CL-DS.UTILS")
      ((NULL SKIPPED-COLUMN))
      (BIND-DATA-MATRIX-DIMENSIONS
       ((DATA-POINTS-COUNT ATTRIBUTES-COUNT DATA-MATRIX))
       (LRET
        ((RESULT
          (MAKE-ARRAY
           (ECLECTOR.READER:QUASIQUOTE
            ((ECLECTOR.READER:UNQUOTE LENGTH)
             (ECLECTOR.READER:UNQUOTE
              (IF (NULL SKIPPED-COLUMN)
                  ATTRIBUTES-COUNT
                  (1- ATTRIBUTES-COUNT)))))
           :ELEMENT-TYPE (ARRAY-ELEMENT-TYPE DATA-MATRIX))))
        (ITERATE (DECLARE (TYPE FIXNUM J I)) (WITH J = 0)
         (FOR I FROM 0 BELOW DATA-POINTS-COUNT)
         (WHEN (EQL POSITION (AREF SPLIT-ARRAY I))
           (ITERATE (DECLARE (TYPE FIXNUM K P)) (WITH P = 0)
            (FOR K FROM 0 BELOW ATTRIBUTES-COUNT)
            (WHEN (EQL SKIPPED-COLUMN K) (NEXT-ITERATION))
            (SETF (MREF RESULT J P) (MREF DATA-MATRIX I K)
                  P (1+ P))
            (FINALLY (ASSERT (= P (ARRAY-DIMENSION RESULT 1)))))
           (INCF J))
         (FINALLY (ASSERT (= J LENGTH)))))))))

[statistical-learning/source/data/functions.lisp:318]
  (DEFUN DATA-MIN/MAX (DATA ATTRIBUTE DATA-POINTS)
    (DECLARE
     (TYPE
      #S(FORMGREP:SYMREF
         :NAME "DATA-MATRIX"
         :QUALIFIER "STATISTICAL-LEARNING.DATA")
      DATA)
     (TYPE FIXNUM ATTRIBUTE)
     (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (ITERATE
     (DECLARE (TYPE DOUBLE-FLOAT MIN MAX ELEMENT)
              (TYPE FIXNUM I))
     (WITH MIN =
      (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") DATA
       (AREF DATA-POINTS 0) ATTRIBUTE))
     (WITH MAX = MIN) (WITH LENGTH = (LENGTH DATA-POINTS))
     (FOR I FROM 1 BELOW LENGTH)
     (FOR ELEMENT =
      (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") DATA
       (AREF DATA-POINTS I) ATTRIBUTE))
     (COND ((< MAX ELEMENT) (SETF MAX ELEMENT))
           ((> MIN ELEMENT) (SETF MIN ELEMENT)))
     (FINALLY (RETURN (VALUES MIN MAX)))))

[statistical-learning/source/data/functions.lisp:335]
  (DEFUN DATA-TRANSPOSE (DATA)
    (DECLARE
     (TYPE
      #S(FORMGREP:SYMREF
         :NAME "DATA-MATRIX"
         :QUALIFIER "STATISTICAL-LEARNING.DATA")
      DATA)
     (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (BIND-DATA-MATRIX-DIMENSIONS ((DATA-POINTS-COUNT ATTRIBUTES-COUNT DATA))
     (ITERATE (DECLARE (TYPE FIXNUM R))
      (WITH RESULT =
       (MAKE-DATA-MATRIX ATTRIBUTES-COUNT DATA-POINTS-COUNT :ELEMENT-TYPE
        (ARRAY-ELEMENT-TYPE DATA)))
      (FOR R FROM 0 BELOW DATA-POINTS-COUNT)
      (ITERATE (DECLARE (TYPE FIXNUM C)) (FOR C FROM 0 BELOW ATTRIBUTES-COUNT)
       (SETF (MREF RESULT C R) (MREF RESULT R C)))
      (FINALLY (RETURN RESULT)))))

[statistical-learning/source/decision-tree/methods.lisp:36]
  (DEFMETHOD #S(FORMGREP:SYMREF
                :NAME "INITIALIZE-LEAF/PROXY"
                :QUALIFIER "SL.TP")
             (PARAMETERS/PROXY (TRAINING-PARAMETERS CLASSIFICATION)
              TRAINING-STATE LEAF)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET* ((TARGET-DATA
            (#S(FORMGREP:SYMREF :NAME "TARGET-DATA" :QUALIFIER "SL.MP")
             TRAINING-STATE))
           (DATA-POINTS
            (#S(FORMGREP:SYMREF :NAME "DATA-POINTS" :QUALIFIER "SL.MP")
             TRAINING-STATE))
           (NUMBER-OF-CLASSES
            (~> TRAINING-PARAMETERS OPTIMIZED-FUNCTION
             #S(FORMGREP:SYMREF
                :NAME "NUMBER-OF-CLASSES"
                :QUALIFIER "SL.OPT")))
           (DATA-POINTS-COUNT (LENGTH DATA-POINTS))
           (PREDICTIONS
            (#S(FORMGREP:SYMREF :NAME "MAKE-DATA-MATRIX" :QUALIFIER "SL.DATA")
             1 NUMBER-OF-CLASSES)))
      (DECLARE (TYPE FIXNUM NUMBER-OF-CLASSES DATA-POINTS-COUNT)
               (TYPE (SIMPLE-ARRAY FIXNUM (*)) DATA-POINTS)
               (TYPE
                #S(FORMGREP:SYMREF
                   :NAME "DOUBLE-FLOAT-DATA-MATRIX"
                   :QUALIFIER "SL.DATA")
                TARGET-DATA PREDICTIONS))
      (ITERATE (DECLARE (TYPE FIXNUM J I INDEX))
       (FOR J FROM 0 BELOW DATA-POINTS-COUNT) (FOR I = (AREF DATA-POINTS J))
       (FOR INDEX =
        (TRUNCATE
         (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") TARGET-DATA I
          0)))
       (INCF
        (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") PREDICTIONS 0
         INDEX)))
      (SETF (#S(FORMGREP:SYMREF :NAME "PREDICTIONS" :QUALIFIER "SL.TP") LEAF)
              (#S(FORMGREP:SYMREF :NAME "DATA-MATRIX-AVG" :QUALIFIER "SL.DATA")
               PREDICTIONS DATA-POINTS-COUNT))))

[statistical-learning/source/ensemble/methods.lisp:236]
  (DEFMETHOD DATA-POINTS-SAMPLES
             ((SAMPLER GRADIENT-BASED-ONE-SIDE-SAMPLER) STATE COUNT)
    (IF-LET ((RESPONSE (GRADIENTS STATE)))
     (BIND
      ((DATA-POINTS-COUNT
        (#S(FORMGREP:SYMREF :NAME "DATA-POINTS-COUNT" :QUALIFIER "SL.DATA")
         RESPONSE))
       (ATTRIBUTES-COUNT
        (#S(FORMGREP:SYMREF :NAME "ATTRIBUTES-COUNT" :QUALIFIER "SL.DATA")
         RESPONSE))
       ((:FLET RESPONSE-AT-POINT (POINT))
        (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
        (ITERATE
         (DECLARE (TYPE FIXNUM I)
                  (TYPE DOUBLE-FLOAT RESULT))
         (WITH RESULT = 0.0d0) (FOR I FROM 0 BELOW ATTRIBUTES-COUNT)
         (INCF RESULT
               (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA")
                (THE
                 #S(FORMGREP:SYMREF
                    :NAME "DOUBLE-FLOAT-DATA-MATRIX"
                    :QUALIFIER "SL.DATA")
                 RESPONSE)
                POINT I))
         (FINALLY (RETURN RESULT))))
       ((:FLET >GRADIENT (POINT-A POINT-B))
        (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
        (> (RESPONSE-AT-POINT POINT-A) (RESPONSE-AT-POINT POINT-B)))
       (SMALL-GRADIENT-SAMPLING-RATE (SMALL-GRADIENT-SAMPLING-RATE SAMPLER))
       (LARGE-GRADIENT-SAMPLING-RATE (LARGE-GRADIENT-SAMPLING-RATE SAMPLER))
       (ORDERED-DATA-POINTS
        (~>
         (#S(FORMGREP:SYMREF :NAME "IOTA-VECTOR" :QUALIFIER "SL.DATA")
          DATA-POINTS-COUNT)
         (SORT #'>GRADIENT)))
       (LARGE-GRADIENT-COUNT
        (MIN (CEILING (* LARGE-GRADIENT-SAMPLING-RATE DATA-POINTS-COUNT))
             DATA-POINTS-COUNT))
       (SMALL-GRADIENT-COUNT
        (MIN (FLOOR (* SMALL-GRADIENT-SAMPLING-RATE DATA-POINTS-COUNT))
             (- DATA-POINTS-COUNT LARGE-GRADIENT-COUNT)))
       (TOTAL-COUNT (+ LARGE-GRADIENT-COUNT SMALL-GRADIENT-COUNT))
       ((:FLET GENERATE-SAMPLE
         (&AUX (R (MAKE-ARRAY TOTAL-COUNT :ELEMENT-TYPE 'FIXNUM))))
        (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0))
                 (TYPE (SIMPLE-ARRAY FIXNUM (*)) R))
        (REPLACE R ORDERED-DATA-POINTS :START1 0 :START2 0 :END1
                 LARGE-GRADIENT-COUNT :END2 LARGE-GRADIENT-COUNT)
        (~>>
         (#S(FORMGREP:SYMREF
             :NAME "SELECT-RANDOM-INDEXES"
             :QUALIFIER "SL.DATA")
          SMALL-GRADIENT-COUNT (- DATA-POINTS-COUNT LARGE-GRADIENT-COUNT))
         (#S(FORMGREP:SYMREF :NAME "TRANSFORM" :QUALIFIER "CL-DS.UTILS")
          (LAMBDA (I)
            (DECLARE (TYPE FIXNUM I))
            (LET ((OFFSET (THE FIXNUM (+ LARGE-GRADIENT-COUNT I))))
              (AREF ORDERED-DATA-POINTS OFFSET))))
         (THE (SIMPLE-ARRAY FIXNUM (*)) _)
         (REPLACE R _ :START1 LARGE-GRADIENT-COUNT :START2 0 :END1
                  TOTAL-COUNT))
        R))
      (DECLARE (TYPE FIXNUM TOTAL-COUNT LARGE-GRADIENT-COUNT))
      (FUNCALL
       (IF (~> STATE #S(FORMGREP:SYMREF :NAME "PARAMETERS" :QUALIFIER "SL.MP")
            PARALLEL)
           #'LPARALLEL.COGNATE:PMAP-INTO
           #'MAP-INTO)
       (MAKE-ARRAY COUNT) #'GENERATE-SAMPLE))
     (~>> STATE #S(FORMGREP:SYMREF :NAME "TRAIN-DATA" :QUALIFIER "SL.MP")
      #S(FORMGREP:SYMREF :NAME "DATA-POINTS-COUNT" :QUALIFIER "SL.DATA")
      (CURRY
       #'#S(FORMGREP:SYMREF :NAME "SELECT-RANDOM-INDEXES" :QUALIFIER "SL.DATA")
       (MAX (SMALL-GRADIENT-SAMPLING-RATE SAMPLER)
            (LARGE-GRADIENT-SAMPLING-RATE SAMPLER)))
      (MAP-INTO (MAKE-ARRAY COUNT)))))

[statistical-learning/source/gradient-boost-tree/methods.lisp:188]
  (DEFMETHOD TARGET ((PARAMETERS CLASSIFICATION) TARGET-DATA EXPECTED-VALUE)
    (DECLARE
     (TYPE
      #S(FORMGREP:SYMREF :NAME "DOUBLE-FLOAT-DATA-MATRIX" :QUALIFIER "SL.DATA")
      TARGET-DATA EXPECTED-VALUE)
     (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (ITERATE
     (DECLARE
      (TYPE
       #S(FORMGREP:SYMREF
          :NAME "DOUBLE-FLOAT-DATA-MATRIX"
          :QUALIFIER "SL.DATA")
       RESULT)
      (TYPE FIXNUM I NUMBER-OF-CLASSES DATA-POINTS-COUNT TARGET))
     (WITH OPTIMIZED-FUNCTION = (OPTIMIZED-FUNCTION PARAMETERS))
     (WITH NUMBER-OF-CLASSES =
      (#S(FORMGREP:SYMREF :NAME "NUMBER-OF-CLASSES" :QUALIFIER "SL.OPT")
       OPTIMIZED-FUNCTION))
     (WITH DATA-POINTS-COUNT =
      (#S(FORMGREP:SYMREF :NAME "DATA-POINTS-COUNT" :QUALIFIER "SL.DATA")
       TARGET-DATA))
     (WITH RESULT =
      (#S(FORMGREP:SYMREF :NAME "MAKE-DATA-MATRIX" :QUALIFIER "SL.DATA")
       DATA-POINTS-COUNT NUMBER-OF-CLASSES))
     (FOR I FROM 0 BELOW DATA-POINTS-COUNT)
     (FOR TARGET =
      (TRUNCATE
       (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") TARGET-DATA I
        0)))
     (ITERATE (DECLARE (TYPE FIXNUM J)) (FOR J FROM 0 BELOW NUMBER-OF-CLASSES)
      (SETF (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") RESULT I J)
              (-
               (IF (= TARGET J)
                   1
                   0)
               (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA")
                EXPECTED-VALUE 0 J))))
     (FINALLY (RETURN RESULT))))

[statistical-learning/source/gradient-boost-tree/methods.lisp:212]
  (DEFMETHOD TARGET ((PARAMETERS REGRESSION) TARGET-DATA EXPECTED-VALUE)
    (DECLARE
     (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0) (COMPILATION-SPEED 0))
     (TYPE
      #S(FORMGREP:SYMREF :NAME "DOUBLE-FLOAT-DATA-MATRIX" :QUALIFIER "SL.DATA")
      TARGET-DATA EXPECTED-VALUE))
    (ITERATE
     (DECLARE
      (TYPE
       #S(FORMGREP:SYMREF
          :NAME "DOUBLE-FLOAT-DATA-MATRIX"
          :QUALIFIER "SL.DATA")
       RESULT)
      (TYPE FIXNUM I))
     (WITH RESULT =
      (#S(FORMGREP:SYMREF :NAME "MAKE-DATA-MATRIX-LIKE" :QUALIFIER "SL.DATA")
       TARGET-DATA))
     (FOR I FROM 0 BELOW
      (#S(FORMGREP:SYMREF :NAME "DATA-POINTS-COUNT" :QUALIFIER "SL.DATA")
       RESULT))
     (ITERATE (DECLARE (TYPE FIXNUM II))
      (FOR II FROM 0 BELOW
       (#S(FORMGREP:SYMREF :NAME "ATTRIBUTES-COUNT" :QUALIFIER "SL.DATA")
        RESULT))
      (SETF (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") RESULT I II)
              (-
               (THE DOUBLE-FLOAT
                    (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA")
                     TARGET-DATA I II))
               (THE DOUBLE-FLOAT
                    (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA")
                     EXPECTED-VALUE 0 II)))))
     (FINALLY (RETURN RESULT))))

[statistical-learning/source/gradient-descent-refine/methods.lisp:13]
  (DEFMETHOD REFINE-TREES
             (
              (PARAMETERS
               #S(FORMGREP:SYMREF :NAME "CLASSIFICATION" :QUALIFIER "SL.DT"))
              ALGORITHM ENSEMBLE TRAIN-DATA TARGET-DATA)
    (BIND
     ((OPTIMIZED-FUNCTION
       (#S(FORMGREP:SYMREF :NAME "OPTIMIZED-FUNCTION" :QUALIFIER "SL.OPT")
        PARAMETERS))
      (NUMBER-OF-CLASSES
       (#S(FORMGREP:SYMREF :NAME "NUMBER-OF-CLASSES" :QUALIFIER "SL.OPT")
        OPTIMIZED-FUNCTION))
      (DATA-POINTS-COUNT
       (#S(FORMGREP:SYMREF :NAME "DATA-POINTS-COUNT" :QUALIFIER "SL.DATA")
        TARGET-DATA))
      (RESULT
       (#S(FORMGREP:SYMREF :NAME "MAKE-DATA-MATRIX" :QUALIFIER "SL.DATA")
        DATA-POINTS-COUNT NUMBER-OF-CLASSES)))
     (CHECK-TYPE TRAIN-DATA
                 #S(FORMGREP:SYMREF
                    :NAME "DOUBLE-FLOAT-DATA-MATRIX"
                    :QUALIFIER "SL.DATA"))
     (CHECK-TYPE RESULT
                 #S(FORMGREP:SYMREF
                    :NAME "DOUBLE-FLOAT-DATA-MATRIX"
                    :QUALIFIER "SL.DATA"))
     (ITERATE
      (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
               (TYPE FIXNUM I))
      (FOR I FROM 0 BELOW DATA-POINTS-COUNT)
      (SETF (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") RESULT I
             (THE FIXNUM
                  (TRUNCATE
                   (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA")
                    TARGET-DATA I 0))))
              1.0d0))
     (REFINE-IMPLEMENTATION ALGORITHM ENSEMBLE TRAIN-DATA RESULT)))

[statistical-learning/source/omp/methods.lisp:4]
  (DEFMETHOD PRUNE-TREES
             (
              (PARAMETERS
               #S(FORMGREP:SYMREF :NAME "CLASSIFICATION" :QUALIFIER "SL.PERF"))
              OMP ENSEMBLE TREES TRAIN-DATA TARGET-DATA)
    (BIND
     ((OPTIMIZED-FUNCTION
       (#S(FORMGREP:SYMREF :NAME "OPTIMIZED-FUNCTION" :QUALIFIER "SL.OPT")
        PARAMETERS))
      (NUMBER-OF-CLASSES
       (#S(FORMGREP:SYMREF :NAME "NUMBER-OF-CLASSES" :QUALIFIER "SL.OPT")
        OPTIMIZED-FUNCTION))
      (DATA-POINTS-COUNT
       (#S(FORMGREP:SYMREF :NAME "DATA-POINTS-COUNT" :QUALIFIER "SL.DATA")
        TARGET-DATA)))
     (CHECK-TYPE TRAIN-DATA
                 #S(FORMGREP:SYMREF
                    :NAME "DOUBLE-FLOAT-DATA-MATRIX"
                    :QUALIFIER "SL.DATA"))
     (IF (= NUMBER-OF-CLASSES 2)
         (PRUNE-TREES-IMPLEMENTATION OMP ENSEMBLE TREES TRAIN-DATA TARGET-DATA)
         (LET ((RESULT
                (#S(FORMGREP:SYMREF
                    :NAME "MAKE-DATA-MATRIX"
                    :QUALIFIER "SL.DATA")
                 DATA-POINTS-COUNT NUMBER-OF-CLASSES)))
           (CHECK-TYPE RESULT
                       #S(FORMGREP:SYMREF
                          :NAME "DOUBLE-FLOAT-DATA-MATRIX"
                          :QUALIFIER "SL.DATA"))
           (ITERATE
            (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
                     (TYPE FIXNUM I))
            (FOR I FROM 0 BELOW DATA-POINTS-COUNT)
            (SETF (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") RESULT
                   I
                   (THE FIXNUM
                        (TRUNCATE
                         (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA")
                          TARGET-DATA I 0))))
                    1.0d0))
           (PRUNE-TREES-IMPLEMENTATION OMP ENSEMBLE TREES TRAIN-DATA RESULT)))))

[statistical-learning/source/optimization/methods.lisp:4]
  (DEFMETHOD RESPONSE
             ((FUNCTION SQUARED-ERROR-FUNCTION) EXPECTED FUNCTION-OUTPUT)
    (DECLARE
     (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0) (SPACE 0) (COMPILATION-SPEED 0))
     (TYPE
      #S(FORMGREP:SYMREF :NAME "DOUBLE-FLOAT-DATA-MATRIX" :QUALIFIER "SL.DATA")
      EXPECTED FUNCTION-OUTPUT))
    (#S(FORMGREP:SYMREF :NAME "CHECK-DATA-POINTS" :QUALIFIER "SL.DATA")
     EXPECTED FUNCTION-OUTPUT)
    (ITERATE
     (DECLARE (TYPE FIXNUM I)
              (TYPE
               #S(FORMGREP:SYMREF
                  :NAME "DOUBLE-FLOAT-DATA-MATRIX"
                  :QUALIFIER "SL.DATA")
               RESULT))
     (WITH RESULT =
      (#S(FORMGREP:SYMREF :NAME "MAKE-DATA-MATRIX-LIKE" :QUALIFIER "SL.DATA")
       EXPECTED))
     (FOR I FROM 0 BELOW
      (#S(FORMGREP:SYMREF :NAME "DATA-POINTS-COUNT" :QUALIFIER "SL.DATA")
       RESULT))
     (ITERATE (DECLARE (TYPE FIXNUM II))
      (FOR II FROM 0 BELOW
       (#S(FORMGREP:SYMREF :NAME "ATTRIBUTES-COUNT" :QUALIFIER "SL.DATA")
        FUNCTION-OUTPUT))
      (SETF (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") RESULT I II)
              (-
               (THE DOUBLE-FLOAT
                    (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA")
                     EXPECTED I II))
               (THE DOUBLE-FLOAT
                    (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA")
                     FUNCTION-OUTPUT I II)))))
     (FINALLY (RETURN RESULT))))

[statistical-learning/source/optimization/methods.lisp:28]
  (DEFMETHOD LOSS
             ((FUNCTION SQUARED-ERROR-FUNCTION) TARGET-DATA WEIGHTS DATA-POINTS
              &OPTIONAL SPLIT-ARRAY)
    (DECLARE (TYPE (OR NULL WEIGHTS-DATA-MATRIX) WEIGHTS)
             (TYPE
              #S(FORMGREP:SYMREF
                 :NAME "DOUBLE-FLOAT-DATA-MATRIX"
                 :QUALIFIER "SL.DATA")
              TARGET-DATA)
             (TYPE
              (OR NULL
                  #S(FORMGREP:SYMREF
                     :NAME "SPLIT-VECTOR"
                     :QUALIFIER "SL.DATA"))
              SPLIT-ARRAY)
             (TYPE (SIMPLE-ARRAY FIXNUM (*)) DATA-POINTS)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0) (SPACE 0)
              (COMPILATION-SPEED 0)))
    (LET* ((TARGET-DATA-WIDTH
            (#S(FORMGREP:SYMREF :NAME "ATTRIBUTES-COUNT" :QUALIFIER "SL.DATA")
             TARGET-DATA))
           (LEFT-SUM
            (MAKE-ARRAY TARGET-DATA-WIDTH :ELEMENT-TYPE 'DOUBLE-FLOAT
                        :INITIAL-ELEMENT 0.0d0))
           (RIGHT-SUM
            (MAKE-ARRAY TARGET-DATA-WIDTH :ELEMENT-TYPE 'DOUBLE-FLOAT
                        :INITIAL-ELEMENT 0.0d0))
           (LEFT-COUNT 0)
           (RIGHT-COUNT 0))
      (DECLARE (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT (*)) LEFT-SUM RIGHT-SUM)
               (TYPE FIXNUM LEFT-COUNT RIGHT-COUNT))
      (#S(FORMGREP:SYMREF :NAME "CASES" :QUALIFIER "CL-DS.UTILS")
       ((NULL SPLIT-ARRAY) (NULL WEIGHTS))
       (ITERATE (DECLARE (TYPE FIXNUM I J))
        (WITH LENGTH = (LENGTH DATA-POINTS)) (FOR J FROM 0 BELOW LENGTH)
        (FOR I = (AREF DATA-POINTS J))
        (FOR RIGHTP = (AND SPLIT-ARRAY (EQL RIGHT (AREF SPLIT-ARRAY J))))
        (IF RIGHTP
            (PROGN
             (INCF RIGHT-COUNT)
             (ITERATE
              (DECLARE (TYPE FIXNUM II)
                       (TYPE DOUBLE-FLOAT VALUE))
              (FOR II FROM 0 BELOW TARGET-DATA-WIDTH)
              (FOR VALUE =
               (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA")
                TARGET-DATA I II))
              (INCF (AREF RIGHT-SUM II) VALUE)))
            (PROGN
             (INCF LEFT-COUNT)
             (ITERATE
              (DECLARE (TYPE FIXNUM II)
                       (TYPE DOUBLE-FLOAT VALUE))
              (FOR II FROM 0 BELOW TARGET-DATA-WIDTH)
              (FOR VALUE =
               (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA")
                TARGET-DATA I II))
              (INCF (AREF LEFT-SUM II) VALUE)))))
       (ITERATE
        (DECLARE (TYPE DOUBLE-FLOAT LEFT-ERROR RIGHT-ERROR)
                 (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT (*)) LEFT-AVG RIGHT-AVG)
                 (TYPE FIXNUM I J))
        (WITH LEFT-ERROR = 0.0d0) (WITH RIGHT-ERROR = 0.0d0)
        (WITH RIGHT-AVG =
         (#S(FORMGREP:SYMREF :NAME "VECTOR-AVG" :QUALIFIER "SL.DATA") RIGHT-SUM
          RIGHT-COUNT))
        (WITH LEFT-AVG =
         (#S(FORMGREP:SYMREF :NAME "VECTOR-AVG" :QUALIFIER "SL.DATA") LEFT-SUM
          LEFT-COUNT))
        (FOR J FROM 0 BELOW (LENGTH DATA-POINTS))
        (FOR I = (AREF DATA-POINTS J))
        (FOR RIGHTP = (AND SPLIT-ARRAY (EQL RIGHT (AREF SPLIT-ARRAY J))))
        (IF RIGHTP
            (INCF RIGHT-ERROR
                  (DATA-POINT-SQUARED-ERROR RIGHT-AVG TARGET-DATA WEIGHTS I))
            (INCF LEFT-ERROR
                  (DATA-POINT-SQUARED-ERROR LEFT-AVG TARGET-DATA WEIGHTS I)))
        (FINALLY
         (RETURN
          (VALUES
           (IF (ZEROP LEFT-COUNT)
               0.0d0
               (/ LEFT-ERROR LEFT-COUNT))
           (IF (ZEROP RIGHT-COUNT)
               0.0d0
               (/ RIGHT-ERROR RIGHT-COUNT)))))))))

[statistical-learning/source/optimization/methods.lisp:102]
  (DEFMETHOD RESPONSE ((FUNCTION K-LOGISTIC-FUNCTION) EXPECTED SUMS)
    (DECLARE
     (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0) (COMPILATION-SPEED 0))
     (TYPE
      #S(FORMGREP:SYMREF :NAME "DOUBLE-FLOAT-DATA-MATRIX" :QUALIFIER "SL.DATA")
      SUMS EXPECTED))
    (ITERATE
     (DECLARE (TYPE FIXNUM I NUMBER-OF-CLASSES)
              (TYPE
               #S(FORMGREP:SYMREF
                  :NAME "DOUBLE-FLOAT-DATA-MATRIX"
                  :QUALIFIER "SL.DATA")
               RESULT))
     (WITH NUMBER-OF-CLASSES =
      (#S(FORMGREP:SYMREF :NAME "ATTRIBUTES-COUNT" :QUALIFIER "SL.DATA") SUMS))
     (WITH RESULT =
      (#S(FORMGREP:SYMREF :NAME "MAKE-DATA-MATRIX-LIKE" :QUALIFIER "SL.DATA")
       SUMS))
     (FOR I FROM 0 BELOW
      (#S(FORMGREP:SYMREF :NAME "DATA-POINTS-COUNT" :QUALIFIER "SL.DATA")
       EXPECTED))
     (ITERATE (DECLARE (TYPE FIXNUM J)) (FOR J FROM 0 BELOW NUMBER-OF-CLASSES)
      (SETF (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") RESULT I J)
              (-
               (IF (= J
                      (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA")
                       EXPECTED I 0))
                   1.0d0
                   0.0d0)
               (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") SUMS I
                J))))
     (FINALLY (RETURN RESULT))))

[statistical-learning/source/optimization/methods.lisp:126]
  (DEFMETHOD LOSS
             ((FUNCTION GINI-IMPURITY-FUNCTION) TARGET-DATA WEIGHTS DATA-POINTS
              &OPTIONAL SPLIT-ARRAY)
    (DECLARE (TYPE (OR NULL WEIGHTS-DATA-MATRIX) WEIGHTS)
             (TYPE (SIMPLE-ARRAY FIXNUM (*)) DATA-POINTS)
             (TYPE
              #S(FORMGREP:SYMREF
                 :NAME "DOUBLE-FLOAT-DATA-MATRIX"
                 :QUALIFIER "SL.DATA")
              TARGET-DATA)
             (TYPE
              (OR NULL
                  #S(FORMGREP:SYMREF
                     :NAME "SPLIT-VECTOR"
                     :QUALIFIER "SL.DATA"))
              SPLIT-ARRAY)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0) (SPACE 0)
              (COMPILATION-SPEED 0)))
    (#S(FORMGREP:SYMREF :NAME "CASES" :QUALIFIER "CL-DS.UTILS")
     ((NULL SPLIT-ARRAY))
     (IF (NULL WEIGHTS)
         (ITERATE
          (DECLARE (TYPE FIXNUM J1 I1 J2 TARGET1 LENGTH)
                   (TYPE (SIMPLE-ARRAY FIXNUM (*)) LEFT-SUMS RIGHT-SUMS))
          (WITH NUMBER-OF-CLASSES = (NUMBER-OF-CLASSES FUNCTION))
          (WITH LEFT-SUMS =
           (MAKE-ARRAY NUMBER-OF-CLASSES :INITIAL-ELEMENT 0 :ELEMENT-TYPE
                       'FIXNUM))
          (WITH RIGHT-SUMS =
           (MAKE-ARRAY NUMBER-OF-CLASSES :INITIAL-ELEMENT 0 :ELEMENT-TYPE
                       'FIXNUM))
          (WITH LENGTH = (LENGTH DATA-POINTS))
          (FOR J1 FROM 0 BELOW LENGTH BY 2) (FOR J2 = (+ J1 1))
          (FOR I1 = (AREF DATA-POINTS J1))
          (FOR TARGET1 =
           (TRUNCATE
            (#S(FORMGREP:SYMREF
                :NAME "MREF"
                :QUALIFIER "STATISTICAL-LEARNING.DATA")
             TARGET-DATA I1 0)))
          (IF (AND SPLIT-ARRAY (EQL RIGHT (AREF SPLIT-ARRAY J1)))
              (INCF (AREF RIGHT-SUMS TARGET1))
              (INCF (AREF LEFT-SUMS TARGET1)))
          (WHEN (< J2 LENGTH)
            (LET* ((I2 (AREF DATA-POINTS J2))
                   (TARGET2
                    (TRUNCATE
                     (#S(FORMGREP:SYMREF
                         :NAME "MREF"
                         :QUALIFIER "STATISTICAL-LEARNING.DATA")
                      TARGET-DATA I2 0))))
              (DECLARE (TYPE FIXNUM I2 TARGET2))
              (IF (AND SPLIT-ARRAY (EQL RIGHT (AREF SPLIT-ARRAY J2)))
                  (INCF (AREF RIGHT-SUMS TARGET2))
                  (INCF (AREF LEFT-SUMS TARGET2)))))
          (FINALLY
           (RETURN
            (VALUES (VECTOR-IMPURITY LEFT-SUMS)
                    (VECTOR-IMPURITY RIGHT-SUMS)))))
         (ITERATE
          (DECLARE (TYPE FIXNUM J I)
                   (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT (*)) LEFT-SUMS RIGHT-SUMS))
          (WITH NUMBER-OF-CLASSES = (NUMBER-OF-CLASSES FUNCTION))
          (WITH LEFT-SUMS =
           (MAKE-ARRAY NUMBER-OF-CLASSES :INITIAL-ELEMENT 0.0d0 :ELEMENT-TYPE
                       'DOUBLE-FLOAT))
          (WITH RIGHT-SUMS =
           (MAKE-ARRAY NUMBER-OF-CLASSES :INITIAL-ELEMENT 0.0d0 :ELEMENT-TYPE
                       'DOUBLE-FLOAT))
          (FOR J FROM 0 BELOW (LENGTH DATA-POINTS))
          (FOR I = (AREF DATA-POINTS J))
          (FOR TARGET =
           (TRUNCATE
            (#S(FORMGREP:SYMREF
                :NAME "MREF"
                :QUALIFIER "STATISTICAL-LEARNING.DATA")
             TARGET-DATA I 0)))
          (IF (AND SPLIT-ARRAY (EQL RIGHT (AREF SPLIT-ARRAY J)))
              (INCF (AREF RIGHT-SUMS TARGET) (WEIGHT-AT WEIGHTS I))
              (INCF (AREF LEFT-SUMS TARGET) (WEIGHT-AT WEIGHTS I)))
          (FINALLY
           (RETURN
            (VALUES (VECTOR-IMPURITY LEFT-SUMS)
                    (VECTOR-IMPURITY RIGHT-SUMS))))))))

[statistical-learning/source/optimization/utils.lisp:52]
  (DEFUN DATA-POINT-SQUARED-ERROR (AVG-VECTOR TARGET-DATA WEIGHTS I)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0) (SPACE 0)))
    (MACROLET ((OP (RESULT II)
                 (ECLECTOR.READER:QUASIQUOTE
                  (LET* ((VALUE
                          (#S(FORMGREP:SYMREF
                              :NAME "MREF"
                              :QUALIFIER "SL.DATA")
                           TARGET-DATA I (ECLECTOR.READER:UNQUOTE II)))
                         (AVG (AREF AVG-VECTOR (ECLECTOR.READER:UNQUOTE II)))
                         (ERROR (* WEIGHT (SQUARE (- VALUE AVG)))))
                    (INCF (ECLECTOR.READER:UNQUOTE RESULT) ERROR)))))
      (ITERATE
       (DECLARE (TYPE FIXNUM II1)
                (TYPE DOUBLE-FLOAT RESULT1))
       (WITH WEIGHT =
        (IF (NULL WEIGHTS)
            1.0d0
            (WEIGHT-AT WEIGHTS I)))
       (WITH RESULT1 = 0.0d0) (WITH SIZE = (ARRAY-DIMENSION TARGET-DATA 1))
       (FOR II1 FROM 0 BELOW SIZE BY 1) (OP RESULT1 II1)
       (FINALLY (RETURN RESULT1)))))

[statistical-learning/source/performance/methods.lisp:84]
  (DEFMETHOD ERRORS ((PARAMETERS CLASSIFICATION) TARGET PREDICTIONS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE
              #S(FORMGREP:SYMREF
                 :NAME "DOUBLE-FLOAT-DATA-MATRIX"
                 :QUALIFIER "SL.DATA")
              TARGET PREDICTIONS))
    (LET* ((DATA-POINTS-COUNT
            (#S(FORMGREP:SYMREF :NAME "DATA-POINTS-COUNT" :QUALIFIER "SL.DATA")
             TARGET))
           (RESULT (MAKE-ARRAY DATA-POINTS-COUNT :ELEMENT-TYPE 'DOUBLE-FLOAT)))
      (DECLARE (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT (*)) RESULT))
      (ITERATE (DECLARE (TYPE FIXNUM I)) (FOR I FROM 0 BELOW DATA-POINTS-COUNT)
       (FOR EXPECTED =
        (TRUNCATE
         (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") TARGET I 0)))
       (SETF (AREF RESULT I)
               (- 1.0d0
                  (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA")
                   PREDICTIONS I EXPECTED))))
      RESULT))

[statistical-learning/source/performance/methods.lisp:114]
  (DEFMETHOD PERFORMANCE-METRIC*
             ((PARAMETERS CLASSIFICATION) (TYPE (EQL :CONFUSION-MATRIX)) TARGET
              PREDICTIONS WEIGHTS)
    (#S(FORMGREP:SYMREF :NAME "CHECK-DATA-POINTS" :QUALIFIER "SL.DATA") TARGET
     PREDICTIONS)
    (BIND
     ((NUMBER-OF-CLASSES
       (THE FIXNUM
            (#S(FORMGREP:SYMREF :NAME "NUMBER-OF-CLASSES" :QUALIFIER "SL.OPT")
             PARAMETERS)))
      (DATA-POINTS-COUNT
       (#S(FORMGREP:SYMREF :NAME "DATA-POINTS-COUNT" :QUALIFIER "SL.DATA")
        TARGET))
      ((:FLET PREDICTION (PREDICTION))
       (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
       (ITERATE (DECLARE (TYPE FIXNUM I))
        (FOR I FROM 0 BELOW NUMBER-OF-CLASSES)
        (FINDING I MAXIMIZING
         (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") PREDICTIONS
          PREDICTION I))))
      (RESULT (MAKE-CONFUSION-MATRIX NUMBER-OF-CLASSES)))
     (ITERATE
      (DECLARE (TYPE FIXNUM I)
               (OPTIMIZE (SPEED 3)))
      (FOR I FROM 0 BELOW DATA-POINTS-COUNT)
      (FOR EXPECTED =
       (TRUNCATE
        (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") TARGET I 0)))
      (FOR PREDICTED = (PREDICTION I))
      (INCF
       (#S(FORMGREP:SYMREF :NAME "AT-CONFUSION-MATRIX" :QUALIFIER "SL.PERF")
        RESULT EXPECTED PREDICTED)
       (IF (NULL WEIGHTS)
           1.0d0
           (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") WEIGHTS I
            0))))
     RESULT))

[statistical-learning/source/random/discrete-distribution.lisp:4]
  (DEFUN DISCRETE-DISTRIBUTION (WEIGHTS)
    (DECLARE
     (TYPE
      #S(FORMGREP:SYMREF :NAME "DOUBLE-FLOAT-DATA-MATRIX" :QUALIFIER "SL.DATA")
      WEIGHTS))
    (LET* ((DATA-POINTS-COUNT
            (~>> WEIGHTS
             #S(FORMGREP:SYMREF :NAME "UNFOLD-TABLE" :QUALIFIER "CL-DS.UTILS")
             (COUNT-IF-NOT #'ZEROP)))
           (PROBS (MAKE-ARRAY DATA-POINTS-COUNT)))
      (ITERATE (DECLARE (TYPE FIXNUM I J)) (WITH AC = 0.0d0) (WITH J = 0)
       (FOR I FROM 0 BELOW
        (#S(FORMGREP:SYMREF :NAME "DATA-POINTS-COUNT" :QUALIFIER "SL.DATA")
         WEIGHTS))
       (FOR WEIGHT =
        (#S(FORMGREP:SYMREF
            :NAME "MREF"
            :QUALIFIER "STATISTICAL-LEARNING.DATA")
         WEIGHTS I 0))
       (WHEN (ZEROP WEIGHT) (NEXT-ITERATION))
       (SETF (AREF PROBS J) (CONS (INCF AC WEIGHT) I)) (INCF J))
      (LET ((MAX (CAR (LAST-ELT PROBS))))
        (DECLARE (TYPE DOUBLE-FLOAT MAX))
        (LAMBDA ()
          (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
          (~>>
           (#S(FORMGREP:SYMREF :NAME "LOWER-BOUND" :QUALIFIER "CL-DS.UTILS")
            PROBS (RANDOM MAX) #'< :KEY #'CAR)
           (AREF PROBS) CDR)))))

[statistical-learning/source/random/randoms.lisp:6]
  (DEFUN RANDOM-UNIFORM (MIN MAX)
    (DECLARE
     (OPTIMIZE (SPEED 3) (SPACE 0) (DEBUG 0) (SAFETY 0) (COMPILATION-SPEED 0))
     (TYPE DOUBLE-FLOAT MIN MAX))
    (+ (RANDOM (- MAX MIN)) MIN))

[statistical-learning/source/random/randoms.lisp:16]
  (DEFUN RANDOM-GAUSS (&OPTIONAL (MEAN 0.0d0) (STD-DEV 0.1d0))
    (DECLARE
     (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0) (SPACE 0) (COMPILATION-SPEED 0))
     (TYPE DOUBLE-FLOAT MEAN STD-DEV))
    (DO* ((RAND-U (* 2.0d0 (- 0.5d0 (RANDOM 1.0d0)))
                  (* 2.0d0 (- 0.5d0 (RANDOM 1.0d0))))
          (RAND-V (* 2.0d0 (- 0.5d0 (RANDOM 1.0d0)))
                  (* 2.0d0 (- 0.5d0 (RANDOM 1.0d0))))
          (RAND-S (+ (* RAND-U RAND-U) (* RAND-V RAND-V))
                  (+ (* RAND-U RAND-U) (* RAND-V RAND-V))))
         ((NOR (= 0.0d0 RAND-S) (>= RAND-S 1.0d0))
          (+ MEAN
             (* STD-DEV
                (* RAND-U
                   (THE DOUBLE-FLOAT
                        (SQRT (/ (* -2.0d0 (LOG RAND-S)) RAND-S)))))))))

[statistical-learning/source/tree-protocol/methods.lisp:400]
  (DEFMETHOD LEAF-FOR/PROXY
             (PROXY (SPLITTER RANDOM-ATTRIBUTE-SPLITTER)
              (NODE FUNDAMENTAL-NODE) DATA INDEX CONTEXT)
    (DECLARE
     (TYPE
      #S(FORMGREP:SYMREF :NAME "DOUBLE-FLOAT-DATA-MATRIX" :QUALIFIER "SL.DATA")
      DATA)
     (TYPE FIXNUM INDEX))
    (LABELS ((IMPL (NODE DEPTH &AUX (NEW-DEPTH (THE FIXNUM (1+ DEPTH))))
               (DECLARE
                (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)
                 (COMPILATION-SPEED 0)))
               (SETF NODE (LPARALLEL.PROMISE:FORCE NODE))
               (ASSERT (NOT (NULL NODE)))
               (IF (TREEP NODE)
                   (BIND (((ATTRIBUTE-INDEX ATTRIBUTE-VALUE) (POINT NODE)))
                    (DECLARE (TYPE FIXNUM ATTRIBUTE-INDEX)
                             (TYPE DOUBLE-FLOAT ATTRIBUTE-VALUE))
                    (IF (>
                         (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA")
                          DATA INDEX ATTRIBUTE-INDEX)
                         ATTRIBUTE-VALUE)
                        (~> NODE RIGHT-NODE (IMPL NEW-DEPTH))
                        (~> NODE LEFT-NODE (IMPL NEW-DEPTH))))
                   (VALUES NODE DEPTH))))
      (IMPL NODE 0)))

[statistical-learning/source/tree-protocol/methods.lisp:424]
  (DEFMETHOD PICK-SPLIT*/PROXY
             (SPLITTER/PROXY (SPLITTER RANDOM-ATTRIBUTE-SPLITTER) PARAMETERS
              STATE)
    (DECLARE
     (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0) (SPACE 0) (COMPILATION-SPEED 0))
     (IGNORE PARAMETERS))
    (BIND
     ((ATTRIBUTES (THE (SIMPLE-ARRAY FIXNUM (*)) (ATTRIBUTE-INDEXES STATE)))
      (DATA
       (THE
        #S(FORMGREP:SYMREF
           :NAME "DOUBLE-FLOAT-DATA-MATRIX"
           :QUALIFIER "SL.DATA")
        (#S(FORMGREP:SYMREF :NAME "TRAIN-DATA" :QUALIFIER "SL.MP") STATE)))
      (DATA-POINTS
       (#S(FORMGREP:SYMREF :NAME "DATA-POINTS" :QUALIFIER "SL.MP") STATE))
      ((MINS . MAXS)
       (ENSURE
        (#S(FORMGREP:SYMREF :NAME "CACHE" :QUALIFIER "SL.MP") STATE 'MINS/MAXS)
        (#S(FORMGREP:SYMREF :NAME "MINS/MAXS" :QUALIFIER "SL.DATA") DATA
         :DATA-POINTS DATA-POINTS :ATTRIBUTES ATTRIBUTES)))
      (ATTRIBUTES-COUNT (LENGTH ATTRIBUTES))
      (ATTRIBUTE-INDEX (RANDOM ATTRIBUTES-COUNT))
      (ATTRIBUTE (AREF ATTRIBUTES ATTRIBUTE-INDEX))
      (MIN
       (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA")
        (THE
         #S(FORMGREP:SYMREF
            :NAME "DOUBLE-FLOAT-DATA-MATRIX"
            :QUALIFIER "SL.DATA")
         MINS)
        0 ATTRIBUTE-INDEX))
      (MAX
       (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA")
        (THE
         #S(FORMGREP:SYMREF
            :NAME "DOUBLE-FLOAT-DATA-MATRIX"
            :QUALIFIER "SL.DATA")
         MAXS)
        0 ATTRIBUTE-INDEX))
      (THRESHOLD
       (IF (= MIN MAX)
           MIN
           (#S(FORMGREP:SYMREF :NAME "RANDOM-UNIFORM" :QUALIFIER "SL.RANDOM")
            MIN MAX))))
     (LIST ATTRIBUTE
           (IF (= THRESHOLD MAX)
               MIN
               THRESHOLD))))

[statistical-learning/source/tree-protocol/methods.lisp:449]
  (DEFMETHOD FILL-SPLIT-VECTOR*/PROXY
             (SPLITTER/PROXY (SPLITTER RANDOM-ATTRIBUTE-SPLITTER) PARAMETERS
              STATE POINT SPLIT-VECTOR)
    (DECLARE
     (TYPE #S(FORMGREP:SYMREF :NAME "SPLIT-VECTOR" :QUALIFIER "SL.DATA")
      SPLIT-VECTOR)
     (TYPE LIST POINT)
     (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (DEBUG 0) (COMPILATION-SPEED 0)))
    (BIND
     ((ATTRIBUTE (FIRST POINT)) (THRESHOLD (SECOND POINT))
      (DATA (#S(FORMGREP:SYMREF :NAME "TRAIN-DATA" :QUALIFIER "SL.MP") STATE))
      (DATA-POINT-INDEXES
       (#S(FORMGREP:SYMREF :NAME "DATA-POINTS" :QUALIFIER "SL.MP") STATE))
      (LENGTH (LENGTH SPLIT-VECTOR)))
     (DECLARE
      (TYPE
       #S(FORMGREP:SYMREF
          :NAME "DOUBLE-FLOAT-DATA-MATRIX"
          :QUALIFIER "SL.DATA")
       DATA)
      (TYPE (SIMPLE-ARRAY FIXNUM (*)) DATA-POINT-INDEXES)
      (TYPE DOUBLE-FLOAT THRESHOLD)
      (TYPE FIXNUM LENGTH ATTRIBUTE))
     (ASSERT
      (< ATTRIBUTE
         (#S(FORMGREP:SYMREF :NAME "ATTRIBUTES-COUNT" :QUALIFIER "SL.DATA")
          DATA)))
     (ASSERT (= (LENGTH DATA-POINT-INDEXES) LENGTH))
     (ITERATE
      (DECLARE
       (TYPE FIXNUM LEFT-COUNT1 LEFT-COUNT2 LEFT-COUNT3 LEFT-COUNT4
        RIGHT-COUNT1 RIGHT-COUNT2 RIGHT-COUNT3 RIGHT-COUNT4 J1 J2 J3 J4))
      (WITH RIGHT-COUNT1 = 0) (WITH RIGHT-COUNT2 = 0) (WITH RIGHT-COUNT3 = 0)
      (WITH RIGHT-COUNT4 = 0) (WITH LEFT-COUNT1 = 0) (WITH LEFT-COUNT2 = 0)
      (WITH LEFT-COUNT3 = 0) (WITH LEFT-COUNT4 = 0)
      (FOR J1 FROM 0 BELOW LENGTH BY 4) (FOR I1 = (AREF DATA-POINT-INDEXES J1))
      (FOR J2 = (+ J1 1)) (FOR J3 = (+ J1 2)) (FOR J4 = (+ J1 3))
      (FOR RIGHTP1 =
       (>
        (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") DATA I1
         ATTRIBUTE)
        THRESHOLD))
      (SETF (AREF SPLIT-VECTOR J1) RIGHTP1)
      (IF RIGHTP1
          (INCF RIGHT-COUNT1)
          (INCF LEFT-COUNT1))
      (COND
       ((< J4 LENGTH)
        (LET* ((I4 (AREF DATA-POINT-INDEXES J4))
               (RIGHTP4
                (>
                 (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") DATA I4
                  ATTRIBUTE)
                 THRESHOLD)))
          (SETF (AREF SPLIT-VECTOR J4) RIGHTP4)
          (IF RIGHTP4
              (INCF RIGHT-COUNT4)
              (INCF LEFT-COUNT4)))
        (LET* ((I3 (AREF DATA-POINT-INDEXES J3))
               (RIGHTP3
                (>
                 (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") DATA I3
                  ATTRIBUTE)
                 THRESHOLD)))
          (SETF (AREF SPLIT-VECTOR J3) RIGHTP3)
          (IF RIGHTP3
              (INCF RIGHT-COUNT3)
              (INCF LEFT-COUNT3)))
        (LET* ((I2 (AREF DATA-POINT-INDEXES J2))
               (RIGHTP2
                (>
                 (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") DATA I2
                  ATTRIBUTE)
                 THRESHOLD)))
          (SETF (AREF SPLIT-VECTOR J2) RIGHTP2)
          (IF RIGHTP2
              (INCF RIGHT-COUNT2)
              (INCF LEFT-COUNT2))))
       ((< J3 LENGTH)
        (LET* ((I3 (AREF DATA-POINT-INDEXES J3))
               (RIGHTP3
                (>
                 (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") DATA I3
                  ATTRIBUTE)
                 THRESHOLD)))
          (SETF (AREF SPLIT-VECTOR J3) RIGHTP3)
          (IF RIGHTP3
              (INCF RIGHT-COUNT3)
              (INCF LEFT-COUNT3)))
        (LET* ((I2 (AREF DATA-POINT-INDEXES J2))
               (RIGHTP2
                (>
                 (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") DATA I2
                  ATTRIBUTE)
                 THRESHOLD)))
          (SETF (AREF SPLIT-VECTOR J2) RIGHTP2)
          (IF RIGHTP2
              (INCF RIGHT-COUNT2)
              (INCF LEFT-COUNT2))))
       ((< J2 LENGTH)
        (LET* ((I2 (AREF DATA-POINT-INDEXES J2))
               (RIGHTP2
                (>
                 (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") DATA I2
                  ATTRIBUTE)
                 THRESHOLD)))
          (SETF (AREF SPLIT-VECTOR J2) RIGHTP2)
          (IF RIGHTP2
              (INCF RIGHT-COUNT2)
              (INCF LEFT-COUNT2)))))
      (FINALLY
       (LET ((LEFT
              (THE FIXNUM (+ LEFT-COUNT1 LEFT-COUNT2 LEFT-COUNT3 LEFT-COUNT4)))
             (RIGHT
              (THE FIXNUM
                   (+ RIGHT-COUNT1 RIGHT-COUNT2 RIGHT-COUNT3 RIGHT-COUNT4))))
         (ASSERT (= (THE FIXNUM (+ LEFT RIGHT)) LENGTH))
         (RETURN (VALUES LEFT RIGHT)))))))

[statistical-learning/source/tree-protocol/methods.lisp:581]
  (DEFMETHOD FILL-SPLIT-VECTOR*/PROXY
             (SPLITTER/PROXY (SPLITTER DISTANCE-SPLITTER) PARAMETERS STATE
              POINT SPLIT-VECTOR)
    (DECLARE (TYPE CONS POINT)
             (TYPE
              #S(FORMGREP:SYMREF :NAME "SPLIT-VECTOR" :QUALIFIER "SL.DATA")
              SPLIT-VECTOR)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0) (SPACE 0)
              (COMPILATION-SPEED 0)))
    (BIND
     (((LEFT-PIVOT . RIGHT-PIVOT) POINT)
      (DATA-POINTS
       (#S(FORMGREP:SYMREF :NAME "DATA-POINTS" :QUALIFIER "SL.MP") STATE))
      (DISTANCE-FUNCTION (ENSURE-FUNCTION (DISTANCE-FUNCTION SPLITTER)))
      (TRAIN-DATA
       (#S(FORMGREP:SYMREF :NAME "TRAIN-DATA" :QUALIFIER "SL.MP") STATE)))
     (DECLARE (TYPE (SIMPLE-ARRAY FIXNUM (*)) DATA-POINTS)
              (TYPE
               #S(FORMGREP:SYMREF
                  :NAME "UNIVERSAL-DATA-MATRIX"
                  :QUALIFIER "SL.DATA")
               TRAIN-DATA))
     (ITERATE (DECLARE (TYPE FIXNUM J I LEFT-LENGTH RIGHT-LENGTH))
      (WITH LEFT-LENGTH = 0) (WITH RIGHT-LENGTH = 0)
      (FOR J FROM 0 BELOW (LENGTH DATA-POINTS)) (FOR I = (AREF DATA-POINTS J))
      (FOR OBJECT =
       (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") TRAIN-DATA I 0))
      (FOR LEFT-DISTANCE = (FUNCALL DISTANCE-FUNCTION LEFT-PIVOT OBJECT))
      (FOR RIGHT-DISTANCE = (FUNCALL DISTANCE-FUNCTION RIGHT-PIVOT OBJECT))
      (FOR RIGHTP = (< RIGHT-DISTANCE LEFT-DISTANCE))
      (SETF (AREF SPLIT-VECTOR J) RIGHTP)
      (IF RIGHTP
          (INCF RIGHT-LENGTH)
          (INCF LEFT-LENGTH))
      (FINALLY (RETURN (VALUES LEFT-LENGTH RIGHT-LENGTH))))))

[statistical-learning/source/tree-protocol/methods.lisp:620]
  (DEFMETHOD LEAF-FOR/PROXY
             (SPLITTER/PROXY (SPLITTER DISTANCE-SPLITTER) NODE DATA INDEX
              CONTEXT)
    (DECLARE (TYPE FIXNUM INDEX))
    (LET ((OBJECT
           (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") DATA INDEX
            0))
          (DISTANCE-FUNCTION (ENSURE-FUNCTION (DISTANCE-FUNCTION SPLITTER))))
      (LABELS ((IMPL (NODE DEPTH &AUX (NEW-DEPTH (THE FIXNUM (1+ DEPTH))))
                 (DECLARE
                  (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0) (SPACE 0)
                   (COMPILATION-SPEED 0)))
                 (SETF NODE (LPARALLEL.PROMISE:FORCE NODE))
                 (IF (TREEP NODE)
                     (BIND
                      (((LEFT-PIVOT . RIGHT-PIVOT) (POINT NODE))
                       (LEFT-DISTANCE
                        (FUNCALL DISTANCE-FUNCTION LEFT-PIVOT OBJECT))
                       (RIGHT-DISTANCE
                        (FUNCALL DISTANCE-FUNCTION RIGHT-PIVOT OBJECT)))
                      (IF (< RIGHT-DISTANCE LEFT-DISTANCE)
                          (~> NODE RIGHT-NODE (IMPL NEW-DEPTH))
                          (~> NODE LEFT-NODE (IMPL NEW-DEPTH))))
                     (VALUES NODE DEPTH))))
        (IMPL NODE 0))))

[statistical-learning/source/tree-protocol/methods.lisp:677]
  (DEFMETHOD #S(FORMGREP:SYMREF :NAME "PICK-SPLIT*/PROXY" :QUALIFIER "SL.TP")
             (SPLITTER/PROXY (SPLITTER HYPERPLANE-SPLITTER) PARAMETERS STATE)
    (DECLARE
     (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0) (SPACE 0) (COMPILATION-SPEED 0)))
    (ITERATE
     (DECLARE
      (TYPE
       #S(FORMGREP:SYMREF
          :NAME "DOUBLE-FLOAT-DATA-MATRIX"
          :QUALIFIER "SL.DATA")
       NORMALS DATA MAX MIN)
      (TYPE FIXNUM I ATTRIBUTES-COUNT)
      (TYPE DOUBLE-FLOAT DOT-PRODUCT)
      (TYPE (SIMPLE-ARRAY FIXNUM (*)) ATTRIBUTES SAMPLES))
     (WITH DOT-PRODUCT = 0.0d0)
     (WITH DATA =
      (#S(FORMGREP:SYMREF :NAME "TRAIN-DATA" :QUALIFIER "SL.MP") STATE))
     (WITH SAMPLES =
      (#S(FORMGREP:SYMREF :NAME "DATA-POINTS" :QUALIFIER "SL.MP") STATE))
     (WITH ATTRIBUTES =
      (#S(FORMGREP:SYMREF :NAME "ATTRIBUTE-INDEXES" :QUALIFIER "SL.TP") STATE))
     (WITH ATTRIBUTES-COUNT = (LENGTH ATTRIBUTES))
     (WITH MAX =
      (ENSURE
       (#S(FORMGREP:SYMREF :NAME "CACHE" :QUALIFIER "SL.MP") STATE 'MAXS)
       (#S(FORMGREP:SYMREF :NAME "MAXS" :QUALIFIER "SL.DATA") DATA :DATA-POINTS
        SAMPLES :ATTRIBUTES ATTRIBUTES)))
     (WITH MIN =
      (ENSURE
       (#S(FORMGREP:SYMREF :NAME "CACHE" :QUALIFIER "SL.MP") STATE 'MINS)
       (#S(FORMGREP:SYMREF :NAME "MINS" :QUALIFIER "SL.DATA") DATA :DATA-POINTS
        SAMPLES :ATTRIBUTES ATTRIBUTES)))
     (WITH NORMALS =
      (#S(FORMGREP:SYMREF :NAME "MAKE-DATA-MATRIX" :QUALIFIER "SL.DATA") 1
       ATTRIBUTES-COUNT))
     (FOR I FROM 0 BELOW ATTRIBUTES-COUNT)
     (SETF (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") NORMALS 0 I)
             (#S(FORMGREP:SYMREF :NAME "RANDOM-GAUSS" :QUALIFIER "SL.RANDOM")
              0.0d0 1.0d0))
     (INCF DOT-PRODUCT
           (*
            (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") NORMALS 0 I)
            (IF (=
                 (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") MIN 0
                  I)
                 (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") MAX 0
                  I))
                (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") MAX 0 I)
                (#S(FORMGREP:SYMREF
                    :NAME "RANDOM-UNIFORM"
                    :QUALIFIER "SL.RANDOM")
                 (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") MIN 0
                  I)
                 (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") MAX 0
                  I)))))
     (FINALLY (RETURN (CONS NORMALS DOT-PRODUCT)))))

[statistical-learning/source/tree-protocol/methods.lisp:740]
  (DEFMETHOD #S(FORMGREP:SYMREF :NAME "LEAF-FOR/PROXY" :QUALIFIER "SL.TP")
             (SPLITTER/PROXY (SPLITTER HYPERPLANE-SPLITTER) NODE DATA INDEX
              CONTEXT)
    (DECLARE
     (TYPE
      #S(FORMGREP:SYMREF :NAME "DOUBLE-FLOAT-DATA-MATRIX" :QUALIFIER "SL.DATA")
      DATA)
     (TYPE FIXNUM INDEX))
    (BIND
     ((ATTRIBUTES (ATTRIBUTE-INDEXES CONTEXT))
      ((:LABELS IMPL (NODE DEPTH &AUX (NEXT-DEPTH (THE FIXNUM (1+ DEPTH)))))
       (DECLARE
        (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0) (SPACE 0)
         (COMPILATION-SPEED 0)))
       (IF (#S(FORMGREP:SYMREF :NAME "TREEP" :QUALIFIER "SL.TP") NODE)
           (BIND (((NORMALS . DOT-PRODUCT) (POINT NODE)))
            (IF (< (WDOT DATA NORMALS INDEX 0 ATTRIBUTES)
                   (THE DOUBLE-FLOAT DOT-PRODUCT))
                (~> NODE RIGHT-NODE (IMPL NEXT-DEPTH))
                (~> NODE LEFT-NODE (IMPL NEXT-DEPTH))))
           (VALUES NODE DEPTH))))
     (IMPL NODE 0)))

[statistical-learning/source/tree-protocol/utils.lisp:16]
  (DEFUN WDOT (FIRST SECOND FIRST-POINT SECOND-POINT ATTRIBUTES)
    (DECLARE
     (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0) (SPACE 0) (COMPILATION-SPEED 0)))
    (ITERATE
     (DECLARE (TYPE FIXNUM I)
              (TYPE DOUBLE-FLOAT RESULT))
     (WITH RESULT = 0.0d0) (FOR I FROM 0 BELOW (LENGTH ATTRIBUTES))
     (FOR ATTRIBUTE = (AREF ATTRIBUTES I))
     (INCF RESULT
           (*
            (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") FIRST
             FIRST-POINT ATTRIBUTE)
            (#S(FORMGREP:SYMREF :NAME "MREF" :QUALIFIER "SL.DATA") SECOND
             SECOND-POINT I)))
     (FINALLY (RETURN RESULT))))

[stmx/doc/benchmark.lisp:1]
  (DECLAIM
   (OPTIMIZE (COMPILATION-SPEED 0) (SPACE 0) (DEBUG 1) (SAFETY 0) (SPEED 3)))

[sucle/src/fps-independent-timestep/fps-independent-timestep.lisp:24]
  (DEFUN MICROSECONDS ()
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((ZEROED-SECONDS
           (LOAD-TIME-VALUE (LOCAL-TIME:TIMESTAMP-TO-UNIX (LOCAL-TIME:NOW)))))
      (DECLARE (TYPE SECONDS ZEROED-SECONDS))
      (MULTIPLE-VALUE-BIND (SEC NSEC)
          (%GET-CURRENT-TIME)
        (DECLARE (TYPE NANOSECOND NSEC)
                 (TYPE SECONDS SEC))
        (+ (* 1000000 (- SEC ZEROED-SECONDS)) (FLOOR NSEC 1000)))))

[sucle/src/image-utility/image-utility.lisp:45]
  (DEFUN NORMALIZE-TO-RGBA-UNDIGNED-BYTE-8 (OPTICL-DATA)
    "Coerce the `opticl-data`, which may have various formats, such as black and white, rgb, or be of 1,2,4,8,16,32 ubyte, to an array with depth 4 and type unsigned-byte 8. This conversion makes some assumptions. Default is t."
    (LET ((DIMENSIONS (ARRAY-DIMENSIONS OPTICL-DATA))
          (TYPE (ARRAY-ELEMENT-TYPE OPTICL-DATA)))
      (WHEN
          (OR (NOT (EQ 'UNSIGNED-BYTE (FIRST TYPE)))
              (MEMBER TYPE '(SINGLE-FLOAT DOUBLE-FLOAT FIXNUM)))
        (ERROR "type not supported"))
      (LET ((CHANNELS (OR (THIRD DIMENSIONS) 1))
            (WIDTH (FIRST DIMENSIONS))
            (HEIGHT (SECOND DIMENSIONS)))
        (IF (AND (EQUAL TYPE '(UNSIGNED-BYTE 8)) (= CHANNELS 4))
            OPTICL-DATA
            (LET ((NEW
                   (MAKE-ARRAY (LIST WIDTH HEIGHT 4) :ELEMENT-TYPE
                               '(UNSIGNED-BYTE 8))))
              (FLET ((U32->8 (N)
                       (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
                       (DECLARE (TYPE (UNSIGNED-BYTE 32) N))
                       (ASH N -24))
                     (U16->8 (N)
                       (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
                       (DECLARE (TYPE (UNSIGNED-BYTE 16) N))
                       (ASH N -8))
                     (U8->8 (N)
                       N)
                     (U4->8 (N)
                       (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
                       (DECLARE (TYPE (UNSIGNED-BYTE 4) N))
                       (* N 17))
                     (U2->8 (N)
                       (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
                       (DECLARE (TYPE (UNSIGNED-BYTE 2) N))
                       (* N 85))
                     (U1->8 (N)
                       (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
                       (DECLARE (TYPE (UNSIGNED-BYTE 1) N))
                       (* N 255)))
                (LET ((CONVERT-FUN
                       (ECASE (SECOND TYPE)
                         (32 #'U32->8)
                         (16 #'U16->8)
                         (8 #'U8->8)
                         (4 #'U4->8)
                         (2 #'U2->8)
                         (1 #'U1->8))))
                  (FLET ((CONVERT-VALUE (VALUE)
                           (FUNCALL CONVERT-FUN VALUE)))
                    (FLET ((DUMP-PIXELS-1 (W H)
                             (LET ((GRAY
                                    (CONVERT-VALUE (AREF OPTICL-DATA W H))))
                               (VALUES GRAY GRAY GRAY 255)))
                           (DUMP-PIXELS-2 (W H)
                             (LET ((GRAY
                                    (CONVERT-VALUE (AREF OPTICL-DATA W H 0)))
                                   (ALPHA
                                    (CONVERT-VALUE (AREF OPTICL-DATA W H 1))))
                               (VALUES GRAY GRAY GRAY ALPHA)))
                           (DUMP-PIXELS-3 (W H)
                             (VALUES (CONVERT-VALUE (AREF OPTICL-DATA W H 0))
                                     (CONVERT-VALUE (AREF OPTICL-DATA W H 1))
                                     (CONVERT-VALUE (AREF OPTICL-DATA W H 2))
                                     255))
                           (DUMP-PIXELS-4 (W H)
                             (VALUES (CONVERT-VALUE (AREF OPTICL-DATA W H 0))
                                     (CONVERT-VALUE (AREF OPTICL-DATA W H 1))
                                     (CONVERT-VALUE (AREF OPTICL-DATA W H 2))
                                     (CONVERT-VALUE (AREF OPTICL-DATA W H 3)))))
                      (LET ((DUMP-PIXELS-FUN
                             (ECASE CHANNELS
                               (1 #'DUMP-PIXELS-1)
                               (2 #'DUMP-PIXELS-2)
                               (3 #'DUMP-PIXELS-3)
                               (4 #'DUMP-PIXELS-4))))
                        (DOTIMES (W WIDTH)
                          (DOTIMES (H HEIGHT)
                            (MULTIPLE-VALUE-BIND (R G B A)
                                (FUNCALL DUMP-PIXELS-FUN W H)
                              (LET ((BASE (* 4 (+ H (* HEIGHT W)))))
                                (SETF (ROW-MAJOR-AREF NEW (+ BASE 0)) R
                                      (ROW-MAJOR-AREF NEW (+ BASE 1)) G
                                      (ROW-MAJOR-AREF NEW (+ BASE 2)) B
                                      (ROW-MAJOR-AREF NEW (+ BASE 3))
                                        A))))))))))
              NEW)))))

[sucle/src/ncurses-clone-for-lem/ncurses-clone.lisp:137]
  (DEFUN GLYPH-VALUE (GLYPH)
    (ETYPECASE GLYPH
      (GLYPH
       (LOCALLY
        (DECLARE (TYPE GLYPH GLYPH)
                 (OPTIMIZE (SPEED 3) (SAFETY 0)))
        (CODE-CHAR
         (LOGAND GLYPH
                 (#S(FORMGREP:SYMREF :NAME "ETOUQ" :QUALIFIER "UTILITY")
                  (1- (ASH 1 *BITS-PER-CHAR-IN-GLYPH*)))))))
      (BIG-GLYPH (BIG-GLYPH-VALUE GLYPH))))

[sucle/src/ncurses-clone-for-lem/ncurses-clone.lisp:146]
  (DEFUN GLYPH-ATTRIBUTES (GLYPH)
    (ETYPECASE GLYPH
      (GLYPH
       (LOCALLY
        (DECLARE (TYPE GLYPH GLYPH)
                 (OPTIMIZE (SPEED 3) (SAFETY 0)))
        (ASH GLYPH -8)))
      (BIG-GLYPH (BIG-GLYPH-ATTRIBUTES GLYPH))))

[sucle/src/ncurses-clone-for-lem/ncurses-clone.lisp:155]
  (DEFUN PREPARE-ATTRIBUTES-FOR-GLYPH (ATTRIBUTES)
    (DECLARE (TYPE GLYPH-ATTRIBUTES ATTRIBUTES))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (ASH ATTRIBUTES 8))

[sucle/src/ncurses-clone-for-lem/ncurses-clone.lisp:167]
  (DEFUN GEN-GLYPH (VALUE ATTRIBUTES)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DECLARE (TYPE GLYPH-ATTRIBUTES ATTRIBUTES))
    (LET ((CODE (CHAR-CODE VALUE)))
      (IF (N-CHAR-FITS-IN-GLYPH CODE)
          (LOGIOR (CHAR-CODE VALUE)
                  (ASH ATTRIBUTES
                       (#S(FORMGREP:SYMREF :NAME "ETOUQ" :QUALIFIER "UTILITY")
                        *BITS-PER-CHAR-IN-GLYPH*)))
          (MAKE-BIG-GLYPH :VALUE VALUE :ATTRIBUTES ATTRIBUTES))))

[sucle/src/opengl/opengl-helper.lisp:1001]
  (DEFUN SLOW-DRAW (GL-THING)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (TYPECASE GL-THING
      (+GLUINT+ (DRAW-DISPLAY-LIST GL-THING))
      (VAO (DRAW-VERTEX-ARRAY GL-THING))
      (GL-LIST (DRAW-DISPLAY-LIST (HANDLE GL-THING)))))

[sucle/src/opengl/opengl-helper.lisp:1009]
  (DEFUN SLOW-DELETE (GL-THING)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (TYPECASE GL-THING
      (+GLUINT+
       (#S(FORMGREP:SYMREF :NAME "DELETE-LISTS" :QUALIFIER "GL") GL-THING 1))
      (VAO (DELETE-VAO GL-THING))
      (GL-LIST
       (#S(FORMGREP:SYMREF :NAME "DELETE-LISTS" :QUALIFIER "GL")
        (HANDLE GL-THING) 1))))

[sucle/src/quads/rectangular-tilemap.lisp:46]
  (PROGN
   (DECLAIM
    (FTYPE (FUNCTION (SIMPLE-VECTOR FIXNUM) (VALUES T T T T))
     INDEX-QUAD-LOOKUP))
   (DEFUN INDEX-QUAD-LOOKUP (ARRAY CODE)
     (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
     (LET ((P (* CODE 4)))
       (DECLARE (TYPE FIXNUM P))
       (VALUES (AREF ARRAY P) (AREF ARRAY (1+ P)) (AREF ARRAY (+ 2 P))
               (AREF ARRAY (+ 3 P))))))

[sucle/src/sucle/block-data.lisp:95]
  (WITH-DECLAIM-INLINE (BLOCK-HASH)
   (DEFUN BLOCK-HASH (I J K)
     (LOCALLY
      (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
               (TYPE
                #S(FORMGREP:SYMREF
                   :NAME "BLOCK-COORD"
                   :QUALIFIER "VOXEL-CHUNKS")
                I J K))
      (LET ((HASH
             (MOD
              (THE
               #S(FORMGREP:SYMREF
                  :NAME "BLOCK-COORD"
                  :QUALIFIER "VOXEL-CHUNKS")
               (* 2654435761
                  (THE
                   #S(FORMGREP:SYMREF
                      :NAME "BLOCK-COORD"
                      :QUALIFIER "VOXEL-CHUNKS")
                   (+ I J K))))
              (ASH 1 32))))
        (VALUES (LOGTEST HASH 4) (LOGTEST HASH 8))))))

[sucle/src/sucle/block-light.lisp:29]
  (DEFUN %LIGHT-NODE (BFS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (TAGBODY
     REP
      (MULTIPLE-VALUE-BIND (PLACE EXISTS?)
          (#S(FORMGREP:SYMREF :NAME "UNIQ-POP" :QUALIFIER "QUEUE") BFS)
        (WHEN EXISTS?
          (LET ((LIGHT-LEVEL
                 (#S(FORMGREP:SYMREF :NAME "%GETLIGHT" :QUALIFIER "WORLD")
                  PLACE)))
            (DECLARE (TYPE (UNSIGNED-BYTE 4) LIGHT-LEVEL))
            (LET ((LOWER-LEVEL (1- LIGHT-LEVEL)))
              (DECLARE (TYPE (SIGNED-BYTE 8) LOWER-LEVEL))
              (MACROLET ((%0CHECK (D OP)
                           (ECLECTOR.READER:QUASIQUOTE
                            (LET ((DISPLACEMENT
                                   ((ECLECTOR.READER:UNQUOTE OP)
                                    (ECLECTOR.READER:UNQUOTE D) PLACE)))
                              (LET ((VAL
                                     (#S(FORMGREP:SYMREF
                                         :NAME "%GETLIGHT"
                                         :QUALIFIER "WORLD")
                                      DISPLACEMENT)))
                                (DECLARE (TYPE (UNSIGNED-BYTE 4) VAL))
                                (WHEN (< VAL LOWER-LEVEL)
                                  (UNLESS
                                      (ISOPAQUE
                                       (#S(FORMGREP:SYMREF
                                           :NAME "%GETBLOCK"
                                           :QUALIFIER "WORLD")
                                        DISPLACEMENT))
                                    (PROGN
                                     (SETF (#S(FORMGREP:SYMREF
                                               :NAME "%GETLIGHT"
                                               :QUALIFIER "WORLD")
                                            DISPLACEMENT)
                                             LOWER-LEVEL)
                                     (BLOCK-DIRTIFY-HASHED DISPLACEMENT))
                                    (#S(FORMGREP:SYMREF
                                        :NAME "UNIQ-PUSH"
                                        :QUALIFIER "QUEUE")
                                     DISPLACEMENT BFS))))))))
                (%0CHECK I-1
                 #S(FORMGREP:SYMREF :NAME "ADD" :QUALIFIER "WORLD"))
                (%0CHECK I+1
                 #S(FORMGREP:SYMREF :NAME "ADD" :QUALIFIER "WORLD"))
                (%0CHECK J-1
                 #S(FORMGREP:SYMREF :NAME "ADD" :QUALIFIER "WORLD"))
                (%0CHECK J+1
                 #S(FORMGREP:SYMREF :NAME "ADD" :QUALIFIER "WORLD"))
                (%0CHECK K-1
                 #S(FORMGREP:SYMREF :NAME "ADD" :QUALIFIER "WORLD"))
                (%0CHECK K+1
                 #S(FORMGREP:SYMREF :NAME "ADD" :QUALIFIER "WORLD")))))
          (GO REP)))))

[sucle/src/sucle/block-light.lisp:71]
  (DEFUN %DE-LIGHT-NODE (BFS LIGHTING-BFS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (TAGBODY
     REP
      (MULTIPLE-VALUE-BIND (PLACE LIGHT-VALUE EXISTS?)
          (#S(FORMGREP:SYMREF :NAME "KV-UNIQ-POP" :QUALIFIER "QUEUE") BFS)
        (DECLARE (TYPE FIXNUM LIGHT-VALUE PLACE))
        (WHEN EXISTS?
          (MACROLET ((CHECK (DISP)
                       (ECLECTOR.READER:QUASIQUOTE
                        (LET ((DISPLACEMENT
                               (#S(FORMGREP:SYMREF
                                   :NAME "ADD"
                                   :QUALIFIER "WORLD")
                                (ECLECTOR.READER:UNQUOTE DISP) PLACE)))
                          (DECLARE (TYPE FIXNUM DISPLACEMENT))
                          (LET ((ADJ-LIGHT-LEVEL
                                 (#S(FORMGREP:SYMREF
                                     :NAME "%GETLIGHT"
                                     :QUALIFIER "WORLD")
                                  DISPLACEMENT)))
                            (DECLARE (TYPE FIXNUM ADJ-LIGHT-LEVEL))
                            (UNLESS (ZEROP ADJ-LIGHT-LEVEL)
                              (IF (< ADJ-LIGHT-LEVEL LIGHT-VALUE)
                                  (PROGN
                                   (PROGN
                                    (SETF (#S(FORMGREP:SYMREF
                                              :NAME "%GETLIGHT"
                                              :QUALIFIER "WORLD")
                                           DISPLACEMENT)
                                            0)
                                    (BLOCK-DIRTIFY-HASHED DISPLACEMENT))
                                   (#S(FORMGREP:SYMREF
                                       :NAME "KV-UNIQ-PUSH"
                                       :QUALIFIER "QUEUE")
                                    DISPLACEMENT ADJ-LIGHT-LEVEL BFS))
                                  (WHEN (>= ADJ-LIGHT-LEVEL LIGHT-VALUE)
                                    (#S(FORMGREP:SYMREF
                                        :NAME "UNIQ-PUSH"
                                        :QUALIFIER "QUEUE")
                                     DISPLACEMENT LIGHTING-BFS)))))))))
            (CHECK I-1)
            (CHECK I+1)
            (CHECK J-1)
            (CHECK J+1)
            (CHECK K-1)
            (CHECK K+1))
          (GO REP))))
    LIGHTING-BFS)

[sucle/src/sucle/block-light.lisp:108]
  (DEFUN %SKY-LIGHT-NODE (BFS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (TAGBODY
     REP
      (MULTIPLE-VALUE-BIND (PLACE EXISTS?)
          (#S(FORMGREP:SYMREF :NAME "UNIQ-POP" :QUALIFIER "QUEUE") BFS)
        (WHEN EXISTS?
          (LET ((LIGHT-LEVEL
                 (#S(FORMGREP:SYMREF :NAME "%SKYGETLIGHT" :QUALIFIER "WORLD")
                  PLACE)))
            (DECLARE (TYPE (UNSIGNED-BYTE 4) LIGHT-LEVEL))
            (LET ((LOWER-LEVEL (1- LIGHT-LEVEL)))
              (DECLARE (TYPE (SIGNED-BYTE 4) LOWER-LEVEL))
              (MACROLET ((%0CHECK (DISP)
                           (ECLECTOR.READER:QUASIQUOTE
                            (LET ((DISPLACEMENT
                                   (#S(FORMGREP:SYMREF
                                       :NAME "ADD"
                                       :QUALIFIER "WORLD")
                                    PLACE (ECLECTOR.READER:UNQUOTE DISP))))
                              (DECLARE (TYPE FIXNUM DISPLACEMENT))
                              (LET ((VAL
                                     (#S(FORMGREP:SYMREF
                                         :NAME "%SKYGETLIGHT"
                                         :QUALIFIER "WORLD")
                                      DISPLACEMENT)))
                                (DECLARE (TYPE (UNSIGNED-BYTE 4) VAL))
                                (WHEN (< VAL LOWER-LEVEL)
                                  (UNLESS
                                      (ISOPAQUE
                                       (#S(FORMGREP:SYMREF
                                           :NAME "%GETBLOCK"
                                           :QUALIFIER "WORLD")
                                        DISPLACEMENT))
                                    (PROGN
                                     (SETF (#S(FORMGREP:SYMREF
                                               :NAME "%SKYGETLIGHT"
                                               :QUALIFIER "WORLD")
                                            DISPLACEMENT)
                                             LOWER-LEVEL)
                                     (BLOCK-DIRTIFY-HASHED DISPLACEMENT))
                                    (#S(FORMGREP:SYMREF
                                        :NAME "UNIQ-PUSH"
                                        :QUALIFIER "QUEUE")
                                     DISPLACEMENT BFS)))))))
                         (DOWNCHECK (DISP)
                           (ECLECTOR.READER:QUASIQUOTE
                            (LET ((DISPLACEMENT
                                   (#S(FORMGREP:SYMREF
                                       :NAME "ADD"
                                       :QUALIFIER "WORLD")
                                    PLACE (ECLECTOR.READER:UNQUOTE DISP))))
                              (DECLARE (TYPE FIXNUM DISPLACEMENT))
                              (LET ((VAL
                                     (#S(FORMGREP:SYMREF
                                         :NAME "%SKYGETLIGHT"
                                         :QUALIFIER "WORLD")
                                      DISPLACEMENT)))
                                (DECLARE (TYPE (UNSIGNED-BYTE 4) VAL))
                                (WHEN (< VAL 15)
                                  (UNLESS
                                      (OR
                                       (ISOPAQUE
                                        (#S(FORMGREP:SYMREF
                                            :NAME "%GETBLOCK"
                                            :QUALIFIER "WORLD")
                                         DISPLACEMENT))
                                       (> J+1 DISPLACEMENT))
                                    (PROGN
                                     (SETF (#S(FORMGREP:SYMREF
                                               :NAME "%SKYGETLIGHT"
                                               :QUALIFIER "WORLD")
                                            DISPLACEMENT)
                                             15)
                                     (BLOCK-DIRTIFY-HASHED DISPLACEMENT))
                                    (#S(FORMGREP:SYMREF
                                        :NAME "UNIQ-PUSH"
                                        :QUALIFIER "QUEUE")
                                     DISPLACEMENT BFS))))))))
                (%0CHECK I-1)
                (%0CHECK I+1)
                (IF (= 15 LIGHT-LEVEL)
                    (DOWNCHECK J-1)
                    (%0CHECK J-1))
                (%0CHECK J+1)
                (%0CHECK K-1)
                (%0CHECK K+1))))
          (GO REP)))))

[sucle/src/sucle/block-light.lisp:167]
  (DEFUN %SKY-DE-LIGHT-NODE (BFS LIGHTING-BFS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (TAGBODY
     REP
      (MULTIPLE-VALUE-BIND (PLACE LIGHT-VALUE EXISTS?)
          (#S(FORMGREP:SYMREF :NAME "KV-UNIQ-POP" :QUALIFIER "QUEUE") BFS)
        (DECLARE (TYPE (UNSIGNED-BYTE 4) LIGHT-VALUE))
        (WHEN EXISTS?
          (MACROLET ((CHECK (DISP)
                       (ECLECTOR.READER:QUASIQUOTE
                        (LET ((DISPLACEMENT
                               (#S(FORMGREP:SYMREF
                                   :NAME "ADD"
                                   :QUALIFIER "WORLD")
                                (ECLECTOR.READER:UNQUOTE DISP) PLACE)))
                          (DECLARE (TYPE FIXNUM DISPLACEMENT))
                          (LET ((ADJ-LIGHT-LEVEL
                                 (#S(FORMGREP:SYMREF
                                     :NAME "%SKYGETLIGHT"
                                     :QUALIFIER "WORLD")
                                  DISPLACEMENT)))
                            (DECLARE (TYPE (UNSIGNED-BYTE 4) ADJ-LIGHT-LEVEL))
                            (UNLESS (ZEROP ADJ-LIGHT-LEVEL)
                              (IF (< ADJ-LIGHT-LEVEL LIGHT-VALUE)
                                  (PROGN
                                   (PROGN
                                    (SETF (#S(FORMGREP:SYMREF
                                              :NAME "%SKYGETLIGHT"
                                              :QUALIFIER "WORLD")
                                           DISPLACEMENT)
                                            0)
                                    (BLOCK-DIRTIFY-HASHED DISPLACEMENT))
                                   (#S(FORMGREP:SYMREF
                                       :NAME "KV-UNIQ-PUSH"
                                       :QUALIFIER "QUEUE")
                                    DISPLACEMENT ADJ-LIGHT-LEVEL BFS))
                                  (#S(FORMGREP:SYMREF
                                      :NAME "UNIQ-PUSH"
                                      :QUALIFIER "QUEUE")
                                   DISPLACEMENT LIGHTING-BFS))))))))
            (CHECK I-1)
            (CHECK I+1)
            (IF (= 15 LIGHT-VALUE)
                (LET ((DISPLACEMENT
                       (#S(FORMGREP:SYMREF :NAME "ADD" :QUALIFIER "WORLD") J-1
                        PLACE)))
                  (UNLESS
                      (OR
                       (ISOPAQUE
                        (#S(FORMGREP:SYMREF
                            :NAME "%GETBLOCK"
                            :QUALIFIER "WORLD")
                         DISPLACEMENT))
                       (> J+1 DISPLACEMENT))
                    (LET ((ADJ-LIGHT-LEVEL
                           (#S(FORMGREP:SYMREF
                               :NAME "%SKYGETLIGHT"
                               :QUALIFIER "WORLD")
                            DISPLACEMENT)))
                      (PROGN
                       (SETF (#S(FORMGREP:SYMREF
                                 :NAME "%SKYGETLIGHT"
                                 :QUALIFIER "WORLD")
                              DISPLACEMENT)
                               0)
                       (BLOCK-DIRTIFY-HASHED DISPLACEMENT))
                      (#S(FORMGREP:SYMREF
                          :NAME "KV-UNIQ-PUSH"
                          :QUALIFIER "QUEUE")
                       DISPLACEMENT ADJ-LIGHT-LEVEL BFS))))
                (CHECK J-1))
            (CHECK J+1)
            (CHECK K-1)
            (CHECK K+1))
          (GO REP))))
    LIGHTING-BFS)

[sucle/src/sucle/render.lisp:398]
  (DEFUN RENDER-AABB-AT (AABB X Y Z &OPTIONAL (R 0.1) (G 0.1) (B 0.1))
    (LET ((ITERATOR
           (#S(FORMGREP:SYMREF
               :NAME "MY-ITERATOR"
               :QUALIFIER "SCRATCH-BUFFER"))))
      (LET ((TIMES (DRAW-AABB X Y Z AABB ITERATOR)))
        (DECLARE (TYPE FIXNUM TIMES)
                 (OPTIMIZE (SPEED 3) (SAFETY 0)))
        (LET ((BOX
               (#S(FORMGREP:SYMREF
                   :NAME "FLUSH-BIND-IN*"
                   :QUALIFIER "SCRATCH-BUFFER")
                ((ITERATOR XYZ))
                (#S(FORMGREP:SYMREF
                    :NAME "CREATE-VAO-OR-DISPLAY-LIST-FROM-SPECS"
                    :QUALIFIER "GLHELP")
                 (:QUADS TIMES)
                 ((*COLOR-ATTR* R G B) (*POSITION-ATTR* (XYZ) (XYZ) (XYZ)))))))
          (#S(FORMGREP:SYMREF :NAME "SLOW-DRAW" :QUALIFIER "GLHELP") BOX)
          (#S(FORMGREP:SYMREF :NAME "SLOW-DELETE" :QUALIFIER "GLHELP") BOX)))))

[sucle/src/sucle/render.lisp:572]
  (DEFUN DRAW-WORLD
         (
          &OPTIONAL (VEC *CALL-LISTS*)
          &AUX (COUNT-OCCLUDED-BY-QUERY 0) (COUNT-ACTUALLY-DRAWN 0)
          (COUNT-OVERRIDDEN 0))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE FIXNUM COUNT-ACTUALLY-DRAWN COUNT-OCCLUDED-BY-QUERY))
    (DECLARE (OPTIMIZE (DEBUG 3) (SAFETY 3)))
    (LOOP :FOR VALUE :ACROSS VEC
          :DO (LET ((DISPLAY-LIST (CHUNK-GL-REPRESENTATION-CALL-LIST VALUE))
                    (QUERY (CHUNK-GL-REPRESENTATION-OCCLUSION-QUERY VALUE)))
                (COND
                 ((AND *OCCLUSION-CULLING-P*
                       (NOT
                        (EQ (CHUNK-GL-REPRESENTATION-OCCLUSION-STATE VALUE)
                            :INIT)))
                  (LET ((AVAILABLE
                         (#S(FORMGREP:SYMREF
                             :NAME "GET-QUERY-OBJECT"
                             :QUALIFIER "GL")
                          QUERY :QUERY-RESULT-AVAILABLE)))
                    (WHEN AVAILABLE
                      (LET ((RESULT
                             (#S(FORMGREP:SYMREF
                                 :NAME "GET-QUERY-OBJECT"
                                 :QUALIFIER "GL")
                              QUERY :QUERY-RESULT))
                            (DT
                             (- *FRAME-TIME*
                                (CHUNK-GL-REPRESENTATION-QUERY-FRAME-TIME
                                 VALUE))))
                        (COND
                         ((AND (= 0 RESULT) (< DT *FRAME-TIME-LIMIT*))
                          (SET-CHUNK-GL-REPRESENTATION-HIDDEN VALUE)
                          (DECF (CHUNK-GL-REPRESENTATION-DRAW-OVERRIDE VALUE)))
                         (T (SET-CHUNK-GL-REPRESENTATION-VISIBLE VALUE)
                          (SETF (CHUNK-GL-REPRESENTATION-DRAW-OVERRIDE VALUE)
                                  0)))))))
                 (T (SET-CHUNK-GL-REPRESENTATION-VISIBLE VALUE)))
                (LET ((OVERRIDDEN-P
                       (AND *OCCLUSION-CULLING-P*
                            (PLUSP
                             (CHUNK-GL-REPRESENTATION-DRAW-OVERRIDE VALUE)))))
                  (COND
                   ((OR (NOT (CHUNK-GL-REPRESENTATION-OCCLUDED VALUE))
                        OVERRIDDEN-P)
                    (INCF COUNT-ACTUALLY-DRAWN)
                    (SYMBOL-MACROLET ((OCCLUSION-STATE
                                       (CHUNK-GL-REPRESENTATION-OCCLUSION-STATE
                                        VALUE)))
                      (COND
                       ((AND *OCCLUSION-CULLING-P*
                             (NOT (EQ OCCLUSION-STATE :WAITING)))
                        (LET ((QUERY
                               (CHUNK-GL-REPRESENTATION-OCCLUSION-QUERY VALUE)))
                          (SETF OCCLUSION-STATE :WAITING)
                          (#S(FORMGREP:SYMREF
                              :NAME "BEGIN-QUERY"
                              :QUALIFIER "GL")
                           :SAMPLES-PASSED QUERY)
                          (#S(FORMGREP:SYMREF
                              :NAME "SLOW-DRAW"
                              :QUALIFIER "GLHELP")
                           DISPLAY-LIST)
                          (SETF (CHUNK-GL-REPRESENTATION-QUERY-FRAME-TIME
                                 VALUE)
                                  *FRAME-TIME*)
                          (#S(FORMGREP:SYMREF
                              :NAME "END-QUERY"
                              :QUALIFIER "GL")
                           :SAMPLES-PASSED)))
                       (T
                        (#S(FORMGREP:SYMREF
                            :NAME "SLOW-DRAW"
                            :QUALIFIER "GLHELP")
                         DISPLAY-LIST))))
                    (WHEN OVERRIDDEN-P (INCF COUNT-OVERRIDDEN)))
                   (T (INCF COUNT-OCCLUDED-BY-QUERY))))))
    (VALUES COUNT-ACTUALLY-DRAWN COUNT-OCCLUDED-BY-QUERY COUNT-OVERRIDDEN))

[sucle/src/sucle/util.lisp:6]
  (DEFUN SPREAD
         (
          &OPTIONAL
          (OBJ
           (#S(FORMGREP:SYMREF :NAME "VEC" :QUALIFIER "SB-CGA") 1.0 2.0 3.0)))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (SYMBOL-MACROLET ((ARRAY-CODE
                       (LET ((SIZE (ARRAY-TOTAL-SIZE OBJ)))
                         (CASE SIZE
                           (0 (VALUES))
                           (1 (VALUES (AREF OBJ 0)))
                           (2 (VALUES (AREF OBJ 0) (AREF OBJ 1)))
                           (3 (VALUES (AREF OBJ 0) (AREF OBJ 1) (AREF OBJ 2)))
                           (4
                            (VALUES (AREF OBJ 0) (AREF OBJ 1) (AREF OBJ 2)
                                    (AREF OBJ 3)))
                           (OTHERWISE (VALUES-LIST (COERCE OBJ 'LIST)))))))
      (ETYPECASE OBJ
        (LIST
         (LET ((SIZE (LIST-LENGTH OBJ)))
           (IF SIZE
               (VALUES-LIST OBJ)
               (ERROR "Attempting to call values-list on a circular list!"))))
        (SIMPLE-STRING ARRAY-CODE)
        ((SIMPLE-ARRAY SINGLE-FLOAT (*)) ARRAY-CODE)
        ((SIMPLE-ARRAY T (*)) ARRAY-CODE))))

[sucle/src/sucle/util.lisp:40]
  (DEFUN TEST-SPREAD ()
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (TIME (DOTIMES (X (EXPT 10 6)) (SPREAD))))

[sucle/src/sucle/voxel-chunks.lisp:783]
  (DEFUN GET-CHUNKS-TO-LOAD (CHUNK-CURSOR-CENTER)
    (MULTIPLE-VALUE-BIND (CX CY CZ)
        (VALUES (CURSOR-X CHUNK-CURSOR-CENTER) (CURSOR-Y CHUNK-CURSOR-CENTER)
                (CURSOR-Z CHUNK-CURSOR-CENTER))
      (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
               (TYPE CHUNK-COORD CX CY CZ))
      (BLOCK OUT
        (LET* ((ACC NIL)
               (CHUNK-COUNT 0)
               (SIZE (CURSOR-RADIUS CHUNK-CURSOR-CENTER))
               (MINX (- CX SIZE))
               (MAXX (+ CX SIZE))
               (MINY (- CY SIZE))
               (MAXY (+ CY SIZE))
               (MINZ (- CZ SIZE))
               (MAXZ (+ CZ SIZE)))
          (DECLARE (TYPE FIXNUM CHUNK-COUNT)
                   (TYPE CHUNK-COORD SIZE)
                   (TYPE CHUNK-COORD MINX MAXX MINY MAXY MINZ MAXZ))
          (FLET ((ADD-CHUNK (X Y Z)
                   (INCF CHUNK-COUNT)
                   (LET ((KEY (CREATE-CHUNK-KEY X Y Z)))
                     (WHEN (CA-UNCACHED-P KEY) (PUSH KEY ACC)))))
            (#S(FORMGREP:SYMREF :NAME "DOBOX" :QUALIFIER "UTILITY")
             ((CHUNK-X MINX MAXX) (CHUNK-Y MINY MAXY) (CHUNK-Z MINZ MAXZ))
             (ADD-CHUNK CHUNK-X CHUNK-Y CHUNK-Z)))
          ACC))))

[sucle/src/text-subsystem/text-subsystem.lisp:349]
  (#S(FORMGREP:SYMREF :NAME "DEFLAZY-GL" :QUALIFIER "GLHELP") INDIRECTION
   ((W #S(FORMGREP:SYMREF :NAME "W" :QUALIFIER "APPLICATION"))
    (H #S(FORMGREP:SYMREF :NAME "H" :QUALIFIER "APPLICATION")) BLOCK-W BLOCK-H)
   (LET* ((UPW (POWER-OF-2-CEILING W))
          (UPH (POWER-OF-2-CEILING H))
          (NEED-TO-UPDATE-SIZE
           (NOT
            (AND (= *INDIRECTION-WIDTH* UPW) (= *INDIRECTION-HEIGHT* UPH)))))
     (WHEN NEED-TO-UPDATE-SIZE
       (SETF *INDIRECTION-WIDTH* UPW
             *INDIRECTION-HEIGHT* UPH)
       (#S(FORMGREP:SYMREF :NAME "REFRESH" :QUALIFIER "DEFLAZY") 'INDIRECTION
        T))
     (LET ((INDIRECTION
            (MAKE-TEXTURE-OR-FRAMEBUFFER *INDIRECTION-WHAT-TYPE* UPW UPH)))
       (ETYPECASE INDIRECTION
         (#S(FORMGREP:SYMREF :NAME "GL-FRAMEBUFFER" :QUALIFIER "GLHELP")
          (LET ((REFRACT INDIRECTION-SHADER))
            (#S(FORMGREP:SYMREF :NAME "USE-GL-PROGRAM" :QUALIFIER "GLHELP")
             REFRACT)
            (#S(FORMGREP:SYMREF :NAME "WITH-UNIFORMS" :QUALIFIER "GLHELP")
             UNIFORM REFRACT
             (#S(FORMGREP:SYMREF :NAME "UNIFORM-MATRIX-4FV" :QUALIFIER "GL")
              (UNIFORM :PMV)
              (LOAD-TIME-VALUE
               (#S(FORMGREP:SYMREF
                   :NAME "IDENTITY-MATRIX"
                   :QUALIFIER "SB-CGA")))
              NIL)
             (#S(FORMGREP:SYMREF :NAME "UNIFORMF" :QUALIFIER "GL")
              (UNIFORM 'SIZE) (/ W BLOCK-W) (/ H BLOCK-H))))
          (#S(FORMGREP:SYMREF :NAME "DISABLE" :QUALIFIER "GL") :CULL-FACE)
          (#S(FORMGREP:SYMREF :NAME "DISABLE" :QUALIFIER "GL") :DEPTH-TEST)
          (#S(FORMGREP:SYMREF :NAME "DISABLE" :QUALIFIER "GL") :BLEND)
          (#S(FORMGREP:SYMREF :NAME "SET-RENDER-AREA" :QUALIFIER "GLHELP") 0 0
           UPW UPH)
          (#S(FORMGREP:SYMREF :NAME "BIND-FRAMEBUFFER" :QUALIFIER "GL")
           :FRAMEBUFFER
           (#S(FORMGREP:SYMREF :NAME "HANDLE" :QUALIFIER "GLHELP")
            INDIRECTION))
          (#S(FORMGREP:SYMREF :NAME "CLEAR" :QUALIFIER "GL") :COLOR-BUFFER-BIT)
          (#S(FORMGREP:SYMREF :NAME "CLEAR" :QUALIFIER "GL") :DEPTH-BUFFER-BIT)
          (#S(FORMGREP:SYMREF :NAME "SLOW-DRAW" :QUALIFIER "GLHELP")
           FULLSCREEN-QUAD))
         (#S(FORMGREP:SYMREF :NAME "GL-TEXTURE" :QUALIFIER "GLHELP")
          (#S(FORMGREP:SYMREF :NAME "BIND-TEXTURE" :QUALIFIER "GL") :TEXTURE-2D
           (#S(FORMGREP:SYMREF :NAME "HANDLE" :QUALIFIER "GLHELP")
            INDIRECTION))
          (CFFI:WITH-FOREIGN-OBJECT (DATA :UINT8 (* UPW UPH 4))
            (LET* ((UPH2 (THE FIXNUM (* 2 UPH)))
                   (UPW2 (THE FIXNUM (* 2 UPW)))
                   (TEMPX (* UPW2 BLOCK-W))
                   (TEMPY (* UPH2 BLOCK-H)))
              (LOOP :FOR X :FROM 0 :BELOW UPW2 :BY 2
                    :DO (LET* ((TEX-X (* W (+ 1 X)))
                               (MOD-TEX-X-TEMPX (MOD TEX-X TEMPX))
                               (BARX (FOOBAR (* 255 MOD-TEX-X-TEMPX) TEMPX))
                               (FOOX (/ (- TEX-X MOD-TEX-X-TEMPX) TEMPX))
                               (BASE (* 2 X))
                               (DELTA (* 2 UPW2)))
                          (DECLARE (TYPE FIXNUM BASE)
                                   (TYPE (UNSIGNED-BYTE 8) BARX FOOX)
                                   (OPTIMIZE (SPEED 3) (SAFETY 0)))
                          (LOOP :REPEAT (THE FIXNUM UPH)
                                :DO (SETF (CFFI:MEM-REF DATA :UINT8 (+ BASE 0))
                                            BARX
                                          (CFFI:MEM-REF DATA :UINT8 (+ BASE 2))
                                            FOOX) (SETF BASE
                                                          (THE FIXNUM
                                                               (+ BASE
                                                                  DELTA))))))
              (LOOP :FOR Y :FROM 0 :BELOW UPH2 :BY 2
                    :DO (LET* ((TEX-Y (* H (+ 1 Y)))
                               (MOD-TEX-Y-TEMPY (MOD TEX-Y TEMPY))
                               (BARY (FOOBAR (* 255 MOD-TEX-Y-TEMPY) TEMPY))
                               (FOOY (/ (- TEX-Y MOD-TEX-Y-TEMPY) TEMPY))
                               (BASE (* UPW2 Y)))
                          (DECLARE (TYPE FIXNUM BASE)
                                   (TYPE (UNSIGNED-BYTE 8) BARY FOOY)
                                   (OPTIMIZE (SPEED 3) (SAFETY 0)))
                          (LOOP :REPEAT (THE FIXNUM UPW)
                                :DO (SETF (CFFI:MEM-REF DATA :UINT8 (+ BASE 1))
                                            BARY
                                          (CFFI:MEM-REF DATA :UINT8 (+ BASE 3))
                                            FOOY) (SETF BASE
                                                          (THE FIXNUM
                                                               (+ BASE 4)))))))
            (#S(FORMGREP:SYMREF :NAME "TEX-IMAGE-2D" :QUALIFIER "GL")
             :TEXTURE-2D 0 :RGBA UPW UPH 0 :RGBA :UNSIGNED-BYTE DATA))))
       INDIRECTION)))

[swap-bytes/ccl.lisp:30]
  (DEFUN #S(FORMGREP:SYMREF :NAME "%SWAP-BYTES-64" :QUALIFIER "SWAP-BYTES")
         (INTEGER)
    (DECLARE (TYPE (UNSIGNED-BYTE 64) INTEGER)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (LOGIOR
     (#S(FORMGREP:SYMREF :NAME "SWAP-BYTES-32" :QUALIFIER "SWAP-BYTES")
      (LDB (BYTE 32 32) INTEGER))
     (ASH
      (#S(FORMGREP:SYMREF :NAME "SWAP-BYTES-32" :QUALIFIER "SWAP-BYTES")
       (LDB (BYTE 32 0) INTEGER))
      32)))

[swap-bytes/network.lisp:7]
  (DEFUN HTONS (INTEGER)
    "Convert (unsigned-byte 16) from host order(little- or big-endian)
to network order(always big-endian)."
    (DECLARE (TYPE (UNSIGNED-BYTE 16) INTEGER)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (SWAP-BYTES-16 INTEGER)
    INTEGER)

[swap-bytes/network.lisp:15]
  (DEFUN NTOHS (INTEGER)
    "Convert (unsigned-byte 16) from network order(always big-endian) to
host order(little- or big-endian)."
    (DECLARE (TYPE (UNSIGNED-BYTE 16) INTEGER)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (SWAP-BYTES-16 INTEGER)
    INTEGER)

[swap-bytes/network.lisp:23]
  (DEFUN HTONL (INTEGER)
    "Convert (unsigned-byte 32) from host order(little- or big-endian)
to network order(always big-endian)."
    (DECLARE (TYPE (UNSIGNED-BYTE 32) INTEGER)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (SWAP-BYTES-32 INTEGER)
    INTEGER)

[swap-bytes/network.lisp:31]
  (DEFUN NTOHL (INTEGER)
    "Convert (unsigned-byte 32) from network order(always big-endian) to
host order(little- or big-endian)."
    (DECLARE (TYPE (UNSIGNED-BYTE 32) INTEGER)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (SWAP-BYTES-32 INTEGER)
    INTEGER)

[swap-bytes/network.lisp:39]
  (DEFUN HTONQ (INTEGER)
    "Convert (unsigned-byte 64) from host order(little- or big-endian)
to network order(always big-endian)."
    (DECLARE (TYPE (UNSIGNED-BYTE 64) INTEGER)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (SWAP-BYTES-64 INTEGER)
    INTEGER)

[swap-bytes/network.lisp:47]
  (DEFUN NTOHQ (INTEGER)
    "Convert (unsigned-byte 64) from network order(always big-endian) to
host order(little- or big-endian)."
    (DECLARE (TYPE (UNSIGNED-BYTE 64) INTEGER)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (SWAP-BYTES-64 INTEGER)
    INTEGER)

[swap-bytes/portable.lisp:7]
  (DEFUN SWAP-BYTES-16 (INTEGER)
    (DECLARE (TYPE (UNSIGNED-BYTE 16) INTEGER)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (LOGIOR (ASH (LOGAND 255 INTEGER) 8) (ASH INTEGER -8)))

[swap-bytes/portable.lisp:13]
  (DEFUN SWAP-BYTES-32 (INTEGER)
    (DECLARE (TYPE (UNSIGNED-BYTE 32) INTEGER)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (LOGIOR (ASH (LOGAND 255 INTEGER) 24) (ASH (LOGAND 65280 INTEGER) 8)
            (ASH (LOGAND 16711680 INTEGER) -8) (ASH INTEGER -24)))

[swap-bytes/portable.lisp:21]
  (DEFUN SWAP-BYTES-64 (INTEGER)
    (DECLARE (TYPE (UNSIGNED-BYTE 64) INTEGER)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (MACROLET ((SHIFT (MASK SHIFT)
                 (ECLECTOR.READER:QUASIQUOTE
                  (ASH (LOGAND (ECLECTOR.READER:UNQUOTE MASK) INTEGER)
                       (ECLECTOR.READER:UNQUOTE SHIFT)))))
      (LOGIOR (SHIFT 255 56) (SHIFT 65280 40) (SHIFT 16711680 24)
              (SHIFT 4278190080 8) (SHIFT 1095216660480 -8)
              (SHIFT 280375465082880 -24) (SHIFT 71776119061217280 -40)
              (ASH INTEGER -56))))

[swap-bytes/sbcl.lisp:14]
  (DEFUN SWAP-BYTES-64 (INTEGER)
    (DECLARE (TYPE (UNSIGNED-BYTE 64) INTEGER)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0)))
    (LOGIOR (SWAP-BYTES-32 (LDB (BYTE 32 32) INTEGER))
            (ASH (SWAP-BYTES-32 (LDB (BYTE 32 0) INTEGER)) 32)))

[sycamore/src/util.lisp:157]
  (DEFUN BIT-VECTOR-COMPARE (A B)
    "Compare bitvectors `A' and `B'."
    (DECLARE (TYPE SIMPLE-BIT-VECTOR A B)
             (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET* ((N-A (LENGTH A)) (N-B (LENGTH B)))
      (OR-COMPARE (FIXNUM-COMPARE N-A N-B)
       (LET ((I (MISMATCH A B)))
         (IF I
             (LET ((X (AREF A I)) (Y (AREF B I)))
               (- X Y))
             0)))))

[sycamore/src/util.lisp:173]
  (DEFUN GSYMBOL-COMPARE-ATOM (A B)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (IF (EQ A B)
        0
        (ETYPECASE A
          (FIXNUM
           (ETYPECASE B
             (FIXNUM
              (IF (< A B)
                  -1
                  1))
             (CHARACTER 1)
             (STRING 1)
             (SYMBOL 1)))
          (CHARACTER
           (ETYPECASE B
             (FIXNUM -1)
             (CHARACTER
              (IF (< (CHAR-CODE A) (CHAR-CODE B))
                  -1
                  1))
             (STRING 1)
             (SYMBOL 1)))
          (STRING
           (ETYPECASE B
             (FIXNUM -1)
             (CHARACTER -1)
             (STRING (STRING-COMPARE A B))
             (SYMBOL 1)))
          (SYMBOL
           (ETYPECASE B
             (FIXNUM -1)
             (CHARACTER -1)
             (STRING -1)
             (SYMBOL (COND ((STRING< A B) -1) ((STRING> A B) 1) (T 0))))))))

[trees/rt.lisp:56]
  (DEFVAR *OPTIMIZATION-SETTINGS* '((SAFETY 3)))

[trivia/bench/run.lisp:2]
  (RUN-BENCHMARKS '((SPEED 3) (DEBUG 0) (SPACE 0) (SAFETY 0)))

[trivia/test/fset.lisp:12]
  (DEFMACRO IS-MATCH (ARG &BODY PATTERN)
    (ECLECTOR.READER:QUASIQUOTE
     (IS-TRUE
      (LOCALLY
       (DECLARE (OPTIMIZE (SAFETY 3) (DEBUG 3) (SPEED 0)))
       (MATCH (ECLECTOR.READER:UNQUOTE ARG)
        ((ECLECTOR.READER:UNQUOTE-SPLICING PATTERN) T)))
      (ECLECTOR.READER:UNQUOTE
       (FORMAT NIL "~<pattern ~a did not match against arg ~s~:@>"
               (LIST PATTERN ARG))))))

[trivia/test/level2.lisp:26]
  (DEFMACRO IS-MATCH (ARG &BODY PATTERN)
    (ECLECTOR.READER:QUASIQUOTE
     (IS-TRUE
      (LOCALLY
       (DECLARE (OPTIMIZE (SAFETY 3) (DEBUG 3) (SPEED 0)))
       (MATCH (ECLECTOR.READER:UNQUOTE ARG)
        ((ECLECTOR.READER:UNQUOTE-SPLICING PATTERN) T)))
      (ECLECTOR.READER:UNQUOTE
       (FORMAT NIL "~<pattern ~a did not match against arg ~s~:@>"
               (LIST PATTERN ARG))))))

[trivia/test/level2.lisp:32]
  (DEFMACRO IS-NOT-MATCH (ARG &BODY PATTERN)
    (ECLECTOR.READER:QUASIQUOTE
     (IS-FALSE
      (LOCALLY
       (DECLARE (OPTIMIZE (SAFETY 3) (DEBUG 3) (SPEED 0)))
       (MATCH (ECLECTOR.READER:UNQUOTE ARG)
        ((ECLECTOR.READER:UNQUOTE-SPLICING PATTERN) T)))
      (ECLECTOR.READER:UNQUOTE
       (FORMAT NIL "~<pattern ~a matched against arg ~s~:@>"
               (LIST PATTERN ARG))))))

[trivial-backtrace/test/tests.lisp:6]
  (ADDTEST (GENERATES-BACKTRACE) TEST-1
   (LET ((OUTPUT NIL))
     (HANDLER-CASE
      (LET ((X 1))
        (LET ((Y (- X (EXPT 1024 0))))
          (DECLARE (OPTIMIZE (SAFETY 3)))
          (/ 2 Y)))
      (ERROR (C) (SETF OUTPUT (PRINT-BACKTRACE C :OUTPUT NIL))))
     (ENSURE (STRINGP OUTPUT))
     (ENSURE (PLUSP (LENGTH OUTPUT)))))

[trivial-backtrace/test/tests.lisp:19]
  (ADDTEST (GENERATES-BACKTRACE) GENERATES-BACKTRACE-TO-STRING-STREAM
   (LET ((OUTPUT NIL))
     (HANDLER-CASE
      (LET ((X 1))
        (LET ((Y (- X (EXPT 1024 0))))
          (DECLARE (OPTIMIZE (SAFETY 3)))
          (/ 2 Y)))
      (ERROR (C)
             (SETF OUTPUT
                     (WITH-OUTPUT-TO-STRING (STREAM)
                       (PRINT-BACKTRACE C :OUTPUT NIL)))))
     (ENSURE (STRINGP OUTPUT))
     (ENSURE (PLUSP (LENGTH OUTPUT)))))

[trivial-types/src/specials.lisp:3]
  (DEFVAR *STANDARD-OPTIMIZE-QUALITIES*
    '((SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 1) (COMPILATION-SPEED 0)))

[trivial-utf-8/trivial-utf-8.lisp:26]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (DEFPARAMETER *OPTIMIZE*
      '(OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 1)
        (COMPILATION-SPEED 0))))

[trucler/Code/Implementations/Native/SBCL/describe-optimize.lisp:7]
  (DEFMETHOD #S(FORMGREP:SYMREF :NAME "DESCRIBE-OPTIMIZE" :QUALIFIER "TRUCLER")
             ((CLIENT CLIENT) (ENV SB-KERNEL:LEXENV))
    (LET ((POLICY (OR (SB-C::LEXENV-POLICY ENV) SB-C::*POLICY*)))
      (MAKE-INSTANCE 'OPTIMIZE-DESCRIPTION :SPEED
                     (SB-C::POLICY-QUALITY POLICY 'SPEED) :COMPILATION-SPEED
                     (SB-C::POLICY-QUALITY POLICY 'COMPILATION-SPEED) :DEBUG
                     (SB-C::POLICY-QUALITY POLICY 'DEBUG) :SPACE
                     (SB-C::POLICY-QUALITY POLICY 'SPACE) :SAFETY
                     (SB-C::POLICY-QUALITY POLICY 'SAFETY))))

[trucler/Code/Implementations/Native/Test/lexical-assertions.lisp:147]
  (DEFMACRO ASSERT-OPTIMIZE-DESCRIPTION
            (
             &KEY (SPEED NIL SPEED-P)
             (COMPILATION-SPEED NIL COMPILATION-SPEED-P) (DEBUG NIL DEBUG-P)
             (SPACE NIL SPACE-P) (SAFETY NIL SAFETY-P) &ENVIRONMENT ENV)
    (LET ((DESCRIPTION
           (#S(FORMGREP:SYMREF :NAME "DESCRIBE-OPTIMIZE" :QUALIFIER "TRUCLER")
            *CLIENT* ENV)))
      (CHECK-TYPE DESCRIPTION
                  #S(FORMGREP:SYMREF
                     :NAME "OPTIMIZE-DESCRIPTION"
                     :QUALIFIER "TRUCLER"))
      (WHEN SPEED-P
        (ASSERT
         (=
          (#S(FORMGREP:SYMREF :NAME "SPEED" :QUALIFIER "TRUCLER") DESCRIPTION)
          SPEED)))
      (WHEN COMPILATION-SPEED-P
        (ASSERT
         (=
          (#S(FORMGREP:SYMREF :NAME "COMPILATION-SPEED" :QUALIFIER "TRUCLER")
           DESCRIPTION)
          COMPILATION-SPEED)))
      (WHEN DEBUG-P
        (ASSERT
         (=
          (#S(FORMGREP:SYMREF :NAME "DEBUG" :QUALIFIER "TRUCLER") DESCRIPTION)
          DEBUG)))
      (WHEN SPACE-P
        (ASSERT
         (=
          (#S(FORMGREP:SYMREF :NAME "SPACE" :QUALIFIER "TRUCLER") DESCRIPTION)
          SPACE)))
      (WHEN SAFETY-P
        (ASSERT
         (=
          (#S(FORMGREP:SYMREF :NAME "SAFETY" :QUALIFIER "TRUCLER") DESCRIPTION)
          SAFETY)))
      (ECLECTOR.READER:QUASIQUOTE (VALUES))))

[trucler/Code/Implementations/Native/Test/tests.lisp:71]
  (DEFUN TEST-OPTIMIZE ()
    (ASSERT-OPTIMIZE-DESCRIPTION)
    (LOCALLY
     (DECLARE
      (OPTIMIZE (SPEED 3) (COMPILATION-SPEED 3) (DEBUG 3) (SPACE 3)
       (SAFETY 3)))
     (ASSERT-OPTIMIZE-DESCRIPTION :SPEED 3 :COMPILATION-SPEED 3 :DEBUG 3 :SPACE
      3 :SAFETY 3)))

[trucler/Code/query-mixin-classes.lisp:72]
  (DEFINE-MIXIN-CLASS SAFETY-MIXIN %SAFETY :SAFETY SAFETY)

[ttt/src/expressions.lisp:35]
  (DEFUN PATT-EXPR-MIN-WIDTH (EXPRESSION)
    (DECLARE (OPTIMIZE (SAFETY 0)))
    (LET ((EXPR-OP (PATT-EXPR-GET-OP EXPRESSION)))
      (COND
       ((AND EXPR-OP (LISTP EXPRESSION))
        (LET ((N (GET-/N (CAR EXPRESSION))) (M (GET-/M (CAR EXPRESSION))))
          (CASE EXPR-OP
            ((! + *)
             (LET* ((POS-ARGS (PATT-EXPR-POS-ARGS EXPRESSION))
                    (RECMIN
                     (IF POS-ARGS
                         (APPLY #'MIN
                                (MAPCAR #'PATT-EXPR-MIN-WIDTH POS-ARGS)))))
               (DECLARE (TYPE FIXNUM RECMIN))
               (CASE EXPR-OP
                 ((! +)
                  (COND ((AND POS-ARGS N) (THE FIXNUM (* N RECMIN)))
                        (POS-ARGS RECMIN) (T 1)))
                 (*
                  (IF (AND N M)
                      (THE FIXNUM (* N RECMIN))
                      0)))))
            ((<> {})
             (REDUCE #'+
                     (MAPCAR #'PATT-EXPR-MIN-WIDTH
                             (PATT-EXPR-POS-ARGS EXPRESSION))))
            (? 0)
            ((^ ^^ ^* ^+ ^N ^@ / LITERAL GENERAL) 1)
            (OTHERWISE
             (WHEN (NOT (OP-IS-PRED? EXPRESSION))
               (PRINT 'OP-ERROR1)
               (PRINT (PATT-EXPR-GET-OP EXPRESSION))
               0)))))
       (EXPR-OP
        (LET ((N (GET-/N EXPRESSION)))
          (CASE (PATT-EXPR-GET-OP EXPRESSION)
            ((_! _+)
             (IF N
                 N
                 1))
            (_? 0)
            (_*
             (IF N
                 N
                 0))
            ((@ LITERAL) 1)
            (OTHERWISE
             (WHEN (NOT (OP-IS-PRED? EXPRESSION))
               (PRINT 'OP-ERROR2)
               (PRINT (PATT-EXPR-GET-OP EXPRESSION)))
             1))))
       ((STICKY? EXPRESSION) 0) (T 1))))

[ttt/src/expressions.lisp:89]
  (DEFUN PATT-EXPR-MAX-WIDTH (EXPRESSION)
    (DECLARE (OPTIMIZE (SAFETY 0)))
    (LET ((EXPR-OP (PATT-EXPR-GET-OP EXPRESSION)))
      (COND
       ((AND EXPR-OP (LISTP EXPRESSION))
        (LET ((N (GET-/N (CAR EXPRESSION))) (M (GET-/M (CAR EXPRESSION))))
          (CASE EXPR-OP
            ((! ? *)
             (LET* ((POS-ARGS (PATT-EXPR-POS-ARGS EXPRESSION))
                    (RECMAX
                     (IF POS-ARGS
                         (APPLY #'MAX
                                (MAPCAR #'PATT-EXPR-MAX-WIDTH POS-ARGS)))))
               (DECLARE (TYPE FIXNUM RECMAX))
               (CASE EXPR-OP
                 (!
                  (COND
                   ((AND POS-ARGS N)
                    (THE FIXNUM
                         (IF (> RECMAX (FLOOR MOST-POSITIVE-FIXNUM N))
                             MOST-POSITIVE-FIXNUM
                             (* N RECMAX))))
                   (POS-ARGS RECMAX) (T 1)))
                 (?
                  (LET ((LOCMAX (MAX 1 RECMAX)))
                    (THE FIXNUM
                         (COND
                          ((AND N (> LOCMAX (FLOOR MOST-POSITIVE-FIXNUM N)))
                           MOST-POSITIVE-FIXNUM)
                          (N (* N LOCMAX)) (T LOCMAX)))))
                 (*
                  (THE FIXNUM
                       (IF (AND M (<= RECMAX (FLOOR MOST-POSITIVE-FIXNUM M)))
                           (* M RECMAX)
                           MOST-POSITIVE-FIXNUM))))))
            ((<> {})
             (REDUCE #'+
                     (MAPCAR #'PATT-EXPR-MAX-WIDTH
                             (PATT-EXPR-POS-ARGS EXPRESSION))))
            (+ MOST-POSITIVE-FIXNUM)
            ((^ ^^ ^* ^+ ^N / ^@ LITERAL GENERAL) 1)
            (OTHERWISE
             (WHEN (NOT (OP-IS-PRED? EXPRESSION))
               (PRINT 'OP-ERROR3)
               (PRINT (PATT-EXPR-GET-OP EXPRESSION))
               MOST-POSITIVE-FIXNUM)))))
       (EXPR-OP
        (LET ((N (GET-/N EXPRESSION)) (M (GET-/M EXPRESSION)))
          (CASE (PATT-EXPR-GET-OP EXPRESSION)
            ((_! _?)
             (IF N
                 N
                 1))
            (_+ MOST-POSITIVE-FIXNUM)
            (_*
             (IF (AND N M)
                 M
                 MOST-POSITIVE-FIXNUM))
            ((@ LITERAL) 1)
            (OTHERWISE
             (WHEN (NOT (OP-IS-PRED? EXPRESSION))
               (PRINT 'OP-ERROR4)
               (PRINT (PATT-EXPR-GET-OP EXPRESSION)))
             MOST-POSITIVE-FIXNUM))))
       ((STICKY? EXPRESSION) MOST-POSITIVE-FIXNUM) (T 1))))

[ttt/src/load.lisp:31]
  (PROCLAIM '(OPTIMIZE (SPEED 3) (SAFETY 3) (SPACE 0) (DEBUG 3)))

[ttt/src/operators/vertical.lisp:119]
  (DEFUN NEXT-V-STATES (VSTATE)
    (DECLARE (OPTIMIZE (SAFETY 0)))
    (LET (RESULT (LEADING-PATT (FIRST (V-STATE-PARGS VSTATE))))
      (CASE (CLASS-NAME (CLASS-OF LEADING-PATT))
        ((UNRESTRICTED-SEQ)
         (IF (= (MIN-ITER LEADING-PATT) 0)
             (PUSH
              (MAKE-V-STATE :PARGS (REST (V-STATE-PARGS VSTATE)) :TSEQ
               (V-STATE-TSEQ VSTATE) :BINDS
               (LET ((B
                      (ADD-BINDING (MK-BINDING (VAR LEADING-PATT) NIL)
                       (V-STATE-BINDS VSTATE))))
                 (DOLIST (V (V-STATE-LEADING-VARS VSTATE))
                   (SETF B (ADD-BINDING (MK-BINDING V NIL) B)))
                 B))
              RESULT))
         (IF (> (MAX-ITER LEADING-PATT) 0)
             (PUSH
              (MAKE-V-STATE :PARGS
               (CONS
                (MAKE-INSTANCE 'UNRESTRICTED-SEQ :MIN-WIDTH 1 :MAX-WIDTH 1
                               :MIN-ITER 1 :MAX-ITER 1 :VAR (VAR LEADING-PATT)
                               :INITIALIZED? T)
                (IF (> (MAX-ITER LEADING-PATT) 1)
                    (CONS
                     (MAKE-INSTANCE 'UNRESTRICTED-SEQ :MIN-WIDTH
                                    (MAX 0
                                         (THE FIXNUM
                                              (1- (MIN-ITER LEADING-PATT))))
                                    :MAX-WIDTH
                                    (THE FIXNUM (1- (MAX-ITER LEADING-PATT)))
                                    :MIN-ITER
                                    (MAX 0
                                         (THE FIXNUM
                                              (1- (MIN-ITER LEADING-PATT))))
                                    :MAX-ITER
                                    (THE FIXNUM (1- (MAX-ITER LEADING-PATT)))
                                    :VAR NIL :INITIALIZED? T)
                     (REST (V-STATE-PARGS VSTATE)))
                    (REST (V-STATE-PARGS VSTATE))))
               :TSEQ (V-STATE-TSEQ VSTATE) :BINDS (V-STATE-BINDS VSTATE))
              RESULT)))
        ((RESTRICTED-SEQ)
         (IF (= (MIN-ITER LEADING-PATT) 0)
             (PUSH
              (MAKE-V-STATE :PARGS (REST (V-STATE-PARGS VSTATE)) :TSEQ
               (V-STATE-TSEQ VSTATE) :BINDS
               (ADD-BINDING (MK-BINDING (VAR LEADING-PATT) NIL)
                (V-STATE-BINDS VSTATE)))
              RESULT))
         (IF (> (MAX-ITER LEADING-PATT) 0)
             (DOLIST (PARG (POS-ARGS LEADING-PATT))
               (PUSH
                (MAKE-V-STATE :LEADING-VARS
                 (CONS (VAR LEADING-PATT) (V-STATE-LEADING-VARS VSTATE)) :PARGS
                 (CONS PARG
                       (IF (> (MAX-ITER LEADING-PATT) 1)
                           (CONS
                            (MAKE-INSTANCE 'RESTRICTED-SEQ :POS-ARGS
                                           (POS-ARGS LEADING-PATT) :MIN-ITER
                                           (MAX 0
                                                (THE FIXNUM
                                                     (1-
                                                      (MIN-ITER
                                                       LEADING-PATT))))
                                           :MAX-ITER
                                           (THE FIXNUM
                                                (1- (MAX-ITER LEADING-PATT)))
                                           :MIN-WIDTH
                                           (IF (= (MIN-ITER LEADING-PATT) 0)
                                               0
                                               (THE FIXNUM
                                                    (- (MIN-WIDTH LEADING-PATT)
                                                       (THE FIXNUM
                                                            (FLOOR
                                                             (MIN-WIDTH
                                                              LEADING-PATT)
                                                             (MIN-ITER
                                                              LEADING-PATT))))))
                                           :MAX-WIDTH
                                           (IF (= (MAX-ITER LEADING-PATT) 0)
                                               0
                                               (THE FIXNUM
                                                    (- (MAX-WIDTH LEADING-PATT)
                                                       (THE FIXNUM
                                                            (CEILING
                                                             (MAX-WIDTH
                                                              LEADING-PATT)
                                                             (MAX-ITER
                                                              LEADING-PATT))))))
                                           :NEG-ARGS (NEG-ARGS LEADING-PATT)
                                           :VAR NIL :INITIALIZED? T)
                            (REST (V-STATE-PARGS VSTATE)))
                           (REST (V-STATE-PARGS VSTATE))))
                 :TSEQ (V-STATE-TSEQ VSTATE) :BINDS (V-STATE-BINDS VSTATE))
                RESULT))))
        ((FREE-SEQ)
         (PUSH
          (MAKE-V-STATE :LEADING-VARS
           (CONS (VAR LEADING-PATT) (V-STATE-LEADING-VARS VSTATE)) :PARGS
           (IF (> (LENGTH (POS-ARGS LEADING-PATT)) 0)
               (CONS (FIRST (POS-ARGS LEADING-PATT))
                     (IF (> (LENGTH (POS-ARGS LEADING-PATT)) 1)
                         (CONS
                          (MAKE-INSTANCE 'FREE-SEQ :MIN-WIDTH
                                         (THE FIXNUM
                                              (- (MIN-WIDTH LEADING-PATT)
                                                 (MIN-WIDTH
                                                  (FIRST
                                                   (POS-ARGS LEADING-PATT)))))
                                         :MAX-WIDTH
                                         (THE FIXNUM
                                              (- (MAX-WIDTH LEADING-PATT)
                                                 (MAX-WIDTH
                                                  (FIRST
                                                   (POS-ARGS LEADING-PATT)))))
                                         :INITIALIZED? T :POS-ARGS
                                         (REST (POS-ARGS LEADING-PATT)))
                          (REST (V-STATE-PARGS VSTATE)))
                         (REST (V-STATE-PARGS VSTATE))))
               (REST (V-STATE-PARGS VSTATE)))
           :TSEQ (V-STATE-TSEQ VSTATE) :BINDS (V-STATE-BINDS VSTATE))
          RESULT))
        ((PERMUTED-SEQ)
         (IF (> (LENGTH (POS-ARGS LEADING-PATT)) 0)
             (LOOP FOR N FROM 0 TO (1- (LENGTH (POS-ARGS LEADING-PATT)))
                   DO (PUSH
                       (MAKE-V-STATE :PARGS
                        (CONS (NTH N (POS-ARGS LEADING-PATT))
                              (IF (> (LENGTH (POS-ARGS LEADING-PATT)) 1)
                                  (CONS
                                   (MAKE-INSTANCE 'PERMUTED-SEQ :MIN-WIDTH
                                                  (THE FIXNUM
                                                       (-
                                                        (MIN-WIDTH
                                                         LEADING-PATT)
                                                        (MIN-WIDTH
                                                         (NTH N
                                                              (POS-ARGS
                                                               LEADING-PATT)))))
                                                  :MAX-WIDTH
                                                  (THE FIXNUM
                                                       (-
                                                        (MAX-WIDTH
                                                         LEADING-PATT)
                                                        (MAX-WIDTH
                                                         (NTH N
                                                              (POS-ARGS
                                                               LEADING-PATT)))))
                                                  :POS-ARGS
                                                  (APPEND
                                                   (SUBSEQ
                                                    (POS-ARGS LEADING-PATT) 0
                                                    N)
                                                   (SUBSEQ
                                                    (POS-ARGS LEADING-PATT)
                                                    (1+ N)))
                                                  :INITIALIZED? T)
                                   (REST (V-STATE-PARGS VSTATE)))
                                  (REST (V-STATE-PARGS VSTATE))))
                        :TSEQ (V-STATE-TSEQ VSTATE) :BINDS
                        (V-STATE-BINDS VSTATE) :LEADING-VARS
                        (CONS (VAR LEADING-PATT)
                              (V-STATE-LEADING-VARS VSTATE)))
                       RESULT))
             (PUSH
              (MAKE-V-STATE :PARGS NIL :TSEQ (V-STATE-TSEQ VSTATE) :BINDS
               (LET ((B
                      (ADD-BINDING (MK-BINDING (VAR LEADING-PATT) NIL)
                       (V-STATE-BINDS VSTATE))))
                 (DOLIST (V (V-STATE-LEADING-VARS VSTATE))
                   (SETF B (ADD-BINDING (MK-BINDING V NIL) B)))
                 B))
              RESULT)))
        (OTHERWISE (ERROR "unrecognized sequence pattern: ~A" LEADING-PATT)))
      (NREVERSE RESULT)))

[type-i/src/infer-typep.lisp:37]
  (DEFUN VALID-TYPE-SPECIFIER-P (OBJECT)
    (DECLARE (OPTIMIZE (SAFETY 3)))
    (IGNORE-ERRORS (TYPEP NIL OBJECT) T))

[uffi/benchmarks/allocation.lisp:14]
  (DECLAIM (OPTIMIZE (DEBUG 3) (SPEED 3) (SAFETY 1) (COMPILATION-SPEED 0)))

[uffi/src/aggregates.lisp:216]
  (DEFUN CONVERT-FROM-FOREIGN-USB8 (S LEN)
    (DECLARE (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (COMPILATION-SPEED 0))
             (FIXNUM LEN))
    (LET ((A (MAKE-ARRAY LEN :ELEMENT-TYPE '(UNSIGNED-BYTE 8))))
      (DOTIMES (I LEN A)
        (DECLARE (FIXNUM I))
        (SETF (AREF A I)
                (#S(FORMGREP:SYMREF :NAME "DEREF-ARRAY" :QUALIFIER "UFFI") S
                 '(:ARRAY :UNSIGNED-BYTE) I)))))

[uffi/src/aggregates.lisp:239]
  (DEFUN CONVERT-FROM-FOREIGN-USB8 (S LEN)
    (LET ((SAP (ALIEN-SAP S)))
      (DECLARE (TYPE SYSTEM-AREA-POINTER SAP))
      (LOCALLY
       (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
       (LET ((RESULT (MAKE-ARRAY LEN :ELEMENT-TYPE '(UNSIGNED-BYTE 8))))
         (FUNCALL *SYSTEM-COPY-FN* SAP 0 RESULT +SYSTEM-COPY-OFFSET+
                  (* LEN +SYSTEM-COPY-MULTIPLIER+))
         RESULT))))

[uffi/src/aggregates.lisp:250]
  (DEFUN CONVERT-FROM-FOREIGN-USB8 (S LEN)
    (LET ((SAP (#S(FORMGREP:SYMREF :NAME "ALIEN-SAP" :QUALIFIER "ALIEN") S)))
      (DECLARE
       (TYPE
        #S(FORMGREP:SYMREF :NAME "SYSTEM-AREA-POINTER" :QUALIFIER "SYSTEM")
        SAP))
      (LOCALLY
       (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
       (LET ((RESULT (MAKE-ARRAY LEN :ELEMENT-TYPE '(UNSIGNED-BYTE 8))))
         (#S(FORMGREP:SYMREF :NAME "COPY-FROM-SYSTEM-AREA" :QUALIFIER "KERNEL")
          SAP 0 RESULT
          (* #S(FORMGREP:SYMREF :NAME "VECTOR-DATA-OFFSET" :QUALIFIER "VM")
             #S(FORMGREP:SYMREF :NAME "WORD-BITS" :QUALIFIER "VM"))
          (* LEN #S(FORMGREP:SYMREF :NAME "BYTE-BITS" :QUALIFIER "VM")))
         RESULT))))

[uffi/src/strings.lisp:102]
  (DEFUN %CONVERT-TO-FOREIGN-STRING (STR ENCODING)
    (DECLARE (IGNORABLE STR ENCODING))
    (ETYPECASE STR
      (NULL
       (#S(FORMGREP:SYMREF :NAME "SAP-ALIEN" :QUALIFIER "ALIEN")
        (#S(FORMGREP:SYMREF :NAME "INT-SAP" :QUALIFIER "SYSTEM") 0)
        (* (#S(FORMGREP:SYMREF :NAME "UNSIGNED" :QUALIFIER "ALIEN") 8))))
      (STRING
       (LOCALLY
        (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
        (LET* ((SIZE (LENGTH STR))
               (STORAGE
                (#S(FORMGREP:SYMREF :NAME "MAKE-ALIEN" :QUALIFIER "ALIEN")
                 (#S(FORMGREP:SYMREF :NAME "UNSIGNED" :QUALIFIER "ALIEN") 8)
                 (1+ SIZE))))
          (DECLARE (FIXNUM SIZE))
          (SETQ STORAGE
                  (#S(FORMGREP:SYMREF :NAME "CAST" :QUALIFIER "ALIEN") STORAGE
                   (*
                    (#S(FORMGREP:SYMREF :NAME "UNSIGNED" :QUALIFIER "ALIEN")
                     8))))
          (DOTIMES (I SIZE)
            (DECLARE (FIXNUM I))
            (SETF (#S(FORMGREP:SYMREF :NAME "DEREF" :QUALIFIER "ALIEN") STORAGE
                   I)
                    (CHAR-CODE (CHAR STR I))))
          (SETF (#S(FORMGREP:SYMREF :NAME "DEREF" :QUALIFIER "ALIEN") STORAGE
                 SIZE)
                  0)
          STORAGE))))
    (ETYPECASE STR
      (NULL (SAP-ALIEN (SB-SYS:INT-SAP 0) (* (UNSIGNED 8))))
      (STRING
       (LOCALLY
        (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
        (LET* ((SIZE (LENGTH STR))
               (STORAGE (MAKE-ALIEN (UNSIGNED 8) (1+ SIZE))))
          (DECLARE (FIXNUM I))
          (SETQ STORAGE (CAST STORAGE (* (UNSIGNED 8))))
          (DOTIMES (I SIZE)
            (DECLARE (FIXNUM I))
            (SETF (DEREF STORAGE I) (CHAR-CODE (CHAR STR I))))
          (SETF (DEREF STORAGE SIZE) 0))
        STORAGE)))
    (ETYPECASE STR
      (NULL (SAP-ALIEN (SB-SYS:INT-SAP 0) (* (UNSIGNED 8))))
      (STRING
       (LOCALLY
        (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
        (LET* ((FE
                (OR ENCODING *DEFAULT-FOREIGN-ENCODING*
                    *DEFAULT-EXTERNAL-FORMAT*))
               (IFE (WHEN FE (LOOKUP-FOREIGN-ENCODING FE))))
          (IF IFE
              (LET* ((OCTETS (STRING-TO-OCTETS STR :EXTERNAL-FORMAT IFE))
                     (SIZE (LENGTH OCTETS))
                     (STORAGE (MAKE-ALIEN (UNSIGNED 8) (+ SIZE 2))))
                (DECLARE (FIXNUM SIZE))
                (SETQ STORAGE (CAST STORAGE (* (UNSIGNED 8))))
                (DOTIMES (I SIZE)
                  (DECLARE (FIXNUM I))
                  (SETF (DEREF STORAGE I) (AREF OCTETS I)))
                (SETF (DEREF STORAGE SIZE) 0)
                (SETF (DEREF STORAGE (1+ SIZE)) 0)
                STORAGE)
              (LET* ((SIZE (LENGTH STR))
                     (STORAGE (MAKE-ALIEN (UNSIGNED 8) (1+ SIZE))))
                (DECLARE (FIXNUM SIZE))
                (SETQ STORAGE (CAST STORAGE (* (UNSIGNED 8))))
                (DOTIMES (I SIZE)
                  (DECLARE (FIXNUM I))
                  (SETF (DEREF STORAGE I) (CHAR-CODE (CHAR STR I))))
                (SETF (DEREF STORAGE SIZE) 0)
                STORAGE))))))
    (IF (NULL STR)
        +NULL-CSTRING-POINTER+
        (LOCALLY
         (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
         (LET* ((FE (OR ENCODING *DEFAULT-FOREIGN-ENCODING*))
                (IFE (WHEN FE (LOOKUP-FOREIGN-ENCODING FE))))
           (IF IFE
               (LET* ((OCTETS
                       (#S(FORMGREP:SYMREF
                           :NAME "ENCODE-STRING-TO-OCTETS"
                           :QUALIFIER "CCL")
                        STR :EXTERNAL-FORMAT IFE))
                      (SIZE (LENGTH OCTETS))
                      (PTR (NEW-PTR (+ SIZE 2))))
                 (DECLARE (FIXNUM SIZE))
                 (DOTIMES (I SIZE)
                   (DECLARE (FIXNUM I))
                   (SETF (#S(FORMGREP:SYMREF
                             :NAME "%GET-UNSIGNED-BYTE"
                             :QUALIFIER "CCL")
                          PTR I)
                           (SVREF OCTETS I)))
                 (SETF (#S(FORMGREP:SYMREF
                           :NAME "%GET-UNSIGNED-BYTE"
                           :QUALIFIER "CCL")
                        PTR SIZE)
                         0)
                 (SETF (#S(FORMGREP:SYMREF
                           :NAME "%GET-UNSIGNED-BYTE"
                           :QUALIFIER "CCL")
                        PTR (1+ SIZE))
                         0)
                 PTR)
               (LET ((PTR (NEW-PTR (1+ (LENGTH STR)))))
                 (#S(FORMGREP:SYMREF :NAME "%PUT-CSTRING" :QUALIFIER "CCL") PTR
                  STR)
                 PTR)))))
    (IF (NULL STR)
        +NULL-CSTRING-POINTER+
        (LET ((PTR (NEW-PTR (1+ (LENGTH STR)))))
          (#S(FORMGREP:SYMREF :NAME "%PUT-CSTRING" :QUALIFIER "CCL") PTR STR)
          PTR))
    NIL)

[uffi/src/strings.lisp:424]
  (DEFUN CMUCL-NATURALIZE-CSTRING (SAP &KEY LENGTH (NULL-TERMINATED-P T))
    (DECLARE
     (TYPE #S(FORMGREP:SYMREF :NAME "SYSTEM-AREA-POINTER" :QUALIFIER "SYSTEM")
      SAP))
    (LOCALLY
     (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
     (LET ((NULL-TERMINATED-LENGTH
            (WHEN NULL-TERMINATED-P
              (LOOP FOR OFFSET OF-TYPE FIXNUM UPFROM 0
                    UNTIL (ZEROP
                           (#S(FORMGREP:SYMREF
                               :NAME "SAP-REF-8"
                               :QUALIFIER "SYSTEM")
                            SAP OFFSET))
                    FINALLY (RETURN OFFSET)))))
       (IF LENGTH
           (IF (AND NULL-TERMINATED-LENGTH
                    (> (THE FIXNUM LENGTH)
                       (THE FIXNUM NULL-TERMINATED-LENGTH)))
               (SETQ LENGTH NULL-TERMINATED-LENGTH))
           (SETQ LENGTH NULL-TERMINATED-LENGTH)))
     (LET ((RESULT (MAKE-STRING LENGTH)))
       (#S(FORMGREP:SYMREF :NAME "COPY-FROM-SYSTEM-AREA" :QUALIFIER "KERNEL")
        SAP 0 RESULT
        (* #S(FORMGREP:SYMREF :NAME "VECTOR-DATA-OFFSET" :QUALIFIER "VM")
           #S(FORMGREP:SYMREF :NAME "WORD-BITS" :QUALIFIER "VM"))
        (* LENGTH #S(FORMGREP:SYMREF :NAME "BYTE-BITS" :QUALIFIER "VM")))
       RESULT)))

[uffi/src/strings.lisp:449]
  (DEFUN CMUCL-NATURALIZE-CSTRING (SAP &KEY LENGTH (NULL-TERMINATED-P T))
    (DECLARE
     (TYPE #S(FORMGREP:SYMREF :NAME "SYSTEM-AREA-POINTER" :QUALIFIER "SYSTEM")
      SAP))
    (LOCALLY
     (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
     (LET ((NULL-TERMINATED-LENGTH
            (WHEN NULL-TERMINATED-P
              (LOOP FOR OFFSET OF-TYPE FIXNUM UPFROM 0
                    UNTIL (ZEROP
                           (#S(FORMGREP:SYMREF
                               :NAME "SAP-REF-8"
                               :QUALIFIER "SYSTEM")
                            SAP OFFSET))
                    FINALLY (RETURN OFFSET)))))
       (IF LENGTH
           (IF (AND NULL-TERMINATED-LENGTH
                    (> (THE FIXNUM LENGTH)
                       (THE FIXNUM NULL-TERMINATED-LENGTH)))
               (SETQ LENGTH NULL-TERMINATED-LENGTH))
           (SETQ LENGTH NULL-TERMINATED-LENGTH)))
     (LET ((RESULT (MAKE-STRING LENGTH)))
       (DOTIMES (I LENGTH)
         (DECLARE (TYPE FIXNUM I))
         (SETF (CHAR RESULT I)
                 (CODE-CHAR
                  (#S(FORMGREP:SYMREF :NAME "SAP-REF-8" :QUALIFIER "SYSTEM")
                   SAP I))))
       RESULT)))

[uffi/src/strings.lisp:471]
  (DEFUN SBCL-NATURALIZE-CSTRING (SAP &KEY LENGTH (NULL-TERMINATED-P T))
    (DECLARE (TYPE SYSTEM-AREA-POINTER SAP)
             (TYPE (OR NULL FIXNUM) LENGTH))
    (LOCALLY
     (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
     (LET ((NULL-TERMINATED-LENGTH
            (WHEN NULL-TERMINATED-P
              (LOOP FOR OFFSET OF-TYPE FIXNUM UPFROM 0
                    UNTIL (ZEROP (SB-SYS:SAP-REF-8 SAP OFFSET))
                    FINALLY (RETURN OFFSET)))))
       (IF LENGTH
           (IF (AND NULL-TERMINATED-LENGTH
                    (> (THE FIXNUM LENGTH)
                       (THE FIXNUM NULL-TERMINATED-LENGTH)))
               (SETQ LENGTH NULL-TERMINATED-LENGTH))
           (SETQ LENGTH NULL-TERMINATED-LENGTH)))
     (LET ((RESULT (MAKE-STRING LENGTH)))
       (FUNCALL *SYSTEM-COPY-FN* SAP 0 RESULT +SYSTEM-COPY-OFFSET+
                (* LENGTH +SYSTEM-COPY-MULTIPLIER+))
       RESULT)))

[uffi/src/strings.lisp:501]
  (DEFUN FAST-NATIVE-TO-STRING (S LEN)
    (DECLARE (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (COMPILATION-SPEED 0))
             (TYPE CHAR-PTR-DEF S))
    (LET* ((LEN (OR LEN (STRLEN S))) (STR (MAKE-STRING LEN)))
      (DECLARE (FIXNUM LEN)
               (TYPE (SIMPLE-ARRAY BASE-CHAR (*)) STR))
      (DOTIMES (I LEN STR)
        (SETF (AREF STR I)
                (#S(FORMGREP:SYMREF :NAME "DEREF-ARRAY" :QUALIFIER "UFFI") S
                 '(:ARRAY :CHAR) I)))))

[uffi/src/strings.lisp:514]
  (DEFUN FAST-NATIVE-TO-STRING (S LEN)
    (DECLARE (OPTIMIZE (SPEED 3) (SPACE 0) (SAFETY 0) (COMPILATION-SPEED 0))
             (TYPE CHAR-PTR-DEF S))
    (LET* ((LEN (OR LEN (STRLEN S))) (STR (MAKE-STRING LEN)))
      (DOTIMES (I LEN STR)
        (SETF (SCHAR STR I)
                (CODE-CHAR
                 (#S(FORMGREP:SYMREF :NAME "DEREF-ARRAY" :QUALIFIER "UFFI") S
                  '(:ARRAY :UNSIGNED-BYTE) I))))))

[uffi/tests/rt.lisp:43]
  (DEFVAR *OPTIMIZATION-SETTINGS* '((SAFETY 3)))

[usocket/backend/mcl.lisp:199]
  (DEFMETHOD INPUT-AVAILABLE-P
             (
              (STREAM
               #S(FORMGREP:SYMREF
                  :NAME "OPENTRANSPORT-STREAM"
                  :QUALIFIER "CCL")))
    (MACROLET ((WHEN-IO-BUFFER-LOCK-GRABBED
                   ((LOCK &OPTIONAL MULTIPLE-VALUE-P) &BODY BODY)
                 "Evaluates the body if and only if the lock is successfully grabbed"
                 (LET ((NEEDS-UNLOCKING-P (GENSYM)) (LOCK-VAR (GENSYM)))
                   (ECLECTOR.READER:QUASIQUOTE
                    (LET* (((ECLECTOR.READER:UNQUOTE LOCK-VAR)
                            (ECLECTOR.READER:UNQUOTE LOCK))
                           (#S(FORMGREP:SYMREF
                               :NAME "*GRABBED-IO-BUFFER-LOCKS*"
                               :QUALIFIER "CCL")
                            (CONS (ECLECTOR.READER:UNQUOTE LOCK-VAR)
                                  #S(FORMGREP:SYMREF
                                     :NAME "*GRABBED-IO-BUFFER-LOCKS*"
                                     :QUALIFIER "CCL")))
                           ((ECLECTOR.READER:UNQUOTE NEEDS-UNLOCKING-P)
                            (NEEDS-UNLOCKING-P
                             (ECLECTOR.READER:UNQUOTE LOCK-VAR))))
                      (DECLARE
                       (DYNAMIC-EXTENT
                        #S(FORMGREP:SYMREF
                           :NAME "*GRABBED-IO-BUFFER-LOCKS*"
                           :QUALIFIER "CCL")))
                      (WHEN (ECLECTOR.READER:UNQUOTE NEEDS-UNLOCKING-P)
                        ((ECLECTOR.READER:UNQUOTE
                          (IF MULTIPLE-VALUE-P
                              'MULTIPLE-VALUE-PROG1
                              'PROG1))
                         (PROGN (ECLECTOR.READER:UNQUOTE-SPLICING BODY))
                         (#S(FORMGREP:SYMREF
                             :NAME "%RELEASE-IO-BUFFER-LOCK"
                             :QUALIFIER "CCL")
                          (ECLECTOR.READER:UNQUOTE LOCK-VAR)))))))))
      (LABELS ((NEEDS-UNLOCKING-P (LOCK)
                 (DECLARE
                  (TYPE #S(FORMGREP:SYMREF :NAME "LOCK" :QUALIFIER "CCL")
                   LOCK))
                 (#S(FORMGREP:SYMREF
                     :NAME "%IO-BUFFER-LOCK-REALLY-GRABBED-P"
                     :QUALIFIER "CCL")
                  LOCK)
                 (#S(FORMGREP:SYMREF
                     :NAME "STORE-CONDITIONAL"
                     :QUALIFIER "CCL")
                  LOCK NIL
                  #S(FORMGREP:SYMREF
                     :NAME "*CURRENT-PROCESS*"
                     :QUALIFIER "CCL"))))
        "similar to stream-listen on buffered-input-stream-mixin but without waiting for lock"
        (LET ((IO-BUFFER
               (#S(FORMGREP:SYMREF :NAME "STREAM-IO-BUFFER" :QUALIFIER "CCL")
                STREAM)))
          (OR
           (NOT
            (EQL 0
                 (#S(FORMGREP:SYMREF
                     :NAME "IO-BUFFER-INCOUNT"
                     :QUALIFIER "CCL")
                  IO-BUFFER)))
           (#S(FORMGREP:SYMREF :NAME "IO-BUFFER-UNTYI-CHAR" :QUALIFIER "CCL")
            IO-BUFFER)
           (LOCALLY
            (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
            (WHEN-IO-BUFFER-LOCK-GRABBED
             ((#S(FORMGREP:SYMREF :NAME "IO-BUFFER-LOCK" :QUALIFIER "CCL")
               IO-BUFFER))
             (FUNCALL
              (#S(FORMGREP:SYMREF
                  :NAME "IO-BUFFER-LISTEN-FUNCTION"
                  :QUALIFIER "CCL")
               IO-BUFFER)
              STREAM IO-BUFFER))))))))

[utility/utility.lisp:29]
  (DEFMACRO WITH-UNSAFE-SPEED (&BODY BODY)
    (ECLECTOR.READER:QUASIQUOTE
     (LOCALLY
      (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
      (PROGN (ECLECTOR.READER:UNQUOTE-SPLICING BODY)))))

[utils-kt/defpackage.lisp:30]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (PROCLAIM '(OPTIMIZE (SPEED 2) (SAFETY 1) (SPACE 1) (DEBUG 3))))

[varjo/src/varjo.internals/environment.lisp:10]
  (DEFUN GET-BASE-ENV (ENV)
    (DECLARE (TYPE ENVIRONMENT ENV)
             (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
    (THE BASE-ENVIRONMENT (SLOT-VALUE ENV 'BASE-ENV)))

[varjo/src/varjo.internals/environment.lisp:732]
  (DEFMETHOD GET-FORM-BINDING (NAME (ENV ENVIRONMENT))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
    (LET* ((PREV-ENV-WITH-BINDINGS (V-PREVIOUS-ENV-WITH-FORM-BINDINGS ENV))
           (BINDINGS-AT-THIS-LEVEL
            (APPEND
             (LET ((SET (V-FORM-BINDINGS ENV)))
               (WHEN SET (GET-FROM-BINDING-SET NAME SET)))
             (UNLESS PREV-ENV-WITH-BINDINGS
               (GET-EXTERNAL-FUNCTION-BY-NAME NAME ENV))))
           (MACRO
            (FIND-IF λ (TYPEP _ 'V-REGULAR-MACRO)
                     (THE LIST BINDINGS-AT-THIS-LEVEL)))
           (MACRO
            (IF PREV-ENV-WITH-BINDINGS
                MACRO
                (WHEN (VALID-FOR-CONTEXTP MACRO ENV) MACRO))))
      (IF BINDINGS-AT-THIS-LEVEL
          (OR MACRO
              (LET* ((BINDINGS-ABOVE
                      (WHEN PREV-ENV-WITH-BINDINGS
                        (GET-FORM-BINDING NAME PREV-ENV-WITH-BINDINGS)))
                     (ALL-BINDINGS
                      (APPEND BINDINGS-AT-THIS-LEVEL
                              (WHEN (TYPEP BINDINGS-ABOVE 'V-FUNCTION-SET)
                                (FUNCTIONS BINDINGS-ABOVE))))
                     (VALID
                      (IF PREV-ENV-WITH-BINDINGS
                          ALL-BINDINGS
                          (REMOVE-IF-NOT λ (VALID-FOR-CONTEXTP _ ENV)
                                         ALL-BINDINGS))))
                (MAKE-FUNCTION-SET VALID)))
          (WHEN PREV-ENV-WITH-BINDINGS
            (GET-FORM-BINDING NAME PREV-ENV-WITH-BINDINGS)))))

[varjo/src/varjo.internals/environment.lisp:813]
  (DEFUN DESCENDANT-ENV-P (ENV ANCESTOR)
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 1))
             (TYPE (OR NULL ENVIRONMENT) ENV ANCESTOR))
    (OR (EQ ENV ANCESTOR)
        (UNLESS (OR (NULL ENV) (NULL ANCESTOR))
          (DESCENDANT-ENV-P (V-PARENT-ENV ENV) ANCESTOR))))

[varjo/src/varjo.internals/flow.lisp:132]
  (DEFUN ID~= (ID-A ID-B)
    (DECLARE (TYPE (OR NULL FLOW-IDENTIFIER) ID-A ID-B)
             (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
    (UNLESS (OR (NULL ID-A) (NULL ID-B))
      (NOT
       (NULL
        (INTERSECTION (LISTIFY (IDS ID-A)) (LISTIFY (IDS ID-B)) :KEY λ
                      (SLOT-VALUE _ 'VAL))))))

[varjo/src/varjo.internals/flow.lisp:139]
  (DEFUN ID= (ID-A ID-B)
    (DECLARE (TYPE (OR NULL FLOW-IDENTIFIER) ID-A ID-B)
             (OPTIMIZE (SPEED 3) (SAFETY 1) (DEBUG 1)))
    (UNLESS (OR (NULL ID-A) (NULL ID-B))
      (EQUAL (SORT (COPY-LIST (RAW-IDS ID-A)) #'<)
             (SORT (COPY-LIST (RAW-IDS ID-B)) #'<))))

[varjo/src/varjo.internals/names.lisp:13]
  (MACROLET ((DEFINE-ASCII-CHAR-RANGES ()
               (LET ((RANGES) (MIN NIL) (MAX NIL))
                 (LOOP :FOR I :IN (SORT
                                   (MAP 'LIST #'CHAR-CODE +ASCII-ALPHA-NUM+)
                                   #'<)
                       :DO (IF MIN
                               (IF (= (- I MAX) 1)
                                   (SETF MAX I)
                                   (PROGN
                                    (PUSH (LIST MIN MAX) RANGES)
                                    (SETF MIN I
                                          MAX I)))
                               (SETF MIN I
                                     MAX I))
                       :FINALLY (PUSH (LIST MIN MAX) RANGES))
                 (LET* ((RANGES (REVERSE RANGES)))
                   (ECLECTOR.READER:QUASIQUOTE
                    (PROGN
                     (DEFUN GLSL-ALPHANUMERIC-P (CHAR)
                       (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 1) (SAFETY 1))
                                (TYPE CHARACTER CHAR))
                       (LET ((CODE (CHAR-CODE CHAR)))
                         (OR
                          (ECLECTOR.READER:UNQUOTE-SPLICING
                           (LOOP :FOR (MIN MAX) :IN RANGES
                                 :COLLECT (ECLECTOR.READER:QUASIQUOTE
                                           (AND
                                            (>= CODE
                                                (ECLECTOR.READER:UNQUOTE MIN))
                                            (<= CODE
                                                (ECLECTOR.READER:UNQUOTE
                                                 MAX)))))))))))))))
    (DEFINE-ASCII-CHAR-RANGES))

[varjo/src/varjo.internals/return-set.lisp:4]
  (DEFUN MERGE-RETURN-SETS (SETS)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 1)))
    (LABELS ((QUALIFIED-EQL (RET-A RET-B)
               (DECLARE (TYPE V-TYPE RET-A RET-B))
               (AND (V-TYPE-EQ RET-A RET-B)
                    (LET ((QA (QUALIFIERS RET-A)) (QB (QUALIFIERS RET-B)))
                      (DECLARE (TYPE LIST QA QB))
                      (AND (= (LENGTH QA) (LENGTH QB))
                           (EVERY #'QUALIFIER= QA QB)))))
             (TYPE-SETS-EQUAL (SET-A SET-B)
               (DECLARE (TYPE (VECTOR V-TYPE *) SET-A SET-B))
               (AND (= (LENGTH SET-A) (LENGTH SET-B))
                    (EVERY #'QUALIFIED-EQL SET-A SET-B)))
             (%MERGE-RETURN-SETS (SET-A SET-B)
               (ASSERT (TYPE-SETS-EQUAL SET-A SET-B) NIL 'RETURN-TYPE-MISMATCH
                       :SETS SETS)
               SET-A))
      (LET* ((SETS (REMOVE NIL SETS)))
        (REDUCE #'%MERGE-RETURN-SETS (REST SETS) :INITIAL-VALUE (FIRST SETS)))))

[vellum/src/column/implementation.lisp:17]
  (DEFUN ITERATOR-AT (ITERATOR COLUMN)
    (DECLARE
     (OPTIMIZE (SPEED 3) (COMPILATION-SPEED 0) (SPACE 0) (DEBUG 0) (SAFETY 0))
     (TYPE INTEGER COLUMN)
     (TYPE SPARSE-MATERIAL-COLUMN-ITERATOR ITERATOR))
    (BIND
     ((STATUS (READ-INITIALIZATION-STATUS ITERATOR))
      (COLUMNS (READ-COLUMNS ITERATOR)) (LENGTH (LENGTH COLUMNS))
      (STACKS (READ-STACKS ITERATOR)) (BUFFERS (READ-BUFFERS ITERATOR))
      (DEPTHS (READ-DEPTHS ITERATOR)) (BUFFER (AREF BUFFERS COLUMN))
      (TOUCHED (READ-TOUCHED ITERATOR)) (INDEX (INDEX ITERATOR))
      (OFFSET (OFFSET INDEX)))
     (UNLESS (< -1 COLUMN LENGTH)
       (ERROR 'NO-SUCH-COLUMN :BOUNDS
              (ECLECTOR.READER:QUASIQUOTE (0 (ECLECTOR.READER:UNQUOTE LENGTH)))
              :ARGUMENT 'COLUMN :VALUE COLUMN :FORMAT-CONTROL
              "There is no such column."))
     (UNLESS (AREF STATUS COLUMN)
       (SETF (AREF STATUS COLUMN) T)
       (INITIALIZE-ITERATOR-COLUMN ITERATOR INDEX (AREF COLUMNS COLUMN)
        (AREF STACKS COLUMN) (AREF BUFFERS COLUMN) (AREF DEPTHS COLUMN)
        (AREF TOUCHED COLUMN) COLUMN))
     (AREF BUFFER OFFSET)))

[vellum/src/column/implementation.lisp:53]
  (DEFUN (SETF ITERATOR-AT) (NEW-VALUE ITERATOR COLUMN)
    (DECLARE
     (OPTIMIZE (SPEED 3) (COMPILATION-SPEED 0) (SPACE 0) (DEBUG 0) (SAFETY 0))
     (TYPE INTEGER COLUMN)
     (TYPE SPARSE-MATERIAL-COLUMN-ITERATOR ITERATOR))
    (BIND
     ((BUFFERS (READ-BUFFERS ITERATOR)) (INDEX (THE FIXNUM (INDEX ITERATOR)))
      (OFFSET (THE FIXNUM (OFFSET INDEX))) (BUFFER (AREF BUFFERS COLUMN))
      (COLUMN-TYPES (READ-COLUMN-TYPES ITERATOR))
      (STATUS (READ-INITIALIZATION-STATUS ITERATOR))
      (COLUMNS (READ-COLUMNS ITERATOR)) (STACKS (READ-STACKS ITERATOR))
      (LENGTH (LENGTH STATUS)) (DEPTHS (READ-DEPTHS ITERATOR))
      (TOUCHED (READ-TOUCHED ITERATOR)))
     (DECLARE (TYPE SIMPLE-VECTOR BUFFERS STATUS))
     (UNLESS (< -1 COLUMN LENGTH)
       (ERROR 'NO-SUCH-COLUMN :BOUNDS
              (ECLECTOR.READER:QUASIQUOTE (0 (ECLECTOR.READER:UNQUOTE LENGTH)))
              :ARGUMENT 'COLUMN :VALUE COLUMN :FORMAT-CONTROL
              "There is no such column."))
     (UNLESS (AREF STATUS COLUMN)
       (SETF (AREF STATUS COLUMN) T)
       (INITIALIZE-ITERATOR-COLUMN ITERATOR INDEX (AREF COLUMNS COLUMN)
        (AREF STACKS COLUMN) (AREF BUFFERS COLUMN) (AREF DEPTHS COLUMN)
        (AREF TOUCHED COLUMN) COLUMN))
     (UNLESS
         (OR (EQ (SVREF COLUMN-TYPES COLUMN) T) (EQ :NULL NEW-VALUE)
             (TYPEP NEW-VALUE
                    (~> ITERATOR SPARSE-MATERIAL-COLUMN-ITERATOR-COLUMNS
                     (AREF COLUMN)
                     #S(FORMGREP:SYMREF
                        :NAME "TYPE-SPECIALIZATION"
                        :QUALIFIER "CL-DS"))))
       (ERROR 'COLUMN-TYPE-ERROR :EXPECTED-TYPE
              (~> ITERATOR SPARSE-MATERIAL-COLUMN-ITERATOR-COLUMNS
               (AREF COLUMN)
               #S(FORMGREP:SYMREF
                  :NAME "TYPE-SPECIALIZATION"
                  :QUALIFIER "CL-DS"))
              :COLUMN COLUMN :DATUM NEW-VALUE))
     (LET ((OLD-VALUE (SVREF BUFFER OFFSET)))
       (SETF (SVREF BUFFER OFFSET) NEW-VALUE)
       (UNLESS (EQL NEW-VALUE OLD-VALUE)
         (LET ((COLUMNS (READ-COLUMNS ITERATOR))
               (TRANSFORMATION
                (ENSURE-FUNCTION (READ-TRANSFORMATION ITERATOR)))
               (CHANGES (READ-CHANGES ITERATOR))
               (TOUCHED (READ-TOUCHED ITERATOR)))
           (DECLARE (TYPE SIMPLE-VECTOR COLUMNS CHANGES)
                    (TYPE SIMPLE-VECTOR TOUCHED))
           (UNLESS (SVREF TOUCHED COLUMN)
             (SETF (SVREF COLUMNS COLUMN)
                     (FUNCALL TRANSFORMATION (SVREF COLUMNS COLUMN))))
           (SETF (~> (SVREF CHANGES COLUMN) (SVREF OFFSET)) T
                 (SVREF TOUCHED COLUMN) T))))
     NEW-VALUE))

[vellum/src/column/implementation.lisp:148]
  (DEFUN MOVE-ITERATOR-TO (ITERATOR NEW-INDEX)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (BIND
     ((NEW-DEPTH (CALCULATE-DEPTH NEW-INDEX)) (DEPTHS (READ-DEPTHS ITERATOR))
      (LENGTH (LENGTH DEPTHS)))
     (DECLARE (TYPE FIXNUM LENGTH)
              (TYPE (SIMPLE-ARRAY FIXNUM (*)) DEPTHS))
     (WHEN (ZEROP LENGTH) (RETURN-FROM MOVE-ITERATOR-TO NIL))
     (LET ((INDEXES (READ-INDEXES ITERATOR))
           (DEPTHS (READ-DEPTHS ITERATOR))
           (STACKS (READ-STACKS ITERATOR))
           (COLUMNS (READ-COLUMNS ITERATOR))
           (CHANGES (READ-CHANGES ITERATOR))
           (BUFFERS (READ-BUFFERS ITERATOR))
           (INITIALIZATION-STATUS (READ-INITIALIZATION-STATUS ITERATOR)))
       (ITERATE (DECLARE (TYPE FIXNUM I)) (FOR I FROM 0 BELOW LENGTH)
        (MOVE-COLUMN-TO ITERATOR NEW-INDEX I NEW-DEPTH INDEXES DEPTHS STACKS
         COLUMNS CHANGES BUFFERS INITIALIZATION-STATUS)))
     (SETF (ACCESS-INDEX ITERATOR) NEW-INDEX) NIL))

[vellum/src/column/internal.lisp:93]
  (DEFUN INDEX-PROMOTED (OLD-INDEX NEW-INDEX)
    (DECLARE (TYPE FIXNUM OLD-INDEX NEW-INDEX)
             (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (COMPILATION-SPEED 0)
              (DEBUG 0)))
    (NOT
     (EQL
      (CEILING (THE FIXNUM (1+ OLD-INDEX))
               #S(FORMGREP:SYMREF
                  :NAME "+MAXIMUM-CHILDREN-COUNT+"
                  :QUALIFIER "CL-DS.COMMON.RRB"))
      (CEILING (THE FIXNUM (1+ NEW-INDEX))
               #S(FORMGREP:SYMREF
                  :NAME "+MAXIMUM-CHILDREN-COUNT+"
                  :QUALIFIER "CL-DS.COMMON.RRB")))))

[vellum/src/column/internal.lisp:126]
  (DEFUN MOVE-COLUMN-TO
         (ITERATOR NEW-INDEX COLUMN-INDEX DEPTH INDEXES DEPTHS STACKS COLUMNS
          CHANGES BUFFERS INITIALIZATION-STATUS
          &KEY (FORCE-INITIALIZATION NIL)
          (PROMOTED (INDEX-PROMOTED (AREF INDEXES COLUMN-INDEX) NEW-INDEX)))
    (DECLARE
     (OPTIMIZE (SPEED 3) (COMPILATION-SPEED 0) (SPACE 0) (DEBUG 0) (SAFETY 0))
     (TYPE FIXNUM COLUMN-INDEX NEW-INDEX)
     (TYPE SIMPLE-VECTOR STACKS COLUMNS CHANGES BUFFERS INITIALIZATION-STATUS)
     (TYPE (SIMPLE-ARRAY FIXNUM (*)) DEPTHS INDEXES))
    (LET ((INDEX (AREF (READ-INDEXES ITERATOR) COLUMN-INDEX)))
      (DECLARE (TYPE FIXNUM INDEX)
               (TYPE BOOLEAN PROMOTED))
      (WHEN (OR (= NEW-INDEX INDEX) (NOR PROMOTED FORCE-INITIALIZATION))
        (SETF (AREF (READ-INDEXES ITERATOR) COLUMN-INDEX) NEW-INDEX)
        (RETURN-FROM MOVE-COLUMN-TO NIL))
      (WHEN
          (NOR (SVREF INITIALIZATION-STATUS COLUMN-INDEX) FORCE-INITIALIZATION)
        (RETURN-FROM MOVE-COLUMN-TO NIL))
      (LET ((NEW-DEPTH (MAX (AREF DEPTHS COLUMN-INDEX) DEPTH))
            (NOT-CHANGED (EVERY #'NULL (AREF CHANGES COLUMN-INDEX))))
        (UNLESS NOT-CHANGED
          (CHANGE-LEAF ITERATOR (AREF DEPTHS COLUMN-INDEX)
           (AREF STACKS COLUMN-INDEX) (AREF COLUMNS COLUMN-INDEX)
           (AREF CHANGES COLUMN-INDEX) (AREF BUFFERS COLUMN-INDEX))
          (LET ((CHANGE (SVREF CHANGES COLUMN-INDEX)))
            (DECLARE (TYPE ITERATOR-CHANGE CHANGE))
            (MACROLET ((UNROLLED ()
                         (ECLECTOR.READER:QUASIQUOTE
                          (PROGN
                           (ECLECTOR.READER:UNQUOTE-SPLICING
                            (ITERATE
                             (FOR I FROM 0 BELOW
                              #S(FORMGREP:SYMREF
                                 :NAME "+MAXIMUM-CHILDREN-COUNT+"
                                 :QUALIFIER "CL-DS.COMMON.RRB"))
                             (COLLECTING
                              (ECLECTOR.READER:QUASIQUOTE
                               (SETF (SVREF CHANGE (ECLECTOR.READER:UNQUOTE I))
                                       NIL)))))))))
              (UNROLLED)))
          (LET ((BUFFER (SVREF BUFFERS COLUMN-INDEX)))
            (DECLARE (TYPE SIMPLE-VECTOR BUFFER))
            (MACROLET ((UNROLLED ()
                         (ECLECTOR.READER:QUASIQUOTE
                          (PROGN
                           (ECLECTOR.READER:UNQUOTE-SPLICING
                            (ITERATE
                             (FOR I FROM 0 BELOW
                              #S(FORMGREP:SYMREF
                                 :NAME "+MAXIMUM-CHILDREN-COUNT+"
                                 :QUALIFIER "CL-DS.COMMON.RRB"))
                             (COLLECTING
                              (ECLECTOR.READER:QUASIQUOTE
                               (SETF (SVREF BUFFER (ECLECTOR.READER:UNQUOTE I))
                                       :NULL)))))))))
              (UNROLLED)))
          (REDUCE-STACK ITERATOR INDEX (AREF DEPTHS COLUMN-INDEX)
           (SVREF STACKS COLUMN-INDEX) (SVREF COLUMNS COLUMN-INDEX)))
        (IF (AND NOT-CHANGED (NOT FORCE-INITIALIZATION))
            (SETF (AREF INITIALIZATION-STATUS COLUMN-INDEX) NIL)
            (PROGN
             (MOVE/PAD-STACK ITERATOR (AREF INDEXES COLUMN-INDEX) NEW-INDEX
              (AREF DEPTHS COLUMN-INDEX) NEW-DEPTH (AREF STACKS COLUMN-INDEX)
              (AREF COLUMNS COLUMN-INDEX))
             (SETF (AREF INDEXES COLUMN-INDEX) NEW-INDEX
                   (AREF DEPTHS COLUMN-INDEX) NEW-DEPTH
                   (AREF INITIALIZATION-STATUS COLUMN-INDEX) T)
             (FILL-BUFFER NEW-DEPTH (AREF BUFFERS COLUMN-INDEX)
              (AREF STACKS COLUMN-INDEX)))))
      NIL))

[vellum/src/column/internal.lisp:955]
  (DEFUN CHANGE-LEAF (ITERATOR DEPTH STACK COLUMN CHANGE BUFFER)
    (DECLARE
     (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0) (COMPILATION-SPEED 0)))
    (DECLARE (TYPE ITERATOR-BUFFER BUFFER)
             (TYPE FIXNUM DEPTH)
             (TYPE ITERATOR-STACK STACK))
    (MACROLET ((UNROLLED ()
                 (ECLECTOR.READER:QUASIQUOTE
                  (+
                   (ECLECTOR.READER:UNQUOTE-SPLICING
                    (ITERATE
                     (FOR I FROM 0 BELOW
                      #S(FORMGREP:SYMREF
                         :NAME "+MAXIMUM-CHILDREN-COUNT+"
                         :QUALIFIER "CL-DS.COMMON.RRB"))
                     (COLLECTING
                      (ECLECTOR.READER:QUASIQUOTE
                       (IF (EQ :NULL
                               (SVREF BUFFER (ECLECTOR.READER:UNQUOTE I)))
                           0
                           1)))))))))
      (LET ((NEW-SIZE (THE FIXNUM (UNROLLED))))
        (COND ((ZEROP NEW-SIZE) (SETF (AREF STACK DEPTH) NIL))
              (T
               (LET* ((TAG
                       (#S(FORMGREP:SYMREF
                           :NAME "READ-OWNERSHIP-TAG"
                           :QUALIFIER "CL-DS.COMMON.ABSTRACT")
                        COLUMN))
                      (OLD-NODE (AREF STACK DEPTH)))
                 (IF (OR (NULL OLD-NODE)
                         (NOT
                          (#S(FORMGREP:SYMREF
                              :NAME "ACQUIRE-OWNERSHIP"
                              :QUALIFIER "CL-DS.COMMON.ABSTRACT")
                           OLD-NODE TAG)))
                     (SETF (AREF STACK DEPTH)
                             (MAKE-LEAF ITERATOR COLUMN OLD-NODE CHANGE BUFFER
                              NEW-SIZE))
                     (MUTATE-LEAF COLUMN OLD-NODE CHANGE BUFFER NEW-SIZE)))))))
    NIL)

[vellum/src/column/internal.lisp:982]
  (DEFUN CHANGE-LEAFS (ITERATOR)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0)))
    (LET* ((INITIALIZATION-STATUS (READ-INITIALIZATION-STATUS ITERATOR))
           (DEPTHS (READ-DEPTHS ITERATOR))
           (STACKS (READ-STACKS ITERATOR))
           (COLUMNS (READ-COLUMNS ITERATOR))
           (CHANGES (READ-CHANGES ITERATOR))
           (BUFFERS (READ-BUFFERS ITERATOR))
           (LENGTH (LENGTH DEPTHS)))
      (DECLARE (TYPE SIMPLE-VECTOR STACKS COLUMNS CHANGES)
               (TYPE (OR SIMPLE-VECTOR SIMPLE-BIT-VECTOR) BUFFERS)
               (TYPE (SIMPLE-ARRAY FIXNUM (*)) DEPTHS)
               (TYPE (SIMPLE-ARRAY BOOLEAN (*)) INITIALIZATION-STATUS))
      (ITERATE (DECLARE (TYPE FIXNUM I)) (FOR I FROM 0 BELOW LENGTH)
       (WHEN (AREF INITIALIZATION-STATUS I)
         (UNLESS (EVERY #'NULL (AREF CHANGES I))
           (CHANGE-LEAF ITERATOR (AREF DEPTHS I) (AREF STACKS I)
            (AREF COLUMNS I) (AREF CHANGES I) (AREF BUFFERS I)))))))

[vellum/src/column/internal.lisp:1041]
  (DEFUN REDUCE-STACK (ITERATOR INDEX DEPTH STACK COLUMN)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((PREV-NODE (AREF STACK DEPTH)))
      (ITERATE (DECLARE (TYPE FIXNUM I BITS))
       (WITH TAG =
        (#S(FORMGREP:SYMREF
            :NAME "READ-OWNERSHIP-TAG"
            :QUALIFIER "CL-DS.COMMON.ABSTRACT")
         COLUMN))
       (FOR I FROM (1- DEPTH) DOWNTO 0)
       (FOR BITS FROM
        #S(FORMGREP:SYMREF :NAME "+BIT-COUNT+" :QUALIFIER "CL-DS.COMMON.RRB")
        BY
        #S(FORMGREP:SYMREF :NAME "+BIT-COUNT+" :QUALIFIER "CL-DS.COMMON.RRB"))
       (FOR NODE = (AREF STACK I))
       (FOR POSITION =
        (LDB
         (BYTE
          #S(FORMGREP:SYMREF :NAME "+BIT-COUNT+" :QUALIFIER "CL-DS.COMMON.RRB")
          BITS)
         INDEX))
       (FOR NEW-NODE =
        (COPY-ON-WRITE-NODE ITERATOR NODE PREV-NODE POSITION TAG COLUMN))
       (ASSERT
        (OR (NULL NEW-NODE)
            (>
             (#S(FORMGREP:SYMREF
                 :NAME "SPARSE-RRB-NODE-SIZE"
                 :QUALIFIER "CL-DS.COMMON.RRB")
              NEW-NODE)
             0)))
       (UNTIL (EQ NODE NEW-NODE))
       (SETF PREV-NODE NEW-NODE
             (AREF STACK I) NEW-NODE)))
    (AREF STACK 0))

[vellum/src/table/functions.lisp:4]
  (DEFUN ROW-AT (HEADER ROW NAME)
    (LET ((COLUMN
           (IF (INTEGERP NAME)
               NAME
               (#S(FORMGREP:SYMREF
                   :NAME "NAME-TO-INDEX"
                   :QUALIFIER "VELLUM.HEADER")
                HEADER NAME))))
      (DECLARE (TYPE INTEGER COLUMN))
      (ETYPECASE ROW
        (TABLE-ROW
         (~> ROW TABLE-ROW-ITERATOR
          (#S(FORMGREP:SYMREF :NAME "ITERATOR-AT" :QUALIFIER "VELLUM.COLUMN")
           COLUMN)))
        (SIMPLE-VECTOR
         (LET ((LENGTH (LENGTH ROW)))
           (DECLARE (TYPE FIXNUM LENGTH))
           (UNLESS (< -1 COLUMN LENGTH)
             (ERROR 'NO-COLUMN :BOUNDS
                    (ECLECTOR.READER:QUASIQUOTE
                     (0 (ECLECTOR.READER:UNQUOTE LENGTH)))
                    :ARGUMENT 'COLUMN :VALUE COLUMN :FORMAT-ARGUMENTS
                    (LIST COLUMN)))
           (LOCALLY
            (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
            (AREF ROW COLUMN))))
        (SEQUENCE
         (LET ((LENGTH (LENGTH ROW)))
           (UNLESS (< -1 COLUMN LENGTH)
             (ERROR 'NO-COLUMN :BOUNDS (IOTA LENGTH) :ARGUMENT 'COLUMN :VALUE
                    COLUMN :FORMAT-ARGUMENTS (LIST COLUMN)))
           (ELT ROW COLUMN))))))

[vellum/src/table/functions.lisp:36]
  (DEFUN (SETF ROW-AT) (NEW-VALUE HEADER ROW NAME)
    (LET ((COLUMN
           (IF (INTEGERP NAME)
               NAME
               (#S(FORMGREP:SYMREF
                   :NAME "NAME-TO-INDEX"
                   :QUALIFIER "VELLUM.HEADER")
                HEADER NAME))))
      (DECLARE (TYPE INTEGER COLUMN))
      (ETYPECASE ROW
        (SETFABLE-TABLE-ROW
         (SETF (~> ROW SETFABLE-TABLE-ROW-ITERATOR
                (#S(FORMGREP:SYMREF
                    :NAME "ITERATOR-AT"
                    :QUALIFIER "VELLUM.COLUMN")
                 COLUMN))
                 NEW-VALUE))
        (SIMPLE-VECTOR
         (LET ((LENGTH (LENGTH ROW)))
           (DECLARE (TYPE FIXNUM LENGTH))
           (UNLESS (< -1 COLUMN LENGTH)
             (ERROR 'NO-COLUMN :BOUNDS
                    (ECLECTOR.READER:QUASIQUOTE
                     (0 (ECLECTOR.READER:UNQUOTE LENGTH)))
                    :ARGUMENT 'COLUMN :VALUE COLUMN :FORMAT-ARGUMENTS
                    (LIST COLUMN)))
           (LOCALLY
            (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 0) (DEBUG 0)))
            (SETF (AREF ROW COLUMN) NEW-VALUE))))
        (SEQUENCE
         (LET ((LENGTH (LENGTH ROW)))
           (UNLESS (< -1 COLUMN LENGTH)
             (ERROR 'NO-COLUMN :BOUNDS (IOTA LENGTH) :ARGUMENT 'COLUMN :VALUE
                    COLUMN :FORMAT-ARGUMENTS (LIST COLUMN)))
           (SETF (ELT ROW COLUMN) NEW-VALUE))))))

[vellum/src/table/to-table.lisp:4]
  (DEFMETHOD TO-TABLE
             (
              (RANGE
               #S(FORMGREP:SYMREF
                  :NAME "FRAME-RANGE-MIXIN"
                  :QUALIFIER "VELLUM.HEADER"))
              &KEY
              (CLASS
               '#S(FORMGREP:SYMREF
                   :NAME "STANDARD-TABLE"
                   :QUALIFIER "VELLUM.TABLE"))
              (BODY NIL) (ENABLE-RESTARTS *ENABLE-RESTARTS*)
              (WRAP-ERRORS *WRAP-ERRORS*) &ALLOW-OTHER-KEYS)
    (LET* ((HEADER
            (#S(FORMGREP:SYMREF :NAME "READ-HEADER" :QUALIFIER "VELLUM.HEADER")
             RANGE))
           (FUNCTION (ENSURE-FUNCTION (BIND-ROW-CLOSURE BODY :HEADER HEADER)))
           (TRANSFORMATION
            (~> (TABLE-FROM-HEADER CLASS HEADER)
             (TRANSFORMATION NIL :IN-PLACE T :ENABLE-RESTARTS ENABLE-RESTARTS
              :WRAP-ERRORS WRAP-ERRORS)))
           (COLUMN-COUNT
            (#S(FORMGREP:SYMREF
                :NAME "COLUMN-COUNT"
                :QUALIFIER "VELLUM.HEADER")
             HEADER))
           (PREV-CONTROL (ENSURE-FUNCTION *TRANSFORM-CONTROL*))
           (TABLE (STANDARD-TRANSFORMATION-TABLE TRANSFORMATION)))
      (DECLARE
       (TYPE
        #S(FORMGREP:SYMREF :NAME "STANDARD-HEADER" :QUALIFIER "VELLUM.HEADER")
        HEADER))
      (BLOCK MAIN
        (#S(FORMGREP:SYMREF :NAME "ACROSS" :QUALIFIER "CL-DS") RANGE
         (LAMBDA (ROW)
           (BLOCK FUNCTION
             (TRANSFORM-ROW-IMPL TRANSFORMATION
              (LAMBDA (EXISTING-ROW)
                (DECLARE (TYPE SETFABLE-TABLE-ROW EXISTING-ROW)
                         (TYPE SIMPLE-VECTOR ROW)
                         (OPTIMIZE (SPEED 3) (SAFETY 0)))
                (ITERATE (DECLARE (TYPE FIXNUM I))
                 (FOR I FROM 0 BELOW (MIN COLUMN-COUNT (LENGTH ROW)))
                 (FOR VALUE = (AREF ROW I))
                 (SETF (RR I EXISTING-ROW HEADER) VALUE))
                (WHEN BODY
                  (WITH-TABLE (TABLE)
                   (LET ((ROW (STANDARD-TRANSFORMATION-ROW TRANSFORMATION)))
                     (#S(FORMGREP:SYMREF
                         :NAME "SET-ROW"
                         :QUALIFIER "VELLUM.HEADER")
                      ROW)
                     (LET ((*TRANSFORM-CONTROL*
                            (LAMBDA (OPERATION)
                              (COND ((EQ OPERATION :FINISH) (RETURN-FROM MAIN))
                                    ((EQ OPERATION :DROP)
                                     (ITERATE (DECLARE (TYPE FIXNUM I))
                                      (FOR I FROM 0 BELOW COLUMN-COUNT)
                                      (SETF (RR I ROW HEADER) :NULL))
                                     (RETURN-FROM FUNCTION))
                                    (T (FUNCALL PREV-CONTROL OPERATION))))))
                       (FUNCALL FUNCTION
                                (STANDARD-TRANSFORMATION-ROW
                                 TRANSFORMATION))))))))))))
      (TRANSFORMATION-RESULT TRANSFORMATION)))

[vernacular/module.lisp:186]
  (DEFCONST FLANK-SPEED
   '((SPEED 3) (SAFETY 1) (DEBUG 0) (COMPILATION-SPEED 0) (SPACE 0))
   "Go as fast as you safely can.")

[vernacular/module.lisp:194]
  (DEFCONST BATTLESHORT
   '((SPEED 3) (SAFETY 0) (DEBUG 0) (COMPILATION-SPEED 0) (SPACE 0))
   "You'd better know what you're doing.")

[vernacular/module.lisp:255]
  (DEFUN CLEAR-INLINE-CACHES (MODULE)
    "Look up the inline caches pointing into MODULE and make them all
unbound again.

This should be used before a module is reloaded, to make sure the
inline caches will point into the new module."
    (DECLARE (OPTIMIZE SPEED (SAFETY 0)))
    (LET ((POINTERS
           (SYNCHRONIZED ('*MODULE-INLINE-CACHE-POINTERS*)
            (POPHASH MODULE *MODULE-INLINE-CACHE-POINTERS*))))
      (DOLIST (P POINTERS)
        (WHEN-LET (CACHE (TRIVIAL-GARBAGE:WEAK-POINTER-VALUE P))
         (SETF (UNBOX CACHE) UNBOUND)))))

[vivace-graph-v3/linear-hash.lisp:53]
  (DEFMETHOD UUID-ARRAY-EQUAL
             ((X SIMPLE-VECTOR) (Y SIMPLE-VECTOR) &OPTIONAL _A _B)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DECLARE (IGNORE _A _B))
    (DOTIMES (I 16)
      (UNLESS (= (SVREF X I) (SVREF Y I)) (RETURN-FROM UUID-ARRAY-EQUAL NIL)))
    T)

[vivace-graph-v3/linear-hash.lisp:61]
  (DEFMETHOD UUID-ARRAY-EQUAL ((X ARRAY) (Y ARRAY) &OPTIONAL _A _B)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DECLARE (IGNORE _A _B))
    (DOTIMES (I 16)
      (UNLESS (= (AREF X I) (AREF Y I)) (RETURN-FROM UUID-ARRAY-EQUAL NIL)))
    T)

[vivace-graph-v3/linear-hash.lisp:69]
  (DEFMETHOD UUID-ARRAY-EQUAL ((X ARRAY) (Y MPOINTER) &OPTIONAL _A _B)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DECLARE (IGNORE _A _B))
    (DOTIMES (I 16)
      (UNLESS
          (= (AREF X I) (GET-BYTE (MPOINTER-MMAP Y) (+ I (MPOINTER-LOC Y))))
        (RETURN-FROM UUID-ARRAY-EQUAL NIL)))
    T)

[vivace-graph-v3/linear-hash.lisp:77]
  (DEFMETHOD UUID-ARRAY-EQUAL ((X MPOINTER) (Y ARRAY) &OPTIONAL _A _B)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DECLARE (IGNORE _A _B))
    (DOTIMES (I 16)
      (UNLESS
          (= (AREF Y I) (GET-BYTE (MPOINTER-MMAP X) (+ I (MPOINTER-LOC X))))
        (RETURN-FROM UUID-ARRAY-EQUAL NIL)))
    T)

[vivace-graph-v3/linear-hash.lisp:85]
  (DEFMETHOD UUID-ARRAY-EQUAL ((X MPOINTER) (Y MPOINTER) &OPTIONAL _A _B)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DECLARE (IGNORE _A _B))
    (DOTIMES (I 16)
      (UNLESS
          (= (GET-BYTE (MPOINTER-MMAP X) (+ I (MPOINTER-LOC X)))
             (GET-BYTE (MPOINTER-MMAP Y) (+ I (MPOINTER-LOC Y))))
        (RETURN-FROM UUID-ARRAY-EQUAL NIL)))
    T)

[vivace-graph-v3/linear-hash.lisp:94]
  (DEFMETHOD UUID-ARRAY-EQUAL ((X ARRAY) (Y MAPPED-FILE) &OPTIONAL OFFSET1 _)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DECLARE (IGNORE _))
    (DOTIMES (I 16)
      (UNLESS (= (AREF X I) (GET-BYTE Y (+ I OFFSET1)))
        (RETURN-FROM UUID-ARRAY-EQUAL NIL)))
    T)

[vivace-graph-v3/linear-hash.lisp:102]
  (DEFMETHOD UUID-ARRAY-EQUAL ((X MAPPED-FILE) (Y ARRAY) &OPTIONAL OFFSET1 _)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DECLARE (IGNORE _))
    (DOTIMES (I 16)
      (UNLESS (= (AREF Y I) (GET-BYTE X (+ I OFFSET1)))
        (RETURN-FROM UUID-ARRAY-EQUAL NIL)))
    T)

[vivace-graph-v3/linear-hash.lisp:110]
  (DEFMETHOD UUID-ARRAY-EQUAL
             ((X MAPPED-FILE) (Y MAPPED-FILE) &OPTIONAL OFFSET-X OFFSET-Y)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DOTIMES (I 16)
      (UNLESS (= (GET-BYTE X (+ I OFFSET-X)) (GET-BYTE Y (+ I OFFSET-Y)))
        (RETURN-FROM UUID-ARRAY-EQUAL NIL)))
    T)

[vivace-graph-v3/node-id.lisp:3]
  (LET ((RANDOM-STATES
         (LIST (MAKE-RANDOM-STATE) (PROGN (SLEEP 1) (MAKE-RANDOM-STATE)))))
    (DEFUN GENERATE-UUID-NAME ()
      "Generate a byte array for V5 UUID generation using time and random bytes"
      (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
      (MULTIPLE-VALUE-BIND (SEC MSEC)
          (GET-TIME-OF-DAY)
        (LET* ((TOTAL-BYTES 40)
               (VEC (MAKE-ARRAY TOTAL-BYTES :ELEMENT-TYPE '(UNSIGNED-BYTE 8)))
               (OFFSET 0))
          (LET ((N-BYTES (CEILING (INTEGER-LENGTH SEC) 8)))
            (DOTIMES (I N-BYTES)
              (SETF (AREF VEC OFFSET) (LDB (BYTE 8 (* I 8)) SEC))
              (INCF OFFSET)))
          (LET ((N-BYTES (CEILING (INTEGER-LENGTH MSEC) 8)))
            (DOTIMES (I N-BYTES)
              (SETF (AREF VEC OFFSET) (LDB (BYTE 8 (* I 8)) MSEC))
              (INCF OFFSET)))
          (LOOP FOR I FROM OFFSET BELOW TOTAL-BYTES
                DO (SETF (AREF VEC I)
                           (RANDOM 256 (NTH (RANDOM 2) RANDOM-STATES))))
          VEC))))

[vivace-graph-v3/node-id.lisp:27]
  (DEFUN GEN-V5-UUID (NAMESPACE)
    "Generates a version 5 (name based SHA1) uuid.  Code stolen from the UUID library."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((NAME (GENERATE-UUID-NAME)) (DIGESTER (IRONCLAD:MAKE-DIGEST :SHA1)))
      (IRONCLAD:UPDATE-DIGEST DIGESTER NAMESPACE)
      (IRONCLAD:UPDATE-DIGEST DIGESTER NAME)
      (LET ((HASH (IRONCLAD:PRODUCE-DIGEST DIGESTER)))
        (LET ((ID (SUBSEQ HASH 0 16)))
          (LET ((TIME-HIGH
                 (DPB 5 (BYTE 4 12)
                      (LOGIOR (ASH (AREF HASH 6) 8) (AREF HASH 7)))))
            (LOOP FOR I FROM 7 DOWNTO 6
                  DO (SETF (AREF ID I) (LDB (BYTE 8 (* 8 (- 7 I))) TIME-HIGH)))
            (SETF (AREF ID 8) (DPB 2 (BYTE 2 6) (AREF HASH 8)))
            ID)))))

[vivace-graph-v3/primitive-node.lisp:273]
  (DEFMETHOD %HASH ((KEY NIL))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (LET ((INT (AREF KEY 0)))
      (LOOP FOR SUBSCRIPT FROM 1 TO 15
            FOR SHIFT FROM 8 BY 8
            DO (INCF INT (ASH (LOGAND (AREF KEY SUBSCRIPT) 255) SHIFT)))
      INT))

[vivace-graph-v3/ve-index.lisp:16]
  (DEFMETHOD %HASH ((VE-KEY VE-KEY))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (+ (%HASH (VE-KEY-ID VE-KEY)) (VE-KEY-TYPE-ID VE-KEY)))

[vivace-graph-v3/ve-index.lisp:28]
  (DEFUN %VE-KEY-EQUAL (KEY1 KEY2)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (AND (= (VE-KEY-TYPE-ID KEY1) (VE-KEY-TYPE-ID KEY2))
         (EQUALP (VE-KEY-ID KEY1) (VE-KEY-ID KEY2))))

[vivace-graph-v3/vev-index.lisp:18]
  (DEFMETHOD %HASH ((VEV-KEY VEV-KEY))
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (+ (%HASH (VEV-KEY-IN-ID VEV-KEY)) (%HASH (VEV-KEY-OUT-ID VEV-KEY))
       (VEV-KEY-TYPE-ID VEV-KEY)))

[vivace-graph-v3/vev-index.lisp:35]
  (DEFUN %VEV-KEY-EQUAL (KEY1 KEY2)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (AND (= (VEV-KEY-TYPE-ID KEY1) (VEV-KEY-TYPE-ID KEY2))
         (EQUALP (VEV-KEY-OUT-ID KEY1) (VEV-KEY-OUT-ID KEY2))
         (EQUALP (VEV-KEY-IN-ID KEY1) (VEV-KEY-IN-ID KEY2))))

[vom/vom.lisp:131]
  (DEFUN FIND-PACKAGE-LEVEL (PACKAGE-KEYWORD)
    "Given  package keyword (doesn't have to be an exact match, can be an alias),
   find the configured loglevel of that package.

   This caches the package->level connection in *package-level-cache*."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0))
             (TYPE KEYWORD PACKAGE-KEYWORD))
    (LET ((CACHED (GETF *PACKAGE-LEVEL-CACHE* PACKAGE-KEYWORD)))
      (WHEN CACHED (RETURN-FROM FIND-PACKAGE-LEVEL CACHED))
      (LET* ((PACKAGE (FIND-PACKAGE PACKAGE-KEYWORD))
             (PACKAGE-NAME
              (WHEN PACKAGE (INTERN (PACKAGE-NAME PACKAGE) :KEYWORD)))
             (PACKAGE-LEVEL (GETF *CONFIG* PACKAGE-NAME))
             (PACKAGE-LEVEL
              (IF PACKAGE-LEVEL
                  PACKAGE-LEVEL
                  (GETF *CONFIG* T)))
             (PACKAGE-LEVEL-VALUE (GETF *LEVELS* PACKAGE-LEVEL 0)))
        (SETF (GETF *PACKAGE-LEVEL-CACHE* PACKAGE-KEYWORD) PACKAGE-LEVEL-VALUE)
        PACKAGE-LEVEL-VALUE)))

[vom/vom.lisp:155]
  (DEFUN DO-LOG (LEVEL-NAME LOG-LEVEL PACKAGE-KEYWORD FORMAT-STR &REST ARGS)
    "The given data to the current *log-stream* stream."
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0) (DEBUG 0))
             (TYPE KEYWORD LEVEL-NAME PACKAGE-KEYWORD)
             (TYPE INTEGER LOG-LEVEL)
             (TYPE STRING FORMAT-STR)
             (TYPE LIST ARGS))
    (LET* ((PACKAGE-LEVEL-VALUE (FIND-PACKAGE-LEVEL PACKAGE-KEYWORD)))
      (WHEN (<= LOG-LEVEL PACKAGE-LEVEL-VALUE)
        (LET* ((LEVEL-STR (STRING LEVEL-NAME))
               (LOGLINE
                (FUNCALL *LOG-FORMATTER* FORMAT-STR LEVEL-STR PACKAGE-KEYWORD
                         ARGS))
               (LOG-STREAMS
                (MULTIPLE-VALUE-LIST
                 (FUNCALL *LOG-HOOK* LOG-LEVEL PACKAGE-KEYWORD
                          PACKAGE-LEVEL-VALUE))))
          (DOLIST (STREAM LOG-STREAMS)
            (WRITE-SEQUENCE LOGLINE
                            (IF (EQ STREAM T)
                                *STANDARD-OUTPUT*
                                STREAM))
            (FINISH-OUTPUT STREAM))))))

[weblocks/src/bundling.lisp:113]
  (DEFUN BUNDLE-SOME-DEPENDENCIES
         (DEPENDENCY-LIST DEPENDENCY-TYPE &KEY BUNDLE-FOLDER)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 2)))
    (LET (EXCEPTIONS)
      (WHEN (LISTP DEPENDENCY-TYPE)
        (SETF EXCEPTIONS (CDR DEPENDENCY-TYPE))
        (SETF DEPENDENCY-TYPE (CAR DEPENDENCY-TYPE)))
      (LOOP FOR DEP IN DEPENDENCY-LIST
            FOR PATH = (LOCAL-PATH DEP)
            IF (AND PATH (TYPEP DEP DEPENDENCY-TYPE)
                    (NULL (FIND PATH EXCEPTIONS :TEST #'STRING-EQUAL)))
            IF (AND
                (CL-PPCRE:SCAN "-import(?:\\.\\d\\d*?|)$" (PATHNAME-NAME PATH))
                (STRING= "css" (PATHNAME-TYPE PATH)))
            COLLECT PATH INTO IMPORTS ELSE
            COLLECT PATH INTO MAIN
            END ELSE
            COLLECT DEP INTO OTHERS
            FINALLY (RETURN
                     (PROGN
                      (WHEN IMPORTS (SETF MAIN (APPEND IMPORTS MAIN)))
                      (WHEN MAIN
                        (PUSH
                         (BUILD-BUNDLE MAIN DEPENDENCY-TYPE :BUNDLE-FOLDER
                          BUNDLE-FOLDER)
                         OTHERS))
                      OTHERS)))))

[weblocks/src/utils/timing.lisp:35]
  (DEFMACRO TIMING (NAME &BODY BODY)
    (WITH-GENSYMS (START/REAL START/CPU END/REAL END/CPU SPENT/REAL SPENT/CPU)
     (ECLECTOR.READER:QUASIQUOTE
      (LET ((THUNK (LAMBDA () (ECLECTOR.READER:UNQUOTE-SPLICING BODY))))
        (IF *ENABLE-TIMINGS*
            (LET (((ECLECTOR.READER:UNQUOTE START/REAL)
                   (GET-INTERNAL-REAL-TIME))
                  ((ECLECTOR.READER:UNQUOTE START/CPU) (GET-INTERNAL-RUN-TIME)))
              (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 3))
                       ((INTEGER 0) (ECLECTOR.READER:UNQUOTE START/REAL)
                        (ECLECTOR.READER:UNQUOTE START/CPU)))
              (INCF *TIMING-LEVEL*)
              (ON-TIMING-START *TIMING-LEVEL* (ECLECTOR.READER:UNQUOTE NAME))
              (PROG1 (FUNCALL THUNK)
                (LET* (((ECLECTOR.READER:UNQUOTE END/REAL)
                        (GET-INTERNAL-REAL-TIME))
                       ((ECLECTOR.READER:UNQUOTE END/CPU)
                        (GET-INTERNAL-RUN-TIME))
                       ((ECLECTOR.READER:UNQUOTE SPENT/REAL)
                        (/
                         (- (ECLECTOR.READER:UNQUOTE END/REAL)
                            (ECLECTOR.READER:UNQUOTE START/REAL))
                         INTERNAL-TIME-UNITS-PER-SECOND))
                       ((ECLECTOR.READER:UNQUOTE SPENT/CPU)
                        (/
                         (- (ECLECTOR.READER:UNQUOTE END/CPU)
                            (ECLECTOR.READER:UNQUOTE START/CPU))
                         INTERNAL-TIME-UNITS-PER-SECOND)))
                  (DECLARE
                   ((INTEGER 0) (ECLECTOR.READER:UNQUOTE END/REAL)
                    (ECLECTOR.READER:UNQUOTE END/CPU))
                   ((RATIONAL 0) (ECLECTOR.READER:UNQUOTE SPENT/REAL)
                    (ECLECTOR.READER:UNQUOTE SPENT/CPU)))
                  (REPORT-TIMING (ECLECTOR.READER:UNQUOTE NAME)
                   (ECLECTOR.READER:UNQUOTE SPENT/REAL)
                   (ECLECTOR.READER:UNQUOTE SPENT/CPU))
                  (ON-TIMING-END *TIMING-LEVEL* (ECLECTOR.READER:UNQUOTE NAME))
                  (DECF *TIMING-LEVEL*))))
            (FUNCALL THUNK))))))

[websocket-driver/src/util.lisp:22]
  (DEFUN GENERATE-ACCEPT (KEY)
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0))
             (TYPE SIMPLE-STRING KEY))
    (#S(FORMGREP:SYMREF :NAME "SHA1-BASE64" :QUALIFIER "SHA1")
     (CONCATENATE 'STRING KEY +GUID+) #'STRING-TO-BASE64-STRING))

[weyl/polynomials/epolynomial.lisp:145]
  (DEFUN MAKE-COMPARISON-FUN (NUM-VARS VAR-ORDER &KEY TOTAL? REVERSE? NEW?)
    (LET ((NAME
           (INTERN
            (FORMAT NIL "COMPARE<~D>-~D~{.~D~}-~S-~S" NUM-VARS
                    (FIRST VAR-ORDER) (REST VAR-ORDER) TOTAL? REVERSE?)))
          GREAT
          LESS)
      (IF (NULL REVERSE?)
          (SETQ GREAT '>
                LESS '<)
          (SETQ GREAT '<
                LESS '>))
      (UNLESS (AND (NULL NEW?) (FBOUNDP NAME))
        (COMPILE NAME
                 (ECLECTOR.READER:QUASIQUOTE
                  (LAMBDA (A B)
                    (LET (A-TEMP B-TEMP)
                      (DECLARE (FIXNUM A-TEMP B-TEMP)
                               (OPTIMIZE (SAFETY 0)))
                      (COND
                       (ECLECTOR.READER:UNQUOTE-SPLICING
                        (WHEN TOTAL?
                          (ECLECTOR.READER:QUASIQUOTE
                           (((PLUSP
                              (ECLECTOR.READER:UNQUOTE
                               (IF (> NUM-VARS 10)
                                   (ECLECTOR.READER:QUASIQUOTE
                                    (LOOP FOR I FIXNUM UPFROM 1 BELOW (ECLECTOR.READER:UNQUOTE
                                                                       NUM-VARS)
                                          SUMMING (THE FIXNUM
                                                       (-
                                                        (THE FIXNUM
                                                             (SVREF A I))
                                                        (THE FIXNUM
                                                             (SVREF B I))))))
                                   (ECLECTOR.READER:QUASIQUOTE
                                    (+
                                     (ECLECTOR.READER:UNQUOTE-SPLICING
                                      (LOOP FOR I UPFROM 1 BELOW NUM-VARS
                                            COLLECT (ECLECTOR.READER:QUASIQUOTE
                                                     (THE FIXNUM
                                                          (-
                                                           (THE FIXNUM
                                                                (SVREF A
                                                                       (ECLECTOR.READER:UNQUOTE
                                                                        I)))
                                                           (THE FIXNUM
                                                                (SVREF B
                                                                       (ECLECTOR.READER:UNQUOTE
                                                                        I)))))))))))))
                             T)
                            ((< A-TEMP B-TEMP) NIL)))))
                       (ECLECTOR.READER:UNQUOTE-SPLICING
                        (LOOP FOR V IN VAR-ORDER
                              APPEND (ECLECTOR.READER:QUASIQUOTE
                                      ((((ECLECTOR.READER:UNQUOTE GREAT)
                                         (SETQ A-TEMP
                                                 (SVREF A
                                                        (ECLECTOR.READER:UNQUOTE
                                                         V)))
                                         (SETQ B-TEMP
                                                 (SVREF B
                                                        (ECLECTOR.READER:UNQUOTE
                                                         V))))
                                        T)
                                       (((ECLECTOR.READER:UNQUOTE LESS) A-TEMP
                                         B-TEMP)
                                        NIL)))))))))))
      (VALUES (SYMBOL-FUNCTION NAME) NAME)))

[weyl/polynomials/epolynomial.lisp:228]
  (DEFUN MAKE-ETERM (EXP COEF)
    (DECLARE (TYPE SIMPLE-ARRAY EXP)
             (OPTIMIZE (SAFETY 0)))
    (LET* ((DIM (ARRAY-DIMENSION EXP 0)) (TERM (MAKE-ARRAY DIM)))
      (DECLARE (FIXNUM DIM)
               (TYPE SIMPLE-ARRAY TERM))
      (SETF (SVREF TERM 0) COEF)
      (DO ((I 1 (1+ I)))
          ((> I DIM) TERM)
        (DECLARE (FIXNUM I))
        (SETF (SVREF TERM I) (SVREF EXP I)))))

[weyl/polynomials/epolynomial.lisp:346]
  (DEFUN GTERM-TIMES (X-TERM Y-TERM DIM)
    (DECLARE (TYPE SIMPLE-ARRAY X-TERM Y-TERM)
             (OPTIMIZE (SAFETY 0)))
    (LET ((E (MAKE-ARRAY DIM)))
      (LOOP FOR I FIXNUM UPFROM 1 BELOW DIM
            DO (SETF (SVREF E I)
                       (THE FIXNUM
                            (+ (THE FIXNUM (SVREF X-TERM I))
                               (THE FIXNUM (SVREF Y-TERM I))))))
      E))

[weyl/polynomials/epolynomial.lisp:356]
  (DEFUN GTERM-QUOT (X-TERM Y-TERM DIM)
    (DECLARE (TYPE SIMPLE-ARRAY X-TERM Y-TERM)
             (OPTIMIZE (SAFETY 0)))
    (LET ((E (MAKE-ARRAY DIM)))
      (LOOP FOR I FIXNUM UPFROM 1 BELOW DIM
            DO (SETF (SVREF E I)
                       (THE FIXNUM
                            (- (THE FIXNUM (SVREF X-TERM I))
                               (THE FIXNUM (SVREF Y-TERM I))))))
      E))

[weyl/polynomials/epolynomial.lisp:366]
  (DEFUN GTERM-LCM (X-TERM Y-TERM DIM)
    (DECLARE (TYPE SIMPLE-ARRAY X-TERM Y-TERM)
             (OPTIMIZE (SAFETY 0)))
    (LET ((E (MAKE-ARRAY DIM)))
      (LOOP FOR I FIXNUM UPFROM 1 BELOW DIM
            DO (SETF (SVREF E I)
                       (MAX (THE FIXNUM (SVREF X-TERM I))
                            (THE FIXNUM (SVREF Y-TERM I)))))
      E))

[weyl/polynomials/epolynomial.lisp:375]
  (DEFUN GTERM-DISJOINT (X-TERM Y-TERM DIM)
    (DECLARE (TYPE SIMPLE-ARRAY X-TERM Y-TERM)
             (OPTIMIZE (SAFETY 0)))
    (LOOP FOR I FIXNUM UPFROM 1 BELOW DIM
          WHEN (NOT
                (OR (ZEROP (THE FIXNUM (SVREF X-TERM I)))
                    (ZEROP (THE FIXNUM (SVREF Y-TERM I)))))
          DO (RETURN NIL)
          FINALLY (RETURN T)))

[weyl/polynomials/epolynomial.lisp:384]
  (DEFUN GTERM-DOMINATES (X-TERM Y-TERM DIM)
    (DECLARE (TYPE SIMPLE-ARRAY X-TERM Y-TERM)
             (OPTIMIZE (SAFETY 0)))
    (LOOP FOR I FIXNUM UPFROM 1 BELOW DIM
          WHEN (< (THE FIXNUM (SVREF X-TERM I)) (THE FIXNUM (SVREF Y-TERM I)))
          DO (RETURN NIL)
          FINALLY (RETURN T)))

[weyl/polynomials/epolynomial.lisp:393]
  (DEFUN GTERM-EQUAL (X-TERM Y-TERM DIM)
    (DECLARE (TYPE SIMPLE-ARRAY X-TERM Y-TERM)
             (OPTIMIZE (SAFETY 0)))
    (LOOP FOR I FIXNUM UPFROM 1 BELOW DIM
          DO (WHEN
                 (NOT
                  (= (THE FIXNUM (SVREF X-TERM I))
                     (THE FIXNUM (SVREF Y-TERM I))))
               (RETURN NIL))
          FINALLY (RETURN T)))

[weyl/polynomials/epolynomial.lisp:402]
  (DEFUN GTERM-CONSTANT? (TERM DIM)
    (DECLARE (TYPE SIMPLE-ARRAY TERM)
             (OPTIMIZE (SAFETY 0)))
    (LOOP FOR I FIXNUM UPFROM 1 BELOW DIM
          DO (WHEN (NOT (ZEROP (THE FIXNUM (SVREF TERM I)))) (RETURN NIL))
          FINALLY (RETURN T)))

[weyl/polynomials/grobner.lisp:198]
  (DEFUN TERMS-S-POLY (GREATER-FUNCTION TERMS1 TERMS2)
    (DECLARE (OPTIMIZE (SAFETY 0)))
    (LET* ((DIM (LENGTH (FIRST TERMS1)))
           (M (GTERM-LCM (LT TERMS1) (LT TERMS2) DIM))
           (ANS-TERMS (LIST NIL))
           (TERMS ANS-TERMS)
           (X (RED TERMS1))
           (Y (RED TERMS2))
           (XE (GTERM-QUOT M (LT TERMS1) DIM))
           (XC (SVREF (LT TERMS2) 0))
           (YE (GTERM-QUOT M (LT TERMS2) DIM))
           (YC (- (SVREF (LT TERMS1) 0)))
           TEMP
           SUM
           NEW-XE
           NEW-YE)
      (LOOP
       (COND
        ((TERMS0? X)
         (COND ((TERMS0? Y) (RETURN (REST ANS-TERMS)))
               (T (SETQ TEMP (GTERM-TIMES YE (LT Y) DIM))
                (SETF (SVREF TEMP 0) (* YC (SVREF (LT Y) 0)))
                (SETF (REST TERMS) (LIST TEMP)) (SETF TERMS (REST TERMS))
                (SETQ Y (RED Y)))))
        ((OR (TERMS0? Y)
             (%FUNCALL GREATER-FUNCTION
              (SETQ NEW-XE (GTERM-TIMES XE (LT X) DIM))
              (SETQ NEW-YE (GTERM-TIMES YE (LT Y) DIM))))
         (SETQ TEMP (GTERM-TIMES XE (LT X) DIM))
         (SETF (SVREF TEMP 0) (* XC (SVREF (LT X) 0)))
         (SETF (REST TERMS) (LIST TEMP)) (SETF TERMS (REST TERMS))
         (SETQ X (RED X)))
        ((%FUNCALL GREATER-FUNCTION NEW-YE NEW-XE)
         (SETF (SVREF NEW-YE 0) (* YC (SVREF (LT Y) 0)))
         (SETF (REST TERMS) (LIST NEW-YE)) (SETF TERMS (REST TERMS))
         (SETQ Y (RED Y)))
        (T (SETQ SUM (+ (* XC (SVREF (LT X) 0)) (* YC (SVREF (LT Y) 0))))
         (UNLESS (0? SUM)
           (SETF (SVREF NEW-XE 0) SUM)
           (SETF (REST TERMS) (LIST NEW-XE))
           (SETF TERMS (REST TERMS)))
         (SETQ X (RED X)
               Y (RED Y)))))))

[weyl/polynomials/upolynomial.lisp:319]
  (DEFUN CLIST-TIMES (X Y)
    (DECLARE (TYPE SIMPLE-ARRAY X Y)
             (OPTIMIZE (SAFETY 0)))
    (LET* ((XLEN (CLIST-LENGTH X))
           (YLEN (CLIST-LENGTH Y))
           (ANSLIST
            (MAKE-ARRAY (- (THE FIXNUM (+ XLEN YLEN)) 1) :INITIAL-ELEMENT
                        (ZERO *COEFFICIENT-DOMAIN*))))
      (DECLARE (FIXNUM XLEN YLEN)
               (TYPE SIMPLE-ARRAY ANSLIST))
      (DO ((XEXP 0 (+ XEXP 1)))
          ((= XEXP XLEN) ANSLIST)
        (DECLARE (FIXNUM XEXP))
        (DO ((XELT (CLIST-GET X XEXP))
             (YEXP 0 (+ YEXP 1))
             (ANSEXP XEXP (+ ANSEXP 1)))
            ((= YEXP YLEN))
          (DECLARE (FIXNUM YEXP ANSEXP))
          (SETF (CLIST-GET ANSLIST ANSEXP)
                  (+ (CLIST-GET ANSLIST ANSEXP)
                     (* XELT (CLIST-GET Y YEXP))))))))

[weyl/vector-spaces/vector.lisp:14]
  (DEFMACRO LOOP-VECTOR-BIND (INDEX VARS-VECTORS &BODY BODY)
    (LET ((CNT 0) VECTORS LIMIT VAR-BINDINGS)
      (SETQ VAR-BINDINGS
              (LOOP FOR (VAR VECT) IN VARS-VECTORS
                    FOR VECTOR = (INTERN (FORMAT NIL ".VV~D." (INCF CNT)))
                    DO (PUSH (LIST VAR VECTOR) VECTORS)
                    COLLECT (ECLECTOR.READER:QUASIQUOTE
                             ((ECLECTOR.READER:UNQUOTE VECTOR)
                              (ECLECTOR.READER:UNQUOTE VECT)))
                    FINALLY (SETQ VECTORS (NREVERSE VECTORS))))
      (COND
       ((ATOM INDEX) (WHEN (NULL INDEX) (SETQ INDEX '.I.))
        (SETQ LIMIT
                (ECLECTOR.READER:QUASIQUOTE
                 (MIN
                  (ECLECTOR.READER:UNQUOTE-SPLICING
                   (LOOP FOR (NIL VECT) IN VECTORS
                         COLLECT (ECLECTOR.READER:QUASIQUOTE
                                  (ARRAY-DIMENSION
                                   (ECLECTOR.READER:UNQUOTE VECT) 0))))))))
       (T (SETQ LIMIT (SECOND INDEX)) (SETQ INDEX (FIRST INDEX))))
      (ECLECTOR.READER:QUASIQUOTE
       (LET (ECLECTOR.READER:UNQUOTE VAR-BINDINGS)
         (DECLARE (OPTIMIZE (SAFETY 1)))
         (LOOP FOR (ECLECTOR.READER:UNQUOTE
                    INDEX) FIXNUM BELOW (ECLECTOR.READER:UNQUOTE
                                         LIMIT) (ECLECTOR.READER:UNQUOTE-SPLICING
                                                 (LOOP FOR (VAR
                                                            VECT) IN VECTORS
                                                       APPEND (ECLECTOR.READER:QUASIQUOTE
                                                               (FOR
                                                                (ECLECTOR.READER:UNQUOTE
                                                                 VAR)
                                                                =
                                                                (SVREF
                                                                 (ECLECTOR.READER:UNQUOTE
                                                                  VECT)
                                                                 (ECLECTOR.READER:UNQUOTE
                                                                  INDEX))))))
               DO (ECLECTOR.READER:UNQUOTE-SPLICING BODY))))))

[xecto/affine-arrays.lisp:421]
  (DEFMACRO DEF-MAP-INTO/3 (OP &OPTIONAL (FUN OP))
    (LET ((NAME (INTERN (FORMAT NIL "%EXECUTE-MAP-INTO/3-~A" OP))))
      (ECLECTOR.READER:QUASIQUOTE
       (PROGN
        (DEFUN (ECLECTOR.READER:UNQUOTE NAME) (VECS OFFSETS COUNT INCREMENT)
          (DECLARE (TYPE (SIMPLE-VECTOR 3) VECS INCREMENT)
                   (TYPE (SIMPLE-ARRAY (AND UNSIGNED-BYTE FIXNUM) (3)) OFFSETS)
                   (TYPE (AND UNSIGNED-BYTE FIXNUM) COUNT))
          (LET ((V0 (AREF VECS 0))
                (V1 (AREF VECS 1))
                (V2 (AREF VECS 2))
                (I0 (AREF OFFSETS 0))
                (I1 (AREF OFFSETS 1))
                (I2 (AREF OFFSETS 2))
                (D0 (AREF INCREMENT 0))
                (D1 (AREF INCREMENT 1))
                (D2 (AREF INCREMENT 2)))
            (DECLARE (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT 1) V0 V1 V2)
                     (TYPE (AND UNSIGNED-BYTE FIXNUM) I0 I1 I2)
                     (TYPE FIXNUM D0 D1 D2)
                     (OPTIMIZE SPEED (SAFETY 0)))
            (LOOP REPEAT
                  COUNT
                  DO (SETF (AREF V0 I0)
                             ((ECLECTOR.READER:UNQUOTE FUN) (AREF V1 I1)
                              (AREF V2 I2))) (INCF I0 D0) (INCF I1 D1) (INCF I2
                                                                             D2))))
        (SETF (GETHASH '((ECLECTOR.READER:UNQUOTE OP) . 3) *MAP-INTO-ROUTINES*)
                '(ECLECTOR.READER:UNQUOTE NAME))
        (ECLECTOR.READER:UNQUOTE
         (LET ((NAME (INTERN (FORMAT NIL "V~A" OP)))
               (NAME! (INTERN (FORMAT NIL "V~A!" OP))))
           (ECLECTOR.READER:QUASIQUOTE
            (PROGN
             (DECLAIM
              (INLINE (ECLECTOR.READER:UNQUOTE NAME)
               (ECLECTOR.READER:UNQUOTE NAME!)))
             (DEFUN (ECLECTOR.READER:UNQUOTE NAME) (X Y)
               (XMAP '(ECLECTOR.READER:UNQUOTE OP) X Y))
             (DEFUN (ECLECTOR.READER:UNQUOTE NAME!) (DST X Y)
               (XMAP-INTO DST '(ECLECTOR.READER:UNQUOTE OP) X Y))))))))))

[xecto/affine-arrays.lisp:463]
  (DEFMACRO DEF-MAP-INTO/2 (OP &OPTIONAL (FUN OP))
    (LET ((NAME (INTERN (FORMAT NIL "%EXECUTE-MAP-INTO/2-~A" OP))))
      (ECLECTOR.READER:QUASIQUOTE
       (PROGN
        (DEFUN (ECLECTOR.READER:UNQUOTE NAME) (VECS OFFSETS COUNT INCREMENT)
          (DECLARE (TYPE (SIMPLE-VECTOR 2) VECS INCREMENT)
                   (TYPE (SIMPLE-ARRAY (AND UNSIGNED-BYTE FIXNUM) (2)) OFFSETS)
                   (TYPE (AND UNSIGNED-BYTE FIXNUM) COUNT))
          (LET ((V0 (AREF VECS 0))
                (V1 (AREF VECS 1))
                (I0 (AREF OFFSETS 0))
                (I1 (AREF OFFSETS 1))
                (D0 (AREF INCREMENT 0))
                (D1 (AREF INCREMENT 1)))
            (DECLARE (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT 1) V0 V1)
                     (TYPE (AND UNSIGNED-BYTE FIXNUM) I0 I1)
                     (TYPE FIXNUM D0 D1)
                     (OPTIMIZE SPEED (SAFETY 0)))
            (LOOP REPEAT
                  COUNT
                  DO (SETF (AREF V0 I0)
                             ((ECLECTOR.READER:UNQUOTE FUN)
                              (AREF V1 I1))) (INCF I0 D0) (INCF I1 D1))))
        (SETF (GETHASH '((ECLECTOR.READER:UNQUOTE OP) . 2) *MAP-INTO-ROUTINES*)
                '(ECLECTOR.READER:UNQUOTE NAME))
        (ECLECTOR.READER:UNQUOTE
         (LET ((NAME (INTERN (FORMAT NIL "V~A" OP)))
               (NAME! (INTERN (FORMAT NIL "V~A!" OP))))
           (ECLECTOR.READER:QUASIQUOTE
            (PROGN
             (DECLAIM
              (INLINE (ECLECTOR.READER:UNQUOTE NAME)
               (ECLECTOR.READER:UNQUOTE NAME!)))
             (DEFUN (ECLECTOR.READER:UNQUOTE NAME) (X)
               (XMAP '(ECLECTOR.READER:UNQUOTE OP) X))
             (DEFUN (ECLECTOR.READER:UNQUOTE NAME!) (DST X)
               (XMAP-INTO DST '(ECLECTOR.READER:UNQUOTE OP) X))))))))))

[xecto/affine-arrays.lisp:518]
  (DEFUN %EXECUTE-MAP-INTO (OP VECS OFFSETS COUNT INCREMENT)
    (DECLARE (TYPE SIMPLE-VECTOR VECS INCREMENT)
             (TYPE (SIMPLE-ARRAY (AND UNSIGNED-BYTE FIXNUM) 1) OFFSETS)
             (TYPE (AND UNSIGNED-BYTE FIXNUM) COUNT))
    (ASSERT (= 3 (LENGTH VECS)))
    (ASSERT (EQL '+ OP))
    (LET ((V0 (AREF VECS 0))
          (V1 (AREF VECS 1))
          (V2 (AREF VECS 2))
          (I0 (AREF OFFSETS 0))
          (I1 (AREF OFFSETS 1))
          (I2 (AREF OFFSETS 2))
          (D0 (AREF INCREMENT 0))
          (D1 (AREF INCREMENT 1))
          (D2 (AREF INCREMENT 2)))
      (DECLARE (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT 1) V0 V1 V2)
               (TYPE (AND UNSIGNED-BYTE FIXNUM) I0 I1 I2)
               (TYPE FIXNUM D0 D1 D2)
               (OPTIMIZE SPEED (SAFETY 0)))
      (LOOP REPEAT
            COUNT
            DO (SETF (AREF V0 I0) (+ (AREF V1 I1) (AREF V2 I2))) (INCF I0
                                                                       D0) (INCF
                                                                            I1
                                                                            D1) (INCF
                                                                                 I2
                                                                                 D2))))

[xecto/affine-arrays.lisp:572]
  (DEFMACRO DEF-REDUCE-INTO (OP)
    (LET ((NAME (INTERN (FORMAT NIL "%EXECUTE-REDUCE-INTO/~A" OP))))
      (ECLECTOR.READER:QUASIQUOTE
       (PROGN
        (DEFUN (ECLECTOR.READER:UNQUOTE NAME)
               (STRIDE DIM DST X DST-OFFSET X-OFFSET COUNT DST-INC X-INC)
          (DECLARE (TYPE FIXNUM STRIDE)
                   (TYPE (AND UNSIGNED-BYTE FIXNUM) DIM DST-OFFSET X-OFFSET
                    COUNT DST-INC X-INC)
                   (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT 1) DST X))
          (LOCALLY
           (DECLARE (OPTIMIZE SPEED (SAFETY 0)))
           (LOOP REPEAT
                 COUNT
                 DO (LET ((X-OFFSET X-OFFSET) (ACC 0.0d0))
                      (DECLARE (TYPE (AND UNSIGNED-BYTE FIXNUM) X-OFFSET)
                               (TYPE DOUBLE-FLOAT ACC))
                      (LOOP REPEAT DIM
                            DO (SETF ACC
                                       ((ECLECTOR.READER:UNQUOTE OP) ACC
                                        (AREF X X-OFFSET))) (INCF X-OFFSET
                                                                  STRIDE))
                      (SETF (AREF DST DST-OFFSET) ACC)) (INCF DST-OFFSET
                                                              DST-INC) (INCF
                                                                        X-OFFSET
                                                                        X-INC))))
        (SETF (GETHASH '(ECLECTOR.READER:UNQUOTE OP) *REDUCE-INTO-ROUTINES*)
                '(ECLECTOR.READER:UNQUOTE NAME))
        (ECLECTOR.READER:UNQUOTE
         (LET ((NAME (INTERN (FORMAT NIL "R~A" OP)))
               (NAME! (INTERN (FORMAT NIL "R~A!" OP))))
           (ECLECTOR.READER:QUASIQUOTE
            (PROGN
             (DECLAIM
              (INLINE (ECLECTOR.READER:UNQUOTE NAME)
               (ECLECTOR.READER:UNQUOTE NAME!)))
             (DEFUN (ECLECTOR.READER:UNQUOTE NAME) (X)
               (XREDUCE '(ECLECTOR.READER:UNQUOTE OP) X))
             (DEFUN (ECLECTOR.READER:UNQUOTE NAME!) (DST X)
               (XREDUCE-INTO DST '(ECLECTOR.READER:UNQUOTE OP) X))))))))))

[xecto/affine-arrays.lisp:622]
  (DEFUN %EXECUTE-REDUCE-INTO
         (OP STRIDE DIM DST X DST-OFFSET X-OFFSET COUNT DST-INC X-INC)
    (DECLARE (TYPE FIXNUM STRIDE)
             (TYPE (AND UNSIGNED-BYTE FIXNUM) DIM DST-OFFSET X-OFFSET COUNT
              DST-INC X-INC)
             (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT 1) DST X)
             (TYPE (EQL +) OP))
    (LOCALLY
     (DECLARE (OPTIMIZE SPEED (SAFETY 0)))
     (LOOP REPEAT
           COUNT
           DO (LET ((X-OFFSET X-OFFSET) (ACC 0.0d0))
                (DECLARE (TYPE (AND UNSIGNED-BYTE FIXNUM) X-OFFSET)
                         (TYPE DOUBLE-FLOAT ACC))
                (LOOP REPEAT DIM
                      DO (INCF ACC (AREF X X-OFFSET)) (INCF X-OFFSET STRIDE))
                (SETF (AREF DST DST-OFFSET) ACC)) (INCF DST-OFFSET
                                                        DST-INC) (INCF X-OFFSET
                                                                       X-INC))))

[xecto/affine-arrays.lisp:682]
  (DEFMACRO DEF-SCAN-INTO (OP)
    (LET ((NAME (INTERN (FORMAT NIL "%EXECUTE-SCAN-INTO/~A" OP))))
      (ECLECTOR.READER:QUASIQUOTE
       (PROGN
        (DEFUN (ECLECTOR.READER:UNQUOTE NAME)
               (DST-STRIDE X-STRIDE DIM DST X DST-OFFSET X-OFFSET COUNT DST-INC
                X-INC)
          (DECLARE (TYPE FIXNUM DST-STRIDE X-STRIDE)
                   (TYPE (AND UNSIGNED-BYTE FIXNUM) DIM DST-OFFSET X-OFFSET
                    COUNT DST-INC X-INC)
                   (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT 1) DST X))
          (LOCALLY
           (DECLARE (OPTIMIZE SPEED (SAFETY 0)))
           (LOOP REPEAT
                 COUNT
                 DO (LET ((DST-OFFSET DST-OFFSET)
                          (X-OFFSET X-OFFSET)
                          (ACC 0.0d0))
                      (DECLARE
                       (TYPE (AND UNSIGNED-BYTE FIXNUM) X-OFFSET DST-OFFSET)
                       (TYPE DOUBLE-FLOAT ACC))
                      (LOOP REPEAT DIM
                            DO (SETF ACC
                                       (SETF (AREF DST DST-OFFSET)
                                               ((ECLECTOR.READER:UNQUOTE OP)
                                                ACC (AREF X X-OFFSET)))) (INCF
                                                                          DST-OFFSET
                                                                          DST-STRIDE) (INCF
                                                                                       X-OFFSET
                                                                                       X-STRIDE))) (INCF
                                                                                                    DST-OFFSET
                                                                                                    DST-INC) (INCF
                                                                                                              X-OFFSET
                                                                                                              X-INC))))
        (SETF (GETHASH '(ECLECTOR.READER:UNQUOTE OP) *SCAN-INTO-ROUTINES*)
                '(ECLECTOR.READER:UNQUOTE NAME))
        (ECLECTOR.READER:UNQUOTE
         (LET ((NAME (INTERN (FORMAT NIL "S~A" OP)))
               (NAME! (INTERN (FORMAT NIL "S~A!" OP))))
           (ECLECTOR.READER:QUASIQUOTE
            (PROGN
             (DECLAIM
              (INLINE (ECLECTOR.READER:UNQUOTE NAME)
               (ECLECTOR.READER:UNQUOTE NAME!)))
             (DEFUN (ECLECTOR.READER:UNQUOTE NAME) (X)
               (XSCAN '(ECLECTOR.READER:UNQUOTE OP) X))
             (DEFUN (ECLECTOR.READER:UNQUOTE NAME!) (DST X)
               (XSCAN-INTO DST '(ECLECTOR.READER:UNQUOTE OP) X))))))))))

[xecto/affine-arrays.lisp:735]
  (DEFUN %EXECUTE-SCAN-INTO
         (OP DST-STRIDE X-STRIDE DIM DST X DST-OFFSET X-OFFSET COUNT DST-INC
          X-INC)
    (DECLARE (TYPE FIXNUM DST-STRIDE X-STRIDE)
             (TYPE (AND UNSIGNED-BYTE FIXNUM) DIM DST-OFFSET X-OFFSET COUNT
              DST-INC X-INC)
             (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT 1) DST X)
             (TYPE (EQL +) OP))
    (LOCALLY
     (DECLARE (OPTIMIZE SPEED (SAFETY 0)))
     (LOOP REPEAT
           COUNT
           DO (LET ((DST-OFFSET DST-OFFSET) (X-OFFSET X-OFFSET) (ACC 0.0d0))
                (DECLARE (TYPE (AND UNSIGNED-BYTE FIXNUM) X-OFFSET DST-OFFSET)
                         (TYPE DOUBLE-FLOAT ACC))
                (LOOP REPEAT DIM
                      DO (INCF ACC (AREF X X-OFFSET)) (SETF (AREF DST
                                                                  DST-OFFSET)
                                                              ACC) (INCF
                                                                    DST-OFFSET
                                                                    DST-STRIDE) (INCF
                                                                                 X-OFFSET
                                                                                 X-STRIDE))) (INCF
                                                                                              DST-OFFSET
                                                                                              DST-INC) (INCF
                                                                                                        X-OFFSET
                                                                                                        X-INC))))

[xecto/affine-arrays.lisp:972]
  (DEFUN FAST-SD (VALUES)
    (DECLARE (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT 1) VALUES)
             (OPTIMIZE SPEED (SAFETY 0)))
    (LET ((AVG 0.0d0))
      (DECLARE (TYPE DOUBLE-FLOAT AVG))
      (MAP NIL (LAMBDA (X) (INCF AVG X)) VALUES)
      (SETF AVG (/ AVG (LENGTH VALUES)))
      (LET ((DELTAS (MAKE-ARRAY (LENGTH VALUES) :ELEMENT-TYPE 'DOUBLE-FLOAT)))
        (DECLARE (TYPE (SIMPLE-ARRAY DOUBLE-FLOAT 1) DELTAS))
        (MAP-INTO DELTAS (LAMBDA (X) (- X AVG)) VALUES)
        (LOOP FOR I BELOW (LENGTH DELTAS)
              DO (SETF (AREF DELTAS I) (EXPT (AREF DELTAS I) 2)))
        (LET ((SUM 0.0d0))
          (DECLARE (TYPE DOUBLE-FLOAT SUM))
          (MAP NIL (LAMBDA (X) (INCF SUM X)) DELTAS)
          (SQRT (TRULY-THE (DOUBLE-FLOAT 0.0d0) (/ SUM (LENGTH VALUES))))))))

[xsubseq/t/benchmark.lisp:8]
  (DEFUN RUN-BENCHMARK ()
    (DECLARE (OPTIMIZE (SPEED 3) (SAFETY 0)))
    (TIME
     (LET ((RESULT
            (XSUBSEQ
             (THE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*))
                  (MAKE-ARRAY 0 :ELEMENT-TYPE '(UNSIGNED-BYTE 8)))
             0)))
       (DOTIMES (I 100000)
         (XNCONCF RESULT
          (XSUBSEQ
           (THE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (100))
                (MAKE-ARRAY 100 :ELEMENT-TYPE '(UNSIGNED-BYTE 8)))
           10 30))))))

[zlib/zlib.lisp:15]
  (EVAL-WHEN (COMPILE)
    (DECLAIM
     (OPTIMIZE (SPEED 3) (SAFETY 0) (SPACE 1) (DEBUG 1)
      (#S(FORMGREP:SYMREF :NAME "INHIBIT-WARNINGS" :QUALIFIER "EXT") 3))))

[zlib/zlib.lisp:595]
  (DEFUN DECODE-DYNAMIC-HUFFMAN-BLOCK (BIT-STREAM RESULT)
    "Decode one block in BIT-STREAM with dynamic Huffman coding and
store the result in RESULT"
    (DECLARE (OPTIMIZE (SPEED 3) (DEBUG 0) (SAFETY 1)))
    (LET ((HLIT (+ (BIT-STREAM-READ-BITS BIT-STREAM 5) 257))
          (HDIST (+ (BIT-STREAM-READ-BITS BIT-STREAM 5) 1))
          (HCLEN (+ (BIT-STREAM-READ-BITS BIT-STREAM 4) 4))
          (CODE-LENGTHS
           (MAKE-ARRAY 19 :INITIAL-ELEMENT 0 :ELEMENT-TYPE 'FIXNUM))
          LITERAL-HUFFMAN-TREE
          DISTANCE-HUFFMAN-TREE
          CODE-LENGTH-HUFFMAN-TREE)
      (DECLARE (TYPE FIXNUM HLIT HDIST HCLEN))
      (LOOP FOR I FIXNUM FROM 1 TO HCLEN
            FOR J FIXNUM IN +DYNAMIC-HUFFMAN-CODE-LENGTHS-ORDER+
            DO (SETF (AREF CODE-LENGTHS J)
                       (THE FIXNUM (BIT-STREAM-READ-BITS BIT-STREAM 3))))
      (SETQ CODE-LENGTH-HUFFMAN-TREE (MAKE-HUFFMAN-TREE CODE-LENGTHS))
      (SETQ LITERAL-HUFFMAN-TREE
              (MAKE-HUFFMAN-TREE
               (READ-HUFFMAN-CODE-LENGTHS BIT-STREAM CODE-LENGTH-HUFFMAN-TREE
                HLIT)))
      (SETQ DISTANCE-HUFFMAN-TREE
              (MAKE-HUFFMAN-TREE
               (READ-HUFFMAN-CODE-LENGTHS BIT-STREAM CODE-LENGTH-HUFFMAN-TREE
                HDIST)))
      (LOOP WITH I FIXNUM = (FILL-POINTER RESULT)
            FOR SYMBOL FIXNUM = (THE FIXNUM
                                     (BIT-STREAM-READ-SYMBOL BIT-STREAM
                                      LITERAL-HUFFMAN-TREE))
            UNTIL (= SYMBOL +HUFFMAN-END-OF-BLOCK-SYMBOL+)
            DO (IF (<= SYMBOL 255)
                   (PROGN (VECTOR-PUSH-EXTEND SYMBOL RESULT) (INCF I))
                   (MULTIPLE-VALUE-BIND (LENGTH DISTANCE)
                       (BIT-STREAM-READ-LENGTH-AND-DISTANCE BIT-STREAM SYMBOL
                        DISTANCE-HUFFMAN-TREE)
                     (DECLARE (TYPE FIXNUM LENGTH DISTANCE))
                     (LOOP WITH SOURCE-INDEX FIXNUM = (- I DISTANCE)
                           FOR J FIXNUM FROM 0 BELOW LENGTH
                           DO (VECTOR-PUSH-EXTEND
                               (THE (UNSIGNED-BYTE 8)
                                    (LOGAND
                                     (AREF RESULT
                                           (+ (MOD J DISTANCE) SOURCE-INDEX))
                                     255))
                               RESULT) (INCF I)))))))

[zpb-exif/exif.lisp:73]
  (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
    (DEFPARAMETER *OPTIMIZATIONS* '(OPTIMIZE (SPEED 3) (SAFETY 0)))
    (DEFPARAMETER *OPTIMIZATIONS* '(OPTIMIZE)))

; No value
CL-USER>