From b06db52e69e3a7b7f4bd90ac129ea369be45284a Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Fri, 31 Dec 2010 15:20:08 +0000
Subject: 	* interp/g-opt.boot ($VMsideEffectFreeOperators): Include %cup
 and 	%cdown. 	* interp/g-util.boot: Expand them. 	*
 interp/vmlisp.lisp (QESET): Remove. 	* algebra/string.spad.pamphlet
 (String): Don't use QESET.

---
 src/interp/g-opt.boot  |  6 +++---
 src/interp/g-util.boot | 28 +++++++++++++++++++---------
 src/interp/vmlisp.lisp |  3 ---
 3 files changed, 22 insertions(+), 15 deletions(-)

(limited to 'src/interp')

diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index 4eadc1a3..84db991f 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -450,15 +450,15 @@ $VMsideEffectFreeOperators ==
         %fsinh %fcosh %ftanh %fcsch %fcoth %fsech %fasinh %facsch
         %nil %pair? %lconcat %llength %lfirst %lsecond %lthird
         %lreverse %lempty? %hash %ismall? %string? %f2s
-        %ccst %ceq %clt %cle %cgt %cge %c2i %i2c %s2c %sname
-        %strlength %streq %i2s %schar %strlt %strconc %strcopy
+        %ccst %ceq %clt %cle %cgt %cge %c2i %i2c %s2c %cup %cdown %sname
+        %strlength %streq %i2s %schar %strlt %strconc %strcopy %strstc
         %vref %vlength %before?)
 
 ++ List of simple VM operators
 $simpleVMoperators == 
   append($VMsideEffectFreeOperators,
     ['CONS,'LIST,'VECTOR,'STRINGIMAGE,'FUNCALL,'%gensym, '%lreverse_!,
-      "MAKE-FULL-CVEC","BVEC-MAKE-FULL","COND"])
+      '%strstc,"MAKE-FULL-CVEC","BVEC-MAKE-FULL","COND"])
 
 ++ Return true if the `form' is semi-simple with respect to
 ++ to the list of operators `ops'.
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index fb08a56a..98e834bb 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -349,13 +349,20 @@ expandFlt ['%flt,x,y] ==
 expandFgt ['%fgt,x,y] ==
   expandFlt ['%flt,y,x]
 
--- String operations  
+-- String operations
+
+++ string equality comparison
 expandStreq ['%streq,x,y] ==
   expandToVMForm ['%not,['%peq,['STRING_=,x,y],'%nil]]
 
+++ string lexicographic comparison  
 expandStrlt ['%strlt,x,y] ==
   expandToVMForm ['%not,['%peq,['STRING_<,x,y],'%nil]]
 
+++ deposit a character `z' at slot number `y' in string object `x'.  
+expandStrstc ['%strstc,x,y,z] ==
+  expandToVMForm ['%store,['%schar,x,y],z]
+
 -- Local variable bindings
 expandBind ['%bind,inits,:body] ==
   body := expandToVMForm body
@@ -424,13 +431,15 @@ for x in [
     ['%or,  :'OR],
 
     -- character operations
-    ['%ceq, :'CHAR_=],
-    ['%clt, :'CHAR_<],
-    ['%cle, :'CHAR_<_=],
-    ['%cgt, :'CHAR_>],
-    ['%cge, :'CHAR_>_=],
-    ['%c2i, :'CHAR_-CODE],
-    ['%i2c, :'CODE_-CHAR],
+    ['%ceq,    :'CHAR_=],
+    ['%clt,    :'CHAR_<],
+    ['%cle,    :'CHAR_<_=],
+    ['%cgt,    :'CHAR_>],
+    ['%cge,    :'CHAR_>_=],
+    ['%cup,    :'CHAR_-UPCASE],
+    ['%cdown,  :'CHAR_-DOWNCASE],
+    ['%c2i,    :'CHAR_-CODE],
+    ['%i2c,    :'CODE_-CHAR],
 
     -- byte operations
     ['%beq, :'byteEqual],
@@ -519,7 +528,7 @@ for x in [
     ['%gensym,  :'GENSYM],
     ['%sname,   :'SYMBOL_-NAME],
 
-    -- string unary functions
+    -- string functions
     ['%string?, :'STRINGP],
     ['%strlength, :'LENGTH],
     ['%schar,     :'CHAR],
@@ -566,6 +575,7 @@ for x in [
 
    ['%streq,   :function expandStreq],
    ['%strlt,   :function expandStrlt],
+   ['%strstc,  :function expandStrstc],
 
    ['%peq,     :function expandPeq],
    ['%before?, :function expandBefore?],
diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp
index 7845b25e..70426163 100644
--- a/src/interp/vmlisp.lisp
+++ b/src/interp/vmlisp.lisp
@@ -917,9 +917,6 @@
 
 ; 17.2 Accessing
 
-(defun QESET (cvec ind c)
-  (setf (char cvec ind) c))
-
 (defun string2id-n (cvec sint)
   (if (< sint 1)
       nil
-- 
cgit v1.2.3