Untitled

; The letters of the alphabet
(define alphabet '(a b c d e f g h i j k l m n o p q r s t u v w x y z))

; Get the index of a symbol in a list
(define (index-of s l)
  (define (iter i l)
    (cond
      ((null? l) -1)
      ((eq? (car l) s) i)
      (else (iter (+ i 1) (cdr l)))))
  (iter 0 l))

; Advance a digit in the space of 0 through 25
(define (advance-digit n) (remainder (+ n 1) 26))

; Stateful version of map
(define (map! f l)
  (if (not (null? '()))
    (begin
      (set-car! l (f (car l)))
      (map! f (cdr l)))))

; Assoc using the cdr instead of the car of the pairs
(define (back-assoc x l)
  (cond
    ((null? l) #f)
    ((= (cdar l) x) (car l))
    (else (back-assoc x (cdr l)))))

; Make a rotor from a list of mappings
(define (make-rotor mapping)
   (define pos 0)

   ; Advance the rotor by one; Return wether the next one should advance as
   ; well
   (define advance
     (begin
       (map!
        (lambda (pair)
          (cons
            (advance-digit (car pair))
            (advance-digit (cdr pair))))
        mapping)
       (set! pos (advance-digit pos))
       (= pos 0)))

   ; Map the characters before reflecting
   (define (map-forward n)
     (cdr (assoc n mapping)))

   ; Map the characters after reflecting
   (define (map-backwards n)
     (cdr (back-assoc n mapping)))

   ; Set the rotor position to the supplied number
   (define (set-to n)
     (if (not (= (+ pos 1) n))
       (advance)
       (set-to n)))

   (define funs
     (list
       (cons 'advance advance)
       (cons 'map-forward map-forward)
       (cons 'map-backwards map-backwards)
       (cons 'set-to set-to)))

   ; The dispatch function
   (define (rotor s . args)
     (if (assoc s funs)
       (apply (cdr (assoc s funs)) args)
       (error "Invalid symbol:" s)))

   rotor)

; Both the plugboard and the reflector can be abstracted to a rotor that
; doesn't turn
(define make-plugboard make-rotor)
(define make-reflector make-rotor)

; Make an enigma from a plugboard, some rotors and a reflector
(define (make-enigma plugboard rotors reflector)
  ; Advance all rotors that need to be advanced
  (define (advance l)
    (if (not (null? l))
        (if ((car l) 'advance) (advance (cdr l)))))

  ; Do the digit transformation step before the reflection
  (define (step-move d)
    (define (iter d l)
      (if (null? l)
        d
        (iter ((car l) 'map-forward d) (cdr l))))
    (iter d (cons plugboard rotors)))

  ; Reflect the digit
  (define (reflect d)
    (reflector 'map-forward d))

  ; Do the digit transformation after the reflection
  (define (backwards-step d)
    (define (iter l)
      (if (null? l)
        d
        ((car l) 'map-backwards (iter (cdr l)))))
    (iter (append rotors (list plugboard))))

  ; Encrypt a digit
  (define (encrypt-digit d)
    ((advance rotors)
     (backwards-step
      (reflect
       (forward-step d)))))

  ; Encrypt a message
  (define (encrypt message)
    (map
      (lambda (num) (list-ref alphabet num))
      (map encrypt-digit
           (map (lambda (s) (index-of s alphabet)) message))))

  ; Set the rotors to a certain position
  (define (set-rotors positions)
    (define (iter positions rotors)
      (cond
        ((null? rotors) 'done)
        ((null? positions) 'done)
        (else
          (begin
            ((car rotors) 'set-to (car positions))
            (iter (cdr positions) (cdr rotors))))))
    (iter positions rotors))

  (define funs
    (list
      (cons 'encrypt encrypt)
      ; En- and Decrypting are the same in an engima
      (cons 'decrypt encrypt)
      (cons 'set-rotors set-rotors)))

   ; The dispatch function
   (define (enigma s . args)
     (if (assoc s funs)
       (apply (cdr (assoc s funs)) args)
       (error "Invalid symbol:" s)))

  enigma)