2023-01-23 16:46:09 +01:00
|
|
|
# s:dedup
|
|
|
|
|
|
|
|
|
|
String deduplication for RetroForth.
|
|
|
|
|
|
|
|
|
|
(c) Arland Childers
|
|
|
|
|
|
|
|
|
|
~~~
|
2023-01-24 02:04:10 +01:00
|
|
|
'init s:keep fll:create 's:dedup.data var-n
|
|
|
|
|
|
|
|
|
|
{{
|
2023-10-23 20:23:23 +02:00
|
|
|
'Temp d:create #1024 allot
|
2023-01-24 02:04:10 +01:00
|
|
|
't1 var
|
|
|
|
|
't2 var
|
|
|
|
|
---reveal---
|
|
|
|
|
:s:dedup.register (s-)
|
|
|
|
|
s:keep @s:dedup.data swap &fll:append/value sip ;
|
|
|
|
|
:s:dedup.defined? (s-f)
|
|
|
|
|
!t1 #0 !t2
|
|
|
|
|
@s:dedup.data [ @t1 s:eq? @t2 or !t2 ] fll:for-each @t2 ;
|
|
|
|
|
:s:dedup.find (s-s)
|
|
|
|
|
!t1 #0 !t2
|
2023-10-23 18:08:18 +02:00
|
|
|
@s:dedup.data [ dup @t1 s:eq? [ !t2 ] &drop choose ]
|
2023-01-24 02:04:10 +01:00
|
|
|
fll:for-each @t2 ;
|
|
|
|
|
:s:dedup (s-s)
|
2023-10-23 20:23:23 +02:00
|
|
|
&Temp s:copy &Temp
|
2023-10-23 18:08:18 +02:00
|
|
|
dup s:dedup.defined? &s:dedup.find &s:dedup.register
|
2023-01-24 02:04:10 +01:00
|
|
|
choose ;
|
|
|
|
|
:s:unique? (s-f) s:dedup.defined? ;
|
|
|
|
|
}}
|
2023-01-23 16:46:09 +01:00
|
|
|
~~~
|
2023-10-23 20:23:23 +02:00
|
|
|
|
|
|
|
|
~~~
|
|
|
|
|
'interface/dedup.retro s:dedup
|
|
|
|
|
dup 's:unique? d:lookup d:source store
|
|
|
|
|
dup 's:dedup d:lookup d:source store
|
|
|
|
|
dup 's:dedup.find d:lookup d:source store
|
|
|
|
|
dup 's:dedup.defined? d:lookup d:source store
|
|
|
|
|
dup 's:dedup.register d:lookup d:source store
|
|
|
|
|
dup 's:dedup.data d:lookup d:source store
|
|
|
|
|
drop
|
|
|
|
|
~~~
|
