Permutations with(out) repetition

{$mode objfpc}
program permutations;
const
   NEWLINE =
      {$ifdef windows}
         #13+
      {$endif}
         #10;

type
   TStrArray = array of string;


function Fact(n : byte) : Int64;
(* Factorial of n: n! = n * (n-1)! *)
begin
   if n in [0, 1] then
      Fact := 1
   else
      Fact := n * Fact(Pred(n));
end;


function Rm(x : char; xs : string) : string;
(* Remove the first occurrence of x in xs. *)
begin
   Rm := xs;
   Delete(Rm, Pos(x, xs), 1);
end;


procedure Clean(var l : TStrArray);
(* Clears any garbage present in list l. *)
var i : LongInt;
begin
   for i := Low(l) to High(l) do
      l[i] := '';
end;


operator in (x : string; ys : TStrArray) res : boolean;
(* Overloads the operator in: is there any x in list ys? *)
var y : string;
begin
   res := false;
   for y in ys do
      if x = y then begin
         res := true;
         break;
      end;
end;


procedure WriteArray(arr : TStrArray; sep : string = NEWLINE);
(* Writes contents of list arr separated by sep. *)
var s : string;
begin
   for s in arr do
      writeln(s);
end;


function Permute(const xs : string) : TStrArray;
(* Returns permutations without repetition. *)

   function Perm(const xs : string) : TStrArray;
   (* Returns total permutations. *)
   var
      i  : LongInt;
      x  : char;
      y  : string;
      ys : TStrArray;
   begin
      if Length(xs) = 0 then begin
         Perm := nil
      end else begin
         SetLength(Perm, Fact(Length(xs)));

         if Length(xs) = 1 then
            Perm[0] := xs
         else begin
            i := 0;
            for x in xs do begin
               ys := Perm(Rm(x, xs));
               for y in ys do begin
                  Perm[i] := Concat(String(x), y);
                  Inc(i);
               end;
            end;
         end;
      end;
   end;

   function Nub(zs : TStrArray) : TStrArray;
   (* Eliminates duplicated elements from zs. *)
   var
      z     : string;
      i     : LongInt;
      count : LongInt = 0;
   begin
      SetLength(Nub, Length(zs));
      Clean(Nub);
      for z in zs do begin
         if not (z in Nub) then begin
            Nub[count] := z;
            Inc(count);
         end;
      end;
      SetLength(Nub, count);
   end;

begin  (* Permute *)
   Permute := Nub(Perm(xs));
end;


begin  (* MAIN BLOCK *)
   WriteArray(Permute('CAII'));
   readln;
end.