# HG changeset patch # User Steve Losh # Date 1460222173 0 # Node ID 8d552510fe9d68ff6b2e5fc62301c17ec4b7683c # Parent 330b4236a18e7eca3ad214885e3165efe761f648 Problem 3, and fix up utils. diff -r 330b4236a18e -r 8d552510fe9d Makefile --- a/Makefile Sat Apr 09 16:38:55 2016 +0000 +++ b/Makefile Sat Apr 09 17:16:13 2016 +0000 @@ -1,4 +1,4 @@ .PHONY: -utilities.lisp: make-utilities.lisp +quickutils.lisp: make-utilities.lisp sbcl --noinform --load make-utilities.lisp --eval '(quit)' diff -r 330b4236a18e -r 8d552510fe9d euler.asd --- a/euler.asd Sat Apr 09 16:38:55 2016 +0000 +++ b/euler.asd Sat Apr 09 17:16:13 2016 +0000 @@ -16,7 +16,9 @@ #:fare-quasiquote-readtable) :serial t - :components ((:file "utilities") ; quickutils package ordering crap + :components ((:file "quickutils") ; quickutils package ordering crap (:file "package") + (:file "utils") + (:file "primes") (:file "euler"))) diff -r 330b4236a18e -r 8d552510fe9d euler.lisp --- a/euler.lisp Sat Apr 09 16:38:55 2016 +0000 +++ b/euler.lisp Sat Apr 09 17:16:13 2016 +0000 @@ -1,9 +1,5 @@ (in-package #:euler) -(defun dividesp (n divisor) - "Return whether `n` is evenly divisible by `divisor`." - (zerop (mod n divisor))) - (defun problem-1 () (loop :for i :from 1 :below 1000 :when (or (dividesp i 3) @@ -18,3 +14,5 @@ :do (psetf p n n (+ p n)))) +(defun problem-3 () + (apply #'max (prime-factorization 600851475143))) diff -r 330b4236a18e -r 8d552510fe9d make-utilities.lisp --- a/make-utilities.lisp Sat Apr 09 16:38:55 2016 +0000 +++ b/make-utilities.lisp Sat Apr 09 17:16:13 2016 +0000 @@ -1,10 +1,11 @@ (ql:quickload 'quickutil) (qtlc:save-utils-as - "utilities.lisp" + "quickutils.lisp" :utilities '(:define-constant :switch + :while :ensure-boolean :with-gensyms ) - :package "EULER.UTILITIES") + :package "EULER.QUICKUTILS") diff -r 330b4236a18e -r 8d552510fe9d package.lisp --- a/package.lisp Sat Apr 09 16:38:55 2016 +0000 +++ b/package.lisp Sat Apr 09 17:16:13 2016 +0000 @@ -1,2 +1,7 @@ +(defpackage #:euler.utils + (:use #:cl #:euler.quickutils) + (:export + #:dividesp)) + (defpackage #:euler - (:use #:cl #:euler.utilities)) + (:use #:cl #:euler.quickutils #:euler.utils)) diff -r 330b4236a18e -r 8d552510fe9d primes.lisp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/primes.lisp Sat Apr 09 17:16:13 2016 +0000 @@ -0,0 +1,19 @@ +(in-package #:euler) + +(defun prime-factorization (n) + "Return the prime factors of `n`." + ;; from http://www.geeksforgeeks.org/print-all-prime-factors-of-a-given-number/ + (let ((result (list))) + (while (evenp n) ; handle 2, the only even prime factor + (push 2 result) + (setf n (/ n 2))) + (loop :for i :from 3 :to (sqrt n) :by 2 ; handle odd (prime) divisors + :do (while (dividesp n i) + (push i result) + (setf n (/ n i)))) + (when (> n 2) ; final check in case we ended up with a prime + (push n result)) + (nreverse result))) + + + diff -r 330b4236a18e -r 8d552510fe9d quickutils.lisp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/quickutils.lisp Sat Apr 09 17:16:13 2016 +0000 @@ -0,0 +1,172 @@ +;;;; This file was automatically generated by Quickutil. +;;;; See http://quickutil.org for details. + +;;;; To regenerate: +;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:DEFINE-CONSTANT :SWITCH :WHILE :ENSURE-BOOLEAN :WITH-GENSYMS) :ensure-package T :package "EULER.QUICKUTILS") + +(eval-when (:compile-toplevel :load-toplevel :execute) + (unless (find-package "EULER.QUICKUTILS") + (defpackage "EULER.QUICKUTILS" + (:documentation "Package that contains Quickutil utility functions.") + (:use #:cl)))) + +(in-package "EULER.QUICKUTILS") + +(when (boundp '*utilities*) + (setf *utilities* (union *utilities* '(:DEFINE-CONSTANT :STRING-DESIGNATOR + :WITH-GENSYMS :EXTRACT-FUNCTION-NAME + :SWITCH :UNTIL :WHILE :ENSURE-BOOLEAN)))) + + (defun %reevaluate-constant (name value test) + (if (not (boundp name)) + value + (let ((old (symbol-value name)) + (new value)) + (if (not (constantp name)) + (prog1 new + (cerror "Try to redefine the variable as a constant." + "~@<~S is an already bound non-constant variable ~ + whose value is ~S.~:@>" name old)) + (if (funcall test old new) + old + (restart-case + (error "~@<~S is an already defined constant whose value ~ + ~S is not equal to the provided initial value ~S ~ + under ~S.~:@>" name old new test) + (ignore () + :report "Retain the current value." + old) + (continue () + :report "Try to redefine the constant." + new))))))) + + (defmacro define-constant (name initial-value &key (test ''eql) documentation) + "Ensures that the global variable named by `name` is a constant with a value +that is equal under `test` to the result of evaluating `initial-value`. `test` is a +function designator that defaults to `eql`. If `documentation` is given, it +becomes the documentation string of the constant. + +Signals an error if `name` is already a bound non-constant variable. + +Signals an error if `name` is already a constant variable whose value is not +equal under `test` to result of evaluating `initial-value`." + `(defconstant ,name (%reevaluate-constant ',name ,initial-value ,test) + ,@(when documentation `(,documentation)))) + + + (deftype string-designator () + "A string designator type. A string designator is either a string, a symbol, +or a character." + `(or symbol string character)) + +(eval-when (:compile-toplevel :load-toplevel :execute) + (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 +(eval-when (:compile-toplevel :load-toplevel :execute) + (defun extract-function-name (spec) + "Useful for macros that want to mimic the functional interface for functions +like `#'eq` and `'eq`." + (if (and (consp spec) + (member (first spec) '(quote function))) + (second spec) + spec)) + ) ; eval-when + + (eval-when (:compile-toplevel :load-toplevel :execute) + (defun generate-switch-body (whole object clauses test key &optional default) + (with-gensyms (value) + (setf test (extract-function-name test)) + (setf key (extract-function-name key)) + (when (and (consp default) + (member (first default) '(error cerror))) + (setf default `(,@default "No keys match in SWITCH. Testing against ~S with ~S." + ,value ',test))) + `(let ((,value (,key ,object))) + (cond ,@(mapcar (lambda (clause) + (if (member (first clause) '(t otherwise)) + (progn + (when default + (error "Multiple default clauses or illegal use of a default clause in ~S." + whole)) + (setf default `(progn ,@(rest clause))) + '(())) + (destructuring-bind (key-form &body forms) clause + `((,test ,value ,key-form) + ,@forms)))) + clauses) + (t ,default)))))) + + (defmacro switch (&whole whole (object &key (test 'eql) (key 'identity)) + &body clauses) + "Evaluates first matching clause, returning its values, or evaluates and +returns the values of `default` if no keys match." + (generate-switch-body whole object clauses test key)) + + (defmacro eswitch (&whole whole (object &key (test 'eql) (key 'identity)) + &body clauses) + "Like `switch`, but signals an error if no key matches." + (generate-switch-body whole object clauses test key '(error))) + + (defmacro cswitch (&whole whole (object &key (test 'eql) (key 'identity)) + &body clauses) + "Like `switch`, but signals a continuable error if no key matches." + (generate-switch-body whole object clauses test key '(cerror "Return NIL from CSWITCH."))) + + + (defmacro until (expression &body body) + "Executes `body` until `expression` is true." + `(do () + (,expression) + ,@body)) + + + (defmacro while (expression &body body) + "Executes `body` while `expression` is true." + `(until (not ,expression) + ,@body)) + + + (defun ensure-boolean (x) + "Convert `x` into a Boolean value." + (and x t)) + +(eval-when (:compile-toplevel :load-toplevel :execute) + (export '(define-constant switch eswitch cswitch while ensure-boolean + with-gensyms with-unique-names))) + +;;;; END OF quickutils.lisp ;;;; diff -r 330b4236a18e -r 8d552510fe9d utilities.lisp --- a/utilities.lisp Sat Apr 09 16:38:55 2016 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,159 +0,0 @@ -;;;; This file was automatically generated by Quickutil. -;;;; See http://quickutil.org for details. - -;;;; To regenerate: -;;;; (qtlc:save-utils-as "utilities.lisp" :utilities '(:DEFINE-CONSTANT :SWITCH :ENSURE-BOOLEAN :WITH-GENSYMS) :ensure-package T :package "EULER.UTILITIES") - -(eval-when (:compile-toplevel :load-toplevel :execute) - (unless (find-package "EULER.UTILITIES") - (defpackage "EULER.UTILITIES" - (:documentation "Package that contains Quickutil utility functions.") - (:use #:cl)))) - -(in-package "EULER.UTILITIES") - -(when (boundp '*utilities*) - (setf *utilities* (union *utilities* '(:DEFINE-CONSTANT :STRING-DESIGNATOR - :WITH-GENSYMS :EXTRACT-FUNCTION-NAME - :SWITCH :ENSURE-BOOLEAN)))) - - (defun %reevaluate-constant (name value test) - (if (not (boundp name)) - value - (let ((old (symbol-value name)) - (new value)) - (if (not (constantp name)) - (prog1 new - (cerror "Try to redefine the variable as a constant." - "~@<~S is an already bound non-constant variable ~ - whose value is ~S.~:@>" name old)) - (if (funcall test old new) - old - (restart-case - (error "~@<~S is an already defined constant whose value ~ - ~S is not equal to the provided initial value ~S ~ - under ~S.~:@>" name old new test) - (ignore () - :report "Retain the current value." - old) - (continue () - :report "Try to redefine the constant." - new))))))) - - (defmacro define-constant (name initial-value &key (test ''eql) documentation) - "Ensures that the global variable named by `name` is a constant with a value -that is equal under `test` to the result of evaluating `initial-value`. `test` is a -function designator that defaults to `eql`. If `documentation` is given, it -becomes the documentation string of the constant. - -Signals an error if `name` is already a bound non-constant variable. - -Signals an error if `name` is already a constant variable whose value is not -equal under `test` to result of evaluating `initial-value`." - `(defconstant ,name (%reevaluate-constant ',name ,initial-value ,test) - ,@(when documentation `(,documentation)))) - - - (deftype string-designator () - "A string designator type. A string designator is either a string, a symbol, -or a character." - `(or symbol string character)) - -(eval-when (:compile-toplevel :load-toplevel :execute) - (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 -(eval-when (:compile-toplevel :load-toplevel :execute) - (defun extract-function-name (spec) - "Useful for macros that want to mimic the functional interface for functions -like `#'eq` and `'eq`." - (if (and (consp spec) - (member (first spec) '(quote function))) - (second spec) - spec)) - ) ; eval-when - - (eval-when (:compile-toplevel :load-toplevel :execute) - (defun generate-switch-body (whole object clauses test key &optional default) - (with-gensyms (value) - (setf test (extract-function-name test)) - (setf key (extract-function-name key)) - (when (and (consp default) - (member (first default) '(error cerror))) - (setf default `(,@default "No keys match in SWITCH. Testing against ~S with ~S." - ,value ',test))) - `(let ((,value (,key ,object))) - (cond ,@(mapcar (lambda (clause) - (if (member (first clause) '(t otherwise)) - (progn - (when default - (error "Multiple default clauses or illegal use of a default clause in ~S." - whole)) - (setf default `(progn ,@(rest clause))) - '(())) - (destructuring-bind (key-form &body forms) clause - `((,test ,value ,key-form) - ,@forms)))) - clauses) - (t ,default)))))) - - (defmacro switch (&whole whole (object &key (test 'eql) (key 'identity)) - &body clauses) - "Evaluates first matching clause, returning its values, or evaluates and -returns the values of `default` if no keys match." - (generate-switch-body whole object clauses test key)) - - (defmacro eswitch (&whole whole (object &key (test 'eql) (key 'identity)) - &body clauses) - "Like `switch`, but signals an error if no key matches." - (generate-switch-body whole object clauses test key '(error))) - - (defmacro cswitch (&whole whole (object &key (test 'eql) (key 'identity)) - &body clauses) - "Like `switch`, but signals a continuable error if no key matches." - (generate-switch-body whole object clauses test key '(cerror "Return NIL from CSWITCH."))) - - - (defun ensure-boolean (x) - "Convert `x` into a Boolean value." - (and x t)) - -(eval-when (:compile-toplevel :load-toplevel :execute) - (export '(define-constant switch eswitch cswitch ensure-boolean with-gensyms - with-unique-names))) - -;;;; END OF utilities.lisp ;;;; diff -r 330b4236a18e -r 8d552510fe9d utils.lisp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/utils.lisp Sat Apr 09 17:16:13 2016 +0000 @@ -0,0 +1,6 @@ +(in-package #:euler.utils) + +(defun dividesp (n divisor) + "Return whether `n` is evenly divisible by `divisor`." + (zerop (mod n divisor))) +