Added array parameters.

Added accumulator parameters - needs a bit more error checking.
Preliminary support for aliasing parameters - disabled until it works
properly.

Tom


git-svn-id: http://svn.cactuscode.org/flesh/trunk@2829 17b73243-c579-4c4c-a9d2-2d5706c11dac

4 files changed, 276 insertions, 33 deletions

diff --git a/lib/sbin/CreateParameterBindings.pl b/lib/sbin/CreateParameterBindings.pl
index e2f7819b..dc1b0d02 100644
--- a/lib/sbin/CreateParameterBindings.pl
+++ b/lib/sbin/CreateParameterBindings.pl
@@ -228,8 +228,16 @@ sub CreateParameterBindings
         $type = $rhparameter_db->{"\U$friend_thorn $parameter\E type"};
         $type_string = &get_c_type_string($type);
 
-        push(@data, "  const $type_string$parameter = RESTRICTED_\U$friend\E_STRUCT.$parameter; \\");
-        push(@use, "  (void) ($parameter + 0); \\");
+        # See if we are sharing it AS something
+        my $name = $rhparameter_db->{"\U$thorn $parameter\E alias"};
+
+        if(! $name)
+        {
+          $name = "$parameter";
+        }
+
+        push(@data, "  const $type_string$name = RESTRICTED_\U$friend\E_STRUCT.$parameter; \\");
+        push(@use, "  (void) ($name + 0); \\");
       }
     }
 
@@ -321,6 +329,7 @@ sub NewParamStuff
   my($filelist);
   my(@creationdata);
   my(@extensiondata);
+  my(@accumulationdata);
   my(@data);
 
   foreach $thorn (split(' ',$rhinterface_db->{'THORNS'}))
@@ -337,6 +346,8 @@ sub NewParamStuff
     push(@data, '');
     push(@data, '');
 
+    push(@data, '#include <stdio.h>');
+    push(@data, '#include <stdlib.h>');
     push(@data, '#include <stdarg.h>');
     push(@data, '');
     push(@data, '#include "cctk_Config.h"');
@@ -369,6 +380,7 @@ sub NewParamStuff
 
 #        print "Generating $block parameters for $thorn, providing $imp\n";
         push(@creationdata,&CreateParameterRegistrationStuff($block, $thorn, $imp, $rhparameter_db, %these_parameters));
+        push(@accumulationdata,&CreateParameterAccumulationStuff($block, $thorn, $rhparameter_db, %these_parameters));
       }
     }
 
@@ -402,6 +414,7 @@ sub NewParamStuff
     push(@data, '{');
 
     push(@data, @extensiondata);
+    push(@data, @accumulationdata);
 
     push(@data, '  return 0;');
     push(@data, '}');
@@ -413,6 +426,7 @@ sub NewParamStuff
     @data=();
     @creationdata=();
     @extensiondata=();
+    @accumulationdata=();
 
     $filelist .= " Create${thorn}Parameters.c";
   }
@@ -453,20 +467,20 @@ sub CreateParameterRegistrationStuff
 
 #    print "This param is $parameter\n";
 
-    $type = $rhparameter_db->{"\U$thorn $parameter\E type"};
+    my $type = $rhparameter_db->{"\U$thorn $parameter\E type"};
 
 #    print "Type is $type\n";
 
-    $n_ranges = $rhparameter_db->{"\U$thorn $parameter\E ranges"};
+    my $n_ranges = $rhparameter_db->{"\U$thorn $parameter\E ranges"};
 
 #    print "N_ranges is $n_ranges\n";
 
-    $quoted_default = $rhparameter_db->{"\U$thorn $parameter\E default"};
+    my $quoted_default = $rhparameter_db->{"\U$thorn $parameter\E default"};
 
 #    $quoted_default =~ s:\"::g;  The database now strips all unescaped quotes.
 
     # Set steerable details
-    $steerable = $rhparameter_db->{"\U$thorn $parameter\E steerable"};
+    my $steerable = $rhparameter_db->{"\U$thorn $parameter\E steerable"};
     if ($steerable =~ /never/i || $steerable =~/^$/)
     {
       $steerable_type = 'CCTK_STEERABLE_NEVER';
@@ -485,6 +499,34 @@ sub CreateParameterRegistrationStuff
       &CST_error(0,$message,'',__LINE__,__FILE__);
     }
 
+    my $array_size = $rhparameter_db->{"\U$thorn $parameter\E array_size"};
+
+    my $dereference = '';
+
+    if(! $array_size)
+    {
+      $array_size = 0;
+      $dereference = '&'
+    }
+
+    my $accumulator_expression = $rhparameter_db->{"\U$thorn $parameter\E accumulator-expression"};
+
+    if(! $accumulator_expression)
+    {
+      $accumulator_expression = 'NULL';
+    }
+    else
+    {
+      $accumulator_expression = "\"$accumulator_expression\"";
+    }
+
+#    my $accumulator_base = $rhparameter_db->{"\U$thorn $parameter\E accumulator-base"};
+#
+#    if(! $accumulator_expression)
+#    {
+#      $accumulator_base = 'NULL';
+#    }
+
     $line="  CCTKi_ParameterCreate(\"$parameter\",\n" .
           "                        \"$thorn\",\n" .
           "                        \"$type\",\n" .
@@ -492,7 +534,10 @@ sub CreateParameterRegistrationStuff
           "                        $steerable_type,\n" .
           "                        " . $rhparameter_db->{"\U$thorn $parameter\E description"} . ",\n" .
           "                        \"" . $quoted_default . "\",\n" .
-          "                        &($structure.$parameter),\n" .
+          "                        $dereference($structure.$parameter),\n" .
+          "                        $array_size,\n" .
+          "                        $accumulator_expression,\n" .
+#          "                        $accumulator_base,\n" .
           "                        $n_ranges";
 
     for($range=1; $range <= $n_ranges; $range++)
@@ -570,4 +615,37 @@ sub CreateParameterExtensionStuff
   return @data;
 }
 
+sub CreateParameterAccumulationStuff
+{
+  my($block, $thorn, $rhparameter_db, %these_parameters) = @_;
+  my(@data);
+
+  @data = ();
+
+  foreach $parameter (sort keys %these_parameters)
+  {
+    my $accumulator_base = $rhparameter_db->{"\U$thorn $parameter\E accumulator-base"};
+
+    if($accumulator_base)
+    {
+
+      print "accumulator_base = $accumulator_base\n";
+
+      $accumulator_base =~ m/([^:]+)::(.+)/;
+
+      my $importhorn = $1;
+      my $accparam   = $2;
+
+      push(@data, "  CCTKi_ParameterAccumulatorBase(\"$thorn\",");
+      push(@data, "                          \"$parameter\",");
+      push(@data, "                          \"$importhorn\",");
+      push(@data, "                          \"$accparam\");");
+      push(@data, "");
+    }
+  }
+
+  return @data;
+}
+
+
 1;
diff --git a/lib/sbin/create_c_stuff.pl b/lib/sbin/create_c_stuff.pl
index 9618fcae..99bb78c3 100644
--- a/lib/sbin/create_c_stuff.pl
+++ b/lib/sbin/create_c_stuff.pl
@@ -37,10 +37,19 @@ sub CreateParameterBindingFile
 
   foreach $parameter (&order_params($rhparameters,$rhparameter_db))
   {
-    $type = $rhparameter_db->{"\U$rhparameters->{$parameter} $parameter\E type"};
-    $type_string = &get_c_type_string($type);
+    my $type = $rhparameter_db->{"\U$rhparameters->{$parameter} $parameter\E type"};
+    my $type_string = &get_c_type_string($type);
+
+    my $array_size = $rhparameter_db->{"\U$rhparameters->{$parameter} $parameter\E array_size"};
+
+    my $suffix = '';
+
+    if($array_size)
+    {
+      $suffix = "[$array_size]";
+    }
 
-    push(@data, "  $type_string$parameter;");
+    push(@data, "  $type_string$parameter$suffix;");
   }
 
   # Some compilers don't like an empty structure.
@@ -171,12 +180,30 @@ sub CreateCStructureParameterHeader
 
   foreach $parameter (&order_params($rhparameters, $rhparameter_db))
   {
-    $type = $rhparameter_db->{"\U$rhparameters->{$parameter} $parameter\E type"};
-    $type_string = &get_c_type_string($type);
+    my $type = $rhparameter_db->{"\U$rhparameters->{$parameter} $parameter\E type"};
+    my $type_string = &get_c_type_string($type);
+
+    my $array_size = $rhparameter_db->{"\U$rhparameters->{$parameter} $parameter\E array_size"};
+
+    my $suffix = '';
+    my $prefix = '';
+
+    if($array_size)
+    {
+      $prefix = '*';
+      $suffix = "[$array_size]";
+    }
+
+    my $name = $rhparameter_db->{"\U$rhparameters->{$parameter} $parameter\E alias"};
+
+    if(! $name)
+    {
+      $name = "$parameter";
+    }
 
-    push(@data, "  $type_string $parameter;");
-    push(@definition, "  const $type_string $parameter = $structure.$parameter; \\");
-    push(@use, "  (void) ($parameter + 0); \\");
+    push(@data, "  $type_string $parameter$suffix;");
+    push(@definition, "  const $type_string $prefix$name = $structure.$parameter; \\");
+    push(@use, "  (void) ($name + 0); \\");
   }
 
   # Some compilers don't like an empty structure.
diff --git a/lib/sbin/create_fortran_stuff.pl b/lib/sbin/create_fortran_stuff.pl
index 2e3c881c..1bd517a4 100644
--- a/lib/sbin/create_fortran_stuff.pl
+++ b/lib/sbin/create_fortran_stuff.pl
@@ -84,9 +84,18 @@ sub CreateFortranThornParameterBindings
     foreach $parameter (sort(keys %these_parameters))
     {
       # Alias the parameter unless it is one we want.
-      if(($rhparameter_db->{"\U$thorn SHARES $friend\E variables"} =~ m:( )*$parameter( )*:) && (length($1) > 0)||length($2)>0||$1 eq $rhparameter_db->{"\U$thorn SHARES $friend\E variables"})
+      if(($rhparameter_db->{"\U$thorn SHARES $friend\E variables"} =~ m:( )*$parameter( )*:) && 
+         (length($1) > 0)||length($2)>0||$1 eq $rhparameter_db->{"\U$thorn SHARES $friend\E variables"})
       {
-        $alias_names{$parameter} = $parameter;
+        # See if we are sharing it AS something
+        my $name = $rhparameter_db->{"\U$thorn $parameter\E alias"};
+
+        if(! $name)
+        {
+          $name = "$parameter";
+        }
+
+        $alias_names{$parameter} = $name;
       }
       else
       {
@@ -136,18 +145,34 @@ sub CreateFortranCommonDeclaration
 
   foreach $parameter (&order_params($rhparameters,$rhparameter_db))
   {
-    $type = $rhparameter_db->{"\U$rhparameters->{$parameter} $parameter\E type"};
+    my $type = $rhparameter_db->{"\U$rhparameters->{$parameter} $parameter\E type"};
+
+    my $type_string = &get_fortran_type_string($type);
+
+    my $array_size = $rhparameter_db->{"\U$rhparameters->{$parameter} $parameter\E array_size"};
+
+    my $suffix = '';
 
-    $type_string = &get_fortran_type_string($type);
+    if($array_size)
+    {
+      $suffix = "($array_size)";
+    }
 
     if($aliases == 0)
     {
-      $line = "$type_string $parameter";
-      $definition .= "$sepchar$parameter";
+      my $name = $rhparameter_db->{"\U$rhparameters->{$parameter} $parameter\E alias"};
+
+      if(! $name)
+      {
+        $name = "$parameter";
+      }
+      
+      $line = "$type_string $name$suffix";
+      $definition .= "$sepchar$name";
     }
     else
     {
-      $line = "$type_string $rhaliases->{$parameter}";
+      $line = "$type_string $rhaliases->{$parameter}$suffix";
       $definition .= "$sepchar$rhaliases->{$parameter}";
     }
 
diff --git a/lib/sbin/parameter_parser.pl b/lib/sbin/parameter_parser.pl
index c7d59da9..0af8bed7 100644
--- a/lib/sbin/parameter_parser.pl
+++ b/lib/sbin/parameter_parser.pl
@@ -145,15 +145,17 @@ sub parse_param_ccl
         $parameter_db{"\U$thorn $block\E variables"} = "";
       }
     }
-    elsif($line =~ m:(EXTENDS |USES )?\s*(?\:CCTK_)?(INT|REAL|BOOLEAN|KEYWORD|STRING)\s+([a-zA-Z]+[a-zA-Z0-9_]*)(\s+\"[^\"]*\")?\s*(.*)$:i)
+    elsif($line =~ m:(EXTENDS |USES )?\s*(?\:CCTK_)?(INT|REAL|BOOLEAN|KEYWORD|STRING)\s+([a-zA-Z]+[a-zA-Z0-9_]*)(\[([^]]+)\])?(\s+\"[^\"]*\")?\s*(.*)$:i)
     {
       # This is a parameter definition.
 
-      $use_or_extend = $1;
-      $type = "\U$2\E";
-      $variable = $3;
-      $description = $4;
-      $options = $5;
+      my $use_or_extend = $1;
+      my $type = "\U$2\E";
+      my $variable = $3;
+      my $array_size = $5;
+      my $description = $6;
+      my $options = $7;
+
       $description =~ s:^\s*::;
 
       if($use_or_extend =~ m:USES:i)
@@ -228,6 +230,31 @@ sub parse_param_ccl
         }
 
         # Parse the options
+
+        # First deal with an alias
+#         if($options =~ m/\bAS\s+([^\s]+)\s*/i)
+#         {
+#           my $alias = $1;
+
+#           if($alias !~ m/[a-zA-Z]+[a-zA-Z0-9_]*/)
+#           {
+#             $message = "Invalid alias name '$alias' for  $variable of thorn $thorn";
+#             &CST_error(0,$message,"",__LINE__,__FILE__);
+#           }
+#           elsif($defined_parameters{"\U$alias\E"})
+#           {
+#             $message = "Invalid alias name '$alias' for $variable of thorn $thorn - parameter of that name already exists";
+#             &CST_error(0,$message,"",__LINE__,__FILE__);
+#           }
+#           else
+#           {
+#             $parameter_db{"\U$thorn $variable\E alias"} = $alias;
+#           }
+
+#           $options =~ s/\bAS\s+([^\s])+\s*//i;
+#         }
+
+        # Now parse options of the form option = value
         %options = split(/\s*=\s*|\s+/, $options);
       
         foreach $option (keys %options)
@@ -236,16 +263,98 @@ sub parse_param_ccl
           {
             $parameter_db{"\U$thorn $variable\E steerable"} = $options{$option};
           }
+          elsif($option =~ m:ACCUMULATOR-BASE:i)
+          {
+            if($options{$option} =~ m/[a-zA-Z]+[a-zA-Z0-9_]*::([a-zA-Z]+[a-zA-Z0-9_]*)/)
+            {
+              if($defined_parameters{"\U$1\E"})
+              {
+                $parameter_db{"\U$thorn $variable\E accumulator-base"} = $options{$option};
+              }
+              else
+              {
+                $message = "Unknown parameter '$options{$option}' specified as accumulator-base of $variable of thorn $thorn\n" .
+                           "   HINT: if it comes from another thorn it must be shared";
+                &CST_error(0,$message,"",__LINE__,__FILE__);
+              }
+            }
+            elsif($options{$option} =~ m/[a-zA-Z]+[a-zA-Z0-9_]*/)
+            {
+              $parameter_db{"\U$thorn $variable\E accumulator-base"} = "$thorn\::$options{$option}";
+            }
+            else
+            {
+              $message = "Invalid accumulator-base $options{$option} for  $variable of thorn $thorn";
+              &CST_error(0,$message,"",__LINE__,__FILE__);
+            }              
+          }
+          elsif($option =~ m:ACCUMULATOR:i)
+          {
+            my $retcode = &CheckExpression($options{$option});
+
+            if($retcode == 0)
+            {
+              $parameter_db{"\U$thorn $variable\E accumulator-expression"} = $options{$option};
+            }
+            elsif($retcode == 1)
+            {
+              $message = "Invalid accumulator expression '$options{$option}' for $variable of thorn $thorn";
+              &CST_error(0,$message,"",__LINE__,__FILE__);
+            }
+            elsif($retcode == 2)
+            {
+              $message = "Arithmetic error in accumulator expression '$options{$option}' for $variable of thorn $thorn";
+              &CST_error(0,$message,"",__LINE__,__FILE__);
+            }
+            elsif($retcode == 3)
+            {
+              $message = "Accumulator expression '$options{$option}' can be infinite for $variable of thorn $thorn";
+              &CST_error(0,$message,"",__LINE__,__FILE__);
+            }
+            elsif($retcode == 4)
+            {
+              $message = "Accumulator expression '$options{$option}' does not commute for $variable of thorn $thorn";
+              &CST_error(0,$message,"",__LINE__,__FILE__);
+            }
+            else
+            {
+              $message = "Internal-error while checking accumulator expression '$options{$option}' for $variable of thorn $thorn";
+              &CST_error(0,$message,"",__LINE__,__FILE__);
+            }
+          }
           else
           {
-            $message = "Unknown option $option for parameter $variable of thorn $thorn";
+            $message = "Unknown option '$option' for parameter $variable of thorn $thorn";
             &CST_error(0,$message,"",__LINE__,__FILE__);
           }
         }
+        
+        # Check array size
+
+        if($array_size)
+        {
+          if($array_size !~ /^\d+$/)
+          {
+            $message = "Invalid array size '$array_size' for parameter $variable of thorn $thorn";
+            &CST_error(0,$message,"",__LINE__,__FILE__);
+          }
+          else
+          {
+            $parameter_db{"\U$thorn $variable\E array_size"} = $array_size;
+          }
+        }
 
         # Store data about this variable.
-        $defined_parameters{"\U$variable\E"} = 1;
-        
+
+        if($alias)
+        {
+          $defined_parameters{"\U$alias\E"} = 1;
+        }
+        else
+        {
+          $defined_parameters{"\U$variable\E"} = 1;
+        }
+
         $parameter_db{"\U$thorn $block\E variables"} .= $variable." ";
         $parameter_db{"\U$thorn $variable\E type"} = $type;
         $parameter_db{"\U$thorn $variable\E description"} = $description;
@@ -605,6 +714,7 @@ sub CheckParameterDefault
 #  @vdesc   The expression to verify
 #  @vtype   string
 #  @vio     in
+#  @endvar
 #
 #  @returntype int
 #  @returndesc
@@ -644,12 +754,12 @@ sub CheckExpression
     # Calculate L(L(a,b),c).
     my $answer1 = &EvalExpression(&EvalExpression($a,$b,"$expression"),$c,$expression);
     
-    print "$answer1\n" if defined $answer1;
+#    print "$answer1\n" if defined $answer1;
     
     # Calculate L(L(a,c),b).
     my $answer2 = &EvalExpression(&EvalExpression($a,$c,"$expression"),$b,$expression);
     
-    print "$answer2\n" if defined $answer2;
+#    print "$answer2\n" if defined $answer2;
     
     if( !defined $answer1 || ! defined $answer2)
     {
@@ -695,14 +805,17 @@ sub CheckExpression
 #  @vdesc   An argument in the expression
 #  @vtype   scalar
 #  @vio     in
+#  @endvar
 #  @var     y
 #  @vdesc   An argument in the expression
 #  @vtype   scalar
 #  @vio     in
+#  @endvar
 #  @var     expression
 #  @vdesc   The expression to evaluate
 #  @vtype   string
 #  @vio     in
+#  @endvar
 #
 #  @returntype scalar
 #  @returndesc