Add in-process Fortran benchmark utility and implement all benchmarks

.gitignore

@@ -46,3 +46,5 @@ levenshtein/*/run
 hello-world/*/code
 hello-world/*/run
 .nrepl-port
+
+lib/fortran/benchmark.mod

compile.sh

@@ -56,6 +56,8 @@ compile 'Clojure' 'clojure' '(cd clojure && mkdir -p classes && clojure -M -e "(
 compile 'Clojure Native' 'clojure-native-image' "(cd clojure-native-image ; clojure -M:native-image-run --pgo-instrument -march=native) ; ./clojure-native-image/run -XX:ProfilesDumpFile=clojure-native-image/run.iprof 10000 2000 $(./check-output.sh -i) && (cd clojure-native-image ; clojure -M:native-image-run --pgo=run.iprof -march=native)"
 compile 'Java' 'jvm' 'javac -cp ../lib/java jvm/run.java'
 compile 'Java Native' 'java-native-image' "(cd java-native-image ; native-image -cp ..:../../lib/java --no-fallback -O3 --pgo-instrument -march=native jvm.run) && ./java-native-image/jvm.run -XX:ProfilesDumpFile=java-native-image/run.iprof 10000 2000 $(./check-output.sh -i) && (cd java-native-image ; native-image -cp ..:../../lib/java -O3 --pgo=run.iprof -march=native jvm.run -o run)"
+compile 'Fortran' 'fortran' "gfortran -O3 -J../lib/fortran ../lib/fortran/benchmark.f90 fortran/run.f90 -o fortran/run"
+
 ####### END The languages
 
 echo

fibonacci/fortran/run.f90

@@ -0,0 +1,45 @@
+program main
+    use benchmark
+    implicit none
+    integer(8) :: n
+    integer(4) :: run_ms, warmup_ms
+    character(len=256) :: arg
+    type(benchmark_result_t) :: warmup_result, benchmark_result
+    character(len = :), allocatable :: result_str
+
+    call get_command_argument(1, arg)
+    read(arg, *) run_ms                 ! Convert the command-line argument to integer
+    call get_command_argument(2, arg)
+    read(arg, *) warmup_ms              ! Convert the command-line argument to integer
+    call get_command_argument(3, arg)
+    read(arg, *) n                      ! Convert the command-line argument to integer
+
+    call run(fibonacci_benchmark, warmup_ms, warmup_result)
+    call run(fibonacci_benchmark, run_ms, benchmark_result)
+
+    call format_results(benchmark_result, result_str)
+    write(*, '(A)') trim(adjustl(result_str))
+
+contains
+
+    integer(8) function fibonacci_benchmark()
+        implicit none
+        integer(8) :: result
+
+        result = fibonacci(n)
+        fibonacci_benchmark = result
+    end function fibonacci_benchmark
+
+    integer(8) recursive function fibonacci(n) result(f)
+        integer(8), intent(in) :: n
+
+        if (n == 0) then
+            f = 0
+        elseif (n == 1) then
+            f = 1
+        else
+            f = fibonacci(n - 1) + fibonacci(n - 2)
+        end if
+    end function fibonacci
+
+end program main

hello-world/fortran/run.f90

@@ -0,0 +1,3 @@
+program main
+    print *, "Hello, World!"                   
+end program main

levenshtein/clojure/run.clj

@@ -57,6 +57,6 @@
         println)))
 
 (comment
-  (-main "1000" "levenshtein/levenshtein-words.txt")
+  (-main "2000" "1000" "levenshtein-words.txt")
   :rcf)
 

levenshtein/fortran/run.f90

@@ -0,0 +1,166 @@
+program main
+   use benchmark
+   implicit none
+
+   integer :: run_ms, warmup_ms, iostat, word_count
+   character(len = 256) :: run_ms_str, warmup_ms_str, input_path
+   character(len = :), allocatable :: args(:)
+   integer, allocatable :: distances(:)
+   type(benchmark_result_t) :: warmup_result, benchmark_result
+   character(len = :), allocatable :: result_str
+
+   call get_command_argument(1, run_ms_str)
+   call get_command_argument(2, warmup_ms_str)
+   call get_command_argument(3, input_path)
+   read(run_ms_str, *) run_ms
+   read(warmup_ms_str, *) warmup_ms
+
+   call read_all_words(input_path, args, iostat)
+   if (iostat /= 0) stop "Error reading file."
+   word_count = size(args)
+   if (word_count == 0) stop "No words read."
+
+   allocate(distances((word_count * (word_count - 1)) / 2))
+   call run(benchmark_function, warmup_ms, warmup_result)
+   call run(benchmark_function, run_ms, benchmark_result)
+
+   ! Sum the distances outside the benchmarked function
+   benchmark_result%result = sum(distances)
+
+   call format_results(benchmark_result, result_str)
+   write(*, '(A)') trim(adjustl(result_str))
+
+   deallocate(args, distances)
+
+   contains
+
+      integer(8) function benchmark_function()
+      implicit none
+      integer :: i, j, idx
+      integer(8) :: sum_distances
+      sum_distances = 0
+      idx = 1
+      do i = 1, size(args)
+         do j = i + 1, size(args)
+            distances(idx) = levenshtein_distance(trim(args(i)), trim(args(j)))
+            sum_distances = sum_distances + distances(idx)
+            idx = idx + 1
+         end do
+      end do
+      benchmark_function = sum_distances
+   end function benchmark_function
+
+   subroutine read_all_words(filename, all_words, iostat)
+      implicit none
+      character(len = *), intent(in) :: filename
+      character(len = :), allocatable, intent(out) :: all_words(:)
+      integer, intent(out) :: iostat
+      integer :: unit, num_words, i
+      integer, parameter :: max_len = 10000 ! Allow for really long words
+      character(len = max_len) :: word
+
+      open(newunit = unit, file = filename, status = 'old', action = 'read', iostat = iostat)
+      if (iostat /= 0) return
+
+      num_words = 0
+      do
+         read(unit, '(A)', iostat = iostat) word
+         if (iostat /= 0) exit
+         num_words = num_words + 1
+      end do
+
+      if (num_words > 0) then
+         allocate(character(len = max_len) :: all_words(num_words))
+         rewind(unit)
+         do i = 1, num_words
+            read(unit, '(A)', iostat = iostat) all_words(i)
+            if (iostat /= 0) exit
+         end do
+      else
+         allocate(all_words, mold = [character(len = max_len) :: ''])
+      end if
+
+      close(unit)
+   end subroutine read_all_words
+
+   ! Calculates the Levenshtein distance between two strings using Wagner-Fischer algorithm
+   ! Space Complexity: O(min(m,n)) - only uses two arrays instead of full matrix
+   ! Time Complexity: O(m*n) where m and n are the lengths of the input strings
+   function levenshtein_distance(s1, s2) result(distance)
+      character(len = *), intent(in) :: s1, s2
+      integer :: distance
+
+      integer :: m, n, i, j, cost
+      integer, allocatable :: prev_row(:), curr_row(:)
+      character(len = 1) :: c1, c2
+      character(len = :), allocatable :: str1, str2
+
+      ! Early termination checks
+      if (s1 == s2) then
+         distance = 0
+         return
+      end if
+
+      if (len_trim(s1) == 0) then
+         distance = len_trim(s2)
+         return
+      end if
+
+      if (len_trim(s2) == 0) then
+         distance = len_trim(s1)
+         return
+      end if
+
+      ! Make s1 the shorter string for space optimization
+      if (len_trim(s1) > len_trim(s2)) then
+         str1 = trim(s2)
+         str2 = trim(s1)
+      else
+         str1 = trim(s1)
+         str2 = trim(s2)
+      end if
+
+      m = len_trim(str1)
+      n = len_trim(str2)
+
+      ! Use two arrays instead of full matrix for space optimization
+      allocate(prev_row(0:m), curr_row(0:m))
+
+      ! Initialize first row
+      do i = 0, m
+         prev_row(i) = i
+      end do
+
+      ! Main computation loop
+      do j = 1, n
+         curr_row(0) = j
+
+         do i = 1, m
+            ! Get characters at current position
+            c1 = str1(i:i)
+            c2 = str2(j:j)
+
+            ! Calculate cost
+            if (c1 == c2) then
+               cost = 0
+            else
+               cost = 1
+            end if
+
+            ! Calculate minimum of three operations
+            curr_row(i) = min(prev_row(i) + 1, & ! deletion
+            curr_row(i - 1) + 1, &               ! insertion
+            prev_row(i - 1) + cost)              ! substitution
+         end do
+
+         ! Swap rows
+         prev_row = curr_row
+      end do
+
+      distance = prev_row(m)
+
+      ! Clean up
+      deallocate(prev_row, curr_row)
+   end function levenshtein_distance
+
+end program main

lib/fortran/benchmark.f90

@@ -0,0 +1,107 @@
+module benchmark
+  implicit none
+  private
+  public :: run, format_results, benchmark_result_t  ! Make benchmark_result_t public
+
+  type :: benchmark_result_t
+    integer :: runs
+    real(8) :: mean_ms
+    real(8) :: std_dev_ms
+    real(8) :: min_ms
+    real(8) :: max_ms
+    integer(8) :: result
+  end type benchmark_result_t
+
+contains
+
+  subroutine run(f, run_ms, result)
+    implicit none
+    interface
+      integer(8) function f()
+      end function f
+    end interface
+    procedure(f), pointer :: func_ptr
+    integer, intent(in) :: run_ms
+    type(benchmark_result_t), intent(out) :: result
+    integer(8) :: start_time, end_time, elapsed_time, total_elapsed_time
+    integer(8) :: count_rate
+    integer :: count
+    real(8) :: elapsed_times(1000000), mean, variance, std_dev, min_time, max_time
+    logical :: print_status
+    integer(8) :: last_status_t
+
+    ! Check for run_ms being zero
+    if (run_ms == 0) then
+      result%runs = 0
+      result%mean_ms = 0.0
+      result%std_dev_ms = 0.0
+      result%min_ms = 0.0
+      result%max_ms = 0.0
+      result%result = 0
+      return
+    end if
+
+    func_ptr => f
+    total_elapsed_time = 0
+    count = 0
+    min_time = 1.0e12
+    max_time = 0.0
+    print_status = (run_ms > 1)
+    call system_clock(count_rate=count_rate)  ! Get the count rate
+
+    if (print_status) then
+      write(0, '(A)', advance='no') "."
+      flush(0)
+    end if
+
+    do while (total_elapsed_time < run_ms * 1.0e6)
+      call system_clock(start_time, count_rate=count_rate)  ! Use nanosecond precision
+      result%result = func_ptr()
+      call system_clock(end_time, count_rate=count_rate)    ! Use nanosecond precision
+      elapsed_time = end_time - start_time
+      if (elapsed_time == 0) cycle  ! Skip zero elapsed time measurements
+      if (count < size(elapsed_times)) then
+        elapsed_times(count + 1) = elapsed_time / 1.0e6
+      else
+        write(0,*) "Error: Exceeded maximum number of iterations"
+        exit
+      end if
+      total_elapsed_time = total_elapsed_time + elapsed_time
+      count = count + 1
+      if (elapsed_times(count) < min_time) min_time = elapsed_times(count)
+      if (elapsed_times(count) > max_time) max_time = elapsed_times(count)
+      if (print_status .and. (end_time - last_status_t) > count_rate) then
+        last_status_t = end_time
+        write(0, '(A)', advance='no') "."
+        flush(0)
+      end if
+    end do
+
+    if (print_status) then
+      write(0, '(A)') ""
+    end if
+
+    mean = sum(elapsed_times(1:count)) / count
+    variance = sum((elapsed_times(1:count) - mean)**2) / count
+    std_dev = sqrt(variance)
+
+    result%runs = count
+    result%mean_ms = mean
+    result%std_dev_ms = std_dev
+    result%min_ms = min_time
+    result%max_ms = max_time
+  end subroutine run
+
+  subroutine format_results(benchmark_result, result_str)
+      implicit none
+      type(benchmark_result_t), intent(in) :: benchmark_result
+      character(len=:), allocatable, intent(out) :: result_str
+      character(len=256) :: temp_str
+
+      write(temp_str, '(f0.6,",",f0.6,",",f0.6,",",f0.6,",",i0,",",i0)') &
+        benchmark_result%mean_ms, benchmark_result%std_dev_ms, benchmark_result%min_ms, benchmark_result%max_ms, benchmark_result%runs, benchmark_result%result
+
+      result_str = trim(adjustl(temp_str))
+  end subroutine format_results
+
+end module benchmark