aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog22
-rw-r--r--src/boot/Makefile.in1
-rw-r--r--src/boot/ast.boot19
-rw-r--r--src/boot/parser.boot70
-rw-r--r--src/boot/tokens.boot3
-rw-r--r--src/interp/macros.lisp2
-rw-r--r--src/interp/pspad1.boot14
-rw-r--r--src/interp/pspad2.boot10
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()