@@ -11,39 +11,69 @@

                              :package :fwoar.string-utils))

   :depends-on (#:anaphora

                #:alexandria

-               #:serapeum

                #:cl-containers

+                 #:closer-mop

                #:iterate

+                 #:fwoar-lisputils/patmatch

                #:fwoar-lisputils/string-utils

-               #-lispworks #:plump

+                 #:plump

                #:positional-lambda

-               #-lispworks #:should-test)

+                 (:feature (:not (:or :ecl :abcl))

+                           #:fwoar-lisputils/implementation-dependent))

   :components ((:file "package")

                (:file "fwoar-lisputils")

-               (:file "lexical-compare")

                (:file "hash-functions")

                (:file "multiple-values")

-               (:file "clos-helpers")

+                 (:file "restarts")

                (:file "counter")

                (:file "vector-utils")

-               #-lispworks

-               (:file "non-lispworks")

-               #-lispworks

-               (:file "patmatch")

+                 (:file "html")

                (:file "glambda")

-               (:file "misc")))

+                 (:file "misc")

+                 ))

+

+(defsystem :fwoar-lisputils/implementation-dependent

+    :description "Utilities that don't work on every system"

+    :author "fiddlerwoaroof <fiddlerwoaroof@gmail.com"

+    :license "MIT"

+    :serial t

+    :depends-on ()

+    :components ((:file "non-ecl" :if-feature (:not (:or :ecl :abcl)))

+                 (:file "lexical-compare" :if-feature (:not (:or :ecl :abcl)))

+                 (:file "clos-helpers" :if-feature (:not (:or :ecl :abcl)))))

+

+(defsystem :fwoar-lisputils/patmatch 

+    :description ""

+    :author "Ed L <edward@elangley.org>"

+    :license "MIT"

+    :depends-on (#:alexandria

+                 #:uiop)

+    :serial t

+    :components ((:module "patmatch"

+                  :components ((:file "package")

+                               (:file "patmatch" :depends-on ("package"))))))

+

+(defsystem :fwoar-lisputils/patmatch/test 

+    :description ""

+    :author "Ed L <edward@elangley.org>"

+    :license "MIT"

+    :depends-on (:fwoar-lisputils/patmatch

+                 :parachute)

+    :serial t

+    :components ((:module "patmatch"

+                  :components ((:file "test")))))

 (defsystem #:fwoar-lisputils/string-utils

   :description "A string splitter"

   :author "fiddlerwoaroof <fiddlerwoaroof@gmail.com"

   :license "MIT"

-  :depends-on (#:should-test)

+    :depends-on ()

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

                (:file "string-utils/split"

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

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

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

-               #-lispworks

+                 #+(or)

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

 (asdf:defsystem #:fwoar-lisputils/swank-utils

deleted file mode 100644

@@ -1,149 +0,0 @@

-(in-package :patmatch)

-

-(define-condition no-pattern (error)

-  ((%pattern-obj :initarg :pattern-obj :reader pattern-obj)

-   (%pattern-form :initarg :pattern-form :reader pattern-form)

-   (%pattern-args :initarg :pattern-args :reader pattern-args)))

-

-(eval-when (:compile-toplevel :load-toplevel :execute)

-  (defgeneric handle-pattern (pattern form &rest args)

-    (:method-combination append)

-

-    (:method append ((pattern (eql 'cons)) form &rest args)

-             (let ((val-sym (gensym "VAL")))

-               (destructuring-bind (car cdr) args

-                 `((,val-sym ,form)

-                   (,car (car ,val-sym))

-                   (,cdr (cdr ,val-sym))))))

-

-    (:method append ((pattern (eql 'vector)) form &rest args)

-             (let ((val-sym (gensym "VAL")))

-               `((,val-sym ,form)

-                 ,@ (loop for arg in args

-                       for idx from 0

-                       collect `(,arg (aref ,val-sym ,idx))))))

-

-    (:method append ((pattern (eql 'hash-table)) form &rest args)

-             (let* ((val-sym (gensym "VAL"))

-                    (binding-forms (loop for (key sym) in args

-                                      append `((,sym (gethash ',key ,val-sym))))))

-               `((,val-sym ,form)

-                 ,@binding-forms)))

-

-    (:method append ((pattern symbol) form &rest args)

-             (when (closer-mop:subclassp pattern 'standard-object)

-               (apply #'handle-pattern

-                      (closer-mop:class-prototype

-                       (closer-mop:ensure-finalized (find-class pattern)))

-                      form

-                      args))))) 

-

-(defmacro let-pat* ((&rest clauses) &body body)

-  `(let* (,@ (loop for ((discriminator . args) val-form) in clauses

-                append (apply 'handle-pattern discriminator val-form args)))

-     ,@body))

-

-

-(defpackage :patmatch/test

-  (:use :cl :should-test)

-  (:import-from :patmatch :let-pat*)

-  (:export ))

-(in-package :patmatch/test)

-

-#|

-(deftest let-pat*-handles-cons ()

-    ""

-  (should be eql

-          2

-          (let-pat* (((cons a b) '(2 . 3)))

-            (declare (ignore b))

-            a))

-  (should be eql

-          3

-          (let-pat* (((cons a b) '(2 . 3)))

-            (declare (ignore a))

-            b)))

-

-(deftest let-pat*-handles-vector ()

-    ""

-  (should be eql

-          2

-          (let-pat* (((vector a b) #(2 3)))

-            (declare (ignore b))

-            a))

-  (should be eql

-          3

-          (let-pat* (((vector a b) #(2 3)))

-            (declare (ignore a))

-            b)))

-

-(deftest let-pat*-handles-hash-table ()

-    ""

-  (should be eql

-          2

-          (let-pat* (((hash-table (:a a) (:b b)) (alexandria:plist-hash-table '(:a 2 :b 3))))

-            (declare (ignore b))

-            a))

-  (should be eql

-          3

-          (let-pat* (((hash-table (:a a) (:b b)) (alexandria:plist-hash-table '(:a 2 :b 3))))

-            (declare (ignore a))

-            b)))

-

-(eval-when (:compile-toplevel :load-toplevel :execute)

-  (defclass test-base ()

-    ((a :initform 1)))

-  (defclass test-sub1 (test-base)

-    ())

-  (defclass test-sub2 (test-base)

-    ((b :initform 2)))

-  (closer-mop:ensure-class 'test-base)

-  (closer-mop:ensure-class 'test-sub1)

-  (closer-mop:ensure-class 'test-sub2)

-  )

-

-(defmethod patmatch:handle-pattern append ((pattern test-base) form &rest args)

-  (alexandria:when-let ((arg (getf args :a)))

-    (let ((val-sym (gensym "test-base-")))

-      `((,val-sym ,form)

-         ,@(serapeum:unsplice

-             `(,arg (slot-value ,val-sym 'a)))))))

-

-(defmethod patmatch:handle-pattern append ((pattern test-sub2) form &rest args)

-  (alexandria:when-let ((arg (getf args :b)))

-    (let ((val-sym (gensym "test-base-")))

-      `((,val-sym ,form)

-        ,@(serapeum:unsplice

-           `(,arg (slot-value ,val-sym 'b)))))))

-

-

-(deftest let-pat*-handles-object-destructuring ()

-    ""

-  (should be eql

-          1

-          (let-pat* (((test-base :a a) (make-instance 'test-base)))

-            a)))

-

-(deftest let-pat*-handles-inheritance ()

-    ""

- (should be eql

-          1

-          (let-pat* (((test-base :a a) (make-instance 'test-sub1)))

-            a))

-

- (should be eql

-          1

-          (let-pat* (((test-sub1 :a a) (make-instance 'test-sub1)))

-            a))

-

- (should be eql

-         1

-         (let-pat* (((test-sub2 :a a) (make-instance 'test-sub2)))

-           a))

-

- (should be equal

-         '(1 2)

-         (let-pat* (((test-sub2 :a a :b b) (make-instance 'test-sub2)))

-           (list a b))))

-

-|#