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


Groups > comp.lang.forth > #34846

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

From "WJ" <w_a_x_man@yahoo.com>
Newsgroups comp.lang.forth
Subject Re: Jensen's device (was: Rosetta Code: ...)
Date 2014-12-09 00:05 +0000
Organization A noiseless patient Spider
Message-ID <m65ec8$lsv$1@dont-email.me> (permalink)
References (1 earlier) <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> <2014Feb14.124846@mips.complang.tuwien.ac.at>

Show all headers | View raw


Anton Ertl wrote:

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

Gauche Scheme:

(use gauche.parameter)

(let1 i (make-parameter 0.0)
  (define (sum  i lo hi term)
    (let1 tmp 0.0
      (i lo)
      (while (<= (i) hi)
        (inc! tmp (term))
        (i (+ 1 (i)))) 
      tmp))
  (sum i 1 100 (cut / (i))))

Another way:

(let1 i (make-parameter 0.0)
  (define (sum  i lo hi term)
    (let1 tmp 0.0
      (i lo)
      (parameter-observer-add! i (^(a b) (inc! tmp (term))) 'before)
      (while (<= (i) hi) (i (+ 1 (i)))) 
      tmp))
  (sum i 1 100 (cut / (i))))

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


Thread

Re: Jensen's device (was: Rosetta Code: ...) "WJ" <w_a_x_man@yahoo.com> - 2014-12-09 00:05 +0000
  Re: Jensen's device (was: Rosetta Code: ...) albert@spenarnc.xs4all.nl (Albert van der Horst) - 2014-12-10 15:25 +0000

csiph-web