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

#F Rules
#F =====
#F
#F A rule is a record with the following mandatory fields:
#F
#F   isRule           = "true"         # identifies rules
#F   operations       = RuleOps        # operations record
#F   name             = <string>       # the name of the rule
#F   info             = <string>       # a string with info about the rule
#F   nonTerminal      = <symbol>       # the non-terminal the rule is meant
#F                                       for, given by its symbol (e.g. "WHT")
#F   forTransposition = true/false     # identifies whether the should also
#F                                       be used in its transposed form
#F   switch           = true/false     # allows to switch rules on (true) or off
#F   isApplicable     = func( params ) # rule applicable for params?
#F   allChildren      = func( params ) # returns a list of ordered lists of
#F                                       all possible children for the rule
#F   randomChildren   = func( params ) # returns an ordered list of children
#F                                       for the rule, chosen at random
#F   rule             =                # the actual rule, given as a formula
#F     func( params, children )          combining children
#F
#F The following are optional fields:
#F
#F The function .isDerivable checks whether a given set of children can
#F be derived from a given spl. This can also be decided by using doing
#F   children in .allChildren(spl.params)
#F In some cases, namely when there are to many children configurations,
#F this field should be present. It is only used in the function RuleTree
#F and nowhere during code generation.
#F
#F   isDerivable = func( spl, children )
#F
#F Note that the field "nonTerminal" must contain a symbol known
#F from the NonTerminalTable in spl.g
#F All rules have to be in the global variable RuleTable in order
#F to be used.
#F
#F
#F new rule:
#F    .children := nt -> list of ordered lists of all possible children
#F    .applicable := nt -> true/false
#F    .apply := (nt, children) -> apply the rule
#F    or .apply := (nt, children, child_nonterms) -> apply the rule
#F Functions for Rules
#F -------------------
#F

RuleOps := OperationsRecord("RuleOps");

#F IsRule( <rule> ) - true for breakdown rules (base class = BreakdownRule)
#F
IsRule := R -> IsRec(R) and IsBound(R.isRule) and R.isRule = true;

#F IsNewRule(<rule>) - true for new style rules (base class = NewBreakdownRule)
#F
IsNewRule := R -> IsRec(R) and IsBound(R.isRule) and R.isRule and IsBound(R.isNewRule) and R.isNewRule;

#F IsAlternativeRewriteRule(<rule>) - true for new style rules (base class = AlternativeRewriteRule)
#F
IsAlternativeRewriteRule := R -> IsRec(R) and IsBound(R.isRule) and R.isRule and IsBound(R.isAlternativeRewriteRule) and R.isAlternativeRewriteRule;

#F RuleOps.Print( <rule> ) -  prints the name of <rule>.
#F
RuleOps.Print:= R -> Print(R.name, Cond(IsBound(R.a), R.printA(), ""));

#F RuleOps.\=( <rule1>, <rule2> ) - equality of rules based on names
#F
RuleOps.\= := (R1, R2) -> IsRule(R1) and IsRule(R2) and R1.name = R2.name and
    When(IsBound(R1.a), R1.a = R2.a, true);

#F RuleOps.\<( <rule1>, <rule2> ) - ordering of rules based on their names.
#F
RuleOps.\< := (R1, R2) -> Cond(
    IsRule(R1) and IsRule(R2),
        R1.name < R2.name or (R1.name = R2.name and When(IsBound(R1.a), R1.a < R2.a, true)),
    ObjId(R1) < ObjId(R2));

# Default rule for SPLs which not non-terminals
Declare(@_Base);

_applicable := (R, nt, ruleset) ->
    (not Same(ruleset, ApplicableTable) or R.switch) and
    (R.nonTerminal=@ or R.nonTerminal = ObjId(nt)) and
    ((nt.transposed = R.transposed) or (nt.transpose()=nt)) and
    # R.requiredFirstTag is obsolete
    When(not IsNewRule(R) or not IsBound(R.requiredFirstTag), true,
	When(IsBound(nt.firstTag),
            When(IsList(R.requiredFirstTag),
                 nt.firstTag().kind() in R.requiredFirstTag,
                 nt.firstTag().kind()  = R.requiredFirstTag), false)) and
    # R.a.requiredFirstTag is the better way of setting mandatory tags
    When(not IsNewRule(R) or not IsBound(R.a.requiredFirstTag), true,
	When(IsBound(nt.firstTag),
            When(IsList(R.a.requiredFirstTag),
                 nt.firstTag().kind() in R.a.requiredFirstTag,
                 nt.firstTag().kind()  = R.a.requiredFirstTag), false)) and
    When(IsNewRule(R),
            SReduceSimple(R.applicable(nt)) <> false,
            R.isApplicable(nt.params));

#F _allChildren( <rule>, <non-terminal>[, <opts>])
#F   returns all possible children obtained by applying <rule> to <non-terminal>
#F   Use of opts.restrictSplit and opts.restrictSplitSize
#F      Set opts.restrictSplit:=true and opts.restrictSplitSize to the desired
#F      size.
#F      Can be used to obtain ruletrees with no leaves <= the specified size
#F      If this is used there will be a problem with generating ruletrees
#F      unless opts.baseHashes is set so that small sizes are fetched from the
#F      hash table. Otherwise generating rule trees will return false

 #_allChildren := (R, nt) -> When(IsNewRule(R), R.children(nt), R.allChildren(nt.params));
_allChildren := function( arg )
    local flag, i, R, nt, opts, ch, ch_copy, children;
    R := arg[1];
    nt := arg[2];
    children :=  When(IsNewRule(R), R.children(nt), R.allChildren(nt.params));
    if IsBound(arg[3]) then
        opts := arg[3];
        ch_copy := Copy(children);
        flag := false;
        i := 1;
        if IsBound(opts.restrictSplit) and opts.restrictSplit = true and
                                         IsBound(opts.restrictSplitSize) then
            for ch in ch_copy do
                while flag=false and i<=Length(ch) do
                    if ch[i].params[1] <= opts.restrictSplitSize then
                        flag := true;
                    fi;
                    i := i+1;
                od;
                if flag then
                    RemoveSet(children, ch);
                    flag := false;
                fi;
                i := 1;

            od;
        fi;
    fi;
    return children;
end;
# children[i] could be a complicated SPL expansion of the nonterms[i]
# or children could be same as nonterms, depending on the workflow you are using
#_apply := (R, nt, children, nonterms) -> Checked(IsRule(R), IsSPL(nt),
#    When(IsNewRule(R),
#	 R.apply(nt, children, nonterms),
#	 When(NumGenArgs(R.rule)=2,
#	      R.rule(nt.params, children),
#	      R.rule(nt.params, children, nonterms)))
#);

# Current rule wrap for fftx needs attributes from nt object.
# The wrapper has var. arg. This fact is used here
# to recognize the wrapper and pass nt instead of its params.
_apply := (R, nt, children, nonterms) -> Checked(IsRule(R), IsSPL(nt),
    When(IsNewRule(R),
     R.apply(nt, children, nonterms),
     Cond(NumGenArgs(R.rule)=-1,
            R.rule(nt, children, nonterms),
            NumGenArgs(R.rule)=2,
            R.rule(nt.params, children),
            R.rule(nt.params, children, nonterms)))
);

#F IsApplicableRule( <rule>, <non-terminal>, <ruleset> )
#F   returns true if <rule> can be applied to <non-terminal>
#F   and false else.
#F
IsApplicableRule := (R, nt, ruleset) -> When(IsAlternativeRewriteRule(R),
    Length(Collect(nt, R.pattern))<>0
    ,
    Checked(IsRule(R), IsSPL(nt),
    (not Same(ruleset, ApplicableTable) or R.switch) and
    (
	_applicable(R, nt, ruleset) or
	(R.forTransposition and _applicable(R, nt.transpose(), ruleset)))));

#F ApplyRuleSPL( <rule>, <non-terminal> )
#F   returns result of application of <rule> to <non-terminal>, if
#F   it is non-applicable an error is reported
#F
ApplyRuleSPL := (R, nt) ->
	Checked(IsRule(R), IsSPL(nt),
		let(c := _allChildren(R,nt)[1],	_apply(R, nt, c, c))
	);

AllApplicableRulesDirect := (spl, ruleset) ->
    Concatenation(
		When(not IsBound(ruleset.(spl.__name__)), [ ],
			Filtered(ruleset.(spl.__name__), r -> not r.forTranspositionOnly and _applicable(r, spl, ruleset))),
		Filtered([@_Base], r ->not r.forTranspositionOnly and _applicable(r, spl, ruleset))
	);

#F AllApplicableRules( <non-terminal>, <ruleset> )
#F   returns list of all rules applicable to a non-terminal
#F
AllApplicableRules := (nt, ruleset) ->
	Checked(IsSPL(nt), Set(AllApplicableRulesDirect(nt, ruleset)));

#F RandomChildrenRule( <rule>, <non-terminal>, <ruleset> )
#F   returns a random set of children for <rule> applied to <spl>.
#F   Calls the rule's randomChildren function if available.
#F   Otherwise, calls RandomList on the rule's allChildren function.
#F
RandomChildrenRule := (R, nt, ruleset) -> Checked(IsApplicableRule(R, nt, ruleset),
    When(IsBound(R.randomChildren),
	 R.randomChildren(nt.params),
	 RandomList(_allChildren(R, nt))));

#F Verification of Rules
#F ---------------------
#F

#F VerifyRules(<non-terminal>, <verify-func>)
#F
#F  Expands <non-terminal> using all applicable rules and all
#F  possible children sets (just one expansion step) and runs
#F  <verify-func> on the obtained partial ruletrees and the non
#F  terminal to check correctness.
#F
#F  verify_func = (rt, nt) -> boolean
#F      <rt> is partial ruletree,
#F      <nt> is original non-terminal
#F
#F  Example:
#F   VerifyRulesForSPL := nt ->
#F       VerifyRules(nt, (rt, nt) ->
#F           InfinityNormMat(MatSPL(SPLRuleTree(rt)) - MatSPL(nt)) < 1e-11);
#F
VerifyRules := function ( nt, verify_func, opts )
  local rule, Csets, C, ruletree, res, direct, transp, transp_nt;
  Constraint(IsSPL(nt));
  res := true;

  for ruletree in ExpandSPL(nt, opts) do
      Print("-- ", ruletree, " --\n");
      Print("checking rule ", ruletree.rule, ": ");
      if verify_func(ruletree, nt) then
	  Print(Green("correct\n"));
      else
	  Print(Red("incorrect!\n"));
	  res := false;
      fi;
  od;
  return res;
end;

_checkMatRuleTree := function(rt, nt)
    local me, them, diff;
    me := MatSPL(SPLRuleTree(rt));
    them := MatSPL(nt);
    diff := InfinityNormMat(me-them);
    return diff < 1e-11;
end;

#F VerifyRulesForSPL( <non-terminal>, <opts> )
#F   expands <non-terminal> using all applicable rules and all
#F   possible children sets (just one expansion step) and checks
#F   whether the resulting matrix matches the non-terminal matrix.
#F
#F   Matrices are obtained with MatSPL, and infinity-norm of the
#F   difference is thresholded, with threshold of 1e-11.
#F
#F   See also VerifyRules, it is a more general function.
#F
VerifyRulesForSPL := (S, opts) -> VerifyRules(S, _checkMatRuleTree, opts);

#F Rule switching
#F ----------------
#F

#F AllRules(<non-terminal> | <non-terminal-name>)
#F    Returns a list of all rules for <non-terminal>.
#F
AllRules := nt -> let(
    name := Cond(IsSPL(nt), nt.__name__, IsString(nt), nt,
	Error("<nt> must be a nonterminal or its name (string)")),
    When(IsBound(ApplicableTable.(name)), ApplicableTable.(name),
	Error("No rules exist for '", name, "'")));

#F Adding your own rules
#F ---------------------
#F

#F BreakdownRule - base class for breakdown rules created with RulesFor(...)
#F
Class(BreakdownRule, rec(
    isRule := true,
    operations := RuleOps,
    info             := "-not specified-",
    forTransposition := false,
    forTranspositionOnly := false,
    switch           := true,
    transposed       := false,
    allChildren      := P -> [[ ]],
    isApplicable     := P -> true,
    __call__         := arg >> ApplyFunc(RuleTree, arg)
));

#F NewBreakdownRule - base class for breakdown rules created with NewRulesFor(...)
#F
Class(NewBreakdownRule, AttrMixin, rec(
    isRule := true,
    isNewRule := true,
    operations := RuleOps,
    info             := "-not specified-",
    forTransposition := false,
    forTranspositionOnly := false,
    switch           := true,
    transposed       := false,

    freedoms := (self, nt) >> [],
    child := (self, nt, fr) >> [],

    children := (self, nt) >> let(
	ff := List(_unwrap(self.freedoms(nt)), _unwrap),
	cart := Cartesian(ff),   # Cartesian([])==[[ ]]
	List(cart, f -> self.child(nt, f))
    ),

    applicable       := nt -> true,
    __call__         := arg >> ApplyFunc(RuleTree, arg),

# NOTE: YSV finish this (--parametrization of rules)
#     print := self >> let(rch := self.rChildren(),
#         Print(self.name, Cond(rch<>[], Print(".from_rChildren(", PrintCS(rch), ")"), ""))),

#     operations := RewritableObjectOps,
#     lessThan := RewritableObject.lessThan,
#     equals := RewritableObject.equals,
#     rChildren := self >> [],
#     from_rChildren := (self, rch) >> Error("not supported"),
));

MakeRule := function ( R, name, nt )
    local doc;
    Constraint(IsRec(R) and IsString(name));
    doc := R.__doc__;
    # R.__doc__ is overwritten upon assignment
    R := WithBases(BreakdownRule, R);
    R.__doc__ := doc;
    R.name    := name;
    R.nonTerminal := nt;
    return R;
end;

NewMakeRule := function ( R, name, nt )
    local doc;
    Constraint(IsRec(R) and IsString(name));
    doc := R.__doc__;
    # R.__doc__ is overwritten upon assignment
    R := WithBases(NewBreakdownRule, R);
    R.__doc__ := doc;
    R.name    := name;
    R.nonTerminal := nt;
    return R;
end;

@_Base := NewMakeRule(
    rec(applicable       := nt -> not IsNonTerminal(nt) and not IsBound(ApplicableTable.(nt.__name__)),
	forTransposition := false,
        forTranspositionOnly := false,
	children             := nt -> [nt.children()],
	apply := (nt,ch,nonterms) -> Inherit(nt, rec(_children := ch))),
        "@_Base", @);

#F ApplicableTable - mapping from non-terminal names to applicable rules
#F
ApplicableTable := rec(
    @ := [ @_Base ]
);

_RulesFor := function(nt, rulesRec, makeRuleFunc)
    local rules, r, ntname, fields, nam;
    Constraint(IsSPL(nt));
    if not IsBound(nt.index) then AddNonTerminal(nt); fi;

    if not IsRec(rulesRec)
        then Error("<rulesRec> must be a record containing rule records as elements"); fi;

    fields := Filtered(RecFields(rulesRec), f -> not IsSystemRecField(f));
    if not ForAll(fields, x -> IsRec(rulesRec.(x)))
        then Error("<rulesRec> must be a record containing rule records as elements");
    fi;

    rules := [];
    for nam in fields do
        rulesRec.(nam) := makeRuleFunc(rulesRec.(nam), nam, nt);
	Add(rules, rulesRec.(nam));
    od;

    if IsBound(ApplicableTable.(nt.__name__)) then Append(ApplicableTable.(nt.__name__), rules);
    else ApplicableTable.(nt.__name__) := rules; fi;

    # NOTE: Assign() was here for backwards compatibility
    for r in rules do Assign(r.name, r); od;
end;

#F RulesFor( <nonterm>, <rulesRec> )
#F
RulesFor := (nt, rulesRec) -> _RulesFor(nt, rulesRec, MakeRule);

NewRulesFor := (nt, rulesRec) -> _RulesFor(nt, rulesRec, NewMakeRule);

SimpleRule := (pat, rule) -> rec(
    isApplicable := Subst(P -> PatternMatch(P, $pat, empty_cx())),
    rule := rule
);

BaseRule := (transform, pat) -> let(lpat := When(IsList(pat), pat, [pat]),
    rec(
	isApplicable := DetachFunc(Subst(P -> PatternMatch(P, $(Concatenation([ListClass],lpat)), empty_cx()))),
	rule := DetachFunc(Subst((P,C) -> ApplyFunc($transform, P).terminate()))
    ));

Class(InfoNt, NonTerminal, rec(
    abbrevs := [ arg -> arg ],
    dims := self >> [1,1],
    doNotExpand := true,
    doNotMeasure := true,
    doNotSaveInHashtable := true,
    isReal := True,
    transpose := self >> self
));

NewRulesFor(InfoNt, rec(Info_Base := rec(applicable := True, apply := arg -> I(1))));

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

Class(AlternativeRewriteRule, AttrMixin, rec(
    isRule := true,
    isAlternativeRewriteRule := true,
    operations := RuleOps,
));

MakeAlternativeRewriteRule := function ( R, name)
    local doc;
    Constraint(IsRec(R) and IsString(name));
    doc := R.__doc__;
    # R.__doc__ is overwritten upon assignment
    R := WithBases(AlternativeRewriteRule, R);
    R.__doc__ := doc;
    R.name    := name;
    return R;
end;

AlternativeRewriteRules := function(rulesRec)
    local fields, nam;

    if not IsRec(rulesRec)
        then Error("<rulesRec> must be a record containing rule records as elements"); fi;

    fields := Filtered(RecFields(rulesRec), f -> not IsSystemRecField(f));
    if not ForAll(fields, x -> IsRec(rulesRec.(x)))
        then Error("<rulesRec> must be a record containing rule records as elements");
    fi;

    for nam in fields do
        rulesRec.(nam) := MakeAlternativeRewriteRule(rulesRec.(nam), nam);
        Assign(nam, rulesRec.(nam));
    od;
end;


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

# LocalConfig is configured in the user's local _spiral.g (Linux/Unix)
# or _spiral_win.g (Windows) in the Spiral root directory
#
# At a minimum, cpuinfo and osinfo need to be set, see one of those
# above mentioned config files for reference

Declare(LocalConfig, SpiralDefaults);
Class(LocalConfig, rec(
    info := meth(self)
                Print("\nPID: ", GetPid(), "\n");
            end,

    appendSym := self >> When(IsBound(self.osinfo.isWindows) and self.osinfo.isWindows(), "%*", "$*"),

    compilerinfo := rec(
        compiler:= "",
        defaultMode := "none",
        modes := rec(none := ""),
        alignmentSpecifier := ()->"",
        info := ()->Print("compiler info not set"),
    ),

    cpuinfo := rec(
        cpuname:="",
        vendor:="",
        freq:=0,
        default_lang:="",
        isWindows := False,
        isLinux := False,
        is32bit := False,
        is64bit := False,
        nproc := 1,
        SIMDname := False,
        info := ()->Print("CPU info not set"),
        SIMD := () -> spiral.platforms.SIMDArchitectures
    ),

    osinfo := rec(info := ()->Print("OS info not set"),
        isWindows := False,
        isLinux := False,
        isDarwin := False,
        isCygwin := False),

    svninfo := rec(version := "unknown",
        modified := "unknown",
        mixed := "unknown",
        isInit := false,
        info := self >> When(self.isInit, Print("SVN: ", self.version, When(self.modified, " (modified)", "")), Print("SVN info not set"))
    ),

    getOpts := arg >> arg[1].cpuinfo.getOpts(Drop(arg, 1)),

    setTitle := meth(arg)
                    local self, title;
                    self := arg[1];
                    if not IsBound(self.osinfo.setTitle) then return false; fi;
                    if Length(arg)=1 then title := ""; else title := Concat(" - ", arg[2]); fi;
                    self.osinfo.setTitle(Concat("Spiral 5.0", title));
                    return true;
                end
));

HighPerfMixin := rec(
    useDeref := true,
    compileStrategy := compiler.IndicesCS2,
    propagateNth := false
);

SpiralDefaults := CopyFields(SpiralDefaults, rec(
    includes := ["<include/omega64.h>"],
    precision       := "double",
    generateInitFunc := true,
    XType := code.TPtr(code.TReal),
    YType := code.TPtr(code.TReal),
    unifyStoredDataType := false, # false | "input" | "output"
                                  # if non-false, then unifies the datatype of
                                  # precomputed data with the datatype of input (X)
                                  # or output (Y)
    # we implement complex transforms using real vector of 2x size
    dataType        := "real",
    globalUnrolling := 32,
    faultTolerant   := false,
    printWebMeasure := false,

    # compiler options
    finalBinSplit := false,
    declareConstants := false,
    doScalarReplacement := false,
    propagateNth := true,
    inplace := false,

    doSumsUnification := false,
    arrayDataModifier := "static",
    scalarDataModifier := "",
    arrayBufModifier := "static",
    funcModifier := "", # for example "__decl" or "__fastcall"
    valuePostfix := "",

    # How much information Spiral is printing on the terminal.
    # Currently rather few functions are using this.
    verbosity := 1,

    # list of include files in generated C code, eg. ["<math.h>"]
    includes := [],

    formulaStrategies := rec(
        sigmaSpl := [ sigma.StandardSumsRules ],
        preRC    := [],
        rc       := [ sigma.StandardSumsRules ],
        postProcess := [
        (s, opts) -> compiler.BlockSums(opts.globalUnrolling, s),
        (s, opts) -> sigma.Process_fPrecompute(s, opts)
        ]
    ),

    baseHashes := [],
    subParams := [],

    sumsgen := sigma.DefaultSumsGen,
    # breakdownRules limits the used breakdown rules.
    # It must be a record of the form
    # rec(
    #   nonTerm := [ breakdown_rule1, breakdown_rule2, ...],
    #   DFT := [ DFT_Base, DFT_CT ]  <-- example
    # ).
    #
    # By default we set it to ApplicableTable for backwards compatibility with
    # older svn revisions.
    #
    # Functions SwitchRulesOn/Off will work only with breakdownRules==ApplicableTable.
    breakdownRules := formgen.ApplicableTable,

    compileStrategy := compiler.IndicesCS,
    simpIndicesInside := [code.nth, code.tcast, code.deref],
    useDeref := true,
    generateComplexCode := false,

    unparser := compiler.CUnparserProg,
    codegen := compiler.DefaultCodegen,
    TCharCtype :=  "char",
    TUCharCtype := "unsigned char",
    TUIntCtype := "unsigned int",
    TULongLongCtype := "unsigned long long",
    TRealCtype := "double",

    operations := rec(Print := s -> Print("<Spiral options record>")),

    highPerf := self >> CopyFields(self, HighPerfMixin),

    coldcache := false,
));

CplxSpiralDefaults := CopyFields(SpiralDefaults, rec(
    includes := ["<include/complex_gcc_sse2.h>"],
    unparser := compiler.CMacroUnparserProg,
    XType := code.TPtr(code.TComplex),
    YType := code.TPtr(code.TComplex),
    dataType := "complex",
    generateComplexCode := true,
    c99 := rec(
        I := "__I__",
        re := "creal",
        im := "cimag"
        )
));

IntelC99Mixin := rec(
    includes := ["<include/omega64c.h>"],
    unparser := compiler.CUnparserProg,
    XType := code.TPtr(code.TComplex),
    YType := code.TPtr(code.TComplex),
    dataType := "complex",
    generateComplexCode := true,
    c99 := rec(
        I := "__I__",
        re := "creal",
        im := "cimag"
        ),
    TComplexCtype := "_Complex double",
    TRealCtype := "double",
);

IBMC99Mixin := rec(
    includes := ["<include/omega64c.h>"],
    unparser := compiler.CUnparserProg,
    XType := code.TPtr(code.TComplex),
    YType := code.TPtr(code.TComplex),
    dataType := "complex",
    generateComplexCode := true,
    c99 := rec(
        I := "__I",
        re := "_creal",
        im := "_cimag"
        ),
    TComplexCtype := "_Complex double",
    TRealCtype := "double",
    postalign := n -> Print("    __alignx(16,", n, ");\n")
);

# How do we determine if we're running on Windows or Linux?
#Try(Load(iswindows));
#Try(Load(islinux));

#  NOTE: I'd like to pull that out into a function call, but failed to use load/include/read inside a function... => ask YSV
#if LocalConfig.osinfo.isWindows() then
#    Exec(let(sdir:=Conf("spiral_dir"), Concat("SubWCRev.exe ", sdir, " ", Concat(sdir, "\\spiral\\svn_win.src ", sdir, "\\spiral\\svn_info.g > NUL"))));
#    Load(svn_info);
#fi;
#if LocalConfig.osinfo.isLinux() then
# NOTE: For now, assume that any non-windows system is a linux system.
#else
 #   Exec(let(sdir:=Conf("spiral_dir"), Concat(". ", sdir, "/spiral/svn_linux.src ", sdir, " > ", sdir, "/spiral/svn_info.g")));
#    Load(svn_info);
#fi;

compiler.Unparser.fileinfo := meth(self, opts)
    local info;

#    if IsBound(opts.fileinfo) then
#        info := opts.fileinfo;
#        Print("/*\tCPU: ");
#        LocalConfig.cpuinfo.info();
#        Print("\n\tOS: ");
#        LocalConfig.osinfo.info();
#        Print("\n\t");
#        LocalConfig.svninfo.info();
#        if IsBound(opts.profile) then
#            Print("\n\tprofile: ", opts.profile.name, ", ", opts.profile.makeopts.CFLAGS);
#        else
#            Print("\n\tlanguage: ", opts.language);
#        fi;
#        PrintLine("\n\ttimestamp: ", let(t:=Date(), Concat(t[2]," ",StringInt(t[3]),", ",StringInt(t[1]), "; ",StringInt(t[4]),":",StringInt(t[5]),":",StringInt(t[6]))),
#            "\n\ttransform: ", info.algorithm.node , "\n\t",
#            "source file: \"", info.file, "(.c)\"\n\t",
#            "performance: ", info.cycles, " cycles, ", spiral._compute_mflops(info.flops, info.cycles), " Mflop/s\n",
#            "\nalgorithm: ", info.algorithm, "\n",
#        "*/\n");
#    fi;

    if IsBound(opts.fileinfo) then
        info := opts.fileinfo;
        if IsBound(opts.profile) then
            Print("/*\tprofile: ", opts.profile.name, ", ", opts.profile.makeopts.CFLAGS);
        else
            Print("/*\tlanguage: ", opts.language);
        fi;
        PrintLine("\n\ttimestamp: ", let(t:=Date(), Concat(t[2]," ",StringInt(t[3]),", ",StringInt(t[1]), "; ",StringInt(t[4]),":",StringInt(t[5]),":",StringInt(t[6]))),
            "\n",
            "\nalgorithm: ", info.algorithm, "\n",
        "*/\n");
    fi;
end;


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

Class(TraceBase, rec());

Class(TraceRewrite, TraceBase, rec(
        __call__ := (self, name,input,output,env) >> WithBases(self, rec(name:=name, input:=input,output:=output,env:=env,operations := PrintOps)),
       print := self >> Print("Rewrite(", self.name,",",self.input,",",self.output,")")
));

Class(TraceExpansion, TraceBase, rec(
        __call__ := (self, name,input,output,env) >> WithBases(self, rec(name:=name, input:=input,output:=output,env:=env,operations := PrintOps)),
       print := self >> Print("Expansion(", self.name,",",self.input,",",self.output,")")
));

Class(TraceTreeExpansion, TraceBase, rec(
        __call__ := (self, name,input,output,children,subtrees,env) >> WithBases(self, rec(name:=name, input:=input,output:=output,children:=children,subtrees:=subtrees, env:=env,operations := PrintOps)),
       print := self >> Print("TreeExpansion(", self.name,",",self.input,",",self.output,",",self.children,")")
));

Class(TraceConversion, TraceBase, rec(
        __call__ := (self, name,input,output,env) >> WithBases(self, rec(name:=name, input:=input,output:=output, env:=env, operations := PrintOps)),
       print := self >> Print("Conversion(", self.name,",",self.input,",",self.output,")")
));

Class(TraceLogPrinter, rec(
        __call__ := (self) >> WithBases(self, rec()),

        addRewrite := (self, name,input,output,env) >>
                           Print("\n------------------------------------------------------------------\n",
                                 "RULE: ", name,
                                 "\n------------------------------------------------------------------\n",
                                 "old expression",
                                 "\n------------------------------------------------------------------\n",
                                 input,
                                 "\n------------------------------------------------------------------\n",
                                 "new expression",
                                 "\n------------------------------------------------------------------\n",
                                 output,
                                 "\n------------------------------------------------------------------\n"),

        addExpansion := (self, name,input,output,env) >>
                           Print("\n==================================================================\n",
                                 "EXPANSION RULE: ", name,
                                 "\n------------------------------------------------------------------\n",
                                 "SPL expression:",
                                 "\n------------------------------------------------------------------\n",
                                 input,
                                 "\n------------------------------------------------------------------\n",
                                 "Sigma-SPL expression:",
                                 "\n------------------------------------------------------------------\n",
                                 output,
                                 "\n\n"),

        addTreeExpansion := meth(self, name,input,output,children,subtrees,env)
                           local d;
                           Print("\n==================================================================\n",
                                 "TREE EXPANSION RULE: ", name,
                                 "\n------------------------------------------------------------------\n",
                                 "original expression:",
                                 "\n------------------------------------------------------------------\n",
                                 input, "\n");

                           if Length(children) <> 0 then
                               Print("\n------------------------------------------------------------------\n",
                                     "subtree substitutions: ",
                                     "\n------------------------------------------------------------------\n");
                               DoForAll(children, i->Print(i, "\n\n"));
                               Print("\n------------------------------------------------------------------\n",
                                     "subtrees substituted: ",
                                     "\n------------------------------------------------------------------\n");
                               Print(subtrees, "\n");
                           fi;
                           # NOTE: pass and save var
                           # d := Collect(output, @(1, var, e->IsBound(e.value)));
                           #if (d <>[]) then
                           #   Print("\n------------------------------------------------------------------\n",
                           #          "data tables: ",
                            #         "\n------------------------------------------------------------------\n");
                            #   DoForAll(d, i->Print(i.id, " := ", i.value, "\n\n"));
                           #fi;

                           Print("------------------------------------------------------------------\n",
                                 "substituted expression:",
                                 "\n------------------------------------------------------------------\n",
                                 output, "\n\n");
                       end,

        addConversion := (self, name,input,output,env) >>
                           Print("\n==================================================================\n",
                                 "CONVERSION RULE: ", name,
                                 "\n------------------------------------------------------------------\n",
                                 "icode:",
                                 "\n------------------------------------------------------------------\n",
                                 input,
                                 "\n------------------------------------------------------------------\n",
                                 "icode:",
                                 "\n------------------------------------------------------------------\n",
                                 output,
                                 "\n\n"),

        beginRuleset := (self, ruleset, input) >>
                           Print("\n******************************************************************\n",
                                 "BEGIN RULESET: ", ruleset.inType, " -> ", ruleset.outType,
                                 "\n------------------------------------------------------------------\n",
                                 "Ruleset:", ruleset,
                                 "\n------------------------------------------------------------------\n",
                                 "Initial ", ruleset.inType,
                                 "\n------------------------------------------------------------------\n",
                                 input,
                                 "\n******************************************************************\n"),

        endRuleset := (self, ruleset,output) >>
                           Print("\n******************************************************************\n",
                                 "END RULESET: ", ruleset.inType, " -> ", ruleset.outType,
                                 "\n------------------------------------------------------------------\n",
                                 "Final ", ruleset.outType,
                                 "\n------------------------------------------------------------------\n",
                                 output,
                                 "\n******************************************************************\n\n"),

        beginStage := (self, from, to, input) >>
                           Print("******************************************************************\n",
                                 "BEGIN TRACE: ",from," -> ", to,
                                 "\n------------------------------------------------------------------\n",
                                 from, " expression:",
                                 "\n------------------------------------------------------------------\n",
                                 input,
                                 "\n******************************************************************\n"),

        endStage := (self, from, to, output) >>
                           Print("\n******************************************************************\n",
                                 "END TRACE: ",from," -> ", to,
                                 "\n------------------------------------------------------------------\n",
                                 to," expression:",
                                 "\n------------------------------------------------------------------\n",
                                 output,
                                 "\n******************************************************************\n\n"),

		addNote := (self, note) >>
                           Print("\n------------------------------------------------------------------\n",
                                 "NOTE:\n", note, "\n",
                                  "------------------------------------------------------------------\n")

                         #NOTE:
                         #d := Collect(spl, @(1, var, e->IsBound(e.value)));
                         #if (d <>[]) then
                         #    Print("\n------------------------------------------------------------------\n",
                         #          "data tables: ",
                         #          "\n------------------------------------------------------------------\n");
                         #    DoForAll(d, i->Print(i.id, " := ", i.value, "\n\n"));
                        #fi;
));

Class(TraceLogToFile, TraceLogPrinter, rec(
        __call__ := (self, filename) >> WithBases(self, rec(filename:=filename)),

        addRewrite    := (self, name,input,output,env) >> AppendTo(self.filename, self.__bases__[1].__bases__[1].addRewrite           (name,input,output,env)),
        addExpansion  := (self, name,input,output,env) >> AppendTo(self.filename, self.__bases__[1].__bases__[1].addExpansion   (name,input,output,env)),
        addTreeExpansion  := (self, name,input,output,children,subtrees,env) >> AppendTo(self.filename, self.__bases__[1].__bases__[1].addTreeExpansion(name,input,output,children,subtrees,env)),
        addConversion := (self, name,input,output,env) >> AppendTo(self.filename, self.__bases__[1].__bases__[1].addConversion (name,input,output,env)),

        beginRuleset  := (self, ruleset, input   ) >> AppendTo(self.filename, self.__bases__[1].__bases__[1].beginRuleset  (ruleset, input   )),
        endRuleset    := (self, ruleset, output  ) >> AppendTo(self.filename, self.__bases__[1].__bases__[1].endRuleset    (ruleset, output  )),
        beginStage    := (self, from, to, input  ) >> AppendTo(self.filename, self.__bases__[1].__bases__[1].beginStage    (from, to, input  )),
        endStage      := (self, from, to, output ) >> AppendTo(self.filename, self.__bases__[1].__bases__[1].endStage      (from, to, output )),
		addNote       := (self, note             ) >> AppendTo(self.filename, self.__bases__[1].__bases__[1].addNote       (note ))
));

Class(TraceLogCollector, rec(
        __call__ := (self) >> WithBases(self, rec(log:=[])),

        addRewrite := meth(self, name,input,output,env)
                    local e;
                    e := TraceRewrite(name, input,output,env);
                    Add(self.log, e);
                    return e;
                end,

        addExpansion := meth(self, name,input,output,env)
                    local e;
                    e := TraceExpansion(name, input,output, env);
                    Add(self.log, e);
                    return e;
                end,

        addTreeExpansion := meth(self, name,input,output,children,subtrees,env)
                    local e;
                    e := TraceTreeExpansion(name, input,output,children,subtrees,env);
                    Add(self.log, e);
                    return e;
                end,

        addConversion := meth(self, name,input,output,env)
                    local e;
                    e := TraceConversion(name, input,output, env);
                    Add(self.log, e);
                    return e;
                end,

        beginRuleset := (self, ruleset, input) >> 0,
        endRuleset := (self, ruleset, output) >> 0,
        beginStage := (self, from, to, input) >> 0,
        endStage := (self, from, to, output) >> 0,
		addNote := (self, note) >> 0

));

Class(TraceLog, rec(

        __call__ := (self) >> WithBases(self, rec(plugins := [])),

        addPlugin := (self, plugin) >>  Add(self.plugins, plugin),

        addRewrite := meth(self, name,input,output,env)
                    local p;
                    for p in self.plugins do
                          p.addRewrite(name,input,output,env);
                     od;
                end,

        addExpansion := meth(self, name,input,output,env)
                    local p;
                    for p in self.plugins do
                        p.addExpansion(name,input,output,env);
                    od;
                end,

        addTreeExpansion := meth(self, name,input,output,children,subtrees,env)
                    local p;
                    for p in self.plugins do
                        p.addTreeExpansion(name,input,output,children,subtrees,env);
                    od;
                end,

        addConversion := meth(self, name,input,output,env)
                    local p;
                    for p in self.plugins do
                        p.addConversion(name,input,output,env);
                    od;
                end,

        beginRuleset := meth(self, ruleset, input)
                    local p;
                    for p in self.plugins do
                        p.beginRuleset(ruleset, input);
                    od;
                end,

        endRuleset := meth(self, ruleset,output)
                    local p;
                    for p in self.plugins do
                        p.endRuleset(ruleset,output);
                    od;
                end,

        beginStage := meth(self, from, to, input)
                    local p;
                    for p in self.plugins do
                        p.beginStage(from, to, input);
                    od;
                end,

        endStage := meth(self, from, to, output)
                    local p;
                    for p in self.plugins do
                        p.endStage(from, to, output);
                    od;
                end,

		addNote := meth(self, note)
                    local p;
                    for p in self.plugins do
                        p.addNote(note);
                    od;
                end
));

# Global variable. Will be moved to 'opts' eventually.
trace_log := TraceLog();

# Convenience functions

TraceToConsole := function()
    trace_log.addPlugin(TraceLogPrinter());
end;

TraceToFile := function(filename)
    trace_log.addPlugin(TraceLogToFile(filename));
end;

trace_collector := TraceLogCollector();
TraceToMemory := function()
    trace_log.addPlugin(trace_collector);
    return(trace_collector);
end;

TraceNote := function(note)
	trace_log.addNote(note);
end;

# --- Example of trace system initialization:---
#trace_log.addPlugin(TraceLogPrinter());
#trace_log.addPlugin(TraceLogToFile("trace.g"));
# Save reference to collector for later use
#trace_collector := TraceLogCollector();
#trace_log.addPlugin(trace_collector);


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

IsTag := x -> IsRec(x) and IsBound(x.isTag) and x.isTag;

Declare(ANoTag);

####################################################################
#F AGenericTag - base class for tags, uses RewritableObject features
#F    which provides
#F      __call__
#F      print
#F      rSetChild
#F      rChildren
#F      lessThan
#F      equal
#F
#F Constructor saves all parameters into .params.
#F  Please read Doc(RewritableObject).
#F
Class(AGenericTag, RewritableObject, rec(
    isTag := true,
    kind := self >> ObjId(self),

    # YSV: this should be called when we transpose the parent structure
    transpose := self >> self,

    isSticky  := false,
    right     := self >> When(IsBound(self.isRight), self.isRight, false),
    left      := self >> When(IsBound(self.isRight), not self.isRight, false),
    bisided   := self >> not IsBound(self.isRight),

    leftChild  := self >> When(IsBound(self.isLeftChild),  self.isLeftChild,  false),
    rightChild := self >> When(IsBound(self.isRightChild), self.isRightChild, false),

    edge       := self >> When(IsBound(self.isEdge),  self.isEdge,  false),

    leftEdge   := self >> self.edge() and self.leftChild(),
    rightEdge  := self >> self.edge() and self.rightChild(),

    # distCompose(<chlist>, <opts>)
    #   Distributes tag over Compose(<chlist>).
    #   Returns list of tags to assign to each composition member.
    #   ANoTag is thrown out later during normalization.
    distCompose := (self, chlist, opts) >>
        Cond( self.left(),
                  [self] :: Replicate(Length(chlist)-1, ANoTag),
              self.right(),
                  Replicate(Length(chlist)-1, ANoTag) :: [self],
              # else bisided
                  Replicate(Length(chlist), self) ),

));

Class(ASingletonTag, AGenericTag, rec(
    params := [],
    from_rChildren := (self, rch) >> self,
    kind := self >> self
));

#F ANoRecurse() -- tag that prevents further recursion.
#F
#F Currently only used in autolib.
#F
Class(ANoRecurse, AGenericTag);

#F ANoTag - denotes absence of tags
#F
Class(ANoTag, ASingletonTag, rec());

#F ATopLevel - used to denote that special top level processing should be used,
#F             generally param[1] denotes at which 'level' the tag should be
#F             dropped.
#F
#F             Marek uses it in his WHT/bit-perms expansions. This tag will
#F             be moved elsewhere soon.
Class(ATopLevel, AGenericTag, rec());

####################################################################
#F Mixin class for taggable objects
#F
#F This object/class will add tagging functionality to whatever object inherits it.
#F Like all mixin style classes, it is not meant to be the sole parent class.
#F
Class(TaggedObjectMixin, rec(
    # this is the actual list of tags. This array should not be accessed directy, rather
    # the methods should be used to parse it.
    tags := [],

    # returns the first tag or ANoTag
    firstTag := self >> When(Length(self.tags) >= 1, self.tags[1], ANoTag),

    # returns true if first tag is has 'tag' object id
    firstTagIs := (self, tag) >> self.firstTag().kind()=tag,

    # returns the tags
    getTags := self >> self.tags,

    # returns true if the object has tags
    hasTags := self >> self.tags <> [],

    # returns a copy of the object with 'tags' added on to any existing tags.
    withTags := (self, tags) >> Checked(IsList(tags), self.setTags(self.tags :: tags)),

    # returns a copy of the object with tags given by 'tags'
    setTags := (self, tags) >> Checked(IsList(tags), CopyFields(self, rec(tags := tags))),

    # return a copy of the whole object without the first tag
    withoutFirstTag := self >> self.setTags(Drop(self.tags, 1)),

    # return a copy of the whole object without the tags given by object id 'tag'
    withoutTag := (self, tag) >> Checked(IsTag(tag), self.setTags(Filtered(self.tags, e -> e.kind() <> tag))),

    # returns true when the object id of at least one of the tags is 'tag'
    hasTag := (self, tag) >> Checked(IsTag(tag), ForAny(self.tags, e -> e.kind() = tag)),

    hasAnyTag := (self, tags) >> Checked(IsList(tags), ForAny(self.tags, e -> e.kind() in tags)),

    # returns true when tag number 'n' has the object id given by 't'
    isTag := (self, n, t) >> When(Length(self.tags) >= n, self.tags[n].kind() = t, false),

    numTags := (self) >> Length(self.tags),

    dropTags := (self) >> CopyFields(self, rec(tags := [])),

    #
    #F getTag
    #
    # get the tag by name or number, function has 3 forms:
    #   getTag(2)           returns 2nd tag
    #   getTag(ASomeTag)    if there is only 1 ASomeTag, returns it, if >1, returns array
    #   getTag(ASomeTag, 2) returns 2nd ASomeTag
    #
    # in case of error, getTag returns false
    #
    getTag := meth(arg)
        local s, t, n;

        Constraint(Length(arg) = 2 or Length(arg) = 3);

        s := arg[1];

        # arg[2] is a number.
        if IsInt(arg[2]) then
            return When(Length(s.tags) >= arg[2],
                s.tags[arg[2]],
                false);

        # arg[2] must be a tag id.
        else
            t := Filtered(arg[1].tags, e -> e.kind() = arg[2]);

            # if tag and number are specified
            if Length(arg) = 3 then
                return When(Length(t) >= arg[3],
                    t[arg[3]],
                    false
                );

            else
                return When(t = [],
                    false,
                    When(Length(t) = 1,
                        t[1],
                        t
                    )
                );
            fi;
        fi;
    end,

    getAnyTag := (self, tags) >> First(self.tags, x->x.kind() in tags)

));

####################################################################
#F Tagged non-terminal. This should be used for all new taggable
#F nonterminals.
#F
#F This supercedes the old system which puts tags into .params field
#F
#F Tags on nonterminals contain information that is beyond the mathematical
#F details of the object. Often tags contain information about hardware
#F which is used to direct the breakdown.
#F
Class(TaggedNonTerminal, TaggedObjectMixin, NonTerminal, rec(
    _short_print := true,
    #--------- Transformation rules support --------------------------------
    from_rChildren := (self, rch) >> let(
        len := Length(rch),
        transposed := rch[len-1],
        tags := rch[len],
        t := ApplyFunc(ObjId(self), rch{[1..len-2]}),
        tt := When(transposed, t.transpose(), t),
        attrTakeA(tt.withTags(tags), self)
    ),

    rChildren := self >>
        Concatenation(self.params, [self.transposed, self.tags]),

    rSetChild := meth(self, n, newChild)
        local l;
        l := Length(self.params);
        if n <= l then
            self.params[n] := newChild;
        elif n = l+1 then
            self.transposed := newChild;
        elif n = l+2 then
            self.tags := newChild;
        else Error("<n> must be in [1..", l+2, "]");
        fi;
        # self.canonizeParams(); ??
        self.dimensions := self.dims();
    end,

    # this print method OVERRIDES the print method in NonTerminal.
    # here, we print the TAG INFO.
    print := (self, i, is) >> Print(
	Inherited(i, is),
        When(IsBound(self.tags) and IsList(self.tags) and self.tags<>[],
             Print(".withTags(", self.tags, ")"))),

    takeTA := (self, o) >> self.setTags(o.getTags()).takeAobj(o),
));


InputTextFile("input.txt");
s := ReadAll(f);;  # two semicolons to hide the result, which may be long
CloseStream(f);


# Copyright 2018-2019, Carnegie Mellon University
# See LICENSE for details

CoSynthesize := function(t, opts)
    local tmp, f;
    tmp := Copy(t);
    for f in opts.csStrategy do
        tmp := f(tmp, opts);
    od;
    return tmp;
end;

ExportCode := function(c)
    local vars;
    vars := FoldL(Collect(c, var), (a,b)->When(not b.id in List(a, i->i.id), Concat([b],a), a), []);
    Print("let(", DoForAll(vars, i->Print(i.id, " := var(\"", i.id, "\", ", i.t, "),\n")), c, ")");
end;

ExportCProg := function(c, opts)
    Print(opts.doc::
        "\n");
    PrintCode(opts.subName, c, opts);
end;

ExportInclude := function(c, opts)
    local parameters, id, unparser, oopts, macro;

    unparser := Copy(opts.unparser);
    opts.unparser.opts:=opts;
    macro := "__"::StringToUpper(opts.filename)::"_H__";

    Print(opts.doc::
        "\n"::
        "#ifndef "::macro::"\n"::
        "#define "::macro::"\n\n"::
        "#ifdef __cplusplus\n"::
        "extern \"C\" {\n"::
        "#endif\n");

    parameters:=Flat(c.params);
    id := opts.subName;
    Print("\n",
        When(IsBound(c.inline) and c.inline, "inline ",""),
        opts.funcModifier, opts.unparser.declare(c.ret, var(id, c.ret), 0, 1), "(",
            DoForAllButLast(parameters, p->Print(unparser.declare(p.t, p,0,1), ", ")),
            When(Length(parameters)>0, unparser.declare(Last(parameters).t, Last(parameters),0,1), ""), ");\n");

    Print("\n#ifdef __cplusplus\n"::
        "}\n"::
        "#endif\n\n"::
        "#endif\n");
    opts.unparser := unparser;
end;


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

# ----------------------------------------------------------------------------------
# Visitor - base class for objects implementing the visitor pattern from Gamma book
# ----------------------------------------------------------------------------------
# This class basically implements a somewhat modified variant of the original
# Visitor pattern from the book by Gamma, et al. "Design Patterns".
#
# Usage example:
#
# define the following class
#
# Class(LispGen, Visitor, rec(
#     add := (self, o) >> Print("(+ ", self(o.args[1]), " ", self(o.args[2]), ")"),
#     mul := (self, o) >> Print("(* ", self(o.args[1]), " ", self(o.args[2]), ")"),
#     sub := (self, o) >> Print("(- ", self(o.args[1]), " ", self(o.args[2]), ")"),
#     var := (self, o) >> Print("(var ", o.id, ")"),
#     Value := (self, o) >> Print("(value ", o.v, ")")
# ));
#
# spiral> LispGen(4*X+2);
# (+ (* (value 4) (var X)) (value 2))spiral>
#
# Note that instead of using 'self' as a function (which invokes __call__),
# we can use self.visit, and make __call__ a constructor for LispGen.
#
# Ie., the methods would look like
#     add := (self, o) >> Print("(+ ", self.visit(o.args[1]), " ", self.visit(o.args[2]), ")"),
#
Class(Visitor, rec(
   __call__ := arg >> ApplyFunc(arg[1].visit, arg{[2..Length(arg)]}),

    # this is a rewrite of the lambda expression. The lambda was getting
    # way too long. This implements the double dispach for the visitor
    # class.
    visit := meth(arg)
        local self, o, len;

        Constraint(Length(arg) >= 2);

        self := arg[1];
        o := arg[2];
        len := Length(arg);

        if IsRec(o) or IsList(o) then
            o := ObjId(o);
            if IsBound(self.(o.name)) then
                ApplyFunc(self.(o.name), arg{[2..len]});

            # this is just here to trap the hacks, rather than silently fail
            elif IsBound(o.visitAs) then
                Error("visitAs has been removed. Don't use it.");

            else
		        Error("Cannot visit <arg[2]>. Visitor ", self,
                " does not have field '", o.name, "'",
                    When(IsBound(o.visitAs),
			            Concat(" or ",o.visitAs, " (from .visitAs)"),
                        ""
                    )
                );
            fi;
        else
            ApplyFunc(self.atomic, arg{[2..len]});
        fi;
    end
));

#F
#F# getVisitAs
#F
#F get the .visitAs if it exists.
#F

getVisitAs := function(v, o)

    o := ObjId(o);

    # if this object has a visitor, or if visitAs is unbound
    if IsBound(v.(o.__name__)) or not IsBound(o.visitAs) then
        return false;
    fi;

    return o.visitAs;
end;

#F HierarchicalVisitor -- same as Visitor, but does not use .visitAs,
#F   instead traverses the super class chain
#F
Class(HierarchicalVisitor, rec(
   __call__ := arg >> ApplyFunc(arg[1].visit, arg{[2..Length(arg)]}),

#F the hierarchical visitor function.
#F
#F we consider the objects by level, in order of the objects in __bases__
#F
#F here's an example:
#F objA
#F  |---parA
#F  | |---parA1
#F  | \---parA2
#F  \---parB
#F
#F traverse order is: objA parA parB parA1 parA2
#F
    warnings := Set([]),
    paranoiaMode := false, # <-- if this is true, then .visit() aborts when there is a mismatch of
                          # the method it finds with what .visitAs prescribes, otherwise,
                          # it silently adds the mismatch to .warnings and continues

    visit := meth(arg)
        local self, o, orig, len, parents, newparents, v;

        Constraint(Length(arg) >= 2);

        self := arg[1];
        o   := arg[2];
        len := Length(arg);

        # lists are handled with .ListClass, records with .<objid>,
        # other objects with .atomic
        if not (IsRec(o) or IsList(o)) or IsString(o) then
            return ApplyFunc(self.atomic, arg{[2..len]});

        # objects are handled here
        else
            # this will be eventually removed, but for the time being,
            # we try to figure out the object which would be selected
            # by .visitAs and compare it to the object which is chosen
            # hierarchically. If there is a difference, we throw an
            # error.

            v := getVisitAs(self, o);

            # paranoia check to make sure we have an object
            Constraint(IsList(o) or (IsRec(o) and IsBound(o.__name__)));

            parents := Cond(IsList(o), [ObjId(o)], ShallowCopy(o.__bases__));

            # traverse the parent tree as given in the function comments
            for o in parents do
                if IsBound(self.(o.__name__)) then

                    # here is our paranoia check which will eventually
                    # be removed after the transition is complete.
                    if (v <> false and v <> o.__name__) then
                        if self.paranoiaMode then
                            Error("visitAs object is different from object picked by hierarchy traversal. Call Marek.");
                        else
                            AddSet(self.warnings, [self,v,o]);
                        fi;
                    fi;

                    return ApplyFunc(self.(o.__name__), arg{[2..len]});
                elif IsBound(o.__bases__) then
                    Append(parents, o.__bases__);
                fi;
            od;

            return Error("Cannot visit <arg[2]>. visitAs was ", v);
        fi;
    end,

    #F
    #F getBases()
    #F
    #F build a list of all the bases according to the order
    #F given in the .visitAs method
    #F
    getBases := meth(self)
        local b, i;

        b := [self];
        i := 1;

        while i <= Length(b) do
            Append(b, ShallowCopy(b[i].__bases__));
            i := i + 1;
        od;

        return b;
    end,

    #F
    #F showMatches(obj)
    #F
    #F returns the ordered list of visitors triggered by this object.
    showMatches := meth(self, o)
        local b, bb, res, i, m;

        Constraint(IsRec(o));

        b := self.getBases();

        bb := ShallowCopy(o.__bases__);
        res := [];
        i := 1;

        while i <= Length(bb) do
            m := Filtered(b, e -> bb[i].name in UserRecFields(e));

            if m <> [] then
                Append(res, [bb[i]] :: m);
            fi;

            Append(bb, ShallowCopy(bb[i].__bases__));
            i := i + 1;
        od;

        return res;
    end,
));

#F HierarchicalVisitorCx -- HierarchicalVisitor with context accessible through
#F   self.cx field. Drawback - start visitor using <walk> method instead of
#F   __call__.
#F
#F   Ex: MyVisitor.walk(tree, arg1, arg2);
#F

Class(HierarchicalVisitorCx, HierarchicalVisitor, rec(

    walk := (arg) >> ApplyFunc(CopyFields(arg[1], rec(
        cx := empty_cx(), _current := false )), Drop(arg, 1)),

    visit := meth(arg)
        local self, parent, res;

        self          := arg[1];
        parent        := self._current;
        self._current := arg[2];

        if parent=false then
            res := ApplyFunc(Inherited, Drop(arg, 1));
        else
            cx_enter(self.cx, parent);
            res := ApplyFunc(Inherited, Drop(arg, 1));
            cx_leave(self.cx, parent);
        fi;

        self._current := parent;

        return res;
    end,
));


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

FixUpHIP_Code := function (c, opts)
    local kernels, kernel_inits, globals, var_decls, var_dels, cx, v, dptr;

    if IsBound(opts.fixUpTeslaV_Code) and opts.fixUpTeslaV_Code then
        kernels := List(Collect(c, specifiers_func), k->k.id);

        dptr := var.fresh_t("hp", TPtr(TReal));

        kernel_inits := List(kernels, k-> call(rec(id := "hipFuncSetCacheConfig"), fcall("reinterpret_cast<const void*>", k), "hipFuncCachePreferL1"));

        globals := Flat(List(Collect(c, @@(1, decl, (e, cx) -> (not IsBound(cx.specifiers_func) or cx.specifiers_func = []) and
                               (not IsBound(cx.func) or cx.func = []))), x->x.vars));

        var_decls := chain(Flat(List(globals, v -> [
                call(rec(id := "hipMalloc"), tcast(TPtr(TPtr(TVoid)), addrof(dptr)), sizeof(v.t.t) * v.t.size),
                call(rec(id := "hipMemcpyToSymbol"), fcall("HIP_SYMBOL", v), addrof(dptr), sizeof(dptr.t))
            ])));

        var_dels := decl(dptr, chain(Flat(List(globals, v -> [
                call(rec(id := "hipMemcpyFromSymbol"), addrof(dptr), fcall("HIP_SYMBOL", v), sizeof(dptr.t)),
                call(rec(id := "hipFree"), dptr)
            ]))));

        cx := chain(kernel_inits :: [var_decls]);
        for v in globals do
            v.t := TPtr(v.t.t, ["__device__"]);
        od;

        c := SubstBottomUp(c, @(1, func, f -> f.id = "init"),
            e -> CopyFields(@(1).val, rec(cmd := decl(dptr, chain(cx, @(1).val.cmd))))
        );
        c := SubstBottomUp(c, @(1, func, f -> f.id = "destroy"),
            e -> CopyFields(@(1).val, rec(cmd := chain(var_dels, @(1).val.cmd)))
        );
        c := SubstBottomUp(c, @(1, chain, e -> ForAny(e.cmds, e -> ObjId(e) = func and e.id = "init")),
            e -> chain(Filtered(@(1).val.cmds, e-> ObjId(e) <> func or e.id <> "init") :: Filtered(@(1).val.cmds, e -> ObjId(e) = func and e.id = "init"))
        );

    fi;

    return c;
end;


#############################################################################
##
##
#W  json.gi                  json Package                Chris Jefferson
##
##  Installation file for functions of the json package.
##
#Y  Copyright (C) 2013-2014 University of St. Andrews, North Haugh,
#Y                          St. Andrews, Fife KY16 9SS, Scotland
##

####
# Functions and variables beginning '_JSON_' are only called
# from C++ by the json package.
####

_JSON_Globals := [];

_JSON_addRef := function(obj)
  Add(_JSON_Globals, obj);
end;

_JSON_clearRefs := function()
  _JSON_Globals := [];
end;

InstallMethod(_GapToJsonStreamInternal, [IsOutputStream, IsInt],
function(o, d)
  PrintTo(o, String(d));
end );

InstallMethod(_GapToJsonStreamInternal, [IsOutputStream, IsFloat],
function(o, d)
  PrintTo(o, String(d));
end );

InstallMethod(_GapToJsonStreamInternal, [IsOutputStream, IsBool],
function(o, b)
  if b = true then
    PrintTo(o, "true");
  elif b = false then
    PrintTo(o, "false");
  else
    Error("Invalid Boolean");
  fi;
end );

InstallMethod(_GapToJsonStreamInternal, [IsOutputStream, IsString],
function(o, s)
  if IsEmpty(s) then
    if IsStringRep(s) then
      PrintTo(o, "\"\"");
    else
      PrintTo(o, "[]");
    fi;
  else
    PrintTo(o, "\"", JSON_ESCAPE_STRING(s), "\"");
  fi;
end );

InstallMethod(_GapToJsonStreamInternal, [IsOutputStream, IsList],
function(o, l)
  local i, first;
  first := true;
  PrintTo(o, "[");
  for i in l do
    if first then
      first := false;
    else
      PrintTo(o, ",");
    fi;
    _GapToJsonStreamInternal(o, i);
  od;
  PrintTo(o, "]");
end );

InstallMethod(_GapToJsonStreamInternal, [IsOutputStream, IsRecord],
function(o, r)
  local i, first;
  first := true;
  PrintTo(o, "{");
  for i in Set(RecNames(r)) do # sort for output stability across GAP sessions
    if first then
      first := false;
    else
      PrintTo(o, ",");
    fi;
    _GapToJsonStreamInternal(o, i); # a string or small integer
    PrintTo(o, " : ");
    _GapToJsonStreamInternal(o, r.(i)); # an arbitrary GAP object
  od;
  PrintTo(o, "}");
end );

InstallGlobalFunction(GapToJsonStream,
function(stream, obj)
  local streamformat;
  streamformat := PrintFormattingStatus(stream);
  SetPrintFormattingStatus(stream, false);
  _GapToJsonStreamInternal(stream, obj);
  SetPrintFormattingStatus(stream, streamformat);
end );

InstallGlobalFunction(GapToJsonString,
function(obj)
  local str, s;
  str := "";
  s := OutputTextString(str, true);
  SetPrintFormattingStatus(s, false);
  GapToJsonStream(s, obj);
  return str;
end );

InstallGlobalFunction(JsonStringToGap,
function(str)
  return JSON_STRING_TO_GAP(str);
end );

InstallGlobalFunction(JsonStreamToGap,
function(str)
  return JSON_STREAM_TO_GAP(str);
end );


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

# Class(DistMixin1, rec(
# #   includes := ["<include/threads.h>", "<include/smp2.h>"],
#     dist_loop := meth(self, o, i, is)
#         local v, lo, hi;
#         v := o.var;
#         lo := o.range[1];
#         hi := Last(o.range);
#         Print(Blanks(i), "for(int ", v, " = tid + ", lo, "; ", v, " <= ", hi, "; ", v, "+= ", o.p, ") {\n");
#         Print(Blanks(i+is), "int ", o.tidvar, " = ", self(o.tidexp, i+is+is, is), ";\n");
#         self(o.cmd,i+is,is);
#         Print(Blanks(i), "}\n");
#         Print(Blanks(i), When(IsBound(self.opts.smp),
#                               self.opts.smp.barrier,
#                               "//barrier(num_threads, tid, &GLOBAL_BARRIER);\n"));
#     end,
#
#     threadId := (self, o, i, is) >> Print("tid")
#
# ));

Class(DistMixin, rec(
#  includes := ["<spumacros.h>"],

   dist_loop := meth(self, o, i, is)
       Print(Blanks(i),    "{\n");
       #Print(Blanks(i+is), "unsigned int ", o.var, " = spe_info.spuid;\n");
       self(o.cmd,i+is,is);
       Print(Blanks(i),    "}\n");
       #Print(Blanks(i),    "//ALL_TO_ALL_BARRIER;\n");
       #Print(Blanks(i),    "BLOCK_ON_READ();\n");
    end,

    dist_barrier := (self,o,i,is) >> Print(Blanks(i), "BLOCK_ON_CPUDMA; ALL_TO_ALL_BARRIER;\n"),

    call := (self, o, i, is) >> Print(Blanks(i), o.args[1].id, self.pinfix(Drop(o.args, 1), ", "), ";\n"),

    fcall := (self, o, i, is) >> Print(self(o.args[1],0,0), "(", self.infix(Drop(o.args, 1), ", "), ")"),

));

Class(DistUnparser, DistMixin, CUnparserProg);
#Class(DistCellUnparser, DistMixin, CellUnparser);


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

# NOTE: the code below checks if BF_NO_COPY flag is set. This is a bad way to check
#        whether something is a class, also hardcoding 128 will break sooner or later
_isclass := x->BinAnd(BagFlags(x),32768)=32768 or not IsRec(x);

_oid := x -> Cond(_isclass(x), x, ObjId(x));

Class(RewritableObjectOps, PrintOps, rec(
    \= := (s1,s2) -> Cond(
        _isclass(s1) and _isclass(s2), BagAddr(s1)=BagAddr(s2),
	_oid(s1) = _oid(s2) and s1.rChildren() = s2.rChildren()),

    \< := (s1,s2) -> Cond(
	_isclass(s1) and _isclass(s2), BagAddr(s1) < BagAddr(s2),
        _oid(s1) <> _oid(s2),        _oid(s1) < _oid(s2),
        s1.rChildren() < s2.rChildren())
));

#F RewritableObject - convenient base class for objects to be used
#F                    with rewriting.
#F
#F It provides
#F      __call__
#F      print
#F      rSetChild
#F      rChildren
#F      lessThan
#F      equal
#F
#F Constructor __call__ takes variable number of arguments and saves all
#F of them into .params field of the constructed instance.
#F
#F To do error checking and validation on .params, redefine .updateParams
#F in subclasses. It is also called after updates in .rSetChild
#F

Class(RewritableObject, rec(
    __call__ := meth(arg)
        local self, params, res;
        self := arg[1];
        params := Drop(arg, 1);
        res := WithBases(self,
            rec(params := params, operations := RewritableObjectOps));
        res.updateParams();
        return res;
    end,

    updateParams := self >> self,

    equals := (self, o) >>
        ObjId(self) = ObjId(o) and self.rChildren() = o.rChildren(),

    lessThan := (self, o) >> Cond(
        ObjId(self) <> ObjId(o), ObjId(self) < ObjId(o),
        [ ObjId(self), self.rChildren() ] < [ ObjId(o), o.rChildren() ]
    ),

    from_rChildren := (self, rch) >> ApplyFunc(ObjId(self), rch),
    rChildren := self >> self.params,
    rSetChild := meth(self, n, newC)
        self.params[n] := newC;
        self.updateParams();
    end,

    # Compatibility interface for Print, supports standard print() and
    # print(s, i, is).
    # NOTE: doesn't propagate it to children
    print := meth(arg)
        local self;
        self := arg[1];
        Print(self.__name__, "(", PrintCS(self.rChildren()), ")");
    end,
));

#F ConstClass - base class for constants.
#F

Class(ConstClass);


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

Import(profiler, rewrite, code);

Class(CompilerDefaults, rec(
    alignmentSpecifier := "",
    modes := [""],
    version := "",
    major := 0,
    minor := 0,
    compiler := "",
    package := "",
    build := "",
    info := self >> Print(self.compiler, " ", self.version),
    default := self >> self.(self.modes[1])(),
    SIMD := () -> spiral.platforms.SIMDArchitectures
));

Class(IntelC, CompilerDefaults, rec(
    alignmentSpecifier := meth(arg)
		local bytes;

		if Length(arg) > 1 then
			bytes := arg[2];
		else
			bytes := 16;
		fi;

		return "__declspec(align("::String(bytes)::"))";
	end,

    postalign := (self, a,i,is) >> Print(Blanks(i), "__assume_aligned(", a, ", 16);\n"),
    restrict := self >> "restrict",

    looppragma := (self, o,i,is) >> When(Collect(o.cmd, loop)=[],
        Print(Blanks(i), "#pragma vector always\n", Blanks(i), "#pragma ivdep\n"),
        Print(Blanks(i), "#pragma novector\n")),

    compiler := "Intel C++ Compiler",

    SIMD := self >> CopyFields(platforms.SIMDArchitectures, rec(
        hasMMX    := True,
		hasSSE    := True,
		hasSSE2   := True,
		hasSSE3   := True,
        hasSSSE3  := () -> self.major >= 10,
		hasSSE4_1 := () -> self.major >= 10,
		hasSSE4_2 := () -> self.major >= 10)),

    modes := ["ia32", "em64t"],

    # WinGetValue is only defined under windows. If the call works, it takes
    # the returned path, adds "bin" onto it, and then appends
    # the iclvars batch file redirected to nul.
    ia32 := self >> CopyFields(default_profiles.win_x86_icc, rec(
        premake := Concat(
            "\"",
            let(a := Try(WinGetValue("SYSTEM/CurrentControlSet/Control/Session Manager/Environment/ICPP_COMPILER15")),
                b := Try(WinGetValue("SYSTEM/CurrentControlSet/Control/Session Manager/Environment/ICPP_COMPILER14")),
                When(a[1],
                    Concat(a[2], "bin\\"),
                    When(b[1],
                        Concat(b[2], "bin\\"),
                        ""
                    )
                )
            ),
            "iclvars.bat\" > nul"
        )
    )),

    em64t := self >> CopyFields(default_profiles.win_x64_icc, rec(
        premake := Concat(
            "\"",
            let(a := Try(WinGetValue("SYSTEM/CurrentControlSet/Control/Session Manager/Environment/ICPP_COMPILER15")),
                b := Try(WinGetValue("SYSTEM/CurrentControlSet/Control/Session Manager/Environment/ICPP_COMPILER14")),
                When(a[1],
                    Concat(a[2], "bin\\"),
                    When(b[1],
                        Concat(b[2], "bin\\"),
                        ""
                    )
                )
            ),
            "iclvars.bat\" intel64 > nul"
        )
    ))
));

Class(GnuC, IntelC, rec(
    compiler := "gcc (GNU Compiler Collection)",

	SIMD := self >> CopyFields(platforms.SIMDArchitectures, rec(
        hasMMX    := True,
		hasSSE    := True,
		hasSSE2   := True,
		hasSSE3   := True,
        hasSSSE3  := True,
		hasSSE4_1 := True,
		hasSSE4_2 := True)),

	alignmentSpecifier := meth(arg)
		local bytes;

		if Length(arg) > 1 then
			bytes := arg[2];
		else
			bytes := 16;
		fi;

		return "__attribute__((aligned("::String(bytes)::")))";
	end,
));

 Class(Llvm_Clang, IntelC, rec(
    compiler := "clang (LLVM Compiler Collection)",

	SIMD := self >> CopyFields(platforms.SIMDArchitectures, rec(
        hasMMX    := True,
		hasSSE    := True,
		hasSSE2   := True,
		hasSSE3   := True,
        hasSSSE3  := True,
		hasSSE4_1 := True,
		hasSSE4_2 := True)),

	alignmentSpecifier := meth(arg)
		local bytes;

		if Length(arg) > 1 then
			bytes := arg[2];
		else
			bytes := 16;
		fi;

		return "__attribute__((aligned("::String(bytes)::")))";
	end,
));

Class(GnuC_ARM, IntelC, rec(
    compiler := "gcc (GNU Compiler Collection)",

	SIMD := self >> CopyFields(platforms.SIMDArchitectures, rec(
        hasMMX    := False,
		hasSSE    := False,
		hasSSE2   := False,
		hasSSE3   := False,
        hasSSSE3  := False,
		hasSSE4_1 := False,
		hasSSE4_2 := False)),

	alignmentSpecifier := meth(arg)
		local bytes;

		if Length(arg) > 1 then
			bytes := arg[2];
		else
			bytes := 16;
		fi;

		return "__attribute__((aligned("::String(bytes)::")))";
	end,
));

Class(VisualC, CompilerDefaults, rec(
    compiler := "MS VisualStudio.NET C++ compiler",
    modes := ["ia32"],
    SIMD := () -> CopyFields(platforms.SIMDArchitectures, rec(hasMMX := True, hasSSE:=True, hasSSE2:=True, hasSSE3:=True)),

	alignmentSpecifier := meth(arg)
		local bytes;

		if Length(arg) > 1 then
			bytes := arg[2];
		else
			bytes := 16;
		fi;

		return "__declspec(align("::String(bytes)::"))";
	end,

    ia32 := self >> CopyFields(default_profiles.win_x86_vcc),
));

Class(VisualC_12, VisualC, rec(
    compiler := "MS VisualStudio.NET C++ 12.0 compiler",
    modes    := ["x86", "x64"],
    SIMD := () -> CopyFields(platforms.SIMDArchitectures, rec(hasMMX := True, hasSSE:=True, hasSSE2:=True, hasSSE3:=True, hasSSE4_1 := True)),
    x86 := self >> CopyFields(default_profiles.win_x86_vcc, rec(
        premake := () -> "call \"%VS120COMNTOOLS%..\\..\\VC\\vcvarsall.bat\" x86 > nul"
    )),
    x64 := self >> CopyFields(default_profiles.win_x64_vcc, rec(
        premake := () -> "call \"%VS120COMNTOOLS%..\\..\\VC\\vcvarsall.bat\" x64 > nul"
    ))
));

Class(NvidiaCuda, IntelC, rec(
    compiler := "NVIDIA Cuda compiler",

	SIMD := self >> CopyFields(platforms.SIMDArchitectures, rec(
        hasMMX    := True,
		hasSSE    := True,
		hasSSE2   := True,
		hasSSE3   := True,
        hasSSSE3  := True,
		hasSSE4_1 := True,
		hasSSE4_2 := True)),

	alignmentSpecifier := meth(arg)
		local bytes;

		if Length(arg) > 1 then
			bytes := arg[2];
		else
			bytes := 16;
		fi;

		return "__attribute__((aligned("::String(bytes)::")))";
	end,
));

SupportedCompilers := rec(
    IntelC := IntelC,
    VisualC := VisualC,
    VisualC_12 := VisualC_12,
    GnuC := GnuC,
    GnuC_ARM := GnuC_ARM,
    Llvm_Clang := Llvm_Clang,
    NvidiaCuda := NvidiaCuda
);


_BUFFER := "";
OutputStreamZmqType := NewType(
    StreamsFamily,
    IsOutputTextStream and IsOutputStreamZmqRep );

InstallMethod( OutputStreamZmq,
    "output stream to Jupyter ZeroMQ",
    [ IsObject, IsZmqSocket, IsString ],
function(kernel, socket, streamname)
    # TODO: more specific, check kernel, connected socket, etc
    if not IsZmqSocket(socket)  then
        Error( "<socket> must be a IsZmqSocket" );
    fi;
    return Objectify( OutputStreamZmqType
                    , rec( kernel := kernel, socket := socket
                         , format := false, streamname := streamname ) );
end);

InstallMethod( OutputStreamZmq,
    "output stream to Jupyter ZeroMQ",
    [ IsObject, IsZmqSocket ],
    { kernel, socket } -> OutputStreamZmq(kernel, socket, "stdout" ) );

InstallMethod( ViewString,
    "output stream to Jupyter ZeroMQ",
    [ IsOutputStreamZmqRep ],
function( obj )
    # TODO: print some useful info about kernel/socket?
    return "OutputStreamZmq()";
end );

InstallMethod( WriteAll,
    "output text string",
    [ IsOutputTextStream and IsOutputStreamZmqRep,
      IsString ],
function( stream, string )
    local curmsg, msg;
    if IsBound(stream!.kernel!.CurrentMsg) then
        curmsg := stream!.kernel!.CurrentMsg;
    else
        curmsg := rec();
    fi;
    Append( _BUFFER, string );
    JupyterMsgSend( stream!.kernel
                  , stream!.kernel!.IOPub
                  , JupyterMsg( stream!.kernel
                              , "stream"
                              , curmsg
                              , rec( name := stream!.streamname
                                   , text := string )
                              , rec () ) );
    return true;
end );

InstallMethod( WriteByte,
    "output text string",
    [ IsOutputTextStream and IsOutputStreamZmqRep,
      IsInt ],
function(stream, byte)
    local curmsg, msg;
    if byte < 0 or 255 < byte  then
        Error( "<byte> must an integer between 0 and 255" );
    fi;
    # TODO
    if IsBound(stream!.kernel!.CurrentMsg) then
        curmsg := stream!.kernel!.CurrentMsg;
    else
        curmsg := rec();
    fi;
    Add( _BUFFER, CharInt(byte) );
    JupyterMsgSend( stream!.kernel
                  , stream!.kernel!.IOPub
                  , JupyterMsg( stream!.kernel
                              , "stream"
                              , curmsg
                              , rec( name := stream!.streamname
                                   , text := CharInt(byte) )
                              , rec () ) );

    return true;
end );

InstallMethod( PrintFormattingStatus, "output text string"
             , [ IsOutputTextStream and IsOutputStreamZmqRep ]
             , str -> str!.format);

InstallMethod( SetPrintFormattingStatus, "output text string"
             , [ IsOutputTextStream and IsOutputStreamZmqRep,
                 IsBool ],
function(str, stat)
    if stat = fail then
        Error("Print formatting status must be true or false");
    else
        str!.format := stat;
    fi;
end);


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

_printattr := x->When((x=[] and TYPE(x)="string") or (x<>[] and IsString(x)), Print("\"", x, "\""), Print(x));

attrTakeA  := (to, from) -> When(IsRec(to) and IsBound(to.takeAobj), to.takeAobj(from), to);

Class(AttrMixin, rec(
    a := rec(),

    setA := meth(arg)
        local self, i, a, f, val;
        a := rec();
        self := arg[1];
        for i in [2..Length(arg)] do
            if IsVarMap(arg[i]) then
                f := NameOf(arg[i][1]);
                val := Eval(arg[i][2]);
                a.(f) := val;
            elif IsList(arg[i]) and Length(arg[i]) in [0,2] then
                if Length(arg[i])>0 then
                    [f, val] := arg[i];
                    a.(f) := val;
                fi;
            else return Error("arg[i] must be a list or varmap");
            fi;
        od;
        return CopyFields(self, rec(a:=a));
    end,

    withA := meth(arg)
        local self, res, set;
        self := arg[1];
        set := self.setA;
        res := ApplyFunc(set, arg);
        res.a := CopyFields(self.a, res.a);
        return res;
    end,

    hasA := (self, attr) >> Cond(IsBound(self.a.(attr)), true, false),

    # getA(<attr>, <def> = false) - returns attribute value.
    #   Optional <def> parameter is value to return when attribute is not found.

    getA := (arg) >> let( self := arg[1], attr := arg[2],
                        def := When(Length(arg)>2, arg[3], false),
                        Cond(IsBound(self.a.(attr)), self.a.(attr), def)),

    printA := self >> let(flds := UserRecFields(self.a),
        Cond(flds=[], Print(""),
             Print(".setA(",
                 DoForAllButLast(flds, x->Print(x, " => ", _printattr(self.a.(x)), ", ")),
                 Last(flds), " => ", _printattr(self.a.(Last(flds))), ")"))),

    takeA   := meth(self, a) self.a := CopyFields(a); return self; end,

    appendA := meth(self, a) self.a := CopyFields(self.a, a); return self; end,

    takeAobj   := meth(self, obj) self.a := CopyFields(obj.a); return self; end,

    appendAobj   := meth(self, obj) self.a := CopyFields(self.a, obj.a); return self; end,

    attrs := ~.takeAobj,

    # testA( attr, v = true ) returns true if object has attribute <attr> with value equal to <v>

    testA := (arg) >> let( self := arg[1], attr := arg[2],
        v := When(IsBound(arg[3]), arg[3], true),
        self.hasA(attr) and self.getA(attr) = v),

    dropA := meth(arg)
        local obj, d, s;
        obj := ShallowCopy(arg[1]);
        d   := Drop(arg, 1);
        if Length(arg)=1 then
            Unbind(obj.a);
        elif ForAll(d, IsString) then
            obj.a := ShallowCopy(obj.a);
            for s in d do Unbind(obj.a.(s)); od;
        else
            Error("Usage: dropA([ <attr_name_string>[, <attr_name_string>[, ...]] ])");
        fi;
        return obj;
    end,

    # listA() returns list of attribute names and values in [[name, value],...] form.

    listA := (self) >> List(Sort(UserRecFields(self.a)), e -> [e, self.a.(e)]),
));


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

#F ==========================================================================
#F ParCell(<num_spus>, <pkSize>) - Cell parallelization tag
#F    .params[1] is num_spus
#F    .params[2] is packetSize
#F
Class(ParCell, AGenericTag, rec(isCell := true));

#F ==========================================================================
#F ParCell_auto (<num_spus>) - Cell parallelization tag
#F    .params[1] is num_spus
#F Highest possible packet size is automatically chosen
Class(ParCell_auto, AGenericTag, rec(isCell := true));

#F ==========================================================================
#F ParDMPCell_old(<num_spus>) - Cell DMP parallelization tag
#F    .params[1] is num_spus
Class(ParCellDMP_old, AGenericTag, rec(isCell := true));

#F ==========================================================================
#F ParDMPCell(<num_spus>) - Cell DMP parallelization tag
#F    .params[1] is num_spus
#F    .params[2] is v
Class(ParCellDMP, AGenericTag, rec(isCell := true));

Class(StickyL, AGenericTag);


%Terminals
    DollarSign ::= '$'
    Percent ::= '%'
    _

    a    b    c    d    e    f    g    h    i    j    k    l    m
    n    o    p    q    r    s    t    u    v    w    x    y    z
%End

%Headers
    /.
        final static int tokenKind[] = new int[128];
        static
        {
            tokenKind['$'] = $sym_type.$prefix$DollarSign$suffix$;
            tokenKind['%'] = $sym_type.$prefix$Percent$suffix$;
            tokenKind['_'] = $sym_type.$prefix$_$suffix$;

            tokenKind['a'] = $sym_type.$prefix$a$suffix$;
            tokenKind['b'] = $sym_type.$prefix$b$suffix$;
            tokenKind['c'] = $sym_type.$prefix$c$suffix$;
            tokenKind['d'] = $sym_type.$prefix$d$suffix$;
            tokenKind['e'] = $sym_type.$prefix$e$suffix$;
            tokenKind['f'] = $sym_type.$prefix$f$suffix$;
            tokenKind['g'] = $sym_type.$prefix$g$suffix$;
            tokenKind['h'] = $sym_type.$prefix$h$suffix$;
            tokenKind['i'] = $sym_type.$prefix$i$suffix$;
            tokenKind['j'] = $sym_type.$prefix$j$suffix$;
            tokenKind['k'] = $sym_type.$prefix$k$suffix$;
            tokenKind['l'] = $sym_type.$prefix$l$suffix$;
            tokenKind['m'] = $sym_type.$prefix$m$suffix$;
            tokenKind['n'] = $sym_type.$prefix$n$suffix$;
            tokenKind['o'] = $sym_type.$prefix$o$suffix$;
            tokenKind['p'] = $sym_type.$prefix$p$suffix$;
            tokenKind['q'] = $sym_type.$prefix$q$suffix$;
            tokenKind['r'] = $sym_type.$prefix$r$suffix$;
            tokenKind['s'] = $sym_type.$prefix$s$suffix$;
            tokenKind['t'] = $sym_type.$prefix$t$suffix$;
            tokenKind['u'] = $sym_type.$prefix$u$suffix$;
            tokenKind['v'] = $sym_type.$prefix$v$suffix$;
            tokenKind['w'] = $sym_type.$prefix$w$suffix$;
            tokenKind['x'] = $sym_type.$prefix$x$suffix$;
            tokenKind['y'] = $sym_type.$prefix$y$suffix$;
            tokenKind['z'] = $sym_type.$prefix$z$suffix$;
        };

        final int getKind(int c)
        {
            return ((c & 0xFFFFFF80) == 0 /* 0 <= c < 128? */ ? tokenKind[c] : 0);
        }
    ./
%End


#
# francy: Interactive Discrete Mathematics in GAP
#

#############################################################################
##
#M  Graph( <graph type> ) .
##
InstallMethod(Graph,
  "a graph type",
  true,
  [IsFrancyGraphType,
   IsFrancyGraphDefaults],
  0,
function(graphType, options)
  return MergeObjects(Objectify(FrancyGraphObjectType, rec(
    id    := GenerateID(),
    nodes := rec(),
    links := rec(),
    type  := graphType!.value,
  )), options);
end);

InstallOtherMethod(Graph,
  "a graph type",
  true,
  [IsFrancyGraphType],
  0,
function(graphType)
  return Graph(graphType, GraphDefaults);
end);

#############################################################################
##
#M  UnsetNodes( <graph> ) . . . . . removes all nodes from graph
##
InstallMethod(UnsetNodes,
  "a graph",
  true,
  [IsFrancyGraph],
  0,
function(graph)
  graph!.nodes := rec();
  return graph;
end);

#############################################################################
##
#M  UnsetNodes( <graph> ) . . . . . removes all nodes from graph
##
InstallMethod(UnsetLinks,
  "a graph",
  true,
  [IsFrancyGraph],
  0,
function(graph)
  graph!.links := rec();
  return graph;
end);

#############################################################################
##
#M  GetShape( <graph>, <string> ) . . . . . gets a node from graph
##
InstallMethod(GetShape,
  "a graph, an id",
  true,
  [IsFrancyGraph,
   IsString],
  0,
function(g, s)
  local shapes;
  shapes := GetShapes(g);
  if IsBound(shapes.(s)) then
    return shapes.(s);
  fi;
  return;
end);

#############################################################################
##
#M  GetShapes( <graph> ) . . . . . gets all nodes from graph
##
InstallMethod(GetShapes,
  "a graph",
  true,
  [IsFrancyGraph],
  0, g -> g!.nodes);

#############################################################################
##
#M  GetLink( <graph>, <string> ) . . . . . gets a link from graph
##
InstallMethod(GetLink,
  "a graph, an id",
  true,
  [IsFrancyGraph,
   IsString],
  0,
function(g, s)
  local links;
  links := GetLinks(g);
  if IsBound(links.(s)) then
    return links.(s);
  fi;
  return;
end);

#############################################################################
##
#M  GetLinks( <graph> ) . . . . . gets all links from graph
##
InstallMethod(GetLinks,
  "a graph",
  true,
  [IsFrancyGraph],
  0, g -> g!.links);

#############################################################################
##
#M  Add( <graph>, <francy object> ) . . . . . add objects to graph
##
InstallOtherMethod(Add,
  "a graph, a link",
  true,
  [IsFrancyGraph,
   IsLink],
  0,
function(graph, link)
  graph!.links!.(link!.id) := link;
  return graph;
end);

InstallOtherMethod(Add,
  "a graph, a shape",
  true,
  [IsFrancyGraph,
   IsShape],
  0,
function(graph, shape)
  graph!.nodes!.(shape!.id) := shape;
  return graph;
end);

InstallOtherMethod(Add,
  "a graph, a list of francy objects",
  true,
  [IsFrancyGraph,
   IsList],
  0,
function(graph, objects)
  local object;
  for object in objects do
    Add(graph, object);
  od;
  return graph;
end);

#############################################################################
##
#M  Remove( <graph>, <francy object> ) . . . . . remove object from graph
##
InstallOtherMethod(Remove,
  "a graph, a shape",
  true,
  [IsFrancyGraph,
   IsShape],
  0,
function(graph, shape)
  local link;
  Unbind(graph!.nodes!.(shape!.id));
  # remove also links to this object
  for link in graph!.links do
    if link!.source!.id = shape!.id or link!.target!.id = shape!.id then
      Unbind(graph!.links!.(link!.id));
    fi;
  od;
  return graph;
end);

InstallOtherMethod(Remove,
  "a graph, a link",
  true,
  [IsFrancyGraph,
   IsLink],
  0,
function(graph, link)
  Unbind(graph!.links!.(link!.id));
  return graph;
end);

InstallOtherMethod(Remove,
  "a graph, a list of francy objects",
  true,
  [IsFrancyGraph,
   IsList],
  0,
function(graph, objects)
  local object;
  for object in objects do
    Remove(graph, object);
  od;
  return graph;
end);

#############################################################################
##
#M  Shape( <shapeType>, <title>, <options> )  . .  create a Shape for a type
##
InstallMethod(Shape,
  "a shape type, a title string, a default configurations record",
  true,
  [IsShapeType,
   IsString,
   IsShapeDefaults],
  0,
function(shapeType, title, options)
  return MergeObjects(Objectify(ShapeObjectType, rec(
    id        := GenerateID(),
    type      := shapeType!.value,
    title     := title,
    callbacks := rec(),
    menus     := rec(),
    messages  := rec(),
    layer     := 0,
    parent    := ""
  )), options);
end);

InstallOtherMethod(Shape,
  "a shape type, a title string",
  true,
  [IsShapeType,
   IsString],
  0,
function(shapeType, title)
  return Shape(shapeType, title, ShapeDefaults);
end);

InstallOtherMethod(Shape,
  "a shape type",
  true,
  [IsShapeType],
  0,
function(shapeType)
  return Shape(shapeType, "", ShapeDefaults);
end);

#############################################################################
##
#M  Add( <graph>, <francy object> ) . . . . . add objects to graph
##
InstallOtherMethod(Add,
  "a shape, a menu",
  true,
  [IsShape,
   IsMenu],
  0,
function(shape, menu)
    shape!.menus!.(menu!.id) := menu;
  return shape;
end);

InstallOtherMethod(Add,
  "a shape, a callback",
  true,
  [IsShape,
   IsCallback],
  0,
function(shape, callback)
  shape!.callbacks!.(callback!.id) := callback;
  return shape;
end);

InstallOtherMethod(Add,
  "a shape, a message",
  true,
  [IsShape,
   IsFrancyMessage],
  0,
function(shape, message)
  shape!.messages!.(message!.id) := message;
  return shape;
end);

InstallOtherMethod(Add,
  "a shape, a list of objects",
  true,
  [IsShape,
   IsList],
  0,
function(shape, objects)
  local object;
  for object in objects do
    Add(shape, object);
  od;
  return shape;
end);

#############################################################################
##
#M  Remove( <graph>, <francy object> ) . . . . . remove object from graph
##
InstallOtherMethod(Remove,
  "a shape, a menu",
  true,
  [IsShape,
   IsMenu],
  0,
function(shape, menu)
  Unbind(shape!.menus!.(menu!.id));
  return shape;
end);

InstallOtherMethod(Remove,
  "a shape, a callback",
  true,
  [IsShape,
   IsCallback],
  0,
function(shape, callback)
  Unbind(shape!.callbacks!.(callback!.id));
  return shape;
end);

InstallOtherMethod(Remove,
  "a shape, a message",
  true,
  [IsShape,
   IsFrancyMessage],
  0,
function(shape, message)
  Unbind(shape!.messages!.(message!.id));
  return shape;
end);

InstallOtherMethod(Remove,
  "a shape, a list of objects",
  true,
  [IsShape,
   IsList],
  0,
function(shape, objects)
  local object;
  for object in objects do
    Remove(shape, object);
  od;
  return shape;
end);

#############################################################################
##
#M  Link( <obj1>, <obj2> )
##
InstallMethod(Link,
  "a shape, another shape, link defaults",
  true,
  [IsShape,
   IsShape,
   IsLinkDefaults],
  0,
function(source, target, options)
  return MergeObjects(Objectify(LinkObjectType, rec(
    id     := GenerateID(),
    source := source!.id,
    target := target!.id
  )), options);
end);

InstallOtherMethod(Link,
  "a shape, another shape",
  true,
  [IsShape,
   IsShape],
  0,
function(source, target)
  return Link(source, target, LinkDefaults);
end);

InstallMethod(Links,
  "a list of shape, a list of shape",
  true,
  [IsList,
   IsList,
   IsLinkDefaults],
  0,
function(source, target, options)
  local list, src, tgt;
  list := [];
  for src in source do
    for tgt in target do
      AddSet(list, Link(src, tgt, options));
    od;
  od;
  return list;
end);

InstallOtherMethod(Links,
  "a list of shape, a list of shape",
  true,
  [IsList,
   IsList],
  0,
function(source, target)
  return Links(source, target, LinkDefaults);
end);


%Terminals
    DollarSign ::= '$'
    _

    a    b    c    d    e    f    g    h    i    j    k    l    m
    n    o    p    q    r    s    t    u    v    w    x    y    z
%End

%Headers
    /.
        //
        // Each upper case letter is mapped into its corresponding
        // lower case counterpart. For example, if an 'A' appears
        // in the input, it is mapped into $sym_type.$prefix$a$suffix$ just
        // like 'a'.
        //
        final static int tokenKind[] = new int[128];
        static
        {
            tokenKind['$'] = $sym_type.$prefix$DollarSign$suffix$;
            tokenKind['_'] = $sym_type.$prefix$_$suffix$;

            tokenKind['a'] = $sym_type.$prefix$a$suffix$;
            tokenKind['b'] = $sym_type.$prefix$b$suffix$;
            tokenKind['c'] = $sym_type.$prefix$c$suffix$;
            tokenKind['d'] = $sym_type.$prefix$d$suffix$;
            tokenKind['e'] = $sym_type.$prefix$e$suffix$;
            tokenKind['f'] = $sym_type.$prefix$f$suffix$;
            tokenKind['g'] = $sym_type.$prefix$g$suffix$;
            tokenKind['h'] = $sym_type.$prefix$h$suffix$;
            tokenKind['i'] = $sym_type.$prefix$i$suffix$;
            tokenKind['j'] = $sym_type.$prefix$j$suffix$;
            tokenKind['k'] = $sym_type.$prefix$k$suffix$;
            tokenKind['l'] = $sym_type.$prefix$l$suffix$;
            tokenKind['m'] = $sym_type.$prefix$m$suffix$;
            tokenKind['n'] = $sym_type.$prefix$n$suffix$;
            tokenKind['o'] = $sym_type.$prefix$o$suffix$;
            tokenKind['p'] = $sym_type.$prefix$p$suffix$;
            tokenKind['q'] = $sym_type.$prefix$q$suffix$;
            tokenKind['r'] = $sym_type.$prefix$r$suffix$;
            tokenKind['s'] = $sym_type.$prefix$s$suffix$;
            tokenKind['t'] = $sym_type.$prefix$t$suffix$;
            tokenKind['u'] = $sym_type.$prefix$u$suffix$;
            tokenKind['v'] = $sym_type.$prefix$v$suffix$;
            tokenKind['w'] = $sym_type.$prefix$w$suffix$;
            tokenKind['x'] = $sym_type.$prefix$x$suffix$;
            tokenKind['y'] = $sym_type.$prefix$y$suffix$;
            tokenKind['z'] = $sym_type.$prefix$z$suffix$;

            tokenKind['A'] = $sym_type.$prefix$a$suffix$;
            tokenKind['B'] = $sym_type.$prefix$b$suffix$;
            tokenKind['C'] = $sym_type.$prefix$c$suffix$;
            tokenKind['D'] = $sym_type.$prefix$d$suffix$;
            tokenKind['E'] = $sym_type.$prefix$e$suffix$;
            tokenKind['F'] = $sym_type.$prefix$f$suffix$;
            tokenKind['G'] = $sym_type.$prefix$g$suffix$;
            tokenKind['H'] = $sym_type.$prefix$h$suffix$;
            tokenKind['I'] = $sym_type.$prefix$i$suffix$;
            tokenKind['J'] = $sym_type.$prefix$j$suffix$;
            tokenKind['K'] = $sym_type.$prefix$k$suffix$;
            tokenKind['L'] = $sym_type.$prefix$l$suffix$;
            tokenKind['M'] = $sym_type.$prefix$m$suffix$;
            tokenKind['N'] = $sym_type.$prefix$n$suffix$;
            tokenKind['O'] = $sym_type.$prefix$o$suffix$;
            tokenKind['P'] = $sym_type.$prefix$p$suffix$;
            tokenKind['Q'] = $sym_type.$prefix$q$suffix$;
            tokenKind['R'] = $sym_type.$prefix$r$suffix$;
            tokenKind['S'] = $sym_type.$prefix$s$suffix$;
            tokenKind['T'] = $sym_type.$prefix$t$suffix$;
            tokenKind['U'] = $sym_type.$prefix$u$suffix$;
            tokenKind['V'] = $sym_type.$prefix$v$suffix$;
            tokenKind['W'] = $sym_type.$prefix$w$suffix$;
            tokenKind['X'] = $sym_type.$prefix$x$suffix$;
            tokenKind['Y'] = $sym_type.$prefix$y$suffix$;
            tokenKind['Z'] = $sym_type.$prefix$z$suffix$;
        };

        final int getKind(char c)
        {
            return (c < 128 ? tokenKind[c] : 0);
        }
    ./
%End