add Matrix example
FossilOrigin-Name: dbd9a4588a272ee38d70897ca36ad3698ef6e63df28af91e17e4b76f4211b9f5
This commit is contained in:
parent
f0d8099acc
commit
d72865f022
1 changed files with 35 additions and 0 deletions
35
example/Matrix.forth
Normal file
35
example/Matrix.forth
Normal file
|
@ -0,0 +1,35 @@
|
|||
#!/usr/bin/env retro -i -s
|
||||
|
||||
By WilhelmVonWeiner: Matrices that store their bounds and a
|
||||
couple rushedly written tests.
|
||||
|
||||
~~~
|
||||
{{
|
||||
:prepare (nms--knms) push dup-pair * rot rot pop ;
|
||||
:create (nms--) d:create dup-pair * #2 + allot ;
|
||||
:initialise (nm--) d:last<xt> store-next store-next ;
|
||||
:fill (na--a) [ store-next ] times ;
|
||||
---reveal---
|
||||
:matrix (nms--a) create initialise ;
|
||||
:matrix<xs> (x1xn...nms--a) prepare matrix swap fill drop ;
|
||||
}}
|
||||
~~~
|
||||
|
||||
Test matrix, should print "matrix works!" and not "broken!".
|
||||
|
||||
```
|
||||
:get-next n:dec dup fetch ;
|
||||
:broken 'broken s:put nl ;
|
||||
#3 #1 'tester matrix
|
||||
get-next #3 -eq? [ broken ] if
|
||||
get-next #1 -eq? [ broken ] if
|
||||
'matrix_works!_at_ s:put n:put nl
|
||||
```
|
||||
|
||||
Test matrix<xs>, should be "contained!" thrice.
|
||||
|
||||
```
|
||||
#30 #20 #10 #3 #1 'tester s:keep matrix<xs>
|
||||
[ tester #2 + #3 [ fetch-next swap ] times drop ] set:from-results
|
||||
[ { #10 #20 #30 } set:contains? [ 'contained! s:put sp nl ] if ] set:for-each
|
||||
```
|
Loading…
Reference in a new issue