sortされているか確認する/uniq

Tao>(sorted? "in.txt" 'string-lessp)
Tao>(uniqs "in.txt" "out.txt")
Tao>(linecount "out.txt")

; [es24]bs:uniqs.tao.6, 21-Feb-91 23:06:43, Edit by Idaten
;
;  uniq.tao - 同一行の削除
;  IDATEN/K.Takeshita
;
;  91/01/18
;
(de uniqs ( infile outfile &aux in out fp str p-str ct1 ct2)
    (!ct1 0) (!ct2 0)
    (with-open-file (in infile)
      (with-open-file (out outfile :direction :output)
	(with-open-file (fp "uniqs.chk" :direction :output :if-exists :append
			    :if-does-not-exist :create )
	  (progn (write-line "---uniqs report---" fp)
	         (write-line (sconc "infile : " (namestring infile)) fp)
		 (write-line (sconc "outfile: " (namestring outfile)) fp)
		 (loop
		  (if (eq (!str (read-line in)) :eof) (return)
		      (progn (inc ct1)
		      (if (string/= p-str str)
			  (progn (write-line str out) (!p-str str) (inc ct2) )
                          ( write-line str fp ) ) ) )
                 )
		 ( write-line (format nil "infile : ~A ~D" (namestring infile) ct1) fp)
		 ( write-line (format nil "outfile: ~A ~D" (namestring outfile) ct2) fp)
		 ( write-line "---end uniqs---" fp)
	   )
	 )
       )
     )
    'ok
)

;  sorted?  あるファイルがソートされているかどうかを調べる
;  91/02/21
;

(de sorted? ( infile func &aux in )
    ( with-open-file (in infile )
      (loop (&aux n m) (:init (!n (read-line in)))
	    (if (eq (!m (read-line in)) :eof) (return t))
	    (if (null (func n m)) (return nil) )
	    (!n m)
      )
    )
)

(de linecount ( infile &aux in )
    ( with-open-file ( in infile )
      (loop (&aux ct ) (:init (!ct 0))
	    (:while (not (eq (read-line in) :eof)) (return ct))
            (inc ct)
      )
    )
)