Annotation of gforth/compat/loops.fs, revision 1.3

1.1       anton       1: \ +DO, -DO...-LOOP and friends
                      2: 
                      3: \ This file is in the public domain. NO WARRANTY.
                      4: 
                      5: \ Hmm, this would be a good application for ]] ... [[
                      6: 
1.3     ! anton       7: \ The program uses the following words
        !             8: \ from CORE :
        !             9: \ : POSTPONE over min ; immediate 2dup IF swap THEN drop negate +LOOP
        !            10: \ ELSE 2drop < 1+ DO u<
        !            11: \ from CORE-EXT :
        !            12: \ ?DO u> 
        !            13: \ from BLOCK-EXT :
        !            14: \ \ 
        !            15: \ from FILE :
        !            16: \ ( 
        !            17: 
1.1       anton      18: : +DO ( compile-time: -- do-sys; run-time: n1 n2 -- )
                     19:     POSTPONE over POSTPONE min POSTPONE ?do ; immediate
                     20: 
                     21: : umin ( u1 u2 -- u )
                     22:     2dup u>
                     23:     IF
                     24:        swap
1.2       anton      25:     THEN
1.1       anton      26:     drop ;
                     27: 
                     28: : U+DO ( compile-time: -- do-sys; run-time: u1 u2 -- )
                     29:     POSTPONE over POSTPONE umin POSTPONE ?do ; immediate
                     30: 
                     31: \ -DO...-LOOP
                     32: 
                     33: \ You have to use the -LOOP implemented below with -DO or U-DO, you
                     34: \ cannot use it with ?DO
                     35: 
                     36: \ The implementation is a little more complicated. Basically, we
                     37: \ create an IF DO ... +LOOP THEN structure. The DO..+LOOP does not
                     38: \ exhibit the anomaly of ?DO...+LOOP; the IF..THEN is needed to
                     39: \ correct for DO's at-least-once semantics. The parameters are
                     40: \ conditioned a bit such that the result is as expected.
                     41: 
                     42: \ I define a '-do-sys' (whose implementation is 'orig do-sys'). Like
                     43: \ ANS Forth loop structures, this implementation of -DO..-LOOP
                     44: \ cannot be mixed with any other structures.
                     45: 
                     46: \ unlike Gforth's -LOOP, this implementation cannot handle all
                     47: \ unsigned increments, only positive integers
                     48: : -LOOP ( compilation -do-sys -- ; run-time loop-sys1 +n -- | loop-sys2 )
                     49:     POSTPONE negate POSTPONE +loop
                     50:     POSTPONE else POSTPONE 2drop POSTPONE then ; immediate
                     51: 
                     52: : -DO ( compilation -- -do-sys ; run-time n1 n2 -- | loop-sys )
                     53:     POSTPONE 2dup POSTPONE < POSTPONE if
                     54:     POSTPONE swap POSTPONE 1+ POSTPONE swap POSTPONE do ; immediate
                     55: 
                     56: : U-DO ( compilation -- -do-sys ; run-time u1 u2 -- | loop-sys )
                     57:     POSTPONE 2dup POSTPONE u< POSTPONE if
                     58:     POSTPONE swap POSTPONE 1+ POSTPONE swap POSTPONE do ; immediate

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>