From 76862a96d4ba24beffa94cfbfbb1c2c8dbd1dd26 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Fri, 31 Dec 2010 09:08:44 +0000
Subject: 	* 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.

---
 src/algebra/strap/CHAR.lsp    |  6 ++++++
 src/algebra/strap/ISTRING.lsp | 22 +++++++++++++---------
 2 files changed, 19 insertions(+), 9 deletions(-)

(limited to 'src/algebra/strap')

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))
-- 
cgit v1.2.3