diff options
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 |