Return to oh_base.rr CVS log

Up to [local] / OpenXM / src / asir-contrib / packages / src

Fixed.

/* $OpenXM: OpenXM/src/asir-contrib/packages/src/oh_base.rr,v 1.12 2015/03/19 15:36:20 ohara Exp $ */

module oh_base;

localf length, nth, remove_nth, range;
localf max2, min2, sum2, mul2;
localf iterate, max, min, sum, mul;
localf assoc_index, assoc_index_r, assoc_keyset, assoc_valset, assoc_match;
localf extern_get,extern_set;
localf uniq;
localf callS;

static Extern; /* associated list */

if (Extern==0) {
    Extern = [];
}else {
}

def length(L) {
    return (type(L)==4||type(L)==5)? ::length(L): 0;
}

/*&usage
Syntax: object nth(list L|alt=Alt): n-th member of L with fool proof.
Example:
[1] oh_base.nth([a,b,c,d],2)
c
[2] oh_base.nth([a,b,c,d],-1|alt=x)
x
*/
def nth(L,I) {
    Alt=getopt(alt);
    if (type(Alt) >= 0) {
        return (0<=I && I<::length(L))? L[I]: Alt;
    }
    return L[I];
}

def remove_nth(L,I) {
    A=[];
    Len=::length(L);
    for(J=0; J<Len; J++) {
        if(J!=I) {
            A = cons(L[J],A);
        }
    }
    return reverse(A);
}

/*&usage
Syntax: list range(integer A, integer B): the list from A to B.
Example:
[1] oh_base.range(2,6)
[2,3,4,5,6]
[2] oh_base.range(3,-2)
[3,2,1,0,-1,-2]
*/
def range(Start,End) {
    L = [];
    if(Start<=End) {
        for(I=End; I>=Start; I--) {
            L = cons(I,L);
        }
    }else {
        for(I=End; I<=Start; I++) {
            L = cons(I,L);
        }
    }
    return L;
}

/*&usage
Syntax: object max2(object A,object B|comp=cmp): the large object under a comparison function.
Example:
[1] oh_base.max2(-2,1);
1
[2] def cmp(A,B) { return (A^2>B^2);}
[3] oh_base.max2(-2,1|comp=cmp);
-2
*/

def max2(A,B) {
    Comp=getopt(comp);
    if (type(Comp) >= 0) {
        return ((*Comp)(A,B))? A: B;
    }
    return (A>B)? A: B;
}

def min2(A,B) {
    Comp=getopt(comp);
    if (type(Comp) >= 0) {
        return ((*Comp)(A,B))? B: A;
    }
    return (A>B)? B: A;
}

def sum2(A,B) {
    return A+B;
}

def mul2(A,B) {
    return A*B;
}

/*&usage
Syntax: object iterate(function F,list L): action of n-term operator generated by 2-term operator F.
Example:
[1] oh_base.max2(-2,1);
1
[2] oh_base.iterate(oh_base.max2, [-2,0,3,-4,1]);
3
[3] oh_base.sum2(a,b);
a+b
[4] oh_base.iterate(oh_base.sum2, [a,b,c,d,e]);
a+b+c+d+e
*/
def iterate(Op2,L) {
    N=length(L);
    if(N==0) {
        return [];
    }
    OPTS=getopt();
    A=L[0];
    for(I=1; I<N; I++) {
        A=(*Op2)(A,L[I]|option_list=OPTS);
    }
    return A;
}

/*&usage
Syntax: object max(list L|comp=cmp): the largest object in L under a comparison function.
Example:
[1] oh_base.max([-2,0,3,-4,1]);
3
[2] def cmp(A,B) { return (A^2>B^2);}
[3] oh_base.max([-2,0,3,-4,1]|comp=cmp);
-4
*/
def max(L) {
    OPTS=getopt();
    return iterate(oh_base.max2,L|option_list=OPTS);
}

def min(L) {
    OPTS=getopt();
    return iterate(oh_base.min2,L|option_list=OPTS);
}

def sum(L) {
    OPTS=getopt();
    return iterate(oh_base.sum2,L|option_list=OPTS);
}

def mul(L) {
    OPTS=getopt();
    return iterate(oh_base.mul2,L|option_list=OPTS);
}

/* Example:
[0] load("oh_base.rr")$
[1] A=assoc([1,-2,3,-4,5],[dog,cat,cow,bird,dog]);
[[1,dog],[-2,cat],[3,cow],[-4,bird],[5,dog]]
[2] oh_base.assoc_index(A,-4);
3
[3] A[3];   
[-4,bird]
[4] oh_base.assoc_index_r(A,dog);
[0,4]
[5] oh_base.assoc_keyset(A);
[1,-2,3,-4,5]
[6] oh_base.assoc_valset(A);
[dog,cat,cow,bird,dog]
*/
/* Find an element which is matched with Key or Value in an associated list.
   Output its index. */
def assoc_index(Assoc,Key) {
    K=0; /* key */
    if(getopt(key)==value) {
        K=1; /* value */
    }
    N=length(Assoc);
    for(I=0; I<N; I++) {
        if (Key==Assoc[I][K]) {
            return I;
        }
    }
    return -1; /* no match */
}

/* Find the elements which is matched with Value in an associated list.
   Output their indexes. */
def assoc_index_r(Assoc,Value) {
    N=length(Assoc);
    L=[];
    for(I=0; I<N; I++) {
        if (Value==Assoc[I][1]) {
            L=cons(I,L);
        }
    }
    return reverse(L); /* no match */
}

/* Output the set of the keys of associated list. */
def assoc_keyset(Assoc) {
    return map('car',Assoc);
}

/* Output the set of the values of associated list. */
def assoc_valset(Assoc) {
    return map('car',map('cdr',Assoc));
}

def assoc_match(Assoc,Key) {
    I=assoc_index(Assoc,Key | option_list=getopt());
    if (I<0) {
        error(sprintf("no match for key %a", Key));
    }
    K=(getopt(key)==value)? 0: 1;
    return Assoc[I][K];
}

def extern_get(Key) {
    return oh_base.assoc_match(Extern,Key);
}

def extern_set(Key,Val) {
    I=oh_base.assoc_index(Extern,Key);
	printf("oh_base.extern_set(%a,%a)(I=%a)\n",Key,type(Val),I);
    if(I>=0) {
        Extern=ltov(Extern);
        Extern[I] = [Key,Val];
        Extern=vtol(Extern);
    }else {
        Extern=cons([Key,Val],Extern);
    }
}

// The function has similar behaivior to UNIX uniq command
def uniq(L) {
    N=length(L);
    if(N==0) return L;
    if(type(L)==5) L=vtol(L);
    Prev=car(L); R=[Prev];
    for(L=cdr(L); L!=[]; L=cdr(L)) {
        D=car(L);
        if(Prev!=D) {
            R=cons(D,R);
            Prev=D;
        }
    }
    return reverse(R);
}

// Saving and Restoring the result of the invoked function
def callS(Func, Args, File) {
    if (access(File)) {
        printf("Loading %a\n", File);
        R=bload(File);
    }else {
        R=call(Func,Args);
        bsave(R, File);
    }
    return R;
}

endmodule;

end;