Merge pull request #51 from sourceryinstitute/functional-interface

Functional interface

Author: Damian Rouson

doc-generator.md

@@ -1,7 +1,6 @@
 project: Directed Acyclic Graph Library
 summary: A Fortran 2018 application programmer interface for representing directed acyclic graphs.
-src_dir: ../src
-src_dir: ../tests
+src_dir: src
 output_dir: doc/html
 preprocess: true
 macro: FORD
@@ -17,7 +16,7 @@ sort: permission-alpha
 extra_mods: iso_fortran_env:https://gcc.gnu.org/onlinedocs/gfortran/ISO_005fFORTRAN_005fENV.html
             iso_c_binding:https://gcc.gnu.org/onlinedocs/gfortran/ISO_005fC_005fBINDING.html#ISO_005fC_005fBINDING
 project_github: https://github.com/sourceryinstitute/dag
-author: Jacob Williams and Damian Rouson
+author: Jacob Williams, Damian Rouson, Robert Singleterry, and Brad Richardson
 print_creation_date: true
 creation_date: %Y-%m-%d %H:%M %z
 project_github: https://github.com/sourceryinstitute/dag

example/feats-dependency-tree.f90

@@ -50,27 +50,27 @@ program labeled_dag_output
 
     associate(feats => &
       dag_t([ &
-        vertex_t(assert_m,        [integer::],                            names(assert_m), var_str(external_)) &
-       ,vertex_t(dag_m,           [integer:: ],                           names(dag_m), var_str(external_)) &
-       ,vertex_t(payload_m,       [integer::],                            names(payload_m), var_str(leaf)) &
-       ,vertex_t(compile_m,       [integer:: ],                           names(compile_m), var_str(leaf)) &
-       ,vertex_t(data_loc_map_m,  [integer::],                            names(data_loc_map_m), var_str(leaf)) &
-       ,vertex_t(task_m,          [payload_m],                            names(task_m), var_str(branch)) &
-       ,vertex_t(task_item_m,     [task_m],                               names(task_item_m), var_str(leaf)) &
-       ,vertex_t(app_m,           [dag_m, task_item_m],                   names(app_m), var_str(branch)) &
-       ,vertex_t(app_generator_m, [app_m, dag_m, task_item_m, compile_m], names(app_generator_m), var_str(branch)) &
-       ,vertex_t(image_m,         [app_m, data_loc_map_m],                names(image_m), var_str(branch)) &
-       ,vertex_t(main,            [app_generator_m, image_m],             names(main), var_str(root)) &
-       ,vertex_t(task_item_s,     [task_item_m],                          names(task_item_s), var_str(root)) &
-       ,vertex_t(compile_s,       [compile_m],                            names(compile_s), var_str(branch)) &
-       ,vertex_t(app_generator_s, [app_generator_m],                      names(app_generator_s), var_str(root)) &
-       ,vertex_t(data_loc_map_s,  [data_loc_map_m],                       names(data_loc_map_s), var_str(root)) &
-       ,vertex_t(payload_s,       [payload_m],                            names(payload_s), var_str(root)) &
-       ,vertex_t(app_s,           [app_m, assert_m],                      names(app_s), var_str(root)) &
-       ,vertex_t(mailbox_m,       [payload_m],                            names(mailbox_m), var_str(branch)) &
-       ,vertex_t(image_s,         [image_m, mailbox_m],                   names(image_s), var_str(root)) &
-       ,vertex_t(final_task_m,    [data_loc_map_m, payload_m, task_m],    names(final_task_m), var_str(branch)) &
-       ,vertex_t(final_task_s,    [final_task_m],                         names(final_task_s), var_str(root)) &
+        vertex_t([integer::],                            names(assert_m), var_str(external_)) &
+       ,vertex_t([integer:: ],                           names(dag_m), var_str(external_)) &
+       ,vertex_t([integer::],                            names(payload_m), var_str(leaf)) &
+       ,vertex_t([integer:: ],                           names(compile_m), var_str(leaf)) &
+       ,vertex_t([integer::],                            names(data_loc_map_m), var_str(leaf)) &
+       ,vertex_t([payload_m],                            names(task_m), var_str(branch)) &
+       ,vertex_t([task_m],                               names(task_item_m), var_str(leaf)) &
+       ,vertex_t([dag_m, task_item_m],                   names(app_m), var_str(branch)) &
+       ,vertex_t([app_m, dag_m, task_item_m, compile_m], names(app_generator_m), var_str(branch)) &
+       ,vertex_t([app_m, data_loc_map_m],                names(image_m), var_str(branch)) &
+       ,vertex_t([app_generator_m, image_m],             names(main), var_str(root)) &
+       ,vertex_t([task_item_m],                          names(task_item_s), var_str(root)) &
+       ,vertex_t([compile_m],                            names(compile_s), var_str(branch)) &
+       ,vertex_t([app_generator_m],                      names(app_generator_s), var_str(root)) &
+       ,vertex_t([data_loc_map_m],                       names(data_loc_map_s), var_str(root)) &
+       ,vertex_t([payload_m],                            names(payload_s), var_str(root)) &
+       ,vertex_t([app_m, assert_m],                      names(app_s), var_str(root)) &
+       ,vertex_t([payload_m],                            names(mailbox_m), var_str(branch)) &
+       ,vertex_t([image_m, mailbox_m],                   names(image_s), var_str(root)) &
+       ,vertex_t([data_loc_map_m, payload_m, task_m],    names(final_task_m), var_str(branch)) &
+       ,vertex_t([final_task_m],                         names(final_task_s), var_str(root)) &
       ]))
       call feats%save_digraph(digraph_file, 'RL', 300)
       call execute_command_line('dot -Tpdf -o ' // output_file // ' ' // digraph_file)

src/dag_m.f90

@@ -15,33 +15,34 @@ module dag_m
   type,public :: dag_t
     !! Encapsulate a graph as an array of vertices, each storing dependency information
     private
-    type(vertex_t),dimension(:),allocatable :: vertices
+    type(vertex_t), allocatable :: vertices(:)
     integer, allocatable :: order(:)
   contains
     procedure :: is_sorted_and_acyclic
     procedure :: to_json
-    procedure :: save_digraph
     procedure :: num_vertices
     procedure :: dependencies_for
     procedure :: depends_on
+
+    procedure :: save_digraph
     generic :: write(formatted) => write_formatted
     generic :: read(formatted) => read_formatted
 
     procedure, private :: write_formatted
     procedure, private :: read_formatted
-
   end type
 
   interface dag_t
 
     module function construct_from_json(json_object) result(dag)
+      !! Construct a dag_t object from a JSON object (result contains a topologically sorted index array)
       implicit none
       type(json_object_t), intent(in) :: json_object
       type(dag_t) dag
     end function
 
-    module function construct_from_components(vertices) result(dag)
-      !! Construct an object containing the topologically sorted vertex ordering for a DAG
+    pure module function construct_from_components(vertices) result(dag)
+      !! Construct a dag_t object from an array of (unsorted) vertex_t objects (result contains a topologically sorted index array)
       implicit none
       type(vertex_t), intent(in) :: vertices(:)
       type(dag_t) dag
@@ -51,14 +52,15 @@ module function construct_from_components(vertices) result(dag)
 
   interface
 
-    module function is_sorted_and_acyclic(self)
+    pure module function is_sorted_and_acyclic(self)
       !! Result is true if dag%order contains a topological sorting of vertex identifiers
       implicit none
       class(dag_t), intent(in) :: self
       logical is_sorted_and_acyclic
     end function
 
     module function to_json(self) result(json_object)
+      !! Result is a JSON representation of the dag_t object
       implicit none
       class(dag_t), intent(in) :: self
       type(json_object_t) json_object

src/dag_s.f90

@@ -14,26 +14,21 @@
 
   implicit none
 
-  type vertex_status_t
-    logical :: marked=.false., checking=.false.
-  end type
-
 contains
 
   module procedure construct_from_components
     dag%vertices = vertices
-    dag%order = toposort(dag)
+    dag%order = topological_sort(dag)
     call assert(dag%is_sorted_and_acyclic(), "construct_from_components: dag%is_sorted_and_acyclic()")
   end procedure
 
-  module function toposort(dag) result(order)
+  pure module function topological_sort(dag) result(order)
     !! Provide array of vertex numbers ordered in a way that respects dependencies
     type(dag_t), intent(in) :: dag
     integer, allocatable :: order(:), searched(:)
     integer v
 
-    call assert(all([(allocated(dag%vertices(v)%edges), v=1, size(dag%vertices))]), &
-        "dag_s toposort: (all([(allocated(dag%vertices(v)%edges), v=1, size(dag%vertices))])")
+    call assert(all(dag%vertices(:)%edges_allocated()), "dag_s topological_sort: all(dag%vertices(:)%edges_allocated())")
 
     block
       integer, allocatable :: discovered(:)
@@ -51,7 +46,7 @@ module function toposort(dag) result(order)
 
   contains
 
-    recursive subroutine depth_first_search(v, d, s, o)
+    pure recursive subroutine depth_first_search(v, d, s, o)
       integer, intent(in) :: v, d(:)
       integer, intent(out), allocatable :: s(:)
       integer, intent(inout), allocatable :: o(:)
@@ -80,7 +75,7 @@ recursive subroutine depth_first_search(v, d, s, o)
 
     end subroutine
 
-  end function toposort
+  end function topological_sort
 
   module procedure is_sorted_and_acyclic
 
@@ -97,7 +92,7 @@ end function toposort
         integer i, j
 
         do i = 1, num_vertices
-          associate(edges => self%vertices(self%order(i))%get_edges())
+          associate(edges => self%vertices(self%order(i))%edges())
             do j = 1, size(edges)
               if (.not. any(edges(j) == self%order(1:i))) then
                 is_sorted_and_acyclic = .false.
@@ -116,11 +111,11 @@ end function toposort
 
   module procedure construct_from_json
     type(fallible_json_value_t) :: maybe_vertices
+    type(error_list_t) errors
 
     maybe_vertices = json_object%get_element("vertices")
-    associate(errors => maybe_vertices%errors())
-      call assert(.not. errors%has_any(), "dag_s construct_from_json: .not. errors%has_any()", char(errors%to_string()))
-    end associate
+    errors = maybe_vertices%errors()
+    call assert(.not. errors%has_any(), "dag_s construct_from_json: .not. errors%has_any()", char(errors%to_string()))
 
     select type (vertices => maybe_vertices%value_())
     type is (json_array_t)
@@ -129,34 +124,32 @@ end function toposort
     class default
       call assert(.false., "dag%from_json: vertices was not an array", char(vertices%to_compact_string()))
     end select
-    dag%order = toposort(dag)
+    dag%order = topological_sort(dag)
   end procedure
 
    module procedure to_json
      type(fallible_json_string_t) maybe_key
      type(error_list_t) errors
+     type(json_string_t) vertices_key
+     type(json_array_t) vertices_value
 
      maybe_key = fallible_json_string_t("vertices")
      errors = maybe_key%errors()
      call assert(.not. errors%has_any(), "dag%to_json: .not. errors%has_any()", char(errors%to_string()))
 
-     block
-       type(json_array_t) vertices_value
 
-       vertices_value = json_array_t(json_element_t(self%vertices%to_json()))
+     vertices_value = json_array_t(json_element_t(self%vertices%to_json()))
 
-       associate(vertices_key => maybe_key%string())
-         json_object = json_object_t([vertices_key], [json_element_t(vertices_value)])
-       end associate
-     end block
+     vertices_key = maybe_key%string()
+     json_object = json_object_t([vertices_key], [json_element_t(vertices_value)])
    end procedure
 
   module procedure num_vertices
     num_vertices = size(self%vertices)
   end procedure
 
   module procedure dependencies_for
-    dependency_ids = self%vertices(vertex_id)%get_edges()
+    dependency_ids = self%vertices(vertex_id)%edges()
   end procedure
 
   module procedure depends_on
@@ -169,7 +162,7 @@ end function toposort
       integer v
 
       do v = 1, size(self%vertices)
-        if (any(self%vertices(v)%edges == vertex_num)) dependencies = [dependencies, v]
+        if (any(self%vertices(v)%edges() == vertex_num)) dependencies = [dependencies, v]
       end do
     end block
 
@@ -193,6 +186,20 @@ end function toposort
     close(iunit,iostat=istat)
   contains
 
+    elemental function integer_to_string(i) result(s)
+      integer,intent(in) :: i
+      integer, parameter :: max_number_width = 64
+      character(len=max_number_width) :: s
+      integer :: istat
+
+      write(s,fmt='(ss,I0)',iostat=istat) i
+      if (istat==0) then
+          s = trim(adjustl(s))
+      else
+          s = '***'
+      end if
+    end function integer_to_string
+
     function generate_digraph(self,rankdir,dpi) result(str)
       !! - Result is the string to write out to a *.dot file. (Called by save_digraph())
       implicit none
@@ -210,6 +217,9 @@ function generate_digraph(self,rankdir,dpi) result(str)
       character(len=*),parameter :: tab = '  '
       character(len=*),parameter :: newline = new_line(' ')
 
+
+      call assert(all(self%vertices(:)%edges_allocated()), "generate_digraph: self%edges_allocated()")
+
       str = 'digraph G {'//newline//newline
       if (present(rankdir)) &
           str = str//tab//'rankdir='//rankdir//newline//newline
@@ -218,24 +228,24 @@ function generate_digraph(self,rankdir,dpi) result(str)
 
       ! define the vertices:
       do i=1,size(self%vertices)
-        label = 'label="'//trim(adjustl(self%vertices(i)%get_label()))//'"'
-        attributes = '['//trim(adjustl(self%vertices(i)%get_attributes()))//','//label//']'
+        label = 'label="'//trim(adjustl(self%vertices(i)%label()))//'"'
+        attributes = '['//trim(adjustl(self%vertices(i)%attributes()))//','//label//']'
         str = str//tab//integer_to_string(i)//' '//attributes//newline
         if (i==size(self%vertices)) str = str//newline
       end do
 
       ! define the dependencies:
       do i=1,size(self%vertices)
-          if (allocated(self%vertices(i)%edges)) then
-              n_edges = size(self%vertices(i)%edges)
-              str = str//tab//integer_to_string(i)//merge(' -> ','    ',n_edges/=0)
-              do j=1,n_edges
-                  ! comma-separated list:
-                  str = str//integer_to_string(self%vertices(i)%edges(j))
-                  if (n_edges>1 .and. j<n_edges) str = str//','
-              end do
-              str = str//';'//newline
-          end if
+        n_edges = size(self%vertices(i)%edges())
+        str = str//tab//integer_to_string(i)//merge(' -> ','    ',n_edges/=0)
+        do j=1,n_edges
+          ! comma-separated list:
+          associate(edges => self%vertices(i)%edges())
+            str = str//integer_to_string(edges(j))
+            if (n_edges>1 .and. j<n_edges) str = str//','
+          end associate
+        end do
+        str = str//';'//newline
       end do
 
       str = str//newline//'}'
@@ -244,23 +254,6 @@ end function generate_digraph
 
   end procedure
 
-  elemental function integer_to_string(i) result(s)
-
-    integer,intent(in) :: i
-    integer, parameter :: max_number_width = 64
-    character(len=max_number_width) :: s
-
-    integer :: istat
-
-    write(s,fmt='(ss,I0)',iostat=istat) i
-    if (istat==0) then
-        s = trim(adjustl(s))
-    else
-        s = '***'
-    end if
-
-  end function integer_to_string
-
   module procedure read_formatted
 
     character(len=*), parameter :: NEWLINE = NEW_LINE('A')