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 \ Permission to use, copy, modify, and/or distribute this
  11 \ software for any purpose with or without fee is hereby granted.
  12 \
  13 \ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
  14 \ WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
  15 \ WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL
  16 \ THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
  17 \ CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING
  18 \ FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
  19 \ CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
  20 \ OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  21
  22 anew task-smart_if.fth
  23
  24 variable SMIF-XT    \ execution token for conditional code
  25 variable SMIF-DEPTH \ depth of nested conditionals
  26
  27 : SMIF{   ( -- , if executing, start compiling, setup depth )
  28     state @ 0=
  29     IF
  30         :noname smif-xt !
  31         1 smif-depth !
  32     ELSE
  33         1 smif-depth +!
  34     THEN
  35 ;
  36
  37 : }SMIF  ( -- , unnest, stop compiling, execute code and forget )
  38     smif-xt @
  39     IF
  40         -1 smif-depth +!
  41         smif-depth @ 0 <=
  42         IF
  43             postpone ;             \ stop compiling
  44             smif-xt @ execute      \ execute conditional code
  45             smif-xt @ >code dp !   \ forget conditional code
  46             0 smif-xt !   \ clear so we don't mess up later
  47         THEN
  48     THEN
  49 ;
  50
  51 \ redefine conditionals to use smart mode
  52 : IF      smif{   postpone if     ; immediate
  53 : DO      smif{   postpone do     ; immediate
  54 : ?DO     smif{   postpone ?do    ; immediate
  55 : BEGIN   smif{   postpone begin  ; immediate
  56 : THEN    postpone then    }smif  ; immediate
  57 : REPEAT  postpone repeat  }smif  ; immediate
  58 : UNTIL   postpone until   }smif  ; immediate
  59 : LOOP    postpone loop    }smif  ; immediate
  60 : +LOOP   postpone +loop   }smif  ; immediate