From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 13 Oct 1994 04:02:54 +0000 (+0000)
Subject: Add new procedures YNODE-EXP-SPECIAL and YNODE-RESULT-SPECIAL to
X-Git-Tag: 20090517-FFI~7067
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=860b17fe757332ddf13fc0968cab1f0ecf7dddf1;p=mit-scheme.git

Add new procedures YNODE-EXP-SPECIAL and YNODE-RESULT-SPECIAL to
identify special markers within the ynode structure.
---

diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg
index efe7e337b..ee0d8b7aa 100644
--- a/v7/src/edwin/edwin.pkg
+++ b/v7/src/edwin/edwin.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: edwin.pkg,v 1.152 1994/10/12 00:30:50 cph Exp $
+$Id: edwin.pkg,v 1.153 1994/10/13 04:02:54 cph Exp $
 
 Copyright (c) 1989-1994 Massachusetts Institute of Technology
 
@@ -1347,10 +1347,12 @@ MIT in each case. |#
 	  ynode-contract!
 	  ynode-doesnt-need-redisplay!
 	  ynode-exp
+	  ynode-exp-special
 	  ynode-expand!
 	  ynode-hidden-children?
 	  ynode-needs-redisplay?
 	  ynode-result
+	  ynode-result-special
 	  ynode-type
 	  ynode-value-node)
   (initialization (initialize-package!)))
\ No newline at end of file
diff --git a/v7/src/runtime/ystep.scm b/v7/src/runtime/ystep.scm
index 3f80067fd..88b95362b 100644
--- a/v7/src/runtime/ystep.scm
+++ b/v7/src/runtime/ystep.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: ystep.scm,v 1.1 1994/10/12 07:54:00 cph Exp $
+$Id: ystep.scm,v 1.2 1994/10/13 04:02:08 cph Exp $
 
 Copyright (c) 1994 Massachusetts Institute of Technology
 
@@ -310,9 +310,22 @@ MIT in each case. |#
 (define ynode-exp:top-level (list 'STEPPER-TOP-LEVEL))
 (define ynode-exp:proceed   (list 'STEPPER-PROCEED))
 
-(define ynode-result:waiting (list '<WAITING>))
-(define ynode-result:reduced (list '<REDUCED>))
-(define ynode-result:unknown (list '<UNKNOWN>))
+(define (ynode-exp-special node)
+  (let ((exp (ynode-exp node)))
+    (and (or (eq? ynode-exp:top-level exp)
+	     (eq? ynode-exp:proceed exp))
+	 (car exp))))
+
+(define ynode-result:waiting (list 'WAITING))
+(define ynode-result:reduced (list 'REDUCED))
+(define ynode-result:unknown (list 'UNKNOWN))
+
+(define (ynode-result-special node)
+  (let ((result (ynode-result node)))
+    (and (or (eq? ynode-result:waiting result)
+	     (eq? ynode-result:reduced result)
+	     (eq? ynode-result:unknown result))
+	 (car result))))
 
 (define (ynode-reduced? node)
   (eq? (ynode-result node) ynode-result:reduced))
@@ -358,7 +371,7 @@ MIT in each case. |#
 	     (and previous
 		  (ynode-reduced? previous)
 		  (ynode-reduces-to? previous reduces-to))))))
-
+
 (define (ynode-splice-under node)
   (let ((children (ynode-children node)))
     (set-ynode-children! node '())
@@ -369,7 +382,7 @@ MIT in each case. |#
 	(ynode-needs-redisplay! ynode)
 	(for-each loop (ynode-children node)))
       new-node)))
-
+
 (define (ynode-reductions node)
   (if (ynode-reduced? node)
       (let ((next (ynode-next node)))