Path: utzoo!attcan!uunet!decwrl!ucbvax!MITCH.ENG.SUN.COM!wmb
From: wmb@MITCH.ENG.SUN.COM (Mitch Bradley)
Newsgroups: comp.lang.forth
Subject: Re: Formatting Forth source code
Message-ID: <9008011409.AA08057@ucbvax.Berkeley.EDU>
Date: 1 Aug 90 06:47:30 GMT
Sender: daemon@ucbvax.BERKELEY.EDU
Reply-To: Mitch Bradley <wmb%MITCH.ENG.SUN.COM@SCFVM.GSFC.NASA.GOV>
Organization: The Internet
Lines: 45

Wil Baden> I'm looking for short but non-trivial examples of code that you
Wil Baden> believe is readable.

Another "readable code" submission:

\ LEFT-PARSE-STRING  ( adr len char -- adra lena  adrb lenb )
\ Splits a string into two halves around a delimiter character.
\ If the delimiter character is present in the string, adra lena is the
\ substring after the first occurrence of the character, adrb lenb
\ is the substring before it.
\ Both substrings exclude the character itself.
\
\ If the character is not present in the string, the original string
\ adr len is returned, and the flag on top of the stack is false.

\ Removes max(n,len) characters from the beginning of the string "adr len"
: /string  ( adr len n -- adr+len adr-len )
   over min >r  swap r@ +  swap r> -
;
: +string  ( adr len -- adr len+1 )  1+  ;
: -string  ( adr len -- adr+1 len-1 )  swap 1+  swap 1-  ;

\ adra,lena is the string after the delimiter
\ adrb,lenb is the string before the delimiter
\ lena = 0 if there was no delimiter

: left-parse-string  ( adr len char -- adra lena  adrb lenb  )
   >r  over 0  2swap                ( adrb 0  adra lena )

   \ Throughout the loop, we maintain both substrings.  Each time through,
   \ we add a character to the first string and remove it from the second.
   \ The loop terminates when either the second string is empty or the
   \ desired character is found

   begin  dup  while                  ( adr0 len0  adr1 len1 )
      over c@  r@ =  if               \ Found it; exchange strings
         r> drop -string 2swap exit   ( adra lena  adrb lenb )
      then
      2swap +string  2swap -string    ( adr0 len0  adr1 len1 )
   repeat                             ( adr0 len0  adr1 len1 )

   \ Character not found.  len1 is 0.
   2swap                              ( adra lena  adrb lenb )
   r> drop
;