A simple implementation of permutation groups

I have big problems with groups. If you in GAP write 

gap> s7 := Group ( (1, 2, 3, 4, 5, 6, 7), (1, 2) );

GAP immediately respond 

Group([ (1,2,3,4,5,6,7), (1,2) ])

And if you then write

gap> Elements ( s7 );

GAP prints the list of all 7! elements of Sym(7) in a second or so.

In my simple implementation of permutation groups it takes about two seconds to generate Sym(5), and Sym(6) seems to be out of reach. The big discrepancy comes from that GAP has been developed at the universities for twenty years or so and that I so far has almost no knowledge of computational algebra. 

In GAP a group is determined by its generators while in ZET it's determined by the set of permutations. To me it's interesting to examine subgroups of Sym(5) in this form, but it would also be interesting to try to make a more general and perhaps more efficient implementation later on.

In GAP i.e. (1,2,3,4) denotes a cycle but here the same vector will denote the identity permutation and the cycle in GAP would correspond to (2,3,4,1) here.

\ The number of permutations in a set of permutations
: ord \ -- n | s -- s
  zst> zst> 2dup >zst >zst
  cs 1+ swap cs swap / ;

\ The number of elements to be permuted in v
: numb \ -- n | v --
  zst@ cs zdrop ;

\ j=v(i)
: pmaps \ i -- j | v --
  zdrop cells zst @ + @ ;

\ composition of permutations as functions
: permcomp \ v1 v2 -- v1v2
  ( zst@ cs 1+ 1
  do zover zover i pmaps pmaps
  loop ) znip znip ;

\ generation of cyclic permutation group
: pgen \ v -- s
  zst yst setcopy -1 1
  do zdup yzcopy1 permcomp zdup yzcopy1 vector=
     if numb 1+ i * 2* negate >zst leave then
  loop yst setdrop ;

\ right coset
: prcoset \ s v -- s'
  0 >xst
  zst yst setmove
  foreach
  ?do yzcopy1 permcomp zfence xzmerge
  loop yst setdrop xst zst setmove ;

\ left coset
: plcoset \ v s -- s'
  0 >xst
  zswap zst yst setmove
  foreach
  ?do yzcopy1 zswap permcomp zfence xzmerge
  loop yst setdrop xst zst setmove ;

\ componentwise composition of permutation sets
: permset* \ -- | s1 s2 -- s3
  0 >xst
  zst yst setmove
  foreach
  ?do yzcopy1 plcoset
  xzmergered
  loop yst setdrop
  xst zst setmove ;

: permgroup? \ -- flag | s --
  zdup zdup permset* zet= ;

\ Generation of standard permutations
: pidentity \ n -- | -- v
  >r ( r> 1+ 1 ?do i loop ) ;

: pcirc \ n -- | -- v
  >r ( r> dup 1 ?do i loop )  ;

: proll \ n -- | -- v
  >r ( r@ 1- dup 1 do i loop r> ) ;

\ The number of element to be permuted in permutations in s
: perm# \ -- n | s -- s
  zst> zst> tuck >zst >zst cs ;

\ Calculate the inverse permutation
: pinv \ v -- v'
  zdup adn2 drop adn1 -rot loc{ a2 a1 } cell/ 1
  do i dup 1- cells a2 + @ 1- cells a1 + ! loop znip ;

\ add the inverses to all permutations in s
: adinv \ s -- s'
  0 >xst zdup xzmerge foreach
  do pinv zfence xzmerge
  loop xst zst setmove reduce ;

\ generates the group s' from the generators in s
: generate \ s -- s'
  zst yst setcopy 0 >xst foreach
  ?do pgen xzmerge
  loop xst zst setmove reduce 1
  begin yzcopy1 zswap permset*
     yzcopy1 permset* ord tuck =
  until yst setdrop drop ;

\ generate set of groups s' from set of generators s
: multigen \ s -- s'
  0 >xst foreach
  ?do generate zfence xzmerge
  loop xst zst setmove reduce ;

\ Set of all subgroups to s
: psubgroups \ s -- s'
  perm# pidentity zfence zfence
  zst yst setmove foreach
  do yst zst setmove zdup zrot multincl
     multigen union zst yst setmove
  loop yst zst setmove ;

{ ( 4 1 2 3 ) ( 2 1 3 4 ) } generate  ok

ord . 24  ok

psubgroups  ok

zdup  ok

cardinality . 30  ok

zet. {{(4,3,2,1),(1,2,3,4)},{(1,2,3,4)},{(1,3,4,2),(1,4,2,3),(1,2,3,4)},{(2,1,4,3),(1,2,3,4)},{(4,1,3,2),(2,4,3,1),(1,2,3,4)},{(3,4,1,2),(1,2,3,4)},{(4,3,2,1),(1,2,3,4),(3,4,1,2),(2,1,4,3)},{(3,1,2,4),(2,3,1,4),(1,2,3,4)},{(1,3,2,4),(1,2,3,4)},{(3,2,1,4),(1,2,3,4)},{(1,2,4,3),(1,2,3,4)},{(4,2,3,1),(1,2,3,4)},{(4,3,2,1),(1,2,3,4),(4,2,3,1),(1,3,2,4)},{(3,4,1,2),(1,2,3,4),(1,4,3,2),(3,2,1,4)},{(1,3,4,2),(1,4,2,3),(1,2,3,4),(1,4,3,2),(1,2,4,3),(1,3,2,4)},{(1,4,3,2),(1,2,3,4)},{(4,3,1,2),(2,1,4,3),(3,4,2,1),(1,2,3,4)},{(1,2,4,3),(1,2,3,4),(3,2,1,4),(4,2,1,3),(3,2,4,1),(4,2,3,1)},{(4,3,2,1),(1,3,4,2),(1,2,3,4),(4,2,1,3),(3,1,2,4),(2,3,1,4),(2,4,3,1),(3,2,4,1),(1,4,2,3),(4,1,3,2),(2,1,4,3),(3,4,1,2)},{(3,2,4,1),(4,2,1,3),(1,2,3,4)},{(3,1,4,2),(3,4,1,2),(1,3,2,4),(1,2,3,4),(2,1,4,3),(4,3,2,1),(2,4,1,3),(4,2,3,1)},{(2,4,1,3),(3,1,4,2),(4,3,2,1),(1,2,3,4)},{(3,1,2,4),(2,3,1,4),(1,2,3,4),(2,1,3,4),(1,3,2,4),(3,2,1,4)},{(4,1,3,2),(2,4,3,1),(1,2,3,4),(2,1,3,4),(1,4,3,2),(4,2,3,1)},{(2,1,4,3),(1,2,3,4),(2,1,3,4),(1,2,4,3)},{(2,1,3,4),(1,2,3,4)},{(4,3,2,1),(1,2,3,4),(2,1,3,4),(3,4,2,1),(1,2,4,3),(4,3,1,2),(3,4,1,2),(2,1,4,3)},{(2,1,3,4),(3,4,2,1),(3,1,4,2),(2,3,4,1),(1,4,2,3),(1,3,4,2),(1,2,3,4),(4,2,3,1),(4,1,2,3),(3,2,1,4),(4,1,3,2),(4,2,1,3),(4,3,1,2),(2,1,4,3),(2,3,1,4),(2,4,1,3),(3,1,2,4),(3,4,1,2),(3,2,4,1),(4,3,2,1),(2,4,3,1),(1,2,4,3),(1,3,2,4),(1,4,3,2)},{(4,1,2,3),(3,4,1,2),(2,3,4,1),(1,2,3,4)},{(4,1,2,3),(2,1,4,3),(3,2,1,4),(1,2,3,4),(4,3,2,1),(3,4,1,2),(2,3,4,1),(1,4,3,2)}} ok

My purpose with the nested sets was to investigate the possibility of simple dynamic data structures without the need of garbage collection. The stacks are administrated as usual and rest data on the stacks comes from faulty programming. So in a way the word q, that resets the stacks in case of error (manually now, but should be automatic), and the word drop, replace the garbage collection systems used in traditional programming with dynamic data. Except from with the present primitive implementation of groups it turned out to be surprisingly efficient.