@@ -0,0 +1,271 @@
1+/- sur=astrolabe
2+/+ *astrolabe
3+=< [sur .]
4+=, sur
5+|%
6+++ search-text-chars "*abcdefghilmnoprstuvwxyz"
7+++ trip-syls
8+ |= syls=cord
9+ %+ turn
10+ (rip [0 24] syls)
11+ trip
12+++ prefixes ^~ (trip-syls sis:po)
13+++ suffixes ^~ (trip-syls dex:po)
14+++ full-opts ^~ (gulf .~zod .~fes)
15+++ sanitize-search-text
16+ |= =search-text
17+ ^- tape
18+ %+ skim search-text
19+ |= a=@t
20+ !=(~ (find [a]~ search-text-chars))
21++$ pfsf ?(%prefix %suffix)
22++$ syl [=tape =pfsf]
23++$ search-text tape
24++$ search-syls (list syl) :: in reverse order, e.g. ["net" "pal" "pel" "sam" ~]. length 1-4
25++$ search-syl-opts (list @q)
26++$ search-opts (list search-syl-opts) :: must have length 4
27++$ search-full
28+ $:
29+ =search-syls
30+ =search-opts
31+ ==
32++$ mr-search :: maybe reversed full search
33+ $:
34+ [reversed=? pain=@]
35+ =search-full
36+ ==
37+++ search-syl-to-search-syl-opts
38+ |= search=syl
39+ ^- search-syl-opts
40+ =/ syls
41+ ?: =(%prefix pfsf.search) prefixes suffixes
42+ ?: =(tape.search "***") full-opts
43+ %+ murn syls
44+ |= cand=tape
45+ ?. (tape-matches tape.search cand) ~
46+ %- ?: =(%prefix pfsf.search) ins:po ind:po
47+ (crip cand)
48+++ search-text-to-search-syls
49+ |= search-text=tape
50+ ^- search-syls
51+ =. search-text (sanitize-search-text search-text)
52+ =/ syl-tapes
53+ %+ turn
54+ %- flop
55+ (rip [0 24] (crip search-text)) :: jet doesn't support rip [3 3] which is equivalent
56+ trip
57+ =| count=@
58+ |-
59+ ^- search-syls
60+ =/ =pfsf
61+ ?: =(0 (mod count 2)) %suffix %prefix
62+ ?~ syl-tapes ~
63+ :- [i.syl-tapes pfsf]
64+ $(syl-tapes t.syl-tapes, count +(count))
65+::
66+++ search-syls-to-search-opts
67+ |= =search-syls
68+ ^- search-opts
69+ =/ opts
70+ %+ turn
71+ search-syls
72+ |= =syl
73+ (search-syl-to-search-syl-opts syl)
74+ ?: %+ lien opts
75+ |= syl-opts=search-syl-opts
76+ =(~ syl-opts)
77+ ~[~ ~ ~ ~]
78+ |-
79+ ?: (gte (lent opts) 4)
80+ opts
81+ $(opts (snoc (search-opts opts) (search-syl-opts ~[.~zod])))
82+::
83+++ search-text-to-full
84+ |= search-text=tape
85+ ^- search-full
86+ =/ =search-syls (search-text-to-search-syls search-text)
87+ :- search-syls
88+ (search-syls-to-search-opts search-syls)
89+::
90+++ expand-search-text-to-len
91+ |= [search=tape flen=@ud rotate=?]
92+ =. search (sanitize-search-text search)
93+ |-
94+ ^- (list tape)
95+ =+ slen=(lent search)
96+ ?: =(slen flen)
97+ ~[search]
98+ ?: (gth slen flen) ~
99+ :-
100+ (weld search (reap (sub flen slen) '*'))
101+ ?. rotate ~
102+ $(search (weld "*" search))
103+::
104+++ expand-search-text
105+ |= search=tape
106+ ^- (list tape)
107+ =. search (sanitize-search-text search)
108+ ?~ search ~
109+ =/ rotate
110+ ?& !=('~' i.search)
111+ !(levy (tape search) (cury test '*')) :: is all wild
112+ ==
113+ =/ expand (cury expand-search-text-to-len search)
114+ ;: weld
115+ (expand 3 rotate)
116+ (expand 6 rotate)
117+ (expand 12 rotate)
118+ ==
119+::
120+++ search-text-to-fulls
121+ |= search=tape
122+ ^- (list search-full)
123+ =/ texts (expand-search-text search)
124+ %+ murn
125+ texts
126+ |= text=tape
127+ =/ full (search-text-to-full text)
128+ ?: =(~[~ ~ ~ ~] search-opts.full)
129+ ~
130+ (some full)
131+++ reverse-list :: that is, put first 2 in back "abcd" -> "cdab"
132+ |* lst=(list)
133+ ^- _lst
134+ %+ weld
135+ (slag 2 lst)
136+ (scag 2 lst)
137+++ pad-search-syls
138+ |= =search-syls
139+ ^- ^search-syls
140+ =/ padding (search-text-to-search-syls "dozzoddozzod")
141+ %+ weld
142+ search-syls
143+ (slag (lent search-syls) padding)
144+++ reverse-search
145+ |= search=search-full
146+ ^- search-full
147+ :- (reverse-list (pad-search-syls search-syls.search))
148+ (reverse-list search-opts.search)
149+++ estimate-search-pain
150+ |= search=search-full
151+ =/ opts search-opts.search
152+ =| acc=@
153+ |-
154+ ?~ opts acc
155+ =/ new-acc
156+ (add (mul acc 2) (lent i.opts))
157+ $(acc new-acc, opts t.opts)
158+:: ++ estimate-search-pain
159+:: |= search=search-full
160+:: =/ max-pain (bex 32)
161+:: =/ opts search-opts.search
162+:: =| acc=@
163+:: |-
164+:: ?~ opts acc
165+:: =/ level-pain (div (mul max-pain (lent i.opts)) 256)
166+:: =/ new-acc
167+:: (add (mul acc 2) (lent i.opts))
168+:: $(acc new-acc, opts t.opts)
169+++ estimate-search-text-pain
170+ |= =search-text
171+ (estimate-search-pain (search-text-to-full search-text))
172+++ maybe-reverse-search
173+ |= [search=search-full]
174+ ^- mr-search
175+ =/ search-pain (estimate-search-pain search)
176+ =/ rsearch (reverse-search search)
177+ =/ rsearch-pain (estimate-search-pain rsearch)
178+ ?: (gth search-pain rsearch-pain)
179+ [[%.y rsearch-pain] rsearch]
180+ [[%.n search-pain] search]
181+::
182+++ maybe-reverse-searches
183+ |= [searches=(list search-full) pain-thresh=@]
184+ =| pain=@
185+ |-
186+ ^- (list mr-search)
187+ ?~ searches ~
188+ =/ mr (maybe-reverse-search i.searches)
189+ =/ new-pain (add pain pain.mr)
190+ ?: (gth new-pain pain-thresh)
191+ $(searches t.searches)
192+ :- mr
193+ $(searches t.searches, pain new-pain)
194+::
195+++ tape-matches
196+ |= [search=tape cand=tape]
197+ ^- ?
198+ |-
199+ ?~ search %.y
200+ ?~ cand %.n
201+ ?: |(=(i.search i.cand) =(i.search '*'))
202+ $(search t.search, cand t.cand)
203+ %.n
204+++ tosd
205+ |= [a=@ =pfsf]
206+ %- ?:(=(%prefix pfsf) tos:po tod:po)
207+ a
208+++ syl-equals
209+ |= [=syl cand=@]
210+ =((crip tape.syl) (tosd cand pfsf.syl))
211+++ syl-matches
212+ |= [=syl cand=@]
213+ :: todo check cand < 256
214+ (tape-matches tape.syl (trip (tosd cand pfsf.syl)))
215+++ matches-search
216+ |= [search=search-syls cand-atom=@]
217+ =/ cand (rip 3 cand-atom)
218+ |-
219+ ^- ?
220+ ?~ search =(cand ~)
221+ :: =? cand =(cand ~)
222+ :: `(lest @)`~[0]
223+ ?~ cand
224+ ?& (syl-equals i.search 0)
225+ $(search t.search)
226+ ==
227+ :: =/ nncand ^- (lest @)
228+ :: ?~ cand ~[0] cand
229+ ?& (syl-matches i.search i.cand)
230+ $(search t.search, cand t.cand)
231+ ==
232+::
233+++ opts-in-range
234+ |= [lb=@ rb=@ opts=(list @)]
235+ ^- search-syl-opts
236+ %+ skim
237+ opts
238+ |= a=@
239+ &((lte lb a) (gte rb a))
240+::
241+++ range-contains-search
242+ |= [lb=@ rb=@ search=search-opts] :: includes lb and rb - [lb, rb]
243+ ^- [opts=search-opts contains=?]
244+ ?~ search `%.y
245+ =/ s-0 i.search
246+ ?~ s-0 `%.n
247+ =/ lb-0 (end 3 lb)
248+ =/ rb-0 (end 3 rb)
249+ =/ cand-0 (opts-in-range lb-0 rb-0 s-0)
250+ =/ cand-0-len (lent cand-0)
251+ :: ~& "lb: {<`@q`lb>} rb: {<`@q`rb>} cand-len: {<cand-0-len>}"
252+ ?: =(0 cand-0-len) `%.n
253+ =. i.search cand-0
254+ :_
255+ ?: (gte cand-0-len 3) %.y :: entire valid galaxy is bounded
256+ =/ lb-clean =(0 (rsh 3 lb)) :: lb is galaxy
257+ =/ rb-clean =(0 (rsh 3 (add-d rb 1))) :: rb is last planet in galaxy
258+ ?: &(=(2 cand-0-len) |(lb-clean rb-clean))
259+ %.y :: two galaxies, and one is right on the edge (fully bounded)
260+ |-
261+ ^- ?
262+ ?~ cand-0 %.n
263+ =/ crb (add .~fipfes-fipzod i.cand-0)
264+ =/ slb (rev-q (rev-f max lb i.cand-0))
265+ =/ srb (rev-q (rev-f min rb crb))
266+ =/ sub-contains +:^$(lb (rsh 3 slb), rb (rsh 3 srb), search t.search)
267+ ?: sub-contains %.y
268+ $(cand-0 t.cand-0)
269+ search
270+::
271+--