3
$Id: ystep.scm,v 1.3 1999/01/02 06:19:10 cph Exp $
5
Copyright (c) 1994, 1999 Massachusetts Institute of Technology
7
This program is free software; you can redistribute it and/or modify
3
$Id: ystep.scm,v 1.7 2003/03/13 03:11:12 cph Exp $
5
Copyright 1994,1997,2003 Massachusetts Institute of Technology
7
This file is part of MIT/GNU Scheme.
9
MIT/GNU Scheme is free software; you can redistribute it and/or modify
8
10
it under the terms of the GNU General Public License as published by
9
11
the Free Software Foundation; either version 2 of the License, or (at
10
12
your option) any later version.
12
This program is distributed in the hope that it will be useful, but
14
MIT/GNU Scheme is distributed in the hope that it will be useful, but
13
15
WITHOUT ANY WARRANTY; without even the implied warranty of
14
16
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15
17
General Public License for more details.
17
19
You should have received a copy of the GNU General Public License
18
along with this program; if not, write to the Free Software
19
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
20
along with MIT/GNU Scheme; if not, write to the Free Software
21
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
22
26
;;;; YStep - a step away from ZStep
285
289
;;;; Stepper nodes
287
(define-structure (ynode (constructor make-ynode-1 (parent type exp)))
291
(define-structure (ynode
292
(constructor make-ynode-1
293
(parent type exp redisplay-flags)))
288
294
;; Could easily store environment as well.
291
297
(exp #f read-only #t)
294
(redisplay-flags (cons #t (if parent (ynode-redisplay-flags parent) '()))
300
(redisplay-flags #f read-only #t))
297
302
(define ynode-exp:top-level (list 'STEPPER-TOP-LEVEL))
298
303
(define ynode-exp:proceed (list 'STEPPER-PROCEED))
318
323
(eq? (ynode-result node) ynode-result:reduced))
320
325
(define (make-ynode parent type exp)
321
(let ((node (make-ynode-1 parent type exp)))
327
(make-ynode-1 parent type exp
329
(if parent (ynode-redisplay-flags parent) '())))))
322
330
(set-ynode-result! node ynode-result:waiting)
324
332
(set-ynode-children! parent (cons node (ynode-children parent))))
328
336
(define (ynode-previous node)
329
337
(let loop ((sibs (ynode-children (ynode-parent node))))
332
((eq? (car sibs) node)
333
(and (not (null? (cdr sibs)))
336
(loop (cdr sibs))))))
339
(if (eq? (car sibs) node)
340
(and (pair? (cdr sibs))
342
(loop (cdr sibs))))))
338
344
(define (ynode-next node)
339
345
(let loop ((sibs (ynode-children (ynode-parent node))))
340
(cond ((or (null? sibs) (null? (cdr sibs)))
342
((eq? (cadr sibs) node)
345
(loop (cdr sibs))))))
348
(if (eq? (cadr sibs) node)
350
(loop (cdr sibs))))))
347
352
(define (ynode-value-node node)
348
353
(if (ynode-reduced? node)
366
371
(set-ynode-children! new-node children)
367
372
(for-each (lambda (c) (set-ynode-parent! c new-node)) children)
368
373
(let loop ((node new-node))
369
(ynode-needs-redisplay! ynode)
374
(ynode-needs-redisplay! node)
370
375
(for-each loop (ynode-children node)))
added
removed
src/runtime/ystep.scm
