From 0c1a2f1f7d230104b6a1d011bf70c65e82ca119f Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Tue, 18 Apr 2023 08:55:18 -0400
Subject: repl: Use pushdown state.

---
 catbird/repl.scm | 19 ++++++++++---------
 1 file changed, 10 insertions(+), 9 deletions(-)

diff --git a/catbird/repl.scm b/catbird/repl.scm
index c30a51f..5619c9a 100644
--- a/catbird/repl.scm
+++ b/catbird/repl.scm
@@ -25,6 +25,7 @@
   #:use-module (catbird mode)
   #:use-module (catbird node)
   #:use-module (catbird node-2d)
+  #:use-module (catbird pushdown)
   #:use-module (catbird region)
   #:use-module (catbird ring-buffer)
   #:use-module (catbird scene)
@@ -129,8 +130,10 @@
   (debug #:accessor debug #:init-keyword #:debug #:init-value #f))
 
 (define-class <repl> (<node-2d>)
-  (level #:accessor level #:init-form (make <repl-level>))
-  (level-stack #:accessor level-stack #:init-value '()))
+  (level-state #:getter level-state #:init-thunk make-pushdown-state))
+
+(define-method (level (repl <repl>))
+  (state-current (level-state repl)))
 
 (define-method (language (repl <repl>))
   (language (level repl)))
@@ -146,6 +149,7 @@
 
 (define-method (initialize (repl <repl>) initargs)
   (next-method)
+  (state-push! (level-state repl) (make <repl-level>))
   (attach-to repl
              (make <canvas>
                #:name 'background)
@@ -159,15 +163,12 @@
   (refresh-prompt repl))
 
 (define-method (push-repl-level (repl <repl>) (new-level <repl-level>))
-  (set! (level-stack repl) (cons (level repl) (level-stack repl)))
-  (set! (level repl) new-level))
+  (state-push! (level-state repl) new-level))
 
 (define-method (pop-repl-level (repl <repl>))
-  (match (level-stack repl)
-    (() (detach repl))
-    ((prev . rest)
-     (set! (level repl) prev)
-     (set! (level-stack repl) rest))))
+  (state-pop! (level-state repl))
+  (unless (state-current (level-state repl))
+    (detach repl)))
 
 (define-method (log-append (repl <repl>) node)
   (let ((container (make <margin-container>
-- 
cgit v1.2.3