diff options
Diffstat (limited to 'src/boot')
| -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 |
4 files changed, 73 insertions, 20 deletions
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"], _ |