summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorkitty <nepeta@canaglie.net>2026-04-21 18:39:25 +1000
committerkitty <nepeta@canaglie.net>2026-04-21 18:39:25 +1000
commitd86eafae2f8f80ce417b29a3f4b5f98ab82be2b2 (patch)
tree07cf6ec4454c0e12677db7974aaa6d15505998c8
parent2778c7d8c90cde9dd67c2aa07b62f65ee8ec3838 (diff)
fix search-wordlist, more tests again
i think thats enough tests for now maybe also maybe i should separate test.fs into a test dir with multiple files? next point of order is .s words and dump at some point also i need to do case stuff. maybe that should be first? also i want dump to have term colours like jewelforth's one has which is a good opportunity to actually use the vocabulary functionatily. bit more ambitious, but i also want to add line editing stuff. i'm worried this will mean fucking around with input again though. also i want to include a startup timer. running the whole testing suite is about 0.035s which is Alright i think, i'd like more detailed stats than `time` gives though. i don't think speed matters too much though
-rw-r--r--sanctuary.fs9
-rw-r--r--test.fs63
2 files changed, 70 insertions, 2 deletions
diff --git a/sanctuary.fs b/sanctuary.fs
index 9ea7a5a..70bc8cf 100644
--- a/sanctuary.fs
+++ b/sanctuary.fs
@@ -453,13 +453,18 @@ defer default-wordlist
forth-wordlist (vocabulary) forth
-1 set-order
+: visible? ( ht -- ? ) >ffa c@ 1 and 0= ;
+
+\ todo handle smudge
: search-wordlist ( a u wid -- 0 | ht -1 )
( wid ) @ begin ( a u ht )
>r 2dup r@ ( a u a u ht ; backup str for next loop )
>nfa count ( a1 u1 a2 u2 )
compare 0= if
- 2drop ( drop backup )
- r> -1 exit
+ r@ visible? if
+ 2drop ( drop backup )
+ r> -1 exit
+ then
then
r> @ ?dup 0=
until
diff --git a/test.fs b/test.fs
index f84cd96..78dd006 100644
--- a/test.fs
+++ b/test.fs
@@ -359,6 +359,8 @@ t{ gt8 -> 0 }t
t{ : gt9 gt8 literal ; -> }t
t{ gt9 0= -> <false> }t
+testing flow control
+
t{ : gi1 if 123 then ; -> }t
t{ : gi2 if 123 else 234 then ; -> }t
t{ 0 gi1 -> }t
@@ -414,4 +416,65 @@ t{ 4 RN1 execute -> 0 1 2 3 4 }t
\ t{ 25 RN2 execute -> 33 22 11 0 }t
hex
+t{ : gd1 do i loop ; -> }t
+t{ 4 1 gd1 -> 1 2 3 }t
+t{ 2 -1 gd1 -> -1 0 1 }t
+t{ mid-uint+1 mid-uint gd1 -> mid-uint }t
+
+\ todo +loop tests
+\ should make -loop first and deal with negatives
+
+t{ : gd5 123 swap 0 do
+ i 4 > if drop 234 leave then
+ loop ; -> }t
+t{ 1 gd5 -> 123 }t
+t{ 5 gd5 -> 123 }t
+t{ 6 gd5 -> 234 }t
+
+\ todo unloop tests
+
+testing define words
+
+t{ : nop : postpone ; ; -> }t
+t{ nop nop1 nop nop2 -> }t
+t{ nop1 -> }t
+t{ nop2 -> }t
+t{ : gdx 123 ; : gdx gdx 234 ; -> }t
+t{ gdx -> 123 234 }t
+
+t{ variable v1 -> }t
+t{ 123 v1 ! -> }t
+t{ v1 @ -> 123 }t
+
+t{ : does1 does> @ 1 + ; -> }t
+t{ : does2 does> @ 2 + ; -> }t
+t{ create cr1 -> }t
+t{ cr1 -> here }t
+t{ 1 , -> }t
+t{ cr1 @ -> 1 }t
+t{ does1 -> }t
+t{ cr1 -> 2 }t
+t{ does2 -> }t
+t{ cr1 -> 3 }t
+
+testing evaluate
+
+: ge1 s" 123" ; immediate
+: ge2 s" 123 1+" ; immediate
+: ge3 s" : ge4 345 ;" ;
+: ge5 evaluate ; immediate
+t{ ge1 evaluate -> 123 }t ( test evaluate in interp. state )
+t{ ge2 evaluate -> 124 }t
+t{ ge3 evaluate -> }t
+t{ ge4 -> 345 }t
+
+t{ : ge6 ge1 ge5 ; -> }t ( test evaluate in compile state )
+t{ ge6 -> 123 }t
+t{ : ge7 ge2 ge5 ; -> }t
+t{ ge7 -> 124 }t
+
+: gs4 source >in ! drop ;
+t{ gs4 123 456
+ -> }t
+
decimal