Skip to content

Instantly share code, notes, and snippets.

@slyrus

slyrus/gist:c0ea2411242b42662bfea5eabfa708db

Last active April 21, 2018 18:16
Show Gist options
  • Save slyrus/c0ea2411242b42662bfea5eabfa708db to your computer and use it in GitHub Desktop.
Save slyrus/c0ea2411242b42662bfea5eabfa708db to your computer and use it in GitHub Desktop.
Download ZIP
macroexapnded clem::defmatrix-funcs
Raw
gistfile1.txt
(PROGN
(PROGN
(EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE) (SB-PCL::COMPILE-OR-LOAD-DEFGENERIC 'ARRAY->T-MATRIX))
(SB-PCL::LOAD-DEFGENERIC 'ARRAY->T-MATRIX '(A) (SB-C:SOURCE-LOCATION))
(FDEFINITION 'ARRAY->T-MATRIX))
(PROGN
(EVAL-WHEN (:COMPILE-TOPLEVEL :EXECUTE) (SB-PCL::COMPILE-OR-LOAD-DEFGENERIC 'ARRAY->T-MATRIX))
(EVAL-WHEN (:LOAD-TOPLEVEL)
(SB-PCL::LOAD-DEFMETHOD 'STANDARD-METHOD 'ARRAY->T-MATRIX 'NIL (LIST (FIND-CLASS 'ARRAY)) '(A)
(LIST* :FUNCTION
(LET* ((SB-PCL::FMF
(SB-INT:NAMED-LAMBDA (SB-PCL::FAST-METHOD ARRAY->T-MATRIX (ARRAY))
(SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL. A)
(DECLARE (IGNORABLE SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL.)
(SB-EXT:DISABLE-PACKAGE-LOCKS SB-PCL::PV-ENV-ENVIRONMENT))
(DECLARE (SB-PCL::%PARAMETER A))
(DECLARE (TYPE ARRAY A))
(DECLARE (IGNORABLE A))
(SYMBOL-MACROLET ((SB-PCL::PV-ENV-ENVIRONMENT SB-PCL::DEFAULT))
(FLET ((NEXT-METHOD-P ()
(DECLARE (OPTIMIZE (SB-C:INSERT-STEP-CONDITIONS 0)))
(NOT (NULL SB-PCL::.NEXT-METHOD-CALL.))))
(DECLARE (IGNORABLE (FUNCTION NEXT-METHOD-P)))
(LET* ((SB-PCL::.ARGS-TAIL. NIL) (SB-PCL::.DUMMY0.))
(DECLARE (IGNORABLE SB-PCL::.ARGS-TAIL. SB-PCL::.DUMMY0.))
(DECLARE (SB-PCL::%CLASS A ARRAY))
(LOCALLY
(DECLARE (SB-EXT:DISABLE-PACKAGE-LOCKS SB-PCL::%PARAMETER-BINDING-MODIFIED))
(SYMBOL-MACROLET ((SB-PCL::%PARAMETER-BINDING-MODIFIED (QUOTE)))
(DECLARE (SB-EXT:ENABLE-PACKAGE-LOCKS SB-PCL::%PARAMETER-BINDING-MODIFIED))
(BLOCK ARRAY->T-MATRIX (ARRAY->MATRIX A :MATRIX-CLASS 'T-MATRIX)))))))))
(SB-PCL::MF (SB-PCL::%MAKE-METHOD-FUNCTION SB-PCL::FMF)))
(SET-FUNCALLABLE-INSTANCE-FUNCTION SB-PCL::MF (SB-PCL::METHOD-FUNCTION-FROM-FAST-FUNCTION SB-PCL::FMF '(:ARG-INFO (1))))
SB-PCL::MF)
'(SB-PCL::PLIST (:ARG-INFO (1)) SB-PCL::SIMPLE-NEXT-METHOD-CALL T))
(SB-C:SOURCE-LOCATION)))
(EVAL-WHEN (:EXECUTE)
(SB-PCL::LOAD-DEFMETHOD 'STANDARD-METHOD 'ARRAY->T-MATRIX 'NIL (LIST (FIND-CLASS 'ARRAY)) '(A)
(LIST* :FUNCTION
(LET* ((SB-PCL::FMF
(SB-INT:NAMED-LAMBDA (SB-PCL::FAST-METHOD ARRAY->T-MATRIX (ARRAY))
(SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL. A)
(DECLARE (IGNORABLE SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL.)
(SB-EXT:DISABLE-PACKAGE-LOCKS SB-PCL::PV-ENV-ENVIRONMENT))
(DECLARE (SB-PCL::%PARAMETER A))
(DECLARE (TYPE ARRAY A))
(DECLARE (IGNORABLE A))
(SYMBOL-MACROLET ((SB-PCL::PV-ENV-ENVIRONMENT SB-PCL::DEFAULT))
(FLET ((NEXT-METHOD-P ()
(DECLARE (OPTIMIZE (SB-C:INSERT-STEP-CONDITIONS 0)))
(NOT (NULL SB-PCL::.NEXT-METHOD-CALL.))))
(DECLARE (IGNORABLE (FUNCTION NEXT-METHOD-P)))
(LET* ((SB-PCL::.ARGS-TAIL. NIL) (SB-PCL::.DUMMY0.))
(DECLARE (IGNORABLE SB-PCL::.ARGS-TAIL. SB-PCL::.DUMMY0.))
(DECLARE (SB-PCL::%CLASS A ARRAY))
(LOCALLY
(DECLARE (SB-EXT:DISABLE-PACKAGE-LOCKS SB-PCL::%PARAMETER-BINDING-MODIFIED))
(SYMBOL-MACROLET ((SB-PCL::%PARAMETER-BINDING-MODIFIED (QUOTE)))
(DECLARE (SB-EXT:ENABLE-PACKAGE-LOCKS SB-PCL::%PARAMETER-BINDING-MODIFIED))
(BLOCK ARRAY->T-MATRIX (ARRAY->MATRIX A :MATRIX-CLASS 'T-MATRIX)))))))))
(SB-PCL::MF (SB-PCL::%MAKE-METHOD-FUNCTION SB-PCL::FMF)))
(SET-FUNCALLABLE-INSTANCE-FUNCTION SB-PCL::MF (SB-PCL::METHOD-FUNCTION-FROM-FAST-FUNCTION SB-PCL::FMF '(:ARG-INFO (1))))
SB-PCL::MF)
'(SB-PCL::PLIST (:ARG-INFO (1)) SB-PCL::SIMPLE-NEXT-METHOD-CALL T))
(SB-C:SOURCE-LOCATION))))
(PROGN
(EVAL-WHEN (:COMPILE-TOPLEVEL :EXECUTE) (SB-PCL::COMPILE-OR-LOAD-DEFGENERIC 'SAMPLE-VARIANCE-RANGE))
(EVAL-WHEN (:LOAD-TOPLEVEL)
(SB-PCL::LOAD-DEFMETHOD 'STANDARD-METHOD 'SAMPLE-VARIANCE-RANGE 'NIL (LIST (FIND-CLASS 'T-MATRIX) (FIND-CLASS 'T) (FIND-CLASS 'T) (FIND-CLASS 'T) (FIND-CLASS 'T)) '(M STARTR ENDR STARTC ENDC)
(LIST* :FUNCTION
(LET* ((SB-PCL::FMF
(SB-INT:NAMED-LAMBDA (SB-PCL::FAST-METHOD SAMPLE-VARIANCE-RANGE (T-MATRIX T T T T))
(SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL. M STARTR ENDR STARTC ENDC)
(DECLARE (IGNORABLE SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL.)
(SB-EXT:DISABLE-PACKAGE-LOCKS SB-PCL::PV-ENV-ENVIRONMENT))
(DECLARE (TYPE FIXNUM ENDC STARTC ENDR STARTR))
(DECLARE (SB-PCL::%PARAMETER ENDC))
(DECLARE (SB-PCL::%PARAMETER STARTC))
(DECLARE (SB-PCL::%PARAMETER ENDR))
(DECLARE (SB-PCL::%PARAMETER STARTR))
(DECLARE (SB-PCL::%PARAMETER M))
(DECLARE (TYPE T ENDC))
(DECLARE (TYPE T STARTC))
(DECLARE (TYPE T ENDR))
(DECLARE (TYPE T STARTR))
(DECLARE (IGNORABLE ENDC STARTC ENDR STARTR M))
(SYMBOL-MACROLET ((SB-PCL::PV-ENV-ENVIRONMENT SB-PCL::DEFAULT))
(FLET ((NEXT-METHOD-P ()
(DECLARE (OPTIMIZE (SB-C:INSERT-STEP-CONDITIONS 0)))
(NOT (NULL SB-PCL::.NEXT-METHOD-CALL.))))
(DECLARE (IGNORABLE (FUNCTION NEXT-METHOD-P)))
(LET* ((SB-PCL::.ARGS-TAIL. NIL) (SB-PCL::.DUMMY0.))
(DECLARE (IGNORABLE SB-PCL::.ARGS-TAIL. SB-PCL::.DUMMY0.))
(DECLARE (SB-PCL::%CLASS M T-MATRIX))
(LOCALLY
(DECLARE (SB-EXT:DISABLE-PACKAGE-LOCKS SB-PCL::%PARAMETER-BINDING-MODIFIED))
(SYMBOL-MACROLET ((SB-PCL::%PARAMETER-BINDING-MODIFIED (QUOTE)))
(DECLARE (SB-EXT:ENABLE-PACKAGE-LOCKS SB-PCL::%PARAMETER-BINDING-MODIFIED))
(BLOCK SAMPLE-VARIANCE-RANGE
(LET ((ACC (COERCE 0 'T)))
(LET ((MU (MEAN-RANGE M STARTR ENDR STARTC ENDC)))
(LET ((MUSQ (* MU MU)))
(IF (EQUAL 'T (ELEMENT-TYPE (CLASS-OF M)))
(LET ((A (MATRIX-VALS M)))
(DECLARE (TYPE (SIMPLE-ARRAY T *) A))
(BLOCK NIL
(LET ((I STARTR))
(DECLARE (DYNAMIC-EXTENT I)
(TYPE FIXNUM I))
(TAGBODY
(GO #:G714)
#:G713
(TAGBODY
(BLOCK NIL
(LET ((J STARTC))
(DECLARE (DYNAMIC-EXTENT J)
(TYPE FIXNUM J))
(TAGBODY
(GO #:G716)
#:G715
(TAGBODY (SETQ ACC (+ (- (* (AREF A I J) (AREF A I J)) MUSQ) ACC)))
(PROGN (SETQ J (1+ J)) NIL)
#:G716
(IF (> J ENDC)
NIL
(GO #:G715))
(RETURN-FROM NIL (PROGN))))))
(PROGN (SETQ I (1+ I)) NIL)
#:G714
(IF (> I ENDR)
NIL
(GO #:G713))
(RETURN-FROM NIL (PROGN))))))
(LET ((A (MATRIX-VALS M)))
(BLOCK NIL
(LET ((I STARTR))
(DECLARE (DYNAMIC-EXTENT I)
(TYPE FIXNUM I))
(TAGBODY
(GO #:G718)
#:G717
(TAGBODY
(BLOCK NIL
(LET ((J STARTC))
(DECLARE (DYNAMIC-EXTENT J)
(TYPE FIXNUM J))
(TAGBODY
(GO #:G720)
#:G719
(TAGBODY (SETQ ACC (+ (- (* (AREF A I J) (AREF A I J)) MUSQ) ACC)))
(PROGN (SETQ J (1+ J)) NIL)
#:G720
(IF (> J ENDC)
NIL
(GO #:G719))
(RETURN-FROM NIL (PROGN))))))
(PROGN (SETQ I (1+ I)) NIL)
#:G718
(IF (> I ENDR)
NIL
(GO #:G717))
(RETURN-FROM NIL (PROGN)))))))))
(DOUBLE-FLOAT-DIVIDE ACC (1- (COUNT-RANGE STARTR ENDR STARTC ENDC))))))))))))
(SB-PCL::MF (SB-PCL::%MAKE-METHOD-FUNCTION SB-PCL::FMF)))
(SET-FUNCALLABLE-INSTANCE-FUNCTION SB-PCL::MF (SB-PCL::METHOD-FUNCTION-FROM-FAST-FUNCTION SB-PCL::FMF '(:ARG-INFO (5))))
SB-PCL::MF)
'(SB-PCL::PLIST (:ARG-INFO (5)) SB-PCL::SIMPLE-NEXT-METHOD-CALL T))
(SB-C:SOURCE-LOCATION)))
(EVAL-WHEN (:EXECUTE)
(SB-PCL::LOAD-DEFMETHOD 'STANDARD-METHOD 'SAMPLE-VARIANCE-RANGE 'NIL (LIST (FIND-CLASS 'T-MATRIX) (FIND-CLASS 'T) (FIND-CLASS 'T) (FIND-CLASS 'T) (FIND-CLASS 'T)) '(M STARTR ENDR STARTC ENDC)
(LIST* :FUNCTION
(LET* ((SB-PCL::FMF
(SB-INT:NAMED-LAMBDA (SB-PCL::FAST-METHOD SAMPLE-VARIANCE-RANGE (T-MATRIX T T T T))
(SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL. M STARTR ENDR STARTC ENDC)
(DECLARE (IGNORABLE SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL.)
(SB-EXT:DISABLE-PACKAGE-LOCKS SB-PCL::PV-ENV-ENVIRONMENT))
(DECLARE (TYPE FIXNUM ENDC STARTC ENDR STARTR))
(DECLARE (SB-PCL::%PARAMETER ENDC))
(DECLARE (SB-PCL::%PARAMETER STARTC))
(DECLARE (SB-PCL::%PARAMETER ENDR))
(DECLARE (SB-PCL::%PARAMETER STARTR))
(DECLARE (SB-PCL::%PARAMETER M))
(DECLARE (TYPE T ENDC))
(DECLARE (TYPE T STARTC))
(DECLARE (TYPE T ENDR))
(DECLARE (TYPE T STARTR))
(DECLARE (IGNORABLE ENDC STARTC ENDR STARTR M))
(SYMBOL-MACROLET ((SB-PCL::PV-ENV-ENVIRONMENT SB-PCL::DEFAULT))
(FLET ((NEXT-METHOD-P ()
(DECLARE (OPTIMIZE (SB-C:INSERT-STEP-CONDITIONS 0)))
(NOT (NULL SB-PCL::.NEXT-METHOD-CALL.))))
(DECLARE (IGNORABLE (FUNCTION NEXT-METHOD-P)))
(LET* ((SB-PCL::.ARGS-TAIL. NIL) (SB-PCL::.DUMMY0.))
(DECLARE (IGNORABLE SB-PCL::.ARGS-TAIL. SB-PCL::.DUMMY0.))
(DECLARE (SB-PCL::%CLASS M T-MATRIX))
(LOCALLY
(DECLARE (SB-EXT:DISABLE-PACKAGE-LOCKS SB-PCL::%PARAMETER-BINDING-MODIFIED))
(SYMBOL-MACROLET ((SB-PCL::%PARAMETER-BINDING-MODIFIED (QUOTE)))
(DECLARE (SB-EXT:ENABLE-PACKAGE-LOCKS SB-PCL::%PARAMETER-BINDING-MODIFIED))
(BLOCK SAMPLE-VARIANCE-RANGE
(LET ((ACC (COERCE 0 'T)))
(LET ((MU (MEAN-RANGE M STARTR ENDR STARTC ENDC)))
(LET ((MUSQ (* MU MU)))
(IF (EQUAL 'T (ELEMENT-TYPE (CLASS-OF M)))
(LET ((A (MATRIX-VALS M)))
(DECLARE (TYPE (SIMPLE-ARRAY T *) A))
(BLOCK NIL
(LET ((I STARTR))
(DECLARE (DYNAMIC-EXTENT I)
(TYPE FIXNUM I))
(TAGBODY
(GO #:G722)
#:G721
(TAGBODY
(BLOCK NIL
(LET ((J STARTC))
(DECLARE (DYNAMIC-EXTENT J)
(TYPE FIXNUM J))
(TAGBODY
(GO #:G724)
#:G723
(TAGBODY (SETQ ACC (+ (- (* (AREF A I J) (AREF A I J)) MUSQ) ACC)))
(PROGN (SETQ J (1+ J)) NIL)
#:G724
(IF (> J ENDC)
NIL
(GO #:G723))
(RETURN-FROM NIL (PROGN))))))
(PROGN (SETQ I (1+ I)) NIL)
#:G722
(IF (> I ENDR)
NIL
(GO #:G721))
(RETURN-FROM NIL (PROGN))))))
(LET ((A (MATRIX-VALS M)))
(BLOCK NIL
(LET ((I STARTR))
(DECLARE (DYNAMIC-EXTENT I)
(TYPE FIXNUM I))
(TAGBODY
(GO #:G726)
#:G725
(TAGBODY
(BLOCK NIL
(LET ((J STARTC))
(DECLARE (DYNAMIC-EXTENT J)
(TYPE FIXNUM J))
(TAGBODY
(GO #:G728)
#:G727
(TAGBODY (SETQ ACC (+ (- (* (AREF A I J) (AREF A I J)) MUSQ) ACC)))
(PROGN (SETQ J (1+ J)) NIL)
#:G728
(IF (> J ENDC)
NIL
(GO #:G727))
(RETURN-FROM NIL (PROGN))))))
(PROGN (SETQ I (1+ I)) NIL)
#:G726
(IF (> I ENDR)
NIL
(GO #:G725))
(RETURN-FROM NIL (PROGN)))))))))
(DOUBLE-FLOAT-DIVIDE ACC (1- (COUNT-RANGE STARTR ENDR STARTC ENDC))))))))))))
(SB-PCL::MF (SB-PCL::%MAKE-METHOD-FUNCTION SB-PCL::FMF)))
(SET-FUNCALLABLE-INSTANCE-FUNCTION SB-PCL::MF (SB-PCL::METHOD-FUNCTION-FROM-FAST-FUNCTION SB-PCL::FMF '(:ARG-INFO (5))))
SB-PCL::MF)
'(SB-PCL::PLIST (:ARG-INFO (5)) SB-PCL::SIMPLE-NEXT-METHOD-CALL T))
(SB-C:SOURCE-LOCATION))))
(PROGN
(EVAL-WHEN (:COMPILE-TOPLEVEL :EXECUTE) (SB-PCL::COMPILE-OR-LOAD-DEFGENERIC 'SET-VAL))
(EVAL-WHEN (:LOAD-TOPLEVEL)
(SB-PCL::LOAD-DEFMETHOD 'STANDARD-METHOD 'SET-VAL 'NIL (LIST (FIND-CLASS 'T-MATRIX) (FIND-CLASS 'T) (FIND-CLASS 'T) (FIND-CLASS 'T)) '(M I J V &KEY (COERCE T))
(LIST* :FUNCTION
(LET* ((SB-PCL::FMF
(SB-INT:NAMED-LAMBDA (SB-PCL::FAST-METHOD SET-VAL (T-MATRIX T T T))
(SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL. M I J V &KEY (COERCE T) &ALLOW-OTHER-KEYS)
(DECLARE (IGNORABLE SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL.)
(SB-EXT:DISABLE-PACKAGE-LOCKS SB-PCL::PV-ENV-ENVIRONMENT))
(DECLARE (FIXNUM J I))
(DECLARE (SB-PCL::%PARAMETER V))
(DECLARE (SB-PCL::%PARAMETER J))
(DECLARE (SB-PCL::%PARAMETER I))
(DECLARE (SB-PCL::%PARAMETER M))
(DECLARE (TYPE T V))
(DECLARE (TYPE T J))
(DECLARE (TYPE T I))
(DECLARE (IGNORABLE V J I M))
(SYMBOL-MACROLET ((SB-PCL::PV-ENV-ENVIRONMENT SB-PCL::DEFAULT))
(FLET ((NEXT-METHOD-P ()
(DECLARE (OPTIMIZE (SB-C:INSERT-STEP-CONDITIONS 0)))
(NOT (NULL SB-PCL::.NEXT-METHOD-CALL.))))
(DECLARE (IGNORABLE (FUNCTION NEXT-METHOD-P)))
(LET ()
(LET* ((SB-PCL::.ARGS-TAIL. NIL) (SB-PCL::.DUMMY0.))
(DECLARE (IGNORABLE SB-PCL::.ARGS-TAIL. SB-PCL::.DUMMY0.))
(DECLARE (SB-PCL::%CLASS M T-MATRIX))
(LOCALLY
(DECLARE (SB-EXT:DISABLE-PACKAGE-LOCKS SB-PCL::%PARAMETER-BINDING-MODIFIED))
(SYMBOL-MACROLET ((SB-PCL::%PARAMETER-BINDING-MODIFIED (QUOTE)))
(DECLARE (SB-EXT:ENABLE-PACKAGE-LOCKS SB-PCL::%PARAMETER-BINDING-MODIFIED))
(BLOCK SET-VAL
(LET* ((#:G729 (MATRIX-VALS M))
(#:I730 I)
(#:J731 J)
(#:NEW1
(IF COERCE
(COERCE V (ELEMENT-TYPE (CLASS-OF M)))
V)))
(FUNCALL #'(SETF AREF) #:NEW1 #:G729 #:I730 #:J731)))))))))))
(SB-PCL::MF (SB-PCL::%MAKE-METHOD-FUNCTION SB-PCL::FMF)))
(SET-FUNCALLABLE-INSTANCE-FUNCTION SB-PCL::MF (SB-PCL::METHOD-FUNCTION-FROM-FAST-FUNCTION SB-PCL::FMF '(:ARG-INFO (4 . T))))
SB-PCL::MF)
'(SB-PCL::PLIST (:ARG-INFO (4 . T)) SB-PCL::SIMPLE-NEXT-METHOD-CALL T))
(SB-C:SOURCE-LOCATION)))
(EVAL-WHEN (:EXECUTE)
(SB-PCL::LOAD-DEFMETHOD 'STANDARD-METHOD 'SET-VAL 'NIL (LIST (FIND-CLASS 'T-MATRIX) (FIND-CLASS 'T) (FIND-CLASS 'T) (FIND-CLASS 'T)) '(M I J V &KEY (COERCE T))
(LIST* :FUNCTION
(LET* ((SB-PCL::FMF
(SB-INT:NAMED-LAMBDA (SB-PCL::FAST-METHOD SET-VAL (T-MATRIX T T T))
(SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL. M I J V &KEY (COERCE T) &ALLOW-OTHER-KEYS)
(DECLARE (IGNORABLE SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL.)
(SB-EXT:DISABLE-PACKAGE-LOCKS SB-PCL::PV-ENV-ENVIRONMENT))
(DECLARE (FIXNUM J I))
(DECLARE (SB-PCL::%PARAMETER V))
(DECLARE (SB-PCL::%PARAMETER J))
(DECLARE (SB-PCL::%PARAMETER I))
(DECLARE (SB-PCL::%PARAMETER M))
(DECLARE (TYPE T V))
(DECLARE (TYPE T J))
(DECLARE (TYPE T I))
(DECLARE (IGNORABLE V J I M))
(SYMBOL-MACROLET ((SB-PCL::PV-ENV-ENVIRONMENT SB-PCL::DEFAULT))
(FLET ((NEXT-METHOD-P ()
(DECLARE (OPTIMIZE (SB-C:INSERT-STEP-CONDITIONS 0)))
(NOT (NULL SB-PCL::.NEXT-METHOD-CALL.))))
(DECLARE (IGNORABLE (FUNCTION NEXT-METHOD-P)))
(LET ()
(LET* ((SB-PCL::.ARGS-TAIL. NIL) (SB-PCL::.DUMMY0.))
(DECLARE (IGNORABLE SB-PCL::.ARGS-TAIL. SB-PCL::.DUMMY0.))
(DECLARE (SB-PCL::%CLASS M T-MATRIX))
(LOCALLY
(DECLARE (SB-EXT:DISABLE-PACKAGE-LOCKS SB-PCL::%PARAMETER-BINDING-MODIFIED))
(SYMBOL-MACROLET ((SB-PCL::%PARAMETER-BINDING-MODIFIED (QUOTE)))
(DECLARE (SB-EXT:ENABLE-PACKAGE-LOCKS SB-PCL::%PARAMETER-BINDING-MODIFIED))
(BLOCK SET-VAL
(LET* ((#:G732 (MATRIX-VALS M))
(#:I733 I)
(#:J734 J)
(#:NEW1
(IF COERCE
(COERCE V (ELEMENT-TYPE (CLASS-OF M)))
V)))
(FUNCALL #'(SETF AREF) #:NEW1 #:G732 #:I733 #:J734)))))))))))
(SB-PCL::MF (SB-PCL::%MAKE-METHOD-FUNCTION SB-PCL::FMF)))
(SET-FUNCALLABLE-INSTANCE-FUNCTION SB-PCL::MF (SB-PCL::METHOD-FUNCTION-FROM-FAST-FUNCTION SB-PCL::FMF '(:ARG-INFO (4 . T))))
SB-PCL::MF)
'(SB-PCL::PLIST (:ARG-INFO (4 . T)) SB-PCL::SIMPLE-NEXT-METHOD-CALL T))
(SB-C:SOURCE-LOCATION))))
(PROGN
(EVAL-WHEN (:COMPILE-TOPLEVEL :EXECUTE) (SB-PCL::COMPILE-OR-LOAD-DEFGENERIC 'FIT))
(EVAL-WHEN (:LOAD-TOPLEVEL)
(SB-PCL::LOAD-DEFMETHOD 'STANDARD-METHOD 'FIT 'NIL (LIST (FIND-CLASS 'T-MATRIX) (FIND-CLASS 'T)) '(M V)
(LIST* :FUNCTION
(LET* ((SB-PCL::FMF
(SB-INT:NAMED-LAMBDA (SB-PCL::FAST-METHOD FIT (T-MATRIX T))
(SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL. M V)
(DECLARE (IGNORABLE SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL.)
(SB-EXT:DISABLE-PACKAGE-LOCKS SB-PCL::PV-ENV-ENVIRONMENT))
(DECLARE (IGNORE M))
(DECLARE (SB-PCL::%PARAMETER V))
(DECLARE (SB-PCL::%PARAMETER M))
(DECLARE (TYPE T V))
(DECLARE (IGNORABLE V M))
(SYMBOL-MACROLET ((SB-PCL::PV-ENV-ENVIRONMENT SB-PCL::DEFAULT))
(FLET ((NEXT-METHOD-P ()
(DECLARE (OPTIMIZE (SB-C:INSERT-STEP-CONDITIONS 0)))
(NOT (NULL SB-PCL::.NEXT-METHOD-CALL.))))
(DECLARE (IGNORABLE (FUNCTION NEXT-METHOD-P)))
(LET* ((SB-PCL::.ARGS-TAIL. NIL) (SB-PCL::.DUMMY0.))
(DECLARE (IGNORABLE SB-PCL::.ARGS-TAIL. SB-PCL::.DUMMY0.))
(DECLARE (SB-PCL::%CLASS M T-MATRIX))
(LOCALLY
(DECLARE (SB-EXT:DISABLE-PACKAGE-LOCKS SB-PCL::%PARAMETER-BINDING-MODIFIED))
(SYMBOL-MACROLET ((SB-PCL::%PARAMETER-BINDING-MODIFIED (QUOTE)))
(DECLARE (SB-EXT:ENABLE-PACKAGE-LOCKS SB-PCL::%PARAMETER-BINDING-MODIFIED))
(BLOCK FIT V))))))))
(SB-PCL::MF (SB-PCL::%MAKE-METHOD-FUNCTION SB-PCL::FMF)))
(SET-FUNCALLABLE-INSTANCE-FUNCTION SB-PCL::MF (SB-PCL::METHOD-FUNCTION-FROM-FAST-FUNCTION SB-PCL::FMF '(:ARG-INFO (2))))
SB-PCL::MF)
'(SB-PCL::PLIST (:ARG-INFO (2)) SB-PCL::SIMPLE-NEXT-METHOD-CALL T))
(SB-C:SOURCE-LOCATION)))
(EVAL-WHEN (:EXECUTE)
(SB-PCL::LOAD-DEFMETHOD 'STANDARD-METHOD 'FIT 'NIL (LIST (FIND-CLASS 'T-MATRIX) (FIND-CLASS 'T)) '(M V)
(LIST* :FUNCTION
(LET* ((SB-PCL::FMF
(SB-INT:NAMED-LAMBDA (SB-PCL::FAST-METHOD FIT (T-MATRIX T))
(SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL. M V)
(DECLARE (IGNORABLE SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL.)
(SB-EXT:DISABLE-PACKAGE-LOCKS SB-PCL::PV-ENV-ENVIRONMENT))
(DECLARE (IGNORE M))
(DECLARE (SB-PCL::%PARAMETER V))
(DECLARE (SB-PCL::%PARAMETER M))
(DECLARE (TYPE T V))
(DECLARE (IGNORABLE V M))
(SYMBOL-MACROLET ((SB-PCL::PV-ENV-ENVIRONMENT SB-PCL::DEFAULT))
(FLET ((NEXT-METHOD-P ()
(DECLARE (OPTIMIZE (SB-C:INSERT-STEP-CONDITIONS 0)))
(NOT (NULL SB-PCL::.NEXT-METHOD-CALL.))))
(DECLARE (IGNORABLE (FUNCTION NEXT-METHOD-P)))
(LET* ((SB-PCL::.ARGS-TAIL. NIL) (SB-PCL::.DUMMY0.))
(DECLARE (IGNORABLE SB-PCL::.ARGS-TAIL. SB-PCL::.DUMMY0.))
(DECLARE (SB-PCL::%CLASS M T-MATRIX))
(LOCALLY
(DECLARE (SB-EXT:DISABLE-PACKAGE-LOCKS SB-PCL::%PARAMETER-BINDING-MODIFIED))
(SYMBOL-MACROLET ((SB-PCL::%PARAMETER-BINDING-MODIFIED (QUOTE)))
(DECLARE (SB-EXT:ENABLE-PACKAGE-LOCKS SB-PCL::%PARAMETER-BINDING-MODIFIED))
(BLOCK FIT V))))))))
(SB-PCL::MF (SB-PCL::%MAKE-METHOD-FUNCTION SB-PCL::FMF)))
(SET-FUNCALLABLE-INSTANCE-FUNCTION SB-PCL::MF (SB-PCL::METHOD-FUNCTION-FROM-FAST-FUNCTION SB-PCL::FMF '(:ARG-INFO (2))))
SB-PCL::MF)
'(SB-PCL::PLIST (:ARG-INFO (2)) SB-PCL::SIMPLE-NEXT-METHOD-CALL T))
(SB-C:SOURCE-LOCATION))))
(PROGN
(EVAL-WHEN (:COMPILE-TOPLEVEL :EXECUTE) (SB-PCL::COMPILE-OR-LOAD-DEFGENERIC 'SET-VAL-FIT))
(EVAL-WHEN (:LOAD-TOPLEVEL)
(SB-PCL::LOAD-DEFMETHOD 'STANDARD-METHOD 'SET-VAL-FIT 'NIL (LIST (FIND-CLASS 'T-MATRIX) (FIND-CLASS 'T) (FIND-CLASS 'T) (FIND-CLASS 'T)) '(M I J V &KEY (TRUNCATE NIL))
(LIST* :FUNCTION
(LET* ((SB-PCL::FMF
(SB-INT:NAMED-LAMBDA (SB-PCL::FAST-METHOD SET-VAL-FIT (T-MATRIX T T T))
(SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL. M I J V &KEY (TRUNCATE NIL) &ALLOW-OTHER-KEYS)
(DECLARE (IGNORABLE SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL.)
(SB-EXT:DISABLE-PACKAGE-LOCKS SB-PCL::PV-ENV-ENVIRONMENT))
(DECLARE (SB-PCL::%PARAMETER V))
(DECLARE (SB-PCL::%PARAMETER J))
(DECLARE (SB-PCL::%PARAMETER I))
(DECLARE (SB-PCL::%PARAMETER M))
(DECLARE (TYPE T V))
(DECLARE (TYPE T J))
(DECLARE (TYPE T I))
(DECLARE (IGNORABLE V J I M))
(SYMBOL-MACROLET ((SB-PCL::PV-ENV-ENVIRONMENT SB-PCL::DEFAULT))
(FLET ((NEXT-METHOD-P ()
(DECLARE (OPTIMIZE (SB-C:INSERT-STEP-CONDITIONS 0)))
(NOT (NULL SB-PCL::.NEXT-METHOD-CALL.))))
(DECLARE (IGNORABLE (FUNCTION NEXT-METHOD-P)))
(LET ()
(LET* ((SB-PCL::.ARGS-TAIL. NIL) (SB-PCL::.DUMMY0.))
(DECLARE (IGNORABLE SB-PCL::.ARGS-TAIL. SB-PCL::.DUMMY0.))
(DECLARE (SB-PCL::%CLASS M T-MATRIX))
(LOCALLY
(DECLARE (SB-EXT:DISABLE-PACKAGE-LOCKS SB-PCL::%PARAMETER-BINDING-MODIFIED))
(SYMBOL-MACROLET ((SB-PCL::%PARAMETER-BINDING-MODIFIED (QUOTE)))
(DECLARE (SB-EXT:ENABLE-PACKAGE-LOCKS SB-PCL::%PARAMETER-BINDING-MODIFIED))
(BLOCK SET-VAL-FIT
(SET-VAL M I J
(COERCE
(IF TRUNCATE
(TRUNCATE V)
V)
(ELEMENT-TYPE (CLASS-OF M)))))))))))))
(SB-PCL::MF (SB-PCL::%MAKE-METHOD-FUNCTION SB-PCL::FMF)))
(SET-FUNCALLABLE-INSTANCE-FUNCTION SB-PCL::MF (SB-PCL::METHOD-FUNCTION-FROM-FAST-FUNCTION SB-PCL::FMF '(:ARG-INFO (4 . T))))
SB-PCL::MF)
'(SB-PCL::PLIST (:ARG-INFO (4 . T)) SB-PCL::SIMPLE-NEXT-METHOD-CALL T))
(SB-C:SOURCE-LOCATION)))
(EVAL-WHEN (:EXECUTE)
(SB-PCL::LOAD-DEFMETHOD 'STANDARD-METHOD 'SET-VAL-FIT 'NIL (LIST (FIND-CLASS 'T-MATRIX) (FIND-CLASS 'T) (FIND-CLASS 'T) (FIND-CLASS 'T)) '(M I J V &KEY (TRUNCATE NIL))
(LIST* :FUNCTION
(LET* ((SB-PCL::FMF
(SB-INT:NAMED-LAMBDA (SB-PCL::FAST-METHOD SET-VAL-FIT (T-MATRIX T T T))
(SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL. M I J V &KEY (TRUNCATE NIL) &ALLOW-OTHER-KEYS)
(DECLARE (IGNORABLE SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL.)
(SB-EXT:DISABLE-PACKAGE-LOCKS SB-PCL::PV-ENV-ENVIRONMENT))
(DECLARE (SB-PCL::%PARAMETER V))
(DECLARE (SB-PCL::%PARAMETER J))
(DECLARE (SB-PCL::%PARAMETER I))
(DECLARE (SB-PCL::%PARAMETER M))
(DECLARE (TYPE T V))
(DECLARE (TYPE T J))
(DECLARE (TYPE T I))
(DECLARE (IGNORABLE V J I M))
(SYMBOL-MACROLET ((SB-PCL::PV-ENV-ENVIRONMENT SB-PCL::DEFAULT))
(FLET ((NEXT-METHOD-P ()
(DECLARE (OPTIMIZE (SB-C:INSERT-STEP-CONDITIONS 0)))
(NOT (NULL SB-PCL::.NEXT-METHOD-CALL.))))
(DECLARE (IGNORABLE (FUNCTION NEXT-METHOD-P)))
(LET ()
(LET* ((SB-PCL::.ARGS-TAIL. NIL) (SB-PCL::.DUMMY0.))
(DECLARE (IGNORABLE SB-PCL::.ARGS-TAIL. SB-PCL::.DUMMY0.))
(DECLARE (SB-PCL::%CLASS M T-MATRIX))
(LOCALLY
(DECLARE (SB-EXT:DISABLE-PACKAGE-LOCKS SB-PCL::%PARAMETER-BINDING-MODIFIED))
(SYMBOL-MACROLET ((SB-PCL::%PARAMETER-BINDING-MODIFIED (QUOTE)))
(DECLARE (SB-EXT:ENABLE-PACKAGE-LOCKS SB-PCL::%PARAMETER-BINDING-MODIFIED))
(BLOCK SET-VAL-FIT
(SET-VAL M I J
(COERCE
(IF TRUNCATE
(TRUNCATE V)
V)
(ELEMENT-TYPE (CLASS-OF M)))))))))))))
(SB-PCL::MF (SB-PCL::%MAKE-METHOD-FUNCTION SB-PCL::FMF)))
(SET-FUNCALLABLE-INSTANCE-FUNCTION SB-PCL::MF (SB-PCL::METHOD-FUNCTION-FROM-FAST-FUNCTION SB-PCL::FMF '(:ARG-INFO (4 . T))))
SB-PCL::MF)
'(SB-PCL::PLIST (:ARG-INFO (4 . T)) SB-PCL::SIMPLE-NEXT-METHOD-CALL T))
(SB-C:SOURCE-LOCATION))))
(PROGN
(EVAL-WHEN (:COMPILE-TOPLEVEL :EXECUTE) (SB-PCL::COMPILE-OR-LOAD-DEFGENERIC 'MAP-SET-VAL))
(EVAL-WHEN (:LOAD-TOPLEVEL)
(SB-PCL::LOAD-DEFMETHOD 'STANDARD-METHOD 'MAP-SET-VAL 'NIL (LIST (FIND-CLASS 'T-MATRIX) (FIND-CLASS 'T)) '(M F)
(LIST* :FUNCTION
(LET* ((SB-PCL::FMF
(SB-INT:NAMED-LAMBDA (SB-PCL::FAST-METHOD MAP-SET-VAL (T-MATRIX T))
(SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL. M F)
(DECLARE (IGNORABLE SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL.)
(SB-EXT:DISABLE-PACKAGE-LOCKS SB-PCL::PV-ENV-ENVIRONMENT))
(DECLARE (SB-PCL::%PARAMETER F))
(DECLARE (SB-PCL::%PARAMETER M))
(DECLARE (TYPE T F))
(DECLARE (IGNORABLE F M))
(SYMBOL-MACROLET ((SB-PCL::PV-ENV-ENVIRONMENT SB-PCL::DEFAULT))
(FLET ((NEXT-METHOD-P ()
(DECLARE (OPTIMIZE (SB-C:INSERT-STEP-CONDITIONS 0)))
(NOT (NULL SB-PCL::.NEXT-METHOD-CALL.))))
(DECLARE (IGNORABLE (FUNCTION NEXT-METHOD-P)))
(LET* ((SB-PCL::.ARGS-TAIL. NIL) (SB-PCL::.DUMMY0.))
(DECLARE (IGNORABLE SB-PCL::.ARGS-TAIL. SB-PCL::.DUMMY0.))
(DECLARE (SB-PCL::%CLASS M T-MATRIX))
(LOCALLY
(DECLARE (SB-EXT:DISABLE-PACKAGE-LOCKS SB-PCL::%PARAMETER-BINDING-MODIFIED))
(SYMBOL-MACROLET ((SB-PCL::%PARAMETER-BINDING-MODIFIED (QUOTE)))
(DECLARE (SB-EXT:ENABLE-PACKAGE-LOCKS SB-PCL::%PARAMETER-BINDING-MODIFIED))
(BLOCK MAP-SET-VAL
(LET* ((#:G735 (SB-C::CHECK-DS-LIST (MAPCAR #'1- (DIM M)) 2 2 '(ROWS COLS)))
(ROWS
(LET ((#:G736 (CAR #:G735)))
(SETQ #:G735 (CDR #:G735))
#:G736))
(COLS
(LET ((#:G737 (CAR #:G735)))
(SETQ #:G735 (CDR #:G735))
#:G737)))
(DECLARE (DYNAMIC-EXTENT ROWS COLS)
(FIXNUM ROWS COLS))
(IF (EQUAL 'T (ELEMENT-TYPE (CLASS-OF M)))
(LET ((A (MATRIX-VALS M)))
(DECLARE (TYPE (SIMPLE-ARRAY T *) A))
(BLOCK NIL
(LET ((I 0))
(DECLARE (DYNAMIC-EXTENT I)
(TYPE FIXNUM I))
(TAGBODY
(GO #:G739)
#:G738
(TAGBODY
(BLOCK NIL
(LET ((J 0))
(DECLARE (DYNAMIC-EXTENT J)
(TYPE FIXNUM J))
(TAGBODY
(GO #:G741)
#:G740
(TAGBODY
(LET* ((#:A742 A) (#:I743 I) (#:J744 J) (#:NEW1 (FUNCALL F (AREF A I J))))
(FUNCALL #'(SETF AREF) #:NEW1 #:A742 #:I743 #:J744)))
(PROGN (SETQ J (1+ J)) NIL)
#:G741
(IF (> J COLS)
NIL
(GO #:G740))
(RETURN-FROM NIL (PROGN))))))
(PROGN (SETQ I (1+ I)) NIL)
#:G739
(IF (> I ROWS)
NIL
(GO #:G738))
(RETURN-FROM NIL (PROGN))))))
(LET ((A (MATRIX-VALS M)))
(BLOCK NIL
(LET ((I 0))
(DECLARE (DYNAMIC-EXTENT I)
(TYPE FIXNUM I))
(TAGBODY
(GO #:G746)
#:G745
(TAGBODY
(BLOCK NIL
(LET ((J 0))
(DECLARE (DYNAMIC-EXTENT J)
(TYPE FIXNUM J))
(TAGBODY
(GO #:G748)
#:G747
(TAGBODY
(LET* ((#:A749 A) (#:I750 I) (#:J751 J) (#:NEW1 (FUNCALL F (AREF A I J))))
(FUNCALL #'(SETF AREF) #:NEW1 #:A749 #:I750 #:J751)))
(PROGN (SETQ J (1+ J)) NIL)
#:G748
(IF (> J COLS)
NIL
(GO #:G747))
(RETURN-FROM NIL (PROGN))))))
(PROGN (SETQ I (1+ I)) NIL)
#:G746
(IF (> I ROWS)
NIL
(GO #:G745))
(RETURN-FROM NIL (PROGN))))))))
M))))))))
(SB-PCL::MF (SB-PCL::%MAKE-METHOD-FUNCTION SB-PCL::FMF)))
(SET-FUNCALLABLE-INSTANCE-FUNCTION SB-PCL::MF (SB-PCL::METHOD-FUNCTION-FROM-FAST-FUNCTION SB-PCL::FMF '(:ARG-INFO (2))))
SB-PCL::MF)
'(SB-PCL::PLIST (:ARG-INFO (2)) SB-PCL::SIMPLE-NEXT-METHOD-CALL T))
(SB-C:SOURCE-LOCATION)))
(EVAL-WHEN (:EXECUTE)
(SB-PCL::LOAD-DEFMETHOD 'STANDARD-METHOD 'MAP-SET-VAL 'NIL (LIST (FIND-CLASS 'T-MATRIX) (FIND-CLASS 'T)) '(M F)
(LIST* :FUNCTION
(LET* ((SB-PCL::FMF
(SB-INT:NAMED-LAMBDA (SB-PCL::FAST-METHOD MAP-SET-VAL (T-MATRIX T))
(SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL. M F)
(DECLARE (IGNORABLE SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL.)
(SB-EXT:DISABLE-PACKAGE-LOCKS SB-PCL::PV-ENV-ENVIRONMENT))
(DECLARE (SB-PCL::%PARAMETER F))
(DECLARE (SB-PCL::%PARAMETER M))
(DECLARE (TYPE T F))
(DECLARE (IGNORABLE F M))
(SYMBOL-MACROLET ((SB-PCL::PV-ENV-ENVIRONMENT SB-PCL::DEFAULT))
(FLET ((NEXT-METHOD-P ()
(DECLARE (OPTIMIZE (SB-C:INSERT-STEP-CONDITIONS 0)))
(NOT (NULL SB-PCL::.NEXT-METHOD-CALL.))))
(DECLARE (IGNORABLE (FUNCTION NEXT-METHOD-P)))
(LET* ((SB-PCL::.ARGS-TAIL. NIL) (SB-PCL::.DUMMY0.))
(DECLARE (IGNORABLE SB-PCL::.ARGS-TAIL. SB-PCL::.DUMMY0.))
(DECLARE (SB-PCL::%CLASS M T-MATRIX))
(LOCALLY
(DECLARE (SB-EXT:DISABLE-PACKAGE-LOCKS SB-PCL::%PARAMETER-BINDING-MODIFIED))
(SYMBOL-MACROLET ((SB-PCL::%PARAMETER-BINDING-MODIFIED (QUOTE)))
(DECLARE (SB-EXT:ENABLE-PACKAGE-LOCKS SB-PCL::%PARAMETER-BINDING-MODIFIED))
(BLOCK MAP-SET-VAL
(LET* ((#:G752 (SB-C::CHECK-DS-LIST (MAPCAR #'1- (DIM M)) 2 2 '(ROWS COLS)))
(ROWS
(LET ((#:G753 (CAR #:G752)))
(SETQ #:G752 (CDR #:G752))
#:G753))
(COLS
(LET ((#:G754 (CAR #:G752)))
(SETQ #:G752 (CDR #:G752))
#:G754)))
(DECLARE (DYNAMIC-EXTENT ROWS COLS)
(FIXNUM ROWS COLS))
(IF (EQUAL 'T (ELEMENT-TYPE (CLASS-OF M)))
(LET ((A (MATRIX-VALS M)))
(DECLARE (TYPE (SIMPLE-ARRAY T *) A))
(BLOCK NIL
(LET ((I 0))
(DECLARE (DYNAMIC-EXTENT I)
(TYPE FIXNUM I))
(TAGBODY
(GO #:G756)
#:G755
(TAGBODY
(BLOCK NIL
(LET ((J 0))
(DECLARE (DYNAMIC-EXTENT J)
(TYPE FIXNUM J))
(TAGBODY
(GO #:G758)
#:G757
(TAGBODY
(LET* ((#:A759 A) (#:I760 I) (#:J761 J) (#:NEW1 (FUNCALL F (AREF A I J))))
(FUNCALL #'(SETF AREF) #:NEW1 #:A759 #:I760 #:J761)))
(PROGN (SETQ J (1+ J)) NIL)
#:G758
(IF (> J COLS)
NIL
(GO #:G757))
(RETURN-FROM NIL (PROGN))))))
(PROGN (SETQ I (1+ I)) NIL)
#:G756
(IF (> I ROWS)
NIL
(GO #:G755))
(RETURN-FROM NIL (PROGN))))))
(LET ((A (MATRIX-VALS M)))
(BLOCK NIL
(LET ((I 0))
(DECLARE (DYNAMIC-EXTENT I)
(TYPE FIXNUM I))
(TAGBODY
(GO #:G763)
#:G762
(TAGBODY
(BLOCK NIL
(LET ((J 0))
(DECLARE (DYNAMIC-EXTENT J)
(TYPE FIXNUM J))
(TAGBODY
(GO #:G765)
#:G764
(TAGBODY
(LET* ((#:A766 A) (#:I767 I) (#:J768 J) (#:NEW1 (FUNCALL F (AREF A I J))))
(FUNCALL #'(SETF AREF) #:NEW1 #:A766 #:I767 #:J768)))
(PROGN (SETQ J (1+ J)) NIL)
#:G765
(IF (> J COLS)
NIL
(GO #:G764))
(RETURN-FROM NIL (PROGN))))))
(PROGN (SETQ I (1+ I)) NIL)
#:G763
(IF (> I ROWS)
NIL
(GO #:G762))
(RETURN-FROM NIL (PROGN))))))))
M))))))))
(SB-PCL::MF (SB-PCL::%MAKE-METHOD-FUNCTION SB-PCL::FMF)))
(SET-FUNCALLABLE-INSTANCE-FUNCTION SB-PCL::MF (SB-PCL::METHOD-FUNCTION-FROM-FAST-FUNCTION SB-PCL::FMF '(:ARG-INFO (2))))
SB-PCL::MF)
'(SB-PCL::PLIST (:ARG-INFO (2)) SB-PCL::SIMPLE-NEXT-METHOD-CALL T))
(SB-C:SOURCE-LOCATION))))
(PROGN
(EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE) (SB-PCL::COMPILE-OR-LOAD-DEFGENERIC 'RANDOM-T-MATRIX))
(SB-PCL::LOAD-DEFGENERIC 'RANDOM-T-MATRIX '(ROWS COLS &KEY MAX) (SB-C:SOURCE-LOCATION))
(FDEFINITION 'RANDOM-T-MATRIX))
(PROGN
(EVAL-WHEN (:COMPILE-TOPLEVEL :EXECUTE) (SB-PCL::COMPILE-OR-LOAD-DEFGENERIC 'RANDOM-T-MATRIX))
(EVAL-WHEN (:LOAD-TOPLEVEL)
(SB-PCL::LOAD-DEFMETHOD 'STANDARD-METHOD 'RANDOM-T-MATRIX 'NIL (LIST (FIND-CLASS 'T) (FIND-CLASS 'T)) '(ROWS COLS &KEY (MAX NIL))
(LIST* :FUNCTION
(LET* ((SB-PCL::FMF
(SB-INT:NAMED-LAMBDA (SB-PCL::FAST-METHOD RANDOM-T-MATRIX (T T))
(SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL. ROWS COLS &KEY (MAX NIL) &ALLOW-OTHER-KEYS)
(DECLARE (IGNORABLE SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL.)
(SB-EXT:DISABLE-PACKAGE-LOCKS SB-PCL::PV-ENV-ENVIRONMENT))
(DECLARE (SB-PCL::%PARAMETER COLS))
(DECLARE (SB-PCL::%PARAMETER ROWS))
(DECLARE (TYPE T COLS))
(DECLARE (TYPE T ROWS))
(DECLARE (IGNORABLE COLS ROWS))
(SYMBOL-MACROLET ((SB-PCL::PV-ENV-ENVIRONMENT SB-PCL::DEFAULT))
(FLET ((NEXT-METHOD-P ()
(DECLARE (OPTIMIZE (SB-C:INSERT-STEP-CONDITIONS 0)))
(NOT (NULL SB-PCL::.NEXT-METHOD-CALL.))))
(DECLARE (IGNORABLE (FUNCTION NEXT-METHOD-P)))
(LET ()
(LET* ((SB-PCL::.ARGS-TAIL. NIL) (SB-PCL::.DUMMY0.))
(DECLARE (IGNORABLE SB-PCL::.ARGS-TAIL. SB-PCL::.DUMMY0.))
(LOCALLY
(DECLARE (SB-EXT:DISABLE-PACKAGE-LOCKS SB-PCL::%PARAMETER-BINDING-MODIFIED))
(SYMBOL-MACROLET ((SB-PCL::%PARAMETER-BINDING-MODIFIED (QUOTE)))
(DECLARE (SB-EXT:ENABLE-PACKAGE-LOCKS SB-PCL::%PARAMETER-BINDING-MODIFIED))
(BLOCK RANDOM-T-MATRIX
(LET ((A (MAKE-INSTANCE 'T-MATRIX :ROWS ROWS :COLS COLS))
(MAXVALUE
(IF MAX
MAX
255)))
(MAP-SET-VAL-FIT A #'(LAMBDA (X) (DECLARE (IGNORE X)) (RANDOM (COERCE MAXVALUE 'T))) :TRUNCATE NIL)
A))))))))))
(SB-PCL::MF (SB-PCL::%MAKE-METHOD-FUNCTION SB-PCL::FMF)))
(SET-FUNCALLABLE-INSTANCE-FUNCTION SB-PCL::MF (SB-PCL::METHOD-FUNCTION-FROM-FAST-FUNCTION SB-PCL::FMF '(:ARG-INFO (2 . T))))
SB-PCL::MF)
'(SB-PCL::PLIST (:ARG-INFO (2 . T)) SB-PCL::SIMPLE-NEXT-METHOD-CALL T))
(SB-C:SOURCE-LOCATION)))
(EVAL-WHEN (:EXECUTE)
(SB-PCL::LOAD-DEFMETHOD 'STANDARD-METHOD 'RANDOM-T-MATRIX 'NIL (LIST (FIND-CLASS 'T) (FIND-CLASS 'T)) '(ROWS COLS &KEY (MAX NIL))
(LIST* :FUNCTION
(LET* ((SB-PCL::FMF
(SB-INT:NAMED-LAMBDA (SB-PCL::FAST-METHOD RANDOM-T-MATRIX (T T))
(SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL. ROWS COLS &KEY (MAX NIL) &ALLOW-OTHER-KEYS)
(DECLARE (IGNORABLE SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL.)
(SB-EXT:DISABLE-PACKAGE-LOCKS SB-PCL::PV-ENV-ENVIRONMENT))
(DECLARE (SB-PCL::%PARAMETER COLS))
(DECLARE (SB-PCL::%PARAMETER ROWS))
(DECLARE (TYPE T COLS))
(DECLARE (TYPE T ROWS))
(DECLARE (IGNORABLE COLS ROWS))
(SYMBOL-MACROLET ((SB-PCL::PV-ENV-ENVIRONMENT SB-PCL::DEFAULT))
(FLET ((NEXT-METHOD-P ()
(DECLARE (OPTIMIZE (SB-C:INSERT-STEP-CONDITIONS 0)))
(NOT (NULL SB-PCL::.NEXT-METHOD-CALL.))))
(DECLARE (IGNORABLE (FUNCTION NEXT-METHOD-P)))
(LET ()
(LET* ((SB-PCL::.ARGS-TAIL. NIL) (SB-PCL::.DUMMY0.))
(DECLARE (IGNORABLE SB-PCL::.ARGS-TAIL. SB-PCL::.DUMMY0.))
(LOCALLY
(DECLARE (SB-EXT:DISABLE-PACKAGE-LOCKS SB-PCL::%PARAMETER-BINDING-MODIFIED))
(SYMBOL-MACROLET ((SB-PCL::%PARAMETER-BINDING-MODIFIED (QUOTE)))
(DECLARE (SB-EXT:ENABLE-PACKAGE-LOCKS SB-PCL::%PARAMETER-BINDING-MODIFIED))
(BLOCK RANDOM-T-MATRIX
(LET ((A (MAKE-INSTANCE 'T-MATRIX :ROWS ROWS :COLS COLS))
(MAXVALUE
(IF MAX
MAX
255)))
(MAP-SET-VAL-FIT A #'(LAMBDA (X) (DECLARE (IGNORE X)) (RANDOM (COERCE MAXVALUE 'T))) :TRUNCATE NIL)
A))))))))))
(SB-PCL::MF (SB-PCL::%MAKE-METHOD-FUNCTION SB-PCL::FMF)))
(SET-FUNCALLABLE-INSTANCE-FUNCTION SB-PCL::MF (SB-PCL::METHOD-FUNCTION-FROM-FAST-FUNCTION SB-PCL::FMF '(:ARG-INFO (2 . T))))
SB-PCL::MF)
'(SB-PCL::PLIST (:ARG-INFO (2 . T)) SB-PCL::SIMPLE-NEXT-METHOD-CALL T))
(SB-C:SOURCE-LOCATION))))
(PROGN
(EVAL-WHEN (:COMPILE-TOPLEVEL :EXECUTE) (SB-PCL::COMPILE-OR-LOAD-DEFGENERIC 'NORMALIZE))
(EVAL-WHEN (:LOAD-TOPLEVEL)
(SB-PCL::LOAD-DEFMETHOD 'STANDARD-METHOD 'NORMALIZE 'NIL (LIST (FIND-CLASS 'T-MATRIX)) '(U &KEY NORMIN NORMAX COPY)
(LIST* :FUNCTION
(LET* ((SB-PCL::FMF
(SB-INT:NAMED-LAMBDA (SB-PCL::FAST-METHOD NORMALIZE (T-MATRIX))
(SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL. U &KEY NORMIN NORMAX COPY &ALLOW-OTHER-KEYS)
(DECLARE (IGNORABLE SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL.)
(SB-EXT:DISABLE-PACKAGE-LOCKS SB-PCL::PV-ENV-ENVIRONMENT))
(DECLARE (SB-PCL::%PARAMETER U))
(DECLARE (IGNORABLE U))
(SYMBOL-MACROLET ((SB-PCL::PV-ENV-ENVIRONMENT SB-PCL::DEFAULT))
(FLET ((NEXT-METHOD-P ()
(DECLARE (OPTIMIZE (SB-C:INSERT-STEP-CONDITIONS 0)))
(NOT (NULL SB-PCL::.NEXT-METHOD-CALL.))))
(DECLARE (IGNORABLE (FUNCTION NEXT-METHOD-P)))
(LET ()
(LET* ((SB-PCL::.ARGS-TAIL. NIL) (SB-PCL::.DUMMY0.))
(DECLARE (IGNORABLE SB-PCL::.ARGS-TAIL. SB-PCL::.DUMMY0.))
(DECLARE (SB-PCL::%CLASS U T-MATRIX))
(LOCALLY
(DECLARE (SB-EXT:DISABLE-PACKAGE-LOCKS SB-PCL::%PARAMETER-BINDING-MODIFIED))
(SYMBOL-MACROLET ((SB-PCL::%PARAMETER-BINDING-MODIFIED (QUOTE)))
(DECLARE (SB-EXT:ENABLE-PACKAGE-LOCKS SB-PCL::%PARAMETER-BINDING-MODIFIED))
(BLOCK NORMALIZE
(LET ((MIN (MIN-VAL U))
(MAX (MAX-VAL U))
(NMIN
(IF NORMIN
NORMIN
0))
(NMAX
(IF NORMAX
NORMAX
255))
(U
(IF COPY
(MAT-COPY U)
U)))
(LET ((SLOPE
(IF (= MAX MIN)
0.0d0
(DOUBLE-FLOAT-DIVIDE (- NMAX NMIN) (- MAX MIN)))))
(MAP-SET-VAL-FIT U #'(LAMBDA (X) (+ NMIN (* SLOPE (- X MIN))))))
U))))))))))
(SB-PCL::MF (SB-PCL::%MAKE-METHOD-FUNCTION SB-PCL::FMF)))
(SET-FUNCALLABLE-INSTANCE-FUNCTION SB-PCL::MF (SB-PCL::METHOD-FUNCTION-FROM-FAST-FUNCTION SB-PCL::FMF '(:ARG-INFO (1 . T))))
SB-PCL::MF)
'(SB-PCL::PLIST (:ARG-INFO (1 . T)) SB-PCL::SIMPLE-NEXT-METHOD-CALL T))
(SB-C:SOURCE-LOCATION)))
(EVAL-WHEN (:EXECUTE)
(SB-PCL::LOAD-DEFMETHOD 'STANDARD-METHOD 'NORMALIZE 'NIL (LIST (FIND-CLASS 'T-MATRIX)) '(U &KEY NORMIN NORMAX COPY)
(LIST* :FUNCTION
(LET* ((SB-PCL::FMF
(SB-INT:NAMED-LAMBDA (SB-PCL::FAST-METHOD NORMALIZE (T-MATRIX))
(SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL. U &KEY NORMIN NORMAX COPY &ALLOW-OTHER-KEYS)
(DECLARE (IGNORABLE SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL.)
(SB-EXT:DISABLE-PACKAGE-LOCKS SB-PCL::PV-ENV-ENVIRONMENT))
(DECLARE (SB-PCL::%PARAMETER U))
(DECLARE (IGNORABLE U))
(SYMBOL-MACROLET ((SB-PCL::PV-ENV-ENVIRONMENT SB-PCL::DEFAULT))
(FLET ((NEXT-METHOD-P ()
(DECLARE (OPTIMIZE (SB-C:INSERT-STEP-CONDITIONS 0)))
(NOT (NULL SB-PCL::.NEXT-METHOD-CALL.))))
(DECLARE (IGNORABLE (FUNCTION NEXT-METHOD-P)))
(LET ()
(LET* ((SB-PCL::.ARGS-TAIL. NIL) (SB-PCL::.DUMMY0.))
(DECLARE (IGNORABLE SB-PCL::.ARGS-TAIL. SB-PCL::.DUMMY0.))
(DECLARE (SB-PCL::%CLASS U T-MATRIX))
(LOCALLY
(DECLARE (SB-EXT:DISABLE-PACKAGE-LOCKS SB-PCL::%PARAMETER-BINDING-MODIFIED))
(SYMBOL-MACROLET ((SB-PCL::%PARAMETER-BINDING-MODIFIED (QUOTE)))
(DECLARE (SB-EXT:ENABLE-PACKAGE-LOCKS SB-PCL::%PARAMETER-BINDING-MODIFIED))
(BLOCK NORMALIZE
(LET ((MIN (MIN-VAL U))
(MAX (MAX-VAL U))
(NMIN
(IF NORMIN
NORMIN
0))
(NMAX
(IF NORMAX
NORMAX
255))
(U
(IF COPY
(MAT-COPY U)
U)))
(LET ((SLOPE
(IF (= MAX MIN)
0.0d0
(DOUBLE-FLOAT-DIVIDE (- NMAX NMIN) (- MAX MIN)))))
(MAP-SET-VAL-FIT U #'(LAMBDA (X) (+ NMIN (* SLOPE (- X MIN))))))
U))))))))))
(SB-PCL::MF (SB-PCL::%MAKE-METHOD-FUNCTION SB-PCL::FMF)))
(SET-FUNCALLABLE-INSTANCE-FUNCTION SB-PCL::MF (SB-PCL::METHOD-FUNCTION-FROM-FAST-FUNCTION SB-PCL::FMF '(:ARG-INFO (1 . T))))
SB-PCL::MF)
'(SB-PCL::PLIST (:ARG-INFO (1 . T)) SB-PCL::SIMPLE-NEXT-METHOD-CALL T))
(SB-C:SOURCE-LOCATION))))
(PROGN
(PROGN
(EVAL-WHEN (:COMPILE-TOPLEVEL :EXECUTE) (SB-PCL::COMPILE-OR-LOAD-DEFGENERIC 'SCALAR-DIVIDE-ROW))
(EVAL-WHEN (:LOAD-TOPLEVEL)
(SB-PCL::LOAD-DEFMETHOD 'STANDARD-METHOD 'SCALAR-DIVIDE-ROW 'NIL (LIST (FIND-CLASS 'T-MATRIX) (FIND-CLASS 'T) (FIND-CLASS 'T)) '(M K Q)
(LIST* :FUNCTION
(LET* ((SB-PCL::FMF
(SB-INT:NAMED-LAMBDA (SB-PCL::FAST-METHOD SCALAR-DIVIDE-ROW (T-MATRIX T T))
(SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL. M K Q)
(DECLARE (IGNORABLE SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL.)
(SB-EXT:DISABLE-PACKAGE-LOCKS SB-PCL::PV-ENV-ENVIRONMENT))
(DECLARE (SB-PCL::%PARAMETER Q))
(DECLARE (SB-PCL::%PARAMETER K))
(DECLARE (SB-PCL::%PARAMETER M))
(DECLARE (TYPE T Q))
(DECLARE (TYPE T K))
(DECLARE (IGNORABLE Q K M))
(SYMBOL-MACROLET ((SB-PCL::PV-ENV-ENVIRONMENT SB-PCL::DEFAULT))
(FLET ((NEXT-METHOD-P ()
(DECLARE (OPTIMIZE (SB-C:INSERT-STEP-CONDITIONS 0)))
(NOT (NULL SB-PCL::.NEXT-METHOD-CALL.))))
(DECLARE (IGNORABLE (FUNCTION NEXT-METHOD-P)))
(LET* ((SB-PCL::.ARGS-TAIL. NIL) (SB-PCL::.DUMMY0.))
(DECLARE (IGNORABLE SB-PCL::.ARGS-TAIL. SB-PCL::.DUMMY0.))
(DECLARE (SB-PCL::%CLASS M T-MATRIX))
(LOCALLY
(DECLARE (SB-EXT:DISABLE-PACKAGE-LOCKS SB-PCL::%PARAMETER-BINDING-MODIFIED))
(SYMBOL-MACROLET ((SB-PCL::%PARAMETER-BINDING-MODIFIED (QUOTE)))
(DECLARE (SB-EXT:ENABLE-PACKAGE-LOCKS SB-PCL::%PARAMETER-BINDING-MODIFIED))
(BLOCK SCALAR-DIVIDE-ROW
(LET ((A (MATRIX-VALS M)))
(DECLARE (TYPE (SIMPLE-ARRAY T *) A))
(BLOCK NIL
(LET ((J 0) (#:G769 (THE INTEGER (COLS M))))
(DECLARE (TYPE UNSIGNED-BYTE J))
(TAGBODY
(GO #:G771)
#:G770
(TAGBODY
(LET* ((#:A772 A) (#:K773 K) (#:J774 J) (#:NEW1 (FIT M (/ (AREF A K J) Q))))
(FUNCALL #'(SETF AREF) #:NEW1 #:A772 #:K773 #:J774)))
(PROGN (SETQ J (1+ J)) NIL)
#:G771
(IF (>= J #:G769)
NIL
(GO #:G770))
(RETURN-FROM NIL (PROGN NIL))))))
M))))))))
(SB-PCL::MF (SB-PCL::%MAKE-METHOD-FUNCTION SB-PCL::FMF)))
(SET-FUNCALLABLE-INSTANCE-FUNCTION SB-PCL::MF (SB-PCL::METHOD-FUNCTION-FROM-FAST-FUNCTION SB-PCL::FMF '(:ARG-INFO (3))))
SB-PCL::MF)
'(SB-PCL::PLIST (:ARG-INFO (3)) SB-PCL::SIMPLE-NEXT-METHOD-CALL T))
(SB-C:SOURCE-LOCATION)))
(EVAL-WHEN (:EXECUTE)
(SB-PCL::LOAD-DEFMETHOD 'STANDARD-METHOD 'SCALAR-DIVIDE-ROW 'NIL (LIST (FIND-CLASS 'T-MATRIX) (FIND-CLASS 'T) (FIND-CLASS 'T)) '(M K Q)
(LIST* :FUNCTION
(LET* ((SB-PCL::FMF
(SB-INT:NAMED-LAMBDA (SB-PCL::FAST-METHOD SCALAR-DIVIDE-ROW (T-MATRIX T T))
(SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL. M K Q)
(DECLARE (IGNORABLE SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL.)
(SB-EXT:DISABLE-PACKAGE-LOCKS SB-PCL::PV-ENV-ENVIRONMENT))
(DECLARE (SB-PCL::%PARAMETER Q))
(DECLARE (SB-PCL::%PARAMETER K))
(DECLARE (SB-PCL::%PARAMETER M))
(DECLARE (TYPE T Q))
(DECLARE (TYPE T K))
(DECLARE (IGNORABLE Q K M))
(SYMBOL-MACROLET ((SB-PCL::PV-ENV-ENVIRONMENT SB-PCL::DEFAULT))
(FLET ((NEXT-METHOD-P ()
(DECLARE (OPTIMIZE (SB-C:INSERT-STEP-CONDITIONS 0)))
(NOT (NULL SB-PCL::.NEXT-METHOD-CALL.))))
(DECLARE (IGNORABLE (FUNCTION NEXT-METHOD-P)))
(LET* ((SB-PCL::.ARGS-TAIL. NIL) (SB-PCL::.DUMMY0.))
(DECLARE (IGNORABLE SB-PCL::.ARGS-TAIL. SB-PCL::.DUMMY0.))
(DECLARE (SB-PCL::%CLASS M T-MATRIX))
(LOCALLY
(DECLARE (SB-EXT:DISABLE-PACKAGE-LOCKS SB-PCL::%PARAMETER-BINDING-MODIFIED))
(SYMBOL-MACROLET ((SB-PCL::%PARAMETER-BINDING-MODIFIED (QUOTE)))
(DECLARE (SB-EXT:ENABLE-PACKAGE-LOCKS SB-PCL::%PARAMETER-BINDING-MODIFIED))
(BLOCK SCALAR-DIVIDE-ROW
(LET ((A (MATRIX-VALS M)))
(DECLARE (TYPE (SIMPLE-ARRAY T *) A))
(BLOCK NIL
(LET ((J 0) (#:G775 (THE INTEGER (COLS M))))
(DECLARE (TYPE UNSIGNED-BYTE J))
(TAGBODY
(GO #:G777)
#:G776
(TAGBODY
(LET* ((#:A778 A) (#:K779 K) (#:J780 J) (#:NEW1 (FIT M (/ (AREF A K J) Q))))
(FUNCALL #'(SETF AREF) #:NEW1 #:A778 #:K779 #:J780)))
(PROGN (SETQ J (1+ J)) NIL)
#:G777
(IF (>= J #:G775)
NIL
(GO #:G776))
(RETURN-FROM NIL (PROGN NIL))))))
M))))))))
(SB-PCL::MF (SB-PCL::%MAKE-METHOD-FUNCTION SB-PCL::FMF)))
(SET-FUNCALLABLE-INSTANCE-FUNCTION SB-PCL::MF (SB-PCL::METHOD-FUNCTION-FROM-FAST-FUNCTION SB-PCL::FMF '(:ARG-INFO (3))))
SB-PCL::MF)
'(SB-PCL::PLIST (:ARG-INFO (3)) SB-PCL::SIMPLE-NEXT-METHOD-CALL T))
(SB-C:SOURCE-LOCATION))))
(PROGN
(EVAL-WHEN (:COMPILE-TOPLEVEL :EXECUTE) (SB-PCL::COMPILE-OR-LOAD-DEFGENERIC 'SCALAR-MULT-ROW))
(EVAL-WHEN (:LOAD-TOPLEVEL)
(SB-PCL::LOAD-DEFMETHOD 'STANDARD-METHOD 'SCALAR-MULT-ROW 'NIL (LIST (FIND-CLASS 'T-MATRIX) (FIND-CLASS 'T) (FIND-CLASS 'T)) '(M K Q)
(LIST* :FUNCTION
(LET* ((SB-PCL::FMF
(SB-INT:NAMED-LAMBDA (SB-PCL::FAST-METHOD SCALAR-MULT-ROW (T-MATRIX T T))
(SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL. M K Q)
(DECLARE (IGNORABLE SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL.)
(SB-EXT:DISABLE-PACKAGE-LOCKS SB-PCL::PV-ENV-ENVIRONMENT))
(DECLARE (SB-PCL::%PARAMETER Q))
(DECLARE (SB-PCL::%PARAMETER K))
(DECLARE (SB-PCL::%PARAMETER M))
(DECLARE (TYPE T Q))
(DECLARE (TYPE T K))
(DECLARE (IGNORABLE Q K M))
(SYMBOL-MACROLET ((SB-PCL::PV-ENV-ENVIRONMENT SB-PCL::DEFAULT))
(FLET ((NEXT-METHOD-P ()
(DECLARE (OPTIMIZE (SB-C:INSERT-STEP-CONDITIONS 0)))
(NOT (NULL SB-PCL::.NEXT-METHOD-CALL.))))
(DECLARE (IGNORABLE (FUNCTION NEXT-METHOD-P)))
(LET* ((SB-PCL::.ARGS-TAIL. NIL) (SB-PCL::.DUMMY0.))
(DECLARE (IGNORABLE SB-PCL::.ARGS-TAIL. SB-PCL::.DUMMY0.))
(DECLARE (SB-PCL::%CLASS M T-MATRIX))
(LOCALLY
(DECLARE (SB-EXT:DISABLE-PACKAGE-LOCKS SB-PCL::%PARAMETER-BINDING-MODIFIED))
(SYMBOL-MACROLET ((SB-PCL::%PARAMETER-BINDING-MODIFIED (QUOTE)))
(DECLARE (SB-EXT:ENABLE-PACKAGE-LOCKS SB-PCL::%PARAMETER-BINDING-MODIFIED))
(BLOCK SCALAR-MULT-ROW
(LET ((A (MATRIX-VALS M)))
(DECLARE (TYPE (SIMPLE-ARRAY T *) A))
(BLOCK NIL
(LET ((J 0) (#:G781 (THE INTEGER (COLS M))))
(DECLARE (TYPE UNSIGNED-BYTE J))
(TAGBODY
(GO #:G783)
#:G782
(TAGBODY
(LET* ((#:A784 A) (#:K785 K) (#:J786 J) (#:NEW1 (FIT M (* (AREF A K J) Q))))
(FUNCALL #'(SETF AREF) #:NEW1 #:A784 #:K785 #:J786)))
(PROGN (SETQ J (1+ J)) NIL)
#:G783
(IF (>= J #:G781)
NIL
(GO #:G782))
(RETURN-FROM NIL (PROGN NIL))))))
M))))))))
(SB-PCL::MF (SB-PCL::%MAKE-METHOD-FUNCTION SB-PCL::FMF)))
(SET-FUNCALLABLE-INSTANCE-FUNCTION SB-PCL::MF (SB-PCL::METHOD-FUNCTION-FROM-FAST-FUNCTION SB-PCL::FMF '(:ARG-INFO (3))))
SB-PCL::MF)
'(SB-PCL::PLIST (:ARG-INFO (3)) SB-PCL::SIMPLE-NEXT-METHOD-CALL T))
(SB-C:SOURCE-LOCATION)))
(EVAL-WHEN (:EXECUTE)
(SB-PCL::LOAD-DEFMETHOD 'STANDARD-METHOD 'SCALAR-MULT-ROW 'NIL (LIST (FIND-CLASS 'T-MATRIX) (FIND-CLASS 'T) (FIND-CLASS 'T)) '(M K Q)
(LIST* :FUNCTION
(LET* ((SB-PCL::FMF
(SB-INT:NAMED-LAMBDA (SB-PCL::FAST-METHOD SCALAR-MULT-ROW (T-MATRIX T T))
(SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL. M K Q)
(DECLARE (IGNORABLE SB-PCL::.PV. SB-PCL::.NEXT-METHOD-CALL.)
(SB-EXT:DISABLE-PACKAGE-LOCKS SB-PCL::PV-ENV-ENVIRONMENT))
(DECLARE (SB-PCL::%PARAMETER Q))
(DECLARE (SB-PCL::%PARAMETER K))
(DECLARE (SB-PCL::%PARAMETER M))
(DECLARE (TYPE T Q))
(DECLARE (TYPE T K))
(DECLARE (IGNORABLE Q K M))
(SYMBOL-MACROLET ((SB-PCL::PV-ENV-ENVIRONMENT SB-PCL::DEFAULT))
(FLET ((NEXT-METHOD-P ()
(DECLARE (OPTIMIZE (SB-C:INSERT-STEP-CONDITIONS 0)))
(NOT (NULL SB-PCL::.NEXT-METHOD-CALL.))))
(DECLARE (IGNORABLE (FUNCTION NEXT-METHOD-P)))
(LET* ((SB-PCL::.ARGS-TAIL. NIL) (SB-PCL::.DUMMY0.))
(DECLARE (IGNORABLE SB-PCL::.ARGS-TAIL. SB-PCL::.DUMMY0.))
(DECLARE (SB-PCL::%CLASS M T-MATRIX))
(LOCALLY
(DECLARE (SB-EXT:DISABLE-PACKAGE-LOCKS SB-PCL::%PARAMETER-BINDING-MODIFIED))
(SYMBOL-MACROLET ((SB-PCL::%PARAMETER-BINDING-MODIFIED (QUOTE)))
(DECLARE (SB-EXT:ENABLE-PACKAGE-LOCKS SB-PCL::%PARAMETER-BINDING-MODIFIED))
(BLOCK SCALAR-MULT-ROW
(LET ((A (MATRIX-VALS M)))
(DECLARE (TYPE (SIMPLE-ARRAY T *) A))
(BLOCK NIL
(LET ((J 0) (#:G787 (THE INTEGER (COLS M))))
(DECLARE (TYPE UNSIGNED-BYTE J))
(TAGBODY
(GO #:G789)
#:G788
(TAGBODY
(LET* ((#:A790 A) (#:K791 K) (#:J792 J) (#:NEW1 (FIT M (* (AREF A K J) Q))))
(FUNCALL #'(SETF AREF) #:NEW1 #:A790 #:K791 #:J792)))
(PROGN (SETQ J (1+ J)) NIL)
#:G789
(IF (>= J #:G787)
NIL
(GO #:G788))
(RETURN-FROM NIL (PROGN NIL))))))
M))))))))
(SB-PCL::MF (SB-PCL::%MAKE-METHOD-FUNCTION SB-PCL::FMF)))
(SET-FUNCALLABLE-INSTANCE-FUNCTION SB-PCL::MF (SB-PCL::METHOD-FUNCTION-FROM-FAST-FUNCTION SB-PCL::FMF '(:ARG-INFO (3))))
SB-PCL::MF)
'(SB-PCL::PLIST (:ARG-INFO (3)) SB-PCL::SIMPLE-NEXT-METHOD-CALL T))
(SB-C:SOURCE-LOCATION))))))
@slyrus
Copy link
Author

slyrus commented Apr 21, 2018

This gives me the following warnings:

; compiling (DEFMATRIXFUNCS T-MATRIX ...)

; file: /tmp/slimeawmP21
; in: DEFMATRIXFUNCS T-MATRIX
;     (CLEM::DEFMATRIXFUNCS CLEM:T-MATRIX :ELEMENT-TYPE T :ACCUMULATOR-TYPE T)
; --> PROGN DEFMETHOD PROGN EVAL-WHEN SB-PCL::%DEFMETHOD-EXPANDER 
; --> SB-PCL::LOAD-DEFMETHOD SB-PCL::LOAD-DEFMETHOD LIST* LET* 
; --> SB-INT:NAMED-LAMBDA FUNCTION SYMBOL-MACROLET 
; --> SB-PCL::FAST-LEXICAL-METHOD-FUNCTIONS 
; --> SB-PCL::BIND-FAST-LEXICAL-METHOD-FUNCTIONS FLET SB-PCL::BIND-ARGS 
; --> LET* LOCALLY SYMBOL-MACROLET BLOCK LET LET LET 
; --> CLEM::WITH-MAP-RANGE CLEM::WITH-MATRIX-VALS IF 
; --> CLEM::WITH-TYPED-MATRIX-VALS LET DO BLOCK LET TAGBODY TAGBODY DO 
; --> BLOCK LET 
; ==>
;   CLEM::STARTC
; 
; note: could not stack allocate STARTC in:
;        (DEFMATRIXFUNCS T-MATRIX :ELEMENT-TYPE T :ACCUMULATOR-TYPE T)

; --> PROGN DEFMETHOD PROGN EVAL-WHEN SB-PCL::%DEFMETHOD-EXPANDER 
; --> SB-PCL::LOAD-DEFMETHOD SB-PCL::LOAD-DEFMETHOD LIST* LET* 
; --> SB-INT:NAMED-LAMBDA FUNCTION SYMBOL-MACROLET 
; --> SB-PCL::FAST-LEXICAL-METHOD-FUNCTIONS 
; --> SB-PCL::BIND-FAST-LEXICAL-METHOD-FUNCTIONS FLET SB-PCL::BIND-ARGS 
; --> LET* LOCALLY SYMBOL-MACROLET BLOCK LET LET LET 
; --> CLEM::WITH-MAP-RANGE CLEM::WITH-MATRIX-VALS IF 
; --> CLEM::WITH-TYPED-MATRIX-VALS LET DO BLOCK LET 
; ==>
;   CLEM::STARTR
; 
; note: could not stack allocate STARTR in:
;        (DEFMATRIXFUNCS T-MATRIX :ELEMENT-TYPE T :ACCUMULATOR-TYPE T)

; --> PROGN DEFMETHOD PROGN EVAL-WHEN SB-PCL::%DEFMETHOD-EXPANDER 
; --> SB-PCL::LOAD-DEFMETHOD SB-PCL::LOAD-DEFMETHOD LIST* LET* 
; --> SB-INT:NAMED-LAMBDA FUNCTION SYMBOL-MACROLET 
; --> SB-PCL::FAST-LEXICAL-METHOD-FUNCTIONS 
; --> SB-PCL::BIND-FAST-LEXICAL-METHOD-FUNCTIONS FLET SB-PCL::BIND-ARGS 
; --> LET* LOCALLY SYMBOL-MACROLET BLOCK LET LET LET 
; --> CLEM::WITH-MAP-RANGE CLEM::WITH-MATRIX-VALS IF 
; --> CLEM::WITH-UNTYPED-MATRIX-VALS LET DO BLOCK LET TAGBODY TAGBODY 
; --> DO BLOCK LET 
; ==>
;   CLEM::STARTC
; 
; note: could not stack allocate STARTC in:
;        (DEFMATRIXFUNCS T-MATRIX :ELEMENT-TYPE T :ACCUMULATOR-TYPE T)

; --> PROGN DEFMETHOD PROGN EVAL-WHEN SB-PCL::%DEFMETHOD-EXPANDER 
; --> SB-PCL::LOAD-DEFMETHOD SB-PCL::LOAD-DEFMETHOD LIST* LET* 
; --> SB-INT:NAMED-LAMBDA FUNCTION SYMBOL-MACROLET 
; --> SB-PCL::FAST-LEXICAL-METHOD-FUNCTIONS 
; --> SB-PCL::BIND-FAST-LEXICAL-METHOD-FUNCTIONS FLET SB-PCL::BIND-ARGS 
; --> LET* LOCALLY SYMBOL-MACROLET BLOCK LET LET LET 
; --> CLEM::WITH-MAP-RANGE CLEM::WITH-MATRIX-VALS IF 
; --> CLEM::WITH-UNTYPED-MATRIX-VALS LET DO BLOCK LET 
; ==>
;   CLEM::STARTR
; 
; note: could not stack allocate STARTR in:
;        (DEFMATRIXFUNCS T-MATRIX :ELEMENT-TYPE T :ACCUMULATOR-TYPE T)

; --> PROGN DEFMETHOD PROGN EVAL-WHEN SB-PCL::%DEFMETHOD-EXPANDER 
; --> SB-PCL::LOAD-DEFMETHOD SB-PCL::LOAD-DEFMETHOD LIST* LET* 
; --> SB-INT:NAMED-LAMBDA FUNCTION SYMBOL-MACROLET 
; --> SB-PCL::FAST-LEXICAL-METHOD-FUNCTIONS 
; --> SB-PCL::BIND-FAST-LEXICAL-METHOD-FUNCTIONS FLET SB-PCL::BIND-ARGS 
; --> LET* LOCALLY SYMBOL-MACROLET BLOCK DESTRUCTURING-BIND 
; --> SB-INT:BINDING* LET* MULTIPLE-VALUE-BIND LET VALUES PROG1 LET 
; ==>
;   #:G223
; 
; note: could not stack allocate #:G192 in:
;        (DEFMATRIXFUNCS T-MATRIX :ELEMENT-TYPE T :ACCUMULATOR-TYPE T)

; ==>
;   #:G217
; 
; note: could not stack allocate #:G193 in:
;        (DEFMATRIXFUNCS T-MATRIX :ELEMENT-TYPE T :ACCUMULATOR-TYPE T)
; 
; compilation unit finished
;   printed 6 notes

@slyrus
Copy link
Author

slyrus commented Apr 21, 2018

if i macroexpand the troublesome bits, I get:

(DEFMETHOD SAMPLE-VARIANCE-RANGE ((M T-MATRIX) STARTR ENDR STARTC ENDC)
   (DECLARE (TYPE FIXNUM STARTR ENDR STARTC ENDC))
   (LET ((ACC (COERCE 0 'T)))
     (LET ((MU (MEAN-RANGE M STARTR ENDR STARTC ENDC)))
       (LET ((MUSQ (* MU MU)))
         (IF (EQUAL 'T (ELEMENT-TYPE (CLASS-OF M)))
             (WITH-TYPED-MATRIX-VALS (M T A)
               (DO ((I STARTR (1+ I)))
                   ((> I ENDR))
                 (DECLARE (DYNAMIC-EXTENT I)
                          (TYPE FIXNUM I))
                 (DO ((J STARTC (1+ J)))
                     ((> J ENDC))
                   (DECLARE (DYNAMIC-EXTENT J)
                            (TYPE FIXNUM J))
                   (INCF ACC (- (* (AREF A I J) (AREF A I J)) MUSQ)))))
             (WITH-UNTYPED-MATRIX-VALS (M T A)
               (DO ((I STARTR (1+ I)))
                   ((> I ENDR))
                 (DECLARE (DYNAMIC-EXTENT I)
                          (TYPE FIXNUM I))
                 (DO ((J STARTC (1+ J)))
                     ((> J ENDC))
                   (DECLARE (DYNAMIC-EXTENT J)
                            (TYPE FIXNUM J))
                   (INCF ACC (- (* (AREF A I J) (AREF A I J)) MUSQ))))))))))

@slyrus
Copy link
Author

slyrus commented Apr 21, 2018

compiling this yields:

cd /home/sly/projects/clem/src/
3 compiler notes:

temp.lisp:10:16:
  note: 
    could not stack allocate STARTR in:
           (DO ((I STARTR (1+ I)))
               ((> I ENDR))
             (DECLARE (DYNAMIC-EXTENT I)
                      (TYPE FIXNUM I))
             (DO ((J STARTC (1+ J)))
                 ((> J ENDC))
               (DECLARE (DYNAMIC-EXTENT J)
                        (TYPE FIXNUM J))
               (INCF ACC (- (* (AREF A I J) (AREF A I J)) MUSQ))))
    --> BLOCK LET 
    ==>
      CLEM::STARTR
    

temp.lisp:14:18:
  note: 
    could not stack allocate STARTC in:
           (DO ((J STARTC (1+ J)))
               ((> J ENDC))
             (DECLARE (DYNAMIC-EXTENT J)
                      (TYPE FIXNUM J))
             (INCF ACC (- (* (AREF A I J) (AREF A I J)) MUSQ)))
    --> BLOCK LET 
    ==>
      CLEM::STARTC
    

temp.lisp:20:16:
  note: 
    could not stack allocate STARTR in:
           (DO ((I STARTR (1+ I)))
               ((> I ENDR))
             (DECLARE (DYNAMIC-EXTENT I)
                      (TYPE FIXNUM I))
             (DO ((J STARTC (1+ J)))
                 ((> J ENDC))
               (DECLARE (DYNAMIC-EXTENT J)
                        (TYPE FIXNUM J))
               (INCF ACC (- (* (AREF A I J) (AREF A I J)) MUSQ))))
    --> BLOCK LET 
    ==>
      CLEM::STARTR
    

temp.lisp:24:18:
  note: 
    could not stack allocate STARTC in:
           (DO ((J STARTC (1+ J)))
               ((> J ENDC))
             (DECLARE (DYNAMIC-EXTENT J)
                      (TYPE FIXNUM J))
             (INCF ACC (- (* (AREF A I J) (AREF A I J)) MUSQ)))
    --> BLOCK LET 
    ==>
      CLEM::STARTC

@slyrus
Copy link
Author

slyrus commented Apr 21, 2018

More examples:

(defun foo (startr endr)
  (declare (dynamic-extent startr))
  (let ((acc 0))
    (do ((i startr (1+ i))) ((> i endr))
      (declare (dynamic-extent i) (fixnum i))
      (incf acc i))
    acc))

(defun foo2 (startr endr)
  (declare (dynamic-extent startr))
  (let ((acc 0))
    (loop for i fixnum from startr to endr
       do (incf acc i))
    acc))

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment