Коротко. Эмуляция объектов на скриптах

Коротко. Эмуляция объектов на скриптах.

Пока "в закорючках".

Но потом будет веселее.

https://bitbucket.org/lulinalex/mindstream/src/2e38af822e24f407949e7f4ea7adf57f83992440/Examples/Scripts/POINT15.ms.script?at=B283

Объекты ВСЕ пока - IMMUTABLE.

Мне ЛИЧНО - это нравится. ОЧЕНЬ.

НО скоро будут и MUTABLE.

"Под капотом" объектов лежит массив, но это тоже всё "детали реализации".

Потом мы натянем на это новую грамматику с ключевым словом class и забудем про "закорючки" как про страшный сон.

INTEGER TYPE PIXEL
ARRAY TYPE POINT
CONST c:POINT:CoordCount 2

POINT : POINT:0
 [ 0 0 ] >>> Result
; // POINT:0

POINT : POINT:
 ^ IN aX
 ^ IN aY
 [ aX |^ aY |^ ] >>> Result
; // POINT:

POINT : POINT:XY
 ^ IN aPoint
 [ aPoint |@ DO ] >>> Result
 ( Result Array:Count = c:POINT:CoordCount ) ?ASSURE 'Точка должна содержать две координаты'
; // POINT:XY

POINT : POINT:OF
 ^ IN aPoint
 [ for ( aPoint |@ DO ) ( PIXEL IN aPx aPx ) ] >>> Result
 ( Result Array:Count = c:POINT:CoordCount ) ?ASSURE 'Точка должна содержать две координаты'
; // POINT:OF

POINT : POINT:+
 POINT IN aLeft
 ^ IN aPoint

 INTEGER VAR i
 i := 0

 [ for ( aPoint |@ DO ) ( PIXEL IN aPx aPx i aLeft [i] + Inc i ) ] >>> Result
; // POINT:+

POINT : POINT:-
 POINT IN aLeft
 ^ IN aPoint

 INTEGER VAR i
 i := 0

 [ for ( aPoint |@ DO ) ( PIXEL IN aPx aPx i aLeft [i] SWAP - Inc i ) ] >>> Result
; // POINT:-

POINT : POINT:Neg
 POINT IN aLeft

 [ for aLeft ( PIXEL IN aPx aPx 0 SWAP - ) ] >>> Result
; // POINT:Neg

VOID : POINT:Print
 POINT IN aPoint
 aPoint Print
; // POINT:Print

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

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 )

P1 POINT:Print
P2 POINT:Print
P3 POINT:Print
P4 POINT:Print
P5 POINT:Print
P6 POINT:Print
P7 POINT:Print
P8 POINT:Print
P9 POINT:Print
P10 POINT:Print

Вот так уже поинтереснее:

ARRAY TYPE Object
WordAlias private PRIVATE
WordAlias Private PRIVATE
WordAlias type TYPE
WordAlias Type TYPE
WordAlias var VAR
WordAlias in IN
WordAlias ?Assure ?ASSURE
WordAlias Const CONST
WordAlias const Const

INTEGER type Pixel

Object type Point

private Const c:Point:CoordCount 2

Point : Point:0
 [ 0 0 ] >>> Result
; // Point:0

Point : Point:
 ^ in aX
 ^ in aY
 [ aX |^ aY |^ ] >>> Result
; // Point:

Point : Point:XY
 ^ in aPoint
 [ aPoint |@ DO ] >>> Result
 ( Result Array:Count = c:Point:CoordCount ) ?Assure 'Точка должна содержать две координаты'
; // Point:XY

Point : Point:OF
 ^ in aPoint
 [ for ( aPoint |@ DO ) ( Pixel in aPx aPx ) ] >>> Result
 ( Result Array:Count = c:Point:CoordCount ) ?Assure 'Точка должна содержать две координаты'
; // Point:OF

Point : Point:+
 Point in Self
 ^ in aPoint

 INTEGER var i
 i := 0

 [ for ( aPoint |@ DO ) ( Pixel in aPx aPx i Self [i] + Inc i ) ] >>> Result
; // Point:+

Point : Point:-
 Point in Self
 ^ in aPoint

 INTEGER var i
 i := 0

 [ for ( aPoint |@ DO ) ( Pixel in aPx aPx i Self [i] SWAP - Inc i ) ] >>> Result
; // Point:-

Point : Point:Neg
 Point in Self

 [ for Self ( Pixel in aPx aPx 0 SWAP - ) ] >>> Result
; // Point:Neg

VOID : Point:Print
 Point in aPoint
 aPoint Print
; // Point:Print

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

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 )

P1 Point:Print
P2 Point:Print
P3 Point:Print
P4 Point:Print
P5 Point:Print
P6 Point:Print
P7 Point:Print
P8 Point:Print
P9 Point:Print
P10 Point:Print

А вот так ещё интереснее:

USES
 NoCapsLock.ms.dict
 params.ms.dict
;

Test PointTest

array type Object

INTEGER type Pixel
// - пиксель
INTEGER type FieldOffset
// - смещение поля
List type PixelList
// - список пикселей

Object type Point

private Const c:Point:CoordCount 2

Point : Point:0
 [ 0 0 ] >>> Result
; // Point:0

Point : Point:
 Pixel right aX
 Pixel right aY
 [ aX |^ aY |^ ] >>> Result
; // Point:

Point : Point:XY
 PixelList right aPoint
 [ aPoint |@ DO ] >>> Result
 ( Result Array:Count = c:Point:CoordCount ) ?Assure 'Точка должна содержать две координаты'
; // Point:XY

Point : Point:OF
 Point right aPoint
 [ for ( aPoint |@ DO ) ( Pixel in aPx aPx ) ] >>> Result
 ( Result Array:Count = c:Point:CoordCount ) ?Assure 'Точка должна содержать две координаты'
; // Point:OF

Point : Point:+
 Point in Self
 Point right aPoint

 FieldOffset var i
 i := 0

 [ for ( aPoint |@ DO ) ( Pixel in aPx aPx i Self [i] + Inc i ) ] >>> Result
; // Point:+

Point : Point:-
 Point in Self
 Point right aPoint

 FieldOffset var i
 i := 0

 [ for ( aPoint |@ DO ) ( Pixel in aPx aPx i Self [i] SWAP - Inc i ) ] >>> Result
; // Point:-

Point : Point:Neg
 Point in Self

 [ for Self ( Pixel in aPx aPx 0 SWAP - ) ] >>> Result
; // Point:Neg

VOID : Point:Print
 Point in aPoint
 aPoint Print
; // Point:Print

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

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 )

P1 Point:Print
P2 Point:Print
P3 Point:Print
P4 Point:Print
P5 Point:Print
P6 Point:Print
P7 Point:Print
P8 Point:Print
P9 Point:Print
P10 Point:Print

USES
 CodeDump.ms.dict
;

@SELF DumpElement

; // PointTest

PointTest

Ну и теперь:

USES
 NoCapsLock.ms.dict
 params.ms.dict
 integer.ms.dict
;

Test PointTest

VOID IMMEDIATE OPERATOR class_impl
; // class_impl

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

VOID IMMEDIATE OPERATOR class
 Literal IN aName
 //'class_impl' Ctx:Parser:PushSymbol
 // - вообще должно быть так, почему не работает - надо разбираться
 ':' Ctx:Parser:PushSymbol
 @ class_impl Ctx:SetWordProducerForCompiledClass
 [ '_' aName |N '_' ] strings:Cat Ctx:Parser:PushSymbol
 ';' Ctx:Parser:PushSymbol

 'array' Ctx:Parser:PushSymbol
 'type' Ctx:Parser:PushSymbol
 aName |N Ctx:Parser:PushSymbol

; // class

class Object

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

IMMEDIATE VOID operator constructor
// - конструктор объектов, пока "фиктивный"
 Literal IN aName
 @SELF Ctx:SetWordProducerForCompiledClass
 ':' Ctx:Parser:PushSymbol
 aName |N Ctx:Parser:PushSymbol
; // constructor

IMMEDIATE VOID operator method
// - метод объекта, пока "фиктивный"
 Literal IN aName
 @SELF Ctx:SetWordProducerForCompiledClass
 ':' Ctx:Parser:PushSymbol
 aName |N Ctx:Parser:PushSymbol
; // method

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

class Point

private Const c:Point:CoordCount 2

Point constructor Point:0
 [ 0 0 ] >>> Result
; // Point:0

Point constructor Point:
 Pixel right aX
 Pixel right aY
 [ aX |^ aY |^ ] >>> Result
; // Point:

Point constructor Point:XY
 PixelList right aPoint
 [ aPoint |@ DO ] >>> Result
 ( Result Array:Count = c:Point:CoordCount ) ?Assure 'Точка должна содержать две координаты'
; // Point:XY

Point constructor Point:OF
 Point right aPoint
 [ for ( aPoint |@ DO ) ( Pixel in aPx aPx ) ] >>> Result
 ( Result Array:Count = c:Point:CoordCount ) ?Assure 'Точка должна содержать две координаты'
; // Point:OF

Point method Point:+
 Point in Self
 Point right aPoint

 FieldOffset var i
 i := 0

 [ for ( aPoint |@ DO ) ( Pixel in aPx ( i Self [i] ) (+) aPx Inc i ) ] >>> Result
; // Point:+

Point method Point:-
 Point in Self
 Point right aPoint

 FieldOffset var i
 i := 0

 [ for ( aPoint |@ DO ) ( Pixel in aPx ( i Self [i] ) (-) aPx Inc i ) ] >>> Result
; // Point:-

Point method Point:Neg
 Point in Self

 [ for Self ( Pixel in aPx 0 (-) aPx ) ] >>> Result
; // Point:Neg

void method Point:Print
 Point in aPoint
 aPoint Print
; // Point:Print

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

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 )

P1 Point:Print
P2 Point:Print
P3 Point:Print
P4 Point:Print
P5 Point:Print
P6 Point:Print
P7 Point:Print
P8 Point:Print
P9 Point:Print
P10 Point:Print

'Hello ' (+) 'world' Print

'Hello ' (+) 'world' Print

'Hello ' (+) 'world' Print

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

USES
 CodeDump.ms.dict
;

@SELF DumpElement

; // PointTest

PointTest

Ну и ещё...
Много пока "закорюк", но всё решаемо.

USES
 NoCapsLock.ms.dict
 params.ms.dict
 integer.ms.dict
;

//REDEFINITION
 : (-)
  IN aLeft
  right aRight
  ( aLeft (-) ( aRight DO ) )
 ; // 

Test PointTest

VOID IMMEDIATE OPERATOR class_impl
; // class_impl

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

VOID IMMEDIATE OPERATOR class
 Literal IN aName
 //'class_impl' Ctx:Parser:PushSymbol
 // - вообще должно быть так, почему не работает - надо разбираться
 ':' Ctx:Parser:PushSymbol
 @ class_impl Ctx:SetWordProducerForCompiledClass
 [ '_' aName |N '_' ] strings:Cat Ctx:Parser:PushSymbol
 ';' Ctx:Parser:PushSymbol

 'array' Ctx:Parser:PushSymbol
 'type' Ctx:Parser:PushSymbol
 aName |N Ctx:Parser:PushSymbol

; // class

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

IMMEDIATE VOID operator constructor
// - конструктор объектов, пока "фиктивный"
 Literal IN aName
 @SELF Ctx:SetWordProducerForCompiledClass
 ':' Ctx:Parser:PushSymbol
 aName |N Ctx:Parser:PushSymbol
; // constructor

IMMEDIATE VOID operator method
// - метод объекта, пока "фиктивный"
 Literal IN aName
 @SELF Ctx:SetWordProducerForCompiledClass
 ':' Ctx:Parser:PushSymbol
 aName |N Ctx:Parser:PushSymbol
; // method

IMMEDIATE VOID operator readonly
// - read-only свойство объекта, пока "фиктивное"
 Literal IN aName
 @SELF Ctx:SetWordProducerForCompiledClass
 ':' Ctx:Parser:PushSymbol
 aName |N Ctx:Parser:PushSymbol
; // readonly

class Object

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

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

class Point

private Const c:Point:Offset:X 0
private Const c:Point:Offset:Y 1
private Const c:Point:CoordCount 2

Point constructor Point:
 Pixel right aX
 Pixel right aY
 [ aX |^ aY |^ ] >>> Result
; // Point:

Point constructor Point:0
 Point: 0 0 >>> Result
; // Point:0

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

Pixel readonly Point:X
 Point in Self
 Self FieldByOffset c:Point:Offset:X >>> Result
; // Point:X

Pixel readonly Point:Y
 Point in Self
 Self FieldByOffset c:Point:Offset:Y >>> Result
; // Point:Y

Point constructor Point:OF
 Point right aPoint
 Point: ( aPoint |^ Point:X ) ( aPoint |^ Point:Y ) >>> Result
; // Point:OF

Point method Point:+
 Point in Self
 Point right aPoint

 Point: ( ( Self Point:X ) (+) ( aPoint |^ Point:X ) ) ( ( Self Point:Y ) (+) ( aPoint |^ Point:Y ) ) >>> Result
; // Point:+

Point method Point:-
 Point in Self
 Point right aPoint

 Point: ( ( Self Point:X ) (-) ( aPoint |^ Point:X ) ) ( ( Self Point:Y ) (-) ( aPoint |^ Point:Y ) ) >>> Result
; // Point:-

Point method Point:Neg
 Point in Self

 Point: Neg ( Self Point:X ) Neg ( Self Point:Y ) >>> Result
; // Point:Neg

void method Point:Print
 Point in aPoint
 aPoint Print
; // Point:Print

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

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 )

P1 Point:Print
P2 Point:Print
P3 Point:Print
P4 Point:Print
P5 Point:Print
P6 Point:Print
P7 Point:Print
P8 Point:Print
P9 Point:Print
P10 Point:Print

P1 Point:X Print
P2 Point:X Print
P3 Point:X Print
P4 Point:X Print
P5 Point:X Print
P6 Point:X Print
P7 Point:X Print
P8 Point:X Print
P9 Point:X Print
P10 Point:X Print

P1 Point:Y Print
P2 Point:Y Print
P3 Point:Y Print
P4 Point:Y Print
P5 Point:Y Print
P6 Point:Y Print
P7 Point:Y Print
P8 Point:Y Print
P9 Point:Y Print
P10 Point:Y 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

USES
 CodeDump.ms.dict
;

@SELF DumpElement

; // PointTest

PointTest

Ну и определяем Self автоматом:

USES
 NoCapsLock.ms.dict
 params.ms.dict
 integer.ms.dict
;

//REDEFINITION
 : (-)
  IN aLeft
  right aRight
  ( aLeft (-) ( aRight DO ) )
 ; // 

Test PointTest

VOID IMMEDIATE OPERATOR class_impl
; // class_impl

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

VOID IMMEDIATE OPERATOR class
 Literal IN aName
 //'class_impl' Ctx:Parser:PushSymbol
 // - вообще должно быть так, почему не работает - надо разбираться
 ':' Ctx:Parser:PushSymbol
 @ class_impl Ctx:SetWordProducerForCompiledClass
 [ '_' aName |N '_' ] strings:Cat Ctx:Parser:PushSymbol
 ';' Ctx:Parser:PushSymbol

 'array' Ctx:Parser:PushSymbol
 'type' Ctx:Parser:PushSymbol
 aName |N Ctx:Parser:PushSymbol

; // class

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

IMMEDIATE VOID operator constructor
// - конструктор объектов, пока "фиктивный"
 Literal IN aName
 @SELF Ctx:SetWordProducerForCompiledClass
 ':' Ctx:Parser:PushSymbol
 aName |N Ctx:Parser:PushSymbol
; // constructor

IMMEDIATE VOID operator method
// - метод объекта, пока "фиктивный"
 Literal IN aName
 @SELF Ctx:SetWordProducerForCompiledClass
 ':' Ctx:Parser:PushSymbol
 aName |N Ctx:Parser:PushSymbol
 'in' Ctx:Parser:PushSymbol
 'Self' Ctx:Parser:PushSymbol
; // method

IMMEDIATE VOID operator readonly
// - read-only свойство объекта, пока "фиктивное"
 Literal IN aName
 @SELF Ctx:SetWordProducerForCompiledClass
 ':' Ctx:Parser:PushSymbol
 aName |N Ctx:Parser:PushSymbol
 'in' Ctx:Parser:PushSymbol
 'Self' Ctx:Parser:PushSymbol
; // readonly

class Object

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

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

class Point

private Const c:Point:Offset:X 0
private Const c:Point:Offset:Y 1
private Const c:Point:CoordCount 2

Point constructor Point:
 Pixel right aX
 Pixel right aY
 [ aX |^ aY |^ ] >>> Result
; // Point:

Point constructor Point:0
 Point: 0 0 >>> Result
; // Point:0

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

Pixel readonly Point:X
 Self FieldByOffset c:Point:Offset:X >>> Result
; // Point:X

Pixel readonly Point:Y
 Self FieldByOffset c:Point:Offset:Y >>> Result
; // Point:Y

Point constructor Point:OF
 Point right aPoint
 Point: ( aPoint |^ Point:X ) ( aPoint |^ Point:Y ) >>> Result
; // Point:OF

Point method Point:+
 Point right aPoint

 Point: ( ( Self Point:X ) (+) ( aPoint |^ Point:X ) ) ( ( Self Point:Y ) (+) ( aPoint |^ Point:Y ) ) >>> Result
; // Point:+

Point method Point:-
 Point right aPoint

 Point: ( ( Self Point:X ) (-) ( aPoint |^ Point:X ) ) ( ( Self Point:Y ) (-) ( aPoint |^ Point:Y ) ) >>> Result
; // Point:-

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

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

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

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 )

P1 Point:Print
P2 Point:Print
P3 Point:Print
P4 Point:Print
P5 Point:Print
P6 Point:Print
P7 Point:Print
P8 Point:Print
P9 Point:Print
P10 Point:Print

P1 Point:X Print
P2 Point:X Print
P3 Point:X Print
P4 Point:X Print
P5 Point:X Print
P6 Point:X Print
P7 Point:X Print
P8 Point:X Print
P9 Point:X Print
P10 Point:X Print

P1 Point:Y Print
P2 Point:Y Print
P3 Point:Y Print
P4 Point:Y Print
P5 Point:Y Print
P6 Point:Y Print
P7 Point:Y Print
P8 Point:Y Print
P9 Point:Y Print
P10 Point:Y 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

USES
 CodeDump.ms.dict
;

@SELF DumpElement

; // PointTest

PointTest

Ну и так. Убрали Self при определении методов:

USES
 NoCapsLock.ms.dict
 params.ms.dict
 integer.ms.dict
;

//REDEFINITION
 : (-)
  IN aLeft
  right aRight
  ( aLeft (-) ( aRight DO ) )
 ; // 

Test PointTest

VOID IMMEDIATE OPERATOR class_impl
; // class_impl

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

STRING var g_CurrentClass
g_CurrentClass := ''

VOID IMMEDIATE OPERATOR class
 Literal IN aName
 aName |N >>> g_CurrentClass
 //'class_impl' Ctx:Parser:PushSymbol
 // - вообще должно быть так, почему не работает - надо разбираться
 ':' Ctx:Parser:PushSymbol
 @ class_impl Ctx:SetWordProducerForCompiledClass
 [ '_' g_CurrentClass '_' ] strings:Cat Ctx:Parser:PushSymbol
 ';' Ctx:Parser:PushSymbol

 'array' Ctx:Parser:PushSymbol
 'type' Ctx:Parser:PushSymbol
 g_CurrentClass Ctx:Parser:PushSymbol

; // class

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

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

IMMEDIATE VOID operator method
// - метод объекта, пока "фиктивный"
 Literal IN aName
 @SELF Ctx:SetWordProducerForCompiledClass
 ':' Ctx:Parser:PushSymbol
 aName |N Ctx:Parser:PushSymbol
 g_CurrentClass Ctx:Parser:PushSymbol
 'in' Ctx:Parser:PushSymbol
 'Self' Ctx:Parser:PushSymbol
; // method

IMMEDIATE VOID operator readonly
// - read-only свойство объекта, пока "фиктивное"
 Literal IN aName
 @SELF Ctx:SetWordProducerForCompiledClass
 ':' Ctx:Parser:PushSymbol
 aName |N Ctx:Parser:PushSymbol
 g_CurrentClass Ctx:Parser:PushSymbol
 'in' Ctx:Parser:PushSymbol
 'Self' Ctx:Parser:PushSymbol
; // readonly

class Object

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

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

class Point

private Const c:Point:Offset:X 0
private Const c:Point:Offset:Y 1
private Const c:Point:CoordCount 2

constructor Point:
 Pixel right aX
 Pixel right aY
 [ aX |^ aY |^ ] >>> Result
; // Point:

constructor Point:0
 Point: 0 0 >>> Result
; // Point:0

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

Pixel readonly Point:X
 Self FieldByOffset c:Point:Offset:X >>> Result
; // Point:X

Pixel readonly Point:Y
 Self FieldByOffset c:Point:Offset:Y >>> Result
; // Point:Y

constructor Point:OF
 Point right aPoint
 Point: ( aPoint |^ Point:X ) ( aPoint |^ Point:Y ) >>> Result
; // Point:OF

Point method Point:+
 Point right aPoint

 Point: ( ( Self Point:X ) (+) ( aPoint |^ Point:X ) ) ( ( Self Point:Y ) (+) ( aPoint |^ Point:Y ) ) >>> Result
; // Point:+

Point method Point:-
 Point right aPoint

 Point: ( ( Self Point:X ) (-) ( aPoint |^ Point:X ) ) ( ( Self Point:Y ) (-) ( aPoint |^ Point:Y ) ) >>> Result
; // Point:-

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

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

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

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 )

P1 Point:Print
P2 Point:Print
P3 Point:Print
P4 Point:Print
P5 Point:Print
P6 Point:Print
P7 Point:Print
P8 Point:Print
P9 Point:Print
P10 Point:Print

P1 Point:X Print
P2 Point:X Print
P3 Point:X Print
P4 Point:X Print
P5 Point:X Print
P6 Point:X Print
P7 Point:X Print
P8 Point:X Print
P9 Point:X Print
P10 Point:X Print

P1 Point:Y Print
P2 Point:Y Print
P3 Point:Y Print
P4 Point:Y Print
P5 Point:Y Print
P6 Point:Y Print
P7 Point:Y Print
P8 Point:Y Print
P9 Point:Y Print
P10 Point:Y 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

USES
 CodeDump.ms.dict
;

@SELF DumpElement

; // PointTest

PointTest

Ну и ещё:

USES
 NoCapsLock.ms.dict
 params.ms.dict
 integer.ms.dict
;

//REDEFINITION
 : (-)
  IN aLeft
  right aRight
  ( aLeft (-) ( aRight DO ) )
 ; // 

Test PointTest

VOID IMMEDIATE OPERATOR class_impl
; // class_impl

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

STRING var g_CurrentClass
g_CurrentClass := ''
STRING var g_CurrentClassImpl
g_CurrentClassImpl := ''

VOID IMMEDIATE OPERATOR class
 Literal IN aName
 aName |N >>> g_CurrentClass
 //'class_impl' Ctx:Parser:PushSymbol
 // - вообще должно быть так, почему не работает - надо разбираться
 ':' Ctx:Parser:PushSymbol
 @ class_impl Ctx:SetWordProducerForCompiledClass
 [ '_' g_CurrentClass '_' ] strings:Cat >>> g_CurrentClassImpl
 g_CurrentClassImpl Ctx:Parser:PushSymbol
 ';' Ctx:Parser:PushSymbol

 'array' Ctx:Parser:PushSymbol
 'type' Ctx:Parser:PushSymbol
 g_CurrentClass Ctx:Parser:PushSymbol

; // class

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

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

IMMEDIATE VOID operator method
// - метод объекта, пока "фиктивный"
 Literal IN aName
 @SELF Ctx:SetWordProducerForCompiledClass
 ':' Ctx:Parser:PushSymbol
 aName |N Ctx:Parser:PushSymbol
 g_CurrentClass Ctx:Parser:PushSymbol
 'in' Ctx:Parser:PushSymbol
 'Self' Ctx:Parser:PushSymbol
; // method

IMMEDIATE VOID operator readonly
// - read-only свойство объекта, пока "фиктивное"
 Literal IN aName
 @SELF Ctx:SetWordProducerForCompiledClass
 ':' Ctx:Parser:PushSymbol
 aName |N Ctx:Parser:PushSymbol
 g_CurrentClass Ctx:Parser:PushSymbol
 'in' Ctx:Parser:PushSymbol
 'Self' Ctx:Parser:PushSymbol
; // readonly

IMMEDIATE VOID operator new[
 '[' Ctx:Parser:PushSymbol
 '@' Ctx:Parser:PushSymbol
 g_CurrentClassImpl Ctx:Parser:PushSymbol
; // new[

INTEGER VAR g_ClassFieldOffset
g_ClassFieldOffset := 0

IMMEDIATE VOID operator ClassFieldOffset
 Literal IN aName
 INTEGER right anOffset
 anOffset |^ >>> g_ClassFieldOffset
 'private' Ctx:Parser:PushSymbol
 'Const' Ctx:Parser:PushSymbol
 [ 'c:' g_CurrentClass ':Offset:' aName |N ] strings:Cat Ctx:Parser:PushSymbol
 g_ClassFieldOffset Ctx:Parser:PushInt
; // ClassFieldOffset

IMMEDIATE VOID operator ClassVMTSize
 'private' Ctx:Parser:PushSymbol
 'Const' Ctx:Parser:PushSymbol
 [ 'c:' g_CurrentClass ':VMT:Size' ] strings:Cat Ctx:Parser:PushSymbol
 g_ClassFieldOffset ++ Ctx:Parser:PushInt
; // ClassVMTSize

class Object

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

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

class Point

ClassFieldOffset X 1
ClassFieldOffset Y 2
ClassVMTSize

constructor Point:
 Pixel right aX
 Pixel right aY
 new[ aX |^ aY |^ ] >>> Result
; // Point:

constructor Point:0
 Point: 0 0 >>> Result
; // Point:0

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

Pixel readonly Point:X
 Self FieldByOffset c:Point:Offset:X >>> Result
; // Point:X

Pixel readonly Point:Y
 Self FieldByOffset c:Point:Offset:Y >>> Result
; // Point:Y

constructor Point:OF
 Point right aPoint
 Point: ( aPoint |^ Point:X ) ( aPoint |^ Point:Y ) >>> Result
; // Point:OF

Point method Point:+
 Point right aPoint

 Point: ( ( Self Point:X ) (+) ( aPoint |^ Point:X ) ) ( ( Self Point:Y ) (+) ( aPoint |^ Point:Y ) ) >>> Result
; // Point:+

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

Point method Point:-
 Point right aPoint

 Point:OF ( Self Point:+ ( aPoint |^ Point:Neg ) ) >>> Result
; // Point:-

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

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

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 )

P1 Point:Print
P2 Point:Print
P3 Point:Print
P4 Point:Print
P5 Point:Print
P6 Point:Print
P7 Point:Print
P8 Point:Print
P9 Point:Print
P10 Point:Print

P1 Point:X Print
P2 Point:X Print
P3 Point:X Print
P4 Point:X Print
P5 Point:X Print
P6 Point:X Print
P7 Point:X Print
P8 Point:X Print
P9 Point:X Print
P10 Point:X Print

P1 Point:Y Print
P2 Point:Y Print
P3 Point:Y Print
P4 Point:Y Print
P5 Point:Y Print
P6 Point:Y Print
P7 Point:Y Print
P8 Point:Y Print
P9 Point:Y Print
P10 Point:Y 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

USES
 CodeDump.ms.dict
;

@SELF DumpElement

; // PointTest

PointTest

Ну и ещё:

USES
 NoCapsLock.ms.dict
 params.ms.dict
 integer.ms.dict
;

//REDEFINITION
 : (-)
  IN aLeft
  right aRight
  ( aLeft (-) ( aRight DO ) )
 ; // 

Test PointTest

VOID IMMEDIATE OPERATOR class_impl
; // class_impl

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

STRING var g_CurrentClass
g_CurrentClass := ''
STRING var g_CurrentClassImpl
g_CurrentClassImpl := ''

VOID IMMEDIATE OPERATOR class
 Literal IN aName
 aName |N >>> g_CurrentClass
 //'class_impl' Ctx:Parser:PushSymbol
 // - вообще должно быть так, почему не работает - надо разбираться
 ':' Ctx:Parser:PushSymbol
 @ class_impl Ctx:SetWordProducerForCompiledClass
 [ '_' g_CurrentClass '_' ] strings:Cat >>> g_CurrentClassImpl
 g_CurrentClassImpl Ctx:Parser:PushSymbol
 ';' Ctx:Parser:PushSymbol

 'array' Ctx:Parser:PushSymbol
 'type' Ctx:Parser:PushSymbol
 g_CurrentClass Ctx:Parser:PushSymbol

; // class

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

IMMEDIATE VOID operator constructor
// - конструктор объектов, пока "фиктивный"
 Literal IN aName
 @SELF Ctx:SetWordProducerForCompiledClass
 g_CurrentClass Ctx:Parser:PushSymbol
 ':' Ctx:Parser:PushSymbol
 [ g_CurrentClass ':' aName |N ] strings:Cat Ctx:Parser:PushSymbol
; // constructor

IMMEDIATE VOID operator method
// - метод объекта, пока "фиктивный"
 Literal IN aName
 @SELF Ctx:SetWordProducerForCompiledClass
 ':' Ctx:Parser:PushSymbol
 [ g_CurrentClass ':' aName |N ] strings:Cat Ctx:Parser:PushSymbol
 g_CurrentClass Ctx:Parser:PushSymbol
 'in' Ctx:Parser:PushSymbol
 'Self' Ctx:Parser:PushSymbol
; // method

IMMEDIATE VOID operator readonly
// - read-only свойство объекта, пока "фиктивное"
 Literal IN aName
 @SELF Ctx:SetWordProducerForCompiledClass
 ':' Ctx:Parser:PushSymbol
 [ g_CurrentClass ':' aName |N ] strings:Cat Ctx:Parser:PushSymbol
 g_CurrentClass Ctx:Parser:PushSymbol
 'in' Ctx:Parser:PushSymbol
 'Self' Ctx:Parser:PushSymbol
; // readonly

IMMEDIATE VOID operator new[
 '[' Ctx:Parser:PushSymbol
 '@' Ctx:Parser:PushSymbol
 g_CurrentClassImpl Ctx:Parser:PushSymbol
; // new[

INTEGER VAR g_ClassFieldOffset
g_ClassFieldOffset := 0

IMMEDIATE VOID operator ClassFieldOffset
 Literal IN aName
 INTEGER right anOffset
 anOffset |^ >>> g_ClassFieldOffset
 'private' Ctx:Parser:PushSymbol
 'Const' Ctx:Parser:PushSymbol
 [ 'c:' g_CurrentClass ':Offset:' aName |N ] strings:Cat Ctx:Parser:PushSymbol
 g_ClassFieldOffset Ctx:Parser:PushInt
; // ClassFieldOffset

IMMEDIATE VOID operator ClassInstanceSize
 'private' Ctx:Parser:PushSymbol
 'Const' Ctx:Parser:PushSymbol
 [ 'c:' g_CurrentClass ':Instance:Size' ] strings:Cat Ctx:Parser:PushSymbol
 g_ClassFieldOffset ++ Ctx:Parser:PushInt
; // ClassInstanceSize

class Object

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

ClassFieldOffset VMT 0
ClassInstanceSize

TtfwWord readonly class
 Self FieldByOffset c:Object:Offset:VMT >>> Result
; // Object:class

STRING readonly ClassName
 Self Object:class |N >>> Result
; // Object:ClassName

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

class Point

ClassFieldOffset X 1
ClassFieldOffset Y 2
ClassInstanceSize

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 |@ DO ] >>> Points
 Point:: ( Points FieldByOffset 0 ) ( Points FieldByOffset 1 ) >>> Result
; // XY

Pixel readonly X
 Self FieldByOffset c:Point:Offset:X >>> Result
; // X

Pixel readonly Y
 Self FieldByOffset c:Point:Offset:Y >>> Result
; // 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
; // -

void method Print
 Self Print
; // Print

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

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 )

array var l_Points

[ P1 P2 P3 P4 P5 P6 P7 P8 P9 P10 ] >>> l_Points

for l_Points Point:Print
for l_Points ( Point:X Print )
for l_Points ( Point:Y Print )
for l_Points ( Object:class Print )
for l_Points ( Object:ClassName 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

USES
 CodeDump.ms.dict
;

@SELF DumpElement

; // PointTest

PointTest