Note that from Maple's perspective, it makes little sense to ask for permutations of a set.  All permutations of an unordered set are equal.  With that in mind, the following should do what you want.  It accepts either a set, a list, a posint, or a range of integers as input, but always returns lists.  Being somewhat lazy this morning, I originally wrote it to handle only integers, then to generalize it used the hackware procedures addressof and pointto.  It returns a module with two exports.  In that regard it is slightly different from combinat[cartprod], that is, the export finished is a procedure not a boolean value:

GeneratePermutations := proc(L :: Or(sequential,posint,range(integer)))

    if L :: 'posint' then
        return procname([seq(1..L)]);
    elif L :: 'range(integer)' then
        return procname([seq(L)]);
    end if;

    module()
    export nextvalue, finished;
    local complete,n,A;

        n := nops(L);
        A := rtable(1..n,sort(map(addressof,convert(L,'list'))));

        complete := `if`(L=[], true, false);
        finished := () -> complete;

        # This uses Algorithm L, pp 39-40, from
        # "The Art of Computer Programming," vol 4, fasicle 2,
        # "Generating all Tuples and Permutations", Donald Knuth

        nextvalue := proc()
        local a,j,k,l;

            if complete then
                error "attempt to call nextvalue on finished iterator";
            end if;

            a := map(pointto,convert(A,'list'));

            # update A

            for j from n-1 to 1 by -1 while A[j+1] <= A[j] do end do;
            if j=0 then
                complete := true;
                return a;
            end if;

            for l from n by -1 while A[l] <= A[j] do end do;
            (A[j],A[l]) := (A[l],A[j]);

            # reverse A[j=1]..A[n]
            l := n;
            for k from j+1 while k < l do
                (A[k],A[l]) := (A[l],A[k]);
                l := l-1;
            end do;

            return a;
        end proc;
    end module;
end proc:

Here is an example

P := GeneratePermutations([a,[1,2],[1,2]]):
while not P:-finished() do P:-nextvalue(); end do;
                              [a, [1, 2], [1, 2]]
                              [[1, 2], a, [1, 2]]
                              [[1, 2], [1, 2], a]

P := GeneratePermutations(2..4):
while not P:-finished() do P:-nextvalue(); end do;
                                   [2, 3, 4]
                                   [2, 4, 3]
                                   [3, 2, 4]
                                   [3, 4, 2]
                                   [4, 2, 3]
                                   [4, 3, 2]

I'm curious, does it work on Maple 9 with a range or integer input?  I suspect it may not, I think that seq(1..3) wasn't added until Maple10, but am not sure and don't have Maple 9 quickly accessible. It would be easy enough for you to fix that, just modify the start, where ranges are converted to lists of integers (if you care).

Literally taken for me the question also makes no sense and as an
ordered finite set is nothing but the according interval of the
Naturals for me that would sufficient (and use substitutions only).

A different source (as I do not have Knuth) and as C program is in
the beautiful online book Jörg Arndt, "Algorithms for programmers",
Chapter 10 at www.jjj.de/fxt/

Have not checked, whether it is Algorithm L.

N.B. This has been completely rewritten.

On rethinking this, I realized that this can be improved by returning a Vector rather than a list.  That has two advantages: it saves memory (each new output is not inserted into Maple's Simplification table) and it is faster because we don't have to process every element (with a call to pointto).  It also permits using the Maple compiler to handle the core of algL.  Here is the rewrite. 

Note that I used a preprocessor directive, BytesPerWord, so that the source code could conceivably be used with 64 bit Maple; however, the use of a preprocessor directive means it will only work if run through command-line maple (my usual mode of working).  You can always manually replace the few occurrences of BytesPerWord with 4 for 32 bit Maple or 8 for 64 bit Maple.  I couldn't think of a nice way to declare the Arrays in ComputePerm so that using the preprocessor directive was not required.

$define BytesPerWord 4

Permute := module()
export ModuleApply, Permute;
local ComputePerm;

    ModuleApply := Permute;
    
    Permute := proc(L :: Or(set,list,posint,range(integer)))
    local u,n,A,V;
        
        if L :: 'posint' then return procname([seq(u, u = 1..L)]);
        elif L :: 'range' then return procname([seq(u, u = L)]);
        end if;
        
        n := nops(L);
        A := rtable(1..n, sort(map(addressof,convert(L,'list'))), 'datatype=integer[BytesPerWord]');
        V := rtable(1..n, i -> pointto(A[i]));
        
        module()
        export nextvalue, finished;
        local complete,cnt,P;
            
            cnt := 0;
            P := rtable(1..n,1..2, 'datatype=integer[BytesPerWord]');
            
            complete := evalb(n=0);
            finished := () -> complete;
            
            nextvalue := proc()
            local i,j,k;
                if complete then
                    error "attempt to call nextvalue on finished iterator";
                end if;
                
                # permute V per previous computation
       
                for i to cnt do
                    (j,k) := (P[i,1],P[i,2]);
                    (V[j], V[k]) := (V[k],V[j]);
                end do;
                cnt := ComputePerm(A,P,n);
                if cnt = 0 then complete := true end if;
                return V;
            end proc;
        end module;
    end proc:
    
    # This uses Algorithm L, pp 39-40, from
    # "The Art of Computer Programming," vol 4, fasicle 2,
    # "Generating all Tuples and Permutations", Donald Knuth
                
    ComputePerm := proc(A :: Array(datatype=integer[BytesPerWord])
                        , P :: Array(datatype = integer[BytesPerWord])
                        , n :: posint
                       )
        
    local j,k,l,cnt;
        
        for j from n-1 to 1 by -1 do
            if A[j+1] > A[j] then break; end if;
        end do;
        
        if j=0 then
            return 0;
        end if;
        
        for l from n by -1 do
            if A[l] > A[j] then break; end if;
        end do;
        
        (A[j],A[l]) := (A[l],A[j]);
        cnt := 1;
        P[1,1] := j;
        P[1,2] := l;
        
        l := n;
        for k from j+1 do
            if k >=l then break; end if;
            (A[k],A[l]) := (A[l],A[k]);
            cnt := cnt+1;
            P[cnt,1] := k;
            P[cnt,2] := l;
            l := l-1;
        end do;
        return cnt;
    end proc;
    
    ComputePerm := Compiler:-Compile(ComputePerm);
    
end module:

P := Permute([1,2,3]):
while not P:-finished() do printf("%d\n",P:-nextvalue()); end do;
1 2 3
1 3 2
2 1 3
2 3 1
3 1 2
3 2 1


N := 10:
P := Permute([seq(1..N)]):
time(proc() while not P:-finished() do P:-nextvalue() end do end proc());

                                                     135.0

<p>&nbsp;</p>
<p>I'm afraid my command of Maple does not stretch to anything not easily portable to other languages; in addition, it relies on ancient features which I understand are nowadays deprecated. [A recent attempt at improving this situation --- by providing type declarations for variables and parameters --- proved so mind-bogglingly counter-productive that I was obliged immediately to reverse it.]</p>
<p>As has already been observed above, there are a great many permutation generators around; though somehow or other, they never seem to do quite what one requires.</p>
<p>My own attempt appears below: it requires a sorted bag / multiset of integers. My excuse for posting it here is that a simple generator which employs adjacent transpositions where possible, in constant amortised time, does not appear to be readily available elsewhere. I have attempted to provide a (sparse) summary of the algorithm.&nbsp;&nbsp;</p>
<p>Any suggestions for updating the style would be welcome: in particular, a more&nbsp;object-oriented recasting might avoid having to cart around the auxiliary arrays as parameters (shades of FORTRAN!).</p>
<p>[Incidentally, the previewer is displaying this message as source plaintext, rendering much of it barely readable --- if anybody requires a clean copy, please let me know.]</p>
<p>WFL</p>
<p>################################################################################</p>
<p># Generate bag-permutations of m elements, ordered by nearly adjacent<br />
# transposition; generator value = m+1 on termination;<br />
# assumes 0 &lt;= n &lt;= m, m &gt; 0; 4 sentinels; no pre-initialisation.<br />
# Maple program, Fred Lunnon, Maynooth 01/07/08<br />
# Version with type-checking time 7x slower than without under Maple 9<br />
# --- commented out again!</p>
<p># A &quot;run&quot; is defined to be a sequence of equally ranked elements in<br />
# consecutive locations (and with consecutive identifiers), such that all<br />
# but the righthand end (highest location) are drifting right (d = +1).<br />
# The drift of the righthand element at j determines that of the entire run.<br />
# A run is &quot;blocked&quot; when the element adjacent in its direction of drift at i<br />
# has equal or lower rank. The element adjacent to a run at its lefthand end<br />
# is of different rank; at its righthand end may be another of equal rank.<br />
# Generator employs Steinhaus-Johnson-Trotter adjacent transposition strategy<br />
# to exchange the earliest (by identifier) unblocked run at j with the single<br />
# element at i. Individual elements within a run behave as though under the<br />
# action of a combination generator by nearly-adjacent transpositions;<br />
# all permutations of the user bag of ranks are transpositions, most of<br />
# which are actually adjacent.<br />
# Once an unblocked element is found, the attached run is shifted one place<br />
# along direction d, the end elements transposed, and all but the rightmost<br />
# drift set leftwards; the drift of all earlier elements is reversed.<br />
# In order to avoid unnecesary and nested loops, reversal takes place during<br />
# search, and the left end of a run is retained in l for future reference.<br />
# Spatial blocking sentinels ranked lowest are installed at either end, and<br />
# temporal termination sentinels ranked highest placed off the righthand end.</p>
<p># Case m = 0 is excluded, since iterator signals immediate termination;<br />
# could be fixed, at the cost of extra testing at its start.<br />
# The generator is stable, in the sense that elements of the same rank remain<br />
# always in the same order. For this reason it might be regarded as a<br />
# permutation generator with restrictions on the ordering of specified subsets.<br />
# Next move takes place in constant amortised time; always by transposition,<br />
# which will be adjacent when possible (for large m, at least 82.7% of moves).</p>
<p># Each element has unique identifier p, lower p drifting more frequently;<br />
# R_[k] = rank (positive integer user symbol) of element at k;<br />
# P_[k] = identifier p of element at k, 0 &lt;= p &lt; m+3;<br />
# Q_[p] = location k of element p, 0 &lt;= k &lt; m+3;<br />
# D_[k] = current drift direction d of element at k, -1 &lt;= d &lt;= +1.<br />
# i,j,k,l locate elements in current permutation;<br />
# d,e = direction of element at j,i; l holds left end of current run.<br />
# Arrays are extended by sentinels indexed 0 at left, m+1,m+2,m+3 at right;<br />
# list [...] subscripts run from 1 to op(list).</p>
<p># Initialiser: Input list of m &gt; 0 rank values (non-decreasing order);<br />
# adjacency improves for increasing partition;<br />
# output R_, P_, Q_, D_ 1-dim arrays of integer.<br />
#initbagperm := proc (rank :: list(integer), R_, P_, Q_, D_) :: NULL;<br />
# local m :: integer, j :: integer, r :: array(integer),<br />
# r_1 :: integer, r_m :: integer;<br />
initbagperm := proc (rank, R_, P_, Q_, D_)<br />
local m, j, r, r_1, r_m;<br />
m := nops(rank); r := sort(rank);<br />
if m &lt;= 0 then print(`bagperm: length &lt;= 0`)<br />
else r_1, r_m := r[1], r[m];<br />
R_ := array(0..m+3, [r_1-1, seq(r[j], j = 1..m), r_1-1, r_m+1, r_m+2]);<br />
P_ := array(0..m+3, [0, seq(j, j = 1..m), 0, m+1, m+2]); # permed identities<br />
Q_ := array(0..m+3, [0, seq(j, j = 1..m), m+2, m+3, 0]); # inverse locations<br />
D_ := array(0..m+3, [0, seq(+1, j = 1..m), 0, +1, +1]); # permed drifts<br />
fi; NULL end;</p>
<p># Iterator: Output permuted ranks in R_[1..m];<br />
# result = location j of run drifted; on termination j = m+1.<br />
#nextbagperm := proc (R_ :: array(integer), P_ :: array(integer),<br />
# Q_ :: array(integer), D_ :: array(integer)) :: integer;<br />
# local i :: integer, j :: integer, k :: integer, l :: integer,<br />
# d :: integer, e :: integer, p :: integer;<br />
nextbagperm := proc (R_, P_, Q_, D_)<br />
local i, j, k, l, d, e, p;<br />
# locate earliest unblocked element at j, starting at blocked element 0<br />
j, i, d := 0, 0, 0;<br />
while R_[j] &gt;= R_[i] do<br />
D_[j] := -d; # blocked at j; reverse drift d pre-emptively<br />
j := Q_[P_[j]+1]; d := D_[j]; i := j+d; # next element at j, neighbour at i<br />
if R_[j-1] &lt;&gt; R_[j] then l := j # save left end of run in l<br />
elif d &lt; 0 then i := l-1 fi od; # restore left end at head of run<br />
# shift run of equal rank from i-d,i-2d,...,l to i,i-d,...,l+d<br />
k := i; if d &lt; 0 then l := j fi;<br />
e := D_[i]; p := P_[i]; # save neighbour drift e and identifier p<br />
while k &lt;&gt; l do<br />
P_[k] := P_[k-d]; Q_[P_[k]] := k;<br />
D_[k] := -1; k := k-d od; # reset drifts of run tail elements<br />
R_[l], R_[i] := R_[i], R_[l]; # transpose user ranks<br />
D_[l], D_[i] := e, d; # restore drifts of head and neighbour<br />
P_[l], Q_[p] := p, l; # wrap neighbour around to other end<br />
j end;</p>
<p># Test bag-perms --- listing<br />
parts := [2, 2, 2]; # chosen partition of set<br />
l := nops(parts): m := add(parts[i], i = 1..l): # length and weight<br />
symb := [seq(seq(i, j = 1..parts[i]), i = 1..l)]:<br />
cardi := combinat[multinomial](m, op(parts)): # number of bag-perms<br />
initbagperm(symb, R_,P_,Q_,D_):<br />
l := 1: print(l, [seq(R_[i], i = 1..n)]);<br />
while nextbagperm(R_,P_,Q_,D_) &lt;= n and l &lt; cardi + 2 do<br />
l := l+1; print(l, [seq(R_[i], i = 1..n)]) od:<br />
print(l, cardi); # equal</p>
<p>################################################################################<br />
<br />
&nbsp;</p>