aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rwxr-xr-xconfigure20
-rw-r--r--configure.ac2
-rw-r--r--src/ChangeLog8
-rw-r--r--src/algebra/strap/CHAR.lsp4
-rw-r--r--src/algebra/strap/ISTRING.lsp8
-rw-r--r--src/algebra/string.spad.pamphlet21
-rw-r--r--src/interp/g-opt.boot6
-rw-r--r--src/interp/g-util.boot28
-rw-r--r--src/interp/vmlisp.lisp3
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 <open-axiom-bugs@lists.sf.net>.
#
@@ -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,5 +1,13 @@
2010-12-31 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ * 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 <gdr@cs.tamu.edu>
+
* interp/g-opt.boot ($VMsideEffectFreeOperators): Include new
builtin functions %strlt, %streq, %strcopy, and %strconc.
* interp/g-util.boot: Expand them.
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-08-29 00:25:03 +0000