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

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

YC on Rosetta Code

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

Contents

  YC on Rosetta Code Lars Brinkhoff <lars.spam@nocrew.org> - 2016-02-11 07:22 +0100
    Re: YC on Rosetta Code Lars Brinkhoff <lars.spam@nocrew.org> - 2016-02-11 07:40 +0100
      Re: YC on Rosetta Code "WJ" <w_a_x_man@yahoo.com> - 2016-02-11 13:22 +0000
      Re: YC on Rosetta Code humptydumpty <ouatubi@gmail.com> - 2016-02-11 13:36 -0800
        Re: YC on Rosetta Code humptydumpty <ouatubi@gmail.com> - 2016-02-11 20:48 -0800
          Re: YC on Rosetta Code Lars Brinkhoff <lars.spam@nocrew.org> - 2016-02-12 07:18 +0100
            Re: YC on Rosetta Code humptydumpty <ouatubi@gmail.com> - 2016-02-11 22:58 -0800
              Re: YC on Rosetta Code Lars Brinkhoff <lars.spam@nocrew.org> - 2016-02-12 08:22 +0100
              Re: YC on Rosetta Code Albert van der Horst <albert@spenarnc.xs4all.nl> - 2016-02-12 11:07 +0000
                Re: YC on Rosetta Code anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2016-02-12 12:51 +0000
                Re: YC on Rosetta Code humptydumpty <ouatubi@gmail.com> - 2016-02-12 11:15 -0800
                  Re: YC on Rosetta Code humptydumpty <ouatubi@gmail.com> - 2016-02-14 08:19 -0800
            Re: YC on Rosetta Code humptydumpty <ouatubi@gmail.com> - 2016-02-11 23:14 -0800
              Re: YC on Rosetta Code Lars Brinkhoff <lars.spam@nocrew.org> - 2016-02-12 08:31 +0100
                Re: YC on Rosetta Code humptydumpty <ouatubi@gmail.com> - 2016-02-12 00:39 -0800
                Re: YC on Rosetta Code humptydumpty <ouatubi@gmail.com> - 2016-02-12 01:21 -0800
      Re: YC on Rosetta Code "WJ" <w_a_x_man@yahoo.com> - 2016-02-14 21:48 +0000

#45433 — YC on Rosetta Code

I wanted to combine the YC and RC threads, so I added this:
https://rosettacode.org/wiki/Y_combinator#Forth

I opted for these stack effects:
\ y ( xt1 -- xt2 )
\ xt2: execute xt1 with ( xi xt2 -- xj )

[toc] | [next] | [standalone]

#45434

> I wanted to combine the YC and RC threads, so I added this:
> https://rosettacode.org/wiki/Y_combinator#Forth
>
> I opted for these stack effects:
> \ y ( xt1 -- xt2 )
> \ xt2: execute xt1 with ( xi xt2 -- xj )

For convenience, here's the code:

  \ Address of an xt.
  variable 'xt
  \ Make room for an xt.
  : xt, ( -- ) here 'xt !  1 cells allot ;
  \ Store xt.
  : !xt ( xt -- ) 'xt @ ! ;
  \ Compile fetching the xt.
  : @xt, ( -- ) 'xt @ postpone literal postpone @ ;
  \ Compile the Y combinator.
  : y, ( xt1 -- xt2 ) >r :noname @xt, r> compile, postpone ; ;
  \ Make a new instance of the Y combinator.
  : y ( xt1 -- xt2 ) xt, y, dup !xt ;

Sample usage:

  \ Factorial
  10 :noname ( u1 xt -- u2 )
     over ?dup if 1- swap execute * else 2drop 1 then ;
  y execute . 3628800 ok
   
  \ Fibonacci
  10 :noname ( u1 xt -- u2 )
     over 2 < if drop else >r 1- dup r@ execute swap 1- r> execute + then ;
  y execute . 55 ok

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

#45456

Lars Brinkhoff wrote:


>   \ Factorial
>   10 :noname ( u1 xt -- u2 )
>      over ?dup if 1- swap execute * else 2drop 1 then ;
>   y execute . 3628800 ok

Oforth:

  >1 10 seqEach(#*) .
  3628800 ok
  >1 25 seqEach(#*) .
  15511210043330985984000000 ok
  >1 33 seqEach(#*) .
  8683317618811886495518194401280000000 ok
  >1 43 seqEach(#*) .
  60415263063373835637355132068513997507264512000000000 ok


>   \ Fibonacci
>   10 :noname ( u1 xt -- u2 )
>      over 2 < if drop else >r 1- dup r@ execute swap 1- r> execute + then ;
>   y execute . 55 ok


  >0 1 #[dup . tuck +] times(20)
  1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 6765 ok

-- 
Amazon bans book.  After nearly a month on the site, all traces of the book and
its 80 reviews have been removed.
http://jamesfetzer.blogspot.com/2015/11/debunking-sandy-hook-debunkers-5.html
https://www.youtube.com/watch?v=EEl_1HWFRfo

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

#45466

On Thursday, February 11, 2016 at 8:40:55 AM UTC+2, Lars Brinkhoff wrote:
> > I wanted to combine the YC and RC threads, so I added this:
> > https://rosettacode.org/wiki/Y_combinator#Forth
> >
> > I opted for these stack effects:
> > \ y ( xt1 -- xt2 )
> > \ xt2: execute xt1 with ( xi xt2 -- xj )
> 
> For convenience, here's the code:
> 
>   \ Address of an xt.
>   variable 'xt
>   \ Make room for an xt.
>   : xt, ( -- ) here 'xt !  1 cells allot ;
>   \ Store xt.
>   : !xt ( xt -- ) 'xt @ ! ;
>   \ Compile fetching the xt.
>   : @xt, ( -- ) 'xt @ postpone literal postpone @ ;
>   \ Compile the Y combinator.
>   : y, ( xt1 -- xt2 ) >r :noname @xt, r> compile, postpone ; ;
>   \ Make a new instance of the Y combinator.
>   : y ( xt1 -- xt2 ) xt, y, dup !xt ;
> 
> Sample usage:
> 
>   \ Factorial
>   10 :noname ( u1 xt -- u2 )
>      over ?dup if 1- swap execute * else 2drop 1 then ;
>   y execute . 3628800 ok
>    
>   \ Fibonacci
>   10 :noname ( u1 xt -- u2 )
>      over 2 < if drop else >r 1- dup r@ execute swap 1- r> execute + then ;
>   y execute . 55 ok

Hi!

Another version (excerpt from gforth terminal):

: yc >R :noname R> compile, latestxt ]] literal swap IF drop EXIT THEN execute ; [[ ;  ok
1 5 :noname tuck * swap 1- dup 1 < ; yc execute .s <2> 120 0  ok

Enjoying forth,
humptydumpty

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

#45467

On Thursday, February 11, 2016 at 11:36:53 PM UTC+2, humptydumpty wrote:
> On Thursday, February 11, 2016 at 8:40:55 AM UTC+2, Lars Brinkhoff wrote:
> > > I wanted to combine the YC and RC threads, so I added this:
> > > https://rosettacode.org/wiki/Y_combinator#Forth
> > >
> > > I opted for these stack effects:
> > > \ y ( xt1 -- xt2 )
> > > \ xt2: execute xt1 with ( xi xt2 -- xj )
> > 
> > For convenience, here's the code:
> > 
> >   \ Address of an xt.
> >   variable 'xt
> >   \ Make room for an xt.
> >   : xt, ( -- ) here 'xt !  1 cells allot ;
> >   \ Store xt.
> >   : !xt ( xt -- ) 'xt @ ! ;
> >   \ Compile fetching the xt.
> >   : @xt, ( -- ) 'xt @ postpone literal postpone @ ;
> >   \ Compile the Y combinator.
> >   : y, ( xt1 -- xt2 ) >r :noname @xt, r> compile, postpone ; ;
> >   \ Make a new instance of the Y combinator.
> >   : y ( xt1 -- xt2 ) xt, y, dup !xt ;
> > 
> > Sample usage:
> > 
> >   \ Factorial
> >   10 :noname ( u1 xt -- u2 )
> >      over ?dup if 1- swap execute * else 2drop 1 then ;
> >   y execute . 3628800 ok
> >    
> >   \ Fibonacci
> >   10 :noname ( u1 xt -- u2 )
> >      over 2 < if drop else >r 1- dup r@ execute swap 1- r> execute + then ;
> >   y execute . 55 ok
> 
> Hi!
> 
> Another version (excerpt from gforth terminal):
> 
> : yc >R :noname R> compile, latestxt ]] literal swap IF drop EXIT THEN execute ; [[ ;  ok
> 1 5 :noname tuck * swap 1- dup 1 < ; yc execute .s <2> 120 0  ok
> 
> Enjoying forth,
> humptydumpty

A little better than my last version is (from gforth terminal):

: yc >R :noname R> compile, latestxt ]] literal swap IF execute EXIT THEN drop ; [[ ;  ok
1 5 :noname tuck * swap 1- dup ; yc execute .s <2> 120 0  ok                         

Enjoying Forth,
humptudumpty

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

#45469

humptydumpty writes:
> : yc >R :noname R> compile, latestxt ]] literal swap IF execute EXIT
> THEN drop ; [[ ; ok

Right, it's a lot better with LATESTXT.  But that's not a standard word.

Why not just

  : yc >r :noname latestxt postpone literal r> compile, postpone ; ;

?

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

#45471

On Friday, February 12, 2016 at 8:18:39 AM UTC+2, Lars Brinkhoff wrote:
> humptydumpty writes:
> > : yc >R :noname R> compile, latestxt ]] literal swap IF execute EXIT
> > THEN drop ; [[ ; ok
> 
> Right, it's a lot better with LATESTXT.  But that's not a standard word.
> 
> Why not just
> 
>   : yc >r :noname latestxt postpone literal r> compile, postpone ; ;
> 
> ?

Hi!

Yes, executing 'latestxt compile,' at compile-time is just recurse so:

: yc >R :noname R> compile, ]] IF recurse exit THEN ; [[ ; redefined yc   ok
1 5 :noname tuck * swap 1- dup ; yc execute .s 2drop <2> 120 0  ok

Now I feel that I cheat a little ... , but is a valid definition for YC!  ok

Enjoying Forth,
humptydumpty

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

#45474

humptydumpty wrote:
>> Why not just
>>   : yc >r :noname latestxt postpone literal r> compile, postpone ; ;
>> ?
>
> Yes, executing 'latestxt compile,' at compile-time is just recurse so:
>
> : yc >R :noname R> compile, ]] IF recurse exit THEN ; [[ ; redefined yc   ok
> 1 5 :noname tuck * swap 1- dup ; yc execute .s 2drop <2> 120 0  ok

No, I wrote "latestxt postpone literal".  That's not the same as
RECURSE.  It saves LATESTXT as a literal inside the :NONAME definition.
At run time, that xt will be passed to the other xt compiled by
COMPILE,.

My suggestion above is what I really wanted to write, if LATESTXT had
been available.  But it's not in the standard, so I opted to store the
:NONAME xt in another, uglier way.

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

#45481

humptydumpty <ouatubi@gmail.com> writes:

>On Friday, February 12, 2016 at 8:18:39 AM UTC+2, Lars Brinkhoff wrote:
>> humptydumpty writes:
>> > : yc >R :noname R> compile, latestxt ]] literal swap IF execute EXIT
>> > THEN drop ; [[ ; ok
>>
>> Right, it's a lot better with LATESTXT.  But that's not a standard word.
>>
>> Why not just
>>
>>   : yc >r :noname latestxt postpone literal r> compile, postpone ; ;
>>
>> ?

>Hi!

>Yes, executing 'latestxt compile,' at compile-time is just recurse so:

>: yc >R :noname R> compile, ]] IF recurse exit THEN ; [[ ; redefined yc   ok
>1 5 :noname tuck * swap 1- dup ; yc execute .s 2drop <2> 120 0  ok

>Now I feel that I cheat a little ... , but is a valid definition for YC!  ok

I don't have a good intuition about what y does. If I read the Rosetta
site correctly it is the pinnacle of functional programming, avoiding
global or local variables and even RECURSE.
Eating up dictionary space seems at odds with that.


>Enjoying Forth,
>humptydumpty

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]

#45482

Albert van der Horst <albert@spenarnc.xs4all.nl> writes:
>I don't have a good intuition about what y does. If I read the Rosetta
>site correctly it is the pinnacle of functional programming, avoiding
>global or local variables and even RECURSE.

Pinnacle is the wrong word.  Statically typed functional programming
languages like Haskell cannot define Y (at least not in the usual way)
and don't miss it.

I see it more as a way to show the power of lambda calculus (or,
alternatively, the S and K combinators).  There is no obvious way to
define recursive functions (much less loops) in these formalisms,
but there is a way to define the Y combinator, and with that you can
define all functions that you can also define as recursive functions
(in a roundabout way).

More practical programming languages allow direct recursion, so the Y
combinator is not used in practice.

>Eating up dictionary space seems at odds with that.

When you evaluate lamda expressions (or combinatorial expressions)
according to the text book, you get intermediate expressions that can
be arbitrarily much larger than the original expression.  The computer
equivalent is using memory; In a Scheme implementation (the closest to
Lambda calculus we usually have), this memory is consumed by a bunch
of closures, and will eventually be garbage-collected.  In Forth, we
have no garbage collection, and the natural way to emulate closures is
to generate anonymous colon definitions at run time.  This consumes
dictionary memory, but so what; in theoretical computer science,
memory is infinite (or 0), and this is just of theoretical interest.

- 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]

#45487

On Friday, February 12, 2016 at 1:07:52 PM UTC+2, Albert van der Horst wrote:
> humptydumpty <ouatubi@gmail.com> writes:
> 
> >On Friday, February 12, 2016 at 8:18:39 AM UTC+2, Lars Brinkhoff wrote:
> >> humptydumpty writes:
> >> > : yc >R :noname R> compile, latestxt ]] literal swap IF execute EXIT
> >> > THEN drop ; [[ ; ok
> >>
> >> Right, it's a lot better with LATESTXT.  But that's not a standard word.
> >>
> >> Why not just
> >>
> >>   : yc >r :noname latestxt postpone literal r> compile, postpone ; ;
> >>
> >> ?
> 
> >Hi!
> 
> >Yes, executing 'latestxt compile,' at compile-time is just recurse so:
> 
> >: yc >R :noname R> compile, ]] IF recurse exit THEN ; [[ ; redefined yc   ok
> >1 5 :noname tuck * swap 1- dup ; yc execute .s 2drop <2> 120 0  ok
> 
> >Now I feel that I cheat a little ... , but is a valid definition for YC!  ok
> 
> I don't have a good intuition about what y does. If I read the Rosetta
> site correctly it is the pinnacle of functional programming, avoiding
> global or local variables and even RECURSE.
> Eating up dictionary space seems at odds with that.
> 
> 
> >Enjoying Forth,
> >humptydumpty
> 
> 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

Hi!

For me is more philosophical, how an word apply to himself?
How could a word be provided to another one which make another one which
executed would (conditionally) run forever?

A word should take parameters from data-stack. So must have
a number which uniquely would identify a word, and much more
such must have a mean to run that word whose 'id' is on stack.
Such 'id' is execution-token that could be run by 'execute'.

Yet more we have anonymous defining word - ':noname' 
that leave an 'xt' on stack.

Ok. How to make forever-running word using that? That 
One to store that 'xt' in a cell-location in dictionary,
fetching and executing it. Something like (gforth excerpt):

: mkforever here 0 , >R :noname R@ postpone literal postpone @ postpone execute postpone ;  dup R> ! ;  ok
mkforever .s execute <1> 140666240484048                                                              
:2: Return stack overflow
mkforever .s >>>execute<<<
Backtrace:
 
That way Lars used to provide a forever running "carrier" for "payload".

Another way is to preserve xt on stack:

:noname dup execute ; dup execute 
:1: Return stack overflow
:noname dup execute ; dup >>>execute<<<
Backtrace:

So 'dup execute' way could lead to something like (gforth terminal) :) 

10 :noname ( u1 xt -- u2 ) over 2 < if drop else >r 1- dup r@ dup execute swap 1- r> dup execute + then ; dup execute . .s 55 <0>  ok

Sorry, I have to leave now,
humptydumpty

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

#45522

On Friday, February 12, 2016 at 9:15:40 PM UTC+2, humptydumpty wrote:
> On Friday, February 12, 2016 at 1:07:52 PM UTC+2, Albert van der Horst wrote:
> > humptydumpty <> writes:
> > 
> > >On Friday, February 12, 2016 at 8:18:39 AM UTC+2, Lars Brinkhoff wrote:
> > >> humptydumpty writes:
> > >> > : yc >R :noname R> compile, latestxt ]] literal swap IF execute EXIT
> > >> > THEN drop ; [[ ; ok
> > >>
> > >> Right, it's a lot better with LATESTXT.  But that's not a standard word.
> > >>
> > >> Why not just
> > >>
> > >>   : yc >r :noname latestxt postpone literal r> compile, postpone ; ;
> > >>
> > >> ?
> > 
> > >Hi!
> > 
> > >Yes, executing 'latestxt compile,' at compile-time is just recurse so:
> > 
> > >: yc >R :noname R> compile, ]] IF recurse exit THEN ; [[ ; redefined yc   ok
> > >1 5 :noname tuck * swap 1- dup ; yc execute .s 2drop <2> 120 0  ok
> > 
> > >Now I feel that I cheat a little ... , but is a valid definition for YC!  ok
> > 
> > I don't have a good intuition about what y does. If I read the Rosetta
> > site correctly it is the pinnacle of functional programming, avoiding
> > global or local variables and even RECURSE.
> > Eating up dictionary space seems at odds with that.
> > 
> > 
> > >Enjoying Forth,
> > >humptydumpty
> > 
> > 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
> 
> Hi!
> 
> For me is more philosophical, how an word apply to himself?
> How could a word be provided to another one which make another one which
> executed would (conditionally) run forever?
> 
> A word should take parameters from data-stack. So must have
> a number which uniquely would identify a word, and much more
> such must have a mean to run that word whose 'id' is on stack.
> Such 'id' is execution-token that could be run by 'execute'.
> 
> Yet more we have anonymous defining word - ':noname' 
> that leave an 'xt' on stack.
> 
> Ok. How to make forever-running word using that? That 
> One to store that 'xt' in a cell-location in dictionary,
> fetching and executing it. Something like (gforth excerpt):
> 
> : mkforever here 0 , >R :noname R@ postpone literal postpone @ postpone execute postpone ;  dup R> ! ;  ok
> mkforever .s execute <1> 140666240484048                                                              
> :2: Return stack overflow
> mkforever .s >>>execute<<<
> Backtrace:
>  
> That way Lars used to provide a forever running "carrier" for "payload".
> 
> Another way is to preserve xt on stack:
> 
> :noname dup execute ; dup execute 
> :1: Return stack overflow
> :noname dup execute ; dup >>>execute<<<
> Backtrace:
> 
> So 'dup execute' way could lead to something like (gforth terminal) :) 
> 
> 10 :noname ( u1 xt -- u2 ) over 2 < if drop else >r 1- dup r@ dup execute swap 1- r> dup execute + then ; dup execute . .s 55 <0>  ok
> 
> Sorry, I have to leave now,
> humptydumpty



Little was left to continue:

: bootstrap dup execute ;
: yc >R :noname R> compile, POSTPONE ; dup ;
10 :noname ( u1 xt -- u2 ) over 2 < if drop else >r 1- dup r@ bootstrap swap 1- r> bootstrap  + then ; yc execute

Or 'bootstrap' himself, not executing 'xt' returned by 'yc':

10 :noname ( u1 xt -- u2 ) over 2 < if drop else >r 1- dup r@ bootstrap swap 1- r> bootstrap  + then ; bootstrap

Enjoying Forth,
humptydumpty

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

#45473

On Friday, February 12, 2016 at 8:18:39 AM UTC+2, Lars Brinkhoff wrote:
> humptydumpty writes:
> > : yc >R :noname R> compile, latestxt ]] literal swap IF execute EXIT
> > THEN drop ; [[ ; ok
> 
> Right, it's a lot better with LATESTXT.  But that's not a standard word.
> 
> Why not just
> 
>   : yc >r :noname latestxt postpone literal r> compile, postpone ; ;
> 
> ?

Hi!

Yes! (Excuse me, I was in little hurry!) And use provided 'latestxt' in
definition of "client".

About using standard words, another version is just:
: yc >R :noname R> compile, ]] IF recurse THEN ; [[ ;

Enjoying Forth,
humptydumpty

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

#45475

humptydumpty wrote:
> About using standard words, another version is just:
> : yc >R :noname R> compile, ]] IF recurse THEN ; [[ ;

The definition of the Y Combinator is that it operates on a function f1
and returns another function f2.  When f2 is called, it calls f1 with f2
as an argument.

I don't think you can define a function that recurses multiple times
with your implementation.  E.g. how to you define the Fibonacci
function?

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

#45478

On Friday, February 12, 2016 at 9:31:11 AM UTC+2, Lars Brinkhoff wrote:
> humptydumpty wrote:
> > About using standard words, another version is just:
> > : yc >R :noname R> compile, ]] IF recurse THEN ; [[ ;
> 
> The definition of the Y Combinator is that it operates on a function f1
> and returns another function f2.  When f2 is called, it calls f1 with f2
> as an argument.
> 
> I don't think you can define a function that recurses multiple times
> with your implementation.  E.g. how to you define the Fibonacci
> function?

Hi!

OK. I see. Here a standard way for yc (excerpt from gforth terminal):

: yc ( xt1 -- xt2 ) align here 0 , 2>R :noname R@ ]] literal @ [[ 2R@ drop compile, ]] ; [[ 2R> nip over swap ! ;   ok
5 :noname ( u1 xt -- u2 ) over ?dup if 1- swap execute * else 2drop 1 then ; yc execute . .s 120 <0>  ok          
10 :noname ( u1 xt -- u2 ) over 2 < if drop else >r 1- dup r@ execute swap 1- r> execute + then ; yc execute . .s  55 <0>  ok

Enjoying Forth,
humptydumpty

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

#45479

On Friday, February 12, 2016 at 9:31:11 AM UTC+2, Lars Brinkhoff wrote:
> humptydumpty wrote:
> > About using standard words, another version is just:
> > : yc >R :noname R> compile, ]] IF recurse THEN ; [[ ;
> 
> The definition of the Y Combinator is that it operates on a function f1
> and returns another function f2.  When f2 is called, it calls f1 with f2
> as an argument.
> 
> I don't think you can define a function that recurses multiple times
> with your implementation.  E.g. how to you define the Fibonacci
> function?

Hi!

Yet could be done (excerpt from gforth terminal):

: enter >R ;  ok
: yc >R :noname R> compile, ]] recurse ; [[ ;  ok                                                    
10 :noname dup 2 < IF rdrop exit ELSE 1- dup R@ enter swap 1- R@ enter + THEN rdrop ; yc execute . .s 55 <0>  ok

Enjoying Forth,
humptydumpty

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

#45534

Lars Brinkhoff wrote:

> > I wanted to combine the YC and RC threads, so I added this:
> > https://rosettacode.org/wiki/Y_combinator#Forth
> > 
> > I opted for these stack effects:
> > \ y ( xt1 -- xt2 )
> > \ xt2: execute xt1 with ( xi xt2 -- xj )
> 
> For convenience, here's the code:
> 
>   \ Address of an xt.
>   variable 'xt
>   \ Make room for an xt.
>   : xt, ( -- ) here 'xt !  1 cells allot ;
>   \ Store xt.
>   : !xt ( xt -- ) 'xt @ ! ;
>   \ Compile fetching the xt.
>   : @xt, ( -- ) 'xt @ postpone literal postpone @ ;
>   \ Compile the Y combinator.
>   : y, ( xt1 -- xt2 ) >r :noname @xt, r> compile, postpone ; ;
>   \ Make a new instance of the Y combinator.
>   : y ( xt1 -- xt2 ) xt, y, dup !xt ;
> 
> Sample usage:
> 
>   \ Factorial
>   10 :noname ( u1 xt -- u2 )
>      over ?dup if 1- swap execute * else 2drop 1 then ;
>   y execute . 3628800 ok

Ruby:

(1..10).reduce &:*
    ==>3628800


>    
>   \ Fibonacci
>   10 :noname ( u1 xt -- u2 )
>      over 2 < if drop else >r 1- dup r@ execute swap 1- r> execute + then ;
>   y execute . 55 ok

a,b=0,1; 20.times{print b," "; a,b=b,a+b}
 ===>
1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 6765

-- 
Amazon bans book.  After nearly a month on the site, all traces of the book and
its 80 reviews have been removed.
http://jamesfetzer.blogspot.com/2015/11/debunking-sandy-hook-debunkers-5.html
https://www.youtube.com/watch?v=EEl_1HWFRfo

[toc] | [prev] | [standalone]

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

csiph-web