remove more pamphlets

1 files changed, 0 insertions, 1822 deletions

diff --git a/src/interp/i-funsel.boot.pamphlet b/src/interp/i-funsel.boot.pamphlet
deleted file mode 100644
index 5f5d4278..00000000
--- a/src/interp/i-funsel.boot.pamphlet
+++ /dev/null
@@ -1,1822 +0,0 @@
-\documentclass{article}
-\usepackage{axiom}
-
-\title{\File{src/interp/i-funsel.boot} Pamphlet}
-\author{The Axiom Team}
-
-\begin{document}
-\maketitle
-\begin{abstract}
-\end{abstract}
-\eject
-\tableofcontents
-\eject
-
-\begin{verbatim}
-New Selection of Modemaps
-
-selection of applicable modemaps is done in two steps:
-  first it tries to find a modemap inside an argument domain, and if
-  this fails, by evaluation of pattern modemaps
-the result is a list of functions with signatures, which have the
-  following form:
-  [sig,elt,cond] where
-    sig is the signature gained by evaluating the modemap condition
-    elt is the slot number to get the implementation
-    cond are runtime checks which are the results of evaluating the
-    modemap condition
-
-the following flags are used:
- $Coerce is NIL, if function selection is done which requires exact
-   matches (e.g. for coercion functions)
- if $SubDom is true, then runtime checks have to be compiled
-\end{verbatim}
-\section{Functions}
-\subsection{isPartialMode}
-[[isPartialMode]] tests whether m contains [[$EmptyMode]]. The
-constant [[$EmptyMode]] (defined in bootfuns.lisp) evaluates to
-[[|$EmptyMode|]]. This constants is inserted in a modemap during
-compile time if the modemap is not yet complete.
-<<isPartialMode>>=
-isPartialMode m ==
-  CONTAINED($EmptyMode,m)
-
-@
-\section{License}
-<<license>>=
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--- 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.
-
-@
-<<*>>=
-<<license>>
-
-import '"i-coerfn"
-)package "BOOT"
-
-$constructorExposureList := '(Boolean Integer String)
-
-sayFunctionSelection(op,args,target,dc,func) ==
-  $abbreviateTypes : local := true
-  startTimingProcess 'debug
-  fsig := formatSignatureArgs args
-  if not LISTP fsig then fsig := LIST fsig
-  if func then func := bright ['"by ",func]
-  sayMSG concat ['%l,:bright '"Function Selection for",op,:func,'%l,
-    '"      Arguments:",:bright fsig]
-  if target then sayMSG concat ['"      Target type:",
-    :bright prefix2String target]
-  if dc	 then sayMSG concat ['"      From:     ",
-    :bright prefix2String dc]
-  stopTimingProcess 'debug
-
-sayFunctionSelectionResult(op,args,mmS) ==
-  $abbreviateTypes : local := true
-  startTimingProcess 'debug
-  if mmS then printMms mmS
-  else sayMSG concat ['"   -> no function",:bright op,
-    '"found for arguments",:bright formatSignatureArgs args]
-  stopTimingProcess 'debug
-
-selectMms(op,args,$declaredMode) ==
-  -- selects applicable modemaps for node op and arguments args
-  -- if there is no local modemap, and it is not a package call, then
-  --   the cached function selectMms1 is called
-  startTimingProcess 'modemaps
-  n:= getUnname op
-  val := getValue op
-  opMode := objMode val
-
-  -- see if we have a functional parameter
-  ((isSharpVarWithNum(n) and opMode) or (val and opMode)) and
-      opMode is ['Mapping,:ta] =>
-	imp :=
-	  val => wrapped2Quote objVal val
-	  n
-	[[['local,:ta], imp , NIL]]
-
-  ((isSharpVarWithNum(n) and opMode) or (val and opMode)) and
-      opMode is ['Variable,f] =>
-	 emptyAtree op
-	 op.0 := f
-	 selectMms(op,args,$declaredMode)
-
-  isSharpVarWithNum(n) and opMode is ['FunctionCalled,f] =>
-	 op.0 := f
-	 selectMms(op,args,$declaredMode)
-
-  types1 := getOpArgTypes(n,args)
-  numArgs := #args
-  member('(SubDomain (Domain)),types1) => NIL
-  member('(Domain),types1) => NIL
-  member($EmptyMode,types1) => NIL
-
-  tar := getTarget op
-  dc  := getAtree(op,'dollar)
-
-  null dc and val and objMode(val) = $AnonymousFunction =>
-      tree := mkAtree objValUnwrap getValue op
-      putTarget(tree,['Mapping,tar,:types1])
-      bottomUp tree
-      val := getValue tree
-      [[['local,:rest objMode val], wrapped2Quote objVal val, NIL]]
-
-  if (n = 'map) and (first types1 = $AnonymousFunction)
-    then
-      tree := mkAtree objValUnwrap getValue first args
-      ut :=
-	tar => underDomainOf tar
-	NIL
-      ua := [underDomainOf x for x in rest types1]
-      member(NIL,ua) => NIL
-      putTarget(tree,['Mapping,ut,:ua])
-      bottomUp tree
-      val := getValue tree
-      types1 := [objMode val,:rest types1]
-      RPLACA(args,tree)
-
-  if numArgs = 1 and (n = "numer" or n = "denom") and
-    isEqualOrSubDomain(first types1,$Integer) and null dc then
-      dc := ['Fraction, $Integer]
-      putAtree(op, 'dollar, dc)
-
-
-  if $reportBottomUpFlag then sayFunctionSelection(n,types1,tar,dc,NIL)
-
-  identType := 'Variable
-  for x in types1 while not $declaredMode repeat
-      not EQCAR(x,identType) => $declaredMode:= x
-  types2 := [altTypeOf(x,y,$declaredMode) for x in types1 for y in args]
-
-  mmS:=
-    dc => selectDollarMms(dc,n,types1,types2)
-
-    if n = "/" and tar = $Integer then
-      tar := $RationalNumber
-      putTarget(op,tar)
-
-    -- now to speed up some standard selections
-    if not tar then
-      tar := defaultTarget(op,n,#types1,types1)
-      if tar and $reportBottomUpFlag then
-	sayMSG concat ['"      Default target type:",
-	  :bright prefix2String tar]
-
-    selectLocalMms(op,n,types1,tar) or
-      (VECTORP op and selectMms1(n,tar,types1,types2,'T))
-  if $reportBottomUpFlag then sayFunctionSelectionResult(n,types1,mmS)
-  stopTimingProcess 'modemaps
-  mmS
-
--- selectMms1 is in clammed.boot
-
-selectMms2(op,tar,args1,args2,$Coerce) ==
-  -- decides whether to find functions from a domain or package
-  --   or by general modemap evaluation
-  or/[STRINGP arg for arg in args1] => NIL
-  if tar = $EmptyMode then tar := NIL
-  nargs := #args1
-  mmS := NIL
-  mmS :=
-    -- special case map for the time being
-    $Coerce and (op = 'map) and (2 = nargs) and
-      (first(args1) is ['Variable,fun]) =>
-	null (ud := underDomainOf CADR args1) => NIL
-	if tar then ut := underDomainOf(tar)
-	else ut := nil
-	null (mapMms := selectMms1(fun,ut,[ud],[NIL],true)) => NIL
-	mapMm := CDAAR mapMms
-	selectMms1(op,tar,[['Mapping,:mapMm],CADR args1],
-	  [NIL,CADR args2],$Coerce)
-
-    $Coerce and (op = 'map) and (2 = nargs) and
-      (first(args1) is ['FunctionCalled,fun]) =>
-	null (ud := underDomainOf CADR args1) => NIL
-	if tar then ut := underDomainOf(tar)
-	else ut := nil
-	funNode := mkAtreeNode fun
-	transferPropsToNode(fun,funNode)
-	null (mapMms := selectLocalMms(funNode,fun,[ud],NIL)) => NIL
-	mapMm := CDAAR mapMms
-	selectMms1(op,tar,[['Mapping,:mapMm],CADR args1],
-	  [NIL,CADR args2],$Coerce)
-
-    -- get the argument domains and the target
-    a := nil
-    for x in args1 repeat if x then a := cons(x,a)
-    for x in args2 repeat if x then a := cons(x,a)
-    if tar and not isPartialMode tar then a := cons(tar,a)
-
-    -- for typically homogeneous functions, throw in resolve too
-    if op in '(_= _+ _* _- ) then
-      r := resolveTypeList a
-      if r ^= nil then a := cons(r,a)
-
-    if tar and not isPartialMode tar then
-      if xx := underDomainOf(tar) then a := cons(xx,a)
-    for x in args1 repeat
-      PAIRP(x) and CAR(x) in '(List Vector Stream FiniteSet Array) =>
-	xx := underDomainOf(x) => a := cons(xx,a)
-
-    -- now extend this list with those from the arguments to
-    -- any Unions, Mapping or Records
-
-    a' := nil
-    a := nreverse REMDUP a
-    for x in a repeat
-      null x => 'iterate
-      x = '(RationalRadicals) => a' := cons($RationalNumber,a')
-      x is ['Union,:l] =>
-	-- check if we have a tagged union
-	l and first l is [":",:.] =>
-	  for [.,.,t] in l repeat
-	    a' := cons(t,a')
-	a' := append(reverse l,a')
-      x is ['Mapping,:l] => a' := append(reverse l,a')
-      x is ['Record,:l] =>
-	a' := append(reverse [CADDR s for s in l],a')
-      x is ['FunctionCalled,name] =>
-	(xm := get(name,'mode,$e)) and not isPartialMode xm =>
-	  a' := cons(xm,a')
-    a := append(a,REMDUP a')
-    a := [x for x in a | PAIRP(x)]
-
-    -- step 1. see if we have one without coercing
-    a' := a
-    while a repeat
-      x:= CAR a
-      a:= CDR a
-      ATOM x => 'iterate
-      mmS := append(mmS, findFunctionInDomain(op,x,tar,args1,args2,NIL,NIL))
-
-    -- step 2. if we didn't get one, trying coercing (if we are
-    --	       suppose to)
-
-    if null(mmS) and $Coerce then
-      a := a'
-      while a repeat
-	x:= CAR a
-	a:= CDR a
-	ATOM x => 'iterate
-	mmS := append(mmS,
-	  findFunctionInDomain(op,x,tar,args1,args2,$Coerce,NIL))
-
-    mmS or selectMmsGen(op,tar,args1,args2)
-  mmS and orderMms(op, mmS,args1,args2,tar)
-
-isAVariableType t ==
-    t is ['Variable,.] or t = $Symbol or t is ['OrderedVariableList,.]
-
-defaultTarget(opNode,op,nargs,args) ==
-  -- this is for efficiency. Chooses standard targets for operations
-  -- when no target exists.
-
-  target := nil
-
-  nargs = 0 =>
-    op = 'nil =>
-      putTarget(opNode, target := '(List (None)))
-      target
-    op = 'true	or op = 'false =>
-      putTarget(opNode, target := $Boolean)
-      target
-    op = 'pi =>
-      putTarget(opNode, target := ['Pi])
-      target
-    op = 'infinity =>
-      putTarget(opNode, target := ['OnePointCompletion, $Integer])
-      target
-    member(op, '(plusInfinity minusInfinity)) =>
-      putTarget(opNode, target := ['OrderedCompletion, $Integer])
-      target
-    target
-
-  a1 := CAR args
-  ATOM a1 => target
-  a1f := QCAR a1
-
-  nargs = 1 =>
-    op = 'kernel =>
-      putTarget(opNode, target := ['Kernel, ['Expression, $Integer]])
-      target
-    op = 'list =>
-      putTarget(opNode, target := ['List, a1])
-      target
-    target
-
-  a2 := CADR args
-
-  nargs >= 2 and op = "draw" and a1 is ['FunctionCalled,sym] and a2 is ['Segment,.] =>
-
-    -- this clears up some confusion over 2D and 3D graphics
-
-    symNode := mkAtreeNode sym
-    transferPropsToNode(sym,symNode)
-
-    nargs >= 3 and CADDR args is ['Segment,.] =>
-      selectLocalMms(symNode,sym,[$DoubleFloat, $DoubleFloat],NIL)
-      putTarget(opNode, target := '(ThreeDimensionalViewport))
-      target
-
-    (mms := selectLocalMms(symNode,sym,[$DoubleFloat],NIL)) =>
-      [.,targ,:.] := CAAR mms
-      targ = $DoubleFloat =>
-	  putTarget(opNode, target := '(TwoDimensionalViewport))
-	  target
-      targ = ['Point, $DoubleFloat] =>
-	  putTarget(opNode, target := '(ThreeDimensionalViewport))
-	  target
-      target
-
-    target
-
-  nargs >= 2 and op = "makeObject" and a1 is ['FunctionCalled,sym] and a2 is ['Segment,.] =>
-    -- we won't actually bother to put a target on makeObject
-    -- this is just to figure out what the first arg is
-    symNode := mkAtreeNode sym
-    transferPropsToNode(sym,symNode)
-
-    nargs >= 3 and CADDR args is ['Segment,.] =>
-      selectLocalMms(symNode,sym,[$DoubleFloat, $DoubleFloat],NIL)
-      target
-
-    selectLocalMms(symNode,sym,[$DoubleFloat],NIL)
-    target
-
-  nargs = 2 =>
-    op = "elt" =>
-	a1 = '(BasicOperator) and a2 is ['List, ['OrderedVariableList, .]] =>
-	   ['Expression, $Integer]
-	target
-
-    op = "eval" =>
-	a1 is ['Expression,b1] and a2 is ['Equation, ['Polynomial,b2]] =>
-	    target :=
-	      canCoerce(b2, a1) => a1
-	      t := resolveTT(b1, b2)
-	      (not t) or (t = $Any) => nil
-	      resolveTT(a1, t)
-	    if target then putTarget(opNode, target)
-	    target
-	a1 is ['Equation, .] and a2 is ['Equation, .] =>
-	    target := resolveTT(a1, a2)
-	    if target and not (target = $Any) then putTarget(opNode,target)
-	    else target := nil
-	    target
-	a1 is ['Equation, .] and a2 is ['List, a2e] and a2e is ['Equation, .] =>
-	    target := resolveTT(a1, a2e)
-	    if target and not (target = $Any) then putTarget(opNode,target)
-	    else target := nil
-	    target
-	a2 is ['Equation, a2e] or a2 is ['List, ['Equation, a2e]] =>
-	    target := resolveTT(a1, a2e)
-	    if target and not (target = $Any) then putTarget(opNode,target)
-	    else target := nil
-	    target
-
-    op = "**" or op = "^" =>
-      a2 = $Integer =>
-	if (target := resolveTCat(a1,'(Field))) then
-	  putTarget(opNode,target)
-	target
-      a1 = '(AlgebraicNumber) and (a2 = $Float or a2 = $DoubleFloat) =>
-	  target := ['Expression, a2]
-	  putTarget(opNode,target)
-	  target
-      a1 = '(AlgebraicNumber) and a2 is ['Complex, a3] and (a3 = $Float or a3 = $DoubleFloat) =>
-	  target := ['Expression, a3]
-	  putTarget(opNode,target)
-	  target
-      ((a2 = $RationalNumber) and
-	(typeIsASmallInteger(a1) or isEqualOrSubDomain(a1,$Integer))) =>
-	    putTarget(opNode, target := '(AlgebraicNumber))
-	    target
-      ((a2 = $RationalNumber) and (isAVariableType(a1)
-	  or a1 is ['Polynomial,.] or a1 is ['RationalFunction,.])) =>
-	    putTarget(opNode, target := defaultTargetFE a1)
-	    target
-      isAVariableType(a1) and (a2 = $PositiveInteger or a2 = $NonNegativeInteger) =>
-	  putTarget(opNode, target := '(Polynomial (Integer)))
-	  target
-      isAVariableType(a2) =>
-	putTarget(opNode, target := defaultTargetFE a1)
-	target
-      a2 is ['Polynomial, D] =>
-	(a1 = a2) or isAVariableType(a1)
-	 or ((a1 is ['RationalFunction, D1]) and (D1 = D)) or (a1 = D)
-	  or ((a1 is [=$QuotientField, D1]) and (D1 = a1)) =>
-	    putTarget(opNode, target := defaultTargetFE a2)
-	    target
-	target
-      a2 is ['RationalFunction, D] =>
-	(a1 = a2) or isAVariableType(a1)
-	 or ((a1 is ['RationalFunction, D1]) and (D1 = D)) or (a1 = D)
-	  or ((a1 is [=$QuotientField, D1]) and (D1 = a1)) =>
-	    putTarget(opNode, target := defaultTargetFE a2)
-	    target
-	target
-      target
-
-    op = "/" =>
-      isEqualOrSubDomain(a1, $Integer) and isEqualOrSubDomain(a2, $Integer) =>
-	putTarget(opNode, target := $RationalNumber)
-	target
-      a1 = a2 =>
-	if (target := resolveTCat(CAR args,'(Field))) then
-	  putTarget(opNode,target)
-	target
-      a1 is ['Variable,.] and a2 is ['Variable,.] =>
-	putTarget(opNode,target := mkRationalFunction  '(Integer))
-	target
-      isEqualOrSubDomain(a1,$Integer) and a2 is ['Variable,.] =>
-	putTarget(opNode,target := mkRationalFunction '(Integer))
-	target
-      a1 is ['Variable,.] and
-	a2 is ['Polynomial,D] =>
-	  putTarget(opNode,target := mkRationalFunction D)
-	  target
-	target
-      a2 is ['Variable,.] and
-	a1 is ['Polynomial,D] =>
-	  putTarget(opNode,target := mkRationalFunction D)
-	  target
-	target
-      a2 is ['Polynomial,D] and (a1 = D) =>
-	putTarget(opNode,target := mkRationalFunction D)
-	target
-      target
-
-  a3 := CADDR args
-  nargs = 3 =>
-    op = "eval" =>
-	a3 is ['List, a3e] =>
-	    target := resolveTT(a1, a3e)
-	    if not (target = $Any) then putTarget(opNode,target)
-	    else target := nil
-	    target
-
-	target := resolveTT(a1, a3)
-	if not (target = $Any) then putTarget(opNode,target)
-	else target := nil
-	target
-  target
-
-mkRationalFunction D ==	 ['Fraction, ['Polynomial, D]]
-
-defaultTargetFE(a,:options) ==
-  a is ['Variable,.] or a = $RationalNumber or MEMQ(QCAR a,
-    [QCAR $Symbol, 'RationalRadicals,
-     'Pi]) or typeIsASmallInteger(a) or isEqualOrSubDomain(a, $Integer) or
-       a = '(AlgebraicNumber) =>
-          IFCAR options => [$FunctionalExpression, ['Complex, $Integer]]
-          [$FunctionalExpression, $Integer]
-  a is ['Complex,uD] => defaultTargetFE(uD, true)
-  a is [D,uD] and MEMQ(D, '(Polynomial RationalFunction Fraction)) =>
-     defaultTargetFE(uD, IFCAR options)
-  a is [=$FunctionalExpression,.] => a
-  IFCAR options => [$FunctionalExpression, ['Complex, a]]
-  [$FunctionalExpression, a]
-
-altTypeOf(type,val,$declaredMode) ==
-  (EQCAR(type,'Symbol) or EQCAR(type,'Variable)) and
-    (a := getMinimalVarMode(objValUnwrap getValue(val),$declaredMode)) =>
-      a
-  type is ['OrderedVariableList,vl] and
-    INTEGERP(val1 := objValUnwrap getValue(val)) and
-      (a := getMinimalVarMode(vl.(val1 - 1),$declaredMode)) =>
-	a
-  type = $PositiveInteger    => $Integer
-  type = $NonNegativeInteger => $Integer
-  type = '(List (PositiveInteger)) => '(List (Integer))
-  NIL
-
-getOpArgTypes(opname, args) ==
-  l := getOpArgTypes1(opname, args)
-  [f(a,opname) for a in l] where
-    f(x,op) ==
-      x is ['FunctionCalled,g] and op ^= 'name =>
-	m := get(g,'mode,$e) =>
-	  m is ['Mapping,:.] => m
-	  x
-	x
-      x
-
-getOpArgTypes1(opname, args) ==
-  null args => NIL
-  -- special cases first
-  opname = 'coef and args is [b,n] =>
-    [CAR getModeSet b, CAR getModeSetUseSubdomain n]
-  opname = 'monom and args is [d,c] =>
-    [CAR getModeSetUseSubdomain d,CAR getModeSet c]
-  opname = 'monom and args is [v,d,c] =>
-    [CAR getModeSet v,CAR getModeSetUseSubdomain d,CAR getModeSet c]
-  (opname = 'cons) and (2 = #args) and (CADR(args) = 'nil) =>
-    ms := [CAR getModeSet x for x in args]
-    if CADR(ms) = '(List (None)) then
-      ms := [first ms,['List,first ms]]
-    ms
-  nargs := #args
-  v := argCouldBelongToSubdomain(opname,nargs)
-  mss := NIL
-  for i in 0..(nargs-1) for x in args repeat
-    ms :=
-      v.i = 0 => CAR getModeSet x
-      CAR getModeSetUseSubdomain x
-    mss := [ms,:mss]
-  nreverse mss
-
-argCouldBelongToSubdomain(op, nargs) ==
-  -- this returns a vector containing 0 or ^0 for each argument.
-  -- if ^0, this indicates that there exists a modemap for the
-  -- op that needs a subdomain in that position
-  nargs = 0 => NIL
-  v := GETZEROVEC nargs
-  isMap(op) => v
-  mms := getModemapsFromDatabase(op,nargs)
-  null mms => v
-  nargs:=nargs-1
-  -- each signature has form
-  -- [domain of implementation, target, arg1, arg2, ...]
-  for [sig,cond,:.] in mms repeat
-    for t in CDDR sig for i in 0..(nargs) repeat
-      CONTAINEDisDomain(t,cond) =>
-	  v.i := 1 + v.i
-  v
-
-CONTAINEDisDomain(symbol,cond) ==
--- looks for [isSubDomain,symbol,[domain]] in cond: returning T or NIL
--- with domain being one of PositiveInteger and NonNegativeInteger
-   ATOM cond => false
-   MEMQ(QCAR cond,'(AND OR and or)) =>
-       or/[CONTAINEDisDomain(symbol, u) for u in QCDR cond]
-   EQ(QCAR cond,'isDomain) =>
-       EQ(symbol,CADR cond) and PAIRP(dom:=CADDR cond) and
-	 MEMQ(dom,'(PositiveInteger NonNegativeInteger))
-   false
-
-selectDollarMms(dc,name,types1,types2) ==
-  -- finds functions for name in domain dc
-  isPartialMode dc => throwKeyedMsg("S2IF0001",NIL)
-  mmS := findFunctionInDomain(name,dc,NIL,types1,types2,'T,'T) =>
-    orderMms(name, mmS,types1,types2,NIL)
-  if $reportBottomUpFlag then sayMSG
-    ["%b",'"          function not found in ",prefix2String dc,"%d","%l"]
-  NIL
-
-selectLocalMms(op,name,types,tar) ==
-  -- partial rewrite, looks now for exact local modemap
-  mmS:= getLocalMms(name,types,tar) => mmS
-  obj := getValue op
-  obj and (objVal obj is ['MAP,:mapDef]) and
-    analyzeMap(op,types,mapDef,tar) and getLocalMms(name,types,tar)
-
--- next defn may be better, test when more time. RSS 3/11/94
--- selectLocalMms(op,name,types,tar) ==
---  mmS := getLocalMms(name,types,tar)
---  -- if no target, just return what we got
---  mmS and null tar => mmS
---  matchingMms := nil
---  for mm in mmS repeat
---    [., targ, :.] := mm
---    if tar = targ then matchingMms := cons(mm, matchingMms)
---  -- if we got some exact matchs on the target, return them
---  matchingMms => nreverse matchingMms
---
---  obj := getValue op
---  obj and (objVal obj is ['MAP,:mapDef]) and
---    analyzeMap(op,types,mapDef,tar) and getLocalMms(name,types,tar)
-
-getLocalMms(name,types,tar) ==
-  -- looks for exact or subsumed local modemap in $e
-  mmS := NIL
-  for  (mm:=[dcSig,:.]) in get(name,'localModemap,$e) repeat
-    -- check format and destructure
-    dcSig isnt [dc,result,:args] => NIL
-    -- make number of args is correct
-    #types ^= #args => NIL
-    -- check for equal or subsumed arguments
-    subsume := (not $useIntegerSubdomain) or (tar = result) or
-      get(name,'recursive,$e)
-    acceptableArgs :=
-      and/[f(b,a,subsume) for a in args for b in types] where
-	f(x,y,subsume) ==
-	  if subsume
-	    then isEqualOrSubDomain(x,y)
-	    else x = y
-    not acceptableArgs =>
-      -- interpreted maps are ok
-      dc = 'interpOnly and not($Coerce)=> mmS := [mm,:mmS]
-      NIL
-    mmS := [mm,:mmS]
-  nreverse mmS
-
-mmCost(name, sig,cond,tar,args1,args2) ==
-  cost := mmCost0(name, sig,cond,tar,args1,args2)
-  res := CADR sig
-  res = $PositiveInteger => cost - 2
-  res = $NonNegativeInteger => cost - 1
-  res = $DoubleFloat => cost + 1
-  cost
-
-mmCost0(name, sig,cond,tar,args1,args2) ==
-  sigArgs := CDDR sig
-  n:=
-    null cond => 1
-    not (or/cond) => 1
-    0
-
-  -- try to favor homogeneous multiplication
-
---if name = "*" and 2 = #sigArgs and first sigArgs ^= first rest sigArgs then n := n + 1
-
-  -- because of obscure problem in evalMm, sometimes we will have extra
-  -- modemaps with the wrong number of arguments if we want to the one
-  -- with no arguments and the name is overloaded. Thus check for this.
-
-  if args1 then
-    for x1 in args1 for x2 in args2 for x3 in sigArgs repeat
-      n := n +
-	isEqualOrSubDomain(x1,x3) => 0
-	topcon := first deconstructT x1
-	topcon2 := first deconstructT x3
-	topcon = topcon2 => 3
-	CAR topcon2 = 'Mapping => 2
-	4
-  else if sigArgs then n := n + 100000000000
-
-  res := CADR sig
-  res=tar => 10000*n
-  10000*n + 1000*domainDepth(res) + hitListOfTarget(res)
-
-orderMms(name, mmS,args1,args2,tar) ==
-  -- it counts the number of necessary coercions of the argument types
-  -- if this isn't enough, it compares the target types
-  mmS and null rest mmS => mmS
-  mS:= NIL
-  N:= NIL
-  for mm in MSORT mmS repeat
-    [sig,.,cond]:= mm
-    b:= 'T
-    p:= CONS(m := mmCost(name, sig,cond,tar,args1,args2),mm)
-    mS:=
-      null mS => list p
-      m < CAAR mS => CONS(p,mS)
-      S:= mS
-      until b repeat
-	b:= null CDR S or m < CAADR S =>
-	  RPLACD(S,CONS(p,CDR S))
-	S:= CDR S
-      mS
-  mmS and [CDR p for p in mS]
-
-domainDepth(d) ==
-  -- computes the depth of lisp structure d
-  atom d => 0
-  MAX(domainDepth(CAR d)+1,domainDepth(CDR d))
-
-hitListOfTarget(t) ==
-  -- assigns a number between 1 and 998 to a type t
-
-  -- want to make it hard to go to Polynomial Pi
-
-  t = '(Polynomial (Pi)) => 90000
-
-  EQ(CAR t, 'Polynomial) => 300
-  EQ(CAR t, 'List) => 400
-  EQ(CAR t,'Matrix) => 910
-  EQ(CAR t,'UniversalSegment) => 501
-  EQ(CAR t,'RationalFunction) => 900
-  EQ(CAR t,'Union) => 999
-  EQ(CAR t,'Expression) => 1600
-  500
-
-getFunctionFromDomain(op,dc,args) ==
-  -- finds the function op with argument types args in dc
-  -- complains, if no function or ambiguous
-  $reportBottomUpFlag:local:= NIL
-  member(CAR dc,$nonLisplibDomains) =>
-    throwKeyedMsg("S2IF0002",[CAR dc])
-  not constructor? CAR dc =>
-    throwKeyedMsg("S2IF0003",[CAR dc])
-  p:= findFunctionInDomain(op,dc,NIL,args,args,NIL,NIL) =>
---+
-    --sig := [NIL,:args]
-    domain := evalDomain dc
-    for mm in nreverse p until b repeat
-      [[.,:osig],nsig,:.] := mm
-      b := compiledLookup(op,nsig,domain)
-    b or  throwKeyedMsg("S2IS0023",[op,dc])
-  throwKeyedMsg("S2IF0004",[op,dc])
-
-isOpInDomain(opName,dom,nargs) ==
-  -- returns true only if there is an op in the given domain with
-  -- the given number of arguments
-  mmList := ASSQ(opName,getOperationAlistFromLisplib CAR dom)
-  mmList := subCopy(mmList,constructSubst dom)
-  null mmList => NIL
-  gotOne := NIL
-  nargs := nargs + 1
-  for mm in CDR mmList while not gotOne repeat
-    nargs = #CAR mm => gotOne := [mm, :gotOne]
-  gotOne
-
-findCommonSigInDomain(opName,dom,nargs) ==
-  -- this looks at all signatures in dom with given opName and nargs
-  -- number of arguments. If no matches, returns NIL. Otherwise returns
-  -- a "signature" where a type position is non-NIL only if all
-  -- signatures shares that type .
-  CAR(dom) in '(Union Record Mapping) => NIL
-  mmList := ASSQ(opName,getOperationAlistFromLisplib CAR dom)
-  mmList := subCopy(mmList,constructSubst dom)
-  null mmList => NIL
-  gotOne := NIL
-  nargs := nargs + 1
-  vec := NIL
-  for mm in CDR mmList repeat
-    nargs = #CAR mm =>
-      null vec	=> vec := LIST2VEC CAR mm
-      for i in 0.. for x in CAR mm repeat
-	if vec.i and vec.i ^= x then vec.i := NIL
-  VEC2LIST vec
-
-findUniqueOpInDomain(op,opName,dom) ==
-  -- return function named op in domain dom if unique, choose one if not
-  mmList := ASSQ(opName,getOperationAlistFromLisplib CAR dom)
-  mmList := subCopy(mmList,constructSubst dom)
-  null mmList =>
-    throwKeyedMsg("S2IS0021",[opName,dom])
-  if #CDR mmList > 1 then
-    mm := selectMostGeneralMm CDR mmList
-    sayKeyedMsg("S2IS0022",[opName,dom,['Mapping,:CAR mm]])
-  else mm := CADR mmList
-  [sig,slot,:.] := mm
-  fun :=
---+
-      $genValue =>
-	 compiledLookupCheck(opName,sig,evalDomain dom)
-      NRTcompileEvalForm(opName, sig, evalDomain dom)
-  NULL(fun) or NULL(PAIRP(fun)) => NIL
-  CAR fun = function(Undef) => throwKeyedMsg("S2IS0023",[opName,dom])
-  binVal :=
-    $genValue => wrap fun
-    fun
-  putValue(op,objNew(binVal,m:=['Mapping,:sig]))
-  putModeSet(op,[m])
-
-selectMostGeneralMm mmList ==
-  -- selects the modemap in mmList with arguments all the other
-  -- argument types can be coerced to
-  -- also selects function with #args closest to 2
-  min := 100
-  mml := mmList
-  while mml repeat
-    [mm,:mml] := mml
-    sz := #CAR mm
-    if (met := ABS(sz - 3)) < min then
-      min := met
-      fsz := sz
-  mmList := [mm for mm in mmList | (#CAR mm) = fsz]
-  mml := CDR mmList
-  genMm := CAR mmList
-  while mml repeat
-    [mm,:mml] := mml
-    and/[canCoerceFrom(genMmArg,mmArg) for mmArg in CDAR mm
-      for genMmArg in CDAR genMm] => genMm := mm
-  genMm
-
-findFunctionInDomain(op,dc,tar,args1,args2,$Coerce,$SubDom) ==
-  -- looks for a modemap for op with signature  args1 -> tar
-  --   in the domain of computation dc
-  -- tar may be NIL (= unknown)
-  null isLegitimateMode(tar, nil, nil) => nil
-  dcName:= CAR dc
-  member(dcName,'(Union Record Mapping Enumeration)) =>
-    -- First cut code that ignores args2, $Coerce and $SubDom
-    -- When domains no longer have to have Set, the hard coded 6 and 7
-    -- should go.
-    op = '_= =>
-        #args1 ^= 2 or args1.0 ^= dc or args1.1 ^= dc => NIL
-        tar and tar ^= '(Boolean) => NIL
-        [[[dc, '(Boolean), dc, dc], ['(Boolean),'$,'$], [NIL, NIL]]]
-    op = 'coerce =>
-        #args1 ^= 1 
-        dcName='Enumeration and (args1.0=$Symbol or tar=dc)=>
-           [[[dc, dc, $Symbol], ['$,$Symbol], [NIL, NIL]]]
-        args1.0 ^= dc => NIL
-        tar and tar ^= $Expression => NIL
-        [[[dc, $Expression, dc], [$Expression,'$], [NIL, NIL]]]
-    member(dcName,'(Record Union)) =>
-      findFunctionInCategory(op,dc,tar,args1,args2,$Coerce,$SubDom)
-    NIL
-  fun:= NIL
-  ( p := ASSQ(op,getOperationAlistFromLisplib dcName) ) and
-    SL := constructSubst dc
-    -- if the arglist is homogeneous, first look for homogeneous
-    -- functions. If we don't find any, look at remaining ones
-    if isHomogeneousList args1 then
-      q := NIL
-      r := NIL
-      for mm in CDR p repeat
-        -- CDAR of mm is the signature argument list
-        if isHomogeneousList CDAR mm then q := [mm,:q]
-        else r := [mm,:r]
-      q := allOrMatchingMms(q,args1,tar,dc)
-      for mm in q repeat
-        fun:= nconc(fun,findFunctionInDomain1(mm,op,tar,args1,args2,SL))
-      r := reverse r
-    else r := CDR p
-    r := allOrMatchingMms(r,args1,tar,dc)
-    if not fun then    -- consider remaining modemaps
-      for mm in r repeat
-        fun:= nconc(fun,findFunctionInDomain1(mm,op,tar,args1,args2,SL))
-  if not fun and $reportBottomUpFlag then
-    sayMSG concat
-      ['"   -> no appropriate",:bright op,'"found in",
-        :bright prefix2String dc]
-  fun
-
-allOrMatchingMms(mms,args1,tar,dc) ==
-  -- if there are exact matches on the arg types, return them
-  -- otherwise return the original list
-  null mms or null rest mms => mms
-  x := NIL
-  for mm in mms repeat
-    [sig,:.] := mm
-    [res,:args] := MSUBSTQ(dc,"$",sig)
-    args ^= args1 => nil
-    x := CONS(mm,x)
-  if x then x
-  else mms
-
-isHomogeneousList y ==
-  y is [x] => true
-  y and rest y =>
-    z := CAR y
-    "and"/[x = z for x in CDR y]
-  NIL
-
-findFunctionInDomain1(omm,op,tar,args1,args2,SL) ==
-  dc:= CDR (dollarPair := ASSQ('$,SL))
-  -- need to drop '$ from SL
-  mm:= subCopy(omm, SL)
-  -- tests whether modemap mm is appropriate for the function
-  -- defined by op, target type tar and argument types args
-  $RTC:local:= NIL
-  -- $RTC is a list of run-time checks to be performed
-
-  [sig,slot,cond,y] := mm
-  [osig,:.]  := omm
-  osig := subCopy(osig, SUBSTQ(CONS('$,'$), dollarPair, SL))
-  if CONTAINED('_#, sig) or CONTAINED('construct,sig) then
-    sig := [replaceSharpCalls t for t in sig]
-  matchMmCond cond and matchMmSig(mm,tar,args1,args2) and
-    EQ(y,'Subsumed) and
-      -- hmmmm: do Union check in following because (as in DP)
-      -- Unions are subsumed by total modemaps which are in the
-      -- mm list in findFunctionInDomain.
-      y := 'ELT      -- if subsumed fails try it again
-      not $SubDom and CAR sig isnt ['Union,:.] and slot is [tar,:args] and
-        (f := findFunctionInDomain(op,dc,tar,args,args,NIL,NIL)) => f
-    EQ(y,'ELT) => [[CONS(dc,sig),osig,nreverse $RTC]]
-    EQ(y,'CONST) => [[CONS(dc,sig),osig,nreverse $RTC]]
-    EQ(y,'ASCONST) => [[CONS(dc,sig),osig,nreverse $RTC]]
-    y is ['XLAM,:.] => [[CONS(dc,sig),y,nreverse $RTC]]
-    sayKeyedMsg("S2IF0006",[y])
-    NIL
-
-findFunctionInCategory(op,dc,tar,args1,args2,$Coerce,$SubDom) ==
-  -- looks for a modemap for op with signature  args1 -> tar
-  --   in the domain of computation dc
-  -- tar may be NIL (= unknown)
-  dcName:= CAR dc
-  not MEMQ(dcName,'(Record Union Enumeration)) => NIL
-  fun:= NIL
- --  cat := constructorCategory dc
-  makeFunc := GETL(dcName,"makeFunctionList") or
-      systemErrorHere '"findFunctionInCategory"
-  [funlist,.] := FUNCALL(makeFunc,"$",dc,$CategoryFrame)
-  -- get list of implementations and remove sharps
-  maxargs := -1
-  impls := nil
-  for [a,b,d] in funlist repeat
-    not EQ(a,op) => nil
-    d is ['XLAM,xargs,:.] =>
-      if PAIRP(xargs) then maxargs := MAX(maxargs,#xargs)
-      else maxargs := MAX(maxargs,1)
-      impls := cons([b,nil,true,d],impls)
-    impls := cons([b,d,true,d],impls)
-  impls := NREVERSE impls
-  if maxargs ^= -1 then
-    SL:= NIL
-    for i in 1..maxargs repeat
-      impls := SUBSTQ(GENSYM(),INTERNL('"#",STRINGIMAGE i),impls)
-  impls and
-    SL:= constructSubst dc
-    for mm in impls repeat
-      fun:= nconc(fun,findFunctionInDomain1(mm,op,tar,args1,args2,SL))
-  if not fun and $reportBottomUpFlag then
-    sayMSG concat
-      ['"   -> no appropriate",:bright op,'"found in",
-        :bright prefix2String dc]
-  fun
-
-matchMmCond(cond) ==
-  -- tests the condition, which comes with a modemap
-  -- cond is 'T or a list, but I hate to test for 'T (ALBI)
-  $domPvar: local := nil
-  atom cond or
-    cond is ['AND,:conds] or cond is ['and,:conds] =>
-      and/[matchMmCond c for c in conds]
-    cond is ['OR,:conds] or cond is ['or,:conds] =>
-      or/[matchMmCond c for c in conds]
-    cond is ['has,dom,x] =>
-      hasCaty(dom,x,NIL) ^= 'failed
-    cond is ['not,cond1] => not matchMmCond cond1
-    keyedSystemError("S2GE0016",
-      ['"matchMmCond",'"unknown form of condition"])
-
-matchMmSig(mm,tar,args1,args2) ==
-  -- matches the modemap signature against  args1 -> tar
-  -- if necessary, runtime checks are created for subdomains
-  -- then the modemap condition is evaluated
-  [sig,:.]:= mm
-  if CONTAINED('_#, sig) then
-    sig := [replaceSharpCalls COPY t for t in sig]
-  null args1 => matchMmSigTar(tar,CAR sig)
-  a:= CDR sig
-  arg:= NIL
-  for i in 1.. while args1 and args2 and a until not b repeat
-    x1:= CAR args1
-    args1:= CDR args1
-    x2:= CAR args2
-    args2:= CDR args2
-    x:= CAR a
-    a:= CDR a
-    rtc:= NIL
-    if x is ['SubDomain,y,:.] then x:= y
-    b := isEqualOrSubDomain(x1,x) or
-      (STRINGP(x) and (x1 is ['Variable,v]) and (x = PNAME v)) or
-	$SubDom and isSubDomain(x,x1) => rtc:= 'T
-	$Coerce => x2=x or canCoerceFrom(x1,x)
-	x1 is ['Variable,:.] and x = '(Symbol)
-    $RTC:= CONS(rtc,$RTC)
-  null args1 and null a and b and matchMmSigTar(tar,CAR sig)
-
-matchMmSigTar(t1,t2) ==
-  -- t1 is a target type specified by :: or by a declared variable
-  -- t2 is the target of a modemap signature
-  null t1 or
-    isEqualOrSubDomain(t2,t1) => true
-    if t2 is ['Union,a,b] then
-      if a='"failed" then return matchMmSigTar(t1, b)
-      if b='"failed" then return matchMmSigTar(t1, a)
-    $Coerce and
-      isPartialMode t1 => resolveTM(t2,t1)
--- I think this should be true	-SCM
---    true
-      canCoerceFrom(t2,t1)
-
-constructSubst(d) ==
-  -- constructs a substitution which substitutes d for $
-  -- and the arguments of d for #1, #2 ..
-  SL:= list CONS('$,d)
-  for x in CDR d for i in 1.. repeat
-    SL:= CONS(CONS(INTERNL('"#",STRINGIMAGE i),x),SL)
-  SL
-
-filterModemapsFromPackages(mms, names, op) ==
-  -- mms is a list of modemaps
-  -- names is a list of domain constructors
-  -- this returns a 2-list containing those modemaps that have one
-  -- of the names in the package source of the modemap and all the
-  -- rest of the modemaps in the second element.
-  good := NIL
-  bad  := NIL
-  -- hack to speed up factorization choices for mpolys and to overcome
-  -- some poor naming of packages
-  mpolys := '("Polynomial" "MultivariatePolynomial"
-   "DistributedMultivariatePolynomial"
-      "HomogeneousDistributedMultivariatePolynomial")
-  mpacks := '("MFactorize" "MRationalFactorize")
-  for mm in mms repeat
-    isFreeFunctionFromMm(mm) => bad := cons(mm, bad)
-    type := getDomainFromMm mm
-    null type => bad := cons(mm,bad)
-    if PAIRP type then type := first type
-    GETDATABASE(type,'CONSTRUCTORKIND) = 'category => bad := cons(mm,bad)
-    name := object2String type
-    found := nil
-    for n in names while not found repeat
-      STRPOS(n,name,0,NIL) => found := true
-      -- hack, hack
-      (op = 'factor) and member(n,mpolys) and member(name,mpacks) =>
-	found := true
-    if found
-      then good := cons(mm, good)
-      else bad := cons(mm,bad)
-  [good,bad]
-
-
-isTowerWithSubdomain(towerType,elem) ==
-  not PAIRP towerType => NIL
-  dt := deconstructT towerType
-  2 ^= #dt => NIL
-  s := underDomainOf(towerType)
-  isEqualOrSubDomain(s,elem) and constructM(first dt,[elem])
-
-selectMmsGen(op,tar,args1,args2) ==
-  -- general modemap evaluation of op with argument types args1
-  -- evaluates the condition and looks for the slot number
-  -- returns all functions which are applicable
-  -- args2 is a list of polynomial types for symbols
-  $Subst: local := NIL
-  $SymbolType: local := NIL
-
-  null (S := getModemapsFromDatabase(op,QLENGTH args1)) => NIL
-
-  if (op = 'map) and (2 = #args1) and
-    (CAR(args1) is ['Mapping,., elem]) and
-      (a := isTowerWithSubdomain(CADR args1,elem))
-	then args1 := [CAR args1,a]
-
-  -- we first split the modemaps into two groups:
-  --   haves:	 these are from packages that have one of the top level
-  --		 constructor names in the package name
-  --   havenots: everything else
-
-  -- get top level constructor names for constructors with parameters
-  conNames := nil
-  if op = 'reshape then args := APPEND(rest args1, rest args2)
-  else args := APPEND(args1,args2)
-  if tar then args := [tar,:args]
-  -- for common aggregates, use under domain also
-  for a in REMDUP args repeat
-    a =>
-      atom a => nil
-      fa := QCAR a
-      fa in '(Record Union) => NIL
-      conNames := insert(STRINGIMAGE fa, conNames)
-
-  if conNames
-    then [haves,havenots] := filterModemapsFromPackages(S,conNames,op)
-    else
-      haves := NIL
-      havenots := S
-
-  mmS := NIL
-
-  if $reportBottomUpFlag then
-    sayMSG ['%l,:bright '"Modemaps from Associated Packages"]
-
-  if haves then
-    [havesExact,havesInexact] := exact?(haves,tar,args1)
-    if $reportBottomUpFlag then
-      for mm in APPEND(havesExact,havesInexact) for i in 1.. repeat
-	sayModemapWithNumber(mm,i)
-    if havesExact then
-      mmS := matchMms(havesExact,op,tar,args1,args2)
-      if mmS then
-	if $reportBottomUpFlag then
-	  sayMSG '"   found an exact match!"
-	return mmS
-    mmS := matchMms(havesInexact,op,tar,args1,args2)
-  else if $reportBottomUpFlag then sayMSG '"   no modemaps"
-  mmS => mmS
-
-  if $reportBottomUpFlag then
-    sayMSG ['%l,:bright '"Remaining General Modemaps"]
-  --  for mm in havenots for i in 1.. repeat sayModemapWithNumber(mm,i)
-
-  if havenots then
-    [havesNExact,havesNInexact] := exact?(havenots,tar,args1)
-    if $reportBottomUpFlag then
-      for mm in APPEND(havesNExact,havesNInexact) for i in 1.. repeat
-	sayModemapWithNumber(mm,i)
-    if havesNExact then
-      mmS := matchMms(havesNExact,op,tar,args1,args2)
-      if mmS then
-	if $reportBottomUpFlag then
-	  sayMSG '"   found an exact match!"
-	return mmS
-    mmS := matchMms(havesNInexact,op,tar,args1,args2)
-  else if $reportBottomUpFlag then sayMSG '"   no modemaps"
-  mmS
- where
-  exact?(mmS,tar,args) ==
-    ex := inex := NIL
-    for (mm := [sig,[mmC,:.],:.]) in mmS repeat
-      [c,t,:a] := sig
-      ok := true
-      for pat in a for arg in args while ok repeat
-	not CONTAINED(['isDomain,pat,arg],mmC) => ok := NIL
-      ok => ex := CONS(mm,ex)
-      inex := CONS(mm,inex)
-    [ex,inex]
-  matchMms(mmaps,op,tar,args1,args2) ==
-    mmS := NIL
-    for [sig,mmC] in mmaps repeat
-      -- sig is [dc,result,:args]
-      $Subst :=
-	tar and not isPartialMode tar =>
-	  -- throw in the target if it is not the same as one
-	  -- of the arguments
-	  res := CADR sig
-	  member(res,CDDR sig) => NIL
-	  [[res,:tar]]
-	NIL
-      [c,t,:a] := sig
-      if a then matchTypes(a,args1,args2)
-      not EQ($Subst,'failed) =>
-	mmS := nconc(evalMm(op,tar,sig,mmC),mmS)
-    mmS
-
-matchTypes(pm,args1,args2) ==
-  -- pm is a list of pattern variables, args1 a list of argument types,
-  --   args2 a list of polynomial types for symbols
-  -- the result is a match from pm to args, if one exists
-  for v in pm for t1 in args1 for t2 in args2 until $Subst='failed repeat
-    p:= ASSQ(v,$Subst) =>
-      t:= CDR p
-      t=t1 => $Coerce and EQCAR(t1,'Symbol) and
-	(q := ASSQ(v,$SymbolType)) and t2 and
-	  (t3 := resolveTT(CDR q, t2)) and
-	    RPLACD(q, t3)
-      $Coerce =>
-	if EQCAR(t,'Symbol) and (q := ASSQ(v,$SymbolType)) then
-	  t := CDR q
-	if EQCAR(t1,'Symbol) and t2 then t1:= t2
-	t0 := resolveTT(t,t1) => RPLACD(p,t0)
-	$Subst:= 'failed
-      $Subst:= 'failed
-    $Subst:= CONS(CONS(v,t1),$Subst)
-    if EQCAR(t1,'Symbol) and t2 then $SymbolType:= CONS(CONS(v,t2),$SymbolType)
-
-evalMm(op,tar,sig,mmC) ==
-  -- evaluates a modemap with signature sig and condition mmC
-  -- the result is a list of lists [sig,slot,cond] or NIL
-  --if $Coerce is NIL, tar has to be the same as the computed target type
---if CONTAINED('LinearlyExplicitRingOver,mmC) then hohoho()
-  mS:= NIL
-  for st in evalMmStack mmC repeat
-    SL:= evalMmCond(op,sig,st)
-    not EQ(SL,'failed) =>
-      SL := fixUpTypeArgs SL
-      sig:= [subCopy(deepSubCopy(x,SL),$Subst) for x in sig]
-      not containsVars sig =>
-	isFreeFunctionFromMmCond mmC and (m := evalMmFreeFunction(op,tar,sig,mmC)) =>
-	   mS:= nconc(m,mS)
-	"or"/[^isValidType(arg) for arg in sig] => nil
-	[dc,t,:args]:= sig
-	$Coerce or null tar or tar=t =>
-	  mS:= nconc(findFunctionInDomain(op,dc,t,args,args,NIL,'T),mS)
-  mS
-
-evalMmFreeFunction(op,tar,sig,mmC) ==
-  [dc,t,:args]:= sig
-  $Coerce or null tar or tar=t =>
-     nilArgs := nil
-     for a in args repeat nilArgs := [NIL,:nilArgs]
-     [[[["__FreeFunction__",:dc],t,:args], [t, :args], nilArgs]]
-  nil
-
-evalMmStack(mmC) ==
-  -- translates the modemap condition mmC into a list of stacks
-  mmC is ['AND,:a] =>
-    ["NCONC"/[evalMmStackInner cond for cond in a]]
-  mmC is ['OR,:args] => [:evalMmStack a for a in args]
-  mmC is ['partial,:mmD] => evalMmStack mmD
-  mmC is ['ofCategory,pvar,cat] and cat is ['Join,:args] =>
-    evalMmStack CONS('AND,[['ofCategory,pvar,c] for c in args])
-  mmC is ['ofType,:.] => [NIL]
-  mmC is ['has,pat,x] =>
-    MEMQ(x,'(ATTRIBUTE SIGNATURE)) =>
-      [[['ofCategory,pat,['CATEGORY,'unknown,x]]]]
-    [['ofCategory,pat,x]]
-  [[mmC]]
-
-evalMmStackInner(mmC) ==
-  mmC is ['OR,:args] =>
-    keyedSystemError("S2GE0016",
-      ['"evalMmStackInner",'"OR condition nested inside an AND"])
-  mmC is ['partial,:mmD] => evalMmStackInner mmD
-  mmC is ['ofCategory,pvar,cat] and cat is ['Join,:args] =>
-    [['ofCategory, pvar, c] for c in args]
-  mmC is ['ofType,:.] => NIL
-  mmC is ['isAsConstant] => NIL
-  mmC is ['has,pat,x] =>
-    MEMQ(x,'(ATTRIBUTE SIGNATURE)) =>
-      [['ofCategory,pat,['CATEGORY,'unknown,x]]]
-    [['ofCategory,pat,x]]
-  [mmC]
-
-evalMmCond(op,sig,st) ==
-  $insideEvalMmCondIfTrue : local := true
-  evalMmCond0(op,sig,st)
-
-evalMmCond0(op,sig,st) ==
-  -- evaluates the nonempty list of modemap conditions st
-  -- the result is either 'failed or a substitution list
-  SL:= evalMmDom st
-  SL='failed => 'failed
-  for p in SL until p1 and not b repeat b:=
-    p1:= ASSQ(CAR p,$Subst)
-    p1 and
-      t1:= CDR p1
-      t:= CDR p
-      t=t1 or
-	containsVars t =>
-	  if $Coerce and EQCAR(t1,'Symbol) then t1:= getSymbolType CAR p
-	  resolveTM1(t1,t)
-	$Coerce and
-	  -- if we are looking at the result of a function, the coerce
-	  -- goes the opposite direction
-	  (t1 = $AnonymousFunction and t is ['Mapping, :.]) => t
-	  CAR p = CADR sig and not member(CAR p, CDDR sig) =>
-	    canCoerceFrom(t,t1) => 'T
-	    NIL
-	  canCoerceFrom(t1,t) => 'T
-	  isSubDomain(t,t1) => RPLACD(p,t1)
-	  EQCAR(t1,'Symbol) and canCoerceFrom(getSymbolType CAR p,t)
-  ( SL and p1 and not b and 'failed ) or evalMmCat(op,sig,st,SL)
-
-fixUpTypeArgs SL ==
-  for (p := [v, :t2]) in SL repeat
-    t1 := LASSOC(v, $Subst)
-    null t1 => RPLACD(p,replaceSharpCalls t2)
-    RPLACD(p, coerceTypeArgs(t1, t2, SL))
-  SL
-
-replaceSharpCalls t ==
-  noSharpCallsHere t => t
-  doReplaceSharpCalls t
-
-doReplaceSharpCalls t ==
-  ATOM t => t
-  t is ['_#, l] => #l
-  t is ['construct,: l] => EVAL ['LIST,:l]
-  [CAR t,:[ doReplaceSharpCalls u for u in CDR t]]
-
-noSharpCallsHere t ==
-  t isnt [con, :args] => true
-  MEMQ(con,'(construct _#)) => NIL
-  and/[noSharpCallsHere u for u in args]
-
-coerceTypeArgs(t1, t2, SL) ==
-  -- if the type t has type-valued arguments, coerce them to the new types,
-  -- if needed.
-  t1 isnt [con1, :args1] or t2 isnt [con2, :args2] => t2
-  con1 ^= con2 => t2
-  coSig := CDR GETDATABASE(CAR t1, 'COSIG)
-  and/coSig => t2
-  csub1 := constructSubst t1
-  csub2 := constructSubst t2
-  cs1 := CDR getConstructorSignature con1
-  cs2 := CDR getConstructorSignature con2
-  [con1, :
-    [makeConstrArg(arg1, arg2, constrArg(c1,csub1,SL),
-      constrArg(c2,csub2,SL), cs)
-       for arg1 in args1 for arg2 in args2 for c1 in cs1 for c2 in cs2
-	 for cs in coSig]]
-
-constrArg(v,sl,SL) ==
-  x := LASSOC(v,sl) =>
-    y := LASSOC(x,SL) => y
-    y := LASSOC(x, $Subst) => y
-    x
-  y := LASSOC(x, $Subst) => y
-  v
-
-makeConstrArg(arg1, arg2, t1, t2, cs) ==
-  if arg1 is ['_#, l] then arg1 := # l
-  if arg2 is ['_#, l] then arg2 := # l
-  cs => arg2
-  t1 = t2 => arg2
-  obj1 := objNewWrap(arg1, t1)
-  obj2 := coerceInt(obj1, t2)
-  null obj2 => throwKeyedMsgCannotCoerceWithValue(wrap arg1,t1,t2)
-  objValUnwrap obj2
-
-evalMmDom(st) ==
-  -- evals all isDomain(v,d) of st
-  SL:= NIL
-  for mmC in st until SL='failed repeat
-    mmC is ['isDomain,v,d] =>
-      STRINGP d => SL:= 'failed
-      p:= ASSQ(v,SL) and not (d=CDR p) => SL:= 'failed
-      d1:= subCopy(d,SL)
-      CONSP(d1) and MEMQ(v,d1) => SL:= 'failed
-      SL:= augmentSub(v,d1,SL)
-    mmC is ['isFreeFunction,v,fun] =>
-      SL:= augmentSub(v,subCopy(fun,SL),SL)
-  SL
-
-orderMmCatStack st ==
-  -- tries to reorder stack so that free pattern variables appear
-  -- as parameters first
-  null(st) or null rest(st) => st
-  vars := DELETE_-DUPLICATES [CADR(s) for s in st | isPatternVar(CADR(s))]
-  null vars => st
-  havevars := nil
-  haventvars := nil
-  for s in st repeat
-    cat := CADDR s
-    mem := nil
-    for v in vars while not mem repeat
-      if MEMQ(v,cat) then
-	mem := true
-	havevars := cons(s,havevars)
-    if not mem then haventvars := cons(s,haventvars)
-  null havevars => st
-  st := nreverse nconc(haventvars,havevars)
-  SORT(st, function mmCatComp)
-
-mmCatComp(c1, c2) ==
-  b1 := ASSQ(CADR c1, $Subst)
-  b2 := ASSQ(CADR c2, $Subst)
-  b1 and null(b2) => true
-  false
-
-evalMmCat(op,sig,stack,SL) ==
-  -- evaluates all ofCategory's of stack as soon as possible
-  $hope:local:= NIL
-  numConds:= #stack
-  stack:= orderMmCatStack [mmC for mmC in stack | EQCAR(mmC,'ofCategory)]
-  while stack until not makingProgress repeat
-    st := stack
-    stack := NIL
-    makingProgress := NIL
-    for mmC in st repeat
-      S:= evalMmCat1(mmC,op, SL)
-      S='failed and $hope =>
-	stack:= CONS(mmC,stack)
-      S = 'failed => return S
-      not atom S =>
-	makingProgress:= 'T
-	SL:= mergeSubs(S,SL)
-  if stack or S='failed then 'failed else SL
-
-evalMmCat1(mmC is ['ofCategory,d,c],op, SL) ==
-  -- evaluates mmC using information from the lisplib
-  -- d may contain variables, and the substitution list $Subst is used
-  -- the result is a substitution or failed
-  $domPvar: local := NIL
-  $hope:= NIL
-  NSL:= hasCate(d,c,SL)
-  NSL='failed and isPatternVar d and $Coerce and ( p:= ASSQ(d,$Subst) )
-    and (EQCAR(CDR p,'Variable) or EQCAR(CDR p,'Symbol)) =>
-      RPLACD(p,getSymbolType d)
-      hasCate(d,c,SL)
-  NSL='failed and isPatternVar d =>
-    -- following is hack to take care of the case where we have a
-    -- free substitution variable with a category condition on it.
-    -- This would arise, for example, where a package has an argument
-    -- that is not in a needed modemap.	 After making the following
-    -- dummy substitutions, the package can be instantiated and the
-    -- modemap used.	   RSS 12-22-85
-    -- If c is not Set, Ring or Field then the more general mechanism
-    dom := defaultTypeForCategory(c, SL)
-    null dom =>
-      op ^= 'coerce => 'failed -- evalMmCatLastChance(d,c,SL)
-    null (p := ASSQ(d,$Subst)) =>
-      dom =>
-	NSL := [CONS(d,dom)]
-      op ^= 'coerce => 'failed -- evalMmCatLastChance(d,c,SL)
-    if containsVars dom then dom := resolveTM(CDR p, dom)
-    $Coerce and canCoerce(CDR p, dom) =>
-      NSL := [CONS(d,dom)]
-    op ^= 'coerce => 'failed -- evalMmCatLastChance(d,c,SL)
-  NSL
-
-hasCate(dom,cat,SL) ==
-  -- asks whether dom has cat under SL
-  -- augments substitution SL or returns 'failed
-  dom = $EmptyMode => NIL
-  isPatternVar dom =>
-    (p:= ASSQ(dom,SL)) and ((NSL := hasCate(CDR p,cat,SL)) ^= 'failed) =>
-       NSL
-    (p:= ASSQ(dom,$Subst)) or (p := ASSQ(dom, SL)) =>
---	S:= hasCate(CDR p,cat,augmentSub(CAR p,CDR p,copy SL))
-      S:= hasCate1(CDR p,cat,SL, dom)
-      not (S='failed) => S
-      hasCateSpecial(dom,CDR p,cat,SL)
-    if SL ^= 'failed then $hope:= 'T
-    'failed
-  SL1 := [[v,:d] for [v,:d] in SL | not containsVariables d]
-  if SL1 then cat := subCopy(cat, SL1)
-  hasCaty(dom,cat,SL)
-
-hasCate1(dom, cat, SL, domPvar) ==
-  $domPvar:local := domPvar
-  hasCate(dom, cat, SL)
-
-hasCateSpecial(v,dom,cat,SL) ==
-  -- v is a pattern variable, dom it's binding under $Subst
-  -- tries to change dom, so that it has category cat under SL
-  -- the result is a substitution list or 'failed
-  dom is ['FactoredForm,arg] =>
-    if isSubDomain(arg,$Integer) then arg := $Integer
-    d := ['FactoredRing,arg]
-    SL:= hasCate(arg,'(Ring),augmentSub(v,d,SL))
-    SL = 'failed => 'failed
-    hasCaty(d,cat,SL)
-  EQCAR(cat,'Field) or EQCAR(cat, 'DivisionRing) =>
-    if isSubDomain(dom,$Integer) then dom := $Integer
-    d:= eqType [$QuotientField, dom]
-    hasCaty(dom,'(IntegralDomain),augmentSub(v,d,SL))
-  cat is ['PolynomialCategory, d, :.] =>
-    dom' := ['Polynomial, d]
-    (containsVars d or canCoerceFrom(dom, dom'))
-       and hasCaty(dom', cat, augmentSub(v,dom',SL))
-  isSubDomain(dom,$Integer) =>
-    NSL:= hasCate($Integer,cat,augmentSub(v,$Integer,SL))
-    NSL = 'failed =>
-      hasCateSpecialNew(v, dom, cat, SL)
-    hasCaty($Integer,cat,NSL)
-  hasCateSpecialNew(v, dom, cat, SL)
-
--- to be used in $newSystem only
-hasCateSpecialNew(v,dom,cat,SL) ==
-  fe := member(QCAR cat, '(ElementaryFunctionCategory
-       TrigonometricFunctionCategory ArcTrigonometricFunctionCategory
-	HyperbolicFunctionCategory ArcHyperbolicFunctionCategory
-	 PrimitiveFunctionCategory SpecialFunctionCategory Evalable
-	  CombinatorialOpsCategory TranscendentalFunctionCategory
-	   AlgebraicallyClosedFunctionSpace ExpressionSpace
-	     LiouvillianFunctionCategory FunctionSpace))
-  alg := member(QCAR cat, '(RadicalCategory AlgebraicallyClosedField))
-  fefull := fe or alg or EQCAR(cat, 'CombinatorialFunctionCategory)
-  partialResult :=
-    EQCAR(dom, 'Variable) or EQCAR(dom, 'Symbol) =>
-      CAR(cat) in
-       '(SemiGroup AbelianSemiGroup Monoid AbelianGroup AbelianMonoid
-         PartialDifferentialRing Ring InputForm) =>
-        	d := ['Polynomial, $Integer]
-        	augmentSub(v, d, SL)
-      EQCAR(cat, 'Group) =>
-        d := ['Fraction, ['Polynomial, $Integer]]
-        augmentSub(v, d, SL)
-      fefull =>
-        d := defaultTargetFE dom
-        augmentSub(v, d, SL)
-      'failed
-    isEqualOrSubDomain(dom, $Integer) =>
-      fe =>
-        d := defaultTargetFE $Integer
-        augmentSub(v, d, SL)
-      alg =>
-        d := '(AlgebraicNumber)
-        --d := defaultTargetFE $Integer
-        augmentSub(v, d, SL)
-      'failed
-    underDomainOf dom = $ComplexInteger =>
-      d := defaultTargetFE $ComplexInteger
-      hasCaty(d,cat,augmentSub(v, d, SL))
-    (dom = $RationalNumber) and alg =>
-      d := '(AlgebraicNumber)
-      --d := defaultTargetFE $Integer
-      augmentSub(v, d, SL)
-    fefull =>
-      d := defaultTargetFE dom
-      augmentSub(v, d, SL)
-    'failed
-  partialResult = 'failed => 'failed
-  hasCaty(d, cat, partialResult)
-
-hasCaty(d,cat,SL) ==
-  -- calls hasCat, which looks up a hashtable and returns:
-  -- 1. T, NIL or a (has x1 x2) condition, if cat is not parameterized
-  -- 2. a list of pairs (argument to cat,condition) otherwise
-  -- then the substitution SL is augmented, or the result is 'failed
-  cat is ['CATEGORY,.,:y] => hasAttSig(d,subCopy(y,constructSubst d),SL)
-  cat is ['SIGNATURE,foo,sig] =>
-    hasSig(d,foo,subCopy(sig,constructSubst d),SL)
-  cat is ['ATTRIBUTE,a] => hasAtt(d,subCopy(a,constructSubst d),SL)
-  x:= hasCat(opOf d,opOf cat) =>
-    y:= KDR cat =>
-      S	 := constructSubst d
-      for [z,:cond] in x until not (S1='failed) repeat
-	S' := [[p, :mkDomPvar(p, d, z, y)] for [p,:d] in S]
-	if $domPvar then
-	  dom := [CAR d, :[domArg(arg, i, z, y) for i in 0..
-			   for arg in CDR d]]
-	  SL := augmentSub($domPvar, dom, copy SL)
-	z' := [domArg2(a, S, S') for a in z]
-	S1:= unifyStruct(y,z',copy SL)
-	if not (S1='failed) then S1:=
-	  atom cond => S1
-	  ncond := subCopy(cond, S)
-	  ncond is ['has, =d, =cat] => 'failed
-	  hasCaty1(ncond,S1)
-      S1
-    atom x => SL
-    ncond := subCopy(x, constructSubst d)
-    ncond is ['has, =d, =cat] => 'failed
-    hasCaty1(ncond, SL)
-  'failed
-
-mkDomPvar(p, d, subs, y) ==
-  l := MEMQ(p, $FormalMapVariableList) =>
-    domArg(d, #$FormalMapVariableList - #l, subs, y)
-  d
-
-domArg(type, i, subs, y) ==
-  p := MEMQ($FormalMapVariableList.i, subs) =>
-    y.(#subs - #p)
-  type
-
-domArg2(arg, SL1, SL2) ==
-  isSharpVar arg => subCopy(arg, SL1)
-  arg = '_$ and $domPvar => $domPvar
-  subCopy(arg, SL2)
-
-hasCaty1(cond,SL) ==
-  -- cond is either a (has a b) or an OR clause of such conditions
-  -- SL is augmented, if cond is true, otherwise the result is 'failed
-  $domPvar: local := NIL
-  cond is ['has,a,b] => hasCate(a,b,SL)
-  cond is ['AND,:args] =>
-    for x in args while not (S='failed) repeat S:=
-      x is ['has,a,b] => hasCate(a,b, SL)
-      -- next line is for an obscure bug in the table
-      x is [['has,a,b]] => hasCate(a,b, SL)
-      --'failed
-      hasCaty1(x, SL)
-    S
-  cond is ['OR,:args] =>
-    for x in args until not (S='failed) repeat S:=
-      x is ['has,a,b] => hasCate(a,b,copy SL)
-      -- next line is for an obscure bug in the table
-      x is [['has,a,b]] => hasCate(a,b,copy SL)
-      --'failed
-      hasCaty1(x, copy SL)
-    S
-  keyedSystemError("S2GE0016",
-    ['"hasCaty1",'"unexpected condition from category table"])
-
-hasAttSig(d,x,SL) ==
-  -- d is domain, x a list of attributes and signatures
-  -- the result is an augmented SL, if d has x, 'failed otherwise
-  for y in x until SL='failed repeat SL:=
-    y is ['ATTRIBUTE,a] => hasAtt(d,a,SL)
-    y is ['SIGNATURE,foo,s] => hasSig(d,foo,s,SL)
-    keyedSystemError("S2GE0016",
-      ['"hasAttSig",'"unexpected form of unnamed category"])
-  SL
-
-hasSigAnd(andCls, S0, SL) ==
-  dead := NIL
-  SA := 'failed
-  for cls in andCls while not dead repeat
-    SA :=
-      atom cls => copy SL
-      cls is ['has,a,b] =>
-	hasCate(subCopy(a,S0),subCopy(b,S0),copy SL)
-      keyedSystemError("S2GE0016",
-	['"hasSigAnd",'"unexpected condition for signature"])
-    if SA = 'failed then dead := true
-  SA
-
-hasSigOr(orCls, S0, SL) ==
-  found := NIL
-  SA := 'failed
-  for cls in orCls until found repeat
-    SA :=
-      atom cls => copy SL
-      cls is ['has,a,b] =>
-	hasCate(subCopy(a,S0),subCopy(b,S0),copy SL)
-      cls is ['AND,:andCls] or cls is ['and,:andCls] =>
-	hasSigAnd(andCls, S0, SL)
-      keyedSystemError("S2GE0016",
-	['"hasSigOr",'"unexpected condition for signature"])
-    if SA ^= 'failed then found := true
-  SA
-
-hasSig(dom,foo,sig,SL) ==
-  -- tests whether domain dom has function foo with signature sig
-  -- under substitution SL
-  $domPvar: local := nil
-  fun:= constructor? CAR dom =>
-    S0:= constructSubst dom
-    p := ASSQ(foo,getOperationAlistFromLisplib CAR dom) =>
-      for [x,.,cond,.] in CDR p until not (S='failed) repeat
-	S:=
-	  atom cond => copy SL
-	  cond is ['has,a,b] =>
-	    hasCate(subCopy(a,S0),subCopy(b,S0),copy SL)
-	  cond is ['AND,:andCls] or cond is ['and,:andCls] =>
-	    hasSigAnd(andCls, S0, SL)
-	  cond is ['OR,:orCls] or cond is ['or,:orCls] =>
-	    hasSigOr(orCls, S0, SL)
-	  keyedSystemError("S2GE0016",
-	     ['"hasSig",'"unexpected condition for signature"])
-	not (S='failed) => S:= unifyStruct(subCopy(x,S0),sig,S)
-      S
-    'failed
-  'failed
-
-hasAtt(dom,att,SL) ==
-  -- tests whether dom has attribute att under SL
-  -- needs S0 similar to hasSig above ??
-  $domPvar: local := nil
-  fun:= CAR dom =>
-    atts:= subCopy(GETDATABASE(fun,'ATTRIBUTES),constructSubst dom) =>
-      PAIRP (u := getInfovec CAR dom) =>
-	--UGH! New world has attributes stored as pairs not as lists!!
-	for [x,:cond] in atts until not (S='failed) repeat
-	  S:= unifyStruct(x,att,copy SL)
-	  not atom cond and not (S='failed) => S := hasCatExpression(cond,S)
-	S
-      for [x,cond] in atts until not (S='failed) repeat
-	S:= unifyStruct(x,att,copy SL)
-	not atom cond and not (S='failed) => S := hasCatExpression(cond,S)
-      S
-    'failed
-  'failed
-
-hasCatExpression(cond,SL) ==
-  cond is ["OR",:l] =>
-    or/[(y:=hasCatExpression(x,SL)) ^= 'failed for x in l] => y
-  cond is ["AND",:l] =>
-    and/[(SL:= hasCatExpression(x,SL)) ^= 'failed for x in l] => SL
-  cond is ["has",a,b] => hasCate(a,b,SL)
-  keyedSystemError("S2GE0016",
-    ['"hasSig",'"unexpected condition for attribute"])
-
-unifyStruct(s1,s2,SL) ==
-  -- tests for equality of s1 and s2 under substitutions SL and $Subst
-  -- the result is a substitution list or 'failed
-  s1=s2 => SL
-  if s1 is [":",x,.] then s1:= x
-  if s2 is [":",x,.] then s2:= x
-  if ^atom s1 and CAR s1 = '_# then s1:= LENGTH CADR s1
-  if ^atom s2 and CAR s2 = '_# then s2:= LENGTH CADR s2
-  s1=s2 => SL
-  isPatternVar s1 => unifyStructVar(s1,s2,SL)
-  isPatternVar s2 => unifyStructVar(s2,s1,SL)
-  atom s1 or atom s2 => 'failed
-  until null s1 or null s2 or SL='failed repeat
-    SL:= unifyStruct(CAR s1,CAR s2,SL)
-    s1:= CDR s1
-    s2:= CDR s2
-  s1 or s2 => 'failed
-  SL
-
-unifyStructVar(v,s,SL) ==
-  -- the first argument is a pattern variable, which is not substituted
-  -- by SL
-  CONTAINED(v,s) => 'failed
-  ps := LASSOC(s, SL)
-  s1 := (ps => ps; s)
-  (s0 := LASSOC(v, SL)) or (s0 := LASSOC(v,$Subst)) =>
-    S:= unifyStruct(s0,s1,copy SL)
-    S='failed =>
-      $Coerce and not atom s0 and constructor? CAR s0 =>
-	containsVars s0 or containsVars s1 =>
-	  ns0 := subCopy(s0, SL)
-	  ns1 := subCopy(s1, SL)
-	  containsVars ns0 or containsVars ns1 =>
-	    $hope:= 'T
-	    'failed
-	  if canCoerce(ns0, ns1) then s3 := s1
-	  else if canCoerce(ns1, ns0) then s3 := s0
-	  else s3 := nil
-	  s3 =>
-	    if (s3 ^= s0) then SL := augmentSub(v,s3,SL)
-	    if (s3 ^= s1) and isPatternVar(s) then SL := augmentSub(s,s3,SL)
-	    SL
-	  'failed
-	$domPvar =>
-	  s3 := resolveTT(s0,s1)
-	  s3 =>
-	    if (s3 ^= s0) then SL := augmentSub(v,s3,SL)
-	    if (s3 ^= s1) and isPatternVar(s) then SL := augmentSub(s,s3,SL)
-	    SL
-	  'failed
---	  isSubDomain(s,s0) => augmentSub(v,s0,SL)
-	'failed
-      'failed
-    augmentSub(v,s,S)
-  augmentSub(v,s,SL)
-
-ofCategory(dom,cat) ==
-  -- entry point to category evaluation from other points than type
-  --   analysis
-  -- the result is true or NIL
-  $Subst:local:= NIL
-  $hope:local := NIL
-  IDENTP dom => NIL
-  cat is ['Join,:cats] => and/[ofCategory(dom,c) for c in cats]
-  (hasCaty(dom,cat,NIL) ^= 'failed)
-
-printMms(mmS) ==
-  -- mmS a list of modemap signatures
-  sayMSG '" "
-  for [sig,imp,.] in mmS for i in 1.. repeat
-    istr := STRCONC('"[",STRINGIMAGE i,'"]")
-    if QCSIZE(istr) = 3 then istr := STRCONC(istr,'" ")
-    sayMSG [:bright istr,'"signature:   ",:formatSignature CDR sig]
-    CAR sig='local =>
-      sayMSG ['"      implemented: local function ",imp]
-    imp is ['XLAM,:.] =>
-      sayMSG concat('"      implemented: XLAM from ",
-	prefix2String CAR sig)
-    sayMSG concat('"      implemented: slot ",imp,
-      '" from ",prefix2String CAR sig)
-  sayMSG '" "
-
-containsVars(t) ==
-  -- tests whether term t contains a * variable
-  atom t => isPatternVar t
-  containsVars1(t)
-
-containsVars1(t) ==
-  -- recursive version, which works on a list
-  [t1,:t2]:= t
-  atom t1 =>
-    isPatternVar t1 or
-      atom t2 => isPatternVar t2
-      containsVars1(t2)
-  containsVars1(t1) or
-    atom t2 => isPatternVar t2
-    containsVars1(t2)
-
-<<isPartialMode>>
-
-getSymbolType var ==
--- var is a pattern variable
-  p:= ASSQ(var,$SymbolType) => CDR p
-  t:= '(Polynomial (Integer))
-  $SymbolType:= CONS(CONS(var,t),$SymbolType)
-  t
-
-isEqualOrSubDomain(d1,d2) ==
-  -- last 2 parts are for tagged unions (hack for now, RSS)
-  (d1=d2) or isSubDomain(d1,d2) or
-    (atom(d1) and ((d2 is ['Variable,=d1]) or (d2 is [=d1])))
-     or (atom(d2) and ((d1 is ['Variable,=d2]) or (d1 is [=d2])))
-
-defaultTypeForCategory(cat, SL) ==
-  -- this function returns a domain belonging to cat
-  -- note that it is important to note that in some contexts one
-  -- might not want to use this result. For example, evalMmCat1
-  -- calls this and should possibly fail in some cases.
-  cat := subCopy(cat, SL)
-  c := CAR cat
-  d := GETDATABASE(c, 'DEFAULTDOMAIN)
-  d => [d, :CDR cat]
-  cat is [c] =>
-    c = 'Field => $RationalNumber
-    c in '(Ring IntegralDomain EuclideanDomain GcdDomain
-      OrderedRing DifferentialRing) => '(Integer)
-    c = 'OrderedSet => $Symbol
-    c = 'FloatingPointSystem => '(Float)
-    NIL
-  cat is [c,p1] =>
-    c = 'FiniteLinearAggregate => ['Vector, p1]
-    c = 'VectorCategory => ['Vector, p1]
-    c = 'SetAggregate => ['Set, p1]
-    c = 'SegmentCategory => ['Segment, p1]
-    NIL
-  cat is [c,p1,p2] =>
-    NIL
-  cat is [c,p1,p2,p3] =>
-    cat is ['MatrixCategory, d, ['Vector, =d], ['Vector, =d]] =>
-      ['Matrix, d]
-    NIL
-  NIL
-
-
-@
-\eject
-\begin{thebibliography}{99}
-\bibitem{1} nothing
-\end{thebibliography}
-\end{document}