LISPообразное нечто

Возился немного с задачами курса Programming Languages и захотелось попробовать сделать на Delphi интерпретатор простого языка. Отбирать хлеб у MS и Embarcadero я не хочу, поэтому не буду даже пытаться что-то оптимизировать и тип данных будет только один — целые числа. Синтаксис пусть будет похож на LISP.

Назвал я этот язык гордым именем PDSL, что означает — PseudoDSL.

Так вот. Каждый элемент этого языка будет выражением, которое можно вычислить. То есть, грубо говоря, процедур не будет, будут только функции.

Простейшее выражение — это целое число, которое вычисляется само в себя:

(Number 5) -> (Number 5)

Другие выражения, должны быть более полезными. Например, функция Add должна работать примерно так:

(Add (Number 2) (Number 3)) -> (Number 5)

или так:

(Add (Number 2) (Add (Number 1) (Number 3))) -> (Number 6)

Очевидно, степень вложенности может быть любой и прежде, чем вычислить выражение, нужно вычислить его параметры. Мы имеем дело с деревом и вычислять его нужно рекурсивно.

Так как речь, напомню, о Delphi, то все выражение можно представить в виде дерева объектов, реализующих такой интерфейс:

IExpression = interface
  function Evaluate: IExpression;
end;

Объекты для примеров выше у меня выглядят примерно так (я не буду вдаваться в подробности, полный код можно скачать :)

constructor TNumber.Create(AValue: Integer);
begin
  inherited Create;
  FValue := AValue;
end;

function TNumber.Evaluate: IExpression;
begin
  Result := Self;
end;

Т.е. число держит в себе значение и возвращает само себя при вычислении.

С Add чуть сложнее. Объект принимает два выражения. И при вычислении сначала вычисляет их, а затем их сумму.

constructor TAdd.Create(AValue1, AValue2: IExpression);
begin
  inherited Create;
  FExprs.Add(AValue1);
  FExprs.Add(AValue2);
end;

function TAdd.Evaluate: IExpression;
var
  Expr1, Expr2: IExpression;
  Val1, Val2: IHasValue;
begin
  Expr1 := FExprs[0].Evaluate;
  Expr2 := FExprs[1].Evaluate;

  if Supports(Expr1, IHasValue, Val1) and Supports(Expr2, IHasValue, Val2) then
    Result := TNumber.Create(Val1.Value + Val2.Value)
  else
    raise EExprException.Create('Invalid expression applied to TAdd');
end;

Здесь интерфейс IHasValue используется для проверки, является ли выражение конечным значением и собственно для получения этого значения.

IHasValue = interface
  ['{567A6313-3ABE-4620-9560-64F93BC4979A}']
  function GetValue: Variant;
  property Value: Variant read GetValue;
end;

Этот интерфейс реализован в объекте TNumber. Тип у нас один, но на всякий случай я решил подойти к вопросу более универсально. То есть не так сложно будет добавить и другие типы в язык.

Так же для удобства я завел функции-конструкторы. Ничего особенного они не делают, но мне с ними немного удобнее.

function Number(AValue: Integer): IExpression;
begin
  Result := TNumber.Create(AValue);
end;

function Add(Expr1, Expr2: IExpression): IExpression;
begin
  Result := TAdd.Create(Expr1, Expr2);
end;

Так же, для удобства отладки я добавил в интерфейс IExpression свойство AsString, которое возвращает описание объекта в виде строки, например:

function TNumber.GetAsString: string;
begin
  Result := Format('(%s %d)', [Self.ClassName, FValue]);
end;

Это относится и к TAdd, и к будущим объектам, я не буду больше подробно на этом моменте останавливаться.

Этого должно быть достаточно, чтобы вычислить один из примеров выше.

var
  Test: IExpression;
begin
  Test := Add(Number(2), Add(Number(1), Number(3)));
  Edit1.Text := Test.AsString;
  Edit2.Text := Test.Evaluate.AsString;
end;

После выполнения этого кода в Edit1 мы видим:

(TAdd (TNumber 2) (TAdd (TNumber 1) (TNumber 3)))

Все правильно. А в Edit2:

(TNumber 6)

Бинго! :)

Все это очень приятно, но практически бесполезно.
Что отличает настоящий язык программирования, от того, что мы имеем? Главное отличие в том, что для того, чтобы двигаться чуть дальше совсем простых примеров, кроме синтаксического дерева нужны переменные, нужны области видимости. То есть код выполняется не сам по себе, он выполняется в рамках некоего окружения.

Давайте подумаем о переменных и области видимости. Что такое переменная? У нее есть имя и значение. Т.е. это пара — имя и связанное с ним выражение (в нашем языке всё — выражения, помните? :)
Здесь мне понадобился вот такой интерфейс:

IEnvironment = interface
  function GetValue(const AName: string): IExpression;
  function SetValue(const AName: string; AExpr: IExpression): IEnvironment;
end;

С GetValue все понятно, а на SetValue я остановлюсь чуть подробнее. Так как мы говорили об областях видимости, давайте договоримся, что если мы объявляем переменную, то она видима текущему узлу дерева и тем, кто ниже, но не тем, кто выше. Поэтому, чтобы не испортить окружение того, кто нас вызвал, объявляя переменную, мы по сути создаем новую копию окружения и отправляем его в его собственную независимую жизнь в рамках текущей области видимости.

Реализована эта функция у меня вот так. В лоб, никакой магии. Оптимальнее было бы не делать полную копию, но к этому я пока не стремлюсь.

function TEnvironment.SetValue(const AName: string; AExpr: IExpression): IEnvironment;
var
  EnvPair: TPair<string, IExpression>;
  NewEnv: TEnvironment;
begin
  NewEnv := TEnvironment.Create;
  for EnvPair in FEnv do
    NewEnv.FEnv.Add(EnvPair.Key, EnvPair.Value);
  NewEnv.FEnv.AddOrSetValue(AName, AExpr);

  Result := NewEnv;
end;

Так как теперь каждое выражение при вычислении должно учитывать свое окружение, то интерфейс IExpression придется слегка изменить:

IExpression = interface
  function GetAsString: string;

  function Evaluate: IExpression; overload;
  function Evaluate(Env: IEnvironment): IExpression; overload;

  property AsString: string read GetAsString;
end;

Evaluate оставшийся без параметров — это ничего особенного, просто возможность вычислить нечто с пустым окружением. Это понадобится, например, при запуске программы.

function TExpression.Evaluate: IExpression;
begin
  Result := Evaluate(TEnvironment.Create);
end;

Так как у нас теперь все есть, давайте сделаем переменные.

constructor TVariable.Create(AName: string);
begin
  inherited Create;
  FName := AName;
end;

function TVariable.Evaluate(Env: IEnvironment): IExpression;
begin
  Result := Env.GetValue(FName);
end;

Объект просто хранит свое имя, а при вычислении возвращает связанное с ним выражение из окружения. Переменные теперь есть, но по-прежнему нет синтаксиса для их объявления.

Предлагаю использовать lisp-оподобную функцию let. Семантика ее такова: (let [varname varvalue] body). Данная функция связывает имя varname с выражением varvalue, а затем возвращает результат вычисления выражения body, естественно вычисляя его в только что созданном новом окружении. Если еще не понятно, скоро станет понятно :)

constructor TLet.Create(const AVarName: string; AVarValue, ABody: IExpression);
begin
  inherited Create;
  FVarName := AVarName;
  FExprs.Add(AVarValue);
  FExprs.Add(ABody);
end;

function TLet.Evaluate(Env: IEnvironment): IExpression;
var
  VarValue: IExpression;
begin
  VarValue := FExprs[0].Evaluate(Env);
  Result := FExprs[1].Evaluate(Env.SetValue(FVarName, VarValue));
end;

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

Настало время небольшого теста:

var
  Test: IExpression;
begin
  Test := Let('N', Number(5),
              Add(Variable('N'), Add(Number(1), Number(3))));
  Edit1.Text := Test.AsString;
  Edit2.Text := Test.Evaluate.AsString;
end;

В Edit1 видим:

(TLet [N (TNumber 5)] (TAdd (TVariable N) (TAdd (TNumber 1) (TNumber 3))))

А в Edit2:

(TNumber 9)

Ура :)

Но это еще не все. Полезному языку не помешали бы функции. Давайте подумаем о них. Для простоты пусть у функций будет только один параметр. На самом деле, это не накладывает вообще никаких ограничений на язык, но это сейчас не важно. Идем дальше. Во-первых, функции нужно объявлять, во-вторых — вызывать. Это два разных действия. Пусть это будут TDefineFunc и TCallFunc.

Очевидно, функция — это выражение. То есть те переменные, что мы имеем — это вполне себе функции, только без параметров. Разница еще и в том, что значение переменной мы вычисляем сразу, а в вычислении значения функции в момент ее объявления смысла мало. Еще один важный нюанс заключается в том, что функция должна вычисляться в рамках окружения, в котором она была объявлена (плюс значение параметра, конечно), а не в рамках окружения, в котором она была вызвана. Это так называемый lexical scope — подход принятый в большинстве языков программирования.

Это приводит нас к простой мысли. В результате вычисления TDefineFunc должен получаться некий объект, хранящий в себе тело функции, информацию об окружении и конечно имя параметра. И затем уже вычисляя TCallFunc в применении к этому объекту, мы присвоим параметру значение и получим результат. Пусть этот «некий» объект будет называться TClosure.

constructor TClosure.Create(AFunc: IExpression; AEnv: IEnvironment; const AParamName: string);
begin
  inherited Create;
  FEnv := AEnv;
  FParamName := AParamName;
  FExprs.Add(AFunc);
end;

function TClosure.EvaluateClosure(AParamValue: IExpression): IExpression;
begin
  Result := FExprs[0].Evaluate(FEnv.SetValue(FParamName, AParamValue));
end;

Как я выше и говорил, он осведомлен об окружении, имени параметра, а так же имеет ссылку на тело функции. Метод Evaluate в данном случае другой, т.к. окружение здесь свое собственное и требуется получить значение параметра функции извне.

Таким образом, TDefineFunc выглядит проще некуда:

constructor TDefineFunc.Create(const AParamName: string; ABody: IExpression);
begin
  inherited Create;
  FParamName := AParamName;
  FExprs.Add(ABody);
end;

function TDefineFunc.Evaluate(Env: IEnvironment): IExpression;
begin
  Result := TClosure.Create(FExprs[0], Env, FParamName);
end;

А TCallFunc немного сложнее:

constructor TCallFunc.Create(const AFuncName: string; AParamValue: IExpression);
begin
  inherited Create;
  FFuncName := AFuncName;
  FExprs.Add(AParamValue);
end;

function TCallFunc.Evaluate(Env: IEnvironment): IExpression;
var
  FuncExpr, ParamVal: IExpression;
  Closure: IClosure;
begin
  ParamVal := FExprs[0].Evaluate(Env);
  FuncExpr := Env.GetValue(FFuncName);

  if Supports(FuncExpr, IClosure, Closure) then
    Result := Closure.EvaluateClosure(ParamVal)
  else
    raise EExprException.Create('Invalid expression applied to TCallFunc');
end;

TCallFunc принимает имя функции и параметр, находит соответствующий TClosure привязанный к переменной в окружении, и затем вычисляет его значение, передавая параметр.

Еще один тест:

var
  Test: IExpression;
begin
  Test := Let('Add2', DefineFunc('N', Add(Variable('N'), Number(2))),
              CallFunc('Add2', Number(3)));
  Edit1.Text := Test.AsString;
  Edit2.Text := Test.Evaluate.AsString;
end;

Т.е. объявляем функцию с параметром N возвращающую N+2, привязываем ее к имени Add2, затем вызываем ее с параметром равным 3. Результат, очевидно, должен быть равным 5.

В Edit1:

(TLet [Add2 (TDefineFunc N (TAdd (TVariable N) (TNumber 2)))] (Add2 (TNumber 3)))

В Edit2:

(TNumber 5)

Ура! :)

Многое уже можем :) Но признаюсь, что начальной моей целью было написать хотя бы вычисление факториала. В данной реализации языка этого сделать нельзя. Почему? Потому что он не поддерживает рекурсию. В момент объявления функции в текущем окружении нет никакой информации о ней самой, она появляется в окружении только после этого. То есть, имея только копию окружения до объявления функции, функция не в состоянии вызвать саму себя.

В связи с этим я немного изменил ход вычисления Let.

function TLet.Evaluate(Env: IEnvironment): IExpression;
var
  VarValue: IExpression;
  Closure: IClosure;
begin
  VarValue := FExprs[0].Evaluate(Env);
  if Supports(VarValue, IClosure, Closure) then
    Closure.Env := Closure.Env.SetValue(FVarName, VarValue);

  Result := FExprs[1].Evaluate(Env.SetValue(FVarName, VarValue));
end;

То есть в окружение TClosure добавляется информации о самой переменной, к которой TClosure привязан.

Настало время финального теста. Не буду останавливаться подробно на добавленных операциях сделанных по образу и подобию функции Add:

function TSub.Evaluate(Env: IEnvironment): IExpression;
var
  Expr1, Expr2: IExpression;
  Val1, Val2: IHasValue;
begin
  Expr1 := FExprs[0].Evaluate(Env);
  Expr2 := FExprs[1].Evaluate(Env);

  if Supports(Expr1, IHasValue, Val1) and Supports(Expr2, IHasValue, Val2) then
    Result := TNumber.Create(Val1.Value - Val2.Value)
  else
    raise EExprException.Create('Invalid expression applied to TSub');
end;

function TMul.Evaluate(Env: IEnvironment): IExpression;
var
  Expr1, Expr2: IExpression;
  Val1, Val2: IHasValue;
begin
  Expr1 := FExprs[0].Evaluate(Env);
  Expr2 := FExprs[1].Evaluate(Env);

  if Supports(Expr1, IHasValue, Val1) and Supports(Expr2, IHasValue, Val2) then
    Result := TNumber.Create(Val1.Value * Val2.Value)
  else
    raise EExprException.Create('Invalid expression applied to TMul');
end;

// возвращает 1, если выражения равны или 0, если нет
function TEquals.Evaluate(Env: IEnvironment): IExpression;
var
  Expr1, Expr2: IExpression;
  Val1, Val2: IHasValue;
begin
  Expr1 := FExprs[0].Evaluate(Env);
  Expr2 := FExprs[1].Evaluate(Env);

  if Supports(Expr1, IHasValue, Val1) and Supports(Expr2, IHasValue, Val2) then
  begin
    if Val1.Value = Val2.Value then
      Result := TNumber.Create(1)
    else
      Result := TNumber.Create(0);
  end
  else
    raise EExprException.Create('Invalid expression applied to TEquals');
end;

// IfThenElse e1 e2 e3
// Возвращает значение e2, если e1 > 0, иначе e3
function TIfThenElse.Evaluate(Env: IEnvironment): IExpression;
var
  Expr1: IExpression;
  Val1: IHasValue;
begin
  Expr1 := FExprs[0].Evaluate(Env);

  if Supports(Expr1, IHasValue, Val1) then
  begin
    if Val1.Value > 0 then
      Result := FExprs[1].Evaluate(Env)
    else
      Result := FExprs[2].Evaluate(Env);
  end
  else
    raise EExprException.Create('Invalid expression applied to TIfThenElse');
end;

Ну и наконец сам тест. Вроде бы все очевидно. Объявлена рекурсивная функция Factorial и вызвана с параметром 10.

var
  Test: IExpression;
begin
  Test := Let('Factorial',
    DefineFunc('N', IfThenElse(Eq(Variable('N'), Number(0)),
                               Number(1),
                               Mul(Variable('N'), 
                                   CallFunc('Factorial', Sub(Variable('N'), Number(1)))))),
    CallFunc('Factorial', Number(10)));
  Edit1.Text := Test.AsString;
  Edit2.Text := Test.Evaluate.AsString;
end;

В Edit2 видим «(TNumber 3628800)». Как раз то, чего я хотел.

Следующий шаг — это уже дать возможность пользователю написать что-то вроде:

Let(Factorial,
    DefineFunc(N, IfThenElse(Eq(N, 0),
                             1,
                             Mul(N, Factorial(Sub(N, 1))))),
    Factorial(10))

разобрать этот текст автоматически, построить синтаксическое дерево и вычислить. Возможно, в следующей серии. Подобный однообразный синтаксис парсить достаточно просто. Можно пойти дальше и сделать синтаксис более дружелюбным, здесь уже на что фантазии хватит. Лично мне приятнее было бы читать функцию вот так:

let
  fun Factorial N =
    if Eq(N, 0) then 1 else Mul(N, Factorial(Sub(N, 1))
do
    Factorial(10)
end

Думаю, очевидно, что семантика все еще полностью совпадает с описанным здесь языком. Но это уже совсем другой вопрос.

И можно наконец уже скачать весь пример :)