/pliant/language/type/text/char.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
20	type Char
21	field Byte raw
22
23
24	function character i -> c
25	arg Int i ; arg Char c
26	has_no_side_effect ; gcc_inline "*(unsigned char *)@2 = $1;"
27	memory_copy addressof:i addressof:c 1
28
29	method c number -> i
30	arg Char c ; arg Int i
31	has_no_side_effect ; gcc_inline "$2 = *(unsigned char *)@1;"
32	i := 0
33	memory_copy addressof:c addressof:i 1
34
35
36	function compare a b -> c
37	arg Char a b ; arg Int c
38	gcc_inline "$3 = *(unsigned char *)@1<*(unsigned char *)@2 ? "+'convert to string':compare_inferior+" : *(unsigned char *)@1>*(unsigned char *)@2 ? "+'convert to string':compare_superior+" : "+'convert to string':compare_equal+";"
39	gcc_inline_compare "$3 = *(unsigned char *)@1 compare *(unsigned char *)@2;"
40	c := compare a:number b:number
41
42
43	export Char character '. number' compare
44
45
46
47
48
49	method s '' i -> c ## section "map one char"
50	arg Str s ; arg Int i ; arg_C Char c
51	check i>=0 and i<s:len "out of range character index"
52	c :> (s:characters translate Char i) map Char
53	# ((the_function '' Str Int -> Char) arg 2) maps := 1
54
55	export ''
56
57
58	function cast_Char_Str c -> s ## section "cast to string"
59	arg Char c ; arg Str s
60	extension ; has_no_side_effect
61	s set (memory_allocate 1 addressof:s) 1 true
62	s 0 := c
63
64	alias 'cast Str' cast_Char_Str in "/pliant/language/basic/ultrasafe.pli"
65
66
67
68
69
70	function parse_char context line parameter
71	arg_rw ParserContext context ; arg Str line ; arg Address parameter
72	if line:len<2 or line:0<>"[dq]":0
73	return
74	var Char c ; var Int l
75	if line:1<>"[lb]":0 and line:1<>"[rb]":0 and line:1<>"[dq]":0
76	c := line 1 ; l := 1
77	eif (line 1 4)="[lb]lb[rb]"
78	c := "[lb]" 0 ; l := 4
79	eif (line 1 4)="[lb]rb[rb]"
80	c := "[rb]" 0 ; l := 4
81	eif (line 4 3)="[lb]dq[rb]"
82	c := "[dq]" 0 ; l := 4
83	eif (line 1 4)="[lb]cr[rb]"
84	c := "[cr]" 0 ; l := 4
85	eif (line 1 4)="[lb]lf[rb]"
86	c := "[lf]" 0 ; l := 4
87	eif (line 1 3)="[lb]0[rb]"
88	c := "[0]" 0 ; l := 3
89	eif (line 1 5)="[lb]tab[rb]"
90	c := "[tab]" 0 ; l := 5
91	else
92	return
93	if (line 1+l 1)="[dq]"
94	var Link:Char cc :> new Char ; cc := c
95	context add_token addressof:cc
96	context forward l+2
97
98	gvar ParserFilter char_filter
99	char_filter function :> the_function parse_char ParserContext Str Address
100	constant 'pliant parser basic types' char_filter
101	export 'pliant parser basic types'
102
103
104
105
106
107	method c isidentcharacter -> r
108	arg Char c ; arg CBool r
109	if c:number>="A":number and c:number<="Z":number
110	return true
111	eif c:number>="a":number and c:number<="z":number
112	return true
113	eif c:number>="0":number and c:number<="9":number
114	return true
115	eif c:number="_":number
116	return true
117	else
118	return false
119
120
121	export '. isidentcharacter'
122
123
124
125
126	module "/pliant/language/data/string_cast.pli"
127
128
129	method data 'to string' options -> string
130	arg Char data ; arg Str options ; arg Str string
131	var Str s := data
132	string := to_string addressof:s Str options
133
134
135	method data 'from string' string options may_skip skiped offset -> status
136	arg_w Char data ; arg Str string options ; arg CBool may_skip ; arg_w Int skiped offset ; arg Status status
137	status := from_string addressof:(var Str s) Str string options may_skip skiped offset
138	if status=failure
139	data := " "
140	void
141	eif s:len<>1
142	data := " "
143	status := failure
144	else
145	data := s 0