[Gd-chatter] r11258 - in trunk/fundev/sources/environment: dfmc/database protocols reports tools

[andreas at gwydiondylan.org]

Author: andreas
Date: Fri Apr 13 01:33:33 2007
New Revision: 11258

Modified:
   trunk/fundev/sources/environment/dfmc/database/class-objects.dylan
   trunk/fundev/sources/environment/dfmc/database/function-objects.dylan
   trunk/fundev/sources/environment/protocols/expression-objects.dylan
   trunk/fundev/sources/environment/protocols/module.dylan
   trunk/fundev/sources/environment/reports/test-suite-report.dylan
   trunk/fundev/sources/environment/tools/environment-frames.dylan
   trunk/fundev/sources/environment/tools/object-browser.dylan
Log:
job: fd

More changes to remove any trace of {complex type} in the environment.



Modified: trunk/fundev/sources/environment/dfmc/database/class-objects.dylan
==============================================================================
--- trunk/fundev/sources/environment/dfmc/database/class-objects.dylan	(original)
+++ trunk/fundev/sources/environment/dfmc/database/class-objects.dylan	Fri Apr 13 01:33:33 2007
@@ -39,17 +39,7 @@
   let context = browsing-context(server, class-definition);
   let direct-superclasses = class-definition.class-definition-superclass-types;
   do(method (superclass-type) => ()
-       let type-object
-         = select (superclass-type)
-	     #t => 
-	       $complex-type-expression-object;
-	     otherwise =>
-	       let superclass
-		 = variable-active-definition(context, superclass-type);
-	       superclass
-		 & make-environment-object-for-source-form
-		     (project-object, superclass);
-	   end;
+      let type-object = make-environment-object-for-type-expression(server, superclass-type);
        type-object & function(type-object)
      end,
      direct-superclasses)

Modified: trunk/fundev/sources/environment/dfmc/database/function-objects.dylan
==============================================================================
--- trunk/fundev/sources/environment/dfmc/database/function-objects.dylan	(original)
+++ trunk/fundev/sources/environment/dfmc/database/function-objects.dylan	Fri Apr 13 01:33:33 2007
@@ -148,16 +148,23 @@
     (server :: <dfmc-database>, object :: <method-object>)
  => (specializers :: <sequence>)
   let specializers = make(<stretchy-vector>);
-  do-method-definition-specializers
-    (method (type :: false-or(<definition>))
-       add!(specializers,
-	    if (type)
-	      make-environment-object-for-source-form(server, type)
-	    else
-	      $complex-type-expression-object
-	    end)
-     end,
-     server, object.compiler-object-proxy);
+  let definition = object.compiler-object-proxy;
+  let context = browsing-context(server, definition);
+
+  let req-types //...rest-type, next-type, key-types, value-types, rest-value-type)
+    = functional-parameter-types(definition);
+  if (req-types)
+    for (type in req-types)
+      add!(specializers, make-environment-object-for-type-expression(server, type));
+    end
+  else
+    let req-vars //...rest-var, next-var, key-vars, value-vars, rest-value-var)
+      = functional-parameters(definition);
+    let object-class-definition = find-<object>(server);
+    for (i from 0 below size(req-vars))
+      add!(specializers, object-class-definition)
+    end
+  end;
   specializers
 end method method-specializers;
 

Modified: trunk/fundev/sources/environment/protocols/expression-objects.dylan
==============================================================================
--- trunk/fundev/sources/environment/protocols/expression-objects.dylan	(original)
+++ trunk/fundev/sources/environment/protocols/expression-objects.dylan	Fri Apr 13 01:33:33 2007
@@ -23,9 +23,6 @@
 define sealed class <complex-type-expression-object> (<type-expression-object>)
 end class <complex-type-expression-object>;
 
-define constant $complex-type-expression-object :: <complex-type-expression-object>
-  = make(<complex-type-expression-object>,
-         compiler-object-proxy: vector(#"complex-type-expression-object"));
 
 
 /// Naming

Modified: trunk/fundev/sources/environment/protocols/module.dylan
==============================================================================
--- trunk/fundev/sources/environment/protocols/module.dylan	(original)
+++ trunk/fundev/sources/environment/protocols/module.dylan	Fri Apr 13 01:33:33 2007
@@ -198,7 +198,7 @@
   // Dylan expression objects
   export <expression-object>,
          <type-expression-object>,
-         $complex-type-expression-object;
+         <complex-type-expression-object>;
 
   // Dylan application objects
   export <character-object>,

Modified: trunk/fundev/sources/environment/reports/test-suite-report.dylan
==============================================================================
--- trunk/fundev/sources/environment/reports/test-suite-report.dylan	(original)
+++ trunk/fundev/sources/environment/reports/test-suite-report.dylan	Fri Apr 13 01:33:33 2007
@@ -87,14 +87,9 @@
 	   otherwise         => "variable";
 	 end,
 	 name);
-  select (type)
-    $complex-type-expression-object => 
-      format(stream, "<object>");
-    otherwise =>
-      //---*** What to do with unexported types?
-      print-environment-object-name
-	(stream, project, type, qualify-names?: #f);
-  end;
+  //---*** What to do with unexported types?
+  print-environment-object-name
+    (stream, project, type, qualify-names?: #f);
   format(stream, ");\n")
 end method write-binding-spec;
 
@@ -107,13 +102,11 @@
   let separator = "";
   format(stream, "  class %s (", name);
   for (superclass in class-direct-superclasses(project, class))
-    unless (superclass == $complex-type-expression-object)
-      format(stream, "%s", separator);
-      //---*** What to do with unexported types?
-      print-environment-object-name
-	(stream, project, superclass, qualify-names?: #f);
-      separator := ", "
-    end
+    format(stream, "%s", separator);
+    //---*** What to do with unexported types?
+    print-environment-object-name
+      (stream, project, superclass, qualify-names?: #f);
+    separator := ", "
   end;
   format(stream, ");\n")
 end method write-binding-spec;

Modified: trunk/fundev/sources/environment/tools/environment-frames.dylan
==============================================================================
--- trunk/fundev/sources/environment/tools/environment-frames.dylan	(original)
+++ trunk/fundev/sources/environment/tools/environment-frames.dylan	Fri Apr 13 01:33:33 2007
@@ -1185,7 +1185,7 @@
 	let describable?    = frame-describe-object?(frame, object);
 	let documentable?   = frame-document-object?(frame, object);
 	let browsable?      = frame-browse-object?(frame, object);
-	let type-browsable? = type & type ~== $complex-type-expression-object;
+	let type-browsable? = type & (~ instance?(type, <complex-type-expression-object>));
 	let generic?
 	  = instance?(object, <method-object>)
 	      & method-generic-function(project, object) ~= #f;

Modified: trunk/fundev/sources/environment/tools/object-browser.dylan
==============================================================================
--- trunk/fundev/sources/environment/tools/object-browser.dylan	(original)
+++ trunk/fundev/sources/environment/tools/object-browser.dylan	Fri Apr 13 01:33:33 2007
@@ -611,7 +611,7 @@
     (project :: <project-object>, object :: <environment-object>, #key page)
  => (success? :: <boolean>)
   let type = environment-object-type(project, object);
-  if (type & type ~== $complex-type-expression-object)
+  if (type)
     find-environment-frame(default-port(),
 			   <object-browser>,
 			   project: project,