Permalink
Browse files

Added my untracked files. BTW, switched to ASDF format for the package.

  • Loading branch information...
1 parent 3d54caa commit a947e04fdbe4a6d5be73441b5bad66bebe3dcc35 Zach Smith committed May 5, 2008
Showing with 1,595 additions and 0 deletions.
  1. +151 −0 dynamic-programming.lisp
  2. +1,102 −0 infix.lisp
  3. +173 −0 number-theory.lisp
  4. +79 −0 package.lisp
  5. +68 −0 pretty-backtrace.lisp
  6. +22 −0 toolbox.asd
View
@@ -0,0 +1,151 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Dynamic Programming ;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmacro defun-dynammic (name-options args &body body)
+ (list name-options args body) )
+
+(macroexpand-1 '(defun-dynammic manhattan (a b c) hello))
+
+(make-symbol "HELLO")
+
+(with-gensyms ("Hello")
+ 5 )
+
+#|
+;;; This would be a cool tool. We would need to use a code walker to walk the
+;;; _returned_ form in order to find free symbols and gensym them.
+(defmacro defmacro-hyg (name args &body body)
+ (let ((free-symbols (collect-free-symbols args body)))
+ `(defmacro ,name ,args
+ (with-gensyms ,free-symbols))))
+|#
+
+(dbind (name &key val win) '(hello :val 5)
+ (list name val win) )
+
+(destructuring-bind (name &key (test #'eql)) '(hello :test #.#'car)
+ (list name test) )
+
+(defun default-memoization (name)
+ (list name :test #'eql :key #'identity) )
+
+(defmacro defun-dynprog (name-spec arg-list &body body)
+ (with-gensyms (cache "DYN-PROG-")
+ `(let ((,cache (make-hash-table)))
+ (defun ,name-spec ,arg-list
+ (let ((,cache (make-hash-table)))
+ (funcall
+ (alambda ,arg-list
+ (declare (notinline self))
+ (macrolet ((,name-spec ,arg-list
+ '`,(self ,@arg-list) ))
+ ,@body ))
+ ,@arg-list ))))))
+
+(macroexpand-1 '(defun-dynprog fact (n) (cond ((= n 1) 1) (t (* n (fact (1- n)))))))
+
+(defun-dynprog fib (n)
+ (cond ((< n 3) n)
+ (t (+ (fib (1- n)) (* n (fib (- n 2))))) ))
+
+(trace fib)
+
+(fib 2)
+
+(defun dyn-label (name args &rest fbody)
+ (let ((label-spec
+ (if (atom name)
+ (default-memoization name)
+ name ))
+ (name-internal 'internal) )
+ (destructuring-bind (name &key test key) label-spec
+ (values 'cache
+ `(,name ,args
+ (setf cache (make-hash-table :test ,test))
+ (,name-internal ,@args) )
+ `(,name-internal ,args
+ (declare (notinline ,name-internal))
+ (mvb (val win) (gethash (funcall ,key ,args) cache)
+ (if win
+ val
+ (setf (gethash (funcall ,key ,args) cache)
+ (macrolet
+ ((,name ,args
+ (,name-internal ,@args) ))
+ ,@fbody )))))))))
+
+(defmacro dyn-labels (label-specs &body body)
+ (multiple-value-bind (cache-names cache-decl funcs)
+ (mvmapcar (/. (x) (apply #'values (mvl (apply #'dyn-label x)))) label-specs)
+ (print (list cache-names cache-decl funcs))
+ `(let ,cache-decl
+ (labels ,funcs
+ ,@body ))))
+
+(apply #'floor '(3 2))
+
+(mvmapcar (lambda (x) (apply #'dyn-label x))
+ '((hello (a b c) (hello (1- a) (1- b) (1- c)))) )
+
+(mvmapcar #'floor '((3 2) (4 3) (5 4)))
+
+(asdf:oos 'asdf:load-op :cl-ode)
+
+(with-debug
+(macroexpand-1 '(dyn-labels ((hello (a)
+ (cond ((= a 1) 1)
+ (t (* a (hello (1- a)))) )))
+ (hello 5) ))
+)
+
+(describe 'apply)
+
+(defun mvmapcar (fn &rest lists)
+ (cond ((null (car lists)) (apply #'values lists))
+ (t (apply #'values
+ (mapcar #'cons (mvl (apply fn (mapcar #'car lists)))
+ (mvl (apply #'mvmapcar fn (mapcar #'cdr lists))) )))))
+
+(mvmapcar #'values '(1 2 3) '(4 5 6))
+
+(caddr '#1=(1 #1# (2 #1#)))
+
+'#1=(1 . #1#)
+
+(setf *print-circle* t)
+
+(asdf:oos 'asdf:load-op :pal)
+
+#|
+
+defun-dyn:
+
+1. Define a function that creates a function with a cache that saves previous evaluations
+
+2. Calling the function creates a (clean) cache and calls the internal function with the proper arguments
+
+|#
+
+(defun mv-mapcar (fn &rest lists)
+ (
+
+(mapcar (/. (x y) (mvl (floor x y))) '(1 2 3) '(3 2 1))
+
+(macroexpand-1 '(dyn-labels (dyn (a b c) (list a b c)) (dyn 1 2 3)))
+
+
+(let ((cache (make-hash-table)))
+ (defun dyn (mat x y)
+ (labels ((%dyn (&rest args)
+ (asif2 (gethash args cache)
+ it
+ (setf it (apply %dyn args)) )))
+ (%dyn
+ (mvb (val win) (gethash args cache)
+ (
+ (defun %dyn (x y)
+ (
+
+
+
Oops, something went wrong.

0 comments on commit a947e04

Please sign in to comment.