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

	(replaceSimpleFunctions): Use it.  Simplify back to original
	implementation. 
	(proclaimCapsuleFunction): Constructor parameters are generic.
	* interp/sys-utility.boot (getVMType): Handle wildcard.
	* algebra/stream.spad.pamphlet: Don't build STREAM with
	proclamation on -- it currently violates type rules.

7 files changed, 45 insertions, 27 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 283064d1..a6e1f476 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,15 @@
 2008-10-04  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
+	* interp/c-util.boot (isAtomicForm): New.
+	(replaceSimpleFunctions): Use it.  Simplify back to original
+	implementation. 
+	(proclaimCapsuleFunction): Constructor parameters are generic.
+	* interp/sys-utility.boot (getVMType): Handle wildcard.
+	* algebra/stream.spad.pamphlet: Don't build STREAM with
+	proclamation on -- it currently violates type rules.
+
+2008-10-04  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
 	* algebra/data.spad.pamphlet (sample$Byte): New.
 
 2008-10-04  Gabriel Dos Reis  <gdr@cs.tamu.edu>
diff --git a/src/algebra/stream.spad.pamphlet b/src/algebra/stream.spad.pamphlet
index 0241548c..66d7a227 100644
--- a/src/algebra/stream.spad.pamphlet
+++ b/src/algebra/stream.spad.pamphlet
@@ -550,6 +550,9 @@ CyclicStreamTools(S,ST): Exports == Implementation where
 @
 \section{domain STREAM Stream}
 <<domain STREAM Stream>>=
+-- As explained below, in the capsule, the Rep for STREAM is actually
+-- a half lie.  So, the system should not be allowed to trust it.
+)boot $optProclaim := false
 import Type
 import Void
 import Boolean
diff --git a/src/input/Makefile.in b/src/input/Makefile.in
index 2eabdecc..acfdd10a 100644
--- a/src/input/Makefile.in
+++ b/src/input/Makefile.in
@@ -528,8 +528,9 @@ pamphlets = \
 	$(wildchar.as.pamplhet)
 
 mostlyclean-local:
-	-rm -rf $(MID)
-	-rm -rf $(OUT)
+	rm -f *.output
+	rm -rf $(MID)
+	rm -rf $(OUT)
 
 clean-local: mostlyclean-local
 
diff --git a/src/input/Makefile.pamphlet b/src/input/Makefile.pamphlet
index 6b673e35..5a320d1c 100644
--- a/src/input/Makefile.pamphlet
+++ b/src/input/Makefile.pamphlet
@@ -883,8 +883,9 @@ $(OUT):
 <<genericRules>>
 
 mostlyclean-local:
-	-rm -rf $(MID)
-	-rm -rf $(OUT)
+	rm -f *.output
+	rm -rf $(MID)
+	rm -rf $(OUT)
 
 clean-local: mostlyclean-local
 
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 5ffaf9c3..8a6f4402 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -856,10 +856,15 @@ eqSubst: (%List, %List, %Form) -> %Form
 eqSubst(args,parms,body) ==
   NSUBLIS(pairList(parms,args),body,KEYWORD::TEST,function EQ)
 
+
+++ returns true if `form' does not really induce computations.
+isAtomicForm: %Form -> %Boolean
+isAtomicForm form ==
+  atom form or first form = "QUOTE"
+
 ++ Walk `form' and replace simple functions as appropriate.
 replaceSimpleFunctions form ==
-  atom form => form
-  form is ["QUOTE",:.] => form
+  isAtomicForm form => form
   -- 1. process argument first.
   for args in tails rest form repeat
     arg' := replaceSimpleFunctions(arg := first args)
@@ -876,7 +881,7 @@ replaceSimpleFunctions form ==
     -- 2.2. the substitution case.
     fun' is ["XLAM",parms,body] =>
       -- conservatively approximate eager semantics
-      and/[atom first as for as in tails args] =>
+      and/[isAtomicForm first as for as in tails args] =>
         -- alpha rename before substitution.
 	newparms := [GENSYM() for p in parms]
 	body := eqSubstAndCopy(newparms,parms,body)
@@ -910,25 +915,21 @@ setCompilerOptimizations level ==
 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 ==
+       ["FUNCTION",[:[vmType first d for d in tails rest sig],"%Shell"], 
+          vmType first sig],op]] where
+      vmType d ==
+        getVMType normalize(d,true)
+      normalize(d,top?) ==
         d = "$" => 
+          not top? => "*"
           -- If the representation is explicitly stated, use it.  That way
           -- we optimize abstractions just as well as builtins.
-          rep := get("Rep","value",$e) => rep
+          r := get("Rep","value",$e) => normalize(r.expr,top?)
           -- Cope with old-style constructor definition
           atom $functorForm => [$functorForm] 
-          $functorForm
-        atom d => d
-        [first d, :[normalize first args for args in tails rest d]]
+          normalize($functorForm,top?)
+        atom d => 
+          top? => "%Thing"
+          getmode(d,$e) => "*"
+          d
+        [first d, :[normalize(first args,false) for args in tails rest d]]
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 5939cdcb..58c39f1b 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -927,8 +927,8 @@ compDefineCapsuleFunction(df is ['DEF,form,signature,specialCases,body],
     e:= compArgumentConditions e
  
     if $profileCompiler then
-      for x in argl for t in rest signature' repeat profileRecord('arguments,x,t)
-
+      for x in argl for t in rest signature' repeat 
+        profileRecord('arguments,x,t)
 
     --4. introduce needed domains into extendedEnv
     for domain in signature' repeat e:= addDomain(domain,e)
diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot
index 20e84c18..3c820e9f 100644
--- a/src/interp/sys-utility.boot
+++ b/src/interp/sys-utility.boot
@@ -44,7 +44,9 @@ namespace BOOT
 ++ representation of a domain, as a Lisp type specifier as seen by
 ++ the runtime system.
 getVMType d ==
-  IDENTP d => "%Thing"
+  IDENTP d => 
+    d = "*" => d
+    "%Thing"
   STRINGP d => "%Thing"            -- literal flag parameter
   case (d' := devaluate d) of
     Void => "%Void"