#!/usr/bin/perl
use warnings FATAL => 'all';
use strict;
use PARI::822;

my (%funcs, %Fun_by_sec);
PARI::822::read(\%funcs, "pari.desc");

open (FILE, "../../doc/usersFUNCS.tex") || die;
for (keys %funcs)
{ 
  my ($s) = $funcs{$_}->{Section};
  next if (!$s);
  push(@{$Fun_by_sec{$s}}, $_);
}
while (<FILE>)
{
  if (/^% *SECTION *: *(.*) */)
  {
    my ($sec) = $1;
    next if (!$Fun_by_sec{$sec});
    for ( sort @{$Fun_by_sec{$sec}} ) {
      my ($fun) = $funcs{$_};
      my ($doc) = $fun->{Doc};
      next if (!defined($doc));

      my ($args)  = $fun->{Help};
      my ($v);
      $doc =~ s/^[\n\t ]*(.)/uc($1)/e;
      $args =~ s/ *:.*//s;
      if (!$args || $args =~ /^\w+=\w+\(\)/) { $args = $v = ''; }
      else
      {
        $args =~ s/^[^(]*\((.*)\)/$1/; # args proper
        $v = $args;
        $v =~ s/([{}&])/\\$1/g;
        $v =~ s/\^(\d+)/^{$1}/g;
        $v =~ s/\[\]/[\\,]/g;
        $v =~ s/(\w\w+)/\\var{$1}/g;
        $v =~ s/\^([a-z])/\\hbox{\\kbd{\\pow}}$1/g;
        $v =~ s/\\var\{flag\}/\\fl/g;
        $v =~ s/\\var\{(\d+)\}/{$1}/g;
        $v =~ s/_/\\_/g; # don't merge with first subst: \var{} rule kills it

        $v = "\$($v)\$";
      }
      if ($doc !~ /\\syn\w*\{/ && $sec !~ /programming\/control/) {
        $doc .= library_syntax($fun, $args);
      }
      s/_def_//;
      my ($secname) = $_;
      my ($l) = ($fun->{Section} =~ 'default')? "def,$_": $_;
      my ($idx) = ($secname =~ s/_/\\_/g)? $l: $secname;
      print "\n\\subsec{$secname$v}\\kbdsidx{$idx}\\label{se:$l}\n$doc\n";
    }
  }
  print;
}

sub library_syntax { my ($fun, $args) = @_;
  return '' if ($fun->{Class} =~ /^(highlevel|gp|default|gp_default)$/);
  my ($Cname) = $fun->{'C-Name'};
  return '' if (!$Cname);
  my ($Variant) = $fun->{Variant};
  my (@proto) = split(//, $fun->{Prototype});
  $args =~ s/[{}&]//g;
  $args =~ s/ *=[^,\)]*//g; # delete default values
  my (@ARGS) = split(/[,^] */, $args); # ^ for O(p^e)
  my ($type) = "GEN";
  my (@vars)=();
  $args = '';
  for (my $i = 0; $i <= $#proto; )
  {
    my ($c) = $proto[$i++];
    if ($c eq 'l') { $type = "long"; next; }
    if ($c eq 'v') { $type = "void"; next; }

    if ($c =~ /^[GWIJE]$/) {$args .= ", GEN " . shift(@ARGS); next;}
    if ($c eq 'U') {$args .= ", ulong " . shift(@ARGS); next;}
    if ($c eq 'L') {$args .= ", long " . shift(@ARGS); next;}
    if ($c eq 'n') {my ($v) = shift(@ARGS); push @vars,"\\kbd{$v}";
                    $args .= ", long " . $v; next;}
    if ($c =~ /^[rs]$/) {$args .= ", const char *" . shift(@ARGS); next;}

    if ($c eq 'p') {$args .= ", long prec"; next;}
    if ($c eq 'b') {$args .= ", long bitprec"; next;}
    if ($c eq 'P') {$args .= ", long precdl"; next;}
    if ($c eq 'C') {$args .= ", GEN ctx"; next;}
    if ($c eq '') { next; }
    if ($c eq 'D') {
      $c = $proto[$i++];
      if ($c eq 'G') {$args .= ", GEN " . shift(@ARGS) ." = NULL"; next;}
      if ($c =~ /^[rs]$/) {$args .= ", const char *" . shift(@ARGS) ." = NULL"; next;}
      if ($c eq '&') {$args .= ", GEN *". shift(@ARGS) ." = NULL"; next;}
      if ($c eq 'P') {$args .= ", long precdl"; next;}
      if ($c eq 'n') {
        my ($v) = shift(@ARGS);
        $args .= ", long $v = -1";
        push @vars,"\\kbd{$v}";
        next;
      }
      if ($c eq 'V') {
        next;
      }
      if ($c =~ /^[EI]$/) {
        $args .= ", GEN ". shift(@ARGS) ." = NULL"; next;
      }
      while (($c = $proto[$i++]) ne ',') {}
    }
  }
  $args =~ s/^, //;

  my ($post);
  my ($l)=scalar @vars;
  if    ($l==0) { $post=''; }
  elsif ($l==1)
  {
    $post = " where $vars[0] is a variable number";
  }
  else
  {
    my ($vl)=join(", ",@vars);
    $post = " where $vl are variable numbers";
  }
  my ($txt) = "\n\nThe library syntax is \\fun{$type}{$Cname}{$args}$post.";
  $txt .= "\n$Variant" if ($Variant);
  return $txt;
}
