2009-01-03 Gabriel Dos Reis <gdr@cs.tamu.edu>

	* Makefile.pamphlet (AXIOM_SRC_TARGETS): Add all-databases.

src/ChangeLog
2009-01-03  Gabriel Dos Reis  <gdr@cs.tamu.edu>

	* lisp/core.lisp.in (|%algebraSystemIsComplete|): New.
	(|%basicSystemIsComplete|): Use it.
	* interp/wi1.boot (setqSingle): Use maximalSuperType.
	(coerceSubset): Simplify.
	(compCoerce1): Tidy.
	* interp/i-resolv.boot (resolveTCat): Use superType.
	* interp/lisplib.boot (findConstructorSlotNumber): Use isSubset.
	(sigsMatch): Likewise.
	(findDomainSlotNumber): Likewise.
	* interp/define.boot (compSubDomain1): Reject for complex subdomain
	predicate.  Support paramterized subdomains.
	* interp/daase.lisp (interpOpen): Read superdomain slot.
	(getdatabase): Remove adhoc hardcoded superdomain info.
	Return superdomain info stored in database.
	(localnrlib): Read superdomain info.
	(write-interpdb): Write superdomain info.
	(database): Add superdomain slot.
	* interp/g-util.boot (superType): New.
	(maximalSuperType): Rework.  Support parameterized subdomains.
	(noteSubDomainInfo): New.
	(isSubDomain): Rework.
	* interp/c-util.boot (isSubset): Rework.
	* interp/g-opt.boot (optEQ): Remove.
	* interp/g-cndata.boot (getImmediateSuperDomain): Remove.
	(maximalSuperType): Move to g-util.boot.
	* interp/types.boot (%Constructor): New type specifier.
	(%Instantiation): Likewise.
	* interp/compiler.boot (primitiveType): Don't return $NegativeInteger.
	(maxSuperType): Remove.
	(hasType): Use maximalSuperType.
	(satisfies): New.
	(coerceSubset): Use it.  Simplify.
	* interp/wi2.boot (smallIntegerStep): Use maximalSuperType.
	* interp/sys-constants.boot ($AtVariables): New.
	($NegativeInteger): Remove.
	($NonPositiveInteger): Likewise.
	($CategoryNames): Category is not a category.	
	* interp/property.lisp: Remove Subsets property settings.
	* interp/i-coerce.boot (coerceSubDomain): Simplify.
	(coerceImmediateSubDomain): Remove.
	(getSubDomainPredicate): Simplify.
	* interp/category.boot (SourceLevelSubset): Use isSubDomain.
	(MachineLevelSubset): Likewise.
	* interp/modemap.boot (mergeModemap): Likewise.
	(isSuperDomain): Remove.
	(augModemapsFromDomain): Support parameterized subdomains.
	* interp/i-util.boot (isSubDomain): Move to g-util.boot.
	* Makefile.pamphlet (all-databases): New target.
	* interp/Makefile.pamphlet ($(AXIOMSYS)): Push
	:open-axiom-algebra-system onto *FEATURES*.
	* etc/Makefile.in (all-databases): New target.

1 files changed, 8 insertions, 25 deletions

diff --git a/src/interp/i-coerce.boot b/src/interp/i-coerce.boot
index 1ca27f51..75b88d46 100644
--- a/src/interp/i-coerce.boot
+++ b/src/interp/i-coerce.boot
@@ -441,12 +441,12 @@ canCoerce1(t1,t2) ==
     nt1 := CAR t1
     nt2 := CAR t2
 
-    EQ(nt1,'Mapping) => EQ(nt2,'Any)
-    EQ(nt2,'Mapping) =>
-      EQ(nt1,'Variable) or EQ(nt1,'FunctionCalled) =>
+    nt1="Mapping" => nt2="Any"
+    nt2="Mapping" =>
+      nt1="Variable" or nt1="FunctionCalled" =>
         canCoerceExplicit2Mapping(t1,t2)
       NIL
-    EQ(nt1,'Union) or EQ(nt2,'Union) => canCoerceUnion(t1,t2)
+    nt1="Union" or nt2="Union" => canCoerceUnion(t1,t2)
 
     -- efficiency hack
     t1 is ['Segment, s1] and t2 is ['UniversalSegment, s2] and
@@ -929,32 +929,15 @@ coerceInt1(triple,t2) ==
 coerceSubDomain(val, tSuper, tSub) ==
   -- Try to coerce from a sub domain to a super domain
   val = '_$fromCoerceable_$ => nil
-  super := getSuperDomainFromDB first tSub
-  superDomain := first super
-  superDomain = tSuper =>
-    coerceImmediateSubDomain(val, tSuper, tSub, CADR super)
-  coerceSubDomain(val, tSuper, superDomain) =>
-    coerceImmediateSubDomain(val, superDomain, tSub, CADR super)
-  nil
-
-coerceImmediateSubDomain(val, tSuper, tSub, pred) ==
-  predfn := getSubDomainPredicate(tSuper, tSub, pred)
-  FUNCALL(predfn, val, nil) => objNew(val, tSub)
+  pred := isSubDomain(tSub,tSuper) =>
+    predFun := getSubDomainPredicate(tSuper,tSub,pred)
+    FUNCALL(predFun,val) => objNew(val,tSub)
   nil
 
 getSubDomainPredicate(tSuper, tSub, pred) ==
-  $env: local := $InteractiveFrame
   predfn := HGET($superHash, CONS(tSuper, tSub)) => predfn
-  name := GENSYM()
-  decl := ['_:, name, ['Mapping, $Boolean, tSuper]]
-  interpret(decl, nil)
   arg := GENSYM()
-  pred' := substitute(arg, "#1", pred)
-  defn := ['DEF, [name, arg], '(NIL NIL), '(NIL NIL), removeZeroOne pred']
-  interpret(defn, nil)
-  op := mkAtree name
-  transferPropsToNode(name, op)
-  predfn := CADAR selectLocalMms(op, name, [tSuper],$Boolean)
+  predfn := COMPILE(nil,["LAMBDA",[arg],substitute(arg,"#1", pred)])
   HPUT($superHash, CONS(tSuper, tSub), predfn)
   predfn