Return to loops.fs CVS log

Up to [gforth] / gforth / compat

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

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: 
        !             7: : +DO ( compile-time: -- do-sys; run-time: n1 n2 -- )
        !             8:     POSTPONE over POSTPONE min POSTPONE ?do ; immediate
        !             9: 
        !            10: : umin ( u1 u2 -- u )
        !            11:     2dup u>
        !            12:     IF
        !            13:        swap
        !            14:     ENDIF
        !            15:     drop ;
        !            16: 
        !            17: : U+DO ( compile-time: -- do-sys; run-time: u1 u2 -- )
        !            18:     POSTPONE over POSTPONE umin POSTPONE ?do ; immediate
        !            19: 
        !            20: \ -DO...-LOOP
        !            21: 
        !            22: \ You have to use the -LOOP implemented below with -DO or U-DO, you
        !            23: \ cannot use it with ?DO
        !            24: 
        !            25: \ The implementation is a little more complicated. Basically, we
        !            26: \ create an IF DO ... +LOOP THEN structure. The DO..+LOOP does not
        !            27: \ exhibit the anomaly of ?DO...+LOOP; the IF..THEN is needed to
        !            28: \ correct for DO's at-least-once semantics. The parameters are
        !            29: \ conditioned a bit such that the result is as expected.
        !            30: 
        !            31: \ I define a '-do-sys' (whose implementation is 'orig do-sys'). Like
        !            32: \ ANS Forth loop structures, this implementation of -DO..-LOOP
        !            33: \ cannot be mixed with any other structures.
        !            34: 
        !            35: \ unlike Gforth's -LOOP, this implementation cannot handle all
        !            36: \ unsigned increments, only positive integers
        !            37: : -LOOP ( compilation -do-sys -- ; run-time loop-sys1 +n -- | loop-sys2 )
        !            38:     POSTPONE negate POSTPONE +loop
        !            39:     POSTPONE else POSTPONE 2drop POSTPONE then ; immediate
        !            40: 
        !            41: : -DO ( compilation -- -do-sys ; run-time n1 n2 -- | loop-sys )
        !            42:     POSTPONE 2dup POSTPONE < POSTPONE if
        !            43:     POSTPONE swap POSTPONE 1+ POSTPONE swap POSTPONE do ; immediate
        !            44: 
        !            45: : U-DO ( compilation -- -do-sys ; run-time u1 u2 -- | loop-sys )
        !            46:     POSTPONE 2dup POSTPONE u< POSTPONE if
        !            47:     POSTPONE swap POSTPONE 1+ POSTPONE swap POSTPONE do ; immediate