пятница, 8 апреля 2016 г.

MUMPS и объекты

Когда появился MUMPS мне точно не известно, я считаю что где то в 70 годы прошлого столетия. Он был стандартизован в США достаточно быстро одним из первых языков программирования. Что говорит о его неординарных свойствах. Меня он поражает компактностью, логической целостностью, полнотой, выразительностью и завершенностью. С помощью минимального набора средств он решает огромный круг задач. Современные языки имеют не богатый набор команд и как правило большие стандартные библиотеки. Совокупность этих 2 элементов собственно и есть языковое средство. И если сами языки более менее компактен , то библиотеки достаточно сумбурны. На их фоне MUMPS и его стандартная библиотека резко выделяются компактностью. Возможности MUMPSа несмотря на это в части обработки данных значительно шире за счет того что в язык включены иерархические структуры данных хранимые на дисках (глобали).
Заметное развитие языка продолжалось где то до 1995 г. когда был выпущен последний стандарт этого языка. После этого развитием языка стали заниматься сами разработчики языка. С того далекого 1995 г. уже много воды утекло. Поменялись многие представления о программировании. Появилась и развивалась идея объектного программирования. И в общем то хорошая идея была доведена до абсурда. Даже были созданы языки которые состоят только из объектов например Java. Все предлагалось представлять в виде объектов. Сделать это конечно можно, но не всегда удобно. Все совершенно забыли что кроме объектов существуют взаимосвязи объектов которые плохо укладываются в схему объектов. А вот в иерархическую структуру они укладываются хорошо. Поэтому соединение объектов и иерархической структуры является с моей точки зрения идеальным решением.

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

Структуры в MUMPSе существовали со дня рождения осталось только добавить обЪекты. Сделать это можно расширив понятие переменной до объекта. Введение объектов в MUMPS наталкивается на идеологические трудности. Во всех языках программирования Объекты представлены в виде его описания, стандартное наименонание - класс и реализаций этого класса называемых экземплярами класса. Класс состоит из раздела описания переменных и методов и раздела реализации методов. Особенностью языка MUMPS является отсутствие описания переменных и программ и поэтому я предлагаю описание класса ограничить разделом реализации, а раздел описаний выбросить. Если хорошо подумать то ясно, что раздел описаний и не нужен. А раздел реализации может быть представлен MUMPS программой. Точки входа в эту программу могут обслуживать свойства этого класса. Связь между классом и программой может быть построена на основе имени. То есть класс и программа могут иметь одно и тоже имя. Каждое классовое свойство мы должны иметь возможность:
  • создать,
  • разрушить,
  • записать туда данные,
  • прочитать их оттуда,
  • удалить данные.
Каждой из этих возможностей можно сопоставить префикс в точке входа. Тогда по имени класса, свойству и этому префиксу можно найти обработчик который будет обрабатывать указанное действие для данного свойства класса.

Сопоставим каждому действию его префикс:
 
- создать              - new,
- разрушить            - free,
- записать туда данные - set,
- прочитать их оттуда  - get,
- удалить данные        - kill.

Например есть свойство PROP в классе CLS. Тогда необходимо написать MUMPS программу со следующими точками входа:
CLS ;пример класса
 ;
newPROP ...
freePROP ...
setPROP ...
getPROP ...
killPROP ...

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

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

В описанной схеме отсутствует механизм наследования. Его можно реализовать либо введением специальной команды либо определенной метки например EXT. Поиск методов обработки тогда необходимо вести по всей схеме наследования. Реализация множественного наследования не вызывает трудностей. Еще для реализации полноценных классов необходима локализация переменных внутри методов.

Таковы в общих чертах мои предложения по добавлению классов в MUMPS. Разработчиком языка я не являюсь потому предлагаю свою реализацию классов на основе языка MUMPS. В приложении находится программа %Type она осуществляет поддержку объектов и пример создания объектов на ее основе. Ясно что синтаксис языка я не имел возможности изменить поэтому обращения к свойствам объекта выполнено в виде вызова программ. Наследование реализовано в виде обращения к головной метке Класса как функции которая возвращает перечень классов предков через запятую.

Локализацию переменных должен выполнять прикладной программист на основе команды New (). Программы содержат комментарии и я думаю позволят разобраться с сутью предложения.

Примеры кода:
%Type
%Type ;Объектная модель
  ;создание объекта ref-ссылка где будет создан объект type-класс объекта
new(ref,type,param) New TypePR,TypeZT ;Локализация переменных внутри вызова
 ZT:ref="" "noREF" ;Вызов ошибок переданных параметров
 ZT:type="" "noType" ;
 Set @ref=type ;связать ссылку с его типом
 Set TypePR=$$FindProp(ref,"new") ;найти в иерархии типов конструктор Типа
 ;Если он найден то выполнить его
  If TypePR'="" Set TypeZT=$ZT,$ZT="ERRsynt" Do   Set $ZT=TypeZT
  .If '$D(param) Do @(TypePR_",type)") Q
  .Do @(TypePR_",type,param)") Q
  Q
  ;Освободить объект
free(ref) New TypePR,TypeZT
 ZT:ref="" "noREF"
 Set TypePR=$$FindProp(ref,"free") ;найти в иерархии типов деструктор Типа
 ;Если он найден то выполнить его
  If TypePR'="" Set TypeZT=$ZT,$ZT="ERRsynt" Do @(TypePR_")") Set $ZT=TypeZT
  K @ref ;удалить объект
  Q
  ;получить свойство объекта
get(ref,prop) New TypePR,TypeZT,TypeR
 ZT:ref="" "noREF"
 ZT:prop="" "noProp"
 ;найти в иерархии типов метод чтения этого свойства
 Set TypePR=$$FindProp(ref,"get",prop),TypeR=""
  ;Если он найден то выполнить его
 Set:TypePR'="" TypeZT=$ZT,$ZT="ERRsynt",@("TypeR=$$"_TypePR_")"),$ZT=TypeZT
 Q TypeR
  ;изменить свойство объекта
set(ref,prop,val) New TypePR,TypeZT,TypeERR
  ZT:ref="" "noRef" ZT:prop="" "noProp"
 Set TypePR=$$FindProp(ref,"set",prop)
 If TypePR'="" Set TypeZT=$ZT,$ZT="ERRsynt",@("TypeERR=$$"_TypePR_",val)"),$ZT=TypeZT ZT:TypeERR'="" TypeERR
 Q
  ;Проверить значение
validate(ref,prop,val) New TypePR,TypeZT,TypeERR
  ZT:ref="" "noRef" ZT:prop="" "noProp"
 Set TypePR=$$FindProp(ref,"validate",prop)
 Q:TypePR="" ""
 Set TypeZT=$ZT,$ZT="ERRsynt",@("TypeERR=$$"_TypePR_",val)"),$ZT=TypeZT
 Q TypeERR
 ;Вызов методов класса
  ;Вызвать функцию объекта
function(ref,prog,param) New TypePR,TypeZT,TypeResult
  ZT:ref="" "noRef" ZT:prop="" "noProp"
 Set TypePR=$$FindProp(ref,prog)
 Q:TypePR="" ""
 Set TypeZT=$ZT,$ZT="ERRsynt"
  If '$D(param) Set @("TypeResult=$$"_TypePR_")")
  Else  Set @("TypeResult=$$"_TypePR_",param)")
  Set $ZT=TypeZT
 Q TypeResult
  ;Вызвать программу объекта
program(ref,prog,param) New TypePR,TypeZT
  ZT:ref="" "noRef" ZT:prop="" "noProp"
 Set TypePR=$$FindProp(ref,prog)
 Q:TypePR=""
 Set TypeZT=$ZT,$ZT="ERRsynt"
  If '$D(param) Do @(TypePR_")")
  Else  Do @(TypePR_",param)")
  Set $ZT=TypeZT
 Q
 ;
ERRsynt S $ZT=$Get(TypeZT),$ZE="" Ztrap "syntObjset"
ERRFindExt  S $ZT=$Get(TypeZT),$ZE="" Ztrap "noObjType"
  ;Вспомогательные программы не для внешнего использования
  ;Найти обработчик свойства по иерархии Типов
  ;Рекурсивный поиск обработчика
FndProg(type,prog) Q:TypePR'=""
  New TypeEXT,TypeJ,TypeA,TypeZT
 Set TypePR=prog_"^"_type
 Q:$T(@TypePR)'=""
 Set TypePR="",TypeZT=$ZT,$ZT="ERRFindExt",@("TypeEXT=$$^"_type_"()"),$ZT=TypeZT
 Q:TypeEXT=""
  For TypeJ=1:1:$L(TypeEXT,",") Do FndProg($P(TypeEXT,",",TypeJ),prog) Q:TypePR'=""
  Q
FndProp(type,prop,prog) Q:TypePR'=""
  New TypeEXT,TypeJ,TypeZT
 Set TypePR1=prop_"^"_type,TypePR2=prog_"^"_type,TypeZT=$ZT,$ZT="ERRFindExt"
 If $T(@TypePR1)'="" S TypePR=TypePR1,TypePR2="",$ZT=TypeZT Q
 If $T(@TypePR2)'="" S TypePR=TypePR2,TypePR1="",$ZT=TypeZT Q
 Set @("TypeEXT=$$^"_type_"()"),$ZT=TypeZT
 Q:TypeEXT=""
  For TypeJ=1:1:$L(TypeEXT,",") Do FndProp($P(TypeEXT,",",TypeJ),prop,prog) Q:TypePR'=""
  Q
FindProp(ref,prog,prop) New TypePR,TypePR1,TypePR2
  Set TypePR=""
  If $G(prop)="" Do FndProg(@ref,prog) S:TypePR'="" TypePR=TypePR_"("""_ref_""""
  Else  Set (TypePR1,TypePR2)="" Do FndProp(@ref,prog_prop,prog) S TypePR=$S(TypePR1'="":TypePR1_"("""_ref_"""",TypePR2'="":TypePR2_"("""_ref_""","""_prop_"""",1:"")
  Q TypePR

XPerson
XPerson() Q "" ;Тип Персонa предков нет возвращается пустое значение
  ;Конструктор не используется поэтому соответствующей точки входа (new) нет.
  ;Деструктор не используется поэтому соответствующей точки входа (free) нет.
  ;Описание свойства FIO
new(ref,type) Q
free(ref) Q
  ;Чтение FIO
getFIO(ref) Q @ref@("FIO")
  ;Запись FIO
setFIO(ref,val) S @ref@("FIO")=val Q:$Q "" Q
  ;Описание свойства Age
  ;Чтение Age
getAge(ref) Q @ref@("Age")
  ;Запись Age
setAge(ref,val) S @ref@("Age")=val Q:$Q "" Q

XPrsn
XPrsn() Q "" ;Тип Персонa предков нет возвращается пустое значение
  ;Конструктор не используется точка входа (new) приведена только для примера она может отсутствовать.
  ;Деструктор не используется точка входа (free) приведена только для примера она может отсутствовать.
  ;Описание свойств
new(ref,type,par) Q
free(ref) Q
  ;Чтение Свойств
get(ref,prop) Q @ref@(prop)
  ;Запись Свойств
set(ref,prop,val) S @ref@(prop)=val Q:$Q "" Q
 

XWorker
XWorker() Q "XPerson" ;Тип Работник предок XPerson
getPOSITION(ref) Q @ref@("POS")
setPOSITION(ref,val) S @ref@("POS")=val Q:$Q "" Q
getMONEY(ref) Q @ref@("MON")
setMONEY(ref,val) S @ref@("MON")=val Q:$Q "" Q

XWrkr
XWrkr() Q "XPrsn" ;Тип Работник предок XPrsn
get(ref,prop) Q @ref@(prop)
set(ref,prop,val) S @ref@(prop)=val Q:$Q "" Q
 

XX
XX ;Персоны
  K ^A
  D new^%Type("^A(1,2)","XPrsn",""),new^%Type("^A(1,3)","XPrsn",""),new^%Type("^A(1,4)","XPrsn","")
  D set^%Type("^A(1,2)","FIO","Иванов Иван Иванович")
 D set^%Type("^A(1,3)","FIO","Петров Петр Петрович")
 D set^%Type("^A(1,4)","FIO","Сидоров Сидор Сидорович")
 D set^%Type("^A(1,2)","Age","50")
 D set^%Type("^A(1,3)","Age","60")
 D set^%Type("^A(1,4)","Age","70")
 W #
 W $$get^%Type("^A(1,2)","FIO")," возраст ",$$get^%Type("^A(1,2)","Age"),!
 W $$get^%Type("^A(1,3)","FIO")," возраст ",$$get^%Type("^A(1,3)","Age"),!
 W $$get^%Type("^A(1,4)","FIO")," возраст ",$$get^%Type("^A(1,4)","Age"),!
 ;Работники
  D new^%Type("^A(2,2)","XWrkr","")
  D new^%Type("^A(2,3)","XWrkr","")
  D new^%Type("^A(2,4)","XWrkr","")
 D set^%Type("^A(2,2)","FIO","Иванов Иван Иванович")
 D set^%Type("^A(2,3)","FIO","Петров Петр Петрович")
 D set^%Type("^A(2,4)","FIO","Сидоров Сидор Сидорович")
 D set^%Type("^A(2,2)","Age","50")
 D set^%Type("^A(2,3)","Age","60")
 D set^%Type("^A(2,4)","Age","70")
 D set^%Type("^A(2,2)","POSITION","Администратор")
 D set^%Type("^A(2,3)","POSITION","Директор")
 D set^%Type("^A(2,4)","POSITION","Рабочий")
 D set^%Type("^A(2,2)","MONEY","50000")
 D set^%Type("^A(2,3)","MONEY","60000")
 D set^%Type("^A(2,4)","MONEY","20000")
 W $$get^%Type("^A(2,2)","FIO")," возраст ",$$get^%Type("^A(2,2)","Age")," ",$$get^%Type("^A(2,2)","POSITION")," ",$$get^%Type("^A(2,2)","MONEY"),!
 W $$get^%Type("^A(2,3)","FIO")," возраст ",$$get^%Type("^A(2,3)","Age")," ",$$get^%Type("^A(2,3)","POSITION")," ",$$get^%Type("^A(2,3)","MONEY"),!
 W $$get^%Type("^A(2,4)","FIO")," возраст ",$$get^%Type("^A(2,4)","Age")," ",$$get^%Type("^A(2,4)","POSITION")," ",$$get^%Type("^A(2,4)","MONEY"),!
 Q
 

X
X ;Персоны
  K ^A
  D new^%Type("^A(1,2)","XPerson"),new^%Type("^A(1,3)","XPerson"),new^%Type("^A(1,4)","XPerson")
  D set^%Type("^A(1,2)","FIO","Иванов Иван Иванович")
 D set^%Type("^A(1,3)","FIO","Петров Петр Петрович")
 D set^%Type("^A(1,4)","FIO","Сидоров Сидор Сидорович")
 D set^%Type("^A(1,2)","Age","50")
 D set^%Type("^A(1,3)","Age","60")
 D set^%Type("^A(1,4)","Age","70")
 W #
 W $$get^%Type("^A(1,2)","FIO")," возраст ",$$get^%Type("^A(1,2)","Age"),!
 W $$get^%Type("^A(1,3)","FIO")," возраст ",$$get^%Type("^A(1,3)","Age"),!
 W $$get^%Type("^A(1,4)","FIO")," возраст ",$$get^%Type("^A(1,4)","Age"),!
 ;Работники
  D new^%Type("^A(2,2)","XWorker")
  D new^%Type("^A(2,3)","XWorker")
  D new^%Type("^A(2,4)","XWorker")
 D set^%Type("^A(2,2)","FIO","Иванов Иван Иванович")
 D set^%Type("^A(2,3)","FIO","Петров Петр Петрович")
 D set^%Type("^A(2,4)","FIO","Сидоров Сидор Сидорович")
 D set^%Type("^A(2,2)","Age","50")
 D set^%Type("^A(2,3)","Age","60")
 D set^%Type("^A(2,4)","Age","70")
 D set^%Type("^A(2,2)","POSITION","Администратор")
 D set^%Type("^A(2,3)","POSITION","Директор")
 D set^%Type("^A(2,4)","POSITION","Рабочий")
 D set^%Type("^A(2,2)","MONEY","50000")
 D set^%Type("^A(2,3)","MONEY","60000")
 D set^%Type("^A(2,4)","MONEY","20000")
 W $$get^%Type("^A(2,2)","FIO")," возраст ",$$get^%Type("^A(2,2)","Age")," ",$$get^%Type("^A(2,2)","POSITION")," ",$$get^%Type("^A(2,2)","MONEY"),!
 W $$get^%Type("^A(2,3)","FIO")," возраст ",$$get^%Type("^A(2,3)","Age")," ",$$get^%Type("^A(2,3)","POSITION")," ",$$get^%Type("^A(2,3)","MONEY"),!
 W $$get^%Type("^A(2,4)","FIO")," возраст ",$$get^%Type("^A(2,4)","Age")," ",$$get^%Type("^A(2,4)","POSITION")," ",$$get^%Type("^A(2,4)","MONEY"),!
 Q

Надеюсь что хоть кому нибудь мои предложения покажутся полезными.

С уважением Шарымов Михаил.

Комментариев нет:

Отправить комментарий