Найти абсолютно простые числа в заданном интервале - PascalABC.NET

function isPrime(N : Integer) : Boolean;
var
  D, Q, dD : Integer;
begin
  Result := False;
  if N <= 1 then Exit;
  if (N >= 5) and (((N - 1) mod 6 = 0) or ((N + 1) mod 6 = 0)) then
    begin
      D := 5;
      dD := 2;
      Q := Trunc(Sqrt(N));
      while D < Q do
        if N mod D = 0 then
          Exit
        else
          begin
            D += dD;
            dD := dD xor 6;
          end;
      Result := True;
    end
  else
    Result := (N = 2) or (N = 3);
end;
 
function SuperPrime(n : Integer) : Boolean;
var
  a : array [0..10] of Integer;
begin
  Result := False;
  if Not isPrime(n) then Exit;
 
  a[0] := 0;
  var t := n;
  while t > 0 do
    begin
      a[0] += 1;
      a[a[0]] := t mod 10;
      t := t div 10;
    end;
  
  if a[0] = 1 then
    begin
      Result := True;
      Exit;
    end;
  
  // Отсортируем массив, чтобы генерировать перестановки в лексографическом порядке
  var i, j : Integer;
  for i := 2 to a[0] do
    begin
      var key := a[i];
      j := i - 1;
      while (j >= 1) and (a[j] > Key) do
        begin
          a[j + 1] := a[j];
          Dec(j);
        end;
      a[j + 1] := key;
    end;
    
  // 0. Получим число из начальной перестановки
  t := 0;
  for var p := 1 to a[0] do
    begin
      t := t * 10 + a[p];
      if not odd(a[a[0]]) then Exit; // Если в числе ( > 9) есть чётная цифра...
    end;
  if Not isPrime(t) then Exit;
 
  // 1. Просматриваем а1, ..., аn с конца до тех пор, пока не попадется ai<ai+1.
  //    Если таковых нет, то генерация закончена.
  repeat
    i := a[0] - 1;
    while (i > 0) and (a[i] >= a[i+1]) do
      i -= 1;
      
    if i > 0 then
      // 2. Рассматриваем ai+1, ai+2, ..., an. Найдем первый с конца am
      //    больший ai и поменяем их местами.
      begin
        j := a[0]+1;
        repeat
          j -= 1;
        until a[j] > a[i];
        
        Swap(a[i], a[j]);
        
        // 3. ai+1, ai+2, ..., an переставим в порядке возрастания
        //    (для этого достаточно её переписать с конца).
        j := i + 1;
        while a[0]+1+i-j > j do
          begin
            swap(a[j], a[a[0]+1+i-j]);
            j += 1;
          end;
          
        // 4. Получем число из найденной перестановки
        t := 0; for var p := 1 to a[0] do t := t * 10 + a[p];
        if Not isPrime(t) then Exit;
      end;
      
    // 5. Возвращаемся к пункту 1. 
  until i = 0;
  
  Result := True;
end;
 
begin /// Основную программу изменить под свои нужды
  for var n := 1 to 2147483647 do
    if SuperPrime(n) then
      Print(n);
  WriteLn(NewLine, 'end.');
end.