domingo, 24 de enero de 2010

Haciendo un intérprete de LISP (XIV)

En esta parte de la serie sobre el intérprete LISP vamos a poner el código de algunas funciones nativas que pueden ser útiles.

Operaciones de lista

Tendríamos por ejemplo


Cell& FOL_Cons(Heap& heap, Cell& args, Cell& envir)
{
if(args.IsEmpty() || args.GetTail().IsEmpty() || !args.GetTail().GetTail().IsEmpty())
throw std::runtime_error("Cons needs two arguments");

Cell& head=heap.Evaluate(args.GetHead(), envir);
Cell& tail=heap.Evaluate(args.GetTail().GetHead(), envir);

if(!tail.IsList())
throw std::runtime_error("Cons needs a list as second argument");

return heap.CreatePair(head, tail);
}

Cell& FOL_Car(Heap& heap, Cell& args, Cell& envir)
{
if(args.IsEmpty() || !args.GetTail().IsEmpty())
throw std::runtime_error("Car requires one arguments");

Cell& head=heap.Evaluate(args.GetHead(), envir);
return head.GetHead();
}

Cell& FOL_Cdr(Heap& heap, Cell& args, Cell& envir)
{
if(args.IsEmpty() || !args.GetTail().IsEmpty())
throw std::runtime_error("Cdr requires one arguments");

Cell& head=heap.Evaluate(args.GetHead(), envir);
return head.GetTail();
}

Cell& FOL_Second(Heap& heap, Cell& args, Cell& envir)
{
if(args.IsEmpty() || !args.GetTail().IsEmpty())
throw std::runtime_error("Second requires one arguments");

Cell& head=heap.Evaluate(args.GetHead(), envir);
return head.GetTail().GetHead();
}

Cell& FOL_Third(Heap& heap, Cell& args, Cell& envir)
{
if(args.IsEmpty() || !args.GetTail().IsEmpty())
throw std::runtime_error("Third requires one arguments");

Cell& head=heap.Evaluate(args.GetHead(), envir);
return head.GetTail().GetTail().GetHead();
}

Cell& FOL_Nth(Heap& heap, Cell& args, Cell& envir)
{
if(args.IsEmpty() || args.GetTail().IsEmpty() || !args.GetTail().GetTail().IsEmpty())
throw std::runtime_error("Nth requires two arguments");

INTEGER at=heap.Evaluate(args.GetHead(), envir).GetInteger();
Cell& list=heap.Evaluate(args.GetTail().GetHead(), envir);
return list.ListIdx(at);
}

Cell& FOL_Length(Heap& heap, Cell& args, Cell& envir)
{
if(args.IsEmpty() || !args.GetTail().IsEmpty())
throw std::runtime_error("Length requires one arguments");

Cell& list=heap.Evaluate(args.GetHead(), envir);
return heap.CreateInteger(list.ListLength());
}

Cell& FOL_List(Heap& heap, Cell& args, Cell& envir)
{
if(args.IsEmpty())
return heap.CreateEmpty();

return heap.CreatePair( heap.Evaluate(args.GetHead(), envir)
, FOL_List(heap, args.GetTail(), envir) );
}

Cell& R_Append(Heap& heap, Cell& list1, Cell& list2)
{
if(list1.IsEmpty())
return list2;

return heap.CreatePair( list1.GetHead(), R_Append(heap, list1.GetTail(), list2) );
}

Cell& FOL_Append(Heap& heap, Cell& args, Cell& envir)
{
if(args.IsEmpty() || args.GetTail().IsEmpty() || !args.GetTail().GetTail().IsEmpty())
throw std::runtime_error("Append requires two arguments");

Cell& list1=heap.Evaluate(args.GetHead(), envir);
Cell& list2=heap.Evaluate(args.GetTail().GetHead(), envir);

return R_Append(heap, list1, list2);
}

Cell& FOL_Reverse(Heap& heap, Cell& args, Cell& envir)
{
if(args.IsEmpty() || !args.GetTail().IsEmpty())
throw std::runtime_error("Reverse requires one arguments");

Cell* r=&heap.CreateEmpty();
for(Cell* p=&heap.Evaluate(args.GetHead(), envir); p->IsPair(); p=&p->GetTail())
r=&heap.CreatePair( p->GetHead(), *r );

return *r;
}

Formas especiales

Algunas posibles son

Cell& FOL_Lambda(Heap& heap, Cell& args, Cell& envir)
{
if(args.IsEmpty() || args.GetTail().IsEmpty())
throw std::runtime_error("Lambda needs two arguments at least");

Cell* params=&args.GetHead();
Cell* p;
for(p=params; p->IsPair(); p=&p->GetTail())
if(!p->GetHead().IsName())
throw std::runtime_error("Binding a non-name");

if(!p->IsEmpty())
throw std::runtime_error("Lambda needs a list as first argument");

return heap.CreateLambda(*new Lambda(*params, args.GetTail(), envir));
}


Cell& FOL_Defun(Heap& heap, Cell& args, Cell& envir)
{
if(args.IsEmpty() || args.GetTail().IsEmpty())
throw std::runtime_error("Defun needs three arguments at least");

Cell& lambda=FOL_Lambda(heap, args.GetTail(), envir);
envir.GetEnvironment().Bind(heap, *args.GetHead().GetName(), lambda);
return lambda;
}

Cell& FOL_Quote(Heap& heap, Cell& args, Cell& envir)
{
if(args.IsEmpty() || !args.GetTail().IsEmpty())
throw std::runtime_error("Quote needs one single argument");

return args.GetHead();
}


Cell& FOL_SetQ(Heap& heap, Cell& args, Cell& envir)
{
if(args.IsEmpty() || args.GetTail().IsEmpty())
throw std::runtime_error("SetQ needs two arguments at least");

if(!args.GetHead().IsName())
throw std::runtime_error("SetQ requires a name as fist argument");

Cell& r=heap.EvaluateInSequence(args.GetTail(), envir);
envir.GetEnvironment().ChangeBond(heap, heap.GetStringFromPool(*args.GetHead().GetName()), r);
return r;
}

Cell& FOL_Define(Heap& heap, Cell& args, Cell& envir)
{
if(args.IsEmpty() || args.GetTail().IsEmpty())
throw std::runtime_error("Define needs two arguments at least");

if(!args.GetHead().IsName())
throw std::runtime_error("Define requires a name as fist argument");

Cell& r=heap.EvaluateInSequence(args.GetTail(), envir);
envir.GetEnvironment().Bind(heap, *args.GetHead().GetName(), r);
return r;
}

Cell& FOL_Let(Heap& heap, Cell& args, Cell& envir)
{
if(args.IsEmpty() || args.GetTail().IsEmpty())
throw std::runtime_error("Let needs two arguments at least");

Cell& envcell=heap.CreateEnvironment(&envir);
Environment& newenv=envcell.GetEnvironment();

//Bind to environment
for(Cell* qb=&args.GetHead(); qb->IsPair(); qb=&qb->GetTail())
{
Cell& binding=qb->GetHead();
if(binding.IsEmpty() || binding.GetTail().IsEmpty())
throw std::runtime_error("Bindings must have two elements at least");

newenv.Bind(heap, *binding.GetHead().GetName(), heap.EvaluateInSequence(binding.GetTail()
, envir)); // HERE!
}

//Evaluate in new environment
return heap.EvaluateInSequence(args.GetTail(), envcell);
}

Cell& FOL_LetInSeq(Heap& heap, Cell& args, Cell& envir)
{
if(args.IsEmpty() || args.GetTail().IsEmpty())
throw std::runtime_error("Let* needs two arguments at least");

Cell& envcell=heap.CreateEnvironment(&envir);
Environment& newenv=envcell.GetEnvironment();

//Bind to environment
for(Cell* qb=&args.GetHead(); qb->IsPair(); qb=&qb->GetTail())
{
Cell& binding=qb->GetHead();
if(binding.IsEmpty() || binding.GetTail().IsEmpty())
throw std::runtime_error("Bindings must have two elements at least");

newenv.Bind(heap, *binding.GetHead().GetName(), heap.EvaluateInSequence(binding.GetTail()
, envcell)); // HERE!
}

//Evaluate in new environment
return heap.EvaluateInSequence(args.GetTail(), envcell);
}

Cell& FOL_Do(Heap& heap, Cell& args, Cell& envir)
{
if(args.IsEmpty() || args.GetTail().IsEmpty() || args.GetTail().GetTail().IsEmpty())
throw std::runtime_error("Do needs three arguments at least");

Cell& envcell=heap.CreateEnvironment(&envir);
Environment& newenv=envcell.GetEnvironment();

//Initial bind to environment
for(Cell* qb=&args.GetHead(); qb->IsPair(); qb=&qb->GetTail())
{
Cell& binding=qb->GetHead();
if(binding.IsEmpty() || binding.GetTail().IsEmpty())
throw std::runtime_error("Bindings must have two elements at least");

newenv.Bind(heap, *binding.GetHead().GetName(), heap.Evaluate(binding.GetTail().GetHead()
, envir)); // HERE!
}

//Loop
Cell* r=NULL;
while(heap.Evaluate(args.GetTail().GetHead(), envcell).GetBoolean())
{
r=&heap.EvaluateInSequence(args.GetTail().GetTail(), envcell);

//Update
for(Cell* qb=&args.GetHead(); qb->IsPair(); qb=&qb->GetTail())
{
Cell& binding=qb->GetHead();
heap.EvaluateInSequence(binding.GetTail().GetTail(), envcell);
}
}

return r==NULL ? heap.CreateEmpty() : *r;
}

Cell& FOL_DoInSeq(Heap& heap, Cell& args, Cell& envir)
{
if(args.IsEmpty() || args.GetTail().IsEmpty() || args.GetTail().GetTail().IsEmpty())
throw std::runtime_error("Do* needs three arguments at least");

Cell& envcell=heap.CreateEnvironment(&envir);
Environment& newenv=envcell.GetEnvironment();

//Initial bind to environment
for(Cell* qb=&args.GetHead(); qb->IsPair(); qb=&qb->GetTail())
{
Cell& binding=qb->GetHead();
if(binding.IsEmpty() || binding.GetTail().IsEmpty())
throw std::runtime_error("Bindings must have two elements at least");

newenv.Bind(heap, *binding.GetHead().GetName(), heap.Evaluate(binding.GetTail().GetHead()
, envcell)); // HERE!
}

//Loop
Cell* r=NULL;
while(heap.Evaluate(args.GetTail().GetHead(), envcell).GetBoolean())
{
r=&heap.EvaluateInSequence(args.GetTail().GetTail(), envcell);

//Update
for(Cell* qb=&args.GetHead(); qb->IsPair(); qb=&qb->GetTail())
{
Cell& binding=qb->GetHead();
heap.EvaluateInSequence(binding.GetTail().GetTail(), envcell);
}
}

return r==NULL ? heap.CreateEmpty() : *r;
}

Cell& FOL_DoList(Heap& heap, Cell& args, Cell& envir)
{
if(args.IsEmpty())
throw std::runtime_error("DoList needs one arguments at least");

Cell& envcell=heap.CreateEnvironment(&envir);
Environment& newenv=envcell.GetEnvironment();

//Check the binding
Cell& binding=args.GetHead();
if(binding.IsEmpty() || binding.GetTail().IsEmpty())
throw std::runtime_error("Bindings must have two elements at least");

//Loop
Cell* r=NULL;
for(Cell* list= &heap.EvaluateInSequence(binding.GetTail(), envir); list->IsPair(); list=&list->GetTail())
{
newenv.Bind(heap, binding.GetHead().GetName(), list->GetHead());
r=&heap.EvaluateInSequence(args.GetTail(), envcell);
}

return r==NULL ? heap.CreateEmpty() : *r;
}

Operaciones y formas especiales con booleanos

Cell& FOL_Boolean_And(Heap& heap, Cell& args, Cell& envir)
{
for(Cell* qa=&args; qa->IsPair(); qa=&qa->GetTail())
if(!heap.Evaluate(qa->GetHead(), envir).GetBoolean())
return heap.CreateBoolean(false);

return heap.CreateBoolean(true);
}

Cell& FOL_Boolean_Or(Heap& heap, Cell& args, Cell& envir)
{
for(Cell* qa=&args; qa->IsPair(); qa=&qa->GetTail())
if(heap.Evaluate(qa->GetHead(), envir).GetBoolean())
return heap.CreateBoolean(true);

return heap.CreateBoolean(false);
}

Cell& FOL_Boolean_Not(Heap& heap, Cell& args, Cell& envir)
{
if(args.IsEmpty() || !args.GetTail().IsEmpty())
throw std::runtime_error("Boolean not needs one single argument");

return heap.CreateBoolean(!heap.Evaluate(args.GetHead(), envir).GetBoolean());
}

Cell& FOL_Boolean_If(Heap& heap, Cell& args, Cell& envir)
{
if(args.IsEmpty() || args.GetTail().IsEmpty() || args.ListLength()>3)
throw std::runtime_error("Lambda needs two or three arguments");

if(heap.Evaluate(args.GetHead(), envir).GetBoolean())
return heap.Evaluate(args.GetTail().GetHead(), envir);

return args.GetTail().GetTail().IsEmpty() ? heap.CreateEmpty()
: heap.Evaluate(args.GetTail().GetTail().GetHead(), envir);
}

Otras funciones

Cell& FOL_ProgN(Heap& heap, Cell& args, Cell& envir)
{
Cell* r=&args;
for(Cell* qa=&args; qa->IsPair(); qa=&qa->GetTail())
r=&heap.Evaluate(qa->GetHead(), envir);
return *r;
}

Cell& FOL_Prog1(Heap& heap, Cell& args, Cell& envir)
{
if(args.IsEmpty())
return args;

Cell& r=heap.Evaluate(args.GetHead(), envir);
for(Cell* qa=&args.GetTail(); qa->IsPair(); qa=&qa->GetTail())
heap.Evaluate(qa->GetHead(), envir);

return r;
}

Cell& FOL_Eval(Heap& heap, Cell& args, Cell& envir)
{
if(args.IsEmpty())
throw std::runtime_error("The evaluator needs one argument at least");

return heap.Evaluate(heap.Evaluate(args.GetHead(), envir), envir);
}

Cell& FOL_Print(Heap& heap, Cell& args, Cell& envir)
{
if(heap.GetPrintOutput()!=NULL)
for(Cell* qa=&args; qa->IsPair(); qa=&qa->GetTail())
heap.Evaluate(qa->GetHead(), envir).Print(*heap.GetPrintOutput());

return heap.CreateEmpty();
}

Realmente podríamos seguir así creando bibliotecas y bibliotecas de funciones.

0 comentarios:

Publicar un comentario en la entrada