#############################################################################
####
##
#A  anupq.gi                    ANUPQ package                  Eamonn O'Brien
#A                                                             & Frank Celler
##
#Y  Copyright 1992-1994,  Lehrstuhl D fuer Mathematik,  RWTH Aachen,  Germany
#Y  Copyright 1992-1994,  School of Mathematical Sciences, ANU,     Australia
##

#############################################################################
##
#F  ANUPQDirectoryTemporary( <dir> ) . . . . .  redefine ANUPQ temp directory
##
##  calls the UNIX command `mkdir' to create <dir>, which must be  a  string,
##  and if successful a directory  object  for  <dir>  is  both  assigned  to
##  `ANUPQData.tmpdir' and returned. The field  `ANUPQData.outfile'  is  also
##  set to be a file in `ANUPQData.tmpdir', and on exit from {\GAP} <dir>  is
##  removed.
##
InstallGlobalFunction(ANUPQDirectoryTemporary, function(dir)
local created;

  # check arguments
  if not IsString(dir) then
    Error(
      "usage: ANUPQDirectoryTemporary( <dir> ) : <dir> must be a string.\n");
  fi;

  # create temporary directory
  CreateDir(dir);
  if not IsDirectoryPath(dir) then
    return fail;
  fi;

  Add( GAPInfo.DirectoriesTemporary, dir );
  ANUPQData.tmpdir  := Directory(dir);
  ANUPQData.outfile := Filename(ANUPQData.tmpdir, "PQ_OUTPUT");
  return ANUPQData.tmpdir;
end);

#############################################################################
##
#F  ANUPQerrorPq( <param> ) . . . . . . . . . . . . . . . . . report an error
##
InstallGlobalFunction( ANUPQerrorPq, function( param )
    Error(
    "Valid Options:\n",
    "    \"ClassBound\", <bound>\n",
    "    \"Prime\", <prime>\n",
    "    \"Exponent\", <exponent>\n",
    "    \"Metabelian\"\n",
    "    \"OutputLevel\", <level>\n",
    "    \"Verbose\"\n",
    "    \"SetupFile\", <file>\n",
    "    \"PqWorkspace\", <workspace>\n",
    "Illegal Parameter: \"", param, "\"" );
end );

#############################################################################
##
#F  ANUPQextractPqArgs( <args> )  . . . . . . . . . . . . . extract arguments
##
InstallGlobalFunction( ANUPQextractPqArgs, function( args )
    local   CR,  i,  act,  match;

    # allow to give only a prefix
    match := function( g, w )
    	return 1 < Length(g)
               and Length(g) <= Length(w)
               and w{[1..Length(g)]} = g;
    end;

    # extract arguments
    CR := rec();
    i  := 2;
    while i <= Length(args)  do
        act := args[i];
        if not IsString( act ) then ANUPQerrorPq( act ); fi;

    	# "ClassBound", <class>
        if match( act, "ClassBound" ) then
            i := i + 1;
            CR.ClassBound := args[i];

    	# "Prime", <prime>
        elif match( act, "Prime" )  then
            i := i + 1;
            CR.Prime := args[i];

    	# "Exponent", <exp>
        elif match( act, "Exponent" )  then
            i := i + 1;
            CR.Exponent := args[i];

        # "Metabelian"
        elif match( act, "Metabelian" ) then
            CR.Metabelian := true;

    	# "Output", <level>
        elif match( act, "OutputLevel" )  then
            i := i + 1;
            CR.OutputLevel := args[i];
    	    CR.Verbose     := true;

    	# "SetupFile", <file>
        elif match( act, "SetupFile" )  then
    	    i := i + 1;
            CR.SetupFile := args[i];

    	# "PqWorkspace", <workspace>
        elif match( act, "PqWorkspace" )  then
    	    i := i + 1;
            CR.PqWorkspace := args[i];

    	# "Verbose"
        elif match( act, "Verbose" ) then
            CR.Verbose := true;

    	# signal an error
    	else
            ANUPQerrorPq( act );

    	fi;
    	i := i + 1;
    od;
    return CR;

end );

#############################################################################
##
#V  ANUPQGlobalVariables
##
InstallValue( ANUPQGlobalVariables,
              [ "F",          #  a free group
                "MapImages"   #  images of the generators in G
                ] );

#############################################################################
##
#F  ANUPQReadOutput . . . . read pq output without affecting global variables
##
InstallGlobalFunction( ANUPQReadOutput, function( file )
    local globalvars, var, result;

    globalvars := [ "ANUPQmagic", "ANUPQautos", "ANUPQgroups" ];

    for var in globalvars do
        HideGlobalVariables( var );
    od;

    Read( file );

    result := rec();

    for var in globalvars do
        if IsBoundGlobal( var ) then
            result.(var) := ValueGlobal( var );
        else
            result.(var) := fail;
        fi;
    od;

    for var in globalvars do
        UnhideGlobalVariables( var );
    od;

    return result;
end );

#############################################################################
##
#F  PqEpimorphism( <arg> : <options> ) . . . . .  epimorphism onto p-quotient
##
InstallGlobalFunction( PqEpimorphism, function( arg )
    return PQ_EPI_OR_PCOVER(arg : PqEpiOrPCover := "pQepi");
end );

#############################################################################
##
#F  Pq( <arg> : <options> ) . . . . . . . . . . . . . . . . . . .  p-quotient
##
InstallGlobalFunction( Pq, function( arg )
    return PQ_EPI_OR_PCOVER(arg : PqEpiOrPCover := "pQuotient");
end );

#############################################################################
##
#F  PqPCover( <arg> : <options> ) . . . . . .  p-covering group of p-quotient
##
InstallGlobalFunction( PqPCover, function( arg )
    return PQ_EPI_OR_PCOVER(arg : PqEpiOrPCover := "pCover");
end );

#############################################################################
##
#F  PQ_GROUP_FROM_PCP(<datarec>,<out>) . extract gp from pq pcp file into GAP
##
InstallGlobalFunction( PQ_GROUP_FROM_PCP, function( datarec, out )
    local gens;
    HideGlobalVariables( "F", "MapImages" );
    Read( datarec.outfname );
    if out = "pCover" then
      datarec.pCover := ValueGlobal( "F" );
      IsPGroup( datarec.pCover );
    else
      if IsBound(datarec.pcgs) then
        gens := datarec.pcgs;
      else
        gens := GeneratorsOfGroup( datarec.group );
      fi;
      datarec.pQepi := GroupHomomorphismByImagesNC(
                           datarec.group,
                           ValueGlobal( "F" ),
                           gens,
                           ValueGlobal( "MapImages" )
                           );
      SetIsSurjective( datarec.pQepi, true );
      datarec.pQuotient := Image( datarec.pQepi );
      IsPGroup( datarec.pQuotient );
    fi;
    UnhideGlobalVariables( "F", "MapImages" );
end );

#############################################################################
##
#F  TRIVIAL_PQ_GROUP(<datarec>, <out>) . . . extract gp when trivial into GAP
##
InstallGlobalFunction( TRIVIAL_PQ_GROUP, function( datarec, out )
local Q;
    Q := TrivialGroup( IsPcGroup );
    if out = "pCover" then
      datarec.pCover := Q;
      IsPGroup( datarec.pCover );
    else
      datarec.pQepi := GroupHomomorphismByFunction(
                           datarec.group, Q, g -> One(Q) );
      SetIsSurjective( datarec.pQepi, true );
      datarec.pQuotient := Image( datarec.pQepi );
      IsPGroup( datarec.pQuotient );
    fi;
end );

#############################################################################
##
#F  PQ_EPI_OR_PCOVER(<args>:<options>) .  p-quotient, its epi. or its p-cover
##
InstallGlobalFunction( PQ_EPI_OR_PCOVER, function( args )
    local   out, datarec, AtClass, trivial;

    out := ValueOption("PqEpiOrPCover");
    datarec := ANUPQ_ARG_CHK("Pq", args);
    datarec.filter := ["Output file in", "Group presentation"];
    VALUE_PQ_OPTION("Identities", [], datarec);
    if datarec.calltype = "GAP3compatible" then
        # ANUPQ_ARG_CHK calls PQ_EPI_OR_PCOVER itself in this case
        # (so datarec.(out) has already been computed)
        return datarec.(out);
    fi;
    trivial := IsEmpty( datarec.group!.GeneratorsOfMagmaWithInverses );
    if trivial then
        ; #the `pq' binary spits out nonsense if given a trivial pres'n
    elif datarec.calltype = "interactive" and
         ( IsBound(datarec.pQuotient) or IsBound(datarec.pCover) ) then
        AtClass := function()
          return IsBound(datarec.complete) and datarec.complete or
                 IsBound(datarec.class) and datarec.class = datarec.ClassBound;
        end;

        if IsBound(datarec.pcoverclass) and
           datarec.pcoverclass = datarec.class and not AtClass() then
            # ``reduce'' the p-cover to a p-class
            PQ_FINISH_NEXT_CLASS( datarec );
        fi;
        while not AtClass() do
            PQ_NEXT_CLASS( datarec );
        od;
        # the following is not executed if the while-loop is
        # executed at least once
        if IsBound( datarec.(out) ) then
            return datarec.(out); # it had already been computed
        fi;
    else
        PQ_PC_PRESENTATION(datarec, "pQ");
        if datarec.class < Minimum(63, datarec.ClassBound) then
            datarec.complete := true;
        fi;
    fi;

    trivial := trivial or IsEmpty(datarec.ngens) or datarec.ngens[1] = 0;
    if not trivial then
        if out = "pCover" then
          PQ_P_COVER( datarec );
        fi;

        PushOptions( rec(nonuser := true) );
        PQ_WRITE_PC_PRESENTATION(datarec, datarec.outfname);
        PopOptions();
    fi;

    if datarec.calltype = "non-interactive" then
        PQ_COMPLETE_NONINTERACTIVE_FUNC_CALL(datarec);
        if IsBound( datarec.setupfile ) then
          if trivial then
            return fail;
          fi;
          return true;
        fi;
    fi;

    if trivial then
        TRIVIAL_PQ_GROUP( datarec, out );
    else
        # read group and images from file
        PQ_GROUP_FROM_PCP( datarec, out );
    fi;
    return datarec.(out);
end );

#############################################################################
##
#F  PqRecoverDefinitions( <G> ) . . . . . . . . . . . . . . . . . definitions
##
##  This function finds a definition for each generator of the p-group <G>.
##  These definitions need not be the same as the ones used by pq.  But
##  they serve the purpose of defining each generator as a commutator or
##  power of earlier ones.  This is useful for extending an automorphism that
##  is given on a set of minimal generators of <G>.
##
InstallGlobalFunction( PqRecoverDefinitions, function( G )
    local   col,  gens,  definitions,  h,  g,  rhs,  gen;

    col  := ElementsFamily( FamilyObj( G ) )!.rewritingSystem;
    gens := GeneratorsOfRws( col );

    definitions := [];

    for h in [1..NumberGeneratorsOfRws( col )] do
        rhs := GetPowerNC( col, h );
        if Length( rhs ) = 1 then
            gen := Position( gens, rhs );
            if not IsBound( definitions[gen] ) then
                definitions[gen] := h;
            fi;
        fi;

        for g in [1..h-1] do
            rhs := GetConjugateNC( col, h, g );
            if Length( rhs ) = 2 then
                gen := SubSyllables( rhs, 2, 2 );
                gen := Position( gens, gen );
                if not IsBound( definitions[gen] ) then
                    definitions[gen] := [h, g];
                fi;
            fi;
        od;
    od;
    return definitions;
end );

#############################################################################
##
#F  PqAutomorphism( <epi>, <autoimages> ) . . . . . . . . . . . . definitions
##
##  Take an automorphism of the preimage and produce the induced automorphism
##  of the image of the epimorphism.
##
InstallGlobalFunction( PqAutomorphism, function( epi, autoimages )
    local   G,  p,  gens,  definitions,  d,  epimages,  i,  pos,  def,
            phi;

    G      := Image( epi );
    p      := PrimePGroup( G );
    gens   := GeneratorsOfGroup( G );

    autoimages := List( autoimages, im->Image( epi, im ) );

    ##  Get a definition for each generator.
    definitions := PqRecoverDefinitions( G );
    d := Number( [1..Length(definitions)],
                 i->not IsBound( definitions[i] ) );

    ##  Find the images for the defining generators of G under the
    ##  automorphism.  We have to be careful, as some of the generators for
    ##  the source might be redundant as generators of G.
    epimages := List( GeneratorsOfGroup(Source(epi)), g->Image(epi,g) );
    for i in [1..d] do
        ##  Find G.i ...
        pos := Position( epimages, G.(i) );
        if pos = fail then
            Error( "generators ", i, "not image of a generators" );
        fi;
        ##  ... and set its image.
        definitions[i] := autoimages[pos];
    od;

    ##  Replace each definition by its image under the automorphism.
    for i in [d+1..Length(definitions)] do
        def := definitions[i];
        if IsInt( def ) then
            definitions[i] := definitions[ def ]^p;
        else
            definitions[i] := Comm( definitions[ def[1] ],
                                    definitions[ def[2] ] );
        fi;
    od;

    phi := GroupHomomorphismByImages( G, G, gens, definitions );
    SetIsBijective( phi, true );

    return phi;
end );

#############################################################################
##
#F  PqLeftNormComm( <words> ) . . . . . . . . . . . . .  left norm commutator
##
##  returns for a list <words> of words in the generators of a group the left
##  norm commutator of <words>, e.g.~if <w1>, <w2>, <w3>  are  words  in  the
##  generators of some free or fp group then  `PqLeftNormComm(  [<w1>,  <w2>,
##  <w3>] );' is equivalent to `Comm( Comm( <w1>, <w2> ), <w3> );'. Actually,
##  the only restrictions on <words> are that <words> must constitute a  list
##  of group elements of the  same  group  (so  a  list  of  permutations  is
##  allowed, for example) and that <words> must contain at least *two* words.
##
InstallGlobalFunction( PqLeftNormComm, function( words )
local fam, comm, word;
  if not IsList(words) or 2 > Length(words) or
     not ForAll(words, IsMultiplicativeElementWithInverse) then
    Error( "<words> should be a list of at least 2 group elements\n" );
  else
    fam := FamilyObj(words[1]);
    if not ForAll(words, w -> IsIdenticalObj(FamilyObj(w), fam)) then
      Error( "<words> should belong to the same group\n" );
    fi;
  fi;
  comm := words[1];
  for word in words{[2 .. Length(words)]} do
    comm := Comm(comm, word);
  od;
  return comm;
end );

#############################################################################
##
#F  PqGAPRelators( <group>, <rels> ) . . . . . . . . pq relators as GAP words
##
##  returns a list of words that {\GAP} understands, given a list  <rels>  of
##  strings in the string representations of the generators of the  fp  group
##  <group> prepared as a list of relators for the `pq' program.
##
##  *Note:*
##  The `pq' program does not  use  `/'  to  indicate  multiplication  by  an
##  inverse and uses square brackets to represent (left normed)  commutators.
##  Also, even though the `pq' program accepts  relations,  all  elements  of
##  <rels> *must* be in relator form, i.e.~a relation of form `<w1>  =  <w2>'
##  must be written as `<w1>*(<w2>)^-1'.
##
##  Here is an example:
##
##  \beginexample
##  gap> F := FreeGroup("a", "b");
##  gap> PqGAPRelators(F, [ "a*b^2", "[a,b]^2*a", "([a,b,a,b,b]*a*b)^2*a" ]);
##  [ a*b^2, a^-1*b^-1*a*b*a^-1*b^-1*a*b*a, b^-1*a^-1*b^-1*a^-1*b*a*b^-1*a*b*a^
##      -1*b*a^-1*b^-1*a*b*a*b^-1*a^-1*b^-1*a^-1*b*a*b^-1*a*b^-1*a^-1*b*a^-1*b^
##      -1*a*b*a*b*a^-1*b*a*b^-1*a*b*a^-1*b*a^-1*b^-1*a*b*a*b^-1*a^-1*b^-1*a^
##      -1*b*a*b^-1*a*b^-1*a^-1*b*a^-1*b^-1*a*b*a*b^2*a*b*a ]
##  \endexample
##
InstallGlobalFunction( PqGAPRelators, function( group, rels )
local gens, relgens, diff, g;
  if not( IsFpGroup(group) ) then
    Error("<group> must be an fp group\n");
  fi;
  gens := List( FreeGeneratorsOfFpGroup(group), String );
  if not ForAll(rels, rel -> Position(rel, '/') = fail) then
    Error( "pq binary does not understand `/' in relators\n" );
  fi;
  relgens := Set( Concatenation(
                      List( rels, rel -> Filtered(
                                             SplitString(rel, "", "*[]()^, "),
                                             str -> Int(str) = fail) ) ) );
  diff := Difference(relgens, gens);
  if not IsEmpty(diff) then
    Error( "generators: ", diff,
           "\nare not among the generators of the group supplied\n" );
  fi;
  CallFuncList(HideGlobalVariables, gens);
  for g in FreeGeneratorsOfFpGroup(group) do
    ASS_GVAR(String(g), g);
  od;
  rels := List( rels, rel -> EvalString(
                                 ReplacedString(
                                     ReplacedString(rel, "]", "])"),
                                     "[", "PqLeftNormComm(["
                                     ) ) );
  CallFuncList(UnhideGlobalVariables, gens);
  return rels;
end );

#############################################################################
##
#F  PqParseWord( <F>, <word> ) . . . . . . . . . . . . parse word through GAP
#F  PqParseWord( <n>, <word> )
##
##  parse <word> through {\GAP}, where <word> is a string representing a word
##  in the generators of <F> (the first form  of  `PqParseWord')  or  <n>  pc
##  generators `x1,...,x<n>'. `PqParseWord' is provided as a  rough-and-ready
##  check of <word> for syntax errors. A syntax error will cause the entering
##  of a `break'-loop,  in  which  the  error  message  may  or  may  not  be
##  meaningful (depending on whether the syntax  error  gets  caught  at  the
##  {\GAP} or kernel level).
##
##  *Note:*
##  The reason the generators *must* be `x1,...,x<n>' in the second  form  of
##  `PqParseWord' is that these are the pc generator names used by  the  `pq'
##  program (as distinct from the generator names for the group  provided  by
##  the user to a function like `Pq' that invokes the `pq' program).
##
InstallGlobalFunction( PqParseWord, function( n, word )
local ParseOnBreak, ParseOnBreakMessage, NormalOnBreak, NormalOnBreakMessage,
      parts, gens;

  if IsGroup(n) or
     Position(word, '[') <> fail or Position(word, '(') <> fail then
    #pass word through GAP's parser to see if it's ok

    NormalOnBreak := OnBreak;
    ParseOnBreak := function()
      Where(0);
      OnBreak := NormalOnBreak;
    end;
    OnBreak := ParseOnBreak;

    if IsFunction(OnBreakMessage) then
      NormalOnBreakMessage := OnBreakMessage;
      ParseOnBreakMessage := function()
        Print( " syntax error in: ", word, "\n" );
        Print( " you can type: 'quit;' to quit to outer loop.\n" );
        OnBreakMessage := NormalOnBreakMessage;
      end;
      OnBreakMessage := ParseOnBreakMessage;
    fi;

    if IsGroup(n) then
      PqGAPRelators(n, [ word ]);
    else
      PqGAPRelators(FreeGroup(n, "x"), [ word ]);
    fi;

    OnBreak := NormalOnBreak;
    if IsFunction(OnBreakMessage) then
      OnBreakMessage := NormalOnBreakMessage;
    fi;

  else
    parts := List( SplitString(word, "*"), part -> SplitString(part, "^") );
    if ForAny( parts, part -> 2 < Length(part) or
                              2 = Length(part) and not IsInt( Int(part[2]) ) )
       then
      Error( "detected invalid exponent in argument <word>: ", word, "\n");
    fi;
    if ForAny( parts, part -> IsEmpty( part[1] ) or part[1][1] <> 'x' ) then
      Error( "generators in argument <word> must all be of form:\n",
             "`x<i>' for some integer <i>\n" );
    fi;
    gens := List( parts, part -> Int( part[1]{[2 .. Length(part[1])]} ) );
    if not ForAll(gens, gen -> IsPosInt(gen) and gen <= n) then
      Error( "generators in argument <word> must be in the range: ",
             "x1,...,x", n, "\n" );
    fi;
  fi;
  return true;
end );

#############################################################################
##
#F  PQ_EVALUATE( <string> ) . . . . . . . . . evaluate a string emulating GAP
##
##  For each substring of the string <string> that is a statement (i.e.  ends
##  in a `;'), `PQ_EVALUATE( <string> )' evaluates it in the same way  {\GAP}
##  would. If the substring is further followed by  a  `;'  (i.e.  there  was
##  `;;'), this is an indication that the statement would produce no  output;
##  otherwise the output that the user would normally see if  she  typed  the
##  statement interactively is displayed.
##
InstallGlobalFunction(PQ_EVALUATE, function(string)
local from, pos, statement, parts, var;
  from := 0;
  pos := Position(string, ';', from);
  while pos <> fail do
    statement := string{[from + 1..pos]};
    statement := ReplacedString(statement," last "," ANUPQData.example.last ");
    if pos < Length(string) and string[pos + 1] = ';' then
      Read( InputTextString(statement) );
      from := pos + 1;
    else
      parts := SplitString(statement, "", " \n");
      if 1 < Length(parts) and parts[2] = ":=" then
        Read( InputTextString(statement) );
        Read( InputTextString(
                  Concatenation( "View(", parts[1], "); Print(\"\\n\");" ) ) );
        ANUPQData.example.last := parts[1];
      else
        var := EvalString(statement);
        View( var );
        Print( "\n" );
        ANUPQData.example.last := var;
      fi;
      from := pos;
    fi;
    pos := Position(string, ';', from);
  od;
end );

#############################################################################
##
#F  PqExample() . . . . . . . . . . execute a pq example or display the index
#F  PqExample( <example>[, PqStart][, Display] )
#F  PqExample( <example>[, PqStart][, <filename>] )
##
##  With no arguments,  or  with  single  argument  `"index"',  or  a  string
##  <example> that is not the name of a file in the `examples' directory,  an
##  index of available examples is displayed.
##
##  With just the one argument <example> that is the name of a  file  in  the
##  `examples' directory, the example contained in that file is  executed  in
##  its simplest form. Some examples accept options  which  you  may  use  to
##  modify some of the options used in the commands of the example.  To  find
##  out which options an example accepts,  use  one  of  the  mechanisms  for
##  displaying the example described below.
##
##  Some examples have both non-interactive and interactive forms; those that
##  are non-interactive only have a name ending  in  `-ni';  those  that  are
##  interactive only have a name ending in `-i'; examples with  names  ending
##  in  `.g'  also  have  only  one  form;  all  other  examples  have   both
##  non-interactive and interactive forms and for these giving  `PqStart'  as
##  second argument invokes `PqStart' initially  and  makes  the  appropriate
##  adjustments  so  that  the  example  is  executed  or   displayed   using
##  interactive functions.
##
##  If `PqExample' is called with last (second or third)  argument  `Display'
##  then the example  is  displayed  without  being  executed.  If  the  last
##  argument is a non-empty  string  <filename>  then  the  example  is  also
##  displayed without being executed but is also written to a file with  that
##  name. Passing an empty string as last argument has  the  same  effect  as
##  passing `Display'.
##
##  *Note:*
##  The  variables  used  in  `PqExample'  are  local  to  the   running   of
##  `PqExample', so there's no  danger  of  having  some  of  your  variables
##  over-written. However, they are not  completely  lost  either.  They  are
##  saved to a record `ANUPQData.examples.vars', i.e.~if `F'  is  a  variable
##  used in the example then you will be able to access it after  `PqExample'
##  has finished as `ANUPQData.examples.vars.F'.
##
InstallGlobalFunction(PqExample, function(arg)
local name, file, instream, line, input, doPqStart, vars, var, printonly,
      filename, DoAltAction, GetNextLine, PrintLine, action, datarec, optname,
      linewidth, sizescreen, CheckForCompoundKeywords, hasFunctionExpr, parts,
      iscompoundStatement, compoundDepth;

  sizescreen := SizeScreen();
  if sizescreen[1] < 80 then
    SizeScreen([80, sizescreen[2]]);
    linewidth := 80;
  else
    linewidth := sizescreen[1];
  fi;

  if IsEmpty(arg) then
    name := "index";
  else
    name := arg[1];
  fi;

  if name = "README" then
    file := fail;
  else
    file := Filename(DirectoriesPackageLibrary( "anupq", "examples"), name);
  fi;
  if file = fail then
    Info(InfoANUPQ + InfoWarning, 1,
         "Sorry! There is no ANUPQ example with name `", name, "'",
         " ... displaying index.");
    name := "index";
    file := Filename(DirectoriesPackageLibrary( "anupq", "examples"), name);
  fi;

  if name <> "index" then
    doPqStart := false;
    if Length(arg) > 1 then
      # At this point the name of the variable <printonly> doesn't make
      # sense; however, if the value assigned to <printonly> is `Display'
      # or an empty string then we ``print only'' and if it is a non-empty
      # string then it is assumed to be a filename and we `LogTo' that filename.
      printonly := arg[Minimum(3, Length(arg))];
      if arg[2] = PqStart then
        if 2 < Length(name) and
           name{[Length(name) - 1 .. Length(name)]} in ["-i", "ni", ".g"] then
          Error( "example does not have a (different) interactive form\n" );
        fi;
        doPqStart := true;
      fi;
    else
      printonly := false;
    fi;

    DoAltAction := function()
      if doPqStart then
        if action[2] = "do" then
          # uncomment line
          line := line{[2..Length(line)]};
        else
          # replace a variable with a proc id
          line := ReplacedString( line, action[5], action[3] );
        fi;
      fi;
    end;

    if printonly = Display or IsString(printonly) then
      GetNextLine := function()
        local from, to;
        line := ReadLine(instream);
        if line = fail then
          return;
        elif IsBound(action) then
          action := SplitString(action, "", "# <>\n");
          DoAltAction();
          Unbind(action);
        elif 3 < Length(line) and line{[1..4]} = "#alt" then
          # only "#alt" actions recognised
          action := line;
        elif IsMatchingSublist(line, "#comment:") then
          line := ReplacedString(line, " supplying", "");
          from := Position(line, ' ');
          to   := Position(line, '<', from);
          Info(InfoANUPQ, 1,
               "In the next command, you may", line{[from .. to - 1]});
          from := to + 1;
          to   := Position(line, '>') - 1;
          Info(InfoANUPQ, 1, "supplying to `PqExample' the option: `",
                             line{[from .. to]}, "'");
        fi;
      end;

      if IsString(printonly) and printonly <> "" then
        filename := printonly;
        LogTo( filename ); #Make sure it's empty and writable
      fi;
      PrintLine := function()
        if IsMatchingSublist(line, "##") then
          line := line{[2..Length(line)]};
        elif line[1] = '#' then
          return;
        fi;
        Print( ReplacedString(line, ";;", ";") );
      end;
      printonly := true; #now the name of the variable makes sense
    else
      printonly := false;
      ANUPQData.example := rec(options := rec());
      datarec := ANUPQData.example.options;

      CheckForCompoundKeywords := function()
        local compoundkeywords;
        compoundkeywords := Filtered( SplitString(line, "", "( ;\n"),
                                      w -> w in ["do", "od", "if", "fi",
                                                 "repeat", "until",
                                                 "function", "end"] );
        hasFunctionExpr := "function" in compoundkeywords;
        compoundDepth := compoundDepth
                         + Number(compoundkeywords,
                                  w -> w in ["do", "if", "repeat", "function"])
                         - Number(compoundkeywords,
                                  w -> w in ["od", "fi", "until",  "end"]);
        return not IsEmpty(compoundkeywords);
      end;

      GetNextLine := function()
        local from, to, bhsinput;
        repeat
          line := ReadLine(instream);
          if line = fail then return; fi;
        until not IsMatchingSublist(line, "#comment:");
        if IsBound(action) then
          action := SplitString(action, "", "# <>\n");
          if action[1] = "alt:" then
            DoAltAction();
          else
            # action[2] = name of a possible option passed to `PqExample'
            # action[4] = string to be replaced in <line> with the value
            #             of the option if ok and set
            optname := action[2];
            if IsDigitChar(optname[ Length(optname) ]) then
              optname := optname{[1..Length(optname) - 1]};
            fi;
            datarec.(action[2]) := ValueOption(action[2]);
            if datarec.(action[2]) = fail then
              Unbind( datarec.(action[2]) );
            else
              if not ANUPQoptionChecks.(optname)( datarec.(action[2]) ) then
                Info(InfoANUPQ, 1, "\"", action[2], "\" value must be a ",
                                   ANUPQoptionTypes.(optname),
                                   ": option ignored.");
                Unbind( datarec.(action[2]) );
              else
                if action[1] = "add" then
                  line[1] := ' ';
                fi;
                if IsString( datarec.(action[2]) ) then
                  line := ReplacedString( line, action[4],
                                          Flat(['"',datarec.(action[2]),'"']) );
                else
                  line := ReplacedString( line, action[4],
                                          String( datarec.(action[2]) ) );
                fi;
              fi;
            fi;
          fi;
          Unbind(action);
        elif IsMatchingSublist(line, "##") then
          ; # do nothing
        elif 3 < Length(line) and line{[1..4]} in ["#sub", "#add", "#alt"] then
          action := line;
        elif line[1] = '#' then
          # execute instructions behind the scenes
          bhsinput := "";
          repeat
            Append( bhsinput,
                    ReplacedString(line{[2..Length(line)]},
                                   "datarec",
                                   "ANUPQData.example.options") );
            line := ReadLine(instream);
          until line[1] <> '#' or
                (3 < Length(line) and line{[1..4]} in ["#sub", "#add", "#com"]);
          Read( InputTextString(bhsinput) );
        fi;
      end;

      PrintLine := function()
        if IsMatchingSublist(line, "##") then
          line := line{[2..Length(line)]};
        elif line[1] = '#' then
          return;
        fi;
        if input = "" then
          Print("gap> ");
        else
          Print(">    ");
        fi;
        Print( ReplacedString(line, ";;", ";") );
      end;
    fi;
  fi;

  instream := InputTextFile(file);
  if name <> "index" then
    FLUSH_PQ_STREAM_UNTIL( instream, 10, 1, ReadLine,
                           line -> IsMatchingSublist(line, "#Example") );
    line := FLUSH_PQ_STREAM_UNTIL( instream, 1, 10, ReadLine,
                                   line -> IsMatchingSublist(line, "#vars:") );
    if Length(line) + 21 < linewidth then
      Info(InfoANUPQ, 1, line{[Position(line, ' ')+1..Position(line, ';')-1]},
                         " are local to `PqExample'");
    else
      #this assumes one has been careful to ensure the `#vars:' line is not
      #longer than 72 characters.
      Info(InfoANUPQ, 1, line{[Position(line, ' ')+1..Position(line, ';')-1]},
                         " are");
      Info(InfoANUPQ, 1, "local to `PqExample'");
    fi;
    vars := SplitString(line, "", " ,;\n");
    vars := vars{[2 .. Length(vars)]};
    if not printonly then
      CallFuncList(HideGlobalVariables, vars);
    fi;
    line := FLUSH_PQ_STREAM_UNTIL(instream, 1, 10, ReadLine,
                                  line -> IsMatchingSublist(line, "#options:"));
    input := "";
    GetNextLine();
    while line <> fail do
      PrintLine();
      if line[1] <> '#' then
        if not printonly then
          if input = "" then
            compoundDepth := 0;
            iscompoundStatement := CheckForCompoundKeywords();
          elif iscompoundStatement and compoundDepth > 0 then
            CheckForCompoundKeywords();
          fi;
          if line <> "\n" then
            Append(input, line);
            if iscompoundStatement then
              if compoundDepth = 0 and Position(input, ';') <> fail then
                Read( InputTextString(input) );
                if hasFunctionExpr then
                  parts := SplitString(input, "", ":= \n");
                  Read( InputTextString(
                            Concatenation(
                                "View(", parts[1], "); Print(\"\\n\");" ) ) );
                  ANUPQData.example.last := parts[1];
                fi;
                iscompoundStatement := false;
                input := "";
              fi;
            elif Position(input, ';') <> fail then
              PQ_EVALUATE(input);
              input := "";
            fi;
          fi;
        fi;
      fi;
      GetNextLine();
    od;
    if printonly then
      if IsBound(filename) then
        LogTo();
      fi;
    else
      ANUPQData.example.vars := rec();
      for var in Filtered(vars, ISBOUND_GLOBAL) do
        ANUPQData.example.vars.(var) := VALUE_GLOBAL(var);
      od;
      Info(InfoANUPQ, 1, "Variables used in `PqExample' are saved ",
                         "in `ANUPQData.example.vars'.");
      CallFuncList(UnhideGlobalVariables, vars);
    fi;
  else
    FLUSH_PQ_STREAM_UNTIL(instream, 1, 10, ReadLine, line -> line = fail);
  fi;
  CloseStream(instream);
  if linewidth <> sizescreen[1] then
    SizeScreen( sizescreen ); # restore what was there before
  fi;
end);

#############################################################################
##
#F  AllPqExamples() . . . . . . . . . .  list the names of all ANUPQ examples
##
InstallGlobalFunction( AllPqExamples, function()
  local dir,  files;

  dir   := DirectoriesPackageLibrary( "anupq", "examples" )[1];
  files := DirectoryContents( Filename( dir, "" ));
  # Remove certain files
  files := Difference( files, [".", "..", "index", "README", "CVS",
                                         "5gp-PG-e5-i", "7gp-a-x-Rel-i"] );
  # Remove files ending with a tilde
  files := Filtered( files, file -> file[ Length(file) ] <> '~' );
  return files;
end );

#############################################################################
##
#F  GrepPqExamples( <string> ) . . . . . . . grep ANUPQ examples for a string
##
##  runs the UNIX command `grep <string>'  over  the  {\ANUPQ}  examples  and
##  returns the list of examples for which  there  is  a  match.  The  actual
##  matches are `Info'-ed at `InfoANUPQ' level 2.
##
InstallGlobalFunction( GrepPqExamples, function( string )
  local dir,  str,  grep,  out,  opts,  lines,  matches,  line;

  dir := DirectoriesPackageLibrary( "anupq", "examples" )[1];
  grep := Filename( DirectoriesSystemPrograms(), "grep" );
  str := "";
  out := OutputTextString( str, true );
  opts := Concatenation( [ string ], AllPqExamples() );
  Process( dir, grep, InputTextNone(), out, opts );
  CloseStream( out );
  lines := SplitString( str, "",  "\n" );
  matches := [];
  for line in lines do
    Info(InfoANUPQ, 2, line);
    Add( matches, SplitString(line, "", ":")[1] );
  od;
  return Set(matches);
end );

#E  anupq.gi  . . . . . . . . . . . . . . . . . . . . . . . . . . . ends here


# Copyright (c) 2018-2021, Carnegie Mellon University
# See LICENSE for details

Class(SMPGlobals, rec(
    pthreads := self >> "pthreads",
    OSThreads := self >> Cond(LocalConfig.osinfo.isWindows(), "winthreads", "LinuxThreads"),
    threads := self >> "threads",
    OpenMP := self >> "OpenMP",
    maxThreads := self >> LocalConfig.cpuinfo.cores,
    getOpts := meth(arg)
        local self, opts, optrec, tid;

        self := arg[1];
        opts := CopyFields(SpiralDefaults);
        optrec := rec(api := self.OpenMP(), numproc := self.maxThreads(), parOdd := false);
        if Length(arg) >= 2 then optrec := CopyFields(optrec, arg[2]); fi;

        opts.breakdownRules.GT := Concat([ GT_Base, GT_NthLoop, CopyFields(GT_Par, rec(parEntireLoop := false, splitLoop := true))],
            When(optrec.parOdd, [GT_Par_odd ], []));
        opts.breakdownRules.TTensorI := [ CopyFields(TTensorI_toGT, rec(applicable := (self, t) >> t.hasTags() and ObjId(t.getTags()[1])=AParSMP ))];
        opts.breakdownRules.TTensorInd := [ dsA_base_smp, dsA_smp, L_dsA_L_base_smp, L_dsA_L_smp ];

        tid := When(optrec.api = "OpenMP", threadId(), CopyFields(var("tid", TInt), rec(isParallelLoopIndex := true)));
        opts.tags := [ AParSMP(optrec.numproc, tid) ];

#        if optrec.api = "threads" then opts.subParams := [var("num_threads", TInt), var("tid", TInt)]; fi;
        opts.smp := optrec;

        return opts;
    end
));


# Copyright (c) 2018-2021, Carnegie Mellon University
# See LICENSE for details

Declare(TDA, _ApplyAllRulesTopDown, limit_cx);

IsRewriteRule := r -> IsRec(r) and IsBound(r.isRewriteRule) and r.isRewriteRule;

Class(RewriteRuleBase, rec(
	isRewriteRule := true,

	regularize := self >> Error("Not implemented. This method needs to convert ",
	"a special kind of rewrite rule into a regular RewriteRule"),
));

#F RewriteRule(<rewrite-rule>)	-- returns <rewrite-rule> object unchanged
#F RewriteRule(<from>, <to_func>) -- creates an unnamed rewrite rule
#F RewriteRule(<from>, <to_func>, <name>) -- creates a rewrite rule
#F
Class(RewriteRule, RewriteRuleBase, rec(
	regularize := self >> self,

	__call__ := meth(arg)
		local op, from, to, name, self;

		self := arg[1];
		arg := Drop(arg, 1);

		if Length(arg)=1 and IsList(arg[1]) then
			arg := arg[1];
		fi;
		if Length(arg)=1 then
			return Checked(IsRewriteRule(arg[1]), arg[1]);
		elif Length(arg)=2 then
			from := arg[1];
			to   := Checked(IsCallableN(arg[2], 1) or IsCallableN(arg[2], 2), arg[2]);
			name := "unnamed";
		elif Length(arg)=3 then
			from := arg[1];
			to   := Checked(IsCallableN(arg[2], 1) or IsCallableN(arg[2], 2), arg[2]);
			name := Checked(IsString(arg[3]), arg[3]);
		else
			Error("Rule requires 1, 2 or 3 arguments. See Doc(ARule)");
		fi;

		if IsList(from) then
			if Length(from)=0 then
				Error("Rule must have non-empty left-side");
			fi;
			op := from[1];
		else
			op := from;
		fi;
		if Is@(op) or not IsRec(op) or not IsBound(op.name) then
			if IsBound(op._target) and Length(op._target)=1 then
				op := op._target[1];
			else
				op := @;
			fi;
		fi;
		return WithBases(self, rec(op := op, from := from, to := to, name := name, operations := PrintOps));
	end,

	print := self >> PrintEval("$1($2, $3, \"$4\")", self.__name__, self.from, self.to, self.name),

));

# Rule(..), alias for RewriteRule, see Doc(RewriteRule)
#
Rule := arg -> ApplyFunc(RewriteRule, arg);

#F ARule(<rewrite-rule>) - returns <rewrite-rule> object unchanged
#F ARule(<op>, <from>, <to_func>) - creates an unnamed rewrite rule for associative <op>
#F ARule(<op>, <from>, <to_func>, <name>) - creates a rewrite rule for associative <op>
#F
#F Create a rewrite rule for an associative operator
#F
Class(AssociativeRewriteRule, RewriteRuleBase, rec(
	__call__ := meth(arg)
		local op, from, to, name, lhs, rhs, self;

		self := arg[1];
		arg := Drop(arg, 1);

		if Length(arg)=1 and IsList(arg[1]) then
			arg := arg[1];
		fi;

		if Length(arg)=1 then
			return Checked(IsRewriteRule(arg[1]), arg[1]);
		elif Length(arg)=3 then
			op   := Checked(IsClass(arg[1]), arg[1]);
			from := Checked(IsList(arg[2]),  arg[2]);
			to   := Checked(IsCallableN(arg[3], 1) or IsCallableN(arg[3], 2), arg[3]);
			name := "unnamed";
		elif Length(arg)=4 then
			op   := Checked(IsClass(arg[1]), arg[1]);
			from := Checked(IsList(arg[2]),  arg[2]);
			to   := Checked(IsCallableN(arg[3], 1) or IsCallableN(arg[3], 2), arg[3]);
			name := Checked(IsString(arg[4]), arg[4]);
		else
			Error("ARule requires 1, 3 or 4 arguments. See Doc(ARule)");
		fi;

		return WithBases(self, rec(op := op, from := from, to := to, name := name, operations := PrintOps));
	end,

	regularize := meth(self)
		local op, from, to, lhs, rhs;

		[op, from, to] := [self.op, self.from, self.to];
		lhs := [op, ...] :: from :: [...];
		if NumArgs(to)=1 then
			rhs := DetachFunc(Subst(
				function(e)
				local rch;
				rch := _children(e);
					# ....left means O.left, where O is the '...' object, defined in rules.gi
				return _fromChildren(e, Concatenation(
				rch{[1 .. ....left]},
				$to(e),
				rch{[....right .. Length(rch)]}));
			end));
		else
			rhs := DetachFunc(Subst(
			function(e,cx)
				local rch;
				rch := _children(e);
					 # ....left means O.left, where O is the '...' object, defined in rules.gi
				return _fromChildren(e, Concatenation(
					rch{[1 .. ....left]},
					$to(e,cx),
					rch{[....right .. Length(rch)]}));
			end));
		fi;
		return RewriteRule(lhs, rhs, self.name);
	end,

	print := self >> PrintEval("$1($2, $3, $4, \"$5\")", self.__name__, self.op, self.from, self.to, self.name),
));

# ARule(..), alias for AssociativeRewriteRule, see Doc(AssociativeRewriteRule)
#
ARule := arg -> ApplyFunc(AssociativeRewriteRule, arg);

_ARule_Transparent := (op, transp_ops, from, to) -> Checked(
	IsClass(op), IsList(transp_ops), ForAll(transp_ops, IsClass),
	IsList(from), IsCallableN(to, 1) or IsCallableN(to, 2),
	List(transp_ops, tr_op ->
	ARule(op, List(from, f -> [tr_op, f]),
		When(IsCallableN(to, 1), Subst(x -> List($to(x), y->$tr_op(y))),
							 Subst((x,cx) -> List($to(x, cx), y->$tr_op(y))))))
);

IsRuleSet := x -> IsRec(x) and IsBound(x.isRuleSet) and x.isRuleSet;

Class(RuleSet, rec(
	isRuleSet	:= true,
	rules		:= rec(),
	# counts how many time this RuleSet changed
	_changes	 := 0,
	# change index of compiled ruleset, need to recompile if
	# '_comp_id' is not equal to '_changes'
	_comp_id	 := -1,

	__transparent__ := [],

	addRules := meth(self, rules)
		local f, rr;
		Constraint(IsRec(rules));
		self.rules := ShallowCopy(self.rules);
		rules := ShallowCopy(rules);

		for f in UserRecFields(rules) do
			rr := rules.(f);
			Constraint(IsRewriteRule(rr) or (IsList(rr) and ForAll(rr, IsRewriteRule)));
			rr := When(IsList(rr), rr, [rr]);
			rr := ConcatList(rr, r ->
			Cond(r _is AssociativeRewriteRule,
				[r] ::
				ConcatList(Filtered(self.__transparent__, t->t[1]=r.op),
				t -> _ARule_Transparent(r.op, t[2], r.from, r.to)),
				[r]));
			rules.(f) := rr;
		od;

		MergeIntoRecord(self.rules, rules);

		# ruleset changed
		self._changes := self._changes + 1;
		return self;
	end,

	compileRule := meth(self, name, rule)
		local op, from, to_func, owner, head;
		owner := rule.owner;
		rule := rule.regularize();
		[op, from, to_func] := [rule.op, rule.from, rule.to];
		op := op.__name__;
		head := When(IsList(from) and from<>[], from[1], from);

		if op = "@" and IsRec(head) and IsBound(head._target) then
			DoForAll(head._target, t ->
				self.compileRule(name, CopyFields(rule, rec(op := t))));
		else
			if not IsBound(self._compiled.(op)) then
				self._compiled.(op) := [ CopyFields(rule, rec(name := name)) ]; #[from, to_func, name, owner] ];
			else
				Add(self._compiled.(op), CopyFields(rule, rec(name := name))); #[from, to_func, name, owner]);
			fi;
		fi;
	end,

	compile := meth(self)
		self._compiled := tab();
		# save the owner ruleset, it will be used to produce warnings of duplicate
		# rule definitions, when dealing with merged rule sets
		DoForAll(self.rules, function(name, rule)
			local r;
			if IsRewriteRule(rule) then rule.owner := self;
			elif IsList(rule) and not IsString(rule) then  for r in rule do r.owner := self; od;
			fi;
		end);

		DoForAll(self.rules, (name, rule) ->
			Cond(IsRewriteRule(rule), self.compileRule(name, rule),
				IsList(rule) and not IsString(rule), DoForAll(rule, r -> self.compileRule(name, r)), 0)
		);
		# remember change number
		self._comp_id := self._changes;
		return self;
	end,

	__call__ := (self, s) >> TDA(s, self, rec()),

	apply1 := (self, s) >> _ApplyAllRulesTopDown(s, limit_cx(1), self),

	get_changes  := self >> self._changes,
	get_comp_ids := self >> self._comp_id,

	changed  := self >> self.get_comp_ids() <> self.get_changes(),

	compiled := self >> When(IsBound(self._locked) or not self.changed(), self, self.compile())._compiled,

	# locked ruleset doesn't check changes and doesn't recompile rules when asked for compiled() table
	locked   := self >> CopyFields(When(self.changed(), self.compile(), self), rec(_locked := true)),
));

Class(EmptyRuleSet, RuleSet);

AnonRuleSet := rules -> WithBases(RuleSet, rec()).addRules(rules);

Class(MergedRuleSet, RuleSet, rec(
	 _mergedConflictWarnings := [],
	 warnConflicts := false,
	 warnDuplicates := true,

	 __call__ := arg >> let(
		 self	 := arg[1],
		 rulesets := Drop(arg, 1),
		 comp_id  := Sum(rulesets, e -> e.get_changes())-1,
		 Checked(Length(rulesets) >= 1,
			 When( Length(rulesets)=1,
				 rulesets[1],
				 WithBases(self, rec(operations := PrintOps,
					 __call__ := RuleSet.__call__,
					 rulesets := rulesets,
					 _comp_id := comp_id))))),

	 get_changes  := self >> Sum(self.rulesets, e -> e.get_changes()),
	 get_comp_ids := self >> self._comp_id,

	 checkConflicts := meth(self, rules1, rules2, rulesets)
		 local conflicts, c;
		 conflicts := Intersection(UserRecFields(rules1), UserRecFields(rules2));
		 # make sure the origins of the rules are different
		 # origin == RuleSet where the rule first appears, i.e., not the MergedRuleSet
		 conflicts := Filtered(conflicts, c -> rules1.(c).owner.__name__ <> rules2.(c).owner.__name__);

		 # prevent duplicate warnings
		 if not self.warnDuplicates then
			 SubtractSet(conflicts, self._mergedConflictWarnings); fi;

		 if conflicts <> [] then
			 PrintErr("Warning: rewrite rule conflict when merging ", rulesets, "\n");
			 for c in conflicts do
				 Add(self._mergedConflictWarnings, c);
				 PrintErr(Blanks(9), c, "  ", rules1.(c).owner, "<->", rules2.(c).owner, "\n");
			 od;
		 fi;
	 end,

	 compile := meth(self)
		local rules, r;
		rules := rec();
		for r in self.rulesets do
			r.compile();
			if self.warnConflicts then
				self.checkConflicts(rules, r.rules, self.rulesets);
			fi;
			MergeIntoRecord(rules, r.rules);
		od;
		self.rules := rules;

		self._compiled := tab();

		DoForAll(self.rules, (name, rule) ->
			Cond(IsRewriteRule(rule), self.compileRule(name, rule),
				IsList(rule) and not IsString(rule),
				DoForAll(rule, r -> self.compileRule(name, r)),0)
		);

		self._comp_id := self.get_changes();
		return self;
	end,

	print := self >> Print(self.name, "(", PrintCS(self.rulesets), ")")
));

RewriteRules := (rule_set, rules) -> rule_set.addRules(rules);

_LookupRules := (expr, ruleset) -> let(
	name := ObjId(expr).__name__,
	R := When(IsBound(ruleset._locked), ruleset._compiled, ruleset.compiled()),
	When(IsBound(R.(name)), R.(name), []) :: When(IsBound(R.@), R.@, []));

#_AddRule2 := function(op, from, to_func)
#	 local rules;
#	 rules := _AddRule_old(op, from, to_func);
#	 if not IsBound(op._rules) then op._rules := BagAddr(rules); fi;
#end;
#_LookupRules2 := op -> When(IsBound(op._rules), BagFromAddr(op._rules), []);

ChkSPL := function(a,b, rule)
	local diff;
#	Error();
	if spiral.spl.IsSPL(a) and spiral.spl.IsSPL(b) then
		diff := spiral.code.InfinityNormMat(spiral.spl.MatSPL(a) -spiral.spl.MatSPL(b));
		if diff > 1E-4 then
			Print("Broken SPL rule: ", rule, "\nold:\n", a, "\nnew:\n", b);
			Error("bad SPL rule");
		fi;
	else
		return true;
	fi;
end;

RuleTrace := Ignore;
RuleStrategyTrace := Ignore;
RuleStrategyTiming := Ignore;
RuleStatus := Ignore;
RuleCheckSPL := false;

apply_rules := function(rules, expr, context)
	local rule, lhs, rhs, old;
	for rule in rules do
		lhs := rule.from;
		rhs := rule.to;
		while PatternMatch(expr, lhs, context) and context.rlimit <> 0 do
			context.rlimit := context.rlimit - 1;
			context.applied := context.applied + 1;
			old := Copy(expr);
			RuleTrace(rule);
			RuleStatus(rule, "OLD: ", [expr, "\n"]);
			if RuleCheckSPL then old := Copy(expr); fi;
			if NumArgs(rhs)=1 then expr := rhs(expr);
			else expr := rhs(expr, context);
			fi;
			RuleStatus(rule, "NEW: ", [expr, "\n"]);
			trace_log.addRewrite(rule.name,old,expr, []);
			if RuleCheckSPL then ChkSPL(old, expr, rule); fi;
		od;
	od;
	return expr;
end;

# non-iterative version (no more: while PatternMatch(...) do ...)
apply_rules_ni := function(rules, expr, context)
	local rule, lhs, rhs, old;
	for rule in rules do
		lhs := rule.from;
		rhs := rule.to;
		if PatternMatch(expr, lhs, context) and context.rlimit <> 0 then
			context.rlimit := context.rlimit - 1;
			context.applied := context.applied + 1;
			old := Copy(expr);
			RuleTrace(rule);
			RuleStatus(rule, "OLD: ", [expr, "\n"]);
			if NumArgs(rhs)=1 then expr := rhs(expr);
			else expr := rhs(expr, context);
			fi;
			RuleStatus(rule, "NEW: ", [expr, "\n"]);
			trace_log.addRewrite(rule.name,old,expr, []);
		fi;
	od;
	return expr;
end;

cx_enter := function(cx, expr)
	local opname;
	if IsRec(expr) and IsBound(expr.name) then
	opname := expr.name;
	if not IsBound(cx.(opname)) then cx.(opname) := [ expr ];
	else Add(cx.(opname), expr); fi;
	fi;
	Add(cx.parents, expr);
end;

cx_leave := function(cx, expr)
	# unupdate context back to original
	if IsRec(expr) and IsBound(expr.name) then
	RemoveLast(cx.(expr.name), 1);
	fi;
	RemoveLast(cx.parents, 1);
end;

map_children := function(expr, to_func)
	local ch, i;
	ch := _children(expr);
	for i in [1..Length(ch)] do
		_setChild(expr, i, to_func(ch[i]));
	od;
	return expr;
end;

map_children_safe := function(expr, to_func)
	local ch, i;
	ch := ShallowCopy(_children(expr));
	if ch=[] then return expr; fi;
	for i in [1..Length(ch)] do
		ch[i] := to_func(ch[i]);
	od;
	return _fromChildren(expr, ch);
end;

# Rule application context fields
#	parents - list of parents of current node,
#			  immediate parent is last, farthest parent is first,
#			  this field is updated by apply_rules()
#	rlimit  - maximum number of rules to apply, this is a parameter
#			  to apply_rules()
#	applied - number of rules applied so far, updated by apply_rules()
#
#	<objid> - for each <objid> list of parents with that id only,
#			  immediate parent is last. For instance Last(context.ISum)
#			  is the enclosing ISum.
#

_meth_cx_isInside := (self, oid) >> let(nam := Cond(IsString(oid), oid, oid.__name__),
	IsBound(self.(nam)) and self.(nam)<>[]
);

# construct an empty context, but set a limit on the number of applied rules
limit_cx := lim -> tab(
	isInside := _meth_cx_isInside,
	parents := [], rlimit := lim, applied := 0
);

# construct an empty initial context
empty_cx := () -> tab(
	isInside := _meth_cx_isInside,
	parents := [], rlimit := -1, applied := 0
);

_ApplyAllRulesTopDown := function(expr, context, ruleset)
	if (not IsRec(expr) or not IsBound(expr.name)) and (not IsList(expr) or BagType(expr) in [T_STRING, T_RANGE]) then
		return expr;
	fi;
	if IsBound(ruleset.__avoid__) and ObjId(expr) in ruleset.__avoid__ then
		return expr;
	fi;
	# apply rules
	expr := apply_rules(_LookupRules(expr, ruleset), expr, context);
	# recurse
	# NOTE: do not enter context if expr has no children!
	cx_enter(context, expr);
	expr := map_children(expr, c -> _ApplyAllRulesTopDown(c, context, ruleset));
	cx_leave(context, expr);
	return expr;
end;

ApplyAllRulesTopDown := (expr, ruleset) ->
	_ApplyAllRulesTopDown(expr, empty_cx(), ruleset.locked());

_ApplyAllRulesBottomUp := function(expr, context, ruleset)
	if (not IsRec(expr) or not IsBound(expr.name)) and (not IsList(expr) or BagType(expr) in [T_STRING, T_RANGE]) then
		return expr;
	fi;
	if IsBound(ruleset.__avoid__) and ObjId(expr) in ruleset.__avoid__ then
		return expr;
	fi;
	# recurse
	cx_enter(context, expr);
	expr := map_children(expr, c -> _ApplyAllRulesBottomUp(c, context, ruleset));
	cx_leave(context, expr);
	# apply rules
	expr := apply_rules(_LookupRules(expr, ruleset), expr, context);
	return expr;
end;

ApplyAllRulesBottomUp := (expr, ruleset) ->
	_ApplyAllRulesBottomUp(expr, empty_cx(), ruleset.locked());

_apply_strategy_step := function(expr, rset, apply_func, opts)
	if IsFunc(rset) then
		if NumArgs(rset)=2 then
			expr := rset(expr, opts);
		else
			expr := rset(expr);
		fi;
	else
		expr := apply_func(expr, rset.locked(), opts);
	fi;
	return expr;
end;

##
## ApplyStrategy(<expr>, <list-of-rulesets>, <apply_func>, <opts>)
##
## <expr>			 - expression to transform
## <list-of-rulesets> - list of rulesets to apply
## <apply_func>	   - of type (expr, rset) -> expr
##
ApplyStrategy := function(expr, strategy, apply_func, opts)
	local rset, l, r, i, t;
	# a hack to make this function reentrant
	# (e.g. to make it possible to call this function from within rhs of a rule)
	l := ....left; r := ....right; i := 1;
	for rset in strategy do
		RuleStrategyTrace(i, rset, expr);
	[expr, t] := UTimedAction(_apply_strategy_step(expr, rset, apply_func, opts));
		RuleStrategyTrace(i, "DONE", expr);
	RuleStrategyTiming(i, t);
		i := i + 1;
	od;
	....left := l;
	....right := r;
	return expr;
end;

TD := ApplyAllRulesTopDown;
BU := ApplyAllRulesBottomUp;

TDA := function(s, ruleset, opts)
	local cx;
	cx := empty_cx();
	cx.opts := opts;
	cx.applied := 1;
	while cx.applied > 0 do
		cx.applied := 0;
		s := _ApplyAllRulesTopDown(s, cx, ruleset);
	od;
	return s;
end;

BUA := function(s, ruleset, opts)
	local cx;

	cx := empty_cx();
	cx.opts := opts;
	cx.applied := 1;
	while cx.applied > 0 do
		cx.applied := 0;
		s := _ApplyAllRulesBottomUp(s, cx, ruleset);
	od;
	return s;
end;

UntilDone := TDA;

Rewrite := function(expr, rset, opts)
	local res;

	if IsList(rset) then
		return FoldL(rset, (a,b)->Rewrite(a, b, opts), expr);
	fi;

	trace_log.beginRuleset(rset, expr);
	res := UntilDone(expr, rset, opts);
	trace_log.endRuleset(rset, res);

	return res;
end;

#F TDA_1by1(<s>, <expr>, <after_each_rule>)
#F
#F This function applies rules in a top-down fashion to <s> until
#F it converges, just like TDA.  However after each application of the
#F rule it runs after_each_rule(s) on the newly transformed <s>.
#F This allows stepwise verification among other things.
#F
#F Example:
#F	r := RandomRuleTree(DFT(4));
#F	# following line (unlike SumsRuleTree) gives non-simplified Sigma-SPL
#F	s := SumsSPL(SPLRuleTree(r));
#F	TDA_1by1(s, MergedRuleSet(RulesSums, RulesDiag, RulesFuncSimp),
#F				x->PrintLine(MatSPL(x)-MatSPL(DFT(4))));
#F
TDA_1by1 := function(s, ruleset, after_each_rule)
	local cx;

	cx := limit_cx(1); cx.applied := 1;
	while cx.applied > 0 do
		cx := limit_cx(1); cx.applied := 0;
		s := _ApplyAllRulesTopDown(s, cx, ruleset);
		after_each_rule(s);
	od;
	return s;
end;


##  Copyright (c) 2018-2021, Carnegie Mellon University
##  See LICENSE for details

ImportAll(paradigms.smp);
ImportAll(paradigms.vector);

Class(FFTXPOWER9Opts, FFTXOpts, rec(
    tags := [],
    operations := rec(Print := s -> Print("<FFTX POWER9 options record>")),
));

power9Opts := function(arg)
    local opts, optrec, vsxopts;

    optrec := rec(dataType := T_Real(64), globalUnrolling := 32);
    vsxopts := rec(svct := true, splitL := false, oddSizes := false, stdTTensor := true, tsplPFA := false, realVect := false, cplxVect := true);

    opts := CopyFields(FFTXOpts, SIMDGlobals.getOpts(POWER9_2xf, vsxopts));
    opts.breakdownRules.TFCall := FFTXOpts.breakdownRules.TFCall;

    opts.globalUnrolling := optrec.globalUnrolling;

    # FFTX specific breakdown rules
    opts.breakdownRules.Circulant := [Circulant_PRDFT_FDataNT];
    opts.breakdownRules.PRDFT := List([PRDFT1_Base1, PRDFT1_Base2, PRDFT1_CT, PRDFT1_PF, PRDFT_PD, PRDFT_Rader], _noT);
    opts.breakdownRules.IPRDFT := List([ IPRDFT1_Base1, IPRDFT1_Base2, IPRDFT1_CT, IPRDFT_PD, IPRDFT_Rader ], _noT);
    opts.breakdownRules.PRDFT3 := List([ PRDFT3_Base1, PRDFT3_Base2, PRDFT3_CT ], _noT);

    return opts;
end;

Declare(ParseOptsPOWER);

Class(FFTXPOWER9DefaultConf, rec(
    __call__ := self >> self,
    getOpts := (self, t) >> ParseOptsPOWER(self, t),
    operations := rec(Print := s -> Print("<FFTX POWER9 Default Configuration>")),
    useOMP := false,
    useSIMD := true
));

power9Conf := rec(
    defaultName := "defaultPOWER9Conf",
    defaultOpts := (arg) >> FFTXPOWER9DefaultConf,
    useOMP := false,
    useSIMD := true,
    confHandler := power9Opts
);

fftx.FFTXGlobals.registerConf(power9Conf);

getTargetOS := function()
    local tgt;

    if LocalConfig.osinfo.isWindows() then
        tgt := "win-x64-cuda";
    elif LocalConfig.osinfo.isLinux() then
        tgt := "linux-cuda";
    elif LocalConfig.osinfo.isDarwin() then
        tgt := "linux-cuda";    ## may work
    fi;
    return tgt;
end;

#-----------------------------------------
# OpenMP + VSX

Class(FFTXPOWER9OMPOpts, FFTXOpts, rec(
    tags := [],
    operations := rec(Print := s -> Print("<FFTX POWER9 OpenMP options record>")),
));

power9OMPOpts := function(arg)
    local opts, optrec, vsxopts, smpopts, tid;

    optrec := rec(dataType := T_Real(64), globalUnrolling := 32);
    vsxopts := rec(svct := true, splitL := false, oddSizes := false, stdTTensor := true, tsplPFA := false);
    smpopts := rec(numproc := LocalConfig.cpuinfo.cores, api := "OpenMP");

    opts := CopyFields(FFTXOpts, SIMDGlobals.getOpts(POWER9_2xf, vsxopts));
    opts.breakdownRules.TFCall := FFTXOpts.breakdownRules.TFCall;

    #-- OpenMP opts merging--
    opts.unparser := When(IsBound(smpopts.OmpMode) and smpopts.OmpMode = "for",
                            OpenMP_POWERUnparser_ParFor,
                            OpenMP_POWERUnparser);
    opts.codegen := spiral.libgen.VecRecCodegen;

    opts.breakdownRules.GT := [ GT_Base, GT_NthLoop,
        CopyFields(GT_Par, rec(parEntireLoop := false, splitLoop := true)), GT_Par_odd,
        GT_Vec_AxI, GT_Vec_IxA, GT_Vec_IxA_Push, GT_Vec_IxA_L, GT_Vec_L_IxA
    ];
    opts.breakdownRules.TTensorI := Concat([
    CopyFields(TTensorI_toGT, rec(
        applicable := (self, t) >> t.hasTags() and ObjId(t.getTags()[1])=AParSMP ))],
        opts.breakdownRules.TTensorI);

    opts.breakdownRules.TTensorInd :=
        Concat([dsA_base_smp, dsA_smp, L_dsA_L_base_smp, L_dsA_L_smp],
            opts.breakdownRules.TTensorInd);

    tid := When(smpopts.api = "OpenMP", threadId(), var("tid", TInt));
    opts.tags := Concat([ AParSMP(smpopts.numproc, tid)  ], opts.tags);
    #----------
    opts.globalUnrolling := optrec.globalUnrolling;

    # FFTX specific breakdown rules
    opts.breakdownRules.Circulant := [Circulant_PRDFT_FDataNT];
    opts.breakdownRules.PRDFT := List([PRDFT1_Base1, PRDFT1_Base2, PRDFT1_CT, PRDFT1_PF, PRDFT_PD, PRDFT_Rader], _noT);
    opts.breakdownRules.IPRDFT := List([ IPRDFT1_Base1, IPRDFT1_Base2, IPRDFT1_CT, IPRDFT_PD, IPRDFT_Rader ], _noT);
    opts.breakdownRules.PRDFT3 := List([ PRDFT3_Base1, PRDFT3_Base2, PRDFT3_CT ], _noT);

    return opts;
end;

Declare(ParseOptsPOWER);

Class(FFTXPOWER9OMPConf, rec(
    __call__ := self >> self,
    getOpts := (self, t) >> ParseOptsPOWER(self, t),
    operations := rec(Print := s -> Print("<FFTX POWER9 OpenMP Configuration>")),
    useOMP := true,
    useSIMD := true
));

power9OMPConf := rec(
    defaultName := "defaultPOWER9OMPConf",
    defaultOpts := (arg) >> FFTXPOWER9OMPConf,
    useOMP := true,
    useSIMD := true,
    confHandler := power9OMPOpts
);

fftx.FFTXGlobals.registerConf(power9OMPConf);

getTargetOS := function()
    local tgt;

    if LocalConfig.osinfo.isWindows() then
        tgt := "win-x64-cuda";
    elif LocalConfig.osinfo.isLinux() then
        tgt := "linux-cuda";
    elif LocalConfig.osinfo.isDarwin() then
        tgt := "linux-cuda";    ## may work
    fi;
    return tgt;
end;

# this is a first experimental opts-deriving logic. This needs to be done extensible and properly
ParseOptsPOWER := function(conf, t)
    local tt, _tt, _conf, _opts;

    if conf.useOMP then
        _opts := power9OMPOpts();
    else
        _opts := power9Opts();
    fi;
    return _opts;

    Error("Don't know how to derive opts!\n");
end;