@@ -39,7 +39,10 @@

   :license "MIT"

   :depends-on (#:should-test)

   :components ((:file "string-utils/package")

-               (:file "string-utils/string-utils" :depends-on ("string-utils/package"))

+               (:file "string-utils/split"

+                :depends-on ("string-utils/package"))

+               (:file "string-utils/string-utils"

+                :depends-on ("string-utils/package"))

                #-lispworks

                (:file "string-utils/test" :depends-on ("string-utils/string-utils"))))

@@ -2,5 +2,8 @@

 (defpackage :fwoar.string-utils

   (:use :cl)

-  (:export #:get-part-modifier #:split))

+  (:export #:get-part-modifier

+           #:split

+           #:insert-at

+           #:insert-where))

new file mode 100644

@@ -0,0 +1,177 @@

+(in-package :fwoar.string-utils)

+

+(deftype array-length ()

+  `(integer 0 ,array-dimension-limit))

+(deftype array-index ()

+  `(integer 0 ,(1- array-dimension-limit)))

+

+(defun get-part-modifier (char string &optional count)

+  (declare (optimize #+dev (debug 3) #-dev (speed 3))

+           (type character char)

+           (type string string))

+

+  (flet ((count-splits (string)

+           (declare (optimize (speed 3))

+                    (type simple-string string))

+           (do* ((x (the array-length 0) (1+ x))

+                 (cur-char #1=(aref string x) #1#)

+                 (result (the array-length 0) (if (char= cur-char char)

+                                                  (1+ result)

+                                                  result)))

+                ((= x (1- (length string))) (1+ result))

+             (declare (type array-length result)))))

+    (typecase string

+      ((and string (not simple-string))

+       (setf string (copy-seq string))))

+    (unless count

+      (setf count (count-splits string))))

+

+  (let ((parts (make-array count :initial-element nil :element-type '(or string null)))

+        (start-idx 0)

+        (target-spot 0))

+    (prog1 parts

+      (dotimes (end-idx (length string))

+        (when (typecase string

+                (simple-string (char= (aref string end-idx) char))

+                (string (char= (aref string end-idx) char)))

+          (setf (aref parts target-spot)

+                (make-array (- end-idx start-idx) :displaced-to string :displaced-index-offset start-idx

+                            :element-type 'character))

+          (incf target-spot)

+          (setf start-idx (1+ end-idx))

+          (when (= target-spot (1- count))

+            (return))))

+      (when (<= start-idx (length string))

+        (setf (aref parts target-spot)

+              (make-array (- (length string) start-idx)

+                          :displaced-to string :displaced-index-offset start-idx

+                          :element-type 'character))))))

+

+;; TODO: implement test

+(defun %split-on-char (divider string &key count (test nil))

+  (declare (optimize #+dev (debug 3) #+dev (speed 0) #+dev (space 0)

+                     #-dev (speed 3) #-dev(space 2))

+           (type (or null array-length) count)

+           (type (or null function symbol) test)

+           (type character divider)

+           (type string string))

+  (typecase string

+    ((and string (not simple-string))

+     (setf string (copy-seq string))))

+  (check-type string simple-string)

+

+  (flet ((count-splits (string)

+           (declare (optimize #+dev (debug 3) #+dev (speed 0) #+dev (space 0)

+                              #-dev (speed 3) #-dev(space 2))

+                    (type simple-string string))

+           (if (/= 0 (length string))

+               (do* ((x (the array-length 0) (1+ x))

+                     (cur-char #1=(aref string x) #1#)

+                     (result (the array-length

+                                  (if (char= cur-char divider)

+                                      1

+                                      0))

+                             (if (char= cur-char divider)

+                                 (1+ result)

+                                 result)))

+                    ((= x (1- (length string))) (1+ result))

+                 (declare (type array-length result)))

+               0))

+         (find-pos (start-pos)

+           (declare (optimize #+dev (debug 3) #+dev (speed 0) #+dev (space 0)

+                     #-dev (speed 3) #-dev(space 2))

+                    (type array-index start-pos))

+           (etypecase test

+             (function (position divider string :start start-pos :test test))

+             (null (position divider string :start start-pos))

+             (symbol (position divider string :start start-pos :test (symbol-function test))))))

+

+    (unless count

+      (setf count (count-splits string)))

+

+    (check-type count array-length)

+    (let ((parts (make-array (max count 1) :fill-pointer 0))

+          (start-pos (the fixnum 0)))

+      (declare (dynamic-extent start-pos))

+      (prog1 parts

+        (loop 

+           for end-pos = (find-pos start-pos)

+           while end-pos 

+           do

+             (vector-push (subseq string start-pos end-pos) parts)

+             (setf start-pos (1+ end-pos))

+           while (< (length parts) (1- count))

+           finally

+             (cond ((or (and end-pos count)

+                        (< start-pos (length string)))

+                    (vector-push (subseq string start-pos)

+                                 parts))

+                   ((not end-pos)

+                    (vector-push "" parts))))))))

+

+(defun %split-on-string (divider string &key count (test nil))

+  (declare (optimize #+dev (debug 3) (speed 3))

+           (type string divider string)

+           (type (or null function symbol) test)

+           (type (or null array-index) count))

+  (flet ((%search (start-pos)

+           (declare (optimize (speed 3))

+                    (type array-index start-pos)

+                    (inline))

+           (typecase divider

+             (simple-string (typecase string

+                              (simple-string (search divider string :start2 start-pos))

+                              (string (search divider string :start2 start-pos))))

+             (string (search divider string :start2 start-pos))))

+         (%search-with-test (start-pos test)

+           (declare (optimize (speed 3))

+                    (type array-index start-pos)

+                    (type function test)

+                    (inline))

+           (typecase divider

+             (simple-string (typecase string

+                              (simple-string (search divider string :start2 start-pos :test test))

+                              (string (search divider string :start2 start-pos :test test))))

+             (string (search divider string :start2 start-pos :test test)))))

+    (declare (dynamic-extent (function %search)

+                             (function %search-with-test)))

+    (let ((num-parts (the array-length 0))

+          (pattern-length (the array-length (length divider)))

+          (search-test (typecase test

+                         (function test)

+                         (null)

+                         (symbol (symbol-function test))))

+          (parts (make-array (if count count 100)

+                             :adjustable t

+                             :fill-pointer 0))

+          (start-pos 0))

+      (loop 

+         for end-pos = (typecase search-test

+                         (function (%search-with-test start-pos search-test))

+                         (null (%search start-pos)))

+         do

+           (vector-push-extend (subseq string start-pos end-pos) parts) 

+           (incf (the array-length num-parts))

+         while end-pos

+         do (setf start-pos (the array-length (+ pattern-length end-pos)))

+         until (and count (>= (1+ num-parts) count))

+         finally

+           (when (and count end-pos)

+             (vector-push-extend (subseq string (+ pattern-length end-pos)) parts))

+           (return parts)))))

+

+(defun split (divider string &key count (test nil) (type nil type-p))

+  (declare (optimize #+dev (debug 3) (speed 3) (space 3)))

+  (unless test

+    (setf test

+          (typecase divider

+            (string 'equal)

+            (t 'eql))))

+  (let ((result (etypecase divider

+                  (character (%split-on-char divider string :count count :test test))

+                  (string (if (= 1 (length divider))

+                              (%split-on-char (aref divider 0) string :count count :test test)

+                              (%split-on-string divider string :count count :test test))))))

+    (if type-p

+        (coerce result type)

+        result)))

@@ -1,177 +1,12 @@

 (in-package :fwoar.string-utils)

-(deftype array-length ()

-  `(integer 0 ,array-dimension-limit))

-(deftype array-index ()

-  `(integer 0 ,(1- array-dimension-limit)))

-

-(defun get-part-modifier (char string &optional count)

-  (declare (optimize #+dev (debug 3) #-dev (speed 3))

-           (type character char)

-           (type string string))

-

-  (flet ((count-splits (string)

-           (declare (optimize (speed 3))

-                    (type simple-string string))

-           (do* ((x (the array-length 0) (1+ x))

-                 (cur-char #1=(aref string x) #1#)

-                 (result (the array-length 0) (if (char= cur-char char)

-                                                  (1+ result)

-                                                  result)))

-                ((= x (1- (length string))) (1+ result))

-             (declare (type array-length result)))))

-    (typecase string

-      ((and string (not simple-string))

-       (setf string (copy-seq string))))

-    (unless count

-      (setf count (count-splits string))))

-

-  (let ((parts (make-array count :initial-element nil :element-type '(or string null)))

-        (start-idx 0)

-        (target-spot 0))

-    (prog1 parts

-      (dotimes (end-idx (length string))

-        (when (typecase string

-                (simple-string (char= (aref string end-idx) char))

-                (string (char= (aref string end-idx) char)))

-          (setf (aref parts target-spot)

-                (make-array (- end-idx start-idx) :displaced-to string :displaced-index-offset start-idx

-                            :element-type 'character))

-          (incf target-spot)

-          (setf start-idx (1+ end-idx))

-          (when (= target-spot (1- count))

-            (return))))

-      (when (<= start-idx (length string))

-        (setf (aref parts target-spot)

-              (make-array (- (length string) start-idx)

-                          :displaced-to string :displaced-index-offset start-idx

-                          :element-type 'character))))))

-

-;; TODO: implement test

-(defun %split-on-char (divider string &key count (test nil))

-  (declare (optimize #+dev (debug 3) #+dev (speed 0) #+dev (space 0)

-                     #-dev (speed 3) #-dev(space 2))

-           (type (or null array-length) count)

-           (type (or null function symbol) test)

-           (type character divider)

-           (type string string))

-  (typecase string

-    ((and string (not simple-string))

-     (setf string (copy-seq string))))

-  (check-type string simple-string)

-

-  (flet ((count-splits (string)

-           (declare (optimize #+dev (debug 3) #+dev (speed 0) #+dev (space 0)

-                              #-dev (speed 3) #-dev(space 2))

-                    (type simple-string string))

-           (if (/= 0 (length string))

-               (do* ((x (the array-length 0) (1+ x))

-                     (cur-char #1=(aref string x) #1#)

-                     (result (the array-length

-                                  (if (char= cur-char divider)

-                                      1

-                                      0))

-                             (if (char= cur-char divider)

-                                 (1+ result)

-                                 result)))

-                    ((= x (1- (length string))) (1+ result))

-                 (declare (type array-length result)))

-               0))

-         (find-pos (start-pos)

-           (declare (optimize #+dev (debug 3) #+dev (speed 0) #+dev (space 0)

-                     #-dev (speed 3) #-dev(space 2))

-                    (type array-index start-pos))

-           (etypecase test

-             (function (position divider string :start start-pos :test test))

-             (null (position divider string :start start-pos))

-             (symbol (position divider string :start start-pos :test (symbol-function test))))))

-

-    (unless count

-      (setf count (count-splits string)))

-

-    (check-type count array-length)

-    (let ((parts (make-array (max count 1) :fill-pointer 0))

-          (start-pos (the fixnum 0)))

-      (declare (dynamic-extent start-pos))

-      (prog1 parts

-        (loop 

-           for end-pos = (find-pos start-pos)

-           while end-pos 

-           do

-             (vector-push (subseq string start-pos end-pos) parts)

-             (setf start-pos (1+ end-pos))

-           while (< (length parts) (1- count))

-           finally

-             (cond ((or (and end-pos count)

-                        (< start-pos (length string)))

-                    (vector-push (subseq string start-pos)

-                                 parts))

-                   ((not end-pos)

-                    (vector-push "" parts))))))))

-

-(defun %split-on-string (divider string &key count (test nil))

-  (declare (optimize #+dev (debug 3) (speed 3))

-           (type string divider string)

-           (type (or null function symbol) test)

-           (type (or null array-index) count))

-  (flet ((%search (start-pos)

-           (declare (optimize (speed 3))

-                    (type array-index start-pos)

-                    (inline))

-           (typecase divider

-             (simple-string (typecase string

-                              (simple-string (search divider string :start2 start-pos))

-                              (string (search divider string :start2 start-pos))))

-             (string (search divider string :start2 start-pos))))

-         (%search-with-test (start-pos test)

-           (declare (optimize (speed 3))

-                    (type array-index start-pos)

-                    (type function test)

-                    (inline))

-           (typecase divider

-             (simple-string (typecase string

-                              (simple-string (search divider string :start2 start-pos :test test))

-                              (string (search divider string :start2 start-pos :test test))))

-             (string (search divider string :start2 start-pos :test test)))))

-    (declare (dynamic-extent (function %search)

-                             (function %search-with-test)))

-    (let ((num-parts (the array-length 0))

-          (pattern-length (the array-length (length divider)))

-          (search-test (typecase test

-                         (function test)

-                         (null)

-                         (symbol (symbol-function test))))

-          (parts (make-array (if count count 100)

-                             :adjustable t

-                             :fill-pointer 0))

-          (start-pos 0))

-      (loop 

-         for end-pos = (typecase search-test

-                         (function (%search-with-test start-pos search-test))

-                         (null (%search start-pos)))

-         do

-           (vector-push-extend (subseq string start-pos end-pos) parts) 

-           (incf (the array-length num-parts))

-         while end-pos

-         do (setf start-pos (the array-length (+ pattern-length end-pos)))

-         until (and count (>= (1+ num-parts) count))

-         finally

-           (when (and count end-pos)

-             (vector-push-extend (subseq string (+ pattern-length end-pos)) parts))

-           (return parts)))))

-

-(defun split (divider string &key count (test nil) (type nil type-p))

-  (declare (optimize #+dev (debug 3) (speed 3) (space 3)))

-  (unless test

-    (setf test

-          (typecase divider

-            (string 'equal)

-            (t 'eql))))

-  (let ((result (etypecase divider

-                  (character (%split-on-char divider string :count count :test test))

-                  (string (if (= 1 (length divider))

-                              (%split-on-char (aref divider 0) string :count count :test test)

-                              (%split-on-string divider string :count count :test test))))))

-    (if type-p

-        (coerce result type)

-        result)))

+(defun insert-at (position item string)

+  (concatenate 'string

+               (subseq string 0 position)

+               (string item)

+               (subseq string position)))

+

+(defun insert-where (predicate item string)

+  (insert-at (position-if predicate string)

+             item

+             string))