пятница, 29 марта 2019 г.
вторник, 13 ноября 2018 г.
Новый Delphi. Языковые фичи
http://blog.marcocantu.com/
http://blog.marcocantu.com/
Ну изобрели "велосипед".
C++ в чистом виде.
Что тоже конечно неплохо...
http://blog.marcocantu.com/
Ну изобрели "велосипед".
C++ в чистом виде.
Что тоже конечно неплохо...
четверг, 15 марта 2018 г.
четверг, 28 декабря 2017 г.
вторник, 28 ноября 2017 г.
воскресенье, 19 ноября 2017 г.
четверг, 16 ноября 2017 г.
Реализация ADT на моих скриптах
Собственно определение аксиоматики ADT:
Определение типа List и операций над ним:
Примеры использования типа List:
(+) http://programmingmindstream.blogspot.ru/2017/11/adt.html?m=1
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
Подписаться на:
Сообщения (Atom)