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/ChangeLog17
-rw-r--r--src/interp/c-util.boot146
-rw-r--r--src/interp/compiler.boot6
-rw-r--r--src/interp/nruncomp.boot22
-rw-r--r--src/interp/nrunfast.boot5
-rw-r--r--src/interp/types.boot2
9 files changed, 187 insertions, 33 deletions
diff --git a/configure b/configure
index 22596d0c..e53d3631 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-2010-02-20.
+# Generated by GNU Autoconf 2.63 for OpenAxiom 1.4.0-2010-02-22.
#
# 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-2010-02-20'
-PACKAGE_STRING='OpenAxiom 1.4.0-2010-02-20'
+PACKAGE_VERSION='1.4.0-2010-02-22'
+PACKAGE_STRING='OpenAxiom 1.4.0-2010-02-22'
PACKAGE_BUGREPORT='open-axiom-bugs@lists.sf.net'
ac_unique_file="src/Makefile.pamphlet"
@@ -1511,7 +1511,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-02-20 to adapt to many kinds of systems.
+\`configure' configures OpenAxiom 1.4.0-2010-02-22 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
@@ -1581,7 +1581,7 @@ fi
if test -n "$ac_init_help"; then
case $ac_init_help in
- short | recursive ) echo "Configuration of OpenAxiom 1.4.0-2010-02-20:";;
+ short | recursive ) echo "Configuration of OpenAxiom 1.4.0-2010-02-22:";;
esac
cat <<\_ACEOF
@@ -1688,7 +1688,7 @@ fi
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
-OpenAxiom configure 1.4.0-2010-02-20
+OpenAxiom configure 1.4.0-2010-02-22
generated by GNU Autoconf 2.63
Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
@@ -1702,7 +1702,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-02-20, which was
+It was created by OpenAxiom $as_me 1.4.0-2010-02-22, which was
generated by GNU Autoconf 2.63. Invocation command line was
$ $0 $@
@@ -21165,7 +21165,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-2010-02-20, which was
+This file was extended by OpenAxiom $as_me 1.4.0-2010-02-22, which was
generated by GNU Autoconf 2.63. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
@@ -21228,7 +21228,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-2010-02-20
+OpenAxiom config.status 1.4.0-2010-02-22
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 30fd65fc..f257c48e 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-2010-02-20],
+AC_INIT([OpenAxiom], [1.4.0-2010-02-22],
[open-axiom-bugs@lists.sf.net])
AC_CONFIG_AUX_DIR(config)
diff --git a/configure.ac.pamphlet b/configure.ac.pamphlet
index b07464dc..009aa656 100644
--- a/configure.ac.pamphlet
+++ b/configure.ac.pamphlet
@@ -1200,7 +1200,7 @@ information:
<<Autoconf init>>=
sinclude(config/open-axiom.m4)
sinclude(config/aclocal.m4)
-AC_INIT([OpenAxiom], [1.4.0-2010-02-20],
+AC_INIT([OpenAxiom], [1.4.0-2010-02-22],
[open-axiom-bugs@lists.sf.net])
@
diff --git a/src/ChangeLog b/src/ChangeLog
index 74841751..0010e2d3 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,10 +1,25 @@
+2010-02-22 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ Expand support for domain inlining to non-niladic functors.
+ * interp/compiler.boot (processInlineRequest): Now accept any
+ functor.
+ * interp/c-util.boot (lookupFunctionInstance): New.
+ (isFormal): Likewise.
+ (expandFormTemplate): Likewise.
+ (equalFormTemplate): Likewise.
+ (getFunctionTemplate): Likewise.
+ (lookupInheritedDefiningFunction): Likewise.
+ (lookupDefiningFunction): Likewise.
+ * interp/nruncomp.boot (optDeltaEntry): Tidy. Use
+ lookupDefiningFunction.
+
2010-02-20 Gabriel Dos Reis <gdr@cs.tamu.edu>
* algebra/boolean.spad.pamphlet (PropositionalFormula):
Reimplement in terms of kernels.
* algebra/Makefile.pamphlet ($(OUT)/KERNEL.$(FASLEXT)): New
dependence rule.
- ($(OUT)PROPFRML.$(FASLEXT)): Likewise.
+ ($(OUT)/PROPFRML.$(FASLEXT)): Likewise.
(axiom_algebra_layer_19): Move PROPFRML to...
(axiom_algebra_layer_6): ...here.
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 0214a1af..0f85c636 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -1,6 +1,6 @@
-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007-2009, Gabriel Dos Reis.
+-- Copyright (C) 2007-2010, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -1529,3 +1529,147 @@ compileQuietly fn ==
quietlyIfInteractive COMP370 fn
+
+--%
+--% Compile Time operation lookup for the benefit of domain inlining.
+--%
+
+++ Subroutine of lookupDefiningFunction.
+++ Called when the domain of computation `dc' is closed (this is the
+++ case of niladic constructors) to lookup up the definition function
+++ of the operation `op' with signature `sig'.
+lookupFunctionInstance(op,sig,dc) ==
+ dom := eval dc
+ sig := MSUBST(devaluate dom,dc,sig)
+ compiledLookup(op,sig,dom)
+
+++ If `x' is a formal map variable, returns its position.
+++ Otherwise return nil.
+isFormal: %Symbol -> %Maybe %Short
+isFormal x ==
+ POSITION(x,$FormalMapVariableList,KEYWORD::TEST, function EQ)
+
+++ Expand the form at position `slot' in the domain template `shell'
+++ with argument list `args'.
+expandFormTemplate(shell,args,slot) ==
+ FIXP slot =>
+ slot = 0 => "$"
+ slot = 2 => "$$"
+ expandFormTemplate(shell,args,getShellEntry(shell,slot))
+ atom slot => slot
+ slot is ["local",parm] and (n := isFormal parm) =>
+ args.n -- FIXME: we should probably expand with dual signature
+ slot is ["NRTEVAL",val] => val
+ slot is ["QUOTE",val] =>
+ STRINGP val => val
+ slot
+ [expandFormTemplate(shell,args,i) for i in slot]
+
+++ Compare the form at `slot' in the domain templare `shell'
+++ for equality with `form'.
+equalFormTemplate(shell,args,slot,form) ==
+ FIXP slot =>
+ slot = 0 => form = "$"
+ slot = 2 => form = "$$"
+ equalFormTemplate(shell,args,getShellEntry(shell,slot),form)
+ slot is ["local",parm] and (n := isFormal parm) =>
+ equalFormTemplate(shell,args,args.n,form)
+ slot is ["NTREVAL",val] => form = val
+ slot is ["QUOTE",val] =>
+ STRINGP val => val = form
+ slot = form
+ atom slot or atom form => form = slot
+ #slot ~= #form => false
+ and/[equalFormTemplate(shell,args,i,x) for i in slot for x in form]
+
+++ Subroutine of lookupDefiningFunction.
+++ Return the location of function templates with signature `sig',
+++ descriptor address in the range [start,end), in the domain
+++ template `shell' whose local reference vector is `funDesc'.
+++ Return value:
+++ nil => function not defined by `shell'.
+++ "ambiguous" => too many candidates
+++ <number> => slot number of unique matching function.
+getFunctionTemplate(sig,start,end,shell,args,funDesc) ==
+ nargs := #rest sig
+ loc := nil -- candidate locations
+ while loc ~= "ambiguous" and start < end repeat
+ n := funDesc.start -- arity of current operator
+ PROGN
+ -- Skip if arity mismatch
+ i := start
+ n ~= nargs => nil
+ -- We are not interested in predicates, at this point.
+ -- Skip if this operator's signature does not match
+ i := i + 2
+ or/[not equalFormTemplate(shell,args,funDesc.k,t)
+ for k in i.. for t in sig] => nil
+ -- Grab the location of this match
+ loc :=
+ FIXP loc => "ambiguous"
+ funDesc.(i + n + 1)
+ start := start + n + 4
+ loc
+
+++ Subroutine of lookupDefiningFunction.
+lookupInheritedDefiningFunction(op,sig,shell,args,slot) ==
+ dom := expandFormTemplate(shell,args,slot)
+ atom dom or dom is ["local",:.] => nil
+ lookupDefiningFunction(op,sig,dom)
+
+++ Return the name of the function definition that explicitly implements
+++ the operation `op' with signature `sig' in the domain of
+++ computation `dc'. Otherwise, return nil.
+++ Note: Only a function defined by the domain template, or its add-chains,
+++ and that is unambiguous is returned. In particular, this
+++ function defaulting packages.
+lookupDefiningFunction(op,sig,dc) ==
+ -- 1. Read domain information, if available.
+ [ctor,:args] := dc
+ -- 1.1. Niladic constructors don't need approximation.
+ null args => lookupFunctionInstance(op,sig,dc)
+ -- 1.2. Don't look into defaulting package
+ isDefaultPackageName ctor => nil
+ -- 1.2. Silently give up if the constructor is just not there
+ loadLibIfNotLoaded ctor
+ infovec := GET(ctor, "infovec") or return nil
+ -- 1.3. We need information about the original domain template
+ shell := first infovec -- domain template
+ opTable := second infovec -- operator-code table
+ opTableLength := #opTable
+ forgetful := infovec.4 = "lookupIncomplete"
+
+ -- 2. Get the address range of op's descriptor set
+ [.,.,.,:funDesc] := fourth infovec
+ index := getOpCode(op, opTable, opTableLength - 1)
+ -- 2.1. For a forgetful functor, try the add chain
+ index = nil =>
+ forgetful and lookupInheritedDefiningFunction(op,sig,shell,args,5)
+ -- 2.2. The operation is either defined here, or is available
+ -- from category package defaults.
+ limit :=
+ index + 2 < opTableLength => opTable.(index + 2)
+ #funDesc
+
+ -- 3. Locate the descriptor with matching signature
+ loc := getFunctionTemplate(sig,opTable.index,limit,shell,args,funDesc)
+
+ -- 4. Look into the add-chain if necessary
+ loc = nil => lookupInheritedDefiningFunction(op,sig,shell,args,shell.5)
+
+ -- 5. Give up if the operation is overloaded on semantics predicates.
+ loc = "ambiguous" => nil
+
+ -- 6. We have a location to a function descriptor.
+ fun := shell.loc
+ -- 6.1. A constant producing functions?
+ fun is [.,.,[.,["dispatchFunction",fun'],.]] => fun'
+ -- 6.2. An inherited function?
+ fun is [idx,:.] =>
+ not FIXP idx => nil -- a UFO?
+ loc := funDesc.(idx + 1)
+ if loc = 0 then loc := 5
+ shell.loc = nil => nil
+ lookupInheritedDefiningFunction(op,sig,shell,args,shell.loc)
+ -- 6.3. Whatever.
+ fun
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index cefcbc4e..44145fe9 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -2230,10 +2230,8 @@ processInlineRequest(t,e) ==
stackAndThrow('"%1b does not designate a domain",[t])
atom T.expr =>
stackWarning('"inline request for type variable %1bp is meaningless",[t])
- T.expr is [ctor] =>
- $optimizableConstructorNames := [ctor,:$optimizableConstructorNames]
- -- Don't try too hard; the current domain evaluation is insane.
- stackWarning('"Ignoring inline arequest for non-niladic type %1bp",[t])
+ [ctor,:.] := T.expr
+ $optimizableConstructorNames := [ctor,:$optimizableConstructorNames]
--%
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index 1b969ae2..dce086dc 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -161,16 +161,8 @@ optDeltaEntry(op,sig,dc,eltOrConst) ==
dc
sig := MSUBST(ndc,dc,sig)
not MEMQ(KAR ndc,$optimizableConstructorNames) => nil
- dcval := optCallEval ndc
- -- MSUBST guarantees to use EQUAL testing
- sig := MSUBST(devaluate dcval, ndc, sig)
- if rest ndc then
- for new in rest devaluate dcval for old in rest ndc repeat
- sig := MSUBST(new,old,sig)
- -- optCallEval sends (List X) to (LIst (Integer)) etc,
- -- so we should make the same transformation
- fn := compiledLookup(op,sig,dcval)
- if null fn then
+ fun := lookupDefiningFunction(op,sig,ndc)
+ if fun = nil then
-- following code is to handle selectors like first, rest
nsig := [quoteSelector tt for tt in sig] where
quoteSelector(x) ==
@@ -178,10 +170,12 @@ optDeltaEntry(op,sig,dc,eltOrConst) ==
get(x,'value,$e) => x
x='$ => x
MKQ x
- fn := compiledLookup(op,nsig,dcval)
- if null fn then return nil
- eltOrConst="CONST" => ['XLAM,'ignore, SPADCALL fn]
- GETL(compileTimeBindingOf first fn,'SPADreplace)
+ fun := lookupDefiningFunction(op,nsig,ndc)
+ fun = nil => nil
+ if CONSP fun then
+ eltOrConst = "CONST" => return ['XLAM,'ignore, SPADCALL fun]
+ fun := first fun
+ GETL(compileTimeBindingOf fun,'SPADreplace)
genDeltaEntry opMmPair ==
--called from compApplyModemap
diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot
index 813dab7d..7f9e5266 100644
--- a/src/interp/nrunfast.boot
+++ b/src/interp/nrunfast.boot
@@ -1,6 +1,6 @@
-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007-2009, Gabriel Dos Reis.
+-- Copyright (C) 2007-2010, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -35,6 +35,9 @@
import c_-util
namespace BOOT
+module nrunfast where
+ getOpCode: (%Symbol, %Vector %Thing, %Short) -> %Maybe %Short
+
++
$doNotCompressHashTableIfTrue := false
diff --git a/src/interp/types.boot b/src/interp/types.boot
index 505fbc30..0fe9d04d 100644
--- a/src/interp/types.boot
+++ b/src/interp/types.boot
@@ -1,4 +1,4 @@
--- Copyright (C) 2007-2009 Gabriel Dos Reis
+-- Copyright (C) 2007-2010 Gabriel Dos Reis
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-04 00:12:54 +0000