Use length compare funs from Alexandria/Serapeum

Author: pfdietz

command-line.lisp

@@ -459,11 +459,11 @@ directories and if files based on their extensions."
            (cond
              (project-p
               (best-guess guesses))
-             ((= 1 (length sources))
+             ((length= 1 sources)
               ;; For a single file either return the guess, or return
               ;; SIMPLE if no language matched.
               (or (car guesses) 'simple))
-             ((= 1 (length (remove-duplicates guesses)))
+             ((length= 1 (remove-duplicates guesses))
               ;; Multiple non-project files must all be equal to return a guess.
               (or (car guesses) 'simple))))))
     (guess-helper sources nil)))

components/clang-tokens.lisp

@@ -72,18 +72,18 @@ SOFTWARE."))
          (let ((children (child-asts root)))
            (switch ((ast-class root) :test #'equal)
              (:AddrLabelExpr
-              (assert (<= 2 (length (source-text root))))
+              (assert (length<= 2 (source-text root)))
               (list (token-from-string "&&") (token-from-string "identifier")))
              (:ArraySubscriptExpr
-              (assert (= 2 (length children)))
+              (assert (length= 2 children))
               (append (tokenize (first children))
                       (list (token-from-string "["))
                       (tokenize (second children))
                       (list (token-from-string "]"))))
              ;; no tokens, just proceed to children
              (:AttributedStmt (tokenize-children children))
              (:BinaryOperator
-              (assert (= 2 (length children)))
+              (assert (length= 2 children))
               (append (tokenize (first children))
                       (list (token-from-string (ast-opcode root)))
                       (tokenize (second children))))
@@ -101,7 +101,7 @@ SOFTWARE."))
                                  (tokenize-children (cdr children))))
              (:CharacterLiteral (list (token-from-string "char-literal")))
              (:CompoundAssignOperator
-              (assert (= 2 (length children)))
+              (assert (length= 2 children))
               (append (tokenize (first children))
                       (list (token-from-string (ast-opcode root)))
                       (tokenize (second children))))
@@ -121,7 +121,7 @@ SOFTWARE."))
                                     (tokenize-children children)
                                     (list (token-from-string "}"))))
              (:ConditionalOperator
-              (assert (= 3 (length children)))
+              (assert (length= 3 children))
               (append (tokenize (first children))
                       (list (token-from-string "?"))
                       (tokenize (second children))
@@ -186,7 +186,7 @@ SOFTWARE."))
                  ;; initializer is the last child
                  (tokenize (lastcar children)))))
              (:DoStmt
-              (assert (= 2 (length children)))
+              (assert (length= 2 children))
               (append (list (token-from-string "do"))
                       (tokenize (first children))
                       (list (token-from-string "while")
@@ -234,7 +234,7 @@ SOFTWARE."))
                      ;; split a-ls on : to get types
                      (types (mapcar [#'token-from-string #'first {split ":\\s*"}]
                                     a-ls)))
-                (assert (= (length types) (1- (length children))) ()
+                (assert (length= types (1- (length children))) ()
                         "Types = ~a, Children = ~a" types children)
                 (append (list (token-from-string "generic")
                               (token-from-string "("))
@@ -256,7 +256,7 @@ SOFTWARE."))
                               (tokenize (first children))
                               (list (token-from-string ")"))
                               (tokenize (second children))
-                              (when (= 3 (length children))
+                              (when (length= 3 children)
                                 (cons (token-from-string "else")
                                       (tokenize (third children))))))
              (:ImaginaryLiteral (list (token-from-string "i-literal")))
@@ -286,7 +286,7 @@ SOFTWARE."))
                                        (not dot))
                                    (list (token-from-string "->"))
                                    (list (token-from-string ".")))))
-                (assert (= 1 (length children)))
+                (assert (length= 1 children))
                 (append (tokenize (first children))
                         dash-dot
                         (list (token-from-string "identifier")))))
@@ -324,7 +324,7 @@ SOFTWARE."))
                                 (list (token-from-string ")"))))
              (:StringLiteral (list (token-from-string "string-literal")))
              (:SwitchStmt
-              (assert (= 2 (length children)))
+              (assert (length= 2 children))
               (append (list (token-from-string "switch")
                             (token-from-string "("))
                       (tokenize (first children))
@@ -371,7 +371,7 @@ SOFTWARE."))
                                 (prog1 (tokenize (nth child children))
                                   (incf child)))))))
              (:WhileStmt
-              (assert (= 2 (length children)))
+              (assert (length= 2 children))
               (append (list (token-from-string "while")
                             (token-from-string "("))
                       (tokenize (first children))

components/in-memory-fodder-database.lisp

@@ -91,7 +91,7 @@ Otherwise, consider all ASTs."
                               (full-stmt
                                (ast-database-full-stmt-list db))
                               (t (ast-database-list db))))))
-    (if (and limit (< limit (length snippets)))
+    (if (and limit (length< limit snippets))
         (mapcar {aref (coerce snippets 'vector)}
                 (random-sample-without-replacement (length snippets) limit))
         snippets)))

components/lexicase.lisp

@@ -25,7 +25,7 @@
 The same individual may be selected multiple times."
   (without-compiler-notes
     (assert
-     (= 1 (length (remove-duplicates population :key [#'length #'fitness])))
+     (length= 1 (remove-duplicates population :key [#'length #'fitness]))
      (population)
      "All fitness vectors must be the same length."))
   (iter (for n below max-size)

components/multi-objective.lisp

@@ -41,11 +41,9 @@ PREDICATES is a list of functions, of equal length to the fitness
 values, which are used to compare each element of the fitness values.
 "
   (every (lambda (compare)
-           (assert (eq (length (fitness candidate))
-                       (length (fitness compare))))
-           (assert (eq (length (fitness candidate))
-                       (length predicates)))
-
+           (assert (length= (fitness candidate)
+                            (fitness compare)
+                            predicates))
            (and (some #'funcall predicates (fitness candidate)
                       (fitness compare))
                 (notany #'funcall predicates (fitness compare)

components/serapi-io.lisp

@@ -648,7 +648,7 @@ command or an invalid Coq command, NIL otherwise."
   "Return T if SEXPR is tagged as VernacImport or VernacRequire, NIL otherwise."
   ;; ASTs for imports have length 2 where the first element is located info
   ;; and the second is either VernacImport or VernacRequire.
-  (and (= 2 (length sexpr))
+  (and (length= 2 sexpr)
        (is-loc-info (first sexpr))
        (or (is-type (intern "VernacImport" :sel/cp/serapi-io)
                     (second sexpr))
@@ -945,7 +945,7 @@ Return a list of IDs for the ASTs that were added."
 (defun tokenize-coq-type (type-string)
   (labels ((find-matching-paren (str pos depth)
              (cond
-               ((equal pos (length str)) nil)
+               ((length= pos str) nil)
                ((and (equal (elt str pos) #\)) (zerop depth))
                 pos)
                ((equal (elt str pos) #\))
@@ -1034,7 +1034,7 @@ Use Ident for unqualified names and Qualid for qualified names."
                       {intern _  :sel/cp/serapi-io } ]
                      (cdr quals))))
       (when (and quals (listp quals))
-        (if (= 1 (length quals))
+        (if (length= 1 quals)
             (wrap-coq-constr-expr #!`(CRef ,(MAKE-COQ-IDENT ID) ()))
             (wrap-coq-constr-expr
              #!`(CRef

components/test-suite.lisp

@@ -408,7 +408,7 @@ By default, sum the results of applying `evaluate' to each test-case using
                   (note 2 "Failed test ~A~%" test)
                   (pushnew test (failed-tests test-suite)
                            :test 'equal :key 'program-args) ;track failed tests
-                  (if (> (length (failed-tests test-suite)) *max-failed-tests*)
+                  (if (length> (failed-tests test-suite) *max-failed-tests*)
                       (setf (failed-tests test-suite)
                             (subseq (failed-tests test-suite) 0
                                     *max-failed-tests*)))

software-evolution-library.lisp

@@ -457,8 +457,8 @@ Each crossover and mutation will be paired with one of the following tags;
         (push (cons (mutation-key crossed mutation)
                     *fitness-evals*)
               *mutation-improvements*)
-        (when (>= (length *mutation-improvements*)
-                  *max-saved-mutation-improvements*)
+        (when (length>= *mutation-improvements*
+                        *max-saved-mutation-improvements*)
           (setf *mutation-improvements*
                 (butlast *mutation-improvements*))))
       (push (setf result (list effect *fitness-evals* fit old-fit))
@@ -854,7 +854,7 @@ number will automatically be promoted).")
   "Incorporate SOFTWARE into POPULATION, keeping POPULATION size constant."
   (push software *population*)
   (loop :while (and *max-population-size*
-                    (> (length *population*) *max-population-size*))
+                    (length> *population* *max-population-size*))
      :do (evict)))
 
 (defvar *tie-breaker-predicate* #'>
@@ -948,7 +948,7 @@ Default selection function for `tournament'."
             (unless (and (null variant) (null mutation-info))
               (collect variant into variants)
               (collect mutation-info into infos)))
-          (while (< (length variants) count))
+          (while (length< variants count))
           (finally (return (values variants infos))))))
 
 (defun validate-evolution-parameters ()
@@ -993,7 +993,7 @@ evolutionary loop:
 (defun remove-elite-individuals ()
   "Remove *ELITISM* individuals from population and return them."
   (assert (and (typep *elitism* '(integer 0 *))
-               (< *elitism* (length *population*)))
+               (length< *elitism* *population*))
     (*elitism*)
     "*ELITISM* is out of range--must be an integer >0 ~
                             and < (length *POPULATION*)")
@@ -1234,7 +1234,7 @@ This differs from how evolve works."
                               ;; after the select operation.
                               (- *max-population-size* *elitism*)))
                (add-elite-individuals elite-individuals)
-               (assert (<= (length *population*) *max-population-size*))))
+               (assert (length<= *population* *max-population-size*))))
            (if (and period period-fn (zerop (mod *generations* period)))
                (funcall period-fn))
         :finally (deinitialize-evolutionary-loop))))
@@ -1271,7 +1271,7 @@ list of the mutations applied to produce those children."
 
 (defun simple-select (population max-size &aux new-pop)
   (declare (ignorable population)) ; tournament uses global *population*
-  (iter (until (= max-size (length new-pop)))
+  (iter (until (length= max-size new-pop))
         (restart-case (push (tournament) new-pop)
           (ignore-failed-selection ()
             :report "Ignore failed `tournament' selection."))))

software/asm.lisp

@@ -161,7 +161,7 @@ Used by `homologous-crossover'."
            (aget :id (elt (genome obj) id))))
     (let* ((id-a (lookup-id a point-a))
            ;; adjust if id-a is beyond length of b
-           (start (if (>= id-a (length (genome b)))
+           (start (if (length>= id-a (genome b))
                       (1- (length (genome b)))
                       id-a))
            ;; max value we can add to start and still have a valid index in b

software/clang-expression.lisp

@@ -90,7 +90,7 @@ This is used to intern string names by `expression'."
 "
   (cond
     ((listp expression)
-     (assert (= 3 (length expression)))
+     (assert (length= 3 expression))
      (format nil "(~a ~a ~a)"
              (expression-to-c (second expression))
              (symbol-name (car expression))
@@ -153,7 +153,7 @@ This is used to intern string names by `expression'."
       (cond
         ((listp expression)
          ;; TODO: support functions/operators with different arity
-         (unless (= (length expression) 3)
+         (unless (length= 3 expression)
            (error (make-condition 'eval-error
                     :text (format nil
                                   "Wrong number of arguments. Expected 2 got ~a"

software/clang.lisp

@@ -813,7 +813,7 @@ Other keys are allowed but are silently ignored.
     (%push :full-stmt full-stmt)
     (%push :guard-stmt guard-stmt)
     (%push :opcode opcode)
-    (%push :name (when (= (length declares) 1)
+    (%push :name (when (length= declares 1)
                    ;; clang name attribute is not aggregated
                    (ast-name (first declares))))
     (make-instance 'clang-ast
@@ -1446,7 +1446,7 @@ software object."))
               (lastcar (child-asts guarded))))
             (:IfStmt
              (let ((children (child-asts guarded)))
-               (if (= 2 (length children))
+               (if (length= 2 children)
                    ;; If with only one branch.
                    (compose-children (second children))
                    ;; If with both branches.
@@ -2204,7 +2204,7 @@ already in scope, it will keep that name.")
          (bind (((head . tail) path)
                 (children (children tree)))
                (assert (>= head 0))
-               (assert (< head (length children)))
+               (assert (length< head children))
                (if tail
                    ;; Recurse into child
                    (replace-nth-child tree head (helper (nth head children) tail))
@@ -4163,7 +4163,7 @@ on various ast classes"))
 
 (defun ast-args-equal (args1 args2)
   "Compare two lists as returned by AST-ARGS"
-  (and (= (length args1) (length args2))
+  (and (length= args1 args2)
        (every #'ast-arg-equal args1 args2)))
 
 (defmethod ast-declares ((c string)) nil)
@@ -6419,8 +6419,7 @@ children.")
     (let* ((children (children ast))
            (new-children (mapcar (lambda (a) (remove-asts-if a fn))
                                  (remove-if fn children))))
-      (unless (and (= (length children)
-                      (length new-children))
+      (unless (and (length= children new-children)
                    (every #'eql children new-children))
         (setf (children ast) new-children)))
     ast)

software/coq.lisp

@@ -652,7 +652,7 @@ unqualified type names."
              (type-matches (string ty1) (string ty2)))
             ;; Two type lists of the same length: check that every element
             ;; matches.
-            ((and (listp ty1) (listp ty2) (= (length ty1) (length ty2)))
+            ((and (listp ty1) (listp ty2) (length= ty1 ty2))
              (every #'identity (mapcar #'type-matches ty1 ty2)))
             (t nil)))
          ((:flet extend-env (type scopes))
@@ -664,7 +664,7 @@ E.g., for type \"bool\", the list includes \"(implb true) : bool -> bool\" and
                 (name (first type))
                 (type-ast (second type)))
             ;; Ensure that TYPE is a function (has at least 1 :->).
-            (when (< 1 (length split-type))
+            (when (length< 1 split-type)
               ;; Iterate over SCOPES, finding items with the correct type.
               (iter (for (scope-name scope-ast colon . scope-ty) in scopes)
                     (declare (ignorable colon))

software/cpp.lisp

@@ -54,7 +54,7 @@
   (nlet rec ((pos 0)
              (bracket-count 0)
              (acc nil))
-    (if (>= pos (length string))
+    (if (length>= pos string)
         (if (> bracket-count 0)
             ;; Not actually delimiters. E.g. operator<.
             string

software/elf-risc.lisp

@@ -106,7 +106,7 @@
                                              (elt (genome elf) (third mut))))))
             (:swap   (elf-swap elf (second mut) (third mut)))))
     elf
-    (assert (= (length (genome elf)) starting-length)
+    (assert (length= (genome elf) starting-length)
             (elf) "mutation ~S changed size of genome [~S -> ~S]"
             mut starting-length (length (genome elf)))))
 
@@ -160,7 +160,7 @@ A value of nil means never replace.")
                  :do
                  (cond
                    ;; don't cross borders or leave the genome
-                   ((or (member (+ s1 i) borders) (>= (+ s1 i) (length genome)))
+                   ((or (member (+ s1 i) borders) (length>= (+ s1 i) genome))
                     (setf forwards-p nil))
                    ((or (member (- s1 i) borders) (< (- s1 i) 0))
                     (setf backwards-p nil))

software/expression.lisp

@@ -163,7 +163,7 @@
 
 (defmethod pick-bad-binop-left ((obj expression))
   "DOCFIXME"
-  (flet ((binopp (subtree) (and (listp subtree) (= 3 (length subtree)))))
+  (flet ((binopp (subtree) (and (listp subtree) (length= 3 subtree))))
     (some->> (iter (for i below (size obj))
                (collect (list i (subtree (genome obj) i))))
              (remove-if-not (lambda-bind ((i subtree))
@@ -177,7 +177,7 @@
 
 (defmethod pick-bad-binop-right ((obj expression))
   "DOCFIXME"
-  (flet ((binopp (subtree) (and (listp subtree) (= 3 (length subtree)))))
+  (flet ((binopp (subtree) (and (listp subtree) (length= 3 subtree))))
     (some->> (iter (for i below (size obj))
                    (collect (list i (subtree (genome obj) i))))
              (remove-if-not (lambda-bind ((i subtree))

software/forth.lisp

@@ -35,7 +35,7 @@
                    (nreverse out))))
           (with-open-file (in path)
             (loop :for line = (read-line in nil) :while line :append
-               (if (and (> (length line) 2) (string= "#! " (subseq line 0 3)))
+               (if (and (length> line 2) (string= "#! " (subseq line 0 3)))
                    (prog1 nil (setf (shebang forth) line))
                    (mapcar [#'list {cons :code}]
                            (mapcan (lambda (el)

software/parseable.lisp

@@ -259,8 +259,8 @@ RECURSIVE is passed, recursive AST children will also be returned.")
   (:method :before ((ast ast)
                     &aux (children (remove nil (children ast))))
     (assert (or (null (ast-annotation ast :child-order))
-                (= (length children)
-                   (length (ast-annotation ast :child-order))))
+                (length= children
+                         (ast-annotation ast :child-order)))
             (ast)
             "The number of elements in the AST's :child-order annotation ~
             defining the order of the children does not match the number ~
@@ -985,7 +985,7 @@ the `genome' of the software object."
   (:method (function (ast ast) &aux (deepest 0) result)
     (do-tree (node ast :index rpath :value result)
       (when (and (funcall function node)
-                 (> (length rpath) deepest))
+                 (length> rpath deepest))
         (setf result node
               deepest (length rpath)))
       nil)))