суббота, 26 сентября 2015 г.

#1168. Эмуляция объектов на скриптах. Продолжаем. Только код

Предыдущая серия была тут - Эмуляция объектов. Продолжаем.

Код примера:

USES
 macro.ms.dict
 core.ms.dict
 NoCapsLock.ms.dict
 params.ms.dict
 integer.ms.dict
 Object.ms.dict
 Testing.ms.dict
;

Test&Dump PointTest

@ _:Object DumpElement

INTEGER type Pixel
// - пиксель
List type PixelList
// - список пикселей

class Point

Pixel member X
Pixel member Y
members-end

constructor :
 Pixel right aX
 Pixel right aY
 new[ aX aY ] =: Result
; // :

constructor 0
 Point:: 0 0 =: Result
; // 0

constructor XY
 PixelList right aPoint
 array var Points
 [ aPoint ] =: Points
 Point:: ( Points FieldByOffset 0 ) ( Points FieldByOffset 1 ) =: Result
; // XY

Pixel readonly X read X

Pixel readonly Y read Y

constructor OF
 Point right aPoint
 Point:: ( aPoint Point:X ) ( aPoint Point:Y ) =: Result
; // OF

Point method +
 Point right aPoint

 Point:: ( Self Point:X (+) ( aPoint Point:X ) ) ( Self Point:Y (+) ( aPoint Point:Y ) ) =: Result
; // +

Point method Neg
 Point:: Neg ( Self Point:X ) Neg ( Self Point:Y ) =: Result
; // Neg

Point method -
 Point right aPoint

 Point:OF ( Self Point:+ ( aPoint Point:Neg ) ) =: Result
; // -

OVERRIDE STRING method ToPrintable
 [ '( ' 'X: ' Self Point:X ToPrintable ', Y: ' Self Point:Y ToPrintable ' )' ] strings:Cat =: Result
; // ToPrintable

void method Print
 Self Point:ToPrintable Print
; // Print

class-end // Point

class Rectangle

Point member TopLeft
Point member BottomRight
members-end

Point readonly TopLeft read TopLeft

Point readonly BottomRight read BottomRight

constructor :
 Point right aTopLeft
 Point right aBottomRight
 new[ aTopLeft aBottomRight ] =: Result
; // :

OVERRIDE STRING method ToPrintable
 [ '( ' 'TopLeft: ' Self Rectangle:TopLeft Point:ToPrintable ', BottomRight: ' Self Rectangle:BottomRight Point:ToPrintable ' )' ] strings:Cat =: Result
; // ToPrintable

void method Print
 Self Rectangle:ToPrintable Print
; // Print

class-end // Rectangle

Point var P1
Point var P2
Point var P3
Point var P4
Point var P5
Point var P6
Point var P7
Point var P8
Point var P9
Point var P10
Point var P11

P1 := Point:0
P2 := Point:0
P3 := Point:: 1 1
P4 := Point:XY ( 2 2 )
P5 := Point:OF P4
P6 := ( P3 Point:+ P4 )
P7 := ( P3 Point:- P4 )
P8 := ( P4 Point:- P3 )
P9 := ( P4 Point:Neg )
P10 := ( P3 Point:Neg )
P11 := Point:XY ( -2 2 )

Object var O1
O1 := P1
O1 Point:Print

array var l_Points

[ P1 P2 P3 P4 P5 P6 P7 P8 P9 P10 P11 ] =: l_Points

l_Points ==> Point:Print
l_Points ==> ( Point:X Print )
l_Points ==> ( Point:Y Print )
l_Points ==> ( Point:class Print )
l_Points ==> ( Point:ClassName Print )
for l_Points ( for ( Object:class %G ) ( getClassName Print ) )

Rectangle var R1
Rectangle var R2
R1 := Rectangle:: P1 P4
R2 := Rectangle:: P6 P7

array var l_Rectangles
[ R1 R2 ] =: l_Rectangles

l_Rectangles ==> Rectangle:Print
l_Rectangles ==> ( Rectangle:class Print )
l_Rectangles ==> ( Rectangle:ClassName Print )
for l_Rectangles ( for ( Object:class %G ) ( getClassName Print ) )

'Hello ' (+) 'world' Print

'Hello ' (+) 'world' Print

'Hello ' (+) 'world' Print

1 (+) 2 Print
10 (+) 20 Print
0 (-) 10 Print
Neg 10 Print
Neg -10 Print

; // PointTest

PointTest

Как всё это устроено "под капотом":

UNIT Object.ms.dict

USES
 core.ms.dict
 macro.ms.dict
 NoCapsLock.ms.dict
 implementation.ms.dict
 params.ms.dict
 axiom_push.ms.dict
 Documentation.ms.dict
 WordsRTTI.ms.dict
 arrays.ms.dict
 Debug.ms.dict
;

EXPORTS
 implementation.ms.dict

USES
 InheritsAndImplementsNew.ms.dict
;

EXPORTS
 InheritsAndImplementsNew.ms.dict

// Понятное дело, что всю обвязку потом упрячем в отдельный словарь object.ms.dict

NamedWordProducer %FIELDS %Fld
NamedWordProducer %PROPERTIES %Props
NamedWordProducer %METHODS %Methods
NamedWordProducer %CONSTRUCTORS %Constructors

OBJECT FUNCTION DoMember 
 OBJECT IN aMember
 aMember DO =: Result
; // DoMember

BOOLEAN FUNCTION FilterMember 
 OBJECT IN aMember
 Result := ( aMember NotValid ! )
; // FilterMember
 
WordAlias %R .Implemented.Words
WordAlias %G .Inherited.Words

ARRAY FUNCTION %ClassRTTIList
 IN %S
 Literal IN aName
 VAR l_List
 %S %% ( aName |N ) =: l_List
 if ( l_List NotValid ) then
  ( Result := [ ] )
 else 
  ( Result := ( l_List CodeIterator ) )
; // %ClassRTTIList

ARRAY FUNCTION %Fld 
 IN %S
 %SUMMARY 'Возвращает итератор полей класса' ;
 %S %ClassRTTIList %Fld >>> Result
; // %Fld

ARRAY FUNCTION %Props 
 IN %S
 %SUMMARY 'Возвращает итератор свойств класса' ;
 %S %ClassRTTIList %Props >>> Result
; // %Props

ARRAY FUNCTION %Methods 
 IN %S
 %SUMMARY 'Возвращает итератор методов класса' ;
 %S %ClassRTTIList %Methods >>> Result
; // %Methods

ARRAY FUNCTION %Constructors 
 IN %S
 %SUMMARY 'Возвращает итератор конструкторов класса' ;
 %S %ClassRTTIList %Constructors >>> Result
; // %Constructors

VOID OPERATOR class_impl
// - имплементация класса, пока "фиктивная"
// Тут мы будем хранить всю информацию о классе - предки, поля, методы
; // class_impl

//MACRO class_impl
//// - имплементация класса, пока "фиктивная"
// Literal IN aName
// @SELF Ctx:SetWordProducerForCompiledClass
// axiom:PushSymbol : 
// aName |N Ctx:Parser:PushSymbol
// // axiom:PushSymbol ;
//; // class_imp

STRING var g_CurrentClass
( g_CurrentClass := '' )
STRING var g_CurrentClassImpl
( g_CurrentClassImpl := '' )

PRIVATE STRING operator MakeFieldOffsetName
 STRING IN aName
 [ 'c:' g_CurrentClass ':Offset:' aName ] strings:Cat =: Result
; // MakeFieldOffsetName

VOID operator define_member
 STRING IN aName
 INTEGER IN aOffset
 axiom:PushSymbol private
 axiom:PushSymbol Const
 aName MakeFieldOffsetName Ctx:Parser:PushSymbol
 aOffset Ctx:Parser:PushInt
; // define_member

INTEGER VAR g_ClassFieldOffset
[EXECUTE]
 ( g_ClassFieldOffset := 0 )
( g_ClassFieldOffset := 0 )

ARRAY VAR g_CurrentClassMembers
[EXECUTE]
 ( g_CurrentClassMembers := [ ] )
( g_CurrentClassMembers := [ ] )

ARRAY VAR g_CurrentClassProperties
[EXECUTE]
 ( g_CurrentClassProperties := [ ] )
( g_CurrentClassProperties := [ ] )

ARRAY VAR g_CurrentClassMethods
[EXECUTE]
 ( g_CurrentClassMethods := [ ] )
( g_CurrentClassMethods := [ ] )

ARRAY VAR g_CurrentClassConstructors
[EXECUTE]
 ( g_CurrentClassConstructors := [ ] )
( g_CurrentClassConstructors := [ ] )

MACRO member
 Literal IN aName
 Ctx:ClearTypeInfo
 aName |N g_ClassFieldOffset define_member
 Inc g_ClassFieldOffset
 aName |N array:AddTo g_CurrentClassMembers
; // member

PRIVATE STRING operator MakeMethodSignaturePrim
 STRING IN aClass
 STRING IN aName
 [ aClass ':' aName ] strings:Cat >>> Result
; // MakeMethodSignaturePrim

CONST cClassImplPrefix '_:'

STRING : getClassNamePrim
 STRING IN Self
 Self ':' string:Split =: Result DROP
; // getClassNamePrim

STRING : getClassName
 IN Self
 Self |N getClassNamePrim =: Result
; // getClassName

MACRO classExpander
 ^ IN anImpl
 %SUMMARY 'Тут можно копировать поля и методы' ;
 anImpl |@ %G .for> ( 
  IN anItem 

  anItem %Fld .for> ( 
   IN aField 
   axiom:PushSymbol member
   aField |N Ctx:Parser:PushSymbol
  ) // anItem %Fld .for>

  anItem %Props .for> ( 
   IN aProp
   axiom:PushSymbol WordAlias
   g_CurrentClass aProp |N MakeMethodSignaturePrim Ctx:Parser:PushSymbol
   anItem |N getClassNamePrim aProp |N MakeMethodSignaturePrim Ctx:Parser:PushSymbol
  ) // anItem %Props .for>

  anItem %Methods .for> ( 
   IN aProp
   axiom:PushSymbol WordAlias
   g_CurrentClass aProp |N MakeMethodSignaturePrim Ctx:Parser:PushSymbol
   anItem |N getClassNamePrim aProp |N MakeMethodSignaturePrim Ctx:Parser:PushSymbol
  ) // anItem %Methods .for>

  anItem %Constructors .for> ( 
   IN aProp
   axiom:PushSymbol WordAlias
   g_CurrentClass aProp |N MakeMethodSignaturePrim Ctx:Parser:PushSymbol
   anItem |N getClassNamePrim aProp |N MakeMethodSignaturePrim Ctx:Parser:PushSymbol
  ) // anItem %Constructors .for>

 )
; // classExpander

CONST cObjectName 'Object'

MACRO class
 Literal IN aName
 g_CurrentClassMembers := [ ]
 g_CurrentClassProperties := [ ]
 g_CurrentClassMethods := [ ]
 g_CurrentClassConstructors := [ ]
 g_ClassFieldOffset := 0
 aName |N =: g_CurrentClass
 // axiom:PushSymbol class_impl
 // - вообще должно быть так, почему не работает - надо разбираться
 [
  ':' 

  @ class_impl Ctx:SetWordProducerForCompiledClass
  [ cClassImplPrefix g_CurrentClass ] strings:Cat =: g_CurrentClassImpl

  g_CurrentClassImpl
   if ( g_CurrentClass !== cObjectName ) then
   begin
    '%INHERITS'
    '@' 
    [ cClassImplPrefix cObjectName ] strings:Cat
    ';'
   end
  ';'
 ] Ctx:Parser:PushArray

 [
  'array' 
  'type' 
  g_CurrentClass
 ] Ctx:Parser:PushArray

 axiom:PushSymbol classExpander
 g_CurrentClassImpl Ctx:Parser:PushSymbol

; // class

STRING FUNCTION NameAsString
 STRING IN aName
 %SUMMARY 'Делает имя таким, чтобы оно было как для Ctx:Parser:PushString'; 
 [ '`' aName '`' ] strings:Cat >>> Result
; // NameAsString

: ListToNameAsString
 STRING IN aName
 ARRAY IN aList
 aName
  aList .for> NameAsString
 ';'
; // ListToNameAsString

MACRO RunCompileProps&Methods
 [
  'implementation'
  g_CurrentClassImpl

   '%PROPERTIES' g_CurrentClassProperties ListToNameAsString

   '%METHODS' g_CurrentClassMethods ListToNameAsString

   '%CONSTRUCTORS' g_CurrentClassConstructors ListToNameAsString

  'end.'
 ] Ctx:Parser:PushArray
; // RunCompileProps&Methods

MACRO class-end
 axiom:PushSymbol RunCompileProps&Methods
; // class-end

INTEGER type FieldOffset
// - смещение поля

PRIVATE VOID operator MakeMethodSignature
 STRING IN aName
 STRING VAR l_Signature
 g_CurrentClass aName MakeMethodSignaturePrim >>> l_Signature
 if ( l_Signature IsWordDeclared ) then
 begin
  axiom:PushSymbol REDEFINITION
 end
 axiom:PushSymbol :
 l_Signature Ctx:Parser:PushSymbol
; // MakeMethodSignature

MACRO constructor
// - конструктор объектов, пока "фиктивный"
 Literal IN aName
 @SELF Ctx:SetWordProducerForCompiledClass
 g_CurrentClass Ctx:Parser:PushSymbol
 aName |N MakeMethodSignature
 aName |N array:AddTo g_CurrentClassConstructors
; // constructor

PRIVATE VOID operator MakeSelfParam
 g_CurrentClass Ctx:Parser:PushSymbol
 axiom:PushSymbol in
 'Self' Ctx:Parser:PushSymbol
; // MakeSelfParam

MACRO method
// - метод объекта, пока "фиктивный"
 Literal IN aName
 @SELF Ctx:SetWordProducerForCompiledClass
 aName |N MakeMethodSignature
 MakeSelfParam
 aName |N array:AddTo g_CurrentClassMethods
; // method

MACRO readonly
// - read-only свойство объекта, пока "фиктивное"
 Literal IN aName
 @SELF Ctx:SetWordProducerForCompiledClass
 aName |N MakeMethodSignature
 MakeSelfParam
 aName |N array:AddTo g_CurrentClassProperties
; // readonly

MACRO new[
 axiom:PushSymbol [
 axiom:PushSymbol @
 g_CurrentClassImpl Ctx:Parser:PushSymbol
; // new[

MACRO RunCompileFields
 [
  'implementation'
  g_CurrentClassImpl

   '%FIELDS' g_CurrentClassMembers ListToNameAsString

  'end.'
 ] Ctx:Parser:PushArray
; // RunCompileFields

MACRO members-end
 axiom:PushSymbol private
 axiom:PushSymbol Const
 [ 'c:' g_CurrentClass ':Instance:Size' ] strings:Cat Ctx:Parser:PushSymbol
 g_ClassFieldOffset Ctx:Parser:PushInt
 axiom:PushSymbol RunCompileFields
; // members-end

class Object

: FieldByOffset
 Object in Self
 FieldOffset right anOffset
 anOffset Self [i]
; // FieldByOffset

VIRTUAL STRING method ToPrintable
 Self ToPrintable =: Result
; // ToPrintable

PRIVATE operator do-get-member
 STRING IN aName
 axiom:PushSymbol FieldByOffset
 aName MakeFieldOffsetName Ctx:Parser:PushSymbol 
; // do-get-member

MACRO get-member
 Literal IN aName
 aName |N do-get-member
; // get-member

MACRO read
 Literal IN aName
 'Self' Ctx:Parser:PushSymbol 
 aName |N do-get-member
 axiom:PushSymbol =:
 'Result' Ctx:Parser:PushSymbol
 axiom:PushSymbol ;
; // read

INTEGER member VMT
members-end

TtfwWord readonly class read VMT

STRING readonly ClassName
 Self Object:class getClassName =: Result
; // Object:ClassName

constructor DoNotCall
 new[ ] =: Result
; // DoNotCall

class-end // Object

Ссылки на код:

Object.ms.dict.web
Point96.ms.script.web

#1174. О "графической нотации"

Хотел поредактировать переписку, но не стал.

Привожу как есть.

Надеюсь, что никто не обидится.

"Виктор Морозов

О графических нотациях.
Я категорически разочарован в графических нотациях. Когда-то, когда я о них знал только из книг, они казались весьма полезными. Представлялось, что с помощью графических нотаций можно понятным образом отражать структуру сложных вещей в их взаимосвязи.
Но когда я столкнулся на практике, оказалось, что всё вовсе не так радужно. Изобразительные свойства графических нотаций явно недостаточны. Детальная разрисовка архитектуры системы и генерация кода с модели не спасает от килотонн дичайшего макаронного кода, а эти самые килотонны дичайшего кода, прекрасно могут жить в системе, будучи инкапсулированными в паттернизированные и отвечающие всем принципам "хорошего ООП-тона" конструкции.
В этом смысле, ООП, конечно, вообще оказалось страшным троянским конём: обещали всеобщее счастье и "город Солнца", а на деле получился жуткий страх с менеджерами фабрик, адаптерами фасадов и сервантами фасетов.

И, хотя я очень не люблю закорюки, очевидно, что единственным способом борьбы с перерождением ООП во всепоглощающего дикого макаронного монстра, является лёгкая функциональщинка и реактивщинка. Особенно, если она не требует закорючек."

Дело не в нотациях. И не в функциональщине. Хотя функциональщина во многом может спасти. Дело в масштабах. И в том, что для каждого масштаба нужен свой инструмент. Т.е. "прецедент системы" надо программировать на одних изобразительных средствах, а "локальные алгоритмы" - на других. А собственно "фреймворки" и "инфраструктуру" - на третьих. Разные уровни абстракции. А обычно всё сваливается в кучу. Ну и опять же - любая "нотация" без вменяемой документации и примеров использования (читай тестов) - ничто. Как-то так. Ну мне по крайней мере видится. Но дальше есть ещё одна проблема - "организация труда". И тут уже дело совсем и не в нотациях и не в тестах.

Насчёт инструментов и масштаба. Пример - есть скажем ассемблер и есть C, а есть C++. А есть bat-файлы. Никому в голову не приходит (теперь наверное) писать всю систему на ассемблере. Хотя наверное есть любители. Так вот и на C++ или C или Delphi ВСЮ систему видимо писать СЛОЖНО. Видимо нужны более высокоуровневые изобразительные средства. Графическая нотация (с кодогенерацией) это попытка "прикрутить некоторые костыли" для решения проблемы "укрупнения масштаба", но не панацея. Но какие-то более высокоуровневые инструменты - нужны. Мне так кажется.

Кстати к функциональщине я бы ещё добавил бы АОП как средство уменьшения сложности и вынесения "пользовательского кода" за скобки "системного". Но тут тоже весь вопрос в правильном фреймворке.

Кнут кстати как-то посетовал на то, что он зря потратил время на TeX. Который он начал делать, чтобы публиковать свои работы. Хотя мне лично кажется, что не зря. Да и опыт опять же. Не буду пытаться никого равнять с Кнутом, но и в опыте "графических нотаций" многое было "сделано зря". Потому, что "надо было колёса паровоза на ходу менять". Но иначе никак. Если это "прикладуха", которая приносит деньги, а не "чисто научный проект". Но тут дело такое - "чисто научный проект" может родить ещё большего "коня в вакууме".

Наверное QT является неплохим примером средства преодоления "проблем масштаба". В их "расширениями" и "макросами". Не могу до конца внятно судить об этом. Но мне так кажется. Хотя и QT тот же Borland когда-то ухитрился более чем трансректально использовать.

Ну и в "моих скриптах" я пытаюсь как раз решать задачу "разных масштабов" и разных "аксиоматик" для разных уровней системы. Но это пока в "плане изысканий" только. А так и на "скриптах" уже "наваяли" столько "макарон". Дело видимо не только в инструменте, но и в "описании подходов" и их документировании, на что тоже зачастую не хватает времени при занятии "прикладухой". Да и тут дело такое - "можно всё описать", но либо "не так", либо оно не будет востребовано в должном объёме. Т.е. затраты - большие, а толку - ноль.

Но тема поднята - правильная. Я сам над нею давно уже думаю.

Виктор Морозов · Общий друг – Михаил Костицын
Относительно Кнута - лично моё мнение: написание системы вёрстки-разметки ради издания книги (даже многотомной) - очень странная затея. Очень странная с точки зрения именно мотивации и народнохозяйственной обоснованности. 
Если же не исходить из той по
сылки, что TeX писался ради написания его трудов - тогда очевидно, что не зря. Ведь пользуются же люди этим инструментом. "Практика - критерий истины".
Что касается "опыта графических нотаций", то, как мне кажется, одна из самых неприятных черт этого инструмента заключается в изрядной самобытности, изначальной его идеологизированности и, наконец, в том, что из-за применения этого инструмента в системе возникают сущности, наличие которых продиктовано не логикой предметной области, не архитектурой разрабатываемой системы, а только спецификой инструмента. 
Примерно то же касается и фреймворков: если заводятся какие-то сущности, которые непонятно что олицетворяют собой и непонятно за что отвечают - это усложняет разработку.
Вот на мой вкус в качестве примера "неудобной" разработки можно привести iOS: меня заставляют ради простейшего функционала лепить какие-то заумные вундервафли, без которых все вполне спокойно обходятся в андроиде при реализации аналогичного функционала.
Простые вещи обязаны делаться просто и быстро.
Добавление кнопки - простая операция. Добавление контекстного меню - тоже. Добавление пункта в контекстное меню - еще проще.

Всё правильно. Но опять же есть "граничные случаи". Тривиальные и сложные. Пример тривиальных случаев ты привёл. Любая концепция или фреймворк к сожалению перекашивается либо в сторону тривиальных вещей, либо в сторону сложных. Нет баланса. А "очевидно", что "тривиальные" и "сложные вещи" должны делаться по-разному. В этом и сложность - сделать "унифицированный" (не забываем про UML или RUP) инструмент/подход для "всех случаев жизни". Либо это слишком тривиально, либо слишком сложно. Встаёт вопрос - "а нужен ли унифицированный инструмент"? СКОРЕЕ всего - НЕ нужен. Но тут другая проблема - что сложнее выучить один "унифицированный" инструмент или несколько "специализированных". Вот на этот вопрос "за всех" - ответить не берусь.

Ну и про "контекстное меню и кнопку" Смайлик «smile» Про VCM я тебе рассказывал - изначально добавить кнопку и пункт меню было просто. Но это не вписалось во "внешние требования". Не угадали с "концепцией".

Ну а дальше - ну сложно "менять колёса на ходу".

iOS - да - неудобен в этом плане тоже. По своему опыту знаю.


Про Android - не скажу. Не программировал в нативной среде.

Виктор Морозов · Общий друг – Михаил Костицын
Вот! Я именно к балансу и "отсутствию перекосов" и клоню. Вот именно этот баланс - и есть главная проблема. Во всяком случае, эта проблема встречается практически везде, где есть "обширный фреймворк".

Ну Вить, в "нашем конкретном случае" над БАЛАНСОМ я ДАВНО думаю. Только не на всё хватает времени. Я же тебе рассказывал, что много времени тратится "в свисток" типа переделки всяческих конвертеров и схем данных. Годы уходят подчас. Но поверь - ты наблюдаешь уже далеко "не самый худший вариант". Так что - было бы желание улучшать. И искать тот самый баланс. Что непросто опять же при программировании "прикладухи". Очень много "побочных требований" приходится реализовывать.

Был кстати момент, когда не было тебя и Миши и я ОДИН занимался "всем вместе", начиная от GUI и кончая "системными вещами". Но всё равно старался улучшить ситуацию. Это я "про нас".

Но проблема ещё и в том, что я не видел "законченной концепции" с должным балансом от "ведущих производителей". За Android опять же - не скажу. Не знаком. Возможно стоит ознакомиться.

Виктор Морозов · Общий друг – Михаил Костицын
Да я не о нашем конкретном случае, он - всего лишь частный случай. Я в целом пытаюсь рассуждать, в некотором отрыве от нашего всего хозяйства. Ведь всюду одни и те же проблемы, грабли, костыли и велосипеды. В той или мной мере. И что с этим всем делать - непонятно.

Тут - согласен. У всех есть проблемы. И для меня самого загадка - что с этим делать. Если бы была "серебряная пуля" - все бы её давно бы использовали бы.

Виктор Морозов · Общий друг – Михаил Костицын
Про андроид - там нет законченной концепции. Вообще. Есть набор кубиков - бери и делай. Вот тебе RecyclerView чтоб показывать список/грид/еще что-то, вот тебе loader чтоб данные загружать, вот тебе fragment и т.д.
Именно в этом и состоит концепция. 
И - правильно. Поскольку 90% приложений - простые. Как только возникают сложные - возникает NDK и всё то же, что и везде: бубен, грабли, велосипед.

Понятно. Ну набор кубиков это хорошо. Но это как раз почти у всех есть. А вот дальше - сложности. Особенно если проект "на годы".

Виктор Морозов · Общий друг – Михаил Костицын

Ну не скажи что "почти у всех есть". У Embarcadero вот нет никаких кубиков - одни только контролы и совсем уж низкоуровневые классы. Велосипедостроние в полный рост Смайлик «smile»

ну "не скажи" Смайлик «smile» есть и кубики.. хотя конечно как посмотреть..

И ещё о графической нотации. Вот скажем сервисы (на модели) - по-моему вполне себе удачное решение. Облегчает "ручной труд" и решает задачу "уменьшения связности системы". А вот те же сборки (на модели) - то ещё убожество. Пользоваться сложно. Хотя без модели ещё сложнее.А казалось бы и то и то - одна из "реализаций" Dependency Inversion. Видимо дело не только в модели, но и в накопленном опыте и его переосмыслении.





пятница, 25 сентября 2015 г.

#1167. Про контейнеры, ARC и производительность

У меня есть контейнеры.

Ссылки:

http://18delphi.blogspot.ru/2013/07/blog-post_3683.html
http://18delphi.blogspot.ru/2013/07/blog-post_8789.html
http://18delphi.blogspot.ru/2013/07/blog-post_20.html
http://18delphi.blogspot.ru/2013/07/2_18.html
http://18delphi.blogspot.ru/2013/07/blog-post_5374.html
http://18delphi.blogspot.ru/2013/07/2.html

Типа TList<T>.

Но свои.

Обычно итерация по контейнеру выглядит так:

for i := 0 to Container.Count - 1 do
 Container.Items[i].SomeMethod;

Где Items выглядит так:

function _l3TypedList_.pm_GetItems(anIndex: Integer): _ItemType_;
//#UC START# *47A1B1C102E9_47B084190028get_var*
//#UC END# *47A1B1C102E9_47B084190028get_var*
begin
//#UC START# *47A1B1C102E9_47B084190028get_impl*
 Result := GetItem(anIndex);
//#UC END# *47A1B1C102E9_47B084190028get_impl*
end;//_l3TypedList_.pm_GetItems

function _l3TypedListPrim_.GetItem(Index: Integer): _ItemType_;
//#UC START# *47B1CCC901BE_47A74A5F0123_var*
//#UC END# *47B1CCC901BE_47A74A5F0123_var*
begin
//#UC START# *47B1CCC901BE_47A74A5F0123_impl*
 CheckIndex(Index);
 Result := ItemSlot(Index)^;
//#UC END# *47B1CCC901BE_47A74A5F0123_impl*
end;//_l3TypedListPrim_.GetItem

Исходники:
https://bitbucket.org/lulinalex/mindstream/src/7b84d023d4aefe22476b8a4ce398c42088e7f164/Examples/1167/?at=B284

И вообще говоря - всё неплохо.

Контейнеры типа TList<T> устроены "примерно так же".

НО!

"Неплохо до тех пор" пока _ItemType_ это тип БЕЗ ARC. Т.е. атомарный или объект.

А не запись с интерфейсами или интерфейс.

Как только появляется ARC и/или "большая" запись, то возникает проблема производительности.

В чём?

А в том, что Items[i] возвращают элементы контейнера ПО ЗНАЧЕНИЮ.

Т.е. - КОПИРУЮТ значения во временые переменные.

Но есть метод GetItemSlot:

function GetItemSlot(anIndex: Integer;
  aList: _l3Items_): PItemType;
//#UC START# *47BEDF2A02EA_47A74A5F0123_var*
//#UC END# *47BEDF2A02EA_47A74A5F0123_var*
begin
//#UC START# *47BEDF2A02EA_47A74A5F0123_impl*
 Result := Pointer(aList.f_Data.AsPointer + anIndex * cItemSize);
 assert(Result <> nil);
//#UC END# *47BEDF2A02EA_47A74A5F0123_impl*
end;//GetItemSlot

- он возвращает УКАЗАТЕЛЬ на элемент контейнера.

Тогда итерацию по контейнеру можно переписать:

for i := 0 to Container.Count - 1 do
 Container.ItemSlot(i).SomeMethod;

Синтаксически - похоже на то что выше. Даже "разыменовывать" указатель не надо. Это делает компилятор.

А вот семантически это несколько другое.

Возвращается указатель на элемент, а не копия значения.

Соответственно нет никаких накладных расходов ни на ARC ни на копирование "большой записи".

ПОНЯТНО, что мы тут неким образом выставляем наружу "кишки контейнера".

Потому что в Delphi нет аналога C++ const & (константная ссылка).

И по этому указателю можно записать значение. Но тут уж - ССЗБ (Сам Себе Злобный Буратина).

Зато с производительностью имеем выигрыш.

Даже если мы сделаем так:

procedure SomeProc(const anItem: ItemType);
...

for i := 0 to Container.Count - 1 do
 SomeProc(Container.ItemSlot(i)^);

То ВСЁ РАВНО ни ARC, ни копирования - НЕ БУДЕТ.

Потому, что там - const написано в SomeProc перед anItem.

И возвращаясь к TList<T> - скажу следующее:

Конструкция:

for Element in Container do
 Element.SomeMethod;

Имеет все те же проблемы, что и самый первый пример.

Ибо:

  TEnumerator<T> = class abstract
  protected
    function DoGetCurrent: T; virtual; abstract;
    function DoMoveNext: Boolean; virtual; abstract;
  public
    property Current: T read DoGetCurrent;
    function MoveNext: Boolean;
  end;

  TEnumerable<T> = class abstract
  private
  {$HINTS OFF}
    function ToArrayImpl(Count: Integer): TArray<T>; // used by descendants
  {$HINTS ON}
  protected
    function DoGetEnumerator: TEnumerator<T>; virtual; abstract;
  public
    destructor Destroy; override;
    function GetEnumerator: TEnumerator<T>;
    function ToArray: TArray<T>; virtual;
  end;

Current: T - возвращается ЗНАЧЕНИЕ, а не указатель или ссылка.

А значит ARC и/или КОПИРОВАНИЕ.

Более того в мобильной версии ARC работает ещё и ДЛЯ ОБЪЕКТОВ (если есть присваивание).

И в контейнерах типа TList<T> по-другому - не сделаешь.

А в "моих" - сделаешь.

Через ItemSlot.

Спасибо за внимание.

P.S. Ну и аналогично в https://bitbucket.org/lulinalex/mindstream/src/99ff3eee284bcab17905f1c9cbe02d4769c3e585/Examples/1167/tfwValueStack.pas?at=B284&fileviewer=file-view-default

Не зря pLast используется, а не Last,

Вот например:

...
function TtfwValueStack.PopBool: Boolean;
//#UC START# *4DB013AF01C9_4DB009CF0103_var*
//#UC END# *4DB013AF01C9_4DB009CF0103_var*
begin
//#UC START# *4DB013AF01C9_4DB009CF0103_impl*
 EtfwCheck.IsTrue(Count > 0, 'Стек пустой');
 Result := pLast.AsBoolean;
 Delete(Count - 1);
//#UC END# *4DB013AF01C9_4DB009CF0103_impl*
end;//TtfwValueStack.PopBool

function TtfwValueStack.IsTopBool: Boolean;
//#UC START# *4DB04213007C_4DB009CF0103_var*
//#UC END# *4DB04213007C_4DB009CF0103_var*
begin
//#UC START# *4DB04213007C_4DB009CF0103_impl*
 if Empty then
  Result := false
 else
  Result := (pLast.rType = tfw_vtBool); 
//#UC END# *4DB04213007C_4DB009CF0103_impl*
end;//TtfwValueStack.IsTopBool
...
function TtfwValueStack.IsTopString: Boolean;
//#UC START# *4DB0488A0157_4DB009CF0103_var*
//#UC END# *4DB0488A0157_4DB009CF0103_var*
begin
//#UC START# *4DB0488A0157_4DB009CF0103_impl*
 if Empty then
  Result := false
 else
  Result := (pLast.rType = tfw_vtStr); 
//#UC END# *4DB0488A0157_4DB009CF0103_impl*
end;//TtfwValueStack.IsTopString

function TtfwValueStack.PopDelphiString: AnsiString;
//#UC START# *4DB0489C0129_4DB009CF0103_var*
//#UC END# *4DB0489C0129_4DB009CF0103_var*
begin
//#UC START# *4DB0489C0129_4DB009CF0103_impl*
 EtfwCheck.IsTrue(Count > 0, 'Стек пустой');
 Result := pLast.AsDelphiString;
 Delete(Count - 1);
//#UC END# *4DB0489C0129_4DB009CF0103_impl*
end;//TtfwValueStack.PopDelphiString
...
etc

P.P.S. Да про многопоточность - я тоже знаю.

В многопоточности НЕЛЬЗЯ указатель отдавать. ТОЛЬКО значение.

Если с контейнером реально из РАЗНЫХ потоков нужно работать.

P.P.P.S. Опять же все проблемы с ARC и копированием вылезают на больших объёмах данных.

#1166. А ещё у меня есть проблемы с новым JEDI под Delphi 10 Seatle и DUnit

#1166. А ещё у меня есть проблемы с новым JEDI под Delphi 10 Seatle и DUnit.

GUITestRunner зависает под Delphi 10 Seatle и DUnit. На моих тестах.

Откатываюсь на "старый" JEDI, который сам портировал (не очень понимая как на самом деле) - всё хорошо.

Виснет где-то на ntWait или WaitForSingleObject. Даже стек не показывает.

Где проблема - пока не нашёл. Живу пока со старым JEDI. Самопортированным.

Если у кого-то есть такие же проблемы - пишите. Буду тогда искать.

#1165. Про исключения и производительность

Профайлил тут свой скрипты на предмет производительности (корни проблемы тут - http://programmingmindstream.blogspot.ru/2015/09/1164-aqtime.html) и "с удивлением" (который раз) столкнулся с тем, что бросание исключения (часто) в бизнес логике ведёт к потере производительности в разы.

Например код:

ARRAY FUNCTION LIST
 OBJECT IN anObject
 ^ IN aFunctor
 
 OBJECT VAR l_Element
 l_Element := anObject
 Result := [
  while true
  begin
   l_Element := ( l_Element aFunctor DO )
   if ( l_Element pop:object:IsNil ) then
    BREAK
   l_Element 
  end
 ]
; // LIST

Работает в разы медленнее чем аналог:

ARRAY FUNCTION LIST
 OBJECT IN anObject
 ^ IN aFunctor
 
 OBJECT VAR l_Element
 l_Element := anObject
 BOOLEAN VAR l_NeedDo
 l_NeedDo := true
 Result := [
  while l_NeedDo
  begin
   l_Element := ( l_Element aFunctor DO )
   if ( l_Element pop:object:IsNil ) then
   begin
    l_NeedDo := false
   end
   else
    l_Element 
  end
 ]
; // LIST

Почему?

А потому, что BREAK на самом деле устроен так:

https://bitbucket.org/lulinalex/mindstream/src/7deb4ed1ebc5a138c2a90cc69f14bed0847b09a1/Examples/1165/BasicsPack.pas?at=B284&fileviewer=file-view-default

procedure TkwBREAK.DoDoIt(const aCtx: TtfwContext);
//#UC START# *4DAEEDE10285_9FA400CD8713_var*
//#UC END# *4DAEEDE10285_9FA400CD8713_var*
begin
//#UC START# *4DAEEDE10285_9FA400CD8713_impl*
 raise EtfwBreak.Create('Выход из цикла');
//#UC END# *4DAEEDE10285_9FA400CD8713_impl*
end;//TkwBREAK.DoDoIt

И основное время "съедает" создание/удаление объекта. Которое вообще говоря "очень недёшево".

Вот ассемблерный код:



Именно поэтому я когда-то делал собственное кеширование объектов.

Вот пример:

https://bitbucket.org/lulinalex/mindstream/src/7deb4ed1ebc5a138c2a90cc69f14bed0847b09a1/Examples/1165/l3UnknownPrim.imp.pas?at=B284&fileviewer=file-view-default

class function _l3UnknownPrim_.NewInstance: TObject;
  //override;
  {* - функция распределения памяти под экземпляр объекта. Перекрыта, для контроля за памятью на объекты. }
{$IfDef _UnknownNeedL3}
var
 l_System : Tl3System;
{$EndIf _UnknownNeedL3} 
begin
 {$IfDef _UnknownNeedL3}
 l_System := Tl3System(g_l3System);
 if (l_System = nil) then
 begin
  if not l3MemUtilsDown{l3SystemDown} then
  begin
   l_System := l3System;
//   if (l_System <> nil) then
//    l_System.Stack2Log('Возможная непарность NewInstance/FreeInatance');
  end;//not l3SystemDown
 end;//l_System = nil
 Assert((l_System <> nil) OR not Cacheable); 
 if (l_System <> nil) AND l_System.CanCache AND Cacheable then
 begin
  Result := GetFromCache;
  if (Result <> nil) then
  begin
   _l3UnknownPrim_(Result).InitAfterAlloc;
   Exit;
  end;//Result <> nil
 end;{l_System.CanCache}
 {$EndIf _UnknownNeedL3}
 Result := AllocInstanceMem;
 _l3UnknownPrim_(Result).Use;
 _l3UnknownPrim_(Result).InitAfterAlloc;
 {$IfDef _UnknownNeedL3}
 {$IfDef l3TraceObjects}
 if (l_System <> nil) then
  l_System.RegisterObject(Result, Cacheable);
 {$EndIf l3TraceObjects}
 {$EndIf _UnknownNeedL3}
end;

А в данном случае я сделал исключения синглетонами и использовал их так:

procedure TkwBREAK.DoDoIt(const aCtx: TtfwContext);
//#UC START# *4DAEEDE10285_9FA400CD8713_var*
//#UC END# *4DAEEDE10285_9FA400CD8713_var*
begin
//#UC START# *4DAEEDE10285_9FA400CD8713_impl*
 raise EtfwBreak.Instance;
//#UC END# *4DAEEDE10285_9FA400CD8713_impl*
end;//TkwBREAK.DoDoIt

И это (отчасти) решило проблему с производительностью.

Всё это конечно "про скрипты" написано.

Да и нашёл я это лишь на больших объёмах обрабатываемых данных. Таких как модель большого проекта (десятки тысяч классов и 12-15 миллионов строк кода).

И казалось бы delphi-разработчика это не касается.

Но я хочу лишь подчеркнуть, что "бросание исключений" это дело "недешёвое". И если вы используете исключения в бизнес-логике без надобности (а я такое видел) в качестве "особого результата функции", то вы обречены на просаживание производительности.

Если исключения кидаются сравнительно часто по сравнению, с "обычным кодом".

Я бы ещё конечно про ARC и исключения написал бы. Но пожалуй не буду.

НЕ думаю, что буду понят правильно. У нас ведь в "мейнстриме" ARC.

Хотя судя по коду - исключения ТОЖЕ подвержены ARC'у.

Но похоже, что разработчики из Embarcadero с проблемами ещё не столкнулись.

Так что будем считать, что это "мои личные фантомные боли".

среда, 23 сентября 2015 г.

#1164. Вопрос про AQTime

Вот уже который раз я пытаюсь измерить время и производительность наших библиотек. И в который раз получаю, что все функции размазаны менее 10%. И оптимизировать их кажется нет смысла.

Т.е. не то что ЯВНЫХ лидеров нет, а ВООБЩЕ - "всё размазано".

Я что-то не так делаю? Как-то не так измеряю? Какие-то триггера неправильно ставлю?

Update: для начала надо замерять не Elapsed Time, а CPU Time. Там измерения несколько другие.

#1163. Ссылка. Изменение курсора и автоматическое восстановление при выходе из метода

#1162. Ссылка. Элегантная реализация «слабых событий»

вторник, 22 сентября 2015 г.

#1161. Ссылка. Delphi IDE Colorizer Supports RAD Studio 10 Seattle

#1160. Ссылка. Блокировка перерисовки окна на время обновления его дочерних окон

Блокировка перерисовки окна на время обновления его дочерних окон.

(+) Неудачный эффект WM_SETREDRAW.
(+)(+) Существует реализация WM_SETREDRAW по умолчанию, но вы можете сделать и лучше.

В нашем "фреймворке" это достигается несколько иначе:

https://bitbucket.org/lulinalex/mindstream/src/1fab802d0af4a7a2166f7181501dd79b86f989ce/Examples/1160/afwBaseControl.pas?at=B284&fileviewer=file-view-default

https://bitbucket.org/lulinalex/mindstream/src/580b4f9e3aeba03a771bf30bc270037f071c37d9/Examples/1160/vcmBase.pas?at=B284&fileviewer=file-view-default

{$If not defined(NoVCL)}
procedure TafwBaseControl.WndProc(var Message: TMessage);
//#UC START# *47E136A80191_48BD1975029B_var*
var
 PS: TPaintStruct;
//#UC END# *47E136A80191_48BD1975029B_var*
begin
//#UC START# *47E136A80191_48BD1975029B_impl*
 // Два case тут для удобства отладки
 case Message.Msg of
  WM_ERASEBKGND,
  WM_NCPAINT,
  WM_PAINT:
  begin
   case Message.Msg of
    WM_ERASEBKGND:
     if InUpdating then
     begin
      Message.Result := 1;  {don't erase background}
      Exit;
     end;//InUpdating
    WM_NCPAINT:
     if InUpdating then
      Exit;
    WM_PAINT:
     if InUpdating then
     begin
      BeginPaint(Handle, PS);
      EndPaint(Handle, PS);
      Exit;
     end;//InUpdating
   end;//case Message.Msg
   inherited;
  end;//WM_ERASEBKGND
  else
   inherited;
 end;//case Message.Msg
//#UC END# *47E136A80191_48BD1975029B_impl*
end;//TafwBaseControl.WndProc
{$IfEnd} //not NoVCL

function TafwBaseControl.InUpdating: Boolean;
//#UC START# *48C6C421015B_48BD1975029B_var*
//#UC END# *48C6C421015B_48BD1975029B_var*
begin
//#UC START# *48C6C421015B_48BD1975029B_impl*
 Result := HandleAllocated AND Visible AND afw.IsObjectLocked(Self);
 // без проверки на видимость, WM_PAINT'ы приходят невидимым контролам, в результате
 // имеем прогрузку дерева при ненужной отрисовке, например.
//#UC END# *48C6C421015B_48BD1975029B_impl*
end;//TafwBaseControl.InUpdating

...

class function TvcmAFW.IsObjectLocked(aControl : TObject = nil): Boolean;
  //override;
  {-}
begin
 Result := ((g_Dispatcher <> nil) AND g_Dispatcher.FormDispatcher.Locked){ OR
           ((g_MenuManager <> nil) AND g_MenuManager.UnlockInProgress)};
 if Result and (aControl <> nil) then
  g_Dispatcher.FormDispatcher.AddControlForInvalidate(aControl);
end;

...


Цитирую:

    WM_PAINT:
     if InUpdating then
     begin
      BeginPaint(Handle, PS);
      EndPaint(Handle, PS);
      Exit;
     end;//InUpdating

#1159. Доступ к приватным членам классов при помощи record'ов

Далеко не всегда парадигма членов класса private/protected/public работает так как хотелось бы.

Ведь на самом деле у класса бывают "обычные" пользователи, "продвинутые" пользователи и "эксперты".

Каждому классу пользователей иногда хочется дать "свой уровень доступа" к методам проектного класса.

Я долго думал над тем как это сделать.

Конечно можно использовать интерфейсы. Не буду рассказывать как - думаю, что все и без меня всё прекрасно знают.

Но (!) интерфейсы это - накладные расходы на AddRef/Release.

А иногда эти накладные расходы хочется избежать.

Хочется что-то подобное интерфейсам, но без ARC. "Протоколы" так сказать.

Про "протоколы" вот ссылки:

Протоколы vs интерфейсы.
"Протоколы" на "коленке".
Objective-C и Delphi.
Массовое использование интерфейсов "вообще" и InterlockedIncrement/InterlockedDecrement в частности...
Не знаю уж как в Objective-C "методы зовутся по имени". Но если бы я это делал..

Но это всё - "конь в вакууме".

Как бы это сделать на практике?

Я долго думал и придумал вот какую штуку.

Ничего "космического". Просто сделать "фасадные" записи, которые имеют доступ к "кишкам объекта".

По "аналогии" с Enumerator'ами, которые тоже реализуются записями:

Про generic'и, "примеси", интерфейсы и енумераторы. Только код.
Товарищ написал. "К слову про синтаксический сахар".

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

https://bitbucket.org/lulinalex/mindstream/src/b550da2431d733e50aab7b5bb3c4dcca7f3f68aa/Examples/Protocols/Protocols.dpr?at=B284&fileviewer=file-view-default

program Protocols;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils;

type
 TmyClass = class
  public
   // Дальше идут протоколы "для продвинутого пользователя":
   type
    Advanced1 = record
     private
      f_Provider : TmyClass;
     public
      constructor Create(aProvider: TmyClass);
      procedure ForAdvancedUser1;
      procedure ForAdvancedUser2;
    end;//Advanced1

    Advanced2 = record
     private
      f_Provider : TmyClass;
     public
      constructor Create(aProvider: TmyClass);
      procedure ForAdvancedUser1;
    end;//Advanced2

    Advanced3 = record
     private
      f_Provider : TmyClass;
     public
      constructor Create(aProvider: TmyClass);
      procedure ForAdvancedUser2;
    end;//Advanced3

   // Дальше идут протоколы "для экспертов":
   type
    Expert1 = record
     private
      f_Provider : TmyClass;
     public
      constructor Create(aProvider: TmyClass);
      procedure ForExpertUser1;
      procedure ForExpertUser2;
    end;//Expert1

    Expert2 = record
     private
      f_Provider : TmyClass;
     public
      constructor Create(aProvider: TmyClass);
      procedure ForExpertUser1;
    end;//Expert2

    Expert3 = record
     private
      f_Provider : TmyClass;
     public
      constructor Create(aProvider: TmyClass);
      procedure ForExpertUser2;
    end;//Expert3

  private
   procedure ForAdvancedUser1;
   procedure ForAdvancedUser2;

   procedure ForExpertUser1;
   procedure ForExpertUser2;
  public
   procedure ForRegularUser1;
   procedure ForRegularUser2;
  public
   // Далее идут методы для получения "протоколов"
   function AsA1: Advanced1;
   function AsA2: Advanced2;
   function AsA3: Advanced3;

   function AsE1: Expert1;
   function AsE2: Expert2;
   function AsE3: Expert3;
 end;//TmyClass

// TmyClass.Advanced1

constructor TmyClass.Advanced1.Create(aProvider: TmyClass);
begin
 f_Provider := aProvider;
end;

procedure TmyClass.Advanced1.ForAdvancedUser1;
begin
 f_Provider.ForAdvancedUser1;
end;

procedure TmyClass.Advanced1.ForAdvancedUser2;
begin
 f_Provider.ForAdvancedUser2;
end;

// TmyClass.Expert1

constructor TmyClass.Expert1.Create(aProvider: TmyClass);
begin
 f_Provider := aProvider;
end;

procedure TmyClass.Expert1.ForExpertUser1;
begin
 f_Provider.ForExpertUser1;
end;

procedure TmyClass.Expert1.ForExpertUser2;
begin
 f_Provider.ForExpertUser2;
end;

// TmyClass.Expert2

constructor TmyClass.Expert2.Create(aProvider: TmyClass);
begin
 f_Provider := aProvider;
end;

procedure TmyClass.Expert2.ForExpertUser1;
begin
 f_Provider.ForExpertUser1;
end;

// TmyClass.Expert3

constructor TmyClass.Expert3.Create(aProvider: TmyClass);
begin
 f_Provider := aProvider;
end;

procedure TmyClass.Expert3.ForExpertUser2;
begin
 f_Provider.ForExpertUser2;
end;

// TmyClass.Advanced2

constructor TmyClass.Advanced2.Create(aProvider: TmyClass);
begin
 f_Provider := aProvider;
end;

procedure TmyClass.Advanced2.ForAdvancedUser1;
begin
 f_Provider.ForAdvancedUser1;
end;

// TmyClass.Advanced3

constructor TmyClass.Advanced3.Create(aProvider: TmyClass);
begin
 f_Provider := aProvider;
end;

procedure TmyClass.Advanced3.ForAdvancedUser2;
begin
 f_Provider.ForAdvancedUser2;
end;

// TmyClass

procedure TmyClass.ForAdvancedUser1;
begin
  WriteLn('ForAdvancedUser1');
end;

procedure TmyClass.ForAdvancedUser2;
begin
  WriteLn('ForAdvancedUser2');
end;

procedure TmyClass.ForExpertUser1;
begin
  WriteLn('ForExpertUser1');
end;

procedure TmyClass.ForExpertUser2;
begin
  WriteLn('ForExpertUser2');
end;

procedure TmyClass.ForRegularUser1;
begin
  WriteLn('ForRegularUser1');
end;

procedure TmyClass.ForRegularUser2;
begin
  WriteLn('ForRegularUser2');
end;

function TmyClass.AsA1: Advanced1;
begin
  Result := Advanced1.Create(Self);
end;

function TmyClass.AsA2: Advanced2;
begin
  Result := Advanced2.Create(Self);
end;

function TmyClass.AsA3: Advanced3;
begin
  Result := Advanced3.Create(Self);
end;

function TmyClass.AsE1: Expert1;
begin
  Result := Expert1.Create(Self);
end;

function TmyClass.AsE2: Expert2;
begin
  Result := Expert2.Create(Self);
end;

function TmyClass.AsE3: Expert3;
begin
  Result := Expert3.Create(Self);
end;

var
 l_C : TmyClass;
begin
  try
    l_C := TmyClass.Create;
    try
      l_C.ForRegularUser1;
      l_C.ForRegularUser2;

      l_C.AsA1.ForAdvancedUser1;
      l_C.AsA1.ForAdvancedUser2;

      l_C.AsA2.ForAdvancedUser1;

      l_C.AsA3.ForAdvancedUser2;

      l_C.AsE1.ForExpertUser1;
      l_C.AsE1.ForExpertUser2;

      l_C.AsE2.ForExpertUser1;

      l_C.AsE3.ForExpertUser2;
    finally
      FreeAndNil(l_C);
    end;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

Вот как-то так..

Понятное дело, что "для каждого класса" такое делать "нудно", да и "глупо".

Но когда класс - "сложный" и выполняет "несколько ответственностей", то это может оказатья полезным.

Ну и про KISS и SRP - я конечно знаю.

(+) Про RTTI и helper'ы я конечно знаю. Тоже.

(+)(+) И про God-object - тоже.

среда, 16 сентября 2015 г.

#1156. Ссылка. Старый код: почему он такой

http://m.habrahabr.ru/post/266803/comments/
http://m.habrahabr.ru/post/266803/

Цитата:
"Кстати, очень часто внесение изменений даже в древний и страшный легаси-код могут происходить быстро и более-менее эффективно.

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

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

Не стоит и говорить о том, что попытки кого-то ещё работать с этим кодом приводят к огромным трудозатратам. Автор-гуру держит знания о коде «в оперативной памяти» и помнит (если повезёт) историю забивания того или иного костыля, тогда как новый программист вынужден продираться через хитросплетения костылей, обросших вековым мхом и разбираться в устройстве легаси с нуля.

Ну и нельзя забывать про bus-factor. Если «тот самый» программист уходит из компании, код медленно начинает превращаться в тыкву. Кстати, время работы такого кода после ухода автора прямо пропорционально его мастерству и может достигать нескольких лет. Но, увы, «работает» не значит «развивается» и внесение изменений в такой код либо просто невозможно, либо разрушает всю систему"

Беда в том, что далеко не всегда это делается "специально". Зачастую этому самому "гуру" не остаётся другого выбора.

суббота, 12 сентября 2015 г.

#1153. Вопрос про git

Загадочная загадка. Был на ноуте склонированный git-репозитарий. Всё работало. И push и pull. И commit.

Выключил ноут. Штатно выключил.

Привёз на дачу.

Поработал немного.

Коммиты работают. В локальный репозитарий.

Говорю Push.

Мне пишут что-то про corrupted packed objects. Ну и Push - не проходит.

Push: write error: Bad file descriptor
...
unable to unpack c85977a761bedd4480c1bda569425a60d8ea7fdc header
inflateEnd: stream consistency error (no message)
unable to unpack c8dd22297bb226e83758af194f6ba45cf1d9366a header
inflateEnd: stream consistency error (no message)
unable to unpack cb8c53459f76e6f37b029e71c823daa5b64d1374 header
inflateEnd: stream consistency error (no message)
unable to unpack ccb2162bd9d593db46cbad96b4a22df3470d0345 header
inflateEnd: stream consistency error (no message)
unable to unpack d164a4d3615d1c1adace9fdca2eb62c404ac6d38 header
inflateEnd: stream consistency error (no message)
unable to unpack d31790f06bf82b9409ea0a1e2895790d93095a40 header
inflateEnd: stream consistency error (no message)
unable to unpack d610ac4f5ed3a91217be05501c1ff3bcff5f295c header
inflateEnd: stream consistency error (no message)
unable to unpack d64e263c336879cfc973082af2db42c174198721 header
inflateEnd: stream consistency error (no message)
unable to unpack d747926f9c0b439cff0049961fc71fc3026a8c3f header
inflateEnd: stream consistency error (no message)
unable to unpack d77b5e4bec7ec16a9965cbd4967abfcfbcbf07f0 header
inflateEnd: stream consistency error (no message)
unable to unpack d7d757e44b85c331421f1615d780f0cf72462667 header
inflateEnd: stream consistency error (no message)
unable to unpack d874389f1b7112d21e0f547056f9faa5ce2c7b67 header
inflateEnd: stream consistency error (no message)
unable to unpack d9df0e8142742d196dcea26c7a8c3edc6feaeb63 header
inflateEnd: stream consistency error (no message)
unable to unpack d9e44b6c835cd16ed95cd9de8fb51755e8361e84 header
inflateEnd: stream consistency error (no message)
unable to unpack d9e92cf532996ae8cd7bb1399ba7f670e1b11687 header
inflateEnd: stream consistency error (no message)
unable to unpack da4ee7f307d8ef19a51eb4499d5655ccc6f628eb header
inflateEnd: stream consistency error (no message)
unable to unpack da5cdb93f829be92125ce7edc9c1cf7b6d804e39 header
inflateEnd: stream consistency error (no message)
unable to unpack dc30713fcbd385b8373cb8b54613c8f5f8672d1d header
inflateEnd: stream consistency error (no message)
unable to unpack dc396ade144f711c931302b53037d42f7bba9bd9 header
inflateEnd: stream consistency error (no message)
unable to unpack dca1917cd2300856b57a6f4b57db4087959ab2ef header
inflateEnd: stream consistency error (no message)
unable to unpack dcbacd58ded7ebaec10f273b92d556104fdb3910 header
inflateEnd: stream consistency error (no message)
unable to unpack ddb4528080ddd89b7c4c3c22182c347b9fabf46b header
inflateEnd: stream consistency error (no message)
unable to unpack e0fd5b1a107127c4cbebb0bcfd9dc803faf74d51 header
inflateEnd: stream consistency error (no message)
unable to unpack e208d1fb0848b4d9d6a0a9c5214467ef0c3e7845 header
inflateEnd: stream consistency error (no message)
unable to unpack e7c3282fb7f95a19e05948ffe39aa81a2cae0913 header
inflateEnd: stream consistency error (no message)
unable to unpack e9a3cee0bcb8e567e88cc6d13f90a13e07ea3304 header
inflateEnd: stream consistency error (no message)
unable to unpack e9eb7ed12c85c4b437b99dadd1bb1cb4d84e07d8 header
inflateEnd: stream consistency error (no message)
unable to unpack eb2958f5804bc69e6921102ed935846c2ce30790 header
inflateEnd: stream consistency error (no message)
unable to unpack edbc35771535cf652e6406d1f4718dbc0d409baa header
inflateEnd: stream consistency error (no message)
unable to unpack ee77c4432f90c9833ed2f1c8e4e28dcd0f45db01 header
inflateEnd: stream consistency error (no message)
unable to unpack efce6c0f28d135010b3e1be5e5dc6a7f7a487311 header
inflateEnd: stream consistency error (no message)
unable to unpack f04d9943daba9ddd57f83502694098123458fa6a header
inflateEnd: stream consistency error (no message)
unable to unpack f072dd0e438ef04c4237b6aab2397ac1bce7b02b header
inflateEnd: stream consistency error (no message)
unable to unpack f32babd535cd2bd3cf8e3ad2544c1fbceb3e5d7c header
inflateEnd: stream consistency error (no message)
unable to unpack f387651744d8638b79c07d0de2d99420b1740cc5 header
inflateEnd: stream consistency error (no message)
unable to unpack f554b9f35f36bc83d1c067218696c9696b0d1e7d header
inflateEnd: stream consistency error (no message)
unable to unpack f84fd8b97db9430b0ec3e101c0032c7363a006af header
inflateEnd: stream consistency error (no message)
unable to unpack f889d7f67f54c94d82bbfde91e91ae9c9fe278bb header
inflateEnd: stream consistency error (no message)
unable to unpack f9863fea0982f2a3cbf0c5a53817458acf173993 header
inflateEnd: stream consistency error (no message)
unable to unpack faf5c45df99f1033785b597f3196bafcbc42e72f header
inflateEnd: stream consistency error (no message)
unable to unpack fb7f098c408faf6b1e201c191fd7d731843f7359 header
inflateEnd: stream consistency error (no message)
unable to unpack fce727b4bf8e7c69de6e688cc267db70b41a7583 header
inflateEnd: stream consistency error (no message)
unable to unpack fdc6bacb9c66f3668c96f144f23614b53f74fb41 header
inflateEnd: stream consistency error (no message)
unable to unpack fe0f377e0320d15b0da18989d2acd578bc135e75 header
inflateEnd: stream consistency error (no message)
unable to unpack fe2b0ad641d187d3e4b3ae914e6e355df32c0bdd header
inflateEnd: stream consistency error (no message)
unable to unpack ff0907aba70349b98eec52050e0ea3d8cb515092 header
inflateEnd: stream consistency error (no message)
unable to unpack ff98774b3007aede9bde0bd9c2ecbe7307df028d header
inflateEnd: stream consistency error (no message)
Delta compression using up to 8 threads.
loose object 993a08e49e4730482911ae7fb47d735388c5e981 (stored in .git/objects/99/3a08e49e4730482911ae7fb47d735388c5e981) is corrupt
The remote end hung up unexpectedly
The remote end hung up unexpectedly
write error: Bad file descriptor


Pull - не спасает.

Делать Clone рядом - уж очень много тянуть.

Cleanup - тоже не спасает.

Есть у git какой-нибудь repair?

И вообще интересно мне знать - что же это такое произошло?

Типа диск при перевозке побился?

#1152. Процитирую коллегу. Несколько грубо, но по делу

"Чувак из Яндекса, Артём Зиннатуллин, рассказывавший про RxJava, был гениален.
Просто крутейший тип.
Особенно доставило вот это: "Ну... Можно, конечно, увлечься паттернами и заработать ООП головного мозга...".
RxJava - это такая функциональщина без закорючек, основанная на publisher/subscriber и на цепочке фильтров и функций, "надевающихся" на некоторый поток данных и умеющих стыковаться в последовательные цепочки.
В результате этого, количество адового портяночного говнокода можно резко сократить, избавившись попутно от необходимости чесать левой ногой правое ухо.
Прекрасная штука, реализовать которую можно в любом языке, поддерживающем интерфейсы и дженерики/темплейты и лямбды (последнее необязательно).
Я редко бываю в восторге от каких-то программистских концепций и кунштюков, но это - вот как раз тот редкий случай. Именно в качестве хорошей профилактики ООП головного мозга. Поскольку из всех видов говнокода ООП-говнокод - как правило самый адский и самый непознаваемый говнокод."