aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rwxr-xr-xconfigure18
-rw-r--r--configure.ac2
-rw-r--r--configure.ac.pamphlet2
-rw-r--r--src/ChangeLog10
-rw-r--r--src/algebra/strap/POLYCAT-.lsp162
-rw-r--r--src/interp/compiler.boot41
-rw-r--r--src/interp/sys-macros.lisp11
7 files changed, 116 insertions, 130 deletions
diff --git a/configure b/configure
index 2da09a52..39fa8a4f 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.63 for OpenAxiom 1.4.0-2009-07-02.
+# Generated by GNU Autoconf 2.63 for OpenAxiom 1.4.0-2009-07-03.
#
# Report bugs to <open-axiom-bugs@lists.sf.net>.
#
@@ -745,8 +745,8 @@ SHELL=${CONFIG_SHELL-/bin/sh}
# Identity of this package.
PACKAGE_NAME='OpenAxiom'
PACKAGE_TARNAME='openaxiom'
-PACKAGE_VERSION='1.4.0-2009-07-02'
-PACKAGE_STRING='OpenAxiom 1.4.0-2009-07-02'
+PACKAGE_VERSION='1.4.0-2009-07-03'
+PACKAGE_STRING='OpenAxiom 1.4.0-2009-07-03'
PACKAGE_BUGREPORT='open-axiom-bugs@lists.sf.net'
ac_unique_file="src/Makefile.pamphlet"
@@ -1502,7 +1502,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-2009-07-02 to adapt to many kinds of systems.
+\`configure' configures OpenAxiom 1.4.0-2009-07-03 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
@@ -1572,7 +1572,7 @@ fi
if test -n "$ac_init_help"; then
case $ac_init_help in
- short | recursive ) echo "Configuration of OpenAxiom 1.4.0-2009-07-02:";;
+ short | recursive ) echo "Configuration of OpenAxiom 1.4.0-2009-07-03:";;
esac
cat <<\_ACEOF
@@ -1675,7 +1675,7 @@ fi
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
-OpenAxiom configure 1.4.0-2009-07-02
+OpenAxiom configure 1.4.0-2009-07-03
generated by GNU Autoconf 2.63
Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
@@ -1689,7 +1689,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-2009-07-02, which was
+It was created by OpenAxiom $as_me 1.4.0-2009-07-03, which was
generated by GNU Autoconf 2.63. Invocation command line was
$ $0 $@
@@ -17704,7 +17704,7 @@ exec 6>&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-2009-07-02, which was
+This file was extended by OpenAxiom $as_me 1.4.0-2009-07-03, which was
generated by GNU Autoconf 2.63. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
@@ -17767,7 +17767,7 @@ Report bugs to <bug-autoconf@gnu.org>."
_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_version="\\
-OpenAxiom config.status 1.4.0-2009-07-02
+OpenAxiom config.status 1.4.0-2009-07-03
configured by $0, generated by GNU Autoconf 2.63,
with options \\"`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\"
diff --git a/configure.ac b/configure.ac
index d0de50d6..186a4dcd 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1,6 +1,6 @@
sinclude(config/open-axiom.m4)
sinclude(config/aclocal.m4)
-AC_INIT([OpenAxiom], [1.4.0-2009-07-02],
+AC_INIT([OpenAxiom], [1.4.0-2009-07-03],
[open-axiom-bugs@lists.sf.net])
AC_CONFIG_AUX_DIR(config)
diff --git a/configure.ac.pamphlet b/configure.ac.pamphlet
index db7b72f6..d7945d12 100644
--- a/configure.ac.pamphlet
+++ b/configure.ac.pamphlet
@@ -1141,7 +1141,7 @@ information:
<<Autoconf init>>=
sinclude(config/open-axiom.m4)
sinclude(config/aclocal.m4)
-AC_INIT([OpenAxiom], [1.4.0-2009-07-02],
+AC_INIT([OpenAxiom], [1.4.0-2009-07-03],
[open-axiom-bugs@lists.sf.net])
@
diff --git a/src/ChangeLog b/src/ChangeLog
index b2570de0..a0bf2157 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,11 +1,17 @@
-2009-07-02 Gabriel Dos Reis <gdr@cse.tamu.edu>
+2009-07-03 Gabriel Dos Reis <gdr@cse.tamu.edu>
+
+ * interp/sys-macros.lisp (PRIMVEC2ARR): Remove.
+ (COLLECTVEC): Likewise.
+ * interp/compiler.boot (compRepeatOrCollect): Tidy.
+
+2009-07-02 Gabriel Dos Reis <gdr@cs.tamu.edu>
Support ECL-based build profiling.
* lisp/Makefile.in (edit): Substitute for oa_enable_profiling.
* lisp/core.lisp.in ($EnableLispProfiling): New.
(compileLispFile): Use it.
-2009-07-02 Gabriel Dos Reis <gdr@cse.tamu.edu>
+2009-07-02 Gabriel Dos Reis <gdr@cs.tamu.edu>
* interp/sys-macros.lisp (COLLECTV): Use setSimpleArrayEntry, not
SETELT.
diff --git a/src/algebra/strap/POLYCAT-.lsp b/src/algebra/strap/POLYCAT-.lsp
index 3b73ad54..eb53dedb 100644
--- a/src/algebra/strap/POLYCAT-.lsp
+++ b/src/algebra/strap/POLYCAT-.lsp
@@ -1162,95 +1162,93 @@
|POLYCAT-;conditionP;MU;27|)
(EXIT
(CONS 0
- (PRIMVEC2ARR
- (PROGN
- (LETT #15#
- (GETREFV (SIZE |monslist|))
+ (PROGN
+ (LETT #15#
+ (GETREFV (SIZE |monslist|))
+ |POLYCAT-;conditionP;MU;27|)
+ (SEQ
+ (LETT #16# 0
|POLYCAT-;conditionP;MU;27|)
- (SEQ
- (LETT #16# 0
- |POLYCAT-;conditionP;MU;27|)
- (LETT |mons| NIL
- |POLYCAT-;conditionP;MU;27|)
- (LETT #17# |monslist|
- |POLYCAT-;conditionP;MU;27|)
- G190
- (COND
- ((OR (ATOM #17#)
- (PROGN
- (LETT |mons| (CAR #17#)
- |POLYCAT-;conditionP;MU;27|)
- NIL))
- (GO G191)))
- (SEQ
- (EXIT
- (|setSimpleArrayEntry| #15#
- #16#
+ (LETT |mons| NIL
+ |POLYCAT-;conditionP;MU;27|)
+ (LETT #17# |monslist|
+ |POLYCAT-;conditionP;MU;27|)
+ G190
+ (COND
+ ((OR (ATOM #17#)
(PROGN
- (LETT #21# NIL
+ (LETT |mons| (CAR #17#)
|POLYCAT-;conditionP;MU;27|)
+ NIL))
+ (GO G191)))
+ (SEQ
+ (EXIT
+ (|setSimpleArrayEntry| #15#
+ #16#
+ (PROGN
+ (LETT #21# NIL
+ |POLYCAT-;conditionP;MU;27|)
+ (SEQ
+ (LETT |m| NIL
+ |POLYCAT-;conditionP;MU;27|)
+ (LETT #18# |mons|
+ |POLYCAT-;conditionP;MU;27|)
+ G190
+ (COND
+ ((OR (ATOM #18#)
+ (PROGN
+ (LETT |m|
+ (CAR #18#)
+ |POLYCAT-;conditionP;MU;27|)
+ NIL))
+ (GO G191)))
(SEQ
- (LETT |m| NIL
- |POLYCAT-;conditionP;MU;27|)
- (LETT #18# |mons|
- |POLYCAT-;conditionP;MU;27|)
- G190
- (COND
- ((OR (ATOM #18#)
- (PROGN
- (LETT |m|
- (CAR #18#)
- |POLYCAT-;conditionP;MU;27|)
- NIL))
- (GO G191)))
- (SEQ
- (EXIT
- (PROGN
- (LETT #19#
- (SPADCALL |m|
+ (EXIT
+ (PROGN
+ (LETT #19#
+ (SPADCALL |m|
+ (SPADCALL
(SPADCALL
- (SPADCALL
- (QCDR |ans|)
- (LETT |i|
- (+ |i| 1)
- |POLYCAT-;conditionP;MU;27|)
- (|getShellEntry|
- $ 181))
+ (QCDR |ans|)
+ (LETT |i|
+ (+ |i| 1)
+ |POLYCAT-;conditionP;MU;27|)
(|getShellEntry|
- $ 51))
+ $ 181))
(|getShellEntry|
- $ 182))
- |POLYCAT-;conditionP;MU;27|)
- (COND
- (#21#
- (LETT #20#
- (SPADCALL #20#
- #19#
- (|getShellEntry|
- $ 183))
- |POLYCAT-;conditionP;MU;27|))
- ('T
- (PROGN
- (LETT #20#
- #19#
- |POLYCAT-;conditionP;MU;27|)
- (LETT #21# 'T
- |POLYCAT-;conditionP;MU;27|)))))))
- (LETT #18# (CDR #18#)
- |POLYCAT-;conditionP;MU;27|)
- (GO G190) G191
- (EXIT NIL))
- (COND
- (#21# #20#)
- ('T
- (|spadConstant| $ 27)))))))
- (LETT #17#
- (PROG1 (CDR #17#)
- (LETT #16# (QSADD1 #16#)
- |POLYCAT-;conditionP;MU;27|))
- |POLYCAT-;conditionP;MU;27|)
- (GO G190) G191 (EXIT NIL))
- #15#))))))))))
+ $ 51))
+ (|getShellEntry| $
+ 182))
+ |POLYCAT-;conditionP;MU;27|)
+ (COND
+ (#21#
+ (LETT #20#
+ (SPADCALL #20#
+ #19#
+ (|getShellEntry|
+ $ 183))
+ |POLYCAT-;conditionP;MU;27|))
+ ('T
+ (PROGN
+ (LETT #20# #19#
+ |POLYCAT-;conditionP;MU;27|)
+ (LETT #21# 'T
+ |POLYCAT-;conditionP;MU;27|)))))))
+ (LETT #18# (CDR #18#)
+ |POLYCAT-;conditionP;MU;27|)
+ (GO G190) G191
+ (EXIT NIL))
+ (COND
+ (#21# #20#)
+ ('T
+ (|spadConstant| $ 27)))))))
+ (LETT #17#
+ (PROG1 (CDR #17#)
+ (LETT #16# (QSADD1 #16#)
+ |POLYCAT-;conditionP;MU;27|))
+ |POLYCAT-;conditionP;MU;27|)
+ (GO G190) G191 (EXIT NIL))
+ #15#)))))))))
#10# (EXIT #10#)))))
(DEFUN |POLYCAT-;charthRoot;SU;28| (|p| $)
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 9d79c3b3..99bbac79 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -2217,7 +2217,7 @@ compReduce(form,m,e) ==
compReduce1(form is ["REDUCE",op,.,collectForm],m,e,$formalArgList) ==
[collectOp,:itl,body]:= collectForm
if STRINGP op then op:= INTERN op
- ^MEMQ(collectOp,'(COLLECT COLLECTV COLLECTVEC)) =>
+ not MEMQ(collectOp,'(COLLECT COLLECTV)) =>
systemError ['"illegal reduction form:",form]
$sideEffectsList: local := nil
$until: local := nil
@@ -2269,6 +2269,7 @@ compRepeatOrCollect(form,m,e) ==
fn(form,$exitModeStack,$leaveLevelStack,$formalArgList,e) ==
$until: local := nil
oldEnv := e
+ aggr := nil
[repeatOrCollect,:itl,body]:= form
itl':=
[([x',e]:= compIterator(x,e) or return "failed"; x') for x in itl]
@@ -2276,15 +2277,14 @@ compRepeatOrCollect(form,m,e) ==
targetMode:= first $exitModeStack
bodyMode:=
repeatOrCollect="COLLECT" =>
- targetMode = '$EmptyMode => '$EmptyMode
- (u:=modeIsAggregateOf('List,targetMode,e)) =>
- CADR u
- (u:=modeIsAggregateOf('PrimitiveArray,targetMode,e)) =>
- repeatOrCollect:='COLLECTV
- CADR u
- (u:=modeIsAggregateOf('Vector,targetMode,e)) =>
- repeatOrCollect:='COLLECTVEC
- CADR u
+ targetMode = $EmptyMode => (aggr:=["List",$EmptyMode]; $EmptyMode)
+ [aggr,u] := modeIsAggregateOf('List,targetMode,e) => u
+ [aggr,u] := modeIsAggregateOf('PrimitiveArray,targetMode,e) =>
+ repeatOrCollect := "COLLECTV"
+ u
+ [aggr,u] := modeIsAggregateOf('Vector,targetMode,e) =>
+ repeatOrCollect := "COLLECTV"
+ u
stackMessage('"Invalid collect bodytype")
return nil
-- If we're doing a collect, and the type isn't conformable
@@ -2296,16 +2296,8 @@ compRepeatOrCollect(form,m,e) ==
[untilCode,.,e']:= comp($until,$Boolean,e')
itl':= substitute(["UNTIL",untilCode],'$until,itl')
form':= [repeatOrCollect,:itl',body']
- m'':=
- repeatOrCollect="COLLECT" =>
- (u:=modeIsAggregateOf('List,targetMode,e)) => CAR u
- ["List",m']
- repeatOrCollect="COLLECTV" =>
- (u:=modeIsAggregateOf('PrimitiveArray,targetMode,e)) => CAR u
- ["PrimitiveArray",m']
- repeatOrCollect="COLLECTVEC" =>
- (u:=modeIsAggregateOf('Vector,targetMode,e)) => CAR u
- ["Vector",m']
+ m'' :=
+ aggr is [c,.] and MEMQ(c,'(List PrimitiveArray Vector)) => [c,m']
m'
T := coerceExit([form',m'',e'],targetMode) or return nil
-- iterator variables and other variables declared in
@@ -2410,16 +2402,15 @@ compIterator(it,e) ==
-- m
-- get(name,"value",e) is [c,R] and MEMQ(c,'(Vector List)) => R
-modeIsAggregateOf(ListOrVector,m,e) ==
- m is [ =ListOrVector,R] => [m,R]
---m = '$EmptyMode => [m,m] I don't think this is correct, breaks POLY +
+modeIsAggregateOf(agg,m,e) ==
+ m is [ =agg,R] => [m,R]
m is ["Union",:l] =>
- mList:= [pair for m' in l | (pair:= modeIsAggregateOf(ListOrVector,m',e))]
+ mList:= [pair for m' in l | (pair:= modeIsAggregateOf(agg,m',e))]
1=#mList => first mList
name:=
m is [fn,:.] => fn
RepIfRepHack m
- get(name,"value",e) is [[ =ListOrVector,R],:.] => [m,R]
+ get(name,"value",e) is [[ =agg,R],:.] => [m,R]
--% VECTOR ITERATORS
diff --git a/src/interp/sys-macros.lisp b/src/interp/sys-macros.lisp
index 1224c6a3..b610af09 100644
--- a/src/interp/sys-macros.lisp
+++ b/src/interp/sys-macros.lisp
@@ -1,6 +1,6 @@
;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
;; All rights reserved.
-;; Copyright (C) 2007-2008, Gabriel Dos Reis.
+;; Copyright (C) 2007-2009, Gabriel Dos Reis.
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
@@ -1205,15 +1205,6 @@
(let ((U (REPEAT-TRAN L NIL)))
(CONS 'THETA (CONS '\, (NCONC (CAR U) (LIST (CDR U)))))))
-;; The following was changed to a macro for efficiency in CCL. To change
-;; it back to a function would require recompilation of a large chunk of
-;; the library.
-(defmacro PRIMVEC2ARR (x)
- x) ;redefine to change Array rep
-
-(defmacro COLLECTVEC (&rest L)
- `(PRIMVEC2ARR (COLLECTV ,@L)))
-
(defmacro COLLECTV (&rest L)
(PROG (CONDS BODY ANS COUNTER X Y)
;;If we can work out how often we will go round
generated by cgit v1.2.3 (git 2.39.1) at 2024-09-09 02:32:40 +0000