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


Groups > comp.lang.forth > #28425

Jensen's device (was: Rosetta Code: ...)

From anton@mips.complang.tuwien.ac.at (Anton Ertl)
Newsgroups comp.lang.forth
Subject Jensen's device (was: Rosetta Code: ...)
Date 2014-02-14 11:48 +0000
Organization Institut fuer Computersprachen, Technische Universitaet Wien
Message-ID <2014Feb14.124846@mips.complang.tuwien.ac.at> (permalink)
References <77e31dd1-7692-4ef6-83b7-8f2fe3cb7957@googlegroups.com> <op.xa7pvk0u5zc71u@localhost> <52fd0ac4$0$2922$e4fe514c@news2.news.xs4all.nl> <30dc37b6-5be5-4c68-a7c5-1aa3b1e67cfd@googlegroups.com> <52fde87f$0$2872$e4fe514c@news2.news.xs4all.nl>

Show all headers | View raw


Hans Bezemer <the.beez.speaks@gmail.com> writes:
>Take a look at http://rosettacode.org/wiki/Jensen%27s_Device#Forth
>
>I did it in two lines.

These lines are:

: sum 0 s>f 1+ swap ?do i over execute f+ loop drop ;
:noname s>f 1 s>f fswap f/ ; 1 100 sum f.

Whereas the core of the original is:

print (sum (i, 1, 100, 1/i))

where the parameters are passed by name.

However, you pass i to the :noname definition on the stack, not by
name.  The following passes both i and 1/i as an xt:

fvariable ii \ I is a Forth word that we need
: sum ( xt1 lo hi xt2 -- r )
  0e swap 1+ rot ?do ( addr xt r1 )
    i s>f over execute f! dup execute f+
  loop 2drop ;
' ii 1 100 :noname 1e ii f@ f/ ; sum f.

I have added it to the Rosettacode page.

- 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 2013: http://www.euroforth.org/ef13/

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


Thread

Rosetta Code: Top rank per group Julian Fondren <julian.fondren@gmail.com> - 2014-02-12 17:37 -0800
  Re: Rosetta Code: Top rank per group "Rod Pemberton" <dont_use_email@xnohavenotit.cnm> - 2014-02-13 03:58 -0500
    Re: Rosetta Code: Top rank per group Hans Bezemer <the.beez.speaks@gmail.com> - 2014-02-13 19:11 +0100
      Re: Rosetta Code: Top rank per group Julian Fondren <julian.fondren@gmail.com> - 2014-02-13 12:08 -0800
        Re: Rosetta Code: Top rank per group Hans Bezemer <the.beez.speaks@gmail.com> - 2014-02-14 10:57 +0100
          Re: Rosetta Code: Top rank per group Paul Rubin <no.email@nospam.invalid> - 2014-02-14 02:50 -0800
          Jensen's device (was: Rosetta Code: ...) anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2014-02-14 11:48 +0000
            Re: Jensen's device (was: Rosetta Code: ...) Hans Bezemer <the.beez.speaks@gmail.com> - 2014-02-14 16:46 +0100
              Re: Jensen's device (was: Rosetta Code: ...) "Rod Pemberton" <dont_use_email@xnohavenotit.cnm> - 2014-02-14 11:30 -0500
                Re: Jensen's device (was: Rosetta Code: ...) Hans Bezemer <the.beez.speaks@gmail.com> - 2014-02-14 23:35 +0100
              Re: Jensen's device (was: Rosetta Code: ...) anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2014-02-15 13:36 +0000
            Re: Jensen's device (was: Rosetta Code: ...) albert@spenarnc.xs4all.nl (Albert van der Horst) - 2014-02-14 19:12 +0000
            Re: Jensen's device (was: Rosetta Code: ...) mhx@iae.nl - 2014-02-14 12:13 -0800
              Re: Jensen's device (was: Rosetta Code: ...) Hans Bezemer <the.beez.speaks@gmail.com> - 2014-02-14 23:47 +0100
              Re: Jensen's device (was: Rosetta Code: ...) mhx@iae.nl - 2014-02-14 23:45 -0800
                Re: Jensen's device (was: Rosetta Code: ...) mhx@iae.nl - 2014-02-15 02:49 -0800
                Re: Jensen's device (was: Rosetta Code: ...) albert@spenarnc.xs4all.nl (Albert van der Horst) - 2014-02-15 11:54 +0000
      Re: Rosetta Code: Top rank per group Hans Bezemer <the.beez.speaks@gmail.com> - 2014-02-13 23:20 +0100
  Re: Rosetta Code: Top rank per group Andrew Haley <andrew29@littlepinkcloud.invalid> - 2014-02-13 04:11 -0600
  Re: Rosetta Code: Top rank per group humptydumpty <ouatubi@gmail.com> - 2014-02-13 10:48 -0800
    Re: Rosetta Code: Top rank per group humptydumpty <ouatubi@gmail.com> - 2014-02-13 20:23 -0800

csiph-web