Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > comp.lang.forth > #45552 > unrolled thread

Rosetta code reverse a string

Back to article view | Back to comp.lang.forth

Contents

  Rosetta code reverse a string foxaudioresearch@gmail.com - 2016-02-15 13:22 -0800
    Re: Rosetta code reverse a string Paul Rubin <no.email@nospam.invalid> - 2016-02-15 15:14 -0800
      Re: Rosetta code reverse a string foxaudioresearch@gmail.com - 2016-02-15 16:49 -0800
        Re: Rosetta code reverse a string Paul Rubin <no.email@nospam.invalid> - 2016-02-15 20:27 -0800
          Re: Rosetta code reverse a string anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2016-02-16 07:25 +0000
          Re: Rosetta code reverse a string Doug Hoffman <glidedog@gmail.com> - 2016-02-16 05:30 -0500
            Re: Rosetta code reverse a string Albert van der Horst <albert@spenarnc.xs4all.nl> - 2016-02-16 11:55 +0000
      Re: Rosetta code reverse a string anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2016-02-16 13:44 +0000
        Re: Rosetta code reverse a string Albert van der Horst <albert@spenarnc.xs4all.nl> - 2016-02-16 14:45 +0000
          Re: Rosetta code reverse a string anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2016-02-16 16:22 +0000
        Re: Rosetta code reverse a string Paul Rubin <no.email@nospam.invalid> - 2016-02-16 13:25 -0800
          Re: Rosetta code reverse a string anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2016-02-17 07:07 +0000
            Re: Rosetta code reverse a string Paul Rubin <no.email@nospam.invalid> - 2016-02-16 23:29 -0800
    Re: Rosetta code reverse a string Albert van der Horst <albert@spenarnc.xs4all.nl> - 2016-02-16 11:46 +0000
    Re: Rosetta code reverse a string "WJ" <w_a_x_man@yahoo.com> - 2016-02-16 18:25 +0000
    Re: Rosetta code reverse a string humptydumpty <ouatubi@gmail.com> - 2016-02-16 13:40 -0800
    Re: Rosetta code reverse a string "WJ" <w_a_x_man@yahoo.com> - 2016-06-28 01:55 +0000
      Re: Rosetta code reverse a string "HAA" <someone@microsoft.com> - 2016-06-29 11:45 +1000

#45552 — Rosetta code reverse a string

I have been at it again.

By defining a string stack and NEXTWORD I could create SPLIT and REVERSE. 

My system has PAD in free memory. I know this won't work with every system.

\ Rosetta code reverse a string
\ These primitive operations are included for completeness
: c+!      ( n addr -- )        dup >r  c@ +  r> c! ;
: append-char  ( char string -- ) dup >r  count dup 1+ r> c! + c! ;
: +place   ( addr1 n addr2 -- ) 2dup 2>r  count +  swap move 2r> c+! ;
: place    ( addr1 n addr2 -- )  2dup 2>r  1+  swap  move  2r> c! ;

HEX
\ build a string stack/array for intermediate results
100 constant ss-width
variable $depth

DECIMAL
: items    ( -- n)   $depth @  ;
: collapse ( -- )    $depth off ;                 \ reset string stack pointer
: new:     ( -- )    1 $depth +! ;                \ incr. string stack pointer
: ]stk$    ( ndx -- addr) ss-width * pad + ;      \ ** PAD is in free memory
: TOP$     ( -- addr) $depth @ ]stk$ ;            \ top string on string stack

: =""      ( caddr -- )  0 swap c! ;

: 1stword  ( addr len -- addr' len')
           2dup bl scan nip - ;                   \ returns the 1st word

: nextword ( addr len -- addr++ len++ addr' len') \ output 1st word & remainder
           2dup 1stword dup >R                    \ get the 1stword
           2swap R> 1+ /string                    \ removes leading space
           2swap ;                                \ put 1st word on top

: split  ( caddr -- )  \ $-- $[1] ... $[n]        \ results go to string stack
            count
            begin
                dup 0>
            while
               nextword new: top$ place           \ this strips spaces 
            repeat
            2drop  ;

: ?$stk    ( flag -- )
           items 0= abort" string stack empty?" ;

: reverse ( caddr -- caddr)
         ?$stk
         dup =""
         1 items
         do
            dup i ]stk$ count rot +place
            bl over append-char                   \ puts the space back
         -1 +loop  ;

: reverse$ ( caddr -- caddr')  split new: top$ reverse ;

: write$   ( $ -- )  cr count type collapse ;

: GO
       c" ---------- Ice and Fire ------------" reverse$ write$
       c"                                     " reverse$ write$
       c" fire, in end will world the say Some" reverse$ write$
       c" ice. in say Some                    " reverse$ write$
       c" desire of tasted I've what From     " reverse$ write$
       c" fire. favor who those with hold I   " reverse$ write$
       c"                                     " reverse$ write$
       c" ... elided paragraph last ...       " reverse$ write$
       c"                                     " reverse$ write$
       c" Frost Robert -----------------------" reverse$ write$
;

[toc] | [next] | [standalone]

#45554

foxaudioresearch@gmail.com writes:
> I have been at it again.
> By defining a string stack and NEXTWORD I could create SPLIT and REVERSE. 
> My system has PAD in free memory. I know this won't work with every system.
> ...


create buf 1000 chars allot
buf value pp

: tr ( caddr u -- ) dup >r pp swap cmove r> pp + to pp  ;
: collect begin parse-name dup while tuck pp >r tr r> swap repeat ;
: >> buf to pp collect 2drop  depth 2/ 0 ?do type bl emit loop cr ;

>> ---------- Ice and Fire ------------
>>                                     
>> fire, in end will world the say Some
>> ice. in say Some                    
>> desire of tasted I've what From     
>> fire. favor who those with hold I   
>>                                     
>> ... elided paragraph last ...       
>>                                     
>> Frost Robert -----------------------

bye

[toc] | [prev] | [next] | [standalone]

#45555

On Monday, February 15, 2016 at 6:14:10 PM UTC-5, Paul Rubin wrote:
> foxaudioresearch@gmail.com writes:
> > I have been at it again.
> > By defining a string stack and NEXTWORD I could create SPLIT and REVERSE. 
> > My system has PAD in free memory. I know this won't work with every system.
> > ...
> 
> 
> create buf 1000 chars allot
> buf value pp
> 
> : tr ( caddr u -- ) dup >r pp swap cmove r> pp + to pp  ;
> : collect begin parse-name dup while tuck pp >r tr r> swap repeat ;
> : >> buf to pp collect 2drop  depth 2/ 0 ?do type bl emit loop cr ;
> 
> >> ---------- Ice and Fire ------------
> >>                                     
> >> fire, in end will world the say Some
> >> ice. in say Some                    
> >> desire of tasted I've what From     
> >> fire. favor who those with hold I   
> >>                                     
> >> ... elided paragraph last ...       
> >>                                     
> >> Frost Robert -----------------------
> 
> bye

Now this is compact.  Very nice.

I tested it on my hobby system and something is not correct. I believe I have to look into parse-name.

It worked flawlessly on Win32forth

"And still I am learning..."  Michelangelo

Me too.

BF

[toc] | [prev] | [next] | [standalone]

#45560

foxaudioresearch@gmail.com writes:
> I tested it on my hobby system and something is not correct. I believe
> I have to look into parse-name.

Oops, looks like it's a gforth word.  You could do something like it
with "word" from ANS core, I think.

http://www.complang.tuwien.ac.at/forth/gforth/Docs-html/The-Input-Stream.html

[toc] | [prev] | [next] | [standalone]

#45562

Paul Rubin <no.email@nospam.invalid> writes:
>foxaudioresearch@gmail.com writes:
>> I tested it on my hobby system and something is not correct. I believe
>> I have to look into parse-name.
>
>Oops, looks like it's a gforth word.

PARSE-NAME is a Forth-2012 standard word.  The Gforth 0.7.0 docs were
from before Forth-2012 and therefore do not document that.

- anton
-- 
M. Anton Ertl  http://www.complang.tuwien.ac.at/anton/home.html
comp.lang.forth FAQs: http://www.complang.tuwien.ac.at/forth/faq/toc.html
     New standard: http://www.forth200x.org/forth200x.html
   EuroForth 2015: http://www.rigwit.co.uk/EuroForth2015/

[toc] | [prev] | [next] | [standalone]

#45566

On 2/15/16 11:27 PM, Paul Rubin wrote:
> foxaudioresearch@gmail.com writes:
>> I tested it on my hobby system and something is not correct. I believe
>> I have to look into parse-name.
>
> Oops, looks like it's a gforth word.  You could do something like it
> with "word" from ANS core, I think.

PARSE-NAME is in the Forth 200x Standard, in the current draft, and the
current release of VFX.

-Doug

[undefined] parse-name [if]
: isspace? ( c -- f )
     bl 1+ u< ;

: isnotspace? ( c -- f )
     isspace? 0= ;

: xt-skip   ( addr1 n1 xt -- addr2 n2 ) \ gforth
     \ skip all characters satisfying xt ( c -- f )
     >r
     BEGIN
	dup
     WHILE
	over c@ r@ execute
     WHILE
	1 /string
     REPEAT  THEN
     r> drop ;

: parse-name ( "name" -- c-addr u )
     source >in @ /string
     ['] isspace? xt-skip over >r
     ['] isnotspace? xt-skip ( end-word restlen r: start-word )
     2dup 1 min + source drop - >in !
     drop r> tuck - ;
[then]

[toc] | [prev] | [next] | [standalone]

#45570

Doug Hoffman <glidedog@gmail.com> writes:

>On 2/15/16 11:27 PM, Paul Rubin wrote:
>> foxaudioresearch@gmail.com writes:
>>> I tested it on my hobby system and something is not correct. I believe
>>> I have to look into parse-name.
>>
>> Oops, looks like it's a gforth word.  You could do something like it
>> with "word" from ANS core, I think.

>PARSE-NAME is in the Forth 200x Standard, in the current draft, and the
>current release of VFX.

>-Doug

>[undefined] parse-name [if]
>: isspace? ( c -- f )
>     bl 1+ u< ;

>: isnotspace? ( c -- f )
>     isspace? 0= ;

>: xt-skip   ( addr1 n1 xt -- addr2 n2 ) \ gforth
>     \ skip all characters satisfying xt ( c -- f )
>     >r
>     BEGIN
>       dup
>     WHILE
>       over c@ r@ execute
>     WHILE
>       1 /string
>     REPEAT  THEN
>     r> drop ;

>: parse-name ( "name" -- c-addr u )
>     source >in @ /string
>     ['] isspace? xt-skip over >r
>     ['] isnotspace? xt-skip ( end-word restlen r: start-word )
>     2dup 1 min + source drop - >in !
>     drop r> tuck - ;
>[then]

NAME is quite common in the meaning of PARSE-NAME.
[ E.g. it is present in ciforth. In ciforth you can also do
    "PARSE-NAME" WANTED ]

To be strictly DP-ANS94 you'd have to use WORD which is ugly.
The solution with $/ is better than using NAME , because it
preserves the spaces between words.

Groetjes Albert
-- 
Albert van der Horst, UTRECHT,THE NETHERLANDS
Economic growth -- being exponential -- ultimately falters.
albert@spe&ar&c.xs4all.nl &=n http://home.hccnet.nl/a.w.m.van.der.horst

[toc] | [prev] | [next] | [standalone]

#45572

Paul Rubin <no.email@nospam.invalid> writes:
>create buf 1000 chars allot
>buf value pp
>
>: tr ( caddr u -- ) dup >r pp swap cmove r> pp + to pp  ;
>: collect begin parse-name dup while tuck pp >r tr r> swap repeat ;
>: >> buf to pp collect 2drop  depth 2/ 0 ?do type bl emit loop cr ;
>
>>> ---------- Ice and Fire ------------
>>>                                     
>>> fire, in end will world the say Some
>>> ice. in say Some                    
>>> desire of tasted I've what From     
>>> fire. favor who those with hold I   
>>>                                     
>>> ... elided paragraph last ...       
>>>                                     
>>> Frost Robert -----------------------

Nice use of the input stream to provide the input.  This allows to
use PARSE-NAME, which has much of the needed functionality already.
It also avoids the need to pass the input string around on the stack.

There is an improvement possible using the technique described by John
Hayes in the SigForth Newsletter 4(2), Fall '92, for implementing {
for locals (and improved in the Forth-2012 reference implementation):

: revline ( "line" -- )
  parse-name dup if
    recurse type space exit then
  2drop ;

: >> ( "line" -- )
  revline cr ;

Here REVLINE just reverses the rest of the line before printing the
token it has parsed.  Note that PARSE-NAME cannot be replaced with BL
WORD COUNT here, because several invocations of WORD may use (and
typically do use) the same buffer.

This example is also nice for demonstrating that we can use the
implicit input through the input stream to make the stack handling
simpler, and can then turn that into an on-stack input with
EXECUTE-PARSING.

: .reverse ( c-addr u -- )
  ['] revline execute-parsing ;

Likewise, we can turn the implicit output to the user terminal into an
explicit output on the stack with >STRING-EXECUTE (Gforth development
version):

: reverse-string ( c-addr1 u1 -- c-addr2 u2 )
  ['] .reverse >string-execute ;

Compare this to what you would have to do to program this without
going through the input stream and without using the implicit-output
words TYPE and SPACE.

- anton
-- 
M. Anton Ertl  http://www.complang.tuwien.ac.at/anton/home.html
comp.lang.forth FAQs: http://www.complang.tuwien.ac.at/forth/faq/toc.html
     New standard: http://www.forth200x.org/forth200x.html
   EuroForth 2015: http://www.rigwit.co.uk/EuroForth2015/

[toc] | [prev] | [next] | [standalone]

#45578

anton@mips.complang.tuwien.ac.at (Anton Ertl) writes:

>Paul Rubin <no.email@nospam.invalid> writes:
>>create buf 1000 chars allot
>>buf value pp
>>
>>: tr ( caddr u -- ) dup >r pp swap cmove r> pp + to pp  ;
>>: collect begin parse-name dup while tuck pp >r tr r> swap repeat ;
>>: >> buf to pp collect 2drop  depth 2/ 0 ?do type bl emit loop cr ;
>>
>>>> ---------- Ice and Fire ------------
>>>>
>>>> fire, in end will world the say Some
>>>> ice. in say Some
>>>> desire of tasted I've what From
>>>> fire. favor who those with hold I
>>>>
>>>> ... elided paragraph last ...
>>>>
>>>> Frost Robert -----------------------

>Nice use of the input stream to provide the input.  This allows to
>use PARSE-NAME, which has much of the needed functionality already.
>It also avoids the need to pass the input string around on the stack.

>There is an improvement possible using the technique described by John
>Hayes in the SigForth Newsletter 4(2), Fall '92, for implementing {
>for locals (and improved in the Forth-2012 reference implementation):

>: revline ( "line" -- )
>  parse-name dup if
>    recurse type space exit then
>  2drop ;

>: >> ( "line" -- )
>  revline cr ;

>Here REVLINE just reverses the rest of the line before printing the
>token it has parsed.  Note that PARSE-NAME cannot be replaced with BL
>WORD COUNT here, because several invocations of WORD may use (and
>typically do use) the same buffer.

>This example is also nice for demonstrating that we can use the
>implicit input through the input stream to make the stack handling
>simpler, and can then turn that into an on-stack input with
>EXECUTE-PARSING.

>: .reverse ( c-addr u -- )
>  ['] revline execute-parsing ;

>Likewise, we can turn the implicit output to the user terminal into an
>explicit output on the stack with >STRING-EXECUTE (Gforth development
>version):

>: reverse-string ( c-addr1 u1 -- c-addr2 u2 )
>  ['] .reverse >string-execute ;

>Compare this to what you would have to do to program this without
>going through the input stream and without using the implicit-output
>words TYPE and SPACE.

Let's compare it with a Forth that has lifted strings to a
very low, but practical abstraction level.
The ministring package ($@ $! $C+ $/ $^ ) saves the day (again).

Note that the first reverse is the original solution that uses
the implicit-output words.

-------------------------------
( ciforth) WANT RDROP $@ $! $+! $C+ $/

: TYPE    PAD $+! ;
: SPACE   BL PAD $C+ ;

\ Print SC in reverse order.
: reverse  DEPTH 2 - >R    BEGIN BL $/ 2SWAP DUP 0= UNTIL
    BEGIN TYPE SPACE DEPTH R@ = UNTIL RDROP ;

: reverse  "" PAD $!   reverse   PAD $@ ;

-------------------------------
Example of usage:

"We gaan naar rome " reverse fd-output WRITE-FILE THROW

>- anton
-- 
Albert van der Horst, UTRECHT,THE NETHERLANDS
Economic growth -- being exponential -- ultimately falters.
albert@spe&ar&c.xs4all.nl &=n http://home.hccnet.nl/a.w.m.van.der.horst

[toc] | [prev] | [next] | [standalone]

#45581

Albert van der Horst <albert@spenarnc.xs4all.nl> writes:
>anton@mips.complang.tuwien.ac.at (Anton Ertl) writes:
>>There is an improvement possible using the technique described by John
>>Hayes in the SigForth Newsletter 4(2), Fall '92, for implementing {
>>for locals (and improved in the Forth-2012 reference implementation):
>
>>: revline ( "line" -- )
>>  parse-name dup if
>>    recurse type space exit then
>>  2drop ;
>
>>: >> ( "line" -- )
>>  revline cr ;
>
>>Here REVLINE just reverses the rest of the line before printing the
>>token it has parsed.  Note that PARSE-NAME cannot be replaced with BL
>>WORD COUNT here, because several invocations of WORD may use (and
>>typically do use) the same buffer.
>
>>This example is also nice for demonstrating that we can use the
>>implicit input through the input stream to make the stack handling
>>simpler, and can then turn that into an on-stack input with
>>EXECUTE-PARSING.
>
>>: .reverse ( c-addr u -- )
>>  ['] revline execute-parsing ;
>
>>Likewise, we can turn the implicit output to the user terminal into an
>>explicit output on the stack with >STRING-EXECUTE (Gforth development
>>version):
>
>>: reverse-string ( c-addr1 u1 -- c-addr2 u2 )
>>  ['] .reverse >string-execute ;
>
>>Compare this to what you would have to do to program this without
>>going through the input stream and without using the implicit-output
>>words TYPE and SPACE.
>
>Let's compare it with a Forth that has lifted strings to a
>very low, but practical abstraction level.
>The ministring package ($@ $! $C+ $/ $^ ) saves the day (again).
>
>Note that the first reverse is the original solution that uses
>the implicit-output words.
>
>-------------------------------
>( ciforth) WANT RDROP $@ $! $+! $C+ $/
>
>: TYPE    PAD $+! ;
>: SPACE   BL PAD $C+ ;
>
>\ Print SC in reverse order.
>: reverse  DEPTH 2 - >R    BEGIN BL $/ 2SWAP DUP 0= UNTIL
>    BEGIN TYPE SPACE DEPTH R@ = UNTIL RDROP ;
>
>: reverse  "" PAD $!   reverse   PAD $@ ;
>
>-------------------------------

So we have EXECUTE-PARSING and >STRING-EXECUTE vs. $@ $! $+! $C+ $/
(plus the use of PAD).

>Example of usage:
>
>"We gaan naar rome " reverse fd-output WRITE-FILE THROW

Of course, you can first put the result into a string and then output
it to a file, but with the approach I posted, you can also do it more
directly (with an additional word: OUTFILE-EXECUTE):

s" We gaan naar rome "  ' .reverse stdout outfile-execute

- anton
-- 
M. Anton Ertl  http://www.complang.tuwien.ac.at/anton/home.html
comp.lang.forth FAQs: http://www.complang.tuwien.ac.at/forth/faq/toc.html
     New standard: http://www.forth200x.org/forth200x.html
   EuroForth 2015: http://www.rigwit.co.uk/EuroForth2015/

[toc] | [prev] | [next] | [standalone]

#45589

anton@mips.complang.tuwien.ac.at (Anton Ertl) writes:
> Note that PARSE-NAME cannot be replaced with BL WORD COUNT here,
> because several invocations of WORD may use (and typically do use) the
> same buffer.

But in Gforth I also found that PARSE-NAME re-used the same buffer on
repeated invocations; that's why I had to copy the words to a user
buffer.  I do like your example's use of RECURSE and I should have done
it that way.

[toc] | [prev] | [next] | [standalone]

#45592

Paul Rubin <no.email@nospam.invalid> writes:
>anton@mips.complang.tuwien.ac.at (Anton Ertl) writes:
>> Note that PARSE-NAME cannot be replaced with BL WORD COUNT here,
>> because several invocations of WORD may use (and typically do use) the
>> same buffer.
>
>But in Gforth I also found that PARSE-NAME re-used the same buffer on
>repeated invocations;

PARSE-NAME gives you addresses into the input buffer (and that's
required by the standard; if you find a case where Gforth does not
comply with that, please report it as a bug).  Gforth reuses the input
buffer on REFILL, but as long as you don't REFILL, the result produced
by each invocation of PARSE stays valid.

- anton
-- 
M. Anton Ertl  http://www.complang.tuwien.ac.at/anton/home.html
comp.lang.forth FAQs: http://www.complang.tuwien.ac.at/forth/faq/toc.html
     New standard: http://www.forth200x.org/forth200x.html
   EuroForth 2015: http://www.rigwit.co.uk/EuroForth2015/

[toc] | [prev] | [next] | [standalone]

#45593

anton@mips.complang.tuwien.ac.at (Anton Ertl) writes:
> Gforth reuses the input buffer on REFILL, but as long as you don't
> REFILL, the result produced by each invocation of PARSE stays valid.

Oh interesting.  I might have noticed the re-use during interactive
testing which would have involved REFILL between invocations.  I'll try
getting rid of the separate copy in the code I posted: if it works, that
will simplify things.  Thanks.

[toc] | [prev] | [next] | [standalone]

#45569

foxaudioresearch@gmail.com writes:

>I have been at it again.

>By defining a string stack and NEXTWORD I could create SPLIT and REVERSE.

>My system has PAD in free memory. I know this won't work with every system.

>\ Rosetta code reverse a string
>\ These primitive operations are included for completeness
>: c+!      ( n addr -- )        dup >r  c@ +  r> c! ;
>: append-char  ( char string -- ) dup >r  count dup 1+ r> c! + c! ;
>: +place   ( addr1 n addr2 -- ) 2dup 2>r  count +  swap move 2r> c+! ;
>: place    ( addr1 n addr2 -- )  2dup 2>r  1+  swap  move  2r> c! ;

>HEX
>\ build a string stack/array for intermediate results
>100 constant ss-width
>variable $depth

>DECIMAL
>: items    ( -- n)   $depth @  ;
>: collapse ( -- )    $depth off ;                 \ reset string stack pointer
>: new:     ( -- )    1 $depth +! ;                \ incr. string stack pointer
>: ]stk$    ( ndx -- addr) ss-width * pad + ;      \ ** PAD is in free memory
>: TOP$     ( -- addr) $depth @ ]stk$ ;            \ top string on string stack

>: =""      ( caddr -- )  0 swap c! ;

>: 1stword  ( addr len -- addr' len')
>           2dup bl scan nip - ;                   \ returns the 1st word

>: nextword ( addr len -- addr++ len++ addr' len') \ output 1st word & remainder
>           2dup 1stword dup >R                    \ get the 1stword
>           2swap R> 1+ /string                    \ removes leading space
>           2swap ;                                \ put 1st word on top

>: split  ( caddr -- )  \ $-- $[1] ... $[n]        \ results go to string stack
>            count
>            begin
>                dup 0>
>            while
>               nextword new: top$ place           \ this strips spaces
>            repeat
>            2drop  ;

>: ?$stk    ( flag -- )
>           items 0= abort" string stack empty?" ;

>: reverse ( caddr -- caddr)
>         ?$stk
>         dup =""
>         1 items
>         do
>            dup i ]stk$ count rot +place
>            bl over append-char                   \ puts the space back
>         -1 +loop  ;

>: reverse$ ( caddr -- caddr')  split new: top$ reverse ;

>: write$   ( $ -- )  cr count type collapse ;

>: GO
>       c" ---------- Ice and Fire ------------" reverse$ write$
>       c"                                     " reverse$ write$
>       c" fire, in end will world the say Some" reverse$ write$
>       c" ice. in say Some                    " reverse$ write$
>       c" desire of tasted I've what From     " reverse$ write$
>       c" fire. favor who those with hold I   " reverse$ write$
>       c"                                     " reverse$ write$
>       c" ... elided paragraph last ...       " reverse$ write$
>       c"                                     " reverse$ write$
>       c" Frost Robert -----------------------" reverse$ write$
>;

Who needs another stack?

-------------------------

\ Split SC into SC1 ... SC2 . reverse order.
: split  BEGIN BL $/ 2SWAP DUP 0= UNTIL ;
: print  >R BEGIN TYPE SPACE DEPTH R@ = UNTIL RDROP ;
: reverse  DEPTH 2 - >R split R> print ;
"We gaan naar rome " reverse CR
-----------------

~/PROJECT/ciforth$ lina <aap.frt
 rome naar gaan We

This is what I would publish in Rosetta:

-------------------------
\ Print SC in reverse order.
: reverse  DEPTH 2 - >R    BEGIN BL $/ 2SWAP DUP 0= UNTIL
    BEGIN TYPE SPACE DEPTH R@ = UNTIL RDROP ;
-------------------------

Groetjes Albert
-- 
Albert van der Horst, UTRECHT,THE NETHERLANDS
Economic growth -- being exponential -- ultimately falters.
albert@spe&ar&c.xs4all.nl &=n http://home.hccnet.nl/a.w.m.van.der.horst

[toc] | [prev] | [next] | [standalone]

#45586

foxaudioresearch@gmail.com wrote:

> I have been at it again.
> 
> By defining a string stack and NEXTWORD I could create SPLIT and REVERSE. 
> 
> My system has PAD in free memory. I know this won't work with every system.
> 
> \ Rosetta code reverse a string
> \ These primitive operations are included for completeness
> : c+!      ( n addr -- )        dup >r  c@ +  r> c! ;
> : append-char  ( char string -- ) dup >r  count dup 1+ r> c! + c! ;
> : +place   ( addr1 n addr2 -- ) 2dup 2>r  count +  swap move 2r> c+! ;
> : place    ( addr1 n addr2 -- )  2dup 2>r  1+  swap  move  2r> c! ;
> 
> HEX
> \ build a string stack/array for intermediate results
> 100 constant ss-width
> variable $depth
> 
> DECIMAL
> : items    ( -- n)   $depth @  ;
> : collapse ( -- )    $depth off ;                 \ reset string stack pointer
> : new:     ( -- )    1 $depth +! ;                \ incr. string stack pointer
> : ]stk$    ( ndx -- addr) ss-width * pad + ;      \ ** PAD is in free memory
> : TOP$     ( -- addr) $depth @ ]stk$ ;            \ top string on string stack
> 
> : =""      ( caddr -- )  0 swap c! ;
> 
> : 1stword  ( addr len -- addr' len')
>            2dup bl scan nip - ;                   \ returns the 1st word
> 
> : nextword ( addr len -- addr++ len++ addr' len') \ output 1st word & remainder
>            2dup 1stword dup >R                    \ get the 1stword
>            2swap R> 1+ /string                    \ removes leading space
>            2swap ;                                \ put 1st word on top
> 
> : split  ( caddr -- )  \ $-- $[1] ... $[n]        \ results go to string stack
>             count
>             begin
>                 dup 0>
>             while
>                nextword new: top$ place           \ this strips spaces 
>             repeat
>             2drop  ;
> 
> : ?$stk    ( flag -- )
>            items 0= abort" string stack empty?" ;
> 
> : reverse ( caddr -- caddr)
>          ?$stk
>          dup =""
>          1 items
>          do
>             dup i ]stk$ count rot +place
>             bl over append-char                   \ puts the space back
>          -1 +loop  ;
> 
> : reverse$ ( caddr -- caddr')  split new: top$ reverse ;
> 
> : write$   ( $ -- )  cr count type collapse ;
> 
> : GO
>        c" ---------- Ice and Fire ------------" reverse$ write$
>        c"                                     " reverse$ write$
>        c" fire, in end will world the say Some" reverse$ write$
>        c" ice. in say Some                    " reverse$ write$
>        c" desire of tasted I've what From     " reverse$ write$
>        c" fire. favor who those with hold I   " reverse$ write$
>        c"                                     " reverse$ write$
>        c" ... elided paragraph last ...       " reverse$ write$
>        c"                                     " reverse$ write$
>        c" Frost Robert -----------------------" reverse$ write$
> ;

Ruby:

puts "---------- Ice and Fire ------------
                                    
fire, in end will world the say Some
ice. in say Some                    
desire of tasted I've what From     
fire. favor who those with hold I   
                                    
... elided paragraph last ...       
                                    
Frost Robert -----------------------".lines.map{|s| s.split.reverse.join " "}



------------ Fire and Ice ----------

Some say the world will end in fire,
Some say in ice.
From what I've tasted of desire
I hold with those who favor fire.

... last paragraph elided ...

----------------------- Robert Frost


-- 
In his message [the Jew Nicolas] Sarkozy insisted that the French people must
change, that there will be dire consequences if they don't, and that not to
intermarry racially is bad for the survival of the country.
http://archive.org/download/DavidDuke_videos/StopTheGenocideOfEuropeanMankindDavidDuke-z43pcbr_el0.ogv

[toc] | [prev] | [next] | [standalone]

#45590

On Monday, February 15, 2016 at 11:22:57 PM UTC+2, foxaudio...@gmail.com wrote:
> I have been at it again.
> 
> By defining a string stack and NEXTWORD I could create SPLIT and REVERSE. 
> 
> My system has PAD in free memory. I know this won't work with every system.
> 
> \ Rosetta code reverse a string
> \ These primitive operations are included for completeness
> : c+!      ( n addr -- )        dup >r  c@ +  r> c! ;
> : append-char  ( char string -- ) dup >r  count dup 1+ r> c! + c! ;
> : +place   ( addr1 n addr2 -- ) 2dup 2>r  count +  swap move 2r> c+! ;
> : place    ( addr1 n addr2 -- )  2dup 2>r  1+  swap  move  2r> c! ;
> 
> HEX
> \ build a string stack/array for intermediate results
> 100 constant ss-width
> variable $depth
> 
> DECIMAL
> : items    ( -- n)   $depth @  ;
> : collapse ( -- )    $depth off ;                 \ reset string stack pointer
> : new:     ( -- )    1 $depth +! ;                \ incr. string stack pointer
> : ]stk$    ( ndx -- addr) ss-width * pad + ;      \ ** PAD is in free memory
> : TOP$     ( -- addr) $depth @ ]stk$ ;            \ top string on string stack
> 
> : =""      ( caddr -- )  0 swap c! ;
> 
> : 1stword  ( addr len -- addr' len')
>            2dup bl scan nip - ;                   \ returns the 1st word
> 
> : nextword ( addr len -- addr++ len++ addr' len') \ output 1st word & remainder
>            2dup 1stword dup >R                    \ get the 1stword
>            2swap R> 1+ /string                    \ removes leading space
>            2swap ;                                \ put 1st word on top
> 
> : split  ( caddr -- )  \ $-- $[1] ... $[n]        \ results go to string stack
>             count
>             begin
>                 dup 0>
>             while
>                nextword new: top$ place           \ this strips spaces 
>             repeat
>             2drop  ;
> 
> : ?$stk    ( flag -- )
>            items 0= abort" string stack empty?" ;
> 
> : reverse ( caddr -- caddr)
>          ?$stk
>          dup =""
>          1 items
>          do
>             dup i ]stk$ count rot +place
>             bl over append-char                   \ puts the space back
>          -1 +loop  ;
> 
> : reverse$ ( caddr -- caddr')  split new: top$ reverse ;
> 
> : write$   ( $ -- )  cr count type collapse ;
> 
> : GO
>        c" ---------- Ice and Fire ------------" reverse$ write$
>        c"                                     " reverse$ write$
>        c" fire, in end will world the say Some" reverse$ write$
>        c" ice. in say Some                    " reverse$ write$
>        c" desire of tasted I've what From     " reverse$ write$
>        c" fire. favor who those with hold I   " reverse$ write$
>        c"                                     " reverse$ write$
>        c" ... elided paragraph last ...       " reverse$ write$
>        c"                                     " reverse$ write$
>        c" Frost Robert -----------------------" reverse$ write$
> ;

Hi!

Another approach:

\ --- Rotate words by rotating chars

: cpull    ( ca u -- )
        over >R 1 /string R> swap move
;
: croll     ( ca u -- )
        dup 0= IF 2drop exit THEN
        over c@ >R 2dup 1- + >R cpull 2R> c!
;

        VARIABLE Len
: word-rot  ( ca u -- )
        dup Len !
        BEGIN                           ( ca u     )
            Len @                       ( ca u f   )
        WHILE
            over c@ BL =                ( ca u f   )
            IF
                drop Len @              ( ca len   )
                2dup croll
                1-                      ( ca len-1 )
            ELSE 
                2dup croll              ( ca u     )
            THEN
            -1 Len +!
        REPEAT
        2drop
;
\ ---

Testing:
s" cube alfa beta gamma delta" 2dup word-rot cr type .s  
delta gamma beta alfa cube<0>  ok


Enjoying Forth,
humptydumpty

[toc] | [prev] | [next] | [standalone]

#48597

foxaudioresearch@gmail.com wrote:

> I have been at it again.
> 
> By defining a string stack and NEXTWORD I could create SPLIT and REVERSE. 
> 
> My system has PAD in free memory. I know this won't work with every system.
> 
> \ Rosetta code reverse a string
> \ These primitive operations are included for completeness
> : c+!      ( n addr -- )        dup >r  c@ +  r> c! ;
> : append-char  ( char string -- ) dup >r  count dup 1+ r> c! + c! ;
> : +place   ( addr1 n addr2 -- ) 2dup 2>r  count +  swap move 2r> c+! ;
> : place    ( addr1 n addr2 -- )  2dup 2>r  1+  swap  move  2r> c! ;
> 
> HEX
> \ build a string stack/array for intermediate results
> 100 constant ss-width
> variable $depth
> 
> DECIMAL
> : items    ( -- n)   $depth @  ;
> : collapse ( -- )    $depth off ;                 \ reset string stack pointer
> : new:     ( -- )    1 $depth +! ;                \ incr. string stack pointer
> : ]stk$    ( ndx -- addr) ss-width * pad + ;      \ ** PAD is in free memory
> : TOP$     ( -- addr) $depth @ ]stk$ ;            \ top string on string stack
> 
> : =""      ( caddr -- )  0 swap c! ;
> 
> : 1stword  ( addr len -- addr' len')
>            2dup bl scan nip - ;                   \ returns the 1st word
> 
> : nextword ( addr len -- addr++ len++ addr' len') \ output 1st word & remainder
>            2dup 1stword dup >R                    \ get the 1stword
>            2swap R> 1+ /string                    \ removes leading space
>            2swap ;                                \ put 1st word on top
> 
> : split  ( caddr -- )  \ $-- $[1] ... $[n]        \ results go to string stack
>             count
>             begin
>                 dup 0>
>             while
>                nextword new: top$ place           \ this strips spaces 
>             repeat
>             2drop  ;
> 
> : ?$stk    ( flag -- )
>            items 0= abort" string stack empty?" ;
> 
> : reverse ( caddr -- caddr)
>          ?$stk
>          dup =""
>          1 items
>          do
>             dup i ]stk$ count rot +place
>             bl over append-char                   \ puts the space back
>          -1 +loop  ;
> 
> : reverse$ ( caddr -- caddr')  split new: top$ reverse ;
> 
> : write$   ( $ -- )  cr count type collapse ;
> 
> : GO
>        c" ---------- Ice and Fire ------------" reverse$ write$
>        c"                                     " reverse$ write$
>        c" fire, in end will world the say Some" reverse$ write$
>        c" ice. in say Some                    " reverse$ write$
>        c" desire of tasted I've what From     " reverse$ write$
>        c" fire. favor who those with hold I   " reverse$ write$
>        c"                                     " reverse$ write$
>        c" ... elided paragraph last ...       " reverse$ write$
>        c"                                     " reverse$ write$
>        c" Frost Robert -----------------------" reverse$ write$
> ;

OCaml:

#load "str.cma";;

"---------- Tyrant? the Is Who ------------
                                    
common? in have tyrannies all that it is What
praise. with except tyrant the mention to allowed not are people The
man. a not group, a is tyrant the America, In
tyrant? the is Who"
 |> Str.(split (regexp "\r?\n"))
 |> List.map
      (fun s -> String.concat " " (List.rev (Str.(split (regexp " +") s))))
 |> List.iter print_endline ;;


------------ Who Is the Tyrant? ----------

What is it that all tyrannies have in common?
The people are not allowed to mention the tyrant except with praise.
In America, the tyrant is a group, not a man.
Who is the tyrant?

-- 
The former leader of the National Front Jean-Marie Le Pen was fined 30,000
euros for exposing the Jews Holocaust gas chamber hoax.
infostormer.com/jean-marie-le-pen-fined-30000-euros-for-exposing-jewish-holocaust-gas-chamber-hoax

[toc] | [prev] | [next] | [standalone]

#48605

WJ wrote:
> ...
> OCaml:
>
> #load "str.cma";;
>
> "---------- Tyrant? the Is Who ------------
>
> common? in have tyrannies all that it is What
> praise. with except tyrant the mention to allowed not are people The
> man. a not group, a is tyrant the America, In
> tyrant? the is Who"
>  |> Str.(split (regexp "\r?\n"))
>  |> List.map
>       (fun s -> String.concat " " (List.rev (Str.(split (regexp " +") s))))
>  |> List.iter print_endline ;;
>
>
> ------------ Who Is the Tyrant? ----------

\ SKIP SCAN exist in most Forths as primitives
\ but can be coded from scratch

: +STRING ( a1 u1 a2 u2 -- a2 u3)
  2swap swap 2over + 2 pick cmove + ;

: SPLIT ( a u char -- a2 u2 a3 u3 )
  >r 2dup r> scan 2swap 2 pick - ;

: /WORD ( a u -- a1 u1 a2 u2 )
  bl skip  bl split  2swap ;

: +WORD ( a1 u1 a2 u2 -- a2 u3 )
  +string  s"  " 2swap +string ;

: REVERSE-WORDS ( src len dest -- dest len )
  >r  0 begin >r  dup while  /word  r> 1+ repeat 2drop
  2r> 0 tuck ?do  +word  loop -trailing ;

: .rvs ( a u -- )  pad reverse-words cr type ;

: plug ( -- ) cr
  s" words user-created few a with things do often can Forth" .rvs
  s" accomplish. to libraries require languages other that" .rvs ;

plug

Forth can often do things with a few user-created words
that other languages require libraries to accomplish. ok

[toc] | [prev] | [standalone]

Back to top | Article view | comp.lang.forth

csiph-web