;;; 
;;; c:\program files\acl62\utility.cl 
;;; 
(load "c:\\program files\\acl62\\my-test.cl") 

(defun search-s1-in-s2 (s1 s2) 
　　(let* ((n1 (length s1)) 
 　　　　　(n2 (length s2)) 
 　　　　　(lst (do ((i 0 (1+ i)) 
 　　　　　　　　　　(j n1 (1+ j)) 
 　　　　　　　　　　(w nil)) 
　　　　　　　　　　((= i n2) 
 　　　　　　　　　　(cond ((null w) nil) 
 　　　　　　　　　　　　　(t (push n2 w) 
 　　　　　　　　　　(cond ((not (member 0 w)) 
　　　　　　　　　　　　　　(append w '(0))) 
 　　　　　　　　　　　　　(t w))))) 
　　　　　　　(cond ((and (equal s1 (subseq s2 i j)) 
 　　　　　　　　　　(cond ((null w) t) 
  　　　　　　　　　　　　　(t (>= i (car w))))) 
 　　　　　　　　　　　(push i w) 
 　　　　　　　　　　　(push (+ i n1) w)))))) 
　　;;; 
　　(do ((l lst (cdr l)) 
　　　　　(w)) 
　　　　((null (cdr l)) w) 
　　　(cond ((not (= (car l) (cadr l))) 
 　　　　　　(push (list (cadr l) (car l)) w)))))) 

(defun divide-s1-with-s2 (s1 s2) 
　　(let ((lst (search-s1-in-s2 s2 s1))) 
　　　　(do ((l lst (cdr l)) 
 　　　　　　(w)) 
　　　　　　((null l) (reverse w)) 
　　　　　(push (subseq s1 (caar l) (cadar l)) 
                w)))) 

(defun implode-aux (l) 
　　(cond ((null l) "") 
　　　　　(t (concatenate 'string 
                     (car l) 
                     (implode-aux (cdr l)))))) 

(defun implode (l) (intern (implode-aux l))) 

;;; 
;;; (replace-s1-with-s2-in-s "a" "x" "abcabc") 
;;;       ===> "xbcxbc" 
;;; 
(defun replace-s1-with-s2-in-s (s1 s2 s) 
　　(let ((lst (divide-s1-with-s2 s s1))) 
　　　 (do ((l lst (cdr l)) 
　　　　  　(w)) 
 　　　　　((null l) (implode-aux (reverse w)))
  　　　　　(if (equal (car l) s1) 
　　　　　　　(push s2 w) 
　　  　　　　(push (car l) w))))) 

(defun display-a-list (l) 
　　(do ((lst l (cdr lst)) 
 　　　　(i 1 (1+ i))) 
　　　　((null lst)) 
　　　　(format t "~% ~a. ~a" i (car lst)))) 

(defun read-sentence () 
　　(let ((input 
            (make-string-input-stream 
               (read-line)))) 
　　　(unwind-protect 
　　　　　(progn 
　　　　　　　(do ((word 
                      (read input nil) 
                      (read input nil)) 
 　　　　　　　　　(sentence nil)) 
　　　　　　　　　((not word) 
                   (return (reverse sentence))) 
　　　　　　　　(push word sentence))) 
　　　　(close input)))) 

(defun diskout-a-list (file-name lst) 
　　(let ((stream 
             (open file-name :direction :output)))
　　　(print lst stream) 
　　　(close stream))) 

(defun diskin-a-list (file-name) 
　　(with-open-file 
       (stream file-name :direction :input) 
 　　(do ((data 
          (read stream nil 'eof) 
          (read stream nil 'eof)) 
  　　　　(w nil)) 
　 　　　((eq data 'eof) (reverse w)) 
　　　　　(push data w)))) 

(defun cut-head-of-list (l n) 
　　(cond ((<= (length l) n) l) 
　　　　　((= (length l) (1+ n)) 
 　　　　　(rest l)) 
　　　　　(t 
            (cut-head-of-list (rest l) n))))

(defun generate-a-number-n1-n2 (n1 n2) 
　　(prog (num) 
　　　　loop 
　　　　(setf num (random (* 6 n2))) 
　　　　(if (and (>= num n1) (<= num n2)) 
　　　　　　(return num) 
    　　　　(go loop)))) 

(defun remove-first-list-from-second-list (f s) 
　　(cond ((null f) s) 
　　　　　((member (first f) s :test #'equal) 
 　　　　　(remove (first f) 
 　　　　　(remove-first-list-from-second-list 
                (rest f)
                s) 
　　　　　　　:test #'equal)) 
　　　　　(t 
　　　　　　(remove-first-list-from-second-list 
                 (rest f) s)))) 

(defun same-set-p (a b) 
　　(and (null 
           (remove-first-list-from-second-list a b)) 
 　　　　(null (remove-first-list-from-second-list 
                    b a)))) 

(defun sub-set-p (a b) 
　　(null (remove-first-list-from-second-list b a)))

(defun rotate-list (l &key direction (distance 2)) 
　　(if (eq direction 'left) 
　　　　(rotate-list-left l distance) 
　　　(rotate-list-right l distance))) 

(defun rotate-list-right (l n) 
　　(if (zerop n) 
　　　　l 
　　　(rotate-list-right 
          (append (last l) (butlast l)) (1- n)))) 

(defun rotate-list-left (l n) 
　　(if (zerop n) 
　　　　l 
　　　(rotate-list-left 
          (append (rest l) (list (first l))) (1- n))))

(defun get-position-of-an-element (e l) 
　　(do ((lst l (cdr lst)) 
　　　　　(i 1 (1+ i))) 
　　　　((null lst) nil) 
　　　(cond ((equal e (car lst)) 
 　　　　　　(return i))))) 

(defun my-nth (n l) (nth (1- n) l)) 

(defun cut-list-at-length (n l) 
　　(if (<= (length l) n) 
　　　　l 
　　　  (do ((lst l (cdr lst)) 
 　　　　　　(i 0 (1+ i)) 
 　　　　　　(w)) 
　　　　　　((= i n) (reverse w)) 
 　　　　(push (car lst) w)))) 

(setf *seed* 0) 

;(defun my-rand () 
; 　　(prog () 
; 　　　　(setf *seed* 
                (mod (+ (* 25173 *seed*) 13849) 
                     65536)) 
; 　　　　(return *seed*))) 

(defun my-rand () 
　　　(prog () 
　　　　　(setf *seed* 
                (mod (+ (* 7 *seed*) 4079) 
                     268435456)) 
　　　　　(return *seed*))) 

(defun my-random (n) (mod (my-rand) n)) 

(defun squash (s) 
　　　(cond ((null s) nil) 
　　　　　　((atom s) (list s)) 
　　　　　　(t (append (squash (car s)) 
                       (squash (cdr s)))))) 

(defun get-numbers-from-a-list (l) 
　　　(do ((lst l (cdr lst)) 
　　　　　　(w)) 
　　　　　((null lst) (reserve w)) 
　　　　(if (numberp (car lst)) 
            (push (car lst) w)))) 

(defun remove-duplicate (l) 
　　(cond ((null l) nil) 
　　　　　((member (car l) (cdr l) 
                   :test #'equal) 
 　　　　　(cons (car l) (remove (car l) 
　　　　　　　　　　　　　　(remove-duplicate (cdr l))
                                  :test #'equal))) 
　　　　　(t 
　　　　　　(cons (car l) 
                  (remove-duplicate (cdr l)))))) 

(defun my-load (filename) 
　　　(let ((stream (open filename :direction :input))) 
　　　　　(do ((form nil (read stream nil stream))) 
　　　　　　　((eq form stream) (close stream)) 
　　　　　　(print (eval form))))) 

(defun make-frame-from-list (l) 
   (putprop (car l) l 'frame)) 

(defun display-frame (frame) 
　　(let ((lst (fget-frame frame))) 
　　　(format t "~%On the frame ~a~%" (car lst)) 
　　　(mapcan #'(lambda (e) 
　　　　　　　　　　　(format t "~% ***** ~a *****~% ~a" 
                          (car e) (cdadr e))) 
　　　　　(rest lst))))