Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]
Groups > comp.lang.forth > #34846
| 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> |
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
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