git.gag.com Git - debian/pforth/blob - fth/smart_if.fth

   1 \ @(#) smart_if.fth 98/01/26 1.2\r
   2 \ Smart Conditionals\r
   3 \ Allow use of if, do, begin, etc.outside of colon definitions.\r
   4 \\r
   5 \ Thanks to Mitch Bradley for the idea.\r
   6 \\r
   7 \ Author: Phil Burk\r
   8 \ Copyright 1994 3DO, Phil Burk, Larry Polansky, Devid Rosenboom\r
   9 \\r
  10 \ The pForth software code is dedicated to the public domain,\r
  11 \ and any third party may reproduce, distribute and modify\r
  12 \ the pForth software code or any derivative works thereof\r
  13 \ without any compensation or license.  The pForth software\r
  14 \ code is provided on an "as is" basis without any warranty\r
  15 \ of any kind, including, without limitation, the implied\r
  16 \ warranties of merchantability and fitness for a particular\r
  17 \ purpose and their equivalents under the laws of any jurisdiction.\r
  18 \r
  19 anew task-smart_if.fth\r
  20 \r
  21 variable SMIF-XT    \ execution token for conditional code\r
  22 variable SMIF-DEPTH \ depth of nested conditionals\r
  23 \r
  24 : SMIF{   ( -- , if executing, start compiling, setup depth )\r
  25         state @ 0=\r
  26         IF\r
  27                 :noname smif-xt !\r
  28                 1 smif-depth !\r
  29         ELSE\r
  30                 1 smif-depth +!\r
  31         THEN\r
  32 ;\r
  33 \r
  34 : }SMIF  ( -- , unnest, stop compiling, execute code and forget )\r
  35         smif-xt @\r
  36         IF\r
  37                 -1 smif-depth +!\r
  38                 smif-depth @ 0 <=\r
  39                 IF\r
  40                         postpone ;             \ stop compiling\r
  41                         smif-xt @ execute      \ execute conditional code\r
  42                         smif-xt @ >code dp !   \ forget conditional code\r
  43                         0 smif-xt !   \ clear so we don't mess up later\r
  44                 THEN\r
  45         THEN\r
  46 ;\r
  47                 \r
  48 \ redefine conditionals to use smart mode\r
  49 : IF      smif{   postpone if     ; immediate\r
  50 : DO      smif{   postpone do     ; immediate\r
  51 : ?DO     smif{   postpone ?do    ; immediate\r
  52 : BEGIN   smif{   postpone begin  ; immediate\r
  53 : THEN    postpone then    }smif  ; immediate\r
  54 : REPEAT  postpone repeat  }smif  ; immediate\r
  55 : UNTIL   postpone until   }smif  ; immediate\r
  56 : LOOP    postpone loop    }smif  ; immediate\r
  57 : +LOOP   postpone +loop   }smif  ; immediate\r