From 8042d68702fdeda99a7e9e240b40e580ec82a8d8 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Fri, 15 Feb 2008 04:28:18 +0000
Subject: 	Add try/catch to Boot. 	* boot/tokens.boot (shoeKeyWords): Add
 new keywords. 	* boot/ast.boot (Ast): Include three new nodes. 
 (bfTry): New. 	(bfThrow): Likewise. 	* boot/parser.boot ($bodyHasReturn):
 Remove. 	(bpNoteReturnStmt): Likewise. 	(bpThrow): New. 
 (bpTry): Likewise. 	(bpPiledCatchItems): Likewise. 	(bpCatchItemList):
 Likewise. 	(bpExceptionHead): Likewise. 	(bpExceptionTail): Likewise. 
 (bpException): Likewise. 	(bpCatchItem): Likewise. 	(bpReturn):
 Include `throw' expressions. 	(bpStatement): Include `try' expressions. 
 * interp/macros.lisp (|tryLine|): Rename from |try|. 	* interp/pspad1.boot:
 Replace `try' with `tryLine' throughout.

---
 src/boot/Makefile.in |  1 -
 src/boot/ast.boot    | 19 ++++++++++++++
 src/boot/parser.boot | 70 ++++++++++++++++++++++++++++++++++++++--------------
 src/boot/tokens.boot |  3 +++
 4 files changed, 73 insertions(+), 20 deletions(-)

(limited to 'src/boot')

diff --git a/src/boot/Makefile.in b/src/boot/Makefile.in
index c438d385..756d59c6 100644
--- a/src/boot/Makefile.in
+++ b/src/boot/Makefile.in
@@ -216,7 +216,6 @@ mostlyclean-local:
 	@rm -f stamp
 
 clean-local: mostlyclean-local
-	@rm -f $(boot_sources)
 	@rm -f *.clisp
 
 distclean-local: clean-local
diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index 8670dfd4..210d5b2e 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -109,6 +109,9 @@ structure Ast ==
   Append(%Sequence)                     -- concatenate lists
   Case(Ast,%Sequence)                   -- case x of ...
   Return(Ast)                           -- return x
+  %Throw(Ast)                           -- throw OutOfRange 3
+  %Catch(Ast)                           -- catch OutOfRange
+  %Try(Ast,%Sequence)                   -- try x / y catch DivisionByZero
   Where(Ast,%Sequence)                  -- e where f x == y
   Structure(Ast,%Sequence)              -- structure Foo == ...
 
@@ -1138,3 +1141,19 @@ bfDs: %Short -> %String
 bfDs n== 
   if n=0 then '"" else CONCAT('"D",bfDs(n-1))
 
+
+++ Generate code for try-catch expressions.
+bfTry: (%Thing,%List) -> %Thing
+bfTry(e,cs) ==
+  null cs => e
+  case first cs of
+    %Catch(tag) => 
+      atom tag => bfTry(["CATCH",["QUOTE",tag],e],rest cs)
+      bpTrap()  -- sorry
+    otherwise => bpTrap()
+
+++ Generate code for `throw'-expressions
+bfThrow e ==
+  atom e => ["THROW",["QUOTE",e],nil]
+  not atom first e => bpTrap()
+  ["THROW",["QUOTE",first e],:rest e]
diff --git a/src/boot/parser.boot b/src/boot/parser.boot
index 9c41a07b..1c4fd348 100644
--- a/src/boot/parser.boot
+++ b/src/boot/parser.boot
@@ -51,10 +51,6 @@ import '"ast"
 ++ written round parenthesis.
 $sawParenthesizedHead := false
 
-++ true if the current function definition has a return statement.
-$bodyHasReturn := false
-
-
 bpFirstToken()==
       $stok:=
           if null $inputStream
@@ -649,18 +645,53 @@ bpCompare()==
                or true)
  
 bpAnd()== bpLeftAssoc('(AND),function bpCompare)
- 
 
-++ Note the fact that a return statement is used in the body
-++ of current function definition.
-bpNoteReturnStmt() ==
-  $bodyHasReturn := true
-  true
+bpThrow() ==
+  bpEqKey "THROW" and bpApplication() and 
+    bpPush bfThrow bpPop1()
+
+bpTry() ==
+  bpEqKey "TRY" and bpAssign() and 
+    (bpEqKey "BACKSET" or true) and 
+      (bpEqKey "CATCH" or bpMissing "CATCH") and
+        (bpPiledCatchItems() or bpName() or bpTrap()) and
+           bpPush bfTry(bpPop2(), bpPop1())
+
+bpPiledCatchItems() ==
+  bpPileBracketed function bpCatchItemList
+
+
+bpCatchItemList() ==
+  bpListAndRecover function bpCatchItem
+
+bpExceptionHead() ==
+  (bpName() or bpTrap()) and
+    ((bpParenthesized function bpIdList and
+      bpPush bfNameArgs (bpPop2(),bpPop1()))
+	or bpName() and bpPush bfNameArgs(bpPop2(),bpPop1()))
+          or true
+
+bpExceptionTail() ==
+  bpEqKey "EXIT" and (bpAssign() or bpTrap()) and
+    bpPush Exit(bpPop2(),bpPop1())
+
+++ Exception:
+++   ExpcetionHead
+++   ExceptionHead => Assign
+bpException() ==
+  bpExceptionHead() and (bpExceptionTail() or true)
+
+++ Catch:
+++   catch Exception
+bpCatchItem() ==
+  (bpException() or bpTrap()) and 
+    bpPush %Catch bpPop1()
 
 bpReturn()==
-         (bpEqKey "RETURN" and bpNoteReturnStmt() and
-           (bpAnd() or bpTrap()) and
-                bpPush bfReturnNoName bpPop1()) or bpAnd()
+  (bpEqKey "RETURN" and  (bpAnd() or bpTrap()) and
+	 bpPush bfReturnNoName bpPop1()) 
+    or bpThrow()
+      or bpAnd()
  
  
 bpLogical()== bpLeftAssoc('(OR),function bpReturn)
@@ -671,7 +702,9 @@ bpExpression()==
                     or bpTrap()) or bpLogical()
  
 bpStatement()==
-  bpConditional function bpWhere or bpLoop()  or bpExpression()
+  bpConditional function bpWhere or bpLoop()  
+    or bpExpression()
+      or bpTry()
  
 bpLoop()==
      bpIterators() and
@@ -727,10 +760,10 @@ bpAssign()==
                  false
  
 bpAssignment()==
-       bpAssignVariable() and
-         bpEqKey "BEC" and
-           (bpAssign() or bpTrap()) and
-              bpPush bfAssign (bpPop2(),bpPop1())
+  bpAssignVariable() and
+    bpEqKey "BEC" and
+      (bpAssign() or bpTrap()) and
+	 bpPush bfAssign (bpPop2(),bpPop1())
  
 -- should only be allowed in sequences
 bpExit()==
@@ -765,7 +798,6 @@ bpStoreName()==
   $wheredefs := nil
   $typings := nil
   $returnType := true           -- assume we may return anything
-  $bodyHasReturn := false
   true
 
 bpReturnType() ==
diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot
index a64c6d56..d3b9d2e0 100644
--- a/src/boot/tokens.boot
+++ b/src/boot/tokens.boot
@@ -42,6 +42,7 @@ shoeKeyWords := [  _
             ['"and","AND"] , _
             ['"by", "BY" ], _
             ['"case","CASE"] , _
+            ['"catch","CATCH"], _
             ['"cross","CROSS"] , _
             ['"else", "ELSE"] , _
             ['"for",  "FOR"] , _
@@ -57,6 +58,8 @@ shoeKeyWords := [  _
             ['"return", "RETURN"], _
             ['"structure", "STRUCTURE"], _
             ['"then",  "THEN"], _
+            ['"throw", "THROW"], _
+            ['"try",   "TRY"], _
             ['"until",  "UNTIL"], _
             ['"where",  "WHERE"], _
             ['"while",  "WHILE"], _
-- 
cgit v1.2.3