#!/bin/sh
#############################################################################
##
#W  maketbl             GAP character table library             Thomas Breuer
##
#H  @(#)$Id: maketbl,v 1.9 2001/11/12 16:42:15 gap Exp $
##
#Y  Copyright (C)  1996,  Lehrstuhl D fuer Mathematik,  RWTH Aachen,  Germany
##
##  This script produces the file 'ctprimar.tbl' for the 'data' directory
##  of the ctbllib package of {\GAP}~4 from the data files 'data/ct[go]*'.
##
##  It must be called from the home directory of the 'ctbllib' package.
##
##  For the conventions about the contents of the table library files,
##  see '../gap4/ctadmin.tbd'.
##
##  If a line has more than 78 characters, this program signals a warning.
##
##  The following calls to 'ARC' are used by this program.
##
##  ARC("<name>","maxes",<list>);
##      The string "<name>M<i>" is constructed as an admissible name for
##      the <i>-th entry of <list>.
##
##  ARC("<name>","projectives",<list>);
##      The projection maps from the tables whose names occur at the odd
##      positions in <list> to <name> will be stored in the global list
##      'LIBLIST.projections'.
##      It is assumed that after the first line of a call, at most one
##      table name occurs in each line.
##
##  ARC("<name>","isSimple",<list>);
##      The table <name> will occur in the list 'LIBLIST.simpleInfo'.
##
##  ARC("<name>","extInfo",<list>);
##      For simple tables <name>, the info in <list> will be stored in
##      'LIBLIST.simpleInfo'.
##


#############################################################################
##
##  The input is taken from 'INFILES'.
##  The output is written to 'OUTFILE', whose string version is 'OUTNAME'.
##  'TMPFILE' and 'PRJFILE' are intermediate files.
##  The old version of 'OUTFILE' is saved in 'OLDFILE'.
##  'CHECKFILE' and 'CHECKFILE2' are used to construct a {\GAP} input file
##  when the files are checked for being readable.
##
INFILES=data/cto*.tbl
OUTFILE=data/ctprimar.tbl
OUTNAME="data/ctprimar.tbl"
TMPFILE=data/ctprimar.new
PRJFILE="data/project.tbl"
NAMFILE="data/names.tbl"
NAMFILE2="data/names2.tbl"
OLDFILE=data/ctprimar.tbl~
CHECKFILE=data/check
CHECKFILE2=data/check2


#############################################################################
##
##  Check for line length at most 78, and for trailing backslashes.
##  Store first names and other names, and create names for maxes.
##  Check admissibility of names used in fusions.
##  Write info about projections to '$PRJFILE'.
##
gawk --traditional \
    -v "PRJ=$PRJFILE" \
    -v "OUTNAM=$OUTNAME" \
    -v "NAMES=$NAMFILE" \
    -v "NAMES2=$NAMFILE2" \
    'BEGIN {
         FS = "\""
         i = 1
         jj = 0
         t = 1
         file = ""
         while ( getline < OUTNAM && $1 !~ /^LIBLIST.firstnames/ ) {
             print $0;
         }
         system( "rm -f " NAMES )
     }

     # Define a function that notifies 'new' as admissible name for the
     # table with name 'old' if this does not cause a collision.
     # Otherwise an error message is printed.
     function setnewname( new, old, first ) {
         if ( new in allnames ) {
             if ( old != allnames[ new ] ) {
                 printf( "clash: name '%s' for tables '%s' and '%s'\n",
                         new, old, allnames[ new ] ) > "/dev/stderr"
             }
             else {
                 if ( first == 0 ) {
                     printf( "name '%s' defined twice for table '%s'\n",
                             new, old ) > "/dev/stderr"
                 }
             }
         }
         else {
             allnames[ new ] = old
             print( old "\"" new ) >> NAMES
         }
     }

     # Check for lines with more than 78 characters.
     { if ( length($0) > 78 ) {
         printf( "too long line in '%s':\n%s\n",
                 FILENAME, $0 ) > "/dev/stderr"
     } }

     # Check for trailing backslashes.
     /\\$/ {
         printf( "trailing backslash in '%s':\n%s\n",
                 FILENAME, $0 ) > "/dev/stderr"
     }

     # Store the first names of the tables,
     # and the corresponding file names.
     /^MOT/ {
         tolo = tolower($2);
         if ( tolo in lowerposition ) {
             printf( "double name %s\n", tolo ) > "/dev/stderr"
         }
         else {
             position[$2] = i
             lowerposition[ tolo ] = i
             setnewname( tolo, $2, 1 )
             firstnam[i] = $2
             if ( file != FILENAME ) {
                 file = FILENAME
                 jj++
                 files[jj] = substr( file, 6, index( file, "." ) - 6 )
             }
             filename[i] = jj
             i++
         }
     }

     # Store the other names of the tables.
     /^ALN\(/ && ! /^ALN:=/ {
         nam = $2
         k = 4
         while ( k <= NF ) {
             if ( $k != "," && $k != "" && $k != "]);" ) {
                 setnewname( tolower($k), nam, 0 )
             }
             k++
         }

         # Scan until the assignment is complete.
         while ( $NF == "" \
                 || substr( $NF, length($NF) ) != ";" ) {
             getline
             k = 1
             while ( k <= NF ) {
                 if ( $k != "," && $k != "" && $k != "]);" ) {
                     setnewname( tolower($k), nam, 0 )
                 }
                 k++
             }
         }
     }

     # Create the names defined by 'maxes' components.
     /^ARC\(.*"maxes"/ {
         nam = tolower($2)
         l = gsub( ",", ",", $5 ); # 'l'-th maximal subgroup
         k = 6
         while ( k <= NF ) {
             if ( index( $k, ";" ) == 0 ) {
                 if ( gsub( ",", ",", $k ) != length($k) ) {
                     setnewname( nam "m" l, $k, 1 )
                 }
                 else {
                     # increase 'l' by the number of read ','
                     l = l + gsub( ",", ",", $k );
                 }
             }
             k++
         }

         # Scan until the assignment is complete.
         while ( $NF == "" \
                 || substr( $NF, length($NF) ) != ";" ) {
             getline
             k = 1
             while ( k <= NF ) {
                 if ( index( $k, ";" ) == 0 ) {
                     if ( gsub( ",", ",", $k ) != length($k) ) {
                         setnewname( nam "m" l, $k, 1 )
                     }
                     else {
                         # increase 'l' by the number of read ','
                         l = l + gsub( ",", ",", $k );
                     }
                 }
                 k++
             }
         }
     }

     # Store the info needed for the map to the names of tables of marks.
     /^ARC\(.*"tomidentifier"/ {
         tblidents[t] = tolower($2)
         tomidents[t] = tolower($6)
         t++
     }

     # Store the source and destination of fusions (just for checks).
     /^ALF/ {
         if ( $2 in fusions ) {
             fusions[$2] = fusions[$2] "\"" $4
         }
         else {
             fusions[$2] = $4
         }

         # Store the fusion source.
         if ( $4 in fusionsource ) {
             fusionsource[$4] = fusionsource[$4] "\"" $2
         }
         else {
             fusionsource[$4] = $2
         }
     }

     # Store the names of source and image of the projections.
     /^ARC.*projectives/ {
         printf( "%s\"%s\n", $6, $2 ) >> PRJ
         nam = $2
         projections[$6] = nam

         # Scan until the assignment is complete.
         while ( $NF == "" \
                 || substr( $NF, length($NF) ) != ";" ) {
             getline

             # If the line has more than one field then the second field
             # is the name of a central extension of 'nam'.
             if ( NF != 1 ) {
                 printf( "%s\"%s\n", $2, nam ) >> PRJ
                 projections[$2] = nam
             }
         }
     }

     END {

         # Print the list of first names, in lines of length at most 77.
         line = "LIBLIST.firstnames := [ "
         l = 0
         for ( j = 1; j < i; j++ ) {

             # Start of a new file, separate the portions.
             if ( filename[j] != l ) {
                 l = filename[j]
                 print( line "\n # file " files[l] )
                 line = " "
             }
             if ( length( line " \"" firstnam[j] "\"," ) <= 77 ) {
                 line = line " \"" firstnam[j] "\",";
             }
             else {
                 print line;
                 line = "  \"" firstnam[j] "\",";
             }
         }
         print line " ];";
         print "MakeImmutable( LIBLIST.firstnames );\n";

         # Print the list of file positions.
         print( "LIBLIST.filenames := Concatenation( [" )
         m = 0
         nam = filename[1]
         for ( j = 1; j < i; j++ ) {
             if ( filename[j] == nam ) {
                 m++
             }
             else {
                 print( "  List( [ 1 .. " m " ], x -> " nam " )," )
                 m = 1
                 nam = filename[j]
             }
         }
         print( "  List( [ 1 .. " m " ], x -> " nam " )," )
         print "  ] );";
         print "MakeImmutable( LIBLIST.filenames );\n";

         # Print the list of file names.
         print( "LIBLIST.files := [" )
         line = " "
         for ( j = 1; j <= jj; j++ ) {
             if ( length( line " \"" files[j] "\"," ) <= 77 ) {
                 line = line " \"" files[j] "\",";
             }
             else {
                 print line;
                 line = "  \"" files[j] "\",";
             }
         }
         print line " ];";
         print "MakeImmutable( LIBLIST.files );\n";

         # Check whether all components of 'fusions' are valid.
         for ( j in fusions ) {
             if ( ! ( j in position ) ) {
                 printf( "fusion source '%s' not valid first name\n",
                         j ) > "/dev/stderr"
             }
         }

         # Check whether all components of 'fusionsource' are valid.
         for ( j in fusionsource ) {
             if ( ! ( j in position ) ) {
                 printf( "fusion destination '%s' not valid first name\n",
                         j ) > "/dev/stderr"
             }
         }

         # Print the list of fusion sources.
         print( "LIBLIST.fusionsource := [" )
         for ( j = 1; j < i; j++ ) {
             print( "  [ # fusions to " firstnam[j] )
             line = " "
             m = split( fusionsource[ firstnam[j] ], text )
             for ( n = 1; n <= m; n++ ) {
                 if ( length( line " \"" text[n] "\"," ) <= 77 ) {
                     line = line " \"" text[n] "\","
                 }
                 else {
                     print line;
                     line = "  \"" text[n] "\",";
                 }
             }
             print line " ],"
         }
         print "  ];";
         print "MakeImmutable( LIBLIST.fusionsource );\n";

         # Print the list of admissible names.
         print( "LIBLIST.names := [" )
         system( "sort " NAMES " > " NAMES2 )
         system( "rm " NAMES )
         name = ""
         line = ""

         while ( getline < NAMES2 ) {
             if ( ! ( $1 in position ) ) {
                 print( "no table \"" $1 "\"" ) > "/dev/stderr"
             }
             else {
                 if ( $1 == name ) {
                     # Append to current entry.
                     if ( length( line ",\"" $2 "\"" ) <= 77 ) {
                         line = line ",\"" $2 "\"";
                     }
                     else {
                         print( line "," );
                         line = "  \"" $2 "\"";
                     }
                 }
                 else {
                     # If there was an entry, close it.
                     if ( name != "" ) {
                         if ( length( line "],"  ) <= 77 ) {
                             print( line "]," )
                         }
                         else {
                             print line
                             print( "  ]," );
                         }
                     }
             
                     # Initialize the new entry.
                     name = $1
                     line = " [\"" $1 "\""
                     if ( length( line ",\"" $2 "\""  ) <= 77 ) {
                         line = line ",\"" $2 "\""
                     }
                     else {
                         print( line "," );
                         line = "  \"" $2 "\""
                     }
                 }
             }
         }
         # Print the buffer, close the entry, close the list.
         print line "]\n];\n";

         system( "rm " NAMES2 )

         # Construct the components 'LIBLIST.allnames', 'LIBLIST.position'.
         print( "LIBLIST.allnames:= [];" )
         print( "LIBLIST.position:= [];" )
         print( "LIBLIST.makenames:= function()" )
         print( "local entry;" )
         print( "for entry in LIBLIST.names do" )
         print( "  LIBLIST.pos:= Position( LIBLIST.firstnames, entry[1] );" )
         print( "  Append( LIBLIST.allnames," )
         print( "          entry{ [2..Length(entry)] } );" )
         print( "  Append( LIBLIST.position," )
         print( "          List( [2..Length(entry)], x -> LIBLIST.pos ) );" )
         print( "od;" )
         print( "end;" )
         print( "LIBLIST.makenames();" )
         print( "Unbind( LIBLIST.names );" );
         print( "Unbind( LIBLIST.pos );" );
         print( "Unbind( LIBLIST.makenames );\n" );

         # They shall be sorted according to the ordering of {\GAP},
         # so we leave the sorting to {\GAP}.
         print( "SortParallel( LIBLIST.allnames, LIBLIST.position );\n" )

         # Print the map to the identifiers of tables of marks.
         print "if TestPackageAvailability(\"tomlib\",\"1.0\") <> fail then"
         print "  TOM_TBL_INFO:= [];"
         print "  TOM_TBL_INFO[1]:= ["
         line = "  "
         for ( j = 1; j < t; j++ ) {
             if ( length( line "\"" tomidents[j] "\"," ) <= 77 ) {
                 line = line "\"" tomidents[j] "\","
             }
             else {
                 print line;
                 line = "  \"" tomidents[j] "\",";
             }
         }
         print line " ];";
         print( "  TOM_TBL_INFO[2]:= [" )
         line = "  "
         for ( j = 1; j < t; j++ ) {
             if ( length( line "\"" tblidents[j] "\"," ) <= 77 ) {
                 line = line "\"" tblidents[j] "\","
             }
             else {
                 print line;
                 line = "  \"" tblidents[j] "\",";
             }
         }
         print line " ];";
         print "  MakeReadOnlyGlobal( \"TOM_TBL_INFO\" );";
         print "  MakeImmutable( TOM_TBL_INFO );";
         print "fi;\n";


     }' $INFILES > $TMPFILE


#############################################################################
##
##  Start to build 'OUTFILE'.
##
mv $OUTFILE $OLDFILE
mv $TMPFILE $OUTFILE


#############################################################################
##
##  Store the projection maps used to construct central extensions.
##  'LIBLIST.projections' is a list of triples, each consisting of
##  the name of the extension, the name of the factor, and the map
##  itself, which is given by the call of 'ProjectionMap' to the
##  factor fusion map.
##
##  Each line in the temporary file '$PRJFILE' consists of the names of
##  the central extension and the factor group, separated by '"'.
##
##  Whenever a call 'ALF("<from>","<to>",<map>);' resp.
##  'ALF("<from>","<to>",<map>,<textlines>);' is found,
##  we need the projection map of <map> if and only if <from> is a label in
##  the array 'projections', with value <to>.
##
gawk --traditional \
     -v "PRJ=$PRJFILE" 'BEGIN {
         FS = "\""

         # Read back the names pairs of projections.
         while ( getline < PRJ > 0 ) {
             projection[$1] = $2
         }
         print( "LIBLIST.projections := [" )

         #  Remove the temporary file.
         system( "rm " PRJ )

     }

     /^ALF/ {

         if ( $2 in projection && projection[$2] == $4 ) {

             # The complete assignment fits in one line.
             if ( $NF != "" && substr( $NF, length($NF) ) == ";" ) {
                 printf( "  [\"%s\",\"%s\",ProjectionMap(\n  %s],\n",
                         $2, $4, substr( $5, 2, length($5)-2 ) )
             }

             # There may be more than one line to scan.
             else {
    
                 # The last character of $5 is '[',
                 # so the following lines contain only text lines.
                 if ( substr( $5, length($5) ) == "[" ) {
                     printf( "  [\"%s\",\"%s\",ProjectionMap(\n  %s)],\n",
                             $2, $4, substr( $5, 2, length($5)-3 ) )
                 }
    
                 # The following lines contain also parts of <map> .
                 else {
                     printf( "  [\"%s\",\"%s\",ProjectionMap(\n  %s\n",
                             $2, $4, substr( $5, 2, length($5)-1 ) )
                     getline

                     # Print full lines until the last character of the line
                     # is ; or '['.
#T Does anybody know why quoting the above ; causes an error?
                     while (    substr( $NF, length($NF) ) != ";" \
                             && substr( $NF, length($NF) ) != "[" ) {
                         printf( "  %s\n", $0 )
                         getline
                     }
                     if ( substr( $NF, length($NF) ) == ";" ) {
                         printf( "  %s],\n",
                                 substr( $0, 1, length($0)-1 ) )
                     }
                     else {
                         printf( "  %s)],\n",
                                 substr( $0, 1, length($0)-2 ) )
                     }
                 }
             }
         }
     }

     END {

           # Close the list 'LIBLIST.projections'.
           print( "  ];" )
           print( "MakeImmutable( LIBLIST.projections );\n" )

     }' $INFILES >> $OUTFILE


#############################################################################
##
##  Store the info about the tables of simple groups, their Schur multipliers
##  and outer automorphism groups, in the list 'LIBLIST.simpleInfo'.
##
##  This is generated from the components 'isSimple' and 'extInfo' set by
##  'ARC'.
##
gawk --traditional \
     'BEGIN {
         FS = "\""
         simple = ""
         print( "LIBLIST.simpleInfo := [" )
     }

     # Print the info about simple groups and their extensions.
     /^ARC.*isSimple/ {
         if ( substr( $5, 2, 4 ) == "true" ) {
             simple = $2
         }
     }

     /^ARC.*extInfo/ {
          if ( $2 == simple ) {
              printf( "  [ \"%s\", \"%s\", \"%s\" ],\n", $6, simple, $8 )
          }
     }

     END {

           # Close the list 'LIBLIST.simpleInfo'.
           print( "  ];" )
           print( "MakeImmutable( LIBLIST.simpleInfo );\n\n" )

     }' $INFILES >> $OUTFILE


#############################################################################
##
##  Add the info about sporadic simple groups.
##
echo 'LIBLIST.sporadicSimple := [' >> $OUTFILE
echo '  "M11", "M12", "J1", "M22", "J2", "M23", "HS", "J3",' >> $OUTFILE
echo '  "M24", "McL", "He", "Ru", "Suz", "ON", "Co3", "Co2",' >> $OUTFILE
echo '  "Fi22", "HN", "Ly", "Th", "Fi23", "Co1", "J4", "F3+",' >> $OUTFILE
echo '  "B", "M" ];' >> $OUTFILE
echo 'MakeImmutable( LIBLIST.sporadicSimple );' >> $OUTFILE
echo ' ' >> $OUTFILE


#############################################################################
##
##  Add the info about generic tables.
##
echo 'LIBLIST.GENERIC := [' >> $OUTFILE
grep 'LIBTABLE.*("' data/ctg*tbl | sed -e 's/^.*("/  "/;s/").*$/",/' \
     >> $OUTFILE
echo '  ];' >> $OUTFILE
echo ' ' >> $OUTFILE
echo 'LIBLIST.GENERIC:= rec(' >> $OUTFILE
echo '   allnames:= List( LIBLIST.GENERIC, LowercaseString ),' >> $OUTFILE
echo '   firstnames:= LIBLIST.GENERIC );' >> $OUTFILE
echo ' ' >> $OUTFILE


#############################################################################
##
##  Add the info about the end of the file ...
##
echo '#############################################################################' >> $OUTFILE
echo '##' >> $OUTFILE
echo '#E' >> $OUTFILE
echo '' >> $OUTFILE


#############################################################################
##
##  Print the differences between old and new version.
##
diff -u $OLDFILE $OUTFILE


#############################################################################
##
##  Check whether for the Brauer tables in the file 'ctb<id>.tbl',
##  the ordinary tables are in 'cto<id>.tbl'.
##
MBTFILE=data/mbtlines
MOTFILE=data/motlines

fgrep MBT data/ctb* > $MBTFILE
fgrep MOT data/cto* > $MOTFILE

gawk --traditional \
    -v "MBT=$MBTFILE" \
    -v "MOT=$MOTFILE" \
    'BEGIN {
         FS = ":MOT"
         while ( getline < MOT ) {
             if ( substr( $1, 6, 3 ) != "cto" ) {
                 printf( "filename %s for ord. tables must start with cto\n",
                          $1 ) > "/dev/stderr"
             }
             ordfilename = substr( $1, 9 )
             ordgrpname = substr( $2, 3, index( $2, "," ) - 4 )
             if ( ordgrpname in ordnames ) {
                 printf( "double ord. name %s\n",
                         ordgrpname ) > "/dev/stderr"
             }
             else {
                 ordnames[ ordgrpname ] = ordfilename
             }
         }
         FS = ":MBT"
         while ( getline < MBT ) {
             if ( substr( $1, 6, 3 ) != "ctb" ) {
                 printf( "filename %s for mod. tables must start with ctb\n",
                          $1 ) > "/dev/stderr"
             }
             modfilename = substr( $1, 9 )
             modgrpname = substr( $2, 3, index( $2, "," ) - 4 )
             prime = substr( $2, index( $2, "," )+1 )
             prime = substr( prime, 1, index( prime, "," )-1 )
             if ( modgrpname in ordnames ) {
                 if ( modfilename != ordnames[ modgrpname ] ) {
                     printf( "for group %s, the ord. table is in cto%s\n",
                              modgrpname,
                              ordnames[ modgrpname ] ) > "/dev/stderr"
                     printf( "    but the %s-modular table is in ctb%s\n",
                             prime,
                             modfilename ) > "/dev/stderr"
                 }
             }
             else {
                 printf( "%s-modular table of %s in file ctb%s",
                         prime,
                         modgrpname,
                         modfilename ) > "/dev/stderr"
                 printf( "without ord. table\n" ) > "/dev/stderr"
             }
         }
     }'

rm -f $MBTFILE $MOTFILE


#############################################################################
##
##  Call {\GAP} without library functions, and check that the table files
##  'clm*', 'ctb*', and 'cto*' can be read and do contain only admissible
##  function calls.
##  In the list given below, 'Concatenation' and 'TransposedMat' are the only
##  library functions that are not defined in the 'ctadmin' file.
##
echo 'LIBTABLE := rec( LOADSTATUS := rec(), clmelab := [],' > $CHECKFILE
echo '                 clmexsp := [] );;' >> $CHECKFILE
echo 'Ignore := function( arg ) return arg; end;;' >> $CHECKFILE
echo 'SET_TABLEFILENAME := Ignore;;' >> $CHECKFILE
echo 'GALOIS := ( x -> x );;' >> $CHECKFILE
echo 'TENSOR := ( x -> x );;' >> $CHECKFILE
echo 'EvalChars := Ignore;;' >> $CHECKFILE
echo 'ALF := function( arg ); end;;' >> $CHECKFILE
echo 'ACM := function( arg ); end;;' >> $CHECKFILE
echo 'ARC := function( arg ); end;;' >> $CHECKFILE
echo 'NotifyCharTableName := function( arg ); end;;' >> $CHECKFILE
echo 'ALN := NotifyCharTableName;;' >> $CHECKFILE
echo 'MBT := function( arg ); end;;' >> $CHECKFILE
echo 'MOT := function( arg ); end;;' >> $CHECKFILE
echo 'ConstructMixed := function( arg ); end;;' >> $CHECKFILE
echo 'ConstructProj := function( arg ); end;;' >> $CHECKFILE
echo 'ConstructDirectProduct := function( arg ); end;;' >> $CHECKFILE
echo 'ConstructSubdirect := function( arg ); end;;' >> $CHECKFILE
echo 'ConstructIsoclinic := function( arg ); end;;' >> $CHECKFILE
echo 'ConstructV4G := function( arg ); end;;' >> $CHECKFILE
echo 'ConstructGS3 := function( arg ); end;;' >> $CHECKFILE
echo 'ConstructPermuted := function( arg ); end;;' >> $CHECKFILE
echo 'ConstructClifford := function( arg ); end;;' >> $CHECKFILE
echo 'ConstructFactor := function( arg ); end;;' >> $CHECKFILE
echo 'Concatenation := function( arg ) return 0; end;;' >> $CHECKFILE
echo 'TransposedMat := function( arg ) return 0; end;;' >> $CHECKFILE
echo 'if not IsBound( Revision ) then Revision:= rec(); fi;' >> $CHECKFILE

ls data | grep 'clm.*.tbl' > $CHECKFILE2
ls data | grep 'ctb.*.tbl' >> $CHECKFILE2
ls data | grep 'cto.*.tbl' >> $CHECKFILE2
sed -e 's/^/READ("data\//;s/\.tbl.*$/.tbl");/' \
     < $CHECKFILE2 >> $CHECKFILE
gap -l data < $CHECKFILE > $CHECKFILE2
sed -e '1d;/^gap> true$/d;/^gap> $/d' \
     < $CHECKFILE2
rm $CHECKFILE $CHECKFILE2


#############################################################################
##
#E

