/pliant/language/type/text/str.pli
1	# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
2	#
3	# This program is free software; you can redistribute it and/or
4	# modify it under the terms of the GNU General Public License version 2
5	# as published by the Free Software Foundation.
6	#
7	# This program is distributed in the hope that it will be useful,
8	# but WITHOUT ANY WARRANTY; without even the implied warranty of
9	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
10	# GNU General Public License for more details.
11	#
12	# You should have received a copy of the GNU General Public License
13	# version 2 along with this program; if not, write to the Free Software
14	# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
15
16	scope "/pliant/language/" "/pliant/install/"
17	module "/pliant/install/ring2.pli"
18
19	public
20	constant default_charset_is_utf8 true
21
22
23	function '+=' s e
24	arg_rw Str s ; arg Str e
25	strong_definition
26	# this is speedup only function
27	s resize s:len+e:len
28	memory_copy e:characters (s:characters translate Char s:len-e:len) e:len
29
30
31	method s search_last pattern default -> position
32	arg Str s pattern ; arg Int default position
33	position := default
34	var Address base := s characters
35	while true
36	base := memory_search base (cast (s:characters translate Char s:len) Int).-.(cast base Int) pattern:characters pattern:len
37	if base=null
38	return
39	position := (cast base Int).-.(cast s:characters Int)
40	base := base translate Char 1
41
42
43	function replace s pattern with -> s2
44	arg Str s pattern with s2
45	check pattern:len>0
46	if pattern:len=with:len
47	s2 := s
48	var Int i := -1
49	while { i := ((s2 i+1 s2:len) search pattern -(i+2))+(i+1) ; i<>(-1) }
50	memory_copy with:characters (s2:characters translate Char i) with:len
51	else
52	var Int i := s search pattern -1
53	if i>=0
54	s2 := (s 0 i)+with+(replace (s i+pattern:len s:len) pattern with)
55	else
56	s2 := s
57
58	function repeat n pattern -> result
59	arg Int n ; arg Str pattern result
60	check n>=0
61	var Address buffer := memory_allocate n*pattern:len addressof:result
62	for (var Int i) 0 n-1
63	memory_copy pattern:characters (buffer translate Char i*pattern:len) pattern:len
64	result set buffer n*pattern:len true
65
66	function reverse s -> result
67	arg Str s result
68	var Int l := s len
69	var Address buffer := memory_allocate l addressof:result
70	for (var Int i) 0 l-1
71	memory_copy (s:characters translate Char l-1-i) (buffer translate Char i) 1
72	result set buffer l true
73
74	function left s l p -> s2
75	arg Str s ; arg Int l ; arg Str p s2
76	check p:len=1
77	if s:len<l
78	var Address buffer := memory_allocate l addressof:s2
79	memory_copy s:characters buffer s:len
80	for (var Int i) s:len l-1
81	memory_copy p:characters (buffer translate Char i) Char:size
82	s2 set buffer l true
83	else
84	s2 := s
85
86	function right s l p -> s2
87	arg Str s ; arg Int l ; arg Str p s2
88	check p:len=1
89	if s:len<l
90	var Address buffer := memory_allocate l addressof:s2
91	memory_copy s:characters (buffer translate Char l-s:len) s:len
92	for (var Int i) 0 l-s:len-1
93	memory_copy p:characters (buffer translate Char i) Char:size
94	s2 set buffer l true
95	else
96	s2 := s
97
98	function upper s -> s2
99	arg Str s s2
100	s2 set (memory_allocate s:len addressof:s2) s:len true
101	for (var Int i) 0 s:len-1
102	var Int n := s:i:number
103	if n>="a":0:number and n<="z":0:number
104	n := n + ("A":0:number-"a":0:number)
105	s2 i := character n
106
107	function lower s -> s2
108	arg Str s s2
109	s2 set (memory_allocate s:len addressof:s2) s:len true
110	for (var Int i) 0 s:len-1
111	var Int n := s:i:number
112	if n>="A":0:number and n<="Z":0:number
113	n := n + ("a":0:number-"A":0:number)
114	s2 i := character n
115
116
117	export '+=' '. search_last' replace repeat reverse left right upper lower
118
119
120
121
122
123	function from_string u s o may_skip skiped offset f -> status
124	arg_w Universal u ; arg Str s o ; arg CBool may_skip ; arg_w Int skiped offset ; arg Function f ; arg Status status
125	indirect
126
127
128	method s option_position name if_not_found -> p
129	arg Str s ; arg Str name ; arg Int if_not_found p
130	var Address start := s characters
131	var Address stop := start translate Char s:len
132	while true
133	var Address id := memory_search start (cast stop Int).-.(cast start Int) name:characters name:len
134	if id=null
135	return if_not_found
136	var Address dq := memory_search start (cast stop Int).-.(cast start Int) "[dq]":characters 1
137	if dq=null or dq>id
138	if id=s:characters or not ((id translate Char -1) map Char):isidentcharacter
139	if (id translate Char name:len)=(s:characters translate Char s:len) or not ((id translate Char name:len) map Char):isidentcharacter
140	return (cast id Int).-.(cast s:characters Int)
141	else
142	start := id translate Char 1
143	else
144	start := id translate Char 1
145	else
146	start := dq translate Char 1
147	var CBool inside := true
148	while inside
149	var Address dq := memory_search start (cast stop Int).-.(cast start Int) "[dq]":characters 1
150	if dq=null
151	return if_not_found
152	var Address lb := memory_search start (cast stop Int).-.(cast start Int) "[lb]":characters 1
153	if lb=null or lb>dq
154	if (memory_search start (cast dq Int).-.(cast start Int) "[rb]":characters 1)<>null
155	return if_not_found
156	start := dq translate Char 1
157	inside := false
158	else
159	if (memory_search start (cast lb Int).-.(cast start Int) "[rb]":characters 1)<>null
160	return if_not_found
161	var Address rb := memory_search (lb translate Char 2) (cast stop Int).-.(cast lb Int)-2 "[rb]":characters 1
162	if rb=null
163	return if_not_found
164	start := rb translate Char 1
165
166	method s option_position name instance if_not_found -> p
167	arg Str s ; arg Str name ; arg Int instance if_not_found p
168	check instance>=0
169	var Int offset := -1
170	for (var Int i) 0 instance
171	var Int next := (s offset+1 s:len) option_position name if_not_found
172	if next=if_not_found
173	return if_not_found
174	else
175	offset += 1+next
176	p := offset
177
178
179	method s option name -> b
180	arg Str s ; arg Str name ; arg CBool b
181	b := (s option_position name -1)<>(-1)
182
183
184	method s option_value name instance fun type default result
185	arg Str s ; arg Str name ; arg Int instance ; arg Function fun ; arg Type type ; arg Universal default ; arg_w Universal result
186	var Int p := s option_position name instance -1
187	if p=(-1)
188	type copy_instance addressof:default addressof:result
189	return
190	p += name:len
191	while p<s:len and (s:p=" ":0 or s:p="[tab]":0)
192	p += 1
193	if (from_string result (s p s:len) "" false (var Int skiped) (var Int offset) fun)=failure
194	type copy_instance addressof:default addressof:result
195
196	meta '. option' e
197	if e:size<2 or not (e:0 cast Str) or not (e:1 cast Str)
198	return
199	var Int u := 2
200	var Link:Argument instance :> argument constant Int 0
201	if u<e:size and (e:u cast Int)
202	instance :> e:u result
203	u += 1
204	if u>=e:size or (e:u constant Type)=null
205	return
206	var Pointer:Type t :> (e:u constant Type) map Type
207	u += 1
208	var Pointer:Function f :> t get_generic_method (the_function '. from string' Universal Str Str CBool Int Int -> Status):generic_index
209	if addressof:f=null or addressof:f=addressof:(the_function '. from string' Universal Str Str CBool Int Int -> Status)
210	return
211	var Link:Argument d :> new Argument
212	d locate t argument_constant
213	d constant := entry_new t
214	from_string (d:constant map Universal) "" "" false (var Int skiped) (var Int offset) f
215	if u<e:size and (e:u cast t)
216	d :> e:u result
217	u += 1
218	if u<>e:size
219	return
220	for (var Int i) 0 e:size-1
221	e suckup e:i
222	var Link:Argument r :> argument local t
223	e add (instruction (the_function '. option_value' Str Str Int Function Type Universal Universal) e:0:result e:1:result instance (argument mapped_constant Function f) (argument mapped_constant Type t) d r)
224	e set_result r access_read
225
226	export '. option_position' '. option'
227
228
229
230
231
232	(gvar Array string_encoding) 'size :=' 256
233	gvar Dictionary string_decoding
234
235	function define_char_encoding char encoded
236	arg Int char ; arg Str encoded
237	var Link:Str e :> new Str ; e := encoded
238	string_encoding char := addressof e
239	var Link:Char c :> new Char ; c := character char
240	string_decoding insert encoded true addressof:c
241
242	define_char_encoding "[lb]":0:number "[lb]lb[rb]"
243	define_char_encoding "[rb]":0:number "[lb]rb[rb]"
244	define_char_encoding "[dq]":0:number "[lb]dq[rb]"
245	define_char_encoding "[cr]":0:number "[lb]cr[rb]"
246	define_char_encoding "[lf]":0:number "[lb]lf[rb]"
247	define_char_encoding "[0]":0:number "[lb]0[rb]"
248
249
250	method data 'to string' options -> string
251	arg Str data ; arg Str options ; arg Str string
252	if options="raw" or options="db" or options="con"
253	string := data
254	else
255	string := "[dq]"+data+"[dq]"
256	var Int i := 1
257	while i<string:len-1
258	var Int ch := string:i number
259	if string_encoding:ch<>null
260	var Pointer:Str e :> string_encoding:ch map Str
261	string := (string 0 i)+e+(string i+1 string:len)
262	i := i+e:len
263	else
264	i := i+1
265
266
267	method data 'from string' string options may_skip skiped offset -> status
268	arg_w Str data ; arg Str string options ; arg CBool may_skip ; arg_w Int skiped offset ; arg Status status
269	if options="raw" or options="db" or options="con"
270	data := string
271	skiped := 0
272	offset := string len
273	return success
274	var Int stop := string:len-1
275	if not may_skip and stop<>(-1)
276	stop := 0
277	for (var Int i) 0 stop
278	var Int ci := string:i number
279	if ci="[dq]":0:number
280	skiped := i
281	var Address cursor := string:characters translate Char i+1
282	var Int remain := string:len-(i+1)
283	var Address dq := memory_search cursor remain "[dq]":characters 1
284	var Address lb := memory_search cursor remain "[lb]":characters 1
285	if dq<>null and (lb=null or dq<lb)
286	# the string to decode does not contain any [ character
287	var Int l := (cast dq Int).-.(cast cursor Int)
288	if (memory_search cursor l "[rb]":characters 1)=null
289	data set (memory_allocate l addressof:data) l true
290	memory_copy cursor data:characters l
291	offset := (cast dq Int) .+. 1 .-. (cast string:characters Int)
292	return success
293	else
294	# the string contains an unmatched ] character
295	return failure
296	var Address buf := memory_allocate remain null
297	var Address b := buf
298	var CBool ok := true
299	while ok
300	var Int remain := (cast string:characters Int).+.string:len.-.(cast cursor Int)
301	var Address dq := memory_search cursor remain "[dq]":characters 1
302	if dq=null
303	# no " character: this is not a valid string
304	ok := false
305	else
306	var Address lb := memory_search cursor remain "[lb]":characters 1
307	if lb=null or dq<lb
308	# no more [ character
309	var Int n := (cast dq Int).-.(cast cursor Int)
310	if (memory_search cursor n "[rb]":characters 1)=null
311	# store the remaining not encoded characters and successfully returns
312	memory_copy cursor b n ; b := b translate Char n
313	var Int l := (cast b Int).-.(cast buf Int)
314	data set (memory_allocate l addressof:data) l true
315	memory_copy buf data:characters l
316	memory_free buf
317	offset := (cast dq Int) .+. 1 .-. (cast string:characters Int)
318	return success
319	else
320	# the string contains an unmatched ] character
321	ok := false
322	else
323	var Int n := (cast lb Int).-.(cast cursor Int)
324	if (memory_search cursor n "[rb]":characters 1)=null
325	# stores the charcters before the first [ : they are not encoded
326	memory_copy cursor b n ; b := b translate Char n
327	var Address rb := memory_search (lb translate Char 2) (cast string:characters Int).+.string:len.-.(cast lb Int)-2 "[rb]":characters 1
328	if rb<>null
329	(var Str sub) set lb (cast rb Int).-.(cast lb Int)+1 false
330	# 'sub' is the encoded character
331	var Pointer:Char ch :> (string_decoding first sub) map Char
332	var Char c
333	if addressof:ch<>null
334	# we found it in the encoding dictionary
335	c := ch
336	else
337	c := sub 1
338	if c:number>="0":0:number and c:number<="9":0:number
339	# we are looking for an integer between [ and ]
340	var Int n := 0
341	for (var Int j) 1 sub:len-2
342	c := sub:j
343	if c:number>="0":0:number and c:number<="9":0:number
344	n := n*10+c:number-"0":0:number
345	else
346	ok := false
347	if n<256
348	c := character n
349	else
350	ok := false
351	eif sub:len=3 and not (c:number>="a":0:number and c:number<="z":0:number) and not (c:number>="A":0:number and c:number<="Z":0:number)
352	# we have a single character in the middle, and it's neither a letter nor a number, so we decode it as itself
353	void
354	else
355	# this is an unsupported encoding
356	ok := false
357	b map Char := c
358	b := b translate Char 1
359	cursor := lb translate Char sub:len
360	else
361	# unmatched [ character
362	ok := false
363	else
364	# unmatched ] character
365	ok := false
366	# if we get there, then ok=false, so free the temporary storage area and return
367	memory_free buf
368	data := ""
369	return failure
370	data := ""
371	status := failure
372
373
374
375
376
377	type StrMatch
378	field Address current
379	field Address stop
380	field Address start
381	field CBool exact
382
383
384	method sm setup s exact
385	arg_w StrMatch sm ; arg Str s ; arg CBool exact
386	sm start := s characters
387	sm current := sm start
388	sm stop := s:characters translate Char s:len
389	sm exact := exact
390
391	((the_function '. setup' StrMatch Str CBool) arg 0):maps := 2
392
393
394	method sm drop_spaces
395	arg_rw StrMatch sm
396	while sm:current<>sm:stop and { var Char c := sm:current map Char ; c=" ":0 or c="[tab]":0 }
397	sm current := sm:current translate Char 1
398
399	method sm conditional_drop_spaces
400	arg_rw StrMatch sm
401	if not sm:exact
402	sm drop_spaces
403
404	method s drop_end_spaces
405	arg_rw Str s
406	var Int l := s:len
407	if l<>0 and ( (s l-1)=" ":0 or (s l-1)="[tab]":0 )
408	while l<>0 and (s l-1)=" ":0
409	l := l-1
410	s resize l
411
412
413	method sm underscore -> ok
414	arg_rw StrMatch sm ; arg CBool ok
415	if sm:current=sm:stop
416	return false
417	var Char c := sm:current map Char
418	sm current := sm:current translate Char 1
419	sm drop_spaces
420	ok := c=" ":0 or c="[tab]":0
421
422	method sm underscore s -> ok
423	arg_rw StrMatch sm ; arg_w Str s ; arg CBool ok
424	var Address cur := sm current
425	while sm:current<>sm:stop and { var Char c := sm:current map Char ; c<>" ":0 and c<>"[tab]":0 }
426	sm current := sm:current translate Char 1
427	if sm:current=sm:stop
428	return false
429	var Int l := (cast sm:current Int).-.(cast cur Int)
430	s set (memory_allocate l addressof:s) l true
431	memory_copy cur s:characters l
432	sm drop_spaces
433	ok := true
434
435
436	method sm spaces sp -> ok
437	arg_rw StrMatch sm ; arg_w Str sp ; arg CBool ok
438	var Address cur := sm current
439	sm drop_spaces
440	var Int l := (cast sm:current Int).-.(cast cur Int)
441	sp set (memory_allocate l addressof:sp) l true
442	memory_copy cur sp:characters l
443	ok := true
444
445	method sm spaces s sp -> ok
446	arg_rw StrMatch sm ; arg_w Str s sp ; arg CBool ok
447	var Address cur := sm current
448	while sm:current<>sm:stop and { var Char c := sm:current map Char ; c<>" ":0 and c<>"[tab]":0 }
449	sm current := sm:current translate Char 1
450	var Int l := (cast sm:current Int).-.(cast cur Int)
451	s set (memory_allocate l addressof:s) l true
452	memory_copy cur s:characters l
453	var Address cur := sm current
454	sm drop_spaces
455	var Int l := (cast sm:current Int).-.(cast cur Int)
456	sp set (memory_allocate l addressof:sp) l true
457	memory_copy cur sp:characters l
458	ok := true
459
460
461	method sm pattern p -> ok
462	arg_rw StrMatch sm ; arg Str p ; arg CBool ok
463	check p:len>0
464	sm conditional_drop_spaces
465	var Int l := (cast sm:stop Int).-.(cast sm:current Int)
466	if l<p:len
467	return false
468	if (memory_different sm:current p:len p:characters p:len)
469	return false
470	sm current := sm:current translate Char p:len
471	ok := true
472
473	method sm pattern s p -> ok
474	arg_rw StrMatch sm ; arg_w Str s ; arg Str p ; arg CBool ok
475	sm conditional_drop_spaces
476	var Address a := memory_search sm:current (cast sm:stop Int).-.(cast sm:current Int) p:characters p:len
477	if a=null
478	return false
479	var Int l := (cast a Int).-.(cast sm:current Int)
480	s set (memory_allocate l addressof:s) l true
481	memory_copy sm:current s:characters l
482	if not sm:exact
483	s drop_end_spaces
484	sm current := a translate Char p:len
485	ok := true
486
487
488	method sm word p -> ok
489	arg_rw StrMatch sm ; arg Str p ; arg CBool ok
490	ok := sm pattern p
491	if sm:current<>sm:stop and (sm:current map Char):isidentcharacter
492	ok := false
493
494	method sm word s p -> ok
495	arg_rw StrMatch sm ; arg_w Str s ; arg Str p ; arg CBool ok
496	sm conditional_drop_spaces
497	var Address a := memory_search sm:current (cast sm:stop Int).-.(cast sm:current Int) p:characters p:len
498	if a=null
499	return false
500	eif a<>sm:current and ((a translate Char -1) map Char):isidentcharacter
501	return false
502	ok := (sm pattern s p)
503	if sm:current<>sm:stop and (sm:current map Char):isidentcharacter
504	ok := false
505
506
507	function memory_acdifferent area1 size1 area2 size2 -> c
508	arg Address area1 ; arg Int size1 ; arg Address area2 ; arg Int size2 ; arg CBool c
509	# unefficient implementation
510	(var Str s1) set area1 size1 false
511	(var Str s2) set area2 size2 false
512	c := lower:s1<>lower:s2
513
514	method sm acpattern p -> ok
515	arg_rw StrMatch sm ; arg Str p ; arg CBool ok
516	check p:len>0
517	sm conditional_drop_spaces
518	var Int l := (cast sm:stop Int).-.(cast sm:current Int)
519	if l<p:len
520	return false
521	if (memory_acdifferent sm:current p:len p:characters p:len)
522	return false
523	sm current := sm:current translate Char p:len
524	ok := true
525
526	function memory_acsearch address size pattern_address pattern_size -> p
527	arg Address address ; arg Int size ; arg Address pattern_address ; arg Int pattern_size ; arg Address p
528	# unefficient implementation
529	(var Str s) set address size false
530	(var Str pattern) set pattern_address pattern_size false
531	var Int i := lower:s search lower:pattern -1
532	if i<>(-1)
533	p := address translate Byte i
534	else
535	p := null
536
537	method sm acpattern s p -> ok
538	arg_rw StrMatch sm ; arg_w Str s ; arg Str p ; arg CBool ok
539	sm conditional_drop_spaces
540	var Address a := memory_acsearch sm:current (cast sm:stop Int).-.(cast sm:current Int) p:characters p:len
541	if a=null
542	return false
543	var Int l := (cast a Int).-.(cast sm:current Int)
544	s set (memory_allocate l addressof:s) l true
545	memory_copy sm:current s:characters l
546	if not sm:exact
547	s drop_end_spaces
548	sm current := a translate Char p:len
549	ok := true
550
551
552	method sm acword p -> ok
553	arg_rw StrMatch sm ; arg Str p ; arg CBool ok
554	ok := sm acpattern p
555	if sm:current<>sm:stop and (sm:current map Char):isidentcharacter
556	ok := false
557
558	method sm acword s p -> ok
559	arg_rw StrMatch sm ; arg_w Str s ; arg Str p ; arg CBool ok
560	sm conditional_drop_spaces
561	var Address a := memory_acsearch sm:current (cast sm:stop Int).-.(cast sm:current Int) p:characters p:len
562	if a=null
563	return false
564	eif a<>sm:current and ((a translate Char -1) map Char):isidentcharacter
565	return false
566	ok := (sm acpattern s p)
567	if sm:current<>sm:stop and (sm:current map Char):isidentcharacter
568	ok := false
569
570
571
572
573	method sm from_string u f -> ok
574	arg_rw StrMatch sm ; arg_w Universal u ; arg Function f ; arg CBool ok
575	sm conditional_drop_spaces
576	(var Str string) set sm:current (cast sm:stop Int).-.(cast sm:current Int) false
577	if (from_string u string "" false (var Int skiped) (var Int offset) f)=success
578	sm:current := sm:current translate Byte offset
579	ok := true
580	else
581	ok := false
582
583	method sm from_string s u f -> ok
584	arg_rw StrMatch sm ; arg_w Str s ; arg_w Universal u ; arg Function f ; arg CBool ok
585	sm conditional_drop_spaces
586	(var Str string) set sm:current (cast sm:stop Int).-.(cast sm:current Int) false
587	if (from_string u string "" true (var Int skiped) (var Int offset) f)=success
588	s set sm:current skiped false
589	sm:current := sm:current translate Byte offset
590	ok := true
591	else
592	ok := false
593
594
595	method sm offset i
596	arg_rw StrMatch sm ; arg_w Int i
597	i := (cast sm:current Int).-.(cast sm:start Int)
598
599
600	method sm conclude initial -> ok
601	arg_rw StrMatch sm ; arg Str initial ; arg CBool ok
602	sm conditional_drop_spaces
603	ok := sm:current=sm:stop
604
605	method sm conclude s initial -> ok
606	arg_rw StrMatch sm ; arg_w Str s ; arg Str initial ; arg CBool ok
607	sm conditional_drop_spaces
608	var Int l := (cast sm:stop Int).-.(cast sm:current Int)
609	var Address c := memory_allocate l addressof:s
610	memory_copy sm:current c l
611	s set c l true
612	if not sm:exact
613	s drop_end_spaces
614	ok := true
615
616	# initial is used to prevent the matched string to be reused as a temporary string
617	if ((the_function '. conclude' StrMatch Str -> CBool):flags .and. function_flag_inline_instructions)<>0 or ((the_function '. conclude' StrMatch Str Str -> CBool):flags .and. function_flag_inline_instructions)<>0
618	error_notify error_id_unexpected null "conclude is inline !!!"
619
620
621	function try_match e exact
622	arg_rw Expression e ; arg CBool exact
623	if e:size<1 or not (e:0 cast Str)
624	return
625	var Link:Argument sm :> argument local StrMatch
626	var Link:Argument ok :> argument local CBool
627	var Link:Instruction end :> instruction the_function:'do nothing'
628	var Pointer:Argument s :> null map Argument
629	e suckup e:0
630	e add (instruction (the_function '. setup' StrMatch Str CBool) sm e:0:result (argument constant CBool exact))
631	for (var Int i) 1 e:size-1
632	if addressof:(entry_type e:i:value)=addressof:Str or addressof:(entry_type e:i:value)=addressof:Char
633	var Str pattern
634	if addressof:(entry_type e:i:value)=addressof:Str
635	pattern := e:i:value map Str
636	else
637	pattern := e:i:value map Char
638	if addressof:s=null
639	e add (instruction (the_function '. pattern' StrMatch Str -> CBool) sm (argument constant Str pattern) ok)
640	else
641	e add (instruction (the_function '. pattern' StrMatch Str Str -> CBool) sm s (argument constant Str pattern) ok)
642	s :> null map Argument
643	e add (instruction (the_function 'jump if not' CBool) ok jump end)
644	eif e:i:ident="_" and e:i:size=0
645	if addressof:s=null
646	e add (instruction (the_function '. underscore' StrMatch -> CBool) sm ok)
647	else
648	e add (instruction (the_function '. underscore' StrMatch Str -> CBool) sm s ok)
649	s :> null map Argument
650	e add (instruction (the_function 'jump if not' CBool) ok jump end)
651	eif e:i:ident="spaces" and e:i:size=1 and (e:i:0 cast Str)
652	e suckup e:i:0
653	if addressof:s=null
654	e add (instruction (the_function '. spaces' StrMatch Str -> CBool) sm e:i:0:result ok)
655	else
656	e add (instruction (the_function '. spaces' StrMatch Str Str -> CBool) sm s e:i:0:result ok)
657	s :> null map Argument
658	e add (instruction (the_function 'jump if not' CBool) ok jump end)
659	eif e:i:ident="pattern" and e:i:size=1 and (e:i:0 cast Str)
660	e suckup e:i:0
661	if addressof:s=null
662	e add (instruction (the_function '. pattern' StrMatch Str -> CBool) sm e:i:0:result ok)
663	else
664	e add (instruction (the_function '. pattern' StrMatch Str Str -> CBool) sm s e:i:0:result ok)
665	s :> null map Argument
666	e add (instruction (the_function 'jump if not' CBool) ok jump end)
667	eif e:i:ident="word" and e:i:size=1 and (e:i:0 cast Str)
668	e suckup e:i:0
669	if addressof:s=null
670	e add (instruction (the_function '. word' StrMatch Str -> CBool) sm e:i:0:result ok)
671	else
672	e add (instruction (the_function '. word' StrMatch Str Str -> CBool) sm s e:i:0:result ok)
673	s :> null map Argument
674	e add (instruction (the_function 'jump if not' CBool) ok jump end)
675	eif e:i:ident="acpattern" and e:i:size=1 and (e:i:0 cast Str)
676	e suckup e:i:0
677	if addressof:s=null
678	e add (instruction (the_function '. acpattern' StrMatch Str -> CBool) sm e:i:0:result ok)
679	else
680	e add (instruction (the_function '. acpattern' StrMatch Str Str -> CBool) sm s e:i:0:result ok)
681	s :> null map Argument
682	e add (instruction (the_function 'jump if not' CBool) ok jump end)
683	eif e:i:ident="acword" and e:i:size=1 and (e:i:0 cast Str)
684	e suckup e:i:0
685	if addressof:s=null
686	e add (instruction (the_function '. acword' StrMatch Str -> CBool) sm e:i:0:result ok)
687	else
688	e add (instruction (the_function '. acword' StrMatch Str Str -> CBool) sm s e:i:0:result ok)
689	s :> null map Argument
690	e add (instruction (the_function 'jump if not' CBool) ok jump end)
691	eif e:i:ident="any" and e:i:size=0 and addressof:s=null
692	s :> argument local Str
693	eif e:i:ident="any" and e:i:size=1 and (e:i:0 cast Str) and addressof:s=null
694	e suckup e:i:0
695	s :> e:i:0:result
696	eif e:i:ident="offset" and e:i:size=1 and (e:i:0 cast Int) and addressof:s=null
697	e suckup e:i:0
698	e add (instruction (the_function '. offset' StrMatch Int) sm e:i:0:result)
699	eif { e:i compile ; (addressof e:i:result)<>null } and { var Pointer:Function function :> e:i:result:type get_generic_method (the_function '. from string' Universal Str Str CBool Int Int -> Status):generic_index ; addressof:function<>null and addressof:function<>addressof:(the_function '. from string' Universal Str Str CBool Int Int -> Status) }
700	e suckup e:i
701	if addressof:s=null
702	e add (instruction (the_function '. from_string' StrMatch Universal Function -> CBool) sm e:i:result (argument mapped_constant Function function) ok)
703	else
704	e add (instruction (the_function '. from_string' StrMatch Str Universal Function -> CBool) sm s e:i:result (argument mapped_constant Function function) ok)
705	s :> null map Argument
706	e add (instruction (the_function 'jump if not' CBool) ok jump end)
707	else
708	return
709	if addressof:s=null
710	e add (instruction (the_function '. conclude' StrMatch Str -> CBool) sm e:0:result ok)
711	else
712	e add (instruction (the_function '. conclude' StrMatch Str Str -> CBool) sm s e:0:result ok)
713	e add end
714	e set_result ok access_read
715
716	meta '. parse' e
717	try_match e false
718
719	meta '. eparse' e
720	try_match e true
721
722	export '. parse' '. eparse'
723
724
725
726
727
728	constant to_index (the_function '. to string' Universal Str -> Str):generic_index
729
730	function to_string data options function -> string
731	arg Universal data ; arg Str options ; arg Function function ; arg Str string
732	indirect
733
734	meta string e
735	if e:size<1 or e:size>2
736	return
737	e:0:compile ?
738	if e:size=2 and not (e:1 cast Str)
739	return
740	var Pointer:Type type :> e:0:result:type:real_data_type
741	var Pointer:Function function :> type get_generic_method to_index
742	if addressof:function=null or addressof:function=addressof:(the_function '. to string' Universal Str -> Str)
743	return
744	e:0 cast type ?
745	e suckup e:0
746	var Link:Argument options
747	if e:size=2
748	e suckup e:1
749	options :> e:1:result
750	else
751	options :> argument constant Str ""
752	var Link:Argument result :> argument local Str
753	e add (instruction (the_function to_string Universal Str Function -> Str) e:0:result options (argument mapped_constant Function function) result)
754	e set_result result access_read
755
756	export string