add a:indices and a:indices/string ; rewrite a:index and a:index/string to use them ; add a:temp

FossilOrigin-Name: 64666568dec02f6900c053557be9adc73c3cdf7a8a2fa6d5730001e852fd7fe0

image/retro.forth

@@ -1606,6 +1606,38 @@ and return a new value.
   &swap dip a:for-each ;
 ~~~
 
+~~~
+:FREE (-n) STRINGS #1025 - #513 #12 * - here - ;
+
+'NextArray var
+:arrays STRINGS #1025 - #513 #12 * - ;
+
+:a:temp (a-a) @NextArray dup #12 eq? [ drop #0 dup !NextArray ] if
+              #513 * arrays + over a:length n:inc copy
+              @NextArray #513 * arrays +
+              &NextArray v:inc ;
+
+{{
+  'Count var
+  :prepare  #0 &Count store ;
+  :reserve  swap #0 , ;
+  :patch    here over - n:dec over store ;
+  :cleanup  dup a:temp swap &Heap store ;
+  :record   @Count , ;
+  (numbers)
+  :match?   over eq? ;
+  :iterate/n [ match? &record if &Count v:inc ] a:for-each ;
+  (strings)
+  :match?   over s:eq? ;
+  :iterate/s [ match? &record if &Count v:inc ] a:for-each ;
+---reveal---
+  :a:indices (av-a)
+    prepare here [ reserve iterate/n drop ] dip patch cleanup ;
+  :a:indices/string (as-a)
+    prepare here [ reserve iterate/s drop ] dip patch cleanup ;
+}}
+~~~
+
 `a:index` and `a:index/string` build on these to return the
 offset of a value in the array, or -1 if the value wasn't
 found.
@@ -1621,20 +1653,8 @@ using a variable for the flag/offset value, but it's pretty clean
 overall.
 
 ~~~
-:a:index (an-i)
-  push push #-1 #0 pop pop swap
-  [ over eq? [ [ over #-1 eq? [ nip dup ] if ] dip ] if
-    [ n:inc ] dip ]
-  a:for-each drop-pair ;
-
-{{
-  :identify
-    #-1 swap #0
-   [ TRUE eq? [ over #-1 eq? [ nip dup ] if ] if n:inc ] a:reduce drop ;
----reveal---
-  :a:index/string (as-n)
-    &Heap [ &s:eq? curry a:map identify ] v:preserve ;
-}}
+:a:index (av-n) [ a:indices #0 a:fetch ] gc ;
+:a:index/string (as-n) [ a:indices/string #0 a:fetch ] gc ;
 ~~~
 
 When making an array, I often want the values in the original
@@ -1865,10 +1885,6 @@ provide much more than I can do here.
 :dump-stack (-)  depth 0; \drpulica ^dump-stack \podulica ^n:put sp ;
 ~~~
 
-~~~
-:FREE (-n) STRINGS #1025 - here - ;
-~~~
-
 ## Listener
 
 If a VM implementation provides both the character output and a

interface/future.retro

@@ -8,15 +8,6 @@ Notes:
 existing set in the future.
 
 ~~~
-'NextArray var
-:arrays FREE #513 #12 n:mul n:sub ;
-
-
-:aa:temp (a-a) @NextArray dup #12 [ drop #0 dup !NextArray ] if
-               #513 n:mul arrays n:add over a:length n:inc copy
-               @NextArray #513 n:mul arrays n:add
-               &NextArray v:inc ;
-
 :aa:make (...n-a) here [ dup comma &comma times ] dip ;
 
 :aa:map
@@ -24,22 +15,6 @@ existing set in the future.
                       &store sip n:inc ] times
          drop-pair ] sip ;
 
-{{
-  'Count var
-  :prepare  #0 &Count store ;
-  :reserve  swap #0 comma ;
-  :patch    here over n:sub n:dec over store ;
-  :cleanup  dup s:temp swap &Free store ;
-  :match?   over eq? ;
-  :record   &Count fetch comma ;
-  :iterate  [ match? &record if &Count v:inc ] a:for-each ;
----reveal---
-  :aa:indices (av-a)
-    prepare here [ reserve iterate drop ] dip patch cleanup ;
-}}
-
-:aa:index (av-n) [ aa:indices #0 a:fetch ] gc ;
-
 :aa:contains? (an-f)
   swap #0 swap [ swap [ over eq? ] dip or ] a:for-each nip ;
 

interface/sources.retro

@@ -47,7 +47,10 @@ dup 'a:right d:set-source
 dup 'a:left d:set-source
 dup '} d:set-source
 dup '{ d:set-source
+dup 'arrays d:set-source
+dup 'a:temp d:set-source
 dup 'a:make d:set-source
+dup 'a:indices d:set-source
 dup 'a:index/string d:set-source
 dup 'a:index d:set-source
 dup 'a:reduce d:set-source

vm/nga-c-native-x86/Makefile

@@ -4,7 +4,7 @@ native386:
 	cp ../../ngaImage nativeImage
 	../../bin/retro-extend nativeImage x86/common.retro x86/cmos-rtc.retro x86/serial.retro x86/display.retro x86/ata.retro x86/listener.retro
 # x86/Block-Editor.retro
-	../../bin/retro-embedimage nativeImage >image.c
+#	../../bin/retro-embedimage nativeImage >image.c
 	cc -fno-pie -Wall -m32 -DTARGET_X86              -c retro.c -o retro_qwerty.o
 	cc -fno-pie -Wall -m32 -DTARGET_X86 -DUSE_DVORAK -c retro.c -o retro_dvorak.o
 	nasm -f elf 386.s