2d34585c5704

Clean up, remove quickutils
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Sun, 19 Jan 2020 19:51:35 -0500
parents 05bc7da3473f
children 2735aa6aab79
branches/tags (none)
files Makefile package.lisp rosalind.asd src/package.lisp src/problems/seto.lisp src/utils.lisp vendor/make-quickutils.lisp vendor/quickutils-package.lisp vendor/quickutils.lisp

Changes

--- a/Makefile	Sat Jan 18 14:04:41 2020 -0500
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,8 +0,0 @@
-.PHONY: vendor
-
-
-# Vendor ----------------------------------------------------------------------
-vendor/quickutils.lisp: vendor/make-quickutils.lisp
-	cd vendor && sbcl --noinform --load make-quickutils.lisp  --eval '(quit)'
-
-vendor: vendor/quickutils.lisp
--- a/package.lisp	Sat Jan 18 14:04:41 2020 -0500
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,9 +0,0 @@
-(defpackage :rosalind
-  (:use
-    :cl
-    :iterate
-    :losh
-    :rosalind.quickutils)
-  (:import-from :1am :is)
-  (:shadowing-import-from :1am :test)
-  (:export :run-tests))
--- a/rosalind.asd	Sat Jan 18 14:04:41 2020 -0500
+++ b/rosalind.asd	Sun Jan 19 19:51:35 2020 -0500
@@ -34,10 +34,7 @@
                )
 
   :serial t
-  :components ((:module "vendor" :serial t
-                :components ((:file "quickutils-package")
-                             (:file "quickutils")))
-               (:file "package")
-               (:module "src" :serial t
-                :components ((:file "utils")
+  :components ((:module "src" :serial t
+                :components ((:file "package")
+                             (:file "utils")
                              (:auto-module "problems")))))
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/package.lisp	Sun Jan 19 19:51:35 2020 -0500
@@ -0,0 +1,9 @@
+(defpackage :rosalind
+  (:use :cl :iterate :losh)
+  (:import-from :1am :is)
+  (:import-from :alexandria
+    :curry :rcurry :compose
+    :ensure-gethash
+    :with-gensyms :once-only :symbolicate)
+  (:shadowing-import-from :1am :test)
+  (:export :run-tests))
--- a/src/problems/seto.lisp	Sat Jan 18 14:04:41 2020 -0500
+++ b/src/problems/seto.lisp	Sun Jan 19 19:51:35 2020 -0500
@@ -10,7 +10,7 @@
 {2, 5}
 {1, 3, 4}
 {8, 10}
-{8, 9, 10, 6, 7}
+{6, 7, 8, 9, 10}
 {1, 3, 4, 6, 7, 9}")
 
 (defun set-string (set)
@@ -39,4 +39,3 @@
 #; Scratch --------------------------------------------------------------------
 
 (problem-seto)
-;; (solve sset)
--- a/src/utils.lisp	Sat Jan 18 14:04:41 2020 -0500
+++ b/src/utils.lisp	Sun Jan 19 19:51:35 2020 -0500
@@ -389,7 +389,7 @@
 
 ;;;; Testing ------------------------------------------------------------------
 (defmacro define-test (problem input output &optional (test 'string=))
-  `(test ,(symb 'test- problem)
+  `(test ,(alexandria:symbolicate 'test- problem)
      (is (,test ,output (aesthetic-string (,problem ,input))))))
 
 (defun run-tests ()
@@ -400,7 +400,7 @@
 (defmacro define-problem (name (arg type) sample-input sample-output &body body)
   (multiple-value-bind (body declarations docstring)
       (alexandria:parse-body body :documentation t)
-    (let ((symbol (symb 'problem- name)))
+    (let ((symbol (alexandria:symbolicate 'problem- name)))
       `(progn
          (defun ,symbol (&optional (,arg ,sample-input))
            ,@(when docstring (list docstring))
@@ -423,5 +423,5 @@
 (defmacro solve (name)
   (assert (symbolp name) ()
     "Usage: (solve foo)~%foo should not be quoted.")
-  `(solve% ',(symb 'problem- name)))
+  `(solve% ',(alexandria:symbolicate 'problem- name)))
 
--- a/vendor/make-quickutils.lisp	Sat Jan 18 14:04:41 2020 -0500
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,16 +0,0 @@
-(ql:quickload 'quickutil)
-
-(qtlc:save-utils-as
-  "quickutils.lisp"
-  :utilities '(
-
-               :compose
-               :curry
-               :ensure-gethash
-               :once-only
-               :rcurry
-               :symb
-               :with-gensyms
-
-               )
-  :package "ROSALIND.QUICKUTILS")
--- a/vendor/quickutils-package.lisp	Sat Jan 18 14:04:41 2020 -0500
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,12 +0,0 @@
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (unless (find-package "ROSALIND.QUICKUTILS")
-    (defpackage "ROSALIND.QUICKUTILS"
-      (:documentation "Package that contains Quickutil utility functions.")
-      (:use #:cl))))
-
-(in-package "ROSALIND.QUICKUTILS")
-
-;; need to define this here so sbcl will shut the hell up about it being
-;; undefined when compiling quickutils.lisp.  computers are trash.
-(defparameter *utilities* nil)
-
--- a/vendor/quickutils.lisp	Sat Jan 18 14:04:41 2020 -0500
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,216 +0,0 @@
-;;;; This file was automatically generated by Quickutil.
-;;;; See http://quickutil.org for details.
-
-;;;; To regenerate:
-;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :CURRY :ENSURE-GETHASH :ONCE-ONLY :RCURRY :SYMB :WITH-GENSYMS) :ensure-package T :package "ROSALIND.QUICKUTILS")
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (unless (find-package "ROSALIND.QUICKUTILS")
-    (defpackage "ROSALIND.QUICKUTILS"
-      (:documentation "Package that contains Quickutil utility functions.")
-      (:use #:cl))))
-
-(in-package "ROSALIND.QUICKUTILS")
-
-(when (boundp '*utilities*)
-  (setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION
-                                         :COMPOSE :CURRY :ENSURE-GETHASH
-                                         :ONCE-ONLY :RCURRY :MKSTR :SYMB
-                                         :STRING-DESIGNATOR :WITH-GENSYMS))))
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (defun make-gensym-list (length &optional (x "G"))
-    "Returns a list of `length` gensyms, each generated as if with a call to `make-gensym`,
-using the second (optional, defaulting to `\"G\"`) argument."
-    (let ((g (if (typep x '(integer 0)) x (string x))))
-      (loop repeat length
-            collect (gensym g))))
-  )                                        ; eval-when
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  ;;; To propagate return type and allow the compiler to eliminate the IF when
-  ;;; it is known if the argument is function or not.
-  (declaim (inline ensure-function))
-
-  (declaim (ftype (function (t) (values function &optional))
-                  ensure-function))
-  (defun ensure-function (function-designator)
-    "Returns the function designated by `function-designator`:
-if `function-designator` is a function, it is returned, otherwise
-it must be a function name and its `fdefinition` is returned."
-    (if (functionp function-designator)
-        function-designator
-        (fdefinition function-designator)))
-  )                                        ; eval-when
-
-  (defun compose (function &rest more-functions)
-    "Returns a function composed of `function` and `more-functions` that applies its ;
-arguments to to each in turn, starting from the rightmost of `more-functions`,
-and then calling the next one with the primary value of the last."
-    (declare (optimize (speed 3) (safety 1) (debug 1)))
-    (reduce (lambda (f g)
-              (let ((f (ensure-function f))
-                    (g (ensure-function g)))
-                (lambda (&rest arguments)
-                  (declare (dynamic-extent arguments))
-                  (funcall f (apply g arguments)))))
-            more-functions
-            :initial-value function))
-
-  (define-compiler-macro compose (function &rest more-functions)
-    (labels ((compose-1 (funs)
-               (if (cdr funs)
-                   `(funcall ,(car funs) ,(compose-1 (cdr funs)))
-                   `(apply ,(car funs) arguments))))
-      (let* ((args (cons function more-functions))
-             (funs (make-gensym-list (length args) "COMPOSE")))
-        `(let ,(loop for f in funs for arg in args
-                     collect `(,f (ensure-function ,arg)))
-           (declare (optimize (speed 3) (safety 1) (debug 1)))
-           (lambda (&rest arguments)
-             (declare (dynamic-extent arguments))
-             ,(compose-1 funs))))))
-  
-
-  (defun curry (function &rest arguments)
-    "Returns a function that applies `arguments` and the arguments
-it is called with to `function`."
-    (declare (optimize (speed 3) (safety 1) (debug 1)))
-    (let ((fn (ensure-function function)))
-      (lambda (&rest more)
-        (declare (dynamic-extent more))
-        ;; Using M-V-C we don't need to append the arguments.
-        (multiple-value-call fn (values-list arguments) (values-list more)))))
-
-  (define-compiler-macro curry (function &rest arguments)
-    (let ((curries (make-gensym-list (length arguments) "CURRY"))
-          (fun (gensym "FUN")))
-      `(let ((,fun (ensure-function ,function))
-             ,@(mapcar #'list curries arguments))
-         (declare (optimize (speed 3) (safety 1) (debug 1)))
-         (lambda (&rest more)
-           (apply ,fun ,@curries more)))))
-  
-
-  (defmacro ensure-gethash (key hash-table &optional default)
-    "Like `gethash`, but if `key` is not found in the `hash-table` saves the `default`
-under key before returning it. Secondary return value is true if key was
-already in the table."
-    `(multiple-value-bind (value ok) (gethash ,key ,hash-table)
-       (if ok
-           (values value ok)
-           (values (setf (gethash ,key ,hash-table) ,default) nil))))
-  
-
-  (defmacro once-only (specs &body forms)
-    "Evaluates `forms` with symbols specified in `specs` rebound to temporary
-variables, ensuring that each initform is evaluated only once.
-
-Each of `specs` must either be a symbol naming the variable to be rebound, or of
-the form:
-
-    (symbol initform)
-
-Bare symbols in `specs` are equivalent to
-
-    (symbol symbol)
-
-Example:
-
-    (defmacro cons1 (x) (once-only (x) `(cons ,x ,x)))
-      (let ((y 0)) (cons1 (incf y))) => (1 . 1)"
-    (let ((gensyms (make-gensym-list (length specs) "ONCE-ONLY"))
-          (names-and-forms (mapcar (lambda (spec)
-                                     (etypecase spec
-                                       (list
-                                        (destructuring-bind (name form) spec
-                                          (cons name form)))
-                                       (symbol
-                                        (cons spec spec))))
-                                   specs)))
-      ;; bind in user-macro
-      `(let ,(mapcar (lambda (g n) (list g `(gensym ,(string (car n)))))
-              gensyms names-and-forms)
-         ;; bind in final expansion
-         `(let (,,@(mapcar (lambda (g n)
-                             ``(,,g ,,(cdr n)))
-                           gensyms names-and-forms))
-            ;; bind in user-macro
-            ,(let ,(mapcar (lambda (n g) (list (car n) g))
-                    names-and-forms gensyms)
-               ,@forms)))))
-  
-
-  (defun rcurry (function &rest arguments)
-    "Returns a function that applies the arguments it is called
-with and `arguments` to `function`."
-    (declare (optimize (speed 3) (safety 1) (debug 1)))
-    (let ((fn (ensure-function function)))
-      (lambda (&rest more)
-        (declare (dynamic-extent more))
-        (multiple-value-call fn (values-list more) (values-list arguments)))))
-  
-
-  (defun mkstr (&rest args)
-    "Receives any number of objects (string, symbol, keyword, char, number), extracts all printed representations, and concatenates them all into one string.
-
-Extracted from _On Lisp_, chapter 4."
-    (with-output-to-string (s)
-      (dolist (a args) (princ a s))))
-  
-
-  (defun symb (&rest args)
-    "Receives any number of objects, concatenates all into one string with `#'mkstr` and converts them to symbol.
-
-Extracted from _On Lisp_, chapter 4.
-
-See also: `symbolicate`"
-    (values (intern (apply #'mkstr args))))
-  
-
-  (deftype string-designator ()
-    "A string designator type. A string designator is either a string, a symbol,
-or a character."
-    `(or symbol string character))
-  
-
-  (defmacro with-gensyms (names &body forms)
-    "Binds each variable named by a symbol in `names` to a unique symbol around
-`forms`. Each of `names` must either be either a symbol, or of the form:
-
-    (symbol string-designator)
-
-Bare symbols appearing in `names` are equivalent to:
-
-    (symbol symbol)
-
-The string-designator is used as the argument to `gensym` when constructing the
-unique symbol the named variable will be bound to."
-    `(let ,(mapcar (lambda (name)
-                     (multiple-value-bind (symbol string)
-                         (etypecase name
-                           (symbol
-                            (values name (symbol-name name)))
-                           ((cons symbol (cons string-designator null))
-                            (values (first name) (string (second name)))))
-                       `(,symbol (gensym ,string))))
-            names)
-       ,@forms))
-
-  (defmacro with-unique-names (names &body forms)
-    "Binds each variable named by a symbol in `names` to a unique symbol around
-`forms`. Each of `names` must either be either a symbol, or of the form:
-
-    (symbol string-designator)
-
-Bare symbols appearing in `names` are equivalent to:
-
-    (symbol symbol)
-
-The string-designator is used as the argument to `gensym` when constructing the
-unique symbol the named variable will be bound to."
-    `(with-gensyms ,names ,@forms))
-  
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (export '(compose curry ensure-gethash once-only rcurry symb with-gensyms
-            with-unique-names)))
-
-;;;; END OF quickutils.lisp ;;;;