* interp/apply.boot: Move content to compiler.boot. Remove.

	* interp/Makefile.pamphlet (OCOBJS): Remove apply.$(OBJEXT).

5 files changed, 277 insertions, 305 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index e28e5c9a..02b9f1e0 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,10 @@
 2008-08-07  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
+	* interp/apply.boot: Move content to compiler.boot.  Remove.
+	* interp/Makefile.pamphlet (OCOBJS): Remove apply.$(OBJEXT).
+
+2008-08-07  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
 	* lisp/core.lisp.in (boot-completed-p): New.
 	(|$useDynamicLink|): Likewise.
 	(|$effectiveFaslType|): Hold extension of linkable FASL.
diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
index ba30803f..6d561733 100644
--- a/src/interp/Makefile.in
+++ b/src/interp/Makefile.in
@@ -102,7 +102,7 @@ OCOBJS=	\
 	info.$(FASLEXT)		modemap.$(FASLEXT)	\
 	category.$(FASLEXT)	define.$(FASLEXT)	\
 	iterator.$(FASLEXT)	compiler.$(FASLEXT)	\
-	apply.$(FASLEXT)	c-doc.$(FASLEXT)	\
+	c-doc.$(FASLEXT)	\
 	profile.$(FASLEXT)	functor.$(FASLEXT)	\
 	nruncomp.$(FASLEXT)	package.$(FASLEXT)	\
 	htcheck.$(FASLEXT)
@@ -330,7 +330,6 @@ setvart.$(FASLEXT): macros.$(FASLEXT)
 ## OpenAxiom's compiler
 wi2.$(FASLEXT): macros.$(FASLEXT) define.$(FASLEXT)
 wi1.$(FASLEXT): macros.$(FASLEXT)
-apply.$(FASLEXT): compiler.$(FASLEXT)
 compiler.$(FASLEXT): c-util.$(FASLEXT) modemap.$(FASLEXT) \
 		pathname.$(FASLEXT) define.$(FASLEXT) iterator.$(FASLEXT)
 nrunopt.$(FASLEXT): c-util.$(FASLEXT)
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet
index f7aa8afe..a9ab12ce 100644
--- a/src/interp/Makefile.pamphlet
+++ b/src/interp/Makefile.pamphlet
@@ -220,7 +220,7 @@ OCOBJS=	\
 	info.$(FASLEXT)		modemap.$(FASLEXT)	\
 	category.$(FASLEXT)	define.$(FASLEXT)	\
 	iterator.$(FASLEXT)	compiler.$(FASLEXT)	\
-	apply.$(FASLEXT)	c-doc.$(FASLEXT)	\
+	c-doc.$(FASLEXT)	\
 	profile.$(FASLEXT)	functor.$(FASLEXT)	\
 	nruncomp.$(FASLEXT)	package.$(FASLEXT)	\
 	htcheck.$(FASLEXT)
@@ -618,7 +618,6 @@ setvart.$(FASLEXT): macros.$(FASLEXT)
 ## OpenAxiom's compiler
 wi2.$(FASLEXT): macros.$(FASLEXT) define.$(FASLEXT)
 wi1.$(FASLEXT): macros.$(FASLEXT)
-apply.$(FASLEXT): compiler.$(FASLEXT)
 compiler.$(FASLEXT): c-util.$(FASLEXT) modemap.$(FASLEXT) \
 		pathname.$(FASLEXT) define.$(FASLEXT) iterator.$(FASLEXT)
 nrunopt.$(FASLEXT): c-util.$(FASLEXT)
diff --git a/src/interp/apply.boot b/src/interp/apply.boot
deleted file mode 100644
index 942f102c..00000000
--- a/src/interp/apply.boot
+++ /dev/null
@@ -1,270 +0,0 @@
--- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
--- All rights reserved.
--- 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.
-
-
-import compiler
-namespace BOOT
-
-compAtomWithModemap: (%Form,%Mode,%Env,%Thing) -> %Maybe %Triple
-compAtomWithModemap(x,m,e,v) ==
-  Tl :=
-    [[transImplementation(x,map,fn),target,e]
-      for map in v | map is [[.,target],[.,fn]]] =>
-                                         --accept only monadic operators
-        T:= or/[t for (t:= [.,target,.]) in Tl | modeEqual(m,target)] => T
-        1=#(Tl:= [y for t in Tl | (y:= convert(t,m))]) => first Tl
-        0<#Tl and m=$NoValueMode => first Tl
-        nil
-
-transImplementation: (%Form,%Modemap,%Thing) -> %Code
-transImplementation(op,map,fn) ==
-  fn := genDeltaEntry [op,:map]
-  fn is ["XLAM",:.] => [fn]
-  ["call",fn]
-
-compApply: (%List,%List,%Thing,%List,%Mode,%Env) -> %Maybe %Triple
-compApply(sig,varl,body,argl,m,e) ==
-  argTl:= [[.,.,e]:= comp(x,$EmptyMode,e) for x in argl]
-  contour:=
-    [Pair(x,[["mode",m'],["value",removeEnv comp(a,m',e)]])
-      for x in varl for m' in sig.source for a in argl]
-  code:= [["LAMBDA",varl,body'],:[T.expr for T in argTl]]
-  m':= resolve(m,sig.target)
-  body':= (comp(body,m',addContour(contour,e))).expr
-  [code,m',e]
-
-compToApply: (%Form,%List,%Mode,%Env) -> %Maybe %Triple
-compToApply(op,argl,m,e) ==
-  T:= compNoStacking(op,$EmptyMode,e) or return nil
-  m1:= T.mode
-  T.expr is ["QUOTE", =m1] => nil
-  compApplication(op,argl,m,T.env,T)
-
-compApplication: (%Form,%List,%Mode,%Env,%Triple) -> %Maybe %Triple
-compApplication(op,argl,m,e,T) ==
-  T.mode is ['Mapping, retm, :argml] =>
-    #argl ^= #argml => nil
-    retm := resolve(m, retm)
-    retm = $Category or isCategoryForm(retm,e) => nil  -- not handled
-    argTl := [[.,.,e] := comp(x,m,e) or return "failed"
-              for x in argl for m in argml]
-    argTl = "failed" => nil
-    form:=
-      not (member(op,$formalArgList) or member(T.expr,$formalArgList)) and ATOM T.expr =>
-        nprefix := $prefix or
-        -- following needed for referencing local funs at capsule level
-           getAbbreviation($op,#rest $form)
-        [op',:[a.expr for a in argTl],"$"] where
-          op':= INTERN STRCONC(encodeItem nprefix,";",encodeItem T.expr)
-      ['call, ['applyFun, T.expr], :[a.expr for a in argTl]]
-    coerce([form, retm, e],resolve(retm,m))
-  op = 'elt => nil
-  eltForm := ['elt, op, :argl]
-  comp(eltForm, m, e)
-
-++ `form' is a call to a operation described by the signature `sig'.
-++ Massage the call so that homogeneous variable length argument lists
-++ are properly tuplified.
-reshapeArgumentList: (%Form,%Signature) -> %Form
-reshapeArgumentList(form,sig) ==
-  [op,:args] := form
-  wantArgumentsAsTuple(args,sig) => [op,["%Comma",:args]]
-  form
-
-compFormWithModemap: (%Form,%Mode,%Env,%Modemap) -> %Maybe %Triple
-compFormWithModemap(form,m,e,modemap) ==
-  [map:= [.,target,:sig],[pred,impl]]:= modemap
-  [op,:argl] := form := reshapeArgumentList(form,sig)
-  if isCategoryForm(target,e) and isFunctor op then
-    [modemap,e]:= substituteIntoFunctorModemap(argl,modemap,e) or return nil
-    [map:= [.,target,:.],:cexpr]:= modemap
-  sv:=listOfSharpVars map
-  if sv then
-     -- SAY [ "compiling ", op, " in compFormWithModemap,
-     -- mode= ",map," sharp vars=",sv]
-    for x in argl for ss in $FormalMapVariableList repeat
-      if ss in sv then
-        [map:= [.,target,:.],:cexpr]:= modemap :=SUBST(x,ss,modemap)
-        -- SAY ["new map is",map]
-  not (target':= coerceable(target,m,e)) => nil
-  map:= [target',:rest map]
-  [f,Tl,sl]:= compApplyModemap(form,modemap,e,nil) or return nil
-
-  --generate code; return
-  T:=
-    [x',m',e'] where
-      m':= SUBLIS(sl,map.(1))
-      x':=
-        form':= [f,:[t.expr for t in Tl]]
-        m'=$Category or isCategoryForm(m',e) => form'
-        -- try to deal with new-style Unions where we know the conditions
-        op = "elt" and f is ['XLAM,:.] and IDENTP(z:=CAR argl) and
-          (c:=get(z,'condition,e)) and
-            c is [["case",=z,c1]] and
-              (c1 is [":",=(CADR argl),=m] or EQ(c1,CADR argl) ) =>
--- first is a full tag, as placed by getInverseEnvironment
--- second is what getSuccessEnvironment will place there
-                ["CDR",z]
-        ["call",:form']
-      e':=
-        Tl => (LAST Tl).env
-        e
-  convert(T,m)
-
--- This version tends to give problems with #1 and categories
--- applyMapping([op,:argl],m,e,ml) ==
---   #argl^=#ml-1 => nil
---   mappingHasCategoryTarget :=
---     isCategoryForm(first ml,e) => --is op a functor?
---       form:= [op,:argl']
---       pairlis:= [[v,:a] for a in argl for v in $FormalMapVariableList]
---       ml:= SUBLIS(pairlis,ml)
---       true
---     false
---   argl':=
---     [T.expr for x in argl for m' in rest ml] where
---       T() == [.,.,e]:= comp(x,m',e) or return "failed"
---   if argl'="failed" then return nil
---   mappingHasCategoryTarget => convert([form,first ml,e],m)
---   form:=
---     not member(op,$formalArgList) and ATOM op =>
---       [op',:argl',"$"] where
---         op':= INTERN STRCONC(STRINGIMAGE $prefix,";",STRINGIMAGE op)
---     ["call",["applyFun",op],:argl']
---   pairlis:= [[v,:a] for a in argl' for v in $FormalMapVariableList]
---   convert([form,SUBLIS(pairlis,first ml),e],m)
-
-applyMapping: (%Form,%Mode,%Env,%List) -> %Maybe %Triple
-applyMapping([op,:argl],m,e,ml) ==
-  #argl^=#ml-1 => nil
-  isCategoryForm(first ml,e) =>
-                                --is op a functor?
-    pairlis:= [[v,:a] for a in argl for v in $FormalMapVariableList]
-    ml' := SUBLIS(pairlis, ml)
-    argl':=
-      [T.expr for x in argl for m' in rest ml'] where
-        T() == [.,.,e]:= comp(x,m',e) or return "failed"
-    if argl'="failed" then return nil
-    form:= [op,:argl']
-    convert([form,first ml',e],m)
-  argl':=
-    [T.expr for x in argl for m' in rest ml] where
-      T() == [.,.,e]:= comp(x,m',e) or return "failed"
-  if argl'="failed" then return nil
-  form:=
-    not member(op,$formalArgList) and ATOM op and not get(op,'value,e) =>
-      nprefix := $prefix or
-   -- following needed for referencing local funs at capsule level
-        getAbbreviation($op,#rest $form)
-      [op',:argl',"$"] where
-        op':= INTERN STRCONC(encodeItem nprefix,";",encodeItem op)
-    ['call,['applyFun,op],:argl']
-  pairlis:= [[v,:a] for a in argl' for v in $FormalMapVariableList]
-  convert([form,SUBLIS(pairlis,first ml),e],m)
-
---% APPLY MODEMAPS
-
-compApplyModemap: (%Form,%Modemap,%Env,%List) -> %Maybe %Triple
-compApplyModemap(form,modemap,$e,sl) ==
-  [op,:argl] := form                   --form to be compiled
-  [[mc,mr,:margl],:fnsel] := modemap   --modemap we are testing
-
-  -- $e     is the current environment
-  -- sl     substitution list, nil means bottom-up, otherwise top-down
-
-  -- 0.  fail immediately if #argl=#margl
-
-  if #argl^=#margl then return nil
-
-  -- 1.  use modemap to evaluate arguments, returning failed if
-  --     not possible
-
-  lt:=
-    [[.,m',$e]:=
-      comp(y,g,$e) or return "failed" where
-        g:= SUBLIS(sl,m) where
-            sl:= pmatchWithSl(m',m,sl) for y in argl for m in margl]
-  lt="failed" => return nil
-
-  -- 2.  coerce each argument to final domain, returning failed
-  --     if not possible
-
-  lt':= [coerce(y,d) or return "failed"
-         for y in lt for d in SUBLIS(sl,margl)]
-  lt'="failed" => return nil
-
-  -- 3.  obtain domain-specific function, if possible, and return
-
-  --$bindings is bound by compMapCond
-  [f,$bindings]:= compMapCond(op,mc,sl,fnsel) or return nil
-
---+ can no longer trust what the modemap says for a reference into
---+ an exterior domain (it is calculating the displacement based on view
---+ information which is no longer valid; thus ignore this index and
---+ store the signature instead.
-
-  f is [op1,d,.] and member(op1,'(ELT CONST Subsumed)) =>
-    [genDeltaEntry [op,:modemap],lt',$bindings]
-  [f,lt',$bindings]
-
-compMapCond: (%Symbol,%Mode,%Env,%List) -> %Code
-compMapCond(op,mc,$bindings,fnsel) ==
-  or/[compMapCond'(u,op,mc,$bindings) for u in fnsel]
-
-compMapCond': (%List,%Symbol,%Mode,%Env) -> %Code
-compMapCond'([cexpr,fnexpr],op,dc,bindings) ==
-  compMapCond''(cexpr,dc) => compMapCondFun(fnexpr,op,dc,bindings)
-  stackMessage('"not known that %1pb has %2pb",[dc,cexpr])
-
-compMapCond'': (%Thing,%Mode) -> %Boolean
-compMapCond''(cexpr,dc) ==
-  cexpr=true => true
-  --cexpr = "true" => true
-  cexpr is ["AND",:l] => and/[compMapCond''(u,dc) for u in l]
-  cexpr is ["OR",:l] => or/[compMapCond''(u,dc) for u in l]
-  cexpr is ["not",u] => not compMapCond''(u,dc)
-  cexpr is ["has",name,cat] => (knownInfo cexpr => true; false)
-        --for the time being we'll stop here - shouldn't happen so far
-        --$disregardConditionIfTrue => true
-        --stackSemanticError(("not known that",'%b,name,
-        -- '%d,"has",'%b,cat,'%d),nil)
-  --now it must be an attribute
-  member(["ATTRIBUTE",dc,cexpr],get("$Information","special",$e)) => true
-  --for the time being we'll stop here - shouldn't happen so far
-  stackMessage('"not known that %1pb has %2pb",[dc,cexpr])
-  false
-
-compMapCondFun: (%Thing,%Symbol,%Mode,%Env) -> %Code
-compMapCondFun(fnexpr,op,dc,bindings) == 
-  [fnexpr,bindings]
-
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 79b5d862..4a3c4ca4 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -38,6 +38,54 @@ import modemap
 import define
 import iterator
 namespace BOOT
+module compiler where
+  coerce: (%Triple,%Mode) -> %Maybe %Triple
+  convert: (%Triple,%Mode) -> %Maybe %Triple
+  comp: (%Form,%Mode,%Env) -> %Maybe %Triple
+  compOrCroak: (%Form,%Mode,%Env) -> %Maybe %Triple
+  compCompilerPredicate: (%Form,%Env) -> %Maybe %Triple
+  checkCallingConvention: (%List,%Short) -> %SimpleArray %Short
+
+
+--% 
+compUniquely: (%Form,%Mode,%Env) -> %Maybe %Triple
+compNoStacking: (%Form,%Mode,%Env) -> %Maybe %Triple
+compNoStacking1: (%Form,%Mode,%Env,%List) -> %Maybe %Triple
+compOrCroak1: (%Form,%Mode,%Env,%Thing) -> %Maybe %Triple
+comp2: (%Form,%Mode,%Env) -> %Maybe %Triple
+comp3: (%Form,%Mode,%Env) -> %Maybe %Triple
+compExpression: (%Form,%Mode,%Env) -> %Maybe %Triple
+compAtom: (%Form,%Mode,%Env) -> %Maybe %Triple
+compSymbol: (%Form,%Mode,%Env) -> %Maybe %Triple
+compString: (%Form,%Mode,%Env) -> %Maybe %Triple
+compAtomWithModemap: (%Form,%Mode,%Env,%Thing) -> %Maybe %Triple
+compTypeOf: (%Form,%Mode,%Env) -> %Maybe %Triple
+compForm: (%Form,%Mode,%Env) -> %Maybe %Triple
+compForm1: (%Form,%Mode,%Env) -> %Maybe %Triple
+compForm2: (%Form,%Mode,%Env,%List) -> %Maybe %Triple
+compForm3: (%Form,%Mode,%Env,%List) -> %Maybe %Triple
+compArgumentsAndTryAgain: (%Form,%Mode,%Env) -> %Maybe %Triple
+compExpressionList: (%List,%Mode,%Env) -> %Maybe %Triple
+compWithMappingMode: (%Form,%Mode,%List) -> %List
+compFormMatch: (%Modemap,%List) -> %Boolean
+compFormWithModemap: (%Form,%Mode,%Env,%Modemap) -> %Maybe %Triple
+compApply: (%List,%List,%Thing,%List,%Mode,%Env) -> %Maybe %Triple
+compToApply: (%Form,%List,%Mode,%Env) -> %Maybe %Triple
+compApplication: (%Form,%List,%Mode,%Env,%Triple) -> %Maybe %Triple
+compApplyModemap: (%Form,%Modemap,%Env,%List) -> %Maybe %Triple
+
+primitiveType: %Thing -> %Mode
+hasUniqueCaseView: (%Form,%Mode,%Env) -> %Boolean
+convertOrCroak: (%Triple,%Mode) -> %Maybe %Triple
+getFormModemaps: (%Form,%Env) -> %List
+transImplementation: (%Form,%Modemap,%Thing) -> %Code
+reshapeArgumentList: (%Form,%Signature) -> %Form
+applyMapping: (%Form,%Mode,%Env,%List) -> %Maybe %Triple
+compMapCond: (%Symbol,%Mode,%Env,%List) -> %Code
+compMapCond': (%List,%Symbol,%Mode,%Env) -> %Code
+compMapCond'': (%Thing,%Mode) -> %Boolean
+compMapCondFun: (%Thing,%Symbol,%Mode,%Env) -> %Code
+
 
 ++ A list of routines for diagnostic reports.  These functions, in an
 ++ abstract sense, have type: forall T: Type . String -> T, so they
@@ -62,16 +110,13 @@ compTopLevel(x,m,e) ==
         --keep old environment after top level function defs
   compOrCroak(x,m,e)
 
-compUniquely: (%Form,%Mode,%Env) -> %Maybe %Triple
 compUniquely(x,m,e) ==
   $compUniquelyIfTrue: local:= true
   CATCH("compUniquely",comp(x,m,e))
 
-compOrCroak: (%Form,%Mode,%Env) -> %Maybe %Triple
 compOrCroak(x,m,e) == 
   compOrCroak1(x,m,e,'comp)
 
-compOrCroak1: (%Form,%Mode,%Env,%Thing) -> %Maybe %Triple
 compOrCroak1(x,m,e,compFn) ==
   fn(x,m,e,nil,nil,compFn) where
     fn(x,m,e,$compStack,$compErrorMessageStack,compFn) ==
@@ -103,7 +148,6 @@ tc() ==
 ++ The form `x' is intended to be evaluated by the compiler, e.g. in
 ++ toplevel conditional definition or as sub-domain predicate.  
 ++ Normalize operators and compile the form.
-compCompilerPredicate: (%Form,%Env) -> %Maybe %Triple
 compCompilerPredicate(x,e) ==
   savedNormalizeTree := $normalizeTree
   $normalizeTree := true
@@ -112,13 +156,11 @@ compCompilerPredicate(x,e) ==
   t
 
 
-comp: (%Form,%Mode,%Env) -> %Maybe %Triple
 comp(x,m,e) ==
   T:= compNoStacking(x,m,e) => ($compStack:= nil; T)
   $compStack:= [[x,m,e,$exitModeStack],:$compStack]
   nil
 
-compNoStacking: (%Form,%Mode,%Env) -> %Maybe %Triple
 compNoStacking(x,m,e) ==
   T:= comp2(x,m,e) =>
     $useRepresentationHack and m=$EmptyMode and T.mode=$Representation => 
@@ -131,13 +173,11 @@ compNoStacking(x,m,e) ==
     --hack only when `Rep' is defined the old way. -- gdr 2008/01/26
   compNoStacking1(x,m,e,$compStack)
 
-compNoStacking1: (%Form,%Mode,%Env,%List) -> %Maybe %Triple
 compNoStacking1(x,m,e,$compStack) ==
   u:= get(RepIfRepHack m,"value",e) =>
     (T:= comp2(x,u.expr,e) => [T.expr,m,T.env]; nil)
   nil
 
-comp2: (%Form,%Mode,%Env) -> %Maybe %Triple
 comp2(x,m,e) ==
   [y,m',e]:= comp3(x,m,e) or return nil
   if $LISPLIB and isDomainForm(x,e) then
@@ -150,7 +190,6 @@ comp2(x,m,e) ==
         --$bootStrapMode-test necessary for compiling Ring in $bootStrapMode
   [y,m',e]
 
-comp3: (%Form,%Mode,%Env) -> %Maybe %Triple
 comp3(x,m,$e) ==
   --returns a Triple or %else nil to signalcan't do'
   $e:= addDomain(m,$e)
@@ -175,20 +214,45 @@ comp3(x,m,$e) ==
     [x',m',addDomain(m',e')]
   t
 
-compTypeOf: (%Form,%Mode,%Env) -> %Maybe %Triple
 compTypeOf(x:=[op,:argl],m,e) ==
   $insideCompTypeOf: local := true
   newModemap:= EQSUBSTLIST(argl,$FormalMapVariableList,get(op,'modemap,e))
   e:= put(op,'modemap,newModemap,e)
   comp3(x,m,e)
 
+applyMapping([op,:argl],m,e,ml) ==
+  #argl^=#ml-1 => nil
+  isCategoryForm(first ml,e) =>
+                                --is op a functor?
+    pairlis:= [[v,:a] for a in argl for v in $FormalMapVariableList]
+    ml' := SUBLIS(pairlis, ml)
+    argl':=
+      [T.expr for x in argl for m' in rest ml'] where
+        T() == [.,.,e]:= comp(x,m',e) or return "failed"
+    if argl'="failed" then return nil
+    form:= [op,:argl']
+    convert([form,first ml',e],m)
+  argl':=
+    [T.expr for x in argl for m' in rest ml] where
+      T() == [.,.,e]:= comp(x,m',e) or return "failed"
+  if argl'="failed" then return nil
+  form:=
+    not member(op,$formalArgList) and ATOM op and not get(op,'value,e) =>
+      nprefix := $prefix or
+   -- following needed for referencing local funs at capsule level
+        getAbbreviation($op,#rest $form)
+      [op',:argl',"$"] where
+        op':= INTERN STRCONC(encodeItem nprefix,";",encodeItem op)
+    ['call,['applyFun,op],:argl']
+  pairlis:= [[v,:a] for a in argl' for v in $FormalMapVariableList]
+  convert([form,SUBLIS(pairlis,first ml),e],m)
+
 hasFormalMapVariable(x, vl) ==
   $formalMapVariables: local := vl
   null vl => false
   ScanOrPairVec(function hasone?,x) where
      hasone? x == MEMQ(x,$formalMapVariables)
 
-compWithMappingMode: (%Form,%Mode,%List) -> %List
 compWithMappingMode(x,m is ["Mapping",m',:sl],oldE) ==
   $killOptimizeIfTrue: local:= true
   e:= oldE
@@ -292,7 +356,6 @@ extractCodeAndConstructTriple(u, m, oldE) ==
   [op,:.,env] := u
   [["CONS",["function",op],env],m,oldE]
 
-compExpression: (%Form,%Mode,%Env) -> %Maybe %Triple
 compExpression(x,m,e) ==
   $insideExpressionIfTrue: local:= true
   -- special forms have dedicated compilers.
@@ -300,7 +363,21 @@ compExpression(x,m,e) ==
     FUNCALL(fn,x,m,e)
   compForm(x,m,e)
 
-compAtom: (%Form,%Mode,%Env) -> %Maybe %Triple
+compAtomWithModemap(x,m,e,v) ==
+  Tl :=
+    [[transImplementation(x,map,fn),target,e]
+      for map in v | map is [[.,target],[.,fn]]] =>
+                                         --accept only monadic operators
+        T:= or/[t for (t:= [.,target,.]) in Tl | modeEqual(m,target)] => T
+        1=#(Tl:= [y for t in Tl | (y:= convert(t,m))]) => first Tl
+        0<#Tl and m=$NoValueMode => first Tl
+        nil
+
+transImplementation(op,map,fn) ==
+  fn := genDeltaEntry [op,:map]
+  fn is ["XLAM",:.] => [fn]
+  ["call",fn]
+
 compAtom(x,m,e) ==
   T:= compAtomWithModemap(x,m,e,get(x,"modemap",e)) => T
   x="nil" =>
@@ -316,7 +393,6 @@ compAtom(x,m,e) ==
     [x,primitiveType x or return nil,e]
   convert(t,m)
 
-primitiveType: %Thing -> %Mode
 primitiveType x ==
   x is nil => $EmptyMode
   STRINGP x => $String
@@ -327,7 +403,6 @@ primitiveType x ==
   FLOATP x => $DoubleFloat
   nil
 
-compSymbol: (%Form,%Mode,%Env) -> %Maybe %Triple
 compSymbol(s,m,e) ==
   s="$NoValue" => ["$NoValue",$NoValueMode,e]
   isFluid s => [s,getmode(s,e) or return nil,e]
@@ -352,7 +427,6 @@ compSymbol(s,m,e) ==
 
 ++ Return true if `m' is the most recent unique type case assumption 
 ++ on `x' that predates its declaration in environment `e'.
-hasUniqueCaseView: (%Form,%Mode,%Env) -> %Boolean
 hasUniqueCaseView(x,m,e) ==
   props := getProplist(x,e)
   for [p,:v] in props repeat
@@ -360,13 +434,11 @@ hasUniqueCaseView(x,m,e) ==
     p = "value" => return false
 
 
-convertOrCroak: (%Triple,%Mode) -> %Maybe %Triple
 convertOrCroak(T,m) ==
   u:= convert(T,m) => u
   userError ["CANNOT CONVERT: ",T.expr,"%l"," OF MODE: ",T.mode,"%l",
     " TO MODE: ",m,"%l"]
 
-convert: (%Triple,%Mode) -> %Maybe %Triple
 convert(T,m) ==
   coerce(T,resolve(T.mode,m) or return nil)
 
@@ -391,13 +463,6 @@ hasType(x,e) ==
 
 --% General Forms
 
-compForm: (%Form,%Mode,%Env) -> %Maybe %Triple
-compForm1: (%Form,%Mode,%Env) -> %Maybe %Triple
-compForm2: (%Form,%Mode,%Env,%List) -> %Maybe %Triple
-compForm3: (%Form,%Mode,%Env,%List) -> %Maybe %Triple
-compArgumentsAndTryAgain: (%Form,%Mode,%Env) -> %Maybe %Triple
-compExpressionList: (%List,%Mode,%Env) -> %Maybe %Triple
-
 compForm(form,m,e) ==
   T:=
     compForm1(form,m,e) or compArgumentsAndTryAgain(form,m,e) or return
@@ -494,7 +559,6 @@ compForm2(form is [op,:argl],m,e,modemapList) ==
 ++ We are about to compile a call.  Returns true if each argument
 ++ partially matches (as could be determined by type inference) the
 ++ corresponding expected type in the callee's modemap.
-compFormMatch: (%Modemap,%List) -> %Boolean
 compFormMatch(mm,partialModeList) == main where
   main() ==
     mm is [[.,.,:argModeList],:.] and match(argModeList,partialModeList) 
@@ -519,12 +583,75 @@ compForm3(form is [op,:argl],m,e,modemapList) ==
     T
   T
 
+
+compFormWithModemap(form,m,e,modemap) ==
+  [map:= [.,target,:sig],[pred,impl]]:= modemap
+  [op,:argl] := form := reshapeArgumentList(form,sig)
+  if isCategoryForm(target,e) and isFunctor op then
+    [modemap,e]:= substituteIntoFunctorModemap(argl,modemap,e) or return nil
+    [map:= [.,target,:.],:cexpr]:= modemap
+  sv:=listOfSharpVars map
+  if sv then
+     -- SAY [ "compiling ", op, " in compFormWithModemap,
+     -- mode= ",map," sharp vars=",sv]
+    for x in argl for ss in $FormalMapVariableList repeat
+      if ss in sv then
+        [map:= [.,target,:.],:cexpr]:= modemap :=SUBST(x,ss,modemap)
+        -- SAY ["new map is",map]
+  not (target':= coerceable(target,m,e)) => nil
+  map:= [target',:rest map]
+  [f,Tl,sl]:= compApplyModemap(form,modemap,e,nil) or return nil
+
+  --generate code; return
+  T:=
+    [x',m',e'] where
+      m':= SUBLIS(sl,map.(1))
+      x':=
+        form':= [f,:[t.expr for t in Tl]]
+        m'=$Category or isCategoryForm(m',e) => form'
+        -- try to deal with new-style Unions where we know the conditions
+        op = "elt" and f is ['XLAM,:.] and IDENTP(z:=CAR argl) and
+          (c:=get(z,'condition,e)) and
+            c is [["case",=z,c1]] and
+              (c1 is [":",=(CADR argl),=m] or EQ(c1,CADR argl) ) =>
+-- first is a full tag, as placed by getInverseEnvironment
+-- second is what getSuccessEnvironment will place there
+                ["CDR",z]
+        ["call",:form']
+      e':=
+        Tl => (LAST Tl).env
+        e
+  convert(T,m)
+
+-- This version tends to give problems with #1 and categories
+-- applyMapping([op,:argl],m,e,ml) ==
+--   #argl^=#ml-1 => nil
+--   mappingHasCategoryTarget :=
+--     isCategoryForm(first ml,e) => --is op a functor?
+--       form:= [op,:argl']
+--       pairlis:= [[v,:a] for a in argl for v in $FormalMapVariableList]
+--       ml:= SUBLIS(pairlis,ml)
+--       true
+--     false
+--   argl':=
+--     [T.expr for x in argl for m' in rest ml] where
+--       T() == [.,.,e]:= comp(x,m',e) or return "failed"
+--   if argl'="failed" then return nil
+--   mappingHasCategoryTarget => convert([form,first ml,e],m)
+--   form:=
+--     not member(op,$formalArgList) and ATOM op =>
+--       [op',:argl',"$"] where
+--         op':= INTERN STRCONC(STRINGIMAGE $prefix,";",STRINGIMAGE op)
+--     ["call",["applyFun",op],:argl']
+--   pairlis:= [[v,:a] for a in argl' for v in $FormalMapVariableList]
+--   convert([form,SUBLIS(pairlis,first ml),e],m)
+
+
 ++ Returns the list of candidate modemaps for a form.  A modemap
 ++ is candidate for a form if its signature has the same number
 ++ of paramter types as arguments supplied to the form.  A special
 ++ case is made for a modemap whose sole parameter type is a Tuple.
 ++ In that case, it matches any number of supplied arguments.
-getFormModemaps: (%Form,%Env) -> %List
 getFormModemaps(form is [op,:argl],e) ==
   op is ["elt",domain,op1] =>
     [x for x in getFormModemaps([op1,:argl],e) | x is [[ =domain,:.],:.]]
@@ -555,7 +682,6 @@ getFormModemaps(form is [op,:argl],e) ==
 ++ the same arity and must take flag argument in the same position.
 ++ Returns a vector of length `nargs' with positive entries indicating
 ++ flag arguments, and negative entries for normal argument passing.
-checkCallingConvention: (%List,%Short) -> %SimpleArray %Short
 checkCallingConvention(sigs,nargs) ==
   v := makeFilledSimpleArray("%Short",nargs,0)
   for sig in sigs repeat
@@ -585,6 +711,52 @@ seteltModemapFilter(name,mmList,e) ==
     nil
   mmList
 
+
+compApply(sig,varl,body,argl,m,e) ==
+  argTl:= [[.,.,e]:= comp(x,$EmptyMode,e) for x in argl]
+  contour:=
+    [Pair(x,[["mode",m'],["value",removeEnv comp(a,m',e)]])
+      for x in varl for m' in sig.source for a in argl]
+  code:= [["LAMBDA",varl,body'],:[T.expr for T in argTl]]
+  m':= resolve(m,sig.target)
+  body':= (comp(body,m',addContour(contour,e))).expr
+  [code,m',e]
+
+compToApply(op,argl,m,e) ==
+  T:= compNoStacking(op,$EmptyMode,e) or return nil
+  m1:= T.mode
+  T.expr is ["QUOTE", =m1] => nil
+  compApplication(op,argl,m,T.env,T)
+
+compApplication(op,argl,m,e,T) ==
+  T.mode is ['Mapping, retm, :argml] =>
+    #argl ^= #argml => nil
+    retm := resolve(m, retm)
+    retm = $Category or isCategoryForm(retm,e) => nil  -- not handled
+    argTl := [[.,.,e] := comp(x,m,e) or return "failed"
+              for x in argl for m in argml]
+    argTl = "failed" => nil
+    form:=
+      not (member(op,$formalArgList) or member(T.expr,$formalArgList)) and ATOM T.expr =>
+        nprefix := $prefix or
+        -- following needed for referencing local funs at capsule level
+           getAbbreviation($op,#rest $form)
+        [op',:[a.expr for a in argTl],"$"] where
+          op':= INTERN STRCONC(encodeItem nprefix,";",encodeItem T.expr)
+      ['call, ['applyFun, T.expr], :[a.expr for a in argTl]]
+    coerce([form, retm, e],resolve(retm,m))
+  op = 'elt => nil
+  eltForm := ['elt, op, :argl]
+  comp(eltForm, m, e)
+
+++ `form' is a call to a operation described by the signature `sig'.
+++ Massage the call so that homogeneous variable length argument lists
+++ are properly tuplified.
+reshapeArgumentList(form,sig) ==
+  [op,:args] := form
+  wantArgumentsAsTuple(args,sig) => [op,["%Comma",:args]]
+  form
+
 substituteIntoFunctorModemap(argl,modemap is [[dc,:sig],:.],e) ==
   #dc^=#sig =>
     keyedSystemError("S2GE0016",['"substituteIntoFunctorModemap",
@@ -602,7 +774,6 @@ substituteIntoFunctorModemap(argl,modemap is [[dc,:sig],:.],e) ==
 
 compConstructorCategory(x,m,e) == [x,resolve($Category,m),e]
 
-compString: (%Form,%Mode,%Env) -> %Maybe %Triple
 compString(x,m,e) == [x,resolve($StringCategory,m),e]
 
 --% SUBSET CATEGORY
@@ -1258,7 +1429,6 @@ compIs(["is",a,b],m,e) ==
 --  One should always call the correct function, since the represent-
 --  ation of basic objects may not be the same.
 
-coerce: (%Triple,%Mode) -> %Maybe %Triple
 coerce(T,m) ==
   $InteractiveMode =>
     keyedSystemError("S2GE0016",['"coerce",
@@ -1645,7 +1815,76 @@ compCat(form is [functorName,:argl],m,e) ==
   --sure if it uses any of the other signatures(see extendsCategoryForm)
   [form,catForm,e]
  
-
+--% APPLY MODEMAPS
+
+compApplyModemap(form,modemap,$e,sl) ==
+  [op,:argl] := form                   --form to be compiled
+  [[mc,mr,:margl],:fnsel] := modemap   --modemap we are testing
+
+  -- $e     is the current environment
+  -- sl     substitution list, nil means bottom-up, otherwise top-down
+
+  -- 0.  fail immediately if #argl=#margl
+
+  if #argl^=#margl then return nil
+
+  -- 1.  use modemap to evaluate arguments, returning failed if
+  --     not possible
+
+  lt:=
+    [[.,m',$e]:=
+      comp(y,g,$e) or return "failed" where
+        g:= SUBLIS(sl,m) where
+            sl:= pmatchWithSl(m',m,sl) for y in argl for m in margl]
+  lt="failed" => return nil
+
+  -- 2.  coerce each argument to final domain, returning failed
+  --     if not possible
+
+  lt':= [coerce(y,d) or return "failed"
+         for y in lt for d in SUBLIS(sl,margl)]
+  lt'="failed" => return nil
+
+  -- 3.  obtain domain-specific function, if possible, and return
+
+  --$bindings is bound by compMapCond
+  [f,$bindings]:= compMapCond(op,mc,sl,fnsel) or return nil
+
+--+ can no longer trust what the modemap says for a reference into
+--+ an exterior domain (it is calculating the displacement based on view
+--+ information which is no longer valid; thus ignore this index and
+--+ store the signature instead.
+
+  f is [op1,d,.] and member(op1,'(ELT CONST Subsumed)) =>
+    [genDeltaEntry [op,:modemap],lt',$bindings]
+  [f,lt',$bindings]
+
+compMapCond(op,mc,$bindings,fnsel) ==
+  or/[compMapCond'(u,op,mc,$bindings) for u in fnsel]
+
+compMapCond'([cexpr,fnexpr],op,dc,bindings) ==
+  compMapCond''(cexpr,dc) => compMapCondFun(fnexpr,op,dc,bindings)
+  stackMessage('"not known that %1pb has %2pb",[dc,cexpr])
+
+compMapCond''(cexpr,dc) ==
+  cexpr=true => true
+  --cexpr = "true" => true
+  cexpr is ["AND",:l] => and/[compMapCond''(u,dc) for u in l]
+  cexpr is ["OR",:l] => or/[compMapCond''(u,dc) for u in l]
+  cexpr is ["not",u] => not compMapCond''(u,dc)
+  cexpr is ["has",name,cat] => (knownInfo cexpr => true; false)
+        --for the time being we'll stop here - shouldn't happen so far
+        --$disregardConditionIfTrue => true
+        --stackSemanticError(("not known that",'%b,name,
+        -- '%d,"has",'%b,cat,'%d),nil)
+  --now it must be an attribute
+  member(["ATTRIBUTE",dc,cexpr],get("$Information","special",$e)) => true
+  --for the time being we'll stop here - shouldn't happen so far
+  stackMessage('"not known that %1pb has %2pb",[dc,cexpr])
+  false
+
+compMapCondFun(fnexpr,op,dc,bindings) == 
+  [fnexpr,bindings]
 
 --% Interface to the backend