aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xconfigure18
-rw-r--r--configure.ac2
-rw-r--r--configure.ac.pamphlet2
-rw-r--r--src/ChangeLog8
-rw-r--r--src/boot/ast.boot13
-rw-r--r--src/boot/strap/ast.clisp630
-rw-r--r--src/boot/strap/scanner.clisp3
-rw-r--r--src/boot/strap/tokens.clisp11
-rw-r--r--src/boot/tokens.boot2
-rw-r--r--src/interp/ax.boot6
10 files changed, 370 insertions, 325 deletions
diff --git a/configure b/configure
index 30a04657..9ca76e60 100755
--- a/configure
+++ b/configure
@@ -1,6 +1,6 @@
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.63 for OpenAxiom 1.4.0-2009-09-21.
+# Generated by GNU Autoconf 2.63 for OpenAxiom 1.4.0-2009-09-24.
#
# Report bugs to <open-axiom-bugs@lists.sf.net>.
#
@@ -745,8 +745,8 @@ SHELL=${CONFIG_SHELL-/bin/sh}
# Identity of this package.
PACKAGE_NAME='OpenAxiom'
PACKAGE_TARNAME='openaxiom'
-PACKAGE_VERSION='1.4.0-2009-09-21'
-PACKAGE_STRING='OpenAxiom 1.4.0-2009-09-21'
+PACKAGE_VERSION='1.4.0-2009-09-24'
+PACKAGE_STRING='OpenAxiom 1.4.0-2009-09-24'
PACKAGE_BUGREPORT='open-axiom-bugs@lists.sf.net'
ac_unique_file="src/Makefile.pamphlet"
@@ -1498,7 +1498,7 @@ if test "$ac_init_help" = "long"; then
# Omit some internal or obsolete options to make the list less imposing.
# This message is too long to be a string in the A/UX 3.1 sh.
cat <<_ACEOF
-\`configure' configures OpenAxiom 1.4.0-2009-09-21 to adapt to many kinds of systems.
+\`configure' configures OpenAxiom 1.4.0-2009-09-24 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
@@ -1568,7 +1568,7 @@ fi
if test -n "$ac_init_help"; then
case $ac_init_help in
- short | recursive ) echo "Configuration of OpenAxiom 1.4.0-2009-09-21:";;
+ short | recursive ) echo "Configuration of OpenAxiom 1.4.0-2009-09-24:";;
esac
cat <<\_ACEOF
@@ -1671,7 +1671,7 @@ fi
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
-OpenAxiom configure 1.4.0-2009-09-21
+OpenAxiom configure 1.4.0-2009-09-24
generated by GNU Autoconf 2.63
Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
@@ -1685,7 +1685,7 @@ cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
-It was created by OpenAxiom $as_me 1.4.0-2009-09-21, which was
+It was created by OpenAxiom $as_me 1.4.0-2009-09-24, which was
generated by GNU Autoconf 2.63. Invocation command line was
$ $0 $@
@@ -17062,7 +17062,7 @@ exec 6>&1
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
-This file was extended by OpenAxiom $as_me 1.4.0-2009-09-21, which was
+This file was extended by OpenAxiom $as_me 1.4.0-2009-09-24, which was
generated by GNU Autoconf 2.63. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
@@ -17125,7 +17125,7 @@ Report bugs to <bug-autoconf@gnu.org>."
_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_version="\\
-OpenAxiom config.status 1.4.0-2009-09-21
+OpenAxiom config.status 1.4.0-2009-09-24
configured by $0, generated by GNU Autoconf 2.63,
with options \\"`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\"
diff --git a/configure.ac b/configure.ac
index 8a414dfc..50f731a1 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1,6 +1,6 @@
sinclude(config/open-axiom.m4)
sinclude(config/aclocal.m4)
-AC_INIT([OpenAxiom], [1.4.0-2009-09-21],
+AC_INIT([OpenAxiom], [1.4.0-2009-09-24],
[open-axiom-bugs@lists.sf.net])
AC_CONFIG_AUX_DIR(config)
diff --git a/configure.ac.pamphlet b/configure.ac.pamphlet
index efa5bcd5..5d27766a 100644
--- a/configure.ac.pamphlet
+++ b/configure.ac.pamphlet
@@ -1151,7 +1151,7 @@ information:
<<Autoconf init>>=
sinclude(config/open-axiom.m4)
sinclude(config/aclocal.m4)
-AC_INIT([OpenAxiom], [1.4.0-2009-09-21],
+AC_INIT([OpenAxiom], [1.4.0-2009-09-24],
[open-axiom-bugs@lists.sf.net])
@
diff --git a/src/ChangeLog b/src/ChangeLog
index fd6c09c2..390e0412 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,11 @@
+2009-09-24 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * boot/ast.boot (bfMember): New.
+ (bfInfApplication): Use it.
+ * boot/tokens.boot: Don't rename IN.
+ * interp/ax.boot (makeAxFile): Fix thinko.
+ (makeAxExportForm): Likewise.
+
2009-09-21 Gabriel Dos Reis <gdr@cs.tamu.edu>
* algebra/data.spad.pamphlet (SystemInteger): Tidy.
diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index 0e7b50a8..195ec126 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -680,7 +680,17 @@ bfApplication(bfop, bfarg) ==
bfReName x==
a := x has SHOERENAME => first a
x
-
+
+
+++ Generate code for a membership test `x in seq' where `seq'
+++ is a sequence (e.g. a list)
+bfMember(var,seq) ==
+ seq is ["QUOTE",seq'] and "and"/[SYMBOLP x for x in seq'] =>
+ ["MEMQ",var,seq]
+ var is ["QUOTE",var'] and SYMBOLP var' =>
+ ["MEMQ",var,seq]
+ ["MEMBER",var,seq]
+
bfInfApplication(op,left,right)==
op = "EQUAL" => bfQ(left,right)
op = "/=" => bfNOT bfQ(left,right)
@@ -690,6 +700,7 @@ bfInfApplication(op,left,right)==
op = ">=" => bfNOT bfLessp(left,right)
op = "OR" => bfOR [left,right]
op = "AND" => bfAND [left,right]
+ op = "IN" => bfMember(left,right)
[op,left,right]
bfNOT x==
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index 615c3f0d..f4633457 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -169,7 +169,7 @@
(DEFUN |bfColonColon| (|package| |name|)
(COND
- ((AND (|%hasFeature| :CLISP) (MEMBER |package| '(EXT FFI)))
+ ((AND (|%hasFeature| :CLISP) (MEMQ |package| '(EXT FFI)))
(FIND-SYMBOL (SYMBOL-NAME |name|) |package|))
(T (INTERN (SYMBOL-NAME |name|) |package|))))
@@ -1071,6 +1071,35 @@
(RETURN
(COND ((SETQ |a| (GET |x| 'SHOERENAME)) (CAR |a|)) (T |x|)))))
+(DEFUN |bfMember| (|var| |seq|)
+ (PROG (|var'| |seq'| |ISTMP#1|)
+ (RETURN
+ (COND
+ ((AND (CONSP |seq|) (EQ (CAR |seq|) 'QUOTE)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |seq|))
+ (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|))
+ (PROGN (SETQ |seq'| (CAR |ISTMP#1|)) T)))
+ (LET ((|bfVar#88| T) (|bfVar#87| |seq'|) (|x| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#87|)
+ (PROGN (SETQ |x| (CAR |bfVar#87|)) NIL))
+ (RETURN |bfVar#88|))
+ (T (PROGN
+ (SETQ |bfVar#88| (SYMBOLP |x|))
+ (COND ((NOT |bfVar#88|) (RETURN NIL))))))
+ (SETQ |bfVar#87| (CDR |bfVar#87|)))))
+ (LIST 'MEMQ |var| |seq|))
+ ((AND (CONSP |var|) (EQ (CAR |var|) 'QUOTE)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |var|))
+ (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|))
+ (PROGN (SETQ |var'| (CAR |ISTMP#1|)) T)))
+ (SYMBOLP |var'|))
+ (LIST 'MEMQ |var| |seq|))
+ (T (LIST 'MEMBER |var| |seq|))))))
+
(DEFUN |bfInfApplication| (|op| |left| |right|)
(COND
((EQ |op| 'EQUAL) (|bfQ| |left| |right|))
@@ -1081,6 +1110,7 @@
((EQ |op| '>=) (|bfNOT| (|bfLessp| |left| |right|)))
((EQ |op| 'OR) (|bfOR| (LIST |left| |right|)))
((EQ |op| 'AND) (|bfAND| (LIST |left| |right|)))
+ ((EQ |op| 'IN) (|bfMember| |left| |right|))
(T (LIST |op| |left| |right|))))
(DEFUN |bfNOT| (|x|)
@@ -1111,39 +1141,39 @@
((NULL |l|) NIL)
((NULL (CDR |l|)) (CAR |l|))
(T (CONS 'OR
- (LET ((|bfVar#88| NIL) (|bfVar#87| |l|) (|c| NIL))
+ (LET ((|bfVar#90| NIL) (|bfVar#89| |l|) (|c| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#87|)
- (PROGN (SETQ |c| (CAR |bfVar#87|)) NIL))
- (RETURN (NREVERSE |bfVar#88|)))
- (T (SETQ |bfVar#88|
+ ((OR (ATOM |bfVar#89|)
+ (PROGN (SETQ |c| (CAR |bfVar#89|)) NIL))
+ (RETURN (NREVERSE |bfVar#90|)))
+ (T (SETQ |bfVar#90|
(APPEND (REVERSE (|bfFlatten| 'OR |c|))
- |bfVar#88|))))
- (SETQ |bfVar#87| (CDR |bfVar#87|))))))))
+ |bfVar#90|))))
+ (SETQ |bfVar#89| (CDR |bfVar#89|))))))))
(DEFUN |bfAND| (|l|)
(COND
((NULL |l|) 'T)
((NULL (CDR |l|)) (CAR |l|))
(T (CONS 'AND
- (LET ((|bfVar#90| NIL) (|bfVar#89| |l|) (|c| NIL))
+ (LET ((|bfVar#92| NIL) (|bfVar#91| |l|) (|c| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#89|)
- (PROGN (SETQ |c| (CAR |bfVar#89|)) NIL))
- (RETURN (NREVERSE |bfVar#90|)))
- (T (SETQ |bfVar#90|
+ ((OR (ATOM |bfVar#91|)
+ (PROGN (SETQ |c| (CAR |bfVar#91|)) NIL))
+ (RETURN (NREVERSE |bfVar#92|)))
+ (T (SETQ |bfVar#92|
(APPEND (REVERSE (|bfFlatten| 'AND |c|))
- |bfVar#90|))))
- (SETQ |bfVar#89| (CDR |bfVar#89|))))))))
+ |bfVar#92|))))
+ (SETQ |bfVar#91| (CDR |bfVar#91|))))))))
(DEFUN |defQuoteId| (|x|)
(AND (CONSP |x|) (EQ (CAR |x|) 'QUOTE) (IDENTP (CADR |x|))))
(DEFUN |bfSmintable| (|x|)
(OR (INTEGERP |x|)
- (AND (CONSP |x|) (MEMBER (CAR |x|) '(SIZE LENGTH |char|)))))
+ (AND (CONSP |x|) (MEMQ (CAR |x|) '(SIZE LENGTH |char|)))))
(DEFUN |bfQ| (|l| |r|)
(COND
@@ -1176,52 +1206,52 @@
(SETQ |nargl| (CADDR . #0#))
(SETQ |largl| (CADDDR . #0#))
(SETQ |sb|
- (LET ((|bfVar#93| NIL) (|bfVar#91| |nargl|) (|i| NIL)
- (|bfVar#92| |sgargl|) (|j| NIL))
+ (LET ((|bfVar#95| NIL) (|bfVar#93| |nargl|) (|i| NIL)
+ (|bfVar#94| |sgargl|) (|j| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#91|)
- (PROGN (SETQ |i| (CAR |bfVar#91|)) NIL)
- (ATOM |bfVar#92|)
- (PROGN (SETQ |j| (CAR |bfVar#92|)) NIL))
- (RETURN (NREVERSE |bfVar#93|)))
- (T (SETQ |bfVar#93|
- (CONS (CONS |i| |j|) |bfVar#93|))))
- (SETQ |bfVar#91| (CDR |bfVar#91|))
- (SETQ |bfVar#92| (CDR |bfVar#92|)))))
+ ((OR (ATOM |bfVar#93|)
+ (PROGN (SETQ |i| (CAR |bfVar#93|)) NIL)
+ (ATOM |bfVar#94|)
+ (PROGN (SETQ |j| (CAR |bfVar#94|)) NIL))
+ (RETURN (NREVERSE |bfVar#95|)))
+ (T (SETQ |bfVar#95|
+ (CONS (CONS |i| |j|) |bfVar#95|))))
+ (SETQ |bfVar#93| (CDR |bfVar#93|))
+ (SETQ |bfVar#94| (CDR |bfVar#94|)))))
(SETQ |body| (SUBLIS |sb| |body|))
(SETQ |sb2|
- (LET ((|bfVar#96| NIL) (|bfVar#94| |sgargl|) (|i| NIL)
- (|bfVar#95| |largl|) (|j| NIL))
+ (LET ((|bfVar#98| NIL) (|bfVar#96| |sgargl|) (|i| NIL)
+ (|bfVar#97| |largl|) (|j| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#94|)
- (PROGN (SETQ |i| (CAR |bfVar#94|)) NIL)
- (ATOM |bfVar#95|)
- (PROGN (SETQ |j| (CAR |bfVar#95|)) NIL))
- (RETURN (NREVERSE |bfVar#96|)))
- (T (SETQ |bfVar#96|
+ ((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 (LIST 'CONS (LIST 'QUOTE |i|) |j|)
- |bfVar#96|))))
- (SETQ |bfVar#94| (CDR |bfVar#94|))
- (SETQ |bfVar#95| (CDR |bfVar#95|)))))
+ |bfVar#98|))))
+ (SETQ |bfVar#96| (CDR |bfVar#96|))
+ (SETQ |bfVar#97| (CDR |bfVar#97|)))))
(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#98| NIL) (|bfVar#97| |$wheredefs|)
+ (LET ((|bfVar#100| NIL) (|bfVar#99| |$wheredefs|)
(|d| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#97|)
- (PROGN (SETQ |d| (CAR |bfVar#97|)) NIL))
- (RETURN (NREVERSE |bfVar#98|)))
- (T (SETQ |bfVar#98|
+ ((OR (ATOM |bfVar#99|)
+ (PROGN (SETQ |d| (CAR |bfVar#99|)) NIL))
+ (RETURN (NREVERSE |bfVar#100|)))
+ (T (SETQ |bfVar#100|
(APPEND (REVERSE
(|shoeComps| (|bfDef1| |d|)))
- |bfVar#98|))))
- (SETQ |bfVar#97| (CDR |bfVar#97|)))))))))
+ |bfVar#100|))))
+ (SETQ |bfVar#99| (CDR |bfVar#99|)))))))))
(DEFUN |bfGargl| (|argl|)
(PROG (|f| |d| |c| |b| |a| |LETTMP#1|)
@@ -1241,13 +1271,13 @@
(LIST (CONS |f| |a|) (CONS |f| |b|)
(CONS (CAR |argl|) |c|) (CONS |f| |d|)))))))))
-(DEFUN |bfDef1| (|bfVar#99|)
+(DEFUN |bfDef1| (|bfVar#101|)
(PROG (|arglp| |control| |quotes| |LETTMP#1| |argl| |body| |args|
|op|)
(RETURN
(PROGN
- (SETQ |op| (CAR |bfVar#99|))
- (SETQ |args| (CADR . #0=(|bfVar#99|)))
+ (SETQ |op| (CAR |bfVar#101|))
+ (SETQ |args| (CADR . #0=(|bfVar#101|)))
(SETQ |body| (CADDR . #0#))
(SETQ |argl|
(COND
@@ -1288,30 +1318,30 @@
(SETQ |arg1| (CADDR . #0#)) (SETQ |body1| (CDDDR . #0#))
(|bfCompHash| |op1| |arg1| |body1|))
(T (|bfTuple|
- (LET ((|bfVar#101| NIL)
- (|bfVar#100|
+ (LET ((|bfVar#103| NIL)
+ (|bfVar#102|
(CONS (LIST |op| |args| |body|) |$wheredefs|))
(|d| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#100|)
- (PROGN (SETQ |d| (CAR |bfVar#100|)) NIL))
- (RETURN (NREVERSE |bfVar#101|)))
- (T (SETQ |bfVar#101|
+ ((OR (ATOM |bfVar#102|)
+ (PROGN (SETQ |d| (CAR |bfVar#102|)) NIL))
+ (RETURN (NREVERSE |bfVar#103|)))
+ (T (SETQ |bfVar#103|
(APPEND (REVERSE
(|shoeComps| (|bfDef1| |d|)))
- |bfVar#101|))))
- (SETQ |bfVar#100| (CDR |bfVar#100|))))))))))
+ |bfVar#103|))))
+ (SETQ |bfVar#102| (CDR |bfVar#102|))))))))))
(DEFUN |shoeComps| (|x|)
- (LET ((|bfVar#103| NIL) (|bfVar#102| |x|) (|def| NIL))
+ (LET ((|bfVar#105| NIL) (|bfVar#104| |x|) (|def| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#102|)
- (PROGN (SETQ |def| (CAR |bfVar#102|)) NIL))
- (RETURN (NREVERSE |bfVar#103|)))
- (T (SETQ |bfVar#103| (CONS (|shoeComp| |def|) |bfVar#103|))))
- (SETQ |bfVar#102| (CDR |bfVar#102|)))))
+ ((OR (ATOM |bfVar#104|)
+ (PROGN (SETQ |def| (CAR |bfVar#104|)) NIL))
+ (RETURN (NREVERSE |bfVar#105|)))
+ (T (SETQ |bfVar#105| (CONS (|shoeComp| |def|) |bfVar#105|))))
+ (SETQ |bfVar#104| (CDR |bfVar#104|)))))
(DEFUN |shoeComp| (|x|)
(PROG (|a|)
@@ -1451,18 +1481,18 @@
((ATOM |body|) NIL)
(T (SETQ |op| (CAR |body|)) (SETQ |args| (CDR |body|))
(COND
- ((MEMBER |op| '(RETURN RETURN-FROM)) T)
- ((MEMBER |op| '(LET PROG LOOP BLOCK DECLARE LAMBDA)) NIL)
- ((LET ((|bfVar#105| NIL) (|bfVar#104| |body|) (|t| NIL))
+ ((MEMQ |op| '(RETURN RETURN-FROM)) T)
+ ((MEMQ |op| '(LET PROG LOOP BLOCK DECLARE LAMBDA)) NIL)
+ ((LET ((|bfVar#107| NIL) (|bfVar#106| |body|) (|t| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#104|)
- (PROGN (SETQ |t| (CAR |bfVar#104|)) NIL))
- (RETURN |bfVar#105|))
+ ((OR (ATOM |bfVar#106|)
+ (PROGN (SETQ |t| (CAR |bfVar#106|)) NIL))
+ (RETURN |bfVar#107|))
(T (PROGN
- (SETQ |bfVar#105| (|needsPROG| |t|))
- (COND (|bfVar#105| (RETURN |bfVar#105|))))))
- (SETQ |bfVar#104| (CDR |bfVar#104|))))
+ (SETQ |bfVar#107| (|needsPROG| |t|))
+ (COND (|bfVar#107| (RETURN |bfVar#107|))))))
+ (SETQ |bfVar#106| (CDR |bfVar#106|))))
T)
(T NIL)))))))
@@ -1554,11 +1584,11 @@
(T (CONS (CADR |l|) |$fluidVars|))))
(RPLACA (CDR |x|) (CADR |l|)))))
((MEMQ U '(PROG LAMBDA)) (SETQ |newbindings| NIL)
- (LET ((|bfVar#106| (CADR |x|)) (|y| NIL))
+ (LET ((|bfVar#108| (CADR |x|)) (|y| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#106|)
- (PROGN (SETQ |y| (CAR |bfVar#106|)) NIL))
+ ((OR (ATOM |bfVar#108|)
+ (PROGN (SETQ |y| (CAR |bfVar#108|)) NIL))
(RETURN NIL))
(T (COND
((NOT (MEMQ |y| |$locVars|))
@@ -1567,22 +1597,22 @@
(SETQ |$locVars| (CONS |y| |$locVars|))
(SETQ |newbindings|
(CONS |y| |newbindings|))))))))
- (SETQ |bfVar#106| (CDR |bfVar#106|))))
+ (SETQ |bfVar#108| (CDR |bfVar#108|))))
(SETQ |res| (|shoeCompTran1| (CDDR |x|)))
(SETQ |$locVars|
- (LET ((|bfVar#108| NIL) (|bfVar#107| |$locVars|)
+ (LET ((|bfVar#110| NIL) (|bfVar#109| |$locVars|)
(|y| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#107|)
+ ((OR (ATOM |bfVar#109|)
(PROGN
- (SETQ |y| (CAR |bfVar#107|))
+ (SETQ |y| (CAR |bfVar#109|))
NIL))
- (RETURN (NREVERSE |bfVar#108|)))
+ (RETURN (NREVERSE |bfVar#110|)))
(T (AND (NOT (MEMQ |y| |newbindings|))
- (SETQ |bfVar#108|
- (CONS |y| |bfVar#108|)))))
- (SETQ |bfVar#107| (CDR |bfVar#107|))))))
+ (SETQ |bfVar#110|
+ (CONS |y| |bfVar#110|)))))
+ (SETQ |bfVar#109| (CDR |bfVar#109|))))))
(T (|shoeCompTran1| (CAR |x|))
(|shoeCompTran1| (CDR |x|)))))))))
@@ -1667,13 +1697,13 @@
(RETURN
(PROGN
(SETQ |a|
- (LET ((|bfVar#109| NIL) (|c| |l|))
+ (LET ((|bfVar#111| NIL) (|c| |l|))
(LOOP
(COND
- ((ATOM |c|) (RETURN (NREVERSE |bfVar#109|)))
- (T (SETQ |bfVar#109|
+ ((ATOM |c|) (RETURN (NREVERSE |bfVar#111|)))
+ (T (SETQ |bfVar#111|
(APPEND (REVERSE (|bfFlattenSeq| |c|))
- |bfVar#109|))))
+ |bfVar#111|))))
(SETQ |c| (CDR |c|)))))
(COND
((NULL |a|) NIL)
@@ -1691,17 +1721,17 @@
((AND (CONSP |f|) (EQ (CAR |f|) 'PROGN))
(COND
((CDR |x|)
- (LET ((|bfVar#111| NIL) (|bfVar#110| (CDR |f|))
+ (LET ((|bfVar#113| NIL) (|bfVar#112| (CDR |f|))
(|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#110|)
- (PROGN (SETQ |i| (CAR |bfVar#110|)) NIL))
- (RETURN (NREVERSE |bfVar#111|)))
+ ((OR (ATOM |bfVar#112|)
+ (PROGN (SETQ |i| (CAR |bfVar#112|)) NIL))
+ (RETURN (NREVERSE |bfVar#113|)))
(T (AND (NOT (ATOM |i|))
- (SETQ |bfVar#111|
- (CONS |i| |bfVar#111|)))))
- (SETQ |bfVar#110| (CDR |bfVar#110|)))))
+ (SETQ |bfVar#113|
+ (CONS |i| |bfVar#113|)))))
+ (SETQ |bfVar#112| (CDR |bfVar#112|)))))
(T (CDR |f|))))
(T (LIST |f|))))))))
@@ -1750,11 +1780,11 @@
(COND
((NULL |l|) NIL)
(T (SETQ |transform|
- (LET ((|bfVar#113| NIL) (|bfVar#112| |l|) (|x| NIL))
+ (LET ((|bfVar#115| NIL) (|bfVar#114| |l|) (|x| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#112|)
- (PROGN (SETQ |x| (CAR |bfVar#112|)) NIL)
+ ((OR (ATOM |bfVar#114|)
+ (PROGN (SETQ |x| (CAR |bfVar#114|)) NIL)
(NOT (AND (CONSP |x|) (EQ (CAR |x|) 'COND)
(PROGN
(SETQ |ISTMP#1| (CDR |x|))
@@ -1788,11 +1818,11 @@
(SETQ |b|
(CAR |ISTMP#5|))
T))))))))))))))
- (RETURN (NREVERSE |bfVar#113|)))
- (T (SETQ |bfVar#113|
+ (RETURN (NREVERSE |bfVar#115|)))
+ (T (SETQ |bfVar#115|
(CONS (|bfAlternative| |a| |b|)
- |bfVar#113|))))
- (SETQ |bfVar#112| (CDR |bfVar#112|)))))
+ |bfVar#115|))))
+ (SETQ |bfVar#114| (CDR |bfVar#114|)))))
(SETQ |no| (LENGTH |transform|))
(SETQ |before| (|bfTake| |no| |l|))
(SETQ |aft| (|bfDrop| |no| |l|))
@@ -1824,17 +1854,17 @@
(SETQ |defs| (CADR . #0=(|LETTMP#1|)))
(SETQ |nondefs| (CADDR . #0#))
(SETQ |a|
- (LET ((|bfVar#115| NIL) (|bfVar#114| |defs|) (|d| NIL))
+ (LET ((|bfVar#117| NIL) (|bfVar#116| |defs|) (|d| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#114|)
- (PROGN (SETQ |d| (CAR |bfVar#114|)) NIL))
- (RETURN (NREVERSE |bfVar#115|)))
- (T (SETQ |bfVar#115|
+ ((OR (ATOM |bfVar#116|)
+ (PROGN (SETQ |d| (CAR |bfVar#116|)) NIL))
+ (RETURN (NREVERSE |bfVar#117|)))
+ (T (SETQ |bfVar#117|
(CONS (LIST (CAR |d|) (CADR |d|)
(|bfSUBLIS| |opassoc| (CADDR |d|)))
- |bfVar#115|))))
- (SETQ |bfVar#114| (CDR |bfVar#114|)))))
+ |bfVar#117|))))
+ (SETQ |bfVar#116| (CDR |bfVar#116|)))))
(SETQ |$wheredefs| (APPEND |a| |$wheredefs|))
(|bfMKPROGN|
(|bfSUBLIS| |opassoc| (NCONC |nondefs| (LIST |expr|))))))))
@@ -1918,16 +1948,16 @@
((AND (CONSP |x|) (NULL (CDR |x|))) (SETQ |f| (CAR |x|))
(LIST 'DEFCONSTANT |f| (LIST 'LIST (LIST 'QUOTE |f|))))
(T (SETQ |a|
- (LET ((|bfVar#117| NIL) (|bfVar#116| (CDR |x|))
+ (LET ((|bfVar#119| NIL) (|bfVar#118| (CDR |x|))
(|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#116|)
- (PROGN (SETQ |i| (CAR |bfVar#116|)) NIL))
- (RETURN (NREVERSE |bfVar#117|)))
- (T (SETQ |bfVar#117|
- (CONS (|bfGenSymbol|) |bfVar#117|))))
- (SETQ |bfVar#116| (CDR |bfVar#116|)))))
+ ((OR (ATOM |bfVar#118|)
+ (PROGN (SETQ |i| (CAR |bfVar#118|)) NIL))
+ (RETURN (NREVERSE |bfVar#119|)))
+ (T (SETQ |bfVar#119|
+ (CONS (|bfGenSymbol|) |bfVar#119|))))
+ (SETQ |bfVar#118| (CDR |bfVar#118|)))))
(LIST 'DEFUN (CAR |x|) |a|
(LIST 'CONS (LIST 'QUOTE (CAR |x|)) (CONS 'LIST |a|))))))))
@@ -1954,21 +1984,21 @@
(DEFUN |bfCaseItems| (|g| |x|)
(PROG (|j| |ISTMP#1| |i|)
(RETURN
- (LET ((|bfVar#120| NIL) (|bfVar#119| |x|) (|bfVar#118| NIL))
+ (LET ((|bfVar#122| NIL) (|bfVar#121| |x|) (|bfVar#120| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#119|)
- (PROGN (SETQ |bfVar#118| (CAR |bfVar#119|)) NIL))
- (RETURN (NREVERSE |bfVar#120|)))
- (T (AND (CONSP |bfVar#118|)
+ ((OR (ATOM |bfVar#121|)
+ (PROGN (SETQ |bfVar#120| (CAR |bfVar#121|)) NIL))
+ (RETURN (NREVERSE |bfVar#122|)))
+ (T (AND (CONSP |bfVar#120|)
(PROGN
- (SETQ |i| (CAR |bfVar#118|))
- (SETQ |ISTMP#1| (CDR |bfVar#118|))
+ (SETQ |i| (CAR |bfVar#120|))
+ (SETQ |ISTMP#1| (CDR |bfVar#120|))
(AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|))
(PROGN (SETQ |j| (CAR |ISTMP#1|)) T)))
- (SETQ |bfVar#120|
- (CONS (|bfCI| |g| |i| |j|) |bfVar#120|)))))
- (SETQ |bfVar#119| (CDR |bfVar#119|)))))))
+ (SETQ |bfVar#122|
+ (CONS (|bfCI| |g| |i| |j|) |bfVar#122|)))))
+ (SETQ |bfVar#121| (CDR |bfVar#121|)))))))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing|) |%List|) |bfCI|))
@@ -1980,19 +2010,19 @@
(COND
((NULL |a|) (LIST (CAR |x|) |y|))
(T (SETQ |b|
- (LET ((|bfVar#122| NIL) (|bfVar#121| |a|) (|i| NIL)
+ (LET ((|bfVar#124| NIL) (|bfVar#123| |a|) (|i| NIL)
(|j| 1))
(LOOP
(COND
- ((OR (ATOM |bfVar#121|)
- (PROGN (SETQ |i| (CAR |bfVar#121|)) NIL))
- (RETURN (NREVERSE |bfVar#122|)))
+ ((OR (ATOM |bfVar#123|)
+ (PROGN (SETQ |i| (CAR |bfVar#123|)) NIL))
+ (RETURN (NREVERSE |bfVar#124|)))
(T (AND (NOT (EQ |i| 'DOT))
- (SETQ |bfVar#122|
+ (SETQ |bfVar#124|
(CONS
(LIST |i| (|bfCARCDR| |j| |g|))
- |bfVar#122|)))))
- (SETQ |bfVar#121| (CDR |bfVar#121|))
+ |bfVar#124|)))))
+ (SETQ |bfVar#123| (CDR |bfVar#123|))
(SETQ |j| (+ |j| 1)))))
(COND
((NULL |b|) (LIST (CAR |x|) |y|))
@@ -2013,10 +2043,10 @@
(DEFUN |bfTry| (|e| |cs|)
(COND
((NULL |cs|) |e|)
- (T (LET ((|bfVar#123| (CAR |cs|)))
- (CASE (CAR |bfVar#123|)
+ (T (LET ((|bfVar#125| (CAR |cs|)))
+ (CASE (CAR |bfVar#125|)
(|%Catch|
- (LET ((|tag| (CADR |bfVar#123|)))
+ (LET ((|tag| (CADR |bfVar#125|)))
(COND
((ATOM |tag|)
(|bfTry| (LIST 'CATCH (LIST 'QUOTE |tag|) |e|)
@@ -2036,16 +2066,16 @@
((ATOM |form|)
(COND ((MEMBER |form| |params|) |form|) (T (|quote| |form|))))
(T (CONS 'LIST
- (LET ((|bfVar#125| NIL) (|bfVar#124| |form|) (|t| NIL))
+ (LET ((|bfVar#127| NIL) (|bfVar#126| |form|) (|t| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#124|)
- (PROGN (SETQ |t| (CAR |bfVar#124|)) NIL))
- (RETURN (NREVERSE |bfVar#125|)))
- (T (SETQ |bfVar#125|
+ ((OR (ATOM |bfVar#126|)
+ (PROGN (SETQ |t| (CAR |bfVar#126|)) NIL))
+ (RETURN (NREVERSE |bfVar#127|)))
+ (T (SETQ |bfVar#127|
(CONS (|backquote| |t| |params|)
- |bfVar#125|))))
- (SETQ |bfVar#124| (CDR |bfVar#124|))))))))
+ |bfVar#127|))))
+ (SETQ |bfVar#126| (CDR |bfVar#126|))))))))
(DEFUN |genTypeAlias| (|head| |body|)
(PROG (|args| |op|)
@@ -2097,7 +2127,7 @@
(LIST |t'| :EXTERNAL-FORMAT :ASCII :ELEMENT-TYPE
'BASE-CHAR))
(T |t'|)))
- ((MEMBER |t| '(|byte| |uint8|))
+ ((MEMQ |t| '(|byte| |uint8|))
(COND
((|%hasFeature| :SBCL)
(LIST (|bfColonColon| 'SB-ALIEN 'UNSIGNED) 8))
@@ -2191,10 +2221,10 @@
(T (SETQ |m| (CAR |t|)) (SETQ |c| (CAADR . #0=(|t|)))
(SETQ |t'| (CADADR . #0#))
(COND
- ((NOT (MEMBER |m| '(|readonly| |writeonly| |readwrite|)))
+ ((NOT (MEMQ |m| '(|readonly| |writeonly| |readwrite|)))
(|coreError|
"missing modifier for argument type for a native function"))
- ((NOT (MEMBER |c| '(|buffer| |pointer|)))
+ ((NOT (MEMQ |c| '(|buffer| |pointer|)))
(|coreError|
"expected 'buffer' or 'pointer' type instance"))
((NOT (MEMBER |t'| |$NativeSimpleDataTypes|))
@@ -2205,7 +2235,7 @@
(PROG (|m|)
(RETURN
(AND (CONSP |t|) (PROGN (SETQ |m| (CAR |t|)) T)
- (MEMBER |m| '(|readonly| |writeonly| |readwrite|))))))
+ (MEMQ |m| '(|readonly| |writeonly| |readwrite|))))))
(DEFUN |coerceToNativeType| (|a| |t|)
(PROG (|y| |c|)
@@ -2235,47 +2265,47 @@
(RETURN
(PROGN
(SETQ |argtypes|
- (LET ((|bfVar#127| NIL) (|bfVar#126| |s|) (|x| NIL))
+ (LET ((|bfVar#129| NIL) (|bfVar#128| |s|) (|x| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#126|)
- (PROGN (SETQ |x| (CAR |bfVar#126|)) NIL))
- (RETURN (NREVERSE |bfVar#127|)))
- (T (SETQ |bfVar#127|
+ ((OR (ATOM |bfVar#128|)
+ (PROGN (SETQ |x| (CAR |bfVar#128|)) NIL))
+ (RETURN (NREVERSE |bfVar#129|)))
+ (T (SETQ |bfVar#129|
(CONS (|nativeArgumentType| |x|)
- |bfVar#127|))))
- (SETQ |bfVar#126| (CDR |bfVar#126|)))))
+ |bfVar#129|))))
+ (SETQ |bfVar#128| (CDR |bfVar#128|)))))
(SETQ |rettype| (|nativeReturnType| |t|))
(COND
- ((LET ((|bfVar#129| T) (|bfVar#128| (CONS |t| |s|))
+ ((LET ((|bfVar#131| T) (|bfVar#130| (CONS |t| |s|))
(|x| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#128|)
- (PROGN (SETQ |x| (CAR |bfVar#128|)) NIL))
- (RETURN |bfVar#129|))
+ ((OR (ATOM |bfVar#130|)
+ (PROGN (SETQ |x| (CAR |bfVar#130|)) NIL))
+ (RETURN |bfVar#131|))
(T (PROGN
- (SETQ |bfVar#129| (|isSimpleNativeType| |x|))
- (COND ((NOT |bfVar#129|) (RETURN NIL))))))
- (SETQ |bfVar#128| (CDR |bfVar#128|))))
+ (SETQ |bfVar#131| (|isSimpleNativeType| |x|))
+ (COND ((NOT |bfVar#131|) (RETURN NIL))))))
+ (SETQ |bfVar#130| (CDR |bfVar#130|))))
(LIST (LIST 'DEFENTRY |op| |argtypes|
(LIST |rettype| (SYMBOL-NAME |op'|)))))
(T (SETQ |cop| (CONCAT (SYMBOL-NAME |op'|) "_stub"))
(SETQ |cargs|
- (LET ((|bfVar#136| NIL)
- (|bfVar#135| (- (LENGTH |s|) 1)) (|i| 0))
+ (LET ((|bfVar#138| NIL)
+ (|bfVar#137| (- (LENGTH |s|) 1)) (|i| 0))
(LOOP
(COND
- ((> |i| |bfVar#135|)
- (RETURN (NREVERSE |bfVar#136|)))
- (T (SETQ |bfVar#136|
+ ((> |i| |bfVar#137|)
+ (RETURN (NREVERSE |bfVar#138|)))
+ (T (SETQ |bfVar#138|
(CONS (|genGCLnativeTranslation,mkCArgName|
|i|)
- |bfVar#136|))))
+ |bfVar#138|))))
(SETQ |i| (+ |i| 1)))))
(SETQ |ccode|
- (LET ((|bfVar#132| "")
- (|bfVar#134|
+ (LET ((|bfVar#134| "")
+ (|bfVar#136|
(CONS (|genGCLnativeTranslation,gclTypeInC|
|t|)
(CONS " "
@@ -2283,20 +2313,20 @@
(CONS "("
(APPEND
(LET
- ((|bfVar#130| NIL) (|x| |s|)
+ ((|bfVar#132| NIL) (|x| |s|)
(|a| |cargs|))
(LOOP
(COND
((OR (ATOM |x|)
(ATOM |a|))
(RETURN
- (NREVERSE |bfVar#130|)))
+ (NREVERSE |bfVar#132|)))
(T
- (SETQ |bfVar#130|
+ (SETQ |bfVar#132|
(CONS
(|genGCLnativeTranslation,cparm|
|x| |a|)
- |bfVar#130|))))
+ |bfVar#132|))))
(SETQ |x| (CDR |x|))
(SETQ |a| (CDR |a|))))
(CONS ") { "
@@ -2309,7 +2339,7 @@
(CONS "("
(APPEND
(LET
- ((|bfVar#131| NIL)
+ ((|bfVar#133| NIL)
(|x| |s|) (|a| |cargs|))
(LOOP
(COND
@@ -2317,27 +2347,27 @@
(ATOM |a|))
(RETURN
(NREVERSE
- |bfVar#131|)))
+ |bfVar#133|)))
(T
- (SETQ |bfVar#131|
+ (SETQ |bfVar#133|
(CONS
(|genGCLnativeTranslation,gclArgsInC|
|x| |a|)
- |bfVar#131|))))
+ |bfVar#133|))))
(SETQ |x| (CDR |x|))
(SETQ |a| (CDR |a|))))
(CONS "); }" NIL))))))))))))
- (|bfVar#133| NIL))
+ (|bfVar#135| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#134|)
+ ((OR (ATOM |bfVar#136|)
(PROGN
- (SETQ |bfVar#133| (CAR |bfVar#134|))
+ (SETQ |bfVar#135| (CAR |bfVar#136|))
NIL))
- (RETURN |bfVar#132|))
- (T (SETQ |bfVar#132|
- (CONCAT |bfVar#132| |bfVar#133|))))
- (SETQ |bfVar#134| (CDR |bfVar#134|)))))
+ (RETURN |bfVar#134|))
+ (T (SETQ |bfVar#134|
+ (CONCAT |bfVar#134| |bfVar#135|))))
+ (SETQ |bfVar#136| (CDR |bfVar#136|)))))
(LIST (LIST 'CLINES |ccode|)
(LIST 'DEFENTRY |op| |argtypes|
(LIST |rettype| |cop|)))))))))
@@ -2397,17 +2427,17 @@
(PROGN
(SETQ |args| NIL)
(SETQ |argtypes| NIL)
- (LET ((|bfVar#137| |s|) (|x| NIL))
+ (LET ((|bfVar#139| |s|) (|x| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#137|)
- (PROGN (SETQ |x| (CAR |bfVar#137|)) NIL))
+ ((OR (ATOM |bfVar#139|)
+ (PROGN (SETQ |x| (CAR |bfVar#139|)) NIL))
(RETURN NIL))
(T (PROGN
(SETQ |argtypes|
(CONS (|nativeArgumentType| |x|) |argtypes|))
(SETQ |args| (CONS (GENSYM) |args|)))))
- (SETQ |bfVar#137| (CDR |bfVar#137|))))
+ (SETQ |bfVar#139| (CDR |bfVar#139|))))
(SETQ |args| (REVERSE |args|))
(SETQ |rettype| (|nativeReturnType| |t|))
(LIST (LIST 'DEFUN |op| |args|
@@ -2418,39 +2448,39 @@
:ONE-LINER T)))))))
(DEFUN |genECLnativeTranslation,callTemplate| (|op| |n| |s|)
- (LET ((|bfVar#141| "")
- (|bfVar#143|
+ (LET ((|bfVar#143| "")
+ (|bfVar#145|
(CONS (SYMBOL-NAME |op|)
(CONS "("
- (APPEND (LET ((|bfVar#140| NIL)
- (|bfVar#138| (- |n| 1)) (|i| 0)
- (|bfVar#139| |s|) (|x| NIL))
+ (APPEND (LET ((|bfVar#142| NIL)
+ (|bfVar#140| (- |n| 1)) (|i| 0)
+ (|bfVar#141| |s|) (|x| NIL))
(LOOP
(COND
- ((OR (> |i| |bfVar#138|)
- (ATOM |bfVar#139|)
+ ((OR (> |i| |bfVar#140|)
+ (ATOM |bfVar#141|)
(PROGN
- (SETQ |x| (CAR |bfVar#139|))
+ (SETQ |x| (CAR |bfVar#141|))
NIL))
- (RETURN (NREVERSE |bfVar#140|)))
+ (RETURN (NREVERSE |bfVar#142|)))
(T
- (SETQ |bfVar#140|
+ (SETQ |bfVar#142|
(CONS
(|genECLnativeTranslation,sharpArg|
|i| |x|)
- |bfVar#140|))))
+ |bfVar#142|))))
(SETQ |i| (+ |i| 1))
- (SETQ |bfVar#139|
- (CDR |bfVar#139|))))
+ (SETQ |bfVar#141|
+ (CDR |bfVar#141|))))
(CONS ")" NIL)))))
- (|bfVar#142| NIL))
+ (|bfVar#144| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#143|)
- (PROGN (SETQ |bfVar#142| (CAR |bfVar#143|)) NIL))
- (RETURN |bfVar#141|))
- (T (SETQ |bfVar#141| (CONCAT |bfVar#141| |bfVar#142|))))
- (SETQ |bfVar#143| (CDR |bfVar#143|)))))
+ ((OR (ATOM |bfVar#145|)
+ (PROGN (SETQ |bfVar#144| (CAR |bfVar#145|)) NIL))
+ (RETURN |bfVar#143|))
+ (T (SETQ |bfVar#143| (CONCAT |bfVar#143| |bfVar#144|))))
+ (SETQ |bfVar#145| (CDR |bfVar#145|)))))
(DEFUN |genECLnativeTranslation,sharpArg| (|i| |x|)
(COND
@@ -2490,18 +2520,6 @@
(PROGN
(SETQ |rettype| (|nativeReturnType| |t|))
(SETQ |argtypes|
- (LET ((|bfVar#145| NIL) (|bfVar#144| |s|) (|x| NIL))
- (LOOP
- (COND
- ((OR (ATOM |bfVar#144|)
- (PROGN (SETQ |x| (CAR |bfVar#144|)) NIL))
- (RETURN (NREVERSE |bfVar#145|)))
- (T (SETQ |bfVar#145|
- (CONS (|nativeArgumentType| |x|)
- |bfVar#145|))))
- (SETQ |bfVar#144| (CDR |bfVar#144|)))))
- (SETQ |n| (INTERN (CONCAT (SYMBOL-NAME |op|) "%clisp-hack")))
- (SETQ |parms|
(LET ((|bfVar#147| NIL) (|bfVar#146| |s|) (|x| NIL))
(LOOP
(COND
@@ -2509,19 +2527,31 @@
(PROGN (SETQ |x| (CAR |bfVar#146|)) NIL))
(RETURN (NREVERSE |bfVar#147|)))
(T (SETQ |bfVar#147|
- (CONS (GENSYM "parm") |bfVar#147|))))
+ (CONS (|nativeArgumentType| |x|)
+ |bfVar#147|))))
(SETQ |bfVar#146| (CDR |bfVar#146|)))))
+ (SETQ |n| (INTERN (CONCAT (SYMBOL-NAME |op|) "%clisp-hack")))
+ (SETQ |parms|
+ (LET ((|bfVar#149| NIL) (|bfVar#148| |s|) (|x| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#148|)
+ (PROGN (SETQ |x| (CAR |bfVar#148|)) NIL))
+ (RETURN (NREVERSE |bfVar#149|)))
+ (T (SETQ |bfVar#149|
+ (CONS (GENSYM "parm") |bfVar#149|))))
+ (SETQ |bfVar#148| (CDR |bfVar#148|)))))
(SETQ |unstableArgs| NIL)
- (LET ((|bfVar#148| |parms|) (|p| NIL) (|bfVar#149| |s|)
- (|x| NIL) (|bfVar#150| |argtypes|) (|y| NIL))
+ (LET ((|bfVar#150| |parms|) (|p| NIL) (|bfVar#151| |s|)
+ (|x| NIL) (|bfVar#152| |argtypes|) (|y| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#148|)
- (PROGN (SETQ |p| (CAR |bfVar#148|)) NIL)
- (ATOM |bfVar#149|)
- (PROGN (SETQ |x| (CAR |bfVar#149|)) NIL)
- (ATOM |bfVar#150|)
- (PROGN (SETQ |y| (CAR |bfVar#150|)) NIL))
+ ((OR (ATOM |bfVar#150|)
+ (PROGN (SETQ |p| (CAR |bfVar#150|)) NIL)
+ (ATOM |bfVar#151|)
+ (PROGN (SETQ |x| (CAR |bfVar#151|)) NIL)
+ (ATOM |bfVar#152|)
+ (PROGN (SETQ |y| (CAR |bfVar#152|)) NIL))
(RETURN NIL))
(T (COND
((|needsStableReference?| |x|)
@@ -2529,31 +2559,31 @@
(SETQ |unstableArgs|
(CONS (CONS |p| (CONS |x| |y|))
|unstableArgs|)))))))
- (SETQ |bfVar#148| (CDR |bfVar#148|))
- (SETQ |bfVar#149| (CDR |bfVar#149|))
- (SETQ |bfVar#150| (CDR |bfVar#150|))))
+ (SETQ |bfVar#150| (CDR |bfVar#150|))
+ (SETQ |bfVar#151| (CDR |bfVar#151|))
+ (SETQ |bfVar#152| (CDR |bfVar#152|))))
(SETQ |foreignDecl|
(LIST (|bfColonColon| 'FFI 'DEF-CALL-OUT) |n|
(LIST :NAME (SYMBOL-NAME |op'|))
(CONS :ARGUMENTS
- (LET ((|bfVar#153| NIL)
- (|bfVar#151| |argtypes|) (|x| NIL)
- (|bfVar#152| |parms|) (|a| NIL))
+ (LET ((|bfVar#155| NIL)
+ (|bfVar#153| |argtypes|) (|x| NIL)
+ (|bfVar#154| |parms|) (|a| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#151|)
+ ((OR (ATOM |bfVar#153|)
(PROGN
- (SETQ |x| (CAR |bfVar#151|))
+ (SETQ |x| (CAR |bfVar#153|))
NIL)
- (ATOM |bfVar#152|)
+ (ATOM |bfVar#154|)
(PROGN
- (SETQ |a| (CAR |bfVar#152|))
+ (SETQ |a| (CAR |bfVar#154|))
NIL))
- (RETURN (NREVERSE |bfVar#153|)))
- (T (SETQ |bfVar#153|
- (CONS (LIST |a| |x|) |bfVar#153|))))
- (SETQ |bfVar#151| (CDR |bfVar#151|))
- (SETQ |bfVar#152| (CDR |bfVar#152|)))))
+ (RETURN (NREVERSE |bfVar#155|)))
+ (T (SETQ |bfVar#155|
+ (CONS (LIST |a| |x|) |bfVar#155|))))
+ (SETQ |bfVar#153| (CDR |bfVar#153|))
+ (SETQ |bfVar#154| (CDR |bfVar#154|)))))
(LIST :RETURN-TYPE |rettype|)
(LIST :LANGUAGE :STDC)))
(SETQ |forwardingFun|
@@ -2561,66 +2591,66 @@
((NULL |unstableArgs|)
(LIST 'DEFUN |op| |parms| (CONS |n| |parms|)))
(T (SETQ |localPairs|
- (LET ((|bfVar#156| NIL)
- (|bfVar#155| |unstableArgs|)
- (|bfVar#154| NIL))
+ (LET ((|bfVar#158| NIL)
+ (|bfVar#157| |unstableArgs|)
+ (|bfVar#156| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#155|)
+ ((OR (ATOM |bfVar#157|)
(PROGN
- (SETQ |bfVar#154|
- (CAR |bfVar#155|))
+ (SETQ |bfVar#156|
+ (CAR |bfVar#157|))
NIL))
- (RETURN (NREVERSE |bfVar#156|)))
- (T (AND (CONSP |bfVar#154|)
+ (RETURN (NREVERSE |bfVar#158|)))
+ (T (AND (CONSP |bfVar#156|)
(PROGN
- (SETQ |a| (CAR |bfVar#154|))
+ (SETQ |a| (CAR |bfVar#156|))
(SETQ |ISTMP#1|
- (CDR |bfVar#154|))
+ (CDR |bfVar#156|))
(AND (CONSP |ISTMP#1|)
(PROGN
(SETQ |x| (CAR |ISTMP#1|))
(SETQ |y| (CDR |ISTMP#1|))
T)))
- (SETQ |bfVar#156|
+ (SETQ |bfVar#158|
(CONS
(CONS |a|
(CONS |x|
(CONS |y| (GENSYM "loc"))))
- |bfVar#156|)))))
- (SETQ |bfVar#155| (CDR |bfVar#155|)))))
+ |bfVar#158|)))))
+ (SETQ |bfVar#157| (CDR |bfVar#157|)))))
(SETQ |call|
(CONS |n|
- (LET ((|bfVar#158| NIL)
- (|bfVar#157| |parms|) (|p| NIL))
+ (LET ((|bfVar#160| NIL)
+ (|bfVar#159| |parms|) (|p| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#157|)
+ ((OR (ATOM |bfVar#159|)
(PROGN
- (SETQ |p| (CAR |bfVar#157|))
+ (SETQ |p| (CAR |bfVar#159|))
NIL))
- (RETURN (NREVERSE |bfVar#158|)))
+ (RETURN (NREVERSE |bfVar#160|)))
(T
- (SETQ |bfVar#158|
+ (SETQ |bfVar#160|
(CONS
(|genCLISPnativeTranslation,actualArg|
|p| |localPairs|)
- |bfVar#158|))))
- (SETQ |bfVar#157| (CDR |bfVar#157|))))))
+ |bfVar#160|))))
+ (SETQ |bfVar#159| (CDR |bfVar#159|))))))
(SETQ |call|
(PROGN
(SETQ |fixups|
- (LET ((|bfVar#160| NIL)
- (|bfVar#159| |localPairs|)
+ (LET ((|bfVar#162| NIL)
+ (|bfVar#161| |localPairs|)
(|p| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#159|)
+ ((OR (ATOM |bfVar#161|)
(PROGN
- (SETQ |p| (CAR |bfVar#159|))
+ (SETQ |p| (CAR |bfVar#161|))
NIL))
(RETURN
- (NREVERSE |bfVar#160|)))
+ (NREVERSE |bfVar#162|)))
(T
(AND
(NOT
@@ -2628,26 +2658,26 @@
(SETQ |q|
(|genCLISPnativeTranslation,copyBack|
|p|))))
- (SETQ |bfVar#160|
- (CONS |q| |bfVar#160|)))))
- (SETQ |bfVar#159|
- (CDR |bfVar#159|)))))
+ (SETQ |bfVar#162|
+ (CONS |q| |bfVar#162|)))))
+ (SETQ |bfVar#161|
+ (CDR |bfVar#161|)))))
(COND
((NULL |fixups|) (LIST |call|))
(T (LIST (CONS 'PROG1
(CONS |call| |fixups|)))))))
- (LET ((|bfVar#162| |localPairs|) (|bfVar#161| NIL))
+ (LET ((|bfVar#164| |localPairs|) (|bfVar#163| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#162|)
+ ((OR (ATOM |bfVar#164|)
(PROGN
- (SETQ |bfVar#161| (CAR |bfVar#162|))
+ (SETQ |bfVar#163| (CAR |bfVar#164|))
NIL))
(RETURN NIL))
- (T (AND (CONSP |bfVar#161|)
+ (T (AND (CONSP |bfVar#163|)
(PROGN
- (SETQ |p| (CAR |bfVar#161|))
- (SETQ |ISTMP#1| (CDR |bfVar#161|))
+ (SETQ |p| (CAR |bfVar#163|))
+ (SETQ |ISTMP#1| (CDR |bfVar#163|))
(AND (CONSP |ISTMP#1|)
(PROGN
(SETQ |x| (CAR |ISTMP#1|))
@@ -2670,18 +2700,18 @@
|p|)
|p|)
|call|)))))))
- (SETQ |bfVar#162| (CDR |bfVar#162|))))
+ (SETQ |bfVar#164| (CDR |bfVar#164|))))
(CONS 'DEFUN (CONS |op| (CONS |parms| |call|))))))
(SETQ |$foreignsDefsForCLisp|
(CONS |foreignDecl| |$foreignsDefsForCLisp|))
(LIST |forwardingFun|)))))
-(DEFUN |genCLISPnativeTranslation,copyBack| (|bfVar#163|)
+(DEFUN |genCLISPnativeTranslation,copyBack| (|bfVar#165|)
(PROG (|a| |y| |x| |p|)
(RETURN
(PROGN
- (SETQ |p| (CAR |bfVar#163|))
- (SETQ |x| (CADR . #0=(|bfVar#163|)))
+ (SETQ |p| (CAR |bfVar#165|))
+ (SETQ |x| (CADR . #0=(|bfVar#165|)))
(SETQ |y| (CADDR . #0#))
(SETQ |a| (CDDDR . #0#))
(COND
@@ -2705,35 +2735,35 @@
(PROGN
(SETQ |rettype| (|nativeReturnType| |t|))
(SETQ |argtypes|
- (LET ((|bfVar#165| NIL) (|bfVar#164| |s|) (|x| NIL))
- (LOOP
- (COND
- ((OR (ATOM |bfVar#164|)
- (PROGN (SETQ |x| (CAR |bfVar#164|)) NIL))
- (RETURN (NREVERSE |bfVar#165|)))
- (T (SETQ |bfVar#165|
- (CONS (|nativeArgumentType| |x|)
- |bfVar#165|))))
- (SETQ |bfVar#164| (CDR |bfVar#164|)))))
- (SETQ |args|
(LET ((|bfVar#167| NIL) (|bfVar#166| |s|) (|x| NIL))
(LOOP
(COND
((OR (ATOM |bfVar#166|)
(PROGN (SETQ |x| (CAR |bfVar#166|)) NIL))
(RETURN (NREVERSE |bfVar#167|)))
- (T (SETQ |bfVar#167| (CONS (GENSYM) |bfVar#167|))))
+ (T (SETQ |bfVar#167|
+ (CONS (|nativeArgumentType| |x|)
+ |bfVar#167|))))
(SETQ |bfVar#166| (CDR |bfVar#166|)))))
+ (SETQ |args|
+ (LET ((|bfVar#169| NIL) (|bfVar#168| |s|) (|x| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#168|)
+ (PROGN (SETQ |x| (CAR |bfVar#168|)) NIL))
+ (RETURN (NREVERSE |bfVar#169|)))
+ (T (SETQ |bfVar#169| (CONS (GENSYM) |bfVar#169|))))
+ (SETQ |bfVar#168| (CDR |bfVar#168|)))))
(SETQ |unstableArgs| NIL)
(SETQ |newArgs| NIL)
- (LET ((|bfVar#168| |args|) (|a| NIL) (|bfVar#169| |s|)
+ (LET ((|bfVar#170| |args|) (|a| NIL) (|bfVar#171| |s|)
(|x| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#168|)
- (PROGN (SETQ |a| (CAR |bfVar#168|)) NIL)
- (ATOM |bfVar#169|)
- (PROGN (SETQ |x| (CAR |bfVar#169|)) NIL))
+ ((OR (ATOM |bfVar#170|)
+ (PROGN (SETQ |a| (CAR |bfVar#170|)) NIL)
+ (ATOM |bfVar#171|)
+ (PROGN (SETQ |x| (CAR |bfVar#171|)) NIL))
(RETURN NIL))
(T (PROGN
(SETQ |newArgs|
@@ -2742,8 +2772,8 @@
(COND
((|needsStableReference?| |x|)
(SETQ |unstableArgs| (CONS |a| |unstableArgs|)))))))
- (SETQ |bfVar#168| (CDR |bfVar#168|))
- (SETQ |bfVar#169| (CDR |bfVar#169|))))
+ (SETQ |bfVar#170| (CDR |bfVar#170|))
+ (SETQ |bfVar#171| (CDR |bfVar#171|))))
(SETQ |op'|
(COND
((|%hasFeature| :WIN32)
diff --git a/src/boot/strap/scanner.clisp b/src/boot/strap/scanner.clisp
index 4c4bda04..b0d7dbf3 100644
--- a/src/boot/strap/scanner.clisp
+++ b/src/boot/strap/scanner.clisp
@@ -153,8 +153,7 @@
(T (|shoeAccumulateLines| |$r| |string|))))
(T (CONS |s| |string|))))))))
-(DEFUN |shoeCloser| (|t|)
- (MEMBER (|shoeKeyWord| |t|) '(CPAREN CBRACK)))
+(DEFUN |shoeCloser| (|t|) (MEMQ (|shoeKeyWord| |t|) '(CPAREN CBRACK)))
(DEFUN |shoeToken| ()
(PROG (|b| |ch| |n| |linepos| |c| |ln|)
diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp
index ce8f5cac..6cec8254 100644
--- a/src/boot/strap/tokens.clisp
+++ b/src/boot/strap/tokens.clisp
@@ -206,12 +206,11 @@
(LIST '|exit| 'EXIT) (LIST '|false| 'NIL)
(LIST '|first| 'CAR) (LIST '|fourth| 'CADDDR)
(LIST '|function| 'FUNCTION)
- (LIST '|genvar| 'GENVAR) (LIST 'IN 'MEMBER)
- (LIST '|is| 'IS) (LIST '|isnt| 'ISNT)
- (LIST '|lastNode| 'LAST) (LIST 'LAST '|last|)
- (LIST '|list| 'LIST) (LIST '|mkpf| 'MKPF)
- (LIST '|nconc| 'NCONC) (LIST '|nil| NIL)
- (LIST '|not| 'NOT)
+ (LIST '|genvar| 'GENVAR) (LIST '|is| 'IS)
+ (LIST '|isnt| 'ISNT) (LIST '|lastNode| 'LAST)
+ (LIST 'LAST '|last|) (LIST '|list| 'LIST)
+ (LIST '|mkpf| 'MKPF) (LIST '|nconc| 'NCONC)
+ (LIST '|nil| NIL) (LIST '|not| 'NOT)
(LIST '|nreverse| 'NREVERSE)
(LIST '|null| 'NULL) (LIST '|or| 'OR)
(LIST '|otherwise| 'T) (LIST 'PAIRP 'CONSP)
diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot
index 39a40df2..ca8c33e7 100644
--- a/src/boot/tokens.boot
+++ b/src/boot/tokens.boot
@@ -248,13 +248,11 @@ for i in [ _
["fourth", "CADDDR"] , _
["function","FUNCTION"] , _
["genvar", "GENVAR"] , _
- ["IN", "MEMBER"] , _
["is", "IS"] , _
["isnt", "ISNT"] , _
["lastNode", "LAST"] , _
["LAST", "last"] , _
["list", "LIST"] , _
--- ["member", "MEMBER"] , _
["mkpf", "MKPF"] , _
["nconc", "NCONC"] , _
["nil" ,NIL ] , _
diff --git a/src/interp/ax.boot b/src/interp/ax.boot
index f70ad4bc..f9614d7e 100644
--- a/src/interp/ax.boot
+++ b/src/interp/ax.boot
@@ -1,6 +1,6 @@
-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007-2008, Gabriel Dos Reis.
+-- Copyright (C) 2007-2009, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -61,7 +61,7 @@ makeAxFile(filename, constructors) ==
axForms :=
[modemapToAx(modemap) for cname in constructors |
(modemap:=getConstructorModemapFromDB cname) and
- (not cname in '(Tuple Exit Type)) and
+ not (cname in '(Tuple Exit Type)) and
not isDefaultPackageName cname]
if $baseForms then
axForms := [:$baseForms, :axForms]
@@ -81,7 +81,7 @@ makeAxExportForm(filename, constructors) ==
axForms :=
[modemapToAx(modemap) for cname in constructors |
(modemap:=getConstructorModemapFromDB cname) and
- (not cname in '(Tuple Exit Type)) and
+ not (cname in '(Tuple Exit Type)) and
not isDefaultPackageName cname]
if $baseForms then
axForms := [:$baseForms, :axForms]