diff options
| author | dos-reis <gdr@axiomatics.org> | 2010-12-31 09:08:44 +0000 |
|---|---|---|
| committer | dos-reis <gdr@axiomatics.org> | 2010-12-31 09:08:44 +0000 |
| commit | 76862a96d4ba24beffa94cfbfbb1c2c8dbd1dd26 (patch) | |
| tree | 4e200ace4c0bffe0e95e118acbd2bbdab71bd5f6 /src/algebra/strap | |
| parent | b1fb4cb58a886484e213bd1235f6de75713950c9 (diff) | |
| download | open-axiom-76862a96d4ba24beffa94cfbfbb1c2c8dbd1dd26.tar.gz | |
* interp/g-opt.boot ($VMsideEffectFreeOperators): Include new
builtin functions %strlt, %streq, %strcopy, and %strconc.
* interp/g-util.boot: Expand them.
* algebra/string.spad.pamphlet (String): Remove uses of
Lisp-level functions CHAR, EQUAL, CHAR=, ans SXHASH.
Diffstat (limited to 'src/algebra/strap')
| -rw-r--r-- | src/algebra/strap/CHAR.lsp | 6 | ||||
| -rw-r--r-- | src/algebra/strap/ISTRING.lsp | 22 |
2 files changed, 19 insertions, 9 deletions
diff --git a/src/algebra/strap/CHAR.lsp b/src/algebra/strap/CHAR.lsp index bfbc88e1..a36914df 100644 --- a/src/algebra/strap/CHAR.lsp +++ b/src/algebra/strap/CHAR.lsp @@ -122,6 +122,11 @@ (DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) |%String|) |CHAR;latex;$S;30|)) +(PUT '|CHAR;latex;$S;30| '|SPADreplace| + '(XLAM (|c|) + (|%strconc| "\\mbox{`" + (|%strconc| (MAKE-FULL-CVEC 1 |c|) "'}")))) + (DECLAIM (FTYPE (FUNCTION (|%String| |%Shell|) |%Char|) |CHAR;char;S$;31|)) @@ -227,6 +232,7 @@ (SPADCALL |c| (|spadConstant| $ 52) (|getShellEntry| $ 42))) (DEFUN |CHAR;latex;$S;30| (|c| $) + (DECLARE (IGNORE $)) (STRCONC "\\mbox{`" (STRCONC (MAKE-FULL-CVEC 1 |c|) "'}"))) (DEFUN |CHAR;char;S$;31| (|s| $) diff --git a/src/algebra/strap/ISTRING.lsp b/src/algebra/strap/ISTRING.lsp index 60503702..1b686d19 100644 --- a/src/algebra/strap/ISTRING.lsp +++ b/src/algebra/strap/ISTRING.lsp @@ -23,23 +23,22 @@ (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|) |ISTRING;=;2$B;5|)) -(PUT '|ISTRING;=;2$B;5| '|SPADreplace| 'EQUAL) +(PUT '|ISTRING;=;2$B;5| '|SPADreplace| '|%streq|) (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|) |ISTRING;<;2$B;6|)) -(PUT '|ISTRING;<;2$B;6| '|SPADreplace| - '(XLAM (|s| |t|) (CGREATERP |t| |s|))) +(PUT '|ISTRING;<;2$B;6| '|SPADreplace| '|%strlt|) (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) |ISTRING;concat;3$;7|)) -(PUT '|ISTRING;concat;3$;7| '|SPADreplace| 'STRCONC) +(PUT '|ISTRING;concat;3$;7| '|SPADreplace| '|%strconc|) (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) |ISTRING;copy;2$;8|)) -(PUT '|ISTRING;copy;2$;8| '|SPADreplace| 'COPY-SEQ) +(PUT '|ISTRING;copy;2$;8| '|SPADreplace| '|%strcopy|) (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Integer| |%Shell|) |%Thing|) @@ -60,6 +59,9 @@ (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%String|) |ISTRING;latex;$S;14|)) +(PUT '|ISTRING;latex;$S;14| '|SPADreplace| + '(XLAM (|s|) (|%strconc| "\\mbox{``" (|%strconc| |s| "''}")))) + (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|) |%Thing|) |ISTRING;replace;$Us2$;15|)) @@ -121,7 +123,7 @@ (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Short|) |ISTRING;hash;$Si;32|)) -(PUT '|ISTRING;hash;$Si;32| '|SPADreplace| 'SXHASH) +(PUT '|ISTRING;hash;$Si;32| '|SPADreplace| '|%hash|) (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Char| |%Shell|) (|%IntegerSection| 0)) @@ -145,11 +147,11 @@ (DEFUN |ISTRING;=;2$B;5| (|s| |t| $) (DECLARE (IGNORE $)) - (EQUAL |s| |t|)) + (NOT (NULL (STRING= |s| |t|)))) (DEFUN |ISTRING;<;2$B;6| (|s| |t| $) (DECLARE (IGNORE $)) - (CGREATERP |t| |s|)) + (NOT (NULL (STRING< |s| |t|)))) (DEFUN |ISTRING;concat;3$;7| (|s| |t| $) (DECLARE (IGNORE $)) @@ -180,6 +182,7 @@ (SPADCALL (ELT $ 40) |s| (|getShellEntry| $ 37))) (DEFUN |ISTRING;latex;$S;14| (|s| $) + (DECLARE (IGNORE $)) (STRCONC "\\mbox{``" (STRCONC |s| "''}"))) (DEFUN |ISTRING;replace;$Us2$;15| (|s| |sg| |t| $) @@ -572,7 +575,8 @@ '(|NonNegativeInteger|) #0#)) |ISTRING;match?;2$CB;34|) (EXIT (COND - ((EQL |p| (- |m| 1)) (EQUAL |pattern| |target|)) + ((EQL |p| (- |m| 1)) + (NOT (NULL (STRING= |pattern| |target|)))) (T (SEQ (COND ((SPADCALL |p| |m| (|getShellEntry| $ 87)) |