Написание интерпретатора схемы с помощью FPC: размещение и указатели

Будучи историком, пишу интерпретатор схемы в FPC оказывается уже на первом этапе для меня серьезной задачей. :) Я слежу за блогом Питера Мишо, , который показал, как это сделать на C (есть также перевод на Ada, который может быть полезен для Pascal).

Рассмотрим эти две функции в C из работы Мишо (v 0.1):

object *alloc_object(void) {
    object *obj;

    obj = malloc(sizeof(object));
    if (obj == NULL) {
        fprintf(stderr, "out of memory\n");
        exit(1);
    }
    return obj;
}

object *make_fixnum(long value) {
    object *obj;

    obj = alloc_object();
    obj->type = FIXNUM;
    obj->data.fixnum.value = value;
    return obj;
}

Насколько я понимаю (только базовые навыки чтения на C), конструктор make_fixnum возвращает указатель на структуру (размеченные данные типа fixnum); для созданного объекта должна быть выделена память (спасибо @David Heffernan за его точка вчера).

Это мой перевод на FPC, который компилируется без ошибок:

program scheme;

type
   TTag = (ScmFixnum);
   PScmObject = ^TScmObject;
   TScmObject = record
      case ScmObjectTag: TTag of
         ScmFixnum: (ScmObjectFixnum: integer);
      end;

var Test: PScmObject = nil;

procedure AllocateObject(x: PScmObject);
begin
    new(x);
end;

function MakeFixnum(x: integer): PScmObject;
var
   fixnum: PScmObject = nil;
begin
   AllocateObject(fixnum);
   fixnum^.ScmObjectTag := ScmFixnum;
   fixnum^.ScmObjectFixnum := x;
   MakeFixnum := fixnum;
end;

begin
   Test := MakeFixnum(1);
   writeln(Test^.ScmObjectTag);
   writeln(Test^.ScmObjectFixnum);
end.

Однако...:

$ ./test 
Runtime error 216 at $080480DD
  $080480DD
  $08048117
  $08063873

Я подозреваю, что в том, как я использую и ссылаюсь на указатели, есть серьезная ошибка.

Большое спасибо всем, кто помогает мне понять, как работает этот указатель и память (ссылки на часто задаваемые вопросы, статьи и т. д. также приветствуются).


delphi pascal freepascal scheme sicp
person Community    schedule 05.01.2013    source источник
comment
AllocateObject действительно должен быть функцией   -  person David Heffernan    schedule 06.01.2013

Ответы (1)


arrow_upward
6
arrow_downward

Ваша функция AllocateObject неверна. Он создает новый объект в переменной x, но не передает созданный объект в вызывающую функцию, так как вызывается по значению. Если вы измените соглашение о вызовах, оно будет работать:

 procedure AllocateObject(out x: PScmObject);
 begin 
    new(x);
 end;

Если вы посмотрите на переменную fixnum в отладчике, вы увидите, что она осталась нулевой.

Независимо от вашего вопроса, я не думаю, что стоит использовать записи в интерпретаторе. Вскоре это превращается в кошмар управления памятью (по крайней мере, это произошло в интерпретаторе, который я написал, когда он приблизился к 20 kloc, и мне пришлось заменить записи следующим образом:)

Вместо вашей записи

 PScmObject = ^TScmObject;
 TScmObject = record
    case ScmObjectTag: TTag of
       ScmFixnum: (ScmObjectFixnum: integer);
    end;

вы можете использовать классы, например:

TScmObject = class()
  function Tag: TTag; virtual; abstract;
  function Fixnum: integer; virtual; abstract;
end;
TScmObjectFixNum = class(TScmObject)
  function Tag: TTag; override;
  function Fixnum: integer; override;
private
  value: integer;
end;

function TScmObjectFixNum.Tag: TTag;
begin
  result := ScmFixnum; 
end;
function TScmObjectFixNum.Fixnum: integer; 
begin
  result := value; 
end;

Затем вы легко создаете его с помощью

 var x: TScmObject;
 x := TScmObjectFixNum.create() ;
 if x.tag = scmfixnum (* or x is TScmObjectFixNum *) then
    ... x.scmfixnum ...
 x.free

Если в реализации вашей схемы нет циклических ссылок, вы даже можете использовать интерфейсы. Затем он подсчитывается и автоматически освобождается:

IScmObject = interface
  function Tag: TTag;
  function Fixnum: integer;
end;
TScmObject = class(TInterfacedObject, IScmObject)
  function Tag: TTag; virtual; abstract;
  function Fixnum: integer; virtual; abstract;
end;
TScmObjectFixNum = class(TScmObject)
  function Tag: TTag; override;
  function Fixnum: integer; override;
private
  value: integer;
end;



 var x: IScmObject;
 x := TScmObjectFixNum.create() ;
 if x.tag = scmfixnum (* or x is TScmObjectFixNum *) then
    ... x.scmfixnum ...
 //x.free no longer necessary (or allowed)!
person BeniBela    schedule 05.01.2013
comment
Большое спасибо за ваши усилия! Ваша реализация с классами кажется простой, я попробую. Еще один вопрос: что именно подразумевается под «циклическими ссылками», о которых вы говорили? - person ; 06.01.2013
comment
С интерфейсом объект автоматически удаляется, когда на него не указывает ссылка. Таким образом, вы можете написать var a,b: ISomething; a := TSomething.create; b := a; a := nil; и получить единственный указатель на объект в b . Если вы пишете b := nil;, объект уничтожается. | Но если есть циклическая ссылка, то есть что-то, указывающее на объект, и объект, указывающий на что-то, что не работает, поскольку ссылки никогда не будут нулевыми. Например. если вы внедрили минусы, у вас может быть b = cons(b, b), тогда b указывает на себя и никогда не уничтожается (но если ваши минусы делают копию, все в порядке) - person BeniBela; 06.01.2013