Annotation of rpl/modules/sets/ltos.rplc, revision 1.2

1.1       bertrand    1: #include "src/rplexternals.h"
                      2: #include "sets.h"
                      3: 
1.2     ! bertrand    4: static int
        !             5: orderFunction(const void *a, const void *b)
        !             6: {
        !             7:    if ((*((integer8 *) a)) < (*((integer8 *) b)))
        !             8:    {
        !             9:        return(-1);
        !            10:    }
        !            11:    if ((*((integer8 *) a)) > (*((integer8 *) b)))
        !            12:    {
        !            13:        return(1);
        !            14:    }
        !            15: 
        !            16:    return(0);
        !            17: }
        !            18: 
        !            19: 
1.1       bertrand   20: declareExternalFunction(ltos)
                     21:    declareDaisyChain(current);
                     22:    declareObject(object);
                     23:    declareObject(subObject);
                     24:    declareObject(result);
                     25: 
1.2     ! bertrand   26:    integer8    currentValue;
1.1       bertrand   27:    integer8    i;
1.2     ! bertrand   28:    integer8    j;
1.1       bertrand   29:    integer8    target(vector);
                     30:    integer8    sizeOfList;
                     31: 
                     32:    HEADER
                     33:        declareHelpString("List to set");
                     34:        numberOfArguments(1);
                     35:    FUNCTION
                     36:        pullFromStack(object, list);
                     37:        returnOnError(freeObject(object));
                     38: 
                     39:        listLength(object, sizeOfList);
                     40:        getDaisyChainFromList(object, current);
                     41:        vector = allocate(sizeOfList * size(integer8));
                     42: 
                     43:        i = 0;
                     44: 
                     45:        repeatWhile(not nullified(current))
                     46:            subObject = fetchElementFromDaisyChain(current);
                     47:            getInteger(subObject, vector[i]);
                     48:            returnOnError(freeObject(object); deallocate(vector));
                     49:            postIncr(i);
1.2     ! bertrand   50:            current = nextElementOfDaisyChain(current);
1.1       bertrand   51:        endWhile
                     52: 
                     53:        freeObject(object);
                     54: 
1.2     ! bertrand   55:        if (sizeOfList gt 0) then
        !            56:            qsort(vector, sizeOfList, sizeof(integer8), orderFunction);
        !            57: 
        !            58:            currentValue = vector[0];
        !            59:            j = 1;
        !            60: 
        !            61:            loop(i = 1, i lt sizeOfList, postIncr(i))
        !            62:                if (vector[i] ne currentValue) then
        !            63:                    vector[postIncr(j)] = vector[i];
        !            64:                    currentValue = vector[i];
        !            65:                endIf
        !            66:            endLoop
        !            67: 
        !            68:            sizeOfList = j;
        !            69:            vector = reallocate(vector, sizeOfList * size(integer8));
        !            70:        endIf
        !            71: 
1.1       bertrand   72:        createExternalObject(result, ISET);
1.2     ! bertrand   73:        objectOf(result) = allocate(size(set_t));
1.1       bertrand   74:        objectContainer(set_t, result)->values = vector;
                     75:        objectContainer(set_t, result)->size = sizeOfList;
                     76: 
                     77:        pushOnStack(result);
                     78:    END
                     79: endExternalFunction
                     80: 
                     81: // vim: ts=4

CVSweb interface <joel.bertrand@systella.fr>