From: Matt Birkholz <matt@birkholz.chandler.az.us>
Date: Tue, 4 Feb 2014 21:03:45 +0000 (-0700)
Subject: Fluidize (runtime advice) internal advice-continuation,...
X-Git-Tag: mit-scheme-pucked-9.2.12~401^2~19
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=3243034635f31358108a3b3fc74e214e1fbf2624;p=mit-scheme.git

Fluidize (runtime advice) internal advice-continuation,...

...the-arguments, the-procedure and the-result.
---

diff --git a/src/runtime/advice.scm b/src/runtime/advice.scm
index 03aa1d4da..80051137c 100644
--- a/src/runtime/advice.scm
+++ b/src/runtime/advice.scm
@@ -35,20 +35,23 @@ USA.
 (define (initialize-package!)
   (set! entry-advice-population (make-population))
   (set! exit-advice-population (make-population))
-  unspecific)
+  (set! advice-continuation (make-fluid #f))
+  (set! the-arguments (make-fluid #f))
+  (set! the-procedure (make-fluid #f))
+  (set! the-result (make-fluid #f)))
 
 (define the-arguments)
 (define the-procedure)
 (define the-result)
 
 (define (*args*)
-  (list-copy the-arguments))
+  (list-copy (fluid the-arguments)))
 
 (define (*proc*)
-  the-procedure)
+  (fluid the-procedure))
 
 (define (*result*)
-  the-result)
+  (fluid the-result))
 
 (define (get-advice procedure)
   (lambda-advice (procedure-lambda procedure)))
@@ -80,32 +83,33 @@ USA.
       (lambda (original-body state)
 	(call-with-current-continuation
 	 (lambda (continuation)
-	   (fluid-let ((advice-continuation continuation))
-	     (with-restart 'USE-VALUE
-		 "Return a value from the advised procedure."
-		 continuation
+	   (let-fluid advice-continuation continuation
+	     (lambda ()
+	       (with-restart 'USE-VALUE
+		   "Return a value from the advised procedure."
+		   continuation
+		   (lambda ()
+		     (prompt-for-evaluated-expression "Procedure value"))
 		 (lambda ()
-		   (prompt-for-evaluated-expression "Procedure value"))
-	       (lambda ()
-		 (for-each (lambda (advice)
-			     (with-simple-restart 'CONTINUE
-				 "Continue with advised procedure."
-			       (lambda ()
-				 (advice procedure arguments environment))))
-			   (car state))
-		 (let ((value (scode-eval original-body environment)))
 		   (for-each (lambda (advice)
 			       (with-simple-restart 'CONTINUE
-				   "Return from advised procedure."
+				   "Continue with advised procedure."
 				 (lambda ()
-				   (advice procedure
-					   arguments
-					   value
-					   environment))))
-			     (cdr state))
-		   value))))))))))
-
-(define advice-continuation #f)
+				   (advice procedure arguments environment))))
+			     (car state))
+		   (let ((value (scode-eval original-body environment)))
+		     (for-each (lambda (advice)
+				 (with-simple-restart 'CONTINUE
+				     "Return from advised procedure."
+				   (lambda ()
+				     (advice procedure
+					     arguments
+					     value
+					     environment))))
+			       (cdr state))
+		     value)))))))))))
+
+(define advice-continuation)
 
 ;;;; Advisers
 
@@ -311,15 +315,17 @@ USA.
 ;;;; Break
 
 (define (break-entry-advice procedure arguments environment)
-  (fluid-let ((the-procedure procedure)
-	      (the-arguments arguments))
-    (break-rep environment "Breakpoint on entry" procedure arguments)))
+  (let-fluids the-procedure procedure
+	      the-arguments arguments
+    (lambda ()
+      (break-rep environment "Breakpoint on entry" procedure arguments))))
 
 (define (break-exit-advice procedure arguments result environment)
-  (fluid-let ((the-procedure procedure)
-	      (the-arguments arguments)
-	      (the-result result))
-    (break-rep environment "Breakpoint on exit" procedure arguments result))
+  (let-fluids the-procedure procedure
+	      the-arguments arguments
+	      the-result result
+    (lambda ()
+      (break-rep environment "Breakpoint on exit" procedure arguments result)))
   result)
 
 (define (break-rep environment message . info)
@@ -328,7 +334,7 @@ USA.
 				      (apply trace-display port info)))
 				   message)
 	      environment
-	      advice-continuation))
+	      (fluid advice-continuation)))
 
 (define (break-entry procedure)
   (advise-entry procedure break-entry-advice))