;;; http://shootout.alioth.debian.org/gp4/benchmark.php?test=revcomp
;;; Michael Weber <michaelw@foldr.org>
;;; 2006-07-18

#||
(defpackage #:revcomp-6
  (:use #:cl))
||#
(in-package #:revcomp-6)

(defconstant +line-length+ 60)

(defconstant +lut+
  (let ((lut (make-string 256 :initial-element #\*)))
    (loop for a across "wsatugcyrkmbdhvnWSATUGCYRKMBDHVN"
          for b across "WSTAACGRYMKVHDBNWSTAACGRYMKVHDBN"
          do (setf (char lut (char-code a)) b))
    lut))

(defun main ()
  (declare (optimize (speed 3)))
  (with-open-file (in "/dev/stdin" :external-format :latin-1)
    (with-open-file (out "/dev/stdout" :external-format :latin-1 :direction :output :if-exists :append)
      (let ((chunks '()))
        (flet ((flush-chunks ()
                 ;; reverse, complement, write lines of width +line-length+.  all in one go :(
                 (loop with o-buf = (make-string +line-length+)
                       with chunk of-type simple-string
                       with idx of-type (unsigned-byte 29) = 0
                       until (and (endp chunks) (zerop idx))
                       do (loop for j from 0 below +line-length+
                                if (zerop idx) do (setf chunk (or (pop chunks) (loop-finish))
                                                        idx (length (the simple-string chunk)))
                                do (setf (char o-buf j) (char +lut+ (char-code (char chunk (decf idx)))))
                                finally (write-line o-buf out :end j))))
               (chunk-headerp (line)
                 (char= (char (the simple-string line) 0) #\>)))
          (declare (inline chunk-headerp flush-chunks))
          (loop for line = (read-line in nil nil) while line
                if (chunk-headerp line)
                do (flush-chunks) and do (write-line line out)
                else do (push line chunks)
                finally (flush-chunks)))))))