* interp/lisplib.boot (isFunctor): Noe recognize Mapping as a functor.

	* interp/g-opt.boot (doInlineCall): Tidy one more time.
	($VMsideEffectFreeOperators): Move %aplly to $simpleVMoperators.
	(optLET): Remove as unused.
	* interp/lisp-backend.boot (expandApply): New.  Register as
	expander for %apply forms.
	* interp/define.boot (getXmode): New.
	(displayMissingFunctions): Use it instead of getmode.
	(compDefineCapsuleFunction): Likewise.
	(addDomain): Likewise.
	(getSignature): Likewise.
	(compile): Likewise.
	(compJoin): Likewise.
	* interp/compiler.boot (comp3): Likewise.
	(compWithMappingMode): Likewise.
	(applyMapping): Generate %apply form.
	(compApplication): Likewise.
	(autoCoerceByModemap): Likewise.
	(extractCodeAndConstructTriple): Handle %apply forms.
	(setqSingle): For domain variables, put corresponding macro forms
	in the environment.
	* algebra/ore.spad.pamphlet (Automorphism): Define Rep as a constant.
	Adjust; include explicit uses of rep and per.

7 files changed, 82 insertions, 117 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 44180cec..6d623e84 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,29 @@
+2011-09-11  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* interp/lisplib.boot (isFunctor): Noe recognize Mapping as a functor.
+	* interp/g-opt.boot (doInlineCall): Tidy one more time.
+	($VMsideEffectFreeOperators): Move %aplly to $simpleVMoperators.
+	(optLET): Remove as unused.
+	* interp/lisp-backend.boot (expandApply): New.  Register as
+	expander for %apply forms.
+	* interp/define.boot (getXmode): New.
+	(displayMissingFunctions): Use it instead of getmode.
+	(compDefineCapsuleFunction): Likewise.
+	(addDomain): Likewise.
+	(getSignature): Likewise.
+	(compile): Likewise.
+	(compJoin): Likewise.
+	* interp/compiler.boot (comp3): Likewise.
+	(compWithMappingMode): Likewise.
+	(applyMapping): Generate %apply form.
+	(compApplication): Likewise.
+	(autoCoerceByModemap): Likewise.
+	(extractCodeAndConstructTriple): Handle %apply forms.
+	(setqSingle): For domain variables, put corresponding macro forms
+	in the environment.
+	* algebra/ore.spad.pamphlet (Automorphism): Define Rep as a constant.
+	Adjust; include explicit uses of rep and per.
+
 2011-09-10  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	Remove IndexedList.
diff --git a/src/algebra/ore.spad.pamphlet b/src/algebra/ore.spad.pamphlet
index e55b0eee..3aaeab04 100644
--- a/src/algebra/ore.spad.pamphlet
+++ b/src/algebra/ore.spad.pamphlet
@@ -296,26 +296,25 @@ Automorphism(R:Ring): Join(Group, Eltable(R, R)) with
       morphism: ((R, Integer) -> R) -> %
         ++ morphism(f) returns the morphism given by \spad{f^n(x) = f(x,n)}.
    == add
+      Rep == (R, Integer) -> R
       err:   R -> R
       ident: (R, Integer) -> R
       iter:  (R -> R, NonNegativeInteger, R) -> R
       iterat: (R -> R, R -> R, Integer, R) -> R
-      apply: (%, R, Integer) -> R
- 
-      Rep := ((R, Integer) -> R)
- 
-      1                               == ident
+      apply: (Rep, R, Integer) -> R
+  
+      1                               == per ident
       err r                           == error "Morphism is not invertible"
       ident(r, n)                     == r
       f = g                           == %peq(f,g)$Foreign(Builtin)
-      elt(f, r)                       == apply(f, r, 1)
-      inv f                           == apply(f, #1, - #2)
-      (f: %) ** (n: Integer)          == apply(f, #1, n * #2)
+      elt(f, r)                       == apply(rep f, r, 1)
+      inv f                           == per apply(rep f, #1, - #2)
+      (f: %) ** (n: Integer)          == per apply(rep f, #1, n * #2)
       coerce(f:%):OutputForm          == message("R -> R")
-      morphism(f:(R, Integer) -> R):% == f
+      morphism(f:(R, Integer) -> R):% == per f
       morphism(f:R -> R):%            == morphism(f, err)
-      morphism(f, g)                  == iterat(f, g, #2, #1)
-      apply(f, r, n) == (g := f pretend ((R, Integer) -> R); g(r, n))
+      morphism(f, g)                  == per iterat(f, g, #2, #1)
+      apply(f, r, n) == f(r, n)
  
       iterat(f, g, n, r) ==
           negative? n => iter(g, (-n)::NonNegativeInteger, r)
@@ -327,7 +326,7 @@ Automorphism(R:Ring): Join(Group, Eltable(R, R)) with
  
       f * g ==
         f = g => f**2
-        iterat(f g #1, (inv g)(inv f) #1, #2, #1)
+        per iterat(f g #1, (inv g)(inv f) #1, #2, #1)
 
 @
 \section{package OREPCTO UnivariateSkewPolynomialCategoryOps}
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 132ab160..042421ec 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -188,7 +188,8 @@ comp3(x,m,$e) ==
      nil
   x isnt [.,:.] => compAtom(x,m,e)
   op:= x.op
-  getmode(op,e) is ["Mapping",:ml] and (u:= applyMapping(x,m,e,ml)) => u
+  ident? op and getXmode(op,e) is ["Mapping",:ml]
+    and (T := applyMapping(x,m,e,ml)) => T
   op is ":" => compColon(x,m,e)
   op is "::" => compCoerce(x,m,e)
   not $insideCompTypeOf and stringPrefix?('"TypeOf",PNAME op) =>
@@ -236,33 +237,10 @@ applyMapping([op,:argl],m,e,ml) ==
       emitLocalCallInsn(op,argl',e)
     -- Compiler synthetized operators are inline.
     u ~= nil and u.expr is ["XLAM",:.] => ['%call,u.expr,:argl']
-    ['%call,['applyFun,op],:argl']
+    ['%apply,op,:argl']
   pairlis := pairList($FormalMapVariableList,argl')
   convert([form,applySubst(pairlis,first ml),e],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:= applySubst(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 symbolMember?(op,$formalArgList) and op isnt [.,:.] =>
---       [op',:argl',"$"] where
---         op':= makeSymbol strconc(STRINGIMAGE $prefix,";",STRINGIMAGE op)
---     ['%call,["applyFun",op],:argl']
---   pairlis:= [[v,:a] for a in argl' for v in $FormalMapVariableList]
---   convert([form,applySubst(pairlis,first ml),e],m)
-
 hasFormalMapVariable(x, vl) ==
   $formalMapVariables: local := vl
   null vl => false
@@ -356,10 +334,10 @@ compWithMappingMode(x,m is ["Mapping",m',:sl],oldE) ==
   if string? x then x := makeSymbol x
   for m in sl for v in (vl:= take(#sl,$FormalMapVariableList)) repeat
     [.,.,e]:= compMakeDeclaration(v,m,e)
-  (vl ~= nil) and not hasFormalMapVariable(x, vl) => return
+  (vl ~= nil) and not hasFormalMapVariable(x, vl) =>
     [u,.,.] := comp([x,:vl],m',e) or return nil
     extractCodeAndConstructTriple(u, m, oldE)
-  null vl and (t := comp([x], m', e)) => return
+  null vl and (t := comp([x], m', e)) =>
     [u,.,.] := t
     extractCodeAndConstructTriple(u, m, oldE)
   [u,.,.]:= comp(x,m',e) or return nil
@@ -370,6 +348,7 @@ extractCodeAndConstructTriple(u, m, oldE) ==
   u is ['%call,fn,:.] =>
     if fn is ["applyFun",a] then fn := a
     [fn,m,oldE]
+  u is ['%apply,op,:.] => [op,m,oldE]
   [op,:.,env] := u
   [["CONS",["function",op],env],m,oldE]
 
@@ -694,11 +673,13 @@ compApplication(op,argl,m,T) ==
               for x in argl for m in argml]
     argTl = "failed" => nil
     form:=
-      T.expr isnt [.,:.] and 
+      args := [a.expr for a in argTl]
+      ident? T.expr and 
         not (symbolMember?(op,$formalArgList) or symbolMember?(T.expr,$formalArgList)) and
           null get(T.expr,"value",e) =>
-            emitLocalCallInsn(T.expr,[a.expr for a in argTl],e)
-      ['%call, ['applyFun, T.expr], :[a.expr for a in argTl]]
+            emitLocalCallInsn(T.expr,args,e)
+      ident? T.expr => ['%apply,T.expr,:args]
+      ['%call,['applyFun,T.expr],:args]
     coerce([form, retm, e],resolve(retm,m))
   op is 'elt => nil
   eltForm := ['elt, op, :argl]
@@ -851,6 +832,9 @@ setqSingle(id,val,m,E) ==
   if isDomainForm(val,e') then
     if isDomainInScope(id,e') then
       stackWarning('"domain valued variable %1b has been reassigned within its scope",[id])
+    -- single domains have constant values in their scopes, we might just
+    -- as well take advantage of that at compile-time where appropriate.
+    e' := put(id,'%macro,val,e')
     e':= augModemapsFromDomain1(id,val,e')
       --all we do now is to allocate a slot number for lhs
       --e.g. the %LET form below will be changed by putInLocalDomainReferences
@@ -1714,10 +1698,10 @@ coerceHard(T,m) ==
   $e: local:= T.env
   m':= T.mode
   string? m' and modeEqual(m,$String) => [T.expr,m,$e]
-  modeEqual(m',m) or
-    (get(m',"value",$e) is [m'',:.] or getmode(m',$e) is ["Mapping",m'']) and
-      modeEqual(m'',m) or
-        (get(m,"value",$e) is [m'',:.] or getmode(m,$e) is ["Mapping",m'']) and
+  modeEqual(m',m) or ident? m' and
+    (get(m',"value",$e) is [m'',:.] or getXmode(m',$e) is ["Mapping",m'']) and
+      modeEqual(m'',m) or ident? m and
+        (get(m,"value",$e) is [m'',:.] or getXmode(m,$e) is ["Mapping",m'']) and
           modeEqual(m'',m') => [T.expr,m,T.env]
   string? T.expr and T.expr=m => [T.expr,m,$e]
   isCategoryForm(m,$e) =>
@@ -1778,7 +1762,7 @@ autoCoerceByModemap: (%Maybe %Triple,%Mode) -> %Maybe %Triple
 compCoerce(["::",x,m'],m,e) ==
   e:= addDomain(m',e)
   T:= compCoerce1(x,m',e) => coerce(T,m)
-  getmode(m',e) is ["Mapping",["UnionCategory",:l]] =>
+  ident? m' and getXmode(m',e) is ["Mapping",["UnionCategory",:l]] =>
     T:= (or/[compCoerce1(x,m1,e) for m1 in l]) or return nil
     coerce([T.expr,m',T.env],m)
 
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 81a9e6d9..96db10dc 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -514,6 +514,12 @@ hasDefaultPackage catname ==
   constructor? defname => defname
   nil
  
+++ Like getmode, except that if the mode is local variable with
+++ defined value, we want that value instead.
+getXmode(x,e) ==
+  m := getmode(x,e) or return nil
+  ident? m and get(m,'%macro,e) or m
+
  
 --=======================================================================
 --              Compute the lookup function (complete or incomplete)
@@ -522,7 +528,7 @@ NRTgetLookupFunction(domform,exCategory,addForm,env) ==
   $why: local := nil
   domform := applySubst($pairlis,domform)
   addForm isnt [.,:.] =>
-    IDENTP addForm and (m := getmode(addForm,env)) ~= nil
+    ident? addForm and (m := getmode(addForm,env)) ~= nil
       and isCategoryForm(m,env) 
         and extendsCategory(domform,exCategory,applySubst($pairlis,m),env) =>
           'lookupIncomplete
@@ -1503,7 +1509,7 @@ displayMissingFunctions() ==
   loc := nil              -- list of local operation signatures
   exp := nil              -- list of exported operation signatures
   for [[op,sig,:.],:pred] in $CheckVectorList  | not pred repeat
-    not symbolMember?(op,$formalArgList) and getmode(op,$e) is ['Mapping,:.] =>
+    not symbolMember?(op,$formalArgList) and getXmode(op,$e) is ['Mapping,:.] =>
       loc := [[op,sig],:loc]
     exp := [[op,sig],:exp]
   if loc then
@@ -1745,7 +1751,7 @@ compDefineCapsuleFunction(df is ['DEF,form,signature,specialCases,body],
  
     localOrExported :=
       not symbolMember?($op,$formalArgList) and
-        getmode($op,e) is ['Mapping,:.] => 'local
+        getXmode($op,e) is ['Mapping,:.] => 'local
       'exported
  
     --6a skip if compiling only certain items but not this one
@@ -1780,7 +1786,7 @@ compDefineCapsuleFunction(df is ['DEF,form,signature,specialCases,body],
     [fun,['Mapping,:signature'],$e]
  
 getSignatureFromMode(form,e) ==
-  getmode(opOf form,e) is ['Mapping,:signature] =>
+  getXmode(opOf form,e) is ['Mapping,:signature] =>
     #form~=#signature => stackAndThrow ["Wrong number of arguments: ",form]
     applySubst(pairList($FormalMapVariableList,form.args),signature)
 
@@ -1814,7 +1820,7 @@ addDomain(domain,e) ==
     addNewDomain(domain,e)
   (name:= first domain)='Category => e
   domainMember(domain,getDomainsInScope e) => e
-  getmode(name,e) is ["Mapping",target,:.] and isCategoryForm(target,e)=>
+  getXmode(name,e) is ["Mapping",target,:.] and isCategoryForm(target,e) =>
       addNewDomain(domain,e)
     -- constructor? test needed for domains compiled with $bootStrapMode=true
   isDomainForm(domain,e) => addNewDomain(domain,e)
@@ -1887,7 +1893,7 @@ getSignature(op,argModeList,$e) ==
           for [[dc,:sig],[pred,:.]] in (mmList:= get(op,'modemap,$e)) | dc='_$
             and sig.source = argModeList and knownInfo(pred,$e)]) => first sigl
   null sigl =>
-    (u:= getmode(op,$e)) is ['Mapping,:sig] => sig
+    (u:= getXmode(op,$e)) is ['Mapping,:sig] => sig
     SAY '"************* USER ERROR **********"
     SAY("available signatures for ",op,": ")
     if null mmList
@@ -1968,7 +1974,7 @@ compile u ==
      where
        isLocalFunction op ==
          null symbolMember?(op,$formalArgList) and
-           getmode(op,$e) is ['Mapping,:.]
+           getXmode(op,$e) is ['Mapping,:.]
     u:= [op',lamExpr]
   -- If just updating certain functions, check for previous existence.
   -- Deduce old sequence number and use it (items have been skipped).
@@ -2368,7 +2374,7 @@ compJoin(["Join",:argl],m,e) ==
         x is ["DomainSubstitutionMacro",pl,body] =>
           (parameters:= union(pl,parameters); body)
         x is ["mkCategory",:.] => x
-        x isnt [.,:.] and getmode(x,e) = $Category => x
+        ident? x and getXmode(x,e) = $Category => x
         stackSemanticError(["invalid argument to Join: ",x],nil)
         x
   T:= [wrapDomainSub(parameters,["Join",:catList']),$Category,e]
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index 287e5f7d..05860159 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -280,7 +280,8 @@ doInlineCall(args,parms,body) ==
   for arg in args for parm in parms repeat
     g := gensym()
     tmps := [g,:tmps]
-    sideEffectFree? arg or numOfOccurencesOf(parm,body) = 1 =>
+    n := numOfOccurencesOf(parm,body)
+    atomic? arg or (sideEffectFree? arg and n < 2) or n = 1 =>
       subst := [[g,:arg],:subst]
     inits := [[g,arg],:inits]
   -- 4. Alpha-rename the body and substitute simple expression arguments.
@@ -417,8 +418,7 @@ optSuchthat [.,:u] == ["SUCHTHAT",:u]
  
 ++ List of VM side effect free operators.
 $VMsideEffectFreeOperators ==
-  '(FUNCALL %apply
-    SPADfirst ASH FLOAT_-RADIX FLOAT FLOAT_-SIGN
+  '(SPADfirst ASH FLOAT FLOAT_-SIGN
     %funcall %nothing %when %false %true %otherwise %2bit %2bool
     %and %or %not %peq %ieq %ilt %ile %igt %ige %head %tail %integer?
     %beq %blt %ble %bgt %bge %bitand %bitior %bitxor %bitnot %bcompl
@@ -452,8 +452,8 @@ $VMsideEffectFreeOperators ==
 ++ List of simple VM operators
 $simpleVMoperators == 
   append($VMsideEffectFreeOperators,
-    ['SPADCALL,'%gensym, '%lreverse!,
-      '%strstc,"MAKE-FULL-CVEC"])
+    ['SPADCALL,'%apply, '%gensym, '%lreverse!,
+      '%strstc])
 
 ++ Return true if the `form' is semi-simple with respect to
 ++ to the list of operators `ops'.
@@ -528,7 +528,7 @@ dependentVars expr == main(expr,nil) where
       vars := main(y,vars)
     vars
 
-++ Subroutine of optLET and optBind.  Return true if the variable `var' locally
+++ Subroutine of optBind.  Return true if the variable `var' locally
 ++ defined in a binding form can be safely replaced by its initalization
 ++ `expr' in the `body' of the binding form.
 canInlineVarDefinition(var,expr,body) ==
@@ -559,57 +559,6 @@ canInlineVarDefinition(var,expr,body) ==
 ++ This transformation will probably be more effective when all
 ++ type informations are still around.   Which is why we should
 ++ have a type directed compilation throughout. 
-optLET u ==
-  -- Hands off non-simple cases.
-  u isnt ["LET",inits,body] => u
-  -- Inline functionally used local variables with their initializers.
-  inits := [:newInit for (init := [var,expr]) in inits] where 
-    newInit() ==
-      canInlineVarDefinition(var,expr,body) =>
-        body := substitute(expr,var,body)
-        nil  -- remove this initialization
-      [init] -- otherwwise keep it.
-  null inits => body
-  u.rest.first := inits
-  u.rest.rest.first := body
-  -- Avoid initialization forms that may not be floatable.
-  not(and/[isFloatableVMForm init for [.,init] in inits]) => u
-  -- Identity function.
-  inits is [[=body,init]] => init
-  -- Handle only most trivial operators.
-  body isnt [op,:args] => u
-  -- Well, with case-patterns, it is beneficial to try a bit harder
-  -- with conditional forms.
-  op is '%when =>
-    continue := true      -- shall be continue let-inlining?
-    -- Since we do a single pass, we can't reuse the inits list
-    -- as we may find later that we can't really inline into
-    -- all forms due to excessive conversatism.  So we build a 
-    -- substitution list ahead of time.
-    substPairs := [[var,:init] for [var,init] in inits]
-    for clauses in tails args while continue repeat
-      clause := first clauses
-      -- we do not attempt more complicated clauses yet.
-      clause isnt [test,stmt] => continue := false
-      -- Stop inlining at least one test is not simple
-      not isSimpleVMForm test => continue := false
-      clause.first := applySubst(substPairs,test)
-      isSimpleVMForm stmt =>
-        clause.rest.first := applySubst(substPairs,stmt)
-      continue := false
-    continue => body
-    u
-  not symbolMember?(op,$simpleVMoperators) => u
-  not(and/[atomic? arg for arg in args]) => u
-  -- Inline only if all parameters are used.  Get cute later.
-  not(and/[symbolMember?(x,args) for [x,.] in inits]) => u
-  -- Munge inits into list of dotted-pairs.  Lovely Lisp.
-  for defs in tails inits repeat
-    def := first defs
-    def isnt [.,:.] => systemErrorHere ["optLET",def] -- cannot happen
-    def.rest := second def
-  applySubst(inits,body)
-
 optBind form ==
   form isnt ['%bind,inits,.] => form           -- accept only simple bodies
   ok := true
@@ -862,7 +811,6 @@ optIquo(x is ['%iquo,a,b]) ==
  
 for x in '((%call         optCall) _
            (SEQ          optSEQ)_
-           (LET          optLET)_
            (%bind        optBind)_
            (%try         optTry)_
            (%not         optNot)_
diff --git a/src/interp/lisp-backend.boot b/src/interp/lisp-backend.boot
index 6354a5cf..79200c61 100644
--- a/src/interp/lisp-backend.boot
+++ b/src/interp/lisp-backend.boot
@@ -461,6 +461,9 @@ expandTry ['%try,expr,handlers,cleanup] ==
   cleanup = nil => tryBlock
   ['UNWIND_-PROTECT,tryBlock,:expandToVMForm rest cleanup]
   
+expandApply ['%apply,op,:args] ==
+  ['SPADCALL,:args,op]
+
 ++ Opcodes with direct mapping to target operations.
 for x in [
     -- Boolean constants
@@ -701,7 +704,8 @@ for x in [
    ['%store,  :function expandStore],
    ['%dynval, :function expandDynval],
    ['%throw,  :function expandThrow],
-   ['%try,    :function expandTry]
+   ['%try,    :function expandTry],
+   ['%apply,  :function expandApply]
  ] repeat property(first x,'%Expander) := rest x
 
 ++ Return the expander of a middle-end opcode, or nil if there is none.
diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot
index 4d7d0d7c..0bf11904 100644
--- a/src/interp/lisplib.boot
+++ b/src/interp/lisplib.boot
@@ -734,9 +734,7 @@ isFunctor x ==
     builtinFunctorName? op => true
     getConstructorKindFromDB op in '(domain package)
   u := get(op,'isFunctor,$CategoryFrame) => u
-  op in '(SubDomain Union Record Enumeration) => true
-     --FIXME: above should use builtinFunctionName?.  Change when
-     --FIXME: Mapping acquire first class functorship.
+  builtinFunctorName? op => true
   kind := getConstructorKindFromDB op
   kind = nil or kind = 'category => false
   updateCategoryFrameForConstructor op