## regor-leftist-tree-priority-queue-g.pkg "regor" is a contraction of "register allocator"
# Compiled by:
# src/lib/compiler/back/low/lib/lowhalf.lib# Priority Queue. Let's hope the compiler will inline it for performance
# We already have in the system
#
# src/lib/graph/node-priority-queue-g.pkg# src/lib/src/leftist-tree-priority-queue.pkg# src/lib/src/leftist-heap-priority-queue-g.pkg# src/lib/src/heap-priority-queue.pkg#
# Do we really need this one as well?
# If so, we should move it into the library -- there's nothing regor-specific about it.
# If not, we should replace it with one of the library implementations.
# -- 2011-06-07 CrT XXX BUGGO FIXME
### "Everything that can be invented has been invented.
###
### -- Charles H. Duell, Commissioner, US Patent Office, 1899
# We are invoked from:
#
# src/lib/compiler/back/low/regor/iterated-register-coalescing.pkg#
generic package regor_leftist_tree_priority_queue_g (
# ===================================
Element;
less: (Element, Element) -> Bool;
)
: (weak) Regor_Priority_Queue # Regor_Priority_Queue is from src/lib/compiler/back/low/regor/regor-priority-queue.api{
# A leftist tree is a binary tree with priority ordering
# with the invariant that the left branch is always the taller one
Element = Element;
Priority_Queue = TREE (Element, Int, Priority_Queue, Priority_Queue)
| EMPTY;
fun merge' (EMPTY, EMPTY)
=>
(EMPTY, 0);
merge' (EMPTY, a as TREE(_, d, _, _)) => (a, d);
merge' (a as TREE(_, d, _, _), EMPTY) => (a, d);
merge' (a as TREE (x, d, l, r), b as TREE (y, d', l', r'))
=>
(TREE (root, d_t, l, r), d_t)
where
my (root, l, r1, r2)
=
if (less (x, y)) (x, l, r, b);
else (y, l', r', a);
fi;
my (r, d_r) = merge' (r1, r2);
d_l = case l EMPTY => 0;
TREE(_, d, _, _) => d;
esac;
my (l, r, d_t)
=
if (d_l >= d_r) (l, r, d_l+1);
else (r, l, d_r+1);
fi;
end;
end;
fun merge (a, b)
=
#1 (merge' (a, b));
fun add (x, EMPTY)
=>
TREE (x, 1, EMPTY, EMPTY);
add (x, b as TREE (y, d', l', r'))
=>
if (less (x, y)) TREE (x, d'+1, b, EMPTY);
else #1 (merge' (TREE (x, 1, EMPTY, EMPTY), b));
fi;
end;
};