* interp/g-opt.boot ($VMsideEffectFreeOperators): New.

	($simpleVMoperators): Augment it.
	(semiSimpleRelativeTo?): New.
	(isSimpleVMForm): Use it.
	* interp/c-util.boot (forwardingCall?): New.
	(usesVariablesLinearly?): Likewise.
	(expandableDefinition?): Likewise.
	(foldSpadcall): Tidy.
	(foldExportedFunctionReferences): If a function is discovered to
	be expandable, make it so.
	* interp/define.boot (spadCompileOrSetq): Tidy.

3 files changed, 73 insertions, 15 deletions

diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 45afea96..4df0052f 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -1105,11 +1105,50 @@ replaceSimpleFunctions form ==
   form
 
 
+++ We are processing a function definition with parameter list `vars'
+++ and body given by `body'.  If `body' is a forwarding function call, 
+++ return the target function.  Otherwise, return nil.
+forwardingCall?(vars,body) ==
+  vars is [:vars',.] and body is [fun,: =vars'] and IDENTP fun => fun
+  nil
+
+
+++ Return true if `form' has a linear usage of all variables in `vars'.
+usesVariablesLinearly?(form,vars) ==
+  isAtomicForm form => true
+  and/[numOfOccurencesOf(var,form) < 2 for var in vars] 
+
+++ We are processing a function definition with parameter list `vars'
+++ and body given by `body'.  If `body' is a form that can be inlined,
+++ then return the inline form.  Otherwise, return nil.
+expandableDefinition?(vars,body) ==
+  expand? :=
+    -- We definitely don't want to expand a form that uses
+    -- the domain of computation environment.
+    vars isnt [:vars',env] or CONTAINED(env,body) => false
+
+    -- Constants are currently implemented as niladic functions, and
+    -- we want to avoid disturbing object identity, so we rule
+    -- out use of side-effect full operators.  
+    -- FIXME: This should be done only for constant creators.
+    null vars' => semiSimpleRelativeTo?(body,$VMsideEffectFreeOperators)
+
+    isAtomicForm body => true
+    [op,:args] := body
+    not IDENTP op => false
+    and/[isAtomicForm x for x in args] 
+      or semiSimpleRelativeTo?(body,$simpleVMoperators) =>
+                usesVariablesLinearly?(body,vars')
+    false
+  expand? => ["XLAM",vars',body]
+  nil
+
 ++ Replace all SPADCALLs to operations defined in the current
 ++ domain.  Conditional operations are not folded.
 foldSpadcall: %Form -> %Form
 foldSpadcall form ==
-  isAtomicForm form => form
+  isAtomicForm form => form           -- leave atomic forms alone
+  form is ["DECLARE",:.] => form      -- don't walk declarations
   form is ["LET",inits,:body] =>
     mutateLETFormWithUnaryFunction(form,"foldSpadcall")
   form is ["COND",:stmts] =>
@@ -1129,8 +1168,13 @@ foldSpadcall form ==
 ++ with their corresponding linkage names.  
 foldExportedFunctionReferences defs ==
   for fun in defs repeat
-    foldSpadcall fun is [.,lamex] =>
-      rplac(third lamex, replaceSimpleFunctions third lamex)
+    fun isnt [name,lamex] => nil
+    lamex isnt ["LAM",vars,body] => nil
+    body := replaceSimpleFunctions foldSpadcall body
+    form := expandableDefinition?(vars,body) =>
+      registerFunctionReplacement(name,form)
+      rplac(second fun, ["LAM",vars,["DECLARE",["IGNORE",last vars]],body])
+    rplac(third lamex,body)
   defs
 
 ++ record optimizations permitted at level `level'.
diff --git a/src/interp/define.boot b/src/interp/define.boot
index d25302e8..5a8930ee 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -1246,17 +1246,16 @@ spadCompileOrSetq (form is [nam,[lam,vl,body]]) ==
   if $optReplaceSimpleFunctions then
     body := replaceSimpleFunctions body
 
-  if vl is [:vl',E] and body is [nam',: =vl'] then
+  if nam' := forwardingCall?(vl,body) then
       registerFunctionReplacement(nam,nam')
       sayBrightly ['"     ",:bright nam,'"is replaced by",:bright nam']
-  else if (isAtomicForm body or and/[isAtomicForm x for x in body])
-         and vl is [:vl',E] and not CONTAINED(E,body) then
-           macform := ['XLAM,vl',body]
+  else if macform := expandableDefinition?(vl,body) then
            registerFunctionReplacement(nam,macform)
            sayBrightly ['"     ",:bright nam,'"is replaced by",:bright body]
 
   form := 
-    getFunctionReplacement nam => [nam,[lam,vl,["DECLARE",["IGNORE",E]],body]]
+    getFunctionReplacement nam => 
+      [nam,[lam,vl,["DECLARE",["IGNORE",last vl]],body]]
     [nam,[lam,vl,body]]
 
   $insideCapsuleFunctionIfTrue => 
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index 8110587e..38613f11 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -392,16 +392,31 @@ optLESSP u ==
     ['GREATERP,b,a]
   u
  
-$simpleVMoperators == 
-  '(CONS CAR CDR LENGTH SIZE EQUAL EQL EQ NOT NULL OR AND
-    SPADfirst QVELT _+ _- _* _< _= ASH INTEGER_-LENGTH
+++ List of VM side effect free operators.
+$VMsideEffectFreeOperators ==
+  '(CAR CDR LENGTH SIZE EQUAL EQL EQ NOT NULL OR AND
+    SPADfirst QVELT _+ _- _* _< _= _<_= _> _>_= ASH INTEGER_-LENGTH
      QEQCAR QCDR QCAR INTEGERP FLOATP STRINGP IDENTP SYMBOLP
-      MINUSP GREATERP)
+      MINUSP GREATERP ZEROP ODDP FLOAT_-RADIX FLOAT FLOAT_-SIGN FLOAT_-DIGITS
+       CGREATERP GGREATERP CHAR BOOLE GET BVEC_-GREATER FUNCALL)
 
-isSimpleVMForm form ==
+++ List of simple VM operators
+$simpleVMoperators == 
+  append($VMsideEffectFreeOperators,
+    ["CONS","LIST","VECTOR","STRINGIMAGE",
+      "MAKE-FULL-CVEC","BVEC-MAKE-FULL","COND"])
+
+++ Return true if the `form' is semi-simple with respect to
+++ to the list of operators `ops'.
+semiSimpleRelativeTo?(form,ops) ==
   isAtomicForm form => true
-  form is [op,:args] and MEMQ(op,$simpleVMoperators) 
-    and ("and"/[isAtomicForm arg for arg in args])
+  form isnt [op,:args] or not MEMQ(op,ops) => false
+  and/[semiSimpleRelativeTo?(f,ops) for f in args]
+
+++ Return true if `form' is a simple VM form.
+++ See $simpleVMoperators for the definition of simple operators.
+isSimpleVMForm form ==
+  semiSimpleRelativeTo?(form,$simpleVMoperators)
 
 ++ Return true if `form' is a VM form whose evaluation does not depend
 ++ on the program point where it is evaluated.