#!/usr/bin/env jed-script
implements ("codegen");

if (__argc < 3)
{
   () = fprintf (stderr, "Usage: %s module-name files....\n", __argv[0]);
   exit (1);
}
private variable Module_Name = __argv[1];

% Customize Here
private variable Func_RE = "gsl_[a-zA-Z_0-9]+";
private variable DConst_REs = ["GSL_CONST_[A-Z_0-9]+"];

private variable Type_Map = Assoc_Type[String_Type];
Type_Map["double"] = "D";
Type_Map["int"] = "I";
Type_Map["float"] = "F";
Type_Map["gsl_mode_t"] = "M";
Type_Map["complex"] = "C";

private variable Excluded_Functions =
  ["min", "max", "exp", "cos", "sin", "tan",
   "atanh", "asinh", "acosh", "log", "multiply"];
private variable Excluded_Functions_SLang2 =
  ["hypot"];

private variable Document_Sections = NULL;

private define add_function_doc_section (title, regexp)
{
   variable d = struct
     {
        regexp, section_title, function_docs, next
     };
   d.regexp = regexp;
   d.section_title = title;
   d.function_docs = Assoc_Type[];
   d.next = NULL;

   variable d0 = Document_Sections;
   if (d0 == NULL)
     {
        Document_Sections = d;
        return;
     }

   while (d0.next != NULL)
     d0 = d0.next;

   d0.next = d;
}

switch (Module_Name)
{
 case "gslsf":
   add_function_doc_section ("Airy Functions", "airy");
   add_function_doc_section ("Bessel Functions", "bessel");
   add_function_doc_section ("Beta Functions", "beta");
   add_function_doc_section ("Clausen Functions", "clausen");
   add_function_doc_section ("Conical Functions", "conical");
   add_function_doc_section ("Coulomb Functions", "hydrogenic");
   add_function_doc_section ("Coulomb Wave Functions", "coulomb");
   add_function_doc_section ("Debye Functions", "debye");
   add_function_doc_section ("Di/Tri and Polygamma Functions", "^psi");
   add_function_doc_section ("Elliptic Integrals", "ellint");
   add_function_doc_section ("Error Functions", "erf");
   add_function_doc_section ("Eta/Zeta Functions", "^[zh]?[z]?eta");
   add_function_doc_section ("Exponential Functions and Integrals", "exp");
   add_function_doc_section ("Factorial Functions", "fact");
   add_function_doc_section ("Fermi-Dirac Functions", "fermi_dirac");
   add_function_doc_section ("Gamma Functions", "gamma");
   add_function_doc_section ("Gegenbauer Functions", "gegen");
   add_function_doc_section ("Hypergeometric Functions", "^hyperg");
   add_function_doc_section ("Laguerre Functions", "^laguerre");
   add_function_doc_section ("Lambert Functions", "lambert");
   add_function_doc_section ("Legendre Functions and Spherical Harmonics", "legendre");
   add_function_doc_section ("Logarithm and Related Functions", "^log");
   add_function_doc_section ("Transport Functions", "^transport");
   %add_function_doc_section ("Jacobi Elliptic Functions", "elljac");
   add_function_doc_section ("Miscellaneous Functions", ".");
}
{
 case "gslcdf":
   add_function_doc_section ("PDF Functions", "_pdf$");
   add_function_doc_section ("CDF Functions", ".");
}
{
   add_function_doc_section (sprintf("%s Module Functions", Module_Name), ".");
}

private define make_intrinsic_name (name)
{
   variable re;
   foreach re ([`gsl_sf_\([a-zA-Z_0-9]+\)_complex_e`, `gsl_sf_complex_\([a-zA-Z_0-9]+\)_e`])
     {
	variable matches = string_matches (name, re);
	if (matches != NULL)
	  return matches[1] + "_complex";
     }

   if (0 == strncmp (name, "gsl_sf_", 7))
     return substr (name, 8, -1);

   if (0 == strncmp (name, "gsl_", 4))
     return substr (name, 5, -1);

   return name;
}

private define make_const_name (name)
{
   if (0 == strncmp (name, "GSL_CONST_", 10))
     {
	name = substr (name, 5, -1);
#iffalse
	if (0 == strncmp (name, "CONST_CGSM_", 11))
	  name = "CONST_CGS" + substr (name, 11, -1);
	else if (0 == strncmp (name, "CONST_MKSA_", 11))
	  name = "CONST_MKS" + substr (name, 11, -1);
#endif
     }
   return name;
}

% End of Customizations

% Documentation Functions
private define parse_prototype (prototype)
{
   % Assume form: "type fname (type parm, type parm, ...)"
   % Here, type is assumed to not contain spaces (by construction).
   variable type_names = strtok (prototype, ",()");
   variable argv = String_Type[length (type_names)];
   variable i = 0;
   foreach (type_names)
     {
	variable type_name = ();
	argv[i] = strtok (type_name, " \t")[1];
	i++;
     }
   return argv;
}

private define insert_function_doc_template (iname, fname, usage)
{
   vinsert ("\\function{%s}\n", iname);
   vinsert ("\\synopsis{S-Lang version of %s}\n", fname);

   if (strlen (usage) > 75)
     {
	vinsert ("\\usage{%s}", usage);
	() = bfind ("(");
	go_right(1);
	push_spot ();
	push_mark ();
	() = ffind (")");
	% Expect something like
	%   (Int_Type[] foo, Double_Type bar[])
	% or
	%   (Int_Type[] foo [,Int_Type mode])
	variable args = bufsubstr ();
	pop_spot ();
	push_mark ();
	while (ffind (" "))
	  {
	     del_region ();
	     del ();
	     skip_chars ("^[,)");
	     skip_chars ("[, ");
	     push_mark ();
	  }
	pop_mark (0);
	eol ();
	newline ();
	insert ("#v+\n");
	insert (args);
	bol ();
	insert ("  ");
	while (ffind (","))
	  {
	     if (blooking_at ("["))
	       {
		  go_left (1);
		  del ();
		  push_spot ();
		  () = ffind (" ");
		  () = ffind ("]");
		  del ();
		  pop_spot ();
	       }
	     del ();
	     newline ();
	     trim ();
	     insert ("  ");
	  }
	eol ();
	newline ();
	insert ("#v-\n");
     }
   else
     vinsert ("\\usage{%s}\n", usage);

   %insert ("\\description\n");
   %vinsert (" See \\url{%s} for more information.\n",
   %         "http://sources.redhat.com/gsl/ref/gsl-ref_toc.html");
   insert ("\\done\n\n");
}

private define write_function_documentation ()
{
   variable d = Document_Sections;

   while (d != NULL)
     {
        variable keys = assoc_get_keys (d.function_docs);
        if (length (keys) == 0)
          {
             () = fprintf (stderr, "Section %s has no documented functions\n",
                           d.section_title);
             d = d.next;
             continue;
          }

        vinsert ("\\function_sect{%s}\n", d.section_title);

        variable i = array_sort (array_map (String_Type, &strlow, keys));
        foreach (i)
          {
             i = ();
             variable k = keys[i];
             variable v = d.function_docs[k];
             insert_function_doc_template (k, v.fname, v.usage);
          }

        d = d.next;
     }
}

private define store_function_documentation (iname, fname, u)
{
   variable d;

   variable doc_struct = struct
     {
       fname, usage
     };

   doc_struct.fname = fname;
   doc_struct.usage = u;

   d = Document_Sections;
   while (d != NULL)
     {
        if (string_match (iname, d.regexp, 1))
          {
             d.function_docs[iname] = doc_struct;
             return;
          }
        d = d.next;
     }

   d = Document_Sections;
   d.function_docs[iname] = doc_struct;
}

private variable Documented_Constants = Assoc_Type[String_Type];

private define write_constants_documentation ()
{
   variable constants = assoc_get_keys (Documented_Constants);
   constants = constants[array_sort (constants)];

   variable i = where (0 == array_map (Int_Type,
				       &strncmp, (constants, "CONST_MKSA_", 10)));

   insert ("\\begin_constant_sect{MKSA Constants}\n");
   foreach (constants[i])
     {
	variable c = ();
	vinsert ("\\constant{%s}\n", c);
     }
   insert ("\\end_constant_sect\n");

   constants = constants[array_sort (constants)];

   i = where (0 == array_map (Int_Type,
			      &strncmp, (constants, "CONST_CGSM_", 11)));

   insert ("\\begin_constant_sect{CGSM Constants}\n");
   foreach (constants[i])
     {
	c = ();
	vinsert ("\\constant{%s}\n", c);
     }
   insert ("\\end_constant_sect\n");

}

private define doc_fun_i_fd (iname, prototype)
{
   variable a = parse_prototype (prototype);
   variable fname = a[0];
   variable u;
   u = sprintf ("Int_Type[] %s (Double_Type[] %s)",
		iname, a[1]);
   store_function_documentation (iname, fname, u);
}

private define doc_fun_i_fdd (iname, prototype)
{
   variable a = parse_prototype (prototype);
   variable fname = a[0];
   variable u;
   u = sprintf ("Int_Type[] %s (Double_Type[] %s, Double_Type[] %s)",
		iname, a[1], a[2]);
   store_function_documentation (iname, fname, u);
}

private define doc_fun_d_fd (iname, prototype)
{
   variable a = parse_prototype (prototype);
   variable fname = a[0];
   variable u;
   u = sprintf ("Double_Type[] %s (Double_Type[] %s)",
		iname, a[1]);
   store_function_documentation (iname, fname, u);
}

private define doc_fun_d_fdd (iname, prototype)
{
   variable a = parse_prototype (prototype);
   variable fname = a[0];
   variable u;
   u = sprintf ("Double_Type[] %s (Double_Type[] %s, Double_Type[] %s)",
		iname, a[1], a[2]);
   store_function_documentation (iname, fname, u);
}

private define doc_fun_d_fddd (iname, prototype)
{
   variable a = parse_prototype (prototype);
   variable fname = a[0];
   variable u;
   u = sprintf ("Double_Type[] %s (Double_Type[] %s, Double_Type[] %s, Double_Type[] %s)",
		iname, a[1], a[2], a[3]);
   store_function_documentation (iname, fname, u);
}

private define doc_fun_d_fdddd (iname, prototype)
{
   variable a = parse_prototype (prototype);
   variable fname = a[0];
   variable u;
   u = sprintf ("Double_Type[] %s (Double_Type[] %s, Double_Type[] %s, Double_Type[] %s, Double_Type[] %s)",
		iname, a[1], a[2], a[3], a[4]);
   store_function_documentation (iname, fname, u);
}

private define doc_fun_d_fi (iname, prototype)
{
   variable a = parse_prototype (prototype);
   variable fname = a[0];
   variable u;
   u = sprintf ("Double_Type[] %s (Int_Type[] %s)",
		iname, a[1]);
   store_function_documentation (iname, fname, u);
}

private define doc_fun_d_fid (iname, prototype)
{
   variable a = parse_prototype (prototype);
   variable fname = a[0];
   variable u;
   u = sprintf ("Double_Type[] %s (Int_Type[] %s, Double_Type[] %s)",
		iname, a[1], a[2]);
   store_function_documentation (iname, fname, u);
}

private define doc_fun_d_fidd (iname, prototype)
{
   variable a = parse_prototype (prototype);
   variable fname = a[0];
   variable u;
   u = sprintf ("Double_Type[] %s (Int_Type[] %s, Double_Type[] %s, Double_Type[] %s)",
		iname, a[1], a[2], a[3]);
   store_function_documentation (iname, fname, u);
}

private define doc_fun_d_fiid (iname, prototype)
{
   variable a = parse_prototype (prototype);
   variable fname = a[0];
   variable u;
   u = sprintf ("Double_Type[] %s (Int_Type[] %s, Int_Type[] %s, Double_Type[] %s)",
		iname, a[1], a[2], a[3]);
   store_function_documentation (iname, fname, u);
}

private define doc_fun_d_fiidd (iname, prototype)
{
   variable a = parse_prototype (prototype);
   variable fname = a[0];
   variable u;
   u = sprintf ("Double_Type[] %s (Int_Type[] %s, Int_Type[] %s, Double_Type[] %s, Double_Type[] %s)",
		iname, a[1], a[2], a[3], a[4]);
   store_function_documentation (iname, fname, u);
}

private define doc_fun_d_fiii (iname, prototype)
{
   variable a = parse_prototype (prototype);
   variable fname = a[0];
   variable u;
   u = sprintf ("Double_Type[] %s (Int_Type[] %s, Int_Type[] %s, Int_Type[] %s)",
		iname, a[1], a[2], a[3]);
   store_function_documentation (iname, fname, u);
}

private define doc_fun_i_fdm (iname, prototype)
{
   variable a = parse_prototype (prototype);
   variable fname = a[0];
   variable u;
   u = sprintf ("Int_Type[] %s (Double_Type[] %s [,Int_Type %s])",
		iname, a[1], a[2]);
   store_function_documentation (iname, fname, u);
}

private define doc_fun_i_fddm (iname, prototype)
{
   variable a = parse_prototype (prototype);
   variable fname = a[0];
   variable u;
   u = sprintf ("Int_Type[] %s (Double_Type[] %s, Double_Type %s [,Int_Type %s])",
		iname, a[1], a[2], a[3]);
   store_function_documentation (iname, fname, u);
}

private define doc_fun_d_fdm (iname, prototype)
{
   variable a = parse_prototype (prototype);
   variable fname = a[0];
   variable u;
   u = sprintf ("Double_Type[] %s (Double_Type[] %s [,Int_Type %s])",
		iname, a[1], a[2]);
   store_function_documentation (iname, fname, u);
}

private define doc_fun_d_fddm (iname, prototype)
{
   variable a = parse_prototype (prototype);
   variable fname = a[0];
   variable u;
   u = sprintf ("Double_Type[] %s (Double_Type[] %s, Double_Type[] %s [,Int_Type %s])",
		iname, a[1], a[2], a[3]);
   store_function_documentation (iname, fname, u);
}

private define doc_fun_d_fdddm (iname, prototype)
{
   variable a = parse_prototype (prototype);
   variable fname = a[0];
   variable u;
   u = sprintf ("Double_Type[] %s (Double_Type[] %s, Double_Type[] %s, Double_Type[] %s [,Int_Type %s])",
		iname, a[1], a[2], a[3], a[4]);
   store_function_documentation (iname, fname, u);
}

private define doc_fun_d_fddddm (iname, prototype)
{
   variable a = parse_prototype (prototype);
   variable fname = a[0];
   variable u;
   u = sprintf ("Double_Type[] %s (Double_Type[] %s, Double_Type[] %s, Double_Type[] %s, Double_Type[] %s [,Int_Type %s])",
		iname, a[1], a[2], a[3], a[4], a[5]);
   store_function_documentation (iname, fname, u);
}

private define doc_fun_d_fim (iname, prototype)
{
   variable a = parse_prototype (prototype);
   variable fname = a[0];
   variable u;
   u = sprintf ("Double_Type[] %s (Int_Type[] %s [,Int_Type %s])",
		iname, a[1], a[2]);
   store_function_documentation (iname, fname, u);
}

private define doc_fun_d_fidm (iname, prototype)
{
   variable a = parse_prototype (prototype);
   variable fname = a[0];
   variable u;
   u = sprintf ("Double_Type[] %s (Int_Type[] %s, Double_Type[] %s [,Int_Type %s])",
		iname, a[1], a[2], a[3]);
   store_function_documentation (iname, fname, u);
}

private define doc_fun_d_fiddm (iname, prototype)
{
   variable a = parse_prototype (prototype);
   variable fname = a[0];
   variable u;
   u = sprintf ("Double_Type[] %s (Int_Type[] %s, Double_Type[] %s, Double_Type[] %s [,Int_Type %s])",
		iname, a[1], a[2], a[3], a[4]);
   store_function_documentation (iname, fname, u);
}

private define doc_fun_d_fiidm (iname, prototype)
{
   variable a = parse_prototype (prototype);
   variable fname = a[0];
   variable u;
   u = sprintf ("Double_Type[] %s (Int_Type[] %s, Int_Type[] %s, Double_Type[] %s [,Int_Type %s])",
		iname, a[1], a[2], a[3], a[4]);
   store_function_documentation (iname, fname, u);
}

private define doc_fun_d_fiiim (iname, prototype)
{
   variable a = parse_prototype (prototype);
   variable fname = a[0];
   variable u;
   u = sprintf ("Double_Type[] %s (Int_Type[] %s, Int_Type[] %s, Int_Type[] %s [,Int_Type %s])",
		iname, a[1], a[2], a[3], a[4]);
   store_function_documentation (iname, fname, u);
}

% Complex special functions
private define doc_fun_c_fc (iname, prototype)
{
   variable a = parse_prototype(prototype);
   variable fname = a[0];
   variable u;
   u = sprintf("Complex_Type[] %s (Complex_Type[])",
	       iname, a[1]);
   store_function_documentation (iname, fname, u);
}


% End Documentation Functions
private variable Exclude_List = Assoc_Type[Int_Type,0];
foreach (Excluded_Functions)
{
   $1 = ();
   Exclude_List[$1] = 1;
}

private variable Exclude_List_SLang2 = Assoc_Type[Int_Type,0];
foreach (Excluded_Functions_SLang2)
{
   $1 = ();
   Exclude_List_SLang2[$1] = 1;
}

private variable Include_Files = Assoc_Type[Int_Type];
private define store_function (r, fname, file, prototype)
{
   if (fname == strup (fname))
     {
	vmessage ("Excluding possible macro %s in %s", fname, file);
	return;			       %  could be a macro
     }

   variable iname = make_intrinsic_name (fname);
   if (Exclude_List[iname])
     return;

   Include_Files[path_basename(file)] = 1;
   if (Exclude_List_SLang2[iname])
     r.slang1_matches[iname] = fname;
   else
     r.matches [iname] = fname;
   r.prototypes [iname] = prototype;
}

private define store_constant (a, cname, file)
{
   variable iname = make_const_name (cname);
   Include_Files[path_basename(file)] = 1;
   a [iname] = cname;
   Documented_Constants[iname] = cname;
}

private variable Func_Regexps = NULL;
private variable DConst_Regexps = NULL;

private define special_ret_arg_translate (ret, arg)
{
   variable new_ret = NULL, new_arg = NULL;

   if (ret != NULL)
     {
        switch (ret)
        { case "complex":
	    new_ret = ["int"];
	    new_arg = ["gsl_sf_result *\\*", "gsl_sf_result *\\*"];
	}
     }
   else if (arg != NULL)
     {
        switch (arg)
        { case "complex":
	    new_arg = ["double", "double"];
	}
     }

   return new_ret, new_arg;
}


private define add_func_regexp (p)
{
   p = strchop (p, ',', 0);
   variable ret_type = p[0];
   variable args = p[[1:]];

   variable args_regexp = "";
   variable macro = sprintf ("%s_F", Type_Map[ret_type]);
   variable new_ret, new_arg, arg, narg;

   foreach arg (args)
     {
        (new_ret, new_arg) = special_ret_arg_translate(NULL, arg);
	if (NULL != new_arg)
          {
	     foreach narg (new_arg)
	       args_regexp += sprintf (", *\\<%s\\>[^,\\[\\]\\*)]*", narg);
	  }
        else
          {
	     args_regexp += sprintf (", *\\<%s\\>[^,\\[\\]\\*)]*", arg);
	  }
	macro += Type_Map[arg];
     }
   macro = strup (macro);

   (new_ret, new_arg) = special_ret_arg_translate(ret_type, NULL);
   if (NULL != new_ret)
     {
        ret_type = new_ret[0];
     }
   if (NULL != new_arg)
     {
        foreach narg (new_arg)
	  args_regexp += sprintf (", *\\<%s\\>[^,\\[\\]\\*)]*", narg);
     }

   args_regexp = args_regexp[[1:]];
   variable re = sprintf ("%s +\\(\\<%s\\>\\) *(%s)",
			  ret_type, qualifier("func_re", Func_RE), args_regexp);

   variable s = struct
     {
	re = re,
	macro = macro,
	matches = Assoc_Type[String_Type],
	slang1_matches = Assoc_Type[String_Type],
	prototypes = Assoc_Type[String_Type],
	document_func = __get_reference ("doc_fun_" + strlow(macro)),
	next = Func_Regexps,
     };

   if (s.document_func == NULL)
     vmessage ("Unable to find %s", "doc_fun_" + strlow(macro));

   Func_Regexps = s;
}

add_func_regexp ("int,double");
add_func_regexp ("int,double,double");
add_func_regexp ("double,double");
add_func_regexp ("double,double,double");
add_func_regexp ("double,double,double,double");
add_func_regexp ("double,double,double,double,double");
add_func_regexp ("double,int");
add_func_regexp ("double,int,double");
add_func_regexp ("double,int,double,double");

add_func_regexp ("double,int,int,double");
add_func_regexp ("double,int,int,double,double");
add_func_regexp ("double,int,int,int");

add_func_regexp ("int,double,gsl_mode_t");
add_func_regexp ("int,double,double,gsl_mode_t");
add_func_regexp ("double,double,gsl_mode_t");
add_func_regexp ("double,double,double,gsl_mode_t");
add_func_regexp ("double,double,double,double,gsl_mode_t");
add_func_regexp ("double,double,double,double,double,gsl_mode_t");
add_func_regexp ("double,int,gsl_mode_t");

add_func_regexp ("double,int,double,gsl_mode_t");
add_func_regexp ("double,int,double,double,gsl_mode_t");
add_func_regexp ("double,int,int,double,gsl_mode_t");
add_func_regexp ("double,int,int,int,gsl_mode_t");
%add_func_regexp ("int,int");
%add_func_regexp ("int,int,int");

%% complex special functions
add_func_regexp ("complex,complex"; func_re="gsl_[a-zA-Z_0-9]+_complex_e");
add_func_regexp ("complex,complex"; func_re="gsl_sf_complex_[a-zA-Z_0-9]+_e");

private define add_dconstant_regexp (pat)
{
   variable s = struct
     {
	re, matches, next
     };

   variable re = sprintf ("^ *# *define *\\(%s\\)\\>", pat);
   s.re = re;
   s.matches = Assoc_Type[String_Type];
   s.next = DConst_Regexps;

   DConst_Regexps = s;
}

foreach (DConst_REs)
{
   $1 = ();
   add_dconstant_regexp($1);
}

private define process_file (file)
{
   setbuf ("*scratch*");
   erase_buffer ();

   if (-1 == insert_file (file))
     {
        () = fprintf (stderr, "%s: Unable to insert %s--- skipping\n",
		      __argv[0], file);
	return;
     }
   c_mode ();

   % Get rid of tabs to make REs simpler
   bob ();
   replace ("\t", " ");
   % Get rid of the const qualifier
   bob ();
   while (re_fsearch ("\\<const\\>"))
     {
	push_mark ();
	skip_white ();
	go_right (5);
	skip_white ();
	del_region ();
     }

   variable r = Func_Regexps;
   while (r != NULL)
     {
	variable re = r.re;
	bob ();
	while (re_fsearch (re))
	  {
	     variable prototype = regexp_nth_match (0);
	     variable name = regexp_nth_match (1);
	     store_function (r, name, file, prototype);
	     eol ();
	  }
	r = r.next;
     }

   r = DConst_Regexps;
   while (r != NULL)
     {
	re = r.re;
	bob ();
	while (re_fsearch (re))
	  {
	     name = regexp_nth_match (1);
	     store_constant (r.matches, name, file);
	     eol ();
	  }
	r = r.next;
     }
}

private define find_tag (tag)
{
   bob ();
   !if (fsearch (tag))
     verror ("Unable to find %s tag", tag);

   delete_line ();
}

private define insert_copyright ()
{
   variable copyright;

   bob ();
   !if (fsearch ("<COPYRIGHT>"))
     return;

   delete_line ();

   copyright = NULL;
   foreach (["COPYRIGHT", "../COPYRIGHT"])
     {
	variable c = ();
	if (0 == file_status (c))
	  continue;

	copyright = c;
	break;
     }

   if (copyright == NULL)
     {
	vmessage ("Warning: COPYRIGHT file not found.\n");
	insert ("/* Copyright file goes here */\n");
	return;
     }

   insert ("/*\n");
   () = insert_file (copyright);
   insert ("*/\n");
}

private define sort_assoc (a)
{
   variable keys = assoc_get_keys (a);
   variable values = assoc_get_values (a);
   variable i = array_sort (keys);
   return keys[i], values[i];
}

private define dump_results (module_name)
{
   () = read_file (sprintf ("%s-module.c", module_name));
   erase_buffer ();
   () = insert_file ("template.c");

   bob ();
   replace ("<MODULE_NAME>", module_name);

   insert_copyright ();

   find_tag ("<MODULE_INCLUDES>");
   foreach (Include_Files) using ("keys")
     {
	variable inc_file = ();
	vinsert ("#include <gsl/%s>\n", inc_file);
     }

   find_tag ("<INTRINSIC_DEFINITIONS>");

   variable has_intrinsics = 0, has_dconstants = 0;

   variable fname, iname, i, keys, values;
   variable r = Func_Regexps;
   while (r != NULL)
     {
	variable macro = r.macro;
	(keys, values) = sort_assoc (r.matches);
	_for i (0, length(keys)-1, 1)
	  {
	     iname = keys[i];
	     fname = values[i];
	     vinsert ("%s(%s,\"%s\")\n", macro, fname, iname);
	     has_intrinsics++;
	  }
	r = r.next;
     }
#iffalse
   insert ("#if SLANG_VERSION < 20000\n");
   r = Func_Regexps;
   while (r != NULL)
     {
	macro = r.macro;
	foreach (r.slang1_matches) using ("keys", "values")
	  {
	     (iname, fname) = ();
	     vinsert ("%s(%s,\"%s\")\n", macro, fname, iname);
	     has_intrinsics++;
	  }
	r = r.next;
     }
   insert ("#endif /* SLANG_VERSION < 20000 */\n");
#endif
   find_tag ("<MODULE_INTRINSICS>");

   r = Func_Regexps;
   while (r != NULL)
     {
	(keys, values) = sort_assoc (r.matches);
	_for i (0, length(keys)-1, 1)
	  {
	     iname = keys[i];
	     fname = values[i];
	     vinsert ("   MAKE_INTRINSIC_0(\"%s\", SLF(%s), V),\n",
		      iname, fname);
	  }
	r = r.next;
     }
#iffalse
   insert ("#if SLANG_VERSION < 20000\n");
   r = Func_Regexps;
   while (r != NULL)
     {
	foreach (r.slang1_matches) using ("keys", "values")
	  {
	     (iname, fname) = ();
	     vinsert ("   MAKE_INTRINSIC_0(\"%s\", SLF(%s), V),\n",
		      iname, fname);
	  }
	r = r.next;
     }
   insert ("#endif /* SLANG_VERSION < 20000 */\n");
#endif
   find_tag ("<MODULE_VARIABLES>");
   % add code

   find_tag ("<MODULE_ICONSTANTS>");
   % add code

   find_tag ("<MODULE_DCONSTANTS>");
   r = DConst_Regexps;
   while (r != NULL)
     {
	(keys, values) = sort_assoc (r.matches);
	_for i (0, length(keys)-1, 1)
	  {
	     iname = keys[i];
	     fname = values[i];
	     vinsert ("#ifdef %s\n", fname);
	     vinsert ("   MAKE_DCONSTANT(\"%s\", %s),\n",
		      iname, fname);
	     vinsert ("#endif\n");
	     has_dconstants++;
	  }
	r = r.next;
     }

   find_tag ("MODULE_DEFINES");
   if (has_intrinsics)
     insert ("#define MODULE_HAS_INTRINSICS\n");
   if (has_dconstants)
     insert ("#define MODULE_HAS_DCONSTANTS\n");

   vinsert ("#define _%s_MODULE_C_", strup (module_name));

   save_buffer ();

   % Documentation

   () = read_file (sprintf ("%s-module.tm", module_name));
   erase_buffer ();

   r = Func_Regexps;
   while (r != NULL)
     {
	(keys, values) = sort_assoc (r.prototypes);
	_for i (0, length(keys)-1, 1)
	  {
	     %vinsert ("%s: %s: %s\n", macro, iname, prototype);
	     (@r.document_func)(keys[i], values[i]);
	  }
	r = r.next;
     }
   if (has_intrinsics) write_function_documentation ();

   if (has_dconstants) write_constants_documentation ();

   save_buffer ();
}

private define main ()
{
   variable module_name = Module_Name;

   foreach (__argv[[2:]])
     {
	variable file = ();
	process_file (file);
     }

   dump_results (module_name);
   exit (0);
}

main ();
