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

#F ParStream(p, u)
#F p=# of procs
#F u = minimum packet size (specified)
Class(ParStream, AGenericTag, rec(isParStream := true));

#F MBufCell_spec(u1, u2, p)
#F u1= PkSize for AxI.
#F u2=PkSize for L(IxA) and (IxA)L
#F  p=# of procs (Optional: default=1)
#F  r=# of iters to leave for the children (experimental). Optional.
Class(MBufCell_spec, AGenericTag, rec(isMBufCell_spec := true));

#F MBufCell_its(b)
#F Performs a multibuffer loop with exactly b multibuffered iterations
#F Not to be called directly
Class(MBufCell_its, AGenericTag, rec(isMBufCell_its := true));

#F ==========================================================================
#F MemCell(<its>) - Cell from main mem tag
Class(MemCell, AGenericTag, rec(isMemCell := true));

#F MBuf wrapper tags
Class(MBuf_maxWrapper_WHT, AGenericTag, rec(isMaxWrapper_WHT := true));
Class(MBuf_maxWrapper_DFT, AGenericTag, rec(isMaxWrapper_DFT := true));
Class(MBuf_maxWrapper_DFT_vecrecur, AGenericTag, rec(isMaxWrapper_DFT_vecrecur := true));

#-----------------------------------------------------------------------------
# Deprecated
#-----------------------------------------------------------------------------

#F MBufCell(<its>) - Cell buffer tag
Class(MBufCell, AGenericTag, rec(isMBufCell := true));
Class(MBufCell_max, AGenericTag, rec(isMBufCell := true));
#Class(MBufCell_mbuf, AGenericTag, rec(isMBufCell_mbuf := true));

#F ==========================================================================
#F 2DBufVecRecur(<its>) - Cell from main mem tag
Class(2DBufVecRecur, AGenericTag, rec(is2DBufVecRecur := true));


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

#F Printing of SPLs
#F ----------------
#F

#F SPLOps.Print( <spl> [, <indent> , <indentStep> ] )
#F   prints <spl> with <indent>. Further indenting is done
#F   in steps of size <indentStep>. The default is
#F   indent = 0, indentStep = 2.
#F
SPLOps.Print := function ( arg )
    local S, indent, indentStep;
    if Length(arg) = 1 then   S := arg[1]; indent := 0; indentStep := 2;
    elif Length(arg) = 3 then S := arg[1]; indent := arg[2]; indentStep := arg[3];
    else Error("usage: SPLOps.Print( <spl> [, <indent> , <indentStep> ] )");
    fi;
    Constraint(IsInt(indent) and indent >= 0);
    Constraint(IsInt(indentStep) and indentStep >= 0);
    if IsInt(S) then
	Print(S);
    else
	S.print(indent, indentStep);
    fi;
end;

_CompactPrintSPL := rec(
    doPrintCutoff := true,

    indentWithLines := function(indent, indentStep)
        local x, beg;
	if indent < indentStep - 2 then
	    Print(Blanks(indent));
	else
	    beg := indent mod indentStep;
	    Print(Blanks(beg));
	    x := beg+1;
	    while x < indent - indentStep do
	        Print(" |", Blanks(indentStep-2));
		x := x + indentStep;
	    od;
	    Print(" +"); x := x + 2;
	    while x < indent do
	        Print("-");
		x := x + 1;
	    od;
	fi;
    end,

    indentBlank := function(indent, indentStep)
        Print(Blanks(indent));
    end,

    print := meth(self, spl, maxDepth, indentFunc, indent, indentStep)
        local c;
	if maxDepth > 0 then
	    indentFunc(indent, indentStep);
	    if IsBound(spl.symbol) then Print(spl.symbol, " ", spl.params, "\n");
	    else Print(spl.name, "\n");
	    fi;
	    if IsBound(spl.children) then
		for c in spl.children() do
	            self.print(c, maxDepth-1, indentFunc, indent+indentStep, indentStep);
		od;
	    fi;
	elif self.doPrintCutoff then
	    indentFunc(indent, indentStep);
	    Print("...\n");
	fi;
    end
);

CompactPrintSPL := function(spl, maxDepth)
    Constraint(IsSPL(spl));
    Constraint(IsInt(maxDepth) and maxDepth >= 0);
    _CompactPrintSPL.print(spl,maxDepth, _CompactPrintSPL.indentBlank, 0,5);
end;

CompactPrintSPLTree := function(spl, maxDepth)
    Constraint(IsSPL(spl));
    Constraint(IsInt(maxDepth) and maxDepth >= 0);
    _CompactPrintSPL.print(spl,maxDepth, _CompactPrintSPL.indentWithLines, 0,5);
end;

CompactPrintSPLNode := function(spl)
    Constraint(IsSPL(spl));
    if IsBound(spl.symbol) then Print(spl.symbol, " ", spl.params);
    else Print(spl.name);
    fi;
end;


#
#
#

Read("~/Workspace/Chevalley.gap/init.gi");

Read(Filename(home_dir,"lib/rsys.gd"));
Read(Filename(home_dir,"lib/rsys.gi"));

Read(Filename(home_dir,"lib/chvadj.gd"));
Read(Filename(home_dir,"lib/chvadj.gi"));

Read(Filename(home_dir,"lib/nilchv.gd"));
Read(Filename(home_dir,"lib/nilchv.gi"));

Read(Filename(home_dir,"lib/algU.gd"));
Read(Filename(home_dir,"lib/algU.gi"));

#
# UipotentChv needs SolveRelations
#
Read(Filename(home_dir,"lib/poly.gd"));
Read(Filename(home_dir,"lib/poly.gi"));

#
# UipotentChv needs Descend for Unipotent
# ... and Unipotent has to be declared before
#
# UniAlg needs Witt and UniMod
#
Read(Filename(home_dir,"lib/unichv.gd"));
Read(Filename(home_dir,"lib/witt.gd"));
Read(Filename(home_dir,"lib/unimod.gd"));
Read(Filename(home_dir,"lib/unialg.gd"));

Read(Filename(home_dir,"lib/unichv.gi"));
Read(Filename(home_dir,"lib/witt.gi"));
Read(Filename(home_dir,"lib/unimod.gi"));
Read(Filename(home_dir,"lib/unialg.gi"));


Bottles := function(n)
	local line, i, j, u;
	line := function(n)
		s := String(n);
		if n < 2 then
			return Concatenation(String(n), " bottle of beer");
		else
			return Concatenation(String(n), " bottles of beer");
		fi;
	end;
	for i in [1 .. n] do
		j := n - i + 1;
		u := line(j);
		Display(Concatenation(u, " on the wall"));
		Display(u);
		Display("Take one down, pass it around");
		Display(Concatenation(line(j - 1), " on the wall"));
		if i <> n then
			Display("");
		fi;
	od;
end;


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

#dummy var to keep copyright out of doc string
_dummy := 0;

TimeRec := (i,m) -> rec(index := i, measured := m);

IsTimeRec := r -> IsRec(r) and IsBound(r.index) and IsBound(r.measured);

#F TimeRuleTrees(spl, opts, treenums)
#F
#F    Times each rule tree indexed in list and returns a list of records
#F    spl      - SPL object to build rule trees from
#F    opts     - options
#F    treenums - list of integer indexes to rule trees for SPL object
#F               Must all be from 1 to NofRuleTrees(SPL, obj)
#F
#F	  TimeRec records in returned list of form:
#F    {
#F      index    := <integer, index of tree>,
#F      measured := <float, measured timing value, typically cycles>
#F    }
#F
#F    if opts.timingResultsFile is set, prints results to file

TimeRuleTrees := function(spl, opts, treenums)
	local retlist, idx, tree, meas, verbosity, maxidx, toFile, resultsFile, mem;

	# validate args
	if (not IsSPL(spl)) or (not IsRec(opts)) or (not IsList(treenums)) then
		Error("usage: TimeRuleTrees(spl, opts, treenums)");
	fi;

	# validate list of indexes
	maxidx := NofRuleTrees(spl, opts);
	if not ForAll(treenums, x -> IsInt(x) and x > 0 and x <= maxidx) then
		Error("List of tree indexes must be in range 1..<number of trees for spl>");
	fi;

	verbosity := Cond(IsBound(opts.verbosity), opts.verbosity, 0);

	if verbosity > 0 then
		Print("Timing ", Length(treenums), " rule trees\n");
	fi;

	toFile := IsBound(opts.timingResultsFile) and IsString(opts.timingResultsFile);
	if toFile then
		resultsFile := opts.timingResultsFile;
		PrintTo(resultsFile, "# Timing results for ", spl, "\n\n");
	fi;

	retlist := [];
	for idx in treenums do
		tree := RuleTreeN(spl, idx, opts);
		if tree <> false then
			meas := CMeasureRuleTree(tree, opts);
			Add(retlist, TimeRec(idx, meas));
			if verbosity > 1 then
				Print(idx, ": ", meas, "\n");
			fi;
			if toFile then
				AppendTo(resultsFile, idx, ", ", meas, "\n");
			fi;
		fi;

		ResetCodegen();
	od;
	return retlist;
end;

#F BestTimedRuleTree(reclist)
#F
#F    Finds the TimeRec in reclist with the best time
#F    reclist - list of timing records as returned by TimeRuleTrees
#F
#F	  Returns a copy of the best TimeRec

BestTimedRuleTree := function(reclist)
	local bestRec, tmRec;

	# validate list of timing records
	if not ForAll(reclist, r -> IsTimeRec(r)) then
		Error("reclist is not a valid list of timing records");
	fi;

	bestRec := reclist[1];
	for tmRec in reclist do
		if tmRec.measured < bestRec.measured then
			bestRec := tmRec;
		fi;
	od;

	return Copy(bestRec);
end;

#F TimeStridedRuleTrees(spl, opts, sample_count)
#F
#F    Time a strided list of indexed rule trees starting with index 1
#F    Calculates stride from <rule tree count> / sample_count
#F
#F    Returns a list of timing records (TimeRec)

TimeStridedRuleTrees := function(spl, opts, sample_count)
	local n_trees, stride, index_list;

	if sample_count < 1 then
		Error("<sample_count> must be greater than 0");

	fi;

	n_trees := NofRuleTrees(spl, opts);

	if sample_count > n_trees then
		Error("<sample_count> (", sample_count, ") is larger than number of rule trees (",
			n_trees, ")");
	fi;

	stride := n_trees / sample_count;
	index_list := List([0..(sample_count-1)], x -> 1 + Int(x * stride));

	return TimeRuleTrees(spl, opts, index_list);
end;


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

ImportAll(paradigms.vector);

Class(LSKernel, SumsBase, BaseContainer, rec(
    doNotMarkBB:= true,
    abbrevs := [ ch -> [ch,0], (ch,ops) -> [ch,ops] ],
    new := (self, ch, ops) >> SPL(WithBases(self, rec(
        info := Cond(
            IsInt(ops) or IsRat(ops)
                or IsValue(ops) or IsExp(ops), rec(
                    opcount := When(IsValue(ops),ops.v,ops),
                    free := Set([]),
                    loadFunc := fId(ch.dimensions[2]),
                    storeFunc := fId(ch.dimensions[1])
                ),

            IsRec(ops), ops,

            Error("unknown info")
        ),

        _children := [ch],

        dimensions := ch.dimensions
    ))),

    rChildren := self >> [self._children[1], self.info],

    rSetChild := meth(self, n, what)
        if n=2 then self.info := what;
        elif n=1 then self._children[1] := what;
        else Error("<n> must be in [1..2]");
        fi;
    end,

    mergeInfo := (self, r1, r2) >> rec(
        opcount := r1.opcount + r2.opcount,
        free := Concat(r1.free, r2.free),
        loadFunc := r2.loadFunc,
        storeFunc := r1.storeFunc
    ),

    print := meth(self, indent, indentStep)
        local s,ch,first,newline;

        ch := [self.child(1),self.info];
        if self._short_print or ForAll(ch, x->IsSPLSym(x) or IsSPLMat(x)) then
            newline := Ignore;
        else
            newline := self._newline;
        fi;

        first:=true;
        Print(self.__name__, "(");
        for s in ch do
            if(first) then first:=false;
            else Print(", "); fi;
            newline(indent + indentStep);
            When(IsSPL(s) or (IsRec(s) and IsBound(s.print) and NumGenArgs(s.print)=2),
                s.print(indent + indentStep, indentStep), Print(s));
        od;
        newline(indent);
        Print(")");
        self.printA();
    end,
));

Class(DMAGath, Gath, rec(doNotMarkBB:= true));

Class(DMAScat, Scat, rec(doNotMarkBB:= true));

Class(DMAFence, Buf, rec(doNotMarkBB:= true));

Class(SWPSum, ISum, rec(doNotMarkBB := true));

Class(DMAGathV, VGath, rec(doNotMarkBB := true));
Class(DMAScatV, VScat, rec(doNotMarkBB := true));


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

# Dynamic Programming Search for good trees
# =========================================
# BS, MP, from 08/17/00

#F TimeLimitExpired( <startTime>, <timeLimit> )
#F    calculates if the time limit has expired
#F

TimeLimitExpired := function( startTime, timeLimit )
   return ( TimeInSecs()-startTime > 60*timeLimit );
end;

#F HashTableDP()
#F   returns a hash table for use with dynamic programming
#F

DPMeasureRuleTree := CMeasureRuleTree;

HashTableDP := function()
   return HashTable( HashIndexSPL, IsHashIdenticalSPL, "HashTableDP()" );
end;

_dpMeasure := function(wrappedTree, fullTree, spl, opts, dpopts, indent, isBaseCase)
    local mtree, time, bf;
    # Time tree
    When(dpopts.verbosity>=4, Print(Blanks(indent), "Timing: ", PrettyPrintRuleTree(fullTree, indent+6), "\n"));

#    Print("** _dpMeasure: \n* ", wrappedTree, "\n* ", fullTree, "\n* ", spl, "\n");

    ##################################################
    #    tSPL hack: do not measure everything
    if dpopts.verbosity>=5 then
    Print("Now doing measurments:\n");
    Print("spl: ", spl, "\n");
    if IsBound(dpopts.wraps) then Print("dpopts.wraps: ", dpopts.wraps, "\n"); fi;
    if IsBound(spl.wrap) then Print("spl.wrap", spl.wrap, "\n"); fi;
    fi;

    When(dpopts.verbosity>=5, Print(Blanks(indent), "tSPL: Measuring: ", wrappedTree,"\n"));

    if (IsBound(spl.doNotMeasure) and (spl.doNotMeasure)) then
        When(dpopts.verbosity>=5, Print(Blanks(indent), "tSPL: Not measuring ", spl, "\n"));
        time := 0;
    else
        if not dpopts.timeBaseCases and isBaseCase then
            time := 0; # do not measure
        elif IsBound(dpopts.measureFunction) then
            time := dpopts.measureFunction( wrappedTree, opts );
        else
            time := DPMeasureRuleTree( wrappedTree, opts );
        fi;
        When(dpopts.verbosity>=4, PrintLine("Measurment done: ", time));
    fi;

    ResetCodegen();

    When(dpopts.verbosity>=4, Print(Blanks(indent), "   ! ", time, "\n" ));
    return time;
end;

_dpReuseHash := function(W, spl, opts, dpopts, rvars)
    local lkup, lkup2, i, wrappedspl;

    wrappedspl := spl;
    for i in Reversed(W) do
        wrappedspl := i.twrap(spl,opts);
    od;

    # First lookup in readonly base cases hashtable, if not found, use the DP hashTable
    lkup := MultiHashLookup(opts.baseHashes, spl); # NOTE: why not wrappedspl? because it does not work!
    if lkup <> false then
        # Save in DP hash table also
        if HashLookup(rvars.hashTable, spl) = false then
            HashAdd(rvars.hashTable, spl, lkup);
        fi;
    else
        lkup := HashLookup( rvars.hashTable, wrappedspl);
    fi;

    # Found something -- just return it
    if not lkup = false then
    When(dpopts.verbosity>=5, Print("reuse lkup:\nlkup: ", lkup, "\n"));
    lkup2 := Copy(lkup);
    for i in lkup2 do
            if IsBound(i.origtree) then
                # special case in real A_x_I wrapped guys -- NOTE!!!
        if W <> VWrapId then
            When(dpopts.verbosity>=5, Print("VWrapId: using ruletree instead of origtree:\n"));
            i.ruletree := i.origtree;
        fi;
        Unbind(i.origtree);
        fi;
    od;
    return lkup2;
    fi;
    return lkup;
end;

_dpMax := (a,b) -> a.measured > b.measured;
_dpMin := (a,b) -> a.measured < b.measured;

Declare(_DPSPLRec);

# DPSPLRec( <spl>, <search-options-rec>, <SPL-options-rec>, <recVars> )
#    does the actual dynamic programming recursivedly.
#    do not call directly -- call DPSPL.
#
# HELP -- no checks for infinite loops (YSV: infinite loops in what?)
#
DPSPLRec := function( spl, dpopts, opts, rvars )
    local hspl, res, i;
    opts := TypeOpts(spl, opts);
    hspl := HashAsSPL(spl);
    res  := _DPSPLRec(hspl, dpopts, opts, rvars);
    for i in res do
        i.ruletree := ApplyRuleTreeSPL(i.ruletree, spl, opts);
    od;
    return res;
end;

_DPSPLRec := function( spl, dpopts, opts, rvars )
   local hash, hash2, chash, i, bf, wrappedspl, tree, trees, mtree, W, w, children, childrenSets,
         index, time, bestTrees, bestTrees2, numTimed, result, sorter, dpopts2, IsTopLevel,
         fullTree, mopts;

    ################################################
    if dpopts.verbosity>=5 then
        Print("Recursive call, spl: ", spl, "\n");
        if IsBound(dpopts.wraps) then Print("dpopts.wraps: ", dpopts.wraps, "\n"); fi;
        if IsBound(spl.wrap) then Print("spl.wrap", spl.wrap, "\n"); fi;
    fi;

    dpopts2 := Copy(dpopts);

    if not IsBound(dpopts2.wraps) then
        dpopts2.wraps := [VWrapId];
        dpopts2.wrap_index := 1;
    fi;

    # replaceable wrapper
    if ObjId(spl)=DPWrapper then
        dpopts2.wraps := ListWithout(dpopts2.wraps, dpopts2.wrap_index) :: [spl.wrap];
        dpopts2.wrap_index := Length(dpopts2.wraps);
    fi;
    # stackable wrappers
    if ObjId(spl)=DPSWrapper then
        Add(dpopts2.wraps, spl.wrap);
    fi;

    W := dpopts2.wraps;

    #################################################

    ############################################################
    ## Temporary Hack because spl.doNotMeasure is not checked ##
    ############################################################
    if (ObjId(spl)=InfoNt) then
        W:=[VWrapId];
    fi;

    # Check Time Limit
    if rvars.stopNow or (IsInt(dpopts.timeLimit) and TimeLimitExpired(rvars.startTime, dpopts.timeLimit)) then
        rvars.stopNow := true;
        When(dpopts.verbosity > 1, Print("\nTime Limit Expired!\n\n"));

        return [];
    fi;

    # unify data types to have spl with correct data type attributes before searching in hash
    spl := SumsUnification(spl, opts);

    hash := _dpReuseHash(W, HashAsSPL(spl), opts, dpopts, rvars);
    if hash <> false then
        return hash;
    fi;

    # Set up some local variables and functions
    sorter := When(dpopts.optimize = "maximize", _dpMax, _dpMin);
    numTimed := 0;
    bestTrees := [];
    if dpopts.verbosity>=1 then
        Print(Blanks(rvars.indent), "DP called on ", spl.print(rvars.indent, 2), "\n" );
    fi;
    trees := ExpandSPL(spl, opts);
    When(dpopts.verbosity>=3, Print(Blanks(rvars.indent), Length(trees), " tree(s) to fully expand\n"));
    rvars.indent := rvars.indent + 2;

    # For each possible new one level tree
    for tree in trees do

      # Check Time Limit
      if IsInt(dpopts.timeLimit) and not rvars.stopNow and TimeLimitExpired(rvars.startTime, dpopts.timeLimit) then
        rvars.stopNow := true;
        When(dpopts.verbosity > 1, Print("\nTime Limit Expired!\n\n"));
      else
        # For each possible set of subtrees of <tree>'s children
        childrenSets := Cartesian(List(tree.children, c -> List(DPSPLRec(c,dpopts2,opts,rvars), n->n.ruletree)));

        for children in childrenSets do
          if dpopts.verbosity>=5 then ################################################
            PrintLine("Back again:", "\nspl: ", spl, "\nchildren: ", children);
            When(IsBound(dpopts.wraps), Print("dpopts.wraps: ", dpopts.wraps, "\n"));
            When(IsBound(spl.wrap),    Print("spl.wrap", spl.wrap, "\n"));
          fi;   ######################################################################

          # Construct full tree, wrap it, and measure
          fullTree := CopyRuleTree(tree);
          fullTree.children := ShallowCopy(children);
          mopts := ShallowCopy(opts);
          mtree := fullTree;
          for w in Reversed(W) do
            mtree := w.wrap(mtree, spl, mopts);
            mopts := w.opts(spl, mopts);
          od;
          time := _dpMeasure(mtree, fullTree, spl, mopts, dpopts, rvars.indent,
              Length(childrenSets)=1 and Length(trees)=1);

          rvars.numTimed := rvars.numTimed + 1;
          numTimed := numTimed + 1;

              # See if one of the best times
          Add(bestTrees, rec( ruletree := mtree, origtree:= fullTree, measured := time,
                          globalUnrolling := opts.globalUnrolling ));
          Sort(bestTrees, sorter);
          When(IsBound(bestTrees[dpopts.nBest+1]), Unbind(bestTrees[dpopts.nBest+1]));

          od;
      fi;
   od;
   rvars.indent := rvars.indent - 2;

   # Save final result
   if not(IsBound(spl.doNotSaveInHashtable)) or
       (IsBound(spl.doNotSaveInHashtable) and not spl.doNotSaveInHashtable) then
       wrappedspl := HashAsSPL(spl);
       for w in Reversed(W) do
           wrappedspl := w.twrap(wrappedspl,opts);
       od;
       HashAdd(rvars.hashTable, wrappedspl, bestTrees);

       if IsBound(opts.unsafeDpHashUnwrapped) and opts.unsafeDpHashUnwrapped then
	   if HashLookup(rvars.hashTable, HashAsSPL(spl))=false then
	       HashAdd(rvars.hashTable, HashAsSPL(spl), List(bestTrees, x->CopyFields(x, rec(ruletree:=x.origtree))));
	   fi;
       fi;
   fi;

   if dpopts.verbosity>=2 then
       When(dpopts.verbosity>=3, Print(Blanks(rvars.indent), numTimed, " tree(s) timed at this level\n"));
       Print(Blanks(rvars.indent), "Best Trees:\n" );
       for result in bestTrees do
           Print(Blanks(rvars.indent+3), PrettyPrintRuleTree(result.ruletree, rvars.indent+3), " ! ", result.measured, "\n");
       od;
   fi;

    # NOTE: Hack to avoid wrapped trees in bestfoundtable
    bestTrees2 := Copy(bestTrees);
    for i in bestTrees2 do
        if IsBound(i.origtree) then
            i.ruletree := i.origtree;
            Unbind(i.origtree);
        fi;
    od;

    return bestTrees2;
end;

# GlobalUnrollingDPSPL( <spl>, <search-options-rec>,
#                       <SPL-options-rec>, <rvars> )
#   performs search over global unrolling for DP
#

GlobalUnrollingDPSPL := function( spl, dpopts, opts, rvars )
   local result, bestResult, bestUnrolling, bestHashTable;

   bestResult := false;

   # Initialize to first globalUnrolling setting
   opts.globalUnrolling := dpopts.globalUnrollingMin;

   repeat

      if dpopts.verbosity > 0 then
         Print( "Global_Unrolling := ", opts.globalUnrolling, "\n" );
      fi;

      # Set up hashTable
      if IsBound( dpopts.hashTable ) then
         rvars.hashTable := Copy(dpopts.hashTable);
      else
     rvars.hashTable := HashTableDP();
      fi;

      # Do DP
      result := DPSPLRec( spl, dpopts, opts, rvars );

      # Keep track of best result found over all unrollings
      if bestResult = false or bestResult = [] then
         bestResult := result;
     bestUnrolling := opts.globalUnrolling;
     bestHashTable := rvars.hashTable;
      elif    (     bestResult[1].measured < result[1].measured
                and dpopts.optimize = "maximize" )
           or (     bestResult[1].measured > result[1].measured
                and dpopts.optimize = "minimize" ) then
         bestResult := result;
     bestUnrolling := opts.globalUnrolling;
     bestHashTable := rvars.hashTable;
      fi;

      # Increase globalUnrolling
      opts.globalUnrolling := opts.globalUnrolling * 2;

   until opts.globalUnrolling > dpopts.globalUnrollingMax or
         rvars.stopNow;

   if dpopts.verbosity > 0 then
      Print( "Optimal unrolling is ", bestUnrolling, "\n" );
   fi;

   if IsBound( dpopts.hashTable ) then
      RecCopy(dpopts.hashTable, bestHashTable);
   fi;

   return bestResult;
end;

#F DPSPL( <spl> [, <DP-options-record>, <SPL-options-record> ] )
#F   runs dynamic programing on the given spl.
#F   maintins the n best formulas for each spl.
#F   returns a list of records of the best trees and their times.
#F   also may pass a DPOptionsRecord and a SPLOptionsRecord.
#F   to specify one set of options but not the other, pass just a "rec()"
#F      in place of the options you do not wish to set
#F   call PrintSpecDPOptionsRecord() and PrintSpecSPLOptionsRecord() to get
#F      info on possible options
#F   Verbosity levels:
#F      0 = Print nothing
#F      1 = Show recursive calls to DP
#F      2 = Show best trees found found each recursive call to DP
#F      3 = Show how many trees must be fully expanded and how many were timed
#F      4 = Show formulas that are being timed.
#F

DPSPL := function( arg )
   local spl,
     dpopts, opts,
     rvars,
     result;

   # process arg
   if Length(arg) = 1 then
      spl := arg[1];
      dpopts := MergeDPOptionsRecord(rec());
      opts := MergeSPLOptionsRecord(rec());
   elif Length(arg) = 3 then
      spl := arg[1];
      dpopts := MergeDPOptionsRecord(arg[2]);
#opts := MergeSPLOptionsRecord(arg[3]);
      opts := (arg[3]);
   else
      Error( "usage: DPSPL( <spl>",
             " [, <DP-options-record>, <SPL-options-record> ] )\n" );
   fi;

   # check spl
   if not IsSPL(spl) then
      Error("<spl> must be provided and a valid spl");
   fi;
   # check dataType
   SearchCheckDataType( spl, opts );
   # setup variables used during recursive calls

   rvars := rec( indent := 0, numTimed := 0, stopNow := false);

   # check timeLimit
   if IsInt( dpopts.timeLimit ) then
      rvars.startTime := TimeInSecs();
   fi;

   # check globalUnrolling because it requires extra work
   if dpopts.globalUnrolling = true then
      result := GlobalUnrollingDPSPL( spl, dpopts, opts, rvars );
   else

      # setup hashTable
      if IsBound( dpopts.hashTable ) then
         rvars.hashTable := dpopts.hashTable;
      elif IsBound( opts.hashTable ) then
         rvars.hashTable := opts.hashTable;
      else
         rvars.hashTable := HashTableDP();
      fi;

      result := DPSPLRec( spl, dpopts, opts, rvars );

   fi;

   if dpopts.verbosity >= 3 then
      Print( rvars.numTimed, " total trees timed\n" );
   fi;

   return result;
end;

#F DP(...) alias for DPSPL(...)
#F

DP := DPSPL;


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

Class(DMACodegen, DefaultCodegen, rec(
    Formula := meth(self, o, y, x, opts)
        local icode, datas, prog, params, sub, initsub, io, t, initcode;
        [x, y] := self.initXY(x, y, opts);

        Add(x.t.qualifiers, opts.memModifier);
        Add(y.t.qualifiers, opts.memModifier);

        o := o.child(1);
        params := Set(Concatenation(Collect(o, param), Filtered(Collect(o, var), IsParallelLoopIndex)));

        datas := Collect(o, FDataOfs);
        [o,t] := UTimedAction(BlockSumsOpts(o, opts)); #PrintLine("BlockSums ", t);
        [icode,t] := UTimedAction(self(o, y, x, opts)); #PrintLine("codegen ", t);
        [icode,t] := UTimedAction(ESReduce(icode, opts)); #PrintLine("ESReduce ", t);
        icode := RemoveAssignAcc(icode);
        Unbind(Compile.times);
        [icode,t] := UTimedAction(BlockUnroll(icode, opts)); #PrintLine("BlockUnroll ", t);
        #PrintLine("---compile--");

        icode := DeclareHidden(icode);
        if IsBound(opts.isFixedPoint) and opts.isFixedPoint then
            icode := FixedPointCode(icode, opts.bits, opts.fracbits);
        fi;

        io := When(x=y, [x], [y, x]);
        sub := Cond(IsBound(opts.subNameDMA), opts.subNameDMA, "sub_dma");
        icode := func(TVoid, sub, Concatenation(io, params), icode);

        return icode;
    end,

    LSKernel := meth(self, o, y, x, opts)
        return chain(dma_signal(self.swp_var), cpu_wait(self.swp_var));
    end,

    DMAGath := meth(self, o, y, x, opts)
        local i, func, rfunc, ix, size;
        Add(self.loadbuffers, y);
        Add(self.membuffers, x);
        i := Ind();

        func := o.func;
        size := 1;
        if ObjId(func) = fTensor and ObjId(Last(func.children())) = fId then
            size := Last(func.children()).domain();
            func := fTensor(Concat(DropLast(func.children(), 1), [fBase(size, 0)]));
        fi;

        func := func.lambda();
        return loop(i, func.domain(), dma_load(y+(i*size), x+func.at(i), size));
    end,

    DMAScat := meth(self, o, y, x, opts)
        local i, func, rfunc, ix, size;

        Add(self.storebuffers, x);
        Add(self.membuffers, y);
        i := Ind();

        func := o.func;
        size := 1;
        if ObjId(func) = fTensor and ObjId(Last(func.children())) = fId then
            size := Last(func.children()).domain();
            func := fTensor(Concat(DropLast(func.children(), 1), [fBase(size, 0)]));
        fi;

        func := func.lambda();
        return loop(i, func.domain(), dma_store(y+func.at(i), x+(i*size), size));
    end,

    DMAFence := (self,o,y,x,opts) >> chain(self(o.child(1), y, x, opts), dma_fence()),

    swp_var := false,
    SWPSum := meth(self, o, y, x, opts)
        local old_swp, c;

        old_swp := self.swp_var;
        self.swp_var := o.var;
        c := swp_loop(o.var, o.domain, self(o.child(1), y, x, opts));
        self.swp_var := old_swp;
        return c;
    end

));

Class(CPUCodegen, DefaultCodegen, rec(
    Formula := meth(self, o, y, x, opts)
        local icode, datas, prog, params, sub, initsub, io, t, initcode;
        [x, y] := self.initXY(x, y, opts);

        o := o.child(1);
        params := Set(Concatenation(Collect(o, param), Filtered(Collect(o, var), IsParallelLoopIndex)));

        datas := Collect(o, FDataOfs);
        [o,t] := UTimedAction(BlockSumsOpts(o, opts)); #PrintLine("BlockSums ", t);
        [icode,t] := UTimedAction(self(o, y, x, opts)); #PrintLine("codegen ", t);
        [icode,t] := UTimedAction(ESReduce(icode, opts)); #PrintLine("ESReduce ", t);
        icode := RemoveAssignAcc(icode);
        Unbind(Compile.times);
        [icode,t] := UTimedAction(BlockUnroll(icode, opts)); #PrintLine("BlockUnroll ", t);
        #PrintLine("---compile--");

        icode := DeclareHidden(icode);
        if IsBound(opts.isFixedPoint) and opts.isFixedPoint then
            icode := FixedPointCode(icode, opts.bits, opts.fracbits);
        fi;

        io := When(x=y, [x], [y, x]);
        Add(params, Filtered(icode.free(), i->not IsBound(i.init)));
        sub := Cond(IsBound(opts.subNameCompute), opts.subNameCompute, "sub_cpu");

        icode := func(TVoid, sub, params, icode);

        return icode;

    end,

    DMAGath := meth(self, o, y, x, opts)
        local dma;
        if not IsBound(x.t.qualifiers) then x.t.qualifiers := []; fi;
        if not IsBound(y.t.qualifiers) then y.t.qualifiers := []; fi;
        Add(x.t.qualifiers, opts.memModifier);
        y.t.qualifiers := [ opts.scratchModifier ];
        Add(self.loadbuffers, y);
        return dma_wait(self.swp_var);
    end,

    DMAScat := meth(self, o, y, x, opts)
        local dma;
        if not IsBound(x.t.qualifiers) then x.t.qualifiers := []; fi;
        if not IsBound(y.t.qualifiers) then y.t.qualifiers := []; fi;
        x.t.qualifiers := [ opts.scratchModifier ];
        Add(y.t.qualifiers, opts.memModifier);
        Add(self.storebuffers, x);
        return cpu_signal(self.swp_var);
    end,

    LSKernel := (self, o, y, x, opts) >> self(o.child(1), y, x, opts),

    swp_var := false,
    SWPSum := meth(self, o, y, x, opts)
        local old_swp, c;

        old_swp := self.swp_var;
        self.swp_var := o.var;
        c := swp_loop(o.var, o.domain, self(o.child(1), y, x, opts));
        self.swp_var := old_swp;
        return c;
    end
));

_scratch_variables := function(vars, opts)
   local new_vars, i, nv;
   new_vars := [];
    for i in vars do
        nv := Copy(i);
        nv.t := TArray(nv.t, 2);
        nv.t.qualifiers := [opts.scratchModifier];
        Add(new_vars, nv);
    od;

    return new_vars;
end;

_double_buffer := function(cpu, dma, vars, opts)
    local new_cpu, new_dma, loops, new_loops, l, ld, st, s, w, c, i, s1, s2, ll, lst, new_vars, nv, svars, srec, v, vv, dvars, ass;

    svars := [];
    loops := Collect(dma, swp_loop);
    new_loops := [];
    new_dma := Copy(dma);
    new_cpu := cpu;

    for l in loops do
        i := l.var;

        ld := Collect(l, [loop, @(1), @(2), dma_load]);
        if Length(ld) = 0 then ld := Collect(l, dma_load)[1]; else ld := ld[1]; fi;
        st := Collect(l, [loop, @(1), @(2), dma_store]);
        if Length(st) = 0 then st := Collect(l, dma_store)[1]; else st := st[1]; fi;
        s := Collect(l, dma_signal)[1];
        w := Collect(l, cpu_wait)[1];
        s1 := Filtered(ld.free(), i->IsBound(i.t.qualifiers) and i.t.qualifiers=[opts.scratchModifier])[1];
        s2 := Filtered(st.free(), i->IsBound(i.t.qualifiers) and i.t.qualifiers=[opts.scratchModifier])[1];
        Add(svars, s1);
        Add(svars, s2);

        ll := Copy(l);
        lst := SubstVars(Copy(st), rec((s2.id) := nth(s2, bin_and(i, V(2)))));
        lst := SubstVars(lst, rec((i.id) := i-V(1)));
        lst := Collect(lst, dma_store)[1];

        ll.range := [Minimum(l.range)+1..Maximum(l.range)];
        ll := SubstTopDown(ll, @(1, dma_load), e->dma_load(nth(@(1).val.loc, bin_and(i, V(2))), @(1).val.exp, @(1).val.size));
        ll := SubstTopDown(ll, @(1, dma_store), e->lst);
        ll := SubstTopDown(ll, @(1, cpu_wait), e->cpu_wait(@(1).val.args[1]-1));

        c := chain([
            SubstVars(chain([Copy(ld), Copy(s)]), rec((i.id) := V(0), (s1.id) := nth(s1, 0))),
            ll,
            SubstVars(chain([Copy(w), Copy(st)]), rec((i.id) := i.range-V(1), (s2.id) := nth(s2, 1))),
        ]);
        c := RulesStrengthReduce(c);
        new_dma := SubstBottomUp(new_dma, @(1, swp_loop, e->e.var = i), e->c);
    od;

    svars := Set(svars);
    loops := Collect(cpu, swp_loop);
    new_cpu := Copy(cpu);
    new_loops := [];
    for l in loops do
        i := l.var;
        srec := rec();
        dvars := [];
        ass := [];
        for v in svars do
            vv := var.fresh_t("R", TPtr(v.t.t));
            Add(dvars, vv);
            Add(ass, assign(vv, nth(v, bin_and(i, V(2)))));
            srec.(v.id) := vv;
        od;
        c := SubstVars(l, srec);
        c := swp_loop(c.var, c.range, decl(dvars, chain(Concat(ass, [c.cmd]))));
        new_cpu := SubstBottomUp(new_cpu, @(1, swp_loop, e->e.var = i), e->c);
    od;

    new_vars := _scratch_variables(vars,opts);

    return [new_cpu, new_dma, new_vars];
end;

Class(ScratchMainCodegen, rec(
    genMain := (self, opts, sub, dmafunc, cpufunc, xy, params) >>
        func(TVoid, sub, Concatenation(xy, params), par_exec(
            ApplyFunc(call, Flat(Concatenation([dmafunc], xy))),
            call(cpufunc)
        ))
));

Class(ScratchCodegen, DefaultCodegen, rec(
    CPUCodegen := CPUCodegen,
    DMACodegen := DMACodegen,
    MainCodegen := ScratchMainCodegen,

    Formula := meth(self, o, y, x, opts)
        local tag, main, initfunc, cpufunc, dmafunc, prog, params, sub, initsub, memvars, scratchvars, v, io, loadvar, storevar, v, substrec, svars, initcode, datas, dvars, dv;

        datas := Collect(o, FDataOfs);
        params := Set(Concatenation(Collect(o, param), Filtered(Collect(o, var), IsParallelLoopIndex)));
        sub := Cond(IsBound(opts.subName), opts.subName, "transform");

        initsub := Cond(IsBound(opts.subName), Concat("init_", opts.subName), "init");
        if IsBound(opts.generateInitFunc) and opts.generateInitFunc then
            initcode := chain(List(datas, x -> SReduce(x.var.init, opts)));
            initfunc := func(TVoid, initsub, params :: Set(Collect(initcode, param)), initcode);
        else
            initfunc := func(TVoid, initsub, params, chain());
        fi;

        dvars := List(datas, x->x.var);
        for dv in dvars do
            dv.t.qualifiers := [opts.romModifier];
        od;

        self.DMACodegen.loadbuffers := Set([]);
        self.DMACodegen.storebuffers := Set([]);
        self.DMACodegen.membuffers := Set([]);
        dmafunc := self.DMACodegen.Formula(o, y, x, opts);
        self.DMACodegen.membuffers := Set(self.DMACodegen.membuffers);
        SubtractSet(self.DMACodegen.membuffers, Set([x, y]));
        for v in self.DMACodegen.membuffers do v.t.qualifiers := [opts.memModifier]; od;

        self.CPUCodegen.loadbuffers := Set([]);
        self.CPUCodegen.storebuffers := Set([]);
        cpufunc := self.CPUCodegen.Formula(o, y, x, opts);

        memvars := Set(Concat(
            Filtered(Flat(List(Collect(cpufunc, decl), i->i.vars)), j->IsBound(j.t.qualifiers) and opts.memModifier in j.t.qualifiers),
            self.DMACodegen.membuffers));
        scratchvars := Set(Filtered(Flat(List(Collect(cpufunc, decl), i->i.vars)), j->IsBound(j.t.qualifiers) and opts.scratchModifier in j.t.qualifiers));

        tag := opts.tags[1];

        loadvar := var.fresh_t("S", TArray(opts.XType.t, Cond(tag.isRegCx, 2 * tag.size, tag.size)));
        loadvar.t.qualifiers := [opts.scratchModifier];
        storevar := var.fresh_t("S", TArray(opts.XType.t, Cond(tag.isRegCx, 2 * tag.size, tag.size)));
        storevar.t.qualifiers := [opts.scratchModifier];

        substrec := rec();
        for v in self.CPUCodegen.loadbuffers do substrec.(v.id) := loadvar; od;
        for v in self.CPUCodegen.storebuffers do substrec.(v.id) := storevar; od;
        for v in self.DMACodegen.loadbuffers do substrec.(v.id) := loadvar; od;
        for v in self.DMACodegen.storebuffers do substrec.(v.id) := storevar; od;
        cpufunc :=  SubstVars(cpufunc, substrec);
        dmafunc :=  SubstVars(dmafunc, substrec);

        cpufunc := SubstTopDown(cpufunc, @(1, decl), e->decl(Filtered(@(1).val.vars, i->not i in Concat(memvars, scratchvars, [loadvar, storevar])), @(1).val.cmd));
        dmafunc := SubstTopDown(dmafunc, @(1, decl), e->decl(Filtered(@(1).val.vars, i->not i in Concat(memvars, scratchvars, [loadvar, storevar])), @(1).val.cmd));

        [cpufunc, dmafunc, svars] := When(opts.swp,_double_buffer(cpufunc, dmafunc, [loadvar, storevar], opts),[cpufunc,dmafunc,[loadvar,storevar]]);

        x.t.qualifiers := Set(x.t.qualifiers);
        y.t.qualifiers := Set(y.t.qualifiers);

        main := self.MainCodegen.genMain(opts, sub, dmafunc, cpufunc, [x,y], params);
        prog := program(
            decl(Concat(Set(memvars), svars, dvars), chain(
                initfunc,
                cpufunc,
		        dmafunc,
                main
        )));

        prog.dimensions := o.dims();
        return prog;
    end
));


#############################################################################
##
##  io.gi
##  Copyright (C) 2014-19                                James D. Mitchell
##
##  Licensing information can be found in the README file of this package.
##
#############################################################################
##

#############################################################################
## This file contains methods for reading and writing digraphs from and to
## files.
##
## It is organized as follows:
##
##   0. Internal functions
##
##   1. Picklers for IO
##
##   2. Read/WriteDigraphs (the main functions)
##
##   3. Decoders
##
##   4. Encoders
##
#############################################################################

#############################################################################
# 0. Internal functions
#############################################################################

BindGlobal("DIGRAPHS_SplitStringBySubstring",
function(string, substring)
  local m, n, i, j, out, nr;

  if Length(string) = 0 then
    return [];
  fi;
  if Length(substring) = 1 then
    return SplitString(string, substring);
  fi;

  m := Length(string);
  n := Length(substring);
  i := 1;
  j := 1;
  out := [];
  nr := 0;

  while m - i >= n do
    if string{[i .. i + n - 1]} = substring then
      if i <> 1 then
        nr := nr + 1;
        out[nr] := string{[j .. i - 1]};
        j := i + n;
        i := i + n;
      fi;
    else
      i := i + 1;
    fi;
  od;
  nr := nr + 1;
  out[nr] := string{[j .. Length(string)]};
  return out;
end);

BindGlobal("DIGRAPHS_Graph6Length",
function(n)
  local list;
  list := [];
  if n < 0 then
    return fail;
  elif n < 63 then
    Add(list, n);
  elif n < 258248 then
    Add(list, 63);
    Add(list, Int(n / 64 ^ 2));
    Add(list, Int(n / 64) mod 64);
    Add(list, n mod 64);
  elif n < 68719476736 then
    Add(list, 63);
    Add(list, 63);
    Add(list, Int(n / 64 ^ 5));
    Add(list, Int(n / 64 ^ 4) mod 64);
    Add(list, Int(n / 64 ^ 3) mod 64);
    Add(list, Int(n / 64 ^ 2) mod 64);
    Add(list, Int(n / 64 ^ 1) mod 64);
    Add(list, n mod 64);
  else
    return fail;
  fi;
  return list;
end);

################################################################################
# 1. Picklers
################################################################################

InstallMethod(IO_Pickle, "for a digraph with known digraph group",
[IsFile, IsDigraph and HasDigraphGroup],
function(file, D)
  local g, out;
  g := DigraphGroup(D);
  if IsTrivial(g) then
    TryNextMethod();
  fi;
  if IO_Write(file, "DIGG") = fail then
    return IO_Error;
  fi;
  out := [GeneratorsOfGroup(g),
          RepresentativeOutNeighbours(D),
          DigraphSchreierVector(D)];
  return IO_Pickle(file, out);
end);

IO_Unpicklers.DIGG := function(file)
  local list, gens, rep_out, sch, out, trace, word, D, i, w;

  list := IO_Unpickle(file);
  if list = IO_Error then
    return IO_Error;
  fi;

  gens    := list[1];
  rep_out := list[2];
  sch     := list[3];

  out  := [];
  for i in [1 .. Length(sch)] do
    if sch[i] < 0 then
      out[i] := rep_out[-sch[i]];
    fi;

    trace := DIGRAPHS_TraceSchreierVector(gens, sch, i);
    out[i] := rep_out[trace.representative];
    word := trace.word;
    for w in word do
       out[i] := OnTuples(out[i], gens[w]);
    od;
  od;

  D := ConvertToImmutableDigraphNC(out);
  SetDigraphGroup(D, Group(gens));
  SetDigraphSchreierVector(D, sch);
  SetRepresentativeOutNeighbours(D, rep_out);
  return D;
end;

InstallMethod(IO_Pickle, "for a digraph",
[IsFile, IsDigraph],
function(file, D)
  if IO_Write(file, "DIGT") = fail then
    return IO_Error;
  fi;
  return IO_Pickle(file, OutNeighbours(D));
end);

IO_Unpicklers.DIGT := function(file)
  local out;
  out := IO_Unpickle(file);
  if out = IO_Error then
    return IO_Error;
  fi;
  return ConvertToImmutableDigraphNC(out);
end;

################################################################################
# 2. ReadDigraphs and WriteDigraphs
################################################################################

InstallGlobalFunction(IteratorFromDigraphFile,
function(arg)
  local filename, decoder, file, record;

  if Length(arg) = 1 then
    filename := arg[1];
    decoder  := fail;
  elif Length(arg) = 2 then
    filename := arg[1];
    decoder  := arg[2];
  else
    ErrorNoReturn("there must be 1 or 2 arguments,");
  fi;

  if not IsString(filename) then
    ErrorNoReturn("the 1st argument must be a string,");
  elif decoder <> fail and not IsFunction(decoder) then
    ErrorNoReturn("the 2nd argument must be a function or fail,");
  fi;

  file := DigraphFile(UserHomeExpand(filename), decoder, "r");

  record := rec(file := file, current := file!.coder(file));

  record.NextIterator := function(iter)
    local next;
    next := iter!.current;
    iter!.current := iter!.file!.coder(iter!.file);
    return next;
  end;

  record.IsDoneIterator := function(iter)
    if iter!.current = IO_Nothing then
      if not iter!.file!.closed then
        IO_Close(iter!.file);
      fi;
      return true;
    else
      return false;
    fi;
  end;

  record.ShallowCopy := function(iter)
    local file;
    file := DigraphFile(UserHomeExpand(filename), decoder, "r");
    return rec(file := file, current := file!.coder(file));
  end;

  return IteratorByFunctions(record);
end);

# these functions wrap the various line encoders/decoders in this file so that
# they behave like IO_Pickle.

BindGlobal("DIGRAPHS_EncoderWrapper",
function(encoder)
  if encoder = IO_Pickle then
    return IO_Pickle;
  fi;
  return {file, D} -> IO_WriteLine(file, encoder(D));
end);

BindGlobal("DIGRAPHS_DecoderWrapper",
function(decoder)
  if decoder = IO_Unpickle then
    return IO_Unpickle;
  fi;
  return
    function(file)
      local line;
      line := IO_ReadLine(file);
      if line = "" then
        return IO_Nothing;
      fi;
      return decoder(line);
    end;
end);

# if we are choosing the decoder, then the file extension is used.

BindGlobal("DIGRAPHS_ChooseFileDecoder",
function(filename)
  local splitname, extension;

  if not IsString(filename) then
    ErrorNoReturn("the argument <filename> must be a string,");
  fi;

  splitname := SplitString(filename, ".");
  extension := splitname[Length(splitname)];

  if extension in ["gz", "bz2", "xz"] then
    extension := splitname[Length(splitname) - 1];
  fi;

  if extension = "txt" then
    return DigraphPlainTextLineDecoder("  ", " ", 1);
  elif extension = "g6" then
    return DigraphFromGraph6String;
  elif extension = "s6" then
    return DigraphFromSparse6String;
  elif extension = "d6" then
    return DigraphFromDigraph6String;
  elif extension = "ds6" then
    return DigraphFromDiSparse6String;
  elif extension = "p" or extension = "pickle" then
    return IO_Unpickle;
  fi;

  return fail;
end);

# if we are choosing the decoder, then the file extension is used.

BindGlobal("DIGRAPHS_ChooseFileEncoder",
function(filename)
  local splitname, extension;

  if not IsString(filename) then
    ErrorNoReturn("the argument <filename> must be a string,");
  fi;

  splitname := SplitString(filename, ".");
  extension := splitname[Length(splitname)];

  if extension in ["gz", "bz2", "xz"] then
    extension := splitname[Length(splitname) - 1];
  fi;

  if extension = "txt" then
    return DigraphPlainTextLineEncoder("  ", " ", -1);
  elif extension = "g6" then
    return Graph6String;
  elif extension = "s6" then
    return Sparse6String;
  elif extension = "d6" then
    return Digraph6String;
  elif extension = "ds6" then
    return DiSparse6String;
  elif extension = "p" or extension = "pickle" then
    return IO_Pickle;
  fi;
  return fail;
end);

InstallGlobalFunction(DigraphFile,
function(arg)
  local coder, mode, name, file;

  # defaults
  coder       := fail;
  mode        := "r";
  if Length(arg) = 1 then
    name  := arg[1];
  elif Length(arg) = 2 then
    name  := arg[1];
    if IsString(arg[2]) then
      mode := arg[2];
    else
      coder := arg[2];
    fi;
  elif Length(arg) = 3 then
    name  := arg[1];
    coder := arg[2];
    mode  := arg[3];
  else
    ErrorNoReturn("there must be 1, 2, or 3 arguments,");
  fi;

  # TODO check that the mode and the coder are compatible

  if not IsString(name) then
    ErrorNoReturn("the 1st argument <name> must be a string,");
  elif not (IsFunction(coder) or coder = fail) then
    ErrorNoReturn("the 2nd argument <coder> must be a function or fail,");
  elif not mode in ["a", "w", "r"] then
    ErrorNoReturn("the 3rd argument <mode> must be one of \"a\", ",
                  "\"w\", or \"r\"");
  fi;

  if coder = fail then  # <coder> not specified by the user
    if mode = "r" then
      coder := DIGRAPHS_ChooseFileDecoder(name);
    else
      coder := DIGRAPHS_ChooseFileEncoder(name);
    fi;
  fi;

  if coder = fail then
    ErrorNoReturn("cannot determine the file format,");
  elif mode = "r" then
    coder := DIGRAPHS_DecoderWrapper(coder);
  else
    coder := DIGRAPHS_EncoderWrapper(coder);
  fi;

  file := IO_CompressedFile(UserHomeExpand(name), mode);

  if file = fail then
    ErrorNoReturn("cannot open the file given as the 1st argument <name>,");
  fi;
  file!.coder := coder;
  return file;
end);

InstallGlobalFunction(ReadDigraphs,
function(arg)
  local nr, decoder, name, file, i, next, out;

  # defaults
  nr      := infinity;
  decoder := fail;

  if Length(arg) = 1 then
    name := arg[1];
  elif Length(arg) = 2 then
    name    := arg[1];
    if IsInt(arg[2]) then
      nr      := arg[2];
    else
      decoder := arg[2];
    fi;
  elif Length(arg) = 3 then
    name    := arg[1];
    decoder := arg[2];
    nr      := arg[3];
  else
    ErrorNoReturn("there must be 1, 2, or 3 arguments,");
  fi;

  if not (IsString(name) or IsFile(name)) then
    ErrorNoReturn("the 1st argument <filenname> must be a string or IO ",
                  "file object,");
  elif not (IsFunction(decoder) or decoder = fail) then
    ErrorNoReturn("the argument <decoder> must be a function or fail,");
  elif not (IsPosInt(nr) or IsInfinity(nr)) then
    ErrorNoReturn("the argument <nr> must be a positive integer or ",
                  "infinity");
  fi;

  if IsString(name) then
    file := DigraphFile(name, decoder, "r");
  else
    file := name;
    if file!.closed then
      ErrorNoReturn("the 1st argument <filename> is a closed file,");
    elif file!.rbufsize = false then
      ErrorNoReturn("the mode of the 1st argument <filename> must be \"r\",");
    fi;
  fi;

  decoder := file!.coder;

  if nr < infinity then
    i := 0;
    next := fail;
    while i < nr - 1 and next <> IO_Nothing do
      i := i + 1;
      next := IO_ReadLine(file);
    od;
    if next <> IO_Nothing then
      out := decoder(file);
    else
      out := IO_Nothing;
    fi;
    if IsString(arg[1]) then
      IO_Close(file);
    fi;
    return out;
  fi;

  out := [];
  next := decoder(file);

  while next <> IO_Nothing do
    Add(out, next);
    next := decoder(file);
  od;

  if IsString(arg[1]) then
    IO_Close(file);
  fi;

  return out;
end);

InstallGlobalFunction(WriteDigraphs,
function(arg)
  local name, digraphs, encoder, mode, splitname, compext, g6sum, s6sum, v, e,
        dg6sum, ds6sum, file, D, i;

  # defaults
  encoder := fail;
  mode    := "a";
  if Length(arg) = 2 then
    name     := arg[1];
    digraphs := arg[2];
  elif IsFile(arg[1]) then
    ErrorNoReturn("the 1st argument <filename> is a file, and so there must ",
                  "only be 2 arguments,");
  elif Length(arg) = 3 then
    name     := arg[1];
    digraphs := arg[2];
    if IsString(arg[3]) then
      mode := arg[3];
    else
      encoder := arg[3];
    fi;
  elif Length(arg) = 4 then
    name     := arg[1];
    digraphs := arg[2];
    encoder  := arg[3];
    mode     := arg[4];
  else
    ErrorNoReturn("there must be 2, 3, or 4 arguments,");
  fi;

  if not IsList(digraphs) then
    digraphs := [digraphs];
  fi;

  if not (IsString(name) or IsFile(name)) then
    ErrorNoReturn("the 1st argument <filename> must be a string or a file,");
  elif not ForAll(digraphs, IsDigraph) then
    ErrorNoReturn("the 2nd argument <digraphs> must be a digraph or list of ",
                  "digraphs,");
  elif not (IsFunction(encoder) or encoder = fail) then
    ErrorNoReturn("the argument <encoder> must be a function or fail,");
  elif not mode in ["a", "w"] then
    ErrorNoReturn("the argument <mode> must be \"a\" or \"w\",");
  fi;

  if IsString(name) and not IsExistingFile(name) then
    mode := "w";
  fi;

  if IsString(name) then
    if encoder = fail and DIGRAPHS_ChooseFileEncoder(name) = fail then
      # the file encoder was not specified and cannot be deduced from the
      # filename, so we try to make a guess based on the digraphs themselves
      splitname := SplitString(name, ".");
      if splitname[Length(splitname)] in ["xz", "gz", "bz2"] then
        compext := splitname[Length(splitname)];
        splitname := splitname{[1 .. Length(splitname) - 1]};
      fi;

      # Do we know all the graphs to be symmetric?
      if ForAll(digraphs, g -> HasIsSymmetricDigraph(g)
                               and IsSymmetricDigraph(g)) then
        if ForAny(digraphs, IsMultiDigraph) then
          encoder := DiSparse6String;
          Add(splitname, "ds6");
        else
          # Find the sum of length estimates using Graph6 and Sparse6
          g6sum := 0;
          s6sum := 0;
          for D in digraphs do
            v := DigraphNrVertices(D);
            e := DigraphNrEdges(D);
            g6sum := g6sum + (v * (v - 1) / 2);
            s6sum := s6sum + (e / 2 * (Log2Int(v - 1) + 2) * 3 / 2);
          od;
          if g6sum < s6sum and not ForAny(digraphs, DigraphHasLoops) then
            encoder := Graph6String;
            Add(splitname, "g6");
          else
            encoder := Sparse6String;
            Add(splitname, "s6");
          fi;
        fi;
      else
        if ForAny(digraphs, IsMultiDigraph) then
          encoder := DiSparse6String;
          Add(splitname, "ds6");
        else
          # Find the sum of length estimates using Digraph6 and DiSparse6
          dg6sum := 0;
          ds6sum := 0;
          for D in digraphs do
            v := DigraphNrVertices(D);
            e := DigraphNrEdges(D);
            dg6sum := dg6sum + v ^ 2;
            ds6sum := ds6sum + (e * (Log2Int(v) + 2) * 3 / 2);
          od;
          if dg6sum < ds6sum then
            encoder := Digraph6String;
            Add(splitname, "d6");
          else
            encoder := DiSparse6String;
            Add(splitname, "ds6");
          fi;
        fi;
      fi;
      name := JoinStringsWithSeparator(splitname, ".");
      if IsBound(compext) then
        Append(name, ".");
        Append(name, compext);
      fi;
      Info(InfoWarning, 1, "Writing to ", name);
    fi;
    file := DigraphFile(name, encoder, mode);
  else
    file := name;
    if file!.closed then
      ErrorNoReturn("the 1st argument <filename> is closed,");
    elif file!.wbufsize = false then
      ErrorNoReturn("the mode of the 1st argument <filename> must be ",
                    "\"w\" or \"a\",");
    fi;
  fi;

  encoder := file!.coder;

  for i in [1 .. Length(digraphs)] do
    encoder(file, digraphs[i]);
  od;

  if IsString(arg[1]) then
    IO_Close(file);
  fi;

  return IO_OK;
end);

################################################################################
# 3. Decoders
################################################################################

InstallMethod(DigraphFromGraph6StringCons, "for IsMutableDigraph and a string",
[IsMutableDigraph, IsString],
function(func, s)
  local FindCoord, list, n, start, maxedges, out, pos, nredges, i, bpos, edge,
  j;

  s := Chomp(s);

  # find a position in the adj matrix from the vector
  # knowing a lower bound for pos_y
  FindCoord := function(pos, bound)
    local i, sum;
      i := bound;
      sum := i * (i + 1) / 2;
      while sum < pos do
        i := i + 1;
        sum := sum + i;
      od;
    return [pos - sum + i, i + 1];
  end;

  if Length(s) = 0 then
    ErrorNoReturn("the 2nd argument <s> must be a non-empty string,");
  fi;

  # Convert ASCII chars to integers
  list := List(s, i -> IntChar(i) - 63);

  # Get n the number of vertices of the graph
  if list[1] <> 63 then
    n := list[1];
    start := 2;
  elif Length(list) > 300 then
    if list[2] = 63 then
      n := 0;
      for i in [0 .. 5] do
        n := n + 2 ^ (6 * i) * list[8 - i];
      od;
      start := 9;
    else
      n := 0;
      for i in [0 .. 2] do
        n := n + 2 ^ (6 * i) * list[4 - i];
      od;
      start := 5;
    fi;
  else
    ErrorNoReturn("the 2nd argument <s> is not a valid graph6 string,");
  fi;

  maxedges := n * (n - 1) / 2;
  if list <> [0] and list <> [1] and
      not (Int((maxedges - 1) / 6) + start = Length(list) and
           list[Length(list)] mod 2 ^ ((0 - maxedges) mod 6) = 0) then
    ErrorNoReturn("the 2nd argument <s> is not a valid graph6 string,");
  fi;

  out := List([1 .. n], x -> []);

  # Obtaining the adjacency vector
  pos := 1;
  nredges := 0;
  for j in [start .. Length(list)] do  # Every integer corresponds to 6 bits
    i := list[j];
    bpos := 1;
    while i > 0 do
      if i mod 2 = 0 then
        i := i / 2;
      else
        edge := FindCoord(pos + 6 - bpos, 0);
        out[edge[1]][Length(out[edge[1]]) + 1] := edge[2];
        out[edge[2]][Length(out[edge[2]]) + 1] := edge[1];
        nredges := nredges + 1;
        i := (i - 1) / 2;
      fi;
      bpos := bpos + 1;
    od;
    pos := pos + 6;
  od;
  return DigraphNC(IsMutableDigraph, out);
end);

InstallMethod(DigraphFromGraph6StringCons,
"for IsImmutableDigraph and a string",
[IsImmutableDigraph, IsString],
{filt, s} -> MakeImmutable(DigraphFromGraph6StringCons(IsMutableDigraph, s)));

InstallMethod(DigraphFromGraph6String, "for a function and a string",
[IsFunction, IsString],
DigraphFromGraph6StringCons);

InstallMethod(DigraphFromGraph6String, "for a string", [IsString],
s -> DigraphFromGraph6String(IsImmutableDigraph, s));

InstallMethod(DigraphFromDigraph6StringCons, "for IsMutableDigraph and a string",
[IsMutableDigraph, IsString],
function(func, s)
  local legacy, list, n, start, i, range, source, pos, len, j, bpos, tabpos;
  # NOTE: this package originally used a version of digraph6 that reads down
  # the columns of an adjacency matrix, and appends a '+' to the start.  This
  # has been replaced by the Nauty standard, which reads across the rows of the
  # matrix, and appends a '&' to the start.  For backwards compatibility, this
  # now accepts both formats, sending an info warning if the old format is used.

  s := Chomp(s);
  # Check non-emptiness
  if Length(s) = 0 then
    ErrorNoReturn("the 2nd argument <s> must be a non-empty string,");
  fi;

  # Check for the special '&' character (or the deprecated '+')
  if s[1] = '&' then
    legacy := false;
  elif s[1] = '+' then
    legacy := true;
    Info(InfoDigraphs, 1, "Digraph6 strings beginning with '+' use an old");
    Info(InfoDigraphs, 1, "specification of the Digraph6 format that is");
    Info(InfoDigraphs, 1, "incompatible with the present standard.  They can");
    Info(InfoDigraphs, 1, "still be read by the Digraphs package, but are");
    Info(InfoDigraphs, 1, "unlikely to be recognised by other programs.");
    Info(InfoDigraphs, 1, "Please consider re-encoding with the new format.");
  else
    ErrorNoReturn("the 2nd argument <s> is not a valid digraph6 string,");
  fi;

  # Convert ASCII chars to integers
  list := List(s, i -> IntChar(i) - 63);

  # Get n the number of vertices of the graph
  if list[2] <> 63 then
    n := list[2];
    start := 3;
  elif Length(list) > 300 then
    if list[3] = 63 then
      n := 0;
      for i in [0 .. 5] do
        n := n + 2 ^ (6 * i) * list[9 - i];
      od;
      start := 10;
    else
      n := 0;
      for i in [0 .. 2] do
        n := n + 2 ^ (6 * i) * list[5 - i];
      od;
      start := 6;
    fi;
  else
    ErrorNoReturn("the 2nd argument <s> is not a valid digraph6 string,");
  fi;

  range := [];
  source := [];

  # Obtaining the adjacency vector
  pos := 1;
  len := 1;
  for j in [start .. Length(list)] do  # Every integer corresponds to 6 bits
    i := list[j];
    bpos := 1;
    while i > 0 do
      if i mod 2 = 0 then
        i := i / 2;
      else
        tabpos := pos + 6 - bpos;
        range[len] := (tabpos - 1) mod n + 1;
        source[len] := (tabpos - range[len]) / n + 1;
        len := len + 1;
        i := (i - 1) / 2;
      fi;
      bpos := bpos + 1;
    od;
    pos := pos + 6;
  od;

  if legacy then  # source and range are reversed
    return DigraphNC(IsMutableDigraph,
                 rec(DigraphNrVertices := n,
                     DigraphSource     := range,
                     DigraphRange      := source));
  fi;
  return DigraphNC(IsMutableDigraph,
               rec(DigraphNrVertices := n,
                   DigraphRange      := range,
                   DigraphSource     := source));
end);

InstallMethod(DigraphFromDigraph6StringCons,
"for IsImmutableDigraph and a string",
[IsImmutableDigraph, IsString],
{filt, s} -> MakeImmutable(DigraphFromDigraph6StringCons(IsMutableDigraph, s)));

InstallMethod(DigraphFromDigraph6String, "for a function and a string",
[IsFunction, IsString],
DigraphFromDigraph6StringCons);

InstallMethod(DigraphFromDigraph6String, "for a string",
[IsString], s -> DigraphFromDigraph6String(IsImmutableDigraph, s));

InstallMethod(DigraphFromSparse6StringCons, "for IsMutableDigraph and a string",
[IsMutableDigraph, IsString],
function(func, s)
  local list, n, start, blist, pos, num, bpos, k, range, source, len, v, i,
  finish, x, j;

  s := Chomp(s);
  # Check non-emptiness
  if Length(s) = 0 then
    ErrorNoReturn("the 2nd argument <s> must be a non-empty string,");
  fi;

  # Check for the special ':' character
  if s[1] <> ':' then
    ErrorNoReturn("the 2nd argument <s> is not a valid sparse6 string,");
  fi;

  # Convert ASCII chars to integers
  list := [];
  for i in s do
    Add(list, IntChar(i) - 63);
  od;

  # Get n the number of vertices of the graph
  if list[2] <> 63 then
    n := list[2];
    start := 3;
  elif list[3] = 63 then
    if Length(list) <= 8 then
      ErrorNoReturn("the 2nd argument <s> is not a valid sparse6 string,");
    fi;
    n := 0;
    for i in [0 .. 5] do
      n := n + 2 ^ (6 * i) * list[9 - i];
    od;
    start := 10;
  elif Length(list) > 4 then
      n := 0;
      for i in [0 .. 2] do
        n := n + 2 ^ (6 * i) * list[5 - i];
      od;
      start := 6;
  else
    ErrorNoReturn("the 2nd argument <s> is not a valid sparse6 string,");
  fi;

  # convert list into a list of bits;
  blist := BlistList([1 .. (Length(list) - start + 1) * 6], []);
  pos := 1;
  for i in [start .. Length(list)] do
    num := list[i];
    bpos := 1;
    while num > 0 do
      if num mod 2 = 0 then
        num := num / 2;
      else
        num := (num - 1) / 2;
        blist[pos + 6 - bpos] := true;
      fi;
      bpos := bpos + 1;
    od;
    pos := pos + 6;
  od;

  if n > 1 then
    k := LogInt(n - 1, 2) + 1;
  else
    k := 1;
  fi;

  range := [];
  source := [];

  len := 1;
  v := 0;
  i := 1;
  # remove some of the padding
  finish := Length(blist) - (Length(blist) mod (k + 1));
  while i <= finish - k do
    if blist[i] then
      v := v + 1;
      if v = n then  # We have reached the end
        break;
      fi;
    fi;
    x := 0;
    for j in [1 .. k] do
      if blist[i + j] then
        x := x + 2 ^ (k - j);
      fi;
    od;
    if x = n then  # We have reached the end
      break;
    elif x > v then
      v := x;
    else
      range[len] := x;
      source[len] := v;
      len := len + 1;
      if x <> v then
        range[len] := v;
        source[len] := x;
        len := len + 1;
      fi;
    fi;
    i := i + k + 1;
  od;

  range := range + 1;
  source := source + 1;
  return DigraphNC(IsMutableDigraph, (rec(DigraphNrVertices := n,
                                      DigraphRange := range,
                                      DigraphSource := source)));
end);

InstallMethod(DigraphFromSparse6StringCons,
"for IsImmutableDigraph and a string",
[IsImmutableDigraph, IsString],
{filt, s} -> MakeImmutable(DigraphFromSparse6String(IsMutableDigraph, s)));

InstallMethod(DigraphFromSparse6String, "for a function and a string",
[IsFunction, IsString],
DigraphFromSparse6StringCons);

InstallMethod(DigraphFromSparse6String, "for a string",
[IsString],
s -> DigraphFromSparse6String(IsImmutableDigraph, s));

InstallMethod(DigraphFromDiSparse6StringCons,
"for IsMutableDigraph and a string",
[IsMutableDigraph, IsString],
function(func, s)
  local list, n, start, blist, pos, num, bpos, k, range, source, len, v, i, x,
  finish, j;

  s := Chomp(s);

  # Check non-emptiness
  if Length(s) = 0 then
    ErrorNoReturn("the 2nd argument <s> must be a non-empty string,");
  fi;

  # Check for the special ':' character
  if s[1] <> '.' then
    ErrorNoReturn("the 2nd argument <s> is not a valid disparse6 string,");
  fi;

  # Convert ASCII chars to integers
  list := [];
  for i in s do
    Add(list, IntChar(i) - 63);
  od;

  # Get n the number of vertices of the graph
  if list[2] <> 63 then
    n := list[2];
    start := 3;
  elif list[3] = 63 then
    if Length(list) <= 8 then
      ErrorNoReturn("the 2nd argument <s> is not a valid disparse6 string,");
    fi;
    n := 0;
    for i in [0 .. 5] do
      n := n + 2 ^ (6 * i) * list[9 - i];
    od;
    start := 10;
  elif Length(list) > 4 then
      n := 0;
      for i in [0 .. 2] do
        n := n + 2 ^ (6 * i) * list[5 - i];
      od;
      start := 6;
  else
    ErrorNoReturn("the 2nd argument <s> is not a valid disparse6 string,");
  fi;

  # convert list into a list of bits;
  blist := BlistList([1 .. (Length(list) - start + 1) * 6], []);
  pos := 1;
  for i in [start .. Length(list)] do
    num := list[i];
    bpos := 1;
    while num > 0 do
      if num mod 2 = 0 then
        num := num / 2;
      else
        num := (num - 1) / 2;
        blist[pos + 6 - bpos] := true;
      fi;
      bpos := bpos + 1;
    od;
    pos := pos + 6;
  od;

  if n > 1 then
    k := LogInt(n, 2) + 1;
  else
    k := 1;
  fi;

  range := [];
  source := [];
  # Get the decreasing edges first
  len := 1;
  v := 0;
  i := 1;
  while true do
    if blist[i] then
      v := v + 1;
    fi;
    x := 0;
    for j in [1 .. k] do
      if blist[i + j] then
        x := x + 2 ^ (k - j);
      fi;
    od;
    if x >= n then
      break;
    elif x > v then
      v := x;
    else
      range[len] := x;
      source[len] := v;
      len  := len + 1;
    fi;
    i := i + k + 1;
  od;

  i := i + k + 1;

  # Get the increasing edges
  finish := Length(blist) - (Length(blist) mod (k + 1));
  v := 0;
  while i <= finish - k do
    if blist[i] then
      v := v + 1;
    fi;
    x := 0;
    for j in [1 .. k] do
      if blist[i + j] then
        x := x + 2 ^ (k - j);
      fi;
    od;
    if x >= n then
      break;
    elif x > v then
      v := x;
    else
      range[len] := v;
      source[len] := x;
      len := len + 1;
    fi;
    i := i + k + 1;
  od;
  range := range + 1;
  source := source + 1;
  return DigraphNC(IsMutableDigraph, (rec(DigraphNrVertices := n,
                                      DigraphRange      := range,
                                      DigraphSource     := source)));
end);

InstallMethod(DigraphFromDiSparse6StringCons,
"for IsImmutableDigraph and a string",
[IsImmutableDigraph, IsString],
{filt, s} -> MakeImmutable(DigraphFromDiSparse6String(IsMutableDigraph, s)));

InstallMethod(DigraphFromDiSparse6String,
"for a function and a string",
[IsFunction, IsString],
DigraphFromDiSparse6StringCons);

InstallMethod(DigraphFromDiSparse6String,
"for a string",
[IsString],
s -> DigraphFromDiSparse6String(IsImmutableDigraph, s));

# one graph per line
BindGlobal("DIGRAPHS_PlainTextLineDecoder",
function(func, delimiter1, delimiter2, offset)
  local retval;
  retval := function(s)
    local edges, x;
    s := DIGRAPHS_SplitStringBySubstring(Chomp(s), delimiter1);
    Apply(s, x -> DIGRAPHS_SplitStringBySubstring(x, delimiter2));
    edges := EmptyPlist(Length(s));
    for x in s do
      Apply(x, Int);
      x := x + offset;
      Add(edges, x);
    od;
    return func(edges);
  end;
  return retval;
end);

InstallMethod(DigraphFromPlainTextStringCons,
"for IsMutableDigraph and a string", [IsMutableDigraph, IsString],
function(filt, s)
  local f;
  f := x -> DigraphByEdges(IsMutableDigraph, x);
  return DIGRAPHS_PlainTextLineDecoder(f, "  ", " ", 1)(Chomp(s));
end);

InstallMethod(DigraphFromPlainTextStringCons,
"for IsImmutableDigraph and a string", [IsImmutableDigraph, IsString],
{filt, s} -> MakeImmutable(DigraphFromPlainTextStringCons(IsMutableDigraph, s)));

InstallMethod(DigraphFromPlainTextString, "for a function and a string",
[IsFunction, IsString],
DigraphFromPlainTextStringCons);

InstallMethod(DigraphFromPlainTextString, "for a string",
[IsString],
s -> DigraphFromPlainTextString(IsImmutableDigraph, s));

# DIMACS format: for symmetric digraphs, one per file, can have loops and
# multiple edges.

BindGlobal("DIGRAPHS_ReadDIMACSDigraph",
function(func, name)
  local file, malformed_file, int_from_string, next, split, first_char,
  nr_vertices, vertices, vertex_labels, nr_edges, directed_edges,
  symmetric_edges, nbs, vertex, label, i, j, D;

  file := IO_CompressedFile(UserHomeExpand(name), "r");
  if file = fail then
    ErrorNoReturn("cannot open the file given as the 2nd argument <name>,");
  fi;

  # Helper function for when an error is found in the file's formatting
  malformed_file := function()
    IO_Close(file);
    ErrorNoReturn("the format of the file given as the 2nd argument <name> ",
                  "cannot be determined,");
  end;

  # Helper function to read a string into a non-negative integer
  int_from_string := function(string)
    local int;
    int := Int(string);
    if int = fail or int < 0 then
      malformed_file();
    fi;
    return int;
  end;

  next := IO_ReadLine(file);
  while not IsEmpty(next) do
    NormalizeWhitespace(next);

    # the line is entirely whitespace or a comment
    if IsEmpty(next) or next[1] = 'c' then
      next := IO_ReadLine(file);
      continue;
    fi;

    split := SplitString(next, " ");

    # the line doesn't have a `type'
    if Length(split[1]) <> 1 then
      malformed_file();
    fi;

    first_char := next[1];

    # digraph definition line
    if first_char = 'p' then
      if IsBound(vertices) or Length(split) <> 4 or split[2] <> "edge" then
        malformed_file();
      fi;
      nr_vertices     := int_from_string(split[3]);
      vertices        := [1 .. nr_vertices];
      vertex_labels   := vertices * 0 + 1;
      nr_edges        := int_from_string(split[4]);
      directed_edges  := 0;
      symmetric_edges := 0;
      nbs := List(vertices, x -> []);
      next := IO_ReadLine(file);
      continue;
    fi;

    if not IsBound(vertices) then
      # the problem definition line must precede all other types
      malformed_file();
    elif first_char = 'n' then
      # type: vertex label
      if Length(split) <> 3 then
        malformed_file();
      fi;
      vertex := int_from_string(split[2]);
      if not vertex in vertices then
        malformed_file();
      fi;
      label := Int(split[3]);
      if label = fail then
        malformed_file();
      fi;
      vertex_labels[vertex] := label;
    elif first_char = 'e' then
      # type: edge
      if Length(split) <> 3 then
        malformed_file();
      fi;
      i := int_from_string(split[2]);
      j := int_from_string(split[3]);
      if not (i in vertices and j in vertices) then
        malformed_file();
      fi;
      Add(nbs[i], j);
      directed_edges := directed_edges + 1;
      symmetric_edges := symmetric_edges + 1;
      if i <> j then
        Add(nbs[j], i);
        directed_edges := directed_edges + 1;
      fi;
    elif first_char in "dvx" then
      # type: unsupported lines
      Info(InfoDigraphs, 1,
           "Lines beginning with 'd', 'v', or 'x' are not supported,");
    else
      # type: unknown
      malformed_file();
    fi;
    next := IO_ReadLine(file);
  od;

  if not IsBound(vertices) then
    malformed_file();
  fi;

  if not nr_edges in [directed_edges, 2 * directed_edges, symmetric_edges] then
    Info(InfoDigraphs,
         1,
         "An unexpected number of edges was found,");
  fi;

  IO_Close(file);
  D := func(nbs);
  if IsImmutableDigraph(D) then
    SetDigraphVertexLabels(D, vertex_labels);
  fi;
  return D;
end);

InstallMethod(ReadDIMACSDigraph, "for a string", [IsString],
s -> DIGRAPHS_ReadDIMACSDigraph(ConvertToImmutableDigraphNC, s));

BindGlobal("DIGRAPHS_TournamentLineDecoder",
function(func, s)
  local out, pos, n, i, j;
  pos := 0;
  n := (Sqrt(8 * Length(s) + 1) + 1) / 2;
  out := List([1 .. n], x -> []);
  for i in [1 .. n - 1] do
    for j in [i + 1 .. n] do
      pos := pos + 1;
      if s[pos] = '1' then
        Add(out[i], j);
      else
        Add(out[j], i);
      fi;
    od;
  od;
  return func(out);
end);

InstallMethod(TournamentLineDecoder, "for a string", [IsString],
s -> DIGRAPHS_TournamentLineDecoder(ConvertToImmutableDigraphNC, s));

InstallMethod(DigraphPlainTextLineDecoder,
"for a string, string, and integer",
[IsString, IsString, IsInt],
function(delimiter1, delimiter2, offset)
  return DIGRAPHS_PlainTextLineDecoder(DigraphByEdges,
                                       delimiter1,
                                       delimiter2,
                                       offset);
end);

# one edge per line, one graph per file
BindGlobal("DIGRAPHS_ReadPlainTextDigraph",
function(func, name, delimiter, offset, ignore)
  local file, lines, edges, nr, decoder, line;

  file := IO_CompressedFile(UserHomeExpand(name), "r");
  if file = fail then
    ErrorNoReturn("cannot open the file given as the 2nd argument <name>,");
  fi;

  lines := IO_ReadLines(file);
  edges := EmptyPlist(Length(lines));
  nr := 0;

  decoder := function(string)
    string := DIGRAPHS_SplitStringBySubstring(Chomp(string), delimiter);
    Apply(string, Int);
    return string + offset;
  end;

  for line in lines do
    if Length(line) > 0 and not (line[1] in ignore) then
      nr := nr + 1;
      edges[nr] := decoder(Chomp(line));
    fi;
  od;

  return func(edges);
end);

InstallMethod(ReadPlainTextDigraph,
"for a string, string, integer, and string",
[IsString, IsString, IsInt, IsString],
function(name, delimiter, offset, ignore)
  return DIGRAPHS_ReadPlainTextDigraph(DigraphByEdges,
                                       name,
                                       delimiter,
                                       offset,
                                       ignore);
end);

BindGlobal("DIGRAPHS_AdjacencyMatUpperTriLineDecoder",
function(func, s)
  local out, pos, n, i, j;
  s := Chomp(s);
  pos := 0;
  n := (Sqrt(8 * Length(s) + 1) + 1) / 2;
  out := List([1 .. n], x -> []);
  for i in [1 .. n - 1] do
    for j in [i + 1 .. n] do
      pos := pos + 1;
      if s[pos] = '1' then
        Add(out[i], j);
      fi;
    od;
  od;
  return func(out);
end);

InstallMethod(AdjacencyMatrixUpperTriangleLineDecoder, "for a string",
[IsString],
s -> DIGRAPHS_AdjacencyMatUpperTriLineDecoder(ConvertToImmutableDigraphNC,
                                              s));

BindGlobal("DIGRAPHS_TCodeDecoder",
function(func, s)
  local out, i;

  s := SplitString(Chomp(s), " ");
  Apply(s, EvalString);

  if not ForAll(s, x -> IsInt(x) and x >= 0) then
    ErrorNoReturn("the 2nd argument <s> must be a string of ",
                  "space-separated non-negative integers,");
  elif not Length(s) >= 2 then
    ErrorNoReturn("the 2nd argument <s> must be a string of ",
                  "at least two integers,");
  elif not ForAll([3 .. Length(s)], i -> s[i] < s[1]) then
    ErrorNoReturn("the 2nd argument <s> must be a string consisting of ",
                  "integers in the range [0 .. ", s[1], "],");
  elif Length(s) < 2 * s[2] + 2 then
    ErrorNoReturn("the 2nd argument <s> must be a string of length ",
                  "at least ", 2 * s[2] + 2);
  fi;
  out := List([1 .. s[1]], x -> []);
  for i in [1 .. s[2]] do
    Add(out[s[2 * i + 1] + 1], s[2 * i + 2] + 1);
  od;

  return func(out);
end);

InstallMethod(TCodeDecoder, "for a string", [IsString],
s -> DIGRAPHS_TCodeDecoder(ConvertToImmutableDigraphNC, s));

InstallGlobalFunction(TCodeDecoderNC,
function(str)
  local out, i;
  str := SplitString(Chomp(str), " ");
  Apply(str, Int);
  out := List([1 .. str[1]], x -> []);
  for i in [1 .. str[2]] do
    Add(out[str[2 * i + 1] + 1], str[2 * i + 2] + 1);
  od;
  return ConvertToImmutableDigraphNC(out);
end);

################################################################################
# 4. Encoders
################################################################################

InstallMethod(WriteDIMACSDigraph, "for a digraph", [IsString, IsDigraph],
function(name, D)
  local file, n, verts, nbs, nr_loops, m, labels, i, j;

  if not IsSymmetricDigraph(D) then
    ErrorNoReturn("the 2nd argument <D> must be a symmetric digraph,");
  fi;

  file := IO_CompressedFile(UserHomeExpand(name), "w");
  if file = fail then
    ErrorNoReturn("cannot open the file given as the 1st argument <name>,");
  fi;

  n := DigraphNrVertices(D);
  verts := DigraphVertices(D);
  nbs := OutNeighbours(D);

  nr_loops := 0;
  if not HasDigraphHasLoops(D) or DigraphHasLoops(D) then
    for i in verts do
      for j in nbs[i] do
        if i = j then
          nr_loops := nr_loops + 1;
        fi;
      od;
    od;
    if IsImmutableDigraph(D) then
      SetDigraphHasLoops(D, nr_loops <> 0);
    fi;
  fi;
  m := ((DigraphNrEdges(D) - nr_loops) / 2) + nr_loops;

  # Problem definition
  IO_WriteLine(file, Concatenation("p edge ", String(n), " ", String(m)));

  # Edges
  for i in verts do
    for j in nbs[i] do
      if i <= j then
        IO_WriteLine(file, Concatenation("e ", String(i), " ", String(j)));
      fi;
      # In the case that j < i, the edge will be written elsewhere in the file
    od;
  od;

  # Vertex labels
  if n > 0 then
    labels := DigraphVertexLabels(D);
    if not (IsHomogeneousList(labels) and IsInt(labels[1])) then
      Info(InfoDigraphs, 1,
           "Only integer vertex labels are supported by the DIMACS format.");
      Info(InfoDigraphs, 1,
           "The vertex labels of the 2nd argument <a digraph> will not be",
           " saved.");
    else
      for i in verts do
        IO_WriteLine(file,
                     Concatenation("n ", String(i), " ", String(labels[i])));
      od;
    fi;
  fi;

  IO_Close(file);
  return IO_OK;
end);

InstallGlobalFunction(DigraphPlainTextLineEncoder,
{delimiter1, delimiter2, offset} ->
function(D)
  local str, i, edges;
  edges := DigraphEdges(D);

  if Length(edges) = 0 then
    return "";
  fi;

  str := Concatenation(String(edges[1][1] + offset), delimiter2,
                       String(edges[1][2] + offset));

  for i in [2 .. Length(edges)] do
    Append(str, Concatenation(delimiter1, String(edges[i][1] + offset),
                              delimiter2, String(edges[i][2] + offset)));
  od;
  return str;
end);

InstallGlobalFunction(WritePlainTextDigraph,
function(name, D, delimiter, offset)
  local file, edge;

  if not IsString(name) then
    ErrorNoReturn("the 1st argument <name> must be a string,");
  elif not IsString(delimiter) then
    ErrorNoReturn("the 3rd argument <delimiter> must be a string,");
  elif not IsInt(offset) then
    ErrorNoReturn("the 4th argument <offset> must be an integer,");
  fi;
  file := IO_CompressedFile(UserHomeExpand(name), "w");

  if file = fail then
    ErrorNoReturn("cannot open the file given as the 1st argument <name>,");
  fi;

  for edge in DigraphEdges(D) do
    IO_WriteLine(file, Concatenation(String(edge[1] + offset),
                                     delimiter,
                                     String(edge[2] + offset)));
  od;
  IO_Close(file);
end);

InstallMethod(Graph6String, "for a digraph by out-neighbours",
[IsDigraphByOutNeighboursRep],
function(D)
  local list, adj, n, lenlist, tablen, blist, i, j, pos, block;
  if (IsMultiDigraph(D) or not IsSymmetricDigraph(D)
      or DigraphHasLoops(D)) then
    ErrorNoReturn("the argument <D> must be a symmetric digraph ",
                  "with no loops or multiple edges,");
  fi;

  list := [];
  adj := OutNeighbours(D);
  n := Length(DigraphVertices(D));

  # First write the number of vertices
  lenlist := DIGRAPHS_Graph6Length(n);
  if lenlist = fail then
    ErrorNoReturn("the argument <D> must be a digraph with between 0 and ",
                  "68719476736 vertices,");
  fi;
  Append(list, lenlist);

  # Find adjacencies (non-directed)
  tablen := n * (n - 1) / 2;
  blist := BlistList([1 .. tablen + 6], []);
  for i in DigraphVertices(D) do
    for j in adj[i] do
      # Loops not allowed
      if j > i then
        blist[i + (j - 2) * (j - 1) / 2] := true;
      elif i > j then
        blist[j + (i - 2) * (i - 1) / 2] := true;
      fi;
    od;
  od;

  # Read these into list, 6 bits at a time
  pos := 0;
  while pos < tablen do
    block := 0;
    for i in [1 .. 6] do
      if blist[pos + i] then
        block := block + 2 ^ (6 - i);
      fi;
    od;
    Add(list, block);
    pos := pos + 6;
  od;

  # Create string to return
  return List(list, i -> CharInt(i + 63));
end);

InstallMethod(Digraph6String, "for a digraph by out-neighbours",
[IsDigraphByOutNeighboursRep],
function(D)
  local list, adj, n, lenlist, tablen, blist, i, j, pos, block;
  # NOTE: this package originally used a version of digraph6 that reads down
  # the columns of an adjacency matrix, and appends a '+' to the start.  This
  # has been replaced by the Nauty standard, which reads across the rows of the
  # matrix, and appends a '&' to the start.  The old '+' format can be read by
  # DigraphFromDigraph6String, but can no longer be written by this function.

  list := [];
  adj := OutNeighbours(D);
  n := Length(DigraphVertices(D));

  # First write the special character '&'
  Add(list, -25);

  # Now write the number of vertices
  lenlist := DIGRAPHS_Graph6Length(n);
  if lenlist = fail then
    ErrorNoReturn("the argument <D> must be a digraph with between 0 and ",
                  "68719476736 vertices,");
  fi;
  Append(list, lenlist);

  # Find adjacencies
  tablen := n ^ 2;
  blist := BlistList([1 .. tablen + 6], []);
  for i in DigraphVertices(D) do
    for j in adj[i] do
      blist[j + n * (i - 1)] := true;
    od;
  od;

  # Read these into list, 6 bits at a time
  pos := 0;
  while pos < tablen do
    block := 0;
    for i in [1 .. 6] do
      if blist[pos + i] then
        block := block + 2 ^ (6 - i);
      fi;
    od;
    Add(list, block);
    pos := pos + 6;
  od;

  # Create string to return
  return List(list, i -> CharInt(i + 63));
end);

InstallMethod(Sparse6String, "for a digraph by out-neighbours",
[IsDigraphByOutNeighboursRep],
function(D)
  local list, n, lenlist, adj, nredges, k, blist, v, nextbit, AddBinary, i, j,
        bitstopad, pos, block;
  if not IsSymmetricDigraph(D) then
    ErrorNoReturn("the argument <D> must be a symmetric digraph,");
  fi;

  list := [];
  n := Length(DigraphVertices(D));

  # First write the special character ':'
  Add(list, -5);

  # Now write the number of vertices
  lenlist := DIGRAPHS_Graph6Length(n);
  if lenlist = fail then
    ErrorNoReturn("the argument <D> must be a digraph with between 0 and ",
                  "68719476736 vertices,");
  fi;
  Append(list, lenlist);

  # Get the out-neighbours - half these edges will be discarded
  adj := OutNeighbours(D);
  nredges := DigraphNrEdges(D);

  # k is the number of bits in a vertex label
  if n > 1 then
    k := Log2Int(n - 1) + 1;
  else
    k := 1;
  fi;

  # Add the edges one by one
  blist := BlistList([1 .. nredges * (k + 1) / 2], []);
  v := 0;
  nextbit := 1;
  AddBinary := function(blist, i)
    local b;
    for b in [1 .. k] do
      blist[nextbit] := Int((i mod (2 ^ (k - b + 1))) / (2 ^ (k - b))) = 1;
      nextbit := nextbit + 1;
    od;
  end;
  for i in [1 .. Length(adj)] do
    for j in adj[i] do
      if i < j then
        continue;
      elif i = v + 1 then
        blist[nextbit] := false;
        nextbit := nextbit + 1;
      elif i = v + 2 then
        blist[nextbit] := true;
        nextbit := nextbit + 1;
        v := v + 1;
      elif i > v + 2 then
        blist[nextbit] := true;
        nextbit := nextbit + 1;
        AddBinary(blist, i - 1);
        v := i - 1;
        blist[nextbit] := false;
        nextbit := nextbit + 1;
      fi;
      AddBinary(blist, j - 1);
    od;
  od;

  # Add padding bits:
  #  1. If (n,k) = (2,1), (4,2), (8,3) or (16,4), and vertex
  #     n-2 has an edge but n-1 doesn't have an edge, and
  #     there are k+1 or more bits to pad, then pad with one
  #     0-bit and enough 1-bits to complete the multiple of 6.
  #  2. Otherwise, pad with enough 1-bits to complete the
  #     multiple of 6.

  bitstopad := 5 - ((nextbit - 2) mod 6);
  if ((n = 2 and k = 1) or
      (n = 4 and k = 2) or
      (n = 8 and k = 3) or
      (n = 16 and k = 4)) and
      (v = n - 2) and
      (bitstopad > k) then
    blist[nextbit] := false;
    bitstopad := bitstopad - 1;
  fi;
  for i in [1 .. bitstopad] do
    Add(blist, true);
  od;

  # Read blist into list, 6 bits at a time
  pos := 0;
  while pos < Length(blist) do
    block := 0;
    for i in [1 .. 6] do
      if blist[pos + i] then
        block := block + 2 ^ (6 - i);
      fi;
    od;
    Add(list, block);
    pos := pos + 6;
  od;

  # Create string to return
  return List(list, i -> CharInt(i + 63));
end);

InstallMethod(DiSparse6String, "for a digraph by out-neighbours",
[IsDigraphByOutNeighboursRep],
function(D)
  local list, n, lenlist, adj, source_i, range_i, source_d, range_d, len1,
  len2, sort_d, perm, sort_i, k, blist, v, nextbit, AddBinary, bitstopad,
  pos, block, i, j;

  list := [];
  n := Length(DigraphVertices(D));

  # First write the special character '.'
  list[1] := -17;

  # Now write the number of vertices
  lenlist := DIGRAPHS_Graph6Length(n);
  if lenlist = fail then
    ErrorNoReturn("the argument <D> must be a digraph with between 0 and ",
                  "68719476736 vertices,");
  fi;
  Append(list, lenlist);

  # Separate edges into increasing and decreasing
  adj := OutNeighbours(D);
  source_i := [];
  range_i := [];
  source_d := [];
  range_d := [];
  len1 := 1;
  len2 := 1;
  for i in DigraphVertices(D) do
    for j in adj[i] do
      if i <= j then
        source_i[len1] := i - 1;
        range_i[len1] := j - 1;
        len1 := len1 + 1;
      else
        source_d[len2] := i - 1;
        range_d[len2] := j - 1;
        len2 := len2 + 1;
      fi;
    od;
  od;

  # Sort decreasing edges according to source and then range
  sort_d := function(i, j)
    if source_d[i] < source_d[j]
        or (source_d[i] = source_d[j] and range_d[i] <= range_d[j]) then
      return true;
    else
      return false;
     fi;
  end;

  perm := Sortex([1 .. Length(source_d)], sort_d);
  source_d := Permuted(source_d, perm);
  range_d := Permuted(range_d, perm);

  # Sort increasing edges according to range and then source
  sort_i := function(i, j)
    if range_i[i] < range_i[j]
        or (range_i[i] = range_i[j] and source_i[i] <= source_i[j]) then
      return true;
    else
      return false;
     fi;
  end;

  perm := Sortex([1 .. Length(range_i)], sort_i);
  source_i := Permuted(source_i, perm);
  range_i := Permuted(range_i, perm);

  # k is the number of bits in a vertex label we also want to be able to
  # encode n as a separation symbol between increasing and decreasing edges
  if n > 1 then
    k := LogInt(n, 2) + 1;
  else
    k := 1;
  fi;

  # Add the edges one by one
  blist := [];
  v := 0;
  nextbit := 1;
  AddBinary := function(blist, i)
    local b;
    for b in [1 .. k] do
      blist[nextbit] := Int((i mod (2 ^ (k - b + 1))) / (2 ^ (k - b))) = 1;
      nextbit := nextbit + 1;
    od;
  end;
  for i in [1 .. Length(source_d)] do
    if source_d[i] = v then
      blist[nextbit] := false;
      nextbit := nextbit + 1;
    elif source_d[i] = v + 1 then
      blist[nextbit] := true;
      nextbit := nextbit + 1;
      v := v + 1;
    elif source_d[i] > v + 1 then  # is this check necessary
      blist[nextbit] := true;
      nextbit := nextbit + 1;
      AddBinary(blist, source_d[i]);
      v := source_d[i];
      blist[nextbit] := false;
      nextbit := nextbit + 1;
    fi;
    AddBinary(blist, range_d[i]);
  od;

  # Add a separation symbol (1 n).
  blist[nextbit] := true;
  nextbit := nextbit + 1;
  AddBinary(blist, n);

  # Repeat everything for increasing edges
  v := 0;
  for i in [1 .. Length(range_i)] do
    if range_i[i] = v then
      blist[nextbit] := false;
      nextbit := nextbit + 1;
    elif range_i[i] = v + 1 then
      blist[nextbit] := true;
      nextbit := nextbit + 1;
      v := v + 1;
    elif range_i[i] > v + 1 then  # is this check necessary
      blist[nextbit] := true;
      nextbit := nextbit + 1;
      AddBinary(blist, range_i[i]);
      v := range_i[i];
      blist[nextbit] := false;
      nextbit := nextbit + 1;
    fi;
    AddBinary(blist, source_i[i]);
  od;

  # Add padding bits:
  bitstopad := 5 - ((nextbit - 2) mod 6);
  for i in [1 .. bitstopad] do
    Add(blist, true);
  od;

  # Read blist into list, 6 bits at a time
  pos := 0;
  while pos < Length(blist) do
    block := 0;
    for i in [1 .. 6] do
      if blist[pos + i] then
        block := block + 2 ^ (6 - i);
      fi;
    od;
    Add(list, block);
    pos := pos + 6;
  od;

  # Create string to return
  return List(list, i -> CharInt(i + 63));
end);

InstallMethod(PlainTextString, "for a digraph", [IsDigraph],
D -> DigraphPlainTextLineEncoder("  ", " ", -1)(D));