Permalink
Browse files

Expands MODF-EVAL forms more correctly. I think there was a bug befor…

…e but it

is fixed now.  I need to expand the test suite to test for modf-eval cases.

Changed the way modf expands.  Now we try rewrites, then expansions, then
functions/methods.

A big difference is that it no longer checks to see if there is a
function/method defined and the expansions of the definer macros have the side
effect of setting what argument position to check next.  These two changes allow
functions to be recursive.  However, Instead of getting an error stating, "I don't know
how to deal with blah", you get "value NO-NTH-ARG" isn't a real.
  • Loading branch information...
1 parent 7b50507 commit 19ff5500b00701943ee9d20c5808f96b12e57bf0 @smithzvk committed Jun 29, 2011
Showing with 103 additions and 41 deletions.
  1. +103 −41 modf.lisp
View
@@ -24,11 +24,11 @@ has NEW-VAL in the place specified by expr. NTH-ARG marks which argument is
considered the actual data which will be inverted next."
`(eval-when (:compile-toplevel :load-toplevel :execute)
(setf
+ (gethash ',name *modf-nth-arg*)
+ ,nth-arg
(gethash ',name *modf-expansions*)
(lambda (,expr ,val ,new-val)
- ,@body )
- (gethash ',name *modf-nth-arg*)
- ,nth-arg )))
+ ,@body ))))
;; @\section{Rewrite Rules}
@@ -70,30 +70,28 @@ benefit, not the users, as these symbols belong to the MODF package."
(defmacro modf-fn (symbol)
"Expand to the defined Modf function. Basically, \(MODF-FN SYM) is the
functional analog of #'\(SETF SYM)."
- (symbol-function (modf-name symbol)) )
+ `(function ,(intern (modf-name symbol) :modf)) )
;; <<>>=
(defmacro define-modf-function (name nth-arg (new-val &rest args) &body body)
"Define a new modf function. It inverts NAME forms by modifying the NTH-ARG
term of the arguments of the place form in the MODF macro."
- `(progn
- (defun ,(intern (modf-name name) :modf) (,new-val ,@args)
- ,@body )
- (eval-when (:compile-toplevel :load-toplevel :execute)
- (setf (gethash ',name *modf-nth-arg*)
- ,nth-arg ))))
+ (setf (gethash name *modf-nth-arg*)
+ nth-arg )
+ `(defun ,(intern (modf-name name) :modf) (,new-val ,@args)
+ ,@body ))
;; <<>>=
(defmacro define-modf-method (name nth-arg (new-val &rest args) &body body)
"Define a new modf method. It inverts NAME forms by modifying the NTH-ARG
term of the arguments of the place form in the MODF macro. This method can
specialize on any of ARGS."
- `(progn
- (defmethod ,(intern (modf-name name) :modf) (,new-val ,@args)
- ,@body )
- (eval-when (:compile-toplevel :load-toplevel :execute)
- (setf (gethash ',name *modf-nth-arg*)
- ,nth-arg ))))
+ ;; Side effect in a macro, I know. How can you do this via EVAL-WHEN if the
+ ;; rest of the macro-expansion depends on the side effect.
+ (setf (gethash name *modf-nth-arg*)
+ nth-arg )
+ `(defmethod ,(intern (modf-name name) :modf) (,new-val ,@args)
+ ,@body ))
;; @\section{The {\em modf} macro}
@@ -109,10 +107,66 @@ specialize on any of ARGS."
;; order. It recognizes one special form, modf-eval, which instructs it to not
;; try to invert the enclosed form and just evaluate it.
+;; @\subsection{How does modf expansion work?}
+
+;; @In order to expand modf expressions, we need to work from the inside out.
+;; This means the inner most form is the first we need to deal with. For a
+;; moment let's limit ourselves to the simple case of cons cells. When <<modf>>
+;; recieves an expression like (car (cdr x)), it needs to first figure out how
+;; to replace the cdr of x while storing the car of x. Thus the first part of
+;; the modf expansion should look like
+
+;; (let ((tmp x)) ; Grab x to protect against multiple evaluation
+;; ;; The builder code
+;; (cons (car x)
+;; ... )
+
+;; Then, <<modf>> needs to replace ``...'' with the method of replacing the car
+;; of a cons cell. Since we know we will be operating on the cdr of x, we first
+;; grab that value (just like we grabbed x above)
+
+;; (let ((tmp x))
+;; (cons (car x)
+;; (let ((tmp (cdr x)))
+;; ... )))
+
+;; We do this as an optimization, this way we only need to drill down into the
+;; structure one time. We then expand the outer accessor
+
+;; (let ((tmp x))
+;; (cons (car x)
+;; (let ((tmp (cdr x)))
+;; (cons ...
+;; (cdr tmp) ))))
+
+;; Notice that at each level we only have need of one <<tmp>> symbol. The last
+;; question is, what do we fill into the ``...''. That spot will be filled with
+;; the new value.
+
+;; Now, how can we implement this in code? The nature of the problem is
+;; actually a bit backwards from how we normally think about it. We need a
+;; function that will build up the expansion as we talk the code tree, and
+;; passes it to the next level of recursion. The next level then wraps that
+;; expansion. Looking at the procedure above, we see the information such a
+;; function needs to work:
+
+;; \begin{enumerate}
+;; \item The previous level's expansion. In the above example that is:
+
+;; (cons new-val (cdr tmp))
+
+;; \item The data it will be operating on
+
+;; \item
+
+;; \end{enumerate}
+
+;; To be completed later
+
(defun container-arg-n (expr)
(cond ((eql (car expr) 'cl:apply)
- (1+ (gethash (cadadr expr) *modf-nth-arg*)) )
- (t (gethash (car expr) *modf-nth-arg*)) ))
+ (1+ (gethash (cadadr expr) *modf-nth-arg* 'no-nth-arg)) )
+ (t (gethash (car expr) *modf-nth-arg* 'no-nth-arg)) ))
(defun modf-fn-defined? (expr)
(cond ((eql (car expr) 'cl:apply)
@@ -133,22 +187,49 @@ specialize on any of ARGS."
(defun funcall-expression? (expr)
(eql (car expr) 'cl:funcall) )
+(defun expandable? (expr)
+ (cond ((atom expr) nil)
+ ((eql (first expr) 'modf-eval) nil)
+ (t expr) ))
+
;; <<>>=
(defun modf-expand (new-val expr form)
(cond ((atom expr)
new-val )
((eql (car expr) 'modf-eval)
new-val )
+ ;; First, try rewrite rules
((gethash (car expr) *modf-rewrites*)
(modf-expand new-val (funcall (gethash (car expr) *modf-rewrites*) expr)
form ))
- ((modf-fn-defined? expr)
+ ;; Then, see if an expansion is defined
+ ((expansions-defined? expr)
+ (let ((enclosed-obj-sym (gensym)) )
+ (multiple-value-bind (builder)
+ (funcall (gethash (accessor-in expr) *modf-expansions*)
+ expr form new-val )
+ (modf-expand
+ `(let ((,form
+ ,(let ((enclosed-obj (nth (container-arg-n expr)
+ expr )))
+ (let ((it (and (expandable? enclosed-obj)
+ (container-arg-n enclosed-obj) )))
+ (if it
+ (replace-nth it
+ enclosed-obj
+ enclosed-obj-sym )
+ enclosed-obj )))))
+ ,builder )
+ (nth (container-arg-n expr) expr)
+ enclosed-obj-sym ))))
+ ;; Lastly, This must be a modf function or method
+ (t
(let ((enclosed-obj-sym (gensym)) )
(modf-expand
`(let ((,form
,(let ((enclosed-obj (nth (container-arg-n expr)
expr )))
- (let ((it (and (consp enclosed-obj)
+ (let ((it (and (expandable? enclosed-obj)
(container-arg-n enclosed-obj) )))
(if it
(replace-nth it
@@ -170,27 +251,8 @@ specialize on any of ARGS."
(container-arg-n expr)
expr form ))))))
(nth (container-arg-n expr) expr)
- enclosed-obj-sym )))
- ((expansions-defined? expr)
- (let ((enclosed-obj-sym (gensym)) )
- (multiple-value-bind (builder)
- (funcall (gethash (accessor-in expr) *modf-expansions*)
- expr form new-val )
- (modf-expand
- `(let ((,form
- ,(let ((enclosed-obj (nth (container-arg-n expr)
- expr )))
- (let ((it (and (consp enclosed-obj)
- (container-arg-n enclosed-obj) )))
- (if it
- (replace-nth it
- enclosed-obj
- enclosed-obj-sym )
- enclosed-obj )))))
- ,builder )
- (nth (container-arg-n expr) expr)
- enclosed-obj-sym ))))
- (t (error "Don't know how to handle \"~A\"" expr)) ))
+ enclosed-obj-sym )))))
+ ;; (t (error "Don't know how to handle \"~A\"" expr)) ))
;; <<>>=
(defmacro modf (place value &rest more)

0 comments on commit 19ff550

Please sign in to comment.