diff options
Diffstat (limited to 'src/boot')
| -rw-r--r-- | src/boot/strap/utility.clisp | 25 | ||||
| -rw-r--r-- | src/boot/utility.boot | 23 |
2 files changed, 46 insertions, 2 deletions
diff --git a/src/boot/strap/utility.clisp b/src/boot/strap/utility.clisp index 5e6003fc..4f9a741f 100644 --- a/src/boot/strap/utility.clisp +++ b/src/boot/strap/utility.clisp @@ -7,7 +7,8 @@ (EXPORT '(|objectMember?| |symbolMember?| |stringMember?| |charMember?| |scalarMember?| |listMember?| |reverse| |reverse!| - |lastNode| |append!| |copyList|)) + |lastNode| |append!| |copyList| |substitute| + |substitute!|)) (DEFUN |objectMember?| (|x| |l|) (LOOP @@ -119,3 +120,25 @@ ((NULL |y|) |x|) (T (RPLACD (|lastNode| |x|) |y|) |x|))) +(DEFUN |substitute!| (|y| |x| |s|) + (COND + ((NULL |s|) NIL) + ((EQ |x| |s|) |y|) + (T (COND + ((CONSP |s|) (RPLACA |s| (|substitute!| |y| |x| (CAR |s|))) + (RPLACD |s| (|substitute!| |y| |x| (CDR |s|))))) + |s|))) + +(DEFUN |substitute| (|y| |x| |s|) + (PROG (|t| |h|) + (RETURN + (COND + ((NULL |s|) NIL) + ((EQ |x| |s|) |y|) + ((CONSP |s|) (SETQ |h| (|substitute| |y| |x| (CAR |s|))) + (SETQ |t| (|substitute| |y| |x| (CDR |s|))) + (COND + ((AND (EQ |h| (CAR |s|)) (EQ |t| (CDR |s|))) |s|) + (T (CONS |h| |t|)))) + (T |s|))))) + diff --git a/src/boot/utility.boot b/src/boot/utility.boot index bde1090b..6527a07a 100644 --- a/src/boot/utility.boot +++ b/src/boot/utility.boot @@ -34,7 +34,7 @@ import initial_-env namespace BOOTTRAN module utility (objectMember?, symbolMember?, stringMember?, charMember?, scalarMember?, listMember?, reverse, reverse!, - lastNode, append!, copyList) + lastNode, append!, copyList, substitute, substitute!) --% membership operators @@ -133,3 +133,24 @@ append!(x,y) == y = nil => x lastNode(x).rest := y x + +--% substitution + +substitute!(y,x,s) == + s = nil => nil + sameObject?(x,s) => y + if cons? s then + s.first := substitute!(y,x,first s) + s.rest := substitute!(y,x,rest s) + s + +substitute(y,x,s) == + s = nil => nil + sameObject?(x,s) => y + cons? s => + h := substitute(y,x,first s) + t := substitute(y,x,rest s) + sameObject?(h,first s) and sameObject?(t,rest s) => s + [h,:t] + s + |