(in-package "CL-USER") (DEFUN SORT-MATRIX-ROW (matrix row PRED &key KEY) ;; treat ROWth row of MATRIX as a sequence and heap-sort it (LET ((LEN-1 (1- (array-dimension matrix 1)))) (DECLARE (FIXNUM LEN-1)) (BLOCK NIL (LET ((G7839 (FLOOR LEN-1 2))) (DECLARE (FIXNUM G7839)) (TAGBODY (GO G7841) G7840 (LET* ((G7853 G7839) (G7842 (1+ G7839)) (G7843 (1+ LEN-1)) (G7844 (AREF MATRIX ROW G7839)) (G7845 (IF KEY (FUNCALL KEY G7844) G7844)) (G7846 (ASH G7843 -1))) (DECLARE (FIXNUM G7853 G7842 G7843 G7846)) (BLOCK NIL (TAGBODY G7855 (PROGN (IF (> G7842 G7846) (return)) (LET* ((G7847 (ASH G7842 1)) (G7848 (1- G7847)) (G7849 (AREF MATRIX ROW G7848)) (G7850 (IF KEY (FUNCALL KEY G7849) G7849))) (DECLARE (FIXNUM G7847 G7848)) (IF (< G7847 G7843) (LET* ((G7851 (AREF MATRIX ROW G7847)) (G7852 (IF KEY (FUNCALL KEY G7851) G7851))) (IF (FUNCALL PRED G7850 G7852) (PROGN (SETQ G7848 G7847) (SETQ G7849 G7851) (SETQ G7850 G7852))))) (IF (FUNCALL PRED G7850 G7845) (return)) (FUNCALL #'(SETF AREF) G7849 matrix row G7853) (SETQ G7842 (1+ G7848)) (SETQ G7853 G7848))) (GO G7855))) (FUNCALL #'(SETF AREF) G7844 matrix row G7853)) (SETQ G7839 (1- G7839)) G7841 (IF (NOT (MINUSP G7839)) (GO G7840)) (RETURN-FROM NIL matrix)))) (BLOCK NIL (LET* ((I LEN-1) (I-1 (1- I))) (DECLARE (FIXNUM I I-1)) (TAGBODY (GO G7864) G7863 (MULTIPLE-VALUE-BIND (G7865) (AREF matrix row I) (MULTIPLE-VALUE-BIND (G7868) (AREF matrix row 0) (FUNCALL #'(SETF AREF) G7865 matrix row 0) (FUNCALL #'(SETF AREF) G7868 matrix row I))) (LET* ((G7882 0) (G7871 (1+ 0)) (G7872 (1+ I-1)) (G7873 (AREF MATRIX ROW 0)) (G7874 (IF KEY (FUNCALL KEY G7873) G7873)) (G7875 (ASH G7872 -1))) (DECLARE (FIXNUM G7882 G7871 G7872 G7875)) (BLOCK NIL (TAGBODY G7884 (PROGN (IF (> G7871 G7875) (return)) (LET* ((G7876 (ASH G7871 1)) (G7877 (1- G7876)) (G7878 (AREF MATRIX ROW G7877)) (G7879 (IF KEY (FUNCALL KEY G7878) G7878))) (DECLARE (FIXNUM G7876 G7877)) (IF (< G7876 G7872) (LET* ((G7880 (AREF MATRIX ROW G7876)) (G7881 (IF KEY (FUNCALL KEY G7880) G7880))) (IF (FUNCALL PRED G7879 G7881) (PROGN (SETQ G7877 G7876) (SETQ G7878 G7880) (SETQ G7879 G7881))))) (IF (FUNCALL PRED G7879 G7874) (return)) (FUNCALL #'(SETF AREF) G7878 matrix row G7882) (SETQ G7871 (1+ G7877)) (SETQ G7882 G7877))) (GO G7884))) (FUNCALL #'(SETF AREF) G7873 matrix row G7882)) (SETQ I I-1 I-1 (1- I-1)) G7864 (IF (NOT (ZEROP I)) (GO G7863)) (RETURN-FROM NIL matrix)))))) (setq $a #2A((37 439 549 22 30 455) (-3943 484 238 -2 2 2))) (sort-matrix-row $a 1 #'<)