1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
|
module CodeRay
module Scanners
# by Ralf Mueller
class Fortran < Scanner
register_for :fortran
# file extensions: f, f95, f03, f77, F90, inc (uppercase or lowercase)
file_extension 'f'
include Streamable
KEYWORDS = %w[
allocatable allocate assign assignment backspace
block call close common
contains continue cycle data deallocate
dimension endfile end entry equivalence exit
external format goto
implicit include inquire intent
intrinsic namelist none
nully only open operator optional parameter
pause pointer print private procedure
public read recursive result return
rewind save sequence stop
target use while write] +
# F95 keywords.
%w[elemental pure] +
# F2003
%w[abstract associate asynchronous bind class
deferred enum enumerator extends extends_type_of
final generic import non_intrinsic non_overridable
nopass pass protected same_type_as value volatile]
BLOCKS = %w[
do if interface function module program then case end else elseif elsewhere
enddo endif
select subroutine type where forall] +
# F2003.
%w[enum associate]
OPERATORS = %w[
and eq eqv false ge gt le lt ne neqv not or true]
TYPES = %w[
character complex integer logical real double precision]
PROCEDURES = %w[
abs achar acos adjustl adjustr aimag aint
all allocated anint any asin associated
atan atan2 bit_size btest ceiling char cmplx
conjg cos cosh count cshift date_and_time dble
digits dim dot_product dprod eoshift epsilon
exp exponent floor fraction huge iachar iand
ibclr ibits ibset ichar ieor index int ior
ishft ishftc kind lbound len len_trim lge lgt
lle llt log log10 matmul max
maxexponent maxloc maxval merge min minexponent
minloc minval mod modulo mvbits nearest nint
not pack precision present product radix] +
# Real is taken out here to avoid highlighting declarations.
%w[ random_number random_seed range
repeat reshape rrspacing scale scan
selected_int_kind selected_real_kind set_exponent
shape sign sin sinh size spacieg spread sqrt
sum system_clock tan tanh tiny transfer
transpose trim ubound unpack verify ] +
# F95 intrinsic functions.
%w[null cpu_time] +
# F2003.
%w[ move_alloc command_argument_count get_command
get_command_argument get_environment_variable
selected_char_kind wait flush new_line
extends extends_type_of same_type_as bind ] +
# F2003 ieee_arithmetic intrinsic module.
%w[ ieee_support_underflow_control ieee_get_underflow_mode
ieee_set_underflow_mode ] +
# F2003 iso_c_binding intrinsic module.
%w[ c_loc c_funloc c_associated c_f_pointer
c_f_procpointer ] +
# more intrinsic hpf
%w[all_prefix all_scatter all_suffix any_prefix
any_scatter any_suffix copy_prefix copy_scatter
copy_suffix count_prefix count_scatter count_suffix
grade_down grade_up
hpf_alignment hpf_distribution hpf_template iall iall_prefix
iall_scatter iall_suffix iany iany_prefix iany_scatter
iany_suffix ilen iparity iparity_prefix
iparity_scatter iparity_suffix leadz maxval_prefix
maxval_scatter maxval_suffix minval_prefix minval_scatter
minval_suffix number_of_processors parity
parity_prefix parity_scatter parity_suffix popcnt poppar
processors_shape product_prefix product_scatter
product_suffix sum_prefix sum_scatter sum_suffix] +
# Directives.
%w[align distribute dynamic independent inherit processors
realign redistribute template] +
# Keywords.
%w[block cyclic extrinsic new onto pure with]
CONSTANTS = %w[
# F2003 iso_fortran_env constants.
iso_fortran_env
input_unit output_unit error_unit
iostat_end iostat_eor
numeric_storage_size character_storage_size
file_storage_size] +
# F2003 iso_c_binding constants.
%w[iso_c_binding
c_int c_short c_long c_long_long c_signed_char
c_size_t
c_int8_t c_int16_t c_int32_t c_int64_t
c_int_least8_t c_int_least16_t c_int_least32_t
c_int_least64_t
c_int_fast8_t c_int_fast16_t c_int_fast32_t
c_int_fast64_t
c_intmax_t c_intptr_t
c_float c_double c_long_double
c_float_complex c_double_complex c_long_double_complex
c_bool c_char
c_null_char c_alert c_backspace c_form_feed
c_new_line c_carriage_return c_horizontal_tab
c_vertical_tab
c_ptr c_funptr c_null_ptr c_null_funptr
ieee_exceptions
ieee_arithmetic
ieee_features]
IDENT_KIND = CaseIgnoringWordList.new(:ident).
add(KEYWORDS ,:reserved).
add(BLOCKS ,:class).
add(OPERATORS ,:operator_fat).
add(PROCEDURES,:function).
add(TYPES ,:pre_type).
add(CONSTANTS ,:pre_constant)
ESCAPE = / [rbfnrtv\n\\'"] | x[a-fA-F0-9]{1,2} | [0-7]{1,3} /x
UNICODE_ESCAPE = / u[a-fA-F0-9]{4} | U[a-fA-F0-9]{8} /x
def scan_tokens tokens, options
state = :initial
until eos?
kind = nil
match = nil
case state
when :initial
if scan(/ \s+ | \\\n /x)
kind = :space
elsif scan(%r@ \! [^\n\\]* (?: \\. [^\n\\]* )* @imx)
kind = :comment
elsif match = scan(/ \# \s* if \s* 0 /x)
match << scan_until(/ ^\# (?:elif|else|endif) .*? $ | \z /xm) unless eos?
kind = :comment
elsif scan(/ [-+*\/=<>?:;,!&^|()\[\]{}~%]+ | \.(?!\d) /x)
kind = :operator_fat
elsif match = scan(/ [A-Za-z_][A-Za-z_0-9]* /x)
kind = IDENT_KIND[match]
if kind == :ident and check(/:(?!:)/)
match << scan(/:/)
kind = :label
end
elsif match = scan(/L?["']/)
tokens << [:open, :string]
if match[0] == ?L
tokens << ['L', :modifier]
match = '"'
end
state = :string
kind = :delimiter
elsif scan(/#\s*(\w*)/)
kind = :preprocessor # FIXME multiline preprocs
state = :include_expected if self[1] == 'include'
elsif scan(/0[xX][0-9A-Fa-f]+/)
kind = :hex
elsif scan(/(?:0[0-7]+)(?![89.eEfF])/)
kind = :oct
elsif scan(/[-+]?((\d+\.\d*|\.\d+)([ED][-+]?\d+(?!_)|(E[-+]?\d+)?_\w+)?|\d+([ED][-+]?\d+(?!_)|(E[-+]?\d+)?_\w+))/i)
kind = :float
elsif scan(/(?:\d+)(?![.eEfF])/)
kind = :integer
else
getch
kind = :error
end
when :string
if scan(/[^\\\n"']+/)
kind = :content
elsif md = scan(/["']/)
tokens << [md, :delimiter]
tokens << [:close, :string]
state = :initial
next
elsif scan(/ \\ (?: #{ESCAPE} | #{UNICODE_ESCAPE} ) /mox)
kind = :char
elsif scan(/ \\ | $ /x)
tokens << [:close, :string]
kind = :error
state = :initial
else
raise_inspect "else case \" reached; %p not handled." % peek(1), tokens
end
when :include_expected
if scan(/[^\n]+/)
kind = :include
state = :initial
elsif match = scan(/\s+/)
kind = :space
state = :initial if match.index ?\n
else
getch
kind = :error
end
else
raise_inspect 'Unknown state', tokens
end
match ||= matched
if $CODERAY_DEBUG and not kind
raise_inspect 'Error token %p in line %d' %
[[match, kind], line], tokens
end
raise_inspect 'Empty token', tokens unless match
tokens << [match, kind]
end
if state == :string
tokens << [:close, :string]
end
tokens
end
end
end
end
|
