diff options
| author | dos-reis <gdr@axiomatics.org> | 2011-04-29 09:51:00 +0000 |
|---|---|---|
| committer | dos-reis <gdr@axiomatics.org> | 2011-04-29 09:51:00 +0000 |
| commit | 52889faf70db19459d18fd18123635479e7266d1 (patch) | |
| tree | dd020d1d4dc6c245bdec5f7b6c2594d4e6f77a18 /src/boot/strap | |
| parent | 75b600291e154f55fe8d6d10658980315204ced2 (diff) | |
| download | open-axiom-52889faf70db19459d18fd18123635479e7266d1.tar.gz | |
* boot/utility.boot (assocSymbol): New.
(applySubst): Likewise. Export.
* boot/ast.boot: Use it. Remove SUBLIS and SUBLISLIS.
* interp/ax.boot: Likewise.
* interp/br-con.boot: Likewise.
* interp/br-op1.boot: Likewise.
* interp/br-op2.boot: Likewise.
* interp/br-prof.boot: Likewise.
* interp/br-saturn.boot: Likewise.
* interp/buildom.boot: Likewise.
* interp/c-doc.boot: Likewise.
* interp/c-util.boot: Likewise.
* interp/cattable.boot: Likewise.
* interp/compiler.boot: Likewise.
Diffstat (limited to 'src/boot/strap')
| -rw-r--r-- | src/boot/strap/ast.clisp | 8 | ||||
| -rw-r--r-- | src/boot/strap/utility.clisp | 29 |
2 files changed, 35 insertions, 2 deletions
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index 1ab3b6dd..a6f77349 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -1804,7 +1804,13 @@ (PROGN (SETQ |args| (CDR |ISTMP#2|)) T)))))) - (CONS 'VECTOR |args|)) + (RPLACA |x| 'VECTOR) (RPLACD |x| |args|)) + ((AND (CONSP |x|) (EQ (CAR |x|) '|vector|) + (PROGN + (SETQ |ISTMP#1| (CDR |x|)) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) + (EQ (CAR |ISTMP#1|) 'NIL)))) + (RPLACA |x| 'VECTOR) (RPLACD |x| NIL)) (T (|shoeCompTran1| (CAR |x|)) (|shoeCompTran1| (CDR |x|))))))))) diff --git a/src/boot/strap/utility.clisp b/src/boot/strap/utility.clisp index 38951dd9..97428682 100644 --- a/src/boot/strap/utility.clisp +++ b/src/boot/strap/utility.clisp @@ -8,7 +8,7 @@ (EXPORT '(|objectMember?| |symbolMember?| |stringMember?| |charMember?| |scalarMember?| |listMember?| |reverse| |reverse!| |lastNode| |append!| |copyList| |substitute| |substitute!| - |setDifference|)) + |setDifference| |applySubst|)) (DEFUN |objectMember?| (|x| |l|) (LOOP @@ -120,6 +120,18 @@ ((NULL |y|) |x|) (T (RPLACD (|lastNode| |x|) |y|) |x|))) +(DEFUN |assocSymbol| (|s| |al|) + (PROG (|x|) + (RETURN + (LOOP + (COND + ((AND (CONSP |al|) + (PROGN (SETQ |x| (CAR |al|)) (SETQ |al| (CDR |al|)) T)) + (COND + ((AND (CONSP |x|) (EQ |s| (CAR |x|))) + (IDENTITY (RETURN |x|))))) + (T (RETURN NIL))))))) + (DEFUN |substitute!| (|y| |x| |s|) (COND ((NULL |s|) NIL) @@ -142,6 +154,21 @@ (T (CONS |h| |t|)))) (T |s|))))) +(DEFUN |applySubst| (|sl| |t|) + (PROG (|tl| |hd| |p|) + (RETURN + (COND + ((SYMBOLP |t|) + (COND + ((SETQ |p| (|assocSymbol| |t| |sl|)) (CDR |p|)) + (T |t|))) + ((CONSP |t|) (SETQ |hd| (|applySubst| |sl| (CAR |t|))) + (SETQ |tl| (|applySubst| |sl| (CDR |t|))) + (COND + ((AND (EQ |hd| (CAR |t|)) (EQ |tl| (CDR |t|))) |t|) + (T (CONS |hd| |tl|)))) + (T |t|))))) + (DEFUN |setDifference| (|x| |y|) (PROG (|a| |l| |p|) (RETURN |