Ejemplo n.º 1
0
Archivo: eval.c Proyecto: ingramj/bs
object *bs_eval(object *exp, object *env)
{
tailcall:
    if (is_empty_list(exp)) {
        error("unable to evaluate empty list");
    } else if (is_self_evaluating(exp)) {
        return exp;
    } else if (is_variable(exp)) {
        return lookup_variable_value(exp, env);
    } else if (is_quoted(exp)) {
        return quoted_expression(exp);
    } else if (is_assignment(exp)) {
        return eval_assignment(exp, env);
    } else if (is_definition(exp)) {
        return eval_definition(exp, env);
    } else if (is_if(exp)) {
        if (is_true(bs_eval(if_predicate(exp), env))) {
            exp = if_consequent(exp);
        } else {
            exp = if_alternate(exp);
        }
        goto tailcall;
    } else if (is_lambda(exp)) {
        return make_compound_proc(lambda_parameters(exp),
                lambda_body(exp),
                env);
    } else if (is_begin(exp)) {
        exp = begin_actions(exp);
        if (is_empty_list(exp)) {
            error("empty begin block");
        }
        while (!is_empty_list(cdr(exp))) {
            bs_eval(car(exp), env);
            exp = cdr(exp);
        }
        exp = car(exp);
        goto tailcall;
    } else if (is_cond(exp)) {
        exp = cond_to_if(exp);
        goto tailcall;
    } else if (is_let(exp)) {
        exp = let_to_application(exp);
        goto tailcall;
    } else if (is_and(exp)) {
        exp = and_tests(exp);
        if (is_empty_list(exp)) {
            return get_boolean(1);
        }
        object *result;
        while (!is_empty_list(cdr(exp))) {
            result = bs_eval(car(exp), env);
            if (is_false(result)) {
                return result;
            }
            exp = cdr(exp);
        }
        exp = car(exp);
        goto tailcall;
    } else if (is_or(exp)) {
        exp = or_tests(exp);
        if (is_empty_list(exp)) {
            return get_boolean(0);
        }
        object *result;
        while (!is_empty_list(cdr(exp))) {
            result = bs_eval(car(exp), env);
            if (is_true(result)) {
                return result;
            }
            exp = cdr(exp);
        }
        exp = car(exp);
        goto tailcall;
    } else if (is_application(exp)) {
        object *procedure = bs_eval(application_operator(exp), env);
        object *parameters = eval_parameters(application_operands(exp), env);

        // handle eval specially for tailcall requirement.
        if (is_primitive_proc(procedure) &&
                procedure->value.primitive_proc == eval_proc) {
            exp = eval_expression(parameters);
            env = eval_environment(parameters);
            goto tailcall;
        }

        // handle apply specially for tailcall requirement.
        if (is_primitive_proc(procedure) &&
                procedure->value.primitive_proc == apply_proc) {
            procedure = apply_operator(parameters);
            parameters = apply_operands(parameters);
        }

        if (is_primitive_proc(procedure)) {
            return (procedure->value.primitive_proc)(parameters);
        } else if (is_compound_proc(procedure)) {
            env = extend_environment(
                    procedure->value.compound_proc.parameters,
                    parameters,
                    procedure->value.compound_proc.env);
            exp = make_begin(procedure->value.compound_proc.body);
            goto tailcall;
        } else {
            error("unable to apply unknown procedure type");
        }
    } else {
        error("unable to evaluate expression");
    }
}
Ejemplo n.º 2
0
void assignmentValue(Register result, Register exp)
{
    cdr(result, exp);
    cdr(result, result);
    car(result, result);
}
Ejemplo n.º 3
0
void main()
{
int gd=VGA,gm=VGAHI,errorcode,area,i,j,play=1,rndplay,rac,r,ch,chh,n=1,speed=151,sp=1,si=1,carx,cary,gear=0,aspeed,booster=100,drumx,drumy,drumv,drumx1,drumy1,spp,coin=200;
int life_=10;
int fire=20;
char info[4];
int soun;
char *buff;
char *fir;
char *boost;
int mouse=23;
int x,y,button;


char *tyre1;
float feul=100;
char *car1buf;
char *pcar4buf;
char *fcar5buf;

int recsize;
FILE *fp;
struct record
{
int coins;
int lifes;
float feuls;
int speeds;
int boosters;
int gear_;
int fire_;
}rec;

recsize=sizeof(rec);

initgraph(&gd,&gm,"c:\bagger");
errorcode = graphresult();
if (errorcode != grOk)
{
   printf("Graphics error: %s\n", grapherrormsg(errorcode));
   printf("Press any key to halt:");
   getch();

   exit(1);
}
fp=fopen("c:\\rruunn.r4l","r");
fread(&rec,recsize,1,fp);
coin=rec.coins;
feul=rec.feuls;
speed=rec.speeds;
booster=rec.boosters;
gear=rec.gear_;
fire=rec.fire_;
life_=rec.lifes;
fclose(fp);
remove("c:\\rruunn.r4l");

if(coin>0 && feul>0 && life_>0)
{

//geting car's image*****************************************

  setcolor(RED);
  settextstyle(8,1,4);
  outtextxy(100,100+60,"You have :  ");

  car(125,75);
  area=imagesize(85,15,165,405);
  buff=malloc(area);
  getimage(85,15,165,405,buff);
  putimage(85,15,buff,XOR_PUT);




setcolor(8);
setfillstyle(1,8);
bar((getmaxx()/2)-130,0,(getmaxx()/2)+130,getmaxy());
roadstru();
basicstructure1();
sean1();
gears(5);
speedgrp(151-speed);
feulgrp(100);
coingrp(200);
boostergrp(100);
firee(20);
lifee(10);
car(250,400);
setcolor(WHITE);
setfillstyle(1,WHITE);
for(i=-2000;i<+25000;i+=100)
bar((getmaxx()/2)-5,i,(getmaxx()/2)+5,i+80);

delay(1000);

setcolor(getbkcolor());
setfillstyle(1,getbkcolor());
for(i=1;i<320;i++)
{
bar(getmaxx()/2,0,(getmaxx()/2)-i,getmaxy());
bar(getmaxx()/2,0,(getmaxx()/2)+i,getmaxy());
delay(5);
}

delay(1000);



setcolor(YELLOW);
settextstyle(7,0,15);
outtextxy(100-20,100,"R");

settextstyle(7,0,15);
outtextxy(495-20,100,"E");

setcolor(LIGHTBLUE);
settextstyle(7,0,7);
outtextxy(198-20,130,"UN   LIF");

setcolor(BLUE);
setlinestyle(0,0,3);
line(275,155,385,155);
line(275-2,160,385-2,160);
line(275-4,165,385-4,165);
line(275-6,170,385-6,170);
line(275-8,175,385-8,175);
line(275-9,180,385-9,180);
line(275-10,185,385-10,185);
line(275-12,190,385-12,190);

setcolor(YELLOW);
settextstyle(10,0,7);
outtextxy(295,95,"4");


setcolor(LIGHTBLUE);
for(i=1;i<=465;i++)
{
line(80,228,80+i,228);
delay(5);
}
for(i=1;i<20;i++)
{
line(80,228+i,545,228+i);
delay(7);
}
delay(500);
setcolor(LIGHTRED);
settextstyle(8,0,5);
setusercharsize(2,1,1,2);
textdisp1(80,225,"Run For Life",RED,LIGHTRED);

setcolor(LIGHTRED);
settextstyle(8,0,6);
setusercharsize(2,1,1,1);
textdisp1(80,325,"Stage Clear !!!",LIGHTBLUE,BLUE);

delay(2000);
setcolor(getbkcolor());
setfillstyle(1,getbkcolor());
for(i=1;i<=getmaxx();i++)
{
bar(0,0,0+i,getmaxy());
delay(5);
}



for(i=1;i<450;i+=10)
{
putimage(50,getmaxy()-i,buff,XOR_PUT);
delay(5);
putimage(50,getmaxy()-i,buff,XOR_PUT);
}
putimage(50,getmaxy()-450,buff,XOR_PUT);

	setcolor(YELLOW);
	settextstyle(8,0,2);
	outtextxy(200,200,"Coin left : ");
	outtextxy(220,240,"Life left : ");
	outtextxy(200,280,"Fuel left : ");
	outtextxy(220,320,"Booster left : ");
	outtextxy(200,360,"Fire left : ");

	for(i=1;i<=coin;i++)
	{
	setcolor(getbkcolor());
	setfillstyle(1,getbkcolor());
	bar(350,200,400,250);
	setcolor(YELLOW);
	sprintf(info,"%d",i);
	outtextxy(350,200,info);
	sound(500);
	delay(50);
	nosound();
	}
	for(i=1;i<=life_;i++)
	{
	setcolor(getbkcolor());
	setfillstyle(1,getbkcolor());
	bar(400,240,450,290);
	setcolor(YELLOW);
	sprintf(info,"%d",i);
	outtextxy(400,240,info);
	sound(400);
	delay(50);
	nosound();
	}
	for(i=1;i<=feul;i++)
	{
	setcolor(getbkcolor());
	setfillstyle(1,getbkcolor());
	bar(350,280,400,330);
	setcolor(YELLOW);
	sprintf(info,"%d",i);
	outtextxy(350,280,info);
	sound(500);
	delay(50);
	nosound();
	}
	for(i=1;i<=booster;i++)
	{
	setcolor(getbkcolor());
	setfillstyle(1,getbkcolor());
	bar(400,320,450,370);
	setcolor(YELLOW);
	sprintf(info,"%d",i);
	outtextxy(400,320,info);
	sound(400);
	delay(50);
	nosound();
	}
	for(i=1;i<=fire;i++)
	{
	setcolor(getbkcolor());
	setfillstyle(1,getbkcolor());
	bar(350,360,400,410);
	setcolor(YELLOW);
	sprintf(info,"%d",i);
	outtextxy(350,360,info);
	sound(500);
	delay(50);
	nosound();
	}
	setcolor(LIGHTBLUE);
	setfillstyle(1,LIGHTBLUE);
	for(i=1;i<400;i++)
	{
	bar(200,50,200+i,150);
	delay(2);
	}
	setcolor(YELLOW);
	rectangle(200,50,600,150);
	setcolor(LIGHTRED);
	rectangle(200+5,50+5,600-5,150-5);
	setcolor(RED);
	settextstyle(3,0,3);
	textdisp(220,60,"Do u accept the next challange");
	setcolor(LIGHTRED);
	rectangle(215,110,400,135);
	rectangle(410,110,585,135);
	setcolor(RED);
	rectangle(215+2,110+2,400-2,135-2);
	rectangle(410+2,110+2,585-2,135-2);
	settextstyle(8,0,1);
	outtextxy(235,106,"Yes, I accept !!!");
	outtextxy(435,106,"No, I Quit");

	change(c);
	show();

	while(mouse==23)
	{
	show();
	moupos(&button,&x,&y);
	if((button & 1)==1)
	{
	if(x>410 && x<585 && y>110 && y<135)
	{
	setcolor(getbkcolor());
	setfillstyle(1,getbkcolor());
	for(i=1;i<=getmaxx();i++)
	{
	bar(0,0,0+i,getmaxy());
	delay(5);
	}
	hide();
	//one step here
	setcolor(RED);
	settextstyle(4,0,8);
	outtextxy(180,200,"Looser !!!");
	coin=0;
	feul=0;
	speed=0;
	booster=0;
	gear=0;
	fire=0;
	life_=0;
	mouse=0;
	delay(1000);
	//************************************************************************
setfillstyle(8,WHITE);            //background color and style
bar(1,1,getmaxx(),getmaxy());

setfillstyle(7,YELLOW);      //bagger plate
bar(150,5,500,55);

setcolor(BLUE);
for(i=1;i<=5;i++)
{                          //border of bagger plate
setfillstyle(1,BLUE);
rectangle(150-i,5-i,500+i,55+i);
}

settextstyle(1,0,5);
setcolor(WHITE);          // the bagger writen
outtextxy(200,3,"Run 4 Life");


setcolor(WHITE);          //work place designed
setfillstyle(1,WHITE);
bar(100,100,550,350);


setcolor(BLUE);
for(i=1;i<=5;i++)
{                           //work place border
rectangle(100-i,100-i,550+i,350+i);
}


setcolor(getbkcolor());                 //man's face
ellipse(300,190,0,360,35,40);

setfillstyle(1,getbkcolor());        //man's hat
for(i=1;i<=33;i++)
{
arc(300,172,0,180,i);
}


for(i=1;i<=12;i+=2)
{
 setlinestyle(0,0,0);                    //his hair
 arc(322-i,195,150,200,50);
}
for(i=1;i<=10;i+=5)                    //his hair
{
 setlinestyle(0,0,3);
 arc(322-i,195,150,200,50);
}


for(i=1;i<=12;i+=2)
{
 setlinestyle(0,0,0);                    //his hair
 arc(277+i,195,338,30,50);
}
for(i=1;i<=10;i+=5)                    //his hair
{
 setlinestyle(0,0,3);
  arc(277+i,195,338,30,50);
}

fillellipse(285,185,18,10);   //his eye masks
fillellipse(315,185,18,10);

setcolor(WHITE);           //his eye
setfillstyle(1,WHITE);
fillellipse(285,185,5,1);
fillellipse(315,185,5,1);

setcolor(getbkcolor());
setfillstyle(1,getbkcolor());
fillellipse(285,185,1,1);    //his eye ball
fillellipse(315,185,1,1);

 setlinestyle(0,0,0);   //his nose
line(295,192,292,205);
line(302,192,304,205);
line(292,205,304,205);

for(i=1;i<6;i+=1)             //his mooch
arc(300,232,60,120,20+i);

 setlinestyle(0,0,3);
line(288,210,280,225);       //his mooch
line(311,210,318,225);

setlinestyle(0,0,0);
arc(300,205,230,310,12);     //his mouth
arc(300,227,60,120,13);

setlinestyle(0,0,3);
for(i=1;i<=10;i+=4)         //his dadhi
line(295+i,220,295+i,230);



setlinestyle(0,0,0);
line(285,227,285,240);  //his neck
line(315,227,315,240);

setlinestyle(0,0,3);
line(285,240,235,249);    //his  coat base and right hand
line(315,240,342,249);
line(230,255,250,320);
arc(237,255,90,180,6);
line(250,320,340,310);
line(270,270,275,290);
line(275,290,330,285);
setlinestyle(0,0,3);
line(330,285,340,310);
line(325,285,335,310);
setlinestyle(0,0,0);


setlinestyle(0,0,0);
arc(340,330,70,100,40);
arc(340,335,70,90,40);
arc(340,340,70,90,40);     //his finger
arc(340,345,70,90,40);
arc(340,350,70,90,40);
arc(315,305,350,20,40);
setlinestyle(0,0,3);

line(342,200,342,290);
line(365,200,350,290);
arc(355,232,71,110,35); //his stick
line(342,310,340,320);
line(347,310,349,320);
line(340,320,349,320);

line(285,240,320,250);//his left hand
line(315,240,305,245);
line(320,250,323,285);
circle(310,260,2);
circle(311,270,2);
circle(312,280,2);
line(356,252,360,253);
line(360,253,365,328);
line(330,270,333,290);
line(365,328,280,318);


setcolor(getbkcolor());
setlinestyle(0,0,3);
delay(1000);
for(j=1;j<=250;j++)
{
for(i=1;i<450;i+=30)
{
line(100+i,100,100+i,100+j);
line(103+i,100,103+i,100+j);
}
delay(5);
}
delay(1000);
setcolor(BLUE);
settextstyle(10,0,3);
outtextxy(200,200,"Arrested");
rectangle(190,210,390,250);
delay(1500);
setcolor(getbkcolor());
setlinestyle(0,0,3);
for(i=1;i<=450;i++)
{
line(100,220,100+i,220);
delay(5);
}
for(i=1;i<120;i++)
{
line(100,220-i,550,220-i);
line(100,220+i,550,220+i);
delay(20);
}
setcolor(getbkcolor());
setfillstyle(1,getbkcolor());
bar(100,340,550,350);
settextstyle(8,0,5);
setcolor(RED);
textdisp(150,200,"You Loose");

delay(1000);
setcolor(getbkcolor());
setfillstyle(1,getbkcolor());
for(i=1;i<350;i++)
{
bar(getmaxx()/2,0,(getmaxx()/2)-i,getmaxy());
bar(getmaxx()/2,0,(getmaxx()/2)+i,getmaxy());
delay(5);
}
	//**************************************************************************
	}
	else if(x>215 && x<400 && y>110 && y<135)
	{
	setcolor(getbkcolor());
	setfillstyle(1,getbkcolor());
	for(i=1;i<=getmaxx();i++)
	{
	bar(0,0,0+i,getmaxy());
	delay(5);
	}
	hide();
	setcolor(LIGHTGREEN);
	settextstyle(4,0,8);
	outtextxy(180,200,"Bravo !!!");
	mouse=0;
	}
	}
	}

}
//*********************************************************************************************
rec.coins=coin;
rec.feuls=feul;
rec.speeds=speed;
rec.gear_=gear;
rec.lifes=life_;
rec.fire_=fire;
rec.boosters=booster;
fp=fopen("c:\\rruunn.r4l","w");
fwrite(&rec,recsize,1,fp);
fclose(fp);
//closegraph();
delay(1500);
}
Ejemplo n.º 4
0
void firstOperand(Register result, Register ops)
{
    car(result, ops);
}
Ejemplo n.º 5
0
void procedureBody(Register result, Register procedure)
{
    cdr(result, procedure);
    cdr(result, result);
    car(result, result);
}
Ejemplo n.º 6
0
void ifPredicate(Register result, Register exp)
{
    cdr(result, exp);
    car(result, result);
}
Ejemplo n.º 7
0
void firstExp(Register result, Register exp)
{
    car(result, exp);
}
Ejemplo n.º 8
0
// (as 'any1 . any2) -> any2 | NIL
any doAs(any x) {
   x = cdr(x);
   if (isNil(EVAL(car(x))))
      return Nil;
   return cdr(x);
}
Ejemplo n.º 9
0
// (lit 'any) -> any
any doLit(any x) {
   x = cadr(x);
   if (isNum(x = EVAL(x)) || isNil(x) || x == T || isCell(x) && isNum(car(x)))
      return x;
   return cons(Quote, x);
}
Ejemplo n.º 10
0
/* Evaluate method invocation */
static any evMethod(any o, any expr, any x) {
   any y = car(expr);
   any cls = TheCls, key = TheKey;
   struct {  // bindFrame
      struct bindFrame *link;
      int i, cnt;
      struct {any sym; any val;} bnd[length(y)+3];
   } f;

   f.link = Env.bind,  Env.bind = (bindFrame*)&f;
   f.i = sizeof(f.bnd) / (2*sizeof(any)) - 2;
   f.cnt = 1,  f.bnd[0].sym = At,  f.bnd[0].val = val(At);
   while (isCell(y)) {
      f.bnd[f.cnt].sym = car(y);
      f.bnd[f.cnt].val = EVAL(car(x));
      ++f.cnt, x = cdr(x), y = cdr(y);
   }
   if (isNil(y)) {
      while (--f.i > 0) {
         x = val(f.bnd[f.i].sym);
         val(f.bnd[f.i].sym) = f.bnd[f.i].val;
         f.bnd[f.i].val = x;
      }
      f.bnd[f.cnt].sym = This,  f.bnd[f.cnt++].val = val(This),  val(This) = o;
      y = cls,  cls = Env.cls;  Env.cls = y;
      y = key,  key = Env.key;  Env.key = y;
      x = prog(cdr(expr));
   }
   else if (y != At) {
      f.bnd[f.cnt].sym = y,  f.bnd[f.cnt++].val = val(y),  val(y) = x;
      while (--f.i > 0) {
         x = val(f.bnd[f.i].sym);
         val(f.bnd[f.i].sym) = f.bnd[f.i].val;
         f.bnd[f.i].val = x;
      }
      f.bnd[f.cnt].sym = This,  f.bnd[f.cnt++].val = val(This),  val(This) = o;
      y = cls,  cls = Env.cls;  Env.cls = y;
      y = key,  key = Env.key;  Env.key = y;
      x = prog(cdr(expr));
   }
   else {
      int n, cnt;
      cell *arg;
      cell c[n = cnt = length(x)];

      while (--n >= 0)
         Push(c[n], EVAL(car(x))),  x = cdr(x);
      while (--f.i > 0) {
         x = val(f.bnd[f.i].sym);
         val(f.bnd[f.i].sym) = f.bnd[f.i].val;
         f.bnd[f.i].val = x;
      }
      n = Env.next,  Env.next = cnt;
      arg = Env.arg,  Env.arg = c;
      f.bnd[f.cnt].sym = This,  f.bnd[f.cnt++].val = val(This),  val(This) = o;
      y = cls,  cls = Env.cls;  Env.cls = y;
      y = key,  key = Env.key;  Env.key = y;
      x = prog(cdr(expr));
      if (cnt)
         drop(c[cnt-1]);
      Env.arg = arg,  Env.next = n;
   }
   while (--f.cnt >= 0)
      val(f.bnd[f.cnt].sym) = f.bnd[f.cnt].val;
   Env.bind = f.link;
   Env.cls = cls,  Env.key = key;
   return x;
}
Ejemplo n.º 11
0
// (box 'any) -> sym
any doBox(any x) {
   x = cdr(x);
   return consSym(EVAL(car(x)), Nil);
}
Ejemplo n.º 12
0
// (for sym 'num ['any | (NIL 'any . prg) | (T 'any . prg) ..]) -> any
// (for sym|(sym2 . sym) 'lst ['any | (NIL 'any . prg) | (T 'any . prg) ..]) -> any
// (for (sym|(sym2 . sym) 'any1 'any2 [. prg]) ['any | (NIL 'any . prg) | (T 'any . prg) ..]) -> any
any doFor(any x) {
   any y, body, cond, a;
   cell c1;
   struct {  // bindFrame
      struct bindFrame *link;
      int i, cnt;
      struct {any sym; any val;} bnd[2];
   } f;

   f.link = Env.bind,  Env.bind = (bindFrame*)&f;
   f.i = 0;
   if (!isCell(y = car(x = cdr(x))) || !isCell(cdr(y))) {
      if (!isCell(y)) {
         f.cnt = 1;
         f.bnd[0].sym = y;
         f.bnd[0].val = val(y);
      }
      else {
         f.cnt = 2;
         f.bnd[0].sym = cdr(y);
         f.bnd[0].val = val(cdr(y));
         f.bnd[1].sym = car(y);
         f.bnd[1].val = val(car(y));
         val(f.bnd[1].sym) = Zero;
      }
      y = Nil;
      x = cdr(x),  Push(c1, EVAL(car(x)));
      if (isNum(data(c1)))
         val(f.bnd[0].sym) = Zero;
      body = x = cdr(x);
      for (;;) {
         if (isNum(data(c1))) {
            val(f.bnd[0].sym) = bigCopy(val(f.bnd[0].sym));
            digAdd(val(f.bnd[0].sym), 2);
            if (bigCompare(val(f.bnd[0].sym), data(c1)) > 0)
               break;
         }
         else {
            if (!isCell(data(c1)))
               break;
            val(f.bnd[0].sym) = car(data(c1));
            if (!isCell(data(c1) = cdr(data(c1))))
               data(c1) = Nil;
         }
         if (f.cnt == 2) {
            val(f.bnd[1].sym) = bigCopy(val(f.bnd[1].sym));
            digAdd(val(f.bnd[1].sym), 2);
         }
         do {
            if (!isNum(y = car(x))) {
               if (isSym(y))
                  y = val(y);
               else if (isNil(car(y))) {
                  y = cdr(y);
                  if (isNil(a = EVAL(car(y)))) {
                     y = prog(cdr(y));
                     goto for1;
                  }
                  val(At) = a;
                  y = Nil;
               }
               else if (car(y) == T) {
                  y = cdr(y);
                  if (!isNil(a = EVAL(car(y)))) {
                     val(At) = a;
                     y = prog(cdr(y));
                     goto for1;
                  }
                  y = Nil;
               }
               else
                  y = evList(y);
            }
         } while (isCell(x = cdr(x)));
         x = body;
      }
   for1:
      drop(c1);
      if (f.cnt == 2)
         val(f.bnd[1].sym) = f.bnd[1].val;
      val(f.bnd[0].sym) = f.bnd[0].val;
      Env.bind = f.link;
      return y;
   }
   if (!isCell(car(y))) {
      f.cnt = 1;
      f.bnd[0].sym = car(y);
      f.bnd[0].val = val(car(y));
   }
   else {
      f.cnt = 2;
      f.bnd[0].sym = cdar(y);
      f.bnd[0].val = val(cdar(y));
      f.bnd[1].sym = caar(y);
      f.bnd[1].val = val(caar(y));
      val(f.bnd[1].sym) = Zero;
   }
   y = cdr(y);
   val(f.bnd[0].sym) = EVAL(car(y));
   y = cdr(y),  cond = car(y),  y = cdr(y);
   Push(c1,Nil);
   body = x = cdr(x);
   while (!isNil(a = EVAL(cond))) {
      val(At) = a;
      if (f.cnt == 2) {
         val(f.bnd[1].sym) = bigCopy(val(f.bnd[1].sym));
         digAdd(val(f.bnd[1].sym), 2);
      }
      do {
         if (!isNum(data(c1) = car(x))) {
            if (isSym(data(c1)))
               data(c1) = val(data(c1));
            else if (isNil(car(data(c1)))) {
               data(c1) = cdr(data(c1));
               if (isNil(a = EVAL(car(data(c1))))) {
                  data(c1) = prog(cdr(data(c1)));
                  goto for2;
               }
               val(At) = a;
               data(c1) = Nil;
            }
            else if (car(data(c1)) == T) {
               data(c1) = cdr(data(c1));
               if (!isNil(a = EVAL(car(data(c1))))) {
                  val(At) = a;
                  data(c1) = prog(cdr(data(c1)));
                  goto for2;
               }
               data(c1) = Nil;
            }
            else
               data(c1) = evList(data(c1));
         }
      } while (isCell(x = cdr(x)));
      if (isCell(y))
         val(f.bnd[0].sym) = prog(y);
      x = body;
   }
for2:
   if (f.cnt == 2)
      val(f.bnd[1].sym) = f.bnd[1].val;
   val(f.bnd[0].sym) = f.bnd[0].val;
   Env.bind = f.link;
   return Pop(c1);
}
Ejemplo n.º 13
0
sExpression *eval(sExpression *exp, sEnvironment *env){
  /* ------------------atom-----------------------*/
  /* 1, 10, false, null, "abc" */
  if(isSelfEval(exp))
  {
    return exp;
  }
  /* a symbol */
  else if(isVariable(exp, env))
  {
    return lookupVariable(toSymb(exp), env);
  }
  /* ------------------list-----------------------*/
  /* (quote blur blur) */
  else if(isQuoted(exp))
  {
    return textOfQuoted(exp);
  }
  /* (set! name value) */
  else if(isAssignment(exp))
  {
    return evalAssignment(exp, env);
  }
  /* (define name value) */
  else if(isDefinition(exp))
  {
    return evalDefine(exp, env);
  }
  /* (define-syntax name ...) */
  else if(isDefinitionSyntax(exp))
  {
    return evalDefineSyntax(exp, env);
  }
  /* (if blur blur blur) */
  else if(isIf(exp))
  {
    return evalIf(toList(exp), env);
  }
  /* (lambda (args) (body)) */
  else if(isLambdaConst(exp))
  {
    sList *body;
    sList *param = toList( cadr(toList(exp)));
    sExpression *temp = cdr(toList( cdr(toList(exp))));
    if(isList(temp)){
      body = toList(temp);
    }else{
      body = toList(cons(temp, &sNull));
    }
    return newLambda(param, body, env);
  }
  /* (syntax blur blur) syntax rule */
  else if(isSymbol(car(toList(exp))) && isSyntaxRule(eval(car(toList(exp)), env)))
  {
    sExpression *exp2 = evalSyntaxRule(toSyntax(eval(car(toList(exp)), env)), exp);
    return eval(exp2, env);
  }
  /* the other list (x . y) */
  else if(isApplication(exp))
  {
    if(LAZY_EVAL){
      sExpression *proexp = actualValue(operator(toList(exp)), env);
      if(isLambdaType(proexp) || isPrimitiveProc(proexp)){
        sExpression *operand = operands(toList(exp));
        return applyLazly(proexp, operand, env);
      }
    }else{
      sExpression *proexp = eval(operator(toList(exp)), env);
      if(isLambdaType(proexp) || isPrimitiveProc(proexp)){
        sExpression *operand = operands(toList(exp));
        sExpression *arguments = listOfValues(operand, env);
        return apply(proexp, arguments, env);
      }
    }
  }
  return &sError;
}
Ejemplo n.º 14
0
static sExpression *firstExp(sList *exps){
  return car(exps);
}
Ejemplo n.º 15
0
Archivo: syme.c Proyecto: pdo/aldor
void
symeListSetExtension(SymeList symes, Syme syme)
{
	for (; symes; symes = cdr(symes))
		symeSetExtension(car(symes), syme);
}
Ejemplo n.º 16
0
// (eval 'any ['cnt ['lst]]) -> any
any doEval(any x) {
   any y;
   cell c1;
   bindFrame *p;

   x = cdr(x),  Push(c1, EVAL(car(x))),  x = cdr(x);
   if (!isNum(y = EVAL(car(x))) || !(p = Env.bind))
      data(c1) = EVAL(data(c1));
   else {
      int cnt, n, i, j;
      struct {  // bindFrame
         struct bindFrame *link;
         int i, cnt;
         struct {any sym; any val;} bnd[length(x)];
      } f;

      x = cdr(x),  x = EVAL(car(x));
      j = cnt = (int)unBox(y);
      n = f.i = f.cnt = 0;
      do {
         ++n;
         if ((i = p->i) <= 0  &&  (p->i -= cnt, i == 0)) {
            for (i = 0;  i < p->cnt;  ++i) {
               y = val(p->bnd[i].sym);
               val(p->bnd[i].sym) = p->bnd[i].val;
               p->bnd[i].val = y;
            }
            if (p->cnt  &&  p->bnd[0].sym == At  &&  !--j)
               break;
         }
      } while (p = p->link);
      while (isCell(x)) {
         for (p = Env.bind, j = n; ; p = p->link) {
            if (p->i < 0)
               for (i = 0;  i < p->cnt;  ++i) {
                  if (p->bnd[i].sym == car(x)) {
                     f.bnd[f.cnt].val = val(f.bnd[f.cnt].sym = car(x));
                     val(car(x)) = p->bnd[i].val;
                     ++f.cnt;
                     goto next;
                  }
               }
            if (!--j)
               break;
         }
next:    x = cdr(x);
      }
      f.link = Env.bind,  Env.bind = (bindFrame*)&f;
      data(c1) = EVAL(data(c1));
      while (--f.cnt >= 0)
         val(f.bnd[f.cnt].sym) = f.bnd[f.cnt].val;
      Env.bind = f.link;
      do {
         for (p = Env.bind, i = n;  --i;  p = p->link);
         if (p->i < 0  &&  (p->i += cnt) == 0)
            for (i = p->cnt;  --i >= 0;) {
               y = val(p->bnd[i].sym);
               val(p->bnd[i].sym) = p->bnd[i].val;
               p->bnd[i].val = y;
            }
      } while (--n);
   }
   return Pop(c1);
}
Ejemplo n.º 17
0
void lambdaParameters(Register result, Register exp)
{
    cdr(result, exp);
    car(result, result);
}
Ejemplo n.º 18
0
// (xor 'any 'any) -> flg
any doXor(any x) {
   bool f;

   x = cdr(x),  f = isNil(EVAL(car(x))),  x = cdr(x);
   return  f ^ isNil(EVAL(car(x)))?  T : Nil;
}
Ejemplo n.º 19
0
void ifConsequent(Register result, Register exp)
{
    cdr(result, exp);
    cdr(result, result);
    car(result, result);
}
Ejemplo n.º 20
0
// (nil . prg) -> NIL
any doNil(any x) {
   while (isCell(x = cdr(x)))
      if (isCell(car(x)))
         evList(car(x));
   return Nil;
}
Ejemplo n.º 21
0
void operator(Register result, Register exp)
{
    car(result, exp);
}
Ejemplo n.º 22
0
// (t . prg) -> T
any doT(any x) {
   while (isCell(x = cdr(x)))
      if (isCell(car(x)))
         evList(car(x));
   return T;
}
Ejemplo n.º 23
0
void procedureParameters(Register result, Register procedure)
{
    cdr(result, procedure);
    car(result, result);
}
Ejemplo n.º 24
0
int
cmp_expr(U *p1, U *p2)
{
	int n;

	if (p1 == p2)
		return 0;

	if (p1 == symbol(NIL))
		return -1;

	if (p2 == symbol(NIL))
		return 1;

	if (isnum(p1) && isnum(p2))
		return sign(compare_numbers(p1, p2));

	if (isnum(p1))
		return -1;

	if (isnum(p2))
		return 1;

	if (isstr(p1) && isstr(p2))
		return sign(strcmp(p1->u.str, p2->u.str));

	if (isstr(p1))
		return -1;

	if (isstr(p2))
		return 1;

	if (issymbol(p1) && issymbol(p2))
		return sign(strcmp(get_printname(p1), get_printname(p2)));

	if (issymbol(p1))
		return -1;

	if (issymbol(p2))
		return 1;

	if (istensor(p1) && istensor(p2))
		return compare_tensors(p1, p2);

	if (istensor(p1))
		return -1;

	if (istensor(p2))
		return 1;

	while (iscons(p1) && iscons(p2)) {
		n = cmp_expr(car(p1), car(p2));
		if (n != 0)
			return n;
		p1 = cdr(p1);
		p2 = cdr(p2);
	}

	if (iscons(p2))
		return -1;

	if (iscons(p1))
		return 1;

	return 0;
}
Ejemplo n.º 25
0
void textOfQuotation(Register result, Register exp)
{
    cdr(result, exp);
    car(result, result);
}
Ejemplo n.º 26
0
atom *fn_cdr(env *e, atom *args) {
  if (car(args)->typ != A_PAIR)
    return atom_make(A_ERROR, "first arg must be arg list");

  return cdr(car(args));
}
Ejemplo n.º 27
0
// This function evaluates the parse tree given by expr within the given environment.
Value* eval(Value *expr, Environment *env){
  Value* operator;
  Value* args;
  //printf("Here is expression:  ");
  //printValue(expr);
  //printf("\n");
  
  if (!expr){
    return NULL;
  }
  
  switch (expr->type) 
    {
    case symbolType:
      //printf("unknown identifier");
      args = envLookup(expr->symbolValue, env);
      if (args){
	//printf("going here\n");
	//printValue(expr);
	//printf("\nending here\n");
	return args;
      }
      else{
	printf("syntax error: unknown identifier");
	return NULL;
      }
      break;
    case cellType:
      if (expr->cons->car->type == nullType) {
	return expr->cons->car;
      }
      //printf("Here is expression:  ");
      //printValue(getFirst(expr));
      //printf("\n");
      
      if (getFirst(expr) != NULL && getFirst(expr)->type == openType) {
	operator = car(expr);

	if (!operator){
	  printf("syntax error, missing components here");
	  return NULL;
	}
	if (operator->type == cellType){
	  operator = eval(operator, env);
	}
	
	if (operator->type == symbolType){
	  args = getTail(getTail(expr));
	  //printf("checking args?: ");
	  //printValue(args);
	  //printf("\n"); //if (args  == NULL){
	  //return eval(operator,env); //	  }else 
	  if (strcmp(operator->symbolValue,"define")==0){
	    return evalDefine(args, env);
	  }else if (strcmp(operator->symbolValue,"lambda")==0){
	    /*eval lambda goes here*/
	    return evalLambda(args, env);
	  }else if (strcmp(operator->symbolValue,"if")== 0){
	    return evalIf(args, env);
	    /*eval if goes here*/
	  }else if (strcmp(operator->symbolValue,"quote")==0){
	    /*eval quote goes here*/
	    return evalQuote(args);
	  }else if (strcmp(operator->symbolValue,"let")==0){
	    /*eval let goes here*/
	    return evalLet(args, env);
	  }else{
	    //printf("validation result is shown: %d\n",validateArgs(args, env));
	    if (validateArgs(args, env)==-1){
	      printf("Syntax error! Invalid arguments for the procedure: ");
	      printValue(operator);
	      printf("\n");
	      return NULL;
	    } 
	    Value *evaledOperator = eval(operator, env);
	    Value *evaledArgs = evalEach(args, env);
	    if (!evaledOperator){
	      printf("Unknown procedure: ");
	      printValue(operator);
	      printf("\n");
	    }
	    //printValue(evaledArgs);
	    //printf("\n");
	    return apply(evaledOperator, evaledArgs);
	  }
	}else if (typeCheck(operator)==1){
	  printf("A literal ");
	  printValue(operator);
	  printf(" cannot be a procedure.\n");
	  return NULL; 
	}
      } else if (typeCheck(getFirst(expr))==1){
	//printValue(expr);
	//printf("\n");
	return evalEach(expr,env);
      }else if (getFirst(expr) && getFirst(expr)->type ==cellType && getFirst(getTail(expr)) && getFirst(getTail(expr))->type==closeType){
	return eval(getFirst(expr),env);
      }else if (getFirst(expr) && getFirst(expr)->type == symbolType){
	operator = getFirst(expr);
	Value *returnValue = envLookup(operator->symbolValue, env);
	
	if (returnValue){
	  return returnValue;
	}else{
	  if (strcmp(operator->symbolValue,"define")==0){
	    printf("define: bad syntax in ");
	    printValue(expr);
	    printf("\n");
	  }else if (strcmp(operator->symbolValue,"lambda")==0){
	    printf("lambda: bad syntax in ");
	    printValue(expr);
	    printf("\n");
	  }else if (strcmp(operator->symbolValue,"if")==0){
	    printf("if: bad syntax in ");
	    printValue(expr);
	    printf("\n");
	  }else if (strcmp(operator->symbolValue,"quote")==0){
	    printf("quote: bad syntax in ");
	     printValue(expr);
	     printf("\n");
	  }else if (strcmp(operator->symbolValue,"let")==0){
	     printf("let: bad syntax in ");
	     printValue(expr);
	     printf("\n");
	  }else{
	     
	    printf("Unknown identifier %s.\n",operator->symbolValue);
	   }
	  
	   return NULL;
	 }
       }
       
    case closeType:
      //printValue(expr);
      //printf("\n");
      return NULL;
      break;
    default:
      //printValue(expr);
      //printf("\n");
      if (getTail(expr)){
	assert(getFirst(getTail(expr))!=NULL);
	assert(getFirst(getTail(expr))->type==closeType);
	Value *toRemove = getTail(expr);
	free(toRemove->cons->car);
	free(toRemove->cons);
	free(toRemove);
	expr->cons->cdr = NULL;
	//assert(1==2);
      }
      return expr;      
    }
}
Ejemplo n.º 28
0
void set_state_constants(void)
{
	cellpoint sc = state_constants;
	STATE_INIT = car(sc);
	sc = cdr(sc);
	STATE_SHARP = car(sc);
	sc = cdr(sc);
	STATE_DOT = car(sc);
	sc = cdr(sc);
	STATE_ADD = car(sc);
	sc = cdr(sc);
	STATE_SUB = car(sc);
	sc = cdr(sc);
	STATE_NUM = car(sc);
	sc = cdr(sc);
	STATE_CHAR = car(sc);
	sc = cdr(sc);
	STATE_STR = car(sc);
	sc = cdr(sc);
	STATE_SYM = car(sc);
	sc = cdr(sc);
	STATE_LIST = car(sc);
	sc = cdr(sc);
	STATE_VEC = car(sc);
	sc = cdr(sc);
	STATE_QUOTE = car(sc);
}
Ejemplo n.º 29
0
int main(int argc, char **argv){
     int i;
     char *p;
     GC_INIT();
     ::cgc1::cgc_root_t hash_bucket_root(hash_buckets);
     hash_buckets=reinterpret_cast<node*>(::cgc1::cgc_malloc(sizeof(node)*7313));
     progname = BaseName(argv[0]);
     yyinit();
     for (p=argv[0]; *p; p++) if (*p=='/') progname = p+1;
     for (i=1; i<argc; i++) {
     	  if (EQUAL == strcmp(argv[i],"--help")) {
	       usage();
	       exit(0);
	       }
     	  if (EQUAL == strcmp(argv[i],"-dep")) {
	       stop_after_dep = TRUE;
	       continue;
	       }
     	  if (EQUAL == strcmp(argv[i],"-cxx")) {
	       do_cxx = TRUE;
	       continue;
	       }
     	  if (EQUAL == strcmp(argv[i],"-noline")) {
	       noline = TRUE;
	       continue;
	       }
	  if (EQUAL == strcmp(argv[i],"-pthreadlocal")) {
	       pthreadThreadLocal=TRUE;
               compilerThreadLocal=FALSE;
               continue;
	       }
     	  if (EQUAL == strcmp(argv[i],"-typecodes")) {
	       printtypecodes();
	       return 0;
	       }
     	  if (EQUAL == strcmp(argv[i],"-noarraychks")) {
	       arraychks = FALSE;
	       continue;
	       }
     	  if (EQUAL == strcmp(argv[i],"-nocasechks")) {
	       casechks = FALSE;
	       continue;
	       }
	  if (EQUAL == strcmp(argv[i],"-nomacros")) {
	       nomacros = TRUE;
	       continue;
	       }
     	  if (EQUAL == strcmp(argv[i],"-O")) {
	       arraychks = FALSE;
	       casechks = FALSE;
	       continue;
	       }
	  if (EQUAL == strcmp(argv[i],"-tabwidth")) {
	       i++;
	       if (i < argc) tabwidth = atoi(argv[i]);
	       continue;
	       }
	  if (EQUAL == strcmp(argv[i],"-yydebug")) {
	       yydebug = 1;
	       continue;
	       }
	  if (EQUAL == strcmp(argv[i],"-debug")) {
	       debug = TRUE;
	       continue;
	       }
	  if (EQUAL == strcmp(argv[i],"-v")) {
	       puts(Version);
     	       puts(Copyright);
	       continue;
	       }
     	  if ('-' == argv[i][0] && 'I' == argv[i][1]) {
	       if (argv[i][2] == 0) {
		    error("-I option: missing directory");
		    usage();
		    exit(1);
		    }
	       char buf[256];
	       strcpy(buf,sigpath);
	       strcat(buf,":");
	       strcat(buf,argv[i]+2);
	       sigpath = strperm(buf);
	       continue;
	       }
	  if ('-' == argv[i][0]) {
	       error("unrecognized option %s\n",argv[i]);
	       usage();
	       exit(1);
	       }
	  if ( EQUAL == strcmp(".d",tail(argv[i])) || EQUAL == strcmp(".dd",tail(argv[i])) ) {
	       node f;
	       do_this_cxx = do_cxx || EQUAL == strcmp(".dd",tail(argv[i]));
	       global_scope = new(struct SCOPE);
	       readsetup(global_scope);
	       targetname = newsuffixbase(argv[i],"");
	       f = readfile(argv[i]);
	       if (debug) {
		    char *n = newsuffixbase(argv[i],".out");
		    if (NULL == freopen(n,"w", stdout)) {
			 fatal("can't open file %s",n);
			 }
		    put("After parsing:\n");
		    pp(f);
		    fflush(stdout);
		    }
	       outfilename = newsuffixbase(argv[i], do_this_cxx ? "-tmp.cc" : "-tmp.c");
	       {
		    char *n = newsuffixbase(argv[i],".dep.tmp");
		    dependfile = fopen(n,"w");
		    if (dependfile == NULL) fatal("can't open file %s",n);
		    }
	       f = chkprogram(f);
	       if (debug) {
		    char *n = newsuffixbase(argv[i],".log");
		    if (NULL == freopen(n,"w", stdout)) {
			 fatal("can't open file %s",n);
			 }
		    pprintl(f);
		    }
	       {
		    node t = global_scope->signature;
		    char *n = newsuffixbase(argv[i],".sig.tmp");
		    if (NULL == freopen(n,"w", stdout)) {
			 fatal("can't open file %s",n);
			 }
		    printf("-- generated by %s\n\n",progname);
		    while (t != NULL) {
			 dprint(CAR(t));
			 put(";\n");
			 t = CDR(t);
			 }
		    }
	       if (stop_after_dep) quit();
	       checkfordeferredsymbols();
	       if (debug) {
		    char *n = newsuffixbase(argv[i],".sym");
		    if (NULL == freopen(n,"w", stdout)) {
			 fatal("can't open file %s",n);
			 }
		    printsymboltable();
		    printtypelist();
		    printstringlist();
		    }
	       if (n_errors > 0) {
		    quit();
		    }
	       if (TRUE) {
		    char *n = newsuffixbase(argv[i],"-exports.h.tmp");
		    if (NULL == freopen(n,"w", stdout)) {
			 fatal("can't open file %s",n);
			 }
		    printf("#ifndef %s_included\n",targetname);
		    printf("#define %s_included\n",targetname);
		    declarationsstrings = reverse(declarationsstrings);
		    while (declarationsstrings) {
			 node s = unpos(car(declarationsstrings));
			 assert(isstrconst(s));
			 put_unescape(s->body.string_const.characters);
			 put("\n");
			 declarationsstrings = cdr(declarationsstrings);
			 }
		    put(declarations_header);
		    /* printtypecodes(); */
		    cprinttypes();
		    put(declarations_trailer);
		    put("#endif\n");
		    }
	       if (TRUE) {
		    if (NULL == freopen(outfilename,"w", stdout)) {
			 fatal("can't open file %s",outfilename);
			 }
		    printf("#include \"%s\"\n",newsuffixbase(argv[i],"-exports.h"));
		    put(code_header);
		    headerstrings = reverse(headerstrings);
		    while (headerstrings) {
			 locn(car(headerstrings));
			 printpos();
			 node s = unpos(car(headerstrings));
			 assert(isstrconst(s));
			 put_unescape(s->body.string_const.characters);
			 put("\n");
			 locn(NULL);
			 headerstrings = cdr(headerstrings);
			 }
		    cprintsemi(f);
		    }
	       }
	  else {
	       fprintf(stderr,"unknown file type %s\n",argv[i]);
	       usage();
	       exit(1);
	       }
	  }
     quit();
     return 0;
     }
Ejemplo n.º 30
0
Archivo: eval.c Proyecto: ingramj/bs
static inline object *application_operator(object *exp)
{
    return car(exp);
}