#!/usr/bin/env bash
set -euo pipefail

ROOT="$(cd "$(dirname "${BASH_SOURCE[0]}")/.." && pwd)"

SUITE_URL="${FLOWLOG_INRIA_SUITE_URL:-http://pauillac.inria.fr/~deransar/prolog/inriasuite.tar.gz}"
DEST_DIR="$ROOT/../build/inria_suite"
TARBALL="$DEST_DIR/inriasuite.tar.gz"
SUITE_DIR="$DEST_DIR/inriasuite"
DRIVER="$SUITE_DIR/inriasuite.pl"
WRAPPER="$DEST_DIR/flowlog_inriasuite.pl"

force=0
case "${1:-}" in
  "" ) ;;
  --force ) force=1 ;;
  * )
    echo "usage: $0 [--force]" >&2
    exit 2
    ;;
esac

mkdir -p "$DEST_DIR"

if [[ "$force" -eq 1 || ! -f "$TARBALL" ]]; then
  echo "inria: fetching: $SUITE_URL" >&2
  if command -v fetch >/dev/null 2>&1; then
    fetch -o "$TARBALL" "$SUITE_URL"
  elif command -v curl >/dev/null 2>&1; then
    curl -fsSL -o "$TARBALL" "$SUITE_URL"
  elif command -v wget >/dev/null 2>&1; then
    wget -qO "$TARBALL" "$SUITE_URL"
  else
    echo "inria: cannot fetch suite (need one of: fetch, curl, wget)" >&2
    exit 1
  fi
fi

if [[ "$force" -eq 1 || ! -d "$SUITE_DIR" || ! -f "$DRIVER" ]]; then
  rm -rf "$SUITE_DIR" >/dev/null 2>&1 || true
  tar -xzf "$TARBALL" -C "$DEST_DIR"
fi

if [[ ! -f "$DRIVER" ]]; then
  echo "inria: driver not found after extract: $DRIVER" >&2
  exit 1
fi

# Known INRIA-suite expectations that diverge from modern ISO implementations
# (confirmed with Trealla and Scryer). Patch these locally so `tests/run_inria_suite.sh`
# can be used as a regression suite for Flowlog's ISO behavior.
patch_inria_suite() {
  local tmp

  if [[ -f "$SUITE_DIR/catch-and-throw" ]]; then
    tmp="$(mktemp "$DEST_DIR/.catch-and-throw.XXXXXX")"
    awk -f - "$SUITE_DIR/catch-and-throw" >"$tmp" <<'AWK'
{
  if ($0 ~ /throw\(blabla\)/ && $0 ~ /system_error/) {
    gsub(/system_error/, "unexpected_ball(blabla)")
  }
  print
}
AWK
    mv "$tmp" "$SUITE_DIR/catch-and-throw"
  fi

  if [[ -f "$SUITE_DIR/sub_atom" ]]; then
    tmp="$(mktemp "$DEST_DIR/.sub_atom.XXXXXX")"
    awk -f - "$SUITE_DIR/sub_atom" >"$tmp" <<'AWK'
BEGIN { in_block = 0 }
in_block == 0 && $0 ~ /^[[:space:]]*\[sub_atom\('ab', Before, Length, After, Sub_atom\),/ {
  print "[sub_atom('ab', Before, Length, After, Sub_atom),"
  print "\t[[Before <-- 0, Length <-- 0, Sub_atom <-- ''],"
  print "\t [Before <-- 0, Length <-- 1, Sub_atom <-- 'a'],"
  print "\t [Before <-- 0, Length <-- 2, Sub_atom <-- 'ab'],"
  print "\t [Before <-- 1, Length <-- 0, Sub_atom <-- ''],"
  print "\t [Before <-- 1, Length <-- 1, Sub_atom <-- 'b'],"
  print "\t [Before <-- 2, Length <-- 0, Sub_atom <-- '']]]."
  in_block = 1
  next
}
in_block == 1 {
  if ($0 ~ /\]\]\]\./) {
    in_block = 0
  }
  next
}
{ print }
AWK
    mv "$tmp" "$SUITE_DIR/sub_atom"
  fi
}

patch_inria_suite

suite_abs="$(cd "$SUITE_DIR" && pwd)"
suite_abs_slash="${suite_abs%/}/"

{
  printf '%% Auto-generated by tests/inria/setup_inria_suite.sh. Do not edit.\n'
  printf '%% Source: %s\n\n' "$SUITE_URL"
  cat <<'EOF'
% The INRIA suite driver is intended to be "vanilla ISO Prolog", but its harness
% uses a couple of common library predicates that are not ISO/IEC 13211-1 core.
% Provide tiny reference definitions so the suite can run without depending on
% system-specific libraries/modules.

append([], Ys, Ys).
append([X|Xs], Ys, [X|Zs]) :- append(Xs, Ys, Zs).

member(X, [X|_]).
member(X, [_|Xs]) :- member(X, Xs).

% Flowlog-specific harness overrides
%
% The upstream INRIA harness uses recursion for `loop_through/2`, which can
% tickle edge cases in some embedded runtimes. Use a repeat/fail loop instead.
%
% It also collects substitutions for *all* goal variables, but the INRIA test
% expectations typically mention only the variables of interest (via `<--/2`).
% Derive the variable set from the Expected substitutions to match the suite.

loop_through(F, S) :-
  repeat,
    catch(read(S, X), B, X = B),
    ( X = end_of_file ->
        !
    ; reset_flags,
      ( test(F, X) -> true ; update_score(F, non_null, non_null) ),
      fail
    ).

test(F, [G, Expected]) :-
  !,
  result_expected(G, Expected, R),
  compare_subst_lists(R, Expected, Extra, Missing),
  write_if_wrong(F, G, Expected, Extra, Missing),
  update_score(F, Missing, Extra).
test(F, [G, ProgFile, Expected]) :-
  !,
  [ProgFile],
  result_expected(G, Expected, R),
  compare_subst_lists(R, Expected, Extra, Missing),
  write_if_wrong(F, G, Expected, Extra, Missing),
  update_score(F, Missing, Extra).

result_expected(G, Expected, Res) :-
  expected_lhs_vars(Expected, Want),
  vars_in_term(G, GoalVars),
  filter_vars_eq(GoalVars, Want, Vars),
  get_all_subs_vars(G, Vars, Subs),
  special_ans_forms(Subs, Res).

expected_lhs_vars(Expected, Vars) :-
  ( Expected = [_|_] ; Expected == [] ),
  !,
  expected_lhs_vars_list(Expected, [], Vars).
expected_lhs_vars(_Expected, []).

expected_lhs_vars_list([], Vars, Vars).
expected_lhs_vars_list([Set|Rest], Vars0, Vars) :-
  expected_lhs_vars_set(Set, Vars0, Vars1),
  expected_lhs_vars_list(Rest, Vars1, Vars).

expected_lhs_vars_set([], Vars, Vars).
expected_lhs_vars_set([Sub|Rest], Vars0, Vars) :-
  ( Sub = <--(V, Val) ->
      vars_in_term(V, Vars0, Vars1),
      vars_in_term(Val, Vars1, Vars2)
  ; Vars2 = Vars0
  ),
  expected_lhs_vars_set(Rest, Vars2, Vars).

var_member_eq(V, [H|_]) :- V == H, !.
var_member_eq(V, [_|T]) :- var_member_eq(V, T).

filter_vars_eq([], _Set, []).
filter_vars_eq([V|Vs], Set, [V|Out]) :-
  var_member_eq(V, Set),
  !,
  filter_vars_eq(Vs, Set, Out).
filter_vars_eq([_|Vs], Set, Out) :- filter_vars_eq(Vs, Set, Out).

get_all_subs_vars(G, Vars, AllSubs) :-
  copy_term(Vars-G, Vars2-G2),
  findall(Ans, protect_call_vars(G2, Vars2, Ans), AnsList),
  list_make_subs_list(Vars, AnsList, AllSubs).

protect_call_vars(G, Vars2, R) :-
  catch((call(G), R = Vars2), B, extract_error(B, R)).
EOF
  printf '\n\n'
  cat "$DRIVER"
  printf '\n\n'
  printf "inria_suite_dir('%s').\n\n" "$suite_abs_slash"
  cat <<'EOF'
run_tests_score(Test, T, W) :-
  inria_suite_dir(Dir),
  atom_concat(Dir, Test, Path),
  run_tests(Path),
  score(Path, total(T), wrong(W)).
EOF
} >"$WRAPPER"

echo "inria: ready: $WRAPPER" >&2