!==========================================================================
! Operazioni primitive sulle liste.
! Per semplicita' si assume una lista di interi.
! Il Modulo contiene la definizione del tipo derivato "cella" e delle
! procedure ad esso applicabili. In questo modo si realizza qualcosa di
! simile ad una Classe.
!==========================================================================
MODULE Primitive_Lista
! Il Modulo e' un'unita' di programma che può contenere solo dichiarazioni
! e procedure; deve essere compilato prima delle unità di programma che lo
! usano o assieme ad esse.
!--------------------------------------------------------------------------
  IMPLICIT NONE
!-- Elemento della lista
  TYPE :: Cella
    INTEGER            :: val
    TYPE(Cella),POINTER:: next ! NOTA: definizione ricorsiva
  END TYPE Cella               ! POINTER e' un attributo del dato
!   NOTA: La variabile associata ad un puntatore si chama "target"

CONTAINS    ! Separa le procedure dal resto delle dichiarazioni
!-----------------------------------------------------------------------
FUNCTION Null(lis)
! Test lista vuota
!-----------------------------------------------------------------------
  LOGICAL            :: Null ! Tipo del risultato
                             ! INTENT proibito, perche' ovvio
  TYPE(cella),POINTER:: lis  ! Puntatore iniziale della lista
                             ! INTENT proibito con argomento POINTER!!
  null = .NOT.ASSOCIATED(lis)
!   ASSOCIATED: funzione intrinseca vera se l'argomento ha un target
  RETURN
END FUNCTION Null

!-----------------------------------------------------------------------
FUNCTION Primo(lis)
! Lettura del primo elemento.
!-----------------------------------------------------------------------
  INTEGER            :: Primo
  TYPE(cella),POINTER:: lis  ! Puntatore iniziale della lista
  IF (null(lis)) THEN
    WRITE(*,*) "Operazione non eseguibile"
  ELSE
    Primo = lis%val
  END IF
  RETURN
END FUNCTION Primo

!--------------------------------------------------------------------------
SUBROUTINE Cons(e,lis)
! Inserimento di un elemento in testa.
! Si sarebbe potuta realizzare con una Funzione a valore puntatore.
!--------------------------------------------------------------------------
  INTEGER,INTENT(IN) :: e    ! Valore da inserire
  TYPE(cella),POINTER:: lis  ! Puntatore iniziale della lista
  TYPE(cella),POINTER:: temp ! Puntatore ausiliario
  ALLOCATE(temp)             ! Alloca il nuovo elemento
  temp%val = e               ! Assegnagli il valore
!   Assegnazione "normale"
  temp%next => lis           ! Fallo puntare alla lista
  lis => temp                ! Aggiorna il puntatore iniziale
!   Assegnazioni di puntatore: temp%next punta al target di lis
!                              lis al target di temp
  RETURN
END SUBROUTINE Cons

!-----------------------------------------------------------------------
SUBROUTINE Canc(lis)
! Cancellazione del primo elemento.
!-----------------------------------------------------------------------
  TYPE(cella),POINTER:: lis  ! Puntatore iniziale della lista
  TYPE(cella),POINTER:: temp ! Puntatore ausiliario
  IF (null(lis)) THEN
    WRITE(*,*) "Operazione non eseguibile"
  ELSE
    temp => lis              ! Non perdere traccia del primo elem.!!
    lis => lis%next          ! Il secondo elemento diventa il primo
    DEALLOCATE(temp)         ! Disalloca il primo elemento
  END IF
  RETURN
END SUBROUTINE Canc

!-----------------------------------------------------------------------
SUBROUTINE Stampa(lis)
! Stampa della lista.
!-----------------------------------------------------------------------
  TYPE(cella),POINTER:: lis  ! Puntatore iniziale della lista
  TYPE(cella),POINTER:: p    ! Puntatore ausiliario
  p => lis                   ! necessario per non alterare "lis"
  DO
    IF (null(p))  EXIT
    WRITE(*,*) p%val         ! Scrivi un elemento
    p => p%next              ! Passa al prossimo
  END DO
  RETURN
END SUBROUTINE Stampa
END MODULE Primitive_Lista
