procedure pident(i)
   local p

   p := []

   every put(p, 1 to i)

   return p

end

procedure permute(objects, p)
   local result

   result := []

   every put(result, objects[!p])

   return result

end

procedure pinvert(p)
   local inverse, i

   inverse := list(*p)

   every i := 1 to *p do
      inverse[p[i]] := i

   return inverse

end

procedure cycles(p)
   local indices, cycle, cycles, i

   cycles := []		# list of cycles

   indices := set()

   every insert(indices, 1 to *p)

   repeat {
      i := !indices | break
      delete(indices, i)
      cycle := [i]
      repeat {
         i := integer(p[i])
         delete(indices, i)
         if i = !cycle then break	# done with cycle
         else put(cycle, i)		# new member of cycle
         }
      put(cycles, cycle)
      }

   return cycles

end

procedure permperiod(p)
   local lengths

   lengths := []

   every put(lengths, *!cycles(p))

   return lcml ! lengths

end

procedure lcml(L[])
   local i, j

   i := get(L) | fail

   while j := get(L) do
      i := lcm(i, j)

   return i

end

where lcm() is from the same module:

procedure lcm(i, j)

   if (i =  0) | (j = 0) then return 0

   return abs(i * j) / gcd(i, j)

end


procedure permutations(i)

   suspend permutations_(pident(i))

end

procedure permutations_(p)
   local i

   if *p = 0 then return []

   suspend [p[i := 1 to *p]] |||
      permutataions_(p[1:i] ||| p[i+1:0])

end