aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/g-opt.boot6
-rw-r--r--src/interp/g-util.boot28
-rw-r--r--src/interp/vmlisp.lisp3
3 files changed, 22 insertions, 15 deletions
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