* interp/sys-globals.boot ($compileExportOnly): Remove.

	* interp/sys-driver.boot (initializeGlobalState): Don't set it.
	* interp/define.boot (skipCategoryPackage?): Adjust.
	(compDefineFunctor): Likewise.
	(compDefineFunctor1): Likewise.
	(incompleteFunctorBody): New.
	(compFunctorBody): Use it.

4 files changed, 34 insertions, 19 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index c8b836a1..2aab9c1b 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,13 @@
+2011-08-21  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* interp/sys-globals.boot ($compileExportOnly): Remove.
+	* interp/sys-driver.boot (initializeGlobalState): Don't set it.
+	* interp/define.boot (skipCategoryPackage?): Adjust.
+	(compDefineFunctor): Likewise.
+	(compDefineFunctor1): Likewise.
+	(incompleteFunctorBody): New.
+	(compFunctorBody): Use it.
+
 2011-08-20  Gabriel Dos Reis  <gdr@cse.tamu.edu>
 
 	* interp/sys-utility.boot (constructorDB): New.
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 876d57e9..6e60191e 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -914,9 +914,9 @@ mkEvalableCategoryForm c ==
  
 ++ Return true if we should skip compilation of category package.
 ++ This situation happens either when there is no default, of we are in
-++ bootstrap mode, or we are compiling only for exports.
+++ bootstrap mode.
 skipCategoryPackage? capsule ==
-  null capsule or $bootStrapMode or $compileExportsOnly
+  null capsule or $bootStrapMode
 
 compDefineCategory1(df is ['DEF,form,sig,sc,body],m,e,prefix,fal) ==
   categoryCapsule :=
@@ -1339,8 +1339,7 @@ compDefineFunctor(df,m,e,prefix,fal) ==
   $profileCompiler: local := true
   $profileAlist:    local := nil
   $mutableDomain: local := false
-  $compileExportsOnly or $LISPLIB = nil => 
-    compDefineFunctor1(df,m,e,prefix,fal)
+  $LISPLIB = nil => compDefineFunctor1(df,m,e,prefix,fal)
   lhs := second df
   ctor := opOf lhs
   dbNiladic?(constructorDB ctor) := lhs isnt [.,:.] or lhs.args = nil
@@ -1386,8 +1385,6 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body],
     $implicitParameters: local := inferConstructorImplicitParameters(argl,$e)
     [ds,.,$e]:= compMakeCategoryObject(target,$e) or return
        stackAndThrow('"   cannot produce category object: %1pb",[target])
-    $compileExportsOnly =>
-      compDefineExports(form, categoryExports ds, signature',$e)
     $domainShell: local := copyVector ds
     attributeList := categoryAttributes ds --see below under "loadTimeAlist"
     $condAlist: local := nil
@@ -1485,19 +1482,33 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body],
             ['MAKEPROP, ['QUOTE,op'], ['QUOTE,'%incomplete], true])
     [fun,['Mapping,:signature'],originale]
 
+
+++ Finish the incomplete compilation of a functor body.
+incompleteFunctorBody(form,m,body,e) ==
+  -- The slot numbers from the category shell are bogus at this point.
+  -- Nullify them so people don't think they bear any meaningful
+  -- semantics (well, they should not think these are forwarding either).
+  ops := nil
+  for [opsig,pred,funsel] in categoryExports $domainShell repeat
+    if pred isnt 'T then
+      pred := simpBool pred
+    if funsel is [op,.,.] and op in '(ELT CONST) then
+      third(funsel) := nil
+    ops := [[opsig,pred,funsel],:ops]
+  $lisplibOperationAlist := listSort(function GGREATERP, ops, function first)
+  [bootStrapError(form, _/EDITFILE),m,e]
+
 ++ Subroutine of compDefineFunctor1.  Called to generate backend code
 ++ for a functor definition. 
 compFunctorBody(body,m,e,parForm) ==
-  $bootStrapMode =>
-    [bootStrapError($functorForm, _/EDITFILE),m,e]
+  $bootStrapMode => incompleteFunctorBody($functorForm,m,body,e)
   clearCapsuleDirectory()        -- start collecting capsule functions.
   T:= compOrCroak(body,m,e)
   $capsuleFunctionStack := reverse! $capsuleFunctionStack
   -- ??? Don't resolve default definitions, yet.
-  if $insideCategoryPackageIfTrue then
-    backendCompile $capsuleFunctionStack
-  else 
-    backendCompile foldExportedFunctionReferences $capsuleFunctionStack
+  backendCompile
+    $insideCategoryPackageIfTrue => $capsuleFunctionStack
+    foldExportedFunctionReferences $capsuleFunctionStack
   clearCapsuleDirectory()        -- release storage.
   body is [op,:.] and op in '(add CAPSULE) => T
   $NRTaddForm :=
diff --git a/src/interp/sys-driver.boot b/src/interp/sys-driver.boot
index a2f3f245..37023295 100644
--- a/src/interp/sys-driver.boot
+++ b/src/interp/sys-driver.boot
@@ -1,4 +1,4 @@
--- Copyright (C) 2007-2010 Gabriel Dos Reis
+-- Copyright (C) 2007-2011 Gabriel Dos Reis
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -189,7 +189,6 @@ initializeGlobalState() ==
   $buildingSystemAlgebra := getOptionValue "system-algebra"
   $verbose := getOptionValue "verbose"
   $bootStrapMode := getOptionValue "bootstrap"
-  $compileExportsOnly := getOptionValue "exports-only"
   $compileDefaultsOnly := getOptionValue "defaults-only"
   $reportOptimization := getOptionValue "show-insn"
   $optimizeRep := getOptionValue "inline-rep"
diff --git a/src/interp/sys-globals.boot b/src/interp/sys-globals.boot
index 41b078fe..3f1c2ce1 100644
--- a/src/interp/sys-globals.boot
+++ b/src/interp/sys-globals.boot
@@ -453,11 +453,6 @@ $buildingSystemAlgebra := false
 ++ code generation, etc.
 $verbose := true
 
-++ True if the compiler is invoked to produce only exports of
-++ a domain or a category.  For a category, the compilation of
-++ defaults, if any, is suppressed.
-$compileExportsOnly := false
-
 ++ True if the compiler is invoked to produce implementation
 ++ of category defaults only.  This is meaningful only when
 ++ compiling categories.