New EQLS function. Reinstated STARTS-WITH/ENDS-WITH.

cards.lisp

@@ -27,13 +27,13 @@
 ;;;;   https://codepoints.net/playing_cards
 ;;;;   https://eev.ee/blog/2015/09/12/dark-corners-of-unicode/
 ;;;;
-(load "/home/slytobias/lisp/packages/lang.lisp")
+(load "/home/slytobias/lisp/packages/core.lisp")
 (load "/home/slytobias/lisp/packages/collections.lisp")
 (load "/home/slytobias/lisp/packages/test.lisp")
 
 (defpackage :cards
   (:shadowing-import-from :collections :intersection :set :subsetp :union)
-  (:use :common-lisp :lang :collections :test) 
+  (:use :common-lisp :core :collections :test) 
   (:export :rank :suit :face-up :label :turn :turn-up :turn-down :deck :emptyp :remaining :shuffle :deal :add :presentp :clubs :diamonds :hearts :spades :card :deck :jack :queen :king :ace)
   (:shadow :shuffle :count))
 
@@ -144,7 +144,7 @@
 (defgeneric shuffle (deck))
 (defmethod shuffle ((d deck))
   (with-slots (cards random-state) d
-    (let ((shuffled (lang:shuffle (coerce (elements cards) 'vector) random-state))
+    (let ((shuffled (core:shuffle (coerce (elements cards) 'vector) random-state))
           (shuffled-deck (make-linked-queue)))
       (loop for card across shuffled do (enqueue shuffled-deck card))
       (setf cards shuffled-deck))))

core.lisp

@@ -41,7 +41,7 @@
            :>case :class-template :comment :compose :conc1 :copy-array :cycle
            :defchain :destructure :dohash :doset :dostring :dotuples :dovector
            :drop :drop-until :drop-while :duplicatep
-           :emptyp :equals :every-pred :expand :explode
+           :emptyp :ends-with :equals :eqls :every-pred :expand :explode
            :filter :filter-split :find-some-if :find-subtree :firsts-rests :for :flatten
            :get-num :group :group-until :horners
 	   :if-let :if3 :iffn :in :in-if :inq :is-integer :iterate
@@ -58,7 +58,7 @@
            :shift0 :shift-list0 :shift1 :shift-list1
            :show-symbols :shuffle :singlep :some-pred :sort-symbol-list :splice
 ;           :split-if
-           :stable-partition :stream-partition :suffixp :symb
+           :stable-partition :starts-with :stream-partition :suffixp :symb
            :take :take-drop :take-while :take-until :transfer
            :transition :transition-1 :transition-n :transition-stream :translate :traverse :tree-find-if :tree-map
            :until :valid-num-p 
@@ -658,7 +658,6 @@
 (defmethod equals ((ch1 character) (ch2 character))
   (char= ch1 ch2))
 (defmethod equals ((l1 list) (l2 list))
-                                        ;  (equal l1 l2))
   (cond ((null l1) (null l2))
         ((null l2) nil)
         ((equals (first l1) (first l2)) (equals (rest l1) (rest l2)))
@@ -674,6 +673,25 @@
 ;; (defmethod equals ((k1 keyword) (k2 keyword))
 ;;   (call-next-method))
 
+;; pathname, structure, hash table, bit vector
+(defgeneric eqls (o1 o2)
+  (:documentation "Is O1 EQL to O2 or are all elements EQL?"))
+(defmethod eqls (o1 o2)
+  (eql o1 o2))
+(defmethod eqls ((s1 string) (s2 string))
+  (string= s1 s2))
+(defmethod eqls ((l1 list) (l2 list))
+  (cond ((null l1) (null l2))
+        ((null l2) nil)
+        ((eqls (first l1) (first l2)) (eqls (rest l1) (rest l2)))
+        (t nil)))
+(defmethod eqls ((v1 vector) (v2 vector))
+  (if (= (length v1) (length v2))
+      (do ((i 0 (1+ i)))
+          ((= i (length v1)) t)
+        (unless (eqls (aref v1 i) (aref v2 i))
+          (return nil)))) )
+
 (defgeneric prefixp (s1 s2 &key test)
   (:documentation "Is sequence S1 a prefix of S2?"))
 (defmethod prefixp ((v1 vector) (v2 vector) &key (test #'eql))
@@ -720,6 +738,12 @@
         ((not (mismatch l1 l2 :test test)))
         (t (suffixp l1 (rest l2) :test test))))
 
+(defun starts-with (s1 s2 &key (test #'eql))
+  (prefixp s2 s1 :test test))
+
+(defun ends-with (s1 s2 &key (test #'eql))
+  (suffixp s2 s1 :test test))
+
 ;---------------Macros------------------------
 ;; (defmacro while (test &body body)
 ;;   `(do ()

csv.lisp

@@ -24,13 +24,13 @@
 ;;;;   Notes:
 ;;;;
 ;;;;
-(load "/home/slytobias/lisp/packages/lang.lisp")
+(load "/home/slytobias/lisp/packages/core.lisp")
 (load "/home/slytobias/lisp/packages/test.lisp")
 (load "/home/slytobias/lisp/packages/collections.lisp" :verbose nil)
 
 (defpackage :csv
   (:shadowing-import-from :collections :intersection :set :subsetp :union)
-  (:use :common-lisp :lang :collections :test))
+  (:use :common-lisp :core :collections :test))
 
 (in-package :csv)
 

hanoi.lisp

@@ -25,10 +25,10 @@
 ;;;;   Notes:
 ;;;;
 ;;;;
-(load "/home/slytobias/lisp/packages/lang.lisp")
+(load "/home/slytobias/lisp/packages/core.lisp")
 (load "/home/slytobias/lisp/packages/test.lisp")
 
-(defpackage :hanoi (:use :common-lisp :lang :test))
+(defpackage :hanoi (:use :common-lisp :core :test))
 
 (in-package :hanoi)
 

pathnames.lisp

@@ -1,8 +1,8 @@
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (load "/home/slytobias/lisp/packages/lang.lisp"))
+  (load "/home/slytobias/lisp/packages/core.lisp"))
 
 (defpackage :pathnames
-  (:use :common-lisp :lang)
+  (:use :common-lisp :core)
 ;  #+allegro (:shadow :pathname-as-directory :pathname-as-file) ?
   (:export :directory-p :directory-pathname-p
            :file-exists-p :file-p :file-pathname-p

strings.lisp

@@ -29,12 +29,12 @@
 ;(load "/home/slytobias/lisp/packages/test.lisp")
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  #+ :sbcl (load "/home/slytobias/lisp/packages/lang" :verbose nil)
-  #- :sbcl (load "/home/slytobias/lisp/packages/lang.lisp" :verbose nil))
+  #+ :sbcl (load "/home/slytobias/lisp/packages/core" :verbose nil)
+  #- :sbcl (load "/home/slytobias/lisp/packages/core.lisp" :verbose nil))
 
 (defpackage :strings
-  (:use :common-lisp :lang)
-;  (:use :common-lisp :lang :test)
+  (:use :common-lisp :core)
+;  (:use :common-lisp :core :test)
   (:export :center :commify :commify-list :elide :english-and-list :english-or-list :get-article
            :irregular-plural :join
            :ljust

test-core.lisp

@@ -287,6 +287,41 @@
    (equal (drop-until #'oddp '(0 2 4 5 7 2 9)) '(5 7 2 9))
    (equalp (drop-until #'oddp [0 2 4 5 7 2 9]) #(5 7 2 9))))
 
+(deftest test-equals ()
+  (check
+   (equals 2 2d0)
+   (equals "pung" "pung")
+   (not (equals "pung" "Pung"))
+   (equals #\h #\h)
+   (not (equals #\h #\H))
+   (equals '(1 2 3) '(1 2 3))
+   (equals #(1 2 3) #(1 2 3))
+   (equals '(1 2 3) '(1d0 2d0 3d0))
+   (equals #(1 2 3) #(1d0 2d0 3d0))
+   (equals '("pung" "foo" "bar") '("pung" "foo" "bar"))
+   (equals #("pung" "foo" "bar") #("pung" "foo" "bar"))
+   (equals 'cl-user::cxr 'core::cxr)
+   (equals '(:a #(1 2) (#\c ("d" "e"))) '(:a #(1 2) (#\c ("d" "e"))))
+   (equals '(:a #(1 2d0) (#\c ("d" "e"))) '(:a #(1d0 2) (#\c ("d" "e")))) ))
+
+(deftest test-eqls ()
+  (check
+   (eqls 2 2)
+   (not (eqls 2 2d0))
+   (eqls "pung" "pung")
+   (not (eqls "pung" "Pung"))
+   (eqls #\h #\h)
+   (not (eqls #\h #\H))
+   (eqls '(1 2 3) '(1 2 3))
+   (eqls #(1 2 3) #(1 2 3))
+   (not (eqls '(1 2 3) '(1d0 2d0 3d0)))
+   (not (eqls #(1 2 3) #(1d0 2d0 3d0)))
+   (eqls '("pung" "foo" "bar") '("pung" "foo" "bar"))
+   (eqls #("pung" "foo" "bar") #("pung" "foo" "bar"))
+   (not (eqls 'cl-user::cxr 'core::cxr))
+   (eqls '(:a #(1 2) (#\c ("d" "e"))) '(:a #(1 2) (#\c ("d" "e"))))
+   (not (eqls '(:a #(1 2d0) (#\c ("d" "e"))) '(:a #(1d0 2) (#\c ("d" "e")))) )))
+
 (deftest test-prefixp ()
   (check
    (prefixp '() '())
@@ -354,6 +389,31 @@
    (suffixp #2=#(:a :b :c :d :e) #2#)
    (suffixp #(:b :c :d) #(:a :b :c :d))))
 
+(deftest test-starts-with ()
+  (check
+   (starts-with "Is" "Is")
+   (starts-with "Is this not pung?" "Is")
+   (not (starts-with "Is this not pung?" "is"))
+   (starts-with "Is this not pung?" "is" :test #'char-equal)
+   (starts-with (subseq "Is this not pung?" 12) "pung")
+   (starts-with '(a b c) '(a b))
+   (starts-with '(a b) '(a b))
+   (starts-with '(1 2 3 4 5) '(1 2))
+   (not (starts-with '(1 2 3 4 5) '(2 3)))
+   (starts-with '((a . 1) (b . 2) (c . 3)) '((a . 1)) :test #'equal)
+   (starts-with (subseq [1 2 3 4 5] 2) [3 4])
+   (starts-with #[1 10] #[1 3])))
+
+(deftest test-ends-with ()
+  (check   
+    (ends-with "Is this not pung?" "pung?")
+    (ends-with (subseq "Is this not pung?" 0 7) "this")
+    (not (ends-with "Is this not pung?" "PUNG?"))
+    (ends-with "Is this not pung?" "PUNG?" :test #'char-equal)
+    (ends-with '(a b c) '(b c))
+    (ends-with (subseq [1 2 3 4 5] 0 4) [3 4])
+    (ends-with #[1 10] #[8 10])))
+
 (deftest test-rotate-list0 ()
   (check
    (equal (rotate-list0 3 0) '(0 1 2))