open FStarC_Range
open FStarC_Tactics_Types
open FStarC_Tactics_Result
open FStarC_Tactics_Monad
open FStarC_Syntax_Syntax

module NBETerm = FStarC_TypeChecker_NBETerm
module POB = FStarC_TypeChecker_Primops_Base

(* These definitions are ≡ to the ones generated by F*'s extraction of the
   tactic effect.  We need them here to break a circular dependency between the
   compiler and ulib (cf. tactics meeting of 2017-08-03). *)
type 'a __tac = 'a FStarC_Tactics_Monad.tac

let r = dummyRange

type itac =
    POB.psc -> FStarC_Syntax_Embeddings_Base.norm_cb -> universes -> args -> term option
type nbe_itac =
    NBETerm.nbe_cbs -> universes -> NBETerm.args -> NBETerm.t option

type native_primitive_step =
    { name: FStarC_Ident.lid;
      arity: Prims.int;
      strong_reduction_ok: bool;
      tactic: itac}

let perr  s   = if FStarC_Debug.any () then FStarC_Format.print_error s
let perr1 s x = if FStarC_Debug.any () then FStarC_Format.print1_error s x

let compiled_tactics: native_primitive_step list ref = ref []

let list_all () =
    if FStarC_Options.no_plugins ()
    then []
    else !compiled_tactics

let register_plugin (s: string) (arity: Prims.int) (t: itac) (n:nbe_itac) =
    let step =
           { POB.name=FStarC_Ident.lid_of_str s;
             POB.arity=arity;
             POB.auto_reflect=None;
             POB.strong_reduction_ok=true;
             POB.requires_binder_substitution = false;
             POB.renorm_after = false;
             POB.interpretation=t;
             POB.univ_arity=Z.of_int 0;
             POB.interpretation_nbe=n;
          }
    in
    FStarC_TypeChecker_Cfg.register_plugin step;
    (* perr1 "Registered plugin %s\n" s; *)
    ()

let register_tactic (s: string) (arity: Prims.int) (t: itac)=
    let step =
        { name=FStarC_Ident.lid_of_str s;
          arity = arity;
          strong_reduction_ok=true;
          tactic=t } in
    compiled_tactics := step :: !compiled_tactics;
    (* perr1 "Registered tactic %s\n" s; *)
    ()

let bump (f : 'b -> 'c) (g : 'a -> 'b) : 'a -> 'c =
    fun x -> f (g x)

let from_tactic_0 (tau: 'b __tac) : 'b tac = tau

let from_tactic_1  t = bump from_tactic_0  t
let from_tactic_2  t = bump from_tactic_1  t
let from_tactic_3  t = bump from_tactic_2  t
let from_tactic_4  t = bump from_tactic_3  t
let from_tactic_5  t = bump from_tactic_4  t
let from_tactic_6  t = bump from_tactic_5  t
let from_tactic_7  t = bump from_tactic_6  t
let from_tactic_8  t = bump from_tactic_7  t
let from_tactic_9  t = bump from_tactic_8  t
let from_tactic_10 t = bump from_tactic_9  t
let from_tactic_11 t = bump from_tactic_10 t
let from_tactic_12 t = bump from_tactic_11 t
let from_tactic_13 t = bump from_tactic_12 t
let from_tactic_14 t = bump from_tactic_13 t
let from_tactic_15 t = bump from_tactic_14 t
let from_tactic_16 t = bump from_tactic_15 t
let from_tactic_17 t = bump from_tactic_16 t
let from_tactic_18 t = bump from_tactic_17 t
let from_tactic_19 t = bump from_tactic_18 t
let from_tactic_20 t = bump from_tactic_19 t
let from_tactic_21 t = bump from_tactic_20 t
let from_tactic_22 t = bump from_tactic_21 t
let from_tactic_23 t = bump from_tactic_22 t
let from_tactic_24 t = bump from_tactic_23 t
let from_tactic_25 t = bump from_tactic_24 t
