:- module treedecode.
% preliminary version of the decoder

:- interface.

:- import_module io, maybe, list.
:- import_module scorers, config, tropt.

:- impure pred main(io::di, io::uo) is cc_multi.

:- type complete_h(OC) ---> complete_h(
            c_score :: score,
            c_singscore :: single_score,
            c_output :: OC
          ).

:- type model(OCC) ---> model(
          slave_config :: slave_config, % this was used to construct the model
            % used as hashkey for caching
          config :: config.config, % this was used to construct the model
          % full_config :: {config.cachekey, option_table(config.option)},
            % full_config is sufficient and necessary to reconstruct this model
            % used as hashkey for caching
          stack_limit :: int,
          tweaks :: tweaks,
          nbest :: maybe(int),
          weights :: scorers__weights,
          wnames :: list(string),
          scorers :: scorers,
          trgshared :: trgshared(OCC),
          trproviders :: trginit,
          occonf :: OCC,
          % various penalties
          right_root_coercion_scorer :: scorer_id
          % src_word_penalty_scorer :: scorer_id,
          % tgt_word_penalty_scorer :: scorer_id,
          % phrase_penalty_scorer :: scorer_id
        ).

:- implementation.

:- import_module feeder, int, string, string_tools, list, maybe, svmap, map, svset, set.
:- import_module debugstr, require, version_array, va_tools, map_tools.
:- import_module relation, pair, assoc_list, solutions, bool, math, hash_table.
:- import_module std_util, univ, bag.
:- import_module type_desc.
:- import_module pickle.
:- import_module list_tools.
:- import_module memusage, binheap, lazy.
:- import_module grid_feeder.
:- import_module svg.
:- import_module io_tools.
:- import_module time_tools.
:- import_module progress_dots.
:- import_module wisebmp, initable, svnversion.
:- import_module getopt, getopt_tools.
:- import_module utils, stack, recombstack, ordered, float.
:- import_module stat, conffloat, table, distribution, cache_manager, cached.
:- import_module map_set.
:- import_module dir_tools.
:- import_module complexterm.

:- import_module bilt, compact_lt, bitree_corpus.

:- import_module scorers.
:- import_module lm.
:- import_module restrict.
:- import_module segments.
:- import_module core_defs.
:- import_module tropt.
% :- import_module sge, sge.feeder, sge.list.
:- import_module sge_options.
:- import_module externalize_stream.
:- import_module externalize_stream.list.
:- import_module externalize_stream.feeder.
:- import_module t_generic.
:- import_module t_preserve_all.
:- import_module t_drop_fr_reins.
:- import_module t_word_for_word.
:- import_module t_word_for_word_factored.
:- import_module evaluation.
:- import_module bleu. % for mert
% Blocked fro the moment
:- import_module mert. %, bleurisk.
:- import_module afunafun.
:- import_module binodelm.
:- import_module config.
:- import_module oc_generic, oc_segments, oc_tree.
% :- import_module expand_map.

:- instance option(option) where [pred(getopt_tools__opt/5) is config__opt].



:- mutable(global_tracesons, set(int), set__init, ground, [untrailed]).
:- pragma promise_pure(glob_tracesons/0).
:- func glob_tracesons = set(int).
glob_tracesons = W :- semipure get_global_tracesons(W).

:- mutable(global_traceback, set(int), set__init, ground, [untrailed]).
:- pragma promise_pure(glob_traceback/0).
:- func glob_traceback = set(int).
glob_traceback = W :- semipure get_global_traceback(W).



:- func normalize_to_sum(list(float)) = list(float).
normalize_to_sum(InL) = OutL :-
  Sum = list__foldl(func(A, B)=A+B, InL, 0.0),
  OutL = list__map(func(A)=A/Sum, InL).

:- func normalize_to_sum_abs(list(float)) = list(float).
normalize_to_sum_abs(InL) = OutL :-
  Sum = list__foldl(func(A, B)=abs(A)+B, InL, 0.0),
  OutL = list__map(func(A)=A/Sum, InL).

:- func normalize_to_zero_one(list(float)) = list(float).
normalize_to_zero_one(InL) = OutL :-
  Min = reducel(func(A, B) = float.min(A, B), InL),
  Max = reducel(func(A, B) = float.max(A, B), InL),
  Wid`with_type`float = Max - Min,
  OutL = list__map(func(A)=(A-Min)/Wid, InL).

:- func normalize(list(float)) = list(float).
normalize(L) = Out :-
   Out = normalize_to_sum_abs(L),
  trace[io(!IO)]debugstr("Normalizing to sum_abs: ", {L, Out}, !IO).


:- type slave_input(T) ---> slave_input(
          s_config :: slave_config_with_oc_type,
          mert_imposed_weights :: maybe(weightslist),
          input_data :: T
        ).

:- func may_impose_weights(maybe(weightslist), model(OCC)) = model(OCC).
may_impose_weights(no, Model) = Model.
may_impose_weights(yes(NewW), Model) = OutModel :-
  if length(NewW) = length(Model^wnames)`with_type`int
  then
    Weights = from_list(normalize(NewW)),
    trace[io(!IO)] (
      debugstr("WNames:  ", Model^wnames, !IO),
      debugstr("Imposing Weights: "++dump_weights(to_list(Weights))++"\n", !IO)
    ),
    TModel = Model^weights := Weights,
    OutModel = TModel^trgshared := NewTrgShared,
    NewTrgShared =  (Model^trgshared)^weightsnscorers := NewWeightsNScorers,
    NewWeightsNScorers = 
        (Model^trgshared^weightsnscorers)^weights := Model^weights
  else
    error("Internal error: asked to impose weights of incompatible length: "
      ++" got "++int_to_string(length(NewW))
      ++" but model expects "++int_to_string(length(Model^wnames)))
  .

:- pred slave_transl_sentences(slave_input(list(later_t))::in,
            slave_output_with_oc_type::out,
            io::di, io::uo) is cc_multi.
slave_transl_sentences(slave_input(SlaveConfigWOC, MayWeights, TestInTrees),
    OutStats, !IO) :-
  (
    SlaveConfigWOC = produce_string(SlaveConfig)
  ; SlaveConfigWOC = produce_tree(SlaveConfig)
  ),
  interpret_config(SlaveConfig, Config, scorers.init, Scorers,
    map.init, _, !IO),
  load_seed_model(SlaveConfig, Config, Scorers, PreliminaryModel, !IO),
  (
  PreliminaryModel = produce_string(Model),
    SlaveConfigWOC = produce_string(__SlaveConfig),
    transl_sentences(may_impose_weights(MayWeights, Model),
      TestInTrees, _TestOutSents,
      init_stats, TOutStats, !IO),
    OutStats = produce_string(treedecode.ensure_serializable(TOutStats))
  ;
  PreliminaryModel = produce_tree(Model),
    SlaveConfigWOC = produce_tree(_SlaveConfig),
    transl_sentences(may_impose_weights(MayWeights, Model),
      TestInTrees, _TestOutSents,
      init_stats, TOutStats, !IO),
    OutStats = produce_tree(treedecode.ensure_serializable(TOutStats))
  ;
  PreliminaryModel = produce_string(_Model),
    SlaveConfigWOC = produce_tree(_SlaveConfig),
    error("Mismatched OC type!")
  ;
  PreliminaryModel = produce_tree(_Model),
    SlaveConfigWOC = produce_string(__SlaveConfig),
    error("Mismatched OC type!")
  ).

:- type slave_config_with_oc_type == with_oc_type(slave_config, slave_config).
:- type slave_output_with_oc_type == with_oc_type(stats(oc_segments), stats(oc_tree)).

:- func slave_config_with_oc_type(model(OCC)) = slave_config_with_oc_type.
slave_config_with_oc_type(Model) = Out :-
  (
  Model^config^output_type = produce_string,
    Out = produce_string(Model^slave_config)
  ;
  Model^config^output_type = produce_tree,
    Out = produce_tree(Model^slave_config)
  ).

:- func ensure_correct_oc_type(model(OCC), slave_output_with_oc_type) = univ.
  % the output type is in fact stats(OC).
ensure_correct_oc_type(Model, In) = Out :-
  Exp = Model^config^output_type,
  (
  Exp = produce_string,
    Out = univ(pick_produce_string(In))
  ;
  Exp = produce_tree,
    Out = univ(pick_produce_tree(In))
  ).

:- func pick_produce_tree(slave_output_with_oc_type) = stats(oc_tree).
pick_produce_tree(produce_tree(O)) = O.
pick_produce_tree(produce_string(_)) = func_error("Expected tree, got string!").

:- func pick_produce_string(slave_output_with_oc_type) = stats(oc_segments).
pick_produce_string(produce_string(O)) = O.
pick_produce_string(produce_tree(_)) = func_error("Expected string, got tree!").

:- type with_oc_type(A, B) --->
          produce_string(A)
        ; produce_tree(B)
        .

:- type preliminary_model == with_oc_type(
          model(oc_segments.config)
        , model(oc_tree.config))
        .


:- pred load_seed_model(slave_config::in, config.config::in,
            scorers::in, 
            preliminary_model::out,
            io::di, io::uo) is det.
load_seed_model(SlaveConfig, Config, InScorers, PreliminaryModel, !IO) :-
  % debugstr("Config: ", serializable(Config), !IO),

  some [!Scorers] (
  !:Scorers = InScorers,

  time_start("Initing tropt generators", TMInitTRG, !IO),
  init_all(Config^dirconf, Config^trgconf, TrProviders, !Scorers, !IO),
  time_dump(TMInitTRG, !IO),


  register_scorer("right_root_afun_coercion", RightRootCoercionScorer, !Scorers),
    % extra penalty if using a tropt inappropriately, eg. using Obj where Adj
    % was expected
  % register_scorer("src_afun_tgt_afun_cost", AAScorer, !Scorers),
    % regular probability score for translating OBJ into Obj and similar
  register_scorer("src_word_penalty", SrcWPScorer, !Scorers),
  register_scorer("tgt_word_penalty", TgtWPScorer, !Scorers),
    % for each input/output word, a penalty applies
  register_scorer("phrase_penalty", PPScorer, !Scorers),
    % for each output phrase, a penalty applies

  StackLimit = Config^stack_limit,
  Tweaks = Config^tweaks,

  (
  Config^occonf = oc_segments(OCConfig),
    oc_generic.init(OCConfig, OCCInited, !Scorers, !IO),
    OutScorers = !.Scorers,
    setup_weights(Config, OutScorers, SrcWPScorer, TgtWPScorer,
      RightRootCoercionScorer,
      WNames, Weights, !IO),
    TrgShared = trgshared(
      % AAScorer,
      SrcWPScorer, TgtWPScorer, PPScorer,
      OCCInited,
      Config^tweaks^int(tropt_limit),
      weightsnscorers(Weights, OutScorers),
      Config^limits
      % version_array__empty
    ),
    PreliminaryModel = produce_string(model(
      SlaveConfig, Config,
      % { serializable(Config), Opts },
      StackLimit,
      Tweaks,
      no, % no nbest list
      Weights,
      WNames,
      OutScorers,
      TrgShared,
      TrProviders,
      OCCInited,
      RightRootCoercionScorer
      % SrcWPScorer, TgtWPScorer, PPScorer
    ))
  ;
  Config^occonf = oc_tree(OCConfig),
    oc_generic.init(OCConfig, OCCInited, !Scorers, !IO),
    OutScorers = !.Scorers,
    setup_weights(Config, OutScorers, SrcWPScorer, TgtWPScorer,
      RightRootCoercionScorer,
      WNames, Weights, !IO),
    TrgShared = trgshared(
      % AAScorer,
      SrcWPScorer, TgtWPScorer, PPScorer,
      OCCInited,
      Config^tweaks^int(tropt_limit),
      weightsnscorers(Weights, OutScorers),
      Config^limits
      % version_array__empty
    ),
    PreliminaryModel = produce_tree(model(
      SlaveConfig, Config,
      % { serializable(Config), Opts },
      StackLimit,
      Tweaks,
      no, % no nbest list
      Weights,
      WNames,
      OutScorers,
      TrgShared,
      TrProviders,
      OCCInited,
      RightRootCoercionScorer
      % WPScorer, PPScorer
    ))
  )

  ), % some !Scorers
  debugstr("load_seed_model: Finished.\n", !IO).

:- pred setup_weights(config.config::in, scorers::in,
            scorer_id::in, scorer_id::in, scorer_id::in,
            list(string)::out, weights::out,
            io::di, io::uo) is det.
setup_weights(Config, Scorers, SrcWPScorer, TgtWPScorer,
    RightRootCoercionScorer,
    WNames, Weights, !IO) :-
  WNames = scorers.names(Scorers),
  (
  if length(Config^weights) = 0
  then
    debugstr("Defaulting to even weights with wordpenalties negative and high right_root_coercion.\n", !IO),
    TWeights = list__duplicate(length(WNames), 1.0)
                 ^ set_corresponding_elem(SrcWPScorer, -1.0)
                 ^ set_corresponding_elem(TgtWPScorer, -1.0)
                 ^ set_corresponding_elem(RightRootCoercionScorer, 100.0)
  else
    TWeights = Config^weights
  ),
  Weights = from_list(normalize(TWeights)),

  debugstr("WNames:  ", WNames, !IO),
  debugstr("Weights: "++dump_weights(to_list(Weights))++"\n", !IO).

:- pred slave_modes(io::di, io::uo) is cc_multi.
slave_modes(!IO) :-
  hostname(Host, !IO),
  pid(Pid, !IO),
  io.command_line_arguments(Args, !IO),
  (
  if Args = ["runpred" | Tail]
  then
    io.get_environment_var("JOB_ID", MayJobID, !IO),
    io.progname_base("treedecode", StdErrBaseName, !IO),
    ( MayJobID = yes(JID),
        NewStdErr = StdErrBaseName++".o"++JID
    ; MayJobID = no,
        NewStdErr = StdErrBaseName++".o"++Host++":"++int_to_string(Pid)
    ),
    debugstr("Redirecting stderr to: ", NewStdErr, !IO),
    utils.redirect_stderr(NewStdErr, !IO),

    debugstr("Args: ", Args, !IO),
    ArgsS = join_list(" ", Tail),
    time_start("slave for "++ArgsS
      ++" ("++Host++":"++int_to_string(Pid)++")", _TMMain, !IO),
    make_yourself_polite(!IO),
    
    t_generic.slave_mode(t_word_for_word.fake_config, !IO),
    % t_generic.slave_mode(t_word_for_word_factored.fake_config, !IO),
    % t_generic.slave_mode(t_preserve_all.fake_config, !IO),
    t_generic.slave_mode(t_drop_fr_reins.fake_config, !IO),
    % t_generic.slave_mode(afunafun.fake_config, !IO),

    grid_feeder.slave_mode(t_preserve_all, !IO),
    grid_feeder.slave_mode(t_word_for_word_factored, !IO),
    grid_feeder.slave_mode(binodelm, !IO),
    grid_feeder.slave_mode(afunafun, !IO),

    externalize_stream.slave_mode_io(
      "slave_transl_sentences", slave_transl_sentences,
      unpickle_from_fileptr(core_defs.unpickles),
      pickle_to_fileptr(core_defs.pickles),
      !IO),
      % serializer_with_initables, !IO),

    debugstr("Should never get here! You forgot to implement slave mode for:\n  "
      ++ArgsS, !IO)
  else true
  ).

:- type surely_serializable_initable(C, I) --->
            surely_serializable_initable(C)
          ; never_used_surely_serializable_initable(C, I)
          .
:- func initable_to_ssinitable(initable(C, I))
            = surely_serializable_initable(C, I).
initable_to_ssinitable(IC) = surely_serializable_initable(det_config(IC)).
:- func ssinitable_to_initable(surely_serializable_initable(C, I))
            = initable(C, I).
ssinitable_to_initable(surely_serializable_initable(C)) = not_inited(C).
ssinitable_to_initable(never_used_surely_serializable_initable(_, _))
  = func_error("ssinitable_to_initable: never used was used!").

/*
:- pred deserializer_with_initables `with_type` deserializer(T) `with_inst` deserializer.
deserializer_with_initables(Stream, Data, !IO) :-
  some [!UnPickles] (
    !:UnPickles = unpickles,
    DummyVA = version_array([1,2,3]),
    register_unpickle(type_ctor(type_of(DummyVA)), unpickle_version_array,
        !UnPickles),
    DummyInitable = never_used_surely_serializable_initable(3, 3),
    register_unpickle(type_ctor(type_of(DummyInitable)),
        unpickle_initable_ensuring_inited,
        !UnPickles),
    unpickle_from_stream(!.UnPickles, Stream, Data, !IO)
  ).

:- pred unpickle_initable_ensuring_inited
            `with_type` maybe_unpickle `with_inst` maybe_unpickle.
unpickle_initable_ensuring_inited(UnPickles, TypeDesc, UnivInitable, !BB) :-
  (
  if type_args(TypeDesc) = [CType, IType]
  then
    has_type(FakeC, CType),
    has_type(FakeI, IType),
    unpickle(UnPickles, SurelySerializable, !BB),
    Serializable = ssinitable_to_initable(SurelySerializable),
    % same_type(SurelySerializable,
        % never_used_surely_serializable_initable(FakeC, FakeI)),
    same_type(Inited, inited(FakeC, FakeI)),
    Inited = ensure_inited(Serializable),
    UnivInitable = univ(Inited)
  else
    error("unpickle_initable: bad type_desc")
  ).

:- pred serializer_with_initables `with_type` serializer(T) `with_inst` serializer.
serializer_with_initables(Stream, Data, !IO) :-
  some [!Pickles] (
    trace[io(!IO)] debugstr("serializer_with_initables started\n", !IO),
    !:Pickles = pickles,
    DummyVA = version_array([1,2,3]),
    register_pickle(type_ctor(type_of(DummyVA)), pickle_version_array,
        !Pickles),
    DummyInitable = initable.inited(3,3),
    register_pickle(type_ctor(type_of(DummyInitable)), pickle_initable,
        !Pickles),
    trace[io(!IO)] debugstr("serializer_with_initables about to pickle\n", !IO),
    pickle_to_stream(!.Pickles, Stream, Data, !IO),
    trace[io(!IO)] debugstr("serializer_with_initables pickled\n", !IO)
  ).


:- pred pickle_initable `with_type` maybe_pickle `with_inst` maybe_pickle.
pickle_initable(Pickles, UnivInitable, !BB) :-
  trace[io(!IO)] debugstr("pickle_initable called\n", !IO),
  (
  if type_args(univ_type(UnivInitable)) = [CType, IType]
  then
    has_type(FakeC, CType),
    has_type(FakeI, IType),
    same_type(Serializable,
        never_used_surely_serializable_initable(FakeC, FakeI)),
    same_type(Initable, inited(FakeC, FakeI)),
    % has_type(Initable, univ_type(UnivInitable)),
    det_univ_to_type(UnivInitable, Initable),
    Serializable = initable_to_ssinitable(Initable),
    trace[io(!IO)] debugstr("Sureser pickling.\n", !IO),
    % same_type(Serializable, Initable),
    pickle(Pickles, Serializable, !BB),
    trace[io(!IO)] debugstr("Sureser pickled.\n", !IO)
  else
    error("pickle_initable: bad type_desc")
  ).
*/

main(!IO) :-
  slave_modes(!IO),

  hostname(Host, !IO),
  pid(Pid, !IO),
  time_start("master v."++svnversion
    ++" ("++Host++":"++int_to_string(Pid)++")", TMMain, !IO),
  make_yourself_polite(!IO),
  get_options_with_usage(option_ops(short_option, long_option, option_defaults), usage, Opts, _Args, !IO),
  % impure set_global_options(Opts),

  lookup_maybe_string_option(Opts, chdir, MayChdirThere),
  (
  MayChdirThere = yes(DThere),
    dir_tools.chdir(DThere, MayErrorThere, !IO),
    ( MayErrorThere = error(EThere), error(EThere)
    ; MayErrorThere = ok )
  ; MayChdirThere = no
  ),

  % I'm in the master mode
  get_multiconfig(Opts, MultiConfig, !IO),

  (
  MultiConfig = single_config(ConfigSrc),
    % doing just one config
    interpret_config(ConfigSrc, Config, scorers.init, Scorers,
        map.init, _, !IO),
    load_seed_model(ConfigSrc, Config, Scorers, PreliminaryModel, !IO),
    impure run_preliminary_model(PreliminaryModel, !IO)
  ;
  MultiConfig = several_configs(AllConfigs),
    % looping through several configs
    impure loop_through_configs(AllConfigs,
      map.init, _no_vars_worth_remembering, !IO)
  ),
  time_dump(TMMain, !IO),

  % for purposes of profiling, chdir back
  lookup_maybe_string_option(Opts, chdir_back, MayChdir),
  (
  MayChdir = yes(D),
    dir_tools.chdir(D, MayError, !IO),
    ( MayError = error(E), debugstr("chdir-back: "++E, !IO)
    ; MayError = ok )
  ; MayChdir = no
  ),
  true.

:- impure pred loop_through_configs(list(slave_config)::in, known_vars::in, known_vars::out, io::di, io::uo) is cc_multi.

loop_through_configs([], !K, !I).
loop_through_configs([ConfigSrc|Tail], !K, !I) :-
  interpret_config(ConfigSrc, Config, scorers.init, Scorers, !K, !I),
  load_seed_model(ConfigSrc, Config, Scorers, PreliminaryModel, !I),
  impure run_preliminary_model(PreliminaryModel, !I),
  impure loop_through_configs(Tail, !K, !I).

:- impure pred run_preliminary_model(preliminary_model::in,
            io::di, io::uo) is cc_multi.
run_preliminary_model(PreliminaryModel, !IO) :-
  (
  PreliminaryModel = produce_string(TypedPreliminaryModel),
    impure run_main(TypedPreliminaryModel, !IO)
  ;
  PreliminaryModel = produce_tree(TypedPreliminaryModel),
    impure run_main(TypedPreliminaryModel, !IO)
  ).


:- instance generable(oc_segments.config, oc_segments.oc_segments) where [].
:- instance generable(oc_tree.config, oc_tree.oc_tree) where [].

:- impure pred run_main(model(OCC)::in, io::di, io::uo) is cc_multi
     <= (generable(OCC, OC)).


run_main(PreliminaryModel, !IO) :-
  Config = PreliminaryModel^config,
  evaluation.init(Config^evaluation, Evaluation, !IO),

  % Set input stream
  % (
  % Config^testsource = stdin,
    % InputStreamName = "stdin",
    % io__stdin_stream(Stdin, !IO),
    % InputStream = Stdin
  % ;
  % Config^testsource = file(FN),
    % InputStreamName = FN,
    % utils__open_input(FN, InputStream, !IO)
  % ),

  % Slurp input sentences
  (
  Config^testsource = stdin,
    InputStreamName = "stdin",
    io__input_stream(Stdin, !IO),
    feeder__load_all_lines(Stdin, TTestInSents, !IO)
  ;
  Config^testsource = file(FN),
    InputStreamName = FN,
    feeder__load_all_lines_from_file(FN, TTestInSents, !IO)
  ),
  TestInTrees = list.map(
    (func(SentID-Sent)
        = factorsent_to_latertree(from_int(SentID),
            Model^config^testfactors, chomp(Sent))
    ), add_ordering(1, TTestInSents)),

  (
  if reference_sentences_available(Evaluation, SentCount)
  then
    (
    if SentCount = length(TestInTrees)
    then true
    else
      error(
        format("Inconsistent number of sentences: %i input, %i reference.",
          [i(length(TestInTrees)), i(SentCount)]))
    )
  else true
  ),

  % sanity check, translate a short input sentence locally
  all_maximal_elements(func(S)= -approx_length(S), TestInTrees, ShortestSents, _),
  (
  ShortestSents = [FirstShortest|_],
    transl_sentence(Model^nbest:=yes(10), 1, FirstShortest, _Out, OutNBL,
        init_stats, _OutStats, !IO),
    debugstr(join_list("",
      list.map(
        (func(Cand) = string.format("%.3f\t%s\t%s\n",
          [f(single_score(Model^weights, from_scorelist(Cand^scores))),
           s(join_list(" ", Cand^words)),
           s(weightslist_to_string(Cand^scores))
          ])
        ), OutNBL)
      ), !IO)
  ;
  ShortestSents = [], error("Empty set of test sentences in "++InputStreamName)
  ),

  % debugging options are commented out because mmc fails to compile this
  % predicate once impure set_global... is used
  /*
  % debugging options
  io__get_environment_var("TRACESONS", MayTSListString, !IO),
  ( MayTSListString = no,
    TSList = []
  ; MayTSListString = yes(TSListString),
    TSList = obosplit_at_char(',', TSListString)
  ),
  list__foldl(
    (pred(TS::in, IS::in, OS::out) is det:-
      if string__to_int(string__replace_all(TS, "H", ""), HypID)
      then set__insert(IS, HypID, OS)
      else error("Bad hyp id: "++TS)
    ), TSList, set__init, TSS),
  debugstr("Tracesons: ", TSS, !IO),
  impure set_global_tracesons(TSS),
  */

  /*
  io__get_environment_var("TRACEBACK", MayTBListString, !IO),
  ( MayTBListString = no,
    TBList = []
  ; MayTBListString = yes(TBListString),
    TBList = obosplit_at_char(',', TBListString)
  ),
  list__foldl(
    (pred(TB::in, IS::in, OS::out) is det:-
      if string__to_int(string__replace_all(TB, "H", ""), HypID)
      then set__insert(IS, HypID, OS)
      else error("Bad hyp id: "++TB)
    ), TBList, set__init, TBS),
  debugstr("Traceback: ", TBS, !IO),
  impure set_global_traceback(TBS),
  % end of debugging options
  */


  % MERT blocked for the moment
  MertMethod = Config^mert,
  (
    (
    MertMethod = bleurisk(_NBest, _DevInF, _DevFactors, _DevRefFiles),
      error("bleurisk unsupported")
      /*
      feeder__load_all_lines_from_file(DevInF, DevInSents, !IO),
      load_refs(DevRefFiles, DevRefs, !IO),

      RefLens = list__map(
        (func(Lens)=L:-if Lens=[SingleL] then L = SingleL
         else error("bleurisk does not support multiple references!")),
        to_list(DevRefs^lengths)),
      SrcLens = list__map(
        (func(S) = length(obosplit_at_char(' ', S))),
        DevInSents
        ),
      DevLens = list.map_corresponding(func(A, B) = {A, B}, SrcLens, RefLens),
  
      bleurisk.init(BleuRiskInited, !IO),
      % XXX bleurisk.stop is never called
      Optimizer = (pred(SNBL::in, InW::in, OutW::out, !.I::di, !:I::uo) is det:-
        bleurisk.optimize(BleuRiskInited, DevLens, SNBL, PreliminaryModel^wnames, InW, TOutW, !I),
        OutW = normalize(TOutW),
        true
      )
      */
    ;
    MertMethod = mert(NBest, RandStarts, DevInF, DevFactors, DevRefFiles),
      (
      if NBest > PreliminaryModel^stack_limit
      then
        error("MERT N-best-list size greater than stacklimit!"
          ++" Increase stacklimit.")
      else
        PreliminaryModelWithNBestSize = PreliminaryModel^nbest := yes(NBest)
      ),
      feeder__load_all_lines_from_file(DevInF, DevInSents, !IO),
      % convert sentences to trees
      DevInTrees = list.map(
        (func(SentID-Sent)
            = factorsent_to_latertree(from_int(SentID), DevFactors, chomp(Sent))
        ), add_ordering(1, DevInSents)),
      load_refs(DevRefFiles, DevRefs, !IO),
      (
      if sentcount(DevRefs) = length(DevInTrees)
      then true
      else
        error(
          format("Inconsistent number of sentences: %i input, %i dev reference.",
            [i(length(DevInTrees)), i(sentcount(DevRefs))]))
      ),
  
      (
      if RandStarts = 0
      then Rand = no_randomize
      else Rand = randomize(
            list__duplicate(size(PreliminaryModel^weights), -1.0), % minima
            list__duplicate(size(PreliminaryModel^weights), 1.0), % maxima
            RandStarts
          )
      ),
  
      Optimizer = (pred(SNBL::in, InW::in, OutW::out, !.I::di, !:I::uo) is det:-
        OutW = mert.optimize(SNBL, Rand, InW)
      )
    ),
    time_start("MERTING", TMMerting, !IO),
    train_mert(Optimizer, DevInTrees, DevRefs,
        PreliminaryModelWithNBestSize, BestWeightsList, !IO),
    ImposeWeights = yes(BestWeightsList),
    time_dump(TMMerting, !IO)
  ;
  MertMethod = try_some(Probes, DevInF, DevFactors, DevEvalConf),
    feeder__load_all_lines_from_file(DevInF, DevInSents, !IO),
    DevInTrees = list.map(
      (func(SentID-Sent)
          = factorsent_to_latertree(from_int(SentID), DevFactors, chomp(Sent))
      ), add_ordering(1, DevInSents)),
    evaluation.init(DevEvalConf, DevEvaluation, !IO),
    (
    if reference_sentences_available(DevEvaluation, DevSentCount)
    then
      (
      if DevSentCount = length(DevInTrees)
      then true
      else
        error(
          format("Inconsistent number of sentences: %i input, %i dev reference.",
            [i(length(DevInTrees)), i(DevSentCount)]))
      )
    else error("Won't MERT with no evaluation specified.")
    ),
    time_start("MERTING (try-some)", TMMert, !IO),
    WeightsList = probes_to_weights(Probes, PreliminaryModel),
    mert_try_some(WeightsList, DevInTrees, DevEvaluation,
        PreliminaryModel, BestWeightsList, !IO),
    ImposeWeights = yes(BestWeightsList),
    time_dump(TMMert, !IO)
  ;
  MertMethod = no_mert,
    ImposeWeights = no
  ),
  Model = PreliminaryModel,

  % debugstr("Translation Model: ", Model, !IO),

  /*
  lookup_maybe_string_option(Opts, search_err_stacksizes, MaySearchErrStacks),
  (
  MaySearchErrStacks = no
  ;
  MaySearchErrStacks = yes(StackSizesStr),
    StackSizes = list__map(converse(det_to_int_or_die, "Bad stack size"),
      obosplit_at_char(',', StackSizesStr)),
    % slurp input
    feeder__fold_lines_aku_io(InputStream, nodots, 
      (pred(L::in, Tail::in, [T|Tail]::out, !.I::di, !:I::uo) is det:-
        T = factorsent_to_deptree(fake_sent_id, Config^testfactors, chomp(L))
      ), [], RevInSents, !IO),
    % translate at various stack sizes
    list__foldl(
      (pred(InSent::in, !.I2::di, !:I2::uo) is det:-
        list__foldl2(
          (pred(StackSize::in, PrevFinStacks::in,
              [ThisFinStack | PrevFinStacks]::out, !.I::di, !:I::uo) is det :-
            time_start("Translating with stacksize "++int_to_string(StackSize), TMTrWithStack, !I),
            transl(Model^stack_limit:=StackSize, InSent, FilledStacks, !I),
            ThisFinStack = FilledStacks^elem(size(FilledStacks)-1),
            time_dump(TMTrWithStack, !I),
            time_start("Comparing with previous "++int_to_string(length(PrevFinStacks))++" stacks.", TMComparing, !I),
            compare_stacks(ThisFinStack, PrevFinStacks, !I),
            time_dump(TMComparing, !I)
          ), StackSizes, [], _AllFinStacks, !I2)
      ), reverse(RevInSents), !IO),
    utils__exit(0, !IO)
  ),
  */

  % expand_map.turn_on_trajectory_analysis(!IO),

  cached_launch_translation(
    mert_cache_desc,
    Model,
    ImposeWeights,
    InputStreamName,
    TestInTrees,
    Stats,
    !IO),

  % Don't forget to emit the standard output!
  list.foldr(
    (pred(MayOutSent::in, !.I2::di, !:I2::uo) is det:-
      ( MayOutSent = no_translation
      ; MayOutSent = translated(OutSent, _score),
        io.write_string(final_output_to_string(OutSent), !I2)
      ),
      io.nl(!I2)
    ),
    Stats^revsents, !IO),

  % create SVG log, if required
  get_environment_var("SVGLOG", MayLogFNPattern, !IO),
  (
  MayLogFNPattern = no
  ;
  MayLogFNPattern = yes(LogFNPattern),
    debugstr("Will save SVG log to files named: ", LogFNPattern, !IO),
    get_environment_var("SVGLOGCOMMENTS", MayCommentFNs, !IO),
    (
    MayCommentFNs = no, Comments = no
    ;
    MayCommentFNs = yes(FNsS),
      FNs = split_at_char(' ', FNsS),
      list.map_foldl(feeder__load_all_lines_from_file, FNs, CommentsPerFile,
        !IO),
      (
      if table.transpose(CommentsPerFile, CommentsPerSentence),
         length(CommentsPerSentence) = length(Stats^revsents)`with_type`int
      then
        Comments = yes(CommentsPerSentence)
      else
        Comments = yes(list.duplicate(length(Stats^revsents), ["Couldn't provide comments, files differ in number of lines: "++FNsS]))
      )
    ),
    list.foldl(
      (pred(I-MayOCS::in, !.I::di, !:I::uo) is det:-
        MayOCS = no_translation,
          debugstr("No output, no SVG log file for sentence: ", I, !I)
        ;
        MayOCS = translated(OCS, _score),
          some [!D] ( !:D = svg.new,
          TreesD = final_output_to_drawing(OCS, Evaluation),
          (
          Comments = no,
            PlaceTreesD = v(origin)
          ; Comments = yes(LinesPerSent),
            CommentsHere = list.det_index1(LinesPerSent, I),
            place(tl,
              tile_array(down, mins, no_bless,
                list.map(text(75, left), CommentsHere)),
              v(origin), bless("comments"), !D),
            PlaceTreesD = sub("comments", bl)
          ),
          place(tl, TreesD, PlaceTreesD, no_bless, !D),
          LogFN = string.replace_all(LogFNPattern,
             "%", int_to_string(I)),
          SVG = svg.to_svg(hard_pad(30.0, !.D)),
          string_to_file(SVG++"\n\n", LogFN, !I),
          debugstr("Saved final tree to: ", LogFN, !I)
          ) % some
      ), add_ordering(1, list.reverse(Stats^revsents)), !IO)
  ),

  % print overall trajectory information

  % print_overall_trajectory_information(!IO),
  % TopHypInfo = get_short_tophyp_info,
  TopHypInfo = "",
  
  Durations = assoc_list.values(Stats^durations),
  TotDuration = reducel(func(A,B)=A+B, Durations),
  Worst = reducel(func(AID-AD, BID-BD)=
    (if AD>BD then AID-AD else BID-BD), Stats^durations),
  Worst = WorstSentID - WorstSentDur,
  list.filter_map(
    (pred(Tr::in, Sc::out) is semidet:-
      Tr = translated(_, Sc)
    ), Stats^revsents, Scores, NonTranslated),
  io__stderr_stream(StdErr, !IO),
  io__format(StdErr, "Translated %i sentences (%i had no translation) in %s (%.1f+-%.1fs/sent, worst: %i in %s), stacksize %i, avg score %.3f%s.\n", [
      i(Stats^cnt),
      i(length(NonTranslated)),
      s(sec_to_humans(TotDuration)),
      f(TotDuration/float(Stats^cnt)),
      f(stddev(Durations)),
      i(int(WorstSentID)),
      s(sec_to_humans(WorstSentDur)),
      i(Model^stack_limit),
      f(avg(Scores)),
      s(TopHypInfo)
    ], !IO),
  TroptCountsStr = join_list(" ", list.map(
    func(Name-Cnt) = string.format("%s:%i", [s(Name),i(Cnt)]),
      sort(by_value, desc, bag.to_assoc_list(Stats^trgens)))),
  io__format(StdErr, "Tropts used: %s\n", [s(TroptCountsStr)], !IO),
  InWords = list.map(func(F)=float(F), Stats^input_words),
  OutWords = list.map(func(F)=float(F), Stats^output_words),
  Shortest = list.map(func(F)=float(F), Stats^treelet_min_counts_for_best_hyp),
  Longest = list.map(func(F)=float(F), Stats^treelet_max_counts_for_best_hyp),
  io__format(StdErr, "For the translated: avg input words: %.1f±%.1f, output words %.1f±%.1f, shortest path len: %.1f±%.1f, longest: %.1f±%.1f.\n", [
      f(avg(InWords)), f(stddev(InWords)),
      f(avg(OutWords)), f(stddev(OutWords)),
      f(avg(Shortest)), f(stddev(Shortest)),
      f(avg(Longest)), f(stddev(Longest))
    ], !IO),
  (
  if reference_sentences_available(Evaluation, _)
  then
    oc_generic.eval(Evaluation, stats_to_translated_sentences(Stats),
        Eval, MayPlainText,
        !IO),
    io__format(StdErr, "%s\n",
      [ s(
          Eval^detail
        )
      ], !IO),
    (
    MayPlainText = yes(PlainText),
      PlainTextFN = "out.txt",
      debugstr("Saving final plaintext to: "++PlainTextFN++"\n", !IO),
      string_to_file(join_list("",
        list.map(func(Ws)=join_list(" ", Ws)++"\n", PlainText)),
        PlainTextFN, !IO)
    ;
    MayPlainText = no
    )
  else true
  ).

:- pred cached_launch_translation(
            cache_desc::in,
            model(OCC)::in,
            maybe(weightslist)::in,
            string::in,
            list(later_t)::in, stats(OC)::out,
            io::di, io::uo) is cc_multi
     <= (generable(OCC, OC)).

cached_launch_translation(
    CDesc,
    Model,
    MayImposeWeights,
    InputStreamName,
    TestInTrees,
    Stats,
    !IO) :-
  cached__call(CDesc,
    (pred(_CacheInput::in, OStats::out, !.I::di, !:I::uo) is cc_multi :-
      launch_translation(
          Model,
          MayImposeWeights,
          InputStreamName,
          TestInTrees,
          OStats,
          !I)
    ),
    pickle_to_stream(core_defs.pickles),
    unpickle_from_stream(core_defs.unpickles),
    {Model^slave_config, MayImposeWeights, TestInTrees},
      % whenever anything of this changes, recalc
    Stats, 
    !IO).

:- pred launch_translation(model(OCC)::in,
            maybe(weightslist)::in,
            string::in,
            list(later_t)::in, stats(OC)::out,
            io::di, io::uo) is cc_multi
     <= (generable(OCC, OC)).

launch_translation(
    Model,
    MayImposeWeights,
    InputStreamName,
    TestInTrees,
    OutStats,
    !IO) :-
  my_garbage_collect(!IO),

  time_start("Translating "++InputStreamName, TMTranslating, !IO),
  io.get_environment_var("SGEJOBS_TEST", MayJobs, !IO),
  (
  if length(TestInTrees) > 10,
     MayJobs = yes(JobsStr),
     TJobs = det_to_int_or_die(JobsStr,
       (func)="Expecting number in SGEJOBS_TEST env.var, but got "++JobsStr),
     TJobs > 0
  then % will try to qsub
    Jobs = min(length(TestInTrees), TJobs),
    nchunks(Jobs, TestInTrees, TestInChunks),
    parallel_map_io(
      all_at_once(qrsh([dot_sge_options])),
      "slave_transl_sentences",
      slave_transl_sentences,
      % serializer_with_initables, deserializer_with_initables,
      % write_term, read_term,
      % write_term, read_term,
      pickle_to_fileptr(core_defs.pickles),
      unpickle_from_fileptr(core_defs.unpickles),
      list.map(
        func(C) = slave_input(slave_config_with_oc_type(Model),
                    MayImposeWeights, C),
        TestInChunks
      ),
      OutChunksWithOCType,
      !IO),
    % ensure all chunks are of the correct type
    list.map(det_univ_to_type,
      list.map(ensure_correct_oc_type(Model), OutChunksWithOCType),
      OutChunks),
    % join chunks together
    Stats = list_tools.reducel(func(New, Aku)=stats_join(Aku, New), OutChunks)
  else % translate all locally
    transl_sentences(may_impose_weights(MayImposeWeights, Model),
      TestInTrees, _TestOutSents,
      init_stats, Stats, !IO)
  ),
  OutStats = treedecode.ensure_serializable(Stats),
  memusage.dump_process_status(!IO),
  time_dump(TMTranslating, !IO).

% Used in MERT try-some: each probe specifies a weight distribution, this
% function constructs the appropriate number of weights for a given model.
:- func probes_to_weights(probes, model(OCC)) = list(weightslist).
probes_to_weights([], _M) = [].
probes_to_weights([Probe|Tail], Model)
    = MyWeights ++ probes_to_weights(Tail, Model) :-
  NWeights = list.length(Model^wnames),
  (
  Probe = wordpenalties_negative,
    MyWeights = [
      list__duplicate(NWeights, 1.0)
      ^ set_corresponding_elem(Model^trgshared^src_word_penalty_scorer, -1.0)
      ^ set_corresponding_elem(Model^trgshared^tgt_word_penalty_scorer, -1.0)
    ]
  ;
  Probe = all_equal,
    MyWeights = [ list.duplicate(NWeights, 1.0) ]
  ;
  Probe = one_vs_rest(OneScored, RestScored),
    int.fold_up(
      (pred(Idx::in, Tail2::in, [W|Tail2]::out) is det :-
        W = list__replace_nth_det(
              list.duplicate(NWeights, RestScored),
              Idx, OneScored)
      ), 1, NWeights, [], MyWeights)
  ;
  Probe = one_vs_rest_vs_wordpenalties(OneScored, RestScored, WPScored),
    Base =
      list__duplicate(NWeights, RestScored)
      ^ set_corresponding_elem(Model^trgshared^src_word_penalty_scorer, WPScored)
      ^ set_corresponding_elem(Model^trgshared^tgt_word_penalty_scorer, WPScored),
    int.fold_down(
      (pred(Idx::in, Tail2::in, [W|Tail2]::out) is det :-
        W = list__replace_nth_det(Base, Idx, OneScored)
      ), 1, NWeights, [], MyWeights)
  ).

:- func stats_to_translated_sentences(stats(OC)) = list(maybe(OC)).
stats_to_translated_sentences(Stats)
  = list.map(
      (func(Tr)=O :-
        Tr = no_translation, O = no
        ; Tr = translated(TO, _), O = yes(TO)
      ), list.reverse(Stats^revsents)).

:- pred dump_translated_sents_to_file(list(maybe(OC))::in, string::in,
            io::di, io::uo) is det
            <= oc(_OCC, OC).
dump_translated_sents_to_file(MaySents, OutFN, !IO) :-
  io_tools.open_output_or_die(OutFN, OutStream, !IO),
  debugstr("Writing output to: ", OutFN, !IO),
  list.foldl(
    (pred(MayOutSent::in, !.I2::di, !:I2::uo) is det:-
      ( MayOutSent = no
      ; MayOutSent = yes(OutSent),
        io.write_string(OutStream, final_output_to_string(OutSent), !I2)
      ),
      io.nl(OutStream, !I2)
    ),
    MaySents, !IO),
  io.close_output(OutStream, !IO).

:- type mert_result ---> mert_result(
          weightslist :: weightslist,
          evaluation_result :: evaluation_result
        ).

:- type generator(T, A, I) == (pred(maybe(T), A, A, I, I)).
:- inst generator == (pred(out, in, out, di, uo) is det).

:- pred fold_while_io(
          generator(T, A, I)::in(generator),
          pred(T, A, A, I, I)::in(pred(in, in, out, di, uo) is cc_multi),
          A::in, A::out,
          I::di, I::uo) is cc_multi.
fold_while_io(Generator, Folder, !Aku, !IO) :-
  Generator(MayE, !Aku, !IO),
  (
  MayE = yes(E),
    Folder(E, !Aku, !IO),
    fold_while_io(Generator, Folder, !Aku, !IO)
  ;
  MayE = no % final
  ).


:- type mert_aku(OC) ---> mert_aku(
          iteration :: int,
          randstarts :: int
        ).

:- pred mert_try_some(
            % generator(weightslist, mert_aku(OC), io)
              % ::in(generator),
            list(weightslist)::in,
            list(later_t)::in,
            evaluation.inited::in,
            model(OCC)::in, weightslist::out,
            io::di, io::uo) is cc_multi 
     <= (generable(OCC, OC)).
mert_try_some(WeightsProbes, InTrees, Evaluation, Model, BestWeights, !IO) :-
  % map each weight probe to score by translating the sentences
  list.map_foldl(
    (pred(Iter-Weights::in, MertResult::out, !.I::di, !:I::uo) is cc_multi :-
      cached_launch_translation(mert_cache_desc,
        Model,
        yes(Weights),
        "MERT for "++weightslist_to_string(Weights),
        InTrees,
        Stats,
        !I),
      Translated = stats_to_translated_sentences(Stats),
      dump_translated_sents_to_file(Translated,
        format("mert%i.out", [i(Iter)]), !I),
      oc_generic.eval(Evaluation, Translated, Eval, MayPlainText, !I),
      (
      MayPlainText = yes(PlainText),
        PlainTextFN = format("mert%i.out.txt", [i(Iter)]),
        debugstr("Saving final plaintext to: "++PlainTextFN++"\n", !I),
        string_to_file(join_list("",
          list.map(func(Ws)=join_list(" ", Ws)++"\n", PlainText)),
          PlainTextFN, !I)
      ;
      MayPlainText = no
      ),
      MertResult = mert_result(Weights, Eval),
      debugformat("MERT: %s: %s\n", [
          s(weightslist_to_string(Weights)),
          s(MertResult^evaluation_result^detail)
        ], !I)
    ), add_ordering(WeightsProbes), MertResults, !IO),

  % print a summary of probes + scores
  SortedResults = sort(
    func(A, B)
      = builtin.ordering(B^evaluation_result^brief, A^evaluation_result^brief),
    MertResults),
  debugstr("Summary of MERT:\n", !IO),
  list.foldl(
    (pred(MertResult::in,  !.I::di, !:I::uo) is det:-
      debugformat("  %s:\t%s\n", [
          s(weightslist_to_string(MertResult^weightslist)),
          s(MertResult^evaluation_result^detail)
        ], !I)
    ), SortedResults, !IO),

  BestWeights = list.det_head(SortedResults)^weightslist.

:- type optimizer == (pred(scorednbestlist, list(float), list(float), io, io)).
:- inst optimizer == (pred(in, in, out, di, uo) is det).


:- pred train_mert(optimizer::in(optimizer), list(later_t)::in, refs::in,
            model(OCC)::in, weightslist::out, io::di, io::uo) is cc_multi
     <= (generable(OCC, OC)).

train_mert(Optimizer, InTrees, Refs, Model, BestWeights, !IO) :-
  mert_loop(Optimizer, InTrees, Refs, 1, 
    blank_scored_nbestlist(Refs),
    Model, to_list(Model^weights), BestWeights, !IO).

:- func dump_weights(list(float)) = string.
dump_weights(W) = join_list(" ",
    map(func(F) = string.format("%.3f", [f(F)]), W)
  ).

:- pred mert_loop(optimizer::in(optimizer), list(later_t)::in, refs::in,
            int::in, scorednbestlist::in, model(OCC)::in,
            weightslist::in, weightslist::out,
            io::di, io::uo) is cc_multi
     <= (generable(OCC, OC)).
mert_loop(Optimizer, InTrees, Refs, Iter, SNBLSoFar, Model,
    OldWeights, BestWeights, !IO) :-
  Msg = (func(M)="MERT ("++int_to_string(Iter)++"): "++M),
  time_start(Msg("loop total"), TMtotal, !IO),
  time_start(Msg("translating"), TMtransl, !IO),

  cached_launch_translation(mert_cache_desc,
    Model,
    yes(OldWeights),
    "MERT for "++weightslist_to_string(OldWeights),
    InTrees,
    Stats,
    !IO),
  Translated = stats_to_translated_sentences(Stats),
  NBestList = list.reverse(Stats^revnbestcands),
  dump_translated_sents_to_file(Translated,
    format("mert%i.out", [i(Iter)]), !IO),
  BestTransls = list.map(
    (func(MayOC) = S :-
        MayOC = no, S = []
      ; MayOC = yes(OC), S = final_output_to_wordlist(OC)
    ), Translated),
  string_to_file(join_list("", list.map(
      (func(Words) = join_list(" ", Words)++"\n"),
      BestTransls
    )),
    format("mert%i.linearized.out", [i(Iter)]), !IO),
  string_to_file(join_list("", list.map(
      (func(Cands) = join_list("", Sents)++"\n" :-
        Sents = list.map(func(Cand) = join_list(" ", Cand^words)++"\n", Cands)
      ),
      NBestList
    )),
    format("mert%i.linearized.nbestout", [i(Iter)]), !IO),
  /*
  cached__call(mert_cache_desc,
    (pred({_IM_Config, Weights, NBS}::in, {NBL, BTL}::out, !.I::di, !:I::uo) is cc_multi :-
      UseM = InModel^weights := from_list(Weights),
      translate_to_nbest(UseM, InTrees, NBS, NBL, BTL, !I)
    ),
    pickle_to_stream(core_defs.pickles),
    unpickle_from_stream(core_defs.unpickles),
    {InModel^slave_config, to_list(InModel^weights), NBestSize},
      % full_config +weights represent both InModel and InTrees
    {NBestList, BestTransls}, 
    !IO),
  % translate_to_nbest(InModel, InTrees, NBestSize, NBestList, BestTransls, !IO),
  */
  time_dump(TMtransl, !IO),

  % just for curious people: the score now
  debugstr(Msg("current point: "++dump_weights(OldWeights)
    ++" => "++nice_detailed_bleu(detailed_bleu(Refs, BestTransls)))++"\n", !IO),
  
  % time_start(Msg("scoring"), TMscore, !IO),
  % SNBL = fake_nonzero_score(score_nbestlist(Refs, NBestList)),
  SNBL = score_nbestlist(Refs, NBestList),
  % trace[io(!I)]dump_scored_nbest(SNBL, !I),
  SingleBestProjDBLEU = project_bleu(Refs, SNBL, OldWeights),
  trace[io(!I)] debugstr("Projected curr on single: "++dump_weights(OldWeights)
    ++" => "++bleu_projection_to_string(SingleBestProjDBLEU)++"\n", !I),
  TNewSNBL = merge_scored_nbestlists(SNBLSoFar, SNBL),
  trace[io(!I)] debugstr("Projected curr on merged: "++dump_weights(OldWeights)
    ++" => "++bleu_projection_to_string(project_bleu(Refs, TNewSNBL, OldWeights))++"\n", !I),
  NewSNBL = clean_nbl(Msg(""), Refs^refcount, OldWeights, SingleBestProjDBLEU^worst^bleu, TNewSNBL),
  % NewSNBL = TNewSNBL,
  % time_dump(TMscore, !IO),

  (
  if NewSNBL = SNBLSoFar
  then % nothing new in nbestlist
    debugstr(Msg("finished, nbestlist unchanged")++"\n", !IO),
    time_dump(TMtotal, !IO),
    BestWeights = OldWeights
  else % something new, worth optimizing
    time_start(Msg("optimizing"), TMopti, !IO),
    hash_table__generic_double_hash(NewSNBL, NewSNBLHash1, NewSNBLHash2),
    % memusage.dump_process_status(!IO),
    cached.call(mert_cache_desc,
      (pred({_M, _N,W}::in, Opt::out, !.I::di, !:I::uo) is det :-
        Optimizer(NewSNBL, W, Opt, !I)
      ),
      pickle_to_stream(core_defs.pickles),
      unpickle_from_stream(core_defs.unpickles),
      {Model^slave_config, {NewSNBLHash1, NewSNBLHash2}, OldWeights},
      NewWeights,
      !IO),
    % Optimizer(NewSNBL, OldWeights, NewWeights, !IO),
    time_dump(TMopti, !IO),
    % debugstr(Msg("new weights: "++dump_weights(NewWeights))++"\n", !IO),
    OptiSingleDBLEU = project_bleu(Refs, SNBL, NewWeights),
    trace[io(!I)] debugstr("Projected opti on single: "++dump_weights(NewWeights)
      ++" => "++bleu_projection_to_string(OptiSingleDBLEU)++"\n", !I),
    trace[io(!I)] debugstr("Projected opti on merged: "++dump_weights(NewWeights)
      ++" => "++bleu_projection_to_string(project_bleu(Refs, NewSNBL, NewWeights))++"\n", !I),
    
    (
    if max_delta(OldWeights, NewWeights) < 0.005
    then % weights unchanged
      debugstr(Msg("finished, weights unchanged")++"\n", !IO),
      time_dump(TMtotal, !IO),
      BestWeights = NewWeights
    else
      time_dump(TMtotal, !IO),
      mert_loop(Optimizer, InTrees, Refs, Iter+1, NewSNBL, Model,
        NewWeights, BestWeights, !IO)
    )
  ).

:- pred dump_scored_nbest(scorednbestlist::in, io::di, io::uo) is det.
dump_scored_nbest(NBL, !IO) :-
  list__foldl(
    (pred(Sent-ScoredCands::in, !.I::di, !:I::uo) is det:-
      BleuComps = list__map(func(C)=C^bleucomps, set__to_sorted_list(ScoredCands)),
      TBleuComps = det_transpose(BleuComps),
      BlAvgDev = list__map(
        (func(Comps) = conffloat__to_string(2, conffloat(avg(L), stddev(L))) :-
          L = list__map(func(I)=float(I), Comps)
        ),
        TBleuComps),
      debugstr("Sent "++int_to_string(Sent)++": "++join_list(" ", BlAvgDev)++"\n", !I)
    ),
    add_ordering(NBL), !IO).

:- func max_delta(list(float), list(float)) = float.
max_delta(A, B) = Max :-
  Deltas = list__map_corresponding(func(X, Y) = abs(X-Y), A, B),
  Max = reducel(float__max, Deltas).

/*
:- pred translate_to_nbest(model(OCC)::in, list(later_t)::in, int::in, nbestlist::out, list(list(string))::out, io::di, io::uo) is cc_multi
     <= (generable(OCC, OC)).

translate_to_nbest(Model, InTrees, NBest, OutNBL, OutBest, !IO) :-
  transl_sentences
  list__foldl2(
    (pred(T::in, {TailBestCands, TailBestSents}::in, {OBestCands, OBestSents}::out, !.I::di, !:I::uo) is cc_multi:-
      transl(Model, latertree_to_deptree(T), Stacks, !I),
      transl_sentence(Model, length(InTrees), In, Out, _OutNBL, !S, !I)
      (
      if best(Stacks, BestHyp)
      then
        ThisBestSent = final_output_to_wordlist(BestHyp^output),
        debugstr("Best output: "++join_list(" ", ThisBestSent)++"\n", !I),
        BestHyps = get_n_best(Stacks^elem(size(Stacks)-1), NBest),
        % convert hyps to candidates
        ThisBestCands = list__map(
          (func(H)=candidate(final_output_to_wordlist(H^output),
            to_scorelist(H^score))),
          BestHyps)
      else % no translation found
        ThisBestCands = [],
        ThisBestSent = []
      ),
      OBestSents = [ThisBestSent | TailBestSents],
      OBestCands = [ThisBestCands | TailBestCands]
    ), InTrees, {[], []}, {TNBL, TSents}, !IO),
  OutNBL = reverse(TNBL),
  OutBest = reverse(TSents).
*/

    

:- type stats(OC) ---> stats(
          cnt :: int, % number of sentences translated
          revsents :: list(transl_sentence_output(OC)),
            % output sentences, in reverse order
          revnbestcands :: list(list(candidate)),
            % output nbestlists, in reverse order
          treelet_min_counts_for_best_hyp :: list(int),
            % the shortest paths lengths used to get to the best hypothesis
          treelet_max_counts_for_best_hyp :: list(int),
            % the longest paths lengths used to get to the best hypothesis
            % recombination is what makes min and max differ
          durations :: assoc_list(sentid, float), % how long which sentence took
          trgens :: bag(string), % which trgens were used how often
          input_words :: list(int), % input sentence lengths
          output_words :: list(int) % input sentence lengths
        ).

:- func init_stats = stats(OC).
init_stats = stats(0, [], [], [], [], [], bag.init, [], []).

:- func stats_join(stats(OC), stats(OC)) = stats(OC).
stats_join(
    stats(ACnt, ARev, ARevNBL, AMin, AMax, ADurs, ATrgens, AInLens, AOutLens),
    stats(BCnt, BRev, BRevNBL, BMin, BMax, BDurs, BTrgens, BInLens, BOutLens)
  ) = stats(
        ACnt + BCnt,
        BRev++ARev,
        BRevNBL++ARevNBL,
        BMin++AMin,
        BMax++AMax,
        BDurs++ADurs,
        bag.union(ATrgens, BTrgens),
        BInLens++AInLens,
        BOutLens++AOutLens
      ).

:- func ensure_serializable(stats(OC)) = stats(OC)
            <= oc_generic.oc(OCC, OC).
ensure_serializable(Stats)
 = Stats^revsents := list.map(
     (func(MayO) = Out :-
       MayO = no_translation, Out = no_translation
       ; MayO = translated(TO, TS),
           Out = translated(ensure_serializable(TO), TS)
     ),
     Stats^revsents).

:- func mert_cache_desc = cache_desc.
mert_cache_desc = cache_desc("../../cache_mert2/", yes(100)).


:- pred transl(model(OCC)::in, t::in, stacks(OCC, OC)::out, io::di, io::uo) is cc_multi
     <= (generable(OCC, OC)).

transl(Model, T, ImprovedFilledStacks, !IO) :-
  % debugstr("Input sentence: "++join_list(" ", to_list(T^words))++"\n", !IO),
  (
  if size(T) > wisebmp__max_width
  then error("BMP can't hold this long sentence")
  else true
  ),
  debugstr("Input sentence: "++dump_words_to_string(list(T^words))++"\n", !IO),
  time_start("Generating tropts", TMTrOpts, !IO),
  make_tropts(
    Model^trgshared,
    Model^trproviders, T, TrOpts),
  time_dump(TMTrOpts, !IO),
  dump_tropt_sizes(TrOpts, !IO),
  Words = size(T),
  Stacks = init(Words+1, recombstack__new(Model^stack_limit)),
  S0 = Stacks^elem(0),
  S01 = insert_prune(hyp_new(Model, T), S0),
  NewStacks = (Stacks^elem(0) := S01),
  process(Model, T, TrOpts, 0, NewStacks, FilledStacks, !IO),
  dump_stack_sizes(Words, FilledStacks, !IO),

  % additional forced searches in different space regions
  ForcedBreadth = Model^config^tweaks^int(forced_upper_breadth),
  list.foldl2(
    (pred(SrcStackNo::in, !.A::in, !:A::out, !.I2::di, !:I2::uo) is cc_multi :-
      Seeds = sorted_elems(FilledStacks^elem(SrcStackNo)),
      list.foldl2(
        (pred(Iteration::in,
            {ISeeds, IFinStack}::in,
            {OSeeds, OFinStack}::out,
            !.I::di, !:I::uo) is cc_multi :-
          ISeeds = [],
            OSeeds = [], OFinStack = IFinStack
          ;
          ISeeds = [Seed|OSeeds],
            dump_hyp(
              string.format("Forced restart %i/%i at stack %i/%i from: ",
                [i(Iteration), i(ForcedBreadth),
                 i(SrcStackNo), i(size(T)-1)]),
              Seed, !I),
            Stks = init(Words+1, recombstack__new(Model^stack_limit)),
            StksWithSeed = Stks^elem(1):=insert_prune(Seed, Stks^elem(1)),
            process(Model, T, TrOpts, 1, StksWithSeed, ThisFilledStacks, !I),
            dump_stack_sizes(Words, ThisFilledStacks, !I),
            % merge
            list.foldl(
              insert_prune, unsorted_elems(ThisFilledStacks^elem(size(T))),
              IFinStack, OFinStack),
            % debugstr("Ifin, ofin: ",
            %   {0+size(IFinStack), 0+size(OFinStack)}, !I),
            (
            if best(ThisFilledStacks, ThisBest)
            then
              debugformat("  Best scored: %s\n", [
                s(detailed_score(Model, ThisBest))
                ], !I)
            else
              debugstr("  no best hyp from this run\n", !I)
            )
        ),
        1`..`min(ForcedBreadth, length(Seeds)),
        { Seeds, !.A },
        { _, !:A }, !I2
      )
    ),
    1`..`(size(T)-1),
    FilledStacks^elem(size(T)), ImprovedLastStack,
    !IO
  ),
  ImprovedFilledStacks = (Stacks^elem(size(T)) := prune(ImprovedLastStack)),

  true.


:- pred transl_sentences(model(OCC)::in, 
            list(later_t)::in,
            list(transl_sentence_output(OC))::out,
            stats(OC)::in, stats(OC)::out, io::di, io::uo) is cc_multi
     <= (generable(OCC, OC)).
transl_sentences(Model, InTrees, OutSents, !Stats, !IO) :-
  list.map_foldl2(
    (pred(In::in, Out::out, !.S::in, !:S::out, !.I::di, !:I::uo) is cc_multi :-
      transl_sentence(Model, length(InTrees), In, Out, _OutCands, !S, !I)
    ),
    InTrees,
    OutSents,
    !Stats, !IO).

:- type transl_sentence_output(OC) --->
          no_translation
        ; translated(
            final_output :: OC,
            final_score :: single_score
          ).

/*
:- type scored_output(OC) ---> scored_output(
          so_output :: OC,
          so_score :: score,
          so_final_score :: single_score
        ).
:- type transl_sentence_output_nbest(OC) --->
          no_translation
        ; translated(
            nbest_outputs :: list(scored_output(OC))
          ).
*/

:- pred transl_sentence(model(OCC)::in, int::in,
            later_t::in, transl_sentence_output(OC)::out,
            list(candidate)::out,
            stats(OC)::in, stats(OC)::out, io::di, io::uo) is cc_multi
     <= (generable(OCC, OC)).
transl_sentence(Model, TotSents,
    LaterT, TranslOutput, NBLOutput, !Stats, !IO) :-
  T = latertree_to_deptree(LaterT),
  !Stats^cnt:= !.Stats^cnt+1,
  SentID = T^sentid,
  io.get_environment_var("JUSTSENT", MayJust, !IO),
  (
  if MayJust = yes(JustStr),
     JustL = list.map(
       (func(S) = det_to_int_or_die(S,
         (func)="Bad sentence ID "++S++" in JUSTSENT: "++JustStr)
       ), split_at_char(',', JustStr)),
     not(member(int(SentID), JustL))
  then % ignore this sentence
    TranslOutput = no_translation,
    NBLOutput = []
  else
    time_start("Processing sentence "++int_to_string(int(SentID))
      ++" ("++int_to_string(!.Stats^cnt)++"/"++int_to_string(TotSents)++")",
      TMFull, !IO),
    LastHypIDBeforeTranslating = last_hyp_id,
    LastRecombinedCntBeforeTranslating = recombined_cnt,
    
    transl(Model, T, FilledStacks, !IO),

    io__stderr_stream(StdErr, !IO),
    (
    if best(FilledStacks, BestHypBeforeResc)
    then % there is at least one output

      % if rescoring or producing n-bestlist, extract max(stacklimit, n) hyps
      % linearize and rescore them
      % otherwise just extract the first-best
      (
      if Model^nbest = yes(N)
      then NeedN = N
      else if need_rescoring(BestHypBeforeResc^output)
      then NeedN = Model^stack_limit
      else NeedN = 0
      ),
      (
      if NeedN = 0
      then
        BestOut = BestHypBeforeResc^output,
        BestScore = BestHypBeforeResc^score,
        NBLOutput = [],
        NBLInfo = ""
      else
        time_start("Extracting "++int_to_string(NeedN)++" best.", TMEx, !IO),
        % extract nbestlist
        LastStack = FilledStacks^elem(size(FilledStacks)-1),
        CompleteHyps = list.reverse(get_n_best(LastStack, NeedN)),
        time_dump(TMEx, !IO),

        % generate delayed factors
        % XXX

        % rescore them
        time_start("Rescoring "++int_to_string(length(CompleteHyps))
          ++" best.", TMResc, !IO),
        rescore_several_hypotheses(Model,
          CompleteHyps, RescoredCompleteHyps, !IO),
        time_dump(TMResc, !IO),

        SortedRescoredCompleteHyps = list.sort(
          (func(A, B)=builtin.ordering(B^c_singscore, A^c_singscore)),
          RescoredCompleteHyps),
        trace[runtime(env("RESCORE")), io(!DIO)]
          debugstr(join_list("",
            list.map(
              (func(Cand) = string.format("orig  %.3f\t%s\t%s\n",
                [f(Cand^c_singscore),
                 s(join_list(" ", final_output_to_wordlist(Cand^c_output))),
                 s(to_string(3, Cand^c_score))
                ])
              ), RescoredCompleteHyps)
            ), !DIO),
        trace[runtime(env("RESCORE")), io(!DIO)]
          debugstr(join_list("",
            list.map(
              (func(Cand) = string.format("resc  %.3f\t%s\t%s\n",
                [f(Cand^c_singscore),
                 s(join_list(" ", final_output_to_wordlist(Cand^c_output))),
                 s(to_string(3, Cand^c_score))
                ])
              ), SortedRescoredCompleteHyps)
            ), !DIO),
        (
        if det_head(SortedRescoredCompleteHyps) \= det_head(RescoredCompleteHyps)
        then debugstr("Yes, different first hypothesis!\n", !IO)
        else true
        ),

        BestCompleteHyp = det_head(SortedRescoredCompleteHyps),
        BestOut = BestCompleteHyp^c_output,
        BestScore = BestCompleteHyp^c_score,
        % convert hyps to candidates
        NBLOutput = list__map(
          (func(H)=candidate(final_output_to_wordlist(H^c_output),
            to_scorelist(H^c_score))),
          SortedRescoredCompleteHyps),
        NBLInfo = ", NBL size: "++int_to_string(length(NBLOutput))
      ),

      BestWords = final_output_to_wordlist(BestOut),
      BestString = final_output_to_string(BestOut),
      OldMax = !.Stats^treelet_max_counts_for_best_hyp,
      !Stats^treelet_max_counts_for_best_hyp :=
        [ hyp_max_predecessors(BestHypBeforeResc) | OldMax ],
      OldMin = !.Stats^treelet_min_counts_for_best_hyp,
      !Stats^treelet_min_counts_for_best_hyp :=
        [ hyp_min_predecessors(BestHypBeforeResc) | OldMin ],
      !Stats^input_words := [ T^size | !.Stats^input_words ],
      !Stats^output_words := [ length(BestWords) | !.Stats^output_words ],
      % do *not* emit anything on stdout, slave mode gets screwed up!
      % io__write_string(BestString++"\n", !IO), % print the best hypothesis
      debugstr("Input sentence (repeated): "
        ++dump_words_to_string(list(T^words))++"\n", !IO),
      TroptsBeforeResc = BestHypBeforeResc^tropts_used_so_far,
      TroptRanks = list.reverse(list.map(
        func(tropt_used(_name, R))=R, TroptsBeforeResc)),
      TroptRanksStr = join_list(",", list.map(int_to_string, TroptRanks)),
      TroptCounts = bag.from_list(list.map(
        func(tropt_used(Name, _r))=Name, TroptsBeforeResc)),
      !:Stats = !.Stats^trgens := bag.union(TroptCounts, !.Stats^trgens),
      TroptCountsStr = join_list(" ", list.map(
          func(Name-Cnt) = string.format("%s:%i", [s(Name),i(Cnt)]),
          sort(by_value, desc, bag.to_assoc_list(TroptCounts)))),
      io__format(StdErr, "Best Hyp: %s\n  As words: %s\n  Scored: %s\n"
        ++"  Partial hyps: %i, recombined: %i%s\n"
        ++"  Tropt (BEFORE RESCORING) ranks: %s, Counts: %s\n", [
        s(BestString),
        s(join_list(" ", BestWords)),
        s(scorers.detailed_score(Model^weights, BestScore)),
        i(last_hyp_id - LastHypIDBeforeTranslating),
        i(recombined_cnt - LastRecombinedCntBeforeTranslating),
        s(NBLInfo),
        s(TroptRanksStr),
        s(TroptCountsStr)
      ], !IO),
      TranslOutput
        = translated(BestOut, single_score(Model^weights, BestScore))
    else
      TranslOutput = no_translation,
      NBLOutput = [],
      io__write_string(StdErr, "NO BEST HYPOTHESIS\n", !IO)
      % do *not* emit anything on stdout, slave mode gets screwed up!
      % io__nl(!IO) % print empty line instead of the hypothesis
    ),
  
    !Stats^revsents:=[TranslOutput|!.Stats^revsents],
    !Stats^revnbestcands:=[NBLOutput|!.Stats^revnbestcands],
    seconds_since(TMFull, Duration, !IO),
    !Stats^durations:=[SentID-Duration|!.Stats^durations],
    
    % expand_map.after_sentence(Model, FilledStacks, T, !IO),
  
    time_dump(TMFull, !IO)
  ).

:- pred print_nbest(model(OCC)::in, int::in, int::in,
            treedecode.stack(OCC, OC)::in, io::di, io::uo) is det
     <= oc(OCC, OC).
print_nbest(_Model, SentNum, NBest, LastStack, !IO) :-
  BestCompleteHyps = get_n_best(LastStack, NBest),
  list__foldl(
    (pred(H::in, !.I::di, !:I::uo) is det:-
      io__format("%i\t%s\t%s\t%f\n", [
        i(SentNum),
        s(dump_to_string(H^c_output)),
        s(join_list(" ", list__map(float_to_string, to_scorelist(H^c_score)))),
        f(H^c_singscore)
      ], !I)
    ), BestCompleteHyps, !IO).
 
:- func get_n_best(treedecode.stack(OCC, OC), int) = list(complete_h(OC))
     <= oc(OCC, OC).

get_n_best(Stack, NBest) = CompleteHyps :-
  % If there were no hypothesis recombination, this would do the job:
  %   Hyps = take_upto(NBest, sorted_elems(Stack))
  % With recombination, we have to search the lattice back.

  % convert finalhyps to backstates, push them to queue
  list.foldl2(
    (pred(H::in, !.B::in, !:B::out, _::in, W::out) is det :-
      list.foldl(
        (pred(Delta::in, !.B2::in, !:B2::out) is det :-
          TailScore = Delta^delta_score,
          svinsert(
            backstate_score(0, single_score(H^model^weights, TailScore)),
            backstate(Delta^source_hyp, TailScore, [Delta^tail_operation]), !B2)
        ), set.to_sorted_list(H^src), !B),
      W = H^model^weights % just pick the weights
    ),
    unsorted_elems(Stack), binheap.init, SeedBH,
    version_array.empty, Weights),
  % NBest-times ask the monad to provide the best hypothesis
  rev_take_upto(NBest,
    get_next_best(Weights),
    _RemainingMonad,
    open_backstates(
      NBest,
      0, 0,
      SeedBH,
      set.init
    ),
    _RemainingBestHyps,
    [], CompleteHyps),
  true.

:- type backstate(OCC, OC) ---> backstate(
            curr_h :: h(OCC, OC), % current hypothesis
            tail_score :: score, % score from curr_h till end
            tail_operations :: list(tail_operation(OC))
                % operations from curr_h till end
          ).

:- type tail_operation(OC) ---> tail_operation(
          node :: int,
          operation :: OC
        ).

    % checks for sentinel
:- pred backstate_is_origin(backstate(OCC, OC)::in) is semidet.
backstate_is_origin(BS) :-
  BS^curr_h^covered_cnt = 0.

:- type backstate_score ---> backstate_score(
                                stack_no :: int,
                                backstate_score::single_score
                              ).

:- instance ordered(backstate_score) where [
     % sort by ascending stack_no
     % within stack sort by decreasing score
     ordering(A, B) = Ord :- (
       S = builtin__ordering(A^stack_no, B^stack_no),
       (
       if S = (=)
       then Ord  = builtin__ordering(B^backstate_score, A^backstate_score)
       else Ord = S
       )
     )
   ].

:- type open_backstates(OCC, OC) ---> open_backstates(
            limit :: int,
            curr_stack :: int,
            curr_count :: int, % how many hyps from the current stack
              % were generated already
            bh :: binheap(backstate_score, backstate(OCC, OC)),
            seen_outputs :: set(OC) % to produce n unique outputs
          ).

:- pred get_next_best(weights::in)
            `with_type` monad_aku(complete_h(OC), open_backstates(OCC, OC))
            `with_inst` monad_aku
        <= (oc(OCC, OC)).
get_next_best(Weights, !OBS, Result) :-
  trace[runtime(env("GETNBEST")), io(!IO)]
    debugformat("get_next_best, bh: %s\n",
      [s(join_list(" ",
          list.map(func(BSC)=string.format("%i:%.3f",
            [i(BSC^stack_no), f(BSC^backstate_score)]),
            keys(binheap.to_sorted_assoc_list(!.OBS^bh))))
        )], !IO),
  (
  if getmin(!.OBS^bh, backstate_score(HypStackNo, TailSingleScore), BackState,
        NewBH)
  then
    !OBS^bh := NewBH,
    (
    if HypStackNo > !.OBS^curr_stack
    then
      % a stack ended before limit
      % move to the stack of current hyp, reset count
      !OBS^curr_stack := HypStackNo,
      !OBS^curr_count := 0
    else true
    ),
    % Solving current stack
    % within stack, if under limit, proceed, if over limit, just drop
    (
    if !.OBS^curr_count > !.OBS^limit
    then % over limit, drop hyp, search to different stack
      get_next_best(Weights, !OBS, Result)
    else % below limit, proceed
      !OBS^curr_count := !.OBS^curr_count+1,
      (
      if backstate_is_origin(BackState)
      then % got another next best
        trace[runtime(env("GETNBEST")), io(!IO)]
          debugstr("Got to root, score: ", TailSingleScore, !IO),
        list_tools.reducel(
          (pred(
              tail_operation(Where, SmallOC)::in,
              tail_operation(Root, OCSoFar)::in,
              tail_operation(Root, OutOC)::out) is det :-
            trace[runtime(env("GETNBEST")), io(!IO)]
              debugformat("Attach at %i: %s\n         to: %s\n",
                [i(Where), s(dump_to_string(SmallOC)),
                 s(dump_to_string(OCSoFar))], !IO),
            {OutOC, _Score} = oc_expand(OCSoFar, Where, SmallOC)
          ), BackState^tail_operations, tail_operation(_, FinalOC)),
        (
        if set.member(FinalOC, !.OBS^seen_outputs)
        then % skip this output, don't count stacklimit
          !OBS^curr_count := !.OBS^curr_count-1,
          get_next_best(Weights, !OBS, Result)
        else
          set.insert(!.OBS^seen_outputs, FinalOC, NewSeen),
          !OBS^seen_outputs := NewSeen,
          CompleteHyp = complete_h(BackState^tail_score,
            single_score(Weights, BackState^tail_score),
            FinalOC),
          trace[runtime(env("GETNBEST")), io(!IO)]
            debugformat("Got complete: %s\n",
              [s(dump_to_string(FinalOC))], !IO),
          Result = result(CompleteHyp, get_next_best(Weights))
        )
      else % have to expand BackState
        BackState = backstate(H, TailScore, TailOps),
        trace[runtime(env("GETNBEST")), io(!IO)]
          dump_hyp("Backing from: ", H, !IO),
        trace[runtime(env("GETNBEST")), io(!IO)]
          debugstr("  Sources: "
            ++join_list(", ",
                list.map(func(D)=dump_hypid(D^source_hyp),
                  set.to_sorted_list(H^src)))
            ++"\n", !IO),
        TailCoveredCnt = HypStackNo,
        list.foldl(
          (pred(Delta::in, !.B::in, !:B::out) is det :-
            PrevH = Delta^source_hyp,
            trace[runtime(env("GETNBEST")), io(!IO)]
              dump_hyp("    Prev hyp: ", PrevH, !IO),
            NewTailScore = TailScore + Delta^delta_score,
            NewTailOps
              = [ Delta^tail_operation | TailOps],
            NewCoveredCnt = TailCoveredCnt + Delta^delta_covered_cnt,
            NewBackState = backstate(PrevH, NewTailScore, NewTailOps),
            binheap.svinsert(
              backstate_score(
                NewCoveredCnt,
                single_score(Weights, NewBackState^tail_score)
              ),
              NewBackState, !B)
          ),
          set.to_sorted_list(H^src), !.OBS^bh, NewBH2),
        !OBS^bh := NewBH2,
        % directly search for next
        get_next_best(Weights, !OBS, Result)
      )
    )
  else Result = no_more_results
  ).




:- import_module stack.

:- mutable(glob_recombined_cnt, int, 0, ground, [untrailed]).
:- func recombined_cnt = int.
:- pragma promise_pure(recombined_cnt/0).
recombined_cnt = S :- semipure get_glob_recombined_cnt(S).
:- func inc_recombined_cnt = int. % assign a new id, increase
:- pragma promise_pure(inc_recombined_cnt/0).
inc_recombined_cnt = S :-
  semipure get_glob_recombined_cnt(S),
  impure set_glob_recombined_cnt(S+1).


:- mutable(glob_last_hyp_id, int, 0, ground, [untrailed]).
:- func last_hyp_id = int.
:- pragma promise_pure(last_hyp_id/0).
last_hyp_id = S :- semipure get_glob_last_hyp_id(S).
:- func new_hyp_id = int. % assign a new id, increase
:- pragma promise_pure(new_hyp_id/0).
new_hyp_id = S :-
  semipure get_glob_last_hyp_id(S),
  impure set_glob_last_hyp_id(S+1).

:- func dump_hypid(h(OCC, OC)) = string.
dump_hypid(H) = dump_hypid_int(H^hypid).
:- func dump_hypid_int(int) = string.
dump_hypid_int(I) = "H"++int_to_string(I)++"H".

:- type tropt_used ---> tropt_used(
            % root_index ... where the tropt is rooted
            trgname :: string, % the generator of this tropt
            tropt_rank :: int % rank of the tropt within the tropts stack
          ).

    % delta describes how a hyp was created from a previous hyp
:- type delta(OCC, OC) ---> delta(
          source_hyp :: h(OCC, OC),
          delta_score :: score,
          delta_covered_cnt :: int,
          tail_operation :: tail_operation(OC) % the operation (tropt) used here
        ).

:- type h(OCC, OC) ---> h(
            hypid :: hypid,
            singscore :: single_score,
            score :: score, % the total score of this hypo
            % score_delta :: score, % the difference between this and the previous
            % covered_cnt_delta :: int, % the difference between this and prev
            % root :: int, % where a tropt was attached
            % operation :: OC, % the operation that was used here
            src :: set(delta(OCC, OC)), % all possible ways to get to this hyp
            tropts_used_so_far :: list(tropt_used),
            covered_cnt :: int,
            covered_bmp :: wisebmp, % which nodes were already covered
            queue :: list(opened_position), % queue of frontier nodes to cover
            output :: OC, % the concatenation of all operations until now
            input_tree :: t,
            model :: model(OCC)
          ).

% :- type h_key ---> h_key(string, string, set(opened_position)).
% :- type h_key ---> h_key(univ, univ, set(opened_position)).
% :- type h_key ---> h_key(univ, univ, set(int)).
                        % allow recombination with different afuns

:- type h_key --->
            opened_positions_equal(set(opened_position))
          ; opened_positions_and_some_father_attrs_equal(
              set({opened_position, maybe(restricted_word)})
            )
          .
:- type h_value ---> h_value(single_score, hypid).
:- instance ordered(h_value) where [
     ordering(A, B) = C :- compare(C, A, B)
   ].

:- instance stackable(h(OCC, OC), h_value, h_key) <= oc(OCC, OC) where [
     value(H)=h_value(H^singscore, H^hypid),
     func(to_key/1) is treedecode.to_key,
     pred(recombine/3) is treedecode.recombine,
     (write_elem(Msg, H, !IO) :-
       dump_hyp(Msg, H, !IO)
     )
   ].

:- func to_key(h(OCC, OC)) = h_key
     <= oc(OCC, OC).
to_key(H) = Key :-
  EqTest = H^model^config^recomb_equality,
  (
  EqTest = opened_positions_equal,
    Key = opened_positions_equal(list_to_set(H^queue))
  ;
  EqTest
  = opened_positions_and_some_father_attrs_equal(FactorsConfig, UseFactors),
    Restrictor = make_restrictor(FactorsConfig^word^wordfactor, UseFactors),
    Slots = list.map(
      (func(Pos@opened_position(Fr, _Afun)) = {Pos, MayFatherAttrs} :-
        if find_frontier_parent(H^output, Fr, Father)
        then 
          RestrictedFather = Restrictor(Father),
          /*
          trace[io(!IO)]debugformat("restrict %s  <== %s\n",
            [s(dump_restricted_word(RestrictedFather)),
             s(dump_word_to_string(Father))], !IO),
          */
          MayFatherAttrs = yes(RestrictedFather)
        else
          MayFatherAttrs = no
      ), H^queue),
    Key = opened_positions_and_some_father_attrs_equal(list_to_set(Slots))
  ).

/* various outdated options:
    % to_ordinal(H^covered_bmp), % might be needed in future
    % dump_to_string(H^output),
    % univ(H^covered_bmp),
    % univ(H^output),
    list_to_set(H^queue)
    % list_to_set(OpenSlots)
  ) :-
  % trace[io(!IO)]debugstr("KEYED:\t"++to_ordinal(H^covered_bmp)++"<TAB>"++dump_to_string(H^output)++"<TAB>"++dump(H^queue)++"\t", H^output, !IO).
  % OpenSlots = list.map(func(opened_position(I,_))=I, H^queue),
  true.
*/

:- pred recombine(h(OCC, OC)::in, h(OCC, OC)::in, h(OCC, OC)::out) is semidet
        <= (stackable(h(OCC, OC), h_value, h_key), oc(OCC, OC)).
recombine(H1, H2, OutH) :-
  trace[io(!IO)] debugstr("Recombining 1: ", type_of(H1), !IO),
  trace[io(!IO)] debugstr("Recombining 2: ", type_of(H2), !IO),
  trace[io(!IO)] debugstr("Recombining 3: ", type_of(OutH), !IO),
  dump_h0($line),
  trace [run_time(env("RECOMB")), io(!IO)] (
    dump_hyp("Recomb: ", H1, !IO),
    dump_hyp("   and: ", H2, !IO)
  ),
  S1 = singscore(H1),
  S2 = singscore(H2),
  (
  if S1 > S2
    ; (S1 = S1, hypid(H1)<hypid(H2))
  then % H1 better or at least older
    TOutH = H1
  else % H2 better
    TOutH = H2
  ),
  _unused = inc_recombined_cnt,
  % Remember all possible ways to get to this hypothesis
  (
  if identical(H1^output, H2^output)
  then % keep just better history
    OutH = TOutH
  else % keep both histories
    dump_h0($line),
    trace [run_time(env("RECOMB")), io(!IO)]
      debugstr("   ...keeping both histories\n", !IO),
    dump_h0($line),
    trace[runtime(env("RECOMB")), io(!IO)] (
      list.foldl(
        (pred(S::in, !.I::di, !:I::uo) is det:-
          debugstr("   Source of "++dump_hypid(H1)++": ", dump_hypid(S^source_hyp), !I),
          debugstr("   VAL: ", S, !I)
        ), set.to_sorted_list(H1^src),
        !IO)),
    trace[runtime(env("RECOMB")), io(!IO)]
          debugstr("   Sources of "++dump_hypid(H2)++": "
            ++join_list(", ",
                list.map(func(D)=dump(D^source_hyp),
                % list.map(func(D)=dump_hypid(D^source_hyp),
                  set.to_sorted_list(H2^src)))
            ++"\n", !IO),
    OutH = TOutH^src := set.union(H1^src, H2^src),
    trace[runtime(env("RECOMB")), io(!IO)]
          debugstr("   Sources of merged "++dump_hypid(OutH)++": "
            ++join_list(", ",
                list.map(func(D)=dump_hypid(D^source_hyp),
                  set.to_sorted_list(OutH^src)))
            ++"\n", !IO)
  ).
  /*
  % we won't recombine hyps differing in opened slot labels, if the difference
  % in cost is smaller than the penalty of slot relabelling
  O1 = sort(by_key, asc, opened_positions_to_assoc_list(H1^queue)),
  O2 = sort(by_key, asc, opened_positions_to_assoc_list(H2^queue)),
  % and in general, the hyps must have the same number and positions of slots
  keys(O1) = keys(O2) `with_type` list(int),
  % count differing afuns
  Differing = list.foldl(func({A,B}, IC) = (if A=B then IC else IC+1),
    list.map_corresponding(func(A,B)={A,B}, values(O1), values(O2)),
    0),
  % require the gap in scores
  M = H1^model,
  (
  if float(Differing)
      *weight_of_scorer_id(M^weights, M^right_root_coercion_scorer)
    > abs(S1-S2)
  then
    (
    if S1 > S2
      ; (S1 = S1, hypid(H1)<hypid(H2))
    then % H1 better or at least older
      TOutH = H1
    else % H2 better
      TOutH = H2
    ),
    _unused = inc_recombined_cnt,
    % Remember all possible ways to get to this hypothesis
    OutH = TOutH^src := set.union(H1^src, H2^src)
  else
    trace [run_time(env("RECOMB")), io(!IO)]
      debugstr("...too similar scores to recombine.\n", !IO),
    fail
  ).
  */

:- func hyp_new(model(OCC), t) = h(OCC, OC) <= oc(OCC, OC).
hyp_new(M, T) = h(new_hyp_id, 0.0, BlankScore, 
  set.init,
  [], % tropt history
  0, new,
  [opened_position(0, "--root--")],
  BlankOC,
  T, M) :-
  {BlankOC, BlankScore} = oc_generic.init(M^occonf, T, M^scorers).

:- func hyp_min_predecessors(h(OCC, OC)) = int.
% count the length of hypotheses chain, exluding the current hyp
% for recombined hypothesis, the shortest length is returned
:- func hyp_max_predecessors(h(OCC, OC)) = int.
% count the length of hypotheses chain, exluding the current hyp
% for recombined hypothesis, the longest length is returned
hyp_min_predecessors(H) = Len :-
  hyp_predecessors(int.min, H, Len, map.init, _).
hyp_max_predecessors(H) = Len :-
  hyp_predecessors(int.max, H, Len, map.init, _).

:- pred hyp_predecessors(func(int, int)=int, h(OCC, OC), int, map(hypid, int), map(hypid, int)).
:- mode hyp_predecessors(func(in, in)=out is det, in, out, in, out) is det.
hyp_predecessors(MinMax, H, Len, !Known) :-
  if map.search(!.Known, H^hypid, KnownLen)
  then Len = KnownLen
  else
    Preds = list.map(func(D)=D^source_hyp, set.to_sorted_list(H^src)),
    (
      Preds = [], Len = 0
    ; Preds = [_|_],
        list.map_foldl(hyp_predecessors(MinMax), Preds, Lens, !Known),
        Len = 1+reducel(MinMax, Lens)
    ),
    svmap.det_insert(H^hypid, Len, !Known).

:- type stack(OCC, OC) == recombstack__stack(h(OCC, OC), h_value, h_key).

:- type stacks(OCC, OC) == version_array(treedecode.stack(OCC, OC)).



:- pred dump_tropt_sizes(tropts(OC)::in, io::di, io::uo) is det.
dump_tropt_sizes(Stacks, !IO) :-
  io__stderr_stream(Stream, !IO),
  io__write_string(Stream, "TrOpts per word:", !IO),
  list__foldl(
    (pred(S::in, !.I::di, !:I::uo) is det:-
      io__format(Stream, " %i", [i(length(S))], !I)
    ), to_list(Stacks), !IO),
  io__nl(Stream, !IO).



:- pred dump_stack_sizes(int::in, stacks(OCC, OC)::in, io::di, io::uo) is det.
dump_stack_sizes(CurrStack, Stacks, !IO) :-
  io__stderr_stream(Stream, !IO),
  io__write_string(Stream, "[", !IO),
  fold_up(
    (pred(J::in, !.I::di, !:I::uo) is det:-
      S = Stacks^elem(J),
      io__format(Stream, " %i", [i(S^size)], !I),
      (
      if J=CurrStack
      then io__write_string(Stream, ">", !I)
      else true
      )
    ), 0, Stacks^size-1, !IO),
  io__write_string(Stream, "]", !IO),
  io__nl(Stream, !IO).

:- pred best(stacks(OCC, OC)::in, h(OCC, OC)::out) is semidet
     <= oc(OCC, OC).
best(Stacks, TBestHypo) :-
  peek_top(Stacks^elem(size(Stacks)-1), TBestHypo).


:- func best(stacks(OCC, OC)) = h(OCC, OC)
     <= oc(OCC, OC).

best(Stacks) = BestHypo :-
  (
  if best(Stacks, TBestHypo)
  then
    BestHypo = TBestHypo
  else
    error("Last stack is empty!")
  ).


:- pred dump_hyp(string::in, h(OCC, OC)::in, io::di, io::uo) is det
     <= oc(OCC, OC).
dump_hyp(Msg, H, !IO) :-
  io__stderr_stream(E, !IO),
  dump_hyp(E, Msg, H, !IO).
:- pred dump_hyp(io__output_stream::in, string::in, h(OCC, OC)::in, io::di, io::uo) is det
   <= oc(OCC, OC).
dump_hyp(OutStream, Prefix, H, !IO) :-
  io__format(OutStream, "%s%s (%s): %s\tcovering: %s\t%s\n", [
    s(Prefix),
    s(dump_hypid(H)),
    s(nice_score(H^model, H)),
    s(dump_to_string(
        (func(F)=
          (
          if get_afun_from_queue(H^queue, F, TgtAfun)
          then TgtAfun++"-"++int_to_string(F)
          else int_to_string(F)
          )
        ), H^output)),
    s(dump_covered(H^input_tree, H)),
    s(detailed_score(H^model, H))
  ], !IO).

:- pred process(model(OCC)::in, t::in, tropts(OC)::in, int::in, stacks(OCC, OC)::in, stacks(OCC, OC)::out, io::di, io::uo) is cc_multi
     <= oc(OCC, OC).

process(Model, T, TrOpts, StackCnt, Stacks, OutStacks, !IO) :-
  % io__format("Processing stack %i which contains %i hyps\n",
    % [i(StackCnt), i(length(Elems))], !IO),
  (
  if StackCnt = size(Stacks)-1
  then % finished!
    LastStack = prune(Stacks^elem(StackCnt)),
    trace [run_time(env("DUMPSTACK")), io(!IO2)] (
      io__stderr_stream(StdErr, !IO2),
      io__write_string(StdErr, "Last stack: "
        ++int_to_string(StackCnt)++".\n", !IO2),
      recombstack__foldl(
        (pred(H::in, !.I::di, !:I::uo) is det :-
          % dump the hypothesis
          dump_hyp("Final: ", H, !I),
          % recalc its score
          % det_univ_to_type(univ(H), H2),
          % aux_hyp_recalc_score(Model^lm, H2, !I),
          true
        ), LastStack, !IO2)
    ),
    OutStacks = Stacks^elem(StackCnt) := LastStack
  else % expanding
    Stack = prune(Stacks^elem(StackCnt)),
    UseStacks = Stacks^elem(StackCnt) := Stack,
    (
    if Stack^size = 0
    then
      % try further stacks
      trace [run_time(env("DUMPSTACK")), io(!IO2)]
        debugstr("Skipping empty stack "
          ++int_to_string(StackCnt)++".\n", !IO2),
      process(Model, T, TrOpts, StackCnt+1, UseStacks, OutStacks, !IO)
    else
      trace [run_time(env("DUMPSTACKSIZES")), io(!IO2)]
        dump_stack_sizes(StackCnt, UseStacks, !IO2),
      trace [run_time(env("DUMPSTACK")), io(!IO2)] (
        io__stderr_stream(StdErr, !IO2),
        io__write_string(StdErr, "Processing stack "
          ++int_to_string(StackCnt)++".\n", !IO2),
        recombstack__foldl(dump_hyp("ToExp: "), Stack, !IO2)
      ),
      recombstack__fold(
        expand(Model, T, TrOpts), Stack, UseStacks, TOutStacks),
      % debugstr("Processed all from stack "
        % ++int_to_string(StackCnt)++".\n", !IO),
      trace [run_time(env("DUMPSTACK")), io(!IO3)] debugstr("\n", !IO3),
      process(Model, T, TrOpts, StackCnt+1, TOutStacks, OutStacks, !IO)
    )
  ).

:- func dump_covered(t, h(OCC, OC)) = string.
dump_covered(T, H) = join_list(" ", Wrds) :-
  fold_down(
    (pred(I::in, Tail::in, [W|Tail]::out) is det:-
      if get(H^covered_bmp, I)
      then
        TW = dump_word_to_string(T^words^elem(I)),
        (
        if get_afun_from_queue(H^queue, I, TgtAfun)
        then W = "["++TW++"-"++TgtAfun++"-"++int_to_string(I)++"]"
        else W = TW
        )
      else W = "_"
    ), 0, T^size-1, [], Wrds).



:- pred expand(model(OCC)::in, t::in, tropts(OC)::in, h(OCC, OC)::in,
            stacks(OCC, OC)::in, stacks(OCC, OC)::out) is cc_multi
     <= oc(OCC, OC).

expand(Model, T, TrOpts, InH, InStacks, OutStacks) :-
  trace[io(!IO)]
    possibly_self_kill(!IO),
    % exit_if_over_x_perc_realmem(40.0, !IO),
  unsorted_aggregate(
    generate_next(Model, T, TrOpts, InH), 
    (pred(H::in, IS::in, OS::out) is det:-
      Targ = H^covered_cnt,
      I = IS^elem(Targ),
      trace[io(!IO)] debugstr("Inserting: ", type_of(H), !IO),
      OS = IS^elem(Targ) := insert_prune(H, I)
    ), InStacks, OutStacks).

  
:- pred generate_next(model(OCC)::in, t::in, tropts(OC)::in,
            h(OCC, OC)::in, h(OCC, OC)::out) is nondet
     <= oc(OCC, OC).

:- mutable(lh, maybe(univ), no, ground, [untrailed]).

:- pred dump_h0(int::in) is det.
dump_h0(Lineno) :-
  trace [io(!IO), state(lh, !LH)]
    (
    !.LH = no
    ;
    !.LH = yes(UnivLH),
      debugstr("Printing H0 at "++ $file++":"++int_to_string(Lineno)++"\n", !IO),
      det_univ_to_type(UnivLH, LH),
      same_type(H`with_type`treedecode.h(oc_segments.config, oc_segments.oc_segments), LH),
      debugstr("  H0: ", LH, !IO)
    ).

generate_next(M, T, TrOpts, H, NextHyp) :-
  trace [run_time(env("EXPAND")), io(!IO)] debugstr("Expanding "++dump_hypid(H)++" ("++nice_score(M, H)++"): "++dump_to_string(H^output)++"; covered: "++dump_covered(T, H)++"\n", !IO),
  trace [run_time(env("EXPAND")), io(!IO)] debugstr("Expanding: ", H, !IO),
  trace [run_time(env("EXPAND")), io(!IO), state(lh, !LH)]
    (
    !.LH = no,
      !:LH = yes(univ(H))
    ;
    !.LH = yes(UnivLH),
      det_univ_to_type(UnivLH, LH),
      same_type(H, LH),
      debugstr(" Fixed H0: ", LH, !IO)
    ),
  % trace [io(!IO)] debugstr("  Covered: "++bmp_to_string(H^covered_bmp)++"\n", !IO),
  (
  if pop(H^queue, Position, PoppedQueue)
  then % let's expand this node, former frontier, now the root
    Position = opened_position(Root, RootAfun),
    trace [run_time(env("TRACESONS")), io(!IO)] maytraceparent_of_sons(H, Root, !IO),
    % pick a translation option
    LocalTrOpts = TrOpts^elem(Root),
    % trace [io(!IO)] debugstr("  Available options at "++int_to_string(Root)++": ", 0+length(LocalTrOpts), !IO),
    member(TrOptRank-TrOpt, LocalTrOpts),
    TrOpt = tropt(_TrgName, _Weights, LT, TrInternalCnt, TrOptCovers, Frontiers, TrOptScore, RightRootAfun, RightSegs),
    trace [run_time(env("EXPANDNEW")), io(!IO)] debugstr("  + tropt at "++int_to_string(Root)++" to cover "++dump_tropt_lt(T, LT)++"\n", !IO),
    trace [run_time(env("EXPANDNEW")), io(!IO)] debugstr("    Tropt covers: "++to_string(TrOptCovers)++"\n", !IO),
    % ensure that this option can be applied here
    wisebmp__clear(intersect(TrOptCovers, unset(H^covered_bmp, Root))),
    trace [run_time(env("EXPANDNEW")), io(!IO)] debugstr("    and can be applied\n", !IO),
    (
    % root afun must match or a penalty applies
    % penalty has the meaning of probability: how probable is it for a Sb slot to be filled by an Obj filler
    if RightRootAfun = RootAfun
    then RightRootCoercionPenalty = 0.0
    else
      RightRootCoercionPenalty = -1.0,
      trace [run_time(env("EXPANDNEW")), io(!IO)]
        debugformat("    Paying for coercion: %s --> %s\n",
          [s(RightRootAfun), s(RootAfun)], !IO)
      % partial penalties possible for 'easily convertible afuns'
    ),
    % trace [io(!IO)] debugstr("    prev segments: ", H^outsegs, !IO),
    % NewSegs = expand_segments(M^lm, H^outsegs, Root, RightSegs),
    {NewSegs, ExpandScoreDelta} = oc_expand(H^output, Root, RightSegs),
    % trace [io(!IO)] debugstr("    exp segments:  ", NewSegs, !IO),
    % trace [io(!IO)] debugstr("      scoredeltaLM:  ", to_string(ExpandScoreDelta), !IO),
    NewQueue = Frontiers++PoppedQueue,
    % NewSegsScore = get_score(NewSegs),
    TScoreDelta = (new_score(M^scorers) + TrOptScore + ExpandScoreDelta)
          ^ plus(M^right_root_coercion_scorer, RightRootCoercionPenalty),
    % ScoreDelta = finalize(TScoreDelta),
    ScoreDelta = TScoreDelta,
    TScore = (H^score + ScoreDelta),
    % trace [io(!IO)] debugstr("      scoredeltaafun:  ", RightRootCoercionPenalty, !IO),
    % NewScore = finalize(TScore),
    NewScore = TScore,
    % trace [io(!IO)] debugstr("       exp score:  ", to_string(NewScore), !IO),
    NewCovered = union(TrOptCovers, H^covered_bmp),
    Delta = delta(H, % the previous hyp
      ScoreDelta, % the additional cost of this hyp
      TrInternalCnt, % how many iternals added this step
      tail_operation(Root, RightSegs) % arguments for expansion
    ),
    NextHyp = h(new_hyp_id,
      single_score(M^weights, NewScore),
      NewScore,
      make_singleton_set(Delta), % the previous hypo
      [tropt_used(TrOpt^trgname, TrOptRank)|H^tropts_used_so_far],
      H^covered_cnt+TrInternalCnt, NewCovered, NewQueue, NewSegs,
      H^input_tree, H^model),
    % trace [io(!IO)] debugstr("    Created a new hyp at "++int_to_string(Root)++": ", []++NextHyp^outsegs, !IO),
    trace [run_time(env("EXPANDNEW")), io(!IO)]
      debugstr("  = new "
        ++dump_hypid(NextHyp)
        ++" of "++int_to_string(H^covered_cnt+TrInternalCnt)
        ++" words ("++nice_score(M, NextHyp)++"): ========> "
        ++dump_to_string(NextHyp^output)
        ++", que: "++dump(NextHyp^queue)
        ++"\n", !IO),
    trace [run_time(env("EXPANDNEW")), io(!IO)] debugstr("    TrOptCovers: "++to_string(TrOptCovers)++"\n", !IO),
    trace [run_time(env("EXPANDNEW")), io(!IO)] debugstr("    OldCovered:  "++to_string(H^covered_bmp)++"\n", !IO),
    trace [run_time(env("EXPANDNEW")), io(!IO)] debugstr("    Newcovered:  "++to_string(NewCovered)++"\n", !IO),
    trace [run_time(env("TRACEBACK")), io(!IO)] maytraceback(M, NextHyp, !IO),
    trace [run_time(env("TRACESONS")), io(!IO)] maytraceson(NextHyp, !IO),

    % trace [io(!IO)] store_hyp_in_expand_map_if_needed(T, H, NextHyp, !IO),

    % trace [io(!IO)] debugstr("    scored: "++detailed_score(NextHyp)++"; "++dump(NextHyp^outsegs)++"\n", !IO),
    % trace [io(!IO)] (
      % det_univ_to_type(univ(NextHyp), NextHypOCSegs),
      % aux_hyp_recalc_score(M^lm, NextHypOCSegs, !IO)
    % ),
    true
  else
    % the queue is empty, this must not happen
    error("This hypo has no pending frontier nodes!")
  )
  .

:- pred maytraceparent_of_sons(h(OCC, OC)::in, int::in, io::di, io::uo) is det
     <= oc(OCC, OC).
maytraceparent_of_sons(H, Sub, !IO) :-
  (
  if
    set__member(H^hypid, glob_tracesons)
  then dump_hyp("Considering at "++int_to_string(Sub)++": ", H, !IO)
  else true
  ).
:- pred maytraceson(h(OCC, OC)::in, io::di, io::uo) is det
     <= oc(OCC, OC).
maytraceson(H, !IO) :-
  Preds = list.map(func(D)=D^source_hyp, set.to_sorted_list(H^src)),
  PredHypIDs = set.list_to_set(list.map(func(X)=X^hypid, Preds)),
  ObservedParentHypIDs =  set.to_sorted_list(
    set.intersect(glob_tracesons, PredHypIDs)),
  (
  ObservedParentHypIDs = [ParentH | OtherParents],
    dump_hyp("Son of "++dump_hypid_int(ParentH)++": ", H, !IO),
    list.foldl(
      (pred(OtherParentH::in, !.I::di, !:I::uo) is det:-
        dump_hyp("    or "++dump_hypid_int(OtherParentH)++": ", H, !I)
      ), OtherParents, !IO)
  ;
  ObservedParentHypIDs = [], true
  ).

:- pred maytraceback(model(OCC)::in, h(OCC, OC)::in, io::di, io::uo) is det
     <= oc(OCC, OC).
maytraceback(M, H, !IO) :-
  if set__member(H^hypid, glob_traceback)
  then
    debugnl(!IO),
    traceback("", M, H, !IO)
  else true.

:- pred traceback(string::in, model(OCC)::in, h(OCC, OC)::in, io::di, io::uo) is det
     <= oc(OCC, OC).
traceback(Prefix, M, H, !IO) :-
  io__stderr_stream(StdErr, !IO),
  io__format(StdErr, "%sTraceback: %s (%s): %s\tcv-ing: %s\t%s\n", [
    s(Prefix),
    s(dump_hypid(H)),
    s(nice_score(M, H)),
    s(dump_to_string(H^output)),
    s(dump_covered(H^input_tree, H)),
    s(detailed_score(M, H))
  ], !IO),
  Prevs = list.map(func(D)=D^source_hyp, set.to_sorted_list(H^src)),
  (
  Prevs = [],
    debugstr(Prefix++" -end-of-traceback-\n\n", !IO)
  ;
  Prevs = [_|_],
    list.foldl(traceback(Prefix++" ", M), Prevs, !IO)
  ).

/*
:- pred aux_hyp_recalc_score(lm::in, h(oc_segments.config, oc_segments)::in, io::di, io::uo) is det.
aux_hyp_recalc_score(no_lm, _H, !IO) :-
  debugstr("No lm, nothing to recalc\n", !IO).
aux_hyp_recalc_score(LM@lm(_, _, LMScorer, _), H, !IO) :-
  segments(KnownTot, _KnownScored, OutSegs) = H^output^segments,
  list__foldl2(
    (pred(Seg::in, IS::in, OS::out, !.I::di, !:I::uo) is det:-
      if Seg = scored(_, Sc, _, LJ, _)
      then
        compare_score("newhypseg", LM, Sc, LJ, _Same, !I),
        OS = IS+Sc
      else OS = IS
    ), OutSegs, 0.0, NewTot, !IO),
  Label = "newhypseg",
  KnownTot2 = peek(H^score, LMScorer),
  debugstr("    "++Label++" totalknown1:  ", KnownTot, !IO),
  debugstr("    "++Label++" totalknown2:  ", KnownTot2, !IO),
  debugstr("    "++Label++" totalrecalc:  ", NewTot, !IO),
  (
  if abs(KnownTot - NewTot) < 0.0001, 
     abs(KnownTot2 - NewTot) < 0.0001
  then true
  else debugstr("    "++Label++" DIFFER\n", !IO)
  ).
*/

:- func nice_score(model(OCC), h(OCC, OC)) = string.
nice_score(M, H)
  = string__format("%.3f", [f(single_score(M^weights, H^score))]).

:- func detailed_score(model(OCC), h(OCC, OC)) = string.
detailed_score(M, H)
  = scorers__detailed_score(M^weights, H^score).





:- pred pop(list(T)::in, T::out, list(T)::out) is semidet.
pop([H|T], H, T).