From ae136274ed491b5210e1fe47f7efb0bacb9584b1 Mon Sep 17 00:00:00 2001
From: Abdulaziz Ghuloum <aghuloum@cs.indiana.edu>
Date: Thu, 21 May 2009 18:43:28 +0300
Subject: [PATCH] - the source-level optimizer now optimizes (inlining,  
 constant-folding, etc.) across debug-calls.

---
 scheme/ikarus.compiler.source-optimizer.ss | 29 +++++++++++++++++++++-
 scheme/last-revision                       |  2 +-
 2 files changed, 29 insertions(+), 2 deletions(-)

diff --git a/scheme/ikarus.compiler.source-optimizer.ss b/scheme/ikarus.compiler.source-optimizer.ss
index 28ade5f..351625a 100644
--- a/scheme/ikarus.compiler.source-optimizer.ss
+++ b/scheme/ikarus.compiler.source-optimizer.ss
@@ -510,6 +510,30 @@
                 (map (lambda (x) (score-value-visit-operand! x sc))
                      rand*)))))))
   ;;;
+  (define (E-debug-call ctxt ec sc)
+    (let ([rand* (app-rand* ctxt)])
+      (cond
+        [(< (length rand*) 2)
+         (decrement sc 1)
+         (make-primref 'debug-call)]
+        [else
+         (let ([src/expr (car rand*)]
+               [rator (cadr rand*)]
+               [rands (cddr rand*)])
+           (let ([ctxt2 (make-app rands (app-ctxt ctxt))])
+             (let ([rator (E (operand-expr rator) 
+                             ctxt2 
+                             (operand-env rator)
+                             (operand-ec rator) 
+                             sc)])
+               (if (app-inlined ctxt2)
+                   (begin
+                     (set-app-inlined! ctxt #t)
+                     (residualize-operands rator (cons src/expr rands) sc))
+                   (begin
+                     (decrement sc 1)
+                     (make-primref 'debug-call))))))])))
+  ;;;
   (define (E-var x ctxt env ec sc)
     (ctxt-case ctxt
       [(e) (make-constant (void))]
@@ -768,7 +792,10 @@
        (make-forcall name (map (lambda (x) (E x 'v env ec sc)) rand*))]
       [(primref name)
        (ctxt-case ctxt
-         [(app) (fold-prim name ctxt ec sc)]
+         [(app) 
+          (case name
+            [(debug-call) (E-debug-call ctxt ec sc)]
+            [else (fold-prim name ctxt ec sc)])]
          [(v) (decrement sc 1) x]
          [else (make-constant #t)])]
       [(clambda g cases cp free name) 
diff --git a/scheme/last-revision b/scheme/last-revision
index 9bbb474..32ed469 100644
--- a/scheme/last-revision
+++ b/scheme/last-revision
@@ -1 +1 @@
-1785
+1786