@@ -1,5 +1,3 @@

-;;;; fwoar.lisputils.lisp

-

 (in-package #:fwoar.lisputils)

 (defmacro neither (&rest forms) `(not (or ,@forms)))

@@ -8,10 +8,12 @@

   "Use the current package name to generate a <PACKAGE-NAME>.MAIN function in CL-USER.

 This will not do anything if :FW.DEV is not in features as it's only intended as a shortcut"

-  (if (featurep :fw.dev)

-      (let ((entrypoint-symbol (intern (format nil "~a.~a" (package-name *package*) '#:main)

-                                       :cl-user)))

-        `(progn (defun ,entrypoint-symbol ,args

-                  ,@body)

-                (export ',entrypoint-symbol :cl-user)))

-      ()))

+  `(progn ,@(when (featurep :fw.dev)

+              (let ((entrypoint-symbol (intern (format nil "~a.~a" (package-name *package*) '#:main)

+                                               :cl-user)))

+                `((defun ,entrypoint-symbol ,args

+                    ,@body)

+                  (export ',entrypoint-symbol :cl-user))))

+          (defun ,(intern (symbol-name '#:main) *package*) ,args

+            ,@body)

+          (export ',(intern (symbol-name '#:main) *package*) *package*)))

@@ -1,44 +1,42 @@

-;;;; package.lisp

+(defpackage :fwoar-lisputils.package

+  (:use :cl)

+  (:export))

+(in-package :fwoar-lisputils.package)

 (defpackage :fwoar.counter

   (:use :cl))

-(defpackage :patmatch

+(defpackage :fwoar.anonymous-gf

   (:use :cl)

-  (:export :let-pat* :handle-pattern))

+  (:export #:glambda))

-(defpackage :fwoar.anonymous-gf

+(defpackage :fwoar-lisputils.restarts

   (:use :cl)

-  (:export :glambda))

+  (:export #:with-retry #:with-retry* #:safely-invoke-restart))

-(defpackage #:fwoar.lisputils

+(defpackage :fwoar.lisputils

   (:use #:cl #:alexandria)

   (:nicknames #:fw.lu)

   (:shadow #:with)

-  (:import-from :fwoar.anonymous-gf :glambda)

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

-  (:import-from :serapeum :op)

+  (:import-from #:fwoar.anonymous-gf #:glambda)

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

   (:export #:lambda-if #:lambda-cond #:alambda #:rollup-list

            #:ensure-mapping #:alist-string-hash-table #:make-pairs

            #:copy-slots #:transform-alist #:%json-pair-transform

-           #:%default-pair-transform #:default-when

-           #:transform-result #:slots-to-pairs #:normalize-html

-           #:destructuring-lambda #:let-each #:let-first #:let-second

-           #:neither #:neither-null #:m-lambda #:sets #:defparameters

-           #:setfs #:prog1-let #:prog1-bind #:if-let* #:with #:aconsf

-           #+null #:ensure-list #:pick #:vector-destructuring-bind #:with-accessors*

-           #:skip-values #:limit-values #:substitute-values #:op #:pick/r

-           #:pick-error #:twice #:glambda #:default-unless #:transform-first-value

-           #:may #:defun-ct

-           #:define-cluser-entrypoint

-           #:new

-           #:make-constructor

-           #:dive

-           #:empty-hash-table-like

-           #:v-assoc)) 

+           #:%default-pair-transform #:default-when #:transform-result

+           #:slots-to-pairs #:normalize-html #:destructuring-lambda

+           #:let-each #:let-first #:let-second #:neither

+           #:neither-null #:m-lambda #:sets #:defparameters #:setfs

+           #:prog1-let #:prog1-bind #:if-let* #:with #:aconsf #:pick

+           #:vector-destructuring-bind #:with-accessors* #:skip-values

+           #:limit-values #:substitute-values #:op #:pick/r

+           #:pick-error #:twice #:glambda #:default-unless

+           #:transform-first-value #:may #:defun-ct

+           #:define-cluser-entrypoint #:new #:make-constructor #:dive

+           #:empty-hash-table-like #:v-assoc #:defclass+))

 (defpackage :fwoar.lisputils.shortcuts

   (:use :cl :fwoar.lisputils)

   (:nicknames #:fw.lu.t)

-  (:export :~>))

+  (:export #:~>))

@@ -2,8 +2,7 @@

   #+fw.dev

   (:nicknames fw.su)

   (:use :cl )

-  (:export

-   #:log-json))

+  (:export #:log-json))

 (in-package :fwoar.swank-utils)

 (defvar *target-identifier* (alexandria:make-keyword (gensym "JSON")))

@@ -7,8 +7,8 @@

     (once-only (vector)

       `(symbol-macrolet ,(mapcar (destructuring-lambda ((num symbol))

                                    `(,symbol (aref ,vector ,num)))

-				                  mappings)

-	       ,@body))))

+                          mappings)

+         ,@body))))

 (defun v-assoc (item vector &key test test-not key)

@@ -16,8 +16,8 @@

         for assoc-key = (car cur)

         for keyed = (if key (funcall key assoc-key) assoc-key)

         if (and test (funcall test item keyed)) do (return cur)

-        else if (and test-not (not (funcall test item keyed))) do (return cur)

-        else when (eql item keyed) do (return cur)))

+          else if (and test-not (not (funcall test item keyed))) do (return cur)

+                 else when (eql item keyed) do (return cur)))

 (defun v-first (vector)

   (elt vector 0))

@@ -27,10 +27,11 @@

   (check-type table (array * (* *)))

   (let ((table-index (cl-containers:make-container 'cl-containers:simple-associative-container :test test)))

     (loop for row-num from 0 to (1- (array-dimension table 0))

-       for current-row = (make-array (array-dimension table 1)

-				     :displaced-to table

-				     :displaced-index-offset (apply #'array-row-major-index table (list row-num 0)))

-       do (setf (cl-containers:item-at table-index (funcall key current-row)) row-num))

+          for current-row = (make-array (array-dimension table 1)

+                                        :displaced-to table

+                                        :displaced-index-offset (apply #'array-row-major-index

+                                                                       table (list row-num 0)))

+          do (setf (cl-containers:item-at table-index (funcall key current-row)) row-num))

     table-index))

 (defun join-tables (table1 table2 &key (test 'eql) (key1 'v-first) (key2 'v-first))

@@ -39,13 +40,15 @@

   (check-type table2 (array * (* *)))

   (let ((table2-index (index-table table2 :test test :key key2)))

     (loop for row-num from 0 to (1- (array-dimension table1 0))

-       for current-row = (make-array (array-dimension table1 1)

-				     :displaced-to table1

-				     :displaced-index-offset (apply #'array-row-major-index table1 (list row-num 0)))

-       for dest-index = (cl-containers:item-at table2-index (funcall key1 current-row))

-       when dest-index

-       collect (let* ((to-row (make-array (array-dimension table2 1)

-					  :displaced-to table2

-					  :displaced-index-offset (apply #'array-row-major-index table2 (list dest-index 0)))))

-		 (concatenate 'vector current-row to-row)))))

+          for current-row = (make-array (array-dimension table1 1)

+                                        :displaced-to table1

+                                        :displaced-index-offset (apply #'array-row-major-index

+                                                                       table1 (list row-num 0)))

+          for dest-index = (cl-containers:item-at table2-index (funcall key1 current-row))

+          when dest-index

+            collect (let* ((to-row (make-array (array-dimension table2 1)

+                                               :displaced-to table2

+                                               :displaced-index-offset (apply #'array-row-major-index

+                                                                              table2 (list dest-index 0)))))

+                      (concatenate 'vector current-row to-row)))))