diff options
Diffstat (limited to 'src/interp')
-rw-r--r-- | src/interp/g-opt.boot | 6 | ||||
-rw-r--r-- | src/interp/g-util.boot | 28 | ||||
-rw-r--r-- | src/interp/vmlisp.lisp | 3 |
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 |