330b4236a18e

Start repo.
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Sat, 09 Apr 2016 16:38:55 +0000
parents
children 8d552510fe9d
branches/tags (none)
files .hgignore Makefile README.markdown euler.asd euler.lisp make-utilities.lisp package.lisp utilities.lisp

Changes

diff -r 000000000000 -r 330b4236a18e .hgignore
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/.hgignore	Sat Apr 09 16:38:55 2016 +0000
@@ -0,0 +1,9 @@
+syntax: glob
+
+.DS_Store
+*.pyc
+*.swp
+*.swo
+*.un~
+.ropeproject
+tags
diff -r 000000000000 -r 330b4236a18e Makefile
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Makefile	Sat Apr 09 16:38:55 2016 +0000
@@ -0,0 +1,4 @@
+.PHONY: 
+
+utilities.lisp: make-utilities.lisp
+	sbcl --noinform --load make-utilities.lisp  --eval '(quit)'
diff -r 000000000000 -r 330b4236a18e README.markdown
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/README.markdown	Sat Apr 09 16:38:55 2016 +0000
@@ -0,0 +1,1 @@
+My solutions to Project Euler problems.
diff -r 000000000000 -r 330b4236a18e euler.asd
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/euler.asd	Sat Apr 09 16:38:55 2016 +0000
@@ -0,0 +1,22 @@
+(asdf:defsystem #:euler
+  :name "euler"
+  :description "Project Euler solutions."
+
+  :author "Steve Losh <steve@stevelosh.com>"
+  :maintainer "Steve Losh <steve@stevelosh.com>"
+
+  :license "MIT/X11"
+  :version "0.0.1"
+
+  :depends-on (#:defstar
+               #:optima
+               #:trivial-types
+               #:cl-arrows
+               #:fare-quasiquote-optima
+               #:fare-quasiquote-readtable)
+
+  :serial t
+  :components ((:file "utilities") ; quickutils package ordering crap
+               (:file "package")
+               (:file "euler")))
+
diff -r 000000000000 -r 330b4236a18e euler.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/euler.lisp	Sat Apr 09 16:38:55 2016 +0000
@@ -0,0 +1,20 @@
+(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)
+                  (dividesp i 5))
+        :sum i))
+
+(defun problem-2 ()
+  (loop :with p = 0
+        :with n = 1
+        :while (<= n 4000000)
+        :when (evenp n) :sum n
+        :do (psetf p n
+                   n (+ p n))))
+
diff -r 000000000000 -r 330b4236a18e make-utilities.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/make-utilities.lisp	Sat Apr 09 16:38:55 2016 +0000
@@ -0,0 +1,10 @@
+(ql:quickload 'quickutil)
+
+(qtlc:save-utils-as
+  "utilities.lisp"
+  :utilities '(:define-constant
+               :switch
+               :ensure-boolean
+               :with-gensyms
+               )
+  :package "EULER.UTILITIES")
diff -r 000000000000 -r 330b4236a18e package.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/package.lisp	Sat Apr 09 16:38:55 2016 +0000
@@ -0,0 +1,2 @@
+(defpackage #:euler
+  (:use #:cl #:euler.utilities))
diff -r 000000000000 -r 330b4236a18e utilities.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/utilities.lisp	Sat Apr 09 16:38:55 2016 +0000
@@ -0,0 +1,159 @@
+;;;; 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 ;;;;