aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2010-12-11 18:52:23 +0000
committerdos-reis <gdr@axiomatics.org>2010-12-11 18:52:23 +0000
commit0835ad7e9a8e7f90f61b633fd74304f00b07d386 (patch)
tree8cf1d362e2edf28abb4f0c734e27d89c8505806f
parentf8e7728606692cfb26816637c0622007758d9ae5 (diff)
downloadopen-axiom-0835ad7e9a8e7f90f61b633fd74304f00b07d386.tar.gz
* 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.
Diffstat
-rw-r--r--src/ChangeLog20
-rw-r--r--src/boot/ast.boot49
-rw-r--r--src/boot/parser.boot77
-rw-r--r--src/boot/strap/ast.clisp939
-rw-r--r--src/boot/strap/parser.clisp87
-rw-r--r--src/boot/translator.boot2
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 <gdr@cs.tamu.edu>
+
+ * 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 <gdr@cs.tamu.edu>
* 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()
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-02 10:41:53 +0000