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.

8 files changed, 108 insertions, 33 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 737afebc..d0b8c020 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,27 @@
 2008-02-14  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
+	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.
+
+2008-02-14  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
 	* OpenAxiom-1.1.0 has been released.
 
 2008-02-10  Gabriel Dos Reis  <gdr@cs.tamu.edu>
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"], _
diff --git a/src/interp/macros.lisp b/src/interp/macros.lisp
index b4e7ab75..aec5e26e 100644
--- a/src/interp/macros.lisp
+++ b/src/interp/macros.lisp
@@ -717,7 +717,7 @@ terminals and empty or at-end files.  In Common Lisp, we must assume record size
 
 (defmacro wi (a b) b)
 
-(defmacro |try| (X)
+(defmacro |tryLine| (X)
   `(LET ((|$autoLine|))
         (declare (special |$autoLine|))
         (|tryToFit| (|saveState|) ,X)))
diff --git a/src/interp/pspad1.boot b/src/interp/pspad1.boot
index b738d5e2..3fa01f97 100644
--- a/src/interp/pspad1.boot
+++ b/src/interp/pspad1.boot
@@ -235,17 +235,17 @@ undent() ==
   0
 
 spill(fn,a) == 
-  u := try FUNCALL(fn,a) => u
+  u := tryLine FUNCALL(fn,a) => u
   (nearMargin() or spillLine()) and FUNCALL(fn,a)
  
 formatSpill(fn,a) ==
-  u := try FUNCALL(fn,a) => u
+  u := tryLine FUNCALL(fn,a) => u
   v := (stay:= nearMargin() or indent() and newLine()) and FUNCALL(fn,a) 
   w := stay or undent()
   v and w
  
 formatSpill2(fn,f,a) ==
-  u := try FUNCALL(fn,f,a) => u
+  u := tryLine FUNCALL(fn,f,a) => u
   v := (stay:= nearMargin() or indent() and newLine()) and FUNCALL(fn,f,a) 
   w := stay or undent()
   v and w
@@ -293,7 +293,7 @@ formatDollar(name,p,argl) ==
   kind := (n=1 => "Nud"; "Led")
   IDENTP name and GETL(p,kind) => format([p,:argl],name)
   formatForcePren [p,:argl] and 
-    (try (format "$$" and formatForcePren name) 
+    (tryLine (format "$$" and formatForcePren name) 
       or (indent() and format "$__" and formatForcePren name and undent()))
  
 formatMacroCheck name ==
@@ -412,8 +412,8 @@ formatApplication1 u ==
   [op,x] := u
   formatHasDollarOp x or $formatForcePren or 
     pspadBindingPowerOf("left",x) < 1000  => formatOpPren(op,x)
-  try (formatOp op and format " ") and 
-    (try formatApplication2 x or
+  tryLine (formatOp op and format " ") and 
+    (tryLine formatApplication2 x or
       format "(" and formatApplication2 x and format ")")
 
 formatHasDollarOp x ==
@@ -433,7 +433,7 @@ formatApplication2 x ==
   format x
 
 formatDot ["dot",a,x] ==
-  try (formatOp a and format ".") and
+  tryLine (formatOp a and format ".") and
     ATOM x => format x
     formatPren x
  
diff --git a/src/interp/pspad2.boot b/src/interp/pspad2.boot
index fc1fba2a..bfcb317d 100644
--- a/src/interp/pspad2.boot
+++ b/src/interp/pspad2.boot
@@ -355,7 +355,7 @@ formatIf1 x ==
     isTrue a => format b
     format "if " and format a and format " then " and format b
   format "if " and format a and
-    (try
+    (tryLine
       (format " then " and format b and format " else "
         and formatIfThenElse c) or spillLine()
           and format " then " and format b and
@@ -381,7 +381,7 @@ formatConstruct(['construct,:u]) ==
     "and"/[format "," and formatCut x for x in rest u]) and format "]"
  
 formatNextConstructItem x ==
-  try format x or ($m := $m + 2) and newLine() and format x
+  tryLine format x or ($m := $m + 2) and newLine() and format x
  
 formatREPEAT ["REPEAT",:iteratorList,body] ==
   tryBreakNB(null iteratorList or (formatIterator first iteratorList and
@@ -463,12 +463,12 @@ formatNonAtom x ==
  
 formatCAPSULE ['CAPSULE,:l,x] == 
   $insideCAPSULE: local := true
-  try formatBlock(l,x) or formatPiles(l,x) or spillLine() and formatBlock(l,x)
+  tryLine formatBlock(l,x) or formatPiles(l,x) or spillLine() and formatBlock(l,x)
 
 formatPAREN [.,:argl] == formatFunctionCallTail argl
  
 formatSEQ ["SEQ",:l,[.,.,x]] == 
-  try formatBlock(l,x) or formatPiles(l,x) or spillLine() and formatBlock(l,x)
+  tryLine formatBlock(l,x) or formatPiles(l,x) or spillLine() and formatBlock(l,x)
  
 --======================================================================
 --              Comment Handlers
@@ -593,7 +593,7 @@ isGensym x ==
 --                       Macro Helpers
 --======================================================================
 tryToFit(s,x) ==
---% try to format on current line; see macro try in file PSPADAUX LISP
+--% try to format on current line; see macro tryLine in file PSPADAUX LISP
   --returns nil if unable to format stuff in x on a single line
   x => ($back:= rest $back; $c)
   restoreState()