# HG changeset patch # User Steve Losh # Date 1579481495 18000 # Node ID 2d34585c57044b5b27b049c4c6e3aa5b57b05b39 # Parent 05bc7da3473fa4dfd7fb12b80fc3e5fb43d5da3e Clean up, remove quickutils diff -r 05bc7da3473f -r 2d34585c5704 Makefile --- 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 diff -r 05bc7da3473f -r 2d34585c5704 package.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)) diff -r 05bc7da3473f -r 2d34585c5704 rosalind.asd --- 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"))))) diff -r 05bc7da3473f -r 2d34585c5704 src/package.lisp --- /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)) diff -r 05bc7da3473f -r 2d34585c5704 src/problems/seto.lisp --- 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) diff -r 05bc7da3473f -r 2d34585c5704 src/utils.lisp --- 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))) diff -r 05bc7da3473f -r 2d34585c5704 vendor/make-quickutils.lisp --- 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") diff -r 05bc7da3473f -r 2d34585c5704 vendor/quickutils-package.lisp --- 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) - diff -r 05bc7da3473f -r 2d34585c5704 vendor/quickutils.lisp --- 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 ;;;;