Skip to content

Commit b8531ec

Browse files
aradiaradi
committed
Refactor fypp constructs
Added include file with common variables and functions. Removed unnecessary loop variables.
1 parent e64c6ea commit b8531ec

4 files changed

+102
-75
lines changed

‎src/common.fypp

Lines changed: 49 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,49 @@
1+
#:mute
2+
3+
#! Real kinds to be considered during templating
4+
#:set REAL_KINDS = ["sp", "dp", "qp"]
5+
6+
#! Real types to be considere during templating
7+
#:set REAL_TYPES = ["real({})".format(k) for k in REAL_KINDS]
8+
9+
#! Collected (kind, type) tuples for real types
10+
#:set REAL_KINDS_TYPES = list(zip(REAL_KINDS, REAL_TYPES))
11+
12+
13+
#! Integer kinds to be considered during templating
14+
#:set INT_KINDS = ["int8", "int16", "int32", "int64"]
15+
16+
#! Integer types to be considere during templating
17+
#:set INT_TYPES = ["integer({})".format(k) for k in INT_KINDS]
18+
19+
#! Collected (kind, type) tuples for integer types
20+
#:set INT_KINDS_TYPES = list(zip(INT_KINDS, INT_TYPES))
21+
22+
23+
#! Whether Fortran 90 compatible code should be generated
24+
#:set VERSION90 = defined('VERSION90')
25+
26+
27+
#! Ranks to be generated when templates are created
28+
#:if not defined('MAXRANK')
29+
#:if VERSION90
30+
#:set MAXRANK = 7
31+
#:else
32+
#:set MAXRANK = 15
33+
#:endif
34+
#:endif
35+
36+
37+
#! Generates an array rank suffix.
38+
#!
39+
#! Args:
40+
#! rank [in]: Integer with rank.
41+
#!
42+
#! Returns:
43+
#! Array rank suffix string (e.g. (:,:) if rank = 2)
44+
#!
45+
#:def ranksuffix(rank)
46+
#{if rank > 0}#(${":" + ",:" * (rank - 1)}$)#{endif}#
47+
#:enddef
48+
49+
#:endmute

‎src/stdlib_experimental_io.fypp

Lines changed: 9 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,9 @@
1-
module stdlib_experimental_io
1+
#:include "common.fypp"
2+
3+
#:set KINDS_TYPES = REAL_KINDS_TYPES + INT_KINDS_TYPES
24

3-
#:set REALKINDS = ["sp", "dp", "qp"]
4-
#:set INTKINDS = ["int8", "int16", "int32", "int64"]
5-
#:set REALTYPES = ["real({})".format(k) for k in REALKINDS]
6-
#:set INTTYPES = ["integer({})".format(k) for k in INTKINDS]
7-
#:set KINDS = REALKINDS + INTKINDS
8-
#:set TYPES = REALTYPES + INTTYPES
9-
#:set ikt = list(zip(range(len(KINDS)), KINDS, TYPES))
5+
6+
module stdlib_experimental_io
107

118
use stdlib_experimental_kinds, only: sp, dp, qp, &
129
int8, int16, int32, int64
@@ -22,20 +19,20 @@ public :: loadtxt, savetxt, open
2219
public :: parse_mode
2320

2421
interface loadtxt
25-
#:for i1, k1, t1 in ikt
22+
#:for k1, _ in KINDS_TYPES
2623
module procedure loadtxt_${k1}$
2724
#:endfor
2825
end interface
2926

3027
interface savetxt
31-
#:for i1, k1, t1 in ikt
28+
#:for k1, _ in KINDS_TYPES
3229
module procedure savetxt_${k1}$
3330
#:endfor
3431
end interface
3532

3633
contains
3734

38-
#:for i1, k1, t1 in ikt
35+
#:for k1, t1 in KINDS_TYPES
3936
subroutine loadtxt_${k1}$(filename, d)
4037
! Loads a 2D array from a text file.
4138
!
@@ -80,7 +77,7 @@ close(s)
8077
end subroutine
8178
#:endfor
8279

83-
#:for i1, k1, t1 in ikt
80+
#:for k1, t1 in KINDS_TYPES
8481
subroutine savetxt_${k1}$(filename, d)
8582
! Saves a 2D array into a text file.
8683
!

‎src/stdlib_experimental_stats.fypp

Lines changed: 20 additions & 33 deletions
Original file line numberDiff line numberDiff line change
@@ -1,13 +1,11 @@
1-
module stdlib_experimental_stats
1+
#:include "common.fypp"
2+
3+
#:set REAL_KINDS_TYPES = REAL_KINDS_TYPES
4+
#:set INT_KINDS_TYPES = INT_KINDS_TYPES
5+
#:set RANKS = range(3, MAXRANK + 1)
26

3-
#:set VERSION90 = defined('VERSION90')
4-
#:set REALKINDS = ["sp", "dp", "qp"]
5-
#:set INTKINDS = ["int8", "int16", "int32", "int64"]
6-
#:set REALTYPES = ["real({})".format(k) for k in REALKINDS]
7-
#:set INTTYPES = ["integer({})".format(k) for k in INTKINDS]
8-
#:set iktr = list(zip(range(len(REALKINDS)), REALKINDS, REALTYPES))
9-
#:set ikti = list(zip(range(len(INTKINDS)), INTKINDS, INTTYPES))
107

8+
module stdlib_experimental_stats
119
use stdlib_experimental_kinds, only: sp, dp, qp, &
1210
int8, int16, int32, int64
1311
implicit none
@@ -16,44 +14,44 @@ private
1614
public :: mean
1715

1816
interface mean
19-
#:for i1, k1, t1 in iktr
17+
#:for k1, t1 in REAL_KINDS_TYPES
2018
module function mean_1_${k1}$_${k1}$(x) result(res)
2119
${t1}$, intent(in) :: x(:)
2220
${t1}$ :: res
2321
end function mean_1_${k1}$_${k1}$
2422
#:endfor
2523

26-
#:for i1, k1, t1 in ikti
24+
#:for k1, t1 in INT_KINDS_TYPES
2725
module function mean_1_${k1}$_dp(x) result(res)
2826
${t1}$, intent(in) :: x(:)
2927
real(dp) :: res
3028
end function mean_1_${k1}$_dp
3129
#:endfor
3230

3331

34-
#:for i1, k1, t1 in iktr
32+
#:for k1, t1 in REAL_KINDS_TYPES
3533
module function mean_2_all_${k1}$_${k1}$(x) result(res)
3634
${t1}$, intent(in) :: x(:,:)
3735
${t1}$ :: res
3836
end function mean_2_all_${k1}$_${k1}$
3937
#:endfor
4038

41-
#:for i1, k1, t1 in ikti
39+
#:for k1, t1 in INT_KINDS_TYPES
4240
module function mean_2_all_${k1}$_dp(x) result(res)
4341
${t1}$, intent(in) :: x(:,:)
4442
real(dp) :: res
4543
end function mean_2_all_${k1}$_dp
4644
#:endfor
4745

48-
#:for i1, k1, t1 in iktr
46+
#:for k1, t1 in REAL_KINDS_TYPES
4947
module function mean_2_${k1}$_${k1}$(x, dim) result(res)
5048
${t1}$, intent(in) :: x(:,:)
5149
integer, intent(in) :: dim
5250
${t1}$ :: res(merge(size(x, 1), size(x, 2), mask = 1 < dim ))
5351
end function mean_2_${k1}$_${k1}$
5452
#:endfor
5553

56-
#:for i1, k1, t1 in ikti
54+
#:for k1, t1 in INT_KINDS_TYPES
5755
module function mean_2_${k1}$_dp(x, dim) result(res)
5856
${t1}$, intent(in) :: x(:,:)
5957
integer, intent(in) :: dim
@@ -62,39 +60,28 @@ interface mean
6260
#:endfor
6361

6462

65-
#:def ranksuffix(rank)
66-
#{if rank > 0}#(${":" + ",:" * (rank - 1)}$)#{endif}#
67-
#:enddef
68-
69-
#:if defined('MAXRANK')
70-
#:set ranks = range(3,MAXRANK+1)
71-
#:elif VERSION90
72-
#:set ranks = range(3,8)
73-
#:else
74-
#:set ranks = range(3,16)
75-
#:endif
7663

7764

78-
#:for i1, k1, t1 in iktr
79-
#:for rank in ranks
65+
#:for k1, t1 in REAL_KINDS_TYPES
66+
#:for rank in RANKS
8067
module function mean_${rank}$_all_${k1}$_${k1}$(x) result(res)
8168
${t1}$, intent(in) :: x${ranksuffix(rank)}$
8269
${t1}$ :: res
8370
end function mean_${rank}$_all_${k1}$_${k1}$
8471
#:endfor
8572
#:endfor
8673

87-
#:for i1, k1, t1 in ikti
88-
#:for rank in ranks
74+
#:for k1, t1 in INT_KINDS_TYPES
75+
#:for rank in RANKS
8976
module function mean_${rank}$_all_${k1}$_dp(x) result(res)
9077
${t1}$, intent(in) :: x${ranksuffix(rank)}$
9178
real(dp) :: res
9279
end function mean_${rank}$_all_${k1}$_dp
9380
#:endfor
9481
#:endfor
9582

96-
#:for i1, k1, t1 in iktr
97-
#:for rank in ranks
83+
#:for k1, t1 in REAL_KINDS_TYPES
84+
#:for rank in RANKS
9885
module function mean_${rank}$_${k1}$_${k1}$(x, dim) result(res)
9986
${t1}$, intent(in) :: x${ranksuffix(rank)}$
10087
integer, intent(in) :: dim
@@ -107,8 +94,8 @@ interface mean
10794
#:endfor
10895
#:endfor
10996

110-
#:for i1, k1, t1 in ikti
111-
#:for rank in ranks
97+
#:for k1, t1 in INT_KINDS_TYPES
98+
#:for rank in RANKS
11299
module function mean_${rank}$_${k1}$_dp(x, dim) result(res)
113100
${t1}$, intent(in) :: x${ranksuffix(rank)}$
114101
integer, intent(in) :: dim

‎src/stdlib_experimental_stats_mean.fypp

Lines changed: 24 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -1,19 +1,18 @@
1-
submodule (stdlib_experimental_stats) stdlib_experimental_stats_mean
1+
#:include "common.fypp"
2+
3+
#:set REAL_KINDS_TYPES = REAL_KINDS_TYPES
4+
#:set INT_KINDS_TYPES = INT_KINDS_TYPES
5+
#:set RANKS = range(3, MAXRANK + 1)
26

3-
#:set VERSION90 = defined('VERSION90')
4-
#:set REALKINDS = ["sp", "dp", "qp"]
5-
#:set INTKINDS = ["int8", "int16", "int32", "int64"]
6-
#:set REALTYPES = ["real({})".format(k) for k in REALKINDS]
7-
#:set INTTYPES = ["integer({})".format(k) for k in INTKINDS]
8-
#:set iktr = list(zip(range(len(REALKINDS)), REALKINDS, REALTYPES))
9-
#:set ikti = list(zip(range(len(INTKINDS)), INTKINDS, INTTYPES))
7+
8+
submodule (stdlib_experimental_stats) stdlib_experimental_stats_mean
109

1110
use stdlib_experimental_error, only: error_stop
1211
implicit none
1312

1413
contains
1514

16-
#:for i1, k1, t1 in iktr
15+
#:for k1, t1 in REAL_KINDS_TYPES
1716
module function mean_1_${k1}$_${k1}$(x) result(res)
1817
${t1}$, intent(in) :: x(:)
1918
${t1}$ :: res
@@ -23,7 +22,8 @@ module function mean_1_${k1}$_${k1}$(x) result(res)
2322
end function mean_1_${k1}$_${k1}$
2423
#:endfor
2524

26-
#:for i1, k1, t1 in ikti
25+
26+
#:for k1, t1 in INT_KINDS_TYPES
2727
module function mean_1_${k1}$_dp(x) result(res)
2828
${t1}$, intent(in) :: x(:)
2929
real(dp) :: res
@@ -34,7 +34,7 @@ end function mean_1_${k1}$_dp
3434
#:endfor
3535

3636

37-
#:for i1, k1, t1 in iktr
37+
#:for k1, t1 in REAL_KINDS_TYPES
3838
module function mean_2_all_${k1}$_${k1}$(x) result(res)
3939
${t1}$, intent(in) :: x(:,:)
4040
${t1}$ :: res
@@ -44,7 +44,8 @@ module function mean_2_all_${k1}$_${k1}$(x) result(res)
4444
end function mean_2_all_${k1}$_${k1}$
4545
#:endfor
4646

47-
#:for i1, k1, t1 in ikti
47+
48+
#:for k1, t1 in INT_KINDS_TYPES
4849
module function mean_2_all_${k1}$_dp(x) result(res)
4950
${t1}$, intent(in) :: x(:,:)
5051
real(dp) :: res
@@ -54,7 +55,8 @@ module function mean_2_all_${k1}$_dp(x) result(res)
5455
end function mean_2_all_${k1}$_dp
5556
#:endfor
5657

57-
#:for i1, k1, t1 in iktr
58+
59+
#:for k1, t1 in REAL_KINDS_TYPES
5860
module function mean_2_${k1}$_${k1}$(x, dim) result(res)
5961
${t1}$, intent(in) :: x(:,:)
6062
integer, intent(in) :: dim
@@ -72,7 +74,8 @@ module function mean_2_${k1}$_${k1}$(x, dim) result(res)
7274
end function mean_2_${k1}$_${k1}$
7375
#:endfor
7476

75-
#:for i1, k1, t1 in ikti
77+
78+
#:for k1, t1 in INT_KINDS_TYPES
7679
module function mean_2_${k1}$_dp(x, dim) result(res)
7780
${t1}$, intent(in) :: x(:,:)
7881
integer, intent(in) :: dim
@@ -91,19 +94,7 @@ end function mean_2_${k1}$_dp
9194
#:endfor
9295

9396

94-
#:def ranksuffix(rank)
95-
#{if rank > 0}#(${":" + ",:" * (rank - 1)}$)#{endif}#
96-
#:enddef
97-
98-
#:if defined('MAXRANK')
99-
#:set ranks = range(3,MAXRANK+1)
100-
#:elif VERSION90
101-
#:set ranks = range(3,8)
102-
#:else
103-
#:set ranks = range(3,16)
104-
#:endif
105-
106-
#:for i1, k1, t1 in iktr
97+
#:for k1, t1 in REAL_KINDS_TYPES
10798
#:for rank in ranks
10899
module function mean_${rank}$_all_${k1}$_${k1}$(x) result(res)
109100
${t1}$, intent(in) :: x${ranksuffix(rank)}$
@@ -115,7 +106,8 @@ end function mean_${rank}$_all_${k1}$_${k1}$
115106
#:endfor
116107
#:endfor
117108

118-
#:for i1, k1, t1 in ikti
109+
110+
#:for k1, t1 in INT_KINDS_TYPES
119111
#:for rank in ranks
120112
module function mean_${rank}$_all_${k1}$_dp(x) result(res)
121113
${t1}$, intent(in) :: x${ranksuffix(rank)}$
@@ -127,7 +119,8 @@ end function mean_${rank}$_all_${k1}$_dp
127119
#:endfor
128120
#:endfor
129121

130-
#:for i1, k1, t1 in iktr
122+
123+
#:for k1, t1 in REAL_KINDS_TYPES
131124
#:for rank in ranks
132125
module function mean_${rank}$_${k1}$_${k1}$(x, dim) result(res)
133126
${t1}$, intent(in) :: x${ranksuffix(rank)}$
@@ -151,7 +144,8 @@ end function mean_${rank}$_${k1}$_${k1}$
151144
#:endfor
152145
#:endfor
153146

154-
#:for i1, k1, t1 in ikti
147+
148+
#:for k1, t1 in INT_KINDS_TYPES
155149
#:for rank in ranks
156150
module function mean_${rank}$_${k1}$_dp(x, dim) result(res)
157151
${t1}$, intent(in) :: x${ranksuffix(rank)}$

0 commit comments

Comments
 (0)