diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 22 | ||||
| -rw-r--r-- | src/boot/Makefile.in | 1 | ||||
| -rw-r--r-- | src/boot/ast.boot | 19 | ||||
| -rw-r--r-- | src/boot/parser.boot | 70 | ||||
| -rw-r--r-- | src/boot/tokens.boot | 3 | ||||
| -rw-r--r-- | src/interp/macros.lisp | 2 | ||||
| -rw-r--r-- | src/interp/pspad1.boot | 14 | ||||
| -rw-r--r-- | src/interp/pspad2.boot | 10 |
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() |