version 1.9, 2004/12/17 03:09:08 |
version 1.11, 2005/09/27 03:00:21 |
|
|
* DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, |
* DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, |
* PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. |
* PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. |
* |
* |
* $OpenXM: OpenXM_contrib2/asir2000/builtin/pf.c,v 1.8 2004/06/27 03:15:57 noro Exp $ |
* $OpenXM: OpenXM_contrib2/asir2000/builtin/pf.c,v 1.10 2005/09/08 08:37:02 noro Exp $ |
*/ |
*/ |
#include "ca.h" |
#include "ca.h" |
#include "math.h" |
#include "math.h" |
Line 63 void make_tri(void); |
|
Line 63 void make_tri(void); |
|
void make_exp(void); |
void make_exp(void); |
void simplify_pow(PFINS,Obj *); |
void simplify_pow(PFINS,Obj *); |
|
|
void Pfunctor(),Pargs(),Pfunargs(),Pvtype(),Pcall(),Pdeval(); |
void Pfunctor(),Pargs(),Pfunargs(),Pvtype(),Pcall(),Pdeval(),Pfunargs_ext(); |
void Pregister_handler(); |
void Pregister_handler(); |
void Peval_quote(); |
void Peval_quote(); |
void Pmapat(); |
void Pmapat(); |
Line 76 struct ftab puref_tab[] = { |
|
Line 76 struct ftab puref_tab[] = { |
|
{"functor",Pfunctor,1}, |
{"functor",Pfunctor,1}, |
{"args",Pargs,1}, |
{"args",Pargs,1}, |
{"funargs",Pfunargs,1}, |
{"funargs",Pfunargs,1}, |
|
{"funargs_ext",Pfunargs_ext,1}, |
{"register_handler",Pregister_handler,1}, |
{"register_handler",Pregister_handler,1}, |
{"add_handler",Padd_handler,2}, |
{"add_handler",Padd_handler,2}, |
{"list_handler",Plist_handler,1}, |
{"list_handler",Plist_handler,1}, |
Line 83 struct ftab puref_tab[] = { |
|
Line 84 struct ftab puref_tab[] = { |
|
{"call",Pcall,2}, |
{"call",Pcall,2}, |
{"vtype",Pvtype,1}, |
{"vtype",Pvtype,1}, |
{"deval",Pdeval,1}, |
{"deval",Pdeval,1}, |
{"eval_quote",Peval_quote,1}, |
{"eval_quote",Peval_quote,-2}, |
{0,0,0}, |
{0,0,0}, |
}; |
}; |
|
|
|
|
} |
} |
|
|
#define ISPFINS(p)\ |
#define ISPFINS(p)\ |
(p)&&(ID(p) == O_P)&&((int)VR((P)p)->attr!=V_PF)&&\ |
((p)&&(ID(p) == O_P)&&((int)VR((P)p)->attr==V_PF)&&\ |
UNIQ(DEG(DC((P)p)))&&UNIQ(COEF(DC((P)p))) |
UNIQ(DEG(DC((P)p)))&&UNIQ(COEF(DC((P)p)))) |
|
|
void Pfunctor(arg,rp) |
void Pfunctor(arg,rp) |
NODE arg; |
NODE arg; |
|
|
} |
} |
} |
} |
|
|
|
void Pfunargs_ext(arg,rp) |
|
NODE arg; |
|
LIST *rp; |
|
{ |
|
P p; |
|
P f; |
|
FUNC t; |
|
PF pf; |
|
PFINS ins; |
|
PFAD ad; |
|
NODE n,n0,d,d0,a,a0; |
|
LIST alist,dlist; |
|
Q q; |
|
int i; |
|
|
|
p = (P)ARG0(arg); |
|
if ( !ISPFINS(p) ) |
|
*rp = 0; |
|
else { |
|
ins = (PFINS)VR(p)->priv; ad = ins->ad; pf = ins->pf; |
|
t = (FUNC)MALLOC(sizeof(struct oFUNC)); |
|
t->name = t->fullname = pf->name; t->id = A_PURE; t->argc = pf->argc; |
|
t->f.puref = pf; |
|
makesrvar(t,&f); |
|
|
|
d0 = a0 = 0; |
|
for ( i = 0; i < pf->argc; i++ ) { |
|
NEXTNODE(d0,d); STOQ(ad[i].d,q); BDY(d) = (pointer)q; |
|
NEXTNODE(a0,a); BDY(a) = (pointer)ad[i].arg; |
|
} |
|
NEXT(d) = 0; NEXT(a) = 0; MKLIST(alist,a0); MKLIST(dlist,d0); |
|
|
|
n0 = mknode(3,f,dlist,alist); |
|
MKLIST(*rp,n0); |
|
} |
|
} |
|
|
void Pvtype(arg,rp) |
void Pvtype(arg,rp) |
NODE arg; |
NODE arg; |
Q *rp; |
Q *rp; |
Line 627 void Peval_quote(arg,rp) |
|
Line 665 void Peval_quote(arg,rp) |
|
NODE arg; |
NODE arg; |
Obj *rp; |
Obj *rp; |
{ |
{ |
|
FNODE a; |
|
QUOTE q; |
|
|
asir_assert(ARG0(arg),O_QUOTE,"eval_quote"); |
asir_assert(ARG0(arg),O_QUOTE,"eval_quote"); |
*rp = eval((FNODE)BDY((QUOTE)ARG0(arg))); |
if ( argc(arg) == 2 && ARG1(arg) ) { |
|
a = partial_eval((FNODE)BDY((QUOTE)ARG0(arg))); |
|
MKQUOTE(q,a); |
|
*rp = (Obj)q; |
|
} else |
|
*rp = eval((FNODE)BDY((QUOTE)ARG0(arg))); |
} |
} |