(LETREC MAKEHEAP (MAKEHEAP LAMBDA (LST) (LET (AUXMAKEHEAP LST LSTLEN (DIV LSTLEN (QUOTE 2))) (LSTLEN LENGTH LST))) (AUXMAKEHEAP LAMBDA (LST N M) (IF (EQ M (QUOTE 0)) LST (AUXMAKEHEAP (HEAPIFY LST N M) N (SUB M (QUOTE 1))))) (LENGTH LAMBDA (LST) (IF (EQ LST (QUOTE NIL)) (QUOTE 0) (ADD (QUOTE 1) (LENGTH (CDR LST))))) (HEAPIFY LAMBDA (LST N M) (IF (LEQ N (SUB (MUL M (QUOTE 2)) (QUOTE 1))) LST ;NO CHILDREN IN LST (LET (IF (EQ (CAR NEXTANDLST) M) ;WE HAVE HEAP FROM HERE DOWN (CDR NEXTANDLST) (HEAPIFY (CDR NEXTANDLST) N (CAR NEXTANDLST))) ;DOWN!! (NEXTANDLST SWAPIFNEEDED LST M (NODEANDCHILDREN LST M M))))) (NODEANDCHILDREN LAMBDA (LST M1 M2) ;NODE AT M1 (LETREC (IF (EQ M1 (QUOTE 1)) (CONS (CAR LST) (GETSIBLINGS (CDR LST) M2)) ;GOT NODE, ETC (NODEANDCHILDREN (CDR LST) (SUB M1 (QUOTE 1)) M2)) (GETSIBLINGS LAMBDA (LST M) (IF (EQ M (QUOTE 1)) (CONS (CAR LST) ;LEFTCHILD (IF (EQ (CDR LST) (QUOTE NIL)) ;RIGHTCHILD? (QUOTE NIL) ;NOPE... (CAR (CDR LST)))) ;OK, THROW IT IN (GETSIBLINGS (CDR LST) (SUB M (QUOTE 1))))))) (SWAP LAMBDA (LST ITEM1 POS1 ITEM2 POS2) (LETREC (IF (LEQ POS1 POS2) (AUXSWAP LST ITEM1 POS1 ITEM2 (SUB POS2 POS1)) (AUXSWAP LST ITEM2 POS2 ITEM1 (SUB POS1 POS2))) (AUXSWAP LAMBDA (LST ITEM1 P1 ITEM2 OFFSET) (IF (LEQ P1 (QUOTE 1)) (CONS ITEM2 (UPDATE (CDR LST) ITEM1 OFFSET)) (CONS (CAR LST) (AUXSWAP (CDR LST) ITEM1 (SUB P1 (QUOTE 1)) ITEM2 OFFSET)))) (UPDATE LAMBDA (LST I P) (IF (LEQ P (QUOTE 1)) (CONS I (CDR LST)) (CONS (CAR LST) (UPDATE (CDR LST) I (SUB P (QUOTE 1)))))))) (LEQPRIORITY LAMBDA (N1 N2) (LET (LEQ (PRIORITY N1) (PRIORITY N2)) (PRIORITY LAMBDA (X) (CDR (CDR X))))) (SWAPIFNEEDED LAMBDA (LST M NODES) (LET (LET (IF (EQ RCHILD (QUOTE NIL)) (IF (LEQPRIORITY LCHILD PARENT) (CONS M LST) (CONS LCPOS (SWAP LST PARENT M LCHILD LCPOS))) (IF (LEQPRIORITY LCHILD PARENT) (IF (LEQPRIORITY RCHILD PARENT) (CONS M LST) (CONS RCPOS (SWAP LST PARENT M RCHILD RCPOS))) (IF (LEQPRIORITY RCHILD PARENT) (CONS LCPOS (SWAP LST PARENT M LCHILD LCPOS)) (IF (LEQPRIORITY RCHILD LCHILD) (CONS LCPOS (SWAP LST PARENT M LCHILD LCPOS)) (CONS RCPOS (SWAP LST PARENT M RCHILD RCPOS)))))) (RCPOS ADD LCPOS (QUOTE 1))) (PARENT CAR NODES) (LCHILD CAR (CDR NODES)) (RCHILD CDR (CDR NODES)) (LCPOS MUL M (QUOTE 2)))))&