Haciendo un intérprete de LISP (XV)

En esta entrega del intérprete LISP vamos a tratar la entrada/salida someramente. Nos dedicaremos a ver únicamente la rutina de lectura de expresiones y la de escritura de valores.

La rutina de lectura

Tampoco vamos a adentrarnos mucho en la rutina de lectura. De hecho, se puede usar una PEG fácilmente para las expresiones S. Tomado, y simplificado, de aquí.

Atom = {Char}+ 
<s-expression> ::= <quote>? Atom / <quote>? '('  <s-expression>* ')' 
<quote>  ::= [']

Realmente lo interesante aquí es que los literales y los identificadores se pueden agrupar como átomos en la gramática y, luego, distinguirlos en la parte semántica.

La rutina de escritura

A diferencia de la rutina de lectura, la escritura debe servir para cualquier valor. Por ejemplo, una función lambda. Además, hemos de intentar formatear algo la salida para que la lectura sea agradable. Es lo que se denomina el prettyprinting.

No vamos a calentarnos mucho la cabeza. Usaremos una indentación para destacar el grado de anidamiento que tengan los valores. Todo eso se puede incluir en una misma rutina de la siguiente forma:

void Cell::Print(std::wostream& o, std::wstring const& indent, int depth)const
{
 if(this==NULL)
  throw std::logic_error("Null cell");

 switch(cell_type)
 {
 case CT_UNUSED:
  o << L"[unused]";
  break;

 case CT_EMPTY:
  o << L"()";
  break;

 case CT_PAIR:
  if(IsList())
  {
   if(depth>0)
   {
    o << L"(";
    Cell const* c=this;
    c->value.head->Print(o, indent+L" ", depth-1);
    c=c->value.tail;
    while(c->IsPair())
    {
     o << L"\n " << indent;
     c->value.head->Print(o, indent+L" ", depth-1);
     c=c->value.tail;
    }
    o << L")";
   }
   else
    o << L"[list]";
  }
  else
  {
   if(depth>0)
   {
    o << L"[\n";
    value.head->Print(o, indent+L" ");
    o << L"\n";
    value.tail->Print(o, indent+L" ");
    o << L"]";
   }
   else
    o << L"[pair]";
  }
  break;

 case CT_INTEGER:
  o << value.integer;
  break;

 case CT_REAL:
  o << value.real;
  break;

 case CT_STRING:
  o << L"\"" << *value.string_idx << L"\"";
  break;

 case CT_BOOLEAN:
  o << (value.boolean? L"[true]" : L"[false]");
  break;

 case CT_NAME:
  o << *value.string_idx;
  break;

 case CT_ENVIR:
  o << L"[envir " << (void*)this;
  if(depth>0)
  {
   o << L"\n";
   value.environment->Print(o, indent+L" ", depth-1);
  }
  o << L"]";
  break;

 case CT_LAMBDA:
  if(depth>0)
  {
   o << L"[lambda " << (void*)this << L" ";
   value.lambda->Print(o, indent+L" ", depth-1);
   o << L"]";
  }
  else
   o << L"[lambda " << (void*)this << L"]";
  break;

 case CT_NATIVE:
  o << L"[native " << (void*)this << L"]";
  break;
 }
}

En las celdas lambda y entorno delegamos al propio objeto, pero las rutinas de impresión son muy similares.

Con esto hemos acabado la parte inexcusable del LISP. A partir de aquí dedicaremos las siguientes entradas a extensiones y modificaciones. Empezaremos por la más necesaria: la recolección de basura, ya que hasta ahora creábamos celdas pero no las destruíamos.

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.

Lenguajes declarativos y lenguajes imperativos

Un pequeño interludio en el intérprete de LISP para despejar mentes.

Hace años, cuando aún estudiaba, íbamos andando por una avenida un compañero de piso mío y yo. A eso que se nos paró un coche y un hombre algo barbudo (junto a un extraño copiloto que no recuerdo bien) nos preguntó con acento de otra ciudad.

-Disculpen, ¿cómo se llega al centro meteorológico?

El centro meteorológico no sólo era conocido en el barrio, sino que estaba bastante cerca. Mi respuesta fue bastante sencilla (y con acento autóctono):

-Siga por esta calle, la segunda a la izquierda y hasta la rotonda. Allí está.

Mi compañero de piso tuvo una respuesta distinta, pero equivalente.

-Está en diagonal estas dos manzanas.

El buen hombre nos dio las gracias y mi compañero de piso destacó que yo era "imperativo" porque había resuelto el problema mediante órdenes. Por otra lado, él mismo era "declarativo" porque había resuelto el problema describiendo la solución.

Realmente es un buen ejemplo para aprender qué es un lenguaje de programación imperativo y qué es un lenguaje de programación declarativo.

Haciendo un intérprete de LISP (XIII)

En la última entrada introducimos SetQ. Este SetQ es distinto a los del LISP usual en dos aspectos. El primero está relacionado con la capacidad que tiene el SetQ usual del LISP para modificar varios símbolos a la vez. El segundo, sin embargo, sí que es importante ya que está relacionado con la clausura léxica.

Inspeccionando el estado del intérprete

Vamos a introducir unas funciones nativas para inspeccionar el montículo y los entornos. Usualmente esto se hace en LISP con órdenes (commands). De hecho, la salida del intérprete con Quit también suele ser una orden pero, para mantenerlo simple todo, usaremos funciones nativas.

Para inspeccionar el montículo usaremos esta función nativa:

Cell& FOL_Heap(Heap& heap, Cell& args, Cell& envir)
{
 if(!args.IsEmpty())
  throw std::runtime_error("Heap needs no arguments");

 heap.Print(std::wcout);

 return args;
}

Para inspeccionar los entornos usaremos esta función nativa:

Cell& FOL_Envir(Heap& heap, Cell& args, Cell& envir)
{
 INTEGER depth=args.IsEmpty() ? 0 : heap.Evaluate(args.GetHead(), envir).GetInteger();
 Cell* e=&envir;
 while(depth>0)
 {
  --depth;
  Cell* parent=e->GetEnvironment().GetParent();
  if(parent!=NULL)
   e=parent;
 }

 return *e;
}

Esta última función toma un argumento opcional que indica qué nivel de entorno padre queremos inspeccionar.

Inspeccionando entornos padre

Lo veremos con un ejemplo. Definimos esta función:

> (setq f (lambda (x) (envir x)))

<lambda 003A9AD0 <envir 003A6828> (x)
  ((envir
    x))>

Luego, la usamos:

> (f 0)

<envir 003A9438>= <envir
 (x
  0)
>

El entorno donde se evaluó (envir 0) era el que tenía definido únicamente la x. El resto de símbolos está definido en el entorno padre.

> (f 1)

<envir 003A6828>= <envir
 (add
  <native 003A6930>)
 (envir
  <native 003A6A48>)
  ...

Omito el resto de símbolos. Como ya hemos visto, cuando un símbolo no se encuentra en un entorno, se recurre al entorno padre.

El problema de setq

El problema de setq radica en que, tal como está, sólo modifica el entorno local. Incluso cuando el símbolo a modificar esté en un entorno padre. En el caso de las funciones este entorno padre es la clausura léxica.

> (setq f (lambda (x) (setq y 3) (envir x)))

<lambda 003A74A0 <envir 003A6828> (x)
  ((setq
    y
    3)
   (envir
    x))>

> (f 0)

<envir 003AA810>= <envir
 (x
  0)
 (y
  3)
>

Sin embargo, si predefino el símbolo "y", no obtengo el resultado deseado.

> (setq y 5)

5

> (f 0)

<envir 003AA810>= <envir
 (x
  0)
 (y
  3)
>

> y

5

Hay que modificar el comportamiento de setq para que actúe no sólo en el entorno local. También debe modificar los entornos padre si el símbolo a modificar está allí.

Cambiando el vínculo

Introducimos un nuevo método en los entornos. Buscaremos en los entornos padre y modificaremos el símbolo en el entorno donde lo encontremos. Si no lo encontramos, lo definimos localmente.

Cell& Environment::ChangeBond(Heap& heap, STRING name, Cell& cell)
{
 //Modifiy if already defined.
 Environment* current=this;
 while(current!=NULL)
 {
  BONDMAP::iterator i=current->m_Bonds.find(name);
  if(i!=current->m_Bonds.end() && i->second!=NULL)
  {
   i->second=&cell;
   return cell;
  }

  //Go to parent's (if it exists)
  if(current->m_Parent==NULL)
   break;

  current=&current->m_Parent->GetEnvironment();
 }

 //Define if not defined.
 m_Bonds[name]=&cell;
 return cell;
}

El resultado es que ahora podemos hacer lo que queríamos hacer: modificar símbolos del entorno de definición.

> (setq f (lambda (x) (setq y 3) (envir x)))

<lambda> (x)
((setq
 y
 3)
(envir
 x))>

> (setq y 5)

5

> (f 0)

<envir 003AA810>= <envir
 (x
  0)
>

> y

3

>

Haciendo un intérprete de LISP (XII)

En la última parte mencionábamos que teníamos que introducir algunas funciones nativas que nos sacasen del REPL. Queremos salir del intérprete de nuestro LISP. Aquí diremos cómo hacerlo y también empezaremos a definir los nombres.

Saliendo del intérprete

La forma más sencilla es una función nativa que llame a exit().

Cell& FOL_Quit(Heap& heap, Cell& args, Cell& envir)
{
 exit(0);
 return args;
}

El retorno no es necesario estrictamente hablando. Lo que sí que es necesario es darle un nombre a esta función nativa. Lo haremos así, en la inicialización.

    env.Bind(h, L"quit", &FOL_Quit);

El resultado es que ahora podemos salir del intérprete escribiendo "(quit)".

Más nombres

Es completamente necesario que el usuario pueda dar nombres a nuevas funciones. Hasta ahora hemos permitido que las crease usando "lambda", pero eran funciones anónimas. Hay que ir un paso más allá y permitir nombrarlas. Lo haremos más general aún. Permitiremos que el usuario pueda darle un nombre a cualquier valor. Para eso introduciremos "setq" que no es más que otra función nativa.

Cell& FOL_SetQ(Heap& heap, Cell& args, Cell& envir)
{

"setq" va a requerir dos argumentos al menos. El primero será el nombre y el segundo una secuencia de expresiones cuyo resultado será el valor a asignar al nombre.

 if(args.IsEmpty() || args.GetTail().IsEmpty())
  throw std::runtime_error("SetQ needs two arguments at least");

Comprobemos que el primer argumento es un nombre. Es importante distinguir aquí que el primer argumento es un nombre, no una expresión cuyo resultado es un nombre. No vamos a evaluar ese primer argumento. Esa es la razón de que "setq" tenga la "q". Más sobre esto un poco más adelante.

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

El resto de argumentos sí se evalúa en secuencia y obtenemos un resultado.

 Cell& r=heap.EvaluateInSequence(args.GetTail(), envir);

Es el resultado el que se vincula al nombre en el entorno actual. Esto es muy importante. Estamos vinculándolo en el entorno actual. No en el entorno global.

 envir.GetEnvironment().Bind(heap, *args.GetHead().GetName(), r);

El retorno de "setq" no es significativo ya que lo que queremos es el efecto lateral de vincular el nombre con el resultado. Por sencillez, devolvemos el propio resultado. Devolver una CT_EMPTY es más portable pero habría que reservar otra celda en el montículo.

 return r;
}

Finalmente, y como ocurre con las nativas, hemos de darle un nombre en el entorno global, justo antes de iniciar el REPL.

    env.Bind(h, L"setq", &FOL_SetQ);

Para probar "setq" definiremos la función "double". La sesión podría ser tal que así.

> (setq double (lambda (x) (add x x)))

<lambda 003A7FA8 <envir 003A6828> (x)
 ((add
   x
   x))>

> (double 3)

6

> (quit)

Quote

El hecho de que haya argumentos que debamos evaluar y otros que no es un inconveniente. Las lambda siempre evalúan sus argumentos. ¿Cómo podemos forzarlas para que no lo hagan? La respuesta es introducir una función nativa "quote" que, al ser evaluada, devuelve su único argumento sin evaluar.

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();
}

La añadimos también al entorno global con el nombre "quote".

    env.Bind(h, L"quote", &FOL_Quote);

El uso que tiene es bien sencillo.

> (quote (add 3 3))

(add
3
3)

> (add 3 3)

6

En el siguiente post introduciremos dos funciones nativas nuevas que nos van a permitir hurgar en los entresijos de nuestro intérprete. De esa forma, podremos ver cómo funciona interactivamente.

Haciendo un intérprete de LISP (XI)

Hasta ahora hemos probado nuestro intérprete de una forma ficticia. Hemos dicho que había un bucle de lectura, evaluación e impresión (llamado REPL de read-evaluate-print loop) pero nunca lo hemos implementado. Es hora de hacerlo.

Inicialización

La inicialización del bucle principal es bien sencilla: crear el montículo, crear el entorno inicial para darles nombre a las funciones nativas y empezar con el bucle.

En nuestro modelo de celdas hay que crear una celda para crear el entorno y luego poder acceder al objeto Environment directamente.

int main()
{
Heap h;
Cell& envir=h.CreateEnvironment(NULL);
Environment& env=envir.GetEnvironment();

Las funciones nativas que tenemos son dos: sumar enteros y creación de funciones lambdas. Las hemos llamado ya "add" y "lambda".

 env.Bind(h, L"add", &FOL_Add);
env.Bind(h, L"lambda", &FOL_Lambda);

A partir de este punto, y mientras este entorno esté accesible por la evaluación, podremos usar estas funciones nativas.

El bucle principal

En principio no queremos salir del bucle. Usaremos "for(;;)" que es lo mismo que escribir "while(true)".

for(;;)
{

A continuación vamos a leer una línea de texto del usuario. Como no queremos calentarnos la cabeza reservando buffers, tentemos a la suerte con un buffer en la pila (podríamos tener desbordamiento). Para que quede más bonito le ponemos un prompt ">" y saltos de línea "\n" que separen la entrada del usuario de la salida del evaluador.

wchar_t buffer[8192];
std::wcout << L"\n> ";
std::wcin.getline(buffer, 8192);
std::wcout << L"\n";

El hecho de que hasta ahora sólo hayamos trabajado con la evaluación significa que llamaremos a funciones que aún no tenemos preparadas. Concretamente la impresión y la lectura de expresiones S. La impresión es sencilla, pero la lectura requiere un pequeño parser así que he decidido encapsularla en otra clase que he llamado Exp (expresión). Esta clase lanza excepciones si el usuario introdujo una expresión S incorrecta.

  try
{
Exp e(h, buffer);

Es importante ver que Exp necesita el montículo (heap) como argumento ya que va a crear expresiones con celdas y el único objeto que puede crear celdas es el montículo. De esta forma las celdas creadas están controladas lo que será muy importante más adelante.

Debido a que el usuario puede introducir varias expresiones -por ejemplo "(add 1 1) (add 2 2)"- la clase Exp las mete en una lista. Queremos evaluar lo que ocurra en esa lista expresión a expresión. Nos quedaremos con el último resultado para simplificar. Todo esto lo hará la función EvaluateInSequence().

try
{
Exp v=e.EvaluateInSequence(envir);

De alguna mágica manera, imprimiremos.

v.Print(std::wcout);
std::wcout << std::endl;
}

Y capturamos las excepciones tanto en evaluación como en lectura.

catch(std::exception& e)
{
std::wcout << L"Exception evaluating: ";
 std::cout << e.what() << std::endl;
}
}
catch(std::exception& e)
{
std::wcout << L"Exception parsing: ";
std::cout << e.what() << std::endl;
}
}
}

Evaluando en secuencia

Será más sencillo si en vez de hacerlo en Exp lo hacemos en Heap. De esta forma Exp se queda sólo como un envoltorio que únicamente se dedica a leer expresiones.

Exp Exp::EvaluateInSequence(Cell& envir)
{
return Exp(*m_Heap, m_Heap->EvaluateInSequence(*m_Cell, envir));
}

Para evaluar en secuencia empezamos por la primera expresión de la lista y continuamos cada vez con la siguiente hasta llegar al final. Una vez ahí, paramos. 

Cell& Heap::EvaluateInSequence(Cell& cell, Cell& envir)
{
Cell* c=&cell;
Cell* r=&CreateEmpty();
while(c->IsPair())
{
r=&Evaluate(c->GetHead(), envir);
c=&c->GetTail();
}
return *r;
}

Esta evaluación en secuencia también me va a servir para que "lambda" pueda trabajar con una secuencia de expresiones. Es decir, podremos hacer cosas como "(lambda (x) (add 1 1) (add x x))" y calculará primero la parte "(add 1 1)" y luego "(add x x)" retornando este último valor. Basta cambiar la última línea en Lambda::Apply (lo vimos en la parte VIII)

Cell& Lambda::Apply(Heap& heap, Cell& args, Cell& envir)const
{
 Cell& local_cell=heap.CreateEnvironment(&m_Closure);
Environment& local=local_cell.GetEnvironment();

 Cell const *a, *p;
for(a=&args, p=&m_Params; a->IsPair() && p->IsPair(); a=&a->GetTail(), p=&p->GetTail())
local.Bind(heap, *p->GetHead().GetName(), heap.Evaluate(a->GetHead(),envir));

if((a->IsEmpty())!=(p->IsEmpty()))
throw std::runtime_error("Incorrect arity");

 return heap.EvaluateInSequence(m_Body, local_cell);
}

El cambio es en la última línea. De hecho, el llamar a Evaluate() era incorrecto ya que m_Body era una lista (ver parte X). Ahora sí que todo queda consistente.

En la siguiente parte sacaremos provecho a esta habilidad de evaluar varias expresiones en secuencia. Además, introduciremos una función nativa que nos saca del bucle (infinito) de lectura evaluación e impresión.

Haciendo un intérprete de LISP (X)

Después del descanso navideño continuamos con nuestro intérprete LISP. Hoy vamos a probar las funciones lambda desde el REPL (Read-Eval-Print Loop).

La nativa que hace lambdas

Las funciones lambdas son objetos que hemos de crear. Ya vimos cómo hacerlo en la parte séptima. Sin embargo, hemos de poder crear objetos lambda desde el evaluador. La forma de conseguirlo es mediante una función nativa.

El código es el siguiente:

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 need a list as first argument");

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

Primero comprobamos que nos han pasado dos argumentos. El primero va a ser la lista de parámetros y el segundo (y restantes) el cuerpo de la función lambda. Los parámetros han de estar en una lista de nombres. Eso lo comprobamos en el bucle y el consiguiente if. Finalmente, creamos el objeto lambda donde almacenaremos la función lambda.

Esto se hace en dos pasos. El primero es crear el objeto. Realmente esto sólo almacena tres referencias: a los parámetros, al cuerpo de la función y al entorno (para la clausura léxica). A continuación, creamos una celda CT_LAMBDA que contendrá ese objeto recién creado. Esta segunda parte la hace CreateLambda().

Se retorna la celda.

Probando las funciones lambda

Usamos el intérprete interactivo para probar las funciones lambda. Primero crearemos una. Como ya teníamos hecha una función de suma, la utilizaremos para hacer la función doble. Escribimos que queremos una función que toma un argumento x y devuelve la suma de x con x.

> (lambda (x) (add x x))

El resultado de evaluar esta expresión S será un valor de tipo CT_LAMBDA. Un objeto lambda que no es más que la función lambda que toma un x y devuelve la suma de x con x. Dependiendo de cómo hayamos hecho la impresión, la visualización de este valor podría ser

<lambda 003A7460 <envir 003A6950> (x) ((add x x))>

Lo interesante de las funciones lambda no es crearlas, es aplicarlas. Calculemos el doble de siete.

> ( (lambda (x) (add x x)) 7 )

14

Vistas así las funciones lambda no son más que una substitución (la regla beta o beta reduccción). Sustituimos x por 7 en (add x x). El resultado es (add 7 7) que evalúa a 14.

Las funciones lambda son muy interesantes porque tienen gran expresividad. Entre otras cosas son Turing completas y podemos expresar algoritmos no decidibles con ellas. Por ejemplo, la forma más rápida de colgar el ordenador es el siguiente bucle infinito.

> ( (lambda (x) (x x)) (lambda (x) (x x)) )