From b06db52e69e3a7b7f4bd90ac129ea369be45284a Mon Sep 17 00:00:00 2001 From: dos-reis 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. --- configure | 20 ++++++++++---------- configure.ac | 2 +- src/ChangeLog | 8 ++++++++ src/algebra/strap/CHAR.lsp | 4 ++-- src/algebra/strap/ISTRING.lsp | 8 ++++---- src/algebra/string.spad.pamphlet | 21 +++++++++++---------- src/interp/g-opt.boot | 6 +++--- src/interp/g-util.boot | 28 +++++++++++++++++++--------- src/interp/vmlisp.lisp | 3 --- 9 files changed, 58 insertions(+), 42 deletions(-) diff --git a/configure b/configure index fdcebf28..44024bc3 100755 --- a/configure +++ b/configure @@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.65 for OpenAxiom 1.4.0-2010-12-27. +# Generated by GNU Autoconf 2.65 for OpenAxiom 1.4.0-2010-12-31. # # Report bugs to . # @@ -701,8 +701,8 @@ MAKEFLAGS= # Identity of this package. PACKAGE_NAME='OpenAxiom' PACKAGE_TARNAME='openaxiom' -PACKAGE_VERSION='1.4.0-2010-12-27' -PACKAGE_STRING='OpenAxiom 1.4.0-2010-12-27' +PACKAGE_VERSION='1.4.0-2010-12-31' +PACKAGE_STRING='OpenAxiom 1.4.0-2010-12-31' PACKAGE_BUGREPORT='open-axiom-bugs@lists.sf.net' PACKAGE_URL='' @@ -1491,7 +1491,7 @@ if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF -\`configure' configures OpenAxiom 1.4.0-2010-12-27 to adapt to many kinds of systems. +\`configure' configures OpenAxiom 1.4.0-2010-12-31 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1566,7 +1566,7 @@ fi if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of OpenAxiom 1.4.0-2010-12-27:";; + short | recursive ) echo "Configuration of OpenAxiom 1.4.0-2010-12-31:";; esac cat <<\_ACEOF @@ -1677,7 +1677,7 @@ fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF -OpenAxiom configure 1.4.0-2010-12-27 +OpenAxiom configure 1.4.0-2010-12-31 generated by GNU Autoconf 2.65 Copyright (C) 2009 Free Software Foundation, Inc. @@ -2569,7 +2569,7 @@ cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by OpenAxiom $as_me 1.4.0-2010-12-27, which was +It was created by OpenAxiom $as_me 1.4.0-2010-12-31, which was generated by GNU Autoconf 2.65. Invocation command line was $ $0 $@ @@ -5468,7 +5468,7 @@ fi # Define the identity of the package. PACKAGE='openaxiom' - VERSION='1.4.0-2010-12-27' + VERSION='1.4.0-2010-12-31' cat >>confdefs.h <<_ACEOF @@ -20961,7 +20961,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" -This file was extended by OpenAxiom $as_me 1.4.0-2010-12-27, which was +This file was extended by OpenAxiom $as_me 1.4.0-2010-12-31, which was generated by GNU Autoconf 2.65. Invocation command line was CONFIG_FILES = $CONFIG_FILES @@ -21027,7 +21027,7 @@ _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" ac_cs_version="\\ -OpenAxiom config.status 1.4.0-2010-12-27 +OpenAxiom config.status 1.4.0-2010-12-31 configured by $0, generated by GNU Autoconf 2.65, with options \\"\$ac_cs_config\\" diff --git a/configure.ac b/configure.ac index 82974d84..3c7bafd4 100644 --- a/configure.ac +++ b/configure.ac @@ -33,7 +33,7 @@ dnl Makefiles for building OpenAxiom interpreter, compiler, libraries, and dnl auxiliary tools where appropriate. dnl -AC_INIT([OpenAxiom], [1.4.0-2010-12-27], +AC_INIT([OpenAxiom], [1.4.0-2010-12-31], [open-axiom-bugs@lists.sf.net]) dnl Most of the macros used in this configure.ac are defined in files diff --git a/src/ChangeLog b/src/ChangeLog index 188cc62e..ed2b2231 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,11 @@ +2010-12-31 Gabriel Dos Reis + + * 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. + 2010-12-31 Gabriel Dos Reis * interp/g-opt.boot ($VMsideEffectFreeOperators): Include new diff --git a/src/algebra/strap/CHAR.lsp b/src/algebra/strap/CHAR.lsp index a36914df..76abf4fe 100644 --- a/src/algebra/strap/CHAR.lsp +++ b/src/algebra/strap/CHAR.lsp @@ -135,12 +135,12 @@ (DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) |%Char|) |CHAR;upperCase;2$;32|)) -(PUT '|CHAR;upperCase;2$;32| '|SPADreplace| 'CHAR-UPCASE) +(PUT '|CHAR;upperCase;2$;32| '|SPADreplace| '|%cup|) (DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) |%Char|) |CHAR;lowerCase;2$;33|)) -(PUT '|CHAR;lowerCase;2$;33| '|SPADreplace| 'CHAR-DOWNCASE) +(PUT '|CHAR;lowerCase;2$;33| '|SPADreplace| '|%cdown|) (DEFUN |CHAR;=;2$B;1| (|a| |b| $) (DECLARE (IGNORE $)) diff --git a/src/algebra/strap/ISTRING.lsp b/src/algebra/strap/ISTRING.lsp index 1b686d19..36f22984 100644 --- a/src/algebra/strap/ISTRING.lsp +++ b/src/algebra/strap/ISTRING.lsp @@ -214,21 +214,21 @@ (LOOP (COND ((> |i| #1#) (RETURN NIL)) - (T (SEQ (QESET |r| |k| (CHAR |s| |i|)) + (T (SEQ (SETF (CHAR |r| |k|) (CHAR |s| |i|)) (EXIT (SETQ |k| (+ |k| 1)))))) (SETQ |i| (+ |i| 1)))) (LET ((|i| 0) (#2=#:G1511 (- |n| 1))) (LOOP (COND ((> |i| #2#) (RETURN NIL)) - (T (SEQ (QESET |r| |k| (CHAR |t| |i|)) + (T (SEQ (SETF (CHAR |r| |k|) (CHAR |t| |i|)) (EXIT (SETQ |k| (+ |k| 1)))))) (SETQ |i| (+ |i| 1)))) (LET ((|i| (+ |h| 1)) (#3=#:G1512 (- |m| 1))) (LOOP (COND ((> |i| #3#) (RETURN NIL)) - (T (SEQ (QESET |r| |k| (CHAR |s| |i|)) + (T (SEQ (SETF (CHAR |r| |k|) (CHAR |s| |i|)) (EXIT (SETQ |k| (+ |k| 1)))))) (SETQ |i| (+ |i| 1)))) (EXIT |r|)))))) @@ -238,7 +238,7 @@ ((OR (< |i| (|getShellEntry| $ 6)) (< (SPADCALL |s| (|getShellEntry| $ 47)) |i|)) (|error| "index out of range")) - (T (SEQ (QESET |s| (- |i| (|getShellEntry| $ 6)) |c|) + (T (SEQ (SETF (CHAR |s| (- |i| (|getShellEntry| $ 6))) |c|) (EXIT |c|)))))) (DEFUN |ISTRING;substring?;2$IB;17| (|part| |whole| |startpos| $) diff --git a/src/algebra/string.spad.pamphlet b/src/algebra/string.spad.pamphlet index e25719f6..b336d9a6 100644 --- a/src/algebra/string.spad.pamphlet +++ b/src/algebra/string.spad.pamphlet @@ -94,6 +94,8 @@ Character: OrderedFinite() with import %cle: (%,%) -> Boolean from Foreign Builtin import %cgt: (%,%) -> Boolean from Foreign Builtin import %cge: (%,%) -> Boolean from Foreign Builtin + import %cup: % -> % from Foreign Builtin + import %cdown: % -> % from Foreign Builtin import %c2i: % -> NNI from Foreign Builtin import %i2c: NNI -> % from Foreign Builtin import %ccst: String -> % from Foreign Builtin @@ -136,10 +138,10 @@ Character: OrderedFinite() with %s2c s upperCase c == - CHAR_-UPCASE(c)$Lisp : % + %cup c lowerCase c == - CHAR_-DOWNCASE(c)$Lisp : % + %cdown c @ @@ -268,9 +270,9 @@ CharacterClass: Join(SetCategory, ConvertibleTo String, ++ Authors: Stephen Watt, Michael Monagan, Manuel Bronstein 1986 .. 1991 -- The following Lisp dependencies are divided into two groups -- Those that are required --- QESET MAKE-FULL-CVEC EQ QSLESSP QSGREATERP +-- MAKE-FULL-CVEC -- Those that can are included for efficiency only --- COPY SUBSTRING STRPOS RPLACSTR DOWNCASE UPCASE CGREATERP +-- SUBSTRING STRPOS RPLACSTR ++ Description: ++ This domain implements low-level strings @@ -283,8 +285,6 @@ IndexedString(mn:Integer): Export == Implementation where Export == StringAggregate() Implementation == add - -- These assume Character's Rep is Small I - Qsetelt ==> QESET$Lisp import %strlength: % -> N from Foreign Builtin import %streq: (%,%) -> Boolean from Foreign Builtin import %strlt: (%,%) -> Boolean from Foreign Builtin @@ -292,6 +292,7 @@ IndexedString(mn:Integer): Export == Implementation where import %schar: (%,I) -> Character from Foreign Builtin import %strconc: (%,%) -> % from Foreign Builtin import %strcopy: % -> % from Foreign Builtin + import %strstc: (%,Integer,Character) -> Void from Foreign Builtin import %hash : % -> SingleInteger from Foreign Builtin c: Character @@ -323,19 +324,19 @@ IndexedString(mn:Integer): Export == Implementation where r := new((m-(h-l+1)+n)::N, space$C) k: NonNegativeInteger := 0 for i in 0..l-1 repeat - Qsetelt(r, k, %schar(s, i)) + %strstc(r, k, %schar(s, i)) k := k + 1 for i in 0..n-1 repeat - Qsetelt(r, k, %schar(t, i)) + %strstc(r, k, %schar(t, i)) k := k + 1 for i in h+1..m-1 repeat - Qsetelt(r, k, %schar(s, i)) + %strstc(r, k, %schar(s, i)) k := k + 1 r setelt(s:%, i:I, c:C) == i < mn or i > maxIndex(s) => error "index out of range" - Qsetelt(s, i - mn, c) + %strstc(s, i - mn, c) c substring?(part, whole, startpos) == 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