вторник, 30 июня 2015 г.

Ссылка. here's still things I don't understand with Generic :/

https://plus.google.com/u/0/+PaulTOTH/posts/5BVhKN9Fw4C?cfem=1

Цитата:

"
here's still things I don't understand with Generic :/

type
  TValues<T> = array of record
    Key  : string;
    Value: T;
  end;//TValues<T>

  TIntegerValues = TValues<Integer>;

procedure TForm1.FormCreate(Sender: TObject);
var
  V: TIntegerValues;
begin
  SetLength(V, 1);
  V[0].Key := 'TEST';
  V[0].Value := 1;  // E2010 Incompatible types 'T' and 'Integer'
end;

"

Это ПРАВДА так?

Где тут "Incompatible types"?

Чего я не вижу?

(+) Только код. Коллекции от Embarcadero. Это что-то
(+) Generic'и в Delphi и шаблоны в C++. Коротко. Напишу грубость
(+) Про "примеси", шаблоны и Generic'и
(+) Про "примеси", шаблоны и Generic'и №2
(+) Containers 3. Generics and without Generics...

https://quality.embarcadero.com/browse/RSP-11388

понедельник, 29 июня 2015 г.

ToDo. Завершать FORWARD-декларацию слова, как только появился правый или левый параметр

ToDo.

Завершать FORWARD-декларацию слова, как только появился правый или левый параметр.

FORWARD X

operator X
 IN A // - тут не завершаем
 IN B // - тут тоже не завершаем
 ^@ IN C // - тут завершаем
; // X

И:

FORWARD X

operator X
 IN A // - тут не завершаем
 IN B // - тут тоже не завершаем
 ^ IN C // - тут завершаем
; // X

Зачем?

Чтобы можно было написать так:

FORWARD X

operator X
 IN A // - тут не завершаем
 IN B // - тут тоже не завершаем
 ^ IN C // - тут завершаем
 
 procedure Y
  1 2 X 3 // - тут наш оператор УЖЕ определён, с ПОЛНОЙ сигнатурой
 ; // Y
; // X

Или так:

FORWARD X

operator X
 IN A // - тут не завершаем
 IN B // - тут тоже не завершаем
 ^@ IN C // - тут завершаем
 
 procedure Y
  1 2 3 X // - тут наш оператор УЖЕ определён, с ПОЛНОЙ сигнатурой
 ; // Y
; // X

Ну и конечно так:

FORWARD X

operator X
 IN A // - тут не завершаем
 IN B // - тут тоже не завершаем
 ^@ IN C // - тут завершаем
 
 1 2 3 X // - тут наш оператор УЖЕ определён, с ПОЛНОЙ сигнатурой
 // - вызываем САМИ себя !!! С ПОЛНОЙ сигнатурой
; // X

Но!

ТОЛЬКО если X - НЕ Immediate.

А если Immediate, то СРАЗУ ругаться:

FORWARD X

IMMEDIATE operator X // - тут СРАЗУ ругаемся !!!
 IN A // - тут не завершаем
 IN B // - тут тоже не завершаем
 ^ IN C // - тут завершаем
; // X

Завершать определение ОБЯЗАТЕЛЬНО, через FinishDefinitionOfWord !!!

Чтобы правильно Runner создать.

Ну и НЕ ЗАБЫТЬ про ПОВТОРНЫЕ вызовы, чтобы ТАМ не создавать ДУБЛИКАТОВ.

Да! Не забыть про AddedParameters, Опять же. Чтобы НЕ БЫЛО дубликатов.

суббота, 27 июня 2015 г.

ToDo. Сделать тесты к скриптовым словам

Примерно так:

 operator EVAL
 // - оператор вычисляющий значение aWhat
  RIGHT IN aWhat
  aWhat |^ DO
 ; // EVAL 

  EVAL %Tests 'тесты к оператору EVAL'
  (
  // - это тесты к оператору EVAL
   : T1
    EVAL 1 PrintStack
   ; // T1

   : T2
    EVAL '2' PrintStack
   ; // T2

   : T3
    VAR X
    X := 1
    EVAL X PrintStack
   ; // T3

   : T4
    EVAL ( 123 456 ) PrintStack
   ; // T4

   : T5
    EVAL ( 123 456 + ) PrintStack
   ; // T5

   : T6
    EVAL ( 1 2 + ) == 3 ASSERTS
   ; // T6

   : T7
    EVAL ( 'A' 'B' Cat ) == 'AB' ASSERTS
   ; // T7

  ) // EVAL %Tests

И получаем поддерево тестов в DUnit:

EVAL - тесты к оператору EVAL
T1
T2
T3
T4
T5
T6
T7

Ну и "паранойя":

 + %Tests 'Тесты к оператору +'
 (
  : T1
   1 2 + == 3 ASSERT
  ; // T1

  : T2
   1 -2 + == -1 ASSERT
  ; // T2

  : T3
   VAR A A := 1
   VAR B B := 2
   A B + == 3 ASSERT
  ; // T3

  : T4
   VAR A A := 1
   VAR B B := 2
   VAR C C := 3
   A B + == C ASSERT
  ; // T4

 ) // + %Tests

И получаем поддерево тестов в DUnit:

+ - Тесты к оператору +
T1
T2
T3
T4

 ARRAY %Tests 'Тесты к оператору ARRAY'
 (
   : T1
    [ ] PrintStack
   ; // T1

   : T2
    [ 1 2 ] PrintStack
   ; // T2

   : T3
    [ 1 2 3 ] PrintStack
   ; // T3

   : T4
    [ 1 2 3 ] Revert PrintStack
   ; // T4

   : T5
    [ 1 2 2 3 1 3 5 6 7 ] RemoveDup PrintStack
   ; // T5

   : T6
    ARRAY VAR A
    A := [ 1 2 2 3 1 3 5 6 7 ] 
    A RemoveDup PrintStack
   ; // T6

   : T7
    ARRAY VAR A
    A := [ 1 2 2 3 1 3 5 6 7 ] 
    A RemoveDup ==> Print
   ; // T7

 ) // ARRAY %Tests

Надеюсь, что мысль понятна.

Есть функционал и есть "атомарные тесты" к нему.

Я думаю, что это "до меня" уже сотни людей придумали.

По-моему - прикольно. Главное, что всё почти уже реализовано.

Осталось только в DUnit зарегистрировать.

Т.е. в ЛЮБОМ приложении, которое включает в себя эти слова и DUnit - получаем отдельную ветку с тестами к словам.

Слово %Tests выглядит примерно так:

 VOID operator %Tests
  LEFT IN aWord
  RIGHT IN aDoc
  RIGHT IN aTests

  VAR l_Group

  DUnit:AddTestsGroup aWord aDoc >>> l_Group

  aCode MembersIterator ==> ( IN aTest
   l_Group DUnit:TestsGroup:AddTest aTest
  )
 ; // %Tests

+Михаил Костицын
+Виктор Морозов
+Vsevolod Leonov
+Igor Belyh
+Николай Зверев
+Yaroslav Brovin
+Денис Мартьянов
+Марин Мирою

Можно пойти дальше:

 'TControl' RTTIObject %Tests 'Тесты к классу TControl'
 (
  : T1
   OBJECT VAR l_Control
   'TControl' RTTIClass 'Create' RTTIConstructor RTTIExecute [ nil { - Это Owner} ] >>> l_Control
   CONST cName 'MyControl'
   'TControl' RTTIClass 'Name' RTTIProperty l_Control RTTISet [ cName { - Это значение Name } ]
   STRING VAR l_Name
   'TControl' RTTIClass 'Name' RTTIProperty l_Control RTTIGet >>> l_Name
   l_Name == cName ASSERT
  ; // T1
 )

пятница, 26 июня 2015 г.

Коротко. Ни о чём

Сегодня очередной раз допиливал свои скрипты и неожиданно понял, что наконец написал "язык", о котором "давно мечтал".

На котором "приятно" программировать.

Не нравится аксиоматика - меняем на лету.

Нужны тесты - делаем тесты.

Нужны предикаты - делаем предикаты.

Нужны примеси - вот тебе пожалуйста примеси.

Нужны контракты - вот тебе контракты.

Нужны прецеденты - пожалуйста прецеденты.

Нужен биндинг из UML - пожалуйста. Вот вам биндинг.

Всё на лету.

И всё в рамках минимальной аксиоматики. Из которой выводится любая другая аксиоматика.

Хочется дойти до отображения ТЗ на код.

четверг, 25 июня 2015 г.

Ссылки. Про АОП в дельфи. Любопытно по-моему

http://wiert.me/2015/06/24/aspect-oriented-programming-in-delphi/

https://bitbucket.org/NickHodges/nickdemocode/src/7b39c444825f/AOP/Code/?at=default

Ссылка. Пишем на JS в функционально-декларативном стиле

http://habrahabr.ru/post/260961/

Мдя...

Пишем функцию clone

clone = (some) -> 
    switch Object.prototype.toString.call(some)
        when "[object Undefined]" then undefined
        when "[object Boolean]" then some
        when "[object Number]" then some
        when "[object String]" then some
        when "[object Function]" then some.bind({})
        when "[object Null]" then null
        when "[object Array]" then some.map (el) -> clone(el)
        when "[object Object]" then Object.keys(some).reduce ((acc, k) -> acc[clone(k)] = clone(some[k]); acc), {}

опять промолчу...

"
~~Fortran~~Erlang-программист напишет ~~Fortran~~Erlang-программу на любом языке программирования? :)
"

О!

Ссылка. Использование монад в С++. Часть 1: монада списка

http://habrahabr.ru/company/infopulse/blog/260809/

Промолчу...

среда, 24 июня 2015 г.

Ещё одна ошибка EMBT. C Implicit

Ну и ещё вам коммит в тему - https://bitbucket.org/lulinalex/mindstream/commits/21ae139f9a346046ce90dbcc056f066f3033edc0

Почему-то без AsRef обойтись не удалось. Ошибка?

Ссылка. WorksPad

http://www.workspad.ru/

Ссылка. Корпоративная мобильная разработка (взгляд из Samsung)

http://blogs.embarcadero.com/vsevolodleonov/2015/06/23/enterprisemobility1/

Только код. Коллекции от Embarcadero. Это что-то

...

class procedure TArray.Copy<T>(const Source: array of T; var Destination: array of T; SourceIndex, DestIndex, Count: NativeInt);
begin
  CheckArrays(Pointer(@Source[0]), Pointer(@Destination[0]), SourceIndex, Length(Source), DestIndex, Length(Destination), Count);
  if IsManagedType(T) then
    System.CopyArray(Pointer(@Destination[DestIndex]), Pointer(@Source[SourceIndex]), TypeInfo(T), Count)
  else
    System.Move(Pointer(@Source[SourceIndex])^, Pointer(@Destination[DestIndex])^, Count * SizeOf(T));
end;

...

function TListHelper.GetElSize: Integer;
begin
  Result := PDynArrayTypeInfo(PByte(FTypeInfo) + PDynArrayTypeInfo(FTypeInfo).name).elSize;
end;

function TListHelper.GetElType: Pointer;
begin
  Result := PDynArrayTypeInfo(PByte(FTypeInfo) + PDynArrayTypeInfo(FTypeInfo).name).elType^;
end;

...

procedure TListHelper.InternalExchangeMRef(Index1, Index2: Integer; Kind: TTypeKind);
begin
  case Kind of
    TTypeKind.tkUString: DoExchangeString(Index1, Index2);
    TTypeKind.tkInterface: DoExchangeInterface(Index1, Index2);
    TTypeKind.tkVariant: DoExchangeVariant(Index1, Index2);
    TTypeKind.tkDynArray: DoExchangeDynArray(Index1, Index2);
{$IF Defined(AUTOREFCOUNT)}
    TTypeKind.tkClass: DoExchangeObject(Index1, Index2);
{$ENDIF}
{$IF not Defined(NEXTGEN)}
    TTypeKind.tkLString: DoExchangeAnsiString(Index1, Index2);
    TTypeKind.tkWString: DoExchangeWideString(Index1, Index2);
{$ENDIF}
  end;
end;

...

procedure TListHelper.InternalExtractItemMRef(const Value; Kind: TTypeKind; out Item; Direction: Byte);
begin
  case Kind of
    TTypeKind.tkUString:
      if Direction = Byte(TDirection.FromBeginning) then
        DoExtractItemFwdString(Value, Item)
      else
        DoExtractItemRevString(Value, Item);
    TTypeKind.tkInterface:
      if Direction = Byte(TDirection.FromBeginning) then
        DoExtractItemFwdInterface(Value, Item)
      else
        DoExtractItemRevInterface(Value, Item);
{$IF not Defined(NEXTGEN)}
    TTypeKind.tkString:
      if Direction = Byte(TDirection.FromBeginning) then
        DoExtractItemFwdAnsiString(Value, Item)
      else
        DoExtractItemRevAnsiString(Value, Item);
    TTypeKind.tkWString:
      if Direction = Byte(TDirection.FromBeginning) then
        DoExtractItemFwdWideString(Value, Item)
      else
        DoExtractItemRevWideString(Value, Item);
{$ENDIF}
{$IF Defined(AUTOREFCOUNT)}
    TTypeKind.tkClass:
      if Direction = Byte(TDirection.FromBeginning) then
        DoExtractItemFwdObject(Value, Item)
      else
        DoExtractItemRevObject(Value, Item);
{$ENDIF}
  end;
end;

...

procedure TListHelper.DoReverseMRef(Kind: TTypeKind);
var
  b, e: Integer;
begin
  b := 0;
  e := FCount - 1;
  while b < e do
  begin
    case Kind of
      TTypeKind.tkUString: DoExchangeStringInline(b, e);
      TTypeKind.tkInterface: DoExchangeInterfaceInline(b, e);
      TTypeKind.tkDynArray: DoExchangeDynArrayInline(b, e);
      TTypeKind.tkVariant: DoExchangeVariantInline(b, e);
{$IF not Defined(NEXTGEN)}
      TTypeKind.tkLString: DoExchangeAnsiStringInline(b, e);
      TTypeKind.tkWString: DoExchangeWideStringInline(b, e);
{$ENDIF}
{$IF Defined(AUTOREFCOUNT)}
      TTypeKind.tkClass: DoExchangeObjectInline(b, e);
{$ENDIF}
    end;
    Inc(b);
    Dec(e);
  end;
end;

...

function TList<T>.InternalCompare(const Left, Right): Integer;
begin
  Result := FComparer.Compare(T(Left), T(Right));
end;

procedure TList<T>.InternalNotify(const Item; Action: TCollectionNotification);
begin
  Notify(T(Item), Action);
end;

function TList<T>.ItemValue(const Item: T): NativeInt;
begin
  case SizeOf(T) of
    1: Result := PByte(@Item)[0] shl 0;
    2: Result := PByte(@Item)[0] shl 0 + PByte(@Item)[1] shl 8;
    3: Result := PByte(@Item)[0] shl 0 + PByte(@Item)[1] shl 8 + PByte(@Item)[2] shl 16;
{$IF SizeOf(Pointer) <= 4}
    4: Result := PByte(@Item)[0] shl 0 + PByte(@Item)[1] shl 8 + PByte(@Item)[2] shl 16 + PByte(@Item)[3] shl 24;
{$ELSE}
    4: Result := PByte(@Item)[0] shl 0 + PByte(@Item)[1] shl 8 + PByte(@Item)[2] shl 16 + PByte(@Item)[3] shl 24;
    5: Result := PByte(@Item)[0] shl 0 + PByte(@Item)[1] shl 8 + PByte(@Item)[2] shl 16 + PByte(@Item)[3] shl 24 +
       NativeInt(PByte(@Item)[4]) shl 32;
    6: Result := PByte(@Item)[0] shl 0 + PByte(@Item)[1] shl 8 + PByte(@Item)[2] shl 16 + PByte(@Item)[3] shl 24 +
       NativeInt(PByte(@Item)[4]) shl 32 + NativeInt(PByte(@Item)[5]) shl 40;
    7: Result := PByte(@Item)[0] shl 0 + PByte(@Item)[1] shl 8 + PByte(@Item)[2] shl 16 + PByte(@Item)[3] shl 24 +
       NativeInt(PByte(@Item)[4]) shl 32 + NativeInt(PByte(@Item)[5]) shl 40 + NativeInt(PByte(@Item)[6]) shl 48;
  else
    Result := PByte(@Item)[0] shl 0 + PByte(@Item)[1] shl 8 + PByte(@Item)[2] shl 16 + PByte(@Item)[3] shl 24 +
       NativeInt(PByte(@Item)[4]) shl 32 + NativeInt(PByte(@Item)[5]) shl 40 + NativeInt(PByte(@Item)[6]) shl 48 +
       NativeInt(PByte(@Item)[7]) shl 56;
{$ENDIF}
  end;
end;

...

Жутко от подобного кода не становится? Мне - становится...

Куда там Степанову с его STL.

А ведь наверное можно было сделать по-человечески.

(+) Generic'и в Delphi и шаблоны в C++. Коротко. Напишу грубость
(+) Про "примеси", шаблоны и Generic'и
(+) Про "примеси", шаблоны и Generic'и №2

shl 0
shl 8
shl 16

...

Хочется спросить - "ребята в каком веке мы живём"?

shl - это ДЕЙСТВИТЕЛЬНО нужно?

Особенно shl 0

...

Не понимаю...

Да и case SizeOf(T) of - доставляет...

Ссылка. Только код. Ещё примеры тестов

https://bitbucket.org/lulinalex/mindstream/raw/5477e8565c114596311e99523ee472846831bdaf/all.script

Только код. Примеры "высокоуровневых" тестов

Тест K127477158

 Параметры: ( "Очистить строку Базового Поиска" )
 Выполнить (
  "Ввести {('№ ! * 0123456789 ! * / | = > ? # $ % № ( ) ] [ [ \ _ " ` : . / @ * ')}"
  "Ввести {(''')}"
  // выше использован способ получить одинарную кавычку в контекст
  "Выделить и скопировать текущий текст"
  ППР
  "Перевести фокус в поле 'Слова в тексте' в ППР"
  "Вставить"
  "Игнорировать любую ошибку после действий" ( 
   "Нажать Искать" )
  "Сравнить с эталоном, что введено в поле 'Слова в тексте'"
 )
;

K127477158


Тест K136262540

 Параметры: ( "Открывать документы из списка в текущем окне" "Восстанавливать позицию мыши" )
 Выполнить ( 
  "Открываем НК"
  "Переключиться на вкладку {('Комментарии')}"
  "Найти документ {('Схема. Налоговый кодекс. НДФЛ. Налоговая база')} в списке и открыть его"
  "Назад по истории"
  "Переключиться на вкладку {('Комментарии')}"
  "Копировать"
  "Записать содержимое буфера в эталон"
 )
;

K136262540

Тест K138547857

 Выполнить (
  ППР
  "в поле 'Слова в названии' ввести {('Документ')}"
  "Установить фокус в поле 'Раздел/Тема' "
  "Ввести строку {('My Class A')}"
  "Нажать Искать"
  "Назад по истории"
  "Сравнить с эталоном введенный контекст в полях 'Слова в названии' и 'Раздел/Тема'"
 )
;

K138547857

Тест K161121041

 Выполнить (
  "Очистить журнал работы"
  "Открываем {(10003000)}"
  "Открываем {(2001)}"
  "Открываем {(2002)}"
  "Открываем {(2003)}"
  "Открываем {(2004)}"
  "Открываем {(2005)}"
  ОМ
  "Открываем {(10003000)}"
  ОМ
  "Сравнить список последних открытых документов с эталоном"
 )
;

K161121041

Тест K167353606

 Параметры: ( "Установить размер шрифта для экспорта и печати, как он отображается на экране" )
 Выполнить (
  "Поиск лекарственного средства"
  "Ввести строку {('хел')}"
  "Нажать Искать"
  "Предварительный просмотр с эталонами"
 )
;

K167353606

Тест K172363502

 Параметры: ( "Восстанавливать позицию мыши" )
 Выполнить (
  "Открываем {(12034870)}"
  СР
  "Потянуть вертикальный скроллер текущего контрола вниз до конца"
  "##Дать тесту время для отрисовки контролов"
  "Нажать {('Ctrl+Home')}"
  "Сравнить текущие абзацы обеих редакций с эталоном"
 )
;

K172363502

Тест K177537862

 Выполнить (
  "Список всех документов"
  "Обработать диалог Анализ списка модально" ( 
   "Сравнить элементы текущего дерева с эталоном без разворачивания папок"
  )
 )
;

K177537862

Тест K183337891

 Выполнить (
  "Открываем НК"
  75 раз ( "Перейти на параграф вниз" )
  "Дождаться переключения вкладок"
  СР
  "Вернуться в текст документа"
  "Выделить {(1)} параграфов"
  "Сравнить выделенный текст текущего редактора с эталоном"
 )
;

K183337891

Тест K185830873

 Выполнить (
  "Открываем {(5656383)}"
  "Открыть вкладку 'Редакции' и отметить редакцию {('10.07.2009 - 18.10.2009 (первоначальная) (от 28.06.2009)')}"
  "Сравнить выбранные редакции"
  "Сравнить {(5)} следующих изменений в СР с эталоном"
 )
;

K185830873

Тест K193823276

 Выполнить (
  "Установить документ {(79145)}  на контроль. Переключиться на ТБ27 и выполнить" (
   "Открыть вкладку 'Документы на контроле' и выполнить" (   
    "Открыть документ сразу в сравнении с предыдущей редакцией"
    "Сравнить текущие абзацы обеих редакций с эталоном"
    ОМ
    "##Дать тесту время для отрисовки контролов"
    // нельзя переключать базы находясь в СР, если редакция пропадает
   )
  )
 )
;

K193823276

Тест K200085315

 Параметры: ( "Выставить главной форме размеры {(1456 1000)}" "Переключиться на ТБ24" )
 Выполнить (
  "Открываем {(6086112)}"
  "Предварительный просмотр"
  "Нажать {('Esc')}"
  "Выполнить {(@ NOP)} с переключённой базой"
  "##Установить фокус в документ после переключения баз"
 )
;

K200085315

Тест K200085334

 Выполнить (
  "Открываем {(2008)}"
  "Предварительный просмотр"
  "Дать системе перерисоваться"
  "Нажать {('Esc')}"
  "Выполнить {(@ "Проверить, что удалось перевести фокус в оглавление")} с переключённой базой"
 )
;

K200085334

Только код. Ну и ещё определение аксиоматики

NamedWordProducer %IMPLEMENTS %R
// - список реализуемых элементов
//NamedWordProducer %INHERITS %G
// - список унаследованных элементов

NamedWordProducer %FORWARDS %F
// - список элементов которые должны быть определены ДО текущего

NamedWordProducer %TOBEINCLUDED %w
// - список элементов, которые должны буть включены для корректного определения данного

NamedWordProducer %RAISES %E

NamedWordProducer %RAISESINSET %Es

WordAlias %&& И
WordAlias %|| ИЛИ

WordAlias %! NOT
WordAlias %== =
WordAlias %!= <>

CONST "" ''
// - алиас пустой строки

USES
 'W:\shared\models\NewSchool\MDProcess.root.script'
;

/*{OBJECT FUNCTION %P IN %S
 VAR l_P
 l_P := ( %S pop:Word:Parent )
 if ( l_P pop:Word:Name '%C' SameText ) then
 ( 
  l_P := ( l_P pop:Word:Parent )
 ) 
 if ( l_P NotValid ) then
 (
  Result := nil
 ) 
 else
 (
  Result := l_P
 ) 
;}*/

/*{OBJECT FUNCTION %T IN %S
 VAR l_T
 l_T := ( %S ->^ '%T' )
 if ( l_T NotValid ) then
 (
  Result := nil
 ) 
 else
 (
  l_T := ( l_T DO )
  if ( l_T NotValid ) then
  (
   Result := nil
  ) 
  else
  (
   Result := l_T
  )
 )
;

STRING FUNCTION %TN IN %S
 Result := ( %S %T |N )
;

STRING FUNCTION %TS IN %S
 Result := ( %S %T |S )
;

STRING FUNCTION |U IN %S
 VAR l_U
 l_U := ( %S ->^ '%U' )
 if ( l_U NotValid ) then
 (
  Result := ''
 ) 
 else
 (
  Result := ( l_U DO |N )
 )
;}*/

STRING CallerWorker %SU
 Result := ( Caller ->0 |U )
;

OBJECT CallerWorker %S%P
 Result := ( Caller ->0 %P )
;

OBJECT CallerWorker %S%P%P
 Result := ( Caller ->0 %P %P )
;

OBJECT CallerWorker %S%P%P%P
 Result := ( Caller ->0 %P %P %P )
;

OBJECT CallerWorker %S%P%P%P%P
 Result := ( Caller ->0 %P %P %P %P )
;

OBJECT CallerWorker %S%P%P%P%P%P
 Result := ( Caller ->0 %P %P %P %P %P )
;

OBJECT FUNCTION DoMember OBJECT IN anUIDVar
 VAR l_Element
 anUIDVar DO =: l_Element
 // - берём ссылку на элемент модели
 if ( l_Element IsVoid ) then
 // - пропускаем невалидные ссылки
 (
  Result := nil
 )
 else
 (
  Result := l_Element
 ) 
; // DoMember

BOOLEAN FUNCTION FilterMember OBJECT IN aMember
 Result := ( aMember NotValid ! )
; // FilterMember
 
ARRAY FUNCTION ELEMLIST STRING IN aListName IN %S
 if ( %S NotValid ) then
  ( Result := [ ] )
 else
  (
   VAR l_List
   l_List := ( %S %% aListName )
   
   if ( l_List NotValid ) then
    ( Result := [ ] )
   else 
//    ( Result := ( [ l_List DO ] ) )
    ( Result := ( @ FilterMember ( @ DoMember ( l_List CodeIterator ) MAP ) FILTER ) ) 
  )
; // ELEMLIST

ARRAY FUNCTION %R IN %S
 Result := ( '%R' %S ELEMLIST )
;

ARRAY FUNCTION %G IN %S
 Result := ( '%G' %S ELEMLIST )
;

ARRAY FUNCTION %C IN %S
 Result := ( %S %% '%C' MembersIterator )
;

ARRAY CallerWorker %S%C
 Result := ( Caller ->0 %C )
;

ARRAY FUNCTION %Ops IN %S
 Result := ( %S %% '%Ops' MembersIterator )
;

ARRAY CallerWorker %S%Ops
 Result := ( Caller ->0 %Ops )
;

ARRAY FUNCTION %Attrs IN %S
 Result := ( %S %% '%Attrs' MembersIterator )
;

ARRAY CallerWorker %S%Attrs
 Result := ( Caller ->0 %Attrs )
;

ARRAY FUNCTION %Lnks IN %S
 Result := ( %S %% '%Lnks' MembersIterator )
;

ARRAY CallerWorker %S%Lnks
 Result := ( Caller ->0 %Lnks )
;

ARRAY CallerWorker %S%G
 Result := ( Caller ->0 %G )
;

ARRAY CallerWorker %S%R
 Result := ( Caller ->0 %R )
;

OBJECT CallerWorker %S%T
 Result := ( Caller ->0 %T )
;

ARRAY FUNCTION %A
 Result := ( @ FilterMember ( @ DoMember ( @ UIDS_LIST MembersIterator ) MAP ) FILTER )
; // %A

Ссылка. RSpec

http://rspec.info/

Ссылка. Ещё раз. Анти-паттерны Test Driven Development

http://habrahabr.ru/post/43761/

вторник, 23 июня 2015 г.

Offtopic. Про Нюрнберг

http://www.hrights.ru/text/koval/discuss18-06-03.htm

«С точки зрения права это чистое безобразие, это ведь суд победителей над побежденными, причем там даже не было попыток это скрыть. Какое тут равенство сторон? Это суд, который судил по специально для него написанным законам. Был сознательно нарушен фундаментальнейший, самый важный принцип права: закон не имеет обратной силы. Решили, что имеет. И вздернули людей, многие из которых поступали строго в соответствии с законами своей страны, действовавшими тогда. Ужасными законами, варварскими, но законами. Тем не менее найдите юриста, который сказал бы, что Нюрнбергский процесс — событие печальное, о нём следует сожалеть и признать, что он отодвинул нас назад. Ни один самый строгий юрист, понимающий все юридические недостатки Нюрнберга, не выступит таким образом»

https://ru.wikipedia.org/wiki/%D0%9A%D0%BE%D0%B2%D0%B0%D0%BB%D1%91%D0%B2,_%D0%A1%D0%B5%D1%80%D0%B3%D0%B5%D0%B9_%D0%90%D0%B4%D0%B0%D0%BC%D0%BE%D0%B2%D0%B8%D1%87

Только код. Определение аксиоматики моей скриптовой машины. На ней же

// Аксиоматика

IMMEDIATE OPERATOR ^L
 // - определяет ПРАВЫЙ параметр, который может быть как словом, так и неизвестным идентификатором
 //   L - сокращение типа от слова Literal
 //   При этом передаётся ссылка на ИСХОДНОЕ слово, а не на КОМПИЛИРОВАННУЮ последовательность.
 //   Это важно для ОПЕРАТОРОВ и WordWorker'ов.
 TtfwWordModifier::tfw_wmRightWordRef Ctx:IncludeModifier
 TtfwWordModifier::tfw_wmTreatUnknownAsString Ctx:IncludeModifier
; // ^L

IMMEDIATE OPERATOR BOOLEAN
 TtfwWordModifier::tfw_wmBool Ctx:IncludeModifier
; // BOOLEAN

IMMEDIATE OPERATOR CARDINAL
 TtfwWordModifier::tfw_wmInt Ctx:IncludeModifier
; // CARDINAL

IMMEDIATE OPERATOR INTEGER
 TtfwWordModifier::tfw_wmInt Ctx:IncludeModifier
; // INTEGER

IMMEDIATE OPERATOR STRING
 TtfwWordModifier::tfw_wmStr Ctx:IncludeModifier
; // STRING

IMMEDIATE OPERATOR ARRAY
 TtfwWordModifier::tfw_wmList Ctx:IncludeModifier
; // ARRAY

IMMEDIATE OPERATOR OBJECT
 TtfwWordModifier::tfw_wmObj Ctx:IncludeModifier
; // OBJECT

IMMEDIATE OPERATOR INTERFACE
 TtfwWordModifier::tfw_wmIntf Ctx:IncludeModifier
; // INTERFACE

IMMEDIATE OPERATOR CHAR
 TtfwWordModifier::tfw_wmChar Ctx:IncludeModifier
; // CHAR

IMMEDIATE OPERATOR CLASS
 TtfwWordModifier::tfw_wmClass Ctx:IncludeModifier
; // CLASS

INLINE OPERATOR then
  ^ IN aWhatToThen
 aWhatToThen DO
; // then

BOOLEAN FUNCTION NotValid IN %S
 if ( %S IsVoid ) then
  ( true >>> Result )
 else
 if ( %S pop:object:IsNil ) then
  ( true >>> Result )
 else 
  ( false >>> Result )
; // NotValid

BOOLEAN OPERATOR IS
  CLASS OBJECT IN anObj
  ^ IN aClass
 STRING CLASS VAR l_Class
 ( aClass DO ) >>> l_Class
 if ( anObj IsClass ) then
  ( ( l_Class anObj pop:class:Inherits ) >>> Result )
 else
  ( ( l_Class anObj pop:object:Inherits ) >>> Result )
; // IS

STRING FUNCTION |N

  /*OBJECT*/ IN %S

 if ( %S IsVoid ) then
  ( '' >>> Result )
 else
 if ( %S pop:object:IsNil ) then
  ( '' >>> Result )
 else
 if ( %S IS class::TkwString ) then
  ( %S DO >>> Result )
 else
 if ( %S IS class::TkwInteger ) then
  ( %S DO IntToStr >>> Result )
 else
 if ( %S IS class::TkwMain ) then
  ( %S pop:object:ClassName >>> Result )
 else
 if ( %S IS class::TkwCompiledMain ) then
  ( %S pop:object:ClassName >>> Result )
 else
  ( %S pop:Word:Name >>> Result )
; // |N

IMMEDIATE OPERATOR WordAlias
 ^L IN aName
 ^ LINK IN aCode
 aCode aName |N Define
; // WordAlias

NamedWordProducer %INHERITS %G
 // - список унаследованных элементов

WordAlias ITERATE Iterate
WordAlias WordWorker WORDWORKER

WordAlias operator OPERATOR

//   VOID operator :=
operator :=
// - пока так, иначе конструкция @ XXX -> A := 1024 - не работает, т.к. XXX снимается со стека уже в контексте := И срабатывает КОНТРОЛЬ СТЕКА   
  ^@ IN aLeft
  ^ IN aRight
 aRight DO >>>^ aLeft
;

VOID operator ^:=
  IN aLeft
  ^ IN aRight
 aRight DO >>>^ aLeft
;

VOID operator >>>[]
  IN aLeft
  ^ IN aRight
 aLeft aRight DO Array:Add
;

operator IT 
  ARRAY IN A
  ^ IN aWhatToDo
 aWhatToDo A ITERATE
; // IT

WordAlias ==> IT

operator for
  ^ IN aList
  ^ IN aWhatToDo
 aList DO ==> ( aWhatToDo DO )
; // for

WordAlias CONSTANT CONST
WordAlias Test PROCEDURE
WordAlias Тест PROCEDURE

WordAlias Если if
WordAlias если if
WordAlias то then
WordAlias иначе else

WordAlias выходим EXIT
WordAlias Выходим EXIT

WordAlias =:^ >>>^
WordAlias =: >>>

VOID operator +!
  INTEGER IN anIncrement
  ^ IN aWhatToIncrement
// Пример:
// {code}
// VAR l_WinID
// 5 >>> l_WinID
// 1 +! l_WinID
// l_WinID .
// {code}

 aWhatToIncrement DO anIncrement + =:^ aWhatToIncrement
; // +!

WordAlias =+ +!

VOID operator =- 
  INTEGER IN anInc
  ^ IN aWhatToDecrement
 aWhatToDecrement DO anInc - =:^ aWhatToDecrement
; // =-

VOID operator +=
  ^@ IN aLeft
  ^ IN aRight
 aLeft DO
 aRight DO
 +
 >>>^ aLeft
;

VOID operator -=
  ^@ IN aLeft
  ^ IN aRight
 aLeft DO
 aRight DO
 -
 >>>^ aLeft
;

STRING FUNCTION strings:Cat ARRAY IN anArray
 // - складывает строки массива на стеке

 PROCEDURE DoCat STRING IN aStr1
  Result := ( Result aStr1 Cat )
 ; // DoCat

 Result := ''
 @ DoCat anArray ITERATE
; // strings:Cat

VOID operator INC
  ^ IN aWhatToIncrement
 aWhatToIncrement DO 1 + =:^ aWhatToIncrement
; // INC

WordAlias ++! INC
WordAlias Inc INC

VOID operator DEC
  ^ IN aWhatToDecrement
 aWhatToDecrement DO 1 - =:^ aWhatToDecrement
; // DEC

WordAlias --! DEC
WordAlias Dec DEC

BOOLEAN FUNCTION array:HasString ARRAY IN anArray STRING IN aString
 Result := false

  PROCEDURE Поиск STRING IN anItem
   if ( anItem aString SameStr )
    ( Result := true )
  ; // Поиск

  @ Поиск anArray ITERATE
; // array:HasString

BOOLEAN FUNCTION array:HasText ARRAY IN anArray STRING IN aString
 Result := false

  PROCEDURE Поиск STRING IN anItem
   if ( anItem aString SameText )
    ( Result := true )
  ; // Поиск

  @ Поиск anArray ITERATE
; // array:HasText

INTEGER FUNCTION array:StringCount ARRAY IN anArray STRING IN aString
 Result := 0

  PROCEDURE Поиск STRING IN anItem
   if ( anItem aString SameStr )
    ( ++! Result )
  ; // Поиск

  @ Поиск anArray ITERATE
; // array:StringCount

PROCEDURE "Сравнить текущее исключение с эталоном"
 STRING VAR l_ClassName
 current:exception:ClassName >>> l_ClassName
 l_ClassName .
 STRING VAR l_Message
 STRING VAR l_Message_out
 current:exception:Message >>> l_Message

 if ( l_ClassName 'EAssertionFailed' SameText )
  ( l_Message '(' string:Split DROP >>> l_Message )
 else
  ( l_ClassName 'EAccessViolation' SameText ? (
     l_Message ' at ' string:Split DROP >>> l_Message
    )
  )
 l_Message 'Главный файл:' string:Split =: l_Message_out =: l_Message
 l_Message_out '. ' string:Split =: l_Message_out DROP
 l_Message l_Message_out Cat .
; // "Сравнить текущее исключение с эталоном"

PROCEDURE "Выполнить и если было исключение, то выполнить" IN aProc1 IN aProc2
 INTEGER VAR l_StackLevel
 l_StackLevel := StackLevel
 TRY
  TRY
   aProc1 DO
  EXCEPT
   "Сравнить текущее исключение с эталоном"
   aProc2 DO
  END
 FINALLY
  l_StackLevel ReduceStackLevel
 END
; // "Выполнить и если было исключение, то выполнить"

VOID operator анти-тест
  ^ IN aWhatToDo
 VAR l_WasException
 false =: l_WasException
 "Выполнить {(@ ( aWhatToDo DO ) )} и если было исключение, то выполнить {(@ ( true =: l_WasException ) )}"
 l_WasException
  [ 'Тест ' script:FileName ' почему-то стал проходить' ] strings:Cat
   ASSERTS
; // анти-тест

WordAlias "тест с падением" анти-тест

VOID operator "Выполнить подавив исключение"
  ^ IN aWhatToDo
 VAR l_WasException
 false =: l_WasException
 "Выполнить {(@ ( aWhatToDo DO ) )} и если было исключение, то выполнить {(@ ( true =: l_WasException ) )}"
 l_WasException
  [ 'Запланированного исключения в тесте: ' script:FileName ' почему-то не случилось' ] strings:Cat
   ASSERTS
; // "Выполнить подавив исключение"

PROCEDURE "Выполнить обработав исключение" OBJECT IN aProc STRING IN anException
 TRY
  aProc DO
 EXCEPT
  current:exception:Message anException ?!= ? RAISE
 END
; // "Выполнить обработав исключение"

PROCEDURE ToDo STRING IN aString
 'To Do: ' aString Cat .
; // ToDo

PROCEDURE "! Тест в разработке"
 script:FileName sysutils:ExtractFileName ' в состоянии разработки' Cat ToDo
; // "! Тест в разработке"

PROCEDURE OnTest
// - ждёт обновления контролов по OnTest
  3 LOOP (
   ProcessMessages
   application:ActionIdle
  )
  // - позволяем пройти всем OnTest
; // OnTest

WordAlias "Дать системе перерисоваться" OnTest

PROCEDURE "Нажать" STRING IN aString
 aString key
 OnTest
; // "Нажать"

VOID operator "Обработать Enter модально"
  ^ IN aWhatToDo
 @ ( "Нажать {('Enter')}" ) MODAL ( aWhatToDo DO )
; // "Обработать Enter модально"

PROCEDURE ASSUME STRING IN aStr
 // Включает "условную директиву" aStr в тестируемом приложении
 // http://mdp.garant.ru/pages/viewpage.action?pageId=236719181 №44
; // ASSUME

PROCEDURE UNASSUME STRING IN aStr
 // Выключает "условную директиву" aStr в тестируемом приложении
 // http://mdp.garant.ru/pages/viewpage.action?pageId=236719181 №44
; // UNASSUME

BOOLEAN FUNCTION ArraysAreEqual ARRAY IN A ARRAY IN B
 A IsArray 'Где массив?' ASSERTS
 B IsArray 'Где массив?' ASSERTS
 CONST l_Exception 'Выходим из итератора'
 INTEGER VAR l_Index
 l_Index := 0
 INTEGER VAR l_Count
 l_Count := ( A Array:Count )

   PROCEDURE DoWithItem IN B[i]
    if ( l_Index A [i] B[i] ?== ) then
     ++! l_Index
    else
    (
     Result := false
     l_Exception RAISE
    )
   ;

 if ( l_Count B Array:Count ?!= ) then
 (
  Result := false
  EXIT
 )
 TRY
  @ DoWithItem B ITERATE
  Result := true
 EXCEPT
  if ( current:exception:Message l_Exception ?!= ) then
   RAISE
 END
; // ArraysAreEqual

BOOLEAN operator AND BOOLEAN
  IN aFirst
  ^ IN aSecond
 // Двусторонний, а не обратный польский &&
 if aFirst then
  (
   if ( aSecond DO ) then
    ( Result := true )
   else
    ( Result := false )
   )
 else
  ( Result := false )
; // AND

WordAlias И AND

BOOLEAN operator OR BOOLEAN
  IN aFirst
  ^ IN aSecond
 // Двусторонний, а не обратный польский ||
 if aFirst then
  ( Result := true )
 else
  if ( aSecond DO ) then
   ( Result := true )
  else
   ( Result := false )
; // OR

WordAlias ИЛИ OR

BOOLEAN operator NOT
  ^ IN aWhatToNot
 // Правосторонний, а не обратный польский !
 Result := ( aWhatToNot DO ! )
; // NOT

WordAlias НЕ NOT

BOOLEAN operator =
  IN aLeft
  ^ IN aRight
 // Правосторонний, а не обратный польский ==
 // ТЕПЕРЬ С БЛЭКДЖЕКОМ И МАССИВАМИ!

//1 РАВНО 1  . - True
//[ 10 20 ] РАВНО ( 10 20 ) . - True
//[ 10 20 ] РАВНО ( [ 10 20 ] ) . - True
//[ 10 ] РАВНО ( [ 10 ] ) . - True
//[ 10 ] РАВНО ( 10 ) . - True
//[ 10 ] РАВНО ( 20 ) . - False

 ARRAY VAR l_Right
 l_Right := ( [ aRight DO ] )
 TRY
  if ( aLeft IsArray ) then
  (
   if
    (
     ( l_Right IsArray ) И
     ( l_Right Array:Count 1 == ) И
     ( 0 l_Right [i] IsArray )
    )
   then
   (
    Result := ( aLeft 0 l_Right [i] ArraysAreEqual )
   )
   else
   (
    Result := ( aLeft l_Right ArraysAreEqual )
   )
  )
  else
  (
   if ( l_Right Array:Count 1 == ) then
   (
    Result := ( aLeft 0 l_Right [i] ?== )
   )
   else
   (
    Result := false
   )
  )
 FINALLY
  l_Right := ( [ ] )
  aLeft := nil
 END
; //=

WordAlias РАВНО =

BOOLEAN operator <>
  IN aLeft
  ^ IN aRight
 // Правосторонний, а не обратный польский !=
 Result := ( aLeft aRight DO ?!= )
; //<>

WordAlias НЕРАВНО <>
WordAlias "НЕ РАВНО" НЕРАВНО

BOOLEAN operator >
  STRING INTEGER BOOLEAN IN aLeft
  ^ IN aRight
 Result := ( aLeft aRight DO GREATER )
;

WordAlias БОЛЬШЕ >

BOOLEAN operator <
  STRING INTEGER BOOLEAN IN aLeft
  ^ IN aRight
  Result := ( aLeft aRight DO LESS )
;

WordAlias МЕНЬШЕ <

BOOLEAN operator >=
  STRING INTEGER BOOLEAN IN aLeft
  ^ IN aRight
 Result := ( aLeft < ( aRight DO ) ! )
;

WordAlias "БОЛЬШЕ ИЛИ РАВНО" >=

BOOLEAN operator <=
  STRING INTEGER BOOLEAN IN aLeft
  ^ IN aRight
 Result := ( aLeft > ( aRight DO ) ! )
;

WordAlias "МЕНЬШЕ ИЛИ РАВНО" <=

WordAlias ЯВЛЯЕТСЯ IS
WordAlias Is IS

BOOLEAN operator NOTIS
  CLASS OBJECT IN anObj
  ^ IN aClass
 Result := NOT ( anObj Is ( aClass DO ) )
;

WordAlias NotIs NOTIS
WordAlias НЕЯВЛЯЕТСЯ NOTIS
WordAlias "НЕ ЯВЛЯЕТСЯ" НЕЯВЛЯЕТСЯ

IMMEDIATE operator WordAliasByRef
 ^L IN aName
 ^ IN aCode
 aCode DO aName |N Define
; // WordAliasByRef

IMMEDIATE operator [EXECUTE]
 ^ IN aCode
 aCode DO
; // [EXECUTE] 
 
STRING operator |NS
 IN aName
 Result := ( [ '`' aName |N '`' ] strings:Cat )
; // |NS

OBJECT FUNCTION %ST IN %S
 if ( %S NotValid ) then
 (
  Result := nil
 ) 
 else
 (
  Result := ( %S pop:Word:Producer )
 ) 
; // %ST

STRING FUNCTION |S IN %S
 %S %ST |N =: Result
; // |S

OBJECT FUNCTION %P IN %S
 VAR l_P
 l_P := ( %S pop:Word:Parent )
 if ( l_P pop:Word:Name '%C' SameText ) then
 ( 
  l_P := ( l_P pop:Word:Parent )
 ) 
 if ( l_P NotValid ) then
 (
  Result := nil
 ) 
 else
 (
  Result := l_P
 ) 
; // %P

OBJECT FUNCTION %T IN %S
 VAR l_T
 l_T := ( %S ->^ '%T' )
 if ( l_T NotValid ) then
 (
  Result := nil
 ) 
 else
 (
  l_T := ( l_T DO )
  if ( l_T NotValid ) then
  (
   Result := nil
  ) 
  else
  (
   Result := l_T
  )
 )
; // %T

STRING FUNCTION %TN IN %S
 Result := ( %S %T |N )
; // %TN

STRING FUNCTION %TS IN %S
 Result := ( %S %T |S )
; // %TS

STRING FUNCTION |U IN %S
 VAR l_U
 l_U := ( %S ->^ '%U' )
 if ( l_U NotValid ) then
 (
  Result := ''
 ) 
 else
 (
  Result := ( l_U DO |N )
 )
; // |U

operator WHILE
  ^ IN aCondition
  ^ IN aWhatToDo
 @ ( aCondition DO ) WHILEDO ( aWhatToDo DO )
; // WHILE

WordAlias ПОКА WHILE
WordAlias while WHILE

WordAlias ДА true

WordAlias НЕТ false

BOOLEAN operator "в интервале"
  INTEGER IN aValue
  ^ IN anInterval
 INTEGER VAR "нижнее значение"
 INTEGER VAR "верхнее значение"
 ( anInterval DO )
 >>> "верхнее значение"
 >>> "нижнее значение"
 Result := ( ( aValue "БОЛЬШЕ ИЛИ РАВНО" "нижнее значение" )
 И ( aValue "МЕНЬШЕ ИЛИ РАВНО" "верхнее значение" ) )
; // "в интервале"
   
ARRAY FUNCTION SplitToArray
 STRING IN aValue
 STRING IN aDelim
 STRING VAR l_Tail
 aValue >>> l_Tail
 if ( l_Tail = '' ) then
 BEGIN
  Result := [ '' ]
 END 
 else
 BEGIN 
  Result := [ 
   WHILE ( l_Tail <> '' )
   BEGIN
    l_Tail aDelim string:Split >>> l_Tail
   END
  ]
 END
; // SplitToArray

IMMEDIATE operator __INIT_VAR
 IN aValue
 ^ IN aVar
 aValue >>>^ aVar
; // __INIT_VAR

PROCEDURE Ctx:Parser:PushSymbols
 STRING IN aString
 aString ' ' SplitToArray ==> ( 
  STRING IN aStr
  if ( '`' aStr StartsStr ) then
  BEGIN
   aStr '`' '' string:Replace Ctx:Parser:PushString
  END
  else
  BEGIN
   aStr Ctx:Parser:PushSymbol 
  END
 )
; // Ctx:ParserPushSymbols

PROCEDURE Ctx:Parser:PushArray
 ARRAY IN anArray
 anArray ==> Ctx:Parser:PushSymbols
; // Ctx:Parser:PushArray

IMMEDIATE operator VarProducer
 // - Переносим VarProducer из Delphi в скрипты
 //   Единственное пока отличие, что стереотипы были VarProducer VarType,
 //   а стало ??? Unexisting word ??? VAR
 //   Но со временем можно ввести SetStereotype (WordProducer)
  ^L IN aName
 STRING VAR l_Name
 aName |N >>> l_Name

 [
 'IMMEDIATE operator'
 l_Name

 '@ VAR DO'
 ';' 
 ] Ctx:Parser:PushArray
; // VarProducer

// Код в VarProducer в итоге заставляет машину скомпилировать следующее:
/* 
IMMEDIATE operator VarType
 @ VAR DO
;
*/

IMMEDIATE operator InitedVarProducer
  ^L IN aName
 STRING VAR l_Name
 aName |N >>> l_Name
 
 [
 'IMMEDIATE operator'
 l_Name
 
 '^L IN aName'
 '^ IN aValue'
 'STRING VAR l_Name'
 'aName |N >>> l_Name'
 
 '`VAR` Ctx:Parser:PushSymbol'
 'l_Name Ctx:Parser:PushSymbol'
 
 'aValue DO'
 '`__INIT_VAR` Ctx:Parser:PushSymbol'
 
 'l_Name Ctx:Parser:PushSymbol'
 ';' 
 ] Ctx:Parser:PushArray
; // InitedVarProducer

// Код в InitedVarProducer в итоге заставляет машину скомпилировать следующее:'
/*
IMMEDIATE operator VarTypeI
  ^L IN aName
  ^ IN aValue
 STRING VAR l_Name
 aName |N >>> l_Name
 
 'VAR' Ctx:Parser:PushSymbol
 l_Name Ctx:Parser:PushSymbol
 
 aValue DO
 '__INIT_VAR' Ctx:Parser:PushSymbol
 
 l_Name Ctx:Parser:PushSymbol
 
; // VarTypeI
*/

operator AllMembers==>
// Итерирует все вложенные элементы рекурсивно
 OBJECT IN anObject
 ^ IN aLambda
 
 FORWARD DoMembers
 
 PROCEDURE DoMembers
  OBJECT IN anObject
  anObject MembersIterator ==> (
   IN aWord 
   aWord aLambda DO
   aWord DoMembers
  )
 ; // DoMembers
 
 anObject DoMembers
; // AllMembers==>

STRING FUNCTION strings:CatSep 
 // - складывает строки массива
  ARRAY IN anArray
  STRING IN aSep

 PROCEDURE DoCat 
  STRING IN aStr
  
  if ( aStr <> '' ) then
  BEGIN
   if ( Result = '') then
    ( Result := aStr )
   else
    (
     if ( aSep Result EndsStr ) then
      (
       Result := ( Result aStr Cat )
      )
     else
      (
       Result := ( Result aSep Cat aStr Cat )
      ) 
    )
  END // aStr <> ''
 ; // DoCat

 Result := ''
 @ DoCat anArray ITERATE
; // strings:Cat

PROCEDURE __DumpMembers
 OBJECT IN anObject
 
 PROCEDURE Dump
  OBJECT IN anObject
   [
    anObject pop:Word:Directives
    anObject %ST %ST |N
    anObject %ST |N
    anObject |N
   ] ' ' strings:CatSep .
 ; // Dump
 
 anObject Dump
 anObject AllMembers==> Dump
 anObject %P Dump
; // __DumpMembers

operator Ctx:Parser:PushSymbolAtRight
 ^L IN aName 
 aName |N Ctx:Parser:PushSymbol
; // Ctx:Parser:PushSymbolAtRight

IMMEDIATE operator NamedInitedVarProducer
  ^L IN aName
  ^L IN aNewName
  
 STRING VAR l_Name
 aName |N >>> l_Name
 
 STRING VAR l_NewName
 aNewName |N >>> l_NewName
 
 [
 'IMMEDIATE operator'
 l_Name
 
 '^ IN aValue'
 
 '`VAR` Ctx:Parser:PushSymbol'
 
 'Ctx:Parser:PushSymbolAtRight'
 l_NewName
 
 'aValue DO'
 '`__INIT_VAR` Ctx:Parser:PushSymbol'
 
 'Ctx:Parser:PushSymbolAtRight'
 l_NewName
 
 ';' 
 ] Ctx:Parser:PushArray
; // NamedInitedVarProducer

IMMEDIATE operator NamedAutolinkProducer
 ^L IN aOpName
 ^L IN aName
 [
  'IMMEDIATE operator'
  aOpName |N
  '^ IN aCode'
  'aCode '
  aName |NS
  'Define'
  ';' 
 ] Ctx:Parser:PushArray
; // NamedAutolinkProducer

Microsoft - умиляет

#32768 The class for a menu.
#32769 The class for the desktop window.
#32770 The class for a dialog box.
#32771 The class for the task switch window.
#32772 The class for icon titles.

https://msdn.microsoft.com/en-us/library/windows/desktop/ms633574(v=vs.85).aspx

пятница, 12 июня 2015 г.

Ссылка. Синдром “придумано не нами”

http://sergeyteplyakov.blogspot.ru/2015/06/not-invented-here-syndrom.html

ToDo. Про определение "аксиоматики на лету"

 TtfwContext = record
   rCaller : ItfwScriptCaller;
   rEngine : ItfwScriptEngine;
   rParser : ItfwParser;
   rCompiler : ItfwCompiler;
   rException : Exception;
   rUsed : Tl3StringList;
   rTypeInfo : TtfwTypeInfo; // Информация о типе слова
   rScriptFilename : AnsiString;
   rKeyWordCompilingNow : TtfwKeyWord;
   rFirstHalfOfDualWord : TtfwWord; // Первая половина двойного слова
   rStoredValuesStack : ItfwStoredValuesStack; // Стек для сохранения состояния слов при обработке рекурсивных вызовов
   rWordCompilingNow : TtfwWord; // Текущее компилируемое слово
   rWordDefiningNow : TtfwWord; // Текущее определяемое ИМЕНОВАННОЕ слово
   rKeyWordDefiningNow : TtfwKeyWord; // Текущее определяемое ИМЕНОВАННОЕ слово
   rWasCloseBracket : Boolean;
   rPrevFinder : Il3KeywordFinder;
 end;//TtfwContext

-- вытащить это всё в "ручки" скриптовой машины.

четверг, 11 июня 2015 г.

Коротко. Неожиданно для себя

Неожиданно для себя сделал сегодня получение "байт-кода" из UML.

Т.е. получается что-то ДРАКОН-like. Рисуем UML и получаем "программу" на "скриптах".

Ссылка. Прикручивание Python к Delphi. python4delphi - оказывается уже "незачем". Разве что только "заради батареек".

И ещё сделал вот что:

IMMEDIATE operator DefineVar
 @ VAR DO
;

DefineVar A

Эквивалентно:

VAR A

Банально? Да не совсем.

Дальше, ведь можно сделать так (используя WordCompilingNow):

IMMEDIATE operator DefineVar
  ^L IN aName
 Ctx:WordCompilingNow ->^ ( aName |N )
 DROP
; // DefineVar

DefineVar A

среда, 10 июня 2015 г.

Задачка 7

вторник, 9 июня 2015 г.

Задачка 6

Ну и смотрим предыдущую задачу.

Тест:

v1 = (0, 0)
v2 = (0, 1)
v3 = (1, 0)

P = 3.4142135623731

v1 = (0, 0)
v2 = (0, -1)
v3 = (-1, 0)

P = 3.4142135623731

v1 = (0, 0)
v2 = (-1, 0)
v3 = (0, 1)

P = 3.4142135623731

v1 = (0, 1)
v2 = (1, 0)
v3 = (0, -1)

P = 4.82842712474619

Задачка 5

Площадь прямоугольника равна сумме двух составляющих его треугольников.

Ну и смотрим задачу 2.

Тестовый пример:

v1 = (0, 0)
v2 = (0, 1)
v3 = (1, 1)
v4 = (1, 0)

S Должно быть равно 1.

Тестовый пример:

v1 = (0, 0)
v2 = (0, 0.5)
v3 = (0.5, 0.5)
v4 = (0.5, 0)

S Должно быть равно 0.25

четверг, 4 июня 2015 г.

Ссылка. Тестовое задание от Infoteсs

http://rusdelphi.com/zadachi/testovoe-zadanie-ot-infotess/?utm_source=feedburner&utm_medium=feed&utm_campaign=Feed%3A+Rusdelphi+%28rusdelphi%29

Offtopic. Про образование

Чужая статья:

"

Чему равны три шестых, или ЕГЭ во Франции.

Виктор Дос

Я уже пятый год преподаю физику и математику в Парижском университете имени Пьера и Марии Кюри, известном также под названием Paris VI. Мой университет — далеко не худший в Париже. Россия всегда несколько отстает от Запада, и сейчас в Париже я могу наблюдать наше возможное недалекое будущее.

Во Франции уже давно введен и действует Единый Государственный Экзамен, называется он у них БАК. Мотивация введения французского БАКа была примерно та же, что и нашего ЕГЭ: чтобы поставить всех учеников в равные условия, свести на нет коррупцию в образовании, унифицировать требования к выпускникам. Человек, сдавший БАК, имеет право без вступительных экзаменов записаться в любой университет своего профиля и учиться в нем бесплатно. А если ученик сдал БАК с отметкой выше определенного уровня, то он имеет право записаться на подготовительное отделение в одну из так называемых гранд эколь (самой известной из них является Эколь нормаль суперьер) — это что-то вроде элитных университетов. Для поступления в гранд эколь после подготовительных курсов нужно выдержать еще и вступительные экзамены. В процессе учебы как в гранд эколь, так и в университете в зимнюю и в весеннюю сессии происходит отсев: если у студента сумма баллов всех экзаменов оказывается ниже определенного уровня, его отчисляют (или оставляют на второй год). Отсев серьезный: в моем университете в первую зимнюю сессию отсеивают около 40% студентов, в следующую — еще процентов 30. Фактически это растянутые на два года вступительные экзамены. Венчается учеба двумя или тремя годами так называемого DEA, что примерно соответствует нашей аспирантуре. DEA, как и у нас, должно завершаться диссертацией и ученой степенью. Естественно, что до этого уровня добираются только самые-самые... Ну и чтобы завершить это довольно скучное вступление, немного о себе: доктор физматнаук, профессор, занимаюсь теоретической физикой; в университете Paris VI первокурсникам преподаю математику и общую физику, читаю теоретический курс и веду семинары для аспирантов Эколь нормаль суперьер.

Как видите, система образования задумана как будто совсем неплохо. И тем не менее могу сообщить, что «хотели как лучше, а получилось как всегда» бывает не только в России. Французское образование (и я подозреваю, что не только французское) — яркий тому пример.

В этом учебном году я обнаружил, что среди 50 моих учеников-первокурсников 8 человек считают, что три шестых (3/6) равны одной трети (1/3). Подчеркну: это молодые люди, которые только что сдали «научный БАК», то есть тот, в котором приоритет отдается математике и физике. Все эксперты, которым я это рассказывал и которые не имеют опыта преподавания в парижских университетах, сразу же становятся в тупик. Пытаясь понять, как такое может быть, они совершают стандартную ошибку: они ищут ошибочное математическое рассуждение, которое может привести к подобному результату. На самом деле все намного проще: студентам это сообщили в школе, а они, как прилежные ученики, запомнили — вот и все. Я их переучил: на очередном занятии (темой которого вообще-то была производная функции) сделал небольшое отступление и сообщил, что 3/6 равно 1/2, а вовсе не 1/3, как считают некоторые из присутствующих. Реакция была такая: «Да? — Хорошо...». Если бы я им сообщил, что это равно одной десятой, реакция была бы точно такой же.

Надо сказать, что арифметическая операция деления — это, пожалуй, самая трудная тема для современного французского среднего образования. Во французской школе операция деления вводится в виде формального алгоритма деления в столбик, который позволяет из двух чисел (делимого и делителя) путем строго определенных математических манипуляций получать третье число (результат деления). Усвоить этот ужас можно, только проделав массу упражнений. Ученикам предъявляются шарады в виде уже выполненного деления в столбик, в котором некоторые цифры опущены, — их надо найти. Естественно, после всего этого, что бы тебе ни сказали про 3/6, согласишься на все.

Я долго не мог понять, как с подобным уровнем знаний молодые люди сумели сдать БАК, задачи в котором, как правило, составлены на вполне приличном уровне. Теперь я знаю ответ. Дело в том, что практически все задачи, предлагаемые на БАКе, можно решить с помощью хорошего калькулятора, которым пользоваться при сдаче БАКа совершенно официально разрешено.

Теперь о том, как собственно учат математике и физике в университете. Что касается математики, то под этой вывеской в осеннем семестре изучаются три темы: тригонометрия, производные функций и несколько интегралов от стандартных функций — в общем, все то, что и так нужно было знать, чтобы сдать БАК. Но в университете учат все сначала, чтобы научить, наконец, «по-настоящему».

С преподаванием физики дела обстоят похоже. Очень кратко: курс физики в первом семестре в Университете имени Пьера и Марии Кюри начинается почему-то с линейной оптики, затем два занятия подряд студенты вынуждены зубрить наизусть огромную таблицу с размерностями физических величин (как выражается в килограммах, секундах и метрах гравитационная постоянная — при этом они понятия не имеют, что такое гравитационная постоянная), затем механика и почему-то гидродинамика. Почему именно это и в таком порядке? Да, собственно, какая разница, в каком порядке все это зубрить...

Попробую предложить отдаленную аналогию всей этой ахинеи для гуманитариев. Представьте себе, что программа университетского курса под названием «Русская литература» состоит из следующих разделов: 1. Творчество А. П. Чехова; 2. Лингвистический анализ произведений русских и советских писателей XIX и XX веков; 3. «Слово о полку Игореве»; 4. Творчество А. Платонова. И на этом — все...

Читатель небось уже измучился в ожидании ответа на давно созревший вопрос: «Как же такое может быть?!» Ведь Франция — один из мировых лидеров и в теоретической физике, и в математике, и в высоких технологиях... И, в конце концов, куда подевалась выдающаяся французская математическая школа «Бурбаки»? И вообще, при чем тут ЕГЭ?

Про «Бурбаки» ответить проще всего. Эта школа продолжает функционировать, но при этом стала похожей на «черную дыру»: людей она продолжает в себя «всасывать», но, что там у нее делается внутри, те, кто находится снаружи, уже не знают. Хотя мощная математическая традиция «Бурбаки» в французском обществе, конечно же, осталась. Именно поэтому несчастных детишек здесь так мучают шарадами про деление в столбик. К примеру, когда нужно было решить уравнение 5x+3=0, один мой студент исписал целую страницу рассуждениями про структуру и счетность множества решений такого типа уравнений, но само уравнение решить так и не смог.

Вся эта катастрофа в образовании началась не так уж давно, и когда говорят про умных и образованных людей, то это в действительности очень тонкий слой общества, состоящий из пожилых и вымирающих «динозавров». И подпитки этого слоя сейчас просто не происходит (точнее, она происходит за счет китайцев и прочих там русских).

Во-вторых, существует и совершенно другая точка зрения на происходящее. Этот крайне циничный взгляд на современное общество как-то растолковал мне один мой коллега по университету. Он считает, что все развивается так, как надо. Дело в том, что современному развитому обществу нужны только хорошие исполнители. Поэтому вся система образования должна быть настроена на отбор, выращивание и дрессировку именно хороших исполнителей, а учить думать молодых людей совершенно не нужно. Что же касается творческих личностей, то о них особенно беспокоиться не следует — тот, кто действительно талантлив, так или иначе все равно пробьется. А для тех, кто идет в «отходы», существуют метлы для подметания улиц, заводские конвейеры и т.д. Вы вон в Советском Союзе в свое время напроизводили миллионы «думающих» инженеров, и что? По части своих прямых профессиональных обязанностей они, как правило, ни черта делать не умели, а вместо этого предпочитали размышлять о смысле жизни, о Достоевском...

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

Надеюсь, понятно, при чем тут ЕГЭ? Когда люди, вместо того, чтобы думать самим и учить думать своих детей, пытаются все на свете сводить к алгоритмам и тупым тестам, наступает всеобщее отупение. В моей молодости экзамены в стиле ЕГЭ проводились только на военной кафедре, что как раз было вполне оправдано: «приказ начальника — закон для подчиненного», а думать при этом было противопоказано. Теперь такой стиль обучения становится всеобщим.

А нашему министерству единый экзамен нравится.

На открытии всероссийского августовского интернет-педсовета выступил министр образования и науки РФ Андрей Фурсенко. Он заявил, что эксперимент по введению Единого государственного экзамена (ЕГЭ) должен развиваться и стать основной формой проверки знаний российских школьников. Министр напомнил, что в этом году в эксперименте по введению ЕГЭ, который является одновременно выпускным в школе и вступительным в вузе, участвовало 65 субъектов федерации, включая Москву и Санкт-Петербург. Он считает, что «16 регионов, в которых эксперимент ведется достаточно успешно, уже могут проводить ЕГЭ в регулярном режиме, остальные должны его развивать». Впрочем, Андрей Фурсенко признает и другие формы проверки знаний, например, предметные олимпиады, на которые в 2005 году финансирование будет прописано отдельной строкой в федеральном бюджете. Министр сообщил, что в 2004 году ЕГЭ сдавали около 1 млн. абитуриентов, что очень много. Андрей Фурсенко предложил высказать свое мнение о ЕГЭ на интернет-педсовете не только ученикам, но и их родителям. Интернет-педсовет продлится до 8 сентября.

procedure TForm1.DoItClick(Sender: TObject);
var
 l_V : Double;
 l_I : Double;
begin
 l_V := StrToFloat(Edit1.Text);
 l_I := Int(l_V);
 lbInt.Caption := FloatToStr(l_I);
 lbFrac.Caption := FloatToStr(Frac(l_V));
end;