; Brian Alliet
; Programming Language Theory
; 4005-710-01
; Copyright 2005 Brian Alliet

; list-perms generates a list of all the permutations of a given list
(define-match list-perms
    ('() '(())) ; there is only one permutation of the empty list
    ; the permutations of a non empty list is every element of the list ;
    ; follow by each permutation of the remaining elements
    (xs (list-comp (cons x ps) (x <- xs) (ps <- (list-perms (delete x xs))))))

; perms finds all the permutations of the list of numbers in the range [1,n]
(define (perms n) (list-perms (from-to 1 n)))

; next-perm finds the next permutation in a sequence of #f if there are none left
(define-match next-perm
    ; the empty list and lists with a single element have no other permutations
    ('() #f)
    ((list _) #f)
    ((cons x xs)
        ; first just try to permute the tail
        (match (next-perm xs)
            ; couldn't permute the tail anymore, reverse it to get it back in ascending order
            ('#f (let ((xs2 (reverse xs)))
                ; find an element bigger than the current head in xs2
                (match (filter (right-section > x) xs2)
                    ; found one, put that back in front and put the current head in its place
                    ((cons x2 _) (cons x2 (replace x2 x xs2)))
                    ; didn't find one, no more permutations are possible
                    ('() #f))))
            ; we could permute the tail, stick the car back on and return
            (xs2 (cons x xs2)))))

; permute finds all the permutations of a given list using next-perm
(define (permute xs)
    (cons xs ; the given list is always a valid permutation, so cons that on to the results
        (match (next-perm xs) ; find the next one
            ('#f '()) ; no next permutation, terminate the list
            (xs2 (permute xs2)))))

(define (main args) (unsafe-perform-io (do io:
    (put-str-ln (show (perms 3)))
    (put-str-ln (show (permute (from-to 1 3))))
    (io:return (if
        (and
            (equal? (permute (from-to 1 6)) (perms 6))
            (= (length (perms 7)) 5040))
        0 1))
    )))