#############################################################################
##
##  Magic.gi                                         AutoDoc package
##
##  Copyright 2013, Max Horn, JLU Giessen
##                  Sebastian Gutsche, University of Kaiserslautern
##
#############################################################################

# Check if a string has the given suffix or not. Another
# name for this would "StringEndsWithOtherString".
# For example, AUTODOC_HasSuffix("file.gi", ".gi") returns
# true while AUTODOC_HasSuffix("file.txt", ".gi") returns false.
BindGlobal( "AUTODOC_HasSuffix",
function(str, suffix)
    local n, m;
    n := Length(str);
    m := Length(suffix);
    return n >= m and str{[n-m+1..n]} = suffix;
end );

# Given a string containing a ".", , return its suffix,
# i.e. the bit after the last ".". For example, given "test.txt",
# it returns "txt".
BindGlobal( "AUTODOC_GetSuffix",
function(str)
    local i;
    i := Length(str);
    while i > 0 and str[i] <> '.' do i := i - 1; od;
    if i < 0 then return ""; fi;
    return str{[i+1..Length(str)]};
end );

# Check whether the given directory exists, and if not, attempt
# to create it.
BindGlobal( "AUTODOC_CreateDirIfMissing",
function(d)
    local tmp;
    if not IsDirectoryPath(d) then
        tmp := CreateDir(d); # Note: CreateDir is currently undocumented
        if tmp = fail then
            Error("Cannot create directory ", d, "\n",
                  "Error message: ", LastSystemError().message, "\n");
            return false;
        fi;
    fi;
    return true;
end );

# Scan the given (by name) subdirs of a package dir for
# files with one of the given extensions, and return the corresponding
# filenames, as relative paths (relative to the package dir).
#
# For example, the invocation
#   AUTODOC_FindMatchingFiles("AutoDoc", [ "gap/" ], [ "gi", "gd" ]);
# might return a list looking like
#  [ "gap/AutoDocMainFunction.gd", "gap/AutoDocMainFunction.gi", ... ]
BindGlobal( "AUTODOC_FindMatchingFiles",
function (pkg, subdirs, extensions)
    local d_rel, d, tmp, files, result;

    result := [];

    for d_rel in subdirs do
        # Get the absolute path to the directory in side the package...
        d := DirectoriesPackageLibrary( pkg, d_rel );
        if IsEmpty( d ) then
            continue;
        fi;
        d := d[1];
        # ... but also keep the relative path (such as "gap")
        d_rel := Directory( d_rel );

        files := DirectoryContents( d );
        Sort( files );
        for tmp in files do
            if not AUTODOC_GetSuffix( tmp ) in [ "g", "gi", "gd", "autodoc" ] then
                continue;
            fi;
            if not IsReadableFile( Filename( d, tmp ) ) then
                continue;
            fi;
            Add( result, Filename( d_rel, tmp ) );
        od;
    od;
    return result;
end );

# AutoDoc(pkg[, opt])
#
## Make this function callable with the package_name AutoDocWorksheet.
## Which will then create a worksheet!
InstallGlobalFunction( AutoDoc,
function( arg )
    local pkg, package_info, opt, scaffold, gapdoc, maketest,
          autodoc, pkg_dir, doc_dir, doc_dir_rel, d, tmp,
          title_page, tree, is_worksheet, position_document_class, i, gapdoc_latex_option_record;

    pkg := arg[1];

    if LowercaseString( pkg ) = "autodocworksheet" then
        is_worksheet := true;
        package_info := rec( );
        pkg_dir := DirectoryCurrent( );
    else
        is_worksheet := false;
        package_info := PackageInfo( pkg )[ 1 ];
        pkg_dir := DirectoriesPackageLibrary( pkg, "" )[1];
    fi;

    if Length(arg) >= 2 then
        opt := arg[2];
    else
        opt := rec();
    fi;

    # Check for certain user supplied options, and if present, add them
    # to the opt record.
    tmp := function( key )
        local val;
        val := ValueOption( key );
        if val <> fail then
            opt.(key) := val;
        fi;
    end;

    tmp( "dir" );
    tmp( "scaffold" );
    tmp( "autodoc" );
    tmp( "gapdoc" );
    tmp( "maketest" );

    #
    # Setup the output directory
    #
    if not IsBound( opt.dir ) then
        doc_dir := "doc";
    elif IsString( opt.dir ) or IsDirectory( opt.dir ) then
        doc_dir := opt.dir;
    else
        Error( "opt.dir must be a string containing a path, or a directory object" );
    fi;

    if IsString( doc_dir ) then
        # Record the relative version of the path
        doc_dir_rel := Directory( doc_dir );

        # We intentionally do not use
        #   DirectoriesPackageLibrary( pkg, "doc" )
        # because it returns an empty list if the subdirectory is missing.
        # But we want to handle that case by creating the directory.
        doc_dir := Filename(pkg_dir, doc_dir);
        doc_dir := Directory(doc_dir);

    else
        # TODO: doc_dir_rel = ... ?
    fi;

    # Ensure the output directory exists, create it if necessary
    AUTODOC_CreateDirIfMissing(Filename(doc_dir, ""));

    # Let the developer know where we are generating the documentation.
    # This helps diagnose problems where multiple instances of a package
    # are visible to GAP and the wrong one is used for generating the
    # documentation.
    # TODO: Using Info() instead of Print?
    Print( "Generating documentation in ", doc_dir, "\n" );

    #
    # Extract scaffolding settings, which can be controlled via
    # opt.scaffold or package_info.AutoDoc. The former has precedence.
    #
    if not IsBound(opt.scaffold) then
        # Default: enable scaffolding if and only if package_info.AutoDoc is present
        if IsBound( package_info.AutoDoc ) then
            scaffold := rec( );
        fi;
    elif IsRecord(opt.scaffold) then
        scaffold := opt.scaffold;
    elif IsBool(opt.scaffold) then
        if opt.scaffold = true then
            scaffold := rec();
        fi;
    else
        Error("opt.scaffold must be a bool or a record");
    fi;

    # Merge package_info.AutoDoc into scaffold
    if IsBound(scaffold) and IsBound( package_info.AutoDoc ) then
        AUTODOC_APPEND_RECORD_WRITEONCE( scaffold, package_info.AutoDoc );
    fi;

    if IsBound( scaffold ) then
        AUTODOC_WriteOnce( scaffold, "TitlePage", true );
        AUTODOC_WriteOnce( scaffold, "MainPage", true );
    fi;

    #
    # Extract AutoDoc settings
    #
    if not IsBound(opt.autodoc) and not is_worksheet then
        # Enable AutoDoc support if the package depends on AutoDoc.
        tmp := Concatenation( package_info.Dependencies.NeededOtherPackages,
                              package_info.Dependencies.SuggestedOtherPackages );
        if ForAny( tmp, x -> LowercaseString(x[1]) = "autodoc" ) then
            autodoc := rec();
        fi;
    elif IsRecord(opt.autodoc) then
        autodoc := opt.autodoc;
    elif IsBool(opt.autodoc) and opt.autodoc = true then
        autodoc := rec();
    fi;

    if IsBound(autodoc) then
        if not IsBound( autodoc.files ) then
            autodoc.files := [ ];
        fi;

        if not IsBound( autodoc.scan_dirs ) and not is_worksheet then
            autodoc.scan_dirs := [ "gap", "lib", "examples", "examples/doc" ];
        elif not IsBound( autodoc.scan_dirs ) and is_worksheet then
            autodoc.scan_dirs := [ ];
        fi;

        if not IsBound( autodoc.level ) then
            autodoc.level := 0;
        fi;

        PushOptions( rec( level_value := autodoc.level ) );

        if not is_worksheet then
            Append( autodoc.files, AUTODOC_FindMatchingFiles(pkg, autodoc.scan_dirs, [ "g", "gi", "gd" ]) );
        fi;
    fi;

    #
    # Extract GAPDoc settings
    #
    if not IsBound( opt.gapdoc ) then
        # Enable GAPDoc support by default
        gapdoc := rec();
    elif IsRecord( opt.gapdoc ) then
        gapdoc := opt.gapdoc;
    elif IsBool( opt.gapdoc ) and opt.gapdoc = true then
        gapdoc := rec();
    fi;

    #
    # Extract test settings
    #

    if IsBound( opt.maketest ) then
        if IsRecord( opt.maketest ) then
            maketest := opt.maketest;
        elif opt.maketest = true then
            maketest := rec( );
        fi;
    fi;

    if IsBound( gapdoc ) then

        if not IsBound( gapdoc.main ) then
            gapdoc.main := pkg;
        fi;

        # FIXME: the following may break if a package uses more than one book
        if IsBound( package_info.PackageDoc ) and IsBound( package_info.PackageDoc[1].BookName ) then
            gapdoc.bookname := package_info.PackageDoc[1].BookName;
        elif not is_worksheet then
            # Default: book name = package name
            gapdoc.bookname := pkg;

            Print("\n");
            Print("WARNING: PackageInfo.g is missing a PackageDoc entry!\n");
            Print("Without this, your package manual will not be recognized by the GAP help system.\n");
            Print("You can correct this by adding the following to your PackageInfo.g:\n");
            Print("PackageDoc := rec(\n");
            Print("  BookName  := ~.PackageName,\n");
            #Print("  BookName  := \"", pkg, "\",\n");
            Print("  ArchiveURLSubset := [\"doc\"],\n");
            Print("  HTMLStart := \"doc/chap0.html\",\n");
            Print("  PDFFile   := \"doc/manual.pdf\",\n");
            Print("  SixFile   := \"doc/manual.six\",\n");
            Print("  LongTitle := ~.Subtitle,\n");
            Print("),\n");
            Print("\n");
        fi;

        if not IsBound( gapdoc.files ) then
            gapdoc.files := [];
        fi;

        if not IsBound( gapdoc.scan_dirs ) and not is_worksheet then
            gapdoc.scan_dirs := [ "gap", "lib", "examples", "examples/doc" ];
        fi;

        if not is_worksheet then
            Append( gapdoc.files, AUTODOC_FindMatchingFiles(pkg, gapdoc.scan_dirs, [ "g", "gi", "gd" ]) );
        fi;

        # Attempt to weed out duplicates as they may confuse GAPDoc (this
        # won't work if there are any non-normalized paths in the list).
        gapdoc.files := Set( gapdoc.files );

        # Convert the file paths in gapdoc.files, which are relative to
        # the package directory, to paths which are relative to the doc directory.
        # For this, we assume that doc_dir_rel is normalized (e.g.
        # it does not contains '//') and relative.
        d := Number( Filename( doc_dir_rel, "" ), x -> x = '/' );
        d := Concatenation( ListWithIdenticalEntries(d, "../") );
        gapdoc.files := List( gapdoc.files, f -> Concatenation( d, f ) );
    fi;

    # read tree
    # FIXME: shouldn't tree be declared inside of an 'if IsBound(autodoc)' section?
    tree := DocumentationTree( );

    if IsBound( autodoc ) then
        if IsBound( autodoc.section_intros ) then
            AUTODOC_PROCESS_INTRO_STRINGS( autodoc.section_intros : Tree := tree );
        fi;

        AutoDocScanFiles( autodoc.files : PackageName := pkg, Tree := tree );
    fi;

    if is_worksheet then
        # FIXME: We use scaffold and autodoc here without checking whether
        # they are bound. Does that mean worksheets always use them?
        if IsRecord( scaffold.TitlePage ) and IsBound( scaffold.TitlePage.Title ) then
            pkg := scaffold.TitlePage.Title;

        elif IsBound( tree!.TitlePage.Title ) then
            pkg := tree!.TitlePage.Title;

        elif IsBound( autodoc.files ) and Length( autodoc.files ) > 0  then
            pkg := autodoc.files[ 1 ];

            while Position( pkg, '/' ) <> fail do
                Remove( pkg, 1 );
            od;

            while Position( pkg, '.' ) <> fail do
                Remove( pkg, Length( pkg ) );
            od;

        else
            Error( "could not figure out a title." );
        fi;

        if not IsString( pkg ) then
            pkg := JoinStringsWithSeparator( pkg, " " );
        fi;

        gapdoc.main := ReplacedString( pkg, " ", "_" );
        gapdoc.bookname := ReplacedString( pkg, " ", "_" );
    fi;

    #
    # Generate scaffold
    #
    gapdoc_latex_option_record := rec( );

    if IsBound( scaffold ) then
        ## Syntax is [ "class", [ "options" ] ]
        if IsBound( scaffold.document_class ) then
            position_document_class := PositionSublist( GAPDoc2LaTeXProcs.Head, "documentclass" );

            if IsString( scaffold.document_class ) then
                scaffold.document_class := [ scaffold.document_class ];
            fi;

            if position_document_class = fail then
                Error( "something is wrong with the LaTeX header" );
            fi;

            GAPDoc2LaTeXProcs.Head := Concatenation(
                  GAPDoc2LaTeXProcs.Head{[ 1 .. PositionSublist( GAPDoc2LaTeXProcs.Head, "{", position_document_class ) ]},
                  scaffold.document_class[ 1 ],
                  GAPDoc2LaTeXProcs.Head{[ PositionSublist( GAPDoc2LaTeXProcs.Head, "}", position_document_class ) .. Length( GAPDoc2LaTeXProcs.Head ) ]} );

            if Length( scaffold.document_class ) = 2 then

                GAPDoc2LaTeXProcs.Head := Concatenation(
                      GAPDoc2LaTeXProcs.Head{[ 1 .. PositionSublist( GAPDoc2LaTeXProcs.Head, "[", position_document_class ) ]},
                      scaffold.document_class[ 2 ],
                      GAPDoc2LaTeXProcs.Head{[ PositionSublist( GAPDoc2LaTeXProcs.Head, "]", position_document_class ) .. Length( GAPDoc2LaTeXProcs.Head ) ]} );
            fi;
        fi;

        if IsBound( scaffold.latex_header_file ) then
            GAPDoc2LaTeXProcs.Head := StringFile( scaffold.latex_header_file );
        fi;

        if IsBound( scaffold.gapdoc_latex_options ) then
            if IsRecord( scaffold.gapdoc_latex_options ) then
                for i in RecNames( scaffold.gapdoc_latex_options ) do
                    if not IsString( scaffold.gapdoc_latex_options.( i ) )
                       and IsList( scaffold.gapdoc_latex_options.( i ) )
                       and LowercaseString( scaffold.gapdoc_latex_options.( i )[ 1 ] ) = "file" then
                        scaffold.gapdoc_latex_options.( i ) := StringFile( scaffold.gapdoc_latex_options.( i )[ 2 ] );
                    fi;
                od;

                gapdoc_latex_option_record := scaffold.gapdoc_latex_options;
            fi;
        fi;

        if not IsBound( scaffold.includes ) then
            scaffold.includes := [ ];
        fi;

        if IsBound( autodoc ) then
            # If scaffold.includes is already set, then we add
            # AutoDocMainFile.xml to it, but *only* if it not already
            # there. This way, package authors can control where
            # it is put in their includes list.
            if not "AutoDocMainFile.xml" in scaffold.includes then
                Add( scaffold.includes, "AutoDocMainFile.xml" );
            fi;
        fi;

        if IsBound( scaffold.bib ) and IsBool( scaffold.bib ) then
            if scaffold.bib = true then
                scaffold.bib := Concatenation( pkg, ".bib" );
            else
                Unbind( scaffold.bib );
            fi;
        elif not IsBound( scaffold.bib ) then
            # If there is a doc/PKG.bib file, assume that we want to reference it in the scaffold.
            if IsReadableFile( Filename( doc_dir, Concatenation( pkg, ".bib" ) ) ) then
                scaffold.bib := Concatenation( pkg, ".bib" );
            fi;
        fi;

        AUTODOC_WriteOnce( scaffold, "index", true );

        if IsBound( gapdoc ) then
            if AUTODOC_GetSuffix( gapdoc.main ) = "xml" then
                scaffold.main_xml_file := gapdoc.main;
            else
                scaffold.main_xml_file := Concatenation( gapdoc.main, ".xml" );
            fi;
        fi;

        # TODO: It should be possible to only rebuild the title page. (Perhaps also only the main page? but this is less important)
        if IsBound( scaffold.TitlePage ) then
            if IsRecord( scaffold.TitlePage ) then
                title_page := scaffold.TitlePage;
            else
                title_page := rec( );
            fi;

            AUTODOC_WriteOnce( title_page, "dir", doc_dir );
            AUTODOC_APPEND_RECORD_WRITEONCE( title_page, tree!.TitlePage );

            if not is_worksheet then
                AUTODOC_APPEND_RECORD_WRITEONCE( title_page, ExtractTitleInfoFromPackageInfo( pkg ) );
            fi;

            CreateTitlePage( title_page );
        fi;

        if IsBound( scaffold.MainPage ) and scaffold.MainPage <> false then
            scaffold.dir := doc_dir;
            scaffold.book_name := pkg;
            CreateMainPage( scaffold );
        fi;
    fi;

    #
    # Run AutoDoc
    #
    if IsBound( autodoc ) then
        WriteDocumentation( tree, doc_dir );
    fi;

    #
    # Run GAPDoc
    #
    if IsBound( gapdoc ) then

        # Ask GAPDoc to use UTF-8 as input encoding for LaTeX, as the XML files
        # of the documentation are also in UTF-8 encoding, and may contain characters
        # not contained in the default Latin 1 encoding.
        SetGapDocLaTeXOptions( "utf8", gapdoc_latex_option_record );

        MakeGAPDocDoc( doc_dir, gapdoc.main, gapdoc.files, gapdoc.bookname, "MathJax" );

        CopyHTMLStyleFiles( Filename( doc_dir, "" ) );

        # The following (undocumented) API is there for compatibility
        # with old-style gapmacro.tex based package manuals. It
        # produces a manual.lab file which those packages can use if
        # they wish to link to things in the manual we are currently
        # generating. This can probably be removed eventually, but for
        # now, doing it does not hurt.

        # FIXME: It seems that this command does not work if pdflatex
        #        is not present. Maybe we should remove it.

        if not is_worksheet then
            GAPDocManualLab( pkg );
        fi;

    fi;

    if IsBound( maketest ) then

        AUTODOC_WriteOnce( maketest, "filename", "maketest.g" );
        AUTODOC_WriteOnce( maketest, "folder", pkg_dir );
        AUTODOC_WriteOnce( maketest, "scan_dir", doc_dir );
        AUTODOC_WriteOnce( maketest, "files_to_scan", gapdoc.files );

        if IsString( maketest.folder ) then
            maketest.folder := Directory( maketest.folder );
        fi;

        if IsString( maketest.scan_dir ) then
            maketest.scan_dir := Directory( maketest.scan_dir );
        fi;

        AUTODOC_WriteOnce( maketest, "commands", [ ] );
        AUTODOC_WriteOnce( maketest, "book_name", gapdoc.main );

        CreateMakeTest( maketest );
    fi;

    return true;
end );


#
# Directory of where my stuff is
#
home_dir:=Directory("~/Workspace/Chevalley.gap/");
lib_dir:=Directory("~/Workspace/Chevalley.gap/lib");
test_dir:=Directory("~/Workspace/Chevalley.gap/test");
data_dir:=Directory("~/Workspace/Chevalley.gap/lib/data");
g2_dir:=Directory("~/Workspace/Chevalley.gap/lib/cases/g2");
g2_dir_char2:=Directory("~/Workspace/Chevalley.gap/lib/cases/g2/char2");
g2_dir_char3:=Directory("~/Workspace/Chevalley.gap/lib/cases/g2/char3");
f4_dir:=Directory("~/Workspace/Chevalley.gap/lib/cases/f4");
f4_dir_char2:=Directory("~/Workspace/Chevalley.gap/lib/cases/f4/char2");
f4_dir_char3:=Directory("~/Workspace/Chevalley.gap/lib/cases/f4/char3");
e6_dir:=Directory("~/Workspace/Chevalley.gap/lib/cases/e6");
e6_dir_char2:=Directory("~/Workspace/Chevalley.gap/lib/cases/e6/char2");
e6_dir_char3:=Directory("~/Workspace/Chevalley.gap/lib/cases/e6/char3");
e7_dir:=Directory("~/Workspace/Chevalley.gap/lib/cases/e7");
e7_dir_char2:=Directory("~/Workspace/Chevalley.gap/lib/cases/e7/char2");
e7_dir_char3:=Directory("~/Workspace/Chevalley.gap/lib/cases/e7/char3");
e8_dir:=Directory("~/Workspace/Chevalley.gap/lib/cases/e8");
e8_dir_char2:=Directory("~/Workspace/Chevalley.gap/lib/cases/e8/char2");
e8_dir_char3:=Directory("~/Workspace/Chevalley.gap/lib/cases/e8/char3");
e8_dir_char5:=Directory("~/Workspace/Chevalley.gap/lib/cases/e8/char5");
components_dir:=Directory("~/Workspace/Chevalley.gap/lib/components");
#
# Read("~/Workspace/Chevalley.gap/init.gap"); Read(Filename(home_dir,"load.gap"));
#


--
-- An instance of this template must have a %Export section and the export_terminals option
--
-- Macros that may be redefined in an instance of this template
--
--     $eof_token
--     $additional_interfaces
--     $super_stream_class -- subclass LpgLexStream for getKind
--     $prs_stream_class -- use /.PrsStream./ if not subclassing
--     $super_class
--
-- B E G I N N I N G   O F   T E M P L A T E   LexerTemplateF
--
%Options programming_Language=typescript,margin=4
%Options table
%options action-block=("*.ts", "/.", "./")
%options ParseTable=ParseTable
%Options prefix=Char_

--
-- This template requires that the name of the EOF token be set
-- to EOF and that the prefix be "Char_" to be consistent with
-- KeywordTemplateD.
--
%Eof
    EOF
%End

--
-- This template also requires that the name of the parser EOF
-- Token to be exported be set to EOF_TOKEN
--
%Export
    EOF_TOKEN
%End

%Define
    --
    -- Macros that are be needed in an instance of this template
    --
    $eof_token /.%_EOF_TOKEN./

    $additional_interfaces /../
    $super_stream_class /.%file_prefix%LpgLexStream./
    $prs_stream_class /.IPrsStream./
    $super_class /.Object./

    $prs_stream /. // macro prs_stream is deprecated. Use function getPrsStream
                  this.getPrsStream()./
    $setSym1 /. // macro setSym1 is deprecated. Use function setResult
                this.this.lexParser.setSym1./
    $setResult /. // macro setResult is deprecated. Use function setResult
                  this.this.lexParser.setSym1./
    $getSym /. // macro getSym is deprecated. Use function getLastToken
               this.this.lexParser.getSym./
    $getToken /. // macro getToken is deprecated. Use function getToken
                 this.this.lexParser.getToken./
    $getLeftSpan /. // macro getLeftSpan is deprecated. Use function getLeftSpan
                    this.this.lexParser.getFirstToken./
    $getRightSpan /. // macro getRightSpan is deprecated. Use function getRightSpan
                     this.this.lexParser.getLastToken./

    --
    -- Macros useful for specifying actions
    --
    $Header
    /.
                //
                // Rule %rule_number:  %rule_text
                //
                ./

    $DefaultAction
    /.%Header%case %rule_number: { ./

    $BeginAction /.%DefaultAction./

    $EndAction
    /.            break;
                }./

    $BeginJava
    /.%BeginAction
                %symbol_declarations./

    $EndJava /.%EndAction./

    $NoAction
    /.%Header%case %rule_number:
                    break; ./

    $BeginActions
    /.
        public  ruleAction(ruleNumber : number ) : void
        {
            switch(ruleNumber)
            {./

    $SplitActions
    /.
                    default:
                        this.ruleAction%rule_number(ruleNumber);
                        break;
                }
                return;
            }

            public  ruleAction%rule_number(ruleNumber : number ) : void
            {
                switch (ruleNumber)
                {./

    $EndActions
    /.
                default:
                    break;
            }
            return;
        }./
%End

%Globals
    /.
  import { RuleAction, ParseTable, LexParser, ILexStream, IPrsStream, Monitor,LpgLexStream} from "lpg2ts";
  import { %prs_type } from ".\/%prs_type";
  import { %sym_type } from ".\/%sym_type";
  import { %kw_lexer_class } from ".\/%kw_lexer_class";
    ./
%End

%Headers
    /.
    export class %action_type extends %super_class implements RuleAction%additional_interfaces
    {
        private lexStream: %super_stream_class ;

        private static  prs : ParseTable = new %prs_type();
        public  getParseTable() : ParseTable{ return %action_type.prs; }

        private  lexParser  : LexParser= new LexParser();
        public  getParser()  : LexParser{ return this.lexParser; }

        public  getToken(i : number)  : number{ return this.lexParser.getToken(i); }
        public  getRhsFirstTokenIndex(i : number) : number{ return this.lexParser.getFirstToken(i); }
        public  getRhsLastTokenIndex(i : number)  : number{ return this.lexParser.getLastToken(i); }

        public getLeftSpan() : number{ return this.lexParser.getToken(1); }
        public getRightSpan() : number { return this.lexParser.getLastToken(); }

        public  resetKeywordLexer() : void
        {
            if (!this.kwLexer)
                  this.kwLexer = new %kw_lexer_class(this.lexStream.getInputChars(), %_IDENTIFIER);
             this.kwLexer.setInputChars(this.lexStream.getInputChars());
        }

        public  reset( filename : string,  tab : number = 4, input_chars? : string) : void
        {
            this.lexStream = new %super_stream_class(filename,input_chars, tab);
            this.lexParser.reset(<ILexStream>  this.lexStream, %action_type.prs, <RuleAction> this);
            this.resetKeywordLexer();
        }

        constructor( filename : string,  tab : number =  4 ,input_chars? : string)
        {
            super();
            this.lexStream = new %super_stream_class(filename,input_chars, tab);
            this.lexParser.reset(<ILexStream>  this.lexStream, %action_type.prs, <RuleAction> this);
            this.resetKeywordLexer();
        }

        public  getILexStream()  : ILexStream{ return  this.lexStream; }

        /**
         * @deprecated replaced by {@link #getILexStream()}
         */
        public  getLexStream()  : ILexStream{ return  this.lexStream; }

        private initializeLexer(prsStream : %prs_stream_class ,  start_offset : number, end_offset : number) : void
        {
            if (this.lexStream.getInputChars() == null)
                throw new ReferenceError("LexStream was not initialized");
            this.lexStream.setPrsStream(prsStream);
            prsStream.makeToken(start_offset, end_offset, 0); // Token list must start with a bad token
        }

        private  addEOF(prsStream : %prs_stream_class, end_offset : number ) : void
        {
            prsStream.makeToken(end_offset, end_offset, %eof_token); // and end with the end of file token
            prsStream.setStreamLength(prsStream.getSize());
        }

        public  lexerWithPosition(prsStream: %prs_stream_class , start_offset : number , end_offset : number, monitor? : Monitor) : void
        {
            if (start_offset <= 1)
                 this.initializeLexer(prsStream, 0, -1);
            else this.initializeLexer(prsStream, start_offset - 1, start_offset - 1);

            this.lexParser.parseCharacters(start_offset, end_offset,monitor);

            this.addEOF(prsStream, (end_offset >= this.lexStream.getStreamIndex() ? this.lexStream.getStreamIndex() : end_offset + 1));
        }

        public  lexer(prsStream: %prs_stream_class ,  monitor? : Monitor) : void
        {

            this.initializeLexer(prsStream, 0, -1);
            this.lexParser.parseCharactersWhitMonitor(monitor);
            this.addEOF(prsStream, this.lexStream.getStreamIndex());
        }

        /**
         * If a parse stream was not passed to this Lexical analyser then we
         * simply report a lexical error. Otherwise, we produce a bad token.
         */
        public  reportLexicalError( startLoc : number,  endLoc : number) : void {
            let prs_stream = this.lexStream.getIPrsStream();
            if (!prs_stream)
                this.lexStream.reportLexicalError(startLoc, endLoc);
            else {
                //
                // Remove any token that may have been processed that fall in the
                // range of the lexical error... then add one error token that spans
                // the error range.
                //
                for (let i : number = prs_stream.getSize() - 1; i > 0; i--) {
                    if (prs_stream.getStartOffset(i) >= startLoc)
                         prs_stream.removeLastToken();
                    else break;
                }
                prs_stream.makeToken(startLoc, endLoc, 0); // add an error token to the this.prsStream
            }
        }
    ./
%End

%Rules
    /.%BeginActions./
%End

%Trailers
    /.
        %EndActions
    }
    ./
%End

--
-- E N D   O F   T E M P L A T E
--


package main

import (
	"fmt"
)

type Bowser interface {
	Hi()
}

type Possum interface {
	Hi()
    Pebbles()
}

type Unsat interface {
	Hi()
    Pebbles()
    MissMe()
}

type B struct{}

func (b *B) Hi() {
	fmt.Printf("B.Hi called\n")
}
func (b *B) Pebbles() {}

    chk := 0
	var v Bowser = &B{}
	switch v.(type) {
    case Possum:
		fmt.Printf("ooh! it types as a Possum!\n")
        chk = 2
	case Bowser:
		fmt.Printf("yabadadoo! it types as a Bowser!\n")
        chk = 1
	}
    fmt.Printf("chk = '%v'\n", chk)

    // and verify that v implements Bowser too:
    asBowser, isBowser := v.(Bowser)
    asIsNil := (asBowser == nil)

    // negative check, should not convert:
    asUn, isUn := v.(Unsat)
    asUnNil := (asUn == nil)


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

rSetChildFields := arg -> Checked(IsList(arg),
	Subst(
		meth(self, n, newChild)
			if not n in [1..numfields] then
				Error("<n> must be in ", [1..numfields]);
			else
				self.(RecName(fields[n])) := newChild;
			fi;
		end,
		numfields => Length(arg),
		fields => arg)
);

rSetChildFieldsCh := arg -> Checked(IsList(arg),
	Subst(
		meth(self, n, newChild)
			if not n in [1..chCount+numfields] then
				Error("<n> must be in ", [1..chCount+numfields]);
			elif n in [1..chCount] then
				self._children[n] := newChild;
			else
				self.(RecName(fields[n-chCount])) := newChild;
			fi;
		end,
		numfields => Length(arg)-1,
		chCount => arg[1],
		fields => Drop(arg, 1))
);

#  rChildrenFieldsCh: gives rChildren method where rChildren is self.children() :: [self.field1, self.field2, ... ],
#  arg[1] is "field1", arg[2] is "field2" etc.
#  ex: rChildren := rChildrenFieldsCh("stride", "v")
#
rChildrenFieldsCh := arg -> Checked(IsList(arg),
	Subst( (self) >> self._children :: List([1..numfields], i -> self.(RecName(fields[i]))),
		numfields => Length(arg),
		fields => arg )
);

rSetChildFieldsF := arg -> Checked(IsList(arg), Length(arg)>1,
	Subst(
		meth(self, n, newChild)
			if not n in [1..numfields] then
				Error("<n> must be in ", [1..numfields]);
			else
				self.(RecName(fields[n])) := func(newChild);
			fi;
		end,
		numfields => Length(arg)-1,
		fields => Drop(arg, 1),
		func => arg[1])
);

Local._print := function(arg)
	local a;
	for a in arg do
		if IsRec(a) and IsBound(a.__bases__) then
			Print(a.__bases__[1]);
		else
			Print(a);
		fi;
	od;
end;

Local._children := function(obj)
	if IsRec(obj) then
		if not IsBound(obj.rChildren) then
			return [];
		else
			return obj.rChildren();
		fi;
	elif BagType(obj) in [T_STRING, T_RANGE] then
		return [];
	elif IsList(obj) then
		return obj;
	else
		return [];
	fi;
end;

Local._setChild := function(obj, n, newchild)
	if IsRec(obj) then
		if not IsBound(obj.rSetChild) then
			Error("<obj> must have rSetChild(<n>, <newChild>) method");
		fi;
		obj.rSetChild(n, newchild);
	elif IsList(obj) then
		obj[n] := newchild;
	else
		Error("<obj> must be a record or a list");
	fi;
end;

Local._fromChildren := function(obj, newchildren)
	if IsRec(obj) then
		if not IsBound(obj.from_rChildren) then
			Error("<obj> must have from_rChildren(<newChildren>) method");
		fi;
		return obj.from_rChildren(newchildren);
	elif BagType(obj) in [T_STRING, T_RANGE] then
		return  obj;
	elif IsList(obj) then
		return newchildren;
	elif newchildren=[] then
		return obj;
	else
		return Error("<obj> must be a record or a list");
	fi;
end;

_PrintShape := function(obj, maxDepth, printCutoff, info, i, is)
	if maxDepth > 0 then
		Print(Blanks(i));
		_print(obj, " ", info(obj), "\n");
		DoForAll(_children(obj), c -> _PrintShape(c, maxDepth-1, printCutoff, info, i+is, is));
	elif printCutoff then
		Print(Blanks(i));
		Print("...\n");
	fi;
end;

PrintShape := (obj, maxDepth) -> Checked(IsInt(maxDepth) and maxDepth >= 0,
	_PrintShape(obj, maxDepth, true, x->"", 0, 4));

# info is a function : obj -> what to print
PrintShapeInfo := (obj, maxDepth, info) -> Checked(IsInt(maxDepth) and maxDepth >= 0,
	_PrintShape(obj, maxDepth, true, info, 0, 4));

PrintShape2 := (obj, maxDepth) -> Checked(IsInt(maxDepth) and maxDepth >= 0,
	_PrintShape(obj, maxDepth, false, x->"", 0, 4));

Local.id := ObjId; # ObjId now handles lists

#F ShapeObject(<obj>)
#F   Convert an object to a list-based pattern,
#F   i.e. add(X, Y) becomes [add, var, var]
#F
ShapeObject := obj -> Cond(
	BagType(obj) in [T_STRING,T_RANGE], obj,
	IsRec(obj) or IsList(obj), let(
		res := Concatenation([ObjId(obj)], List(_children(obj), ShapeObject)),
		When(Length(res)=1, res[1], res)),
	obj
);

#F ShapeObject@(<obj>, <func>)
#F
#F Same as ShapeObject(obj) but takes a boolean function <func>, and objects
#F for which <func> returns true are replaced by @.
#F
ShapeObject@ := (obj, func_replace_by_wildcard) -> Cond(
	BagType(obj) in [T_STRING,T_RANGE], obj,
	func_replace_by_wildcard(obj), @,
	IsRec(obj) or IsList(obj), let(
		res := Concatenation([ObjId(obj)], List(_children(obj), x -> ShapeObject@(x, func_replace_by_wildcard))),
		When(Length(res)=1, res[1], res)),
	obj
);

Class(..., rec(
	left := false,
	right := false
));

Left := z -> z.left;
Right := z -> z.right;

# @ : basic pattern object
# .parent is the pointer to the unique object in @.table
# That table does not store any precondition functions
#
Class(@, rec(
	is@ := true,

	table := WeakRef(tab()),

	__call__ := meth(arg)
		local res, self, num, target, precond;
		if Length(arg) < 2 or Length(arg) > 4 then
			Error("Usage: @(<num>, [<target>], [<cond>])");
		fi;

		self := arg[1];
		num := arg[2];
		if Length(arg) >= 3 then
			target := arg[3];
		fi;
		if Length(arg) = 4 then
			precond := arg[4];
		fi;

		if not IsBound(self.table.(num)) then
			res := self.new(num);
			self.table.(num) := res;
			if IsBound(target) then
				res := res.target(target);
			fi;
			if IsBound(precond) then
				res := res.cond(precond);
			fi;
			return res;
		else
			res := self.table.(num);
			Unbind(res._target);
			Unbind(res._precond);
			if IsBound(target) then
				res := res.target(target);
			fi;
			if IsBound(precond) then
				res := res.cond(precond);
			fi;
			return res;
		fi;
	end,

	new := (self, num) >> CantCopy(
		WithBases(self, rec(num := num, operations := PrintOps))),

	match := meth(self, obj, cx)
		if (not IsBound(self._target) or ObjId(obj) in self._target) and
		   (not IsBound(self._precond) or self._precond(obj))
		then
			if IsBound(self.parent) then
				self.parent.val := obj;
			else
				self.val := obj;
			fi;
			return true;
		else
			return false;
		fi;
	end,

	cond := (self, precond_func) >> Checked(IsCallableN(precond_func, 1), CantCopy(
		WithBases(self, rec(_precond := precond_func,
							 parent := When(IsBound(self.parent), self.parent, self))))),

	target := (self, target_id) >> CantCopy(
		WithBases(self, rec(#_taddr  := When(IsList(target_id), List(target_id,BagAddr), [BagAddr(target_id)]),
							_target := When(IsList(target_id), target_id,			   [target_id]),
							parent := When(IsBound(self.parent), self.parent, self)))),

	val := false,

	print := self >> Print("@(", self.num, ")",
						   When(IsBound(self._target),
								Print(".target(", self._target, ")"),
								""),
						   When(IsBound(self._precond),
								Print(".cond(", self._precond, ")"),
								"")),

	clear := meth(self)
		local e, l;
		l := TabToList(self.table);
		for e in l do
			if IsRec(e) and IsBound(e.val) then
				e.val := false;
			fi;
		od;
		if IsBound(self.val) then
			self.val := false;
		fi;
	end
));

# @@ : basic pattern object for context sensitive matching
# @@ has its own table.
# It still uses a .parent to point into @@.table where matches are stored
# That table does not store any precondition functions.
# Both lhs and rhs of rewrite rules must use either @ or @@. Otherwise wrong
# table will be used.

Class(@@, @, rec(
	table := WeakRef(tab()),

	match := meth(self, obj, cx)
		local base_match;
		base_match := @.match;
		if not IsBound(self._cxcond) then
			return base_match(self, obj, cx);
		else
			return base_match(self, obj, cx) and self._cxcond(obj, cx);
		fi;
	end,

	cond := (self, cxcond_func) >> CantCopy(Checked(IsCallableN(cxcond_func, 2),
		WithBases(self, rec(_cxcond := cxcond_func,
							 parent := When(IsBound(self.parent), self.parent, self))))),

	print := self >> Print("@@(", self.num, ")",
						   When(IsBound(self._target),
								Print(".target(", self._target, ")"),
								""),
						   When(IsBound(self._cxcond),
								Print(".cond(", self._cxcond, ")"),
								""))
));

Is@ := x -> IsRec(x) and IsBound(x.is@) and x.is@;

Local._midmatch := arg->false;
Local._normalmatch := arg->false;

Local._match_id := (obj, shape, cx) -> Cond(
	IsRec(shape) and IsBound(shape.is@),
		shape.match(obj, cx),
	BagType(shape) < T_FUNCTION or BagType(shape) in [T_STRING,T_RANGE],
		BagType(shape) = BagType(obj) and shape=obj,
	Same(obj, shape) or Same(ObjId(obj), shape));

##
Declare(cx_enter, cx_leave, empty_cx, apply_rules_ni, _SubstBottomUp, _SubstTopDown);
##

# PatternMatch(<obj>, <shape>, <cx>)
#	Returns true if <obj> matches the given <shape> in a given context <cx>.
#	For plain matches use empty context table empty_cx().
#
PatternMatch := function(obj, shape, cx)
	local ch, numch, shlen, res;

	if not IsList(shape) or BagType(shape) in [T_STRING,T_RANGE] then
		return _match_id(obj, shape, cx);
	elif shape = [] then
		return false;
	elif not _match_id(obj, shape[1], cx) then
		return false;
	else
		shlen := Length(shape);
		ch := _children(obj);
		numch := Length(ch);
		if shlen = 1
			then return numch = 0;
		else
			cx_enter(cx, obj);
			if shape[2] = ... then
				if shape[shlen] = ... then
					res := _midmatch(ch, shape{[3..shlen-1]}, cx);
				elif numch < shlen-2 then
					res := false;
				else
					....left := numch-shlen+2;
					....right := numch+1;
					res := _normalmatch(ch, numch-shlen+3, shlen-2,  shape, 3, shlen-2, cx);
				fi;
			elif Last(shape) = ... then
				if numch < shlen-2 then
					res := false;
				else
					....left := 0;
					....right := shlen-1;
					res := _normalmatch(ch, 1, shlen-2,  shape, 2, shlen-2, cx);
				fi;
			else
				....left := false;
				....right := false;
				res := _normalmatch(ch, 1, numch,  shape, 2, shlen-1, cx);
			fi;
			cx_leave(cx, obj);
			return res;
		fi;
	fi;
end;

_normalmatch := function(lst, lstart, llen, shape, sstart, slen, cx)
	local i, ch;
	if llen <> slen then
		return false;
	else
		for i in [0..slen-1] do
			if not PatternMatch(lst[lstart+i], shape[sstart+i], cx) then
				return false;
			fi;
		od;
		return true;
	fi;
end;

_midmatch := function(lst, shape, cx)
	local i, ch, shlen, res, llen;
	shlen := Length(shape);
	llen := Length(lst);
	if llen < shlen then
		return false;
	elif llen = shlen then
		res := _normalmatch(lst, 1, llen, shape, 1, shlen, cx);
		if res then
			....left := 0;
			....right := llen + 1;
		fi;
		return res;
	else
		for i in [1 .. llen - shlen + 1] do
			if PatternMatch(lst[i], shape[1], cx) then
				if shlen = 1 then
					....left := i-1;
					....right := i+shlen;
					return true;
				else
					if _normalmatch(lst, i+1, shlen-1,  shape, 2, shlen-1, cx) then
						....left := i-1;
						....right := i+shlen;
						return true;
					fi;
				fi;
			fi;
		od;
		return false;
	fi;
end;

#F AlternativesRewrite( <expr>, <from>, <to_func> )
#F
#F Creates all alternatives for substitution of an expression tree.
#F	<expr> - expression to substitute in
#F	<from> - shape to substitute
#F	<to_func> - a substitution function of the form e->f(e), where
#F			 as <e> will be passed the subtree matching <from>
#F

Declare(_AlternativesRewrite, _ConditionalAlternativesRewrite);

AlternativesRewrite := (expr, from, to_func) ->
	_AlternativesRewrite(expr, from, to_func, empty_cx(), []);

_AlternativesRewrite := function(expr, from, to_func, cx, list)
	local ch, i, clist;

	ch := _children(expr);
	if Length(ch) <> 0 then
		# not a leaf
		cx_enter(cx, expr);
		for i in [1..Length(ch)] do
			clist := _AlternativesRewrite(ch[i], from, to_func, cx, []);
			Append(list, List(clist, function(x) local a; a:=Copy(expr); _setChild(a, i, x); return a; end));
		od;
		cx_leave(cx, expr);
	fi;

	if PatternMatch(expr, from, cx) then
		Add(list, When(NumArgs(to_func)=2, to_func(cx, expr), to_func(expr)));
	fi;

	return list;
end;

ConditionalAlternativesRewrite := (expr, from, condition_to_func, rewrite_to_func) ->
	_ConditionalAlternativesRewrite(expr, from, condition_to_func, rewrite_to_func, empty_cx(), []);

_ConditionalAlternativesRewrite := function(expr, from, condition_to_func, rewrite_to_func, cx, list)
	local ch, i, clist;

	ch := _children(expr);
	if Length(ch) <> 0 then
		# not a leaf
		cx_enter(cx, expr);
		for i in [1..Length(ch)] do
			clist := _ConditionalAlternativesRewrite(ch[i], from, condition_to_func, rewrite_to_func, cx, []);
			Append(list, List(clist, function(x) local a; a:=Copy(expr); _setChild(a, i, x[2]); return [x[1], a]; end));
		od;
		cx_leave(cx, expr);
	fi;

	if PatternMatch(expr, from, cx) then
		Add(list, [When(NumArgs(condition_to_func)=2, condition_to_func(cx, expr), condition_to_func(expr)),
				When(NumArgs(rewrite_to_func)=2, rewrite_to_func(cx, expr), rewrite_to_func(expr))]);
	fi;

	return list;
end;

# Return a list of rewrite rule objects, from either a list of a record
# passing in a record has the advantage of clean rule naming
#
_parseRuleSet := rset -> Cond(
	IsList(rset), List(rset, Rule),
	IsRec(rset),  List(UserRecFields(rset),
	function(fld) local r; r := Rule(rset.(fld)); r.name := fld; return r; end),
	Error("<rset> must be a list of rules, or a record rec(rule1 := Rule(...), ...)")
);

#F SubstBottomUp( <expr>, <from>, <to_func> )
#F
#F Destructive bottom up substitution on an expression tree.
#F	<expr> - expression to substitute in
#F	<from> - shape to substitute
#F	<to_func> - a substitution function of the form e->f(e), where
#F			 as <e> will be passed the subtree matching <from>
#F
SubstBottomUp := (expr, from, to_func) ->
	_SubstBottomUp(expr, [ Rule(from, to_func, "unnamed(SubstBottomUp)") ], empty_cx());

SubstBottomUpRules := (expr, ruleset) ->
	_SubstBottomUp(expr, _parseRuleSet(ruleset), empty_cx());

_SubstBottomUp := function(expr, rules, cx)
	local ch, i;
	ch := _children(expr);
	if ch <> [] then
		cx_enter(cx, expr);
		for i in [1..Length(ch)] do
			_setChild(expr, i, _SubstBottomUp(ch[i], rules, cx));
		od;
		cx_leave(cx, expr);
	fi;
	return apply_rules_ni(rules, expr, cx);
end;

_SubstLeaves := function(expr, from, to_func, cx)
	local ch, i;
	ch := _children(expr);
	if Length(ch) <> 0 then
		# not a leaf
		cx_enter(cx, expr);
		for i in [1..Length(ch)] do
			_setChild(expr, i, _SubstLeaves(ch[i], from, to_func, cx));
		od;
		cx_leave(cx, expr);
		return expr;
	else
		# a leaf
		if PatternMatch(expr, from, cx) then
			return When(NumArgs(to_func)=2, to_func(cx, expr), to_func(expr));
		else
			return expr;
		fi;
	fi;
end;

SubstLeaves := (expr, from, to_func) -> _SubstLeaves(expr, from, to_func, empty_cx());

SubstChildren := function(expr, from, to_func)
	local ch, i;
	ch := _children(expr);
	#expr := map_children_safe(expr, c -> When(PatternMatch(c,from,empty_cx()), to_func(c), c));
	for i in [1..Length(ch)] do
		_setChild(expr, i,
			When(PatternMatch(ch[i],from,empty_cx()), to_func(ch[i]), ch[i]));
	od;
	return expr;
end;

SubstTopDown := (expr, from, to_func) ->
	_SubstTopDown(expr, [ Rule(from, to_func, "unnamed(SubstTopDown)") ], empty_cx());

SubstTopDown_named := (expr, from, to_func, name) ->
	_SubstTopDown(expr, [ Rule(from, to_func, name) ], empty_cx());

SubstTopDownRules := (expr, ruleset) ->
	_SubstTopDown(expr, _parseRuleSet(ruleset), empty_cx());

_SubstTopDown := function(expr, rules, cx)
	local ch, newch, res;
	expr := apply_rules_ni(rules, expr, cx);

	ch := _children(expr);
	if ch <> [] then
		cx_enter(cx, expr);
		newch :=  List(ch, c -> _SubstTopDown(c, rules, cx));
		res := _fromChildren(expr, newch);
		cx_leave(cx, expr);
	else
		res := expr;
	fi;
	return res;
end;

Declare(_SubstTopDownNR);

# same as SubstTopDown but doesn't recurse on the substitution
SubstTopDownNR := (expr, from, to_func) ->
	_SubstTopDownNR(expr, [ Rule(from, to_func, "unnamed(SubstTopDownNR)") ], empty_cx());

SubstTopDownNR_named := (expr, from, to_func, name) ->
	_SubstTopDownNR(expr, [ Rule(from, to_func, name) ], empty_cx());

SubstTopDownRulesNR := (expr, ruleset) ->
	_SubstTopDownNR(expr, _parseRuleSet(ruleset), empty_cx());

_SubstTopDownNR := function(expr, rules, cx)
	local ch, newch, res, n_applied;
	n_applied := cx.applied;
	cx.rlimit := 1;
	expr := apply_rules_ni(rules, expr, cx);
	if cx.applied > n_applied then
		return expr;
	fi;

	ch := _children(expr);
	if ch <> [] then
		cx_enter(cx, expr);
		newch :=  List(ch, c -> _SubstTopDownNR(c, rules, cx));
		res := _fromChildren(expr, newch);
		cx_leave(cx, expr);
	else
		res := expr;
	fi;
	return res;
end;

#F MatchSubst(<expr>, <rulelist>)
#F
#F Attempts matching 1 of the rules from the list to <expr> if it
#F succeeds the transformation is applied, otherwise original
#F expression is returned.
#F
#F MatchSubst is similar to SubstTopDown, but it does not recurse
#F on children.
#F
MatchSubst := function(expr, rules)
	local ch, i, r, cx;
	cx := empty_cx();
	for r in _parseRuleSet(rules) do
		if PatternMatch(expr, r.from, cx) then
			RuleTrace(r);
			return r.to(expr);
		fi;
	od;
	return expr;
end;

Declare(_Collect);

#F Collect(<expr>, <shape>)
#F
#F Returns a list of all subtrees of <expr> that match <shape>
#F
Collect := (expr, shape) -> _Collect(expr, shape, empty_cx(), true);

#F Contains(<expr>, <shape>)
#F
#F Returns 'true' if <expr> contains <shape>
#F NOTE: optimize this
Contains := (expr, shape) -> _Collect(expr, shape, empty_cx(), false)<>[];

#F CollectNR(<expr>, <shape>)
#F
#F Returns a list of all subtrees of <expr> that match <shape>.
#F Unlike 'Collect', once 'CollectNR' finds an object matching <shape>,
#F it does not search inside its children.
#F
CollectNR := (expr, shape) -> _Collect(expr, shape, empty_cx(), false);

_Collect := function(expr, shape, cx, do_recurse)
	local res, ch, c;
	if PatternMatch(expr, shape, cx) then
		if not do_recurse then
			return [expr];
		else
			cx_enter(cx, expr);
			res := Concatenation(List(_children(expr), c -> _Collect(c, shape, cx, do_recurse)));
			cx_leave(cx, expr);
			return Concatenation([expr], res);
		fi;
	else
		cx_enter(cx, expr);
		res := Concatenation(List(_children(expr), c -> _Collect(c, shape, cx, do_recurse)));
		cx_leave(cx, expr);
		return res;
	fi;
end;

Declare(_Pull);

#F Pull(<expr>, <shape>, <to_func>, <pull_func>)
#F
#F Pull is a hybrid of Collect and SubstBottomUp. First three parameters
#F specify substitution, and the last one collection:
#F
#F	<expr> - expression to substitute in
#F	<from> - shape to substitute
#F	<to_func> - a substitution function of the form e->f(e), where
#F			 as <e> will be passed the subtree matching <from>
#F	<pull_func> - applied to matching subtree <e> to collect data
#F
#F Pull retuns a tuple [<data>, <newtree>], where <data> is a list
#F of all matched subtrees (before substitutions) with <pull_func>
#F applied, and <newtree> is a tree obtained by substitution.
#F
## Note: This is Top-down recursive Pull, same as PullTD
Pull := (expr, shape, to_func, pull_func) -> _Pull(expr, shape, to_func, pull_func, empty_cx(),
	true, true);
# Top-down recursive Pull
PullTD := (expr, shape, to_func, pull_func) -> _Pull(expr, shape, to_func, pull_func, empty_cx(),
	true, true);

# Bottom-up recursive Pull (non-recursive bottom up does not exist)
PullBU := (expr, shape, to_func, pull_func) -> _Pull(expr, shape, to_func, pull_func, empty_cx(),
	true, false);

# Top-down non-recursive Pull
PullNR := (expr, shape, to_func, pull_func) -> _Pull(expr, shape, to_func, pull_func, empty_cx(),
	false, true);

_Pull := function(expr, shape, to_func, pull_func, cx, do_recurse, top_down)
	local ch, i, t, data, newdata, newexpr;
	data := [];

	if top_down then
		if PatternMatch(expr, shape, cx) then
			Add(data, When(NumArgs(pull_func)=2, pull_func(cx, expr), pull_func(expr)));
			expr := When(NumArgs(to_func)=2, to_func(cx, expr), to_func(expr));
			if not do_recurse then
				return [ data, expr ];
			fi;
		fi;
	fi;

	cx_enter(cx, expr);
	ch := _children(expr);
	for i in [1..Length(ch)] do
		t := _Pull(ch[i], shape, to_func, pull_func, cx, do_recurse, top_down);
		Append(data, t[1]);
		_setChild(expr, i, t[2]);
	od;
	cx_leave(cx, expr);

	if not top_down then
		if PatternMatch(expr, shape, cx) then
			Add(data, When(NumArgs(pull_func)=2, pull_func(cx, expr), pull_func(expr)));
			expr := When(NumArgs(to_func)=2, to_func(cx, expr), to_func(expr));
			if not do_recurse then
				return [ data, expr ];
			fi;
		fi;
	fi;
	return [data, expr];
end;

#F Harvest( <expr>, <shape-func-list> )
#F
#F Harvest is a generalization of Collect( <expr>, <shape> ).
#F It returns concatenated list of <func>(child) for all children
#F of <expr> that match <shape>, for each <shape>-<func> pair.
Harvest := function( expr, shape_func_list )
	local res, sf, c;
	res := [];
	for sf in shape_func_list do
		Append(res, List(Collect(expr, sf[1]), sf[2]));
	od;
	return res;
end;

#F SubstObj(<expr>, <obj>, <new_obj>
#F replacing all occurences of <obj> by <new_obj>
SubstObj := (expr, obj, new_obj) -> SubstTopDownNR_named(expr, @.cond(x -> x=obj), e -> new_obj, "SubstObj");


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

Verifier := rec(
    MaxError := 6,
    IgnoreRoots := false
);

if not IsBound(GenerateErrorReports) then
    GenerateErrorReports := true;
fi;

#F HandleTestError ( <func-name>, <func-args>, <bool> )
#F    Creates a directory and reports the given function call in
#F    'test.g', backtrace in 'backtrace' and current configuration in
#F    'conf.g'
#F
#F    Boolean parameter, if true, tells HandleTestError to all Error()
#F    thus causing an exception, if false, program will continue
#F    normally.
#F
HandleTestError := function (FuncName, FuncArgs, doErr)
    local dir,file,arg,n,k;
    if IsBound(GenerateErrorReports) and GenerateErrorReports = false then
	return;
    fi;
    dir := Concat(Conf("tmp_dir"), Conf("path_sep"), "Error-",
		  String(TimeInSecs()), Conf("path_sep"));
    file := Concat(dir, "test.g");
    SysMkdir(dir);
    # Create a file (truncate if it exists)
    PrintTo(file, "Import(spiral.spl, spiral.nt, spiral.code); \n");
#F    AppendTo(file, "config_update_val(\"remove_temporaries\", SRC_CMDLINE, int_val(0));\n");
#F    AppendTo(file,"config_update_val(\"tmp_dir\", SRC_CMDLINE, str_val(\"./tmp\"));\n");
    AppendTo(file, "GenerateErrorReports := false; \n");
    AppendTo(file, "SPL_DEFAULTS := ", SPL_DEFAULTS, ";\n");
    # write function arguments
    n := 1;
    for arg in FuncArgs do
	AppendTo(file, "arg", String(n), " := ");
	if IsString(arg) then
	    AppendTo(file, "\"", arg, "\"");
	else
	    AppendTo(file, arg);
	fi;
	AppendTo(file, ";\n\n");
	n := n+1;
    od;

    # write function call
    k := 1;
    AppendTo(file, "result := ", FuncName, "( ");
    while k<>n do
	AppendTo(file, "arg", String(k));
	if k <> n-1 then AppendTo(file, ", "); fi;
	k := k + 1;
    od;
    AppendTo(file, " );\n\n");

    # other info
    # NOTE: implement a config dump in sys_conf
#F    AppendTo(Concat(dir, "conf.g"), ConfigProfileList(), ";\n");
    BacktraceTo(Concat(dir, "backtrace.txt"), 100);

    if doErr then
	Error(FuncName, " failed, see ", dir);
    else
	Print(FuncName, " failed, see ", dir, "\n");
    fi;
end;

#F DeriveSPLOptions ( <spl>, <spl-options-record> )
#F    Merges the defaults with <spl-options-record>, derives other
#F    fields, such as dataType, from <spl>, and returns a complete
#F    options record.
#F
DeriveSPLOptions := function (S, R)
    # set options
    R := MergeSPLOptionsRecord(R);

    # check if MPI req'd
#    if IsDMP(S) then
#	R.language := "c.mpi.mpich";
#    fi;

    # if user didn't specify data type determine it from S
    if R.dataType = "no default" then
	if IsRealSPL(S) then R.dataType := "real";
    	else R.dataType := "complex";
	fi;
    else
	;# prevent user from doing nonsense
	#if not IsRealSPL(S) and R.dataType = "real" then
	#    Error("invalid combination: complex <S> and real data type");
	#fi;
    fi;
    return R;
end;

#F DeriveScalarType ( <spl-options-record> )
#F
DeriveScalarType := function(SPLOpts)
    local suffix;
    if IsBound(SPLOpts.customDataType) then return SPLOpts.customDataType;
    elif IsBound(SPLOpts.customReal) and SPLOpts.dataType = "real" then return SPLOpts.customReal;
    elif IsBound(SPLOpts.customComplex) and SPLOpts.dataType = "complex" then return SPLOpts.customComplex;
    else
	if SPLOpts.dataType = "real" then suffix := "";
	elif SPLOpts.dataType = "complex" then suffix := "_cplx";
	else Error("SPLOpts.dataType has invalid value '", SPLOpts.dataType, "'");
	fi;
	if SPLOpts.precision = "single" then return Concat("float",suffix);
	elif SPLOpts.precision = "double" then return Concat("double",suffix);
	elif SPLOpts.precision = "extended" then return Concat("long_double",suffix);
	else Error("SPLOpts.precision has invalid value '", SPLOpts.dataType, "'");
	fi;
    fi;
end;

ProgInputType := rec(
    SPLSource := 0,
    TargetSource := 1,
    ObjFile := 2
);

#F DeriveType ( <spl-options-record> )
DeriveType := (opts)->When(IsBound(opts.vector), opts.vector.isa.ctype,
    DeriveScalarType(opts));

#F ProgSPL ( <spl> , <spl-options-record> )
#F    Convert <spl> to a 'Prog' record used by xxxProg functions.
#F    See gap/src/spiral_spl_prog.c for details.
#F
ProgSPL := function (SPL, Opts)
    local prog;
    Opts := DeriveSPLOptions(SPL, Opts);
    prog := rec();
    prog.profile   := Opts.language;
    prog.type      := ProgInputType.SPLSource;
    prog.data_type := DeriveScalarType(Opts);

    if IsBound(Opts.zeroBits) then prog.zero_bits := Opts.zeroBits;
    else prog.zero_bits := 0; fi;

    prog.dim_rows  := EvalScalar(SPL.dimensions[1]);
    prog.dim_cols  := EvalScalar(SPL.dimensions[2]);
    prog.auto_dim  := 0;

    if IsBound(Opts.compflags) then prog.compiler_flags := Opts.compflags; fi;

    if IsBound(Opts.file) then prog.file := Opts.file;
    else prog.file := SysTmpName(); fi;

    if IsBound(Opts.subName) then prog.sub_name := Opts.subName;
    else prog.sub_name := "sub"; fi;

    prog.spl_file := prog.file;
    return prog;
end;

#F   Valid <compare-type>'s are
#F     "random": compare on random vector (default)
#F     "basis" : compare on standard basis
#F     <int>   : compare on <int> random standard base vectors
#F
VerifierOpts := function (CO)
    local opts;
    opts := Concat("-g -e ", String(Verifier.MaxError), " ");
    if CO = "basis" then return Concat(opts, " -b");
    elif CO = "random" then return Concat(opts, " -r");
    elif IsInt(CO) then return Concat(opts, " -s ", String(CO));
    else Error("<CO> must be an integer, \"random\", or \"basis\"");
    fi;
end;