----------------------------------------------------------------
-- Criba de Eratostenes
--
-- Creación de una lista que contenga todos los primos menores
-- que el numero que el usuario introduce
----------------------------------------------------------------
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
with Ada.Numerics.Elementary_Functions; use Ada.Numerics.Elementary_Functions;
with Lista;
procedure criba is
----------------------------------------------------------------
-- Declaración de tipos y paquetes
----------------------------------------------------------------
package ListaCriba is new Lista(Natural); use ListaCriba;
subtype LCriba is ListaCriba.Tipo;
----------------------------------------------------------------
-- Declaración de funciones y procedimientos
----------------------------------------------------------------
function Primo(N,Div:positive) return boolean is
-- POST: Res = True si not Div(X,N) para todo valor de X|2 <= X < sqrt(N)
begin
if Div > integer(sqrt(float(N))) then
return True;
else
return (N mod Div/=0) and then Primo(N,Div+1);
end if;
end Primo;
function Criba_Aux(N,Cand,Inc:positive) return LCriba is
begin
if Cand > N then
return Vacia;
elsif Primo(Cand,2) then
return Cons(Cand, Criba_Aux(N, Cand+Inc, 6-Inc));
else
return Criba_Aux(N, Cand+Inc, 6-Inc);
end if;
end Criba_Aux;
function Criba(N:positive) return LCriba is
-- Incluimos 2 y 3 en la criba y empezamos desde el 5
-- POST: Devuelve todos los primos anteriores al numero especificado
begin
if Es_Vacia(N) then
return vacia;
else
return Cons(2,Cons(3,Criba_Aux(N,5,2)));
end if;
end Criba;
procedure ImprPrimo(N:positive) is
begin
Put(N,0);
end ImprPrimo;
procedure ImprCriba is new Escribir(ImprPrimo);
----------------------------------------------------------------
-- Delcaración de variables y/o constantes
----------------------------------------------------------------
N: natural;
----------------------------------------------------------------
-- Parte ejecutiva
----------------------------------------------------------------
begin
Put("Introduce un numero: "); Get(N); New_Line;
Put("Primos anteriores a ese numero:"); New_Line;
ImprCriba(Criba(N));
end criba;