source: XMLF90/src/sax/m_charset.f90 @ 295

Last change on this file since 295 was 6, checked in by ymipsl, 12 years ago

Import des sources XMLF90

File size: 4.9 KB
Line 
1module m_charset
2!
3! One-byte only, sorry
4!
5private
6
7integer, parameter, private  :: small_int = selected_int_kind(1)
8
9!--------------------------------------------------------------------------
10type, public :: charset_t
11! private
12      integer(kind=small_int), dimension(0:255) :: mask
13end type charset_t
14
15
16public  :: operator(.in.), operator(+)
17public  :: assignment(=)
18public  :: print_charset, reset_charset
19
20interface operator(.in.)
21      module procedure belongs
22end interface
23private :: belongs
24
25interface assignment(=)
26      module procedure set_string_to_charset, set_codes_to_charset
27end interface
28private ::  set_string_to_charset, set_codes_to_charset
29
30interface operator(+)
31      module procedure add_string_to_charset, &
32                       add_code_to_charset, add_codes_to_charset
33end interface
34private :: add_string_to_charset, add_code_to_charset, add_codes_to_charset
35
36!--------------------------------------------------------------------------
37
38character(len=*), parameter, private :: &
39            lowercase = "abcdefghijklmnopqrstuvwxyz",  & 
40            uppercase = "ABCDEFGHIJKLMNOPQRSTUVWXYZ", &
41            digits    = "0123456789"
42
43integer, parameter, public   :: SPACE           = 32
44integer, parameter, public   :: NEWLINE         = 10
45integer, parameter, public   :: CARRIAGE_RETURN = 13
46integer, parameter, public   :: TAB             =  9
47
48type(charset_t), public    :: initial_name_chars
49type(charset_t), public    :: name_chars
50type(charset_t), public    :: whitespace
51type(charset_t), public    :: valid_chars
52type(charset_t), public    :: uppercase_chars
53
54public  :: setup_xml_charsets
55
56
57CONTAINS !==========================================================
58
59!--------------------------------------------------------------
60function belongs(c,charset)  result(res)
61character(len=1), intent(in)  :: c
62type(charset_t), intent(in)   :: charset
63logical                       :: res
64
65integer  :: code
66
67code = ichar(c)
68res = (charset%mask(code) == 1)
69
70end function belongs
71
72!--------------------------------------------------------------
73
74function add_string_to_charset(charset,str)  result (sum)
75type(charset_t), intent(in)      :: charset
76character(len=*), intent(in)     :: str
77type(charset_t)                  :: sum
78
79integer :: length, code, i
80
81sum%mask = charset%mask
82
83length = len_trim(str)
84do i = 1, length
85      code = ichar(str(i:i))
86      sum%mask(code) = 1
87enddo
88end function add_string_to_charset
89
90!--------------------------------------------------------------
91
92function add_code_to_charset(charset,code) result(sum)
93type(charset_t), intent(in)      :: charset
94integer, intent(in)              :: code
95type(charset_t)                  :: sum
96
97if ((code > 255) .or. (code < 0)) return
98sum%mask = charset%mask
99sum%mask(code) = 1
100
101end function add_code_to_charset
102
103!--------------------------------------------------------------
104function add_codes_to_charset(charset,codes) result(sum)
105type(charset_t), intent(in)        :: charset
106integer, dimension(:), intent(in)  :: codes
107type(charset_t)                    :: sum
108
109integer  :: i
110
111sum%mask = charset%mask
112do i = 1, size(codes)
113      if ((codes(i) > 255) .or. (codes(i) < 0)) cycle
114      sum%mask(codes(i)) = 1
115enddo
116end function add_codes_to_charset
117
118!--------------------------------------------------------------
119
120subroutine set_string_to_charset(charset,str)     
121type(charset_t), intent(out)   :: charset
122character(len=*), intent(in)   :: str
123
124
125integer :: length, code, i
126
127charset%mask = 0
128
129length = len_trim(str)
130do i = 1, length
131      code = ichar(str(i:i))
132      charset%mask(code) = 1
133enddo
134
135end subroutine set_string_to_charset
136
137!--------------------------------------------------------------
138
139subroutine set_codes_to_charset(charset,codes)     
140type(charset_t), intent(out)   :: charset
141integer, dimension(:), intent(in)  :: codes
142
143integer :: i
144
145charset%mask = 0
146
147do i = 1, size(codes)
148      charset%mask(codes(i)) = 1
149enddo
150
151end subroutine set_codes_to_charset
152
153
154!--------------------------------------------------------------
155subroutine print_charset(charset)     
156type(charset_t), intent(in)   :: charset
157
158integer :: i
159
160do i = 0, 255
161      if (charset%mask(i) == 1) print *, "Code: ", i
162enddo
163end subroutine print_charset
164
165!--------------------------------------------------------------
166
167subroutine reset_charset(charset)     
168type(charset_t), intent(inout)   :: charset
169
170integer :: i
171
172do i = 0, 255
173      charset%mask(i) = 0
174enddo
175end subroutine reset_charset
176
177!--------------------------------------------------------------
178
179!--------------------------------------------------------
180subroutine setup_xml_charsets()
181
182integer :: i
183
184uppercase_chars = uppercase
185initial_name_chars = (lowercase  // uppercase //  "_:" )
186name_chars = initial_name_chars + ( digits // ".-")
187whitespace = (/ SPACE, NEWLINE, TAB, CARRIAGE_RETURN /)
188
189valid_chars = whitespace + (/ (i, i=33,255) /)
190
191end subroutine setup_xml_charsets
192!--------------------------------------------------------
193
194end module m_charset
195
196
197
198
199
200
201
202
203
Note: See TracBrowser for help on using the repository browser.