четверг, 16 ноября 2017 г.

Реализация ADT на моих скриптах

Собственно определение аксиоматики 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

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

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