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/ChangeLog16
-rw-r--r--src/interp/Makefile.in9
-rw-r--r--src/interp/Makefile.pamphlet9
-rw-r--r--src/interp/g-util.boot1
-rw-r--r--src/interp/macros.lisp125
-rw-r--r--src/interp/sys-utility.boot117
9 files changed, 160 insertions, 139 deletions
diff --git a/configure b/configure
index 008036c2..ba5b8fe6 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.60 for OpenAxiom 1.1.0-2008-02-03.
+# Generated by GNU Autoconf 2.60 for OpenAxiom 1.1.0-2008-02-04.
#
# Report bugs to <open-axiom-bugs@lists.sf.net>.
#
@@ -713,8 +713,8 @@ SHELL=${CONFIG_SHELL-/bin/sh}
# Identity of this package.
PACKAGE_NAME='OpenAxiom'
PACKAGE_TARNAME='openaxiom'
-PACKAGE_VERSION='1.1.0-2008-02-03'
-PACKAGE_STRING='OpenAxiom 1.1.0-2008-02-03'
+PACKAGE_VERSION='1.1.0-2008-02-04'
+PACKAGE_STRING='OpenAxiom 1.1.0-2008-02-04'
PACKAGE_BUGREPORT='open-axiom-bugs@lists.sf.net'
ac_unique_file="src/Makefile.pamphlet"
@@ -1387,7 +1387,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.1.0-2008-02-03 to adapt to many kinds of systems.
+\`configure' configures OpenAxiom 1.1.0-2008-02-04 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
@@ -1457,7 +1457,7 @@ fi
if test -n "$ac_init_help"; then
case $ac_init_help in
- short | recursive ) echo "Configuration of OpenAxiom 1.1.0-2008-02-03:";;
+ short | recursive ) echo "Configuration of OpenAxiom 1.1.0-2008-02-04:";;
esac
cat <<\_ACEOF
@@ -1561,7 +1561,7 @@ fi
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
-OpenAxiom configure 1.1.0-2008-02-03
+OpenAxiom configure 1.1.0-2008-02-04
generated by GNU Autoconf 2.60
Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
@@ -1575,7 +1575,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.1.0-2008-02-03, which was
+It was created by OpenAxiom $as_me 1.1.0-2008-02-04, which was
generated by GNU Autoconf 2.60. Invocation command line was
$ $0 $@
@@ -25225,7 +25225,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.1.0-2008-02-03, which was
+This file was extended by OpenAxiom $as_me 1.1.0-2008-02-04, which was
generated by GNU Autoconf 2.60. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
@@ -25274,7 +25274,7 @@ Report bugs to <bug-autoconf@gnu.org>."
_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF
ac_cs_version="\\
-OpenAxiom config.status 1.1.0-2008-02-03
+OpenAxiom config.status 1.1.0-2008-02-04
configured by $0, generated by GNU Autoconf 2.60,
with options \\"`echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\"
diff --git a/configure.ac b/configure.ac
index d4c1d21d..4ff799e1 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1,6 +1,6 @@
sinclude(config/open-axiom.m4)
sinclude(config/aclocal.m4)
-AC_INIT([OpenAxiom], [1.1.0-2008-02-03],
+AC_INIT([OpenAxiom], [1.1.0-2008-02-04],
[open-axiom-bugs@lists.sf.net])
AC_CONFIG_AUX_DIR(config)
diff --git a/configure.ac.pamphlet b/configure.ac.pamphlet
index 10e2cdfd..2dcfd529 100644
--- a/configure.ac.pamphlet
+++ b/configure.ac.pamphlet
@@ -1019,7 +1019,7 @@ information:
<<Autoconf init>>=
sinclude(config/open-axiom.m4)
sinclude(config/aclocal.m4)
-AC_INIT([OpenAxiom], [1.1.0-2008-02-03],
+AC_INIT([OpenAxiom], [1.1.0-2008-02-04],
[open-axiom-bugs@lists.sf.net])
@
diff --git a/src/ChangeLog b/src/ChangeLog
index 41398bd2..2e2ba3e9 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,19 @@
+2008-02-04 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * interp/Makefile.pamphlet (OBJS): Include sys-utility.$(FASLEXT).
+ (sys-utility.$(FASLEXT)): New rule.
+ * interp/sys-utility.boot: New.
+ * interp/macros.lisp (|functionp|): Move to sys-utility.boot.
+ (|macrop|): Likewise.
+ (|delete|): Likewise.
+ (CONTAINED, contained\,eq, contained\,equal): Likewise.
+ (ASSOCLEFT): Likewise.
+ (ASSOCRIGHT): Likewise.
+ (ADDASSOC): Likewise.
+ (DELLASOS): Likewise.
+ (LASSOC): Likewise.
+ (|rassoc|): Likewise.
+
2008-02-03 Gabriel Dos Reis <gdr@cs.tamu.edu>
* interp/foam_l.lisp (|G-stdoutVar|): Define; don't just assign.
diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
index a97c829d..2f372312 100644
--- a/src/interp/Makefile.in
+++ b/src/interp/Makefile.in
@@ -20,7 +20,7 @@ AXIOMSYS= $(axiom_target_bindir)/AXIOMsys$(EXEEXT)
OBJS= vmlisp.$(FASLEXT) hash.$(FASLEXT) \
diagnostics.$(FASLEXT) sys-driver.$(FASLEXT) \
- macros.$(FASLEXT) \
+ sys-utility.$(FASLEXT) macros.$(FASLEXT) \
unlisp.$(FASLEXT) \
astr.$(FASLEXT) bits.$(FASLEXT) \
alql.$(FASLEXT) buildom.$(FASLEXT) \
@@ -551,7 +551,7 @@ metalex.$(FASLEXT): metalex.lisp macros.$(FASLEXT)
nlib.$(FASLEXT): nlib.lisp macros.$(FASLEXT)
$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
-macros.$(FASLEXT): macros.lisp sys-macros.$(FASLEXT)
+macros.$(FASLEXT): macros.lisp sys-macros.$(FASLEXT) sys-utility.$(FASLEXT)
$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
## The new parser component roughtly is:
@@ -701,7 +701,7 @@ pspad2.$(FASLEXT): pspad2.boot pspad1.$(FASLEXT)
pspad1.$(FASLEXT): pspad1.boot macros.$(FASLEXT)
$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
-g-util.$(FASLEXT): g-util.boot macros.$(FASLEXT)
+g-util.$(FASLEXT): g-util.boot macros.$(FASLEXT) sys-utility.$(FASLEXT)
$(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
g-cndata.$(FASLEXT): g-cndata.boot sys-macros.$(FASLEXT)
@@ -758,6 +758,9 @@ axext_l.$(FASLEXT): axext_l.lisp foam_l.$(FASLEXT)
foam_l.$(FASLEXT): foam_l.lisp vmlisp.$(FASLEXT)
$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+sys-utility.$(FASLEXT): sys-utility.boot vmlisp.$(FASLEXT)
+ $(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+
vmlisp.$(FASLEXT): vmlisp.lisp boot-pkg.$(FASLEXT)
$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet
index b5a644e3..e4385f67 100644
--- a/src/interp/Makefile.pamphlet
+++ b/src/interp/Makefile.pamphlet
@@ -111,7 +111,7 @@ compiled.
<<environment>>=
OBJS= vmlisp.$(FASLEXT) hash.$(FASLEXT) \
diagnostics.$(FASLEXT) sys-driver.$(FASLEXT) \
- macros.$(FASLEXT) \
+ sys-utility.$(FASLEXT) macros.$(FASLEXT) \
unlisp.$(FASLEXT) \
astr.$(FASLEXT) bits.$(FASLEXT) \
alql.$(FASLEXT) buildom.$(FASLEXT) \
@@ -874,7 +874,7 @@ metalex.$(FASLEXT): metalex.lisp macros.$(FASLEXT)
nlib.$(FASLEXT): nlib.lisp macros.$(FASLEXT)
$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
-macros.$(FASLEXT): macros.lisp sys-macros.$(FASLEXT)
+macros.$(FASLEXT): macros.lisp sys-macros.$(FASLEXT) sys-utility.$(FASLEXT)
$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
## The new parser component roughtly is:
@@ -1024,7 +1024,7 @@ pspad2.$(FASLEXT): pspad2.boot pspad1.$(FASLEXT)
pspad1.$(FASLEXT): pspad1.boot macros.$(FASLEXT)
$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
-g-util.$(FASLEXT): g-util.boot macros.$(FASLEXT)
+g-util.$(FASLEXT): g-util.boot macros.$(FASLEXT) sys-utility.$(FASLEXT)
$(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
g-cndata.$(FASLEXT): g-cndata.boot sys-macros.$(FASLEXT)
@@ -1081,6 +1081,9 @@ axext_l.$(FASLEXT): axext_l.lisp foam_l.$(FASLEXT)
foam_l.$(FASLEXT): foam_l.lisp vmlisp.$(FASLEXT)
$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+sys-utility.$(FASLEXT): sys-utility.boot vmlisp.$(FASLEXT)
+ $(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+
vmlisp.$(FASLEXT): vmlisp.lisp boot-pkg.$(FASLEXT)
$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index 5d62e098..ca50a4e5 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -33,6 +33,7 @@
import '"macros"
+import '"sys-utility"
)package "BOOT"
++
diff --git a/src/interp/macros.lisp b/src/interp/macros.lisp
index 775f76cc..b4e7ab75 100644
--- a/src/interp/macros.lisp
+++ b/src/interp/macros.lisp
@@ -1,6 +1,6 @@
;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
;; All rights reserved.
-;; Copyright (C) 2007, Gabriel Dos Reis.
+;; Copyright (C) 2007-2008, Gabriel Dos Reis.
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
@@ -54,6 +54,7 @@
(import-module "sys-macros")
+(import-module "sys-utility")
(in-package "BOOT")
; 5 PROGRAM STRUCTURE
@@ -62,16 +63,8 @@
(defun SETANDFILE (x y) (LAM\,EVALANDFILEACTQ `(defparameter ,x ',y)))
-; 5.3.2 Declaring Global Variables and Named Constants
-
-(defun |functionp| (fn)
- (if (identp fn) (and (fboundp fn) (not (macro-function fn))) (functionp fn)))
-(defun |macrop| (fn) (and (identp fn) (macro-function fn)))
-
; 6 PREDICATES
-; 6.2 Data Type Predicates
-
; 6.3 Equality Predicates
(defun COMPARE (X Y)
@@ -106,14 +99,6 @@
; 7 CONTROL STRUCTURE
-; 7.1 Constants and Variables
-
-; 7.1.1 Reference
-
-; 7.2 Generalized Variables
-
-; 7.3 Function Invocation
-
; 7.8 Iteration
; 7.8.2 General Iteration
@@ -127,12 +112,6 @@
"Needed by spadCompileOrSetq" 1)
-; 7.8.4 Mapping
-
-
-
-; 7.10 Dynamic Non-local Exits
-
; 10.1 The Property List
@@ -161,15 +140,7 @@
; 10.7 CATCH and THROW
; 12 NUMBERS
-
-; 12.3 Comparisons on Numbers
-
-; 12.4 Arithmetic Operations
-
-; 12.5 Irrational and Transcendental Functions
-
-; 12.5.1 Exponential and Logarithmic Functions
-
+
; 12.6 Small Finite Field ops with vector trimming
(defun TRIMLZ (vec)
@@ -208,28 +179,11 @@
(define-function '|append| #'APPEND)
-;;(defun |delete| (item list) ; renaming from DELETE is done in DEF
-;; (cond ((atom list) list)
-;; ((equalp item (qcar list)) (|delete| item (qcdr list)))
-;; ('t (cons (qcar list) (|delete| item (qcdr list))))))
-
-(defun |delete| (item sequence)
- (cond ((symbolp item) (remove item sequence :test #'eq))
- ((and (atom item) (not (arrayp item))) (remove item sequence))
- (T (remove item sequence :test #'equalp))))
-
-
-
-
-
(defun THETACHECK (VAL VAR OP) (if (EQL VAL VAR) (THETA_ERROR OP) val))
; 15 LISTS
-; 15.1 Conses
-
-
; 15.2 Lists
@@ -314,22 +268,6 @@
; 15.5 Using Lists as Sets
-#-:CCL
-(DEFUN CONTAINED (X Y)
- (if (symbolp x)
- (contained\,eq X Y)
- (contained\,equal X Y)))
-
-(defun contained\,eq (x y)
- (if (atom y) (eq x y)
- (or (contained\,eq x (car y)) (contained\,eq x (cdr y)))))
-
-(defun contained\,equal (x y)
- (cond ((atom y) (equal x y))
- ((equal x y) 't)
- ('t (or (contained\,equal x (car y)) (contained\,equal x (cdr y))))))
-
-
(DEFUN PREDECESSOR (TL L)
"Returns the sublist of L whose CDR is EQ to TL."
(COND ((ATOM L) NIL)
@@ -342,63 +280,6 @@
; 15.6 Association Lists
-
-;; FIXME: Should not this be named `alistAllKeys'?
-(DEFUN ASSOCLEFT (X)
- "Returns all the keys of association list X."
- (if (ATOM X)
- X
- (mapcar #'car x)))
-
-;; FIXME: Should not this be named `alistAllValues'?
-(DEFUN ASSOCRIGHT (X)
- "Returns all the datums of association list X."
- (if (ATOM X)
- X
- (mapcar #'cdr x)))
-
-
-(DEFUN ADDASSOC (X Y L)
- "Put the association list pair (X . Y) into L, erasing any previous association for X"
- (COND ((ATOM L)
- (CONS (CONS X Y) L))
- ((EQUAL X (CAAR L))
- (CONS (CONS X Y) (CDR L)))
- ((CONS (CAR L) (ADDASSOC X Y (CDR L))))))
-
-(DEFUN DELLASOS (U V)
- "Remove any assocation pair (U . X) from list V."
- (COND ((ATOM V) NIL)
- ((EQUAL U (CAAR V))
- (CDR V))
- ((CONS (CAR V) (DELLASOS U (CDR V))))))
-
-
-;; FIXME: Should not this be named `alistValue'?
-(DEFUN LASSOC (X Y)
- "Return the datum associated with key X in association list Y."
- (PROG NIL
- A
- (COND ((ATOM Y)
- (RETURN NIL))
- ((EQUAL (CAAR Y) X)
- (RETURN (CDAR Y))) )
- (SETQ Y (CDR Y))
- (GO A)))
-
-;; FIXME: Should not this be named `alistKey'?
-(DEFUN |rassoc| (X Y)
- "Return the key associated with datum X in association list Y."
- (PROG NIL
- A
- (COND ((ATOM Y)
- (RETURN NIL))
- ((EQUAL (CDAR Y) X)
- (RETURN (CAAR Y))) )
- (SETQ Y (CDR Y))
- (GO A)))
-
-; (defun QLASSQ (p a-list) (let ((y (assoc p a-list :test #'eq))) (if y (cdr y))))
(defun QLASSQ (p a-list) (cdr (assq p a-list)))
(define-function 'LASSQ #'QLASSQ)
diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot
new file mode 100644
index 00000000..727721f0
--- /dev/null
+++ b/src/interp/sys-utility.boot
@@ -0,0 +1,117 @@
+-- Copyright (C) 2007-2008 Gabriel Dos Reis
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+-- - Redistributions of source code must retain the above copyright
+-- notice, this list of conditions and the following disclaimer.
+--
+-- - Redistributions in binary form must reproduce the above copyright
+-- notice, this list of conditions and the following disclaimer in
+-- the documentation and/or other materials provided with the
+-- distribution.
+--
+-- - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+-- names of its contributors may be used to endorse or promote products
+-- derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+--
+
+-- This file defines some utility functions common to both the compiler
+-- and interpreter.
+
+import '"vmlisp"
+)package "BOOT"
+
+++ returns true if `f' is bound to a macro.
+macrop: %Thing -> %Boolean
+macrop f ==
+ IDENTP f and MACRO_-FUNCTION f
+
+++ returns true if `f' is bound to a function
+functionp: %Thing -> %Boolean
+functionp f ==
+ IDENTP f => FBOUNDP f and not MACRO_-FUNCTION f
+ FUNCTIONP f
+
+++ remove `item' from `sequence'.
+delete: (%Thing,%Sequence) -> %Sequence
+delete(item,sequence) ==
+ SYMBOLP item =>
+ REMOVE(item,sequence,KEYWORD::TEST,function EQ)
+ atom item and not ARRAYP item =>
+ REMOVE(item,SEQUENCE)
+ REMOVE(item,sequence,KEYWORD::TEST,function EQUALP)
+
+++ returns true if `x' is contained in `y'.
+CONTAINED: (%Thing,%Thing) -> %Boolean
+CONTAINED(x,y) == main where
+ main() ==
+ SYMBOLP x => eq(x,y)
+ equal(x,y)
+ eq(x,y) ==
+ atom y => EQ(x,y)
+ eq(x, car y) or eq(x, cdr y)
+ equal(x,y) ==
+ atom y => EQUAL(x,y)
+ equal(x, car y) or equal(x, cdr y)
+
+++ Returns all the keys of association list `x'
+-- ??? Should not this be named `alistAllKeys'?
+ASSOCLEFT: %Thing -> %Thing
+ASSOCLEFT x ==
+ atom x => x
+ MAPCAR(function first,x)
+
+++ Returns all the datums of association list `x'.
+-- ??? Should not this be named `alistAllValues'?
+ASSOCRIGHT: %Thing -> %Thing
+ASSOCRIGHT x ==
+ atom x => x
+ MAPCAR(function rest,x)
+
+++ Put the association list pair `(x . y)' into `l', erasing any
+++ previous association for `x'.
+ADDASSOC: (%Thing,%Thing,%List) -> %List
+ADDASSOC(x,y,l) ==
+ atom l => [[x,:y],:l]
+ x = first first l => [[x,:y],:cdr l]
+ [first l,:ADDASSOC(x,y,rest l)]
+
+
+++ Remove any assocation pair `(u . x)' from list `v'.
+DELLASOS: (%Thing,%List) -> %List
+DELLASOS(u,v) ==
+ atom v => nil
+ u = first first v => rest v
+ [first v,:DELLASOS(u,rest v)]
+
+
+++ Return the datum associated with key `x' in association list `y'.
+-- ??? Should not this be named `alistValue'?
+LASSOC: (%Thing,%List) -> %Thing
+LASSOC(x,y) ==
+ atom y => nil
+ x = first first y => rest first y
+ LASSOC(x,rest y)
+
+++ Return the key associated with datum `x' in association list `y'.
+rassoc: (%Thing,%List) -> %Thing
+rassoc(x,y) ==
+ atom y => nil
+ x = rest first y => first first y
+ rassoc(x,rest y)
+
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-07 12:44:54 +0000