#1127. Печать стека после вычисления значения выражения. Пример использования. Только код

Код:

UNIT DumpStack.ms.dict

USES
 io.ms.dict
;

PROCEDURE DumpStackTo
  ^ IN aLambda
 %REMARK 'Вычисляемое значение'
  ^ IN aOutput
 %REMARK 'Устройство вывода'

 %SUMMARY 'Печатает состояние стека после вычисления выражения aLambda' ;

 INTEGER VAR l_StackLevel
 %REMARK 'Уровень стека'

 StackLevel >>> l_StackLevel

 aLambda DO
 %REMARK 'Вычисляем выражение aLambda. Оно может положить на стек "сколько угодно" значений'

 StackLevel l_StackLevel - >>> l_StackLevel
 %REMARK 'Вычисляем приращение стека'

 l_StackLevel >= 0 ?ASSURE 'Приращение стека не может быть отрицательным'

 while ( l_StackLevel > 0 )
 %REMARK 'Цикл по значениям в стеке'
 begin
  Dec l_StackLevel
  aOutput DO
  %REMARK 'Печатаем значение со стека'
 end // while ( l_StackLevel > 0 ) 
 
; // DumpStackTo

PROCEDURE DumpStack
  ^ IN aLambda
 %REMARK 'Вычисляемое значение'
 DumpStackTo ( aLambda DO ) Log
; // DumpStack

Пример использования:

UNIT DogAndBracket.ms.dict

USES
 axiom:Tl3TokenType
 axiom_push.ms.dict
 core.ms.dict
 io.ms.dict
 macro.ms.dict
 NoCapsLock.ms.dict
 params.ms.dict
 arrays.ms.dict
 Testing.ms.dict
;

Procedure DogAndBracket
 String in aBracketOpen
 String in aBracketClose
 INTERFACE var l_Parser 
 Ctx:Parser >>> l_Parser
 ARRAY var l_A
 l_A := []

 l_Parser pop:Parser:NextToken
 while true
 begin
  String var l_Token
  l_Parser pop:Parser:TokenLongString >>> l_Token
  TOKEN_TYPE var l_TokenType
  l_Parser pop:Parser:TokenType >>> l_TokenType
  if ( l_TokenType = Tl3TokenType::l3_ttSymbol ) then
  begin

   ( l_Token = NameOf ( ) ?Fail 'Вложенные скобки пока не поддерживаются'
   ( l_Token = NameOf [ ) ?Fail 'Вложенные скобки пока не поддерживаются'

   if ( l_Token = aBracketClose ) then
   begin
    aBracketOpen Ctx:Parser:PushSymbol
    l_A .slice> 2 .for> 
    begin
     TOKEN in aSymbol
     TOKEN_TYPE in aTokenType
     axiom:PushSymbol @ 
     aSymbol aTokenType axiom:Push 
    end
    l_Token Ctx:Parser:PushSymbol 
    break
   end //l_Token = aBracketClose
  end // l_TokenType = Tl3TokenType::l3_ttSymbol
  if ( l_TokenType = Tl3TokenType::l3_ttInteger ) then
  begin
   l_Parser pop:Parser:TokenInt >>>[] l_A
  end // l_TokenType = Tl3TokenType::l3_ttInteger
  else
  begin
   l_Token >>>[] l_A
  end // l_TokenType = Tl3TokenType::l3_ttInteger
  l_TokenType >>>[] l_A
  l_Parser pop:Parser:NextToken
 end // while true
; // DogAndBracket

USES
 DumpStack.ms.dict
;

MACRO @(
 %SUMMARY '
 Компилирует СПИСОК адресов слов.
 Аналог ( @ X1 @ X2 .. @ XN )
 '
 ;
 NameOf (
  NameOf ) 
   DogAndBracket
; // @(

TestsFor @(
 Test T1 DumpStack @( 1 2 3 4 5 6 1 2 + '123' ) ;
; // TestsFor @(

MACRO @[
 %SUMMARY '
 Компилирует МАССИВ адресов слов.
 Аналог [ @ X1 @ X2 .. @ XN ]
 '
 ;
 NameOf [
  NameOf ]
   DogAndBracket
; // @[

TestsFor @[
 Test T1 DumpStack @[ 1 2 3 4 5 6 1 2 + '123' ] ;
; // TestsFor @[

PROGRAM DogAndBracket.ms.script

USES
 DogAndBracket.ms.dict
 Testing.ms.dict
;

Test&Dump DogAndBracketTest
 RunTests.in.array @[ @( @[ ]
  %REMARK 'Запускаем тесты к указанным скриптовым словам' 
; // DogAndBracketTest

DogAndBracketTest

Вывод на печать:

VOID TestWithDump DogAndBracketTest
 DogAndBracketTest
 DumpElement
 '@('
 @
 Tests:@(
 DoRunTestsFor
 '@['
 @
 Tests:@[
 DoRunTestsFor
; // VOID TestWithDump DogAndBracketTest

Testing: @(
T1
123
+
2
1
6
5
4
3
2
1
Testing end: @(
------------------
Testing: @[
T1
[ 1 2 3 4 5 6 1 2 + 123 ]
Testing end: @[
------------------