int genelif(Error_printer *err, Frag *frag, Node * n, int v)
{
switch (n->what) {
case nEMPTY:
return 0;
case nIF: {
int els = genbra(err, frag, n->l, 1);
int rtval;
mklooplvl(frag, lvlSCOPE, 0, 0);
if (v)
gen(err, frag, n->r);
else
genn(err, frag, n->r);
rmlooplvl(frag, lvlSCOPE, 0, 0);
emitc(frag, iBRA);
rtval = emitn(frag, 0);
setlist(frag, els, frag->code);
return rtval;
} case nSEMI: {
if (n->r->what == nELSE && n->r->r->what == nIF) {
int z = genelif(err, frag, n->l, v);
if (!z)
error_2(err, "\"%s\" %d: else without if", n->r->loc->name, n->r->loc->line);
else
addlist(frag, z, genelif(err, frag, n->r->r, v));
return z;
}
}
}
if (v)
gen(err, frag, n);
else
genn(err, frag, n);
return 0;
}
void test_2_run(int level, Float& e1, Float& e2, Float& e3) {
const st dim = 2;
// new shape--------------------
Shape2D shape;
Shape2D cir;
//CreatCircle(cir, 2.1, 2.1, 0.8, 359);
Float x1 = -0.5, y1 = -0.5, x2 = 0.5, y2 = 0.5;
CreatCube(shape, x1, y1, x2, y2);
// define unit length
Float UL = 1.0;
// build grid ------------------
Domain_<Float, Float, dim> domain(&shape, UL, level, level + 1);
//domain.adaptive().adapt_shape_boundary(cir);
domain.build();
//domain.new_data(4,0,0,0); // idx = 3 used for exact
//domain.set_val(3,exact_fun_2);
Poisson_<Float, Float, dim> poisson(&domain);
poisson.set_beta(coe_set_b);
poisson.set_f(f_fun_2);
// set exact
domain.set_val(0, exact_fun_2);
// boundary condition
Poisson_<Float, Float, dim>::BoundaryCondition bc;
//bc.set_default_1_bc(exact_fun_2);
poisson.set_boundary_condition(0, 0, poisson.phi_idx(), &bc);
poisson.set_boundary_condition(0, 1, poisson.phi_idx(), &bc);
poisson.set_boundary_condition(0, 2, poisson.phi_idx(), &bc);
poisson.set_boundary_condition(0, 3, poisson.phi_idx(), &bc);
std::cout << "solve -----------\n";
poisson.solve();
cout << "end solve -------\n";
e1 = error_1(domain, 2, 0);
e2 = error_2(domain, 2, 0);
e3 = error_i(domain, 2, 0);
//cout << "error 1 " << e1 << "\n";
//cout << "error 2 " << e2 << "\n";
//cout << "error 3 " << e3 << "\n";
// show ================================
GnuplotActor::list_spActor lga;
lga.push_back(
GnuplotActor::LeafNodesContour(domain.grid(), poisson.phi_idx()));
lga.push_back(
GnuplotActor::GhostNodesContours(domain.ghost(),
poisson.phi_idx()));
lga.push_back(GnuplotActor::Shape(shape, 0));
Gnuplot gp;
gp.set_equal_ratio();
//gp.set_xrange(2.0,3.0);
//gp.set_yrange(1.5,2.5);
//gp.set_cbrange(-2.0, 2.0);
gp.plot(lga);
//delete shape
}
static int genla(Error_printer *err, Frag *frag, Node * n)
{
switch (n->what) {
case nEMPTY: {
return 0;
} case nSEMI: {
int result = genla(err, frag, n->r);
return result + genla(err, frag, n->l);
} case nNAM: {
return 1;
} case nSET: {
if (n->l->what == nNAM) {
genn(err, frag, n);
return 1;
}
}
}
error_2(err, "\"%s\" %d: incorrect local list", n->loc->name, n->loc->line);
return 0;
}
static void genn(Error_printer *err, Frag *frag, Node * n)
{
switch(n->what) {
case nPAREN: {
genn(err, frag, n->r);
break;
} case nQUOTE: {
error_2(err, "\"%s\" %d: `used incorrectly", n->loc->name, n->loc->line);
break;
} case nLABEL: {
frag->looplvls->name = strdup(n->s);
break;
} case nLOCAL: {
if (n->r->what == nSEMI && n->r->l->what == nPAREN) {
int amnt;
mklooplvl(frag, lvlSCOPE, 0, 0);
amnt = genll(err, frag, n->r->l->r);
push_lst(frag);
emitn(frag, amnt);
emitc(frag, iLOC);
fixlooplvl(frag, amnt + 1);
genla(err, frag, n->r->l->r);
genn(err, frag, n->r->r);
rmlooplvl(frag, lvlSCOPE, 0, 0);
} else if (n->r->what == nSEMI && last_is_paren(n->r)) {
// Handles with a b [f]
Node *r;
int amnt;
n->r = extract_last_is_paren(n->r, &r);
mklooplvl(frag, lvlSCOPE, 0, 0);
amnt = genll(err, frag, n->r);
push_lst(frag);
emitn(frag, amnt);
emitc(frag, iLOC);
fixlooplvl(frag, amnt + 1);
genla(err, frag, n->r);
genn(err, frag, r);
rmlooplvl(frag, lvlSCOPE, 0, 0);
} else {
int amnt = genll(err, frag, n->r); /* Create variables */
push_lst(frag);
emitn(frag, amnt);
emitc(frag, iLOC);
fixlooplvl(frag, amnt + 1);
genla(err, frag, n->r); /* Initialize them */
}
break;
} case nFOR: {
int top, cont;
Node *name;
Node *args = extract_loop_name(n->r, &name);
if (args->what != nSEMI) { /* One arg */
genn(err, frag, args); /* Initializer */
} else if (args->r->what != nSEMI) { /* Two args */
genn(err, frag, args->l); /* Initializer */
emitc(frag, iBRA);
emitn(frag, 0);
mklooplvl(frag, lvlLOOP, frag->code-sizeof(int), 0);
if (name)
frag->looplvls->name = strdup(name->r->s);
top = frag->code;
cont = frag->code;
setlist(frag,genbra(err, frag, args->r, 0), top); /* Test */
rmlooplvl(frag, lvlLOOP, cont, frag->code);
} else if (args->r->r->what != nSEMI) { /* Three args */
genn(err, frag, args->l); /* Initializer */
emitc(frag, iBRA);
emitn(frag, 0);
mklooplvl(frag, lvlLOOP, frag->code-sizeof(int), 0);
if (name)
frag->looplvls->name = strdup(name->r->s);
top = frag->code;
genn(err, frag, args->r->r); /* Increment */
cont = frag->code;
setlist(frag,genbra(err, frag, args->r->l, 0), top); /* Test */
rmlooplvl(frag, lvlLOOP, cont, frag->code);
} else { /* Four args */
genn(err, frag, args->l); /* Initializer */
emitc(frag, iBRA);
emitn(frag, 0);
mklooplvl(frag, lvlLOOP, frag->code-sizeof(int), 0);
if (name)
frag->looplvls->name = strdup(name->r->s);
top = frag->code;
mklooplvl(frag, lvlSCOPE, 0, 0);
genn(err, frag, args->r->r->r); /* Body */
rmlooplvl(frag, lvlSCOPE, 0, 0);
genn(err, frag, args->r->r->l); /* Increment */
cont = frag->code;
setlist(frag,genbra(err, frag, args->r->l, 0), top); /* Test */
rmlooplvl(frag, lvlLOOP, cont, frag->code);
}
break;
} case nFOREACH: case nFORINDEX: {
int top, cont;
Node *name;
Node *args = extract_loop_name(n->r, &name);
if (args->what != nSEMI) { /* One arg */
error_2(err,"\"%s\" %d: No args for foreach?", n->loc->name, n->loc->line);
} else if (args->r->what != nSEMI) { /* Two args */
error_2(err,"\"%s\" %d: Only two args for foreach?", n->loc->name, n->loc->line);
} else { /* Three args */
if (args->l->what != nNAM) {
error_2(err, "\"%s\" %d: First arg to foreach must be a variable", n->loc->name, n->loc->line);
}
mklooplvl(frag, lvlSCOPE, 0, 0); /* Scope for args */
gen(err, frag, args->l); /* Variable (check that it really is at runtime) */
gen(err, frag, args->r->l); /* Array/object */
push_num(frag);
emitl(frag, 0); /* Temp vars for iFOREACH */
push_num(frag);
emitl(frag, -1);
emitc(frag, iBRA);
emitn(frag, 0);
mklooplvl(frag, lvlLOOP, frag->code-sizeof(int), 0); /* Start loop */
if (name)
frag->looplvls->name = strdup(name->r->s);
top = frag->code;
mklooplvl(frag, lvlSCOPE, 0, 0); /* Scope for body */
genn(err, frag, args->r->r);
rmlooplvl(frag, lvlSCOPE, 0, 0); /* Body scope done */
cont = frag->code;
if (n->what == nFOREACH)
emitc(frag, iFOREACH);
else
emitc(frag, iFORINDEX);
align_frag(frag, sizeof(int));
emitn(frag, top - (frag->code));
rmlooplvl(frag, lvlLOOP, cont, frag->code); /* Complete loop */
emitc(frag, iPOP);
emitc(frag, iPOP);
emitc(frag, iPOP);
emitc(frag, iPOP);
fixlooplvl(frag, 4); /* POP temp vars */
rmlooplvl(frag, lvlSCOPE, 0, 0); /* POP args scope */
}
break;
} case nWHILE: {
int top, cont;
Node *name;
Node *args = extract_loop_name(n->r, &name);
if (args->what==nEMPTY) {
error_2(err,"\"%s\" %d: No args for while", n->loc->name, n->loc->line);
break;
}
emitc(frag, iBRA);
emitn(frag, 0);
mklooplvl(frag, lvlLOOP, frag->code-sizeof(int), 0);
if (name)
frag->looplvls->name = strdup(name->r->s);
top = frag->code;
mklooplvl(frag, lvlSCOPE, 0, 0);
if (args->what==nSEMI)
genn(err, frag, args->r);
rmlooplvl(frag, lvlSCOPE, 0, 0);
cont = frag->code;
if (args->what==nSEMI)
setlist(frag, genbra(err, frag, args->l, 0), top);
else
setlist(frag, genbra(err, frag, args, 0), top);
rmlooplvl(frag, lvlLOOP, cont, frag->code);
break;
} case nRETURN: {
int z;
if (n->r)
gen(err, frag, n->r);
else
push_void(frag);
emitc(frag, iSTASH);
rmlooplvl(frag, lvlVALUE, 0, 0);
poploops(frag, NULL);
emitc(frag, iBRA);
z = emitn(frag, 0);
if (frag->rtn)
addlist(frag, frag->rtn, z);
else
frag->rtn = z;
break;
} case nLOOP: {
int cont;
Node *name;
Node *args = extract_loop_name(n->r, &name);
cont = frag->code;
mklooplvl(frag, lvlLOOP, 0, 0);
if (name)
frag->looplvls->name = strdup(name->r->s);
mklooplvl(frag, lvlSCOPE, 0, 0);
genn(err, frag, args);
rmlooplvl(frag, lvlSCOPE, 0, 0);
emitc(frag, iBRA);
align_frag(frag, sizeof(int));
emitn(frag, cont - (frag->code));
rmlooplvl(frag, lvlLOOP, cont, frag->code);
break;
} case nBREAK: {
struct looplvl *ll = findlvl(frag, NULL);
if (n->r) {
// printf("looking... %s %p %p\n",n->r->s,frag,ll);
if (n->r->what == nNAM)
ll = findlvl(frag, n->r->s);
else if (n->r->what != nEMPTY)
error_2(err, "\"%s\" %d: Invalid argument to break", n->r->loc->name, n->r->loc->line);
}
if (ll) {
int z;
// printf("break %d %d\n", ll->scopelvl, frag->scopelvl);
poploops(frag, ll);
emitc(frag, iBRA);
z = emitn(frag, 0);
if (ll->brk)
addlist(frag, ll->brk, z);
else
ll->brk = z;
} else
error_2(err, "\"%s\" %d: break with no loop", n->loc->name, n->loc->line);
break;
} case nCONT: {
struct looplvl *ll = findlvl(frag, NULL);
if (n->r) {
if (n->r->what == nNAM)
ll = findlvl(frag, n->r->s);
else if (n->r->what != nEMPTY)
error_2(err, "\"%s\" %d: Invalid argument to continue", n->r->loc->name, n->r->loc->line);
}
if (ll) {
int z;
poploops(frag, ll);
emitc(frag, iBRA);
z = emitn(frag, 0);
if (ll->cont)
addlist(frag, ll->cont, z);
else
ll->cont = z;
} else
error_2(err, "\"%s\" %d: continue with no loop", n->loc->name, n->loc->line);
break;
} case nUNTIL: {
int els = genbra(err, frag, n->r, 1);
struct looplvl *ll = findlvl(frag, NULL);
if (ll) {
int z;
// printf("break %d %d\n", ll->scopelvl, frag->scopelvl);
poploops(frag, ll);
emitc(frag, iBRA);
z = emitn(frag, 0);
if (ll->brk)
addlist(frag, ll->brk, z);
else
ll->brk = z;
} else {
error_2(err, "\"%s\" %d: until with no loop", n->loc->name, n->loc->line);
}
setlist(frag, els, frag->code);
break;
} case nIF: {
gencond(err, frag, n->r, 0);
break;
} case nELSE: {
error_2(err, "\"%s\" %d: else with no if", n->loc->name, n->loc->line);
break;
} case nSEMI: {
if (n->r->what == nELSE) {
int done = genelif(err, frag, n->l, 0);
if (!done)
error_2(err, "\"%s\" %d: else with no if", n->r->loc->name, n->r->loc->line);
if (n->r->r->what == nIF) {
addlist(frag, done, genbra(err, frag, n->r->r->l, 1));
n = n->r;
}
mklooplvl(frag, lvlSCOPE, 0, 0);
genn(err, frag, n->r->r);
rmlooplvl(frag, lvlSCOPE, 0, 0);
setlist(frag, done, frag->code);
} else {
genn(err, frag, n->l);
genn(err, frag, n->r);
}
break;
} case nEMPTY: {
break;
} default: {
gen(err, frag, n);
emitc(frag, iPOP);
rmlooplvl(frag, lvlVALUE, 0, 0);
break;
}
}
}
static void gen(Error_printer *err, Frag *frag, Node * n)
{
switch(n->what) {
case nCOMMA: {
genn(err, frag, n->l), gen(err, frag, n->r);
break;
} case nPAREN: {
gen(err, frag, n->r);
break;
} case nLIST: {
int amnt = genl(err, frag, n->r);
push_lst(frag);
emitn(frag, amnt);
emitc(frag, iFIX);
fixlooplvl(frag, amnt);
break;
} case nVOID: {
push_void(frag);
break;
} case nTHIS: {
push_this(frag);
break;
} case nNUM: {
push_num(frag);
emitl(frag, n->n);
break;
} case nFP: {
push_fp(frag);
emitd(frag, n->fp);
break;
} case nSTR: {
push_str(frag);
emits(frag, n->s, n->n);
break;
} case nNAM: {
push_nam(frag);
emitp(frag, n->s);
emitc(frag, iGET_ATOM);
break;
} case nSET: {
gen(err, frag, n->r);
// gena(err, frag, n->l); (lvalue change)
gen(err, frag, n->l);
emitc(frag, iSET);
rmlooplvl(frag, lvlVALUE, 0, 0);
break;
} case nIF: {
gencond(err, frag, n->r, 1);
break;
} case nPOST: {
gen(err, frag, n->l);
gen(err, frag, n->r);
// gena(err, frag, n->l); (lvalue change)
gen(err, frag, n->l);
emitc(frag, iSET);
rmlooplvl(frag, lvlVALUE, 0, 0);
emitc(frag, iPOP);
rmlooplvl(frag, lvlVALUE, 0, 0);
break;
} case nADDR: {
/* Generate a code snippet */
genfunc(err, frag, consempty(n->loc), n->r);
break;
} case nDEFUN: {
if (n->r->what==nSEMI) {
if (n->r->l->what==nCALL && n->r->l->l->what==nNAM) { /* fn sq(x) x*x */
genfunc(err, frag, n->r->l->r, n->r->r);
push_nam(frag);
emitp(frag, n->r->l->l->s);
emitc(frag, iGETF_ATOM);
emitc(frag, iSET);
rmlooplvl(frag, lvlVALUE, 0, 0);
} else if (n->r->l->what==nNAM && n->r->r->what==nSEMI && n->r->r->l->what==nPAREN) { /* fn sq (x) x*x */
genfunc(err, frag, n->r->r->l, n->r->r->r);
push_nam(frag);
emitp(frag, n->r->l->s);
emitc(frag, iGETF_ATOM);
emitc(frag, iSET);
rmlooplvl(frag, lvlVALUE, 0, 0);
} else if (n->r->l->what==nNAM && n->r->r->what==nPAREN) { /* fn sq (x) */
genfunc(err, frag, n->r->r, consempty(n->loc));
push_nam(frag);
emitp(frag, n->r->l->s);
emitc(frag, iGETF_ATOM);
emitc(frag, iSET);
rmlooplvl(frag, lvlVALUE, 0, 0);
} else if (n->r->l->what==nPAREN) { /* fn (x) x*x */
genfunc(err, frag, n->r->l, n->r->r);
} else {
error_2(err, "\"%s\" %d: ill-formed fn", n->r->loc->name, n->r->loc->line);
push_void(frag);
}
} else if(n->r->what==nCALL && n->r->l->what==nNAM) { /* fn sq(x) */
genfunc(err, frag, n->r->r, consempty(n->loc));
push_nam(frag);
emitp(frag, n->r->l->s);
emitc(frag, iGETF_ATOM);
emitc(frag, iSET);
rmlooplvl(frag, lvlVALUE, 0, 0);
} else if(n->r->what==nPAREN) { /* fn () */
genfunc(err,frag, n->r, consempty(n->loc));
} else {
error_2(err, "\"%s\" %d: ill-formed fn", n->r->loc->name, n->r->loc->line);
push_void(frag);
}
break;
} case nLAMBDA: {
genfunc(err, frag, n->r->l, n->r->r);
break;
} case nSEMI: {
if (n->r->what == nELSE) {
int done = genelif(err, frag, n->l, 1);
if (!done)
error_2(err, "\"%s\" %d: else w/o if error", n->r->loc->name, n->r->loc->line);
if (n->r->r->what == nIF) {
addlist(frag, done, genbra(err, frag, n->r->r->l, 1));
n = n->r;
}
mklooplvl(frag, lvlSCOPE, 0, 0);
gen(err, frag, n->r->r);
rmlooplvl(frag, lvlSCOPE, 0, 0);
setlist(frag, done, frag->code);
} else {
genn(err, frag, n->l);
gen(err, frag, n->r);
}
break;
} case nEQ: case nNE: case nGT: case nLT: case nGE: case nLE: case nLAND: case nLOR: case nNOT: {
int b = genbra(err, frag, n, 1);
int link;
push_num(frag);
emitl(frag, 1);
emitc(frag, iBRA);
link=emitn(frag, 0);
setlist(frag, b, frag->code);
push_num(frag);
emitl(frag, 0);
*(int *)(frag->begcode+link)=frag->code-link;
break;
} case nCALL: {
// int nargs = genl(err, frag, n->r); /* By value */
int nargs = gencl(err, frag, n->r); /* Functionalize */
push_lst(frag);
emitn(frag, nargs);
// gena(err, frag, n->l); (lvalue change)
gen(err, frag, n->l);
emitc(frag, iCALL);
fixlooplvl(frag, nargs + 1);
break;
} case nCALL1: { /* Ends up being the same as above */
// if (n->r->what != nNAM)
// error_2(err, "\"%s\" %d: Invalid member name", n->r->loc->name, n->r->loc->line);
if (n->r->what == nNAM) { /* Turn it into a string .x -> ."x" */
n->r->what = nSTR;
}
int nargs = gencl(err, frag, n->r);
// push_str(frag);
// emits(frag, n->r->s, n->r->n);
push_lst(frag);
emitn(frag, nargs);
// gena(err, frag, n->l); (lvalue change)
gen(err, frag, n->l);
emitc(frag, iCALL);
fixlooplvl(frag, nargs + 1);
break;
} case nCOM: case nNEG: case nSHL: case nSHR: case nMUL: case nDIV: case nMOD: case nAND:
case nADD: case nSUB: case nOR: case nXOR: case nAT: {
if (n->l)
gen(err, frag, n->l);
if (n->r)
gen(err, frag, n->r);
emitc(frag, what_tab[n->what].i);
if (n->r && n->l)
rmlooplvl(frag, lvlVALUE, 0, 0);
break;
} default: {
genn(err, frag, n);
push_void(frag);
}
}
}
