queue_lib.f90.erb

<%
  require 'fort'
  LOG_2_CHAR_LEN_MAX = 10

  REALS = ::Fort::Type::Real.multi_provide
  INTEGERS = ::Fort::Type::Integer.multi_provide
  LOGICALS = ::Fort::Type::Logical.multi_provide
  COMPLEXES = ::Fort::Type::Complex.multi_provide
  CHARACTERS = ::Fort::Type::Character.multi_provide(len: :':', len: [0])
  TYPES\
  = REALS\
  + INTEGERS\
  + LOGICALS\
  + COMPLEXES\
  + CHARACTERS
%>

# include "fortran_lib.h"
module queue_lib
   USE_FORTRAN_LIB_H
   <%= ::Fort::Type::USE_ISO_FORTRAN_ENV %>
   implicit none

   private

   public:: push
   public:: shift

   <% TYPES.each{|t| %>
      interface push
         module procedure push<%= t %>Queue
      end interface push

      interface shift
         module procedure shift<%= t %>Queue
      end interface shift

      interface is_empty
         module procedure is_empty<%= t %>Queue
      end interface is_empty
   <% } %>

   type, public:: Queue
   end type Queue

   type:: QueueNode
   end type QueueNode

   <% TYPES.each{|t| %>
      type, extends(Queue), public:: <%= t %>Queue
         type(<%= t %>QueueNode), pointer:: tail => null()
         type(<%= t %>QueueNode), pointer:: head => null()
      end type <%= t %>Queue

      type, extends(QueueNode):: <%= t %>QueueNode
         <%= t.declare %><%= (t.dim > 0) ? ', allocatable' : '' %>:: value
         type(<%= t %>QueueNode), pointer:: next => null()
      end type <%= t %>QueueNode
   <% } %>

contains

   <% TYPES.each{|t| %>
      subroutine push<%= t %>Queue(self, value)
         type(<%= t %>Queue), intent(inout):: self
         <%= t.declare %>, intent(in):: value
         type(<%= t %>QueueNode), pointer:: newNode

         allocate(newNode)
         newNode%value = value

         ! ! If user defined type allows member variables with the target attribute, I would define Queue as:
         ! type <%= t %>Queue
         !    type(<%= t %>QueueNode), target:: root
         !    type(<%= t %>QueueNode), pointer:: tail => root
         !    type(<%= t %>QueueNode), pointer:: head => root%next
         ! end type <%= t %>Queue
         ! ! and the following if-statement could be simplified as:
         ! self%tail%next => newNode
         if(is_empty(self))then
            self%head => newNode
         else
            self%tail%next => newNode
         end if
         self%tail => newNode
      end subroutine push<%= t %>Queue

      function shift<%= t %>Queue(self, value) result(isSuccess)
         type(<%= t %>Queue), intent(inout):: self
         <%= t.declare %><%= (t.dim > 0) ? ', allocatable' : '' %>, intent(inout):: value
         Logical:: isSuccess
         type(<%= t %>QueueNode), pointer:: removedNode => null()

         if(is_empty(self))then
            isSuccess = .false.
            return
         end if

         value = self%head%value
         removedNode => self%head
         self%head => self%head%next
         deallocate(removedNode)
         isSuccess = .true.
      end function shift<%= t %>Queue

      function is_empty<%= t %>Queue(self) result(answer)
         type(<%= t %>Queue), intent(in):: self
         Logical:: answer

         answer = .not.associated(self%head)
      end function is_empty<%= t %>Queue
   <% } %>
end module queue_lib