kcc

#!/usr/bin/env perl
use strict;
use warnings;

use v5.10;
use Cwd qw(abs_path getcwd);
use File::Basename qw(basename dirname fileparse);
use lib dirname(__FILE__);

use File::Copy qw(move);
use File::Path qw(rmtree);
use File::Spec::Functions qw(rel2abs catfile);
use MIME::Base64 qw(encode_base64);
use String::Escape qw(quote backslash printable);
use UUID::Tiny qw(:std);

use RV_Kcc::Files qw(profileDir hardwareAddressesFile nativeCC nativeCXX distDir kBinDir tempFile tempDir error IS_CYGWIN);
use RV_Kcc::Opts qw(
      getopts arg classify
      cppArgs suppressions ifdefs ldArgs nativeObjFiles srcFiles objFiles trampolineFiles breakpoints
      RVMAIN BASE_LIBS MAGIC
);
use RV_Kcc::Shell qw(shell checkError setShellDebugFile saveArgv debug);

# Here we trap control-c (and others) so we can clean up when that happens.
$SIG{'ABRT'} = 'interruptHandler';
$SIG{'TERM'} = 'interruptHandler';
$SIG{'QUIT'} = 'interruptHandler';
$SIG{'SEGV'} = 'interruptHandler';
$SIG{'HUP' } = 'interruptHandler';
$SIG{'TRAP'} = 'interruptHandler';
$SIG{'STOP'} = 'interruptHandler';
$SIG{'INT'} = 'interruptHandler'; # Handle control-c.

use constant KRUN         => do {
      my $path = kBinDir('krun');
      my $ext = IS_CYGWIN? '.bat' : '';
      $path . $ext;
};
use constant PRINTF       => IS_CYGWIN? 'printf %%s' : 'printf %s';
use constant QUOTE_INT    => IS_CYGWIN? printable("\"Int\"") : "\"Int\"";
use constant QUOTE_STRING => IS_CYGWIN? printable("\"String\"") : "\"String\"";

exit main();

sub validateOptions {
      !srcFiles() && !objFiles() && !nativeObjFiles()
            && error("no input files found.\n");
      (arg('-c') || arg('-E') || arg('-M') || arg('-MM')) && arg('-o') && (scalar srcFiles() > 2)
            && error("cannot specify -o with -c or -E with multiple files.\n");
}

sub main {
      saveArgv();

      foreach (@ARGV) {
            # Clean entries: remove spaces, tabs and newlines
            $_ =~ tr/ \t\n/\0\0\0/;
      }

      $ENV{OCAMLRUNPARAM} = "s=32M,b,l=8M";
      getopts() or error("Failed to parse the command line.\n");
      validateOptions();

      my $noLicense = defined(arg('--no-license-message'))
            || defined($ENV{'KCC_NO_LICENSE_MESSAGE'});

      my $heapSize = "1G";
      if (arg('-Xmx')) {
            $heapSize = arg('-Xmx');
      }
      # Set heap and stack size of krun
      $ENV{K_OPTS} = "-Xmx$heapSize";

      if (arg('-E') || arg('-M') || arg('-MM')) {
            my $oval = arg('-o') || '-';

            return preprocess($oval, '/dev/null', (srcFiles())[0], (srcFiles())[1]);
      } elsif (arg('-c') && arg('-o')) {
            my $result = tempFile('compile');
            compile($result, (srcFiles())[0], (srcFiles())[1]);
            move($result, arg('-o'));

            return 0;
      } elsif (arg('-c')) {
            for (my $i = 0; $i < (scalar srcFiles() - 1); $i += 2) {
                  my $oval = basename((srcFiles())[$i], ".c", ".cc", ".cp", ".cxx", ".cpp", ".CPP", ".c++", ".C", ".h", ".hh", ".hp", ".hxx", ".hpp", ".HPP", ".h++", ".H", ".tcc") . ".o";
                  my $result = tempFile('compile');
                  compile($result, (srcFiles())[$i], (srcFiles())[$i+1]);
                  move($result, $oval);
            }
            return 0;
      } elsif (arg('-shared')) {
            compileAll(srcFiles());

            sharedObject(arg('-o') || 'a.out');

            return 0;
      }

      if (!arg('-nodefaultlibs')) {
            classify(profileDir('lib', 'libc.so'), 'none');
            if (arg('-Xk++')) {
                  classify(profileDir('lib', 'libstdc++.so'), 'none');
            }
      }

      # Compile source files to object files
      compileAll(srcFiles());

      # Linking.
      my $programConfFile = tempFile('conf');
      linkAll($programConfFile);

      my $useCompile = -e profileDir('c-cpp-kompiled', 'c-cpp-kompiled', 'execution_partial.o');

      my $oval = arg('-o') || 'a.out';

      if (arg('-frunner-script') || !$useCompile) {
            debug("Building an executable using the runner script.\n");
            open(FILE, $programConfFile) or error("Couldn't open file: $!\n");
            my $programConf = join("", <FILE>);
            close(FILE);
            $programConf = encode_base64($programConf);
            open(FILE, distDir('program-runner')) or error("Couldn't open file: $!\n");
            my $template = join("", <FILE>);
            close(FILE);

            my $profDir = profileDir();
            my $krun = KRUN;
            $template =~ s?__EXTERN_SCRIPTS_DIR__?$profDir?g;
            $template =~ s?__EXTERN_HEAP_SIZE__?$heapSize?g;
            $template =~ s?__EXTERN_KRUN__?$krun?g;

            open(my $programRunner, '>', $oval) or error("Couldn't open file: $!\n");
            print $programRunner "$template\n";
            print $programRunner "sub linkedProgram {\nreturn <<'PROGRAMCONF';\n$programConf\nPROGRAMCONF\n}\n";
            print $programRunner "sub nativeLibraries {\n return '" . join(' ', BASE_LIBS) . "';\n}\n";

            if (nativeObjFiles()) {
                  my $obj = tempFile('obj');
                  shell('ld', '-r', '-o', $obj, nativeObjFiles())->run();
                  open(FILE, $obj) or error("Couldn't open file: $!\n");
                  my $programObj = join("", <FILE>);
                  close(FILE);
                  $programObj = encode_base64($programObj);
                  print $programRunner "sub nativeObjFile {\nreturn <<'PROGRAMOBJ';\n$programObj\nPROGRAMOBJ\n}\n";
            } else {
                  print $programRunner "sub nativeObjFile {\n return undef;\n}\n";
            }

            my $encodedJsonAsPerlString = quote(backslash(getRVErrorJson()));
            print $programRunner "sub getJson {\n return $encodedJsonAsPerlString;\n}\n";

            my $encodedOptsAsPerlString = quote(backslash(makeOptions(0)));
            print $programRunner "sub getOptions {\n return $encodedOptsAsPerlString;\n}\n";

            close($programRunner);
            my $numFilesChanged = chmod(0755, $oval);

            ($numFilesChanged == 1)
                  or error("Call to chmod $oval failed.\n");
      } else {
            debug("Building a natively-compiled executable.\n");
            my $sem = profileDir('c-cpp-kompiled', 'c-cpp-kompiled');
            my $d = tempDir('native');
            my ($rvErrorJson, $string) = (getRVErrorJson(), QUOTE_STRING);

            setShellDebugFile($programConfFile, 1);
            shell(catfile($sem, 'marshalvalue'),
                        catfile($sem, 'realdef.cma'),
                        '-c', 'ARGV', '`#argv`(.KList) ', 'text',
                        '-c', 'OPTIONS', makeOptions(0), 'text',
                        '-c', 'JSON', "#token($rvErrorJson, $string)", 'text',
                        '--output-file', catfile($d, 'kore_term')
                 )->run();
            shell(catfile($sem, 'marshalvalue'),
                        catfile($sem, 'realdef.cma'), '-s', # -s before -c
                        '-c', 'PGM', $programConfFile, 'binaryfile',
                        '--output-file', catfile($d, 'marshal_term')
                 )->run();

            open(my $pluginPath, '>', catfile($d, 'plugin_path')) or error("Couldn't open file: $!\n");
            print $pluginPath catfile($sem, 'realdef.cma');
            close($pluginPath);

            my @lnk = (catfile($d, 'kore_term.o'), catfile($d, 'marshal_term.o'), catfile($d, 'plugin_path.o'));

            my $native = profileDir('native');
            if (arg('-fnative-binary')) {
                  debug("Linking all native objects into seperate binary.\n");
                  my @trampolineFiles = trampolineFiles();
                  my $trampolines = catfile($d, 'trampolines.txt');
                  shell("cat @trampolineFiles | sort | uniq")->stdout($trampolines)->run();
                  shell("cat '$trampolines' | awk -F '\t' '{if (\$1!=\"\") print \$1; }' | " . distDir("make-trampolines"))
                        ->stdout($d, 'trampolines.h')->run();
                  shell("cat '$trampolines' | awk -F '\t' '{if (\$2!=\"\") print \$2; }'")
                        ->stdout($d, 'used_symbols')->run(); 
                  shell("(cat '$trampolines' | awk -F '\t' '{if (\$1!=\"\") print \"__\" \$1; }'; comm -12 '" . catfile($d, 'used_symbols') . "' '" . dumpSymbols() . "') | sort | uniq | " . distDir("make-symbols"))
                        ->stdout($d, 'symbols.c')->run();
                  shell(nativeCC(), '-std=c11', '-o', catfile($d, 'native_binary'),
                              catfile($native, 'server.c'),
                              catfile($native, 'main.o'),
                              catfile($native, 'builtins.o'),
                              catfile($native, 'platform.o'),
                              '-I', $native, '-I', $d, '-w', '-g',
                              ldArgs())->run();

            } else {
                  debug("Linking native objects directly.\n");
                  shell('touch', catfile($d, 'native_binary'))->run();
                  push(@lnk, catfile($native, 'builtins.o'), ldArgs());
            }

            push(@lnk, catfile($d, 'native_binary.o'));

            my $old_cwd = getcwd();
            chdir($d);
            shell('ld', '-r', '-b', 'binary', '-o', 'kore_term.o', 'kore_term')->run();
            shell('ld', '-r', '-b', 'binary', '-o', 'marshal_term.o', 'marshal_term')->run();
            shell('ld', '-r', '-b', 'binary', '-o', 'plugin_path.o', 'plugin_path')->run();
            shell('ld', '-r', '-b', 'binary', '-o', 'native_binary.o', 'native_binary')->run();
            chdir($old_cwd);

            shell(nativeCompiler(), catfile($sem, 'execution_partial.o'), '-o', $oval, '-Wl,-E', @lnk)->run();
      }

      return 0;
}

sub nativeCompiler {
      if (arg('-Xk++')) {
            return nativeCXX();
      } else {
            return nativeCC();
      }
}

sub compileAll {
      my (@srcFiles) = (@_);

      while (scalar @srcFiles > 0) {
            my $oval = tempFile('merge');
            my $input = shift @srcFiles;
            my $lang = shift @srcFiles;
            compile($oval, $input, $lang);
            classify($oval, 'none');
      }
}

sub compile {
      my ($oval, $inputFile, $lang) = (@_);
      if ($lang eq 'c' or $lang eq 'c++') {
            my $kast = tempFile('kast');
            my $obj = tempFile('obj');
            my $trampolines = tempFile('trampolines');
            my $uuid = create_uuid_as_string();
            my @cmd = getTranslationCommand($kast, $inputFile, $lang, $uuid, $trampolines);
            debug("Compiling (C or C++) $inputFile.\n");
            shell(@cmd)->verbose()->run();
            if (arg('-fno-native-compilation')) {
                  shell(nativeCompiler(), '-c', getStd($lang), '-x', $lang, '/dev/null', '-o', $obj)->verbose()->run();
            } else {
                  setShellDebugFile($obj, 0);
                  shell(nativeCompiler(), '-c', getStd($lang), '-x', $lang, $inputFile, '-o', $obj, cppArgs())->verbose()->run();
                  shell(distDir('globalize-syms'), $uuid, $obj)->run();
            }
            shell('objcopy', '--redefine-sym', 'main=' . RVMAIN, $obj)->run();
            shell(distDir('merge-kcc-obj'), $obj, $kast, $trampolines, $oval)->run();
      } else {
            debug("Compiling $inputFile.\n");
            setShellDebugFile($oval, 0);
            shell(nativeCompiler(), '-c', '-x', $lang, $inputFile, '-o', $oval, cppArgs())->verbose()->run();
      }
}

sub pushObj {
      my ($arr, $obj, $i) = @_;

      if (defined $obj) {
            push(@{$_[0]}, "-pOBJ$i=cat");
            push(@{$_[0]}, "-cOBJ$i=$obj");
      } else {
            push(@{$_[0]}, "-pOBJ$i=" . PRINTF);
            push(@{$_[0]}, "-cOBJ$i=.K");
      }
}

sub makeOptions {
      my ($link) = (@_);

      my @options = ();

      if (arg('-fno-native-compilation')) {
            push(@options, "`NoNativeFallback`(.KList)");
      }

      if (arg('-frecover-all-errors')) {
            push(@options, "`RecoverAll`(.KList)");
      }

      if (arg('-fuse-native-std-lib')) {
            push(@options, "`UseNativeStdLib`(.KList)");
      }

      if (arg('-flint') || arg('-Wlint')) {
            my $heapSize;
            if (arg('-fheap-size=')) {
                  $heapSize = shell("echo " . arg('-fheap-size=') . " | sed -e 's/[Tt]/kg/i;s/[Gg]/km/i;s/[Mm]/kk/i;s/k/*1024/ig' | bc")->stdout()->run();
                  chop($heapSize);
            } else {
                  $heapSize = 1024 * 1024 * 1024;
            }
            my $heapSizeInt = $heapSize;
            $heapSize = quote(printable($heapSize));
            if (IS_CYGWIN) {
                  $heapSize = printable($heapSize);
            }
            my $stackSize;
            if (arg('-fstack-size=')) {
                  $stackSize = shell("echo " . arg('-fstack-size=') . " | sed -e 's/[Tt]/kg/i;s/[Gg]/km/i;s/[Mm]/kk/i;s/k/*1024/ig' | bc")->stdout()->run();
                  chop($stackSize);
            } else {
                  $stackSize = shell('ulimit -s')->stdout()->run();
                  chop($stackSize);
                  if ($stackSize eq 'unlimited') {
                        $stackSize = $heapSizeInt;
                  } else {
                        $stackSize = $stackSize * 1024; # result was in kb
                  }
            }
            $stackSize = quote(printable($stackSize));
            if (IS_CYGWIN) {
                  $stackSize = printable($stackSize);
            }
            my $int = QUOTE_INT;
            push(@options, "`Lint`(.KList)");
            push(@options, "`Heap`(#token($heapSize, $int))");
            push(@options, "`Stack`(#token($stackSize, $int))");
      }

      if (arg('-e')) {
            my $entry = quote(printable(quote(arg('-e'))));
            my $string = QUOTE_STRING;
            push(@options, "`EntryPoint`(#token($entry, $string))");
      }

      if (arg('-finteractive-fail')) {
            push(@options, "`InteractiveFail`(.KList)");
      }

      if (arg('-Wfatal-errors')) {
            push(@options, "`FatalErrors`(.KList)");
      }

      if (arg('-funresolved-symbols=')) {
            my $string_arg = arg('-funresolved-symbols=');
            if ($string_arg eq 'ignore-all') {
                  push(@options, "`UnresolvedSymbols`(`IgnoreAll`(.KList))");
            } elsif ($string_arg eq 'warn-all') {
                  push(@options, "`UnresolvedSymbols`(`WarnAll`(.KList))");
            } elsif ($string_arg eq 'report-all') {
                  push(@options, "`UnresolvedSymbols`(`ReportAll`(.KList))");
            } elsif ($string_arg eq 'warn-unreachable') {
                  push(@options, "`UnresolvedSymbols`(`WarnUnreachable`(.KList))");
            }
      } else {
            push(@options, "`UnresolvedSymbols`(`WarnUnreachable`(.KList))");
      }

      for (breakpoints()) {
            my ($file, $line) = @{$_};
            $file = quote(printable(quote(rel2abs($file))));
            $line = quote(printable($line));
            my ($string, $int) = (QUOTE_STRING, QUOTE_INT);
            push(@options, "`Breakpoint`(#token($file, $string), #token($line, $int))");
      }

      if ($link) {
            push(@options, "`Link`(.KList)");
      }

      return makeSet(@options);

}

sub addArg {
      my ($name, $value, $category, @krunArgs) = @_;

      if (useInterpreter()) {
            push(@krunArgs, '-c', $name, $value, $category);
      } else {
            push(@krunArgs, "-c$name=$value");
            if ($category eq 'text' or $category eq 'binary') {
                  push(@krunArgs, "-p$name=" . PRINTF);
            } else {
                  push(@krunArgs, "-p$name=cat");
            }
      }
      return @krunArgs;
}

sub sharedObject {
      my ($oval) = (@_);

      my $trampolines = tempFile('trampolines');
      my @trampolineFiles = trampolineFiles();
      if (@trampolineFiles) {
            shell("cat @trampolineFiles | sort | uniq")->stdout($trampolines)->run();
      } else {
            shell('touch', $trampolines)->run();
      }

      debug("Creating shared object.\n");
      my $accum = tempFile('accum');
      shell(getLinkingCommand($accum, 'dummy', 0))->verbose()->run();

      my $obj = tempFile('merge');
      shell('ld', '-r', '-o', $obj, nativeObjFiles())->run();
      shell(distDir('merge-kcc-obj'), $obj, $accum, $trampolines, $oval)->run();
}

sub linkAll {
      my ($output) = (@_);
      my $symbols = dumpSymbols();

      debug("Linking.\n");
      shell(getLinkingCommand($output, $symbols, 1))->verbose()->run();
}

sub getKRunCommand {
      my ($output, $symbols, $sem) = @_;

      my $def = profileDir($sem);

      my @krun;
      if (useInterpreter()) {
            my $dir = catfile($def, $sem);
            @krun =
                  ( catfile($dir, 'interpreter')
                  , catfile($dir, 'realdef.cma')
                  , $symbols
                  , '--output-file', $output
                  );
      } else {
            @krun =
                  ( KRUN
                  , '--output', 'binary'
                  , '--output-file', $output
                  , '-d', $def
                  , '-w', 'none'
                  , '--smt', 'none'
                  , '--argv', $symbols
                  );

            if (arg('-d')) {
                  push(@krun, '--debug');
            }
      }

      return @krun;
}

sub getLinkingCommand {
      my ($output, $symbols, $link) = (@_);

      my @objs = objFiles();

      my @krun = getKRunCommand($output, $symbols, 'c-cpp-linking-kompiled');

      if (arg('-flinking-depth=')) {
            push(@krun, '--depth');
            push(@krun, arg('-flinking-depth='));
      }

      my ($rvErrorJson, $string) = (getRVErrorJson(), QUOTE_STRING);
      my $json = "#token($rvErrorJson, $string)";

      @krun = addArg("OPTIONS", makeOptions($link), 'text', @krun);
      @krun = addArg("JSON", $json, 'text', @krun);

      my $uuid = create_uuid_as_string();
      my $encodedUuid = quote(printable(quote($uuid)));
      my $uuidOpt = "#token($encodedUuid, $string)";
      @krun = addArg("UUID", $uuidOpt, 'text', @krun);

      if (scalar @objs) {
            my $allObjsFile = tempFile('all-objs');
            my @catArgs = ();
            my @objTexts = ();
            for (my $i = 0; $i < scalar @objs; $i++) {
                  my $thisObj = "";
                  if (-e $objs[$i]) {
                        $thisObj = do {
                              local $/ = undef;
                              open my $fh, '<', $objs[$i];
                              <$fh>;
                        };
                  }
                  if (length $thisObj) {
                        # push(@objTexts, "`unwrapObj`($thisObj)");
                        $thisObj = substr($thisObj, 8, -1);
                        # wrap $thisObj with `unwrapObj`()
                        push(@objTexts, "$thisObj\x02\x00\x00\x00\x00\x00\x00\x00\x09\x00u\x00n\x00w\x00r\x00a\x00p\x00O\x00b\x00j\x00\x00\x00\x00\x01");
                  }
            }
            my $objText = join('', @objTexts);

            my $one = chr((scalar @objTexts >> 24) & 0xff);
            my $two = chr((scalar @objTexts >> 16) & 0xff);
            my $three = chr((scalar @objTexts >> 8) & 0xff);
            my $four = chr((scalar @objTexts >> 0) & 0xff);

            $objText = "$objText\x03$one$two$three$four";
            $objText = "$objText\x02\x00\x00\x00\x00\x00\x00\x00\x0b\x00o\x00b\x00j\x00s\x00W\x00r\x00a\x00p\x00p\x00e\x00r\x00\x00\x00\x00\x01";
            $objText = "$objText\x03\00\00\00\01";

            $objText = MAGIC . "\x04\x00\x01$objText\x07";
            open(my $file, '>', "$allObjsFile");
            print $file $objText;
            close $file;

            @krun = addArg("OBJS", $allObjsFile, 'binaryfile', @krun);
      } else {
            @krun = addArg("OBJS", "objsWrapper(.K)", 'text', @krun);
      }

      @krun = addArg("PGM", ".K", 'text', @krun);

      @krun = addArg("HWADDR", ".K", 'text', @krun);

      setShellDebugFile($output, 1);
      return @krun;
}

sub getTranslationCommand {
      my ($output, $src, $lang, $uuid, $trampolines) = (@_);

      my $cTransDef = profileDir("c-translation-kompiled");
      my $cppTransDef = profileDir("cpp-translation-kompiled");

      my @krun = getKRunCommand($output, 'dummy',
            $lang eq 'c++'? 'cpp-translation-kompiled' : 'c-translation-kompiled');

      if (arg('-ftranslation-depth=')) {
            push(@krun, '--depth');
            push(@krun, arg('-ftranslation-depth='));
      }

      my ($rvErrorJson, $string) = (getRVErrorJson(), QUOTE_STRING);
      my $json = "#token($rvErrorJson, $string)";

      @krun = addArg("OPTIONS", makeOptions(0), 'text', @krun);
      @krun = addArg("JSON", $json, 'text', @krun);

      my $encodedUuid = quote(printable(quote($uuid)));
      my $uuidOpt = "#token($encodedUuid, $string)";
      @krun = addArg("UUID", $uuidOpt, 'text', @krun);

      my $kast = parse($src, $lang, $trampolines);
      @krun = addArg("PGM", $kast, 'textfile', @krun);

      @krun = addArg("HWADDR", hardwareAddressesFile(), 'textfile', @krun);

      setShellDebugFile($output, 1);
      return @krun;
}

sub dumpSymbols {
      state $syms = do {
            my $tmp = tempFile('syms');
            shell(distDir('gccsymdump'), nativeCC(), profileDir('native', 'builtins.o'), ldArgs())->stdout($tmp)->run();
            $tmp;
      };
      return $syms;
}

sub preprocess {
      my ($output, $trampolines, $inputFile, $lang) = @_;
      my $isStdout = 0;
      debug("Preprocessing $inputFile.\n");
      if ($output eq '-') {
            $output = tempFile('pp');
            $isStdout = 1;
      }
      my $directoryname = dirname($inputFile);

      my @ppArgs;
      if ($lang eq 'c++') {
            @ppArgs = (profileDir('cpp-pp'), cppArgs(), getStd($lang), $inputFile, '-o', $output);
      } else {
            @ppArgs = (profileDir('pp'), cppArgs(), getStd($lang), $inputFile, '-o', $output);
      }

      setShellDebugFile($output, 0);
      my $retval = shell(@ppArgs)->verbose()->result();
      if (!$retval) {
            if (arg('-fnative-binary')) {
                  my $cmd = "set -o pipefail && " . distDir("call-sites") . " '$output' --char=sc -- -x $lang | sort | uniq";
                  shell('/bin/bash', '-c', $cmd)->stdout($trampolines)->run();
            } else {
                  shell('touch', $trampolines)->run();
            }

            shell("rv-ifdefclear $output || true")->run();
            for (ifdefs()) {
                  shell("rv-ifdefall $output @$_ || true")->run();
            }
            if ($isStdout) {
                  shell('cat', $output)->verbose()->run();
            }
      }
      return $retval;
}

sub parse {
      my ($inputFile, $lang, $trampolines) = @_;

      my $ppResult = tempFile('pp');
      my $kast = tempFile('kast-txt');

      setShellDebugFile($ppResult, 0);
      checkError(preprocess($ppResult, $trampolines, $inputFile, $lang));

      debug("Parsing $inputFile.\n");
      setShellDebugFile($kast, 0);
      if ($lang eq 'c++') {
            my $std = getStd('c++');
            my $cppParser = distDir('clang-kast');
            my @cppParserArgs = ('-x', 'c++-cpp-output', $std);
            if (arg('-fno-diagnostics-color')) {
                  push(@cppParserArgs, '-fno-diagnostics-color');
            }

            shell($cppParser, $ppResult, '--', @cppParserArgs)->verbose()->stdout($kast)->run();

            return $kast;
      }
      my $cparser = distDir('cparser');
      shell($cparser, $ppResult, '--trueName', $inputFile)->verbose()->stdout($kast)->run();

      return $kast;
}

sub getStd {
      state $c45 = ! shell(nativeCC(), '-std=c45', '-E', '/dev/null')->result(); # sanity check
      state $cpp14 = ! shell(nativeCXX(), '-std=c++14', '-E', '/dev/null')->result();
      state $c11 = ! shell(nativeCC(), '-std=c11', '-E', '/dev/null')->result();

      my ($lang) = @_;

      my $std;
      if (defined arg('-std=')) {
            $std = arg('-std=');
      } elsif ($lang eq 'c++' && $cpp14 && !$c45) {
            $std = 'c++14';
      } elsif ($lang eq 'c++') {
            $std = 'c++11';
      } elsif ($lang eq 'c' && $c11 && !$c45) {
            $std = 'c11';
      } elsif ($lang eq 'c') {
            $std = 'c99';
      } else {
            return '';
      }
      return "-std=$std";
}

sub makeSet {
      my $set = '`.Set`(.KList)';
      foreach my $el (@_) {
            $set = "`_Set_`(`SetItem`($el), $set)";
      }
      return $set;
}

sub useInterpreter {
      -e profileDir('cpp-translation-kompiled', 'cpp-translation-kompiled', 'interpreter');
}

sub getRVErrorJson {
      state $json = do {
            my $format;
            my $output;
            if (arg('-fissue-report=')) {
                  my $file = arg('-fissue-report=');
                  my ($base, $dir, $ext) = fileparse($file, ('\.json', '\.JSON', '\.csv', '\.CSV'));
                  if (!$ext) {
                        error("Format not supported for the issue report file '$file'.\nThe format for the issue report (JSON/CSV) is inferred from the file extension.\n");
                  }
                  $format = uc substr($ext,1);
                  $output = quote(printable(abs_path($file)));
                  $output = ", \"output\": $output";
            } else {
                  $format = "Console";
                  $output = "";
            }

            my $allSuppress = join(',', suppressions());
            my $rvError = shell('command -v rv-error || true')->stdout()->run();
            chop($rvError);
            $rvError = quote(printable($rvError));

            my $messageLength = 80;
            if (arg('-fmessage-length=')) {
                  $messageLength = arg('-fmessage-length=');
            }

            quote(printable(quote(printable
                  ( "{\"suppressions\": [$allSuppress]"
                  . ",\"message_length\": $messageLength"
                  . ",\"format\": \"$format\""
                  . ",\"previous_errors\": []"
                  . ",\"fatal_errors\": " . (arg('-Wfatal-errors')? 'true' : 'false')
                  . ",\"rv_error\": $rvError"
                  . "$output}"
                  ))));
      };
      return $json;
}

sub interruptHandler {
      # Call single cleanup point.
      finalCleanup();
      # Since we were interrupted, we should exit with a non-zero code.
      exit 1;
}

# This subroutine can be used as a way to ensure we clean up all resources
# whenever we exit. This is going to be mostly temp files. If the program
# terminates for almost any reason, this code will be executed.
sub finalCleanup { }

# This block gets run at the end of a normally terminating program, whether it
# simply exits, or dies. We use this to clean up.
END {
      # $? contains the value the program would normally have exited with.
      my $retval = $?;
      # Call single cleanup point.
      finalCleanup();
      exit $retval;
}