retroforth/example/Matrix.retro
crc 6e7c73f93b work on 2020.10 is under way, begin updates to remove deprecated words
FossilOrigin-Name: 1a4cb2c13230dafba7a0e14e512fe3f97aeb4b3a7b28cac5db5ec404b2acd5a2
2020-08-09 03:27:42 +00:00

35 lines
907 B
Text

#!/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> (xn...x1nms-) 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 matrix<xs>
{ tester #2 + #3 [ fetch-next swap ] times drop }
[ { #10 #20 #30 } a:contains? [ 'contained! s:put sp nl ] if ] a:for-each
```