Subversion Repositories Kolibri OS

Rev

Blame | Last modification | View Log | Download | RSS feed

  1. lib\ext\locals.f \EOF
  2.  
  3. ( 28.Mar.2000 Andrey Cherezov  Copyright [C] RU FIG
  4.   Èñïîëüçîâàíû èäåè ñëåäóþùèõ àâòîðîâ:
  5.   Ruvim Pinka; Dmitry Yakimov; Oleg Shalyopa; Yuriy Zhilovets;
  6.   Konstantin Tarasov
  7.  
  8.   !! Ðàáîòàåò, òîëüêî íà÷èíàÿ ñ 30 áèëäà SPF/3.75: VERSION . 375030  Ok
  9. )
  10.  
  11. ( Ïðîñòîå ðàñøèðåíèå ÑÏ-Ôîðòà ëîêàëüíûìè ïåðåìåííûìè.
  12.   Ðåàëèçîâàíî áåç èñïîëüçîâàíèÿ LOCALS ñòàíäàðòà 94.
  13.  
  14.   Îáúÿâëåíèå âðåìåííûõ ïåðåìåííûõ, âèäèìûõ òîëüêî âíóòðè
  15.   òåêóùåãî ñëîâà è îãðàíè÷åííûõ âðåìåíåì âûçîâà äàííîãî
  16.   ñëîâà âûïîëíÿåòñÿ ñ ïîìîùüþ ñëîâà "{". Âíóòðè îïðåäåëåíèÿ
  17.   ñëîâà èñïîëüçóåòñÿ êîíñòðóêöèÿ, ïîäîáíàÿ ñòåêîâîé íîòàöèè Ôîðòà
  18.   { ñïèñîê_èíèöèàëèçèðîâàííûõ_ëîêàëîâ \ ñï.íåèíèö.ëîêàëîâ -- ÷òî óãîäíî }
  19.   Íàïðèìåð:
  20.  
  21.   { a b c d \ e f -- i j }
  22.  
  23.   ×àñòü "\ ñï.íåèíèö.ëîêàëîâ" ìîæåò îòñóòñòâîâàòü, íàïðèìåð:
  24.  
  25.   { item1 item2 -- }
  26.  
  27.   Ýòî çàñòàâëÿåò ÑÏ-Ôîðò àâòîìàòè÷åñêè âûäåëÿòü ìåñòî â
  28.   ñòåêå âîçâðàòîâ äëÿ ýòèõ ïåðåìåííûõ â ìîìåíò âûçîâà ñëîâà
  29.   è àâòîìàòè÷åñêè îñâîáîæäàòü ìåñòî ïðè âûõîäå èç íåãî.
  30.  
  31.   Îáðàùåíèå ê òàêèì ëîêàëüíûì ïåðåìåííûì - êàê ê VALUE-ïåðåìåííûì
  32.   ïî èìåíè. Åñëè íóæåí àäðåñ ïåðåìåííîé, òî èñïîëüçóåòñÿ "^ èìÿ".
  33.  
  34.   Ïðèìåðû:
  35.  
  36.   : TEST { a b c d \ e f -- } a . b . c .  b c + -> e  e .  f .  ^ a @ . ;
  37.    Ok
  38.   1 2 3 4 TEST
  39.   1 2 3 5 0 1  Ok
  40.  
  41.   : TEST { a b -- } a . b . CR 5 0 DO I . a . b . CR LOOP ;
  42.    Ok
  43.   12 34 TEST
  44.   12 34
  45.   0 12 34
  46.   1 12 34
  47.   2 12 34
  48.   3 12 34
  49.   4 12 34
  50.    Ok
  51.  
  52.   : TEST { a b } a . b . ;
  53.    Ok
  54.   1 2 TEST
  55.   1 2  Ok
  56.  
  57.   : TEST { a b \ c } a . b . c . ;
  58.    Ok
  59.   1 2 TEST
  60.   1 2 0  Ok
  61.  
  62.   : TEST { a b -- } a . b . ;
  63.    Ok
  64.   1 2 TEST
  65.   1 2  Ok
  66.  
  67.   : TEST { a b \ c -- d } a . b . c . ;
  68.    Ok
  69.   1 2 TEST
  70.   1 2 0  Ok
  71.  
  72.   : TEST { \ a b } a . b .  1 -> a  2 -> b  a . b . ;
  73.    Ok
  74.   TEST
  75.   0 0 1 2  Ok
  76.  
  77.   Èìåíà ëîêàëüíûõ ïåðåìåííûõ ñóùåñòâóþò â äèíàìè÷åñêîì
  78.   âðåìåííîì ñëîâàðå òîëüêî â ìîìåíò êîìïèëÿöèè ñëîâà, à
  79.   ïîñëå ýòîãî âû÷èùàþòñÿ è áîëåå íåäîñòóïíû.
  80.  
  81.   Èñïîëüçîâàòü êîíñòðóêöèþ "{ ... }" âíóòðè îäíîãî îïðåäåëåíèÿ ìîæíî
  82.   òîëüêî îäèí ðàç.
  83.  
  84.   Êîìïèëÿöèÿ ýòîé áèáëèîòåêè äîáàâëÿåò â òåêóùèé ñëîâàðü êîìïèëÿöèè
  85.   Òîëüêî äâà ñëîâà:
  86.   ñëîâàðü "vocLocalsSupport" è "{"
  87.   Âñå îñòàëüíûå äåòàëè "ñïðÿòàíû" â ñëîâàðå, èñïîëüçîâàòü èõ
  88.   íå ðåêîìåíäóåòñÿ.
  89. )
  90.  
  91.  
  92. VOCABULARY vocLocalsSupport
  93.  
  94. GET-CURRENT ALSO vocLocalsSupport DEFINITIONS
  95.  
  96. USER widLocals
  97. USER uLocalsCnt
  98. USER uLocalsUCnt
  99. USER uPrevCurrent
  100. USER uAddDepth
  101.  
  102. : (Local^) ( N -- ADDR )
  103.   RP@ +
  104. ;
  105. : LocalOffs ( n -- offs )
  106.   uLocalsCnt @ SWAP - CELLS CELL+ uAddDepth @ +
  107. ;
  108. : CompileLocalsInit
  109.   uPrevCurrent @ SET-CURRENT
  110.   uLocalsCnt  @ uLocalsUCnt @ - ?DUP IF CELLS LIT, POSTPONE DRMOVE THEN
  111.   uLocalsUCnt @ ?DUP IF LIT, POSTPONE (RALLOT) THEN
  112.   uLocalsCnt  @ ?DUP
  113.   IF CELLS LIT, POSTPONE >R  ['] (LocalsExit) LIT, POSTPONE >R THEN
  114. ;
  115. : CompileLocal@ ( n -- )
  116.   LocalOffs LIT, POSTPONE RP+@
  117. ;
  118. : LocalsStartup
  119.   TEMP-WORDLIST widLocals !
  120.   GET-CURRENT uPrevCurrent !
  121.   ALSO vocLocalsSupport
  122.   ALSO widLocals @ CONTEXT ! DEFINITIONS
  123.   uLocalsCnt 0!
  124.   uLocalsUCnt 0!
  125.   uAddDepth 0!
  126. ;
  127. : LocalsCleanup
  128.   PREVIOUS PREVIOUS
  129.   widLocals @ FREE-WORDLIST
  130. ;
  131. : LocalsDoes@
  132.   uLocalsCnt @ ,
  133.   uLocalsCnt 1+!
  134.   DOES> @ CompileLocal@
  135. ;
  136. : ;; POSTPONE ; ; IMMEDIATE
  137.  
  138. : ^ ' >BODY @ LocalOffs LIT, POSTPONE RP+ ; IMMEDIATE
  139.  
  140. : -> ' >BODY @ LocalOffs LIT, POSTPONE RP+! ; IMMEDIATE
  141.  
  142. : â POSTPONE -> ; IMMEDIATE
  143.  
  144. WARNING @ WARNING 0!
  145. \ ===
  146. \ ïåðåîïðåäåëåíèå ñîîòâåòñòâóþùèõ ñëîâ äëÿ âîçìîæíîñòè èñïîëüçîâàòü
  147. \ âðåìåííûå ïåðåìåííûå âíóòðè  öèêëà DO LOOP  è íåçàâèñèìî îò èçìåíåíèÿ
  148. \ ñîäåðæèìîãî ñòåêà âîçâðàòîâ  ñëîâàìè   >R   R>
  149.  
  150. : DO    POSTPONE DO     [  3 CELLS ] LITERAL  uAddDepth +! ; IMMEDIATE
  151. : ?DO   POSTPONE ?DO    [  3 CELLS ] LITERAL  uAddDepth +! ; IMMEDIATE
  152. : LOOP  POSTPONE LOOP   [ -3 CELLS ] LITERAL  uAddDepth +! ; IMMEDIATE
  153. : +LOOP POSTPONE +LOOP  [ -3 CELLS ] LITERAL  uAddDepth +! ; IMMEDIATE
  154. : >R    POSTPONE >R     [  1 CELLS ] LITERAL  uAddDepth +! ; IMMEDIATE
  155. : R>    POSTPONE R>     [ -1 CELLS ] LITERAL  uAddDepth +! ; IMMEDIATE
  156. : RDROP POSTPONE RDROP  [ -1 CELLS ] LITERAL  uAddDepth +! ; IMMEDIATE
  157.  
  158. \ ===
  159.  
  160. : ;  LocalsCleanup POSTPONE ; ; IMMEDIATE
  161.  
  162. WARNING !
  163.  
  164. \ =====================================================================
  165. SET-CURRENT
  166.  
  167. : {
  168.   LocalsStartup
  169.   BEGIN
  170.     BL SKIP PeekChar DUP [CHAR] \ <>
  171.                     OVER [CHAR] - <> AND
  172.                     SWAP [CHAR] } <> AND
  173.   WHILE
  174.     CREATE LocalsDoes@ IMMEDIATE
  175.   REPEAT
  176.  
  177.   PeekChar >IN 1+! DUP [CHAR] } <>
  178.   IF
  179.     [CHAR] \ =
  180.     IF
  181.       BEGIN
  182.         BL SKIP PeekChar DUP [CHAR] - <> SWAP [CHAR] } <> AND
  183.       WHILE
  184.         CREATE LocalsDoes@ IMMEDIATE
  185.         uLocalsUCnt 1+!
  186.       REPEAT
  187.     THEN
  188.     [CHAR] } PARSE 2DROP
  189.   ELSE DROP THEN
  190.   CompileLocalsInit
  191. ;; IMMEDIATE
  192.  
  193. PREVIOUS
  194.