Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]
Groups > comp.lang.forth > #44720
| From | "HAA" <someone@microsoft.com> |
|---|---|
| Newsgroups | comp.lang.forth |
| Subject | Re: BEGIN WHILE UNTIL THEN |
| Date | 2016-01-09 23:46 +1100 |
| Organization | Aioe.org NNTP Server |
| Message-ID | <n6qvf5$tib$1@gioia.aioe.org> (permalink) |
| References | <08c4616c-21ad-4bdf-9fe4-a9e5ee2e5dad@googlegroups.com> <20160107051310.67828226@_> <n6n3q1$u8j$1@gioia.aioe.org> <2016Jan8.113226@mips.complang.tuwien.ac.at> |
Anton Ertl wrote:
> "HAA" <someone@microsoft.com> writes:
> >This is the problem ANS WHILE was designed to solve. It lets you exit the
> >loop at different points avoiding the need to test (again) which condition
> >caused the exit e.g.
> >
> > BEGIN test1 WHILE test2 WHILE ... REPEAT exit2 ELSE exit1 THEN
> >
> > BEGIN test1 WHILE test2 UNTIL exit2 ELSE exit1 THEN
> >
> >Other variations:
> >
> > BEGIN test1 WHILE test2 WHILE ... REPEAT exit2 THEN exit1
> >
> > BEGIN test1 WHILE test2 WHILE ... REPEAT THEN exit1/exit2
> >
> >The topic is discussed by Brodie/Moore in 'Thinking FORTH' Chapter 8 ...
> >
> >"The value is that you get simpler programs. And it costs nothing."
>
> There is a mind load cost in the first three examples: the exit
> fragments are not right where the corresponding conditions are, but
> you have to count the WHILEs and THENs and ELSEs, and match them up.
> That's why I prefer things like:
>
> begin
> test1 if exit1 EXIT then
> test2 if exit2 EXIT then
> ...
> again
It appears not everyone on the GForth team shares your reservations...
Examples of multiple WHILE use in GForth 0.7.0
: scan
>r BEGIN dup WHILE over c@ r@ <> WHILE 1 /string REPEAT THEN rdrop ;
: s>unumber? ( addr u -- ud flag )
over [char] ' =
IF \ a ' alone is rather unusual :-)
drop char+ c@ 0 true EXIT
THEN
base @ >r dpl on getbase
0. 2swap
BEGIN ( d addr len )
dup >r >number dup
WHILE \ there are characters left
dup r> -
WHILE \ the last >number parsed something
dup 1- dpl ! over c@ [char] . =
WHILE \ the current char is '.'
1 /string
REPEAT THEN \ there are unparseable characters left
2drop false
ELSE
rdrop 2drop true
THEN
r> base ! ;
: skip-defs ( -- )
BEGIN refill WHILE source -trailing nip 0= UNTIL THEN ;
: (done) ( do-addr -- )
\G resolve branches of leave and ?leave and ?do
\G do-addr is the address of the beginning of our
\G loop so we can take care of nested loops
tleavings @
BEGIN dup
WHILE
>r dup r@ cell+ @ \ address of branch
u> 0= \ lower than DO?
WHILE
r@ 2 cells + @ \ branch token
branchtoresolve,
r@ @ r> free throw
REPEAT r> THEN
tleavings ! drop ;
: (_debug) ( body ip -- )
0 Nesting !
BEGIN Unnest off
cr ." Scanning code..." cr C-Formated on
swap scanword dbg-ip !
cr ." Nesting debugger ready!" cr
BEGIN d.s disp-step D-Key
WHILE C-Stop @ 0=
WHILE 0 get-next set-bp
dbg-ip @ jump
[ here DebugLoop ! ]
restore-bp
REPEAT
Nesting @ 0= IF EXIT THEN
-1 Nesting +! r>
ELSE
get-next >r 1 Nesting +!
THEN
dup
AGAIN ;
: -zeros ( addr u -- addr' u' )
BEGIN dup WHILE 1- 2dup + c@ '0 <> UNTIL 1+ THEN ;
: find-prev-line ( max addr -- max span addr pos2 )
backward^ 2@ forward^ 2!
over 2 + negate s>d backward^ 2@ d+ 0. dmax 2dup hist-setpos
BEGIN
backward^ 2! 2dup get-line WHILE
hist-pos 2dup forward^ 2@ d< WHILE
rot drop
REPEAT 2drop THEN tuck ;
: extract-word ( addr len -- addr' len' ) dup >r
BEGIN 1- dup 0>= WHILE 2dup + c@ bl = UNTIL THEN 1+
tuck + r> rot - ;
: \"-parse ( "string"<"> -- c-addr u ) \ gforth-internal backslash-quote-parse
\G parses string, translating @code{\}-escapes to characters (as in
\G C). The resulting string resides at @code{here}. See @code{S\"}
\G for the supported @code{\-escapes}.
here >r
>in @ chars source chars over + >r + begin ( parse-area R: here parse-end )
dup r@ < while
dup c@ '" <> while
dup c@ dup '\ = if ( parse-area c R: here parse-end )
drop char+ dup r@ = abort" unfinished \-escape"
\-escape c,
else
c, char+
endif
repeat then
char+ source >r - r> min char/ >in !
r> drop
here r> - dup negate allot
here swap char/ ;
: (BranchAddr?) ( a-addr1 -- a-addr2 true | false )
\ searches a branch with destination a-addr1
\ a-addr1: branch destination
\ a-addr2: pointer in branch table
SearchPointer @
BEGIN dup BranchPointer @ u<
WHILE
dup @ 2 pick <>
WHILE 3 cells +
REPEAT
nip dup 3 cells + SearchPointer ! true
ELSE
2drop false
THEN ;
: MyBranch ( a-addr -- a-addr a-addr2 )
\ finds branch table entry for branch at a-addr
dup @
BranchAddr?
BEGIN
WHILE 1 cells - @
over <>
WHILE dup @
MoreBranchAddr?
REPEAT
SearchPointer @ 3 cells -
ELSE true ABORT" SEE: Table failure"
THEN ;
: RepeatCheck ( a-addr1 a-addr2 true | false -- false )
IF BEGIN 2dup
1 cells - @ swap @
u<=
WHILE drop dup cell+
MoreBranchAddr? 0=
UNTIL false
ELSE true
THEN
ELSE false
THEN ;
: see-code-next-inline { addr1 addr2 -- addr3 }
\ decompile starting at addr1 until an inlined primitive is found,
\ or addr2 is reached; addr3 is addr2 or the next inlined
\ primitive
addr1 begin { addr }
addr addr2 u< while
addr @ dup decompile-prim = while
addr cr simple-see-word
addr cell+
repeat then
addr ;
: u8len ( u8 -- n )
dup max-single-byte u< IF drop 1 EXIT THEN \ special case ASCII
$800 2 >r
BEGIN 2dup u>= WHILE 5 lshift r> 1+ >r dup 0= UNTIL THEN
2drop r> ;
: $> ( -- )
BEGIN source >in @ /string s" <$" search 0= WHILE
type cr refill 0= UNTIL EXIT THEN
nip source >in @ /string rot - dup 2 + >in +! type ;
: read-chunked ( fid -- ) base @ >r hex >r
BEGIN pad $100 r@ read-line throw WHILE
pad swap s>number drop dup WHILE r@ add-chunk drop
pad 1 r@ read-line throw nip 0= UNTIL
ELSE drop THEN THEN rdrop r> base ! ;
: skip ( addr1 n1 char -- addr2 n2 ) \ gforth
\G skip all characters equal to char
>r
BEGIN
dup
WHILE
over c@ r@ =
WHILE
1 /string
REPEAT THEN
rdrop ;
: -trailing ( c_addr u1 -- c_addr u2 ) \ string dash-trailing
\G Adjust the string specified by @i{c-addr, u1} to remove all
\G trailing spaces. @i{u2} is the length of the modified string.
BEGIN
dup
WHILE
1- 2dup + c@ bl <>
UNTIL 1+ THEN ;
: (f83find) ( c_addr u f83name1 -- f83name2 )
BEGIN dup WHILE (find-samelen) dup WHILE
>r 2dup r@ cell+ char+ capscomp 0=
IF 2drop r> EXIT THEN
r> @
REPEAT THEN nip nip ;
: (find-samelen) ( u f83name1 -- u f83name2/0 )
BEGIN 2dup cell+ c@ $1F and <> WHILE @ dup 0= UNTIL THEN ;
: (parse-white) ( c_addr1 u1 -- c_addr2 u2 )
BEGIN dup WHILE over c@ bl <= WHILE 1 /string
REPEAT THEN 2dup
BEGIN dup WHILE over c@ bl > WHILE 1 /string
REPEAT THEN nip - ;
....
Back to comp.lang.forth | Previous | Next — Previous in thread | Next in thread | Find similar | Unroll thread
BEGIN WHILE UNTIL THEN Julian Fondren <julian.fondren@gmail.com> - 2016-01-04 14:50 -0800
Re: BEGIN WHILE UNTIL THEN "HAA" <someone@microsoft.com> - 2016-01-05 11:24 +1100
Re: BEGIN WHILE UNTIL THEN Julian Fondren <julian.fondren@gmail.com> - 2016-01-04 16:47 -0800
Re: BEGIN WHILE UNTIL THEN "HAA" <someone@microsoft.com> - 2016-01-05 12:17 +1100
Re: BEGIN WHILE UNTIL THEN anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2016-01-05 10:51 +0000
Re: BEGIN WHILE UNTIL THEN stephen@mpeforth.com (Stephen Pelc) - 2016-01-05 15:06 +0000
Re: BEGIN WHILE UNTIL THEN Chris Curl <ccurl609@gmail.com> - 2016-01-04 17:25 -0800
Re: BEGIN WHILE UNTIL THEN "HAA" <someone@microsoft.com> - 2016-01-05 13:06 +1100
Re: BEGIN WHILE UNTIL THEN Chris Curl <ccurl609@gmail.com> - 2016-01-04 21:42 -0800
Re: BEGIN WHILE UNTIL THEN rickman <gnuarm@gmail.com> - 2016-01-05 01:48 -0500
Re: BEGIN WHILE UNTIL THEN Albert van der Horst <albert@spenarnc.xs4all.nl> - 2016-01-05 11:15 +0000
Re: BEGIN WHILE UNTIL THEN "HAA" <someone@microsoft.com> - 2016-01-06 14:35 +1100
Re: BEGIN WHILE UNTIL THEN Albert van der Horst <albert@spenarnc.xs4all.nl> - 2016-01-05 02:04 +0000
Re: BEGIN WHILE UNTIL THEN Julian Fondren <julian.fondren@gmail.com> - 2016-01-04 18:37 -0800
Re: BEGIN WHILE UNTIL THEN hughaguilar96@gmail.com - 2016-01-04 19:17 -0800
Re: BEGIN WHILE UNTIL THEN anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2016-01-05 11:10 +0000
Re: BEGIN WHILE UNTIL THEN "HAA" <someone@microsoft.com> - 2016-01-06 15:02 +1100
Re: BEGIN WHILE UNTIL THEN november.nihal@gmail.com - 2016-01-05 08:03 -0800
Re: BEGIN WHILE UNTIL THEN november.nihal@gmail.com - 2016-01-05 08:07 -0800
Re: BEGIN WHILE UNTIL THEN november.nihal@gmail.com - 2016-01-05 08:18 -0800
Re: BEGIN WHILE UNTIL THEN november.nihal@gmail.com - 2016-01-05 08:21 -0800
Re: BEGIN WHILE UNTIL THEN Rod Pemberton <NoHaveNotOne@bcczxcfre.cmm> - 2016-01-07 05:13 -0500
Re: BEGIN WHILE UNTIL THEN "HAA" <someone@microsoft.com> - 2016-01-08 12:36 +1100
Re: BEGIN WHILE UNTIL THEN anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2016-01-08 10:32 +0000
Re: BEGIN WHILE UNTIL THEN Raimond Dragomir <raimond.dragomir@gmail.com> - 2016-01-08 02:55 -0800
Re: BEGIN WHILE UNTIL THEN Coos Haak <chforth@hccnet.nl> - 2016-01-08 13:57 +0100
Re: BEGIN WHILE UNTIL THEN Raimond Dragomir <raimond.dragomir@gmail.com> - 2016-01-08 06:55 -0800
Re: BEGIN WHILE UNTIL THEN hughaguilar96@gmail.com - 2016-01-08 15:06 -0800
Re: BEGIN WHILE UNTIL THEN Chris Curl <ccurl609@gmail.com> - 2016-01-08 16:59 -0800
Re: BEGIN WHILE UNTIL THEN "Elizabeth D. Rather" <erather@forth.com> - 2016-01-08 16:15 -1000
Re: BEGIN WHILE UNTIL THEN Chris Curl <ccurl609@gmail.com> - 2016-01-08 22:23 -0800
Re: BEGIN WHILE UNTIL THEN "Elizabeth D. Rather" <erather@forth.com> - 2016-01-08 21:12 -1000
Re: BEGIN WHILE UNTIL THEN Chris Curl <ccurl609@gmail.com> - 2016-01-09 08:04 -0800
Re: BEGIN WHILE UNTIL THEN "Elizabeth D. Rather" <erather@forth.com> - 2016-01-09 09:16 -1000
Re: BEGIN WHILE UNTIL THEN anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2016-01-10 15:31 +0000
Re: BEGIN WHILE UNTIL THEN Chris Curl <ccurl609@gmail.com> - 2016-01-10 08:11 -0800
Re: BEGIN WHILE UNTIL THEN "Elizabeth D. Rather" <erather@forth.com> - 2016-01-10 09:42 -1000
Re: BEGIN WHILE UNTIL THEN Albert van der Horst <albert@spenarnc.xs4all.nl> - 2016-01-11 13:02 +0000
Re: BEGIN WHILE UNTIL THEN anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2016-01-13 16:20 +0000
Re: BEGIN WHILE UNTIL THEN hughaguilar96@gmail.com - 2016-01-10 14:10 -0800
Re: BEGIN WHILE UNTIL THEN hughaguilar96@gmail.com - 2016-01-11 18:38 -0800
Re: BEGIN WHILE UNTIL THEN "HAA" <someone@microsoft.com> - 2016-01-14 08:47 +1100
Re: BEGIN WHILE UNTIL THEN Chris Curl <ccurl609@gmail.com> - 2016-01-13 17:24 -0800
Re: BEGIN WHILE UNTIL THEN hughaguilar96@gmail.com - 2016-01-13 19:25 -0800
Re: BEGIN WHILE UNTIL THEN "HAA" <someone@microsoft.com> - 2016-01-14 22:09 +1100
Re: BEGIN WHILE UNTIL THEN anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2016-01-14 16:21 +0000
Re: BEGIN WHILE UNTIL THEN "HAA" <someone@microsoft.com> - 2016-01-16 11:34 +1100
Re: BEGIN WHILE UNTIL THEN Bernd Paysan <bernd.paysan@gmx.de> - 2016-01-16 03:43 +0100
Re: BEGIN WHILE UNTIL THEN "HAA" <someone@microsoft.com> - 2016-01-19 18:01 +1100
Re: BEGIN WHILE UNTIL THEN Bernd Paysan <bernd.paysan@gmx.de> - 2016-01-19 23:07 +0100
Re: BEGIN WHILE UNTIL THEN "HAA" <someone@microsoft.com> - 2016-01-21 14:29 +1100
Re: BEGIN WHILE UNTIL THEN Bernd Paysan <bernd.paysan@gmx.de> - 2016-01-21 22:25 +0100
Re: BEGIN WHILE UNTIL THEN "HAA" <someone@microsoft.com> - 2016-01-24 13:28 +1100
Re: BEGIN WHILE UNTIL THEN Bernd Paysan <bernd.paysan@gmx.de> - 2016-01-25 01:31 +0100
Re: BEGIN WHILE UNTIL THEN "HAA" <someone@microsoft.com> - 2016-01-25 21:45 +1100
Re: BEGIN WHILE UNTIL THEN Chris Curl <ccurl609@gmail.com> - 2016-01-25 10:24 -0800
Re: BEGIN WHILE UNTIL THEN Bernd Paysan <bernd.paysan@gmx.de> - 2016-01-25 20:41 +0100
Re: BEGIN WHILE UNTIL THEN "HAA" <someone@microsoft.com> - 2016-01-28 20:39 +1100
Re: BEGIN WHILE UNTIL THEN Bernd Paysan <bernd.paysan@gmx.de> - 2016-01-28 16:05 +0100
Re: BEGIN WHILE UNTIL THEN Chris Curl <ccurl609@gmail.com> - 2016-01-21 20:52 -0800
Re: BEGIN WHILE UNTIL THEN "HAA" <someone@microsoft.com> - 2016-01-24 13:16 +1100
Re: BEGIN WHILE UNTIL THEN Chris Curl <ccurl609@gmail.com> - 2016-01-14 08:46 -0800
Re: BEGIN WHILE UNTIL THEN "HAA" <someone@microsoft.com> - 2016-01-16 11:34 +1100
Re: BEGIN WHILE UNTIL THEN Chris Curl <ccurl609@gmail.com> - 2016-01-15 20:53 -0800
Re: BEGIN WHILE UNTIL THEN hughaguilar96@gmail.com - 2016-01-13 19:31 -0800
Re: BEGIN WHILE UNTIL THEN "HAA" <someone@microsoft.com> - 2016-01-11 09:29 +1100
Re: BEGIN WHILE UNTIL THEN Chris Curl <ccurl609@gmail.com> - 2016-01-10 21:18 -0800
Re: BEGIN WHILE UNTIL THEN Paul Rubin <no.email@nospam.invalid> - 2016-01-10 21:29 -0800
Re: BEGIN WHILE UNTIL THEN "Elizabeth D. Rather" <erather@forth.com> - 2016-01-10 20:37 -1000
Re: BEGIN WHILE UNTIL THEN Gerry Jackson <gerry@jackson9000.fsnet.co.uk> - 2016-01-11 09:05 +0000
Re: BEGIN WHILE UNTIL THEN "HAA" <someone@microsoft.com> - 2016-01-12 12:26 +1100
Re: BEGIN WHILE UNTIL THEN hughaguilar96@gmail.com - 2016-01-10 14:18 -0800
Re: BEGIN WHILE UNTIL THEN Raimond Dragomir <raimond.dragomir@gmail.com> - 2016-01-08 23:31 -0800
Re: BEGIN WHILE UNTIL THEN Chris Curl <ccurl609@gmail.com> - 2016-01-09 08:09 -0800
Re: BEGIN WHILE UNTIL THEN Andrew Haley <andrew29@littlepinkcloud.invalid> - 2016-01-09 05:31 -0600
Re: BEGIN WHILE UNTIL THEN Andrew Haley <andrew29@littlepinkcloud.invalid> - 2016-01-09 07:52 -0600
Re: BEGIN WHILE UNTIL THEN Ron Aaron <rambamist@gmail.com> - 2016-01-09 18:22 +0200
Re: BEGIN WHILE UNTIL THEN anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2016-01-09 16:29 +0000
Re: BEGIN WHILE UNTIL THEN stephen@mpeforth.com (Stephen Pelc) - 2016-01-08 11:23 +0000
Re: BEGIN WHILE UNTIL THEN hughaguilar96@gmail.com - 2016-01-10 20:17 -0800
Re: BEGIN WHILE UNTIL THEN stephen@mpeforth.com (Stephen Pelc) - 2016-01-11 11:56 +0000
Re: BEGIN WHILE UNTIL THEN Gerry Jackson <gerry@jackson9000.fsnet.co.uk> - 2016-01-11 11:59 +0000
generalized CASE (was: BEGIN WHILE UNTIL THEN) anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2016-01-11 12:30 +0000
Re: generalized CASE (was: BEGIN WHILE UNTIL THEN) hughaguilar96@gmail.com - 2016-01-11 13:52 -0800
Re: generalized CASE Gerry Jackson <gerry@jackson9000.fsnet.co.uk> - 2016-01-11 22:00 +0000
Re: generalized CASE Coos Haak <chforth@hccnet.nl> - 2016-01-12 01:50 +0100
Re: BEGIN WHILE UNTIL THEN hughaguilar96@gmail.com - 2016-01-11 14:16 -0800
Re: BEGIN WHILE UNTIL THEN Chris Curl <ccurl609@gmail.com> - 2016-01-11 16:17 -0800
Re: BEGIN WHILE UNTIL THEN anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2016-01-12 13:07 +0000
Re: BEGIN WHILE UNTIL THEN Gerry Jackson <gerry@jackson9000.fsnet.co.uk> - 2016-01-12 20:48 +0000
Re: BEGIN WHILE UNTIL THEN hughaguilar96@gmail.com - 2016-01-12 14:16 -0800
Re: BEGIN WHILE UNTIL THEN anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2016-01-08 16:21 +0000
Re: BEGIN WHILE UNTIL THEN stephen@mpeforth.com (Stephen Pelc) - 2016-01-08 20:12 +0000
Re: BEGIN WHILE UNTIL THEN anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2016-01-09 18:19 +0000
Re: BEGIN WHILE UNTIL THEN "HAA" <someone@microsoft.com> - 2016-01-11 09:34 +1100
Re: BEGIN WHILE UNTIL THEN Bernd Paysan <bernd.paysan@gmx.de> - 2016-01-08 21:13 +0100
Re: BEGIN WHILE UNTIL THEN "HAA" <someone@microsoft.com> - 2016-01-09 23:46 +1100
Re: BEGIN WHILE UNTIL THEN Rod Pemberton <NoHaveNotOne@bcczxcfre.cmm> - 2016-01-08 10:11 -0500
Re: BEGIN WHILE UNTIL THEN "HAA" <someone@microsoft.com> - 2016-01-11 08:38 +1100
Re: BEGIN WHILE UNTIL THEN november.nihal@gmail.com - 2016-01-08 03:04 -0800
csiph-web