Super Nand!

super-nand.rkt

#lang eopl

;; Given a quoted logical expression, convert it into nands.
;; Does little to no optimization in terms of output size

(define (super-nand! expr)
  (if (and (list? expr) (not (null? expr)))
      (case (car expr)
        ['not (let [[x (super-nand! (cadr expr))]]
                (list 'nand x x))]
        ['and
         (let [[x (super-nand! (cadr expr))]
               [y (super-nand! (caddr expr))]]
           (list 'nand
                 (list 'nand x y)
                 (list 'nand x y)))]
        ['or
         (let [[x (super-nand! (cadr expr))]
               [y (super-nand! (caddr expr))]]
           (list 'nand (list 'nand x x) (list 'nand y y)))]
        ['nand
         (let [[x (super-nand! (cadr expr))]
               [y (super-nand! (caddr expr))]]
           (list 'nand x y))]
        ['if->then
         (let [[p (cadr expr)]
               [q (caddr expr)]]
           (super-nand! (list 'or (list 'not p) q)))]
        ['xor
         (let [[p (super-nand! (cadr expr))]
               [q (super-nand! (caddr expr))]]
           (let [[-p (super-nand! (list 'not p))]
                 [-q (super-nand! (list 'not q))]]
             (list 'nand
                   (list 'nand p -q)
                   (list 'nand -p q))))]
        ['iff
         (let [[p (super-nand! (cadr expr))]
               [q (super-nand! (caddr expr))]]
           (let [[-p (super-nand! (list 'not p))]
                 [-q (super-nand! (list 'not q))]]
             (list 'nand
                   (list 'nand p q)
                   (list 'nand -p -q))))]
        ['nor
         (let [[-p (super-nand! (list 'not (cadr expr)))]
               [-q (super-nand! (list 'not (caddr expr)))]]
           (super-nand! (list
                         'not
                         (list 'nand -p -q))))])
      expr))