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
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>