Modules

categorical-crypto

  • Prelude

CategoricalCrypto

  • CategoricalCrypto
  • Abstract
  • Abstract2
  • Abstract2.Equivalence
  • Abstract2.Morphism
  • Abstract2.OAPEmulation
  • Abstract2.WideSubcategory
  • Channel.Category
  • Channel.Core
  • Channel.Selection
  • Examples.Basic
  • Examples.Commitment
  • Examples.RelSetup
  • Examples.Signatures
  • FamilyCategory
  • Machine.Constraints
  • Machine.Core
  • MachineAxioms
  • RandomOracle
  • RandomOracle2
  • SFunM
  • Standard
  • Standard2
  • Standard2.Morphism
  • StandardTV
  • UCSetup
  • UCSetup.Morphism
  • VanishingTV

Categories

  • Actegory
  • Actegory.Underlying
  • Category.EquivClosureHelper
  • Coherence.Monoidal
  • Coherence.Monoidal.Compare
  • Coherence.Monoidal.Diagram
  • Coherence.Monoidal.Frontend
  • Coherence.Monoidal.Frontend.Core
  • Coherence.Monoidal.Frontend.Sigma
  • Coherence.Monoidal.MacLane
  • Coherence.Monoidal.Normalize
  • Coherence.Monoidal.Reflect
  • Coherence.Monoidal.Sigma
  • Coherence.Monoidal.Test.Frontend
  • Coherence.Monoidal.Test.InterchangeStress
  • Coherence.Monoidal.Test.Limitations
  • Coherence.Monoidal.Test.SigmaFrontend
  • Coherence.Monoidal.WireCoherence
  • CoherenceIsos
  • Diagram.Coend.Ext.Setoids
  • Discrete
  • FreeMonoidal
  • FreeStrictMonoidal
  • Functor.Monoidal.CurriedTensor
  • Functor.Monoidal.CurriedTensor.Properties
  • Functor.Monoidal.Properties.Ext
  • Functor.Presheaf.Morphism
  • GradedKleisli
  • GradedKleisli.Functorial
  • GradedKleisli.Functorial.Category
  • GradedKleisli.Regrade
  • KernelCongruence
  • KernelCongruence.Reindex
  • LocallyGraded
  • LocallyGraded.FreeActegory
  • LocallyGraded.FreeActegory.Kleisli
  • LocallyGraded.Kleisli
  • Monad.Graded.Ext
  • Monad.Graded.Morphism
  • Monad.Graded.Pullback
  • Monad.Graded.Uncurried
  • Morphism.Reasoning.Ext
  • NaturalTransformationHelper
  • Properties

Class

  • Monad.Ext

Data

  • List.Properties.Ext
  • Maybe.Ext
  • Nat.Poly

LibExt

  • LibExt
1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495
{-# OPTIONS --safe --without-K #-}
module Reflection.Utils.Args where
 
open import Meta.Prelude
open import Meta.Init
 
open import Data.List using (map; zip; reverse; length)
open import Data.Fin using (toℕ)
open import Data.Vec.Base using (Vec; []; _∷_)
import Data.Vec.Base as Vec
import Data.Maybe as Maybe
open import Relation.Nullary using (Dec)
 
open import Reflection.AST.Argument.Information
import Reflection.AST.Argument.Visibility as Vis
 
takeFirst : ∀ {ℓ} {A : Set ℓ} (n : ℕ) → List A → Maybe (Vec A n)
takeFirst zero _ = just []
takeFirst (suc _) [] = nothing
takeFirst (suc n) (x ∷ xs) = Maybe.map (x ∷_) (takeFirst n xs)
 
getVisibility : Arg A → Visibility
getVisibility (arg (arg-info v _) _) = v
 
unArgs : Args A → List A
unArgs = map unArg
 
args : Term → Args Term
args = λ where
(var _ xs) → xs
(def _ xs) → xs
(con _ xs) → xs
_ → []
 
args′ : Term → List Term
args′ = unArgs ∘ args
 
vArgs : Args A → List A
vArgs = λ where
[] → []
(vArg x ∷ xs) → x ∷ vArgs xs
(_ ∷ xs) → vArgs xs
 
visibleCount : Args A → ℕ
visibleCount = length ∘ vArgs
 
-- Take the last `n` visible arguments of a `def`. Returns `nothing`
-- if the term isn't a `def` or has fewer than `n` visible
-- arguments. Hidden arguments and any leading visible arguments
-- beyond the last `n` are skipped.
getVisibleArgs : ∀ n → Term → Maybe (Vec Term n)
getVisibleArgs n (def _ xs) = Maybe.map Vec.reverse (takeFirst n (reverse (vArgs xs)))
getVisibleArgs _ _ = nothing
 
argInfo : Arg A → ArgInfo
argInfo (arg i _) = i
 
isVisible? : (a : Arg A) → Dec (visibility (argInfo a) ≡ visible)
isVisible? a = visibility (argInfo a) Vis.≟ visible
 
isInstance? : (a : Arg A) → Dec (visibility (argInfo a) ≡ instance′)
isInstance? a = visibility (argInfo a) Vis.≟ instance′
 
isHidden? : (a : Arg A) → Dec (visibility (argInfo a) ≡ hidden)
isHidden? a = visibility (argInfo a) Vis.≟ hidden
 
remove-iArgs : Args A → Args A
remove-iArgs [] = []
remove-iArgs (iArg x ∷ xs) = remove-iArgs xs
remove-iArgs (x ∷ xs) = x ∷ remove-iArgs xs
 
hide : Arg A → Arg A
hide = λ where
(vArg x) → hArg x
(hArg x) → hArg x
(iArg x) → iArg x
a → a
 
∀indices⋯ : Args Type → Type → Type
∀indices⋯ [] ty = ty
∀indices⋯ (i ∷ is) ty = Π[ "_" ∶ hide i ] (∀indices⋯ is ty)
 
apply⋯ : Args Type → Name → Type
apply⋯ is n = def n $ remove-iArgs $
map (λ{ (n , arg i _) → arg i (♯ (length is ∸ suc (toℕ n)))}) (zip (allFin $ length is) is)
 
-- Applying a list of arguments to a term of any shape.
apply∗ : Term → Args Term → Term
apply∗ f xs = case f of λ where
(def n as) → def n (as ++ xs)
(con c as) → con c (as ++ xs)
(var x as) → var x (as ++ xs)
(pat-lam cs as) → pat-lam cs (as ++ xs)
(meta x as) → meta x (as ++ xs)
f → f