
(********************************************************************)
(*                                                                  *)
(*  make.s7i      Make library to manage the compilation process    *)
(*  Copyright (C) 2010 - 2013  Thomas Mertes                        *)
(*                                                                  *)
(*  This file is part of the Seed7 Runtime Library.                 *)
(*                                                                  *)
(*  The Seed7 Runtime Library is free software; you can             *)
(*  redistribute it and/or modify it under the terms of the GNU     *)
(*  Lesser General Public License as published by the Free Software *)
(*  Foundation; either version 2.1 of the License, or (at your      *)
(*  option) any later version.                                      *)
(*                                                                  *)
(*  The Seed7 Runtime Library is distributed in the hope that it    *)
(*  will be useful, but WITHOUT ANY WARRANTY; without even the      *)
(*  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR *)
(*  PURPOSE.  See the GNU Lesser General Public License for more    *)
(*  details.                                                        *)
(*                                                                  *)
(*  You should have received a copy of the GNU Lesser General       *)
(*  Public License along with this program; if not, write to the    *)
(*  Free Software Foundation, Inc., 51 Franklin Street,             *)
(*  Fifth Floor, Boston, MA  02110-1301, USA.                       *)
(*                                                                  *)
(********************************************************************)


include "makedata.s7i";
include "stdio.s7i";
include "osfiles.s7i";
include "time.s7i";
include "getf.s7i";
include "shell.s7i";


const set of char: parameter_char is {'!' .. '~'} - {'<', '>', '|', ';', ')'};
const set of char: dos_parameter_char is {'!' .. '~'} - {'&', '<', '>', '|'};

const type: makeFlag is new enum
    ignoreErrors. dontExecute, silentMode
  end enum;

const type: makeFlags is set of makeFlag;


const func string: getCommandParameter (inout string: stri) is func
  result
    var string: symbol is "";
  local
    var integer: leng is 0;
    var integer: pos is 1;
  begin
    leng := length(stri);
    if pos <= leng then
      incr(pos);
      while pos <= leng and stri[pos] in parameter_char do
        incr(pos);
      end while;
      symbol := stri[.. pred(pos)];
      stri := stri[pos ..];
    end if;
  end func;


(**
 *  Read a parameter for a Unix command from a 'string'.
 *  Unix parameters consist of unquoted and quoted parts. Quoted parts
 *  can be quoted with single quotes (') or with double quotes (").
 *  A single quoted part ends with the next single quote. A double
 *  quoted part ends with unescaped double quotes. In a double quoted
 *  part the sequences \" and \\ do not terminate the quoted part and
 *  describe a double quote (") respectively a backslash (\). In an
 *  unquoted part a backslash (\) can used to escape characters that
 *  would otherwise have a special meaning. The backslash is ignored
 *  and the character after it is added to the word. To represent a
 *  backslash it must be doubled. When the function is called it is
 *  assumed that stri[1] contains the first character of the parameter.
 *  When the function is left ''stri'' is empty or stri[1] contains the
 *  character after the parameter.
 *  @return the next parameter for a Unix command.
 *)
const func string: getUnixCommandParameter (inout string: stri, in set of char: allowed) is func
  result
    var string: symbol is "";
  local
    var integer: leng is 0;
    var integer: pos is 1;
  begin
    leng := length(stri);
    repeat
      if stri[pos] = '"' then
        incr(pos);
        while pos <= leng and stri[pos] <> '"' do
          if stri[pos] = '\\' and pos < leng and (stri[succ(pos)] = '"' or stri[succ(pos)] = '\\') then
            incr(pos);
          end if;
          symbol &:= stri[pos];
          incr(pos);
        end while;
        incr(pos);
      elsif stri[pos] = ''' then
        incr(pos);
        while pos <= leng and stri[pos] <> ''' do
          symbol &:= stri[pos];
          incr(pos);
        end while;
        incr(pos);
      else
        repeat
          if stri[pos] = '\\' and pos < leng then
            incr(pos);
          end if;
          symbol &:= stri[pos];
          incr(pos);
        until pos > leng or stri[pos] not in allowed or stri[pos] = '"' or stri[pos] = ''';
      end if;
    until pos > leng or stri[pos] not in allowed;
    stri := stri[pos ..];
  end func;


(**
 *  Read a parameter for a Dos command from a 'string'.
 *  Dos parameters consist of unquoted and quoted parts. Quoted parts
 *  start with a double quote (") and end with the next double quote.
 *  The starting and ending double quotes are part of the result.
 *  In an unquoted part a caret (^) can used to escape characters that
 *  would otherwise have a special meaning. The caret is ignored and
 *  the character after it is added to the word. To represent a caret
 *  it must be doubled. When the function is called it is assumed that
 *  stri[1] contains the first character of the parameter. When the
 *  function is left 'stri' is empty or stri[1] contains the character
 *  after the parameter.
 *  @return the next parameter for a Dos command.
 *)
const func string: getDosCommandParameter (inout string: stri, in set of char: allowed) is func
  result
    var string: symbol is "";
  local
    var integer: leng is 0;
    var integer: pos is 1;
  begin
    leng := length(stri);
    repeat
      # writeln("source char: " <& stri[pos]);
      if stri[pos] = '"' then
        # Inside quotation mode
        repeat
          symbol &:= stri[pos];
          incr(pos);
        until pos > leng or stri[pos] = '"';
        if pos <= leng then
          # Consume the terminating quotation mark
          symbol &:= '"';
          incr(pos);
        end if;
      else
        # Outside quotation mode
        repeat
          if stri[pos] = '^' then
            incr(pos);
            if pos <= leng then
              symbol &:= stri[pos];
            end if;
          else
            symbol &:= stri[pos];
          end if;
          incr(pos);
        until pos > leng or stri[pos] not in allowed or stri[pos] = '"';
      end if;
    until pos > leng or stri[pos] not in allowed;
    stri := stri[pos ..];
  end func;


const func boolean: doOneCommand (inout string: command,
    inout string: commandOutput, in boolean: doLog) is forward;


const func string: execBacktickCommands (in string: stri) is func
  result
    var string: withBacktickOutput is "";
  local
    var integer: backtickPos is 0;
    var integer: closingBacktickPos is 0;
    var string: command is "";
    var file: commandFile is STD_NULL;
    var string: backtickOutput is "";
  begin
    withBacktickOutput := stri;
    backtickPos := pos(withBacktickOutput, '`');
    while backtickPos <> 0 do
      closingBacktickPos := pos(withBacktickOutput, '`', succ(backtickPos));
      if closingBacktickPos <> 0 then
        command := withBacktickOutput[succ(backtickPos) .. pred(closingBacktickPos)];
        if not doOneCommand(command, backtickOutput, FALSE) then
          commandFile := popen(command, "r");
          if commandFile <> STD_NULL then
            backtickOutput := gets(commandFile, 999999999);
            while endsWith(backtickOutput, "\r\n") do
              backtickOutput := backtickOutput[.. length(backtickOutput) - 2];
            end while;
            while endsWith(backtickOutput, "\n") do
              backtickOutput := backtickOutput[.. pred(length(backtickOutput))];
            end while;
          else
            backtickOutput := "";
          end if;
        end if;
        withBacktickOutput := withBacktickOutput[.. pred(backtickPos)] & backtickOutput &
                              withBacktickOutput[succ(closingBacktickPos) ..];
      end if;
      backtickPos := pos(withBacktickOutput, '`', succ(backtickPos));
    end while;
  end func;


const proc: doRm (in string: commandName, inout string: command, in boolean: doLog) is func
  local
    var string: parameter is "";
    var boolean: force is FALSE;
    var string: fileName is "";
  begin
    if doLog then
      write(commandName);
    end if;
    skipWhiteSpace(command);
    while command <> "" do
      parameter := getCommandParameter(command);
      if doLog then
        write(" " <& parameter);
      end if;
      if parameter = "-f" then
        force := TRUE;
      else
        parameter := convDosPath(parameter);
        if pos(parameter, "*") <> 0 or pos(parameter, "?") <> 0 then
          for fileName range findMatchingFiles(parameter) do
            removeFile(fileName);
          end for;
        else
          if fileType(parameter) <> FILE_ABSENT then
            removeFile(parameter);
          end if;
        end if;
      end if;
      skipWhiteSpace(command);
    end while;
  end func;


const proc: doCp (inout string: command, in boolean: cpCommand, in boolean: doLog) is func
  local
    var string: parameter is "";
    var boolean: overwriteExisting is FALSE;
    var boolean: archive is FALSE;
    var string: fileName is "";
    var array string: fileList is 0 times "";
    var string: destination is "";
    var string: destFileName is "";
    var integer: slashPos is 0;
  begin
    if doLog then
      write([]("copy", "cp")[ord(cpCommand)]);
    end if;
    overwriteExisting := cpCommand;
    skipWhiteSpace(command);
    while command <> "" do
      parameter := getCommandParameter(command);
      if doLog then
        write(" " <& parameter);
      end if;
      if parameter = "/Y" then
        overwriteExisting := TRUE;
      elsif parameter = "-n" then
        overwriteExisting := FALSE;
      elsif parameter = "-a" or parameter = "-p" then
        archive := TRUE;
      else
        parameter := convDosPath(parameter);
        if pos(parameter, "*") <> 0 or pos(parameter, "?") <> 0 then
          for fileName range findMatchingFiles(parameter) do
            fileList &:= [] (fileName);
          end for;
        else
          fileList &:= [] (parameter);
        end if;
      end if;
      skipWhiteSpace(command);
    end while;
    if length(fileList) >= 2 then
      destination := fileList[length(fileList)];
      fileList := fileList[.. pred(length(fileList))];
      if fileType(destination) = FILE_DIR then
        for fileName range fileList do
          if fileType(fileName) = FILE_REGULAR or fileType(fileName) = FILE_DIR then
            slashPos := rpos(fileName, "/");
            if slashPos = 0 then
              destFileName := destination & "/" & fileName;
            else
              destFileName := destination & "/" & fileName[succ(slashPos) ..];
            end if;
            if fileType(destFileName) = FILE_REGULAR and overwriteExisting then
              block
                removeFile(destFileName);
              exception
                catch FILE_ERROR:
                  writeln(" *** Cannot remove " <& destFileName);
              end block;
            end if;
            if fileType(destFileName) = FILE_ABSENT then
              # write("copyFile " <& fileName <& " " <& destination);
              if archive then
                cloneFile(fileName, destFileName);
              else
                copyFile(fileName, destFileName);
              end if;
            end if;
          end if;
        end for;
      elsif length(fileList) = 1 then
        fileName := fileList[1];
        if fileType(fileName) = FILE_REGULAR or fileType(fileName) = FILE_DIR then
          if fileType(destination) = FILE_REGULAR and overwriteExisting then
            block
              removeFile(destination);
            exception
              catch FILE_ERROR:
                writeln(" *** Cannot remove " <& destFileName);
            end block;
          end if;
          if fileType(destination) = FILE_ABSENT then
            # write("copyFile " <& fileName <& " " <& destination);
            if archive then
              cloneFile(fileName, destFileName);
            else
              copyFile(fileName, destFileName);
            end if;
          end if;
        end if;
      end if;
    end if;
  end func;


const func string: doPwd (inout string: command, in boolean: doLog) is func
  result
    var string: commandOutput is "";
  begin
    if doLog then
      write("pwd");
    end if;
    skipWhiteSpace(command);
    if startsWith(command, "-W") then
      if doLog then
        write(" -W");
      end if;
      command := command[3 ..];
      skipWhiteSpace(command);
    end if;
    commandOutput := getcwd;
  end func;


const func string: doEcho (inout string: command, in boolean: doLog) is func
  result
    var string: commandOutput is "";
  local
    var string: whiteSpace is "";
    var string: parameter is "";
  begin
    whiteSpace := getWhiteSpace(command);
    if command <> "" and (command[1] = '"' or command[1] = ''') then
      while command <> "" and command[1] in parameter_char do
        if commandOutput <> "" then
          commandOutput &:= whiteSpace;
        end if;
        parameter := getUnixCommandParameter(command, parameter_char);
        commandOutput &:= execBacktickCommands(parameter);
        whiteSpace := getWhiteSpace(command);
      end while;
    else
      while command <> "" and command[1] in parameter_char do
        parameter := getDosCommandParameter(command, dos_parameter_char);
        commandOutput &:= parameter;
        commandOutput &:= getWhiteSpace(command);
      end while;
    end if;
    if doLog then
      write("echo " <& commandOutput);
    end if;
  end func;


const proc: doCd (inout string: command, in boolean: doLog) is func
  local
    var string: parameter is "";
  begin
    skipWhiteSpace(command);
    if command <> "" then
      parameter := getCommandParameter(command);
      if doLog then
        write("cd " <& parameter);
      end if;
      parameter := convDosPath(parameter);
      if fileType(parameter) = FILE_DIR then
        chdir(parameter);
      else
        writeln(" *** cd " <& parameter <& " - No such file or directory");
        # writeln(getcwd);
        # writeln(fileType(parameter));
      end if;
    end if;
  end func;


const proc: make (in string: makefile, in array string: targets, in makeFlags: flags) is forward;


const proc: doMake (inout string: command, in boolean: doLog) is func
  local
    var string: parameter is "";
    var string: makefile is "";
    var array string: targets is 0 times "";
    var makeFlags: flags is makeFlags.value;
    var string: savedCurrentDir is "";
  begin
    savedCurrentDir := getcwd;
    skipWhiteSpace(command);
    if doLog then
      write("make");
    end if;
    while command <> "" and command[1] in parameter_char do
      parameter := getCommandParameter(command);
      if doLog then
        write(" " <& parameter);
      end if;
      if length(parameter) >= 2 and parameter[1] = '-' then
        if parameter = "-C" then
          skipWhiteSpace(command);
          parameter := convDosPath(getCommandParameter(command));
          chdir(parameter);
          if doLog then
            write(" " <& parameter);
          end if;
        elsif parameter = "-f" then
          skipWhiteSpace(command);
          makefile := convDosPath(getCommandParameter(command));
          if doLog then
            write(" " <& makefile);
          end if;
        elsif parameter = "-i" then
          incl(flags, ignoreErrors);
        elsif parameter = "-n" then
          incl(flags, dontExecute);
        elsif parameter = "-s" then
          incl(flags, silentMode);
        end if;
      else
        targets &:= parameter;
      end if;
      skipWhiteSpace(command);
    end while;
    if doLog then
      writeln;
    end if;
    if makefile = "" then
      if fileType("makefile") = FILE_REGULAR then
        makefile := "makefile";
      elsif fileType("Makefile") = FILE_REGULAR then
        makefile := "Makefile";
      end if;
    end if;
    make(makefile, targets, flags);
    chdir(savedCurrentDir);
  end func;


const func boolean: doOneCommand (inout string: command,
    inout string: commandOutput, in boolean: doLog) is func
  result
    var boolean: done is TRUE;
  local
    var string: commandName is "";
  begin
    if command <> "" and command[1] = '#' then
      command := "";
      commandOutput := "";
    else
      commandName := lower(getWord(command));
      # writeln("doOneCommand: " <& commandName);
      if commandName = "rm" or commandName = "del" then
        doRm(commandName, command, doLog);
        commandOutput := "";
      elsif commandName = "cp" then
        doCp(command, TRUE, doLog);
        commandOutput := "";
      elsif commandName = "copy" then
        doCp(command, FALSE, doLog);
        commandOutput := "";
      elsif commandName = "pwd" then
        commandOutput := doPwd(command, doLog);
      elsif commandName = "echo" then
        commandOutput := doEcho(command, doLog);
      elsif commandName = "cd" then
        doCd(command, doLog);
        commandOutput := "";
      elsif commandName = "make" or commandName = "make7" then
        doMake(command, doLog);
        commandOutput := "";
      elsif commandName = "(" then
        done := doOneCommand(command, commandOutput, doLog);
      else
        done := FALSE;
        commandOutput := "";
      end if;
    end if;
  end func;


const proc: appendToFile (in string: file_name, in string: stri) is func
  local
    var file: work_file is STD_NULL;
  begin
    if stri <> "" then
      work_file := open(file_name, "a");
      if work_file <> STD_NULL then
        write(work_file, stri);
        close(work_file);
      end if;
    end if;
  end func;


const func boolean: doCommands (inout string: command, in boolean: doLog) is func
  result
    var boolean: done is TRUE;
  local
    var integer: quotePos is 0;
    var string: commandOutput is "";
    var string: redirect is "";
    var string: fileName is "";
  begin
    if startsWith(command, "\"") then
      quotePos := rpos(command, "\"");
      if quotePos <> 0 and quotePos <> 1 then
        command := command[2 .. pred(quotePos)] & command[succ(quotePos) ..];
      end if;
    end if;
    repeat
      done := doOneCommand(command, commandOutput, doLog);
      if done then
        skipWhiteSpace(command);
        redirect := getWord(command);
        if redirect = ">" then
          skipWhiteSpace(command);
          fileName := getCommandParameter(command);
          if doLog then
            writeln(" > " <& fileName);
          end if;
          if fileName <> "/dev/null" and fileName <> "NUL:" and fileName <> "NUL" then
            fileName := convDosPath(fileName);
            putf(fileName, commandOutput & "\n");
          end if;
        elsif redirect = ">>" then
          skipWhiteSpace(command);
          fileName := getCommandParameter(command);
          if doLog then
            writeln(" >> " <& fileName);
          end if;
          if fileName <> "/dev/null" and fileName <> "NUL:" and fileName <> "NUL" then
            fileName := convDosPath(fileName);
            appendToFile(fileName, commandOutput & "\n");
          end if;
        elsif commandOutput <> "" then
          writeln(commandOutput);
        end if;
        skipWhiteSpace(command);
        if command <> "" and command[1] = ';' then
          command := command[2 ..];
          skipWhiteSpace(command);
        end if;
      end if;
    until command = "" or not done;
  end func;


const func integer: processCommand (in makeDataType: makeData, in var string: command,
    in boolean: doLog) is func
  result
    var integer: commandStatus is 0;
  local
    var string: fullCommand is "";
    var integer: gtPos is 0;
    var boolean: doRedirect is FALSE;
    var boolean: doAppend is FALSE;
    var string: fileName is "";
    var file: aFile is STD_NULL;
    var string: commandOutput is "";
  begin
    # writeln("process command: " <& command);
    fullCommand := command;
    if not doCommands(command, doLog) then
      gtPos := rpos(fullCommand, ">");
      if gtPos >= 2 then
        fileName := fullCommand[succ(gtPos) ..];
        skipSpace(fileName);
        if fullCommand[pred(gtPos)] = '>' and gtPos >= 3 and
            fullCommand[gtPos - 2] not in {'\\', '^'} then
          doAppend := TRUE;
          fullCommand := fullCommand[.. gtPos - 2];
        elsif fullCommand[pred(gtPos)] not in {'\\', '^', '2'} then
          doRedirect := TRUE;
          fullCommand := fullCommand[.. pred(gtPos)];
        end if;
      end if;
      if doRedirect or doAppend then
        if doLog then
          write(fullCommand);
          if doAppend then
            write(">");
          end if;
          writeln("> " & fileName);
        end if;
        if startsWith(fullCommand, "\"") then
          command := getQuotedText(fullCommand);
        else
          command := getWord(fullCommand);
        end if;
        # writeln("cmd: " <& literal(command) <& " " <& literal(convDosPath(command)) <& " " <& literal(fullCommand));
        aFile := popen(convDosPath(command), fullCommand, "r");
        if aFile <> STD_NULL then
          commandOutput := gets(aFile, 999999999);
          close(aFile);
          if fileName <> "/dev/null" and fileName <> "NUL:" and fileName <> "NUL" then
            if doAppend then
              appendToFile(fileName, commandOutput);
            else
              putf(fileName, commandOutput);
            end if;
          end if;
        end if;
      else
        if doLog then
          writeln(fullCommand);
          flush(STD_OUT);
        end if;
        if startsWith(fullCommand, "\"") then
          command := getQuotedText(fullCommand);
        else
          command := getWord(fullCommand);
        end if;
        # writeln("cmd: " <& literal(command) <& " " <& literal(convDosPath(command)) <& " " <& literal(fullCommand));
        commandStatus := shell(convDosPath(command), fullCommand);
      end if;
    end if;
  end func;


const func string: expandInternalMacro (in char: macro, in ruleType: rule,
    in array string: strictDependencies) is func
  result
    var string: expandedMacro is "";
  begin
    case macro of
      when {'@'}:
          expandedMacro := rule.name;
      when {'<'}:
          if length(rule.dependencies) <> 0 then
            expandedMacro := rule.dependencies[1];
          end if;
      when {'?'}:
          expandedMacro := join(strictDependencies, " ");
      when {'^'}:
          expandedMacro := join(strictDependencies, " ");
      when {'+'}:
          expandedMacro := join(rule.dependencies, " ");
    end case;
  end func;


const func string: applyInternalMacros (in ruleType: rule, in string: stri) is func
  result
    var string: macrosApplied is "";
  local
    const set of char: iternalMacroDesignator is {'@', '<', '?', '^', '+'};
    var integer: dollarPos is 0;
    var integer: pos is 0;
    var string: dependency is "";
    var set of string: dependencySet is (set of string).value;
    var array string: strictDependencies is 0 times "";
    var char: macro is ' ';
    var string: suffix is "";
    var string: replacement is "";
  begin
    for dependency range rule.dependencies do
      if dependency not in dependencySet then
        strictDependencies &:= dependency;
        incl(dependencySet, dependency);
      end if;
    end for;
    macrosApplied := stri;
    dollarPos := pos(macrosApplied, '$');
    while dollarPos <> 0 do
      if dollarPos < length(macrosApplied) then
        if macrosApplied[succ(dollarPos)] in iternalMacroDesignator then
          macrosApplied := macrosApplied[.. pred(dollarPos)] &
              expandInternalMacro(macrosApplied[succ(dollarPos)], rule, strictDependencies) &
              macrosApplied[dollarPos + 2 ..];
        elsif macrosApplied[succ(dollarPos)] = '(' then
          pos := dollarPos + 2;
          if pos <= length(macrosApplied) and macrosApplied[pos] in iternalMacroDesignator then
            macro := macrosApplied[pos];
            incr(pos);
            if pos <= length(macrosApplied) then
              if macrosApplied[pos] = ')' then
                macrosApplied := macrosApplied[.. pred(dollarPos)] &
                    expandInternalMacro(macro, rule, strictDependencies) &
                    macrosApplied[succ(pos) ..];
              elsif macrosApplied[pos] = ':' then
                incr(pos);
                suffix := "";
                while pos <= length(macrosApplied) and macrosApplied[pos] <> '=' do
                  suffix &:= macrosApplied[pos];
                  incr(pos);
                end while;
                if pos <= length(macrosApplied) then
                  incr(pos);
                  replacement := "";
                  while pos <= length(macrosApplied) and macrosApplied[pos] <> ')' do
                    replacement &:= macrosApplied[pos];
                    incr(pos);
                  end while;
                  if pos <= length(macrosApplied) then
                    macrosApplied := macrosApplied[.. pred(dollarPos)] &
                        replaceSuffixes(expandInternalMacro(macro, rule, strictDependencies), suffix, replacement) &
                        macrosApplied[succ(pos) ..];
                  end if;
                end if;
              end if;
            end if;
          end if;
        elsif macrosApplied[succ(dollarPos)] = '$' then
          macrosApplied := macrosApplied[.. pred(dollarPos)] & macrosApplied[succ(dollarPos) ..];
        end if;
      end if;
      dollarPos := pos(macrosApplied, '$', succ(dollarPos));
    end while;
  end func;


const proc: processCommands (in makeDataType: makeData, inout ruleType: rule) is func
  local
    var string: command is "";
    var integer: commandStatus is 0;
    var boolean: printCommand is TRUE;
    var boolean: ignoreError is FALSE;
  begin
    for command range rule.commands do
      command := applyInternalMacros(rule, command);
      printCommand := TRUE;
      ignoreError := FALSE;
      if startsWith(command, "@-") or startsWith(command, "-@")then
        printCommand := FALSE;
        ignoreError := TRUE;
        command := command[3 ..];
      elsif startsWith(command, "@") then
        printCommand := FALSE;
        command := command[2 ..];
      elsif startsWith(command, "-") then
        ignoreError := TRUE;
        command := command[2 ..];
      end if;
      if printCommand and not makeData.inSilentMode then
        writeln(applyMacros(makeData.macros, command, TRUE));
        flush(STD_OUT);
      end if;
      if makeData.executeCommands then
        command := applyMacros(makeData.macros, command, FALSE);
        commandStatus := processCommand(makeData, command, FALSE);
        if commandStatus <> 0 and not makeData.doIgnoreErrors then
          writeln(" *** [" <& rule.name <& "] Error " <& commandStatus);
          exit(PROGRAM);
        end if;
      end if;
    end for;
    rule.commandsDone := TRUE;
  end func;


const func string: pattern_match (in var string: main_stri, in string: pattern) is func
  result
    var string: stem is "";
  local
    var integer: percentPos is 0;
    var integer: main_index is 2;
    var string: pattern_tail is "";
  begin
    if startsWith(main_stri, "./") then
      main_stri := main_stri[3 ..];
    end if;
    percentPos := pos(pattern, '%');
    if percentPos = rpos(pattern, '%') then
      if startsWith(main_stri, pattern[.. pred(percentPos)]) and
          endsWith(main_stri, pattern[succ(percentPos) ..]) then
        stem := main_stri[percentPos .. length(main_stri) - length(pattern) + percentPos];
      end if;
    end if;
  end func;


const proc: processRule (inout makeDataType: makeData, in string: targetName) is forward;


const proc: processRule (inout makeDataType: makeData, inout ruleType: rule) is func
  local
    var string: dependency is "";
    var string: dependencyFile is "";
    var string: ruleFile is "";
    var time: targetTime is time.value;
    var boolean: commandsNecessary is FALSE;
  begin
    (* write(rule.name <& ":");
      for dependency range rule.dependencies do
        write(" " <& dependency);
      end for;
      writeln; *)
    for dependency range rule.dependencies do
      processRule(makeData, dependency);
    end for;
    if makeData.executeCommands or not rule.commandsDone then
      ruleFile := convDosPath(rule.name);
      if fileType(ruleFile) = FILE_ABSENT then
        processCommands(makeData, rule);
      else
        targetTime := getMTime(ruleFile);
        for dependency range rule.dependencies do
          dependencyFile := convDosPath(applyMacros(makeData.macros, dependency, FALSE));
          if dependencyFile <> "" then
            if not makeData.executeCommands then
              commandsNecessary := TRUE;
            elsif fileType(dependencyFile) = FILE_ABSENT then
              writeln(" *** File " <& dependencyFile <& " missing");
            elsif getMTime(dependencyFile) > targetTime then
              commandsNecessary := TRUE;
            end if;
          end if;
        end for;
        if commandsNecessary then
          processCommands(makeData, rule);
        end if;
      end if;
    end if;
  end func;


const proc: processPatternRule (inout makeDataType: makeData, in string: targetName,
    inout ruleType: dependencyRule) is func
  local
    var string: ruleName is "";
    var string: stem is "";
    var boolean: found is FALSE;
    var string: ruleNameFound is "";
    var string: stemFound is "";
    var ruleType: patternRule is ruleType.value;
    var ruleType: actualRule is ruleType.value;
    var string: dependency is "";
  begin
    for key ruleName range makeData.patternRules do
      # writeln("try " <& ruleName);
      stem := pattern_match(targetName, ruleName);
      if stem <> "" then
        # writeln("Pattern rule: " <& ruleName <& " stem: " <& stem);
        if not found or length(stem) < length(stemFound) then
          stemFound := stem;
          ruleNameFound := ruleName;
        end if;
        found := TRUE;
      end if;
    end for;
    if found then
      patternRule := makeData.patternRules[ruleNameFound];
      actualRule.name := targetName;
      for dependency range patternRule.dependencies do
        actualRule.dependencies &:= replace(dependency, "%", stemFound);
      end for;
      for dependency range dependencyRule.dependencies do
        actualRule.dependencies &:= dependency;
      end for;
      actualRule.commands := patternRule.commands;
      processRule(makeData, actualRule);
    else
      processRule(makeData, dependencyRule);
    end if;
  end func;


const proc: processRule (inout makeDataType: makeData, in string: targetName) is func
  local
    var string: ruleName is "";
    var ruleType: emptyRule is ruleType.value;
  begin
    ruleName := applyMacros(makeData.macros, targetName, FALSE);
    if ruleName <> "" then
      # writeln("process rule: " <& ruleName);
      if ruleName in makeData.rules then
        if length(makeData.rules[ruleName].commands) <> 0 then
          processRule(makeData, makeData.rules[ruleName]);
        else
          processPatternRule(makeData, ruleName, makeData.rules[ruleName]);
        end if;
      else
        processPatternRule(makeData, ruleName, emptyRule);
      end if;
    end if;
  end func;


(**
 *  Use rules and commands from a makefile to create the specified ''targets''.
 *  @param makefile Path of the makefile which contains rules and commands
 *                  in the usual makefile syntax.
 *  @param targets The targets that should be made.
 *  @param flags Options which affect command execution
 *  @param macros Predefined make macros.
 *)
const proc: make (in string: makefile, in array string: targets, in makeFlags: flags,
    in stringHash: macros) is func
  local
    var ruleType: rule is ruleType.value;
    var makeDataType: makeData is makeDataType.value;
    var string: target is "";
  begin
    # writeln("make -f " <& makefile <& " " <& join(targets, " "));
    makeData.executeCommands := dontExecute not in flags;
    makeData.inSilentMode := silentMode in flags;
    makeData.doIgnoreErrors := ignoreErrors in flags;
    makeData.macros := macros;
    if "CPPFLAGS" not in makeData.macros then
      makeData.macros @:= ["CPPFLAGS"] "";
    end if;
    if "CFLAGS" not in makeData.macros then
      makeData.macros @:= ["CFLAGS"] "";
    end if;
    if "CC" not in makeData.macros then
      makeData.macros @:= ["CC"] "cc";
    end if;
    makeData.macros @:= ["MAKE"] "make7";
    if length(targets) <> 0 then
      makeData.macros @:= ["MAKECMDGOALS"] join(targets, " ");
    end if;
    readMakefile(makeData, makefile);
    if ".c.o" in makeData.rules and "%.o" not in makeData.patternRules then
      rule.name := "%.o";
      rule.dependencies := [] ("%.c");
      rule.commands := makeData.rules[".c.o"].commands;
      makeData.patternRules @:= [rule.name] rule;
      excl(makeData.rules, ".c.o");
    elsif "%.o" not in makeData.patternRules then
      rule.name := "%.o";
      rule.dependencies := [] ("%.c");
      rule.commands := [] (applyMacros(makeData.macros, "$(CC) -c $(CPPFLAGS) $(CFLAGS) $< -o $@", TRUE));
      makeData.patternRules @:= [rule.name] rule;
    end if;
    if ".c.obj" in makeData.rules and "%.obj" not in makeData.patternRules then
      rule.name := "%.obj";
      rule.dependencies := [] ("%.c");
      rule.commands := makeData.rules[".c.obj"].commands;
      makeData.patternRules @:= [rule.name] rule;
      excl(makeData.rules, ".c.obj");
    elsif "%.obj" not in makeData.patternRules then
      rule.name := "%.obj";
      rule.dependencies := [] ("%.c");
      rule.commands := [] (applyMacros(makeData.macros, "$(CC) -c $(CPPFLAGS) $(CFLAGS) $< -o $@", TRUE));
      makeData.patternRules @:= [rule.name] rule;
    end if;
    if length(targets) = 0 then
      processRule(makeData, makeData.nameOfFirstRule);
    else
      for target range targets do
        processRule(makeData, target);
      end for;
    end if;
  end func;


(**
 *  Use rules and commands from a makefile to create the specified ''targets''.
 *  @param makefile Path of the makefile which contains rules and commands
 *                  in the usual makefile syntax.
 *  @param targets The targets that should be made.
 *  @param flags Options which affect command execution
 *)
const proc: make (in string: makefile, in array string: targets, in makeFlags: flags) is func
  begin
    make(makefile, targets, flags, stringHash.value);
  end func;


(**
 *  Use rules and commands from a makefile to create the specified ''target''.
 *  @param makefile Path of the makefile which contains rules and commands
 *                  in the usual makefile syntax.
 *  @param target The target that should be made.
 *  @param flags Options which affect command execution
 *  @param macros Predefined make macros.
 *)
const proc: make (in string: makefile, in string: target, in makeFlags: flags, in stringHash: macros) is func
  begin
    if target = "" then
      make(makefile, 0 times "", flags, macros);
    else
      make(makefile, [] (target), flags, macros);
    end if;
  end func;


(**
 *  Use rules and commands from a makefile to create the specified ''target''.
 *  @param makefile Path of the makefile which contains rules and commands
 *                  in the usual makefile syntax.
 *  @param target The target that should be made.
 *  @param flags Options which affect command execution
 *)
const proc: make (in string: makefile, in string: target, in makeFlags: flags) is func
  begin
    make(makefile, target, flags, stringHash.value);
  end func;
