diff options
-rwxr-xr-x | configure | 18 | ||||
-rw-r--r-- | configure.ac | 2 | ||||
-rw-r--r-- | configure.ac.pamphlet | 2 | ||||
-rw-r--r-- | src/ChangeLog | 8 | ||||
-rw-r--r-- | src/boot/ast.boot | 13 | ||||
-rw-r--r-- | src/boot/strap/ast.clisp | 630 | ||||
-rw-r--r-- | src/boot/strap/scanner.clisp | 3 | ||||
-rw-r--r-- | src/boot/strap/tokens.clisp | 11 | ||||
-rw-r--r-- | src/boot/tokens.boot | 2 | ||||
-rw-r--r-- | src/interp/ax.boot | 6 |
10 files changed, 370 insertions, 325 deletions
@@ -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] |