From 0835ad7e9a8e7f90f61b633fd74304f00b07d386 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Sat, 11 Dec 2010 18:52:23 +0000 Subject: * boot/parser.boot (bpListAndRecover): Use Lisp-level CATCH. (bpTry): Rewrite. (bpTry): Likewise. (bpSimpleCatch): Remove. (bpPiledCatchItems): Likewise. (bpCatchItemList): Likewise. (bpExceptionHead): Likewise. (bpExceptionTail): Likewise. (bpExceptionVariable): New. (bpFinally): Likewise. * boot/ast.boot (%Ast): Add %Pretend and %Finally. %Catch now takes two arguments. (bfTry): Rewrite. (bfThrow): Likewise. (bfHandlers): New. (codeForCatchHandlers): Likewise. * boot/translator.boot (shoeOutParse): Use Lisp-level CATCH. --- src/ChangeLog | 20 + src/boot/ast.boot | 49 ++- src/boot/parser.boot | 77 ++-- src/boot/strap/ast.clisp | 939 ++++++++++++++++++++++++-------------------- src/boot/strap/parser.clisp | 87 ++-- src/boot/translator.boot | 2 +- 6 files changed, 676 insertions(+), 498 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 13f89e98..9eb9e54e 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,23 @@ +2010-12-11 Gabriel Dos Reis + + * boot/parser.boot (bpListAndRecover): Use Lisp-level CATCH. + (bpTry): Rewrite. + (bpTry): Likewise. + (bpSimpleCatch): Remove. + (bpPiledCatchItems): Likewise. + (bpCatchItemList): Likewise. + (bpExceptionHead): Likewise. + (bpExceptionTail): Likewise. + (bpExceptionVariable): New. + (bpFinally): Likewise. + * boot/ast.boot (%Ast): Add %Pretend and %Finally. + %Catch now takes two arguments. + (bfTry): Rewrite. + (bfThrow): Likewise. + (bfHandlers): New. + (codeForCatchHandlers): Likewise. + * boot/translator.boot (shoeOutParse): Use Lisp-level CATCH. + 2010-12-10 Gabriel Dos Reis * boot/ast.boot (bfMmeber): Tidy. diff --git a/src/boot/ast.boot b/src/boot/ast.boot index 25e539ff..2336a6c9 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -103,6 +103,7 @@ structure %Ast == %BoundedSgement(%Ast,%Ast) -- 2..4 %Tuple(%List) -- comma-separated expression sequence %ColonAppend(%Ast,%Ast) -- [:y] or [x, :y] + %Pretend(%Ast,%Ast) -- e : t -- hard coercion %Is(%Ast,%Ast) -- e is p -- patterns %Isnt(%Ast,%Ast) -- e isnt p -- patterns %Reduce(%Ast,%Ast) -- +/[...] @@ -128,7 +129,8 @@ structure %Ast == %Return(%Ast) -- return x %Leave(%Ast) -- leave x %Throw(%Ast) -- throw OutOfRange 3 - %Catch(%Ast) -- catch OutOfRange + %Catch(%Signature,%Ast) -- catch(x: OutOfRange) => print x + %Finally(%Ast) -- finally closeFile f %Try(%Ast,%Sequence) -- try x / y catch DivisionByZero %Where(%Ast,%Sequence) -- e where f x == y %Structure(%Ast,%Sequence) -- structure Foo == ... @@ -1154,22 +1156,49 @@ bfDs n == n = 0 => '"" strconc('"D",bfDs(n-1)) +bfHandlers(n,e,hs) == main(n,e,hs,nil) where + main(n,e,hs,xs) == + hs = nil => + ["COND", + nreverse + [[true,["THROW",KEYWORD::OPEN_-AXIOM_-CATCH_-POINT,n]],:xs]] + hs is [['%Catch,['%Signature,v,t],s],:hs'] => + t := + symbol? t => ["QUOTE",[t]] -- instantiate niladic type ctor + ["QUOTE",t] + main(n,e,hs',[[bfQ(["CAR",e],t),["LET",[[v,["CDR",e]]],s]],:xs]) + bpTrap() + +codeForCatchHandlers(g,e,cs) == + ehTest := ['AND,['CONSP,g], + [bfQ(['CAR,g],KEYWORD::OPEN_-AXIOM_-CATCH_-POINT)]] + ["LET",[[g,["CATCH",KEYWORD::OPEN_-AXIOM_-CATCH_-POINT,e]]], + ["COND",[ehTest,bfHandlers(g,["CDR",g],cs)],[true,g]]] ++ Generate code for try-catch expressions. bfTry: (%Thing,%List) -> %Thing bfTry(e,cs) == - cs = nil => e - case first cs of - %Catch(tag) => - atom tag => bfTry(["CATCH",["QUOTE",tag],e],rest cs) - bpTrap() -- sorry - otherwise => bpTrap() + g := gensym() + cs is [:cs',f] and f is ['%Finally,s] => + cs' = nil => ["UNWIND-PROTECT",e,s] + ["UNWIND-PROTECT",codeForCatchHandlers(g,e,cs'),s] + codeForCatchHandlers(g,e,cs) ++ Generate code for `throw'-expressions bfThrow e == - atom e => ["THROW",["QUOTE",e],nil] - not atom first e => bpTrap() - ["THROW",["QUOTE",first e],:rest e] + t := nil + x := nil + if e is ["%Pretend",:.] then + t := third e + x := second e + else + t := "SystemException" + x := e + t := + symbol? t => ["QUOTE",[t]] + ["QOUTE",t] + ["THROW",KEYWORD::OPEN_-AXIOM_-CATCH_-POINT, + ["CONS",KEYWORD::OPEN_-AXIOM_-CATCH_-POINT,["CONS",t,x]]] --% Type alias definition diff --git a/src/boot/parser.boot b/src/boot/parser.boot index 2962014a..29141095 100644 --- a/src/boot/parser.boot +++ b/src/boot/parser.boot @@ -281,7 +281,9 @@ bpListAndRecover(f)== done := false c := $inputStream while not done repeat - found := try apply(f,nil) catch TRAPPOINT + found := CATCH('TRAPPOINT,apply(f,nil)) +-- try apply(f,nil) +-- catch TRAPPOINT --(e) => e if found = "TRAPPED" then $inputStream:=c @@ -683,51 +685,52 @@ bpAnd() == bpLeftAssoc('(AND),function bpCompare) bpThrow() == - bpEqKey "THROW" and bpApplication() and + bpEqKey "THROW" and bpApplication() => + -- Allow user-supplied matching type tag + if bpEqKey "COLON" then + bpApplication() or bpTrap() + bpPush %Pretend(bpPop2(),bpPop1()) bpPush bfThrow bpPop1() + nil ++ Try: ++ try Assign CatchItems bpTry() == - bpEqKey "TRY" and bpAssign() and - (bpEqKey "BACKSET" or true) and - (bpEqKey "CATCH" or bpMissing "CATCH") and - (bpPiledCatchItems() or bpSimpleCatch() or bpTrap()) and - bpPush bfTry(bpPop2(), bpPop1()) + bpEqKey "TRY" => + bpAssign() + cs := [] + while bpHandler "CATCH" repeat + bpCatchItem() + cs := [bpPop1(),:cs] + bpHandler "FINALLY" => + bpFinally() and + bpPush bfTry(bpPop2(),nreverse [bpPop1(),:cs]) + cs = nil => bpTrap() -- missing handlers + bpPush bfTry(bpPop1(),nreverse cs) + nil -++ SimpleCatch: -++ catch Name -bpSimpleCatch() == - bpCatchItem() and bpPush [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 +bpCatchItem() == + (bpExceptionVariable() or bpTrap()) and + (bpEqKey "EXIT" or bpTrap()) and + (bpAssign() or bpTrap()) and + bpPush %Catch(bpPop2(),bpPop1()) -bpExceptionTail() == - bpEqKey "EXIT" and (bpAssign() or bpTrap()) and - bpPush %Exit(bpPop2(),bpPop1()) +bpExceptionVariable() == + t := $stok + bpEqKey "OPAREN" and + (bpSignature() or bpTrap()) and + (bpEqKey "CPAREN" or bpMissing t) + or bpTrap() -++ Exception: -++ ExpcetionHead -++ ExceptionHead => Assign -bpException() == - bpExceptionHead() and (bpExceptionTail() or true) +bpFinally() == + (bpAssign() or bpTrap()) and + bpPush %Finally bpPop1() -++ Catch: -++ catch Exception -bpCatchItem() == - (bpException() or bpTrap()) and - bpPush %Catch bpPop1() +bpHandler key == + s := bpState() + bpEqKey "BACKSET" and bpEqKey key => true + bpRestore s + false ++ Leave: ++ LEAVE Logical diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index 280f58a3..70ac6194 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -79,78 +79,84 @@ (DEFUN |%ColonAppend| #0=(|bfVar#29| |bfVar#30|) (CONS '|%ColonAppend| (LIST . #0#))) -(DEFUN |%Is| #0=(|bfVar#31| |bfVar#32|) (CONS '|%Is| (LIST . #0#))) +(DEFUN |%Pretend| #0=(|bfVar#31| |bfVar#32|) + (CONS '|%Pretend| (LIST . #0#))) -(DEFUN |%Isnt| #0=(|bfVar#33| |bfVar#34|) +(DEFUN |%Is| #0=(|bfVar#33| |bfVar#34|) (CONS '|%Is| (LIST . #0#))) + +(DEFUN |%Isnt| #0=(|bfVar#35| |bfVar#36|) (CONS '|%Isnt| (LIST . #0#))) -(DEFUN |%Reduce| #0=(|bfVar#35| |bfVar#36|) +(DEFUN |%Reduce| #0=(|bfVar#37| |bfVar#38|) (CONS '|%Reduce| (LIST . #0#))) -(DEFUN |%PrefixExpr| #0=(|bfVar#37| |bfVar#38|) +(DEFUN |%PrefixExpr| #0=(|bfVar#39| |bfVar#40|) (CONS '|%PrefixExpr| (LIST . #0#))) -(DEFUN |%Call| #0=(|bfVar#39| |bfVar#40|) +(DEFUN |%Call| #0=(|bfVar#41| |bfVar#42|) (CONS '|%Call| (LIST . #0#))) -(DEFUN |%InfixExpr| #0=(|bfVar#41| |bfVar#42| |bfVar#43|) +(DEFUN |%InfixExpr| #0=(|bfVar#43| |bfVar#44| |bfVar#45|) (CONS '|%InfixExpr| (LIST . #0#))) -(DEFUN |%ConstantDefinition| #0=(|bfVar#44| |bfVar#45|) +(DEFUN |%ConstantDefinition| #0=(|bfVar#46| |bfVar#47|) (CONS '|%ConstantDefinition| (LIST . #0#))) -(DEFUN |%Definition| #0=(|bfVar#46| |bfVar#47| |bfVar#48|) +(DEFUN |%Definition| #0=(|bfVar#48| |bfVar#49| |bfVar#50|) (CONS '|%Definition| (LIST . #0#))) -(DEFUN |%Macro| #0=(|bfVar#49| |bfVar#50| |bfVar#51|) +(DEFUN |%Macro| #0=(|bfVar#51| |bfVar#52| |bfVar#53|) (CONS '|%Macro| (LIST . #0#))) -(DEFUN |%Lambda| #0=(|bfVar#52| |bfVar#53|) +(DEFUN |%Lambda| #0=(|bfVar#54| |bfVar#55|) (CONS '|%Lambda| (LIST . #0#))) -(DEFUN |%SuchThat| #0=(|bfVar#54|) (CONS '|%SuchThat| (LIST . #0#))) +(DEFUN |%SuchThat| #0=(|bfVar#56|) (CONS '|%SuchThat| (LIST . #0#))) -(DEFUN |%Assignment| #0=(|bfVar#55| |bfVar#56|) +(DEFUN |%Assignment| #0=(|bfVar#57| |bfVar#58|) (CONS '|%Assignment| (LIST . #0#))) -(DEFUN |%While| #0=(|bfVar#57|) (CONS '|%While| (LIST . #0#))) +(DEFUN |%While| #0=(|bfVar#59|) (CONS '|%While| (LIST . #0#))) -(DEFUN |%Until| #0=(|bfVar#58|) (CONS '|%Until| (LIST . #0#))) +(DEFUN |%Until| #0=(|bfVar#60|) (CONS '|%Until| (LIST . #0#))) -(DEFUN |%For| #0=(|bfVar#59| |bfVar#60| |bfVar#61|) +(DEFUN |%For| #0=(|bfVar#61| |bfVar#62| |bfVar#63|) (CONS '|%For| (LIST . #0#))) -(DEFUN |%Implies| #0=(|bfVar#62| |bfVar#63|) +(DEFUN |%Implies| #0=(|bfVar#64| |bfVar#65|) (CONS '|%Implies| (LIST . #0#))) -(DEFUN |%Iterators| #0=(|bfVar#64|) (CONS '|%Iterators| (LIST . #0#))) +(DEFUN |%Iterators| #0=(|bfVar#66|) (CONS '|%Iterators| (LIST . #0#))) -(DEFUN |%Cross| #0=(|bfVar#65|) (CONS '|%Cross| (LIST . #0#))) +(DEFUN |%Cross| #0=(|bfVar#67|) (CONS '|%Cross| (LIST . #0#))) -(DEFUN |%Repeat| #0=(|bfVar#66| |bfVar#67|) +(DEFUN |%Repeat| #0=(|bfVar#68| |bfVar#69|) (CONS '|%Repeat| (LIST . #0#))) -(DEFUN |%Pile| #0=(|bfVar#68|) (CONS '|%Pile| (LIST . #0#))) +(DEFUN |%Pile| #0=(|bfVar#70|) (CONS '|%Pile| (LIST . #0#))) -(DEFUN |%Append| #0=(|bfVar#69|) (CONS '|%Append| (LIST . #0#))) +(DEFUN |%Append| #0=(|bfVar#71|) (CONS '|%Append| (LIST . #0#))) -(DEFUN |%Case| #0=(|bfVar#70| |bfVar#71|) +(DEFUN |%Case| #0=(|bfVar#72| |bfVar#73|) (CONS '|%Case| (LIST . #0#))) -(DEFUN |%Return| #0=(|bfVar#72|) (CONS '|%Return| (LIST . #0#))) +(DEFUN |%Return| #0=(|bfVar#74|) (CONS '|%Return| (LIST . #0#))) + +(DEFUN |%Leave| #0=(|bfVar#75|) (CONS '|%Leave| (LIST . #0#))) -(DEFUN |%Leave| #0=(|bfVar#73|) (CONS '|%Leave| (LIST . #0#))) +(DEFUN |%Throw| #0=(|bfVar#76|) (CONS '|%Throw| (LIST . #0#))) -(DEFUN |%Throw| #0=(|bfVar#74|) (CONS '|%Throw| (LIST . #0#))) +(DEFUN |%Catch| #0=(|bfVar#77| |bfVar#78|) + (CONS '|%Catch| (LIST . #0#))) -(DEFUN |%Catch| #0=(|bfVar#75|) (CONS '|%Catch| (LIST . #0#))) +(DEFUN |%Finally| #0=(|bfVar#79|) (CONS '|%Finally| (LIST . #0#))) -(DEFUN |%Try| #0=(|bfVar#76| |bfVar#77|) (CONS '|%Try| (LIST . #0#))) +(DEFUN |%Try| #0=(|bfVar#80| |bfVar#81|) (CONS '|%Try| (LIST . #0#))) -(DEFUN |%Where| #0=(|bfVar#78| |bfVar#79|) +(DEFUN |%Where| #0=(|bfVar#82| |bfVar#83|) (CONS '|%Where| (LIST . #0#))) -(DEFUN |%Structure| #0=(|bfVar#80| |bfVar#81|) +(DEFUN |%Structure| #0=(|bfVar#84| |bfVar#85|) (CONS '|%Structure| (LIST . #0#))) (DEFPARAMETER |$inDefIS| NIL) @@ -251,21 +257,21 @@ (PROGN (SETQ |a| (COND ((|bfTupleP| |b|) (CDR |b|)) (T (LIST |b|)))) (COND - ((LET ((|bfVar#83| NIL) (|bfVar#82| |a|) (|x| NIL)) + ((LET ((|bfVar#87| NIL) (|bfVar#86| |a|) (|x| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#82|) - (PROGN (SETQ |x| (CAR |bfVar#82|)) NIL)) - (RETURN |bfVar#83|)) + ((OR (ATOM |bfVar#86|) + (PROGN (SETQ |x| (CAR |bfVar#86|)) NIL)) + (RETURN |bfVar#87|)) (T (PROGN - (SETQ |bfVar#83| + (SETQ |bfVar#87| (AND (CONSP |x|) (EQ (CAR |x|) 'COLON) (PROGN (SETQ |ISTMP#1| (CDR |x|)) (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)))))) - (COND (|bfVar#83| (RETURN |bfVar#83|)))))) - (SETQ |bfVar#82| (CDR |bfVar#82|)))) + (COND (|bfVar#87| (RETURN |bfVar#87|)))))) + (SETQ |bfVar#86| (CDR |bfVar#86|)))) (|bfMakeCons| |a|)) (T (CONS 'LIST |a|))))))) @@ -417,19 +423,19 @@ (COND ((NULL |iters|) (LIST NIL NIL NIL NIL NIL NIL)) (T (SETQ |f| (CAR |iters|)) (SETQ |r| (|bfSep| (CDR |iters|))) - (LET ((|bfVar#86| NIL) (|bfVar#84| |f|) (|i| NIL) - (|bfVar#85| |r|) (|j| NIL)) + (LET ((|bfVar#90| NIL) (|bfVar#88| |f|) (|i| NIL) + (|bfVar#89| |r|) (|j| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#84|) - (PROGN (SETQ |i| (CAR |bfVar#84|)) NIL) - (ATOM |bfVar#85|) - (PROGN (SETQ |j| (CAR |bfVar#85|)) NIL)) - (RETURN (NREVERSE |bfVar#86|))) - (T (SETQ |bfVar#86| - (CONS (APPEND |i| |j|) |bfVar#86|)))) - (SETQ |bfVar#84| (CDR |bfVar#84|)) - (SETQ |bfVar#85| (CDR |bfVar#85|))))))))) + ((OR (ATOM |bfVar#88|) + (PROGN (SETQ |i| (CAR |bfVar#88|)) NIL) + (ATOM |bfVar#89|) + (PROGN (SETQ |j| (CAR |bfVar#89|)) NIL)) + (RETURN (NREVERSE |bfVar#90|))) + (T (SETQ |bfVar#90| + (CONS (APPEND |i| |j|) |bfVar#90|)))) + (SETQ |bfVar#88| (CDR |bfVar#88|)) + (SETQ |bfVar#89| (CDR |bfVar#89|))))))))) (DEFUN |bfReduce| (|op| |y|) (PROG (|it| |ny| |g2| |body| |g1| |g| |init| |a|) @@ -547,25 +553,25 @@ (COND (|vars| (SETQ |loop| (LIST 'LET - (LET ((|bfVar#89| NIL) - (|bfVar#87| |vars|) (|v| NIL) - (|bfVar#88| |inits|) (|i| NIL)) + (LET ((|bfVar#93| NIL) + (|bfVar#91| |vars|) (|v| NIL) + (|bfVar#92| |inits|) (|i| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#87|) + ((OR (ATOM |bfVar#91|) (PROGN - (SETQ |v| (CAR |bfVar#87|)) + (SETQ |v| (CAR |bfVar#91|)) NIL) - (ATOM |bfVar#88|) + (ATOM |bfVar#92|) (PROGN - (SETQ |i| (CAR |bfVar#88|)) + (SETQ |i| (CAR |bfVar#92|)) NIL)) - (RETURN (NREVERSE |bfVar#89|))) + (RETURN (NREVERSE |bfVar#93|))) (T - (SETQ |bfVar#89| - (CONS (LIST |v| |i|) |bfVar#89|)))) - (SETQ |bfVar#87| (CDR |bfVar#87|)) - (SETQ |bfVar#88| (CDR |bfVar#88|)))) + (SETQ |bfVar#93| + (CONS (LIST |v| |i|) |bfVar#93|)))) + (SETQ |bfVar#91| (CDR |bfVar#91|)) + (SETQ |bfVar#92| (CDR |bfVar#92|)))) |loop|)))) |loop|)))) @@ -1088,16 +1094,16 @@ (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) (PROGN (SETQ |seq| (CAR |ISTMP#1|)) T))) (CONSP |seq|) - (LET ((|bfVar#91| T) (|bfVar#90| |seq|) (|y| NIL)) + (LET ((|bfVar#95| T) (|bfVar#94| |seq|) (|y| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#90|) - (PROGN (SETQ |y| (CAR |bfVar#90|)) NIL)) - (RETURN |bfVar#91|)) + ((OR (ATOM |bfVar#94|) + (PROGN (SETQ |y| (CAR |bfVar#94|)) NIL)) + (RETURN |bfVar#95|)) (T (PROGN - (SETQ |bfVar#91| (APPLY |pred| |y| NIL)) - (COND ((NOT |bfVar#91|) (RETURN NIL)))))) - (SETQ |bfVar#90| (CDR |bfVar#90|)))))))) + (SETQ |bfVar#95| (APPLY |pred| |y| NIL)) + (COND ((NOT |bfVar#95|) (RETURN NIL)))))) + (SETQ |bfVar#94| (CDR |bfVar#94|)))))))) (DEFUN |bfMember| (|var| |seq|) (PROG (|ISTMP#1|) @@ -1157,32 +1163,32 @@ ((NULL |l|) NIL) ((NULL (CDR |l|)) (CAR |l|)) (T (CONS 'OR - (LET ((|bfVar#93| NIL) (|bfVar#92| |l|) (|c| NIL)) + (LET ((|bfVar#97| NIL) (|bfVar#96| |l|) (|c| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#92|) - (PROGN (SETQ |c| (CAR |bfVar#92|)) NIL)) - (RETURN (NREVERSE |bfVar#93|))) - (T (SETQ |bfVar#93| + ((OR (ATOM |bfVar#96|) + (PROGN (SETQ |c| (CAR |bfVar#96|)) NIL)) + (RETURN (NREVERSE |bfVar#97|))) + (T (SETQ |bfVar#97| (APPEND (REVERSE (|bfFlatten| 'OR |c|)) - |bfVar#93|)))) - (SETQ |bfVar#92| (CDR |bfVar#92|)))))))) + |bfVar#97|)))) + (SETQ |bfVar#96| (CDR |bfVar#96|)))))))) (DEFUN |bfAND| (|l|) (COND ((NULL |l|) T) ((NULL (CDR |l|)) (CAR |l|)) (T (CONS 'AND - (LET ((|bfVar#95| NIL) (|bfVar#94| |l|) (|c| NIL)) + (LET ((|bfVar#99| NIL) (|bfVar#98| |l|) (|c| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#94|) - (PROGN (SETQ |c| (CAR |bfVar#94|)) NIL)) - (RETURN (NREVERSE |bfVar#95|))) - (T (SETQ |bfVar#95| + ((OR (ATOM |bfVar#98|) + (PROGN (SETQ |c| (CAR |bfVar#98|)) NIL)) + (RETURN (NREVERSE |bfVar#99|))) + (T (SETQ |bfVar#99| (APPEND (REVERSE (|bfFlatten| 'AND |c|)) - |bfVar#95|)))) - (SETQ |bfVar#94| (CDR |bfVar#94|)))))))) + |bfVar#99|)))) + (SETQ |bfVar#98| (CDR |bfVar#98|)))))))) (DEFUN |defQuoteId| (|x|) (AND (CONSP |x|) (EQ (CAR |x|) 'QUOTE) (IDENTP (CADR |x|)))) @@ -1228,52 +1234,52 @@ (SETQ |nargl| (CADDR . #0#)) (SETQ |largl| (CADDDR . #0#)) (SETQ |sb| - (LET ((|bfVar#98| NIL) (|bfVar#96| |nargl|) (|i| NIL) - (|bfVar#97| |sgargl|) (|j| NIL)) + (LET ((|bfVar#102| NIL) (|bfVar#100| |nargl|) (|i| NIL) + (|bfVar#101| |sgargl|) (|j| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#96|) - (PROGN (SETQ |i| (CAR |bfVar#96|)) NIL) - (ATOM |bfVar#97|) - (PROGN (SETQ |j| (CAR |bfVar#97|)) NIL)) - (RETURN (NREVERSE |bfVar#98|))) - (T (SETQ |bfVar#98| - (CONS (CONS |i| |j|) |bfVar#98|)))) - (SETQ |bfVar#96| (CDR |bfVar#96|)) - (SETQ |bfVar#97| (CDR |bfVar#97|))))) + ((OR (ATOM |bfVar#100|) + (PROGN (SETQ |i| (CAR |bfVar#100|)) NIL) + (ATOM |bfVar#101|) + (PROGN (SETQ |j| (CAR |bfVar#101|)) NIL)) + (RETURN (NREVERSE |bfVar#102|))) + (T (SETQ |bfVar#102| + (CONS (CONS |i| |j|) |bfVar#102|)))) + (SETQ |bfVar#100| (CDR |bfVar#100|)) + (SETQ |bfVar#101| (CDR |bfVar#101|))))) (SETQ |body| (SUBLIS |sb| |body|)) (SETQ |sb2| - (LET ((|bfVar#101| NIL) (|bfVar#99| |sgargl|) (|i| NIL) - (|bfVar#100| |largl|) (|j| NIL)) + (LET ((|bfVar#105| NIL) (|bfVar#103| |sgargl|) (|i| NIL) + (|bfVar#104| |largl|) (|j| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#99|) - (PROGN (SETQ |i| (CAR |bfVar#99|)) NIL) - (ATOM |bfVar#100|) - (PROGN (SETQ |j| (CAR |bfVar#100|)) NIL)) - (RETURN (NREVERSE |bfVar#101|))) - (T (SETQ |bfVar#101| + ((OR (ATOM |bfVar#103|) + (PROGN (SETQ |i| (CAR |bfVar#103|)) NIL) + (ATOM |bfVar#104|) + (PROGN (SETQ |j| (CAR |bfVar#104|)) NIL)) + (RETURN (NREVERSE |bfVar#105|))) + (T (SETQ |bfVar#105| (CONS (LIST 'CONS (LIST 'QUOTE |i|) |j|) - |bfVar#101|)))) - (SETQ |bfVar#99| (CDR |bfVar#99|)) - (SETQ |bfVar#100| (CDR |bfVar#100|))))) + |bfVar#105|)))) + (SETQ |bfVar#103| (CDR |bfVar#103|)) + (SETQ |bfVar#104| (CDR |bfVar#104|))))) (SETQ |body| (LIST 'SUBLIS (CONS 'LIST |sb2|) (LIST 'QUOTE |body|))) (SETQ |lamex| (LIST 'MLAMBDA |gargl| |body|)) (SETQ |def| (LIST |op| |lamex|)) (CONS (|shoeComp| |def|) - (LET ((|bfVar#103| NIL) (|bfVar#102| |$wheredefs|) + (LET ((|bfVar#107| NIL) (|bfVar#106| |$wheredefs|) (|d| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#102|) - (PROGN (SETQ |d| (CAR |bfVar#102|)) NIL)) - (RETURN (NREVERSE |bfVar#103|))) - (T (SETQ |bfVar#103| + ((OR (ATOM |bfVar#106|) + (PROGN (SETQ |d| (CAR |bfVar#106|)) NIL)) + (RETURN (NREVERSE |bfVar#107|))) + (T (SETQ |bfVar#107| (APPEND (REVERSE (|shoeComps| (|bfDef1| |d|))) - |bfVar#103|)))) - (SETQ |bfVar#102| (CDR |bfVar#102|))))))))) + |bfVar#107|)))) + (SETQ |bfVar#106| (CDR |bfVar#106|))))))))) (DEFUN |bfGargl| (|argl|) (PROG (|f| |d| |c| |b| |a| |LETTMP#1|) @@ -1293,13 +1299,13 @@ (LIST (CONS |f| |a|) (CONS |f| |b|) (CONS (CAR |argl|) |c|) (CONS |f| |d|))))))))) -(DEFUN |bfDef1| (|bfVar#104|) +(DEFUN |bfDef1| (|bfVar#108|) (PROG (|arglp| |control| |quotes| |LETTMP#1| |argl| |body| |args| |op|) (RETURN (PROGN - (SETQ |op| (CAR |bfVar#104|)) - (SETQ |args| (CADR . #0=(|bfVar#104|))) + (SETQ |op| (CAR |bfVar#108|)) + (SETQ |args| (CADR . #0=(|bfVar#108|))) (SETQ |body| (CADDR . #0#)) (SETQ |argl| (COND @@ -1340,30 +1346,30 @@ (SETQ |arg1| (CADDR . #0#)) (SETQ |body1| (CDDDR . #0#)) (|bfCompHash| |op1| |arg1| |body1|)) (T (|bfTuple| - (LET ((|bfVar#106| NIL) - (|bfVar#105| + (LET ((|bfVar#110| NIL) + (|bfVar#109| (CONS (LIST |op| |args| |body|) |$wheredefs|)) (|d| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#105|) - (PROGN (SETQ |d| (CAR |bfVar#105|)) NIL)) - (RETURN (NREVERSE |bfVar#106|))) - (T (SETQ |bfVar#106| + ((OR (ATOM |bfVar#109|) + (PROGN (SETQ |d| (CAR |bfVar#109|)) NIL)) + (RETURN (NREVERSE |bfVar#110|))) + (T (SETQ |bfVar#110| (APPEND (REVERSE (|shoeComps| (|bfDef1| |d|))) - |bfVar#106|)))) - (SETQ |bfVar#105| (CDR |bfVar#105|)))))))))) + |bfVar#110|)))) + (SETQ |bfVar#109| (CDR |bfVar#109|)))))))))) (DEFUN |shoeComps| (|x|) - (LET ((|bfVar#108| NIL) (|bfVar#107| |x|) (|def| NIL)) + (LET ((|bfVar#112| NIL) (|bfVar#111| |x|) (|def| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#107|) - (PROGN (SETQ |def| (CAR |bfVar#107|)) NIL)) - (RETURN (NREVERSE |bfVar#108|))) - (T (SETQ |bfVar#108| (CONS (|shoeComp| |def|) |bfVar#108|)))) - (SETQ |bfVar#107| (CDR |bfVar#107|))))) + ((OR (ATOM |bfVar#111|) + (PROGN (SETQ |def| (CAR |bfVar#111|)) NIL)) + (RETURN (NREVERSE |bfVar#112|))) + (T (SETQ |bfVar#112| (CONS (|shoeComp| |def|) |bfVar#112|)))) + (SETQ |bfVar#111| (CDR |bfVar#111|))))) (DEFUN |shoeComp| (|x|) (PROG (|a|) @@ -1505,16 +1511,16 @@ (COND ((MEMQ |op| '(RETURN RETURN-FROM)) T) ((MEMQ |op| '(LET PROG LOOP BLOCK DECLARE LAMBDA)) NIL) - ((LET ((|bfVar#110| NIL) (|bfVar#109| |body|) (|t| NIL)) + ((LET ((|bfVar#114| NIL) (|bfVar#113| |body|) (|t| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#109|) - (PROGN (SETQ |t| (CAR |bfVar#109|)) NIL)) - (RETURN |bfVar#110|)) + ((OR (ATOM |bfVar#113|) + (PROGN (SETQ |t| (CAR |bfVar#113|)) NIL)) + (RETURN |bfVar#114|)) (T (PROGN - (SETQ |bfVar#110| (|needsPROG| |t|)) - (COND (|bfVar#110| (RETURN |bfVar#110|)))))) - (SETQ |bfVar#109| (CDR |bfVar#109|)))) + (SETQ |bfVar#114| (|needsPROG| |t|)) + (COND (|bfVar#114| (RETURN |bfVar#114|)))))) + (SETQ |bfVar#113| (CDR |bfVar#113|)))) T) (T NIL))))))) @@ -1607,11 +1613,11 @@ (RPLACA (CDR |x|) (CADR |l|))))) ((EQ U '|%Leave|) (RPLACA |x| 'RETURN)) ((MEMQ U '(PROG LAMBDA)) (SETQ |newbindings| NIL) - (LET ((|bfVar#111| (CADR |x|)) (|y| NIL)) + (LET ((|bfVar#115| (CADR |x|)) (|y| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#111|) - (PROGN (SETQ |y| (CAR |bfVar#111|)) NIL)) + ((OR (ATOM |bfVar#115|) + (PROGN (SETQ |y| (CAR |bfVar#115|)) NIL)) (RETURN NIL)) (T (COND ((NOT (MEMQ |y| |$locVars|)) @@ -1620,22 +1626,22 @@ (SETQ |$locVars| (CONS |y| |$locVars|)) (SETQ |newbindings| (CONS |y| |newbindings|)))))))) - (SETQ |bfVar#111| (CDR |bfVar#111|)))) + (SETQ |bfVar#115| (CDR |bfVar#115|)))) (SETQ |res| (|shoeCompTran1| (CDDR |x|))) (SETQ |$locVars| - (LET ((|bfVar#113| NIL) (|bfVar#112| |$locVars|) + (LET ((|bfVar#117| NIL) (|bfVar#116| |$locVars|) (|y| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#112|) + ((OR (ATOM |bfVar#116|) (PROGN - (SETQ |y| (CAR |bfVar#112|)) + (SETQ |y| (CAR |bfVar#116|)) NIL)) - (RETURN (NREVERSE |bfVar#113|))) + (RETURN (NREVERSE |bfVar#117|))) (T (AND (NOT (MEMQ |y| |newbindings|)) - (SETQ |bfVar#113| - (CONS |y| |bfVar#113|))))) - (SETQ |bfVar#112| (CDR |bfVar#112|)))))) + (SETQ |bfVar#117| + (CONS |y| |bfVar#117|))))) + (SETQ |bfVar#116| (CDR |bfVar#116|)))))) (T (|shoeCompTran1| (CAR |x|)) (|shoeCompTran1| (CDR |x|))))))))) @@ -1726,13 +1732,13 @@ (RETURN (PROGN (SETQ |a| - (LET ((|bfVar#114| NIL) (|c| |l|)) + (LET ((|bfVar#118| NIL) (|c| |l|)) (LOOP (COND - ((ATOM |c|) (RETURN (NREVERSE |bfVar#114|))) - (T (SETQ |bfVar#114| + ((ATOM |c|) (RETURN (NREVERSE |bfVar#118|))) + (T (SETQ |bfVar#118| (APPEND (REVERSE (|bfFlattenSeq| |c|)) - |bfVar#114|)))) + |bfVar#118|)))) (SETQ |c| (CDR |c|))))) (COND ((NULL |a|) NIL) @@ -1750,17 +1756,17 @@ ((AND (CONSP |f|) (EQ (CAR |f|) 'PROGN)) (COND ((CDR |x|) - (LET ((|bfVar#116| NIL) (|bfVar#115| (CDR |f|)) + (LET ((|bfVar#120| NIL) (|bfVar#119| (CDR |f|)) (|i| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#115|) - (PROGN (SETQ |i| (CAR |bfVar#115|)) NIL)) - (RETURN (NREVERSE |bfVar#116|))) + ((OR (ATOM |bfVar#119|) + (PROGN (SETQ |i| (CAR |bfVar#119|)) NIL)) + (RETURN (NREVERSE |bfVar#120|))) (T (AND (NOT (ATOM |i|)) - (SETQ |bfVar#116| - (CONS |i| |bfVar#116|))))) - (SETQ |bfVar#115| (CDR |bfVar#115|))))) + (SETQ |bfVar#120| + (CONS |i| |bfVar#120|))))) + (SETQ |bfVar#119| (CDR |bfVar#119|))))) (T (CDR |f|)))) (T (LIST |f|)))))))) @@ -1809,11 +1815,11 @@ (COND ((NULL |l|) NIL) (T (SETQ |transform| - (LET ((|bfVar#118| NIL) (|bfVar#117| |l|) (|x| NIL)) + (LET ((|bfVar#122| NIL) (|bfVar#121| |l|) (|x| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#117|) - (PROGN (SETQ |x| (CAR |bfVar#117|)) NIL) + ((OR (ATOM |bfVar#121|) + (PROGN (SETQ |x| (CAR |bfVar#121|)) NIL) (NOT (AND (CONSP |x|) (EQ (CAR |x|) 'COND) (PROGN (SETQ |ISTMP#1| (CDR |x|)) @@ -1847,11 +1853,11 @@ (SETQ |b| (CAR |ISTMP#5|)) T)))))))))))))) - (RETURN (NREVERSE |bfVar#118|))) - (T (SETQ |bfVar#118| + (RETURN (NREVERSE |bfVar#122|))) + (T (SETQ |bfVar#122| (CONS (|bfAlternative| |a| |b|) - |bfVar#118|)))) - (SETQ |bfVar#117| (CDR |bfVar#117|))))) + |bfVar#122|)))) + (SETQ |bfVar#121| (CDR |bfVar#121|))))) (SETQ |no| (LENGTH |transform|)) (SETQ |before| (|bfTake| |no| |l|)) (SETQ |aft| (|bfDrop| |no| |l|)) @@ -1883,17 +1889,17 @@ (SETQ |defs| (CADR . #0=(|LETTMP#1|))) (SETQ |nondefs| (CADDR . #0#)) (SETQ |a| - (LET ((|bfVar#120| NIL) (|bfVar#119| |defs|) (|d| NIL)) + (LET ((|bfVar#124| NIL) (|bfVar#123| |defs|) (|d| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#119|) - (PROGN (SETQ |d| (CAR |bfVar#119|)) NIL)) - (RETURN (NREVERSE |bfVar#120|))) - (T (SETQ |bfVar#120| + ((OR (ATOM |bfVar#123|) + (PROGN (SETQ |d| (CAR |bfVar#123|)) NIL)) + (RETURN (NREVERSE |bfVar#124|))) + (T (SETQ |bfVar#124| (CONS (LIST (CAR |d|) (CADR |d|) (|bfSUBLIS| |opassoc| (CADDR |d|))) - |bfVar#120|)))) - (SETQ |bfVar#119| (CDR |bfVar#119|))))) + |bfVar#124|)))) + (SETQ |bfVar#123| (CDR |bfVar#123|))))) (SETQ |$wheredefs| (APPEND |a| |$wheredefs|)) (|bfMKPROGN| (|bfSUBLIS| |opassoc| (NCONC |nondefs| (LIST |expr|)))))))) @@ -1977,16 +1983,16 @@ ((AND (CONSP |x|) (NULL (CDR |x|))) (SETQ |f| (CAR |x|)) (LIST 'DEFCONSTANT |f| (LIST 'LIST (LIST 'QUOTE |f|)))) (T (SETQ |a| - (LET ((|bfVar#122| NIL) (|bfVar#121| (CDR |x|)) + (LET ((|bfVar#126| NIL) (|bfVar#125| (CDR |x|)) (|i| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#121|) - (PROGN (SETQ |i| (CAR |bfVar#121|)) NIL)) - (RETURN (NREVERSE |bfVar#122|))) - (T (SETQ |bfVar#122| - (CONS (|bfGenSymbol|) |bfVar#122|)))) - (SETQ |bfVar#121| (CDR |bfVar#121|))))) + ((OR (ATOM |bfVar#125|) + (PROGN (SETQ |i| (CAR |bfVar#125|)) NIL)) + (RETURN (NREVERSE |bfVar#126|))) + (T (SETQ |bfVar#126| + (CONS (|bfGenSymbol|) |bfVar#126|)))) + (SETQ |bfVar#125| (CDR |bfVar#125|))))) (LIST 'DEFUN (CAR |x|) |a| (LIST 'CONS (LIST 'QUOTE (CAR |x|)) (CONS 'LIST |a|)))))))) @@ -2013,21 +2019,21 @@ (DEFUN |bfCaseItems| (|g| |x|) (PROG (|j| |ISTMP#1| |i|) (RETURN - (LET ((|bfVar#125| NIL) (|bfVar#124| |x|) (|bfVar#123| NIL)) + (LET ((|bfVar#129| NIL) (|bfVar#128| |x|) (|bfVar#127| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#124|) - (PROGN (SETQ |bfVar#123| (CAR |bfVar#124|)) NIL)) - (RETURN (NREVERSE |bfVar#125|))) - (T (AND (CONSP |bfVar#123|) + ((OR (ATOM |bfVar#128|) + (PROGN (SETQ |bfVar#127| (CAR |bfVar#128|)) NIL)) + (RETURN (NREVERSE |bfVar#129|))) + (T (AND (CONSP |bfVar#127|) (PROGN - (SETQ |i| (CAR |bfVar#123|)) - (SETQ |ISTMP#1| (CDR |bfVar#123|)) + (SETQ |i| (CAR |bfVar#127|)) + (SETQ |ISTMP#1| (CDR |bfVar#127|)) (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) (PROGN (SETQ |j| (CAR |ISTMP#1|)) T))) - (SETQ |bfVar#125| - (CONS (|bfCI| |g| |i| |j|) |bfVar#125|))))) - (SETQ |bfVar#124| (CDR |bfVar#124|))))))) + (SETQ |bfVar#129| + (CONS (|bfCI| |g| |i| |j|) |bfVar#129|))))) + (SETQ |bfVar#128| (CDR |bfVar#128|))))))) (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing|) |%List|) |bfCI|)) @@ -2039,19 +2045,19 @@ (COND ((NULL |a|) (LIST (CAR |x|) |y|)) (T (SETQ |b| - (LET ((|bfVar#127| NIL) (|bfVar#126| |a|) (|i| NIL) + (LET ((|bfVar#131| NIL) (|bfVar#130| |a|) (|i| NIL) (|j| 1)) (LOOP (COND - ((OR (ATOM |bfVar#126|) - (PROGN (SETQ |i| (CAR |bfVar#126|)) NIL)) - (RETURN (NREVERSE |bfVar#127|))) + ((OR (ATOM |bfVar#130|) + (PROGN (SETQ |i| (CAR |bfVar#130|)) NIL)) + (RETURN (NREVERSE |bfVar#131|))) (T (AND (NOT (EQ |i| 'DOT)) - (SETQ |bfVar#127| + (SETQ |bfVar#131| (CONS (LIST |i| (|bfCARCDR| |j| |g|)) - |bfVar#127|))))) - (SETQ |bfVar#126| (CDR |bfVar#126|)) + |bfVar#131|))))) + (SETQ |bfVar#130| (CDR |bfVar#130|)) (SETQ |j| (+ |j| 1))))) (COND ((NULL |b|) (LIST (CAR |x|) |y|)) @@ -2067,27 +2073,120 @@ (DEFUN |bfDs| (|n|) (COND ((EQL |n| 0) "") (T (CONCAT "D" (|bfDs| (- |n| 1)))))) +(DEFUN |bfHandlers| (|n| |e| |hs|) + (|bfHandlers,main| |n| |e| |hs| NIL)) + +(DEFUN |bfHandlers,main| (|n| |e| |hs| |xs|) + (PROG (|hs'| |s| |ISTMP#6| |t| |ISTMP#5| |v| |ISTMP#4| |ISTMP#3| + |ISTMP#2| |ISTMP#1|) + (RETURN + (COND + ((NULL |hs|) + (LIST 'COND + (NREVERSE (CONS (LIST T + (LIST 'THROW + :OPEN-AXIOM-CATCH-POINT |n|)) + |xs|)))) + ((AND (CONSP |hs|) + (PROGN + (SETQ |ISTMP#1| (CAR |hs|)) + (AND (CONSP |ISTMP#1|) (EQ (CAR |ISTMP#1|) '|%Catch|) + (PROGN + (SETQ |ISTMP#2| (CDR |ISTMP#1|)) + (AND (CONSP |ISTMP#2|) + (PROGN + (SETQ |ISTMP#3| (CAR |ISTMP#2|)) + (AND (CONSP |ISTMP#3|) + (EQ (CAR |ISTMP#3|) '|%Signature|) + (PROGN + (SETQ |ISTMP#4| (CDR |ISTMP#3|)) + (AND (CONSP |ISTMP#4|) + (PROGN + (SETQ |v| (CAR |ISTMP#4|)) + (SETQ |ISTMP#5| + (CDR |ISTMP#4|)) + (AND (CONSP |ISTMP#5|) + (NULL (CDR |ISTMP#5|)) + (PROGN + (SETQ |t| (CAR |ISTMP#5|)) + T))))))) + (PROGN + (SETQ |ISTMP#6| (CDR |ISTMP#2|)) + (AND (CONSP |ISTMP#6|) + (NULL (CDR |ISTMP#6|)) + (PROGN + (SETQ |s| (CAR |ISTMP#6|)) + T)))))))) + (SETQ |hs'| (CDR |hs|)) + (SETQ |t| + (COND + ((SYMBOLP |t|) (LIST 'QUOTE (LIST |t|))) + (T (LIST 'QUOTE |t|)))) + (|bfHandlers,main| |n| |e| |hs'| + (CONS (LIST (|bfQ| (LIST 'CAR |e|) |t|) + (LIST 'LET (LIST (LIST |v| (LIST 'CDR |e|))) + |s|)) + |xs|))) + (T (|bpTrap|)))))) + +(DEFUN |codeForCatchHandlers| (|g| |e| |cs|) + (PROG (|ehTest|) + (RETURN + (PROGN + (SETQ |ehTest| + (LIST 'AND (LIST 'CONSP |g|) + (LIST (|bfQ| (LIST 'CAR |g|) + :OPEN-AXIOM-CATCH-POINT)))) + (LIST 'LET + (LIST (LIST |g| + (LIST 'CATCH :OPEN-AXIOM-CATCH-POINT |e|))) + (LIST 'COND + (LIST |ehTest| + (|bfHandlers| |g| (LIST 'CDR |g|) |cs|)) + (LIST T |g|))))))) + (DECLAIM (FTYPE (FUNCTION (|%Thing| |%List|) |%Thing|) |bfTry|)) (DEFUN |bfTry| (|e| |cs|) - (COND - ((NULL |cs|) |e|) - (T (LET ((|bfVar#128| (CAR |cs|))) - (CASE (CAR |bfVar#128|) - (|%Catch| - (LET ((|tag| (CADR |bfVar#128|))) - (COND - ((ATOM |tag|) - (|bfTry| (LIST 'CATCH (LIST 'QUOTE |tag|) |e|) - (CDR |cs|))) - (T (|bpTrap|))))) - (T (|bpTrap|))))))) + (PROG (|s| |cs'| |f| |ISTMP#1| |g|) + (RETURN + (PROGN + (SETQ |g| (GENSYM)) + (COND + ((AND (CONSP |cs|) (PROGN (SETQ |ISTMP#1| (REVERSE |cs|)) T) + (CONSP |ISTMP#1|) + (PROGN + (SETQ |f| (CAR |ISTMP#1|)) + (SETQ |cs'| (CDR |ISTMP#1|)) + T) + (PROGN (SETQ |cs'| (NREVERSE |cs'|)) T) (CONSP |f|) + (EQ (CAR |f|) '|%Finally|) + (PROGN + (SETQ |ISTMP#1| (CDR |f|)) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) + (PROGN (SETQ |s| (CAR |ISTMP#1|)) T)))) + (COND + ((NULL |cs'|) (LIST 'UNWIND-PROTECT |e| |s|)) + (T (LIST 'UNWIND-PROTECT + (|codeForCatchHandlers| |g| |e| |cs'|) |s|)))) + (T (|codeForCatchHandlers| |g| |e| |cs|))))))) (DEFUN |bfThrow| (|e|) - (COND - ((ATOM |e|) (LIST 'THROW (LIST 'QUOTE |e|) NIL)) - ((NOT (ATOM (CAR |e|))) (|bpTrap|)) - (T (CONS 'THROW (CONS (LIST 'QUOTE (CAR |e|)) (CDR |e|)))))) + (PROG (|x| |t|) + (RETURN + (PROGN + (SETQ |t| NIL) + (SETQ |x| NIL) + (COND + ((AND (CONSP |e|) (EQ (CAR |e|) '|%Pretend|)) + (SETQ |t| (CADDR |e|)) (SETQ |x| (CADR |e|))) + (T (SETQ |t| '|SystemException|) (SETQ |x| |e|))) + (SETQ |t| + (COND + ((SYMBOLP |t|) (LIST 'QUOTE (LIST |t|))) + (T (LIST 'QOUTE |t|)))) + (LIST 'THROW :OPEN-AXIOM-CATCH-POINT + (LIST 'CONS :OPEN-AXIOM-CATCH-POINT (LIST 'CONS |t| |x|))))))) (DEFUN |backquote| (|form| |params|) (COND @@ -2095,16 +2194,16 @@ ((ATOM |form|) (COND ((MEMBER |form| |params|) |form|) (T (|quote| |form|)))) (T (CONS 'LIST - (LET ((|bfVar#130| NIL) (|bfVar#129| |form|) (|t| NIL)) + (LET ((|bfVar#133| NIL) (|bfVar#132| |form|) (|t| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#129|) - (PROGN (SETQ |t| (CAR |bfVar#129|)) NIL)) - (RETURN (NREVERSE |bfVar#130|))) - (T (SETQ |bfVar#130| + ((OR (ATOM |bfVar#132|) + (PROGN (SETQ |t| (CAR |bfVar#132|)) NIL)) + (RETURN (NREVERSE |bfVar#133|))) + (T (SETQ |bfVar#133| (CONS (|backquote| |t| |params|) - |bfVar#130|)))) - (SETQ |bfVar#129| (CDR |bfVar#129|)))))))) + |bfVar#133|)))) + (SETQ |bfVar#132| (CDR |bfVar#132|)))))))) (DEFUN |genTypeAlias| (|head| |body|) (PROG (|args| |op|) @@ -2304,47 +2403,47 @@ (RETURN (PROGN (SETQ |argtypes| - (LET ((|bfVar#132| NIL) (|bfVar#131| |s|) (|x| NIL)) + (LET ((|bfVar#135| NIL) (|bfVar#134| |s|) (|x| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#131|) - (PROGN (SETQ |x| (CAR |bfVar#131|)) NIL)) - (RETURN (NREVERSE |bfVar#132|))) - (T (SETQ |bfVar#132| + ((OR (ATOM |bfVar#134|) + (PROGN (SETQ |x| (CAR |bfVar#134|)) NIL)) + (RETURN (NREVERSE |bfVar#135|))) + (T (SETQ |bfVar#135| (CONS (|nativeArgumentType| |x|) - |bfVar#132|)))) - (SETQ |bfVar#131| (CDR |bfVar#131|))))) + |bfVar#135|)))) + (SETQ |bfVar#134| (CDR |bfVar#134|))))) (SETQ |rettype| (|nativeReturnType| |t|)) (COND - ((LET ((|bfVar#134| T) (|bfVar#133| (CONS |t| |s|)) + ((LET ((|bfVar#137| T) (|bfVar#136| (CONS |t| |s|)) (|x| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#133|) - (PROGN (SETQ |x| (CAR |bfVar#133|)) NIL)) - (RETURN |bfVar#134|)) + ((OR (ATOM |bfVar#136|) + (PROGN (SETQ |x| (CAR |bfVar#136|)) NIL)) + (RETURN |bfVar#137|)) (T (PROGN - (SETQ |bfVar#134| (|isSimpleNativeType| |x|)) - (COND ((NOT |bfVar#134|) (RETURN NIL)))))) - (SETQ |bfVar#133| (CDR |bfVar#133|)))) + (SETQ |bfVar#137| (|isSimpleNativeType| |x|)) + (COND ((NOT |bfVar#137|) (RETURN NIL)))))) + (SETQ |bfVar#136| (CDR |bfVar#136|)))) (LIST (LIST 'DEFENTRY |op| |argtypes| (LIST |rettype| (PNAME |op'|))))) (T (SETQ |cop| (CONCAT (PNAME |op'|) "_stub")) (SETQ |cargs| - (LET ((|bfVar#141| NIL) - (|bfVar#140| (- (LENGTH |s|) 1)) (|i| 0)) + (LET ((|bfVar#144| NIL) + (|bfVar#143| (- (LENGTH |s|) 1)) (|i| 0)) (LOOP (COND - ((> |i| |bfVar#140|) - (RETURN (NREVERSE |bfVar#141|))) - (T (SETQ |bfVar#141| + ((> |i| |bfVar#143|) + (RETURN (NREVERSE |bfVar#144|))) + (T (SETQ |bfVar#144| (CONS (|genGCLnativeTranslation,mkCArgName| |i|) - |bfVar#141|)))) + |bfVar#144|)))) (SETQ |i| (+ |i| 1))))) (SETQ |ccode| - (LET ((|bfVar#137| "") - (|bfVar#139| + (LET ((|bfVar#140| "") + (|bfVar#142| (CONS (|genGCLnativeTranslation,gclTypeInC| |t|) (CONS " " @@ -2352,20 +2451,20 @@ (CONS "(" (APPEND (LET - ((|bfVar#135| NIL) (|x| |s|) + ((|bfVar#138| NIL) (|x| |s|) (|a| |cargs|)) (LOOP (COND ((OR (ATOM |x|) (ATOM |a|)) (RETURN - (NREVERSE |bfVar#135|))) + (NREVERSE |bfVar#138|))) (T - (SETQ |bfVar#135| + (SETQ |bfVar#138| (CONS (|genGCLnativeTranslation,cparm| |x| |a|) - |bfVar#135|)))) + |bfVar#138|)))) (SETQ |x| (CDR |x|)) (SETQ |a| (CDR |a|)))) (CONS ") { " @@ -2378,7 +2477,7 @@ (CONS "(" (APPEND (LET - ((|bfVar#136| NIL) + ((|bfVar#139| NIL) (|x| |s|) (|a| |cargs|)) (LOOP (COND @@ -2386,27 +2485,27 @@ (ATOM |a|)) (RETURN (NREVERSE - |bfVar#136|))) + |bfVar#139|))) (T - (SETQ |bfVar#136| + (SETQ |bfVar#139| (CONS (|genGCLnativeTranslation,gclArgsInC| |x| |a|) - |bfVar#136|)))) + |bfVar#139|)))) (SETQ |x| (CDR |x|)) (SETQ |a| (CDR |a|)))) (CONS "); }" NIL)))))))))))) - (|bfVar#138| NIL)) + (|bfVar#141| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#139|) + ((OR (ATOM |bfVar#142|) (PROGN - (SETQ |bfVar#138| (CAR |bfVar#139|)) + (SETQ |bfVar#141| (CAR |bfVar#142|)) NIL)) - (RETURN |bfVar#137|)) - (T (SETQ |bfVar#137| - (CONCAT |bfVar#137| |bfVar#138|)))) - (SETQ |bfVar#139| (CDR |bfVar#139|))))) + (RETURN |bfVar#140|)) + (T (SETQ |bfVar#140| + (CONCAT |bfVar#140| |bfVar#141|)))) + (SETQ |bfVar#142| (CDR |bfVar#142|))))) (LIST (LIST 'CLINES |ccode|) (LIST 'DEFENTRY |op| |argtypes| (LIST |rettype| |cop|))))))))) @@ -2466,17 +2565,17 @@ (PROGN (SETQ |args| NIL) (SETQ |argtypes| NIL) - (LET ((|bfVar#142| |s|) (|x| NIL)) + (LET ((|bfVar#145| |s|) (|x| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#142|) - (PROGN (SETQ |x| (CAR |bfVar#142|)) NIL)) + ((OR (ATOM |bfVar#145|) + (PROGN (SETQ |x| (CAR |bfVar#145|)) NIL)) (RETURN NIL)) (T (PROGN (SETQ |argtypes| (CONS (|nativeArgumentType| |x|) |argtypes|)) (SETQ |args| (CONS (GENSYM) |args|))))) - (SETQ |bfVar#142| (CDR |bfVar#142|)))) + (SETQ |bfVar#145| (CDR |bfVar#145|)))) (SETQ |args| (REVERSE |args|)) (SETQ |rettype| (|nativeReturnType| |t|)) (LIST (LIST 'DEFUN |op| |args| @@ -2487,39 +2586,39 @@ :ONE-LINER T))))))) (DEFUN |genECLnativeTranslation,callTemplate| (|op| |n| |s|) - (LET ((|bfVar#146| "") - (|bfVar#148| + (LET ((|bfVar#149| "") + (|bfVar#151| (CONS (PNAME |op|) (CONS "(" - (APPEND (LET ((|bfVar#145| NIL) - (|bfVar#143| (- |n| 1)) (|i| 0) - (|bfVar#144| |s|) (|x| NIL)) + (APPEND (LET ((|bfVar#148| NIL) + (|bfVar#146| (- |n| 1)) (|i| 0) + (|bfVar#147| |s|) (|x| NIL)) (LOOP (COND - ((OR (> |i| |bfVar#143|) - (ATOM |bfVar#144|) + ((OR (> |i| |bfVar#146|) + (ATOM |bfVar#147|) (PROGN - (SETQ |x| (CAR |bfVar#144|)) + (SETQ |x| (CAR |bfVar#147|)) NIL)) - (RETURN (NREVERSE |bfVar#145|))) + (RETURN (NREVERSE |bfVar#148|))) (T - (SETQ |bfVar#145| + (SETQ |bfVar#148| (CONS (|genECLnativeTranslation,sharpArg| |i| |x|) - |bfVar#145|)))) + |bfVar#148|)))) (SETQ |i| (+ |i| 1)) - (SETQ |bfVar#144| - (CDR |bfVar#144|)))) + (SETQ |bfVar#147| + (CDR |bfVar#147|)))) (CONS ")" NIL))))) - (|bfVar#147| NIL)) + (|bfVar#150| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#148|) - (PROGN (SETQ |bfVar#147| (CAR |bfVar#148|)) NIL)) - (RETURN |bfVar#146|)) - (T (SETQ |bfVar#146| (CONCAT |bfVar#146| |bfVar#147|)))) - (SETQ |bfVar#148| (CDR |bfVar#148|))))) + ((OR (ATOM |bfVar#151|) + (PROGN (SETQ |bfVar#150| (CAR |bfVar#151|)) NIL)) + (RETURN |bfVar#149|)) + (T (SETQ |bfVar#149| (CONCAT |bfVar#149| |bfVar#150|)))) + (SETQ |bfVar#151| (CDR |bfVar#151|))))) (DEFUN |genECLnativeTranslation,sharpArg| (|i| |x|) (COND @@ -2559,38 +2658,38 @@ (PROGN (SETQ |rettype| (|nativeReturnType| |t|)) (SETQ |argtypes| - (LET ((|bfVar#150| NIL) (|bfVar#149| |s|) (|x| NIL)) + (LET ((|bfVar#153| NIL) (|bfVar#152| |s|) (|x| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#149|) - (PROGN (SETQ |x| (CAR |bfVar#149|)) NIL)) - (RETURN (NREVERSE |bfVar#150|))) - (T (SETQ |bfVar#150| + ((OR (ATOM |bfVar#152|) + (PROGN (SETQ |x| (CAR |bfVar#152|)) NIL)) + (RETURN (NREVERSE |bfVar#153|))) + (T (SETQ |bfVar#153| (CONS (|nativeArgumentType| |x|) - |bfVar#150|)))) - (SETQ |bfVar#149| (CDR |bfVar#149|))))) + |bfVar#153|)))) + (SETQ |bfVar#152| (CDR |bfVar#152|))))) (SETQ |n| (INTERN (CONCAT (PNAME |op|) "%clisp-hack"))) (SETQ |parms| - (LET ((|bfVar#152| NIL) (|bfVar#151| |s|) (|x| NIL)) + (LET ((|bfVar#155| NIL) (|bfVar#154| |s|) (|x| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#151|) - (PROGN (SETQ |x| (CAR |bfVar#151|)) NIL)) - (RETURN (NREVERSE |bfVar#152|))) - (T (SETQ |bfVar#152| - (CONS (GENSYM "parm") |bfVar#152|)))) - (SETQ |bfVar#151| (CDR |bfVar#151|))))) + ((OR (ATOM |bfVar#154|) + (PROGN (SETQ |x| (CAR |bfVar#154|)) NIL)) + (RETURN (NREVERSE |bfVar#155|))) + (T (SETQ |bfVar#155| + (CONS (GENSYM "parm") |bfVar#155|)))) + (SETQ |bfVar#154| (CDR |bfVar#154|))))) (SETQ |unstableArgs| NIL) - (LET ((|bfVar#153| |parms|) (|p| NIL) (|bfVar#154| |s|) - (|x| NIL) (|bfVar#155| |argtypes|) (|y| NIL)) + (LET ((|bfVar#156| |parms|) (|p| NIL) (|bfVar#157| |s|) + (|x| NIL) (|bfVar#158| |argtypes|) (|y| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#153|) - (PROGN (SETQ |p| (CAR |bfVar#153|)) NIL) - (ATOM |bfVar#154|) - (PROGN (SETQ |x| (CAR |bfVar#154|)) NIL) - (ATOM |bfVar#155|) - (PROGN (SETQ |y| (CAR |bfVar#155|)) NIL)) + ((OR (ATOM |bfVar#156|) + (PROGN (SETQ |p| (CAR |bfVar#156|)) NIL) + (ATOM |bfVar#157|) + (PROGN (SETQ |x| (CAR |bfVar#157|)) NIL) + (ATOM |bfVar#158|) + (PROGN (SETQ |y| (CAR |bfVar#158|)) NIL)) (RETURN NIL)) (T (COND ((|needsStableReference?| |x|) @@ -2598,31 +2697,31 @@ (SETQ |unstableArgs| (CONS (CONS |p| (CONS |x| |y|)) |unstableArgs|))))))) - (SETQ |bfVar#153| (CDR |bfVar#153|)) - (SETQ |bfVar#154| (CDR |bfVar#154|)) - (SETQ |bfVar#155| (CDR |bfVar#155|)))) + (SETQ |bfVar#156| (CDR |bfVar#156|)) + (SETQ |bfVar#157| (CDR |bfVar#157|)) + (SETQ |bfVar#158| (CDR |bfVar#158|)))) (SETQ |foreignDecl| (LIST (|bfColonColon| 'FFI 'DEF-CALL-OUT) |n| (LIST :NAME (PNAME |op'|)) (CONS :ARGUMENTS - (LET ((|bfVar#158| NIL) - (|bfVar#156| |argtypes|) (|x| NIL) - (|bfVar#157| |parms|) (|a| NIL)) + (LET ((|bfVar#161| NIL) + (|bfVar#159| |argtypes|) (|x| NIL) + (|bfVar#160| |parms|) (|a| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#156|) + ((OR (ATOM |bfVar#159|) (PROGN - (SETQ |x| (CAR |bfVar#156|)) + (SETQ |x| (CAR |bfVar#159|)) NIL) - (ATOM |bfVar#157|) + (ATOM |bfVar#160|) (PROGN - (SETQ |a| (CAR |bfVar#157|)) + (SETQ |a| (CAR |bfVar#160|)) NIL)) - (RETURN (NREVERSE |bfVar#158|))) - (T (SETQ |bfVar#158| - (CONS (LIST |a| |x|) |bfVar#158|)))) - (SETQ |bfVar#156| (CDR |bfVar#156|)) - (SETQ |bfVar#157| (CDR |bfVar#157|))))) + (RETURN (NREVERSE |bfVar#161|))) + (T (SETQ |bfVar#161| + (CONS (LIST |a| |x|) |bfVar#161|)))) + (SETQ |bfVar#159| (CDR |bfVar#159|)) + (SETQ |bfVar#160| (CDR |bfVar#160|))))) (LIST :RETURN-TYPE |rettype|) (LIST :LANGUAGE :STDC))) (SETQ |forwardingFun| @@ -2630,66 +2729,66 @@ ((NULL |unstableArgs|) (LIST 'DEFUN |op| |parms| (CONS |n| |parms|))) (T (SETQ |localPairs| - (LET ((|bfVar#161| NIL) - (|bfVar#160| |unstableArgs|) - (|bfVar#159| NIL)) + (LET ((|bfVar#164| NIL) + (|bfVar#163| |unstableArgs|) + (|bfVar#162| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#160|) + ((OR (ATOM |bfVar#163|) (PROGN - (SETQ |bfVar#159| - (CAR |bfVar#160|)) + (SETQ |bfVar#162| + (CAR |bfVar#163|)) NIL)) - (RETURN (NREVERSE |bfVar#161|))) - (T (AND (CONSP |bfVar#159|) + (RETURN (NREVERSE |bfVar#164|))) + (T (AND (CONSP |bfVar#162|) (PROGN - (SETQ |a| (CAR |bfVar#159|)) + (SETQ |a| (CAR |bfVar#162|)) (SETQ |ISTMP#1| - (CDR |bfVar#159|)) + (CDR |bfVar#162|)) (AND (CONSP |ISTMP#1|) (PROGN (SETQ |x| (CAR |ISTMP#1|)) (SETQ |y| (CDR |ISTMP#1|)) T))) - (SETQ |bfVar#161| + (SETQ |bfVar#164| (CONS (CONS |a| (CONS |x| (CONS |y| (GENSYM "loc")))) - |bfVar#161|))))) - (SETQ |bfVar#160| (CDR |bfVar#160|))))) + |bfVar#164|))))) + (SETQ |bfVar#163| (CDR |bfVar#163|))))) (SETQ |call| (CONS |n| - (LET ((|bfVar#163| NIL) - (|bfVar#162| |parms|) (|p| NIL)) + (LET ((|bfVar#166| NIL) + (|bfVar#165| |parms|) (|p| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#162|) + ((OR (ATOM |bfVar#165|) (PROGN - (SETQ |p| (CAR |bfVar#162|)) + (SETQ |p| (CAR |bfVar#165|)) NIL)) - (RETURN (NREVERSE |bfVar#163|))) + (RETURN (NREVERSE |bfVar#166|))) (T - (SETQ |bfVar#163| + (SETQ |bfVar#166| (CONS (|genCLISPnativeTranslation,actualArg| |p| |localPairs|) - |bfVar#163|)))) - (SETQ |bfVar#162| (CDR |bfVar#162|)))))) + |bfVar#166|)))) + (SETQ |bfVar#165| (CDR |bfVar#165|)))))) (SETQ |call| (PROGN (SETQ |fixups| - (LET ((|bfVar#165| NIL) - (|bfVar#164| |localPairs|) + (LET ((|bfVar#168| NIL) + (|bfVar#167| |localPairs|) (|p| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#164|) + ((OR (ATOM |bfVar#167|) (PROGN - (SETQ |p| (CAR |bfVar#164|)) + (SETQ |p| (CAR |bfVar#167|)) NIL)) (RETURN - (NREVERSE |bfVar#165|))) + (NREVERSE |bfVar#168|))) (T (AND (NOT @@ -2697,26 +2796,26 @@ (SETQ |q| (|genCLISPnativeTranslation,copyBack| |p|)))) - (SETQ |bfVar#165| - (CONS |q| |bfVar#165|))))) - (SETQ |bfVar#164| - (CDR |bfVar#164|))))) + (SETQ |bfVar#168| + (CONS |q| |bfVar#168|))))) + (SETQ |bfVar#167| + (CDR |bfVar#167|))))) (COND ((NULL |fixups|) (LIST |call|)) (T (LIST (CONS 'PROG1 (CONS |call| |fixups|))))))) - (LET ((|bfVar#167| |localPairs|) (|bfVar#166| NIL)) + (LET ((|bfVar#170| |localPairs|) (|bfVar#169| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#167|) + ((OR (ATOM |bfVar#170|) (PROGN - (SETQ |bfVar#166| (CAR |bfVar#167|)) + (SETQ |bfVar#169| (CAR |bfVar#170|)) NIL)) (RETURN NIL)) - (T (AND (CONSP |bfVar#166|) + (T (AND (CONSP |bfVar#169|) (PROGN - (SETQ |p| (CAR |bfVar#166|)) - (SETQ |ISTMP#1| (CDR |bfVar#166|)) + (SETQ |p| (CAR |bfVar#169|)) + (SETQ |ISTMP#1| (CDR |bfVar#169|)) (AND (CONSP |ISTMP#1|) (PROGN (SETQ |x| (CAR |ISTMP#1|)) @@ -2739,18 +2838,18 @@ |p|) |p|) |call|))))))) - (SETQ |bfVar#167| (CDR |bfVar#167|)))) + (SETQ |bfVar#170| (CDR |bfVar#170|)))) (CONS 'DEFUN (CONS |op| (CONS |parms| |call|)))))) (SETQ |$foreignsDefsForCLisp| (CONS |foreignDecl| |$foreignsDefsForCLisp|)) (LIST |forwardingFun|))))) -(DEFUN |genCLISPnativeTranslation,copyBack| (|bfVar#168|) +(DEFUN |genCLISPnativeTranslation,copyBack| (|bfVar#171|) (PROG (|a| |y| |x| |p|) (RETURN (PROGN - (SETQ |p| (CAR |bfVar#168|)) - (SETQ |x| (CADR . #0=(|bfVar#168|))) + (SETQ |p| (CAR |bfVar#171|)) + (SETQ |x| (CADR . #0=(|bfVar#171|))) (SETQ |y| (CADDR . #0#)) (SETQ |a| (CDDDR . #0#)) (COND @@ -2774,35 +2873,35 @@ (PROGN (SETQ |rettype| (|nativeReturnType| |t|)) (SETQ |argtypes| - (LET ((|bfVar#170| NIL) (|bfVar#169| |s|) (|x| NIL)) + (LET ((|bfVar#173| NIL) (|bfVar#172| |s|) (|x| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#169|) - (PROGN (SETQ |x| (CAR |bfVar#169|)) NIL)) - (RETURN (NREVERSE |bfVar#170|))) - (T (SETQ |bfVar#170| + ((OR (ATOM |bfVar#172|) + (PROGN (SETQ |x| (CAR |bfVar#172|)) NIL)) + (RETURN (NREVERSE |bfVar#173|))) + (T (SETQ |bfVar#173| (CONS (|nativeArgumentType| |x|) - |bfVar#170|)))) - (SETQ |bfVar#169| (CDR |bfVar#169|))))) + |bfVar#173|)))) + (SETQ |bfVar#172| (CDR |bfVar#172|))))) (SETQ |args| - (LET ((|bfVar#172| NIL) (|bfVar#171| |s|) (|x| NIL)) + (LET ((|bfVar#175| NIL) (|bfVar#174| |s|) (|x| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#171|) - (PROGN (SETQ |x| (CAR |bfVar#171|)) NIL)) - (RETURN (NREVERSE |bfVar#172|))) - (T (SETQ |bfVar#172| (CONS (GENSYM) |bfVar#172|)))) - (SETQ |bfVar#171| (CDR |bfVar#171|))))) + ((OR (ATOM |bfVar#174|) + (PROGN (SETQ |x| (CAR |bfVar#174|)) NIL)) + (RETURN (NREVERSE |bfVar#175|))) + (T (SETQ |bfVar#175| (CONS (GENSYM) |bfVar#175|)))) + (SETQ |bfVar#174| (CDR |bfVar#174|))))) (SETQ |unstableArgs| NIL) (SETQ |newArgs| NIL) - (LET ((|bfVar#173| |args|) (|a| NIL) (|bfVar#174| |s|) + (LET ((|bfVar#176| |args|) (|a| NIL) (|bfVar#177| |s|) (|x| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#173|) - (PROGN (SETQ |a| (CAR |bfVar#173|)) NIL) - (ATOM |bfVar#174|) - (PROGN (SETQ |x| (CAR |bfVar#174|)) NIL)) + ((OR (ATOM |bfVar#176|) + (PROGN (SETQ |a| (CAR |bfVar#176|)) NIL) + (ATOM |bfVar#177|) + (PROGN (SETQ |x| (CAR |bfVar#177|)) NIL)) (RETURN NIL)) (T (PROGN (SETQ |newArgs| @@ -2811,8 +2910,8 @@ (COND ((|needsStableReference?| |x|) (SETQ |unstableArgs| (CONS |a| |unstableArgs|))))))) - (SETQ |bfVar#173| (CDR |bfVar#173|)) - (SETQ |bfVar#174| (CDR |bfVar#174|)))) + (SETQ |bfVar#176| (CDR |bfVar#176|)) + (SETQ |bfVar#177| (CDR |bfVar#177|)))) (SETQ |op'| (COND ((|%hasFeature| :WIN32) (CONCAT "_" (PNAME |op'|))) @@ -2849,36 +2948,36 @@ (PROGN (SETQ |rettype| (|nativeReturnType| |t|)) (SETQ |argtypes| - (LET ((|bfVar#176| NIL) (|bfVar#175| |s|) (|x| NIL)) + (LET ((|bfVar#179| NIL) (|bfVar#178| |s|) (|x| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#175|) - (PROGN (SETQ |x| (CAR |bfVar#175|)) NIL)) - (RETURN (NREVERSE |bfVar#176|))) - (T (SETQ |bfVar#176| + ((OR (ATOM |bfVar#178|) + (PROGN (SETQ |x| (CAR |bfVar#178|)) NIL)) + (RETURN (NREVERSE |bfVar#179|))) + (T (SETQ |bfVar#179| (CONS (|nativeArgumentType| |x|) - |bfVar#176|)))) - (SETQ |bfVar#175| (CDR |bfVar#175|))))) + |bfVar#179|)))) + (SETQ |bfVar#178| (CDR |bfVar#178|))))) (SETQ |parms| - (LET ((|bfVar#178| NIL) (|bfVar#177| |s|) (|x| NIL)) + (LET ((|bfVar#181| NIL) (|bfVar#180| |s|) (|x| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#177|) - (PROGN (SETQ |x| (CAR |bfVar#177|)) NIL)) - (RETURN (NREVERSE |bfVar#178|))) - (T (SETQ |bfVar#178| - (CONS (GENSYM "parm") |bfVar#178|)))) - (SETQ |bfVar#177| (CDR |bfVar#177|))))) + ((OR (ATOM |bfVar#180|) + (PROGN (SETQ |x| (CAR |bfVar#180|)) NIL)) + (RETURN (NREVERSE |bfVar#181|))) + (T (SETQ |bfVar#181| + (CONS (GENSYM "parm") |bfVar#181|)))) + (SETQ |bfVar#180| (CDR |bfVar#180|))))) (SETQ |strPairs| NIL) (SETQ |aryPairs| NIL) - (LET ((|bfVar#179| |parms|) (|p| NIL) (|bfVar#180| |s|) + (LET ((|bfVar#182| |parms|) (|p| NIL) (|bfVar#183| |s|) (|x| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#179|) - (PROGN (SETQ |p| (CAR |bfVar#179|)) NIL) - (ATOM |bfVar#180|) - (PROGN (SETQ |x| (CAR |bfVar#180|)) NIL)) + ((OR (ATOM |bfVar#182|) + (PROGN (SETQ |p| (CAR |bfVar#182|)) NIL) + (ATOM |bfVar#183|) + (PROGN (SETQ |x| (CAR |bfVar#183|)) NIL)) (RETURN NIL)) (T (COND ((EQ |x| '|string|) @@ -2900,33 +2999,33 @@ (NULL (CDR |ISTMP#3|))))))))) (SETQ |aryPairs| (CONS (CONS |p| (GENSYM "loc")) |aryPairs|)))))) - (SETQ |bfVar#179| (CDR |bfVar#179|)) - (SETQ |bfVar#180| (CDR |bfVar#180|)))) + (SETQ |bfVar#182| (CDR |bfVar#182|)) + (SETQ |bfVar#183| (CDR |bfVar#183|)))) (COND ((|%hasFeature| :DARWIN) (SETQ |op'| (CONCAT '_ |op'|)))) (SETQ |call| (CONS (|bfColonColon| 'CCL 'EXTERNAL-CALL) (CONS (STRING |op'|) - (APPEND (LET ((|bfVar#183| NIL) - (|bfVar#181| |argtypes|) - (|x| NIL) (|bfVar#182| |parms|) + (APPEND (LET ((|bfVar#186| NIL) + (|bfVar#184| |argtypes|) + (|x| NIL) (|bfVar#185| |parms|) (|p| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#181|) + ((OR (ATOM |bfVar#184|) (PROGN (SETQ |x| - (CAR |bfVar#181|)) + (CAR |bfVar#184|)) NIL) - (ATOM |bfVar#182|) + (ATOM |bfVar#185|) (PROGN (SETQ |p| - (CAR |bfVar#182|)) + (CAR |bfVar#185|)) NIL)) (RETURN - (NREVERSE |bfVar#183|))) + (NREVERSE |bfVar#186|))) (T - (SETQ |bfVar#183| + (SETQ |bfVar#186| (APPEND (REVERSE (LIST |x| @@ -2938,45 +3037,45 @@ (ASSOC |p| |aryPairs|)) (CDR |p'|)) (T |p|)))) - |bfVar#183|)))) - (SETQ |bfVar#181| - (CDR |bfVar#181|)) - (SETQ |bfVar#182| - (CDR |bfVar#182|)))) + |bfVar#186|)))) + (SETQ |bfVar#184| + (CDR |bfVar#184|)) + (SETQ |bfVar#185| + (CDR |bfVar#185|)))) (CONS |rettype| NIL))))) (COND ((EQ |t| '|string|) (SETQ |call| (LIST (|bfColonColon| 'CCL 'GET-CSTRING) |call|)))) - (LET ((|bfVar#184| |aryPairs|) (|arg| NIL)) + (LET ((|bfVar#187| |aryPairs|) (|arg| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#184|) - (PROGN (SETQ |arg| (CAR |bfVar#184|)) NIL)) + ((OR (ATOM |bfVar#187|) + (PROGN (SETQ |arg| (CAR |bfVar#187|)) NIL)) (RETURN NIL)) (T (SETQ |call| (LIST (|bfColonColon| 'CCL 'WITH-POINTER-TO-IVECTOR) (LIST (CDR |arg|) (CAR |arg|)) |call|)))) - (SETQ |bfVar#184| (CDR |bfVar#184|)))) + (SETQ |bfVar#187| (CDR |bfVar#187|)))) (COND (|strPairs| (SETQ |call| (LIST (|bfColonColon| 'CCL 'WITH-CSTRS) - (LET ((|bfVar#186| NIL) - (|bfVar#185| |strPairs|) (|arg| NIL)) + (LET ((|bfVar#189| NIL) + (|bfVar#188| |strPairs|) (|arg| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#185|) + ((OR (ATOM |bfVar#188|) (PROGN - (SETQ |arg| (CAR |bfVar#185|)) + (SETQ |arg| (CAR |bfVar#188|)) NIL)) - (RETURN (NREVERSE |bfVar#186|))) - (T (SETQ |bfVar#186| + (RETURN (NREVERSE |bfVar#189|))) + (T (SETQ |bfVar#189| (CONS (LIST (CDR |arg|) (CAR |arg|)) - |bfVar#186|)))) - (SETQ |bfVar#185| (CDR |bfVar#185|)))) + |bfVar#189|)))) + (SETQ |bfVar#188| (CDR |bfVar#188|)))) |call|)))) (LIST (LIST 'DEFUN |op| |parms| |call|)))))) diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp index 078f48a7..e009d80d 100644 --- a/src/boot/strap/parser.clisp +++ b/src/boot/strap/parser.clisp @@ -317,12 +317,18 @@ (DEFUN |bpMissing| (|s|) (PROGN (|bpSpecificErrorHere| (CONCAT (PNAME |s|) " possibly missing")) - (THROW 'TRAPPOINT 'TRAPPED))) + (THROW :OPEN-AXIOM-CATCH-POINT + (CONS :OPEN-AXIOM-CATCH-POINT + (CONS '(|SystemException|) (TRAPPOINT 'TRAPPED)))))) (DEFUN |bpCompMissing| (|s|) (OR (|bpEqKey| |s|) (|bpMissing| |s|))) (DEFUN |bpTrap| () - (PROGN (|bpGeneralErrorHere|) (THROW 'TRAPPOINT 'TRAPPED))) + (PROGN + (|bpGeneralErrorHere|) + (THROW :OPEN-AXIOM-CATCH-POINT + (CONS :OPEN-AXIOM-CATCH-POINT + (CONS '(|SystemException|) (TRAPPOINT 'TRAPPED)))))) (DEFUN |bpRecoverTrap| () (PROG (|pos2| |pos1|) @@ -731,40 +737,61 @@ (DEFUN |bpAnd| () (|bpLeftAssoc| '(AND) #'|bpCompare|)) (DEFUN |bpThrow| () - (AND (|bpEqKey| 'THROW) (|bpApplication|) - (|bpPush| (|bfThrow| (|bpPop1|))))) + (COND + ((AND (|bpEqKey| 'THROW) (|bpApplication|)) + (COND + ((|bpEqKey| 'COLON) (OR (|bpApplication|) (|bpTrap|)) + (|bpPush| (|%Pretend| (|bpPop2|) (|bpPop1|))))) + (|bpPush| (|bfThrow| (|bpPop1|)))) + (T NIL))) (DEFUN |bpTry| () - (AND (|bpEqKey| 'TRY) (|bpAssign|) (OR (|bpEqKey| 'BACKSET) T) - (OR (|bpEqKey| 'CATCH) (|bpMissing| 'CATCH)) - (OR (|bpPiledCatchItems|) (|bpSimpleCatch|) (|bpTrap|)) - (|bpPush| (|bfTry| (|bpPop2|) (|bpPop1|))))) - -(DEFUN |bpSimpleCatch| () - (AND (|bpCatchItem|) (|bpPush| (LIST (|bpPop1|))))) - -(DEFUN |bpPiledCatchItems| () (|bpPileBracketed| #'|bpCatchItemList|)) - -(DEFUN |bpCatchItemList| () (|bpListAndRecover| #'|bpCatchItem|)) + (PROG (|cs|) + (RETURN + (COND + ((|bpEqKey| 'TRY) (|bpAssign|) (SETQ |cs| NIL) + (LOOP + (COND + ((NOT (|bpHandler| 'CATCH)) (RETURN NIL)) + (T (PROGN + (|bpCatchItem|) + (SETQ |cs| (CONS (|bpPop1|) |cs|)))))) + (COND + ((|bpHandler| 'FINALLY) + (AND (|bpFinally|) + (|bpPush| + (|bfTry| (|bpPop2|) + (NREVERSE (CONS (|bpPop1|) |cs|)))))) + ((NULL |cs|) (|bpTrap|)) + (T (|bpPush| (|bfTry| (|bpPop1|) (NREVERSE |cs|)))))) + (T NIL))))) -(DEFUN |bpExceptionHead| () - (OR (AND (OR (|bpName|) (|bpTrap|)) - (OR (AND (|bpParenthesized| #'|bpIdList|) - (|bpPush| (|bfNameArgs| (|bpPop2|) (|bpPop1|)))) - (AND (|bpName|) - (|bpPush| (|bfNameArgs| (|bpPop2|) (|bpPop1|)))))) - T)) +(DEFUN |bpCatchItem| () + (AND (OR (|bpExceptionVariable|) (|bpTrap|)) + (OR (|bpEqKey| 'EXIT) (|bpTrap|)) (OR (|bpAssign|) (|bpTrap|)) + (|bpPush| (|%Catch| (|bpPop2|) (|bpPop1|))))) -(DEFUN |bpExceptionTail| () - (AND (|bpEqKey| 'EXIT) (OR (|bpAssign|) (|bpTrap|)) - (|bpPush| (|%Exit| (|bpPop2|) (|bpPop1|))))) +(DEFUN |bpExceptionVariable| () + (PROG (|t|) + (DECLARE (SPECIAL |$stok|)) + (RETURN + (PROGN + (SETQ |t| |$stok|) + (OR (AND (|bpEqKey| 'OPAREN) (OR (|bpSignature|) (|bpTrap|)) + (OR (|bpEqKey| 'CPAREN) (|bpMissing| |t|))) + (|bpTrap|)))))) -(DEFUN |bpException| () - (AND (|bpExceptionHead|) (OR (|bpExceptionTail|) T))) +(DEFUN |bpFinally| () + (AND (OR (|bpAssign|) (|bpTrap|)) (|bpPush| (|%Finally| (|bpPop1|))))) -(DEFUN |bpCatchItem| () - (AND (OR (|bpException|) (|bpTrap|)) - (|bpPush| (|%Catch| (|bpPop1|))))) +(DEFUN |bpHandler| (|key|) + (PROG (|s|) + (RETURN + (PROGN + (SETQ |s| (|bpState|)) + (COND + ((AND (|bpEqKey| 'BACKSET) (|bpEqKey| |key|)) T) + (T (|bpRestore| |s|) NIL)))))) (DEFUN |bpLeave| () (AND (|bpEqKey| 'LEAVE) (OR (|bpLogical|) (|bpTrap|)) diff --git a/src/boot/translator.boot b/src/boot/translator.boot index 001901ab..1ae7a639 100644 --- a/src/boot/translator.boot +++ b/src/boot/translator.boot @@ -363,7 +363,7 @@ shoeOutParse stream == $bpCount := 0 $bpParenCount := 0 bpFirstTok() - found := try bpOutItem() catch TRAPPOINT + found := CATCH('TRAPPOINT,bpOutItem()) --try bpOutItem() catch TRAPPOINT found = "TRAPPED" => nil not bStreamNull $inputStream => bpGeneralErrorHere() -- cgit v1.2.3