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

Groups > comp.lang.forth > #45434

Re: YC on Rosetta Code

Show all headers | View raw

> 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

Back to comp.lang.forth | Previous | Next — Previous in thread | Next in thread | Find similar | Unroll thread

Thread

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

csiph-web