import data.real.basic
import data.set
import tactic
-- import exercices_espaces_metriques
open push_neg

namespace tactic.interactive
open lean.parser tactic interactive
open interactive (loc.ns)
open interactive.types
open tactic expr
local postfix *:9001 := many -- sinon ne comprends pas ident*

/- décompose en premier caractère, reste  INUTILISE-/
def un_car : string → string × string
| ⟨(x :: xs)⟩  := ( ⟨ [x] ⟩ , ⟨ xs ⟩ )
| _ := ("","")

def deux_car : string → string
| ⟨(x ::  y :: xs)⟩  := ⟨ [x,y] ⟩
| _ := ""

def trois_car : string → string
| ⟨(x ::  y :: z ::xs)⟩  := ⟨ [x,y,z] ⟩
| _ := ""

/- décompose une chaine de caractères selon la première parenthèse ouvrante
Le premier terme ne sert qu'à la récursivité  INUTILISE-/
meta def debut_chaine : string × string → string × string
| (s , t ) := do
    let d := un_car t,
    match d  with
        | ("(",reste) :=  (s,t)
        | ( ⟨(x)⟩, reste) :=  (debut_chaine (s ++ d.1, reste ))
        -- | _ := ("ERREUR", "")
        end

-- set_option trace.eqn_compiler.elim_match true
-- ne fonctionne pas : le "Prop" est ignoré, ou bien tout est Prop ??
-- meta def is_prop : expr →  bool
--     | `(%%e : Prop) := tt
   --  | _             := ff

-- détermine si l'expression est une propriété
-- basé sur le fait (peut-être optimiste) que si on échoue à trouver le type,
-- c'est qu'il y a des variables libres,
-- et donc que c'est une propriété
meta def is_prop : expr →  tactic bool
| e := do {
    expr_t ←  infer_type e,
    -- expr_tt ← infer_type expr_t,
    if expr_t = `(Prop) then return tt else return ff
        } <|> return tt

-- test if expr is semantically an implication or a function
-- (as opposed to a "∀" expression )
meta def is_arrow' : expr → tactic bool
| `(%%P → %%Q) := if has_var_idx Q 0 then return ff else return tt
| _ := return ff

meta def instanciate (e : expr) : tactic expr :=
match e with
| (pi pp_name binder type body) := do
    a ← mk_local' pp_name binder type,
    return $ instantiate_var body a
| (lam pp_name binder type body) := do
    a ← mk_local' pp_name binder type,
    return $ instantiate_var body a
| _ := return e
end

open tactic
example : true :=
by do e ← to_expr ```(∀ y : ℕ, ∀ x : ℕ, y = x), (es, tgt) ← mk_local_pis e, trace e, trace es, trace tgt

/- Décompose la racine d'une expression (un seul pas)
 LOGICS : ET, OU, SSI, QUELQUESOIT, IMPLIQUE, FONCTION, NON, EXISTE,
SETS: INTER, UNION, INCLUS, APPARTIENT, COMPLEMENTAIRE1,s IMAGE_ENSEMBLE, IMAGE_RECIPROQUE,
EGALITE, ENSEMBLE1, APPLICATION
NUMBERS: -/
private meta def analyse_expr_step  (e : expr) : tactic (string × (list expr)) :=
do  S ←  (tactic.pp e), let e_joli := to_string S,
match e with
| (lam name binder type body)          := return ("lambda[" ++ to_string name ++ "]", [type,body]) -- name → binder_info → expr → expr → expr
------------------------- LOGIQUE -------------------------
| `(%%p ∧ %%q) := return ("PROP_AND", [p,q])
| `(%%p ∨ %%q) := return ("PROP_OR", [p,q])
| `(%%p ↔ %%q) := return ("PROP_IFF", [p,q])
| `(¬ %%p) := return ("PROP_NOT", [p])
| `(%%p → false)  := return ("PROP_NOT", [p])
| (pi name binder type body) := do bool ←  (is_arrow' e),
    if bool then do bool2 ← tactic.is_prop e,
                    if bool2 then return ("PROP_IMPLIES", [type,body])
                        else return ("FUNCTION", [type,body])
     else do inst_body ← instanciate e,
       return ("QUANT_∀[" ++ to_string name ++ "]", [type, inst_body])
| `(Exists %%p) := do match p with          --  améliorer : cas d'une prop, mais attention aux variables !!
    | (lam name binder type body) :=
    -- la suite teste s'il s'agit de l'existence d'un objet ou d'une propriété
        -- d'abord, si `body` contient des variables libres, c'est une propriété
        -- if type.has_var then return ("EXISTE[PROP:" ++ to_string name ++ "]", [type,body])
        -- si ce n'est pas le cas, on peut chercher son type, et voir si c'est Prop
        -- else do type_type ← infer_type type,
            -- if type_type = `(Prop)
            do inst_body ← instanciate p,
                bool ← is_prop p, if bool
                then return ("PROP_∃[" ++ to_string name ++ "]", [type,inst_body])
                else return ("QUANT_∃[" ++ to_string name ++ "]", [type,inst_body])
    |  _ := return ("ERROR", [])
    end
------------------------- THEORIE DES ENSEMBLES -------------------------
| `(%%A ∩ %%B) := return ("SET_INTER", [A,B])
| `(%%A ∪ %%B) := return ("SET_UNION", [A,B])
| `(set.compl %%A) := return ("SET_COMPLEMENT", [A])
| `(%%A \ %%B) := return ("SET_SYM_DIFF", [A,B])
| `(%%A ⊆ %%B) := return ("PROP_INCLUDED", [A,B])
| `(%%a ∈ %%A) := return ("PROP_BELONGS", [a,A])
| `(@set.univ %%X) := return ("SET_UNIVERSE", [X])
| `(-%%A) := return ("MINUS", [A])
| `(set.Union %%A) := return ("SET_UNION+", [A])
| `(set.Inter %%A) := return ("SET_INTER+", [A])
| `(%%f '' %%A) := return ("SET_IMAGE", [f,A])
| `(%%f  ⁻¹' %%A) := return ("SET_INVERSE", [f,A])
| `(∅) := return ("SET_EMPTY", [])
| `(_root_.set %%X) := return ("SET", [X])
-- polymorphe
| `(%%a = %%b) := return ("PROP_EQUAL", [a,b]) -- faudrait connaitre le type ?
| `(%%a ≠ %%b) := return ("PROP_EQUAL_NOT", [a,b]) -- faudrait connaitre le type ?
----------- TOPOLOGY --------------
-- | `(B(%%x, %%r))

---------------------------- NOMBRES particuliers (cf aussi plus bas)
| `(0:ℝ) := return ("NUMBER[0]",[])               -- OK, mais peut-être faut-il garder l'info 0 : réel
| `(0:ℕ) := return ("NUMBER[0]",[])               -- non testé
| `(0:ℤ) := return ("NUMBER[0]",[])               -- non testé
| `(1:ℝ) := return ("NUMBER[1]",[])
| `(1:ℕ) := return ("NUMBER[1]",[])               -- non testé
| `(1:ℤ) := return ("NUMBER[1]",[])               -- non testé
-- | `(0 < %%b) := return ("POSITIF", [b])
| `(%%a < %%b) := return ("PROP_<", [a,b])
| `(%%a ≤ %%b) := return ("PROP_≤", [a,b])
-- | `(%%a > 0) := return ("POSITIF", [a])
| `(%%a > %%b) := return ("PROP_>", [a,b])
| `(%%a ≥ %%b) := return ("PROP_≥", [a,b])
------------------------------ Meta_applications

| (app fonction argument)   := -- do let Sfonction := to_string(fonction),
    -- pour les nombres, utiliser la pretty printer de Lean
    -- récupérer le type ?
    if is_numeral e
        then return ("NUMBER["++e_joli ++"]",[])
    -- détecter les sous-ensembles
--    else if to_string(fonction) = "set.{0}"
--        then return("SET", [argument])
--        else return("META_APPLICATION[[pp:" ++ e_joli ++"]]",[fonction,argument])
        else return("APPLICATION",[fonction,argument])
| `(ℝ) := return ("TYPE_NUMBER[ℝ]",[])
| `(ℕ) := return ("TYPE_NUMBER[ℕ]",[])
| (const name list_level)   := return ("CONSTANT[name:"++ e_joli ++ "/" ++ to_string name ++"]", []) -- name → list level → expr
| (var nat)       := return ("VAR["++ to_string nat ++ "]", []) --  nat → expr
| (sort level)      := return ("TYPE", [])  -- level → expr
| (mvar name pretty_name type)        := return ("METAVAR[" ++ to_string pretty_name ++ "]", []) -- name → name → expr → expr
| (local_const name pretty_name bi type) := return ("LOCAL_CONSTANT[name:"++ to_string pretty_name++"/identifier:"++ to_string name ++ "]", []) -- name → name → binder_info → expr → expr
| (elet name_var type_var expr body)        := return ("LET["++ to_string name_var ++"]", [type_var,expr,body]) --name → expr → expr → expr → expr
| (macro liste pas_compris)       := return ("MACRO", []) -- macro_def → list expr → expr
end

-- A node will be a leaf of the analysis tree iff it belongs to the following list:
-- leaves = ["NOMBRE", "CONSTANT", "VAR", "TYPE", "METAVAR", "LOCAL_CONSTANT",
--          "LET", "MACRO", "ERREUR"]
-- A leaf is followed by a separateur_virgule or a ")"
-- A node which is not a leaf is followed by a "("

def separateur_virgule := "¿, "
def separateur_egale := " ¿= "
def open_paren := "¿("
def closed_paren := "¿)"
/- Analyse récursivement une expression à l'aide de analyse_expr_step,
renvoie le résultat sous forme de chaine bien parenthésée-/
private meta def analyse_rec : expr →  tactic string
| e :=
do ⟨string, liste_expr⟩ ←  analyse_expr_step(e),
--    bool ← is_prop e,
--    let string := to_string bool ++ "." ++ string,
    match liste_expr with
    -- ATTENTION, cas de plus de trois arguiments non traité
    -- à remplacer par un list.map
    |[e1] :=  do
       string1 ← analyse_rec e1,
       return(string ++ open_paren ++ string1 ++ closed_paren)
    |[e1,e2] :=  do
        string1 ← analyse_rec e1,
        string2 ← analyse_rec e2,
--        if  string = "APPLICATION"
--            then return (string1 ++ open_paren ++ string2 ++ closed_paren) else
        return (string ++ open_paren ++ string1 ++ separateur_virgule ++ string2 ++ closed_paren)
    |[e1,e2,e3] :=  do  -- non utilisé
        string1 ← analyse_rec e1,
        string2 ← analyse_rec e2,
        string3 ← analyse_rec e3,
        return (string ++ open_paren ++ string1 ++ separateur_virgule ++ string2 ++ separateur_virgule ++ string3 ++ closed_paren)
    | _ :=    return(string)
    end
private meta def analyse_expr : expr →  tactic string
| e := do
    expr_t ←  infer_type e,
    bool ← is_prop expr_t,
    -- expr_tt ← infer_type expr_t,
    if bool then do
            -- S ←  (tactic.pp expr_t),
            -- let S1 := to_string S,
            S ←  (tactic.pp expr_t), let et_joli := to_string S,
            S1b ← analyse_rec e,
            S2 ← analyse_rec expr_t,
            let S3 := "PROPERTY[" ++ S1b ++ "/pp_type: " ++ et_joli ++ "]" ++ separateur_egale ++ S2,
            return(S3)
        else  do
            -- let S1 :=  to_string e,
            S1b ← analyse_rec e,
            S2 ← analyse_rec expr_t,
            let S3 := "OBJECT[" ++ S1b ++ separateur_egale ++ S2,
            return(S3)

/- Affiche la liste des objets du contexte, séparés par des retour chariots
format :  "OBJET" ou "PROPRIETE" : affichage Lean : structure -/
meta def analyse_contexte : tactic unit :=
do liste_expr ← local_context,
    trace "context:",
    liste_expr.mmap (λ h, analyse_expr h >>= trace),
    return ()

/- Affiche la liste des buts, même format que analyse_contexte
(excepté qu'il n'y a que des PROPRIETES) -/
meta def analyse_buts : tactic unit :=
do liste_expr ← get_goals,
    trace "goals:",
    liste_expr.mmap (λ h, analyse_expr h >>= trace),
    return ()

---------------------------------------------------------
--------- NON UTILISES (debuggage) ----------------------------------
---------------------------------------------------------

/- Appelle l'analyse récursive sur le but ou sur une hypothèse. Non utilisé par la suite. -/
meta def analyse (names : parse ident*) : tactic unit :=
match names with
    | [] := do goal ← tactic.target,
                trace (analyse_rec goal)
    | [nom] := do expr ← get_local nom,
                expr_t ←  infer_type expr,
                expr_tt ← infer_type expr_t,
                -- la suite différencie selon la sémantique,
                -- ie les objets (éléments, ensembles, fonctions)
                -- vs les propriétés
                if expr_tt = `(Prop) then
                    trace (analyse_rec expr_t)
                else  do S1 ← (analyse_rec expr),
                        S2 ← (analyse_rec expr_t),
                        --let S2 := to_string expr_t,
                        let S3 := S1 ++ " : "++ S2,
                        trace(S3)
    | _ := skip
    end

/- Appelle l'analyse en 1 coup sur le but ou sur une hypothèse. Non utilisé par la suite. -/
meta def analyse1 (names : parse ident*) : tactic unit :=
match names with
    | [] := do goal ← tactic.target,
                trace (analyse_expr_step goal)
    | [nom] := do expr ← get_local nom,
                expr_t ←  infer_type expr,
                trace (analyse_expr_step expr_t)
    | _ := skip
    end

-- non utilisé
private meta def analyse_expr2 : expr →  tactic string
| e := do
    expr_t ←  infer_type e,
    expr_tt ← infer_type expr_t,
    if expr_tt = `(Prop) then do
            S ←  (tactic.pp expr_t),
            let S1 := to_string S,
            S2 ← analyse_rec expr_t,
            let S3 := "PROPRIETE : " ++ S1 ++ " : " ++ S2,
            return(S3)
        else  do let S0 := "OBJET : ",
            let S1 :=  to_string e,
            S2 ← analyse_rec expr_t,
            let S3 := S0 ++ S1 ++ " : "++ S2,
            return(S3)

---------------------------------------------------------
----------------- Essai de rendu LateX, non abouti ------
---------------------------------------------------------

/- transforme une expression lean en expression latex
AMELIORER :
tenir compte de la profondeur de l'arbre pour décider si on met des prenthèses-/
/- ET, OU, SSI, QUELQUESOIT, IMPLIQUE, FONCTION, NON1, EXISTE,
INTER, UNION, INCLUS, APPARTIENT, COMPLEMENTAIRE1, IMAGE_ENSEMBLE, IMAGE_RECIPROQUE,
EGALITE, ENSEMBLE1, APPLICATION-/
meta def latex_expr : expr →  tactic string
| e := do
    ⟨string, liste_expr⟩ ←  analyse_expr_step e,
    if list.length liste_expr =2 then do
        let e1 := list.head liste_expr,
        let e2 := list.head (list.tail liste_expr),
        S1 ← latex_expr e1,
        S2 ← latex_expr e2,
        match string with
            | "ET" := return (S1 ++ " et " ++ S2)
            | "OU" := return (S1 ++ " ou " ++ S2)
            | "SSI" := return ("(" ++ S1 ++ "" ++") \\Leftrightarrow (" ++ S2 ++ ")")

            | "INCLUS" := return (S1 ++ "" ++" \\subset " ++ S2)
            | _ := return "ERREUR"
            end

    else if list.length liste_expr =1 then do
        let e1 := list.head liste_expr,
        S1 ← latex_expr e1,
        match string with
            | "NON" := return ("NON (" ++ S1 ++ ")")
            | "COMPLEMENTAIRE" := return (S1  ++ "^c")
            | _ := return "ERREUR"
            end
    else return (string)

meta def latex_buts : tactic unit :=
do liste_expr ← get_goals,
    trace "Buts :",
    -- liste_buts ← tactic.get_goals,
    -- types ← list.mmap tactic.infer_type liste_buts,
    -- trace types,
    liste_expr.mmap (λ h, latex_expr h >>= trace),
    return ()

meta def latex_but : tactic unit :=
do expr ← target,
    trace "But :",
    -- liste_buts ← tactic.get_goals,
    -- types ← list.mmap tactic.infer_type liste_buts,
    -- trace types,
    trace (latex_expr expr),
    return ()

----------------------------------------------
------------- DEBUGGAGE -------------------
-------------------------------------------

/- debug -/
private meta def analyse_expr_step_brut  (e : expr) : tactic (string × (list expr)) :=
match e with
-- autres
| (pi name binder type body ) := return ("pi (nom : " ++ to_string name ++ ")",[type,body])
| (app fonction argument)   := return ("application", [fonction,argument])
| (const name list_level)   := return ("constante :" ++ to_string name, []) -- name → list level → expr
| (var nat)       := return ("var_"++ to_string nat, []) --  nat → expr
| (sort level)      := return ("sort", [])  -- level → expr
| (mvar name pretty_name type)        := return ("metavar", []) -- name → name → expr → expr
| (local_const name pretty_name bi type) := return ("constante_locale :" ++ to_string pretty_name, []) -- name → name → binder_info → expr → expr
| (lam name binder type body)          := return ("lambda (nom : " ++ to_string name ++ ")", [type,body]) -- name → binder_info → expr → expr → expr
| (elet name_var type_var expr body)        := return ("let", []) --name → expr → expr → expr → expr
| (macro liste pas_compris)       := return ("macro", []) -- macro_def → list expr → expr
end

/-  Debug -/
private meta def analyse_rec_brut : expr →  tactic string
| e :=
do ⟨string, liste_expr⟩ ←  analyse_expr_step_brut e,
    match liste_expr with
    -- ATTENTION, cas de plus de trois arguiments non traité
    -- à remplacer par un list.map
    |[e1] :=  do
       string1 ← analyse_rec_brut e1,
       return(string ++ "(" ++ string1 ++ ")")
    |[e1,e2] :=  do
        string1 ← analyse_rec_brut e1,
        string2 ← analyse_rec_brut e2,
        if  string = "APPLICATION" then do
            { type2 ← infer_type e2,
            let string_type2 := to_string type2, -- trace string_type2,
            if (string_type2 = "Type" ) ∨ (trois_car (to_string(e2)) = "_in" ) -- Type  ou instance
                then return (string1)
                else return (string1 ++ "(" ++ string2 ++")")
            }   <|> return (string1 ++ "(" ++ string2 ++")")
            else return (string ++ "(" ++ string1 ++ "," ++ string2 ++ ")")
    |[e1,e2,e3] :=  do  -- non utilisé
        string1 ← analyse_rec_brut e1,
        string2 ← analyse_rec_brut e2,
        string3 ← analyse_rec_brut e3,
        return (string ++ "(" ++ string1 ++ "," ++ string2 ++ "," ++ string3 ++ ")")
    | _ :=    return(string)
    end

/- Debug -/
meta def analyse_brut (names : parse ident*) : tactic unit :=
match names with
    | [] := do goal ← tactic.target,
                trace (analyse_rec_brut goal)
    | [nom] := do expr ← get_local nom,
                expr_t ←  infer_type expr,
                expr_tt ← infer_type expr_t,
                -- la suite différencie selon la sémantique,
                -- ie les objets (éléments, ensembles, fonctions)
                -- vs les propriétés
                if expr_tt = `(Prop) then
                    trace (analyse_rec_brut expr_t)
                else  do S1 ← (analyse_rec_brut expr),
                        S2 ← (analyse_rec_brut expr_t),
                        --let S2 := to_string expr_t,
                        let S3 := S1 ++ " : "++ S2,
                        trace(S3)
    | _ := skip
    end

-- débug
private meta def analyse_expr_brut : expr →  tactic string
| e := do
    expr_t ←  infer_type e,
    expr_tt ← infer_type expr_t,
    if expr_tt = `(Prop) then do
            S ←  (tactic.pp expr_t),
            let S1 := to_string S,
            S2 ← analyse_rec_brut expr_t,
            let S3 := "PROPRIETE : " ++ S1 ++ " : " ++ S2,
            return(S3)
        else  do let S0 := "OBJET : ",
            let S1 :=  to_string e,
            S2 ← analyse_rec_brut expr_t,
            let S3 := S0 ++ S1 ++ " : "++ S2,
            return(S3)

/- Affiche la liste des objets du contexte, séparés par des retour chariots
format :  "OBJET" ou "PROPRIETE" : affichage Lean : structure -/
meta def analyse_contexte_brut : tactic unit :=
do liste_expr ← local_context,
    trace "Contexte :",
    liste_expr.mmap (λ h, analyse_expr_brut h >>= trace),
    return ()

/- Analyse brute de Lean (dans expr) -/
meta def analyse_raw (names : parse ident*) : tactic unit :=
match names with
    | [] := do goal ← tactic.target,
                trace $ to_raw_fmt goal
    | [nom] := do expr ← get_local nom,
                expr_t ←  infer_type expr,
                trace $ to_raw_fmt expr_t
    | _ := skip
    end

end tactic.interactive


import types

import category_theory.category.basic
import category_theory.core
import data.nat.digits

open params
open types

open category_theory
open nat

namespace littleendian

variables [category (bitvec word_len)]

/-!
  # Littleendian

  The `littleendian` function and its inverse.
-/

/- Needed for `littleendian`, `of_digits`. -/
variables [semiring (list ℕ)]

/-- Lean library has `of_digits` code for this so we use it.
TODO : Explain why it works with base 256.
-/
def littleendian (l : list ℕ) : list ℕ := of_digits 256 l

/-- Lean library has `digits` code for this so we use it.
TODO : Explain why it works with base 256.
-/
def littleendian_inv (l : list ℕ) : list ℕ := digits 256 (l.nth 0).iget

/-- Define a category for functions from `list ℕ` to `list ℕ`-/
variable [category (list ℕ → list ℕ)]

/- Just some notation for inverse. -/
local notation `littleendian⁻¹` := littleendian_inv

/-- We assume there is an isomorphism between `littleindian` and `littleendian⁻¹`.
In other words, `littleendian` function is invertible and the inverse is `littleendian⁻¹`. -/
lemma littleendian_is_inv (I : littleendian ≅ littleendian⁻¹) : I.hom ≫ I.inv = 𝟙 littleendian :=
  by rw [iso.hom_inv_id]

end littleendian


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro

! This file was ported from Lean 3 source module data.option.basic
! leanprover-community/mathlib commit f340f229b1f461aa1c8ee11e0a172d0a3b301a4a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Init.Control.Combinators
import Mathlib.Data.Option.Defs
import Mathlib.Logic.IsEmpty
import Mathlib.Logic.Relator
import Mathlib.Mathport.Rename

/-!
# Option of a type

This file develops the basic theory of option types.

If `α` is a type, then `Option α` can be understood as the type with one more element than `α`.
`Option α` has terms `some a`, where `a : α`, and `none`, which is the added element.
This is useful in multiple ways:
* It is the prototype of addition of terms to a type. See for example `WithBot α` which uses
  `none` as an element smaller than all others.
* It can be used to define failsafe partial functions, which return `some the_result_we_expect`
  if we can find `the_result_we_expect`, and `none` if there is no meaningful result. This forces
  any subsequent use of the partial function to explicitly deal with the exceptions that make it
  return `none`.
* `Option` is a monad. We love monads.

`Part` is an alternative to `Option` that can be seen as the type of `True`/`False` values
along with a term `a : α` if the value is `True`.

-/

namespace Option

variable {α β γ δ : Type _}

theorem coe_def : (fun a ↦ ↑a : α → Option α) = some :=
  rfl
#align option.coe_def Option.coe_def

#align option.get_or_else Option.getD

@[simp]
theorem getD_coe (x y : α) : Option.getD (↑x) y = x :=
  rfl
#align option.get_or_else_coe Option.getD_coe

theorem coe_get {o : Option α} (h : o.isSome) : ((Option.get _ h : α) : Option α) = o :=
  Option.some_get h
#align option.coe_get Option.coe_get

theorem eq_of_mem_of_mem {a : α} {o1 o2 : Option α} (h1 : a ∈ o1) (h2 : a ∈ o2) : o1 = o2 :=
  h1.trans h2.symm
#align option.eq_of_mem_of_mem Option.eq_of_mem_of_mem

theorem Mem.leftUnique : Relator.LeftUnique ((· ∈ ·) : α → Option α → Prop) :=
fun _ _ _=> mem_unique
#align option.mem.left_unique Option.Mem.leftUnique

theorem some_injective (α : Type _) : Function.Injective (@some α) := fun _ _ ↦ some_inj.mp
#align option.some_injective Option.some_injective

/-- `Option.map f` is injective if `f` is injective. -/
theorem map_injective {f : α → β} (Hf : Function.Injective f) : Function.Injective (Option.map f)
  | none, none, _ => rfl
  | some a₁, some a₂, H => by rw [Hf (Option.some.inj H)]
#align option.map_injective Option.map_injective

@[simp]
theorem map_comp_some (f : α → β) : Option.map f ∘ some = some ∘ f :=
  rfl
#align option.map_comp_some Option.map_comp_some

@[simp]
theorem none_bind' (f : α → Option β) : none.bind f = none :=
  rfl
#align option.none_bind' Option.none_bind'

@[simp]
theorem some_bind' (a : α) (f : α → Option β) : (some a).bind f = f a :=
  rfl
#align option.some_bind' Option.some_bind'

theorem bind_eq_some' {x : Option α} {f : α → Option β} {b : β} :
    x.bind f = some b ↔ ∃ a, x = some a ∧ f a = some b :=
  by cases x <;> simp
#align option.bind_eq_some' Option.bind_eq_some'

theorem bind_eq_none' {o : Option α} {f : α → Option β} :
    o.bind f = none ↔ ∀ b a, a ∈ o → b ∉ f a := by
  simp only [eq_none_iff_forall_not_mem, mem_def, bind_eq_some, not_exists, not_and]
#align option.bind_eq_none' Option.bind_eq_none'

theorem joinM_eq_join : joinM = @join α :=
  funext fun _ ↦ rfl
#align option.join_eq_join Option.joinM_eq_join

theorem bind_eq_bind {α β : Type _} {f : α → Option β} {x : Option α} : x >>= f = x.bind f :=
  rfl
#align option.bind_eq_bind Option.bind_eq_bind

theorem map_coe {α β} {a : α} {f : α → β} : f <$> (a : Option α) = ↑(f a) :=
  rfl
#align option.map_coe Option.map_coe

@[simp]
theorem map_coe' {a : α} {f : α → β} : Option.map f (a : Option α) = ↑(f a) :=
  rfl
#align option.map_coe' Option.map_coe'

/-- `Option.map` as a function between functions is injective. -/
theorem map_injective' : Function.Injective (@Option.map α β) := fun f g h ↦
  funext fun x ↦ some_injective _ <| by simp only [← map_some', h]
#align option.map_injective' Option.map_injective'

@[simp]
theorem map_inj {f g : α → β} : Option.map f = Option.map g ↔ f = g :=
  map_injective'.eq_iff
#align option.map_inj Option.map_inj

attribute [simp] map_id

@[simp]
theorem map_eq_id {f : α → α} : Option.map f = id ↔ f = id :=
  map_injective'.eq_iff' map_id
#align option.map_eq_id Option.map_eq_id

theorem map_comm {f₁ : α → β} {f₂ : α → γ} {g₁ : β → δ} {g₂ : γ → δ} (h : g₁ ∘ f₁ = g₂ ∘ f₂)
  (a : α) :
    (Option.map f₁ a).map g₁ = (Option.map f₂ a).map g₂ := by rw [map_map, h, ← map_map]
#align option.map_comm Option.map_comm

section pmap

variable {p : α → Prop} (f : ∀ a : α, p a → β) (x : Option α)

-- Porting note: Can't simp tag this anymore because `pbind` simplifies
-- @[simp]
theorem pbind_eq_bind (f : α → Option β) (x : Option α) : (x.pbind fun a _ ↦ f a) = x.bind f := by
  cases x <;> simp only [pbind, none_bind', some_bind']
#align option.pbind_eq_bind Option.pbind_eq_bind

theorem map_bind {α β γ} (f : β → γ) (x : Option α) (g : α → Option β) :
    Option.map f (x >>= g) = x >>= fun a ↦ Option.map f (g a) := by
  simp only [← map_eq_map, ← bind_pure_comp, LawfulMonad.bind_assoc]
#align option.map_bind Option.map_bind

theorem map_bind' (f : β → γ) (x : Option α) (g : α → Option β) :
    Option.map f (x.bind g) = x.bind fun a ↦ Option.map f (g a) := by cases x <;> simp
#align option.map_bind' Option.map_bind'

theorem map_pbind (f : β → γ) (x : Option α) (g : ∀ a, a ∈ x → Option β) :
    Option.map f (x.pbind g) = x.pbind fun a H ↦ Option.map f (g a H) := by
  cases x <;> simp only [pbind, map_none']
#align option.map_pbind Option.map_pbind

theorem pbind_map (f : α → β) (x : Option α) (g : ∀ b : β, b ∈ x.map f → Option γ) :
    pbind (Option.map f x) g = x.pbind fun a h ↦ g (f a) (mem_map_of_mem _ h) := by cases x <;> rfl
#align option.pbind_map Option.pbind_map

@[simp]
theorem pmap_none (f : ∀ a : α, p a → β) {H} : pmap f (@none α) H = none :=
  rfl
#align option.pmap_none Option.pmap_none

@[simp]
theorem pmap_some (f : ∀ a : α, p a → β) {x : α} (h : p x) :
    pmap f (some x) = fun _ ↦ some (f x h) :=
  rfl
#align option.pmap_some Option.pmap_some

theorem mem_pmem {a : α} (h : ∀ a ∈ x, p a) (ha : a ∈ x) : f a (h a ha) ∈ pmap f x h := by
  rw [mem_def] at ha ⊢
  subst ha
  rfl
#align option.mem_pmem Option.mem_pmem

theorem pmap_map (g : γ → α) (x : Option γ) (H) :
    pmap f (x.map g) H = pmap (fun a h ↦ f (g a) h) x fun a h ↦ H _ (mem_map_of_mem _ h) := by
  cases x <;> simp only [map_none', map_some', pmap]
#align option.pmap_map Option.pmap_map

theorem map_pmap (g : β → γ) (f : ∀ a, p a → β) (x H) :
    Option.map g (pmap f x H) = pmap (fun a h ↦ g (f a h)) x H :=
  by cases x <;> simp only [map_none', map_some', pmap]
#align option.map_pmap Option.map_pmap

-- Porting note: Can't simp tag this anymore because `pmap` simplifies
-- @[simp]
theorem pmap_eq_map (p : α → Prop) (f : α → β) (x H) :
    @pmap _ _ p (fun a _ ↦ f a) x H = Option.map f x := by
  cases x <;> simp only [map_none', map_some', pmap]
#align option.pmap_eq_map Option.pmap_eq_map

theorem pmap_bind {α β γ} {x : Option α} {g : α → Option β} {p : β → Prop} {f : ∀ b, p b → γ} (H)
    (H' : ∀ (a : α), ∀ b ∈ g a, b ∈ x >>= g) :
    pmap f (x >>= g) H = x >>= fun a ↦ pmap f (g a) fun b h ↦ H _ (H' a _ h) := by
  cases x <;> simp only [pmap, bind_eq_bind, none_bind, some_bind]
#align option.pmap_bind Option.pmap_bind

variable {f x}

theorem pbind_eq_none {f : ∀ a : α, a ∈ x → Option β}
    (h' : ∀ a (H : a ∈ x), f a H = none → x = none) : x.pbind f = none ↔ x = none := by
  cases x
  · simp
  · simp only [pbind, iff_false]
    intro h
    cases h' _ rfl h
#align option.pbind_eq_none Option.pbind_eq_none

theorem pbind_eq_some {f : ∀ a : α, a ∈ x → Option β} {y : β} :
    x.pbind f = some y ↔ ∃ (z : α) (H : z ∈ x), f z H = some y := by
  rcases x with (_|x)
  · simp only [pbind, false_iff, not_exists]
    intro z h
    simp at h
  · simp only [pbind]
    refine ⟨λ h => ⟨x, rfl, h⟩, ?_⟩
    rintro ⟨z, H, hz⟩
    simp only [mem_def, Option.some_inj] at H
    simpa [H] using hz
#align option.pbind_eq_some Option.pbind_eq_some

-- Porting note: Can't simp tag this anymore because `pmap` simplifies
-- @[simp]
theorem pmap_eq_none_iff {h} : pmap f x h = none ↔ x = none := by cases x <;> simp
#align option.pmap_eq_none_iff Option.pmap_eq_none_iff

-- Porting note: Can't simp tag this anymore because `pmap` simplifies
-- @[simp]
theorem pmap_eq_some_iff {hf} {y : β} :
    pmap f x hf = some y ↔ ∃ (a : α) (H : x = some a), f a (hf a H) = y := by
  rcases x with (_|x)
  · simp only [not_mem_none, exists_false, pmap, not_false_iff, exists_prop_of_false]
  · constructor
    · intro h
      simp only [pmap, Option.some_inj] at h
      refine ⟨x, rfl, h⟩
    · rintro ⟨a, H, rfl⟩
      simp only [mem_def, Option.some_inj] at H
      simp only [H, pmap]
#align option.pmap_eq_some_iff Option.pmap_eq_some_iff

-- Porting note: Can't simp tag this anymore because `join` and `pmap` simplify
-- @[simp]
theorem join_pmap_eq_pmap_join {f : ∀ a, p a → β} {x : Option (Option α)} (H) :
    (pmap (pmap f) x H).join = pmap f x.join fun a h ↦ H (some a) (mem_of_mem_join h) _ rfl := by
  rcases x with (_ | _ | x) <;> simp
#align option.join_pmap_eq_pmap_join Option.join_pmap_eq_pmap_join

end pmap

@[simp]
theorem seq_some {α β} {a : α} {f : α → β} : some f <*> some a = some (f a) :=
  rfl
#align option.seq_some Option.seq_some

@[simp]
theorem some_orElse' (a : α) (x : Option α) : (some a).orElse (fun _ ↦ x) = some a :=
  rfl
#align option.some_orelse' Option.some_orElse'

#align option.some_orelse Option.some_orElse

@[simp]
theorem none_orElse' (x : Option α) : none.orElse (fun _ ↦ x) = x := by cases x <;> rfl
#align option.none_orelse' Option.none_orElse'

#align option.none_orelse Option.none_orElse

@[simp]
theorem orElse_none' (x : Option α) : x.orElse (fun _ ↦ none) = x := by cases x <;> rfl

#align option.orelse_none' Option.orElse_none'

#align option.orelse_none Option.orElse_none

#align option.is_some_none Option.isSome_none

#align option.is_some_some Option.isSome_some

#align option.is_some_iff_exists Option.isSome_iff_exists

#align option.is_none_none Option.isNone_none

#align option.is_none_some Option.isNone_some

#align option.not_is_some Option.not_isSome

#align option.not_is_some_iff_eq_none Option.not_isSome_iff_eq_none

#align option.ne_none_iff_is_some Option.ne_none_iff_isSome

theorem iget_mem [Inhabited α] : ∀ {o : Option α}, isSome o → o.iget ∈ o
  | some _, _ => rfl
#align option.iget_mem Option.iget_mem

theorem iget_of_mem [Inhabited α] {a : α} : ∀ {o : Option α}, a ∈ o → o.iget = a
  | _, rfl => rfl
#align option.iget_of_mem Option.iget_of_mem

theorem getD_default_eq_iget [Inhabited α] (o : Option α) :
    o.getD default = o.iget := by cases o <;> rfl
#align option.get_or_else_default_eq_iget Option.getD_default_eq_iget

@[simp]
theorem guard_eq_some' {p : Prop} [Decidable p] (u) : _root_.guard p = some u ↔ p := by
  cases u
  by_cases h : p <;> simp [_root_.guard, h]
#align option.guard_eq_some' Option.guard_eq_some'

theorem liftOrGet_choice {f : α → α → α} (h : ∀ a b, f a b = a ∨ f a b = b) :
    ∀ o₁ o₂, liftOrGet f o₁ o₂ = o₁ ∨ liftOrGet f o₁ o₂ = o₂
  | none, none => Or.inl rfl
  | some a, none => Or.inl rfl
  | none, some b => Or.inr rfl
  | some a, some b => by simpa [liftOrGet] using h a b
#align option.lift_or_get_choice Option.liftOrGet_choice

#align option.lift_or_get_none_left Option.liftOrGet_none_left

#align option.lift_or_get_none_right Option.liftOrGet_none_right

#align option.lift_or_get_some_some Option.liftOrGet_some_some

/-- Given an element of `a : option α`, a default element `b : β` and a function `α → β`, apply this
function to `a` if it comes from `α`, and return `b` otherwise. -/
def casesOn' : Option α → β → (α → β) → β
  | none, n, _ => n
  | some a, _, s => s a
#align option.cases_on' Option.casesOn'

@[simp]
theorem casesOn'_none (x : β) (f : α → β) : casesOn' none x f = x :=
  rfl
#align option.cases_on'_none Option.casesOn'_none

@[simp]
theorem casesOn'_some (x : β) (f : α → β) (a : α) : casesOn' (some a) x f = f a :=
  rfl
#align option.cases_on'_some Option.casesOn'_some

@[simp]
theorem casesOn'_coe (x : β) (f : α → β) (a : α) : casesOn' (a : Option α) x f = f a :=
  rfl
#align option.cases_on'_coe Option.casesOn'_coe

-- Porting note: Left-hand side does not simplify.
-- @[simp]
theorem casesOn'_none_coe (f : Option α → β) (o : Option α) :
    casesOn' o (f none) (f ∘ (fun a ↦ ↑a)) = f o := by cases o <;> rfl
#align option.cases_on'_none_coe Option.casesOn'_none_coe

theorem orElse_eq_some (o o' : Option α) (x : α) :
    (o <|> o') = some x ↔ o = some x ∨ o = none ∧ o' = some x := by
  cases o
  · simp only [true_and, false_or, eq_self_iff_true, none_orElse]
  · simp only [some_orElse, or_false, false_and]
#align option.orelse_eq_some Option.orElse_eq_some

theorem orElse_eq_some' (o o' : Option α) (x : α) :
    o.orElse (fun _ ↦ o') = some x ↔ o = some x ∨ o = none ∧ o' = some x :=
  Option.orElse_eq_some o o' x
#align option.orelse_eq_some' Option.orElse_eq_some'

@[simp]
theorem orElse_eq_none (o o' : Option α) : (o <|> o') = none ↔ o = none ∧ o' = none := by
  cases o
  · simp only [true_and, none_orElse, eq_self_iff_true]
  · simp only [some_orElse, false_and]
#align option.orelse_eq_none Option.orElse_eq_none

@[simp]
theorem orElse_eq_none' (o o' : Option α) : o.orElse (fun _ ↦ o') = none ↔ o = none ∧ o' = none :=
  Option.orElse_eq_none o o'
#align option.orelse_eq_none' Option.orElse_eq_none'

section

open Classical

theorem choice_eq_none (α : Type _) [IsEmpty α] : choice α = none :=
  dif_neg (not_nonempty_iff_imp_false.mpr isEmptyElim)
#align option.choice_eq_none Option.choice_eq_none

#align option.choice_is_some_iff_nonempty Option.choice_isSome_iff_nonempty

end

-- Porting note: Can't simp tag this anymore because `elim` simplifies
-- @[simp]
theorem elim_none_some (f : Option α → β) : (fun x ↦ Option.elim x (f none) (f ∘ some)) = f :=
  funext fun o ↦ by cases o <;> rfl
#align option.elim_none_some Option.elim_none_some

end Option


-- Copyright (c) 2017 Scott Morrison. All rights reserved.
-- Released under Apache 2.0 license as described in the file LICENSE.
-- Authors: Stephen Morgan, Scott Morrison, Johannes Hölzl

import category_theory.functor_category
import category_theory.fully_faithful

namespace category_theory

universes v v' w u u' -- declare the `v`'s first; see `category_theory.category` for an explanation

instance types : large_category (Type u) :=
{ hom     := λ a b, (a → b),
  id      := λ a, id,
  comp    := λ _ _ _ f g, g ∘ f }

@[simp] lemma types_hom {α β : Type u} : (α ⟶ β) = (α → β) := rfl
@[simp] lemma types_id {α : Type u} (a : α) : (𝟙 α : α → α) a = a := rfl
@[simp] lemma types_comp {α β γ : Type u} (f : α → β) (g : β → γ) (a : α) : (((f : α ⟶ β) ≫ (g : β ⟶ γ)) : α ⟶ γ) a = g (f a) := rfl

namespace functor_to_types
variables {C : Type u} [𝒞 : category.{v} C] (F G H : C ⥤ Type w) {X Y Z : C}
include 𝒞
variables (σ : F ⟹ G) (τ : G ⟹ H)

@[simp] lemma map_comp (f : X ⟶ Y) (g : Y ⟶ Z) (a : F.obj X) : (F.map (f ≫ g)) a = (F.map g) ((F.map f) a) :=
by simp

@[simp] lemma map_id (a : F.obj X) : (F.map (𝟙 X)) a = a :=
by simp

lemma naturality (f : X ⟶ Y) (x : F.obj X) : σ.app Y ((F.map f) x) = (G.map f) (σ.app X x) :=
congr_fun (σ.naturality f) x

@[simp] lemma vcomp (x : F.obj X) : (σ ⊟ τ).app X x = τ.app X (σ.app X x) := rfl

variables {D : Type u'} [𝒟 : category.{u'} D] (I J : D ⥤ C) (ρ : I ⟹ J) {W : D}

@[simp] lemma hcomp (x : (I ⋙ F).obj W) : (ρ ◫ σ).app W x = (G.map (ρ.app W)) (σ.app (I.obj W) x) := rfl

end functor_to_types

def ulift_trivial (V : Type u) : ulift.{u} V ≅ V := by tidy

def ulift_functor : Type u ⥤ Type (max u v) :=
{ obj := λ X, ulift.{v} X,
  map := λ X Y f, λ x : ulift.{v} X, ulift.up (f x.down) }

@[simp] lemma ulift_functor.map {X Y : Type u} (f : X ⟶ Y) (x : ulift.{v} X) :
  ulift_functor.map f x = ulift.up (f x.down) := rfl

instance ulift_functor_faithful : fully_faithful ulift_functor :=
{ preimage := λ X Y f x, (f (ulift.up x)).down,
  injectivity' := λ X Y f g p, funext $ λ x,
    congr_arg ulift.down ((congr_fun p (ulift.up x)) : ((ulift.up (f x)) = (ulift.up (g x)))) }

end category_theory

-- Isomorphisms in Type and equivalences.

namespace equiv

universe u

variables {X Y : Type u}

def to_iso (e : X ≃ Y) : X ≅ Y :=
{ hom := e.to_fun,
  inv := e.inv_fun,
  hom_inv_id' := funext e.left_inv,
  inv_hom_id' := funext e.right_inv }

@[simp] lemma to_iso_hom {e : X ≃ Y} : e.to_iso.hom = e := rfl
@[simp] lemma to_iso_inv {e : X ≃ Y} : e.to_iso.inv = e.symm := rfl

end equiv

namespace category_theory.iso

universe u

variables {X Y : Type u}

def to_equiv (i : X ≅ Y) : X ≃ Y :=
{ to_fun := i.hom,
  inv_fun := i.inv,
  left_inv := λ x, congr_fun i.hom_inv_id x,
  right_inv := λ y, congr_fun i.inv_hom_id y }

@[simp] lemma to_equiv_fun (i : X ≅ Y) : (i.to_equiv : X → Y) = i.hom := rfl
@[simp] lemma to_equiv_symm_fun (i : X ≅ Y) : (i.to_equiv.symm : Y → X) = i.inv := rfl

end category_theory.iso