;;;
;;; 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))))