lib\ext\locals.f \EOF
( 28.Mar.2000 Andrey Cherezov Copyright [C] RU FIG
Èñïîëüçîâàíû èäåè ñëåäóþùèõ àâòîðîâ:
Ruvim Pinka; Dmitry Yakimov; Oleg Shalyopa; Yuriy Zhilovets;
Konstantin Tarasov
!! Ðàáîòàåò, òîëüêî íà÷èíàÿ ñ 30 áèëäà SPF/3.75: VERSION . 375030 Ok
)
( Ïðîñòîå ðàñøèðåíèå ÑÏ-Ôîðòà ëîêàëüíûìè ïåðåìåííûìè.
Ðåàëèçîâàíî áåç èñïîëüçîâàíèÿ LOCALS ñòàíäàðòà 94.
Îáúÿâëåíèå âðåìåííûõ ïåðåìåííûõ, âèäèìûõ òîëüêî âíóòðè
òåêóùåãî ñëîâà è îãðàíè÷åííûõ âðåìåíåì âûçîâà äàííîãî
ñëîâà âûïîëíÿåòñÿ ñ ïîìîùüþ ñëîâà "{". Âíóòðè îïðåäåëåíèÿ
ñëîâà èñïîëüçóåòñÿ êîíñòðóêöèÿ, ïîäîáíàÿ ñòåêîâîé íîòàöèè Ôîðòà
{ ñïèñîê_èíèöèàëèçèðîâàííûõ_ëîêàëîâ \ ñï.íåèíèö.ëîêàëîâ -- ÷òî óãîäíî }
Íàïðèìåð:
{ a b c d \ e f -- i j }
×àñòü "\ ñï.íåèíèö.ëîêàëîâ" ìîæåò îòñóòñòâîâàòü, íàïðèìåð:
{ item1 item2 -- }
Ýòî çàñòàâëÿåò ÑÏ-Ôîðò àâòîìàòè÷åñêè âûäåëÿòü ìåñòî â
ñòåêå âîçâðàòîâ äëÿ ýòèõ ïåðåìåííûõ â ìîìåíò âûçîâà ñëîâà
è àâòîìàòè÷åñêè îñâîáîæäàòü ìåñòî ïðè âûõîäå èç íåãî.
Îáðàùåíèå ê òàêèì ëîêàëüíûì ïåðåìåííûì - êàê ê VALUE-ïåðåìåííûì
ïî èìåíè. Åñëè íóæåí àäðåñ ïåðåìåííîé, òî èñïîëüçóåòñÿ "^ èìÿ".
Ïðèìåðû:
: TEST { a b c d \ e f -- } a . b . c . b c + -> e e . f . ^ a @ . ;
Ok
1 2 3 4 TEST
1 2 3 5 0 1 Ok
: TEST { a b -- } a . b . CR 5 0 DO I . a . b . CR LOOP ;
Ok
12 34 TEST
12 34
0 12 34
1 12 34
2 12 34
3 12 34
4 12 34
Ok
: TEST { a b } a . b . ;
Ok
1 2 TEST
1 2 Ok
: TEST { a b \ c } a . b . c . ;
Ok
1 2 TEST
1 2 0 Ok
: TEST { a b -- } a . b . ;
Ok
1 2 TEST
1 2 Ok
: TEST { a b \ c -- d } a . b . c . ;
Ok
1 2 TEST
1 2 0 Ok
: TEST { \ a b } a . b . 1 -> a 2 -> b a . b . ;
Ok
TEST
0 0 1 2 Ok
Èìåíà ëîêàëüíûõ ïåðåìåííûõ ñóùåñòâóþò â äèíàìè÷åñêîì
âðåìåííîì ñëîâàðå òîëüêî â ìîìåíò êîìïèëÿöèè ñëîâà, à
ïîñëå ýòîãî âû÷èùàþòñÿ è áîëåå íåäîñòóïíû.
Èñïîëüçîâàòü êîíñòðóêöèþ "{ ... }" âíóòðè îäíîãî îïðåäåëåíèÿ ìîæíî
òîëüêî îäèí ðàç.
Êîìïèëÿöèÿ ýòîé áèáëèîòåêè äîáàâëÿåò â òåêóùèé ñëîâàðü êîìïèëÿöèè
Òîëüêî äâà ñëîâà:
ñëîâàðü "vocLocalsSupport" è "{"
Âñå îñòàëüíûå äåòàëè "ñïðÿòàíû" â ñëîâàðå, èñïîëüçîâàòü èõ
íå ðåêîìåíäóåòñÿ.
)
VOCABULARY vocLocalsSupport
GET-CURRENT ALSO vocLocalsSupport DEFINITIONS
USER widLocals
USER uLocalsCnt
USER uLocalsUCnt
USER uPrevCurrent
USER uAddDepth
: (Local^) ( N -- ADDR )
RP@ +
;
: LocalOffs ( n -- offs )
uLocalsCnt @ SWAP - CELLS CELL+ uAddDepth @ +
;
: CompileLocalsInit
uPrevCurrent @ SET-CURRENT
uLocalsCnt @ uLocalsUCnt @ - ?DUP IF CELLS LIT, POSTPONE DRMOVE THEN
uLocalsUCnt @ ?DUP IF LIT, POSTPONE (RALLOT) THEN
uLocalsCnt @ ?DUP
IF CELLS LIT, POSTPONE >R ['] (LocalsExit) LIT, POSTPONE >R THEN
;
: CompileLocal@ ( n -- )
LocalOffs LIT, POSTPONE RP+@
;
: LocalsStartup
TEMP-WORDLIST widLocals !
GET-CURRENT uPrevCurrent !
ALSO vocLocalsSupport
ALSO widLocals @ CONTEXT ! DEFINITIONS
uLocalsCnt 0!
uLocalsUCnt 0!
uAddDepth 0!
;
: LocalsCleanup
PREVIOUS PREVIOUS
widLocals @ FREE-WORDLIST
;
: LocalsDoes@
uLocalsCnt @ ,
uLocalsCnt 1+!
DOES> @ CompileLocal@
;
: ;; POSTPONE ; ; IMMEDIATE
: ^ ' >BODY @ LocalOffs LIT, POSTPONE RP+ ; IMMEDIATE
: -> ' >BODY @ LocalOffs LIT, POSTPONE RP+! ; IMMEDIATE
: â POSTPONE -> ; IMMEDIATE
WARNING @ WARNING 0!
\ ===
\ ïåðåîïðåäåëåíèå ñîîòâåòñòâóþùèõ ñëîâ äëÿ âîçìîæíîñòè èñïîëüçîâàòü
\ âðåìåííûå ïåðåìåííûå âíóòðè öèêëà DO LOOP è íåçàâèñèìî îò èçìåíåíèÿ
\ ñîäåðæèìîãî ñòåêà âîçâðàòîâ ñëîâàìè >R R>
: DO POSTPONE DO [ 3 CELLS ] LITERAL uAddDepth +! ; IMMEDIATE
: ?DO POSTPONE ?DO [ 3 CELLS ] LITERAL uAddDepth +! ; IMMEDIATE
: LOOP POSTPONE LOOP [ -3 CELLS ] LITERAL uAddDepth +! ; IMMEDIATE
: +LOOP POSTPONE +LOOP [ -3 CELLS ] LITERAL uAddDepth +! ; IMMEDIATE
: >R POSTPONE >R [ 1 CELLS ] LITERAL uAddDepth +! ; IMMEDIATE
: R> POSTPONE R> [ -1 CELLS ] LITERAL uAddDepth +! ; IMMEDIATE
: RDROP POSTPONE RDROP [ -1 CELLS ] LITERAL uAddDepth +! ; IMMEDIATE
\ ===
: ; LocalsCleanup POSTPONE ; ; IMMEDIATE
WARNING !
\ =====================================================================
SET-CURRENT
: {
LocalsStartup
BEGIN
BL SKIP PeekChar DUP [CHAR] \ <>
OVER [CHAR] - <> AND
SWAP [CHAR] } <> AND
WHILE
CREATE LocalsDoes@ IMMEDIATE
REPEAT
PeekChar >IN 1+! DUP [CHAR] } <>
IF
[CHAR] \ =
IF
BEGIN
BL SKIP PeekChar DUP [CHAR] - <> SWAP [CHAR] } <> AND
WHILE
CREATE LocalsDoes@ IMMEDIATE
uLocalsUCnt 1+!
REPEAT
THEN
[CHAR] } PARSE 2DROP
ELSE DROP THEN
CompileLocalsInit
;; IMMEDIATE
PREVIOUS