Скорее "для себя". Классы в скриптовой машине

Классы в скриптовой машине.

Вот тут - http://programmingmindstream.blogspot.ru/2014/01/blog-post_9030.html я писал "абстрактно", теперь напишу "конкретно"

Определение класса:

class TPoint

 INTEGER VAR X
 INTEGER VAR Y

 BOOLEAN FUNCTION Compare
  TPoint IN anOther
  Result := ( Self . X = anOther . X ) AND ( Self . Y = anOther . Y )
 ; // Compare

; // TPoint

Его использование:

TPoint VAR A := new TPoint
  A . X := 10
  A . Y := 20

TPoint VAR B := new TPoint
  B . X := 100
  B . Y := 200

A . Compare B WriteLn
 // - будет напечатано false

Как это "устроено изнутри":

[:] .
 // Определяем оператор .
 // [:] - означает, что определяется слово выполняемое при компиляции

 OBJECT VAR l_LeftParam := LastCompiledWord
 // - получаем слово, которое было скомпилировано перед вызовом нашего

 STRING VAR l_FieldName := NextToken
 // - выбираем следующий токен из входного потока

 ASSERT ( l_LeftParam ClassType HasMember l_FieldName Cat [ 'Класс не имеет члена: ' l_FieldName ] )
 // - проверяем, что на классе есть член с указанным именем

 OBJECT VAR l_Field := ( l_LeftParam ClassType GetMember l_FieldName )
 // - берём описатель члена класса

 CompileWord l_FieldName
 // - компилируем имя поля

 if ( l_Field IsVar ) then
 begin
  if ( NextToken = ':=' ) then
  begin
   // - это оператор присваивания
   OBJECT VAR l_ValueCode := CompileNextWord
   // - компилируем код ОДНОГО слова справа от нас
   CompileWord l_ValueCode
   // - копилируем код значения
   CompileWord @ SetFieldValue
   // - компилируем код установки значения
  end
  else
  begin
   UngetToken
   // - возвращаем токен во входной поток ибо он нам "не подошёл"
   CompileWord @ GetFieldValue
   // - компилируем код установки значения
  end
 end
 else
 if ( l_Field IsMethod ) then
 begin
  INTEGER VAR l_RightParamsCount := ( l_Field RightParamCount )
  // - получаем число "правых" параметров классового метода
  ARRAY VAR l_ParamsCode := [ l_RightParamsCount LOOP CompileNextWord ]
  // - компилируем l_RightParamsCount слов за нами и получаем их код в качестве массива
  CompileWord l_ParamsCode
  // - компилируем код параметров
  CompileWord @ Call
  // - компилируем функцию вызова метода
 end
 else
  ASSERT ( false 'Непонятный тип члена класса' )
; // .

Т. е. код:

  B . X := 100
  B . Y := 200
 A . Compare B WriteLn

Разворачивается в такой:

  B 'X' @ ( 100 ) SetFieldValue
  B 'Y' @ ( 200 ) SetFieldValue
 A 'Compare' [ B ] Call  WriteLn

А код:

 BOOLEAN FUNCTION Compare
  TPoint IN anOther
  Result := ( Self . X = anOther . X ) AND ( Self . Y = anOther . Y )
 ; // Compare

Разворачивается в такой:

 BOOLEAN FUNCTION Compare
  TPoint IN anOther
  Result := ( ( Self 'X' GetFieldValue ) = ( anOther 'X' GetFieldValue ) ) AND ( ( Self 'Y' GetFieldValue ) = ( anOther 'Y' GetFieldValue ) )
 ; // Compare

Дальше наверное надо описать как выглядят GetFieldValue, SetFieldValue и Call.

А также - как выглядит new.

Ну и конечно это всё - "навскидку". Можно тут оптимизировать - уходя от ИМЁН членов в реально скомпилированном коде.

Но там "не всё так просто".

Я ещё про VIRTUAL и OVERRIDE не написал.

GetFieldValue и SetFieldValue на самом деле выглядят просто:

: GetFieldValue
 OBJECT IN anInstance
 STRING IN aFieldName
 anInstance GetMember aFieldName DO
 // - берём ссылку на член класса и выполняем её
; // GetFieldValue

: SetFieldValue
 OBJECT IN anInstance
 STRING IN aFieldName
 OBJECT IN aValue
 anInstance GetMember aFieldName ^:= ( aValue DO )
 // - берём ссылку на член класса и прописываем в неё вычисленное значение aValue
; // GetFieldValue

Call тоже не выглядит уж очень сложным:

: Call
 OBJECT IN anInstance
 STRING IN aMethodName
 ARRAY IN aParam
 anInstance
 // - кладём ссылку на экземпляр на стек
 aParam ITERATE ( IN aParam aParam DO )
 // - вычисляем параметры и кладём их на стек
 anInstance GetMember aMethodName DO
 // - берём ссылку на член класса и выполняем её
; // GetFieldValue

Сложнее всего с new...

На самом деле тут используется "создание по образцу" (или по прототипу):

OBJECT WordWorker new
 ^ OBJECT IN aClass
 Result := ( class:TCompiledWord .Create )
 // - создаём РЕАЛЬНЫЙ класс приложения - TCompiledWord
 ARRAY VAR l_Members := aClass MembersIterator
 for l_Members ( 
  OBJECT IN aMember
  if ( aMember IsVar ) then
  begin
   Result -> ( aMember Name )
   // - создаём ссылку на НОВУЮ переменную
   ^ := ( aMember DO )
   // - инициализируем её значением по-умолчанию
  end
 )
; // new

Как выглядит .Create? Вот он как раз - "зашит в аксиоматике скриптовой машины".

Теперь как выглядят HasMember и GetMember:

BOOLEAN FUNCTION HasMember
 OBJECT IN aClass
 ^ STRING IN aMemberName
 Result := false
 for ( aClass MembersIterator ) (
  OBJECT IN aMember
  if ( aMember WordName = ( aMemberName DO ) ) then
  begin
   Result := true
   break
  end
 )
; // HasMember

OBJECT FUNCTION GetMember
 OBJECT IN aClass
 ^ STRING IN aMemberName
 Result := nil
 for ( aClass MembersIterator ) (
  OBJECT IN aMember
  if ( aMember WordName = ( aMemberName DO ) ) then
  begin
   Result := aMember
   break
  end
 )
; // GetMember

Теперь как выглядит оператор ->:

OBJECT FUNCTION ->
 OBJECT IN aClass
 ^ STRING IN aMemberName
 Result := nil
 for ( aClass MembersIterator ) (
  OBJECT IN aMember
  if ( aMember WordName = ( aMemberName DO ) ) then
  begin
   Result := aMember
   break
  end
 )
 Result := ( aClass AddVar aMemberName )
; // GetMember

Как выглядит AddVar? Вот он как раз - "зашит в аксиоматике скриптовой машины".