subroutinearithmeticrecursiveprivate
recursive subroutine arithmetic(c, kind, a, b, v)
a + b, a - b or a * b.
Arguments
| Name | Type | Intent | Attributes | Description |
|---|---|---|---|---|
| c | type(fypp_t) | inout | the state | |
| kind | integer | in | which | |
| a | type(value_t) | in | the first operand | |
| b | type(value_t) | in | the second operand | |
| v | type(value_t) | out | the result |
Calls
Source
Show the code
recursive subroutine arithmetic(c, kind, a, b, v)
type(fypp_t), intent(inout) :: c !! the state
integer, intent(in) :: kind !! which
type(value_t), intent(in) :: a !! the first operand
type(value_t), intent(in) :: b !! the second operand
type(value_t), intent(out) :: v !! the result
type(buffer_t) :: text
character(len=:), allocatable :: joined
integer :: k, n, base
logical :: a_number, b_number
a_number = a%kind == V_INT .or. a%kind == V_BOOL
b_number = b%kind == V_INT .or. b%kind == V_BOOL
if (a_number .and. b_number) then
select case (kind)
case (E_ADD); call make_int(a%number + b%number, v)
case (E_SUB); call make_int(a%number - b%number, v)
case default; call make_int(a%number*b%number, v)
end select
else if (kind == E_ADD .and. a%kind == V_STR .and. b%kind == V_STR) then
call make_string(a%text//b%text, v)
else if (kind == E_ADD .and. a%kind == b%kind .and. (a%kind == V_LIST .or. a%kind == V_TUPLE)) then
v%kind = a%kind
n = size(a%items)
allocate (v%items(n + size(b%items)))
v%items(1:n) = a%items
v%items(n + 1:) = b%items
else if (kind == E_MUL .and. a_number .and. b%kind >= V_STR .and. b%kind <= V_TUPLE) then
call arithmetic(c, kind, b, a, v)
else if (kind == E_MUL .and. a%kind == V_STR .and. b_number) then
do k = 1, b%number
call add(text, a%text)
end do
call take(text, joined)
call make_string(joined, v)
else if (kind == E_MUL .and. (a%kind == V_LIST .or. a%kind == V_TUPLE) .and. b_number) then
n = size(a%items)
v%kind = a%kind
allocate (v%items(n*max(b%number, 0)))
do k = 1, max(b%number, 0)
base = (k - 1)*n
v%items(base + 1:base + n) = a%items
end do
else
call fail(c, 'unsupported operand types in arithmetic')
end if
end subroutine arithmetic