Собственно определение аксиоматики ADT:
UNIT ADT.ms.dict
USES
axiom:CompiledWordWorkerWord
axiom:TtfwSuppressNextImmediate
axiom:Capture
;
//BOOLEAN CompileTime-VAR g_NeedLog true
BOOLEAN CompileTime-VAR g_NeedLog false
STRING CompileTime-VAR g_Indent ''
: :Log
ToPrintable
if g_NeedLog then
( ToPrintable 'Log: ' SWAP Cat g_Indent SWAP Cat . )
else
DROP
; // :Log
: :Log:
^@ IN aName
^ IN aLambda
if g_NeedLog then
begin
STRING VAR l_Name
aName DO >>> l_Name
l_Name ' Enter' Cat :Log
TF g_Indent (
g_Indent ' ' Cat >>> g_Indent
aLambda DO
) // TF g_Indent
l_Name ' Leave' Cat :Log
end // g_NeedLog
else
begin
aLambda DO
end // g_NeedLog
; // :Log:
: OutDelim
'----------' .
; // OutDelim
: .
ToPrintable
if g_NeedLog then
( 'Value: ' SWAP Cat )
.
; // .
PROCEDURE :Dump
WordOrBox IN aValue
PROCEDURE :DoDump
WordOrBox IN aValue
RULES
( aValue pop:Word:IsCapture )
( aValue Capture:Lambda CodeIterator ==> DumpCodeCall )
//( aValue Capture:Lambda DumpElement )
//()
//( aValue DumpElement )
DEFAULT
()
; // RULES
; // :DoDump
RULES
( g_NeedLog ! )
()
( aValue IsWordBox )
( aValue pop:WordBox:Boxed :DoDump )
DEFAULT
( aValue :DoDump )
; // RULES
; // :Dump
: :ValueDo
WordOrBox
IN aValue
aValue :Log
//aValue :Dump
aValue DO
DUP :Log
; // :ValueDo
: DerefParam
IN aValue
: DoDeref
'DerefParam' :Log:
( aValue :ValueDo )
; // DoDeref
if ( aValue IsWordBox ) then
( aValue pop:WordBox:Boxed >>> aValue )
RULES
( aValue IsWord )
(
RULES
( aValue pop:Word:IsWordPusher )
DoDeref
( aValue pop:Word:IsBeginLike )
DoDeref
( aValue pop:Word:IsConst )
DoDeref
DEFAULT
aValue
; // RULES
)
DEFAULT
aValue
; // RULES
; // DerefParam
//MACRO
STACK_CHANGING_MACRO
codePusher
IN aCode
aCode pop:Word:CodeIterator .for> DO
aCode pop:Word:DecRef
; // codePusher
STRING CompileTime-VAR g_CurrentDataName ''
TkwCompiledTypedKeyValues ARRAY ItfwWordBox TYPE ADT
STACK_CHANGING_MACRO data
^L IN aName
^ IN aCode
/*{ @SELF Ctx:SetWordProducerForCompiledClass
class::TkwCompiledKeyValues Ctx:SetCompiledClassForCompilingWord
'axiom:operator' Ctx:Parser:PushSymbol
aName |N Ctx:Parser:PushSymbol
';' Ctx:Parser:PushSymbol}*/
VAR l_Name
aName |N >>> l_Name
l_Name >>> g_CurrentDataName
//'ANY' Ctx:Parser:PushSymbol
'ADT' Ctx:Parser:PushSymbol
//'TkwCompiledTypedKeyValues' Ctx:Parser:PushSymbol
//'ARRAY' Ctx:Parser:PushSymbol
'TYPE' Ctx:Parser:PushSymbol
l_Name Ctx:Parser:PushSymbol
aCode pop:Word:IncRef
aCode
'codePusher' Ctx:Parser:PushSymbol
; // data
INTEGER CompileTime-VAR g_UnnamedCount 0
IMMEDIATE VOID OPERATOR unnamed
'field' g_UnnamedCount IntToStr + @SELF axiom:DefineVar
INC g_UnnamedCount
; // unnamed
IMMEDIATE VOID OPERATOR unnamedleft
'field' g_UnnamedCount IntToStr + @SELF axiom:DefineVar
INC g_UnnamedCount
; // unnamedleft
/*{IMMEDIATE VOID OPERATOR VAR
^L IN aName
aName |N @SELF axiom:DefineVar
; // VAR}*/
STACK_CHANGING_MACRO constructorPusher
IN aSelf
IN aCode
IN aName
VAR l_Members
aCode pop:Word:MembersIterator >>> l_Members
VAR l_IsAtomic
l_Members .IsEmpty >>> l_IsAtomic
aSelf Ctx:SetWordProducerForCompiledClass
if l_IsAtomic then
begin
//class::TkwCompiledKeyValues Ctx:SetCompiledClassForCompilingWord
class::TkwCompiledTypedKeyValues Ctx:SetCompiledClassForCompilingWord
//class::TkwCompiledKeyValuesWithWordInfo Ctx:SetCompiledClassForCompilingWord
g_CurrentDataName Ctx:Parser:PushSymbol
end // l_IsAtomic
else
begin
g_CurrentDataName Ctx:Parser:PushSymbol
end // l_IsAtomic
//( 'INTERFACE' Ctx:Parser:PushSymbol )
'axiom:operator' Ctx:Parser:PushSymbol
aName Ctx:Parser:PushSymbol
if ( l_IsAtomic ! ) then
begin
VAR l_Count
0 >>> l_Count
ARRAY VAR l_FieldNames
[
l_Members
.for> (
IN anItem
if ( anItem pop:Word:Producer @ unnamedleft == ) then
begin
'^@' Ctx:Parser:PushSymbol
end // ( anItem pop:Word:Producer @ unnamedleft )
else
begin
'^' Ctx:Parser:PushSymbol
end // ( anItem pop:Word:Producer @ unnamedleft )
'IN' Ctx:Parser:PushSymbol
VAR l_FieldName
'aField' l_Count IntToStr Cat >>> l_FieldName
l_FieldName Ctx:Parser:PushSymbol
INC l_Count
l_FieldName
) // .for>
] >>> l_FieldNames
'[' Ctx:Parser:PushSymbol
l_FieldNames
.for> (
IN anItem
anItem Ctx:Parser:PushSymbol
'DerefParam' Ctx:Parser:PushSymbol
'nil' Ctx:Parser:PushSymbol
'>>>' Ctx:Parser:PushSymbol
anItem Ctx:Parser:PushSymbol
) // .for>
']' Ctx:Parser:PushSymbol
/*{ 'KeyValuesCreate:' Ctx:Parser:PushSymbol
'(' Ctx:Parser:PushSymbol
'IN' Ctx:Parser:PushSymbol
'aMade' Ctx:Parser:PushSymbol
l_FieldNames
.for> (
IN anItem
'aMade' Ctx:Parser:PushSymbol
'->' Ctx:Parser:PushSymbol
anItem 'a' .CutPrefix Ctx:Parser:PushSymbol
':=' Ctx:Parser:PushSymbol
'(' Ctx:Parser:PushSymbol
anItem Ctx:Parser:PushSymbol
'DerefParam' Ctx:Parser:PushSymbol
')' Ctx:Parser:PushSymbol
) // .for>
')' Ctx:Parser:PushSymbol}*/
'>>>' Ctx:Parser:PushSymbol
'Result' Ctx:Parser:PushSymbol
end // ( l_IsAtomic ! )
';' Ctx:Parser:PushSymbol
0 >>> g_UnnamedCount
aCode pop:Word:DecRef
; // constructorPusher
//MACRO
//PROCEDURE
:
constructor
^L IN aName
^ IN aCode
aCode pop:Word:IncRef
'constructorPusher' Ctx:Parser:PushSymbol
@SELF
aCode
aName |N
; // constructor
: .DO?
IN aValue
: DoDeref
'.DO?' :Log:
( aValue :ValueDo )
true
; // DoDeref
if ( aValue IsWordBox ) then
( aValue pop:WordBox:Boxed >>> aValue )
RULES
( aValue IsWord )
begin
RULES
// - проверка на то, что это конструктор, чтобы не звать все подряд ссылки на функции
( aValue pop:Word:IsConst )
begin
// - тут вычисляется ссылка на значение
DoDeref
end // ( aValue pop:Word:IsConst )
( aValue pop:Word:IsBeginLike )
begin
// - чтобы работало ( 1 ) в xs
DoDeref
end // ( aValue pop:Word:IsBeginLike )
( aValue pop:Word:IsWordPusher )
begin
false ?ASSURE 'Ловушка'
aValue DO
DO
true
end // ( aValue pop:Word:IsWordPusher )
( aValue Is class::TkwCompiledTypedKeyValues )
begin
// - тут зовутся нульарные конструкторы
( aValue pop:Word:Producer @ constructor == ) ?ASSURE
[ aValue pop:Word:Name ' : ' aValue pop:Word:Producer pop:Word:Name ]
//DoDeref
aValue
false
end // ( aValue Is TkwCompiledTypedKeyValues )
( aValue pop:Word:IsRunner )
begin
// - тут зовутся все остальные конструкторы
( aValue pop:Word:Producer @ constructor == ) ?ASSURE
[ aValue pop:Word:Name ' : ' aValue pop:Word:Producer pop:Word:Name ]
DoDeref
end // ( aValue pop:Word:IsRunner )
( aValue pop:Word:IsCapture )
DoDeref
DEFAULT
begin
//( [ aValue pop:Word:Name ' : ' aValue pop:Word:Producer pop:Word:Name ] strings:Cat Msg )
aValue
false
end // DEFAULT
; // RULES
end // ( aValue IsWord )
DEFAULT
begin
aValue
false
end // DEFAULT
; // RULES
; // .DO?
INTEGER CompileTime-VAR g_Guard 0
: .getMembers
ADT IN aData
VAR l_Index
if ( aData IsArray ! ) then
( aData DO >>> aData )
//aData Array:Count >>> l_Index
0 >>> l_Index
aData
//.reverted>
.for> (
//DEC l_Index
INC g_Guard
TRY
//if ( g_Guard < 10 ) then
//if ( g_Guard < 5 ) then
if ( g_Guard < 4 ) then
begin
.DO? ?
begin
DUP l_Index aData Array:SetItem
end // .DO?
end // ( g_Guard < 10 )
FINALLY
DEC g_Guard
END
INC l_Index
) // .for>
/*{ aData pop:Word:MembersIterator
.reverted>
.for> (
IN anItem
anItem DO .DO?
) // .for>}*/
; // .getMembers
ARRAY FUNCTION array:CopyWithoutDuplicatedStrings
IN anArray
RULES
( anArray .IsNil )
[nil]
( anArray Array:SortKey TtfwSortKey::tfw_skString == )
// - типа и так сортированный - не надо ничего копировать
anArray
DEFAULT
(
VAR l_Used
Array:MakeStringSorted >>> l_Used
VAR l_Copy
[] >>> l_Copy
VAR l_Empty
true >>> l_Empty
anArray
.filter> .AddToArray?: l_Used
.for> (
IN anElement
anElement .AddToArray: l_Copy
false >>> l_Empty
) // anArray .for>
RULES
l_Empty
[nil]
DEFAULT
l_Copy
; // RULES
)
; // RULES
>>> Result
; // array:CopyWithoutDuplicatedStrings
ARRAY FUNCTION TotalMembers
VAR l_It
nil >>> l_It
VAR l_W
Context:rWordCompilingNow >>> l_W
while ( l_W .NotIsNil )
begin
l_W pop:Word:MembersIterator
.filter> ( pop:Word:Name 'Result' != )
.join> l_It
>>> l_It
if ( Ctx:WordDefiningNow l_W == ) then
( nil >>> l_W )
else
( l_W pop:Word:Parent >>> l_W )
end
l_It
.filter> pop:Word:IsVarLike
.filter> ( pop:Word:IsGlobalVar ! )
.map> pop:Word:Name
array:CopyWithoutDuplicatedStrings
>>> l_It
l_It >>> Result
; // TotalMembers
MACRO match
VAR l_Names
[
VAR l_Parser
Ctx:Parser >>> l_Parser
VAR l_Continue
true >>> l_Continue
l_Parser pop:Parser:NextToken
while l_Continue
begin
STRING VAR l_Token
l_Parser pop:Parser:TokenLongString >>> l_Token
if ( l_Token ':' == ) then
begin
( false >>> l_Continue )
end // ( l_Token ':' == )
else
begin
l_Token
l_Parser pop:Parser:NextToken
end // ( l_Token ':' == )
end // true
] >>> l_Names
VAR l_It
TotalMembers >>> l_It
l_Names
.filter> ( l_It SWAP array:HasString ! )
.filter> ( '_' != )
.for> (
IN anItem
'VAR' Ctx:Parser:PushSymbol
anItem Ctx:Parser:PushSymbol
) // .for>
'.getMembers' Ctx:Parser:PushSymbol
l_Names
.reverted>
.for> (
IN anItem
if ( anItem '_' == ) then
begin
'DROP' Ctx:Parser:PushSymbol
end // ( anItem '_' == )
else
begin
'>>>' Ctx:Parser:PushSymbol
anItem Ctx:Parser:PushSymbol
end // ( anItem '_' == )
) // .for>
; // match
WordAliasSafe !( (
: .Check?
IN aValue
VAR l_Value
: DoDeref
'.Check?' :Log:
(
aValue :ValueDo
DUP >>> l_Value
)
true
; // DoDeref
aValue >>> l_Value
RULES
( aValue IsWordBox )
RULES
( l_Value pop:Word:IsCapture )
(
DoDeref
if (
( l_Value IsWordBox )
AND ( l_Value pop:Word:IsCapture )
) then
begin
false ?ASSURE 'Ловушка'
//'got' Msg
DROP // - снимаем true
l_Value call.me
end // ( l_Value pop:Word:IsCapture )
)
DEFAULT
( aValue false )
; // RULES
( aValue IsWord )
RULES
( aValue pop:Word:IsWordPusher )
( aValue :ValueDo MakeCaptureScreen true )
//( aValue :ValueDo MakeCaptureScreen false )
//( aValue false )
( aValue pop:Word:IsConst )
// Чтобы работало: ^@( aList1 ) :List: ^@( aList2 )
DoDeref
( aValue pop:Word:IsRunner )
// Чтобы работало: ^@( aList1 ) :List: ^@( aList2 )
begin
//( aValue pop:Word:Producer @ constructor == ) ?ASSURE
// [ aValue pop:Word:Name ' : ' aValue pop:Word:Producer pop:Word:Name ]
DoDeref
end // ( aValue pop:Word:IsRunner )
DEFAULT
( aValue false )
; // RULES
DEFAULT
( aValue false )
; // aValue
; // .Check?
PROCEDURE .OutCapture
ARRAY IN anIt
//if ( anIt .NotEmpty ) then
begin
'Capture:' Ctx:Parser:PushSymbol
'[' Ctx:Parser:PushSymbol
anIt .for> (
IN anItem
anItem Ctx:Parser:PushSymbol
) // anIt .for>
']' Ctx:Parser:PushSymbol
'!(' Ctx:Parser:PushSymbol
anIt .for> (
IN anItem
'IN' Ctx:Parser:PushSymbol
'_' anItem Cat Ctx:Parser:PushSymbol
) // anIt .for>
anIt .for> (
IN anItem
':' Ctx:Parser:PushSymbol
anItem Ctx:Parser:PushSymbol
STRING VAR l_Item
'_' anItem Cat >>> l_Item
l_Item Ctx:Parser:PushSymbol
'.Check?' Ctx:Parser:PushSymbol
'?' Ctx:Parser:PushSymbol
'(' Ctx:Parser:PushSymbol
'DUP' Ctx:Parser:PushSymbol
'>>>' Ctx:Parser:PushSymbol
// - типа перезаписываем значение
l_Item Ctx:Parser:PushSymbol
')' Ctx:Parser:PushSymbol
';' Ctx:Parser:PushSymbol
) // anIt .for>
end // ( anIt .NotEmpty )
/*{ else
begin
'!(' Ctx:Parser:PushSymbol
end // ( anIt .NotEmpty )}*/
; // .OutCapture
MACRO Cap(
TotalMembers .OutCapture
; // Cap(
MACRO Cap[
VAR l_Names
[
VAR l_Parser
Ctx:Parser >>> l_Parser
VAR l_Continue
true >>> l_Continue
l_Parser pop:Parser:NextToken
while l_Continue
begin
STRING VAR l_Token
l_Parser pop:Parser:TokenLongString >>> l_Token
if ( l_Token '](' == ) then
begin
( false >>> l_Continue )
end // ( l_Token ':' == )
else
begin
l_Token
l_Parser pop:Parser:NextToken
end // ( l_Token ':' == )
end // true
] >>> l_Names
l_Names .OutCapture
; // Cap[
WordAlias ^@[ Cap[
WordAlias ^@( Cap(
IMMEDIATE VOID operator def
^L IN aName
VAR l_Compiler
VAR l_Name
aName |N >>> l_Name
@ (
IN aCode
'Result' aCode pop:Word:FindMember pop:KeyWord:Word aCode pop:Compiler:AddCodePartRef
TtfwSuppressNextImmediate::tfw_sniNo @ pop:Word:SetValue aCode pop:Word:AddCodePart
) // BeforeFinishDefinitionOfNewWord
@ (
IN aCode
VAR l_KW
l_Name aCode pop:Word:CheckWord >>> l_KW
@ call.me l_KW pop:KeyWord:SetWord
) // AfterFillCompiledWord
.TtfwProcedureEx.Create >>> l_Compiler
TRY
l_Name Ctx:SetNewWordName
@SELF Ctx:SetWordProducerForCompiledClass
l_Compiler DO
FINALLY
l_Compiler Word:DecRef
END // TRY..FINALLY
; // def
WordAlias Lambda ^@
/*{ : :Call
Lambda IN aLambda
aLambda DO >>> aLambda
RULES
( aLambda pop:Word:IsWordPusher )
(
aLambda DO >>> aLambda
aLambda DO
)
DEFAULT
( aLambda DO )
; // RULES
; // :Call}*/
: :CallOn
IN aParam
Lambda IN aLambdaToCall
: :CheckParam
IN aParam
RULES
( aParam IsWordBox )
RULES
( aParam pop:Word:IsCapture )
( aParam DO )
DEFAULT
aParam
; // RULES
DEFAULT
aParam
; // RULES
; // :CheckParam
/*{ if ( aLambdaToCall pop:Word:IsVarLike ! ) then
begin
aLambdaToCall pop:Word:Name Msg
aLambdaToCall pop:Object:ClassName Msg
end }*/
VAR l_Lambda
//if ( aLambdaToCall pop:Word:IsVarLike ! ) then
// ( aLambdaToCall pop:Object:ClassName Msg )
if ( aLambdaToCall pop:Word:IsVarLike ) then
( aLambdaToCall pop:Word:GetValue >>> l_Lambda )
else
( aLambdaToCall DO >>> l_Lambda )
//if ( aLambdaToCall pop:Word:IsVarLike ! ) then
// ( aLambdaToCall pop:Object:ClassName Msg )
RULES
( l_Lambda pop:Word:IsWordPusher )
(
l_Lambda DO >>> l_Lambda
//if ( aLambdaToCall pop:Word:IsVarLike ! ) then
// ( aLambdaToCall pop:Object:ClassName Msg )
//aLambdaToCall pop:Word:Name Msg
//aLambdaToCall pop:Object:ClassName Msg
if ( aLambdaToCall pop:Word:IsVarLike ) then
begin
//l_Lambda Msg
l_Lambda MakeCaptureScreen >>> l_Lambda
l_Lambda >>>^ aLambdaToCall
//'got' Msg
end // ( aLambdaToCall pop:Word:IsVarLike )
aParam :CheckParam l_Lambda DO
)
DEFAULT
( aParam :CheckParam l_Lambda DO )
; // RULES
; // :CallOn
Определение типа List и операций над ним:
UNIT ADTList.ms.dict
USES
ADT.ms.dict
;
data List (
//constructor List: ( ANY unnamed List unnamed )
constructor :List: ( ANY unnamedleft List unnamed )
constructor List:[] ()
) // List
List def List:
^ IN aList1
^ IN aList2
^@[ aList1 ]( aList1 ) :List: ^@[ aList2 ]( aList2 )
; // List:
//PROCEDURE
:
// - чтобы итератор мог на стек значения возвращать, например для преобразования к массиву
.List:For:
List IN aList
^ IN aLambda
RULES
( aList List:[] == )
()
DEFAULT
begin
'List:ForFor:' :Log:
(
VAR l_Continue
true >>> l_Continue
while l_Continue
begin
aList match l_Head aList :
l_Head aLambda :CallOn
if ( aList List:[] == ) then
( false >>> l_Continue )
end // l_Continue
) // 'List:ForFor:' :Log:
end // DEFAULT
; // RULES
nil >>> aList
; // .List:For:
List def .List:Map
List IN aList
Lambda IN aLambda
RULES
( aList List:[] == )
List:[]
DEFAULT
begin
'List:Map' :Log:
(
aList match l_Head l_Tail :
^@[ l_Head aLambda ]( l_Head aLambda :CallOn )
:List:
^@[ l_Tail aLambda ]( l_Tail aLambda call.me )
)
end // DEFAULT
; // RULES
; // .List:Map
List def .List:Filter
List IN aList
Lambda IN aLambda
'List:Filter' :Log:
(
VAR l_Cont
true >>> l_Cont
while l_Cont
begin
RULES
( aList List:[] == )
(
List:[]
false >>> l_Cont
)
DEFAULT
begin
aList match l_Head aList :
if ( l_Head aLambda :CallOn ) then
begin
^@[ l_Head ]( l_Head )
:List:
^@[ aList aLambda ]( aList aLambda .List:Filter )
false >>> l_Cont
end // ( l_Head aLambda :CallOn )
end // DEFAULT
; // RULES
end // while l_Cont
) // 'List:Filter' :Log:
; // .List:Filter
List def .List:Join
List IN aList1
List IN aList2
RULES
( aList1 List:[] == )
aList2
( aList2 List:[] == )
aList1
DEFAULT
begin
'List:Join' :Log:
(
aList1 match l_Head l_Tail :
^@[ l_Head ]( l_Head )
:List:
^@[ l_Tail aList2 ]( l_Tail aList2 call.me )
)
end // DEFAULT
; // RULES
; // .List:Join
List def .List:Take
List IN aList
INTEGER IN aCount
RULES
( aList List:[] == )
List:[]
( aCount <= 0 )
List:[]
DEFAULT
begin
'List:Take' :Log:
(
aList match l_Head l_Tail :
^@[ l_Head ]( l_Head )
:List:
^@[ l_Tail aCount ]( l_Tail aCount ` - 1 call.me )
)
end // DEFAULT
; // RULES
nil >>> aList
; // .List:Take
INTEGER def .List:Count
List IN aList
RULES
( aList List:[] == )
0
DEFAULT
begin
'List:Count' :Log:
(
aList match _ l_Tail :
1 ` + ( l_Tail call.me )
//1 l_Tail call.me +
)
end // DEFAULT
; // RULES
; // .List:Count
List def .Any:ToList
ANY IN anItem
^@[ anItem ]( anItem ) :List: List:[]
; // .Any:ToList
WordAlias .ItemToList .Any:ToList
List def .List:Add
List IN aList
ANY IN aValue
'List:Add' :Log:
(
aList
aValue .Any:ToList
//^@[ aValue ]( aValue ) :List: List:[]
.List:Join
)
; // .List:Add
List def xs
'xs' :Log:
( 1 :List: ^@[ ]( xs ( 2 * ) .List:Map ) )
; // xs
List def xs1
'xs1' :Log:
( 1 :List: ^@[ ]( xs1 ( 1 + ) .List:Map ) )
; // xs1
List def xs2
List:[]
; // xs2
List def xs3
INTEGER IN aStart
'xs3' :Log:
( ^@[ aStart ]( aStart ) :List: ^@[ aStart ]( aStart ` + 1 xs3 ) )
; // xs3
List def .Array:ToList
ARRAY IN anArray
List VAR l_List
List:[] >>> l_List
anArray .for> (
IN anItem
l_List anItem .List:Add >>> l_List
) // anArray .for>
l_List
; // .Array:ToList
WordAlias .ArrayToList .Array:ToList
/*{
qsort [] = []
qsort (x:xs) = qsort (filter (< x) xs) ++ [x] ++ qsort (filter (>= x) xs)
}*/
List def .List:Sort
List IN aList
RULES
( aList List:[] == )
List:[]
DEFAULT
begin
'List:Sort' :Log:
(
aList match l_Head l_Tail :
l_Tail ^@[ l_Head ]( l_Head LESS ) .List:Filter
.List:Sort
l_Head .ItemToList
.List:Join
l_Tail ^@[ l_Head ]( l_Head SWAP LESS ) .List:Filter
//l_Tail ^@[ l_Head ]( l_Head LESS ! ) .List:Filter
.List:Sort
.List:Join
)
end // DEFAULT
; // RULES
; // .List:Sort
ARRAY def .List:ToArray
List IN aList
Capture: [ aList ] (
OBJECT IN aLambda
List IN aList
aList .List:For: ( aLambda DO )
) FunctorToIterator
; // .List:ToArray
WordAlias .ListToArray .List:ToArray
Примеры использования типа List:
PROGRAM ADT.ms.script
USES
ADT.ms.dict
;
USES
ADTList.ms.dict
;
Test&Dump ADTTest
data MyEnum (
constructor One ()
constructor Two ()
constructor Three ()
) // MyEnum
//MyEnum .
One .
Two .
Three .
One One == .
Two Two == .
Three Three == .
One Two == .
xs2 .
xs
10
.List:Take
.ListToArray .
//.List:For: .
OutDelim
xs1
10
.List:Take
.ListToArray .
//.List:For: .
OutDelim
xs
10
.List:Take
xs
10
.List:Take
.List:Join
.ListToArray .
//.List:For: .
OutDelim
xs
10
.List:Take
xs
.List:Join
10
.List:Take
.ListToArray .
//.List:For: .
OutDelim
xs
//10
//.List:Take
// - на самом деле - всё равно есть тут Take или нет
// ибо объединяются ДВЕ БЕСКОНЕЧНЫЕ последовательности, а выбирается потом из первой из них
xs
.List:Join
10
.List:Take
.ListToArray .
//.List:For: .
OutDelim
xs
( 4 != )
.List:Filter
10
.List:Take
( 2 != )
.List:Filter
.ListToArray .
//.List:For: .
OutDelim
List: 1 List:[]
IsOdd
.List:Filter
.ListToArray .
//.List:For: .
OutDelim
List:[] .
OutDelim
VAR l_List
List: 1 List:[] >>> l_List
l_List
.ListToArray .
//.List:For: .
OutDelim
List: 1 List: 2 List:[] >>> l_List
l_List
.ListToArray .
//.List:For: .
OutDelim
List: 1 List: 2 List: 3 List: 4 List: 5 List: 6 List:[] >>> l_List
l_List
.ListToArray .
//.List:For: .
OutDelim
List: 1 List: 2 List: 3 List: 4 List: 5 List: 6 List:[]
.ListToArray .
//.List:For: .
OutDelim
List: 1 List: 2 List: 3 List: 4 List: 5 List: 6 List: 7 List: 8 List: 9 List: 10 List:[]
.ListToArray .
//.List:For: .
OutDelim
List: 1 List:[]
IsOdd
.List:Filter
.ListToArray .
//.List:For: .
OutDelim
List: 1 List: 2 List: 3 List: 4 List: 5 List: 6 List: 7 List: 8 List: 9 List: 10 List:[]
IsOdd
.List:Filter
.ListToArray .
//.List:For: .
OutDelim
List: 1 List: 2 List: 3 List: 4 List: 5 List: 6 List: 7 List: 8 List: 9 List: 10 List:[]
IsEven
.List:Filter
.ListToArray .
//.List:For: .
OutDelim
List: 1 List: 2 List: 3 List: 4 List: 5 List: 6 List: 7 List: 8 List: 9 List: 10 List:[]
IsEven
.List:Filter
3
.List:Take
.ListToArray .
//.List:For: .
OutDelim
List: 1 List: 2 List:[]
( 2 * )
.List:Map
( 1 + )
.List:Map
.ListToArray .
//.List:For: .
OutDelim
List: 1 List:[]
( 2 * )
.List:Map
.ListToArray .
//.List:For: .
OutDelim
List: 1 List: 2 List: 3 List: 4 List: 5 List: 6 List: 7 List: 8 List: 9 List: 10 List:[]
( 2 * )
.List:Map
.ListToArray .
//.List:For: .
OutDelim
List: 1 List: 2 List: 3 List: 4 List: 5 List: 6 List: 7 List: 8 List: 9 List: 10 List:[] >>> l_List
l_List
l_List
.List:Join
.ListToArray .
//.List:For: .
OutDelim
List: 1 List: 2 List: 3 List: 4 List: 5 List: 6 List: 7 List: 8 List: 9 List: 10 List:[]
List: 11 List: 12 List: 13 List: 14 List: 15 List: 16 List: 17 List: 18 List: 19 List: 20 List:[]
.List:Join
List: 21 List: 22 List: 23 List: 24 List: 25 List: 26 List: 27 List: 28 List: 29 List: 30 List:[]
.List:Join >>> l_List
l_List
l_List
.List:Join >>> l_List
l_List
l_List
.List:Join >>> l_List
l_List
.ListToArray .
//.List:For: .
OutDelim
l_List
5
.List:Take
.ListToArray .
//.List:For: .
OutDelim
List: 1 List: 2 List: 3 List: 4 List: 5 List: 6 List: 7 List: 8 List: 9 List: 10 List:[]
.List:Count .
OutDelim
List:[]
1
.List:Add
2
.List:Add
3
.List:Add
4
.List:Add
5
.List:Add
.ListToArray .
//.List:For: .
OutDelim
List:[]
'a'
.List:Add
'b'
.List:Add
'c'
.List:Add
'd'
.List:Add
'e'
.List:Add
.ListToArray .
//.List:For: .
OutDelim
List:[]
@ +
.List:Add
@ -
.List:Add
@ *
.List:Add
@ /
.List:Add
.ListToArray .
//.List:For: .
OutDelim
xs
1
.List:Take
.ListToArray .
//.List:For: .
OutDelim
xs
20
.List:Take
.ListToArray .
//.List:For: .
OutDelim
xs
( 2 * ) .List:Map
20
.List:Take
( 2 * ) .List:Map
.ListToArray .
//.List:For: .
OutDelim
xs1
200
.List:Take
.ListToArray .
//.List:For: .
OutDelim
1
xs3
//500
200
.List:Take
.ListToArray .
//.List:For: .
OutDelim
1
xs3
200
.List:Take
.ListToArray .
//.List:For: .
OutDelim
; // ADTTest
ADTTest
DT1.ms.script
USES
ADT.ms.dict
;
USES
ADTList.ms.dict
;
Test&Dump ADTTest
[ 1 2 3 ]
.ArrayToList
.ListToArray .
OutDelim
1
xs3
IsOdd .List:Filter
//10
5001
.List:Take
IsOdd .List:Filter
IsOdd .List:Filter
.ListToArray .
//.List:For: .
OutDelim
[ 1 2 3 ]
.ArrayToList
.ListToArray .
//.List:For: .
OutDelim
[ 1 2 3 ]
.ArrayToList
( 1 LESS ) .List:Filter
.ListToArray .
//.List:For: .
OutDelim
[ 1 2 3 ]
.ArrayToList
.List:Sort
.ListToArray .
//.List:For: .
OutDelim
[ 1 2 ]
.ArrayToList
.List:Sort
.ListToArray .
//.List:For: .
OutDelim
[ 2 1 ]
.ArrayToList
.List:Sort
.ListToArray .
//.List:For: .
OutDelim
[ 1 2 3 ]
.ArrayToList
.List:Sort
.ListToArray .
//.List:For: .
OutDelim
[ 3 2 1 ]
.ArrayToList
.List:Sort
.ListToArray .
//.List:For: .
OutDelim
[ 1 2 3 4 5 6 7 8 9 10 ]
.ArrayToList
.List:Sort
.ListToArray .
//.List:For: .
OutDelim
//[ 1 2 3 4 5 6 7 8 9 10 ]
[ 8 9 10 2 1 3 20 ]
.ArrayToList
.List:Sort
.ListToArray .
//.List:For: .
OutDelim
10 .ItemToList
.ListToArray .
//.List:For: .
OutDelim
[ 1 2 3 4 5 6 7 8 9 10 ] .ArrayToList
.ListToArray .
//.List:For: .
OutDelim
1
xs3
5001
.List:Take
.ListToArray .
//.List:For: .
OutDelim
1
xs3
IsOdd .List:Filter
5001
.List:Take
//IsOdd .List:Filter
.ListToArray .
//.List:For: .
OutDelim
; // ADTTest
ADTTest
(+) http://programmingmindstream.blogspot.ru/2017/11/adt.html?m=1