/*        Hierarchy Builder: algebraic hierarchies made easy
    This software is released under the terms of the MIT license              */

func export.any id ->.
export.any S :-
  coq.locate-all S L,
  if (L = []) (coq.error "HB: cannot locate" S) true,
  if (L = [X]) (export.any.aux S X) (coq.error "HB:" S "is ambiguous:" L).
func export.any.aux id, located ->.
export.any.aux S (loc-gref GR) :- export.abbrev S GR, !.
export.any.aux S (loc-modpath MP) :- export.module S MP, !.
export.any.aux S X :- coq.error "HB:" S "denotes" X "which is not supported for exporting".

% [export.module Module] exports a Module now adds it to the collection of
% modules to export in the end of the current enclosing module,
% by the command HB.Exports
% CAVEAT: "module" is a keyword, we put it in the namespace by hand
func export.module id, modpath ->.
export.module NiceModule Module :- !,
  log.coq.env.export-module NiceModule Module,
  coq.env.current-library File,
  acc-clause current (module-to-export File NiceModule Module).

func export.abbrev id, gref ->.
export.abbrev NiceName GR :- !,
  coq.env.current-library File,
  acc-clause current (abbrev-to-export File NiceName GR).

func export.clause prop ->.
export.clause Clause :- !,
  coq.env.current-library File,
  acc-clauses current [Clause, clause-to-export File Clause].

func export.reexport-all-modules-and-CS option string ->.
export.reexport-all-modules-and-CS Filter :- std.do! [
  coq.env.current-library File,
  export.private.compute-filter Filter MFilter,
  if-verbose (coq.say {header} "exporting under the module path" MFilter),

  % NODE: std.list-uniq is for coq < 8.13

  std.findall (module-to-export File NiceModule_ Module_) ModsCL,
  std.filter {std.list-uniq ModsCL} (export.private.module-in-module MFilter) ModsCLFiltered,
  std.map ModsCLFiltered module-to-export_module-nice NiceMods,
  std.map ModsCLFiltered module-to-export_module Mods,

  if-verbose (coq.say {header} "exporting modules" NiceMods),
  std.forall2 NiceMods Mods log.coq.env.export-module,


  std.findall (instance-to-export File NiceInstance_ Const_) InstCL,
  std.filter {std.list-uniq InstCL} (export.private.instance-in-module MFilter) InstCLFiltered,
  std.map InstCLFiltered instance-to-export_instance Insts,

  if-verbose (coq.say {header} "exporting CS instances" Insts),
  std.forall Insts log.coq.CS.declare-instance,

  std.findall (abbrev-to-export File NiceAbbrev_ GR_) InstAbbL,
  std.filter {std.list-uniq InstAbbL} (export.private.abbrev-in-module MFilter) InstAbbLFiltered,
  std.map InstAbbLFiltered abbrev-to-export_name AbbNames,
  std.map InstAbbLFiltered abbrev-to-export_body AbbBodies,

  if-verbose (coq.say {header} "exporting Abbreviations" AbbNames),
  std.forall2 AbbNames AbbBodies (n\b\@global! => log.coq.notation.add-abbreviation n 0 b ff _),

  std.findall (clause-to-export File Clause_) ClausesL,
  if-verbose (coq.say {header} "exporting Clauses" Clauses),
  std.map ClausesL clause-to-export_clause Clauses,
  acc-clauses current Clauses

].


namespace export.private {

:index (1)
func prefixL list A, list A ->.
prefixL [] _.
prefixL [X|Xs] [X|Ys] :- prefixL Xs Ys.

func abbrev-in-module list string, prop ->.
abbrev-in-module PM (abbrev-to-export _ _ GR) :-
  coq.gref->path GR PC,
  prefixL PM PC.

func module-in-module list string, prop ->.
module-in-module PM (module-to-export _ _ M) :-
  coq.modpath->path M PC,
  prefixL PM PC.

func instance-in-module list string, prop ->.
instance-in-module PM (instance-to-export _ _ C) :-
  coq.gref->path (const C) PC,
  prefixL PM PC.

func compute-filter option string -> list string.
compute-filter none [].
compute-filter (some S) MFilter :- % S is a component of the current modpath
  coq.env.current-path P,
  rex_split "\\." S L,
  compute-filter.aux P L MFilter, !.
compute-filter (some S) MFilter :-
  coq.locate-module S M,
  coq.modpath->path M MFilter.

% @gares: same predicate in synterp: code clone?
func compute-filter.aux list string, list string -> list string.
compute-filter.aux [S|_] [S] [S] :- !.
compute-filter.aux [S|XS] [S|SS] [S|YS] :- !, compute-filter.aux XS SS YS.
compute-filter.aux [X|XS] L [X|YS] :- compute-filter.aux XS L YS.

}
