Задача : отладочное слово

вопрос

создать слово
(presently:
которое является одновременно и комментарием и отладочным словом
: (presently: ( -- )
и работает так
открывает собою скобку как в комментарии
анализирует количество параметров в скобках и сопоставляет с реальным положением дел на стеке
ПРИМЕР
(presently: а в с -1 ) если на стеке лежит 4 значения, верхнее из которых -1 - ведёт себя как комментарий, который заканчивается скобкой (ничего не делает)
если же число параметров не совпадает или если правый параметр не равен -1 -
выдаёт предупреждение или останавливает исполнение (в зависимости от флага)
Также пропускает строки в кавычках, чтобы можно было (presently: а в с " флаг = " -1 )
и слово по-прежнему насчитывало в скобках 4 параметра, а программист мог читать более содержательные комментарии

если параметр задан символическим значением, то просто учитывает его в количество, если числом - сравнивает

(presently: 1 2 3 4 )
должно выдать предупреждение, если реальное положение дел на стеке ( 1 2 2 4 )
а вот (presently: 1 2 ad 4 ) удовлетворится числом параметров и тем, что 1 2 и 4 совпали ( ad ни с чем сравниваться не будет)

также слово должно давать возможность отключить его, если все хорошо и нужна компиляция без засорения кода

Использование:
разумеется, к слову на стеке может приходить разное число параметров (в разных ветвлениях) , поэтому использование слова ограничено здравым смыслом, но, думаю, удобно: просто пишем комментарий, который помогает нам читать исходник, он вдруг по ходу оказывается ещё и тестирующим словом. У меня есть несколько вариантов слов с похожим действием, но каждое для своего форта. Интересно - как достичь универсального решения. Разумеется, идею можно развивать... (presently... 1 2 3 4 ) может значить : не менее 4, из которых последние 1 2 3 4
(presently... а а 3 а ) может значить : не менее 4, из которых предпоследняя 3 но это уже сложнее

rmammoth

Решение здесь: viewtopic.php?f=9&p=27783#p27783, правда, не совсем честное,

так как возникло при обсуждении расширений Форта и использует их.

вопрос

rmammoth писал(а):

Решение здесь: viewtopic.php?f=9&p=27783#p27783, правда, не совсем честное,

так как возникло при обсуждении расширений Форта и использует их.

если б система была доступна - то чем оно не совсем честное?

Цитата:

7) обязательно указание на форт-систему, для которой написан код; версию системы. В случае уникальности форт-системы обязательна прямая ссылка, по которой она может быть найдена.

это из правил

rmammoth

вопрос писал(а):

rmammoth писал(а):

Решение здесь: viewtopic.php?f=9&p=27783#p27783, правда, не совсем честное,

так как возникло при обсуждении расширений Форта и использует их.

если б система была доступна - то чем оно не совсем честное?

Цитата:

7) обязательно указание на форт-систему, для которой написан код; версию системы. В случае уникальности форт-системы обязательна прямая ссылка, по которой она может быть найдена.

это из правил

Исходники и проект для QtCreator'а здесь: http://ifolder.ru/18045748 , вместе с окончательной реализацией (presently: , которая теперь выглядит так:

Код:

$: ps
:: (stack-checker)

: (presently: # ( . --> . ) Compiles info for runtime stack state validation; immediate, compile-time only
    ?comp
    [$ps $!
         begin
             token
             dup ")" <> if
                 ?parse if >$ else $marker endif
                 false
             endif
         until
         compile (stack-checker) $? ,
         begin $? while $> , repeat $] ; immediate

: (stack-checker) # ( . --> . ) Throws error on wrong stack state
    r> dup @ swap 1+
    2 ($
        depth @0 < if
            "Stack size must be >= " @0 'str str-concat error
        endif
        @0 0 do
            @1 i + @ marker? not if
                i 1+ pick != if 
                    "Unexpected value on stack, must be "
                    @1 i + @ 'str
                    " at pos. " i 'str
                    str-concat str-concat str-concat error
                endif
            endif
        loop
        @1 @0 + >r $) ;

Там же примеры использования

Код:

: test-1    # Only 1 2 3 4 on top of stack will be accepted with test1
    (presently: 1 2 3 4 )
    . . . . ;

: test-2    # 'test2' requires 6 parameters on stack, with 100 on top and "three" at index 3
    (presently: a b "three" c d 100 )
    . . . . . . ;

вопрос

rmammoth писал(а):

Исходники и проект для QtCreator'а здесь: http://ifolder.ru/18045748 , вместе с окончательной реализацией (presently: , которая теперь выглядит так:

Замечательно. Теперь может быть кто-то предложит вариант для обычного форта.

m1ha

Код:

VARIABLE PARAMETRS
VARIABLE DEFINED_PARAMETRS

: ?DEPTH  DEPTH = 0= IF TRUE ABORT" Wrong number of parameters" THEN ;

: ?SIGN ( Saddr u -- Saddr1 u1 TRUE|FALSE )
>R DUP C@ [CHAR] - = IF 1 CHARS + R> 1- TRUE ELSE R> FALSE THEN
;

: ?NUMBER ( Saddr u -- TRUE|FALSE )
( 2DUP ?DOUBLE IF 2SWAP 2DROP ELSE 2DROP THEN )
2DUP ?SIGN IF 2SWAP 2DROP ELSE 2DROP THEN
0 DO DUP I + C@ [CHAR] 0 1- [CHAR] 9 1+ WITHIN 0= IF NEGATE LEAVE THEN  LOOP 0 > 
;

: >DATA LATEST NAME> 5 + ;
: >PARAMETRS >DATA @ ;
: >DEFINED_PARAMETRS >DATA CELL+ @ ;


: INITDATA ( -- addr )
PARAMETRS 0!
DEFINED_PARAMETRS 0! 
HERE 0. , , 

BEGIN
PARAMETRS 1+!
PARSE-NAME
2DUP 
S" )" COMPARE  >R
2DUP
S" --" COMPARE >R R@ 0= IF [CHAR] ) SkipUpTo -1 PARAMETRS +! THEN

OVER C@ [CHAR] " = DUP IF [CHAR] " SkipUpTo >IN 1+! -1 PARAMETRS +! THEN 0= 
R> 0 <> R@ AND AND
IF 
   2DUP ?NUMBER 
   IF ?SIGN IF -1 ELSE 1 THEN 
   -ROT 0. 2SWAP >NUMBER 2DROP  D>S * PARAMETRS @ , , DEFINED_PARAMETRS 1+! 
ELSE  2DROP THEN 
ELSE 2DROP 
THEN 

R> 0=
UNTIL
PARAMETRS @ OVER CELL+ DEFINED_PARAMETRS @ SWAP ! SWAP ! 
;


: ?number_of_parameters >PARAMETRS ?DEPTH ;

: test_parameters >DEFINED_PARAMETRS IF
 >DATA 2 CELLS + DUP >DEFINED_PARAMETRS 2*  CELLS + SWAP  
DO I @ >PARAMETRS 1- SWAP - PICK  I CELL+ @ = 0= IF TRUE ABORT" wrong parameters" THEN
2 CELLS +LOOP  
THEN ;


: (precentli:  
?COMP
0 BRANCH, >MARK
INITDATA  1 >RESOLVE  POSTPONE ?number_of_parameters   POSTPONE test_parameters 

; IMMEDIATE



: test (precentli: raz dva  -- " tretij PARAMETR="  4 ) . . ;
: test1 (precentli: -- ) ." proverka " ;
: test2 (precentli: ) ." eshe proverka" ;

Написано на SPF.
С уважением m1ha

вопрос

m1ha писал(а):

Написано на SPF.С уважением m1ha

Замечательно... только не пойму, что делают тесты

Код:

Open source project at http://spf.sf.net
Russian FIG at http://www.forth.org.ru ; Started by A.Cherezov
Version 4.20 Build 001 at 21.Jan.2009

pr.f
 Ok
test1
proverka  Ok
test2
eshe proverka Ok
1 2 4 test
1 2 4 test
        ^ Wrong number of parameters
1 2 test
1 2 test
      ^ Wrong number of parameters
4 1 test
4 1 test
       ^ Wrong number of parameters
4 1 2 test
4 1 2 test
        ^ Wrong number of parameters
test
2033879029 448536 test
  ^  -4 Исчерпание стека

из-за этого трудно разобраться в остальном
Уточняю - непонятно, сколько и каких параметров нужно подать на стек в слове test

p.s. у меня precently:

m1ha

Прошу прощения, ошибочка вышла. Исправил, вроде щас нормально работает

Код:

VARIABLE PARAMETRS
VARIABLE DEFINED_PARAMETRS

: ?DEPTH  DEPTH = 0= IF TRUE ABORT" Wrong number of parameters" THEN ;

: ?SIGN ( Saddr u -- Saddr1 u1 TRUE|FALSE )
>R DUP C@ [CHAR] - = IF 1 CHARS + R> 1- TRUE ELSE R> FALSE THEN
;

: ?NUMBER ( Saddr u -- TRUE|FALSE )
( 2DUP ?DOUBLE IF 2SWAP 2DROP ELSE 2DROP THEN )
2DUP ?SIGN IF 2SWAP 2DROP ELSE 2DROP THEN
0 DO DUP I + C@ [CHAR] 0 1- [CHAR] 9 1+ WITHIN 0= IF NEGATE LEAVE THEN  LOOP 0 > 
;

: >PARAMETRS @ ;
: >DEFINED_PARAMETRS CELL+ @ ;


: INITDATA 
PARAMETRS 0!
DEFINED_PARAMETRS 0! 
HERE 0. , , 

BEGIN
PARAMETRS 1+!
PARSE-NAME
2DUP 
S" )" COMPARE  >R
2DUP
S" --" COMPARE >R R@ 0= IF [CHAR] ) SkipUpTo -1 PARAMETRS +! THEN

OVER C@ [CHAR] " = DUP IF [CHAR] " SkipUpTo >IN 1+! -1 PARAMETRS +! THEN 0= 
R> 0 <> R@ AND AND
IF 
   2DUP ?NUMBER 
   IF ?SIGN IF -1 ELSE 1 THEN 
   -ROT 0. 2SWAP >NUMBER 2DROP  D>S * PARAMETRS @ , , DEFINED_PARAMETRS 1+! 
ELSE  2DROP THEN 
ELSE 2DROP 
THEN 

R> 0=
UNTIL
>R R@ PARAMETRS @ OVER CELL+ DEFINED_PARAMETRS @ SWAP ! SWAP ! R> 
;


: ?number_of_parameters >R R@ >PARAMETRS ?DEPTH R>  ; 

: test_parameters >R R@ >DEFINED_PARAMETRS IF 
R@ >DEFINED_PARAMETRS 2 * CELLS R@ 2 CELLS + + R@ 2 CELLS + R> @ -ROT       
DO DUP I @ - PICK  I CELL+ @ = 0= IF TRUE ABORT" wrong parameters"  THEN  
2 CELLS +LOOP DROP
ELSE R> DROP 
THEN ;


: (precentli:  
?COMP
0 BRANCH, >MARK
INITDATA >R 1 >RESOLVE R> LIT, POSTPONE  ?number_of_parameters   POSTPONE test_parameters 
; IMMEDIATE


\ ПРОВЕРКИ


: test (precentli: A " отрицательное значение" -9  ) CR  ." test_0"  ;

: test2 (precentli: a b c )
." test2" CR . . . 10 -9 test CR . . ; 

: test1 (precentli: 1 2 -- 3 ) ." test_1" CR ;

: test3 (precentli: ) CR ." test3 - BEZ PARAMETROV" ;



1 2 test1 . .
CR
45 60 0 test2 test3

Задача : отладочное слово

Кто сейчас на конференции