Skip to content

Commit 87825b0

Browse files
jacobwilliamsjacobwilliams
committed
minor updates.
1 parent 2a6fd9e commit 87825b0

File tree

3 files changed

+58
-57
lines changed

3 files changed

+58
-57
lines changed

‎LICENSE‎

Lines changed: 36 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,38 @@
1+
Fortran Function Parser
2+
https://github.com/jacobwilliams/fortran_function_parser
3+
4+
Copyright (c) 2017, Jacob Williams
5+
All rights reserved.
6+
7+
Redistribution and use in source and binary forms, with or without modification,
8+
are permitted provided that the following conditions are met:
9+
10+
* Redistributions of source code must retain the above copyright notice, this
11+
list of conditions and the following disclaimer.
12+
13+
* Redistributions in binary form must reproduce the above copyright notice, this
14+
list of conditions and the following disclaimer in the documentation and/or
15+
other materials provided with the distribution.
16+
17+
* The names of its contributors may not be used to endorse or promote products
18+
derived from this software without specific prior written permission.
19+
20+
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
21+
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
22+
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
23+
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR
24+
ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
25+
(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
26+
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
27+
ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
28+
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
29+
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
30+
31+
--------------------------------------------------------------------------------
32+
Original FPARSER v1.1 License
33+
--------------------------------------------------------------------------------
34+
135
Copyright (c) 2000-2008, Roland Schmehl.
2-
Copyright (c) 2017, Jacob Williams.
336

437
All rights reserved.
538

@@ -29,3 +62,5 @@ DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
2962
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
3063
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
3164
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
65+
66+
--------------------------------------------------------------------------------

‎README.md‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -111,7 +111,7 @@ as explicit constants these must conform to the format
111111
where `nnn` means any number of digits. The mantissa must contain at least
112112
one digit before or following an optional decimal point. Valid exponent
113113
identifiers are 'e', 'E', 'd' or 'D'. If they appear they must be followed
114-
by a valid exponent!
114+
by a valid exponent.
115115

116116
### Notes
117117

‎src/function_parser.f90‎

Lines changed: 21 additions & 55 deletions
Original file line numberDiff line numberDiff line change
@@ -22,40 +22,6 @@
2222
! * Copyright (c) 2017, Jacob Williams. All rights reserved.
2323
! * This software is distributable under the BSD license. See the terms of the
2424
! BSD license in the documentation provided with this software.
25-
!
26-
!### Function string syntax
27-
!
28-
! Although they have to be passed as array elements of the same declared
29-
! length (Fortran restriction), the variable names can be of arbitrary
30-
! actual length for the parser. Parsing for variables can be case sensitive
31-
! or insensitive, depanding on input flag to the parser function.
32-
!
33-
! The syntax of the function string is similar to the Fortran convention.
34-
! Mathematical Operators recognized are `+`, `-,` `*,` `/,` `**` or alternatively `^`,
35-
! whereas symbols for brackets must be `()`.
36-
!
37-
! The function parser recognizes the (single argument) Fortran 90 intrinsic
38-
! functions `abs`, `exp`, `log10`, `log`, `sqrt`, `sinh`, `cosh`, `tanh`,
39-
! `sin`, `cos`, `tan`, `asin`, `acos`, `atan`.
40-
! Parsing for intrinsic functions is always case INsensitive.
41-
!
42-
! Operations are evaluated in the correct order:
43-
!
44-
! * `() ` expressions in brackets first
45-
! * `-A ` unary minus (or plus)
46-
! * `A**B A^B` exponentiation (`A` raised to the power `B`)
47-
! * `A*B A/B` multiplication and division
48-
! * `A+B A-B` addition and subtraction
49-
!
50-
! The function string can contain integer or real constants. To be recognized
51-
! as explicit constants these must conform to the format:
52-
!
53-
! `[+|-][nnn][.nnn][e|E|d|D[+|-]nnn]`
54-
!
55-
! where `nnn` means any number of digits. The mantissa must contain at least
56-
! one digit before or following an optional decimal point. Valid exponent
57-
! identifiers are 'e', 'E', 'd' or 'D'. If they appear they must be followed
58-
! by a valid exponent.
5925

6026
module function_parser
6127

@@ -125,12 +91,13 @@ module function_parser
12591
integer,parameter :: error_asin_arg_illegal = 4
12692
integer,parameter :: error_acos_arg_illegal = 5
12793
integer,parameter :: error_invalid_operation = 6
128-
character(len=25),dimension(6),parameter :: error_messages = [ 'Division by zero ', & !1
129-
'Argument of SQRT negative', & !2
130-
'Argument of LOG negative ', & !3
131-
'Argument of ASIN illegal ', & !4
132-
'Argument of ACOS illegal ', & !5
133-
'Invalid operation ' ]
94+
character(len=25),dimension(6),parameter :: error_messages = &
95+
[ 'Division by zero ', & ! 1
96+
'Argument of SQRT negative', & ! 2
97+
'Argument of LOG negative ', & ! 3
98+
'Argument of ASIN illegal ', & ! 4
99+
'Argument of ACOS illegal ', & ! 5
100+
'Invalid operation ' ]
134101

135102
type stack_func_container
136103
!! to create an array of the function pointers in the fparser
@@ -253,7 +220,7 @@ subroutine parse_function (me, funcstr, var, case_sensitive, error_msg)
253220
character(len=*),intent(in) :: funcstr !! function string
254221
character(len=*), dimension(:), intent(in) :: var !! array with variable names
255222
logical,intent(in) :: case_sensitive !! are the variables case sensitive?
256-
type(list_of_errors),intent(out) :: error_msg !! list of error messages
223+
type(list_of_errors),intent(out) :: error_msg !! list of error messages
257224

258225
character (len=len(funcstr)) :: func !! function string, local use
259226
character(len=len(var)),dimension(size(var)) :: tmp_var !! variable list, local use
@@ -292,7 +259,7 @@ subroutine evaluate_function (me, val, res, error_msg)
292259

293260
class(fparser),intent(inout) :: me
294261
real(wp), dimension(:), intent(in) :: val !! variable values
295-
type(list_of_errors),intent(out) :: error_msg !! error message list
262+
type(list_of_errors),intent(out) :: error_msg !! error message list
296263
real(wp),intent(out) :: res !! result
297264

298265
integer :: ip !! instruction pointer
@@ -332,7 +299,7 @@ subroutine parse_function_array (me, funcstr, var, case_sensitive, error_msg)
332299
character(len=*),dimension(:),intent(in) :: funcstr !! function string array
333300
character(len=*),dimension(:),intent(in) :: var !! array with variable names
334301
logical,intent(in) :: case_sensitive !! are the variables case sensitive?
335-
type(list_of_errors),intent(out) :: error_msg !! list of error messages
302+
type(list_of_errors),intent(out) :: error_msg !! list of error messages
336303

337304
integer :: i !! counter
338305
integer :: n_funcs !! number of functions in the class
@@ -361,7 +328,7 @@ subroutine evaluate_function_array (me, val, res, error_msg)
361328

362329
class(fparser_array),intent(inout) :: me
363330
real(wp), dimension(:), intent(in) :: val !! variable values
364-
type(list_of_errors),intent(out) :: error_msg !! error message list
331+
type(list_of_errors),intent(out) :: error_msg !! error message list
365332
real(wp),dimension(:),intent(out) :: res !! result. Should be `size(me%f)`
366333

367334
integer :: i !! counter
@@ -889,7 +856,7 @@ subroutine check_syntax (func,funcstr,var,ipos,error_msg)
889856
character(len=*),intent(in) :: funcstr !! original function string
890857
character(len=*), dimension(:),intent(in) :: var !! array with variable names
891858
integer,dimension(:),intent(in) :: ipos
892-
type(list_of_errors),intent(inout) :: error_msg !! list of error messages
859+
type(list_of_errors),intent(inout) :: error_msg !! list of error messages
893860

894861
integer :: n
895862
character(len=1) :: c
@@ -1031,7 +998,7 @@ subroutine add_error_message_to_list (j, ipos, funcstr, error_msg, msg)
1031998
integer,intent(in) :: j
1032999
integer,dimension(:),intent(in) :: ipos
10331000
character(len=*),intent(in) :: funcstr !! original function string
1034-
type(list_of_errors),intent(inout) :: error_msg !! list of error messages
1001+
type(list_of_errors),intent(inout) :: error_msg !! list of error messages
10351002
character(len=*),optional,intent(in) :: msg
10361003

10371004
character(len=:),allocatable :: tmp !! to indicate where on
@@ -1196,7 +1163,7 @@ end subroutine replace_string
11961163

11971164
!*******************************************************************************
11981165
!>
1199-
! Compile function string F into bytecode
1166+
! Compile function string `f` into bytecode
12001167
!
12011168
!@note This is not very efficient since it is parsing it twice
12021169
! just to get the size of all the arrays.
@@ -1208,18 +1175,17 @@ subroutine compile (me, f, var, error_msg)
12081175
class(fparser),intent(inout) :: me
12091176
character(len=*),intent(in) :: f !! function string
12101177
character(len=*),dimension(:),intent(in) :: var !! array with variable names
1211-
type(list_of_errors),intent(inout) :: error_msg !! list of error messages
1212-
1213-
integer :: istat
1178+
type(list_of_errors),intent(inout) :: error_msg !! list of error messages
12141179

1215-
if (allocated(me%bytecode)) deallocate( me%bytecode,me%immed,me%stack,me%bytecode_ops )
1180+
integer :: istat !! allocation status flag
12161181

12171182
me%bytecodesize = 0
12181183
me%immedsize = 0
12191184
me%stacksize = 0
12201185
me%stackptr = 0
12211186

1222-
call compile_substr (me,f,1,len_trim(f),var) ! compile string to determine size
1187+
! compile string to determine size:
1188+
call compile_substr (me,f,1,len_trim(f),var)
12231189

12241190
allocate ( me%bytecode(me%bytecodesize), &
12251191
me%bytecode_ops(me%bytecodesize), &
@@ -1445,10 +1411,10 @@ end subroutine compile_substr
14451411

14461412
!*******************************************************************************
14471413
!>
1448-
! Check if operator `F(j:j)` in string `F` is binary operator.
1414+
! Check if operator `f(j:j)` in string `f` is binary operator.
14491415
!
14501416
! Special cases already covered elsewhere: (that is corrected in v1.1)
1451-
! * operator character `F(j:j)` is first character of string (`j=1`)
1417+
! * operator character `f(j:j)` is first character of string (`j=1`)
14521418

14531419
function is_binary_operator (j, f) result (res)
14541420

@@ -1465,7 +1431,7 @@ function is_binary_operator (j, f) result (res)
14651431
if (f(j:j) == '+' .or. f(j:j) == '-') then ! plus or minus sign:
14661432
if (j == 1) then ! - leading unary operator ?
14671433
res = .false.
1468-
elseif (scan(f(j-1:j-1),'+-*/^(') > 0) then ! - other unary operator ?
1434+
elseif (scan(f(j-1:j-1),'+-*/^(') > 0) then ! - other unary operator ?
14691435
res = .false.
14701436
elseif (scan(f(j+1:j+1),'0123456789') > 0 .and. & ! - in exponent of real number ?
14711437
scan(f(j-1:j-1),'eEdD') > 0) then

0 commit comments

Comments
 (0)