Return to intersection.rplc CVS log

Up to [local] / rpl / modules / sets

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

1.1       bertrand    1: #include "src/rplexternals.h"
                      2: #include "sets.h"
                      3: 
                      4: declareExternalFunction(intersection)
                      5:    declareObject(object1);
                      6:    declareObject(object2);
                      7:    declareObject(result);
                      8: 
                      9:    integer8    i;
                     10:    integer8    j;
                     11:    integer8    k;
                     12:    integer8    target(vector);
                     13: 
                     14:    HEADER
                     15:        declareHelpString("Intersection");
                     16:        numberOfArguments(2);
                     17:    FUNCTION
                     18:        pullFromStack(object1, external);
                     19:        returnOnError(freeObject(object1));
                     20:        pullFromStack(object2, external);
                     21:        returnOnError(freeObject(object1); freeObject(object2));
                     22: 
                     23:        if ((objectSubtype(object1) ne ISET) or
                     24:                (objectSubtype(object2) ne ISET)) then
                     25:            executionError("Type not allowed");
                     26:            returnOnError(freeObject(object1); freeObject(object2));
                     27:        endIf
                     28: 
                     29:        vector = allocate((*((set_t *) (*object1).objet)).size
                     30:                * size(integer8));
                     31: 
                     32:        i = 0;
                     33:        j = 0;
                     34:        k = 0;
                     35: 
                     36:        repeatWhile((i lt (*((set_t *) (*object1).objet)).size) and
                     37:                (j lt (*((set_t *) (*object2).objet)).size))
                     38:            if ((*((set_t *) (*object1).objet)).values[i] lt
                     39:                    (*((set_t *) (*object2).objet)).values[j]) then
                     40:                postIncr(i);
                     41:            elseIf ((*((set_t *) (*object2).objet)).values[j] lt
                     42:                    (*((set_t *) (*object1).objet)).values[i]) then
                     43:                postIncr(j);
                     44:            orElse
                     45:                vector[k] = (*((set_t *) (*object2).objet)).values[j];
                     46:                postIncr(i);
                     47:                postIncr(j);
                     48:                postIncr(k);
                     49:            endIf
                     50:        endWhile
                     51: 
                     52:        vector = reallocate(vector, k * size(integer8));
                     53: 
                     54:        createExternalObject(result, ISET);
1.2     ! bertrand   55:        objectOf(result) = allocate(size(set_t));
1.1       bertrand   56: 
1.2     ! bertrand   57:        objectContainer(set_t, result)->size = k;
        !            58:        objectContainer(set_t, result)->values = vector;
1.1       bertrand   59: 
                     60:        freeObject(object1);
                     61:        freeObject(object2);
                     62: 
                     63:        pushOnStack(result);
                     64:    END
                     65: endExternalFunction
                     66: 
                     67: // vim: ts=4