PreviousUpNext

15.4.366  src/lib/compiler/back/low/regor/regor-leftist-tree-priority-queue-g.pkg

## 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;
};


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext