Import

Fortran For Beginners/.gitignore

@@ -0,0 +1,2 @@
+*.exe
+*.o

Fortran For Beginners/Section 1 - Introduction/entreprise_hello.f90

@@ -0,0 +1,16 @@
+program entreprise_hello
+	implicit none
+	
+	character(len=*), parameter :: PERSON = "World"
+	character(len=:), allocatable :: greeting	
+	
+	greeting = greet(PERSON)
+	print '(A)', greeting
+	contains
+	pure function greet(person_) result(greeting_)
+		character(len=*), intent(in) :: person_
+		character(len=:), allocatable :: greeting_
+
+		greeting_ = "Hello, " // person_ // "!"
+	end function greet
+end program entreprise_hello

Fortran For Beginners/Section 1 - Introduction/hello.f90

@@ -0,0 +1,3 @@
+program hello
+	print *, "Hello, world !"
+end program hello

Fortran For Beginners/Section 2 - The Basics/Fibonacci.f90

@@ -0,0 +1,30 @@
+program Fibonacci
+	implicit none
+	
+	integer :: i
+	integer, dimension(10) :: fib_nb
+
+	fib_nb(1) = 1
+	fib_nb(2) = 1
+
+	do i = 3, 10
+		fib_nb(i) = fib_nb(i-1) + fib_nb(i-2)
+	end do
+
+	do i = 1, 10
+		print *, fib_nb(i)
+	end do
+contains
+	recursive function fib(n) result(fib_)
+		integer, intent(in) :: n
+		integer :: fib_
+
+		if (n == 1) then
+			fib_ = 1
+		else if (n == 1) then
+			fib_ = 1
+		else
+			fib_ = fib(n-1) + fib(n-2)
+		end if
+	end function fib
+end program Fibonacci

Fortran For Beginners/Section 2 - The Basics/uninitialized_example.f90

@@ -0,0 +1,7 @@
+program uninitialized_example
+	implicit none
+	
+	character(len=10) :: something
+
+	print *, something
+end program uninitialized_example

Fortran For Beginners/Section 2 - The Basics/variables_example.f90

@@ -0,0 +1,28 @@
+program variables_example
+	implicit none
+	
+	integer :: x
+	integer :: y
+	integer :: z
+	integer, parameter :: inches_per_foot = 12
+
+	print *, "x = ", x, "y = ", y, "z = ", z
+	print *, "inches_per_foot = ", inches_per_foot
+
+	x = 3
+
+	print *, "x = ", x, "y = ", y, "z = ", z
+
+	y = 4
+
+	print *, "x = ", x, "y = ", y, "z = ", z
+
+	z = x + y
+
+	print *, "x = ", x, "y = ", y, "z = ", z
+
+	x = 1
+
+	print *, "x = ", x, "y = ", y, "z = ", z
+
+end program variables_example

Fortran For Beginners/Section 3 - Interactivity/Makefile

@@ -0,0 +1,25 @@
+# From https://github.com/llamm-de/VSCode_Fortran_Tutorial
+# variables
+RM = del /Q /F
+
+FC=gfortran
+CFLAGS=-c -g -Og -Wall
+FILE=take_notes
+
+# linking
+a.exe: $(FILE).o
+	$(FC) $(FILE).o
+
+# compiling
+$(FILE).o: $(FILE).f90
+	$(FC) $(CFLAGS) $(FILE).f90
+
+
+# cleanup
+clean:
+	-$(RM) $(FILE).o a.exe
+
+# run
+run:
+	make
+	./a.exe

Fortran For Beginners/Section 3 - Interactivity/take_notes.f90

@@ -0,0 +1,18 @@
+program take_notes
+    implicit none
+
+    character(len=*), parameter :: NOTES_FILE = "notes.txt"
+    character(len=100) :: note
+    integer :: unit
+
+    open(newunit = unit, file = NOTES_FILE, position = 'APPEND')
+
+    do
+        print *, "Enter some notes. Enter 'DONE' to quit."
+        read(*, '(A)') note
+        if (trim(note) == "DONE") exit
+        write(unit, '(A)') trim(note)
+    end do
+
+    close(unit)
+end program take_notes

Fortran For Beginners/Section 3 - Interactivity/to_the_power.f90

@@ -0,0 +1,23 @@
+program to_the_power
+	implicit none
+	
+	integer :: base
+	integer :: power
+	integer :: status
+	
+	do
+		print *, "What’s the base number?"
+		read(*, *, iostat=status) base
+		if (status == 0) exit
+		print *, "Sorry, I didn’t understand that."
+	end do
+	
+	do
+		print *, "To what power?"
+		read(*, *, iostat=status) power
+		if (status == 0) exit
+		print *, "Sorry, I didn’t understand that."
+	end do
+
+	print *, base, "**", power, " is ", base**power
+end program to_the_power

Fortran For Beginners/Section 3 - Interactivity/todo.f90

@@ -0,0 +1,10 @@
+program todo
+	use todo_m, only: Todo_t
+
+	implicit none
+
+	type(Todo_t) :: todo_list
+
+	call todo_list%readPreviousTasks()
+	call todo_list%interact()
+end program todo

Fortran For Beginners/Section 3 - Interactivity/todo_m.f90

@@ -0,0 +1,124 @@
+module todo_m
+	implicit none
+	private
+
+	integer, parameter :: MAX_TASKS = 99
+	integer, parameter :: TASK_LENGTH = 100
+	character(len=*), parameter :: TODO_FILE = "todo.txt"
+
+	type, public :: Todo_t
+		private
+		character(len=TASK_LENGTH) :: tasks(MAX_TASKS)
+		integer :: num_tasks
+	contains
+		private
+		procedure, public :: readPreviousTasks
+		procedure, public :: interact
+		procedure :: add
+		procedure :: delete
+		procedure :: save
+	end type Todo_t
+contains
+	subroutine readPreviousTasks(self)
+		class(Todo_t), intent(out) :: self
+
+		integer :: i
+		integer :: status
+		integer :: unit
+
+		open(newunit=unit, file=TODO_FILE)
+
+		do i = 1, MAX_TASKS
+			read(unit, '(A)', iostat=status) self%tasks(i)
+			if (status /= 0) then
+				self%num_tasks = i - 1
+				exit
+			else
+				self%num_tasks = i
+			end if
+		end do
+
+		close(unit)
+	end subroutine readPreviousTasks
+
+	subroutine interact(self)
+		class(Todo_t), intent(inout) :: self
+
+		integer :: i
+		character(len=1) :: response
+
+		do
+			print *, "Here are your current tasks"
+			do i = 1, self%num_tasks
+				print '(I3,") ",A)', i, trim(self%tasks(i))
+			end do
+
+			print *, "What would you like to do? (a)dd, (d)elete, (q)uit"
+			read(*, '(A1)') response
+
+			select case (response)
+			case ('a')
+				call self%add()
+			case ('d')
+				call self%delete()
+			case ('q')
+				exit
+			case default
+				print *, "Sorry, I didn't understand that."
+			end select
+
+			call self%save()
+		end do
+	end subroutine interact
+
+	subroutine add(self)
+		class(Todo_t), intent(inout) :: self
+
+		print *, "What's the task?"
+		self%num_tasks = self%num_tasks + 1
+		read(*, '(A)') self%tasks(self%num_tasks)
+	end subroutine add
+
+	subroutine delete(self)
+		class(Todo_t), intent(inout) :: self
+
+		integer :: i
+		integer :: status
+		integer :: task
+
+		do
+			print *, "Which one would you like to delete?"
+			read(*, *, iostat=status) task
+			if (status == 0) then
+				if (task < 1) then
+					print *, "Task number must be > 1"
+				else if (task > self%num_tasks) then
+					print *, "Task number must be <= ", self%num_tasks
+				else
+					do i = task, self%num_tasks
+						self%tasks(i) = self%tasks(i+1)
+					end do
+					self%num_tasks = self%num_tasks - 1
+					exit
+				end if
+			else
+				print *, "Sorry, I didn't understand that."
+			end if
+		end do
+	end subroutine delete
+
+	subroutine save(self)
+		class(Todo_t), intent(in) :: self
+
+		integer :: i
+		integer :: unit
+
+		open(newunit=unit, file=TODO_FILE, status='REPLACE')
+
+		do i = 1, self%num_tasks
+			write(unit, '(A)') trim(self%tasks(i))
+		end do
+
+		close(unit)
+	end subroutine save
+end module todo_m

Fortran For Beginners/Section 3 - Interactivity/todo_routines_m.f90

@@ -0,0 +1,116 @@
+module todo_routines_m
+	implicit none
+
+	integer, parameter :: MAX_TASKS = 99
+	integer, parameter :: TASK_LENGTH = 100
+	character(len=*), parameter :: TODO_FILE = "todo.txt"
+	
+contains
+	subroutine readPreviousTasks(tasks_, num_tasks_)
+		character(len=TASK_LENGTH), intent(out) :: tasks_(MAX_TASKS)
+		integer, intent(out) :: num_tasks_
+
+		integer :: i
+		integer :: status
+		integer :: unit
+
+		open(newunit=unit, file=TODO_FILE)
+
+		do i = 1, MAX_TASKS
+			read(unit, '(A)', iostat=status) tasks_(i)
+			if (status /= 0) then
+				num_tasks_ = i - 1
+				exit
+			else
+				num_tasks_ = i
+			end if
+		end do
+
+		close(unit)
+	end subroutine readPreviousTasks
+
+	subroutine interact(tasks_, num_tasks_)
+		character(len=TASK_LENGTH), intent(inout) :: tasks_(MAX_TASKS)
+		integer, intent(inout) :: num_tasks_
+
+		integer :: i
+		character(len=1) :: response
+
+		do
+			print *, "Here are your current tasks"
+			do i = 1, num_tasks_
+				print '(I3,") ",A)', i, trim(tasks_(i))
+			end do
+
+			print *, "What would you like to do? (a)dd, (d)elete, (q)uit"
+			read(*, '(A1)') response
+
+			select case (response)
+			case ('a')
+				call add(tasks_, num_tasks_)
+			case ('d')
+				call delete(tasks_, num_tasks_)
+			case ('q')
+				exit
+			case default
+				print *, "Sorry, I didn't understand that."
+			end select
+
+			call save(tasks_, num_tasks_)
+		end do
+	end subroutine interact
+
+	subroutine add(tasks_, num_tasks_)
+		character(len=TASK_LENGTH), intent(inout) :: tasks_(MAX_TASKS)
+		integer, intent(inout) :: num_tasks_
+
+		print *, "What's the task?"
+		num_tasks_ = num_tasks_ + 1
+		read(*, '(A)') tasks_(num_tasks_)
+	end subroutine add
+
+	subroutine delete(tasks_, num_tasks_)
+		character(len=TASK_LENGTH), intent(inout) :: tasks_(MAX_TASKS)
+		integer, intent(inout) :: num_tasks_
+
+		integer :: i
+		integer :: status
+		integer :: task
+
+		do
+			print *, "Which one would you like to delete?"
+			read(*, *, iostat=status) task
+			if (status == 0) then
+				if (task < 1) then
+					print *, "Task number must be > 1"
+				else if (task > num_tasks_) then
+					print *, "Task number must be <= ", num_tasks_
+				else
+					do i = task, num_tasks_
+						tasks_(i) = tasks_(i+1)
+					end do
+					num_tasks_ = num_tasks_ - 1
+					exit
+				end if
+			else
+				print *, "Sorry, I didn't understand that."
+			end if
+		end do
+	end subroutine delete
+
+	subroutine save(tasks_, num_tasks_)
+		character(len=TASK_LENGTH), intent(in) :: tasks_(MAX_TASKS)
+		integer, intent(in) :: num_tasks_
+
+		integer :: i
+		integer :: unit
+
+		open(newunit=unit, file=TODO_FILE, status='REPLACE')
+
+		do i = 1, num_tasks_
+			write(unit, '(A)') trim(tasks_(i))
+		end do
+
+		close(unit)
+	end subroutine save
+end module todo_routines_m

Fortran For Beginners/Section 4 - A Touch of the More Advanced/Makefile

@@ -0,0 +1,17 @@
+RM = del /Q /F
+
+todo: todo_m.o todo.o
+	gfortran todo_m.o todo.o -o todo
+
+todo.o: todo.f90 todo_m.mod
+	gfortran -c todo.f90 -o todo.o
+
+todo_m.o todo_m.mod: todo_m.f90
+	gfortran -c todo_m.f90 -o todo_m.o
+
+# .PHONY: clean
+clean:
+	-$(RM) todo todo.o todo_m.o todo_m.mod
+clean_exe:
+	make clean
+	-$(RM) todo.exe

Fortran For Beginners/Section 4 - A Touch of the More Advanced/todo.f90

@@ -0,0 +1,10 @@
+program todo
+	use todo_m, only: Todo_t
+
+	implicit none
+
+	type(Todo_t) :: todo_list
+
+	call todo_list%readPreviousTasks()
+	call todo_list%interact()
+end program todo

Fortran For Beginners/Section 4 - A Touch of the More Advanced/todo_m.f90

@@ -0,0 +1,124 @@
+module todo_m
+	implicit none
+	private
+
+	integer, parameter :: MAX_TASKS = 99
+	integer, parameter :: TASK_LENGTH = 100
+	character(len=*), parameter :: TODO_FILE = "todo.txt"
+
+	type, public :: Todo_t
+		private
+		character(len=TASK_LENGTH) :: tasks(MAX_TASKS)
+		integer :: num_tasks
+	contains
+		private
+		procedure, public :: readPreviousTasks
+		procedure, public :: interact
+		procedure :: add
+		procedure :: delete
+		procedure :: save
+	end type Todo_t
+contains
+	subroutine readPreviousTasks(self)
+		class(Todo_t), intent(out) :: self
+
+		integer :: i
+		integer :: status
+		integer :: unit
+
+		open(newunit=unit, file=TODO_FILE)
+
+		do i = 1, MAX_TASKS
+			read(unit, '(A)', iostat=status) self%tasks(i)
+			if (status /= 0) then
+				self%num_tasks = i - 1
+				exit
+			else
+				self%num_tasks = i
+			end if
+		end do
+
+		close(unit)
+	end subroutine readPreviousTasks
+
+	subroutine interact(self)
+		class(Todo_t), intent(inout) :: self
+
+		integer :: i
+		character(len=1) :: response
+
+		do
+			print *, "Here are your current tasks"
+			do i = 1, self%num_tasks
+				print '(I3,") ",A)', i, trim(self%tasks(i))
+			end do
+
+			print *, "What would you like to do? (a)dd, (d)elete, (q)uit"
+			read(*, '(A1)') response
+
+			select case (response)
+			case ('a')
+				call self%add()
+			case ('d')
+				call self%delete()
+			case ('q')
+				exit
+			case default
+				print *, "Sorry, I didn't understand that."
+			end select
+
+			call self%save()
+		end do
+	end subroutine interact
+
+	subroutine add(self)
+		class(Todo_t), intent(inout) :: self
+
+		print *, "What's the task?"
+		self%num_tasks = self%num_tasks + 1
+		read(*, '(A)') self%tasks(self%num_tasks)
+	end subroutine add
+
+	subroutine delete(self)
+		class(Todo_t), intent(inout) :: self
+
+		integer :: i
+		integer :: status
+		integer :: task
+
+		do
+			print *, "Which one would you like to delete?"
+			read(*, *, iostat=status) task
+			if (status == 0) then
+				if (task < 1) then
+					print *, "Task number must be > 1"
+				else if (task > self%num_tasks) then
+					print *, "Task number must be <= ", self%num_tasks
+				else
+					do i = task, self%num_tasks
+						self%tasks(i) = self%tasks(i+1)
+					end do
+					self%num_tasks = self%num_tasks - 1
+					exit
+				end if
+			else
+				print *, "Sorry, I didn't understand that."
+			end if
+		end do
+	end subroutine delete
+
+	subroutine save(self)
+		class(Todo_t), intent(in) :: self
+
+		integer :: i
+		integer :: unit
+
+		open(newunit=unit, file=TODO_FILE, status='REPLACE')
+
+		do i = 1, self%num_tasks
+			write(unit, '(A)') trim(self%tasks(i))
+		end do
+
+		close(unit)
+	end subroutine save
+end module todo_m

Intermediate Fortran/.gitignore

@@ -0,0 +1,3 @@
+*.exe
+*.mod
+*.o

Intermediate Fortran/Section 2 - Procedure Attributes/abstract_type_reduce.f90

@@ -0,0 +1,57 @@
+module reduce_m
+	implicit none
+
+	type, abstract :: accumulator_t
+	contains
+		procedure(combiner), deferred, nopass :: combine
+	end type
+
+	abstract interface
+		pure function combiner(x, y) result(z)
+			integer, intent(in) :: x
+			integer, intent(in) :: y
+			integer :: z
+		end function
+	end interface
+contains
+	pure recursive function reduce(vals, accumulator, init) result(combined)
+		integer, intent(in) :: vals(:)
+		class(accumulator_t), intent(in) :: accumulator
+		integer, intent(in) :: init
+		integer :: combined
+
+		if (size(vals) == 1) then
+			combined = accumulator%combine(init, vals(1))
+		else
+			combined = reduce(vals(2:), accumulator, accumulator%combine(init, vals(1)))
+		end if
+	end function
+end module
+
+module multiplier_m
+	use reduce_m, only: accumulator_t
+
+	implicit none
+
+	type, extends(accumulator_t) :: multiplier_t
+	contains
+		procedure, nopass :: combine => multiply
+	end type
+contains
+	pure function multiply(x, y) result(z)
+		integer, intent(in) :: x
+		integer, intent(in) :: y
+		integer :: z
+
+		z = x * y
+	end function
+end module
+
+program main
+	use multiplier_m, only: multiplier_t
+	use reduce_m, only: reduce
+
+	implicit none
+
+	print *, reduce([1, 2, 3, 4], multiplier_t(), 1)
+end program

Intermediate Fortran/Section 2 - Procedure Attributes/fibonaci.f90

@@ -0,0 +1,17 @@
+program fibonaci_test
+	implicit none
+
+	print *, fibonaci(6)
+contains
+	recursive function fibonaci(number) result(fibonaci_number)
+		integer, intent(in) :: number
+		integer :: fibonaci_number
+
+		if (number <= 2) then
+			fibonaci_number = 1
+		else
+			fibonaci_number = fibonaci(number - 1) + fibonaci(number - 2)
+		end if
+		print *, "result:", fibonaci_number
+	end function
+end program

Intermediate Fortran/Section 2 - Procedure Attributes/procedure_argument_reduce.f90

@@ -0,0 +1,46 @@
+module reduce_m
+	implicit none
+
+	abstract interface
+		pure function combiner(x, y) result(z)
+			integer, intent(in) :: x
+			integer, intent(in) :: y
+			integer :: z
+		end function
+	end interface
+contains
+	pure recursive function reduce(vals, accumulator, init) result(combined)
+		integer, intent(in) :: vals(:)
+		procedure(combiner) :: accumulator
+		integer, intent(in) :: init
+		integer :: combined
+
+		if (size(vals) == 1) then
+			combined = accumulator(init, vals(1))
+		else
+			combined = reduce(vals(2:), accumulator, accumulator(init, vals(1)))
+		end if
+	end function
+end module
+
+module multiplier_m
+	implicit none
+
+contains
+	pure function multiply(x, y) result(z)
+		integer, intent(in) :: x
+		integer, intent(in) :: y
+		integer :: z
+
+		z = x * y
+	end function
+end module
+
+program main
+	use multiplier_m, only: multiply
+	use reduce_m, only: reduce
+
+	implicit none
+
+	print *, reduce([1, 2, 3, 4], multiply, 1)
+end program

Intermediate Fortran/Section 2 - Procedure Attributes/pure_and_elemental.f90

@@ -0,0 +1,14 @@
+program pure_and_elemental
+	implicit none
+
+	integer, parameter :: numbers(*) = [2, 3, 5, 7, 11]
+
+	print *, multiply_by_three(numbers)
+contains
+	elemental function multiply_by_three(number) result(multiplied_by_three)
+		integer, intent(in) :: number
+		integer :: multiplied_by_three
+
+		multiplied_by_three = number * 3
+	end function
+end program

Intermediate Fortran/Section 2 - Procedure Attributes/pure_and_elemental_exercise.f90

@@ -0,0 +1,30 @@
+program  pure_and_elemental_exercise
+	implicit none
+
+	integer, parameter :: PRIMES(*) = [2, 3, 5, 7, 11]
+	integer, parameter :: REAL_ANSWER = 1872
+	integer :: answer
+
+	! Replace '42' with an expression using elemental functions
+	! that calculates the equivalent of the following:
+	! answer = 0
+	! do i = 1, size(PRIMES)
+	!   answer = answer + (primes(i) * 3)**2
+	! end do
+	answer = sum(function_(primes))
+
+	if (answer == REAL_ANSWER) then
+		print *, "You got it! :)"
+	else
+		print *, answer
+		print *, "Not passing yet :("
+	end if
+contains
+	! put your functions down here
+	elemental function function_(primes_) result(resu)
+		integer, intent(in) :: primes_
+		integer :: resu
+
+		resu = (primes_ * 3)**2
+	end function
+end program

Intermediate Fortran/Section 2 - Procedure Attributes/pure_and_elemental_solution.f90

@@ -0,0 +1,39 @@
+program  pure_and_elemental_exercise
+	implicit none
+
+	integer, parameter :: PRIMES(*) = [2, 3, 5, 7, 11]
+	integer, parameter :: REAL_ANSWER = 1872
+	integer :: answer
+
+	! Replace '42' with an expression using elemental functions
+	! that calculates the equivalent of the following:
+	! answer = 0
+	! do i = 1, size(PRIMES)
+	!   answer = answer + (primes(i) * 3)**2
+	! end do
+	answer = sum(square(multiply_by_three(PRIMES)))
+	! Note: intrinsic operators are already elemental, so the following works too
+	! answer = sum((PRIMES * 3)**2)
+
+	if (answer == REAL_ANSWER) then
+		print *, "You got it! :)"
+	else
+		print *, answer
+		print *, "Not passing yet :("
+	end if
+contains
+	! put your functions down here
+	elemental function multiply_by_three(number) result(multiplied_by_three)
+		integer, intent(in) :: number
+		integer :: multiplied_by_three
+
+		multiplied_by_three = number * 3
+	end function
+
+	elemental function square(number) result(squared)
+		integer, intent(in) :: number
+		integer :: squared
+
+		squared = number ** 2
+	end function
+end program

Intermediate Fortran/Section 2 - Procedure Attributes/recursive_sum_exercise.f90

@@ -0,0 +1,27 @@
+program recursive_sum_exercise
+	implicit none
+
+	integer, parameter :: THE_NUMBERS(*) = [2, 3, 5, 7, 11]
+	integer :: answer
+
+	answer = sum_(THE_NUMBERS)
+
+	if (answer == 28) then
+		print *, "You got it! :)"
+	else
+		print *, answer
+		print *, "Not quite right yet. :("
+	end if
+contains
+	recursive function sum_(numbers) result(total)
+		integer, intent(in) :: numbers(:)
+		integer :: total
+
+		total = 0
+		if (size(numbers)==1) then
+			total = numbers(1)
+		else
+			total = numbers(1) + sum_(numbers(2:))
+		end if
+	end function
+end program

Intermediate Fortran/Section 2 - Procedure Attributes/recursive_sum_solution.f90

@@ -0,0 +1,37 @@
+program recursive_sum_exercise
+	implicit none
+
+	integer, parameter :: THE_NUMBERS(*) = [2, 3, 5, 7, 11]
+	integer :: answer
+
+	answer = sum2(THE_NUMBERS)
+
+	if (answer == 28) then
+		print *, "You got it! :)"
+	else
+		print *, answer
+		print *, "Not quite right yet. :("
+	end if
+contains
+	recursive function sum_(numbers) result(total)
+		integer, intent(in) :: numbers(:)
+		integer :: total
+
+		if (size(numbers) == 1) then
+			total = numbers(1)
+		else
+			total = sum_(numbers(1:size(numbers)/2)) + sum_(numbers(size(numbers)/2+1:))
+		end if
+	end function
+
+	recursive function sum2(numbers) result(total)
+		integer, intent(in) :: numbers(:)
+		integer :: total
+
+		if (size(numbers) == 1) then
+			total = numbers(1)
+		else
+			total = numbers(1) + sum2(numbers(2:))
+		end if
+	end function
+end program

Intermediate Fortran/Section 2 - Procedure Attributes/sum_with_reduce_exercise.f90

@@ -0,0 +1,56 @@
+module reduce_m
+	implicit none
+
+	abstract interface
+		pure function combiner(x, y) result(z)
+			integer, intent(in) :: x
+			integer, intent(in) :: y
+			integer :: z
+		end function
+	end interface
+contains
+	pure recursive function reduce(vals, accumulator, init) result(combined)
+		integer, intent(in) :: vals(:)
+		procedure(combiner) :: accumulator
+		integer, intent(in) :: init
+		integer :: combined
+
+		if (size(vals) == 1) then
+			combined = accumulator(init, vals(1))
+		else
+			combined = reduce(vals(2:), accumulator, accumulator(init, vals(1)))
+		end if
+	end function
+end module
+
+program main
+	use reduce_m, only: reduce
+
+	implicit none
+
+	integer :: answer
+
+	answer = sum_([1, 2, 3, 4])
+
+	if (answer == 10) then
+		print *, "You got it! :)"
+	else
+		print *, answer
+		print *, "Not quite right yet. :("
+	end if
+contains
+	pure function sum_(numbers) result(total)
+		integer, intent(in) :: numbers(:)
+		integer :: total
+
+		total = reduce(numbers, add, 0)
+	end function
+
+	pure function add(x, y) result(z)
+		integer, intent(in) :: x
+		integer, intent(in) :: y
+		integer :: z
+
+		z = x + y
+	end function
+end program

Intermediate Fortran/Section 2 - Procedure Attributes/sum_with_reduce_solution.f90

@@ -0,0 +1,56 @@
+module reduce_m
+	implicit none
+
+	abstract interface
+		pure function combiner(x, y) result(z)
+			integer, intent(in) :: x
+			integer, intent(in) :: y
+			integer :: z
+		end function
+	end interface
+contains
+	pure recursive function reduce(vals, accumulator, init) result(combined)
+		integer, intent(in) :: vals(:)
+		procedure(combiner) :: accumulator
+		integer, intent(in) :: init
+		integer :: combined
+
+		if (size(vals) == 1) then
+			combined = accumulator(init, vals(1))
+		else
+			combined = reduce(vals(2:), accumulator, accumulator(init, vals(1)))
+		end if
+	end function
+end module
+
+program main
+	use reduce_m, only: reduce
+
+	implicit none
+
+	integer :: answer
+
+	answer = sum_([1, 2, 3, 4])
+
+	if (answer == 10) then
+		print *, "You got it! :)"
+	else
+		print *, answer
+		print *, "Not quite right yet. :("
+	end if
+contains
+	pure function sum_(numbers) result(total)
+		integer, intent(in) :: numbers(:)
+		integer :: total
+
+		total = reduce(numbers, add, 0)
+	end function
+
+	pure function add(x, y) result(z)
+		integer, intent(in) :: x
+		integer, intent(in) :: y
+		integer :: z
+
+		z = x + y
+	end function
+end program

Intermediate Fortran/Section 3 - Data Structures/binary_tree-calculate_total/app/main.f90

@@ -0,0 +1,27 @@
+program main
+	use iso_varying_string, only: put_line
+	use leaf_m, only: leaf_t
+	use node_m, only: node_t
+	use strff, only: to_string
+
+	implicit none
+
+	type(node_t) :: tree
+
+	tree = node_t( &
+			node_t( &
+					node_t( &
+							node_t( &
+									leaf_t(1), &
+									leaf_t(23)), &
+							leaf_t(4)), &
+					leaf_t(567)), &
+			node_t( &
+					leaf_t(89), &
+					node_t( &
+							leaf_t(1234), &
+							leaf_t(56))))
+
+	call put_line(tree%to_string())
+	call put_line(to_string(tree%total()))
+end program

Intermediate Fortran/Section 3 - Data Structures/binary_tree-calculate_total/fpm.toml

@@ -0,0 +1,10 @@
+name = "binary_tree"
+version = "0.1.0"
+license = "MIT"
+author = "Brad Richardson"
+maintainer = "everythingfunctional@protonmail.com"
+copyright = "2021 Brad Richardson"
+
+[dependencies]
+  iso_varying_string = { git = "https://gitlab.com/everythingfunctional/iso_varying_string.git", tag = "v2.0.0" }
+  strff = { git = "https://gitlab.com/everythingfunctional/strff.git", tag = "v2.0.1" }

Intermediate Fortran/Section 3 - Data Structures/binary_tree-calculate_total/src/leaf_m.f90

@@ -0,0 +1,43 @@
+module leaf_m
+	use iso_varying_string, only: varying_string
+	use strff, only: to_string
+	use tree_m, only: tree_t
+
+	implicit none
+	private
+	public :: leaf_t
+
+	type, extends(tree_t) :: leaf_t
+		private
+		integer :: value_
+	contains
+		private
+		procedure, public :: to_string => leaf_to_string
+		procedure, public :: total
+	end type
+
+	interface leaf_t
+		module procedure constructor
+	end interface
+contains
+	pure function constructor(value_) result(leaf)
+		integer, intent(in) :: value_
+		type(leaf_t) :: leaf
+
+		leaf%value_ = value_
+	end function
+
+	pure function leaf_to_string(self) result(string)
+		class(leaf_t), intent(in) :: self
+		type(varying_string) :: string
+
+		string = to_string(self%value_)
+	end function
+
+	pure function total(self)
+		class(leaf_t), intent(in) :: self
+		integer :: total
+
+		total = self%value_
+	end function
+end module

Intermediate Fortran/Section 3 - Data Structures/binary_tree-calculate_total/src/node_m.f90

@@ -0,0 +1,162 @@
+module node_m
+	use iso_varying_string, only: &
+			varying_string, assignment(=), operator(//), len, trim, var_str
+	use strff, only: join, split_at, NEWLINE
+	use tree_m, only: tree_t
+
+	implicit none
+	private
+	public :: node_t
+
+	type, extends(tree_t) :: node_t
+		private
+		class(tree_t), allocatable :: left, right
+	contains
+		private
+		procedure, public :: to_string
+		procedure, public :: total
+	end type
+
+	interface node_t
+		module procedure constructor
+	end interface
+contains
+	function constructor(left, right) result(node)
+		class(tree_t), intent(in) :: left, right
+		type(node_t) :: node
+
+		allocate(node%left, source = left)
+		allocate(node%right, source = right)
+	end function
+
+	pure recursive function to_string(self) result(string)
+		class(node_t), intent(in) :: self
+		type(varying_string) :: string
+
+		type(varying_string) :: blocked
+		type(varying_string), allocatable :: child_strings(:)
+		type(varying_string) :: dashed_line
+		integer :: height_
+		type(varying_string), allocatable :: padded_strings(:)
+		type(varying_string) :: pipes
+		integer, allocatable :: widths(:)
+
+		allocate(child_strings, source = [self%left%to_string(), self%right%to_string()])
+		allocate(widths, source = max_width(child_strings)+1)
+		height_ = maxval(height(child_strings))
+		dashed_line = make_dashes(widths)
+		pipes = join(make_pipe(widths), "")
+		allocate(padded_strings, source = pad_to(child_strings, widths, height_))
+		blocked = join( &
+				[ dashed_line&
+				, pipes &
+				, concat_lines(padded_strings) &
+				], &
+				NEWLINE)
+		string = strip_trailing_space(blocked)
+	end function
+
+	pure recursive function total(self)
+		class(node_t), intent(in) :: self
+		integer :: total
+
+		total = self%left%total() + self%right%total()
+	end function
+
+	elemental function max_width(tree_string) result(width)
+		type(varying_string), intent(in) :: tree_string
+		integer :: width
+
+		width = maxval(len(split_at(tree_string, NEWLINE)))
+	end function
+
+	elemental function height(tree_string)
+		type(varying_string), intent(in) :: tree_string
+		integer :: height
+
+		height = size(split_at(tree_string, NEWLINE))
+	end function
+
+	elemental function pad_to(string, width, num_lines) result(padded)
+		type(varying_string), intent(in) :: string
+		integer, intent(in) :: width, num_lines
+		type(varying_string) :: padded
+
+		integer :: i
+
+		associate(lines => split_at(string, NEWLINE))
+			associate(padded_lines => pad_line(lines, width))
+				padded = join([padded_lines, [(var_str(repeat(" ", width)), i = 1, num_lines - size(lines))]], NEWLINE)
+			end associate
+		end associate
+	contains
+		elemental function pad_line(line, width) result(padded_line)
+			type(varying_string), intent(in) :: line
+			integer, intent(in) :: width
+			type(varying_string) :: padded_line
+
+			padded_line = line // repeat(" ", width - len(line))
+		end function
+	end function
+
+	pure function make_dashes(widths) result(dashes)
+		integer, intent(in) :: widths(:)
+		type(varying_string) :: dashes
+
+		if (size(widths) == 1) then
+			dashes = make_pipe(widths(1))
+		else
+			associate( &
+					leading_spaces => widths(1)/2 - 1, &
+					trailing_spaces => widths(size(widths)) - widths(size(widths))/2, &
+					total_width => sum(widths))
+				associate(dash_width => total_width - leading_spaces - trailing_spaces)
+					dashes = repeat(" ", leading_spaces) // repeat("-", dash_width) // repeat(" ", trailing_spaces)
+				end associate
+			end associate
+		end if
+	end function
+
+	elemental function make_pipe(width) result(pipe)
+		integer, intent(in) :: width
+		type(varying_string) :: pipe
+
+		pipe = center_in(var_str("|"), width)
+	end function
+
+	pure function center_in(string, width) result(centered)
+		type(varying_string), intent(in) :: string
+		integer, intent(in) :: width
+		type(varying_string) :: centered
+
+		associate(leading_spaces => width/2 - len(string)/2 - 1)
+			associate(trailing_spaces => width - leading_spaces - len(string))
+				centered = repeat(" ", leading_spaces) // string // repeat(" ", trailing_spaces)
+			end associate
+		end associate
+	end function
+
+	pure function concat_lines(strings) result(joined)
+		type(varying_string), intent(in) :: strings(:)
+		type(varying_string) :: joined
+
+		integer :: i, j
+
+		associate(lines => [(split_at(strings(i), NEWLINE), i = 1, size(strings))])
+			associate(num_lines => size(lines) / size(strings))
+				joined = join( &
+						[(join( &
+								[(lines(i), i = j, num_lines*size(strings), num_lines)] &
+								, ""), j = 1, num_lines)], &
+						NEWLINE)
+			end associate
+		end associate
+	end function
+
+	pure function strip_trailing_space(string) result(stripped)
+		type(varying_string), intent(in) :: string
+		type(varying_string) :: stripped
+
+		stripped = join(trim(split_at(string, NEWLINE)), NEWLINE)
+	end function
+end module

Intermediate Fortran/Section 3 - Data Structures/binary_tree-calculate_total/src/tree_m.f90

@@ -0,0 +1,34 @@
+module tree_m
+	use iso_varying_string, only: varying_string
+
+	implicit none
+	private
+	public :: tree_t
+
+	type, abstract :: tree_t
+	contains
+		private
+		procedure(to_string_i), public, deferred :: to_string
+		procedure(total_i), public, deferred :: total
+	end type
+
+	abstract interface
+		pure function to_string_i(self) result(string)
+			import :: tree_t, varying_string
+
+			implicit none
+
+			class(tree_t), intent(in) :: self
+			type(varying_string) :: string
+		end function
+
+		pure function total_i(self) result(total)
+			import :: tree_t
+
+			implicit none
+
+			class(tree_t), intent(in) :: self
+			integer :: total
+		end function
+	end interface
+end module

Intermediate Fortran/Section 3 - Data Structures/binary_tree-make_n-ary/app/main.f90

@@ -0,0 +1,32 @@
+program main
+	use iso_varying_string, only: put_line
+	use leaf_m, only: leaf_t
+	use node_m, only: node_t
+	use tree_item_m, only: tree_item_t
+
+	implicit none
+
+	type(node_t) :: tree
+
+	tree = node_t( &
+			[ tree_item_t(node_t( &
+					[ tree_item_t(node_t( &
+							[ tree_item_t(leaf_t(1)) &
+							, tree_item_t(leaf_t(23)) &
+							, tree_item_t(leaf_t(4)) &
+							])) &
+					, tree_item_t(leaf_t(567)) &
+					])) &
+			, tree_item_t(node_t( &
+					[ tree_item_t(node_t( &
+							[ tree_item_t(leaf_t(89)) &
+							])) &
+					, tree_item_t(node_t( &
+							[ tree_item_t(leaf_t(1234)) &
+							, tree_item_t(leaf_t(56)) &
+							])) &
+					])) &
+			])
+
+	call put_line(tree%to_string())
+end program

Intermediate Fortran/Section 3 - Data Structures/binary_tree-make_n-ary/fpm.toml

@@ -0,0 +1,10 @@
+name = "binary_tree"
+version = "0.1.0"
+license = "MIT"
+author = "Brad Richardson"
+maintainer = "everythingfunctional@protonmail.com"
+copyright = "2021 Brad Richardson"
+
+[dependencies]
+  iso_varying_string = { git = "https://gitlab.com/everythingfunctional/iso_varying_string.git", tag = "v2.0.0" }
+  strff = { git = "https://gitlab.com/everythingfunctional/strff.git", tag = "v2.0.1" }

Intermediate Fortran/Section 3 - Data Structures/binary_tree-make_n-ary/src/leaf_m.f90

@@ -0,0 +1,35 @@
+module leaf_m
+	use iso_varying_string, only: varying_string
+	use strff, only: to_string
+	use tree_m, only: tree_t
+
+	implicit none
+	private
+	public :: leaf_t
+
+	type, extends(tree_t) :: leaf_t
+		private
+		integer :: value_
+	contains
+		private
+		procedure, public :: to_string => leaf_to_string
+	end type
+
+	interface leaf_t
+		module procedure constructor
+	end interface
+contains
+	pure function constructor(value_) result(leaf)
+		integer, intent(in) :: value_
+		type(leaf_t) :: leaf
+
+		leaf%value_ = value_
+	end function
+
+	pure function leaf_to_string(self) result(string)
+		class(leaf_t), intent(in) :: self
+		type(varying_string) :: string
+
+		string = to_string(self%value_)
+	end function
+end module

Intermediate Fortran/Section 3 - Data Structures/binary_tree-make_n-ary/src/node_m.f90

@@ -0,0 +1,155 @@
+module node_m
+	use iso_varying_string, only: &
+			varying_string, assignment(=), operator(//), len, trim, var_str
+	use strff, only: join, split_at, NEWLINE
+	use tree_m, only: tree_t
+	use tree_item_m, only: tree_item_t
+
+	implicit none
+	private
+	public :: node_t
+
+	type, extends(tree_t) :: node_t
+		private
+		type(tree_item_t), allocatable :: children(:)
+	contains
+		private
+		procedure, public :: to_string
+	end type
+
+	interface node_t
+		module procedure constructor
+	end interface
+contains
+	function constructor(children) result(node)
+		type(tree_item_t), intent(in) :: children(:)
+		type(node_t) :: node
+
+		allocate(node%children, source = children)
+	end function
+
+	pure recursive function to_string(self) result(string)
+		class(node_t), intent(in) :: self
+		type(varying_string) :: string
+
+		type(varying_string) :: blocked
+		type(varying_string), allocatable :: child_strings(:)
+		type(varying_string) :: dashed_line
+		integer :: height_
+		integer :: i
+		type(varying_string), allocatable :: padded_strings(:)
+		type(varying_string) :: pipes
+		integer, allocatable :: widths(:)
+
+		allocate(child_strings, source = [(self%children(i)%to_string(), i = 1, size(self%children))])
+		allocate(widths, source = max_width(child_strings)+1)
+		height_ = maxval(height(child_strings))
+		dashed_line = make_dashes(widths)
+		pipes = join(make_pipe(widths), "")
+		allocate(padded_strings, source = pad_to(child_strings, widths, height_))
+		blocked = join( &
+				[ dashed_line&
+				, pipes &
+				, concat_lines(padded_strings) &
+				], &
+				NEWLINE)
+		string = strip_trailing_space(blocked)
+	end function
+
+	elemental function max_width(tree_string) result(width)
+		type(varying_string), intent(in) :: tree_string
+		integer :: width
+
+		width = maxval(len(split_at(tree_string, NEWLINE)))
+	end function
+
+	elemental function height(tree_string)
+		type(varying_string), intent(in) :: tree_string
+		integer :: height
+
+		height = size(split_at(tree_string, NEWLINE))
+	end function
+
+	elemental function pad_to(string, width, num_lines) result(padded)
+		type(varying_string), intent(in) :: string
+		integer, intent(in) :: width, num_lines
+		type(varying_string) :: padded
+
+		integer :: i
+
+		associate(lines => split_at(string, NEWLINE))
+			associate(padded_lines => pad_line(lines, width))
+				padded = join([padded_lines, [(var_str(repeat(" ", width)), i = 1, num_lines - size(lines))]], NEWLINE)
+			end associate
+		end associate
+	contains
+		elemental function pad_line(line, width) result(padded_line)
+			type(varying_string), intent(in) :: line
+			integer, intent(in) :: width
+			type(varying_string) :: padded_line
+
+			padded_line = line // repeat(" ", width - len(line))
+		end function
+	end function
+
+	pure function make_dashes(widths) result(dashes)
+		integer, intent(in) :: widths(:)
+		type(varying_string) :: dashes
+
+		if (size(widths) == 1) then
+			dashes = make_pipe(widths(1))
+		else
+			associate( &
+					leading_spaces => widths(1)/2 - 1, &
+					trailing_spaces => widths(size(widths)) - widths(size(widths))/2, &
+					total_width => sum(widths))
+				associate(dash_width => total_width - leading_spaces - trailing_spaces)
+					dashes = repeat(" ", leading_spaces) // repeat("-", dash_width) // repeat(" ", trailing_spaces)
+				end associate
+			end associate
+		end if
+	end function
+
+	elemental function make_pipe(width) result(pipe)
+		integer, intent(in) :: width
+		type(varying_string) :: pipe
+
+		pipe = center_in(var_str("|"), width)
+	end function
+
+	pure function center_in(string, width) result(centered)
+		type(varying_string), intent(in) :: string
+		integer, intent(in) :: width
+		type(varying_string) :: centered
+
+		associate(leading_spaces => width/2 - len(string)/2 - 1)
+			associate(trailing_spaces => width - leading_spaces - len(string))
+				centered = repeat(" ", leading_spaces) // string // repeat(" ", trailing_spaces)
+			end associate
+		end associate
+	end function
+
+	pure function concat_lines(strings) result(joined)
+		type(varying_string), intent(in) :: strings(:)
+		type(varying_string) :: joined
+
+		integer :: i, j
+
+		associate(lines => [(split_at(strings(i), NEWLINE), i = 1, size(strings))])
+			associate(num_lines => size(lines) / size(strings))
+				joined = join( &
+						[(join( &
+								[(lines(i), i = j, num_lines*size(strings), num_lines)] &
+								, ""), j = 1, num_lines)], &
+						NEWLINE)
+			end associate
+		end associate
+	end function
+
+	pure function strip_trailing_space(string) result(stripped)
+		type(varying_string), intent(in) :: string
+		type(varying_string) :: stripped
+
+		stripped = join(trim(split_at(string, NEWLINE)), NEWLINE)
+	end function
+end module

Intermediate Fortran/Section 3 - Data Structures/binary_tree-make_n-ary/src/tree_item_m.f90

@@ -0,0 +1,34 @@
+module tree_item_m
+	use iso_varying_string, only: varying_string
+	use tree_m, only: tree_t
+
+	implicit none
+	private
+	public :: tree_item_t
+
+	type :: tree_item_t
+		private
+		class(tree_t), allocatable :: tree
+	contains
+		private
+		procedure, public :: to_string
+	end type
+
+	interface tree_item_t
+		module procedure constructor
+	end interface
+contains
+	function constructor(tree) result(tree_item)
+		class(tree_t), intent(in) :: tree
+		type(tree_item_t) :: tree_item
+
+		allocate(tree_item%tree, source = tree)
+	end function
+
+	pure recursive function to_string(self) result(string)
+		class(tree_item_t), intent(in) :: self
+		type(varying_string) :: string
+
+		string = self%tree%to_string()
+	end function
+end module

Intermediate Fortran/Section 3 - Data Structures/binary_tree-make_n-ary/src/tree_m.f90

@@ -0,0 +1,24 @@
+module tree_m
+	use iso_varying_string, only: varying_string
+
+	implicit none
+	private
+	public :: tree_t
+
+	type, abstract :: tree_t
+	contains
+		private
+		procedure(to_string_i), public, deferred :: to_string
+	end type
+
+	abstract interface
+		pure function to_string_i(self) result(string)
+			import :: tree_t, varying_string
+
+			implicit none
+
+			class(tree_t), intent(in) :: self
+			type(varying_string) :: string
+		end function
+	end interface
+end module

Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/app/main.f90

@@ -0,0 +1,42 @@
+program main
+	use circle_m, only: circle_t
+	use iso_varying_string, only: put_line
+	use rectangle_m, only: rectangle_t
+	use shape_list_m, only: shape_list_t
+	use shape_item_m, only: shape_item_t
+	use square_m, only: square_t
+	use triangle_m, only: triangle_t
+
+	implicit none
+
+	type(shape_list_t) :: list
+
+	list = shape_list_t( &
+		shapes = [ &
+			shape_item_t( &
+				shape = square_t( &
+					width = 2.0 &
+				) &
+			), &
+			shape_item_t( &
+				shape = circle_t( &
+					radius = 3.0 &
+				) &
+			), &
+			shape_item_t( &
+				shape = triangle_t( &
+					base = 4.0, &
+					height = 5.0 &
+				) &
+			), &
+			shape_item_t( &
+				shape = rectangle_t( &
+					height = 2.0, &
+					width = 3.0 &
+				) &
+			) &
+		] &
+	)
+
+	call put_line(list%to_string())
+end program

Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/fpm.toml

@@ -0,0 +1,10 @@
+name = "heterogeneous_list"
+version = "0.1.0"
+license = "MIT"
+author = "Brad Richardson"
+maintainer = "everythingfunctional@protonmail.com"
+copyright = "2020 Brad Richardson"
+
+[dependencies]
+  iso_varying_string = { git = "https://gitlab.com/everythingfunctional/iso_varying_string.git", tag = "v2.0.0" }
+  strff = { git = "https://gitlab.com/everythingfunctional/strff.git", tag = "v2.0.1" }

Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/src/circle_m.f90

@@ -0,0 +1,39 @@
+module circle_m
+	use iso_varying_string, only: varying_string, operator(//)
+	use shape_m, only: shape_t
+	use strff, only: hanging_indent, to_string, NEWLINE
+
+	implicit none
+	private
+	public :: circle_t
+
+	type, extends(shape_t) :: circle_t
+		private
+		real :: radius
+	contains
+		private
+		procedure, public :: to_string => circle_to_string
+	end type
+
+	interface circle_t
+		module procedure constructor
+	end interface
+contains
+	pure function constructor(radius) result(circle)
+		real, intent(in) :: radius
+		type(circle_t) :: circle
+
+		circle%radius = radius
+	end function
+
+	pure function circle_to_string(self) result(string)
+		class(circle_t), intent(in) :: self
+		type(varying_string) :: string
+
+		string = hanging_indent( &
+				"circle_t(" // NEWLINE &
+						// "radius = " // to_string(self%radius), &
+				4) // NEWLINE &
+				// ")"
+	end function
+end module

Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/src/rectangle_m.f90

@@ -0,0 +1,43 @@
+module rectangle_m
+	use iso_varying_string, only: varying_string, operator(//)
+	use shape_m, only: shape_t
+	use strff, only: hanging_indent, to_string, NEWLINE
+
+	implicit none
+	private
+	public :: rectangle_t
+
+	type, extends(shape_t) :: rectangle_t
+		private
+		real :: height
+		real :: width
+	contains
+		private
+		procedure, public :: to_string => rectangle_to_string
+	end type
+
+	interface rectangle_t
+		module procedure constructor
+	end interface
+contains
+	pure function constructor(height, width) result(rectangle)
+		real, intent(in) :: height
+		real, intent(in) :: width
+		type(rectangle_t) :: rectangle
+
+		rectangle%height = height
+		rectangle%width = width
+	end function
+
+	pure function rectangle_to_string(self) result(string)
+		class(rectangle_t), intent(in) :: self
+		type(varying_string) :: string
+
+		string = hanging_indent( &
+				"rectangle_t(" // NEWLINE &
+						// "height = " // to_string(self%height) // "," // NEWLINE &
+						// "width = " // to_string(self%width), &
+				4) // NEWLINE &
+				// ")"
+	end function
+end module

Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/src/shape_item_m.f90

@@ -0,0 +1,39 @@
+module shape_item_m
+	use iso_varying_string, only: varying_string, operator(//)
+	use shape_m, only: shape_t
+	use strff, only: hanging_indent, NEWLINE
+
+	implicit none
+	private
+	public :: shape_item_t
+
+	type :: shape_item_t
+		private
+		class(shape_t), allocatable :: shape
+	contains
+		private
+		procedure, public :: to_string
+	end type
+
+	interface shape_item_t
+		module procedure constructor
+	end interface
+contains
+	function constructor(shape) result(shape_item)
+		class(shape_t), intent(in) :: shape
+		type(shape_item_t) :: shape_item
+
+		shape_item%shape = shape
+	end function
+
+	elemental function to_string(self) result(string)
+		class(shape_item_t), intent(in) :: self
+		type(varying_string) :: string
+
+		string = hanging_indent( &
+				"shape_item_t(" // NEWLINE &
+						// "shape = " // self%shape%to_string(), &
+				4) // NEWLINE &
+				// ")"
+	end function
+end module

Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/src/shape_list_m.f90

@@ -0,0 +1,41 @@
+module shape_list_m
+	use iso_varying_string, only: varying_string, operator(//)
+	use shape_item_m, only: shape_item_t
+	use strff, only: hanging_indent, indent, join, NEWLINE
+
+	implicit none
+	private
+	public :: shape_list_t
+
+	type :: shape_list_t
+		private
+		type(shape_item_t), allocatable :: shapes(:)
+	contains
+		private
+		procedure, public :: to_string
+	end type
+
+	interface shape_list_t
+		module procedure constructor
+	end interface
+contains
+	function constructor(shapes) result(shape_list)
+		type(shape_item_t), intent(in) :: shapes(:)
+		type(shape_list_t) :: shape_list
+
+		allocate(shape_list%shapes, source = shapes)
+	end function
+
+	pure function to_string(self) result(string)
+		class(shape_list_t), intent(in) :: self
+		type(varying_string) :: string
+
+		string = hanging_indent( &
+				"shape_list_t(" // NEWLINE &
+						// "shapes = [" // NEWLINE &
+						// indent(join(self%shapes%to_string(), "," // NEWLINE), 4) // NEWLINE &
+						// "]", &
+				4) // NEWLINE &
+				// ")"
+	end function
+end module

Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/src/shape_m.f90

@@ -0,0 +1,24 @@
+module shape_m
+	use iso_varying_string, only: varying_string
+
+	implicit none
+	private
+	public :: shape_t
+
+	type, abstract :: shape_t
+	contains
+		private
+		procedure(to_string_i), deferred, public :: to_string
+	end type
+
+	abstract interface
+		pure function to_string_i(self) result(string)
+			import :: shape_t, varying_string
+
+			implicit none
+
+			class(shape_t), intent(in) :: self
+			type(varying_string) :: string
+		end function
+	end interface
+end module

Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/src/square_m.f90

@@ -0,0 +1,39 @@
+module square_m
+	use iso_varying_string, only: varying_string, operator(//)
+	use shape_m, only: shape_t
+	use strff, only: hanging_indent, to_string, NEWLINE
+
+	implicit none
+	private
+	public :: square_t
+
+	type, extends(shape_t) :: square_t
+		private
+		real :: width
+	contains
+		private
+		procedure, public :: to_string => square_to_string
+	end type
+
+	interface square_t
+		module procedure constructor
+	end interface
+contains
+	pure function constructor(width) result(square)
+		real, intent(in) :: width
+		type(square_t) :: square
+
+		square%width = width
+	end function
+
+	pure function square_to_string(self) result(string)
+		class(square_t), intent(in) :: self
+		type(varying_string) :: string
+
+		string = hanging_indent( &
+				"square_t(" // NEWLINE &
+						// "width = " // to_string(self%width), &
+				4) // NEWLINE &
+				// ")"
+	end function
+end module

Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/src/triangle_m.f90

@@ -0,0 +1,43 @@
+module triangle_m
+	use iso_varying_string, only: varying_string, operator(//)
+	use shape_m, only: shape_t
+	use strff, only: hanging_indent, to_string, NEWLINE
+
+	implicit none
+	private
+	public :: triangle_t
+
+	type, extends(shape_t) :: triangle_t
+		private
+		real :: base
+		real :: height
+	contains
+		private
+		procedure, public :: to_string => triangle_to_string
+	end type
+
+	interface triangle_t
+		module procedure constructor
+	end interface
+contains
+	pure function constructor(base, height) result(triangle)
+		real, intent(in) :: base
+		real, intent(in) :: height
+		type(triangle_t) :: triangle
+
+		triangle%base = base
+		triangle%height = height
+	end function
+
+	pure function triangle_to_string(self) result(string)
+		class(triangle_t), intent(in) :: self
+		type(varying_string) :: string
+
+		string = hanging_indent( &
+				"triangle_t(" // NEWLINE &
+						// "base = " // to_string(self%base) // "," // NEWLINE &
+						// "height = " // to_string(self%height), &
+				4) // NEWLINE &
+				// ")"
+	end function
+end module

Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-calculate_area/app/main.f90

@@ -0,0 +1,37 @@
+program main
+	use circle_m, only: circle_t
+	use iso_varying_string, only: put_line
+	use shape_list_m, only: shape_list_t
+	use shape_item_m, only: shape_item_t
+	use square_m, only: square_t
+	use strff, only: to_string
+	use triangle_m, only: triangle_t
+
+	implicit none
+
+	type(shape_list_t) :: list
+
+	list = shape_list_t( &
+		shapes = [ &
+			shape_item_t( &
+				shape = square_t( &
+					width = 2.0 &
+				) &
+			), &
+			shape_item_t( &
+				shape = circle_t( &
+					radius = 3.0 &
+				) &
+			), &
+			shape_item_t( &
+				shape = triangle_t( &
+					base = 4.0, &
+					height = 5.0 &
+				) &
+			) &
+		] &
+	)
+
+	call put_line(list%to_string())
+	call put_line(to_string(list%total_area()))
+end program

Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-calculate_area/fpm.toml

@@ -0,0 +1,10 @@
+name = "heterogeneous_list"
+version = "0.1.0"
+license = "MIT"
+author = "Brad Richardson"
+maintainer = "everythingfunctional@protonmail.com"
+copyright = "2020 Brad Richardson"
+
+[dependencies]
+  iso_varying_string = { git = "https://gitlab.com/everythingfunctional/iso_varying_string.git", tag = "v2.0.0" }
+  strff = { git = "https://gitlab.com/everythingfunctional/strff.git", tag = "v2.0.1" }

Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-calculate_area/src/circle_m.f90

@@ -0,0 +1,47 @@
+module circle_m
+	use iso_varying_string, only: varying_string, operator(//)
+	use shape_m, only: shape_t
+	use strff, only: hanging_indent, to_string, NEWLINE
+
+	implicit none
+	private
+	public :: circle_t
+
+	type, extends(shape_t) :: circle_t
+		private
+		real :: radius
+	contains
+		private
+		procedure, public :: to_string => circle_to_string
+		procedure, public :: area
+	end type
+
+	interface circle_t
+		module procedure constructor
+	end interface
+contains
+	pure function constructor(radius) result(circle)
+		real, intent(in) :: radius
+		type(circle_t) :: circle
+
+		circle%radius = radius
+	end function
+
+	pure function circle_to_string(self) result(string)
+		class(circle_t), intent(in) :: self
+		type(varying_string) :: string
+
+		string = hanging_indent( &
+				"circle_t(" // NEWLINE &
+						// "radius = " // to_string(self%radius), &
+				4) // NEWLINE &
+				// ")"
+	end function
+
+	pure function area(self)
+		class(circle_t), intent(in) :: self
+		real :: area
+
+		area = 3.1415 * self%radius**2
+	end function
+end module

Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-calculate_area/src/shape_item_m.f90

@@ -0,0 +1,47 @@
+module shape_item_m
+	use iso_varying_string, only: varying_string, operator(//)
+	use shape_m, only: shape_t
+	use strff, only: hanging_indent, NEWLINE
+
+	implicit none
+	private
+	public :: shape_item_t
+
+	type :: shape_item_t
+		private
+		class(shape_t), allocatable :: shape
+	contains
+		private
+		procedure, public :: to_string
+		procedure, public :: area
+	end type
+
+	interface shape_item_t
+		module procedure constructor
+	end interface
+contains
+	function constructor(shape) result(shape_item)
+		class(shape_t), intent(in) :: shape
+		type(shape_item_t) :: shape_item
+
+		shape_item%shape = shape
+	end function
+
+	elemental function to_string(self) result(string)
+		class(shape_item_t), intent(in) :: self
+		type(varying_string) :: string
+
+		string = hanging_indent( &
+				"shape_item_t(" // NEWLINE &
+						// "shape = " // self%shape%to_string(), &
+				4) // NEWLINE &
+				// ")"
+	end function
+
+	elemental function area(self)
+		class(shape_item_t), intent(in) :: self
+		real :: area
+
+		area = self%shape%area()
+	end function
+end module

Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-calculate_area/src/shape_list_m.f90

@@ -0,0 +1,49 @@
+module shape_list_m
+	use iso_varying_string, only: varying_string, operator(//)
+	use shape_item_m, only: shape_item_t
+	use strff, only: hanging_indent, indent, join, NEWLINE
+
+	implicit none
+	private
+	public :: shape_list_t
+
+	type :: shape_list_t
+		private
+		type(shape_item_t), allocatable :: shapes(:)
+	contains
+		private
+		procedure, public :: to_string
+		procedure, public :: total_area
+	end type
+
+	interface shape_list_t
+		module procedure constructor
+	end interface
+contains
+	function constructor(shapes) result(shape_list)
+		type(shape_item_t), intent(in) :: shapes(:)
+		type(shape_list_t) :: shape_list
+
+		allocate(shape_list%shapes, source = shapes)
+	end function
+
+	pure function to_string(self) result(string)
+		class(shape_list_t), intent(in) :: self
+		type(varying_string) :: string
+
+		string = hanging_indent( &
+				"shape_list_t(" // NEWLINE &
+						// "shapes = [" // NEWLINE &
+						// indent(join(self%shapes%to_string(), "," // NEWLINE), 4) // NEWLINE &
+						// "]", &
+				4) // NEWLINE &
+				// ")"
+	end function
+
+	pure function total_area(self)
+		class(shape_list_t), intent(in) :: self
+		real :: total_area
+
+		total_area = sum(self%shapes%area())
+	end function
+end module

Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-calculate_area/src/shape_m.f90

@@ -0,0 +1,34 @@
+module shape_m
+	use iso_varying_string, only: varying_string
+
+	implicit none
+	private
+	public :: shape_t
+
+	type, abstract :: shape_t
+	contains
+		private
+		procedure(to_string_i), deferred, public :: to_string
+		procedure(area_i), deferred, public :: area
+	end type
+
+	abstract interface
+		pure function to_string_i(self) result(string)
+			import :: shape_t, varying_string
+
+			implicit none
+
+			class(shape_t), intent(in) :: self
+			type(varying_string) :: string
+		end function
+
+		pure function area_i(self) result(area)
+			import :: shape_t
+
+			implicit none
+
+			class(shape_t), intent(in) :: self
+			real :: area
+		end function
+	end interface
+end module

Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-calculate_area/src/square_m.f90

@@ -0,0 +1,47 @@
+module square_m
+	use iso_varying_string, only: varying_string, operator(//)
+	use shape_m, only: shape_t
+	use strff, only: hanging_indent, to_string, NEWLINE
+
+	implicit none
+	private
+	public :: square_t
+
+	type, extends(shape_t) :: square_t
+		private
+		real :: width
+	contains
+		private
+		procedure, public :: to_string => square_to_string
+		procedure, public :: area
+	end type
+
+	interface square_t
+		module procedure constructor
+	end interface
+contains
+	pure function constructor(width) result(square)
+		real, intent(in) :: width
+		type(square_t) :: square
+
+		square%width = width
+	end function
+
+	pure function square_to_string(self) result(string)
+		class(square_t), intent(in) :: self
+		type(varying_string) :: string
+
+		string = hanging_indent( &
+				"square_t(" // NEWLINE &
+						// "width = " // to_string(self%width), &
+				4) // NEWLINE &
+				// ")"
+	end function
+
+	pure function area(self)
+		class(square_t), intent(in) :: self
+		real :: area
+
+		area = self%width**2
+	end function
+end module

Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-calculate_area/src/triangle_m.f90

@@ -0,0 +1,51 @@
+module triangle_m
+	use iso_varying_string, only: varying_string, operator(//)
+	use shape_m, only: shape_t
+	use strff, only: hanging_indent, to_string, NEWLINE
+
+	implicit none
+	private
+	public :: triangle_t
+
+	type, extends(shape_t) :: triangle_t
+		private
+		real :: base
+		real :: height
+	contains
+		private
+		procedure, public :: to_string => triangle_to_string
+		procedure, public :: area
+	end type
+
+	interface triangle_t
+		module procedure constructor
+	end interface
+contains
+	pure function constructor(base, height) result(triangle)
+		real, intent(in) :: base
+		real, intent(in) :: height
+		type(triangle_t) :: triangle
+
+		triangle%base = base
+		triangle%height = height
+	end function
+
+	pure function triangle_to_string(self) result(string)
+		class(triangle_t), intent(in) :: self
+		type(varying_string) :: string
+
+		string = hanging_indent( &
+				"triangle_t(" // NEWLINE &
+						// "base = " // to_string(self%base) // "," // NEWLINE &
+						// "height = " // to_string(self%height), &
+				4) // NEWLINE &
+				// ")"
+	end function
+
+	pure function area(self)
+		class(triangle_t), intent(in) :: self
+		real :: area
+
+		area = (self%base * self%height) / 2.0
+	end function
+end module

Intermediate Fortran/Section 3 - Data Structures/linked_list_example.f90

@@ -0,0 +1,120 @@
+module integer_list_m
+	implicit none
+	private
+	public :: integer_list_t, visitor_t
+
+	type :: list_node_t
+		private
+		integer :: val
+		type(list_node_t), pointer :: next => null()
+	end type
+
+	type :: integer_list_t
+		private
+		type(list_node_t), pointer :: head => null()
+	contains
+		private
+		procedure, public :: prepend
+		procedure, public :: foreach
+	end type
+
+	type, abstract :: visitor_t
+	contains
+		private
+		procedure(visit_i), deferred, public :: visit
+	end type
+
+	abstract interface
+		subroutine visit_i(self, item)
+			import visitor_t
+			implicit none
+			class(visitor_t), intent(inout) :: self
+			integer, intent(inout) :: item
+		end subroutine
+	end interface
+contains
+	subroutine prepend(self, item)
+		class(integer_list_t), intent(inout) :: self
+		integer, intent(in) :: item
+
+		type(list_node_t), pointer :: new
+
+		if (associated(self%head)) then
+			allocate(new)
+			new%val = item
+			new%next => self%head
+			self%head => new
+		else
+			allocate(self%head)
+			self%head%val = item
+		end if
+	end subroutine
+
+	subroutine foreach(self, visitor)
+		class(integer_list_t), intent(inout) :: self
+		class(visitor_t), intent(inout) :: visitor
+
+		type(list_node_t), pointer :: cursor
+
+		cursor => self%head
+		do while (associated(cursor))
+			call visitor%visit(cursor%val)
+			cursor => cursor%next
+		end do
+	end subroutine
+end module
+
+module list_operator_m
+	use integer_list_m, only: visitor_t
+
+	implicit none
+	private
+	public :: printer_t, squarer_t
+
+	type, extends(visitor_t) :: printer_t
+	contains
+		private
+		procedure, public :: visit => printer_visit
+	end type
+
+	type, extends(visitor_t) :: squarer_t
+	contains
+		private
+		procedure, public :: visit => squarer_visit
+	end type
+contains
+	subroutine printer_visit(self, item)
+		class(printer_t), intent(inout) :: self
+		integer, intent(inout) :: item
+
+		print *, item
+	end subroutine
+
+	subroutine squarer_visit(self, item)
+		class(squarer_t), intent(inout) :: self
+		integer, intent(inout) :: item
+
+		item = item*item
+	end subroutine
+end module
+
+program main
+	use integer_list_m, only: integer_list_t
+	use list_operator_m, only: printer_t, squarer_t
+
+	implicit none
+
+	type(integer_list_t) :: list
+	type(printer_t) :: printer
+	type(squarer_t) :: squarer
+
+	call list%prepend(2)
+	call list%prepend(3)
+	call list%prepend(5)
+
+	call list%foreach(printer)
+
+	call list%foreach(squarer)
+
+	call list%foreach(printer)
+end program

Intermediate Fortran/Section 3 - Data Structures/linked_list_exercise.f90

@@ -0,0 +1,146 @@
+module integer_list_m
+	implicit none
+	private
+	public :: integer_list_t, visitor_t
+
+	type :: list_node_t
+		private
+		integer :: val
+		type(list_node_t), pointer :: next => null()
+	end type
+
+	type :: integer_list_t
+		private
+		type(list_node_t), pointer :: head => null()
+	contains
+		private
+		procedure, public :: prepend
+		procedure, public :: foreach
+	end type
+
+	type, abstract :: visitor_t
+	contains
+		private
+		procedure(visit_i), deferred, public :: visit
+	end type
+
+	abstract interface
+		subroutine visit_i(self, item)
+			import visitor_t
+			implicit none
+			class(visitor_t), intent(inout) :: self
+			integer, intent(inout) :: item
+		end subroutine
+	end interface
+contains
+	subroutine prepend(self, item)
+		class(integer_list_t), intent(inout) :: self
+		integer, intent(in) :: item
+
+		type(list_node_t), pointer :: new
+
+		if (associated(self%head)) then
+			allocate(new)
+			new%val = item
+			new%next => self%head
+			self%head => new
+		else
+			allocate(self%head)
+			self%head%val = item
+		end if
+	end subroutine
+
+	subroutine foreach(self, visitor)
+		class(integer_list_t), intent(inout) :: self
+		class(visitor_t), intent(inout) :: visitor
+
+		type(list_node_t), pointer :: cursor
+
+		cursor => self%head
+		do while (associated(cursor))
+			call visitor%visit(cursor%val)
+			cursor => cursor%next
+		end do
+	end subroutine
+end module
+
+module list_operator_m
+	use integer_list_m, only: visitor_t
+
+	implicit none
+	private
+	public :: printer_t, squarer_t, summer_t
+
+	type, extends(visitor_t) :: printer_t
+	contains
+		private
+		procedure, public :: visit => printer_visit
+	end type
+
+	type, extends(visitor_t) :: squarer_t
+	contains
+		private
+		procedure, public :: visit => squarer_visit
+	end type
+
+	type, extends(visitor_t) :: summer_t
+		private
+		integer :: total = 0
+	contains
+		private
+		procedure, public :: visit => summer_visit
+		procedure, public :: get_sum
+	end type
+contains
+	subroutine printer_visit(self, item)
+		class(printer_t), intent(inout) :: self
+		integer, intent(inout) :: item
+
+		print *, item
+	end subroutine
+
+	subroutine squarer_visit(self, item)
+		class(squarer_t), intent(inout) :: self
+		integer, intent(inout) :: item
+
+		item = item*item
+	end subroutine
+
+	subroutine summer_visit(self, item)
+		class(summer_t), intent(inout) :: self
+		integer, intent(inout) :: item
+
+		self%total = self%total + item
+	end subroutine
+
+	pure integer function get_sum(self)
+		class(summer_t), intent(in) :: self
+
+		get_sum = self%total
+	end function
+end module
+
+program main
+	use integer_list_m, only: integer_list_t
+	use list_operator_m, only: printer_t, squarer_t, summer_t
+
+	implicit none
+
+	type(integer_list_t) :: list
+	type(printer_t) :: printer
+	type(squarer_t) :: squarer
+	type(summer_t) :: summer
+
+	call list%prepend(2)
+	call list%prepend(3)
+	call list%prepend(5)
+
+	call list%foreach(printer)
+
+	call list%foreach(squarer)
+
+	call list%foreach(printer)
+
+	call list%foreach(summer)
+	print *, summer%get_sum()
+end program

Intermediate Fortran/Section 3 - Data Structures/linked_list_solution.f90

@@ -0,0 +1,147 @@
+module integer_list_m
+	implicit none
+	private
+	public :: integer_list_t, visitor_t
+
+	type :: list_node_t
+		private
+		integer :: val
+		type(list_node_t), pointer :: next => null()
+	end type
+
+	type :: integer_list_t
+		private
+		type(list_node_t), pointer :: head => null()
+	contains
+		private
+		procedure, public :: prepend
+		procedure, public :: foreach
+	end type
+
+	type, abstract :: visitor_t
+	contains
+		private
+		procedure(visit_i), deferred, public :: visit
+	end type
+
+	abstract interface
+		subroutine visit_i(self, item)
+			import visitor_t
+			implicit none
+			class(visitor_t), intent(inout) :: self
+			integer, intent(inout) :: item
+		end subroutine
+	end interface
+contains
+	subroutine prepend(self, item)
+		class(integer_list_t), intent(inout) :: self
+		integer, intent(in) :: item
+
+		type(list_node_t), pointer :: new
+
+		if (associated(self%head)) then
+			allocate(new)
+			new%val = item
+			new%next => self%head
+			self%head => new
+		else
+			allocate(self%head)
+			self%head%val = item
+		end if
+	end subroutine
+
+	subroutine foreach(self, visitor)
+		class(integer_list_t), intent(inout) :: self
+		class(visitor_t), intent(inout) :: visitor
+
+		type(list_node_t), pointer :: cursor
+
+		cursor => self%head
+		do while (associated(cursor))
+			call visitor%visit(cursor%val)
+			cursor => cursor%next
+		end do
+	end subroutine
+end module
+
+module list_operator_m
+	use integer_list_m, only: visitor_t
+
+	implicit none
+	private
+	public :: printer_t, squarer_t, summer_t
+
+	type, extends(visitor_t) :: printer_t
+	contains
+		private
+		procedure, public :: visit => printer_visit
+	end type
+
+	type, extends(visitor_t) :: squarer_t
+	contains
+		private
+		procedure, public :: visit => squarer_visit
+	end type
+
+	type, extends(visitor_t) :: summer_t
+		private
+		integer :: total = 0
+	contains
+		private
+		procedure, public :: visit => summer_visit
+		procedure, public :: get_sum
+	end type
+contains
+	subroutine printer_visit(self, item)
+		class(printer_t), intent(inout) :: self
+		integer, intent(inout) :: item
+
+		print *, item
+	end subroutine
+
+	subroutine squarer_visit(self, item)
+		class(squarer_t), intent(inout) :: self
+		integer, intent(inout) :: item
+
+		item = item*item
+	end subroutine
+
+	subroutine summer_visit(self, item)
+		class(summer_t), intent(inout) :: self
+		integer, intent(inout) :: item
+
+		self%total = self%total + item
+	end subroutine
+
+	pure function get_sum(self) result(total)
+		class(summer_t), intent(in) :: self
+		integer :: total
+
+		total = self%total
+	end function
+end module
+
+program main
+	use integer_list_m, only: integer_list_t
+	use list_operator_m, only: printer_t, squarer_t, summer_t
+
+	implicit none
+
+	type(integer_list_t) :: list
+	type(printer_t) :: printer
+	type(squarer_t) :: squarer
+	type(summer_t) :: summer
+
+	call list%prepend(2)
+	call list%prepend(3)
+	call list%prepend(5)
+
+	call list%foreach(printer)
+
+	call list%foreach(squarer)
+
+	call list%foreach(printer)
+
+	call list%foreach(summer)
+	print *, summer%get_sum()
+end program

Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-concat_lists/app/main.f90

@@ -0,0 +1,40 @@
+program main
+	use circle_m, only: circle_t
+	use iso_varying_string, only: put_line
+	use shape_list_m, only: shape_list_t
+	use shape_item_m, only: shape_item_t
+	use square_m, only: square_t
+	use triangle_m, only: triangle_t
+
+	implicit none
+
+	type(shape_list_t) :: list
+	type(shape_list_t) :: duplicated_list
+
+	list = shape_list_t( &
+		shapes = [ &
+			shape_item_t( &
+				shape = square_t( &
+					width = 2.0 &
+				) &
+			), &
+			shape_item_t( &
+				shape = circle_t( &
+					radius = 3.0 &
+				) &
+			), &
+			shape_item_t( &
+				shape = triangle_t( &
+					base = 4.0, &
+					height = 5.0 &
+				) &
+			) &
+		] &
+	)
+
+	call put_line(list%to_string())
+
+	duplicated_list = list // list
+
+	call put_line(duplicated_list%to_string())
+end program

Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-concat_lists/fpm.toml

@@ -0,0 +1,10 @@
+name = "heterogeneous_list"
+version = "0.1.0"
+license = "MIT"
+author = "Brad Richardson"
+maintainer = "everythingfunctional@protonmail.com"
+copyright = "2020 Brad Richardson"
+
+[dependencies]
+  iso_varying_string = { git = "https://gitlab.com/everythingfunctional/iso_varying_string.git", tag = "v2.0.0" }
+  strff = { git = "https://gitlab.com/everythingfunctional/strff.git", tag = "v2.0.1" }

Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-concat_lists/src/circle_m.f90

@@ -0,0 +1,39 @@
+module circle_m
+	use iso_varying_string, only: varying_string, operator(//)
+	use shape_m, only: shape_t
+	use strff, only: hanging_indent, to_string, NEWLINE
+
+	implicit none
+	private
+	public :: circle_t
+
+	type, extends(shape_t) :: circle_t
+		private
+		real :: radius
+	contains
+		private
+		procedure, public :: to_string => circle_to_string
+	end type
+
+	interface circle_t
+		module procedure constructor
+	end interface
+contains
+	pure function constructor(radius) result(circle)
+		real, intent(in) :: radius
+		type(circle_t) :: circle
+
+		circle%radius = radius
+	end function
+
+	pure function circle_to_string(self) result(string)
+		class(circle_t), intent(in) :: self
+		type(varying_string) :: string
+
+		string = hanging_indent( &
+				"circle_t(" // NEWLINE &
+						// "radius = " // to_string(self%radius), &
+				4) // NEWLINE &
+				// ")"
+	end function
+end module

Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-concat_lists/src/shape_item_m.f90

@@ -0,0 +1,39 @@
+module shape_item_m
+	use iso_varying_string, only: varying_string, operator(//)
+	use shape_m, only: shape_t
+	use strff, only: hanging_indent, NEWLINE
+
+	implicit none
+	private
+	public :: shape_item_t
+
+	type :: shape_item_t
+		private
+		class(shape_t), allocatable :: shape
+	contains
+		private
+		procedure, public :: to_string
+	end type
+
+	interface shape_item_t
+		module procedure constructor
+	end interface
+contains
+	function constructor(shape) result(shape_item)
+		class(shape_t), intent(in) :: shape
+		type(shape_item_t) :: shape_item
+
+		shape_item%shape = shape
+	end function
+
+	elemental function to_string(self) result(string)
+		class(shape_item_t), intent(in) :: self
+		type(varying_string) :: string
+
+		string = hanging_indent( &
+				"shape_item_t(" // NEWLINE &
+						// "shape = " // self%shape%to_string(), &
+				4) // NEWLINE &
+				// ")"
+	end function
+end module

Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-concat_lists/src/shape_list_m.f90

@@ -0,0 +1,51 @@
+module shape_list_m
+	use iso_varying_string, only: varying_string, operator(//)
+	use shape_item_m, only: shape_item_t
+	use strff, only: hanging_indent, indent, join, NEWLINE
+
+	implicit none
+	private
+	public :: shape_list_t
+
+	type :: shape_list_t
+		private
+		type(shape_item_t), allocatable :: shapes(:)
+	contains
+		private
+		procedure, public :: to_string
+		procedure :: concat
+		generic, public :: operator(//) => concat
+	end type
+
+	interface shape_list_t
+		module procedure constructor
+	end interface
+contains
+	function constructor(shapes) result(shape_list)
+		type(shape_item_t), intent(in) :: shapes(:)
+		type(shape_list_t) :: shape_list
+
+		allocate(shape_list%shapes, source = shapes)
+	end function
+
+	pure function to_string(self) result(string)
+		class(shape_list_t), intent(in) :: self
+		type(varying_string) :: string
+
+		string = hanging_indent( &
+				"shape_list_t(" // NEWLINE &
+						// "shapes = [" // NEWLINE &
+						// indent(join(self%shapes%to_string(), "," // NEWLINE), 4) // NEWLINE &
+						// "]", &
+				4) // NEWLINE &
+				// ")"
+	end function
+
+	function concat(lhs, rhs) result(combined)
+		class(shape_list_t), intent(in) :: lhs
+		type(shape_list_t), intent(in) :: rhs
+		type(shape_list_t) :: combined
+
+		allocate(combined%shapes, source = [lhs%shapes, rhs%shapes])
+	end function
+end module

Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-concat_lists/src/shape_m.f90

@@ -0,0 +1,24 @@
+module shape_m
+	use iso_varying_string, only: varying_string
+
+	implicit none
+	private
+	public :: shape_t
+
+	type, abstract :: shape_t
+	contains
+		private
+		procedure(to_string_i), deferred, public :: to_string
+	end type
+
+	abstract interface
+		pure function to_string_i(self) result(string)
+			import :: shape_t, varying_string
+
+			implicit none
+
+			class(shape_t), intent(in) :: self
+			type(varying_string) :: string
+		end function
+	end interface
+end module

Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-concat_lists/src/square_m.f90

@@ -0,0 +1,39 @@
+module square_m
+	use iso_varying_string, only: varying_string, operator(//)
+	use shape_m, only: shape_t
+	use strff, only: hanging_indent, to_string, NEWLINE
+
+	implicit none
+	private
+	public :: square_t
+
+	type, extends(shape_t) :: square_t
+		private
+		real :: width
+	contains
+		private
+		procedure, public :: to_string => square_to_string
+	end type
+
+	interface square_t
+		module procedure constructor
+	end interface
+contains
+	pure function constructor(width) result(square)
+		real, intent(in) :: width
+		type(square_t) :: square
+
+		square%width = width
+	end function
+
+	pure function square_to_string(self) result(string)
+		class(square_t), intent(in) :: self
+		type(varying_string) :: string
+
+		string = hanging_indent( &
+				"square_t(" // NEWLINE &
+						// "width = " // to_string(self%width), &
+				4) // NEWLINE &
+				// ")"
+	end function
+end module

Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-concat_lists/src/triangle_m.f90

@@ -0,0 +1,43 @@
+module triangle_m
+	use iso_varying_string, only: varying_string, operator(//)
+	use shape_m, only: shape_t
+	use strff, only: hanging_indent, to_string, NEWLINE
+
+	implicit none
+	private
+	public :: triangle_t
+
+	type, extends(shape_t) :: triangle_t
+		private
+		real :: base
+		real :: height
+	contains
+		private
+		procedure, public :: to_string => triangle_to_string
+	end type
+
+	interface triangle_t
+		module procedure constructor
+	end interface
+contains
+	pure function constructor(base, height) result(triangle)
+		real, intent(in) :: base
+		real, intent(in) :: height
+		type(triangle_t) :: triangle
+
+		triangle%base = base
+		triangle%height = height
+	end function
+
+	pure function triangle_to_string(self) result(string)
+		class(triangle_t), intent(in) :: self
+		type(varying_string) :: string
+
+		string = hanging_indent( &
+				"triangle_t(" // NEWLINE &
+						// "base = " // to_string(self%base) // "," // NEWLINE &
+						// "height = " // to_string(self%height), &
+				4) // NEWLINE &
+				// ")"
+	end function
+end module

Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/app/main.f90

@@ -0,0 +1,49 @@
+program main
+	use circle_m, only: circle_t
+	use filter_out_area_greater_than_m, only: filter_out_area_greater_than_t
+	use filter_out_curves_m, only: filter_out_curves_t
+	use iso_varying_string, only: put_line
+	use shape_list_m, only: shape_list_t
+	use shape_item_m, only: shape_item_t
+	use square_m, only: square_t
+	use strff, only: to_string
+	use triangle_m, only: triangle_t
+
+	implicit none
+
+	type(shape_list_t) :: list
+	type(shape_list_t) :: duplicated_list
+	type(shape_list_t) :: filtered
+
+	list = shape_list_t( &
+		shapes = [ &
+			shape_item_t( &
+				shape = square_t( &
+					width = 2.0 &
+				) &
+			), &
+			shape_item_t( &
+				shape = circle_t( &
+					radius = 3.0 &
+				) &
+			), &
+			shape_item_t( &
+				shape = triangle_t( &
+					base = 4.0, &
+					height = 5.0 &
+				) &
+			) &
+		] &
+	)
+
+	call put_line(list%to_string())
+	call put_line(to_string(list%total_area()))
+
+	duplicated_list = (list*2.0) // (list*0.3)
+
+	call put_line(duplicated_list%to_string())
+
+	filtered = duplicated_list%filtered_by(filter_out_area_greater_than_t(2.0))
+
+	call put_line(filtered%to_string())
+end program

Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/fpm.toml

@@ -0,0 +1,10 @@
+name = "heterogeneous_list"
+version = "0.1.0"
+license = "MIT"
+author = "Brad Richardson"
+maintainer = "everythingfunctional@protonmail.com"
+copyright = "2020 Brad Richardson"
+
+[dependencies]
+  iso_varying_string = { git = "https://gitlab.com/everythingfunctional/iso_varying_string.git", tag = "v2.0.0" }
+  strff = { git = "https://gitlab.com/everythingfunctional/strff.git", tag = "v2.0.1" }

Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/circle_m.f90

@@ -0,0 +1,64 @@
+module circle_m
+	use iso_varying_string, only: varying_string, operator(//)
+	use shape_m, only: shape_t
+	use strff, only: hanging_indent, to_string, NEWLINE
+
+	implicit none
+	private
+	public :: circle_t
+
+	type, extends(shape_t) :: circle_t
+		private
+		real :: radius
+	contains
+		private
+		procedure, public :: to_string => circle_to_string
+		procedure, public :: scale
+		procedure, public :: area
+		procedure, public :: has_curves
+	end type
+
+	interface circle_t
+		module procedure constructor
+	end interface
+contains
+	pure function constructor(radius) result(circle)
+		real, intent(in) :: radius
+		type(circle_t) :: circle
+
+		circle%radius = radius
+	end function
+
+	pure function circle_to_string(self) result(string)
+		class(circle_t), intent(in) :: self
+		type(varying_string) :: string
+
+		string = hanging_indent( &
+				"circle_t(" // NEWLINE &
+						// "radius = " // to_string(self%radius), &
+				4) // NEWLINE &
+				// ")"
+	end function
+
+	function scale(self, factor) result(scaled)
+		class(circle_t), intent(in) :: self
+		real, intent(in) :: factor
+		class(shape_t), allocatable :: scaled
+
+		allocate(scaled, source = circle_t(radius = self%radius * factor))
+	end function
+
+	pure function area(self)
+		class(circle_t), intent(in) :: self
+		real :: area
+
+		area = 3.1415 * self%radius**2
+	end function
+
+	pure function has_curves(self)
+		class(circle_t), intent(in) :: self
+		logical :: has_curves
+
+		has_curves = .true.
+	end function
+end module

Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/filter_out_area_greater_than_m.f90

@@ -0,0 +1,35 @@
+module filter_out_area_greater_than_m
+	use shape_m, only: shape_t
+	use shape_filterer_m, only: shape_filterer_t
+
+	implicit none
+	private
+	public :: filter_out_area_greater_than_t
+
+	type, extends(shape_filterer_t) :: filter_out_area_greater_than_t
+		private
+		real :: limit
+	contains
+		private
+		procedure, public :: matches
+	end type
+
+	interface filter_out_area_greater_than_t
+		module procedure constructor
+	end interface
+contains
+	pure function constructor(limit) result(filter)
+		real, intent(in) :: limit
+		type(filter_out_area_greater_than_t) :: filter
+
+		filter%limit = limit
+	end function
+
+	pure function matches(self, shape)
+		class(filter_out_area_greater_than_t), intent(in) :: self
+		class(shape_t), intent(in) :: shape
+		logical :: matches
+
+		matches = shape%area() < self%limit
+	end function
+end module

Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/filter_out_curves_m.f90

@@ -0,0 +1,22 @@
+module filter_out_curves_m
+	use shape_m, only: shape_t
+	use shape_filterer_m, only: shape_filterer_t
+
+	implicit none
+	private
+	public :: filter_out_curves_t
+
+	type, extends(shape_filterer_t) :: filter_out_curves_t
+	contains
+		private
+		procedure, public :: matches
+	end type
+contains
+	pure function matches(self, shape)
+		class(filter_out_curves_t), intent(in) :: self
+		class(shape_t), intent(in) :: shape
+		logical :: matches
+
+		matches = .not. shape%has_curves()
+	end function
+end module

Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/shape_filterer_m.f90

@@ -0,0 +1,25 @@
+module shape_filterer_m
+	use shape_m, only: shape_t
+
+	implicit none
+	private
+	public :: shape_filterer_t
+
+	type, abstract :: shape_filterer_t
+	contains
+		private
+		procedure(matches_i), deferred, public :: matches
+	end type
+
+	abstract interface
+		pure function matches_i(self, shape) result(matches)
+			import :: shape_t, shape_filterer_t
+
+			implicit none
+
+			class(shape_filterer_t), intent(in) :: self
+			class(shape_t), intent(in) :: shape
+			logical :: matches
+		end function
+	end interface
+end module

Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/shape_item_m.f90

@@ -0,0 +1,67 @@
+module shape_item_m
+	use iso_varying_string, only: varying_string, operator(//)
+	use shape_m, only: shape_t
+	use shape_filterer_m, only: shape_filterer_t
+	use strff, only: hanging_indent, NEWLINE
+
+	implicit none
+	private
+	public :: shape_item_t
+
+	type :: shape_item_t
+		private
+		class(shape_t), allocatable :: shape
+	contains
+		private
+		procedure, public :: to_string
+		procedure :: scale
+		generic, public :: operator(*) => scale
+		procedure, public :: area
+		procedure, public :: satisfies
+	end type
+
+	interface shape_item_t
+		module procedure constructor
+	end interface
+contains
+	function constructor(shape) result(shape_item)
+		class(shape_t), intent(in) :: shape
+		type(shape_item_t) :: shape_item
+
+		allocate(shape_item%shape, source = shape)
+	end function
+
+	elemental function to_string(self) result(string)
+		class(shape_item_t), intent(in) :: self
+		type(varying_string) :: string
+
+		string = hanging_indent( &
+				"shape_item_t(" // NEWLINE &
+						// "shape = " // self%shape%to_string(), &
+				4) // NEWLINE &
+				// ")"
+	end function
+
+	impure elemental function scale(self, factor) result(scaled)
+		class(shape_item_t), intent(in) :: self
+		real, intent(in) :: factor
+		type(shape_item_t) :: scaled
+
+		allocate(scaled%shape, source = self%shape * factor)
+	end function
+
+	elemental function area(self)
+		class(shape_item_t), intent(in) :: self
+		real :: area
+
+		area = self%shape%area()
+	end function
+
+	elemental function satisfies(self, filterer)
+		class(shape_item_t), intent(in) :: self
+		class(shape_filterer_t), intent(in) :: filterer
+		logical :: satisfies
+
+		satisfies = filterer%matches(self%shape)
+	end function
+end module

Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/shape_list_m.f90

@@ -0,0 +1,79 @@
+module shape_list_m
+	use iso_varying_string, only: varying_string, operator(//)
+	use shape_filterer_m, only: shape_filterer_t
+	use shape_item_m, only: shape_item_t
+	use strff, only: hanging_indent, indent, join, NEWLINE
+
+	implicit none
+	private
+	public :: shape_list_t
+
+	type :: shape_list_t
+		private
+		type(shape_item_t), allocatable :: shapes(:)
+	contains
+		private
+		procedure, public :: to_string
+		procedure :: concat
+		generic, public :: operator(//) => concat
+		procedure :: scale
+		generic, public :: operator(*) => scale
+		procedure, public :: total_area
+		procedure, public :: filtered_by
+	end type
+
+	interface shape_list_t
+		module procedure constructor
+	end interface
+contains
+	function constructor(shapes) result(shape_list)
+		type(shape_item_t), intent(in) :: shapes(:)
+		type(shape_list_t) :: shape_list
+
+		allocate(shape_list%shapes, source = shapes)
+	end function
+
+	pure function to_string(self) result(string)
+		class(shape_list_t), intent(in) :: self
+		type(varying_string) :: string
+
+		string = hanging_indent( &
+				"shape_list_t(" // NEWLINE &
+						// "shapes = [" // NEWLINE &
+						// indent(join(self%shapes%to_string(), "," // NEWLINE), 4) // NEWLINE &
+						// "]", &
+				4) // NEWLINE &
+				// ")"
+	end function
+
+	function concat(lhs, rhs) result(combined)
+		class(shape_list_t), intent(in) :: lhs
+		type(shape_list_t), intent(in) :: rhs
+		type(shape_list_t) :: combined
+
+		allocate(combined%shapes, source = [lhs%shapes, rhs%shapes])
+	end function
+
+	function scale(self, factor) result(scaled)
+		class(shape_list_t), intent(in) :: self
+		real, intent(in) :: factor
+		type(shape_list_t) :: scaled
+
+		allocate(scaled%shapes, source = self%shapes * factor)
+	end function
+
+	pure function total_area(self)
+		class(shape_list_t), intent(in) :: self
+		real :: total_area
+
+		total_area = sum(self%shapes%area())
+	end function
+
+	function filtered_by(self, filterer) result(filtered)
+		class(shape_list_t), intent(in) :: self
+		class(shape_filterer_t), intent(in) :: filterer
+		type(shape_list_t) :: filtered
+
+		allocate(filtered%shapes, source = pack(self%shapes, mask = self%shapes%satisfies(filterer)))
+	end function
+end module

Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/shape_m.f90

@@ -0,0 +1,56 @@
+module shape_m
+	use iso_varying_string, only: varying_string
+
+	implicit none
+	private
+	public :: shape_t
+
+	type, abstract :: shape_t
+	contains
+		private
+		procedure(to_string_i), deferred, public :: to_string
+		procedure(scale_i), deferred, public :: scale
+		generic, public :: operator(*) => scale
+		procedure(area_i), deferred, public :: area
+		procedure(has_curves_i), deferred, public :: has_curves
+	end type
+
+	abstract interface
+		pure function to_string_i(self) result(string)
+			import :: shape_t, varying_string
+
+			implicit none
+
+			class(shape_t), intent(in) :: self
+			type(varying_string) :: string
+		end function
+
+		function scale_i(self, factor) result(scaled)
+			import :: shape_t
+
+			implicit none
+
+			class(shape_t), intent(in) :: self
+			real, intent(in) :: factor
+			class(shape_t), allocatable :: scaled
+		end function
+
+		pure function area_i(self) result(area)
+			import :: shape_t
+
+			implicit none
+
+			class(shape_t), intent(in) :: self
+			real :: area
+		end function
+
+		pure function has_curves_i(self) result(has_curves)
+			import :: shape_t
+
+			implicit none
+
+			class(shape_t), intent(in) :: self
+			logical :: has_curves
+		end function
+	end interface
+end module

Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/square_m.f90

@@ -0,0 +1,64 @@
+module square_m
+	use iso_varying_string, only: varying_string, operator(//)
+	use shape_m, only: shape_t
+	use strff, only: hanging_indent, to_string, NEWLINE
+
+	implicit none
+	private
+	public :: square_t
+
+	type, extends(shape_t) :: square_t
+		private
+		real :: width
+	contains
+		private
+		procedure, public :: to_string => square_to_string
+		procedure, public :: scale
+		procedure, public :: area
+		procedure, public :: has_curves
+	end type
+
+	interface square_t
+		module procedure constructor
+	end interface
+contains
+	pure function constructor(width) result(square)
+		real, intent(in) :: width
+		type(square_t) :: square
+
+		square%width = width
+	end function
+
+	pure function square_to_string(self) result(string)
+		class(square_t), intent(in) :: self
+		type(varying_string) :: string
+
+		string = hanging_indent( &
+				"square_t(" // NEWLINE &
+						// "width = " // to_string(self%width), &
+				4) // NEWLINE &
+				// ")"
+	end function
+
+	function scale(self, factor) result(scaled)
+		class(square_t), intent(in) :: self
+		real, intent(in) :: factor
+		class(shape_t), allocatable :: scaled
+
+		allocate(scaled, source = square_t(width = self%width * factor))
+	end function
+
+	pure function area(self)
+		class(square_t), intent(in) :: self
+		real :: area
+
+		area = self%width**2
+	end function
+
+	pure function has_curves(self)
+		class(square_t), intent(in) :: self
+		logical :: has_curves
+
+		has_curves = .false.
+	end function
+end module

Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/triangle_m.f90

@@ -0,0 +1,68 @@
+module triangle_m
+	use iso_varying_string, only: varying_string, operator(//)
+	use shape_m, only: shape_t
+	use strff, only: hanging_indent, to_string, NEWLINE
+
+	implicit none
+	private
+	public :: triangle_t
+
+	type, extends(shape_t) :: triangle_t
+		private
+		real :: base
+		real :: height
+	contains
+		private
+		procedure, public :: to_string => triangle_to_string
+		procedure, public :: scale
+		procedure, public :: area
+		procedure, public :: has_curves
+	end type
+
+	interface triangle_t
+		module procedure constructor
+	end interface
+contains
+	pure function constructor(base, height) result(triangle)
+		real, intent(in) :: base
+		real, intent(in) :: height
+		type(triangle_t) :: triangle
+
+		triangle%base = base
+		triangle%height = height
+	end function
+
+	pure function triangle_to_string(self) result(string)
+		class(triangle_t), intent(in) :: self
+		type(varying_string) :: string
+
+		string = hanging_indent( &
+				"triangle_t(" // NEWLINE &
+						// "base = " // to_string(self%base) // "," // NEWLINE &
+						// "height = " // to_string(self%height), &
+				4) // NEWLINE &
+				// ")"
+	end function
+
+	function scale(self, factor) result(scaled)
+		class(triangle_t), intent(in) :: self
+		real, intent(in) :: factor
+		class(shape_t), allocatable :: scaled
+
+		allocate(scaled, source = triangle_t(base = self%base * factor, height = self%height * factor))
+	end function
+
+	pure function area(self)
+		class(triangle_t), intent(in) :: self
+		real :: area
+
+		area = (self%base * self%height) / 2.0
+	end function
+
+	pure function has_curves(self)
+		class(triangle_t), intent(in) :: self
+		logical :: has_curves
+
+		has_curves = .false.
+	end function
+end module

Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/app/main.f90

@@ -0,0 +1,48 @@
+program main
+	use circle_m, only: circle_t
+	use filter_out_curves_m, only: filter_out_curves_t
+	use iso_varying_string, only: put_line
+	use shape_list_m, only: shape_list_t
+	use shape_item_m, only: shape_item_t
+	use square_m, only: square_t
+	use strff, only: to_string
+	use triangle_m, only: triangle_t
+
+	implicit none
+
+	type(shape_list_t) :: list
+	type(shape_list_t) :: duplicated_list
+	type(shape_list_t) :: filtered
+
+	list = shape_list_t( &
+		shapes = [ &
+			shape_item_t( &
+				shape = square_t( &
+					width = 2.0 &
+				) &
+			), &
+			shape_item_t( &
+				shape = circle_t( &
+					radius = 3.0 &
+				) &
+			), &
+			shape_item_t( &
+				shape = triangle_t( &
+					base = 4.0, &
+					height = 5.0 &
+				) &
+			) &
+		] &
+	)
+
+	call put_line(list%to_string())
+	call put_line(to_string(list%total_area()))
+
+	duplicated_list = (list*2.0) // (list*0.3)
+
+	call put_line(duplicated_list%to_string())
+
+	filtered = duplicated_list%filtered_by(filter_out_curves_t())
+
+	call put_line(filtered%to_string())
+end program

Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/fpm.toml

@@ -0,0 +1,10 @@
+name = "heterogeneous_list"
+version = "0.1.0"
+license = "MIT"
+author = "Brad Richardson"
+maintainer = "everythingfunctional@protonmail.com"
+copyright = "2020 Brad Richardson"
+
+[dependencies]
+  iso_varying_string = { git = "https://gitlab.com/everythingfunctional/iso_varying_string.git", tag = "v2.0.0" }
+  strff = { git = "https://gitlab.com/everythingfunctional/strff.git", tag = "v2.0.1" }

Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/src/circle_m.f90

@@ -0,0 +1,64 @@
+module circle_m
+	use iso_varying_string, only: varying_string, operator(//)
+	use shape_m, only: shape_t
+	use strff, only: hanging_indent, to_string, NEWLINE
+
+	implicit none
+	private
+	public :: circle_t
+
+	type, extends(shape_t) :: circle_t
+		private
+		real :: radius
+	contains
+		private
+		procedure, public :: to_string => circle_to_string
+		procedure, public :: scale
+		procedure, public :: area
+		procedure, public :: has_curves
+	end type
+
+	interface circle_t
+		module procedure constructor
+	end interface
+contains
+	pure function constructor(radius) result(circle)
+		real, intent(in) :: radius
+		type(circle_t) :: circle
+
+		circle%radius = radius
+	end function
+
+	pure function circle_to_string(self) result(string)
+		class(circle_t), intent(in) :: self
+		type(varying_string) :: string
+
+		string = hanging_indent( &
+				"circle_t(" // NEWLINE &
+						// "radius = " // to_string(self%radius), &
+				4) // NEWLINE &
+				// ")"
+	end function
+
+	function scale(self, factor) result(scaled)
+		class(circle_t), intent(in) :: self
+		real, intent(in) :: factor
+		class(shape_t), allocatable :: scaled
+
+		allocate(scaled, source = circle_t(radius = self%radius * factor))
+	end function
+
+	pure function area(self)
+		class(circle_t), intent(in) :: self
+		real :: area
+
+		area = 3.1415 * self%radius**2
+	end function
+
+	pure function has_curves(self)
+		class(circle_t), intent(in) :: self
+		logical :: has_curves
+
+		has_curves = .true.
+	end function
+end module

Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/src/filter_out_curves_m.f90

@@ -0,0 +1,22 @@
+module filter_out_curves_m
+	use shape_m, only: shape_t
+	use shape_filterer_m, only: shape_filterer_t
+
+	implicit none
+	private
+	public :: filter_out_curves_t
+
+	type, extends(shape_filterer_t) :: filter_out_curves_t
+	contains
+		private
+		procedure, public :: matches
+	end type
+contains
+	pure function matches(self, shape)
+		class(filter_out_curves_t), intent(in) :: self
+		class(shape_t), intent(in) :: shape
+		logical :: matches
+
+		matches = .not. shape%has_curves()
+	end function
+end module

Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/src/shape_filterer_m.f90

@@ -0,0 +1,25 @@
+module shape_filterer_m
+	use shape_m, only: shape_t
+
+	implicit none
+	private
+	public :: shape_filterer_t
+
+	type, abstract :: shape_filterer_t
+	contains
+		private
+		procedure(matches_i), deferred, public :: matches
+	end type
+
+	abstract interface
+		pure function matches_i(self, shape) result(matches)
+			import :: shape_t, shape_filterer_t
+
+			implicit none
+
+			class(shape_filterer_t), intent(in) :: self
+			class(shape_t), intent(in) :: shape
+			logical :: matches
+		end function
+	end interface
+end module

Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/src/shape_item_m.f90

@@ -0,0 +1,67 @@
+module shape_item_m
+	use iso_varying_string, only: varying_string, operator(//)
+	use shape_m, only: shape_t
+	use shape_filterer_m, only: shape_filterer_t
+	use strff, only: hanging_indent, NEWLINE
+
+	implicit none
+	private
+	public :: shape_item_t
+
+	type :: shape_item_t
+		private
+		class(shape_t), allocatable :: shape
+	contains
+		private
+		procedure, public :: to_string
+		procedure :: scale
+		generic, public :: operator(*) => scale
+		procedure, public :: area
+		procedure, public :: satisfies
+	end type
+
+	interface shape_item_t
+		module procedure constructor
+	end interface
+contains
+	function constructor(shape) result(shape_item)
+		class(shape_t), intent(in) :: shape
+		type(shape_item_t) :: shape_item
+
+		allocate(shape_item%shape, source = shape)
+	end function
+
+	elemental function to_string(self) result(string)
+		class(shape_item_t), intent(in) :: self
+		type(varying_string) :: string
+
+		string = hanging_indent( &
+				"shape_item_t(" // NEWLINE &
+						// "shape = " // self%shape%to_string(), &
+				4) // NEWLINE &
+				// ")"
+	end function
+
+	impure elemental function scale(self, factor) result(scaled)
+		class(shape_item_t), intent(in) :: self
+		real, intent(in) :: factor
+		type(shape_item_t) :: scaled
+
+		allocate(scaled%shape, source = self%shape * factor)
+	end function
+
+	elemental function area(self)
+		class(shape_item_t), intent(in) :: self
+		real :: area
+
+		area = self%shape%area()
+	end function
+
+	elemental function satisfies(self, filterer)
+		class(shape_item_t), intent(in) :: self
+		class(shape_filterer_t), intent(in) :: filterer
+		logical :: satisfies
+
+		satisfies = filterer%matches(self%shape)
+	end function
+end module

Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/src/shape_list_m.f90

@@ -0,0 +1,79 @@
+module shape_list_m
+	use iso_varying_string, only: varying_string, operator(//)
+	use shape_filterer_m, only: shape_filterer_t
+	use shape_item_m, only: shape_item_t
+	use strff, only: hanging_indent, indent, join, NEWLINE
+
+	implicit none
+	private
+	public :: shape_list_t
+
+	type :: shape_list_t
+		private
+		type(shape_item_t), allocatable :: shapes(:)
+	contains
+		private
+		procedure, public :: to_string
+		procedure :: concat
+		generic, public :: operator(//) => concat
+		procedure :: scale
+		generic, public :: operator(*) => scale
+		procedure, public :: total_area
+		procedure, public :: filtered_by
+	end type
+
+	interface shape_list_t
+		module procedure constructor
+	end interface
+contains
+	function constructor(shapes) result(shape_list)
+		type(shape_item_t), intent(in) :: shapes(:)
+		type(shape_list_t) :: shape_list
+
+		allocate(shape_list%shapes, source = shapes)
+	end function
+
+	pure function to_string(self) result(string)
+		class(shape_list_t), intent(in) :: self
+		type(varying_string) :: string
+
+		string = hanging_indent( &
+				"shape_list_t(" // NEWLINE &
+						// "shapes = [" // NEWLINE &
+						// indent(join(self%shapes%to_string(), "," // NEWLINE), 4) // NEWLINE &
+						// "]", &
+				4) // NEWLINE &
+				// ")"
+	end function
+
+	function concat(lhs, rhs) result(combined)
+		class(shape_list_t), intent(in) :: lhs
+		type(shape_list_t), intent(in) :: rhs
+		type(shape_list_t) :: combined
+
+		allocate(combined%shapes, source = [lhs%shapes, rhs%shapes])
+	end function
+
+	function scale(self, factor) result(scaled)
+		class(shape_list_t), intent(in) :: self
+		real, intent(in) :: factor
+		type(shape_list_t) :: scaled
+
+		allocate(scaled%shapes, source = self%shapes * factor)
+	end function
+
+	pure function total_area(self)
+		class(shape_list_t), intent(in) :: self
+		real :: total_area
+
+		total_area = sum(self%shapes%area())
+	end function
+
+	function filtered_by(self, filterer) result(filtered)
+		class(shape_list_t), intent(in) :: self
+		class(shape_filterer_t), intent(in) :: filterer
+		type(shape_list_t) :: filtered
+
+		allocate(filtered%shapes, source = pack(self%shapes, mask = self%shapes%satisfies(filterer)))
+	end function
+end module

Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/src/shape_m.f90

@@ -0,0 +1,56 @@
+module shape_m
+	use iso_varying_string, only: varying_string
+
+	implicit none
+	private
+	public :: shape_t
+
+	type, abstract :: shape_t
+	contains
+		private
+		procedure(to_string_i), deferred, public :: to_string
+		procedure(scale_i), deferred, public :: scale
+		generic, public :: operator(*) => scale
+		procedure(area_i), deferred, public :: area
+		procedure(has_curves_i), deferred, public :: has_curves
+	end type
+
+	abstract interface
+		pure function to_string_i(self) result(string)
+			import :: shape_t, varying_string
+
+			implicit none
+
+			class(shape_t), intent(in) :: self
+			type(varying_string) :: string
+		end function
+
+		function scale_i(self, factor) result(scaled)
+			import :: shape_t
+
+			implicit none
+
+			class(shape_t), intent(in) :: self
+			real, intent(in) :: factor
+			class(shape_t), allocatable :: scaled
+		end function
+
+		pure function area_i(self) result(area)
+			import :: shape_t
+
+			implicit none
+
+			class(shape_t), intent(in) :: self
+			real :: area
+		end function
+
+		pure function has_curves_i(self) result(has_curves)
+			import :: shape_t
+
+			implicit none
+
+			class(shape_t), intent(in) :: self
+			logical :: has_curves
+		end function
+	end interface
+end module

Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/src/square_m.f90

@@ -0,0 +1,64 @@
+module square_m
+	use iso_varying_string, only: varying_string, operator(//)
+	use shape_m, only: shape_t
+	use strff, only: hanging_indent, to_string, NEWLINE
+
+	implicit none
+	private
+	public :: square_t
+
+	type, extends(shape_t) :: square_t
+		private
+		real :: width
+	contains
+		private
+		procedure, public :: to_string => square_to_string
+		procedure, public :: scale
+		procedure, public :: area
+		procedure, public :: has_curves
+	end type
+
+	interface square_t
+		module procedure constructor
+	end interface
+contains
+	pure function constructor(width) result(square)
+		real, intent(in) :: width
+		type(square_t) :: square
+
+		square%width = width
+	end function
+
+	pure function square_to_string(self) result(string)
+		class(square_t), intent(in) :: self
+		type(varying_string) :: string
+
+		string = hanging_indent( &
+				"square_t(" // NEWLINE &
+						// "width = " // to_string(self%width), &
+				4) // NEWLINE &
+				// ")"
+	end function
+
+	function scale(self, factor) result(scaled)
+		class(square_t), intent(in) :: self
+		real, intent(in) :: factor
+		class(shape_t), allocatable :: scaled
+
+		allocate(scaled, source = square_t(width = self%width * factor))
+	end function
+
+	pure function area(self)
+		class(square_t), intent(in) :: self
+		real :: area
+
+		area = self%width**2
+	end function
+
+	pure function has_curves(self)
+		class(square_t), intent(in) :: self
+		logical :: has_curves
+
+		has_curves = .false.
+	end function
+end module

Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/src/triangle_m.f90

@@ -0,0 +1,68 @@
+module triangle_m
+	use iso_varying_string, only: varying_string, operator(//)
+	use shape_m, only: shape_t
+	use strff, only: hanging_indent, to_string, NEWLINE
+
+	implicit none
+	private
+	public :: triangle_t
+
+	type, extends(shape_t) :: triangle_t
+		private
+		real :: base
+		real :: height
+	contains
+		private
+		procedure, public :: to_string => triangle_to_string
+		procedure, public :: scale
+		procedure, public :: area
+		procedure, public :: has_curves
+	end type
+
+	interface triangle_t
+		module procedure constructor
+	end interface
+contains
+	pure function constructor(base, height) result(triangle)
+		real, intent(in) :: base
+		real, intent(in) :: height
+		type(triangle_t) :: triangle
+
+		triangle%base = base
+		triangle%height = height
+	end function
+
+	pure function triangle_to_string(self) result(string)
+		class(triangle_t), intent(in) :: self
+		type(varying_string) :: string
+
+		string = hanging_indent( &
+				"triangle_t(" // NEWLINE &
+						// "base = " // to_string(self%base) // "," // NEWLINE &
+						// "height = " // to_string(self%height), &
+				4) // NEWLINE &
+				// ")"
+	end function
+
+	function scale(self, factor) result(scaled)
+		class(triangle_t), intent(in) :: self
+		real, intent(in) :: factor
+		class(shape_t), allocatable :: scaled
+
+		allocate(scaled, source = triangle_t(base = self%base * factor, height = self%height * factor))
+	end function
+
+	pure function area(self)
+		class(triangle_t), intent(in) :: self
+		real :: area
+
+		area = (self%base * self%height) / 2.0
+	end function
+
+	pure function has_curves(self)
+		class(triangle_t), intent(in) :: self
+		logical :: has_curves
+
+		has_curves = .false.
+	end function
+end module

Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-scale_shapes/app/main.f90

@@ -0,0 +1,40 @@
+program main
+	use circle_m, only: circle_t
+	use iso_varying_string, only: put_line
+	use shape_list_m, only: shape_list_t
+	use shape_item_m, only: shape_item_t
+	use square_m, only: square_t
+	use triangle_m, only: triangle_t
+
+	implicit none
+
+	type(shape_list_t) :: list
+	type(shape_list_t) :: duplicated_list
+
+	list = shape_list_t( &
+		shapes = [ &
+			shape_item_t( &
+				shape = square_t( &
+					width = 2.0 &
+				) &
+			), &
+			shape_item_t( &
+				shape = circle_t( &
+					radius = 3.0 &
+				) &
+			), &
+			shape_item_t( &
+				shape = triangle_t( &
+					base = 4.0, &
+					height = 5.0 &
+				) &
+			) &
+		] &
+	)
+
+	call put_line(list%to_string())
+
+	duplicated_list = (list*2.0) // (list*0.3)
+
+	call put_line(duplicated_list%to_string())
+end program

Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-scale_shapes/fpm.toml

@@ -0,0 +1,10 @@
+name = "heterogeneous_list"
+version = "0.1.0"
+license = "MIT"
+author = "Brad Richardson"
+maintainer = "everythingfunctional@protonmail.com"
+copyright = "2020 Brad Richardson"
+
+[dependencies]
+  iso_varying_string = { git = "https://gitlab.com/everythingfunctional/iso_varying_string.git", tag = "v2.0.0" }
+  strff = { git = "https://gitlab.com/everythingfunctional/strff.git", tag = "v2.0.1" }

Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-scale_shapes/src/circle_m.f90

@@ -0,0 +1,48 @@
+module circle_m
+	use iso_varying_string, only: varying_string, operator(//)
+	use shape_m, only: shape_t
+	use strff, only: hanging_indent, to_string, NEWLINE
+
+	implicit none
+	private
+	public :: circle_t
+
+	type, extends(shape_t) :: circle_t
+		private
+		real :: radius
+	contains
+		private
+		procedure, public :: to_string => circle_to_string
+		procedure, public :: scale
+	end type
+
+	interface circle_t
+		module procedure constructor
+	end interface
+contains
+	pure function constructor(radius) result(circle)
+		real, intent(in) :: radius
+		type(circle_t) :: circle
+
+		circle%radius = radius
+	end function
+
+	pure function circle_to_string(self) result(string)
+		class(circle_t), intent(in) :: self
+		type(varying_string) :: string
+
+		string = hanging_indent( &
+				"circle_t(" // NEWLINE &
+						// "radius = " // to_string(self%radius), &
+				4) // NEWLINE &
+				// ")"
+	end function
+
+	function scale(self, factor) result(scaled)
+		class(circle_t), intent(in) :: self
+		real, intent(in) :: factor
+		class(shape_t), allocatable :: scaled
+
+		allocate(scaled, source = circle_t(radius = self%radius * factor))
+	end function
+end module

Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-scale_shapes/src/shape_item_m.f90

@@ -0,0 +1,49 @@
+module shape_item_m
+	use iso_varying_string, only: varying_string, operator(//)
+	use shape_m, only: shape_t
+	use strff, only: hanging_indent, NEWLINE
+
+	implicit none
+	private
+	public :: shape_item_t
+
+	type :: shape_item_t
+		private
+		class(shape_t), allocatable :: shape
+	contains
+		private
+		procedure, public :: to_string
+		procedure :: scale
+		generic, public :: operator(*) => scale
+	end type
+
+	interface shape_item_t
+		module procedure constructor
+	end interface
+contains
+	function constructor(shape) result(shape_item)
+		class(shape_t), intent(in) :: shape
+		type(shape_item_t) :: shape_item
+
+		allocate(shape_item%shape, source = shape)
+	end function
+
+	elemental function to_string(self) result(string)
+		class(shape_item_t), intent(in) :: self
+		type(varying_string) :: string
+
+		string = hanging_indent( &
+				"shape_item_t(" // NEWLINE &
+						// "shape = " // self%shape%to_string(), &
+				4) // NEWLINE &
+				// ")"
+	end function
+
+	impure elemental function scale(self, factor) result(scaled)
+		class(shape_item_t), intent(in) :: self
+		real, intent(in) :: factor
+		type(shape_item_t) :: scaled
+
+		allocate(scaled%shape, source = self%shape * factor)
+	end function
+end module

Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-scale_shapes/src/shape_list_m.f90

@@ -0,0 +1,61 @@
+module shape_list_m
+	use iso_varying_string, only: varying_string, operator(//)
+	use shape_item_m, only: shape_item_t
+	use strff, only: hanging_indent, indent, join, NEWLINE
+
+	implicit none
+	private
+	public :: shape_list_t
+
+	type :: shape_list_t
+		private
+		type(shape_item_t), allocatable :: shapes(:)
+	contains
+		private
+		procedure, public :: to_string
+		procedure :: concat
+		generic, public :: operator(//) => concat
+		procedure :: scale
+		generic, public :: operator(*) => scale
+	end type
+
+	interface shape_list_t
+		module procedure constructor
+	end interface
+contains
+	function constructor(shapes) result(shape_list)
+		type(shape_item_t), intent(in) :: shapes(:)
+		type(shape_list_t) :: shape_list
+
+		allocate(shape_list%shapes, source = shapes)
+	end function
+
+	pure function to_string(self) result(string)
+		class(shape_list_t), intent(in) :: self
+		type(varying_string) :: string
+
+		string = hanging_indent( &
+				"shape_list_t(" // NEWLINE &
+						// "shapes = [" // NEWLINE &
+						// indent(join(self%shapes%to_string(), "," // NEWLINE), 4) // NEWLINE &
+						// "]", &
+				4) // NEWLINE &
+				// ")"
+	end function
+
+	function concat(lhs, rhs) result(combined)
+		class(shape_list_t), intent(in) :: lhs
+		type(shape_list_t), intent(in) :: rhs
+		type(shape_list_t) :: combined
+
+		allocate(combined%shapes, source = [lhs%shapes, rhs%shapes])
+	end function
+
+	function scale(self, factor) result(scaled)
+		class(shape_list_t), intent(in) :: self
+		real, intent(in) :: factor
+		type(shape_list_t) :: scaled
+
+		allocate(scaled%shapes, source = self%shapes * factor)
+	end function
+end module

Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-scale_shapes/src/shape_m.f90

@@ -0,0 +1,36 @@
+module shape_m
+	use iso_varying_string, only: varying_string
+
+	implicit none
+	private
+	public :: shape_t
+
+	type, abstract :: shape_t
+	contains
+		private
+		procedure(to_string_i), deferred, public :: to_string
+		procedure(scale_i), deferred, public :: scale
+		generic, public :: operator(*) => scale
+	end type
+
+	abstract interface
+		pure function to_string_i(self) result(string)
+			import :: shape_t, varying_string
+
+			implicit none
+
+			class(shape_t), intent(in) :: self
+			type(varying_string) :: string
+		end function
+
+		function scale_i(self, factor) result(scaled)
+			import :: shape_t
+
+			implicit none
+
+			class(shape_t), intent(in) :: self
+			real, intent(in) :: factor
+			class(shape_t), allocatable :: scaled
+		end function
+	end interface
+end module

Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-scale_shapes/src/square_m.f90

@@ -0,0 +1,48 @@
+module square_m
+	use iso_varying_string, only: varying_string, operator(//)
+	use shape_m, only: shape_t
+	use strff, only: hanging_indent, to_string, NEWLINE
+
+	implicit none
+	private
+	public :: square_t
+
+	type, extends(shape_t) :: square_t
+		private
+		real :: width
+	contains
+		private
+		procedure, public :: to_string => square_to_string
+		procedure, public :: scale
+	end type
+
+	interface square_t
+		module procedure constructor
+	end interface
+contains
+	pure function constructor(width) result(square)
+		real, intent(in) :: width
+		type(square_t) :: square
+
+		square%width = width
+	end function
+
+	pure function square_to_string(self) result(string)
+		class(square_t), intent(in) :: self
+		type(varying_string) :: string
+
+		string = hanging_indent( &
+				"square_t(" // NEWLINE &
+						// "width = " // to_string(self%width), &
+				4) // NEWLINE &
+				// ")"
+	end function
+
+	function scale(self, factor) result(scaled)
+		class(square_t), intent(in) :: self
+		real, intent(in) :: factor
+		class(shape_t), allocatable :: scaled
+
+		allocate(scaled, source = square_t(width = self%width * factor))
+	end function
+end module

Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-scale_shapes/src/triangle_m.f90

@@ -0,0 +1,52 @@
+module triangle_m
+	use iso_varying_string, only: varying_string, operator(//)
+	use shape_m, only: shape_t
+	use strff, only: hanging_indent, to_string, NEWLINE
+
+	implicit none
+	private
+	public :: triangle_t
+
+	type, extends(shape_t) :: triangle_t
+		private
+		real :: base
+		real :: height
+	contains
+		private
+		procedure, public :: to_string => triangle_to_string
+		procedure, public :: scale
+	end type
+
+	interface triangle_t
+		module procedure constructor
+	end interface
+contains
+	pure function constructor(base, height) result(triangle)
+		real, intent(in) :: base
+		real, intent(in) :: height
+		type(triangle_t) :: triangle
+
+		triangle%base = base
+		triangle%height = height
+	end function
+
+	pure function triangle_to_string(self) result(string)
+		class(triangle_t), intent(in) :: self
+		type(varying_string) :: string
+
+		string = hanging_indent( &
+				"triangle_t(" // NEWLINE &
+						// "base = " // to_string(self%base) // "," // NEWLINE &
+						// "height = " // to_string(self%height), &
+				4) // NEWLINE &
+				// ")"
+	end function
+
+	function scale(self, factor) result(scaled)
+		class(triangle_t), intent(in) :: self
+		real, intent(in) :: factor
+		class(shape_t), allocatable :: scaled
+
+		allocate(scaled, source = triangle_t(base = self%base * factor, height = self%height * factor))
+	end function
+end module

Intermediate Fortran/Section 4 - Patterns and Principles/stack_example-main/fpm.toml

@@ -0,0 +1,11 @@
+name = "stack_example"
+license = "MIT"
+author = "Brad Richardson"
+maintainer = "everythingfunctional@protonmail.com"
+copyright = "2021 Brad Richardson"
+
+[dependencies]
+erloff = { git = "https://gitlab.com/everythingfunctional/erloff.git", tag = "v2.0.0" }
+
+[dev-dependencies]
+vegetables = { git = "https://gitlab.com/everythingfunctional/vegetables", tag = "v7.0.2" }

Intermediate Fortran/Section 4 - Patterns and Principles/stack_example-main/src/fallible_integer_m.f90

@@ -0,0 +1,58 @@
+module fallible_integer_m
+	use erloff, only: error_list_t
+
+	implicit none
+	private
+	public :: fallible_integer_t
+
+	type :: fallible_integer_t
+		private
+		integer :: value__
+		type(error_list_t) :: errors_
+	contains
+		private
+		procedure, public :: failed
+		procedure, public :: value_
+		procedure, public :: errors
+	end type
+
+	interface fallible_integer_t
+		module procedure from_value
+		module procedure from_errors
+	end interface
+contains
+	function from_value(value_) result(fallible_integer)
+		integer, intent(in) :: value_
+		type(fallible_integer_t) :: fallible_integer
+
+		fallible_integer%value__ = value_
+	end function
+
+	function from_errors(errors) result(fallible_integer)
+		type(error_list_t), intent(in) :: errors
+		type(fallible_integer_t) :: fallible_integer
+
+		fallible_integer%errors_ = errors
+	end function
+
+	function failed(self)
+		class(fallible_integer_t), intent(in) :: self
+		logical :: failed
+
+		failed = self%errors_%has_any()
+	end function
+
+	function value_(self)
+		class(fallible_integer_t), intent(in) :: self
+		integer :: value_
+
+		value_ = self%value__
+	end function
+
+	function errors(self)
+		class(fallible_integer_t), intent(in) :: self
+		type(error_list_t) :: errors
+
+		errors = self%errors_
+	end function
+end module

Intermediate Fortran/Section 4 - Patterns and Principles/stack_example-main/src/stack_m.f90

@@ -0,0 +1,151 @@
+module stack_m
+	use erloff, only: error_list_t, fatal_t, module_t, procedure_t, NOT_FOUND
+	use fallible_integer_m, only: fallible_integer_t
+
+	implicit none
+	private
+	public :: fallible_stack_t, stack_t
+
+	type :: stack_t
+		private
+		integer, allocatable :: items(:)
+	contains
+		private
+		procedure, public :: empty
+		procedure, public :: top
+		procedure, public :: pop
+		procedure, public :: push
+		procedure, public :: depth
+	end type
+
+	type :: fallible_stack_t
+		private
+		type(stack_t) :: stack_
+		type(error_list_t) :: errors_
+	contains
+		private
+		procedure, public :: failed
+		procedure, public :: stack
+		procedure, public :: errors
+	end type
+
+	interface stack_t
+		module procedure constructor
+	end interface
+
+	interface fallible_stack_t
+		module procedure from_stack
+		module procedure from_errors
+	end interface
+
+	character(len=*), parameter :: MODULE_NAME = "stack_m"
+contains
+	function constructor() result(empty_stack)
+		type(stack_t) :: empty_stack
+
+		allocate(empty_stack%items, source = [integer::])
+	end function
+
+	function empty(self)
+		class(stack_t), intent(in) :: self
+		logical :: empty
+
+		empty = self%depth() == 0
+	end function
+
+	function top(self)
+		class(stack_t), intent(in) :: self
+		type(fallible_integer_t) :: top
+
+		if (self%empty()) then
+			top = fallible_integer_t(error_list_t(fatal_t( &
+					NOT_FOUND, &
+					module_t(MODULE_NAME), &
+					procedure_t("top"), &
+					"Asked for top of an empty stack.")))
+		else
+			top = fallible_integer_t(self%items(1))
+		end if
+	end function
+
+	function pop(self) result(popped)
+		class(stack_t), intent(in) :: self
+		type(fallible_stack_t) :: popped
+
+		if (self%empty()) then
+			popped = fallible_stack_t(error_list_t(fatal_t( &
+					module_t(MODULE_NAME), &
+					procedure_t("pop"), &
+					"Attempted to pop an empty stack.")))
+		else
+			if (self%depth() > 1) then
+				block
+					type(stack_t) :: new_stack
+
+					new_stack%items = self%items(2:)
+					popped = fallible_stack_t(new_stack)
+				end block
+			else
+				popped = fallible_stack_t(stack_t())
+			end if
+		end if
+	end function
+
+	function push(self, top) result(pushed)
+		class(stack_t), intent(in) :: self
+		integer, intent(in) :: top
+		type(stack_t) :: pushed
+
+		if (self%empty()) then
+			allocate(pushed%items, source = [top])
+		else
+			allocate(pushed%items, source = [top, self%items])
+		end if
+	end function
+
+	function depth(self)
+		class(stack_t), intent(in) :: self
+		integer :: depth
+
+		if (allocated(self%items)) then
+			depth = size(self%items)
+		else
+			depth = 0
+		end if
+	end function
+
+	function from_stack(stack) result(fallible_stack)
+		type(stack_t), intent(in) :: stack
+		type(fallible_stack_t) :: fallible_stack
+
+		fallible_stack%stack_ = stack
+	end function
+
+	function from_errors(errors) result(fallible_stack)
+		type(error_list_t), intent(in) :: errors
+		type(fallible_stack_t) :: fallible_stack
+
+		fallible_stack%errors_ = errors
+	end function
+
+	function failed(self)
+		class(fallible_stack_t), intent(in) :: self
+		logical :: failed
+
+		failed = self%errors_%has_any()
+	end function
+
+	function stack(self)
+		class(fallible_stack_t), intent(in) :: self
+		type(stack_t) :: stack
+
+		stack = self%stack_
+	end function
+
+	function errors(self)
+		class(fallible_stack_t), intent(in) :: self
+		type(error_list_t) :: errors
+
+		errors = self%errors_
+	end function
+end module

Intermediate Fortran/Section 4 - Patterns and Principles/stack_example-main/test/main.f90

@@ -0,0 +1,22 @@
+! Generated by make_vegetable_driver. DO NOT EDIT
+program main
+	implicit none
+
+	call run()
+contains
+	subroutine run()
+		use stack_test, only: &
+				stack_new_stack => test_new_stack, &
+				stack_non_empty_stack => test_non_empty_stack
+		use vegetables, only: test_item_t, test_that, run_tests
+
+		type(test_item_t) :: tests
+		type(test_item_t) :: individual_tests(2)
+
+		individual_tests(1) = stack_new_stack()
+		individual_tests(2) = stack_non_empty_stack()
+		tests = test_that(individual_tests)
+
+		call run_tests(tests)
+	end subroutine
+end program