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

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

How to solve this problem in FORTH?

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

Contents

  How to solve this problem in FORTH? Marek Brunda <marekb@phoenics.org> - 2015-01-13 04:24 -0800
    How to solve this problem in FORTH? Julian Fondren <julian.fondren@gmail.com> - 2015-01-13 05:02 -0800
      How to solve this problem in FORTH? Julian Fondren <julian.fondren@gmail.com> - 2015-01-13 05:09 -0800
    Re: How to solve this problem in FORTH? november.nihal@gmail.com - 2015-01-13 05:29 -0800
      Re: How to solve this problem in FORTH? "WJ" <w_a_x_man@yahoo.com> - 2015-01-14 14:00 +0000
        Re: How to solve this problem in FORTH? november.nihal@gmail.com - 2015-01-14 06:59 -0800
          Re: How to solve this problem in FORTH? awegel@arcor.de (Alexander Wegel) - 2015-01-14 23:39 +0100
    Re: How to solve this problem in FORTH? Coos Haak <chforth@hccnet.nl> - 2015-01-13 15:12 +0100
    Re: How to solve this problem in FORTH? humptydumpty <ouatubi@gmail.com> - 2015-01-13 10:30 -0800
    Re: How to solve this problem in FORTH? mhx@iae.nl - 2015-01-13 12:14 -0800
      Re: How to solve this problem in FORTH? "WJ" <w_a_x_man@yahoo.com> - 2015-01-14 09:06 +0000
        Re: How to solve this problem in FORTH? mhx@iae.nl - 2015-01-14 04:13 -0800
        Re: How to solve this problem in FORTH? Julian Fondren <julian.fondren@gmail.com> - 2015-01-14 04:55 -0800
        Re: How to solve this problem in FORTH? "WJ" <w_a_x_man@yahoo.com> - 2015-03-27 06:47 +0000
    Re: How to solve this problem in FORTH? jrcd83@gmail.com - 2015-03-28 08:09 -0700
      Re: How to solve this problem in FORTH? "Alex McDonald" <blog@rivadpm.com> - 2015-03-28 20:53 +0000
    Re: How to solve this problem in FORTH? rickman <gnuarm@gmail.com> - 2015-03-28 20:32 -0400
    Re: How to solve this problem in FORTH? hughaguilar96@gmail.com - 2015-03-28 21:16 -0700
      Re: How to solve this problem in FORTH? hughaguilar96@gmail.com - 2015-03-29 12:16 -0700

#35776 — How to solve this problem in FORTH?

How to solve this problem in FORTH? What do you thing about this post? http://prog21.dadgum.com/33.html

My hurriedly solution is this:

void vadd(int *v1, int *v2, int *v3)
{
       v3[0] = v1[0] + v2[0];
       v3[1] = v1[1] + v2[1];
       v3[2] = v1[2] + v2[2];
}


: ADD ( A1 A2 A3 U -- A1 A2 A3 )
    CELLS SWAP >R >R
    2DUP R@ + @ 
    SWAP R@ + @ +
    R> R@ + ! R> ;    
    
: VADD ( A1 A2 A3 -- )
    0 ADD 1 ADD 2 ADD 2DROP DROP ;

[toc] | [next] | [standalone]

#35777

On Tuesday, January 13, 2015 at 6:24:02 AM UTC-6, Marek Brunda wrote:
> How to solve this problem in FORTH? What do you thing about this post? http://prog21.dadgum.com/33.html

I'm not impressed by the author's grasp of Forth.

  : ]v ( v n -- a )  [ ' ] compile, ] dup if cells postpone literal postpone + else drop then ;
  : vnew ( n -- v )  cells allocate throw ;
  : v! ( v1 v2 -- )  3 cells move ;

  \ C version
  : vadd { v1 v2 vout -- }
    v1 [ 0 ]v @  v1 [ 0 ]v @  + vout [ 0 ]v !
    v1 [ 1 ]v @  v2 [ 1 ]v @  + vout [ 1 ]v !
    v1 [ 2 ]v @  v2 [ 2 ]v @  + vout [ 2 ]v ! ;

  : ccount ( a -- a' x )  dup cell+ swap @ ;
  : v+ ( v1 v2 -- )
    3 cells bounds do
      ccount i +!
    cell +loop drop ;

  \ Erlang version
  : vadd2 ( v1 v2 -- v3 )
    3 vnew dup >r v! r@ v+ r> ;

  : v: ( "name" "x0" "x1" ... "xn" )
    create begin parse-word dup while evaluate , repeat 2drop ;

  : .v ( v n -- )
    ." (" tuck cells bounds ?do
      1- i @ over if . else 0 .r then
    cell +loop drop ." ) " ;

  v: a 1 2 3
  v: b 1 2 3
  v: c 0 0 0

  a b c vadd   c 3 .v  \ output: (2 4 6)
  a b   vadd2    3 .v  \ output: (2 4 6)


-- Julian

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

#35778

Well, there's a typo in vadd that was missed due to my
simple test data, and v! breaks the pattern of explicit
lengths.

I should also add, for the sake of style, that CCOUNT
(the name of the word) will put some people's teeth on
edge.

I didn't spend a lot of time on this.

-- Julian

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

#35779

variable v1{
variable v2{
variable v3{

: } cells swap @ + ;

: vadd ( v3 v2 v1 -- )
	rot >r
	over 0 } @ over 0 } @ + r@ 0 } !
	over 1 } @ over 1 } @ + r@ 1 } !
	     2 } @ swap 2 } @ + r> 2 } !
	;

: nn 1000 random ; immediate

( load values )
here v1{ ! nn , nn , nn ,
here v2{ ! nn , nn , nn ,
here v3{ ! 0 , 0 , 0 , ( answer zeroed )

( try it ) v3{ v2{ v1{ vadd

cr .( v1     == ) v1{ 0 } @ . v1{ 1 } @ . v1{ 2 } @ .
cr .( v2     == ) v2{ 0 } @ . v2{ 1 } @ . v2{ 2 } @ .
cr .( Result == ) v3{ 0 } @ . v3{ 1 } @ . v3{ 2 } @ .

NN

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

#35812

november.nihal@gmail.com wrote:


> variable v1{
> variable v2{
> variable v3{
> 
> : } cells swap @ + ;
> 
> : vadd ( v3 v2 v1 -- )
> 	rot >r
> 	over 0 } @ over 0 } @ + r@ 0 } !
> 	over 1 } @ over 1 } @ + r@ 1 } !
> 	     2 } @ swap 2 } @ + r> 2 } !
> 	;

Indecipherable stack-juggling.

Haven't you ever heard of local variables?

And your function only handles vectors of length 3.

> 
> : nn 1000 random ; immediate
> 
> ( load values )
> here v1{ ! nn , nn , nn ,
> here v2{ ! nn , nn , nn ,
> here v3{ ! 0 , 0 , 0 , ( answer zeroed )
> 
> ( try it ) v3{ v2{ v1{ vadd
> 
> cr .( v1     == ) v1{ 0 } @ . v1{ 1 } @ . v1{ 2 } @ .
> cr .( v2     == ) v2{ 0 } @ . v2{ 1 } @ . v2{ 2 } @ .
> cr .( Result == ) v3{ 0 } @ . v3{ 1 } @ . v3{ 2 } @ .



: vec{
  here { head }  0 ,
  begin
    bl word  dup count s" }vec" compare
  while
    count evaluate ,  1 head +!
  repeat
  drop  head ;

: } 1+ cells + ;

: vec-print { v{ -- }
  v{ @ 0 do  v{ i } @ .  loop ;


: vec-add { v3{ v2{ v1{ -- }
  v1{ @ 0 do 
    v2{ i } @  v1{ i } @  +  v3{ i } !
  loop ;

vec{ 10 20 30 40 }vec     constant v1{
vec{ 100 200 300 400 }vec constant v2{
vec{ 0 0 0 0 }vec         constant v3{


v3{ v2{ v1{  vec-add

cr .( v1     == ) v1{ vec-print
cr .( v2     == ) v2{ vec-print
cr .( Result == ) v3{ vec-print

Output:

v1     == 10 20 30 40  ok
v2     == 100 200 300 400  ok
Result == 110 220 330 440  ok

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

#35814

Stack juggling is a consequence of using a stack language. 

There was no requirement to use locals.

The example presented used vectors of length 3.

And your point is ? 

NN

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

#35817

<november.nihal@gmail.com> wrote:

> And your point is ? 

It's not a point, it's an orifice.

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

#35781

Op Tue, 13 Jan 2015 04:24:01 -0800 (PST) schreef Marek Brunda:

> How to solve this problem in FORTH? What do you thing about this post? http://prog21.dadgum.com/33.html
> 
> My hurriedly solution is this:
> 
> void vadd(int *v1, int *v2, int *v3)
> {
>        v3[0] = v1[0] + v2[0];
>        v3[1] = v1[1] + v2[1];
>        v3[2] = v1[2] + v2[2];
> }
> 
> 
>: ADD ( A1 A2 A3 U -- A1 A2 A3 )
>     CELLS SWAP >R >R
>     2DUP R@ + @ 
>     SWAP R@ + @ +
>     R> R@ + ! R> ;    
>     
>: VADD ( A1 A2 A3 -- )
>     0 ADD 1 ADD 2 ADD 2DROP DROP ;

0
field: .x
field: .y
field: .z
constant /vector

: vadd      ( a1 a2 a3 -- )
        >r
        over .x @ over .x @ + r@ .x !
        over .y @ over .y @ + r@ .y !
        over .z @ over .z @ + r> .z !
        2drop
    ;

-- 
Coos

CHForth, 16 bit DOS applications
http://home.hccnet.nl/j.j.haak/forth.html 

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

#35791

marți, 13 ianuarie 2015, 14:24:02 UTC+2, Marek Brunda a scris:
> How to solve this problem in FORTH? What do you thing about this post? http://prog21.dadgum.com/33.html
> 
> My hurriedly solution is this:
> 
> void vadd(int *v1, int *v2, int *v3)
> {
>        v3[0] = v1[0] + v2[0];
>        v3[1] = v1[1] + v2[1];
>        v3[2] = v1[2] + v2[2];
> }
> 
> 
> : ADD ( A1 A2 A3 U -- A1 A2 A3 )
>     CELLS SWAP >R >R
>     2DUP R@ + @ 
>     SWAP R@ + @ +
>     R> R@ + ! R> ;    
>     
> : VADD ( A1 A2 A3 -- )
>     0 ADD 1 ADD 2 ADD 2DROP DROP ;

Hi!

I'll post here what I posted on reddit ont his subject
http://www.reddit.com/user/humptydumptyII

"I wouldn't use 'v+'. I would use instead an extension of '+!'.

3 cells value /VECTOR \ bytes per VECTOR

: v+! ( vsource vdest -- ; extension of '+!' , add VSOURCE to VDESTINATION )

    over - swap /VECTOR bounds 
    DO
              I @ over I + +!
    [ 1 cells ] LITERAL +LOOP drop ;

If and only if is needed

: v+ ( v1 v2 vsum -- ; add VECTOR1 with VECTOR2 into VECTOR-SUM )

    tuck /VECTOR move
    v+! ;
"

Have a nice day,
humptydumpty

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

#35792

Marek Brunda <marekb@phoenics.org> writes 
> How to solve this problem in FORTH? What do you thing about this post? http://prog21.dadgum.com/33.html

> My hurriedly solution is this:

[..]

> : ADD ( A1 A2 A3 U -- A1 A2 A3 )
>    CELLS SWAP >R >R
>    2DUP R@ + @ 
>    SWAP R@ + @ +
>    R> R@ + ! R> ;    
    
> : VADD ( A1 A2 A3 -- )
>   0 ADD 1 ADD 2 ADD 2DROP DROP ;

Not on every Forth of course, but I would try this:

FORTH> : vadd  params| a b c |
  a          @  b          @  +  c          !
  a    cell+ @  b   cell+  @  +  c    cell+ !
  a 2 cell[] @  b 2 cell[] @  +  c 2 cell[] ! ;  ok

FORTH> ' vadd idis
$01223340  : vadd
$0122334A  pop           rbx
$0122334B  pop           rdi
$0122334C  pop           rax
$0122334D  mov           rdx, [rax] qword
$01223350  add           rdx, [rdi] qword
$01223353  mov           [rbx] qword, rdx
$01223356  mov           rdx, [rax 8 +] qword
$0122335A  add           rdx, [rdi 8 +] qword
$0122335E  mov           [rbx 8 +] qword, rdx
$01223362  mov           rdx, [rax #16 +] qword
$01223366  add           rdx, [rdi #16 +] qword
$0122336A  mov           [rbx #16 +] qword, rdx
$0122336E  ;

Let's see what your hurrying has resulted in:

: ADD ( A1 A2 A3 U -- A1 A2 A3 )
     CELLS SWAP >R >R
     2DUP R@ + @
     SWAP R@ + @ +
     R> R@ + ! R> ;      ok

: VADD ( A1 A2 A3 -- )
     0 ADD 1 ADD 2 ADD 2DROP DROP ;  ok

FORTH> ' vadd idis
$012234C0  : VADD
$012234CA  pop           rbx
$012234CB  pop           rdi
$012234CC  pop           rax
$012234CD  mov           rdx, [rdi] qword
$012234D0  add           rdx, [rax] qword
$012234D3  mov           [rbx] qword, rdx
$012234D6  mov           rdx, [rdi 8 +] qword
$012234DA  add           rdx, [rax 8 +] qword
$012234DE  mov           [rbx 8 +] qword, rdx
$012234E2  mov           rdx, [rdi #16 +] qword
$012234E6  add           rdx, [rax #16 +] qword
$012234EA  mov           [rbx #16 +] qword, rdx
$012234EE  ;

Same functionality == same code.

-marcel

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

#35806

mhx@iae.nl wrote:

> Marek Brunda <marekb@phoenics.org> writes 
> > How to solve this problem in FORTH? What do you thing about this post? http://prog21.dadgum.com/33.html
> 
> > My hurriedly solution is this:
> 
> [..]
> 
> > : ADD ( A1 A2 A3 U -- A1 A2 A3 )
> >    CELLS SWAP >R >R
> >    2DUP R@ + @ 
> >    SWAP R@ + @ +
> >    R> R@ + ! R> ;    
>     
> > : VADD ( A1 A2 A3 -- )
> >   0 ADD 1 ADD 2 ADD 2DROP DROP ;
> 
> Not on every Forth of course, but I would try this:
> 
> FORTH> : vadd  params| a b c |
>   a          @  b          @  +  c          !
>   a    cell+ @  b   cell+  @  +  c    cell+ !
>   a 2 cell[] @  b 2 cell[] @  +  c 2 cell[] ! ;  ok
> 

That awkward, inelegant, tedious to write, tedious to read
"solution" only works for vectors of length 3.

Gauche Scheme:

Creates a new vector:

(define (v-add v1 v2)
  (vector-map + v1 v2))


Changes an existing vector:

(define (v-add! v1 v2 v3)
  (vector-map!
    (lambda (_ val1 val2) (+ val1 val2))
    v3 v1 v2))


Testing:

(define v1 #(10 20 30 40 50 60 70 80 90))
(define v2 #(100 200 300 400 500 600 700 800 900))
(define v3 #(0 0 0 0 0 0 0 0 0))

(v-add v1 v2)
 ===>
#(110 220 330 440 550 660 770 880 990)


(v-add! v1 v2 v3)
v3
 ===>
#(110 220 330 440 550 660 770 880 990)


Let's write a version that will add up any number
of vectors:

(define (v-add* . vectors)
  (apply vector-map + vectors))

(v-add* v1 v2)
 ===>
#(110 220 330 440 550 660 770 880 990)

(v-add* v1 v2 v3)
 ===>
#(220 440 660 880 1100 1320 1540 1760 1980)



Let's write a version that will add up any number
of vectors and store the result in a vector:

(define (v-add*! result . vecs)
  (apply vector-map!
    (lambda args (apply + (cdr args)))
    result vecs))

Testing:

(define v4 #(0 0 0 0 0 0 0 0 0))

(v-add*! v4  v1 v2 v3)
v4
 ===>
#(220 440 660 880 1100 1320 1540 1760 1980)



Too easy?  Let's do it in EMACS Lisp.

(defun v-add! (result &rest vecs)
  (dotimes (i (length (car vecs)))
    (aset result i
      (apply '+ (mapcar (lambda (v) (aref v i)) vecs)))))

Testing:

(setq v1 [10 20 30 40 50 60 70 80 90])
(setq v2 [100 200 300 400 500 600 700 800 900])
(setq v3 [1000 2000 3000 4000 5000 6000 7000 8000 9000])
(setq v4 (make-vector 20 0))

(v-add! v4  v1 v2 v3)
v4
 ===>
[1110 2220 3330 4440 5550 6660 7770 8880 9990 0 0 0 0 0 0 0 0 0 0 0]

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

#35809

On Wednesday, January 14, 2015 at 10:06:55 AM UTC+1, WJ wrote:
> mhx@iae.nl wrote:
[..]
> That awkward, inelegant, tedious to write, tedious to read
> "solution" only works for vectors of length 3.
[..]
For longer vectors I use the BLAS. 

-marcel

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

#35810

On Wednesday, January 14, 2015 at 3:06:55 AM UTC-6, WJ wrote:
> mhx@iae.nl wrote:
> > Not on every Forth of course, but I would try this:
> > 
> > FORTH> : vadd  params| a b c |
> >   a          @  b          @  +  c          !
> >   a    cell+ @  b   cell+  @  +  c    cell+ !
> >   a 2 cell[] @  b 2 cell[] @  +  c 2 cell[] ! ;  ok
> > 
> 
> That awkward, inelegant, tedious to write, tedious to read
> "solution" only works for vectors of length 3.

It's none of those things.  Also, RTFA.  This is what we're
writing in Forth:

  void vadd(int *v1, int *v2, int *v3) {
    v3[0] = v1[0] + v2[0];
    v3[1] = v1[1] + v2[1];
    v3[2] = v1[2] + v2[2];
  }

For vectors of other lengths, there's an extremely obvious
opportunity for a loop: we have the same command with an offset
of 0 cells, 1 cells, 2 cells...

> Gauche Scheme:

Nobody cares.  Do you even care?  If someone else posted code
like this into CLF, would you read it with interest?


-- Julian

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

#37688

WJ wrote:

> mhx@iae.nl wrote:
> 
> > Marek Brunda <marekb@phoenics.org> writes 
> > > How to solve this problem in FORTH? What do you thing about this post? http://prog21.dadgum.com/33.html
> > 
> > > My hurriedly solution is this:
> > 
> > [..]
> > 
> > > : ADD ( A1 A2 A3 U -- A1 A2 A3 )
> > >    CELLS SWAP >R >R
> > >    2DUP R@ + @ 
> > >    SWAP R@ + @ +
> > >    R> R@ + ! R> ;    
> >     
> > > : VADD ( A1 A2 A3 -- )
> > >   0 ADD 1 ADD 2 ADD 2DROP DROP ;
> > 
> > Not on every Forth of course, but I would try this:
> > 
> > FORTH> : vadd  params| a b c |
> >   a          @  b          @  +  c          !
> >   a    cell+ @  b   cell+  @  +  c    cell+ !
> >   a 2 cell[] @  b 2 cell[] @  +  c 2 cell[] ! ;  ok
> > 
> 
> That awkward, inelegant, tedious to write, tedious to read
> "solution" only works for vectors of length 3.
> 
> Gauche Scheme:
> 
> Creates a new vector:
> 
> (define (v-add v1 v2)
>   (vector-map + v1 v2))
> 
> 
> Changes an existing vector:
> 
> (define (v-add! v1 v2 v3)
>   (vector-map!
>     (lambda (_ val1 val2) (+ val1 val2))
>     v3 v1 v2))
> 
> 
> Testing:
> 
> (define v1 #(10 20 30 40 50 60 70 80 90))
> (define v2 #(100 200 300 400 500 600 700 800 900))
> (define v3 #(0 0 0 0 0 0 0 0 0))
> 
> (v-add v1 v2)
>  ===>
> #(110 220 330 440 550 660 770 880 990)

Oforth:

[10, 20, 30, 40, 50, 60, 70, 80, 90]
[100, 200, 300, 400, 500, 600, 700, 800, 900]
zipWith( #+ )  println

 ===>
[110, 220, 330, 440, 550, 660, 770, 880, 990]

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

#37708

I wasn't sure what the fuss was. Then I spent an hour on this? Hypocrit.
Here's a naieve, simple stab, from a beginner:

CREATE V1 1 , 2 , 3 ,
CREATE V2 4 , 5 , 6 ,
CREATE V3 0 , 0 , 0 ,

: VSUM ( addr1 addr2 i -- x ) CELLS TUCK + ROT ROT + @ SWAP @ + CR ;
: VSTORE ( x adest i -- ) CELLS + ! ;
: VADD ( asrc1 asrc2 adest -- )
  3 0 DO
    ROT ROT 2DUP I VSUM
    2SWAP ROT ROT TUCK I VSTORE ( asrc1 and asrc2 switch places )
  LOOP
  2DROP DROP ;
: VADD-HERE ( asrc1 asrc2 adest -- )
\ HERE happens so simply, hubris howls in fury.
  HERE !
  3 0 DO
    2DUP I VSUM
    HERE @ I VSTORE
  LOOP
  2DROP ;

V1 V2 V3 VADD
V3 3 CELLS DUMP
V3 3 CELLS 0 FILL
V1 V2 V3 VADD-HERE
V3 3 CELLS DUMP

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

#37715

on 28/03/2015 15:09:30,  wrote:
> I wasn't sure what the fuss was. Then I spent an hour on this?
> Hypocrit. Here's a naieve, simple stab, from a beginner:

Good that you're trying.

> 
> CREATE V1 1 , 2 , 3 ,
> CREATE V2 4 , 5 , 6 ,
> CREATE V3 0 , 0 , 0 ,
> 
>: VSUM ( addr1 addr2 i -- x ) CELLS TUCK + ROT ROT + @ SWAP @ + CR ;
>: VSTORE ( x adest i -- ) CELLS + ! ;
>: VADD ( asrc1 asrc2 adest -- )
> 3 0 DO
> ROT ROT 2DUP I VSUM
> 2SWAP ROT ROT TUCK I VSTORE ( asrc1 and asrc2 switch places )
> LOOP
> 2DROP DROP ;

But help! what does all this stack juggling do? Comments might help...

>: VADD-HERE ( asrc1 asrc2 adest -- )
> \ HERE happens so simply, hubris howls in fury.

A comment. O dear.

One of the most frustrating jobs I ever had was as a maintenance
programmer. You got to rewrite someone else's code, often badly written
and buggy code. I didn't enjoy it, although it taught me a lot.

One particular set of applications I still remember with irritation, even
now. In tens of thousands of lines of code, there was not a single
sensible comment. Not one. Sections were preceded by chunks of the
Rubaiyat of Omar Khayyam. Individual lines were decorated with comments
much like the one you quote above.

I would encourage you, as an artisan programmer, to consider this. It's
from a parody of the Rubaiyat that I've lightly modified:

: VSUM-STUFF ( addr1 addr2 i -- x ) 
\ Therefore, O Comment, because to all Code's plans
\ And projects some promotion thou impartest,
\ Thou still hast many zealous artisans,
\ Tho' not one artist.
 ...

Like the code you wrote, that's probably quite challenging to understand
and it may require reading a few times. Unlike "HERE happens so simply,
hubris howls in fury", which is still a complete mystery to me.

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

#37721

On 1/13/2015 7:24 AM, Marek Brunda wrote:
> How to solve this problem in FORTH? What do you thing about this post? http://prog21.dadgum.com/33.html
>
> My hurriedly solution is this:
>
> void vadd(int *v1, int *v2, int *v3)
> {
>         v3[0] = v1[0] + v2[0];
>         v3[1] = v1[1] + v2[1];
>         v3[2] = v1[2] + v2[2];
> }
>
>
> : ADD ( A1 A2 A3 U -- A1 A2 A3 )
>      CELLS SWAP >R >R
>      2DUP R@ + @
>      SWAP R@ + @ +
>      R> R@ + ! R> ;
>
> : VADD ( A1 A2 A3 -- )
>      0 ADD 1 ADD 2 ADD 2DROP DROP ;

Rather than SWAP >R >R can't you just use 2>R?  Would it be good to 
combine + @ into one word maybe?  I guess that might be confused with an 
auto-increment sort of thing?

Here is what I came up with...

CREATE V1 1 , 2 , 3 , 4 ,
CREATE V2 5 , 6 , 7 , 8 ,
CREATE V3 0 , 0 , 0 , 0 ,

\ Add one cell of a pair of vectors
: V+Row ( va vb vc -- va+ vb+ vc+ )
   ROT DUP @ >R CELL+
   ROT DUP @ >R CELL+
   ROT 2R> + OVER ! CELL+
   ;

\ add vectors a and b, save in vector c, vector length n
: VADD ( va vb vc n -- )
   0 DO V+Row LOOP 3DROP
   ;

: TryIt ( n -- )
   ." Vector Sum  "
   >R V1 V2 V3 R@ VADD
   V3 R> 0 DO
     DUP @ . CELL+ LOOP DROP CR
   ;

CR 2 TryIt CR 3 TryIt CR 4 TryIt


FLOAD 'VecAdd.f'
Vector Sum  6 8

Vector Sum  6 8 10

Vector Sum  6 8 10 12
  ok

I'm not a big fan of stack juggling.  I would like to find primitives 
that avoid all that.  But that would be at the machine level and 
transparent to the programmer.  I believe that is what the optimizations 
on various compilers do.

-- 

Rick

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

#37723

On Tuesday, January 13, 2015 at 5:24:02 AM UTC-7, Marek Brunda wrote:
> How to solve this problem in FORTH? What do you thing about this post? http://prog21.dadgum.com/33.html
> 
> My hurriedly solution is this:
> 
> void vadd(int *v1, int *v2, int *v3)
> {
>        v3[0] = v1[0] + v2[0];
>        v3[1] = v1[1] + v2[1];
>        v3[2] = v1[2] + v2[2];
> }
> 
> 
> : ADD ( A1 A2 A3 U -- A1 A2 A3 )
>     CELLS SWAP >R >R
>     2DUP R@ + @ 
>     SWAP R@ + @ +
>     R> R@ + ! R> ;    
>     
> : VADD ( A1 A2 A3 -- )
>     0 ADD 1 ADD 2 ADD 2DROP DROP ;

Well, the C program uses one-dimensional arrays. So, there are two possible responses:
1.) "Elizabeth Rather demands that I never use general-purpose data-structures, so I'm going to implement my arrays manually, so my program will be 'exactly what is required' --- and if this is a unreadable mess, then so be it!"
2.) "Hugh's novice package provides many general-purpose data-structures, so I will use 1ARRAY for my one-dimensional arrays."

The guy who wrote the article (http://prog21.dadgum.com/33.html) went with #1 above. According to him: "Understanding What It's Like to Program in Forth," is that Forth is puzzle-solving, similar to Sudoku (and about as profitable). The implication is that Forth will never be used for commercial applications, because it is a toy language. Nobody makes money solving Sudoku puzzles, and nobody makes money writing Forth code --- it is just a silly pastime for bored people with nothing to do (mostly retirees, as the rest of us have jobs to fill up our days).

This has been a lengthy thread, that has tapped the best minds of comp.lang.forth (lol), and so far everybody has gone with #1 above. This is because ANS-Forth is a cult --- everybody feels obliged to restrict themselves as Elizabeth Rather requires --- if anybody were to go with #2, everybody would howl: "That is cheating! ANS-Forth didn't provide 1ARRAY, so you can't use it!"

Well, here is the #2 solution (I'm expecting all of Elizabeth Rather's cult members to say: "#2 is crap!" --- yuck! yuck! yuck!). Note that I removed all the comments so the lines wouldn't wrap. If anybody can't figure it out and needs the version with comments, I can email a file to you.


3 w 1array v1
3 w 1array v2
3 w 1array v3

: show-v3 ( -- )
    cr  0 v3 @ .  1 v3 @ .  2 v3 @ . ;

: vaddg ( -- )                                  
    0 v1 @  0 v2 @  +  0 v3 !
    1 v1 @  1 v2 @  +  1 v3 !
    2 v1 @  2 v2 @  +  2 v3 ! ;

: vadd { 'v3 'v2 'v1 -- }                       
    0 'v1 execute @  0 'v2 execute @  +  0 'v3 execute !
    1 'v1 execute @  1 'v2 execute @  +  1 'v3 execute !
    2 'v1 execute @  2 'v2 execute @  +  2 'v3 execute ! ;

: v+ ( 0 'arrays... -- )                        
    non-zeros { cnt | acc -- }                  
    cnt 0 do  0 to acc  dup-stack               
        cnt 1 do  J swap execute @ +to acc  loop
        acc  I  rot execute !    
        drop  loop
    cnt 0 do  drop  loop  drop ; 
    
cr .( show VADDG VADD and V+ )

100 0 v1 !  110 1 v1 !  120 2 v1 !
200 0 v2 !  210 1 v2 !  220 2 v2 !

vaddg                   show-v3

' v3 ' v2 ' v1 vadd     show-v3

0 ' v3 ' v2 ' v1 v+     show-v3


Here is the output:

show VADDG VADD and V+ 
300 320 340 
300 320 340 
300 320 340 

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

#37733

On Saturday, March 28, 2015 at 9:16:06 PM UTC-7, hughag...@gmail.com wrote:
> 3 w 1array v1
> 3 w 1array v2
> 3 w 1array v3
> 
> : show-v3 ( -- )
>     cr  0 v3 @ .  1 v3 @ .  2 v3 @ . ;
> 
> : vaddg ( -- )                                  
>     0 v1 @  0 v2 @  +  0 v3 !
>     1 v1 @  1 v2 @  +  1 v3 !
>     2 v1 @  2 v2 @  +  2 v3 ! ;
> 
> : vadd { 'v3 'v2 'v1 -- }                       
>     0 'v1 execute @  0 'v2 execute @  +  0 'v3 execute !
>     1 'v1 execute @  1 'v2 execute @  +  1 'v3 execute !
>     2 'v1 execute @  2 'v2 execute @  +  2 'v3 execute ! ;
> 
> : v+ ( 0 'arrays... -- )                        
>     non-zeros { cnt | acc -- }                  
>     cnt 0 do  0 to acc  dup-stack               
>         cnt 1 do  J swap execute @ +to acc  loop
>         acc  I  rot execute !    
>         drop  loop
>     cnt 0 do  drop  loop  drop ; 
>     
> cr .( show VADDG VADD and V+ )
> 
> 100 0 v1 !  110 1 v1 !  120 2 v1 !
> 200 0 v2 !  210 1 v2 !  220 2 v2 !
> 
> vaddg                   show-v3
> 
> ' v3 ' v2 ' v1 vadd     show-v3
> 
> 0 ' v3 ' v2 ' v1 v+     show-v3
> 
> 
> Here is the output:
> 
> show VADDG VADD and V+ 
> 300 320 340 
> 300 320 340 
> 300 320 340

I'm going to release an upgrade to the novice-package pretty soon. In the meantime here is a minor upgrade:

: <dup-stack> ( 0 numbers... count -- 0 numbers... 0 numbers... )       
    dup 1+  0  do  >r  r@ pick  r>  loop drop ;
    
: dup-stack ( 0 numbers... -- 0 numbers... 0 numbers... ) 
    non-zeros  <dup-stack> ;

: <drop-stack> ( 0 numbers... count )   
    0 do  drop  loop
    drop ;
    
: drop-stack ( 0 numbers... )                             
    non-zeros  <drop-stack> ;
    

Given this upgrade, I can also upgrade the V+ code slightly:

char ~ comment      \ this is one way to define the arrays
w 0 3 ary v1
w 0 3 ary v2
w 0 3 ary v3
~

\ char ~ comment      \ this is another way to define the arrays
3 w 1array v1
3 w 1array v2
3 w 1array v3
\ ~

: show-v3 ( -- )
    cr  0 v3 @ .  1 v3 @ .  2 v3 @ . ;

: vaddg ( -- )                                   
    0 v1 @  0 v2 @  +  0 v3 !
    1 v1 @  1 v2 @  +  1 v3 !
    2 v1 @  2 v2 @  +  2 v3 ! ;

: vadd { 'v3 'v2 'v1 -- }                        
    0 'v1 execute @  0 'v2 execute @  +  0 'v3 execute !
    1 'v1 execute @  1 'v2 execute @  +  1 'v3 execute !
    2 'v1 execute @  2 'v2 execute @  +  2 'v3 execute ! ;

: v+ ( 0 'arrays... -- )                         
    non-zeros { cnt | acc -- }                   
    cnt 0 do  0 to acc  cnt <dup-stack>          
        cnt 1 do  J swap execute @ +to acc  loop 
        acc  I  rot execute ! 
        drop               
        loop
    cnt <drop-stack> ;     
    
cr .( show VADDG VADD and V+ )

100 0 v1 !  110 1 v1 !  120 2 v1 !
200 0 v2 !  210 1 v2 !  220 2 v2 !

vaddg                   show-v3

' v3 ' v2 ' v1 vadd     show-v3

0 ' v3 ' v2 ' v1 v+     show-v3


This is cleaner, because we have <DROP-STACK> now, rather than put this general-purpose code in the middle of the application code. Also, it is more efficient because <DUP-STACK> is used rather than DUP-STACK and so NON-ZEROS doesn't get called unnecessarily for every iteration.

Note that my program assumes that the length of the arrays is equal to the number of arrays. There was no problem specification, so I just made this up. It is trivial to upgrade the program to allow the length of the arrays to be something else, and this to be passed in as a parameter. 

The novice package has bounds-checking turned on as a default. If any of the arrays are too short, the program will abort with an enlightening error-message. Bounds-checking can be turned off like this:
FALSE TO BOUNDS-CHECK?
This speeds up the code and can be used after the program is debugged. Bounds-checking is only available with 1ARRAY etc. --- it is not available with ARY.

There is no checking done for the case in which any of the arrays are longer than expected. It is trivial to upgrade the program to do this. Whether this actually is an error or not, is debatable --- it doesn't affect the program operation, so it could be ignored. Debating this kind of issue is actually meaningless, because it is just a made-up programming problem --- correctness is only meaningful in the context of the program doing something useful.

[toc] | [prev] | [standalone]

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

csiph-web