aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog6
-rw-r--r--src/algebra/strap/ISTRING.lsp23
-rw-r--r--src/algebra/strap/OUTFORM.lsp4
-rw-r--r--src/algebra/strap/SYMBOL.lsp12
-rw-r--r--src/algebra/string.spad.pamphlet22
-rw-r--r--src/interp/g-opt.boot1
-rw-r--r--src/interp/g-util.boot11
-rw-r--r--src/interp/i-funsel.boot4
-rw-r--r--src/interp/msgdb.boot30
9 files changed, 62 insertions, 51 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 7912902e..532ef386 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,9 @@
+2010-12-29 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * interp/g-opt.boot ($VMsideEffectFreeOperators): Include %strlength.
+ * interp/g-util.boot: Expand it.
+ * algebra/string.spad.pamphlet (String): Remove use of QCSIZE.
+
2010-12-27 Gabriel Dos Reis <gdr@cs.tamu.edu>
* boot/initial-env.lisp (IDENTP): Remove.
diff --git a/src/algebra/strap/ISTRING.lsp b/src/algebra/strap/ISTRING.lsp
index 4b5f1be6..b6f386f0 100644
--- a/src/algebra/strap/ISTRING.lsp
+++ b/src/algebra/strap/ISTRING.lsp
@@ -12,10 +12,13 @@
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|)
|ISTRING;empty?;$B;3|))
+(PUT '|ISTRING;empty?;$B;3| '|SPADreplace|
+ '(XLAM (|s|) (|%ieq| (|%strlength| |s|) 0)))
+
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) (|%IntegerSection| 0))
|ISTRING;#;$Nni;4|))
-(PUT '|ISTRING;#;$Nni;4| '|SPADreplace| 'QCSIZE)
+(PUT '|ISTRING;#;$Nni;4| '|SPADreplace| '|%strlength|)
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
|ISTRING;=;2$B;5|))
@@ -134,9 +137,11 @@
(DEFUN |ISTRING;empty;$;2| ($) (MAKE-FULL-CVEC 0))
-(DEFUN |ISTRING;empty?;$B;3| (|s| $) (ZEROP (QCSIZE |s|)))
+(DEFUN |ISTRING;empty?;$B;3| (|s| $)
+ (DECLARE (IGNORE $))
+ (ZEROP (LENGTH |s|)))
-(DEFUN |ISTRING;#;$Nni;4| (|s| $) (DECLARE (IGNORE $)) (QCSIZE |s|))
+(DEFUN |ISTRING;#;$Nni;4| (|s| $) (DECLARE (IGNORE $)) (LENGTH |s|))
(DEFUN |ISTRING;=;2$B;5| (|s| |t| $)
(DECLARE (IGNORE $))
@@ -234,7 +239,7 @@
(EXIT |c|))))))
(DEFUN |ISTRING;substring?;2$IB;17| (|part| |whole| |startpos| $)
- (LET ((|np| (QCSIZE |part|)) (|nw| (QCSIZE |whole|)))
+ (LET ((|np| (LENGTH |part|)) (|nw| (LENGTH |whole|)))
(SEQ (SETQ |startpos| (- |startpos| (|getShellEntry| $ 6)))
(EXIT (COND
((MINUSP |startpos|) (|error| "index out of bounds"))
@@ -262,7 +267,7 @@
(EXIT (COND
((MINUSP |startpos|)
(|error| "index out of bounds"))
- ((NOT (< |startpos| (QCSIZE |t|)))
+ ((NOT (< |startpos| (LENGTH |t|)))
(- (|getShellEntry| $ 6) 1))
(T (SEQ (LETT |r| (STRPOS |s| |t| |startpos| NIL)
|ISTRING;position;2$2I;18|)
@@ -275,10 +280,10 @@
(SEQ (SETQ |startpos| (- |startpos| (|getShellEntry| $ 6)))
(EXIT (COND
((MINUSP |startpos|) (|error| "index out of bounds"))
- ((NOT (< |startpos| (QCSIZE |t|)))
+ ((NOT (< |startpos| (LENGTH |t|)))
(- (|getShellEntry| $ 6) 1))
(T (SEQ (LET ((|r| |startpos|)
- (#0=#:G1514 (- (QCSIZE |t|) 1)))
+ (#0=#:G1514 (- (LENGTH |t|) 1)))
(LOOP
(COND
((> |r| #0#) (RETURN NIL))
@@ -294,10 +299,10 @@
(SEQ (SETQ |startpos| (- |startpos| (|getShellEntry| $ 6)))
(EXIT (COND
((MINUSP |startpos|) (|error| "index out of bounds"))
- ((NOT (< |startpos| (QCSIZE |t|)))
+ ((NOT (< |startpos| (LENGTH |t|)))
(- (|getShellEntry| $ 6) 1))
(T (SEQ (LET ((|r| |startpos|)
- (#0=#:G1515 (- (QCSIZE |t|) 1)))
+ (#0=#:G1515 (- (LENGTH |t|) 1)))
(LOOP
(COND
((> |r| #0#) (RETURN NIL))
diff --git a/src/algebra/strap/OUTFORM.lsp b/src/algebra/strap/OUTFORM.lsp
index dcbbd6a0..2f459f95 100644
--- a/src/algebra/strap/OUTFORM.lsp
+++ b/src/algebra/strap/OUTFORM.lsp
@@ -542,9 +542,7 @@
(|mathprint| |x|))
(DEFUN |OUTFORM;message;S$;7| (|s| $)
- (COND
- ((SPADCALL |s| (|getShellEntry| $ 12)) (|OUTFORM;empty;$;73| $))
- (T |s|)))
+ (COND ((ZEROP (LENGTH |s|)) (|OUTFORM;empty;$;73| $)) (T |s|)))
(DEFUN |OUTFORM;messagePrint;SV;8| (|s| $)
(|mathprint| (|OUTFORM;message;S$;7| |s| $)))
diff --git a/src/algebra/strap/SYMBOL.lsp b/src/algebra/strap/SYMBOL.lsp
index 45a9c215..1ab934bc 100644
--- a/src/algebra/strap/SYMBOL.lsp
+++ b/src/algebra/strap/SYMBOL.lsp
@@ -278,7 +278,7 @@
(RETURN
(LET ((|s| (PNAME (SPADCALL |e| (|getShellEntry| $ 100)))))
(SEQ (COND
- ((< 1 (QCSIZE |s|))
+ ((< 1 (LENGTH |s|))
(COND
((SPADCALL (SPADCALL |s| 1 (|getShellEntry| $ 106))
(SPADCALL "\\" (|getShellEntry| $ 43))
@@ -390,7 +390,7 @@
(NIL (RETURN NIL))
(T (SEQ (LETT |qr|
(MULTIPLE-VALUE-CALL #'CONS
- (TRUNCATE |n| (QCSIZE |s|)))
+ (TRUNCATE |n| (LENGTH |s|)))
|SYMBOL;anyRadix|)
(SETQ |n| (CAR |qr|))
(SETQ |ns|
@@ -489,7 +489,7 @@
$)
|SYMBOL;name;2$;31|)
(LET ((|i| (+ (|getShellEntry| $ 41) 1))
- (#0=#:G1526 (QCSIZE |str|)))
+ (#0=#:G1526 (LENGTH |str|)))
(LOOP
(COND
((> |i| #0#) (RETURN NIL))
@@ -501,7 +501,7 @@
(RETURN-FROM |SYMBOL;name;2$;31|
(|SYMBOL;coerce;S$;8|
(SPADCALL |str|
- (SPADCALL |i| (QCSIZE |str|)
+ (SPADCALL |i| (LENGTH |str|)
(|getShellEntry| $ 141))
(|getShellEntry| $ 142))
$))))))
@@ -524,7 +524,7 @@
(|getShellEntry| $ 137))
$)
|SYMBOL;scripts;$R;32|)
- (LETT |nstr| (QCSIZE |str|)
+ (LETT |nstr| (LENGTH |str|)
|SYMBOL;scripts;$R;32|)
(LETT |m|
(SPADCALL |nscripts|
@@ -652,7 +652,7 @@
(|setShellEntry| $ 20 "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
(|setShellEntry| $ 21 "abcdefghijklmnopqrstuvwxyz")
(|setShellEntry| $ 38 "*")
- (|setShellEntry| $ 41 (QCSIZE (|getShellEntry| $ 38)))
+ (|setShellEntry| $ 41 (LENGTH (|getShellEntry| $ 38)))
(|setShellEntry| $ 45
(SPADCALL (SPADCALL "0" (|getShellEntry| $ 43))
(|getShellEntry| $ 44)))
diff --git a/src/algebra/string.spad.pamphlet b/src/algebra/string.spad.pamphlet
index 59b45648..2dd8ec2e 100644
--- a/src/algebra/string.spad.pamphlet
+++ b/src/algebra/string.spad.pamphlet
@@ -268,7 +268,7 @@ CharacterClass: Join(SetCategory, ConvertibleTo String,
++ Authors: Stephen Watt, Michael Monagan, Manuel Bronstein 1986 .. 1991
-- The following Lisp dependencies are divided into two groups
-- Those that are required
--- QENUM QESET QCSIZE MAKE-FULL-CVEC EQ QSLESSP QSGREATERP
+-- QENUM QESET MAKE-FULL-CVEC EQ QSLESSP QSGREATERP
-- Those that can are included for efficiency only
-- COPY STRCONC SUBSTRING STRPOS RPLACSTR DOWNCASE UPCASE CGREATERP
++ Description:
@@ -287,8 +287,8 @@ IndexedString(mn:Integer): Export == Implementation where
Qelt ==> CHAR$Lisp
Qequal ==> EQUAL$Lisp
Qsetelt ==> QESET$Lisp
- Qsize ==> QCSIZE$Lisp
Cheq ==> CHAR_=$Lisp
+ import %strlength: % -> N from Foreign Builtin
c: Character
cc: CharacterClass
@@ -296,8 +296,8 @@ IndexedString(mn:Integer): Export == Implementation where
-- new n == MAKE_-FULL_-CVEC(n, space$C)$Lisp
new(n, c) == MAKE_-FULL_-CVEC(n, c)$Lisp
empty() == MAKE_-FULL_-CVEC(0@I)$Lisp
- empty?(s) == Qsize(s) = 0
- #s == Qsize(s)
+ empty?(s) == %strlength s = 0
+ #s == %strlength s
s = t == Qequal(s, t)
s < t == CGREATERP(t,s)$Lisp
concat(s:%,t:%) == STRCONC(s,t)$Lisp
@@ -335,8 +335,8 @@ IndexedString(mn:Integer): Export == Implementation where
c
substring?(part, whole, startpos) ==
- np:I := Qsize part
- nw:I := Qsize whole
+ np:I := %strlength part
+ nw:I := %strlength whole
(startpos := startpos - mn) < 0 => error "index out of bounds"
np > nw - startpos => false
for ip in 0..np-1 for iw in startpos.. repeat
@@ -345,20 +345,20 @@ IndexedString(mn:Integer): Export == Implementation where
position(s:%, t:%, startpos:I) ==
(startpos := startpos - mn) < 0 => error "index out of bounds"
- startpos >= Qsize t => mn - 1
+ startpos >= %strlength t => mn - 1
r:I := STRPOS(s, t, startpos, NIL$Lisp)$Lisp
%peq(r, NIL$Lisp)$Foreign(Builtin) => mn - 1
r + mn
position(c: Character, t: %, startpos: I) ==
(startpos := startpos - mn) < 0 => error "index out of bounds"
- startpos >= Qsize t => mn - 1
- for r in startpos..Qsize t - 1 repeat
+ startpos >= %strlength t => mn - 1
+ for r in startpos..%strlength t - 1 repeat
if Cheq(Qelt(t, r), c) then return r + mn
mn - 1
position(cc: CharacterClass, t: %, startpos: I) ==
(startpos := startpos - mn) < 0 => error "index out of bounds"
- startpos >= Qsize t => mn - 1
- for r in startpos..Qsize t - 1 repeat
+ startpos >= %strlength t => mn - 1
+ for r in startpos..%strlength t - 1 repeat
if member?(Qelt(t,r), cc) then return r + mn
mn - 1
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index 36f369ec..cd078397 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -451,6 +451,7 @@ $VMsideEffectFreeOperators ==
%nil %pair? %lconcat %llength %lfirst %lsecond %lthird
%lreverse %lempty? %hash %ismall? %string? %f2s
%ccst %ceq %clt %cle %cgt %cge %c2i %i2c %s2c %sname
+ %strlength
%vref %vlength %before?)
++ List of simple VM operators
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index 9737c712..3a2504cf 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -512,6 +512,7 @@ for x in [
-- string unary functions
['%string?, :'STRINGP],
+ ['%strlength, :'LENGTH],
-- general utility
['%hash, :'SXHASH],
@@ -600,7 +601,7 @@ isSharpVar x ==
isSharpVarWithNum x ==
not isSharpVar x => nil
- (n := QCSIZE(p := PNAME x)) < 2 => nil
+ (n := #(p := PNAME x)) < 2 => nil
ok := true
c := 0
for i in 1..(n-1) while ok repeat
@@ -977,8 +978,8 @@ stringPrefix?(pref,str) ==
-- sees if the first #pref letters of str are pref
-- replaces STRINGPREFIXP
not (string?(pref) and string?(str)) => NIL
- (lp := QCSIZE pref) = 0 => true
- lp > QCSIZE str => NIL
+ (lp := # pref) = 0 => true
+ lp > # str => NIL
ok := true
i := 0
while ok and (i < lp) repeat
@@ -992,13 +993,13 @@ stringChar2Integer(str,pos) ==
-- in string str. Returns NIL if not a digit or other error.
if IDENTP str then str := PNAME str
not (string?(str) and
- integer?(pos) and (pos >= 0) and (pos < QCSIZE(str))) => NIL
+ integer?(pos) and (pos >= 0) and (pos < #str)) => NIL
not digit?(d := SCHAR(str,pos)) => NIL
DIG2FIX d
dropLeadingBlanks str ==
str := object2String str
- l := QCSIZE str
+ l := # str
nb := NIL
i := 0
while (i < l) and not nb repeat
diff --git a/src/interp/i-funsel.boot b/src/interp/i-funsel.boot
index 37939a6a..e58d4a3a 100644
--- a/src/interp/i-funsel.boot
+++ b/src/interp/i-funsel.boot
@@ -1016,7 +1016,7 @@ selectMmsGen(op,tar,args1,args2) ==
$Subst: local := NIL
$SymbolType: local := NIL
- null (S := getModemapsFromDatabase(op,QLENGTH args1)) => NIL
+ null (S := getModemapsFromDatabase(op,#args1)) => NIL
if (op = 'map) and (2 = #args1) and
(first(args1) is ['Mapping,., elem]) and
@@ -1702,7 +1702,7 @@ printMms(mmS) ==
sayMSG '" "
for [sig,imp,.] in mmS for i in 1.. repeat
istr := strconc('"[",STRINGIMAGE i,'"]")
- if QCSIZE(istr) = 3 then istr := strconc(istr,'" ")
+ if #istr = 3 then istr := strconc(istr,'" ")
sayMSG [:bright istr,'"signature: ",:formatSignature rest sig]
first sig='local =>
sayMSG ['" implemented: local function ",imp]
diff --git a/src/interp/msgdb.boot b/src/interp/msgdb.boot
index 9d650bd6..36281057 100644
--- a/src/interp/msgdb.boot
+++ b/src/interp/msgdb.boot
@@ -175,7 +175,7 @@ substituteSegmentedMsg(msg,args) ==
cons? x =>
l := [substituteSegmentedMsg(x,args),:l]
c := x.0
- n := STRINGLENGTH x
+ n := # x
-- x is a special case
(n > 2) and c = char "%" and x.1 = char "k" =>
@@ -573,14 +573,14 @@ brightPrint(x,out == $OutputStream) ==
brightPrint0(x,out == $OutputStream) ==
$texFormatting => brightPrint0AsTeX(x,out)
- if IDENTP x then x := PNAME x
+ if IDENTP x then x := symbolName x
not string? x => brightPrintHighlight(x,out)
-- if the first character is a backslash and the second is a percent sign,
-- don't try to give the token any special interpretation. Just print
-- it without the backslash.
- STRINGLENGTH x > 1 and x.0 = char "\" and x.1 = char "%" =>
+ # x > 1 and x.0 = char "\" and x.1 = char "%" =>
sayString(subString(x,1),out)
x = '"%l" =>
sayNewLine(out)
@@ -639,7 +639,7 @@ brightPrint0AsTeX(x, out == $OutputStream) ==
brightPrintHighlight(x,out)
blankIndicator x ==
- if IDENTP x then x := PNAME x
+ if IDENTP x then x := symbolName x
not string? x or MAXINDEX x < 1 => nil
x.0 = char '% and x.1 = char 'x =>
MAXINDEX x > 1 => readInteger subString(x,2)
@@ -655,7 +655,7 @@ brightPrint1(x, out == $OutputStream) ==
brightPrintHighlight(x, out == $OutputStream) ==
$texFormatting => brightPrintHighlightAsTeX(x,out)
x is [key,:rst] =>
- if IDENTP key then key := PNAME key
+ if IDENTP key then key := symbolName key
key is '"%m" => mathprint(rst,out)
string? key and key in '("%p" "%s") => PRETTYPRIN0(rst,out)
key is '"%ce" => brightPrintCenter(rst,out)
@@ -672,7 +672,7 @@ brightPrintHighlight(x, out == $OutputStream) ==
sayString('" . ",out)
brightPrint1(la,out)
sayString('")",out)
- IDENTP x => sayString(PNAME x,out)
+ IDENTP x => sayString(symbolName x,out)
-- following line helps find certain bugs that slip through
-- also see sayBrightlyLength1
vector? x => sayString('"UNPRINTABLE",out)
@@ -699,7 +699,7 @@ brightPrintHighlightAsTeX(x, out == $OutputStream) ==
sayString('" . ",out)
brightPrint1(la,out)
sayString('")",out)
- IDENTP x => sayString(PNAME x,out)
+ IDENTP x => sayString(symbolName x,out)
vector? x => sayString('"UNPRINTABLE",out)
sayString(object2String x,out)
@@ -713,7 +713,7 @@ brightPrintCenter(x,out == $OutputStream) ==
-- centers rst within $LINELENGTH, checking for %l's
atom x =>
x := object2String x
- wid := STRINGLENGTH x
+ wid := # x
if wid < $LINELENGTH then
f := DIVIDE($LINELENGTH - wid,2)
x := [fillerSpaces(f.0,'" "),x]
@@ -759,7 +759,7 @@ brightPrintRightJustify(x, out == $OutputStream) ==
-- right justifies rst within $LINELENGTH, checking for %l's
atom x =>
x := object2String x
- wid := STRINGLENGTH x
+ wid := # x
wid < $LINELENGTH =>
x := [fillerSpaces($LINELENGTH-wid,'" "),x]
for y in x repeat brightPrint0(y,out)
@@ -794,14 +794,14 @@ sayBrightlyLength1 x ==
null $highlightAllowed => 1
1
member(x,'("%l" %l)) => 0
- string? x and STRINGLENGTH x > 2 and x.0 = '"%" and x.1 = '"x" =>
- INTERN x.3
- string? x => STRINGLENGTH x
- IDENTP x => STRINGLENGTH PNAME x
+ string? x and # x > 2 and x.0 = char "%" and x.1 = char "x" =>
+ readInteger(x,2)
+ string? x => # x
+ IDENTP x => # symbolName x
-- following line helps find certain bugs that slip through
-- also see brightPrintHighlight
- vector? x => STRINGLENGTH '"UNPRINTABLE"
- atom x => STRINGLENGTH STRINGIMAGE x
+ vector? x => # '"UNPRINTABLE"
+ atom x => # toString x
2 + sayBrightlyLength x
sayAsManyPerLineAsPossible l ==
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-06 19:48:54 +0000