Способ мышления-Форт



Приложение Б: Определение DOER/MAKE - часть 4


Блок # 22 0 \ DOER/MAKE FORTH-83 Laxen/Perry/Harris LPB 12/05/83 1 : NOTHING ; 2 : DOER CREATE ['] NOTHING >BODY , DOES> @ >R ; 3 VARIABLE MARKER 4 : (MAKE) R> DUP 2+ DUP 2+ SWAP @ >BODY ! 5 @ ?DUP IF >R THEN ; 6 : MAKE STATE @ IF ( компиляция) 7 COMPILE (MAKE) HERE MARKER ! 0 , 8 ELSE HERE [COMPILE] ' >BODY ! 9 [COMPILE] ] THEN ; IMMEDIATE 10 : ;AND COMPILE EXIT HERE MARKER @ ! ; IMMEDIATE 11 : UNDO ['] NOTHING >BODY [COMPILE] ' >BODY ! ; 12 13 \ Код в этом блоке является общественным достоянием. 14 15 - 287 -

Блок # 23 0 ( DOER/MAKE FORTH-83 LabMicro PC/FORTH 2.0 LPB 12/05/83 ) 1 : NOTHING ; 2 : DOER CREATE ['] NOTHING >BODY , DOES> @ >R ; 3 VARIABLE MARKER 4 : (MAKE) R> DUP 2+ DUP 2+ SWAP @ >BODY ! 5 @ ?DUP IF >R THEN ; 6 : MAKE STATE @ IF ( компиляция) 7 COMPILE (MAKE) HERE MARKER ! 0 , 8 ELSE HERE [COMPILE] ' >BODY ! 9 [COMPILE] ] UNSMUDGE THEN ; IMMEDIATE 10 : ;AND COMPILE EXIT HERE MARKER @ ! ; IMMEDIATE 11 : UNDO ['] NOTHING >BODY [COMPILE] ' >BODY ! ; 12 13 ( Код в этом блоке является общественным достоянием.)

Блок # 24 0 ( DOER/MAKE FIG model LPB 10/25/84 ) 1 : NOTHING ; 2 : DOES-APF ( apf -- arf-потомка- ) 2+ ; 3 : DOER @ >R ; 4 VARIABLE MARKER 5 : (MAKE) R> DUP 2+ DUP 2+ SWAP @ 2+ DOES-APF ! 6 @ -DUP IF >R THEN ; 7 : MAKE STATE @ IF ( компиляция) 8 COMPILE (MAKE) HERE MARKER ! 0 , 9 ELSE HERE [COMPILE] ' DOES-APF ! 10 SMUDGE [COMPILE] ] THEN ; IMMEDIATE 11 : ;AND COMPILE ;S HERE MARKER @ ! ; IMMEDIATE 12 : UNDO ' NOTHING [COMPILE] ' DOES-APF ! ; 13 ;S 14 ( Код в этом блоке является общественным достоянием.)

Блок # 25 0 ( DOER/MAKE Стандарт-79 MVP FORTH LPB 12/05/83 ) 1 : NOTHING ; 2 : DOER CREATE ' NOTHING , DOES> @ >R ; 3 VARIABLE MARKER 4 : (MAKE) R> DUP 2+ DUP 2+ SWAP @ 2+ ( apf) ! 5 @ ?DUP IF >R THEN ; 6 : MAKE STATE @ IF ( компиляция) 7 COMPILE (MAKE) HERE MARKER ! 0 , 8 ELSE HERE [COMPILE] ' ! 9 [COMPILE] ] THEN ; IMMEDIATE 10 : ;AND COMPILE EXIT HERE MARKER @ ! ; IMMEDIATE 11 : UNDO ' NOTHING [COMPILE] ' ! ; 12 13 14 ( Код в этом блоке является общественным достоянием.) - 288 -

Блок # 26 0 ( Пример на DOER/MAKE 12/27/84 ) 1 DOER ANSWER 2 : RECITAL CR 3 ." Ваш папа стоит на столе. Спросите его 'WHY?' (почему)" 4 MAKE ANSWER ." Для замены лампочки." 5 BEGIN 6 MAKE ANSWER ." Потому что она сгорела." 7 MAKE ANSWER ." Потому что была старая." 8 MAKE ANSWER ." Потому что мы ее привинтили очень давно." 9 MAKE ANSWER ." Потому что было темно!" 10 MAKE ANSWER ." Потому что стояла ночь!!" 11 MAKE ANSWER ." Перестань спрашивать ПОЧЕМУ?" 12 MAKE ANSWER ." Потому что я с тобой свихнусь." 13 MAKE ANSWER ." Дай мне просто поменять эту лампочку!" 14 FALSE UNTIL ; 15 : WHY? CR ANSWER QUIT ;

---------------------------------------------------------------- - 289 -




Содержание  Назад  Вперед