Initial data commit

Task/Priority-queue/Quackery/priority-queue.quackery

@@ -0,0 +1,98 @@
+( ***** priotity queue ***** )
+
+  [ stack ]                      is heap.pq     (     --> s   )
+
+  [ stack ]                      is comp.pq     (     --> s   )
+
+  [ unpack
+    comp.pq put heap.pq put ]    is pq->stacks  (   p -->     )
+
+  [ heap.pq take comp.pq take
+    2 pack ]                     is stacks->pq  (     --> p   )
+
+  [ heap.pq share swap peek ]    is heapeek     (   n --> x   )
+
+  [ heap.pq take
+    swap poke heap.pq put ]      is heapoke     ( n x -->     )
+
+  [ 1 - 1 >> ]                   is parent      (   n --> n   )
+
+  [ 0 > ]                        is has-parent  (   n --> b   )
+
+  [ 1 << 1+ ]                    is child       (   n --> n   )
+
+  [ child heap.pq share size < ] is has-child   (   n --> b   )
+
+  [ 1+ ]                         is sibling     (   n --> n   )
+
+  [ sibling
+    heap.pq share size < ]       is has-sibling (   n --> b   )
+
+  [ comp.pq share do ]           is compare     ( x x --> b   )
+
+  [ 0 peek size ]                is pqsize      (   p --> n   )
+
+  [ swap pq->stacks
+    heap.pq take tuck size
+    rot 0 join heap.pq put
+    [ dup has-parent while
+      dup parent
+      rot over heapeek
+      2dup compare iff
+        [ 2swap unrot heapoke ]
+        again
+      rot 2drop swap ]
+    heapoke
+    stacks->pq ]                 is topq        ( p x --> p   )
+
+  [ dup heapeek swap
+    [ dup has-child while
+      dup child
+      dup has-sibling if
+        [ dup sibling heapeek
+          over heapeek
+          compare if sibling ]
+      dip over dup heapeek
+      rot dip dup compare iff
+        [ rot heapoke ] again
+      2drop ]
+    heapoke ]                    is heapify.pq  (   n -->     )
+
+  [ dup pqsize 0 = if
+      [ $ "Unexpectedly empty priority queue."
+        fail ]
+    pq->stacks heap.pq share
+    behead
+    over [] = iff
+      [ swap heap.pq replace ]
+    else
+      [ swap -1 split
+        swap join heap.pq put
+        0 heapify.pq ]
+    stacks->pq swap ]            is frompq      (   p --> p x )
+
+  [ ]'[ 2 pack pq->stacks
+    heap.pq share
+    size 1 >> times
+      [ i heapify.pq ]
+    stacks->pq ]                 is pqwith      (   [ --> p   )
+
+( ***** task ***** )
+
+  [ 2 pack topq ]                is insert      ( p n $ --> p     )
+
+  [ frompq unpack ]              is dequeue    (     p --> p n $ )
+
+  [] pqwith [ 0 peek dip [ 0 peek ] < ]
+
+  3 $ "Clear drains"   insert
+  4 $ "Feed cat"       insert
+  5 $ "Make tea"       insert
+  1 $ "Solve RC tasks" insert
+  2 $ "Tax return"     insert
+
+  5 times
+    [ dequeue
+      swap echo say ": "
+      echo$ cr ]
+  drop