* interp/c-util.boot ($optProclaim): New.

	($optReplaceSimpleFunctions): Likewise.
	(setCompilerOptimizations): Likewise.  Set them.
	(proclaimCapsuleFunction): New.
	* interp/compiler.boot (compileSpad2Cmd): Handle option ')optimize'.
	* interp/define.boot (compile): Proclaim if appropriate.
	* interp/sys-driver.boot (compileSpadLibrary): Honor optimization
	level set on commmand line.
	* interp/sys-utility.boot (getVMType): Tidy.
	* interp/types.boot (%Void): Likewise.
	(IntegerSection): New.

7 files changed, 98 insertions, 2 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index af723ff8..33582967 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,19 @@
 2008-10-01  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
+	* interp/c-util.boot ($optProclaim): New.
+	($optReplaceSimpleFunctions): Likewise.
+	(setCompilerOptimizations): Likewise.  Set them.
+	(proclaimCapsuleFunction): New.
+	* interp/compiler.boot (compileSpad2Cmd): Handle option ')optimize'.
+	* interp/define.boot (compile): Proclaim if appropriate.
+	* interp/sys-driver.boot (compileSpadLibrary): Honor optimization
+	level set on commmand line.
+	* interp/sys-utility.boot (getVMType): Tidy.
+	* interp/types.boot (%Void): Likewise.
+	(IntegerSection): New.
+
+2008-10-01  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
 	* interp/i-output.boot: Move dispatch table from property.lisp.
 	* interp/buildom.boot: Likewise.
 	* interp/def.lisp: Likewise.
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 47ff18b1..7bf1e1b9 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -46,6 +46,15 @@ $Representation := nil
 
 $formalArgList := []
 
+--% Optimization control
+
+++ true if we have to proclaim function signatures in the generated Lisp.
+$optProclaim := false
+
+++ true if we have to inline simple functions before codegen.
+$optReplaceSimpleFunctions := false
+
+
 --%
 
 ++ If using old `Rep' definition semantics, return `$' when m is `Rep'.
@@ -821,3 +830,44 @@ ambiguousSignatureError(op, sigs) ==
   stackSemanticError(['"signature of lhs not unique.  Candidates are:",
     :displayAmbiguousSignatures($op,sigs)],nil)
 
+--%
+setCompilerOptimizations level ==
+  level = nil => nil
+  INTEGERP level =>
+    if level = 0 then
+      -- explicit request for no optimization.
+      $optProclaim := false
+      $optReplaceSimpleFunctions := false
+    if level > 0 then 
+      $optProclaim := true
+      $optReplaceSimpleFunctions := true
+  coreError '"unknown optimization level request"
+
+++ Proclaim the type of the capsule function `op' with signature `sig'.
+++ Note that all capsule functions take an additional argument 
+++ standing for the domain of computation object.
+proclaimCapsuleFunction(op,sig) ==
+  LAM_,EVALANDFILEACTQ
+    ["DECLAIM",["FTYPE",
+       ["FUNCTION",[:[argType first d for d in tails rest sig],"%Shell"], 
+          retType first sig],op]] where
+      argType d ==
+        getVMType normalize d
+      retType d ==
+        d := normalize d
+        atom d => getVMType d
+        args := rest d
+        #args = 0 => getVMType d
+        or/[atom a for a in args] => "%Thing"
+        -- not theoretically correct, but practically OK.
+        getVMType d
+      normalize d ==
+        d = "$" => 
+          -- If the representation is explicitly stated, use it.  That way
+          -- we optimize abstractions just as well as builtins.
+          rep := get("Rep","value",$e) => rep
+          -- Cope with old-style constructor definition
+          atom $functorForm => [$functorForm] 
+          $functorForm
+        atom d => d
+        [first d, :[normalize first args for args in tails rest d]]
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 121924bd..004acbb0 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -1683,6 +1683,7 @@ compileSpad2Cmd args ==
       vartrace _
       quiet _
       translate _
+      optimize
         )
 
     translateOldToNew        := nil
@@ -1728,6 +1729,7 @@ compileSpad2Cmd args ==
               throwKeyedMsg("S2IZ0037",['")constructor"])
             fun.0       := 'c
             constructor := [unabbrev o for o in optargs]
+        fullopt = "optimize" => setCompilerOptimizations first optargs
         throwKeyedMsg("S2IZ0036",[STRCONC('")",object2String optname)])
 
     $InteractiveMode : local := nil
@@ -1745,6 +1747,8 @@ compileSpad2Cmd args ==
     if not $buildingSystemAlgebra then 
       extendLocalLibdb $newConlist
     terminateSystemCommand()
+    -- reset compiler optimization options
+    setCompilerOptimizations 0
     spadPrompt()
 
 convertSpadToAsFile path ==
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 88ef628d..b607cd4b 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -1207,6 +1207,11 @@ compile u ==
        else putInLocalDomainReferences optimizedBody
   $doNotCompileJustPrint=true => (PRETTYPRINT stuffToCompile; op')
   $macroIfTrue => constructMacro stuffToCompile
+
+  -- Let the backend know about this function's type
+  if $insideCapsuleFunctionIfTrue and $optProclaim then
+    proclaimCapsuleFunction(op',$signatureOfForm)
+
   result:= spadCompileOrSetq stuffToCompile
   functionStats:=[0,elapsedTime()]
   $functionStats:= addStats($functionStats,functionStats)
diff --git a/src/interp/sys-driver.boot b/src/interp/sys-driver.boot
index 4c98c8e2..da622f96 100644
--- a/src/interp/sys-driver.boot
+++ b/src/interp/sys-driver.boot
@@ -267,6 +267,8 @@ compileSpadLibrary(progname,options,file) ==
   $verbose := false
   $ProcessInteractiveValue := true
   $PrintCompilerMessageIfTrue := $verbose
+  setCompilerOptimizations 
+    getOptionValue(Option '"optimize",%systemOptions())
   CATCH($intTopLevel,
     CATCH("SpadCompileItem",
      CATCH($SpadReaderTag,compiler [file])))
diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot
index 57fc9a9b..441d356e 100644
--- a/src/interp/sys-utility.boot
+++ b/src/interp/sys-utility.boot
@@ -44,6 +44,8 @@ namespace BOOT
 ++ representation of a domain, as a Lisp type specifier as seen by
 ++ the runtime system.
 getVMType d ==
+  IDENTP d => "%Thing"
+  STRINGP d => "%Thing"            -- literal flag parameter
   case (d' := devaluate d) of
     Void => "%Void"
     Boolean => "%Boolean"
@@ -51,11 +53,19 @@ getVMType d ==
     Character => "%Char"
     SingleInteger => "%Short"
     Integer => "%Integer"
+    NonNegativeInteger => ["%IntegerSection",0]
+    PositiveInteger => ["%IntegerSection",1]
+    IntegerMod => "%Integer"
+    DoubleFloat => "%DoubleFloat"
     String => "%String"
     List => "%List"
     Vector => ["%Vector",getVMType second d']
     PrimitiveArray => ["%SimpleArray", getVMType second d']
     Pair => "%Pair"
+    Union => "%Pair"
+    Record =>
+      #rest d' > 2 => "%Shell"
+      "%Pair"
     otherwise => "%Thing"                 -- good enough, for now.
 
 --%
diff --git a/src/interp/types.boot b/src/interp/types.boot
index 6bb4a555..00b55d64 100644
--- a/src/interp/types.boot
+++ b/src/interp/types.boot
@@ -36,9 +36,17 @@ namespace BOOT
 
 --% Basic types used throughout Boot codes.
 
-++ Type of nothing.  Bottom of the latting.
+++ Type of nothing.  Bottom of the abstract machine type lattice.
+++ Since Lisp functions always returns something, we cannot
+++ use the `nil' type specifier (the ideal answer).  Second
+++ best possibility is to have Void-returning functions
+++ systematically return `nil'.  However, until the Lisp
+++ backend is fixed, we will use the interpretation that a 
+++ Void-returning function may return anything, but nobody cares.
+++ Hence, the choice below which contradicts the very first line
+++ of this description.
 %Void <=> 
-  nil
+  true
 
 ++ Type of truth values.
 %Boolean <=> 
@@ -63,6 +71,9 @@ namespace BOOT
 %Integer <=>
   INTEGER
 
+%IntegerSection n <=>
+  INTEGER n
+
 ++ Type of single precision floating point numbers.  Most of the
 ++ time, this is a 32-bit datatype on IEEE-754 host.
 %SingleFloat <=>