fdoc

subroutinearithmeticrecursiveprivate

recursive subroutine arithmetic(c, kind, a, b, v)

a + b, a - b or a * b.

Arguments

NameTypeIntentAttributesDescription
ctype(fypp_t)inout

the state

kindintegerin

which

atype(value_t)in

the first operand

btype(value_t)in

the second operand

vtype(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

Graphs

Calls

Called by