#!/usr/bin/clisp

(defun suffix-match (needle nlen offset suffix-len)
  (if (> offset suffix-len)
    (and (char/= (elt needle (- offset suffix-len 1))
	        (elt needle (- nlen suffix-len 1)))
	 (string= needle needle :start1 (- nlen suffix-len) :end1 nlen
		  :start2 (- offset suffix-len) :end2 offset))
    (string= needle needle :start1 (- nlen offset) :end1 nlen
	     :start2 0 :end2 offset)))

(defun bm-search (haystack hlen needle nlen)
  (let ((skip (make-array nlen :element-type 'integer :initial-element nlen))
	(occ (make-array 256 :element-type 'integer :initial-element nlen))
	(l (make-array 256 :element-type 'integer)))
    (if (or (> nlen hlen) (<= nlen 0) (string= haystack nil) (string= needle nil))
      (return-from bm-search nil))
    (loop for i from 0 to (1- nlen) do
	    (setf (elt occ (char-code (elt needle i))) (- nlen i 1)))

    (setf (elt l 0) -1)
    (loop for i from 1 to (1- nlen) do
	  (let ((j 0))
	    (do ()
	      ((or (= j (- nlen i 1)) (char/= (elt needle (- nlen j 1)) (elt needle (- nlen i j 1)))))
	      (incf j))
	    (setf (elt l i) j)))
    (setf (elt skip 0) 1)

    (loop for i from (1- nlen) downto 1 do
	  (setf (elt skip (elt l i)) i))

    (loop for i from 0 to (1- nlen) with ended = 0 do
	  (progn
	    (when (= (elt l i) (- nlen 1 i))
	      (setf ended i))
	    (when (> ended 0)
	      (setf (elt skip i) ended))))
    (do* ((shift nlen))
      ((>= shift hlen))
      (let ((i 0)
	    (bs 0)
	    (consumed 0))
	(do ()
	  ((or (= i nlen) (char/= (elt haystack (- shift i)) (elt needle (- nlen i 1)))))
	  (incf i))
	(when (= i nlen)
	  (return-from bm-search (+ consumed (- shift (- nlen 1)))))

	(setf bs (elt occ (char-code (elt haystack (- shift i)))))
	(setf shift (+ shift (max (- bs i) (elt skip i)))))))
  nil)

(when (= (length *args* ) 2)
  (let* ((haystack (elt *args* 0))
	 (needle (elt *args* 1))
	 (pos (bm-search haystack (length haystack) needle (length needle))))
    (format t "haystack: ~A, needle: ~A, found at: ~A~%" haystack needle pos)))