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

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