diff options
| author | dos-reis <gdr@axiomatics.org> | 2009-07-03 07:18:33 +0000 |
|---|---|---|
| committer | dos-reis <gdr@axiomatics.org> | 2009-07-03 07:18:33 +0000 |
| commit | 8a4f74e2a21557463176766306120b13fa80e457 (patch) | |
| tree | a76fd4964952766c135a55c4961643239ee02c4e | |
| parent | 9cbc59b328898f7a0966be5ec1665409f6aa836f (diff) | |
| download | open-axiom-8a4f74e2a21557463176766306120b13fa80e457.tar.gz | |
* interp/sys-macros.lisp (PRIMVEC2ARR): Remove.
(COLLECTVEC): Likewise.
* interp/compiler.boot (compRepeatOrCollect): Tidy.
| -rwxr-xr-x | configure | 18 | ||||
| -rw-r--r-- | configure.ac | 2 | ||||
| -rw-r--r-- | configure.ac.pamphlet | 2 | ||||
| -rw-r--r-- | src/ChangeLog | 10 | ||||
| -rw-r--r-- | src/algebra/strap/POLYCAT-.lsp | 162 | ||||
| -rw-r--r-- | src/interp/compiler.boot | 41 | ||||
| -rw-r--r-- | src/interp/sys-macros.lisp | 11 |
7 files changed, 116 insertions, 130 deletions
@@ -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 |