From e978fdb127b726df8a04c4f7f1936b7eaf5e227b Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Wed, 30 May 2012 12:59:38 +0000
Subject: 	* boot/parser.boot: Remove references to $bpCount. 	*
 boot/translator.boot (shoeOutParse): Likewise.

---
 src/ChangeLog                   |  5 +++
 src/boot/parser.boot            | 59 ++++++++++++++++---------------
 src/boot/strap/parser.clisp     | 78 +++++++++++++++++++++--------------------
 src/boot/strap/translator.clisp |  4 +--
 src/boot/translator.boot        |  1 -
 5 files changed, 77 insertions(+), 70 deletions(-)

diff --git a/src/ChangeLog b/src/ChangeLog
index fafaf7d4..a0b0ff8b 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,8 @@
+2012-05-30  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* boot/parser.boot: Remove references to $bpCount.
+	* boot/translator.boot (shoeOutParse): Likewise.
+
 2012-05-29  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	* boot/parser.boot: Remove references to $bpParentCount.
diff --git a/src/boot/parser.boot b/src/boot/parser.boot
index 68a8d11f..7ec02edf 100644
--- a/src/boot/parser.boot
+++ b/src/boot/parser.boot
@@ -92,10 +92,10 @@ bpFirstTok ps ==
   $ttok := tokenValue $stok
   parserNesting ps > 0 and tokenClass $stok = "KEY" =>
     $ttok is "SETTAB" =>
-      $bpCount:=$bpCount+1
+      parserScope(ps) := parserScope ps + 1
       bpNext ps
     $ttok is "BACKTAB" =>
-      $bpCount:=$bpCount-1
+      parserScope(ps) := parserScope ps - 1
       bpNext ps
     $ttok is "BACKSET" =>
       bpNext ps
@@ -114,7 +114,7 @@ bpRequire(ps,f) ==
   apply(f,ps,nil) or bpTrap()
 
 bpState ps ==
-  [parserTokens ps,parserTrees ps,parserNesting ps,$bpCount]
+  [parserTokens ps,parserTrees ps,parserNesting ps,parserScope ps]
 
  
 bpRestore(ps,x)==
@@ -122,7 +122,7 @@ bpRestore(ps,x)==
   bpFirstToken ps
   parserTrees(ps) := second x
   parserNesting(ps) := third x
-  $bpCount:=CADDDR x
+  parserScope(ps) := CADDDR x
   true
  
 bpPush(ps,x) ==
@@ -147,29 +147,32 @@ bpPop3 ps ==
   a
  
 bpIndentParenthesized(ps,f) ==
-  $bpCount:local:=0
-  a:=$stok
-  bpEqPeek "OPAREN" =>
-    parserNesting(ps) := parserNesting ps + 1
-    bpNext ps
-    apply(f,ps,nil) and bpFirstTok ps and
-	    (bpEqPeek "CPAREN" or bpParenTrap(a)) =>
-      parserNesting(ps) := parserNesting ps - 1
-      bpNextToken ps
-      $bpCount=0 => true
-      parserTokens(ps) := append(bpAddTokens $bpCount,parserTokens ps)
-      bpFirstToken ps
-      parserNesting ps = 0 =>
-	bpCancel ps
-	true
-      true
-    bpEqPeek "CPAREN" =>
-      bpPush(ps,bfTuple [])
-      parserNesting(ps) := parserNesting ps - 1
-      bpNextToken ps
-      true
-    bpParenTrap(a)
-  false
+  scope := parserScope ps
+  try
+    parserScope(ps) := 0
+    a:=$stok
+    bpEqPeek "OPAREN" =>
+      parserNesting(ps) := parserNesting ps + 1
+      bpNext ps
+      apply(f,ps,nil) and bpFirstTok ps and
+              (bpEqPeek "CPAREN" or bpParenTrap(a)) =>
+        parserNesting(ps) := parserNesting ps - 1
+        bpNextToken ps
+        parserScope ps = 0 => true
+        parserTokens(ps) := append(bpAddTokens parserScope ps,parserTokens ps)
+        bpFirstToken ps
+        parserNesting ps = 0 =>
+          bpCancel ps
+          true
+        true
+      bpEqPeek "CPAREN" =>
+        bpPush(ps,bfTuple [])
+        parserNesting(ps) := parserNesting ps - 1
+        bpNextToken ps
+        true
+      bpParenTrap(a)
+    false
+  finally parserScope(ps) := scope
  
 bpParenthesized(ps,f) ==
   a := $stok
@@ -355,7 +358,7 @@ bpMoveTo(ps,n) ==
    bpEqPeek "BACKTAB" =>
      n=0  => true
      bpNextToken ps
-     $bpCount:=$bpCount-1
+     parserScope(ps) := parserScope ps - 1
      bpMoveTo(ps,n-1)
    bpEqPeek "BACKSET" =>
      n=0  => true
diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp
index cf7c652c..620207d2 100644
--- a/src/boot/strap/parser.clisp
+++ b/src/boot/strap/parser.clisp
@@ -65,7 +65,7 @@
    T))
 
 (DEFUN |bpFirstTok| (|ps|)
-  (DECLARE (SPECIAL |$bpCount| |$ttok| |$stok|))
+  (DECLARE (SPECIAL |$ttok| |$stok|))
   (PROGN
    (SETQ |$stok|
            (COND
@@ -76,9 +76,10 @@
    (COND
     ((AND (PLUSP (|parserNesting| |ps|)) (EQ (|tokenClass| |$stok|) 'KEY))
      (COND
-      ((EQ |$ttok| 'SETTAB) (SETQ |$bpCount| (+ |$bpCount| 1)) (|bpNext| |ps|))
-      ((EQ |$ttok| 'BACKTAB) (SETQ |$bpCount| (- |$bpCount| 1))
-       (|bpNext| |ps|))
+      ((EQ |$ttok| 'SETTAB)
+       (SETF (|parserScope| |ps|) (+ (|parserScope| |ps|) 1)) (|bpNext| |ps|))
+      ((EQ |$ttok| 'BACKTAB)
+       (SETF (|parserScope| |ps|) (- (|parserScope| |ps|) 1)) (|bpNext| |ps|))
       ((EQ |$ttok| 'BACKSET) (|bpNext| |ps|)) (T T)))
     (T T))))
 
@@ -95,18 +96,16 @@
 (DEFUN |bpRequire| (|ps| |f|) (OR (APPLY |f| |ps| NIL) (|bpTrap|)))
 
 (DEFUN |bpState| (|ps|)
-  (DECLARE (SPECIAL |$bpCount|))
   (LIST (|parserTokens| |ps|) (|parserTrees| |ps|) (|parserNesting| |ps|)
-        |$bpCount|))
+        (|parserScope| |ps|)))
 
 (DEFUN |bpRestore| (|ps| |x|)
-  (DECLARE (SPECIAL |$bpCount|))
   (PROGN
    (SETF (|parserTokens| |ps|) (CAR |x|))
    (|bpFirstToken| |ps|)
    (SETF (|parserTrees| |ps|) (CADR |x|))
    (SETF (|parserNesting| |ps|) (CADDR |x|))
-   (SETQ |$bpCount| (CADDDR |x|))
+   (SETF (|parserScope| |ps|) (CADDDR |x|))
    T))
 
 (DEFUN |bpPush| (|ps| |x|)
@@ -138,34 +137,37 @@
      |a|)))
 
 (DEFUN |bpIndentParenthesized| (|ps| |f|)
-  (LET* (|a|)
+  (LET* (|a| |scope|)
     (DECLARE (SPECIAL |$stok|))
-    (LET ((|$bpCount| 0))
-      (DECLARE (SPECIAL |$bpCount|))
-      (PROGN
-       (SETQ |a| |$stok|)
-       (COND
-        ((|bpEqPeek| 'OPAREN)
-         (SETF (|parserNesting| |ps|) (+ (|parserNesting| |ps|) 1))
-         (|bpNext| |ps|)
-         (COND
-          ((AND (APPLY |f| |ps| NIL) (|bpFirstTok| |ps|)
-                (OR (|bpEqPeek| 'CPAREN) (|bpParenTrap| |a|)))
-           (SETF (|parserNesting| |ps|) (- (|parserNesting| |ps|) 1))
-           (|bpNextToken| |ps|)
-           (COND ((EQL |$bpCount| 0) T)
-                 (T
-                  (SETF (|parserTokens| |ps|)
-                          (|append| (|bpAddTokens| |$bpCount|)
-                                    (|parserTokens| |ps|)))
-                  (|bpFirstToken| |ps|)
-                  (COND ((EQL (|parserNesting| |ps|) 0) (|bpCancel| |ps|) T)
-                        (T T)))))
-          ((|bpEqPeek| 'CPAREN) (|bpPush| |ps| (|bfTuple| NIL))
-           (SETF (|parserNesting| |ps|) (- (|parserNesting| |ps|) 1))
-           (|bpNextToken| |ps|) T)
-          (T (|bpParenTrap| |a|))))
-        (T NIL))))))
+    (PROGN
+     (SETQ |scope| (|parserScope| |ps|))
+     (UNWIND-PROTECT
+         (PROGN
+          (SETF (|parserScope| |ps|) 0)
+          (SETQ |a| |$stok|)
+          (COND
+           ((|bpEqPeek| 'OPAREN)
+            (SETF (|parserNesting| |ps|) (+ (|parserNesting| |ps|) 1))
+            (|bpNext| |ps|)
+            (COND
+             ((AND (APPLY |f| |ps| NIL) (|bpFirstTok| |ps|)
+                   (OR (|bpEqPeek| 'CPAREN) (|bpParenTrap| |a|)))
+              (SETF (|parserNesting| |ps|) (- (|parserNesting| |ps|) 1))
+              (|bpNextToken| |ps|)
+              (COND ((EQL (|parserScope| |ps|) 0) T)
+                    (T
+                     (SETF (|parserTokens| |ps|)
+                             (|append| (|bpAddTokens| (|parserScope| |ps|))
+                                       (|parserTokens| |ps|)))
+                     (|bpFirstToken| |ps|)
+                     (COND ((EQL (|parserNesting| |ps|) 0) (|bpCancel| |ps|) T)
+                           (T T)))))
+             ((|bpEqPeek| 'CPAREN) (|bpPush| |ps| (|bfTuple| NIL))
+              (SETF (|parserNesting| |ps|) (- (|parserNesting| |ps|) 1))
+              (|bpNextToken| |ps|) T)
+             (T (|bpParenTrap| |a|))))
+           (T NIL)))
+       (SETF (|parserScope| |ps|) |scope|)))))
 
 (DEFUN |bpParenthesized| (|ps| |f|)
   (LET* (|a|)
@@ -378,7 +380,7 @@
       (COND (|done| (RETURN NIL))
             (T
              (SETQ |found|
-                     (LET ((#1=#:G719
+                     (LET ((#1=#:G720
                             (CATCH :OPEN-AXIOM-CATCH-POINT
                               (APPLY |f| |ps| NIL))))
                        (COND
@@ -409,11 +411,11 @@
      (|bpPush| |ps| (|reverse!| |b|)))))
 
 (DEFUN |bpMoveTo| (|ps| |n|)
-  (DECLARE (SPECIAL |$bpCount|))
   (COND ((NULL (|parserTokens| |ps|)) T)
         ((|bpEqPeek| 'BACKTAB)
          (COND ((EQL |n| 0) T)
-               (T (|bpNextToken| |ps|) (SETQ |$bpCount| (- |$bpCount| 1))
+               (T (|bpNextToken| |ps|)
+                (SETF (|parserScope| |ps|) (- (|parserScope| |ps|) 1))
                 (|bpMoveTo| |ps| (- |n| 1)))))
         ((|bpEqPeek| 'BACKSET)
          (COND ((EQL |n| 0) T) (T (|bpNextToken| |ps|) (|bpMoveTo| |ps| |n|))))
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
index 623bd82f..c9d4a9d5 100644
--- a/src/boot/strap/translator.clisp
+++ b/src/boot/strap/translator.clisp
@@ -434,8 +434,7 @@
 (DEFUN |shoeOutParse| (|toks|)
   (LET* (|found| |ps|)
     (DECLARE
-     (SPECIAL |$bpCount| |$returns| |$typings| |$wheredefs| |$op| |$ttok|
-      |$stok|))
+     (SPECIAL |$returns| |$typings| |$wheredefs| |$op| |$ttok| |$stok|))
     (PROGN
      (SETQ |ps| (|makeParserState| |toks|))
      (SETQ |$stok| NIL)
@@ -444,7 +443,6 @@
      (SETQ |$wheredefs| NIL)
      (SETQ |$typings| NIL)
      (SETQ |$returns| NIL)
-     (SETQ |$bpCount| 0)
      (|bpFirstTok| |ps|)
      (SETQ |found|
              (LET ((#1=#:G729
diff --git a/src/boot/translator.boot b/src/boot/translator.boot
index b0d35442..bcfc5856 100644
--- a/src/boot/translator.boot
+++ b/src/boot/translator.boot
@@ -362,7 +362,6 @@ shoeOutParse toks ==
   $wheredefs := []
   $typings := []
   $returns := []
-  $bpCount := 0
   bpFirstTok ps
   found :=
     try bpOutItem ps
-- 
cgit v1.2.3