Adding Identities to Peval

Adding Identities to Peval

[Noah Lavine]

[-- Attachment #1: Type: text/plain, Size: 2263 bytes --]

Hello,

I've been working on a patch to add a new sort of optimization to
peval, and I think it's almost ready. It's based on some of the ideas
in "Environment Analysis of Higher-Order Languages".

The goal is to recognize when two quantities are equal even when we
don't know what they are. My working example has been this expression:

(let* ((x (random))
       (y x))
  (eq? x y))

The patch attached to this message lets peval optimize that to

(begin (random) #t)

This happens through objects called 'identities'. We make a new
identity for every constant and the result of every procedure call.
Identities are associated with values, not variables, so x and y above
have the same identity. When it looks at the eq?, peval notices that x
and y have the same identity, and concludes that they must be eq? even
without knowing their value.

The patch adds some members to the <operand> record type to store an
identity for the operand, and an identity-visit function that matches
the visit function used to get values. It also has a few utility
functions and the definition of a new record type <identity> with no
members. The logic added is pretty minimal. I tested it by running
check-guile. It passes about the same number of tests as it did before
I added the patch.

There's one glaring wart. The identity checking is activiated by calls
to (toplevel 'eq?). Clearly, it should be activated by calls to the
primitive 'eq? (and eqv? and equal?). The reason it's not is that my
example above compiles to (call (toplevel-ref 'eq?) ...), and I don't
know how to make it turn into a (primcall 'eq? ...). I tried a few
variants, but they didn't work. What test code should I be using to
produce a primcall?

However, that problem is easy to fix, and besides that I believe the
patch is correct.

This also relates to my earlier ideas for a compiler. After thinking
about it more, I'm not sure I like the direction I took in the
wip-compiler branch, so I decided to start working on peval instead.
This patch has an ulterior motive - besides adding a new optimization
itself, it uses a lot of the infrastructure you'd want for more
aggressive optimization like type-checking. So part of the purpose of
this was to learn how to do that.

What do you think?
Noah

[-- Attachment #2: 0001-Add-Identity-Optimization.patch --]
[-- Type: application/octet-stream, Size: 8547 bytes --]

From 8ef122b4befc1236ee1ff316088d1c109b6b1a07 Mon Sep 17 00:00:00 2001
From: Noah Lavine <noah.b.lavine@gmail.com>
Date: Wed, 15 Feb 2012 20:15:41 -0500
Subject: [PATCH] Add Identity Optimization

* language/tree-il/peval.scm: add 'identities', which allow peval
  to prove that two things are equal without knowing their values.
---
 module/language/tree-il/peval.scm |   89 +++++++++++++++++++++++++++++++-----
 1 files changed, 76 insertions(+), 13 deletions(-)

diff --git a/module/language/tree-il/peval.scm b/module/language/tree-il/peval.scm
index 9aac24c..e2fc16b 100644
--- a/module/language/tree-il/peval.scm
+++ b/module/language/tree-il/peval.scm
@@ -46,14 +46,14 @@
 
 ;; First, some helpers.
 ;;
-(define-syntax *logging* (identifier-syntax #f))
+;; (define-syntax *logging* (identifier-syntax #f))
 
 ;; For efficiency we define *logging* to inline to #f, so that the call
 ;; to log* gets optimized out.  If you want to log, uncomment these
 ;; lines:
 ;;
-;; (define %logging #f)
-;; (define-syntax *logging* (identifier-syntax %logging))
+(define %logging #f)
+(define-syntax *logging* (identifier-syntax %logging))
 ;;
 ;; Then you can change %logging at runtime.
 
@@ -285,7 +285,8 @@
 ;; 
 (define-record-type <operand>
   (%make-operand var sym visit source visit-count residualize?
-                 copyable? residual-value constant-value)
+                 copyable? residual-value constant-value
+                 identity identity-visit identifiable?)
   operand?
   (var operand-var)
   (sym operand-sym)
@@ -295,18 +296,23 @@
   (residualize? operand-residualize? set-operand-residualize?!)
   (copyable? operand-copyable? set-operand-copyable?!)
   (residual-value operand-residual-value %set-operand-residual-value!)
-  (constant-value operand-constant-value set-operand-constant-value!))
+  (constant-value operand-constant-value set-operand-constant-value!)
+  (identity %operand-identity set-operand-identity!)
+  (identity-visit %operand-identity-visit)
+  (identifiable? operand-identifiable? set-operand-identifiable?!))
 
-(define* (make-operand var sym #:optional source visit)
+(define* (make-operand var sym #:optional source visit id-visit)
   ;; Bind SYM to VAR, with value SOURCE.  Bound operands are considered
   ;; copyable until we prove otherwise.  If we have a source expression,
   ;; truncate it to one value.  Copy propagation does not work on
   ;; multiply-valued expressions.
   (let ((source (and=> source truncate-values)))
-    (%make-operand var sym visit source 0 #f (and source #t) #f #f)))
+    (%make-operand var sym visit source 0 #f (and source #t) #f #f
+                   #f id-visit #t)))
 
-(define (make-bound-operands vars syms sources visit)
-  (map (lambda (x y z) (make-operand x y z visit)) vars syms sources))
+(define (make-bound-operands vars syms sources visit id-visit)
+  (map (lambda (x y z) (make-operand x y z visit id-visit))
+       vars syms sources))
 
 (define (make-unbound-operands vars syms)
   (map make-operand vars syms))
@@ -322,6 +328,15 @@
     (else
      val))))
 
+(define (operand-identity op)
+  (and (operand-identifiable? op)
+       (or (operand-constant-value op)
+           (%operand-identity op))))
+
+(define-record-type <identity>
+  (make-identity)
+  identity?)
+
 (define* (visit-operand op counter ctx #:optional effort-limit size-limit)
   ;; Peval is O(N) in call sites of the source program.  However,
   ;; visiting an operand can introduce new call sites.  If we visit an
@@ -348,6 +363,17 @@
          (lambda ()
            (set-operand-visit-count! op (1- (operand-visit-count op)))))))
 
+(define (visit-operand-for-identity op)
+  (and (zero? (operand-visit-count op))
+       (dynamic-wind
+           (lambda ()
+             (set-operand-visit-count! op (1+ (operand-visit-count op))))
+           (lambda ()
+             (and (operand-source op)
+                  ((%operand-identity-visit op) (operand-source op))))
+           (lambda ()
+             (set-operand-visit-count! op (1- (operand-visit-count op)))))))
+
 ;; A helper for constant folding.
 ;;
 (define (types-check? primitive-name args)
@@ -602,6 +628,28 @@ top-level bindings from ENV and return the resulting expression."
          (and (loop tag) (loop body) (loop handler)))
         (_ #f))))
 
+  ;; return an identity for x, or #f if we can't
+  (define (get-identity x env)
+    (match x
+      (($ <const>) x)
+      (($ <lexical-ref> _ _ gensym)
+       (let ((op (cdr (vhash-assq gensym env))))
+         (cond ((not (operand-identifiable? op)) #f)
+               ((var-set? (operand-var op))
+                (set-operand-identifiable?! op #f)
+                #f)
+               ((operand-identity op) => identity)
+               ((visit-operand-for-identity op) =>
+                (lambda (id)
+                  (set-operand-identity! op id)
+                  id))
+               (else (set-operand-identity! op #f)
+                     (set-operand-identifiable?! op #f)
+                     #f))))
+      (($ <call>) (make-identity))
+      (($ <primcall>) (make-identity))
+      (_ #f)))
+
   (define (prune-bindings ops in-order? body counter ctx build-result)
     ;; This helper handles both `let' and `letrec'/`fix'.  In the latter
     ;; cases we need to make sure that if referenced binding A needs
@@ -832,7 +880,9 @@ top-level bindings from ENV and return the resulting expression."
               (new (fresh-gensyms vars))
               (ops (make-bound-operands vars new vals
                                         (lambda (exp counter ctx)
-                                          (loop exp env counter ctx))))
+                                          (loop exp env counter ctx))
+                                        (lambda (exp)
+                                          (get-identity exp env))))
               (env (fold extend-env env gensyms ops))
               (body (loop body env counter ctx)))
          (cond
@@ -861,9 +911,10 @@ top-level bindings from ENV and return the resulting expression."
        ;; an environment that includes the operands.
        (letrec* ((visit (lambda (exp counter ctx)
                           (loop exp env* counter ctx)))
+                 (id-visit (lambda (exp) (get-identity exp env)))
                  (vars (map lookup-var gensyms))
                  (new (fresh-gensyms vars))
-                 (ops (make-bound-operands vars new vals visit))
+                 (ops (make-bound-operands vars new vals visit id-visit))
                  (env* (fold extend-env env gensyms ops))
                  (body* (visit body counter ctx)))
          (if (and (const? body*) (every constant-expression? vals))
@@ -878,9 +929,10 @@ top-level bindings from ENV and return the resulting expression."
       (($ <fix> src names gensyms vals body)
        (letrec* ((visit (lambda (exp counter ctx)
                           (loop exp env* counter ctx)))
+                 (id-visit (lambda (exp) (get-identity exp env)))
                  (vars (map lookup-var gensyms))
                  (new (fresh-gensyms vars))
-                 (ops (make-bound-operands vars new vals visit))
+                 (ops (make-bound-operands vars new vals visit id-visit))
                  (env* (fold extend-env env gensyms ops))
                  (body* (visit body counter ctx)))
          (if (const? body*)
@@ -1109,12 +1161,23 @@ top-level bindings from ENV and return the resulting expression."
       (($ <primcall> src name args)
        (make-primcall src name (map for-value args)))
 
+      (($ <call> src ($ <toplevel-ref> t-src 'eq?) (a b))
+       (log 'visit-eq? (list 'eq? a b))
+       (let ((id-a (get-identity a env))
+             (id-b (get-identity b env)))
+         (log 'id-a id-a 'id-b id-b 'eq? (eq? id-a id-b))
+         (if (and id-a id-b)
+             (make-const #f (eq? id-a id-b))
+             (make-primcall src 'eq? (list a b)))))
+      
       (($ <call> src orig-proc orig-args)
        ;; todo: augment the global env with specialized functions
        (let ((proc (visit orig-proc 'operator)))
          (match proc
            (($ <primitive-ref> _ name)
-            (for-tail (make-primcall src name orig-args)))
+            (let ((rep (make-primcall src name orig-args)))
+              (log 'replacing-call exp rep)
+              (for-tail rep)))
            (($ <lambda> _ _
                ($ <lambda-case> _ req opt #f #f inits gensyms body #f))
             ;; Simple case: no rest, no keyword arguments.
-- 
1.7.6

Re: Adding Identities to Peval

[Mark H Weaver]

Hi Noah,

Noah Lavine <noah.b.lavine@gmail.com> writes:
> I've been working on a patch to add a new sort of optimization to
> peval, and I think it's almost ready. It's based on some of the ideas
> in "Environment Analysis of Higher-Order Languages".

Nice! :)

> There's one glaring wart. The identity checking is activiated by calls
> to (toplevel 'eq?). Clearly, it should be activated by calls to the
> primitive 'eq? (and eqv? and equal?). The reason it's not is that my
> example above compiles to (call (toplevel-ref 'eq?) ...), and I don't
> know how to make it turn into a (primcall 'eq? ...).

The conversion from (toplevel-ref 'eq?) to (primcall 'eq?) is
done by 'resolve-primitives!' in (language tree-il primitives).
'expand-primitives!' is normally also called before 'peval'.
See 'optimize!' in (language tree-il optimize) for details.

I hope to take a deeper look at your patch later, but for now I wanted
to quickly answer your question :)

    Thanks!
      Mark

Re: Adding Identities to Peval

[David Kastrup]

Noah Lavine <noah.b.lavine@gmail.com> writes:

> Hello,
>
> I've been working on a patch to add a new sort of optimization to
> peval, and I think it's almost ready. It's based on some of the ideas
> in "Environment Analysis of Higher-Order Languages".
>
> The goal is to recognize when two quantities are equal even when we
> don't know what they are. My working example has been this expression:
>
> (let* ((x (random))
>        (y x))
>   (eq? x y))
>
> The patch attached to this message lets peval optimize that to
>
> (begin (random) #t)

I have a hard time imagining this optimization to be useful for any code
occuring in practice.  Can you suggest an example that would make more
sense than demonstrating that the optimization works?  Is this supposed
to help with automatically generated code like macros?

-- 
David Kastrup

Re: Adding Identities to Peval

[David Kastrup]

David Kastrup <dak@gnu.org> writes:

> Noah Lavine <noah.b.lavine@gmail.com> writes:
>
>> Hello,
>>
>> I've been working on a patch to add a new sort of optimization to
>> peval, and I think it's almost ready. It's based on some of the ideas
>> in "Environment Analysis of Higher-Order Languages".
>>
>> The goal is to recognize when two quantities are equal even when we
>> don't know what they are. My working example has been this expression:
>>
>> (let* ((x (random))
>>        (y x))
>>   (eq? x y))
>>
>> The patch attached to this message lets peval optimize that to
>>
>> (begin (random) #t)
>
> I have a hard time imagining this optimization to be useful for any code
> occuring in practice.  Can you suggest an example that would make more
> sense than demonstrating that the optimization works?  Is this supposed
> to help with automatically generated code like macros?

Actually, I've been just racking my brain over how to write this better:

            {
	      // We end only one slur unless several ones have been
	      // caused by the same event, like with double slurs.
              if (!ended || scm_is_eq (starter,
				       slurs_[j]->get_property ("cause")))
		{
		  ended = true;
		  starter = slurs_[j]->get_property ("cause");
		  end_slurs_.push_back (slurs_[j]);
		  slurs_.erase (slurs_.begin () + j);
		}
            }

The problem is that if you enter the "if" through the second alternative
condition, you can just jump past the first two assignments (because
they assign values that are already known to be in the respective
variables).  I've not found a good way to handoptimize this short of
using goto or abusing do ... while;

-- 
David Kastrup

Re: Adding Identities to Peval

[David Kastrup]

David Kastrup <dak@gnu.org> writes:

> David Kastrup <dak@gnu.org> writes:
>
>> Noah Lavine <noah.b.lavine@gmail.com> writes:
>>
>>> Hello,
>>>
>>> I've been working on a patch to add a new sort of optimization to
>>> peval, and I think it's almost ready. It's based on some of the ideas
>>> in "Environment Analysis of Higher-Order Languages".
>>>
>>> The goal is to recognize when two quantities are equal even when we
>>> don't know what they are. My working example has been this expression:
>>>
>>> (let* ((x (random))
>>>        (y x))
>>>   (eq? x y))
>>>
>>> The patch attached to this message lets peval optimize that to
>>>
>>> (begin (random) #t)
>>
>> I have a hard time imagining this optimization to be useful for any code
>> occuring in practice.  Can you suggest an example that would make more
>> sense than demonstrating that the optimization works?  Is this supposed
>> to help with automatically generated code like macros?
>
> Actually, I've been just racking my brain over how to write this better:
>
>             {
> 	      // We end only one slur unless several ones have been
> 	      // caused by the same event, like with double slurs.
>               if (!ended || scm_is_eq (starter,
> 				       slurs_[j]->get_property ("cause")))
> 		{
> 		  ended = true;
> 		  starter = slurs_[j]->get_property ("cause");
> 		  end_slurs_.push_back (slurs_[j]);
> 		  slurs_.erase (slurs_.begin () + j);
> 		}
>             }
>
> The problem is that if you enter the "if" through the second alternative
> condition, you can just jump past the first two assignments (because
> they assign values that are already known to be in the respective
> variables).  I've not found a good way to handoptimize this short of
> using goto or abusing do ... while;

So if you want to make this into some sort of feedback: in this
particular case, the equality of some variables is not known because one
has been assigned to another, but because one has arrived from a code
path where the equality has been established by a test.

-- 
David Kastrup

Re: Adding Identities to Peval

[Andy Wingo]

On Thu 16 Feb 2012 02:29, Noah Lavine <noah.b.lavine@gmail.com> writes:

> (let* ((x (random))
>        (y x))
>   (eq? x y))
>
> The patch attached to this message lets peval optimize that to
>
> (begin (random) #t)

Neat :)

Note, we don't need to add extra identities to operands: they already
have their gensyms.  So to get the effect of this patch, you could add a
clause to fold-constants:

  ((primcall src 'eq? (lexical _ _ x) (lexical _ _ y))
   (if (eq? x y)
       (make-const src #t)
       <keep-original-expression>))

This works because peval already turns it into the following, after
processing the operands for value:

  (let ((x (random)))
    (eq? x x))

And all we have to do is check if the lexical is being compared against
itself.

Then, I was about to say:

    Now, while this is a valid reduction:

      (lambda (x) (eq? x x)) => (lambda (x) #t)

    This is not:

      (lambda (x) (eqv? x x)) =/> (lambda (x) #t)

    The reason is +nan.0: (eqv? +nan.0 +nan.0) => #f

But.... that's wrong!  (eqv? +nan.0 +nan.0) isn't specified by the R6RS,
and currently we have it be #t.  I guess that's good for our peval
purposes!

Cheers,

Andy
-- 
http://wingolog.org/

Re: Adding Identities to Peval

[Noah Lavine]

Hello,

> Note, we don't need to add extra identities to operands: they already
> have their gensyms.  So to get the effect of this patch, you could add a
> clause to fold-constants:
>
>  ((primcall src 'eq? (lexical _ _ x) (lexical _ _ y))
>   (if (eq? x y)
>       (make-const src #t)
>       <keep-original-expression>))
>
> This works because peval already turns it into the following, after
> processing the operands for value:
>
>  (let ((x (random)))
>    (eq? x x))

Ah, that is a cleaner way to do it. But ideally I would like
identities to be things that we can store in lists, so that

(let* ((x (random))
       (y (list x))
       (z (car y))
  (eq? x z))

optimizes to (begin (random) #t). That requires more infrastructure,
though - probably some sort of struct representing a value, with parts
for the constant value and the identity, that gets passed around in
peval.

Also, David pointed out that this doesn't have many uses. That is
probably true. :-) I actually did it because it's a simpler version of
type-checking, which *does* have many uses. In order to type-check,
you need to be able to associate extra information with a value (its
type) even in cases where you don't know the value. Identities work
the same way, except that the information is simpler. So my ulterior
motive in doing this is to learn how to do that, and set up whatever
infrastructure I need for it.

Noah

Re: Adding Identities to Peval

[Andy Wingo]

On Thu 16 Feb 2012 14:18, Noah Lavine <noah.b.lavine@gmail.com> writes:

>>  (let ((x (random)))
>>    (eq? x x))
>
> (let* ((x (random))
>        (y (list x))
>        (z (car y))
>   (eq? x z))

This one should reduce to the same thing, but currently doesn't because
(list x) is not considered a "constant expression" because `let' is a
"constructor" (quotes to indicate the language of peval).  If we can
propagate it (probably true in this case, given that it has only one
use), then the expression folds as before:

  (let* ((x (random))
         (z (car (list x))))
    (eq? x z))
  => 
  (let ((x-129 (random))) 
    (eq? x-129 x-129)))

So I don't think that for this purpose (identity) we need any more
mechanism

> In order to type-check, you need to be able to associate extra
> information with a value (its type) even in cases where you don't know
> the value.

For this purpose, have you considered creating a functional database of
facts?  Then you can add facts when you see conditionals, for example,
and you get different facts in the different branches.

  (if test consequent alternate)
  ;; assuming the test doesn't fold
  => (make-if (for-test test current-facts)
              (for-tail consequent (add-fact test #t current-facts))
              (for-tail consequent (add-fact test #f current-facts)))

You can also join the facts accumulated by a conditional branch with the
current facts if you detect that one of the branches leads to a nonlocal
exit, as in

  (define (foo x)
    (if (not (and (struct? x) (eq? (struct-vtable x) <foo>)))
        (error ...))
    ;; here at this point, we have the fact: x is a struct, and its
    ;; vtable is <foo>
    ...)

This is related to range analysis.  But, it's also something that's
easier to do with an explicit notion of control flow (i.e. a CPS IR).

Regards,

Andy
-- 
http://wingolog.org/

Re: Adding Identities to Peval

[Andy Wingo]

On Thu 16 Feb 2012 16:06, Andy Wingo <wingo@pobox.com> writes:

> (list x) is not considered a "constant expression" because `let' is a
> "constructor"

I meant, `list' is a "constructor".

A
-- 
http://wingolog.org/

Re: Adding Identities to Peval

[Noah Lavine]

Hello,

On Thu, Feb 16, 2012 at 10:06 AM, Andy Wingo <wingo@pobox.com> wrote:
> On Thu 16 Feb 2012 14:18, Noah Lavine <noah.b.lavine@gmail.com> writes:
>
>>>  (let ((x (random)))
>>>    (eq? x x))
>>
>> (let* ((x (random))
>>        (y (list x))
>>        (z (car y))
>>   (eq? x z))
>
> This one should reduce to the same thing, but currently doesn't because
> (list x) is not considered a "constant expression" because `let' is a
> "constructor" (quotes to indicate the language of peval).  If we can
> propagate it (probably true in this case, given that it has only one
> use), then the expression folds as before:
>
>  (let* ((x (random))
>         (z (car (list x))))
>    (eq? x z))
>  =>
>  (let ((x-129 (random)))
>    (eq? x-129 x-129)))
>
> So I don't think that for this purpose (identity) we need any more
> mechanism

So you're saying that the gensym that comes from psyntax should
essentially be the identity marker, because there is one gensym for
each value. To make sure I understand, in the x-y-z example, psyntax
would produce different gensyms for x and z, but peval could merge
them later on, right?

In that case, peval would maintain the invariant "if two values must
always be the same, they have the same gensym". Correct?

This seems just a good as what I implemented. I am happy with either way.

>> In order to type-check, you need to be able to associate extra
>> information with a value (its type) even in cases where you don't know
>> the value.
>
> For this purpose, have you considered creating a functional database of
> facts?  Then you can add facts when you see conditionals, for example,
> and you get different facts in the different branches.
>
>  (if test consequent alternate)
>  ;; assuming the test doesn't fold
>  => (make-if (for-test test current-facts)
>              (for-tail consequent (add-fact test #t current-facts))
>              (for-tail consequent (add-fact test #f current-facts)))

This is an interesting idea, and I hadn't really considered it. I had
certainly planned to let the information associated with values change
as the environment changes, which would let it use conditional and
nonlocal-exit information. But a database goes beyond that.

The big difference is that a database could express relationships
between values - if information is associated with a value, where does
the information x < y go? This makes me think that a database is a
long-term solution.

However, if you're not expressing relationships, then I think the
functional database would just amount to keeping an environment
mapping value names to information about them. I hadn't thought this
through when I made my post, but I realize that this is what I would
have to do to let my information-about-values change over time. So
three paragraphs later, I think we agree :-). However, what I'd really
like to do is use an IR that expresses control flow, as you say below.

> This is related to range analysis.  But, it's also something that's
> easier to do with an explicit notion of control flow (i.e. a CPS IR).

Yes, I think you're right. I would be very interested in working on a
CPS IR, but I remember you had a blog post a couple months ago where
you said you weren't sure if CPS or ANF was better for Guile. What do
you think about intermediate representations now?

Noah

Re: Adding Identities to Peval

[Andy Wingo]

Hi Noah,

On Fri 17 Feb 2012 03:22, Noah Lavine <noah.b.lavine@gmail.com> writes:

>>> (let* ((x (random))
>>>        (y (list x))
>>>        (z (car y))
>>>   (eq? x z))
>>
> To make sure I understand, in the x-y-z example, psyntax would produce
> different gensyms for x and z, but peval could merge them later on,
> right?

When processing `z' for value, it should reduce to `x'.  The strategy is
to do computation at compile time -- if at compile time, `z' can reduce
to `x', peval will do it.  But there is no global "give me all the
things that are equal to x" procedure.

> In that case, peval would maintain the invariant "if two values must
> always be the same, they have the same gensym". Correct?

More like the other way around!  If one identifier partially evaluates
to another, then they will have the same gensym, and therefore are the
same identifier.

>> This is related to range analysis.  But, it's also something that's
>> easier to do with an explicit notion of control flow (i.e. a CPS IR).
>
> Yes, I think you're right. I would be very interested in working on a
> CPS IR, but I remember you had a blog post a couple months ago where
> you said you weren't sure if CPS or ANF was better for Guile. What do
> you think about intermediate representations now?

I have no idea :-) I am a little hesitant to move to either one right
now, because our stack machine penalizes named temporaries, and with CPS
(or ANF -- which is closer to what we have, but without the advantage of
treating control flow on a first-class level) you would get a lot more
named temporaries.  But my uncertainty is also because I don't know what
it would make the compiler look like.  Would it simplify things or would
it add complication?  I don't know.

But, writing a pass to turn tree-il into some CPS language would be a
really interesting step in any case.  If you wanted to work on that, I'm
sure it would be instructive to us all.

My humble thoughts :)

Cheers,

Andy
-- 
http://wingolog.org/

Re: Adding Identities to Peval

[Noah Lavine]

[-- Attachment #1: Type: text/plain, Size: 2567 bytes --]

Here is another patch that fixes the first of my examples. (let* ((x
(random)) (y x)) (eq? x y)) now folds to (begin (random) #t). It
turned out to be much smaller than the previous approach. Is it all
right if I push this?

I'm not sure how to make the other one work yet, but I will think about it.

I will send a separate email about the CPS stuff.

Noah

On Fri, Feb 17, 2012 at 3:13 AM, Andy Wingo <wingo@pobox.com> wrote:
> Hi Noah,
>
> On Fri 17 Feb 2012 03:22, Noah Lavine <noah.b.lavine@gmail.com> writes:
>
>>>> (let* ((x (random))
>>>>        (y (list x))
>>>>        (z (car y))
>>>>   (eq? x z))
>>>
>> To make sure I understand, in the x-y-z example, psyntax would produce
>> different gensyms for x and z, but peval could merge them later on,
>> right?
>
> When processing `z' for value, it should reduce to `x'.  The strategy is
> to do computation at compile time -- if at compile time, `z' can reduce
> to `x', peval will do it.  But there is no global "give me all the
> things that are equal to x" procedure.
>
>> In that case, peval would maintain the invariant "if two values must
>> always be the same, they have the same gensym". Correct?
>
> More like the other way around!  If one identifier partially evaluates
> to another, then they will have the same gensym, and therefore are the
> same identifier.
>
>>> This is related to range analysis.  But, it's also something that's
>>> easier to do with an explicit notion of control flow (i.e. a CPS IR).
>>
>> Yes, I think you're right. I would be very interested in working on a
>> CPS IR, but I remember you had a blog post a couple months ago where
>> you said you weren't sure if CPS or ANF was better for Guile. What do
>> you think about intermediate representations now?
>
> I have no idea :-) I am a little hesitant to move to either one right
> now, because our stack machine penalizes named temporaries, and with CPS
> (or ANF -- which is closer to what we have, but without the advantage of
> treating control flow on a first-class level) you would get a lot more
> named temporaries.  But my uncertainty is also because I don't know what
> it would make the compiler look like.  Would it simplify things or would
> it add complication?  I don't know.
>
> But, writing a pass to turn tree-il into some CPS language would be a
> really interesting step in any case.  If you wanted to work on that, I'm
> sure it would be instructive to us all.
>
> My humble thoughts :)
>
> Cheers,
>
> Andy
> --
> http://wingolog.org/

[-- Attachment #2: 0001-Optimize-Equality-Primitives.patch --]
[-- Type: application/octet-stream, Size: 3373 bytes --]

From 07e3c4d6f66be5368fe6d70a2dacea1136b52365 Mon Sep 17 00:00:00 2001
From: Noah Lavine <noah.b.lavine@gmail.com>
Date: Sat, 18 Feb 2012 10:55:49 -0500
Subject: [PATCH] Optimize Equality Primitives

* module/language/tree-il/primitives.scm: add equality-primitive?,
  which is true for eq?, eqv?, and equal?
* module/language/tree-il/peval.scm: if an equality primitive is
  applied to the same variable twice, fold it to #t
---
 module/language/tree-il/peval.scm      |   11 +++++++++++
 module/language/tree-il/primitives.scm |   11 ++++++++++-
 2 files changed, 21 insertions(+), 1 deletions(-)

diff --git a/module/language/tree-il/peval.scm b/module/language/tree-il/peval.scm
index 9aac24c..a588b68 100644
--- a/module/language/tree-il/peval.scm
+++ b/module/language/tree-il/peval.scm
@@ -1103,6 +1103,17 @@ top-level bindings from ENV and return the resulting expression."
          ((name . args)
           (fold-constants src name args ctx))))
 
+      (($ <primcall> src (? equality-primitive? name) (a b))
+       (let ((val-a (for-value a))
+             (val-b (for-value b)))
+         (log 'equality-primitive name val-a val-b)
+         (cond ((and (lexical-ref? val-a) (lexical-ref? val-b)
+                     (eq? (lexical-ref-gensym val-a)
+                          (lexical-ref-gensym val-b)))
+                (for-tail (make-const #f #t)))
+               (else
+                (fold-constants src name (list val-a val-b) ctx)))))
+      
       (($ <primcall> src (? effect-free-primitive? name) args)
        (fold-constants src name (map for-value args) ctx))
 
diff --git a/module/language/tree-il/primitives.scm b/module/language/tree-il/primitives.scm
index f192c4f..157aaa1 100644
--- a/module/language/tree-il/primitives.scm
+++ b/module/language/tree-il/primitives.scm
@@ -29,7 +29,7 @@
             expand-primitives!
             effect-free-primitive? effect+exception-free-primitive?
             constructor-primitive? accessor-primitive?
-            singly-valued-primitive?))
+            singly-valued-primitive? equality-primitive?))
 
 (define *interesting-primitive-names* 
   '(apply @apply
@@ -206,9 +206,13 @@
     bytevector-ieee-double-native-ref bytevector-ieee-double-native-set!
     f32vector-ref f32vector-set! f64vector-ref f64vector-set!))
 
+(define *equality-primitives*
+  '(eq? eqv? equal?))
+
 (define *effect-free-primitive-table* (make-hash-table))
 (define *effect+exceptions-free-primitive-table* (make-hash-table))
 (define *singly-valued-primitive-table* (make-hash-table))
+(define *equality-primitive-table* (make-hash-table))
 
 (for-each (lambda (x)
             (hashq-set! *effect-free-primitive-table* x #t))
@@ -219,6 +223,9 @@
 (for-each (lambda (x) 
             (hashq-set! *singly-valued-primitive-table* x #t))
           *singly-valued-primitives*)
+(for-each (lambda (x)
+            (hashq-set! *equality-primitive-table* x #t))
+          *equality-primitives*)
 
 (define (constructor-primitive? prim)
   (memq prim *primitive-constructors*))
@@ -230,6 +237,8 @@
   (hashq-ref *effect+exceptions-free-primitive-table* prim))
 (define (singly-valued-primitive? prim)
   (hashq-ref *singly-valued-primitive-table* prim))
+(define (equality-primitive? prim)
+  (hashq-ref *equality-primitive-table* prim))
 
 (define (resolve-primitives! x mod)
   (define local-definitions
-- 
1.7.6

Re: Adding Identities to Peval

[Andy Wingo]

On Sat 18 Feb 2012 17:20, Noah Lavine <noah.b.lavine@gmail.com> writes:

> Here is another patch that fixes the first of my examples. (let* ((x
> (random)) (y x)) (eq? x y)) now folds to (begin (random) #t). It
> turned out to be much smaller than the previous approach. Is it all
> right if I push this?

Looks good to me, if you add a test at the same time :-)

Andy
-- 
http://wingolog.org/

Re: Adding Identities to Peval

[Noah Lavine]

Done. I added two tests, for good measure :-).

Noah

On Sun, Feb 19, 2012 at 4:53 AM, Andy Wingo <wingo@pobox.com> wrote:
> On Sat 18 Feb 2012 17:20, Noah Lavine <noah.b.lavine@gmail.com> writes:
>
>> Here is another patch that fixes the first of my examples. (let* ((x
>> (random)) (y x)) (eq? x y)) now folds to (begin (random) #t). It
>> turned out to be much smaller than the previous approach. Is it all
>> right if I push this?
>
> Looks good to me, if you add a test at the same time :-)
>
> Andy
> --
> http://wingolog.org/