aboutsummaryrefslogtreecommitdiff
path: root/src/boot
diff options
context:
space:
mode:
Diffstat (limited to 'src/boot')
-rw-r--r--src/boot/strap/utility.clisp50
-rw-r--r--src/boot/utility.boot30
2 files changed, 42 insertions, 38 deletions
diff --git a/src/boot/strap/utility.clisp b/src/boot/strap/utility.clisp
index c42cc8f2..d522b8c8 100644
--- a/src/boot/strap/utility.clisp
+++ b/src/boot/strap/utility.clisp
@@ -19,8 +19,9 @@
|scalarMember?| |listMember?| |reverse| |reverse!|
|lastNode| |append| |append!| |copyList| |substitute|
|substitute!| |setDifference| |setUnion| |setIntersection|
- |applySubst| |applySubst!| |applySubstNQ| |objectAssoc|
- |remove| |removeSymbol| |atomic?| |finishLine|)))
+ |symbolAssoc| |applySubst| |applySubst!| |applySubstNQ|
+ |objectAssoc| |remove| |removeSymbol| |atomic?|
+ |finishLine|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing|) |%Thing|) |substitute|))
@@ -49,11 +50,17 @@
(DECLAIM
(FTYPE
- (FUNCTION (|%Thing| (|%List| (|%Pair| |%Thing| |%Thing|)))
+ (FUNCTION (|%Thing| (|%List| |%Thing|))
(|%Maybe| (|%Pair| |%Thing| |%Thing|)))
|objectAssoc|))
(DECLAIM
+ (FTYPE
+ (FUNCTION (|%Symbol| (|%List| |%Thing|))
+ (|%Maybe| (|%Pair| |%Symbol| |%Thing|)))
+ |symbolAssoc|))
+
+(DECLAIM
(FTYPE (FUNCTION ((|%List| |%Thing|) (|%List| |%Thing|)) (|%List| |%Thing|))
|setDifference|))
@@ -172,15 +179,25 @@
(DEFUN |append| (|x| |y|) (|append!| (|copyList| |x|) |y|))
-(DEFUN |assocSymbol| (|s| |al|)
+(DEFUN |symbolAssoc| (|s| |l|)
(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)))))))
+ ((NOT
+ (AND (CONSP |l|) (PROGN (SETQ |x| (CAR |l|)) (SETQ |l| (CDR |l|)) T)))
+ (RETURN NIL))
+ ((AND (CONSP |x|) (EQ |s| (CAR |x|))) (RETURN |x|)))))))
+
+(DEFUN |objectAssoc| (|x| |l|)
+ (PROG (|p|)
+ (RETURN
+ (LOOP
+ (COND
+ ((NOT
+ (AND (CONSP |l|) (PROGN (SETQ |p| (CAR |l|)) (SETQ |l| (CDR |l|)) T)))
+ (RETURN NIL))
+ ((AND (CONSP |p|) (EQ (CAR |p|) |x|)) (RETURN |p|)))))))
(DEFUN |substitute!| (|y| |x| |s|)
(COND ((NULL |s|) NIL) ((EQ |x| |s|) |y|)
@@ -208,7 +225,7 @@
(SETQ |tl| (|applySubst| |sl| (CDR |t|)))
(COND ((AND (EQ |hd| (CAR |t|)) (EQ |tl| (CDR |t|))) |t|)
(T (CONS |hd| |tl|))))
- ((AND (SYMBOLP |t|) (SETQ |p| (|assocSymbol| |t| |sl|))) (CDR |p|))
+ ((AND (SYMBOLP |t|) (SETQ |p| (|symbolAssoc| |t| |sl|))) (CDR |p|))
(T |t|)))))
(DEFUN |applySubst!| (|sl| |t|)
@@ -218,7 +235,7 @@
((CONSP |t|) (SETQ |hd| (|applySubst!| |sl| (CAR |t|)))
(SETQ |tl| (|applySubst!| |sl| (CDR |t|))) (RPLACA |t| |hd|)
(RPLACD |t| |tl|))
- ((AND (SYMBOLP |t|) (SETQ |p| (|assocSymbol| |t| |sl|))) (CDR |p|))
+ ((AND (SYMBOLP |t|) (SETQ |p| (|symbolAssoc| |t| |sl|))) (CDR |p|))
(T |t|)))))
(DEFUN |applySubstNQ| (|sl| |t|)
@@ -231,7 +248,7 @@
(SETQ |tl| (|applySubstNQ| |sl| |tl|))
(COND ((AND (EQ |hd| (CAR |t|)) (EQ |tl| (CDR |t|))) |t|)
(T (CONS |hd| |tl|))))))
- ((AND (SYMBOLP |t|) (SETQ |p| (|assocSymbol| |t| |sl|))) (CDR |p|))
+ ((AND (SYMBOLP |t|) (SETQ |p| (|symbolAssoc| |t| |sl|))) (CDR |p|))
(T |t|)))))
(DEFUN |setDifference| (|x| |y|)
@@ -335,17 +352,6 @@
((OR (CHARACTERP |x|) (INTEGERP |x|)) (|removeScalar| |l| |x|))
(T (|removeValue| |l| |x|))))
-(DEFUN |objectAssoc| (|x| |l|)
- (PROG (|a| |p|)
- (RETURN
- (LOOP
- (COND
- ((NOT
- (AND (CONSP |l|) (PROGN (SETQ |p| (CAR |l|)) (SETQ |l| (CDR |l|)) T)))
- (RETURN NIL))
- ((AND (CONSP |p|) (PROGN (SETQ |a| (CAR |p|)) T) (EQ |a| |x|))
- (RETURN |p|)))))))
-
(DEFUN |charPosition| (|c| |s| |k|)
(PROG (|n|)
(RETURN
diff --git a/src/boot/utility.boot b/src/boot/utility.boot
index d60c7d5c..79d84700 100644
--- a/src/boot/utility.boot
+++ b/src/boot/utility.boot
@@ -47,7 +47,7 @@ module utility (objectMember?, symbolMember?, stringMember?,
charMember?, scalarMember?, listMember?, reverse, reverse!,
lastNode, append, append!, copyList, substitute, substitute!,
setDifference, setUnion, setIntersection,
- applySubst, applySubst!, applySubstNQ, objectAssoc,
+ symbolAssoc, applySubst, applySubst!, applySubstNQ, objectAssoc,
remove,removeSymbol,atomic?,finishLine) where
substitute: (%Thing,%Thing,%Thing) -> %Thing
substitute!: (%Thing,%Thing,%Thing) -> %Thing
@@ -57,8 +57,8 @@ module utility (objectMember?, symbolMember?, stringMember?,
lastNode: %List %Thing -> %Maybe %Node %Thing
removeSymbol: (%List %Thing, %Symbol) -> %List %Thing
remove: (%List %Thing, %Thing) -> %List %Thing
- objectAssoc: (%Thing, %List %Pair(%Thing,%Thing)) ->
- %Maybe %Pair(%Thing,%Thing)
+ objectAssoc: (%Thing, %List %Thing) -> %Maybe %Pair(%Thing,%Thing)
+ symbolAssoc: (%Symbol,%List %Thing) -> %Maybe %Pair(%Symbol,%Thing)
setDifference: (%List %Thing,%List %Thing) -> %List %Thing
setUnion: (%List %Thing,%List %Thing) -> %List %Thing
setIntersection: (%List %Thing,%List %Thing) -> %List %Thing
@@ -177,12 +177,15 @@ append(x,y) ==
--% a-list
-assocSymbol(s,al) ==
+symbolAssoc(s,l) ==
repeat
- al is [x,:al] =>
- cons? x and symbolEq?(s,first x) =>
- return x
- return nil
+ l isnt [x,:l] => return nil
+ x is [.,:.] and symbolEq?(s,first x) => return x
+
+objectAssoc(x,l) ==
+ repeat
+ l isnt [p,:l] => return nil
+ p is [.,:.] and sameObject?(first p,x) => return p
--% substitution
@@ -210,7 +213,7 @@ applySubst(sl,t) ==
tl := applySubst(sl,rest t)
sameObject?(hd,first t) and sameObject?(tl,rest t) => t
[hd,:tl]
- symbol? t and (p := assocSymbol(t,sl)) => rest p
+ symbol? t and (p := symbolAssoc(t,sl)) => rest p
t
applySubst!(sl,t) ==
@@ -219,7 +222,7 @@ applySubst!(sl,t) ==
tl := applySubst!(sl,rest t)
t.first := hd
t.rest := tl
- symbol? t and (p := assocSymbol(t,sl)) => rest p
+ symbol? t and (p := symbolAssoc(t,sl)) => rest p
t
++ Like applySubst, but skip quoted materials.
@@ -230,7 +233,7 @@ applySubstNQ(sl,t) ==
tl := applySubstNQ(sl,tl)
sameObject?(hd,first t) and sameObject?(tl,rest t) => t
[hd,:tl]
- symbol? t and (p := assocSymbol(t,sl)) => rest p
+ symbol? t and (p := symbolAssoc(t,sl)) => rest p
t
--% set operations
@@ -293,11 +296,6 @@ remove(l,x) ==
--% search
-objectAssoc(x,l) ==
- repeat
- l isnt [p,:l] => return nil
- p is [a,:.] and sameObject?(a,x) => return p
-
++ Return the index of the character `c' in the string `s', if present.
++ Otherwise, return nil.
charPosition(c,s,k) ==
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-27 10:46:39 +0000