DanilaFe/agda-spa
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Switch maps (and consequently most of the code) to using instances

Browse Source 
Signed-off-by: Danila Fedorin <danila.fedorin@gmail.com>
This commit is contained in:
Danila Fedorin 2025-01-04 21:16:22 -08:00
parent d90b544436
commit d96eb97b69
16 changed files with 257 additions and 240 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
Analysis/Forward.agda
View File

@ -2,10 +2,10 @@ open import Language hiding (_[_])
open import Lattice open import Lattice
module Analysis.Forward module Analysis.Forward
{L : Set} {h} (L : Set) {h}
{_≈ˡ_ : L → L → Set} {_⊔ˡ_ : L → L → L} {_⊓ˡ_ : L → L → L} {_≈ˡ_ : L → L → Set} {_⊔ˡ_ : L → L → L} {_⊓ˡ_ : L → L → L}
(isFiniteHeightLatticeˡ : IsFiniteHeightLattice L h _≈ˡ_ _⊔ˡ_ _⊓ˡ_) {{isFiniteHeightLatticeˡ : IsFiniteHeightLattice L h _≈ˡ_ _⊔ˡ_ _⊓ˡ_}}
(≈ˡ-dec : IsDecidable _≈ˡ_) where {{≈ˡ-dec : IsDecidable _≈ˡ_}} where
open import Data.Empty using (⊥-elim) open import Data.Empty using (⊥-elim)
open import Data.String using (String) open import Data.String using (String)
@ -20,8 +20,8 @@ open IsFiniteHeightLattice isFiniteHeightLatticeˡ
using () renaming (isLattice to isLatticeˡ) using () renaming (isLattice to isLatticeˡ)
module WithProg (prog : Program) where module WithProg (prog : Program) where
open import Analysis.Forward.Lattices isFiniteHeightLatticeˡ ≈ˡ-dec prog open import Analysis.Forward.Lattices L prog hiding (≈ᵛ-Decidable) -- to disambiguate instance resolution
open import Analysis.Forward.Evaluation isFiniteHeightLatticeˡ ≈ˡ-dec prog open import Analysis.Forward.Evaluation L prog
open Program prog open Program prog
private module WithStmtEvaluator {{evaluator : StmtEvaluator}} where private module WithStmtEvaluator {{evaluator : StmtEvaluator}} where
@ -43,7 +43,7 @@ module WithProg (prog : Program) where
(flip (eval s)) (eval-Monoʳ s) (flip (eval s)) (eval-Monoʳ s)
vs₁≼vs₂ vs₁≼vs₂
open StateVariablesFiniteMap.GeneralizedUpdate isLatticeᵐ (λ x → x) (λ a₁≼a₂ → a₁≼a₂) updateVariablesForState updateVariablesForState-Monoʳ states open StateVariablesFiniteMap.GeneralizedUpdate {{isLatticeᵐ}} (λ x → x) (λ a₁≼a₂ → a₁≼a₂) updateVariablesForState updateVariablesForState-Monoʳ states
using () using ()
renaming renaming
( f' to updateAll ( f' to updateAll

12
Analysis/Forward/Adapters.agda
View File

@ -2,14 +2,14 @@ open import Language hiding (_[_])
open import Lattice open import Lattice
module Analysis.Forward.Adapters module Analysis.Forward.Adapters
{L : Set} {h} (L : Set) {h}
{_≈ˡ_ : L → L → Set} {_⊔ˡ_ : L → L → L} {_⊓ˡ_ : L → L → L} {_≈ˡ_ : L → L → Set} {_⊔ˡ_ : L → L → L} {_⊓ˡ_ : L → L → L}
(isFiniteHeightLatticeˡ : IsFiniteHeightLattice L h _≈ˡ_ _⊔ˡ_ _⊓ˡ_) {{isFiniteHeightLatticeˡ : IsFiniteHeightLattice L h _≈ˡ_ _⊔ˡ_ _⊓ˡ_}}
(≈ˡ-dec : IsDecidable _≈ˡ_) {{≈ˡ-dec : IsDecidable _≈ˡ_}}
(prog : Program) where (prog : Program) where
open import Analysis.Forward.Lattices isFiniteHeightLatticeˡ ≈ˡ-dec prog open import Analysis.Forward.Lattices L prog
open import Analysis.Forward.Evaluation isFiniteHeightLatticeˡ ≈ˡ-dec prog open import Analysis.Forward.Evaluation L prog
open import Data.Empty using (⊥-elim) open import Data.Empty using (⊥-elim)
open import Data.String using (String) renaming (_≟_ to _≟ˢ_) open import Data.String using (String) renaming (_≟_ to _≟ˢ_)
@ -41,7 +41,7 @@ module ExprToStmtAdapter {{ exprEvaluator : ExprEvaluator }} where
-- for an assignment, and update the corresponding key. Use Exercise 4.26's -- for an assignment, and update the corresponding key. Use Exercise 4.26's
-- generalized update to set the single key's value. -- generalized update to set the single key's value.
private module _ (k : String) (e : Expr) where private module _ (k : String) (e : Expr) where
open VariableValuesFiniteMap.GeneralizedUpdate isLatticeᵛ (λ x → x) (λ a₁≼a₂ → a₁≼a₂) (λ _ → evalᵉ e) (λ _ {vs₁} {vs₂} vs₁≼vs₂ → evalᵉ-Monoʳ e {vs₁} {vs₂} vs₁≼vs₂) (k ∷ []) open VariableValuesFiniteMap.GeneralizedUpdate {{isLatticeᵛ}} (λ x → x) (λ a₁≼a₂ → a₁≼a₂) (λ _ → evalᵉ e) (λ _ {vs₁} {vs₂} vs₁≼vs₂ → evalᵉ-Monoʳ e {vs₁} {vs₂} vs₁≼vs₂) (k ∷ [])
using () using ()
renaming renaming
( f' to updateVariablesFromExpression ( f' to updateVariablesFromExpression

8
Analysis/Forward/Evaluation.agda
View File

@ -2,13 +2,13 @@ open import Language hiding (_[_])
open import Lattice open import Lattice
module Analysis.Forward.Evaluation module Analysis.Forward.Evaluation
{L : Set} {h} (L : Set) {h}
{_≈ˡ_ : L → L → Set} {_⊔ˡ_ : L → L → L} {_⊓ˡ_ : L → L → L} {_≈ˡ_ : L → L → Set} {_⊔ˡ_ : L → L → L} {_⊓ˡ_ : L → L → L}
(isFiniteHeightLatticeˡ : IsFiniteHeightLattice L h _≈ˡ_ _⊔ˡ_ _⊓ˡ_) {{isFiniteHeightLatticeˡ : IsFiniteHeightLattice L h _≈ˡ_ _⊔ˡ_ _⊓ˡ_}}
(≈ˡ-dec : IsDecidable _≈ˡ_) {{≈ˡ-dec : IsDecidable _≈ˡ_}}
(prog : Program) where (prog : Program) where
open import Analysis.Forward.Lattices isFiniteHeightLatticeˡ ≈ˡ-dec prog open import Analysis.Forward.Lattices L prog
open import Data.Product using (_,_) open import Data.Product using (_,_)
open IsFiniteHeightLattice isFiniteHeightLatticeˡ open IsFiniteHeightLattice isFiniteHeightLatticeˡ

41
Analysis/Forward/Lattices.agda
View File

@ -2,20 +2,21 @@ open import Language hiding (_[_])
open import Lattice open import Lattice
module Analysis.Forward.Lattices module Analysis.Forward.Lattices
{L : Set} {h} (L : Set) {h}
{_≈ˡ_ : L → L → Set} {_⊔ˡ_ : L → L → L} {_⊓ˡ_ : L → L → L} {_≈ˡ_ : L → L → Set} {_⊔ˡ_ : L → L → L} {_⊓ˡ_ : L → L → L}
(isFiniteHeightLatticeˡ : IsFiniteHeightLattice L h _≈ˡ_ _⊔ˡ_ _⊓ˡ_) {{isFiniteHeightLatticeˡ : IsFiniteHeightLattice L h _≈ˡ_ _⊔ˡ_ _⊓ˡ_}}
(≈ˡ-Decidable : IsDecidable _≈ˡ_) {{≈ˡ-Decidable : IsDecidable _≈ˡ_}}
(prog : Program) where (prog : Program) where
open import Data.String using () renaming (_≟_ to _≟ˢ_) open import Data.String using (String) renaming (_≟_ to _≟ˢ_)
open import Data.Product using (proj₁; proj₂; _,_) open import Data.Product using (proj₁; proj₂; _,_)
open import Data.Unit using (tt)
open import Data.Sum using (inj₁; inj₂) open import Data.Sum using (inj₁; inj₂)
open import Data.List using (List; _∷_; []; foldr) open import Data.List using (List; _∷_; []; foldr)
open import Data.List.Membership.Propositional using () renaming (_∈_ to _∈ˡ_) open import Data.List.Membership.Propositional using () renaming (_∈_ to _∈ˡ_)
open import Data.List.Relation.Unary.Any as Any using () open import Data.List.Relation.Unary.Any as Any using ()
open import Relation.Binary.PropositionalEquality using (_≡_; refl) open import Relation.Binary.PropositionalEquality using (_≡_; refl)
open import Utils using (Pairwise; _⇒_; _∨_) open import Utils using (Pairwise; _⇒_; _∨_; it)
open IsFiniteHeightLattice isFiniteHeightLatticeˡ open IsFiniteHeightLattice isFiniteHeightLatticeˡ
using () using ()
@ -29,14 +30,15 @@ open Program prog
import Lattice.FiniteMap import Lattice.FiniteMap
import Chain import Chain
≡-Decidable-String = record { R-dec = _≟ˢ_ } instance
≡-Decidable-State = record { R-dec = _≟_ } ≡-Decidable-String = record { R-dec = _≟ˢ_ }
≡-Decidable-State = record { R-dec = _≟_ }
-- The variable -> abstract value (e.g. sign) map is a finite value-map -- The variable -> abstract value (e.g. sign) map is a finite value-map
-- with keys strings. Use a bundle to avoid explicitly specifying operators. -- with keys strings. Use a bundle to avoid explicitly specifying operators.
-- It's helpful to export these via 'public' since consumers tend to -- It's helpful to export these via 'public' since consumers tend to
-- use various variable lattice operations. -- use various variable lattice operations.
module VariableValuesFiniteMap = Lattice.FiniteMap.WithKeys ≡-Decidable-String isLatticeˡ vars module VariableValuesFiniteMap = Lattice.FiniteMap.WithKeys String L tt vars
open VariableValuesFiniteMap open VariableValuesFiniteMap
using () using ()
renaming renaming
@ -45,7 +47,7 @@ open VariableValuesFiniteMap
; _≈_ to _≈ᵛ_ ; _≈_ to _≈ᵛ_
; _⊔_ to _⊔ᵛ_ ; _⊔_ to _⊔ᵛ_
; _≼_ to _≼ᵛ_ ; _≼_ to _≼ᵛ_
; ≈₂-Decidable⇒≈-Decidable to ≈ˡ-Decidable⇒≈ᵛ-Decidable ; ≈-Decidable to ≈ᵛ-Decidable
; _∈_ to _∈ᵛ_ ; _∈_ to _∈ᵛ_
; _∈k_ to _∈kᵛ_ ; _∈k_ to _∈kᵛ_
; _updating_via_ to _updatingᵛ_via_ ; _updating_via_ to _updatingᵛ_via_
@ -63,27 +65,25 @@ open IsLattice isLatticeᵛ
; ⊔-idemp to ⊔ᵛ-idemp ; ⊔-idemp to ⊔ᵛ-idemp
) )
public public
open Lattice.FiniteMap.IterProdIsomorphism ≡-Decidable-String isLatticeˡ open Lattice.FiniteMap.IterProdIsomorphism String L _
using () using ()
renaming renaming
( Provenance-union to Provenance-unionᵐ ( Provenance-union to Provenance-unionᵐ
) )
public public
open Lattice.FiniteMap.IterProdIsomorphism.WithUniqueKeysAndFixedHeight ≡-Decidable-String isLatticeˡ vars-Unique ≈ˡ-Decidable _ fixedHeightˡ open Lattice.FiniteMap.IterProdIsomorphism.WithUniqueKeysAndFixedHeight String L _ vars-Unique
using () using ()
renaming renaming
( isFiniteHeightLattice to isFiniteHeightLatticeᵛ ( isFiniteHeightLattice to isFiniteHeightLatticeᵛ
; fixedHeight to fixedHeightᵛ
; ⊥-contains-bottoms to ⊥ᵛ-contains-bottoms ; ⊥-contains-bottoms to ⊥ᵛ-contains-bottoms
) )
public public
≈ᵛ-Decidable = ≈ˡ-Decidable⇒≈ᵛ-Decidable ≈ˡ-Decidable
joinSemilatticeᵛ = IsFiniteHeightLattice.joinSemilattice isFiniteHeightLatticeᵛ
fixedHeightᵛ = IsFiniteHeightLattice.fixedHeight isFiniteHeightLatticeᵛ
⊥ᵛ = Chain.Height.⊥ fixedHeightᵛ ⊥ᵛ = Chain.Height.⊥ fixedHeightᵛ
-- Finally, the map we care about is (state -> (variables -> value)). Bring that in. -- Finally, the map we care about is (state -> (variables -> value)). Bring that in.
module StateVariablesFiniteMap = Lattice.FiniteMap.WithKeys ≡-Decidable-State isLatticeᵛ states module StateVariablesFiniteMap = Lattice.FiniteMap.WithKeys State VariableValues tt states
open StateVariablesFiniteMap open StateVariablesFiniteMap
using (_[_]; []-∈; m₁≼m₂⇒m₁[ks]≼m₂[ks]; m₁≈m₂⇒k∈m₁⇒k∈km₂⇒v₁≈v₂) using (_[_]; []-∈; m₁≼m₂⇒m₁[ks]≼m₂[ks]; m₁≈m₂⇒k∈m₁⇒k∈km₂⇒v₁≈v₂)
renaming renaming
@ -94,11 +94,11 @@ open StateVariablesFiniteMap
; _∈k_ to _∈kᵐ_ ; _∈k_ to _∈kᵐ_
; locate to locateᵐ ; locate to locateᵐ
; _≼_ to _≼ᵐ_ ; _≼_ to _≼ᵐ_
; ≈₂-Decidable⇒≈-Decidable to ≈ᵛ-Decidable⇒≈ᵐ-Decidable ; ≈-Decidable to ≈ᵐ-Decidable
; m₁≼m₂⇒m₁[k]≼m₂[k] to m₁≼m₂⇒m₁[k]ᵐ≼m₂[k]ᵐ ; m₁≼m₂⇒m₁[k]≼m₂[k] to m₁≼m₂⇒m₁[k]ᵐ≼m₂[k]ᵐ
) )
public public
open Lattice.FiniteMap.IterProdIsomorphism.WithUniqueKeysAndFixedHeight ≡-Decidable-State isLatticeᵛ states-Unique ≈ᵛ-Decidable _ fixedHeightᵛ open Lattice.FiniteMap.IterProdIsomorphism.WithUniqueKeysAndFixedHeight State VariableValues _ states-Unique
using () using ()
renaming renaming
( isFiniteHeightLattice to isFiniteHeightLatticeᵐ ( isFiniteHeightLattice to isFiniteHeightLatticeᵐ
@ -111,9 +111,6 @@ open IsFiniteHeightLattice isFiniteHeightLatticeᵐ
) )
public public
≈ᵐ-Decidable = ≈ᵛ-Decidable⇒≈ᵐ-Decidable ≈ᵛ-Decidable
fixedHeightᵐ = IsFiniteHeightLattice.fixedHeight isFiniteHeightLatticeᵐ
-- We now have our (state -> (variables -> value)) map. -- We now have our (state -> (variables -> value)) map.
-- Define a couple of helpers to retrieve values from it. Specifically, -- Define a couple of helpers to retrieve values from it. Specifically,
-- since the State type is as specific as possible, it's always possible to -- since the State type is as specific as possible, it's always possible to
@ -147,12 +144,12 @@ joinForKey k states = foldr _⊔ᵛ_ ⊥ᵛ (states [ incoming k ])
joinForKey-Mono : ∀ (k : State) → Monotonic _≼ᵐ_ _≼ᵛ_ (joinForKey k) joinForKey-Mono : ∀ (k : State) → Monotonic _≼ᵐ_ _≼ᵛ_ (joinForKey k)
joinForKey-Mono k {fm₁} {fm₂} fm₁≼fm₂ = joinForKey-Mono k {fm₁} {fm₂} fm₁≼fm₂ =
foldr-Mono joinSemilatticeᵛ joinSemilatticeᵛ (fm₁ [ incoming k ]) (fm₂ [ incoming k ]) _⊔ᵛ_ ⊥ᵛ ⊥ᵛ foldr-Mono it it (fm₁ [ incoming k ]) (fm₂ [ incoming k ]) _⊔ᵛ_ ⊥ᵛ ⊥ᵛ
(m₁≼m₂⇒m₁[ks]≼m₂[ks] fm₁ fm₂ (incoming k) fm₁≼fm₂) (m₁≼m₂⇒m₁[ks]≼m₂[ks] fm₁ fm₂ (incoming k) fm₁≼fm₂)
(⊔ᵛ-idemp ⊥ᵛ) ⊔ᵛ-Monotonicʳ ⊔ᵛ-Monotonicˡ (⊔ᵛ-idemp ⊥ᵛ) ⊔ᵛ-Monotonicʳ ⊔ᵛ-Monotonicˡ
-- The name f' comes from the formulation of Exercise 4.26. -- The name f' comes from the formulation of Exercise 4.26.
open StateVariablesFiniteMap.GeneralizedUpdate isLatticeᵐ (λ x → x) (λ a₁≼a₂ → a₁≼a₂) joinForKey joinForKey-Mono states open StateVariablesFiniteMap.GeneralizedUpdate {{isLatticeᵐ}} (λ x → x) (λ a₁≼a₂ → a₁≼a₂) joinForKey joinForKey-Mono states
using () using ()
renaming renaming
( f' to joinAll ( f' to joinAll

14
Analysis/Sign.agda
View File

@ -52,7 +52,6 @@ open import Lattice.AboveBelow Sign _≡_ (record { ≈-refl = refl; ≈-sym = s
using () using ()
renaming renaming
( AboveBelow to SignLattice ( AboveBelow to SignLattice
; ≈-Decidable to ≈ᵍ-Decidable
; ⊥ to ⊥ᵍ ; ⊥ to ⊥ᵍ
; ⊤ to ⊤ᵍ ; ⊤ to ⊤ᵍ
; [_] to [_]ᵍ ; [_] to [_]ᵍ
@ -72,10 +71,7 @@ open AB.Plain 0ˢ using ()
; _⊓_ to _⊓ᵍ_ ; _⊓_ to _⊓ᵍ_
) )
open IsLattice isLatticeᵍ using () open IsLattice isLatticeᵍ using () renaming (≼-trans to ≼ᵍ-trans)
renaming
( ≼-trans to ≼ᵍ-trans
)
plus : SignLattice → SignLattice → SignLattice plus : SignLattice → SignLattice → SignLattice
plus ⊥ᵍ _ = ⊥ᵍ plus ⊥ᵍ _ = ⊥ᵍ
@ -175,9 +171,9 @@ instance
module WithProg (prog : Program) where module WithProg (prog : Program) where
open Program prog open Program prog
open import Analysis.Forward.Lattices isFiniteHeightLatticeᵍ ≈ᵍ-Decidable prog open import Analysis.Forward.Lattices SignLattice prog
open import Analysis.Forward.Evaluation isFiniteHeightLatticeᵍ ≈ᵍ-Decidable prog open import Analysis.Forward.Evaluation SignLattice prog
open import Analysis.Forward.Adapters isFiniteHeightLatticeᵍ ≈ᵍ-Decidable prog open import Analysis.Forward.Adapters SignLattice prog
eval : ∀ (e : Expr) → VariableValues → SignLattice eval : ∀ (e : Expr) → VariableValues → SignLattice
eval (e₁ + e₂) vs = plus (eval e₁ vs) (eval e₂ vs) eval (e₁ + e₂) vs = plus (eval e₁ vs) (eval e₂ vs)
@ -233,7 +229,7 @@ module WithProg (prog : Program) where
SignEval = record { eval = eval; eval-Monoʳ = eval-Monoʳ } SignEval = record { eval = eval; eval-Monoʳ = eval-Monoʳ }
-- For debugging purposes, print out the result. -- For debugging purposes, print out the result.
output = show (Analysis.Forward.WithProg.result isFiniteHeightLatticeᵍ ≈ᵍ-Decidable prog) output = show (Analysis.Forward.WithProg.result SignLattice prog)
-- This should have fewer cases -- the same number as the actual 'plus' above. -- This should have fewer cases -- the same number as the actual 'plus' above.
-- But agda only simplifies on first argument, apparently, so we are stuck -- But agda only simplifies on first argument, apparently, so we are stuck

46
Isomorphism.agda
View File

@ -63,27 +63,29 @@ module TransportFiniteHeight
portChain₂ (done₂ a₂≈a₁) = done₁ (g-preserves-≈₂ a₂≈a₁) portChain₂ (done₂ a₂≈a₁) = done₁ (g-preserves-≈₂ a₂≈a₁)
portChain₂ (step₂ {b₁} {b₂} (b₁≼b₂ , b₁̷≈b₂) b₂≈b₂' c) = step₁ (≈₁-trans (≈₁-sym (g-⊔-distr b₁ b₂)) (g-preserves-≈₂ b₁≼b₂) , g-preserves-̷≈ b₁̷≈b₂) (g-preserves-≈₂ b₂≈b₂') (portChain₂ c) portChain₂ (step₂ {b₁} {b₂} (b₁≼b₂ , b₁̷≈b₂) b₂≈b₂' c) = step₁ (≈₁-trans (≈₁-sym (g-⊔-distr b₁ b₂)) (g-preserves-≈₂ b₁≼b₂) , g-preserves-̷≈ b₁̷≈b₂) (g-preserves-≈₂ b₂≈b₂') (portChain₂ c)
isFiniteHeightLattice : IsFiniteHeightLattice B height _≈₂_ _⊔₂_ _⊓₂_ open Chain.Height (IsFiniteHeightLattice.fixedHeight fhlA)
isFiniteHeightLattice = using ()
let renaming (⊥ to ⊥₁; ⊤ to ⊤₁; bounded to bounded₁; longestChain to c)
open Chain.Height (IsFiniteHeightLattice.fixedHeight fhlA)
using () instance
renaming (⊥ to ⊥₁; ⊤ to ⊤₁; bounded to bounded₁; longestChain to c) fixedHeight = record
in record { ⊥ = f ⊥₁
{ isLattice = lB ; ⊤ = f ⊤₁
; fixedHeight = record ; longestChain = portChain₁ c
{ ⊥ = f ⊥₁ ; bounded = λ c' → bounded₁ (portChain₂ c')
; ⊤ = f ⊤₁
; longestChain = portChain₁ c
; bounded = λ c' → bounded₁ (portChain₂ c')
}
} }
finiteHeightLattice : FiniteHeightLattice B isFiniteHeightLattice : IsFiniteHeightLattice B height _≈₂_ _⊔₂_ _⊓₂_
finiteHeightLattice = record isFiniteHeightLattice = record
{ height = height { isLattice = lB
; _≈_ = _≈₂_ ; fixedHeight = fixedHeight
; _⊔_ = _⊔₂_ }
; _⊓_ = _⊓₂_
; isFiniteHeightLattice = isFiniteHeightLattice finiteHeightLattice : FiniteHeightLattice B
} finiteHeightLattice = record
{ height = height
; _≈_ = _≈₂_
; _⊔_ = _⊔₂_
; _⊓_ = _⊓₂_
; isFiniteHeightLattice = isFiniteHeightLattice
}

2
Language.agda
View File

@ -22,7 +22,7 @@ open import Relation.Nullary using (¬_)
open import Lattice open import Lattice
open import Utils using (Unique; push; Unique-map; x∈xs⇒fx∈fxs) open import Utils using (Unique; push; Unique-map; x∈xs⇒fx∈fxs)
open import Lattice.MapSet (record { R-dec = _≟ˢ_ }) using () open import Lattice.MapSet String {{record { R-dec = _≟ˢ_ }}} _ using ()
renaming renaming
( MapSet to StringSet ( MapSet to StringSet
; to-List to to-Listˢ ; to-List to to-Listˢ

2
Language/Base.agda
View File

@ -39,7 +39,7 @@ data _∈ᵇ_ : String → BasicStmt → Set where
in←₁ : ∀ {k : String} {e : Expr} → k ∈ᵇ (k ← e) in←₁ : ∀ {k : String} {e : Expr} → k ∈ᵇ (k ← e)
in←₂ : ∀ {k k' : String} {e : Expr} → k ∈ᵉ e → k ∈ᵇ (k' ← e) in←₂ : ∀ {k k' : String} {e : Expr} → k ∈ᵉ e → k ∈ᵇ (k' ← e)
open import Lattice.MapSet (record { R-dec = String._≟_ }) open import Lattice.MapSet String {{record { R-dec = String._≟_ }}} _
renaming renaming
( MapSet to StringSet ( MapSet to StringSet
; insert to insertˢ ; insert to insertˢ

14
Lattice.agda
View File

@ -187,8 +187,8 @@ record IsLattice {a} (A : Set a)
(_⊓_ : A → A → A) : Set a where (_⊓_ : A → A → A) : Set a where
field field
joinSemilattice : IsSemilattice A _≈_ _⊔_ {{joinSemilattice}} : IsSemilattice A _≈_ _⊔_
meetSemilattice : IsSemilattice A _≈_ _⊓_ {{meetSemilattice}} : IsSemilattice A _≈_ _⊓_
absorb-⊔-⊓ : (x y : A) → (x ⊔ (x ⊓ y)) ≈ x absorb-⊔-⊓ : (x y : A) → (x ⊔ (x ⊓ y)) ≈ x
absorb-⊓-⊔ : (x y : A) → (x ⊓ (x ⊔ y)) ≈ x absorb-⊓-⊔ : (x y : A) → (x ⊓ (x ⊔ y)) ≈ x
@ -217,12 +217,12 @@ record IsFiniteHeightLattice {a} (A : Set a)
(_⊓_ : A → A → A) : Set (lsuc a) where (_⊓_ : A → A → A) : Set (lsuc a) where
field field
isLattice : IsLattice A _≈_ _⊔_ _⊓_ {{isLattice}} : IsLattice A _≈_ _⊔_ _⊓_
open IsLattice isLattice public open IsLattice isLattice public
field field
fixedHeight : FixedHeight h {{fixedHeight}} : FixedHeight h
module ChainMapping {a b} {A : Set a} {B : Set b} module ChainMapping {a b} {A : Set a} {B : Set b}
{_≈₁_ : A → A → Set a} {_≈₂_ : B → B → Set b} {_≈₁_ : A → A → Set a} {_≈₂_ : B → B → Set b}
@ -252,7 +252,7 @@ record Semilattice {a} (A : Set a) : Set (lsuc a) where
_≈_ : A → A → Set a _≈_ : A → A → Set a
_⊔_ : A → A → A _⊔_ : A → A → A
isSemilattice : IsSemilattice A _≈_ _⊔_ {{isSemilattice}} : IsSemilattice A _≈_ _⊔_
open IsSemilattice isSemilattice public open IsSemilattice isSemilattice public
@ -263,7 +263,7 @@ record Lattice {a} (A : Set a) : Set (lsuc a) where
_⊔_ : A → A → A _⊔_ : A → A → A
_⊓_ : A → A → A _⊓_ : A → A → A
isLattice : IsLattice A _≈_ _⊔_ _⊓_ {{isLattice}} : IsLattice A _≈_ _⊔_ _⊓_
open IsLattice isLattice public open IsLattice isLattice public
@ -274,6 +274,6 @@ record FiniteHeightLattice {a} (A : Set a) : Set (lsuc a) where
_⊔_ : A → A → A _⊔_ : A → A → A
_⊓_ : A → A → A _⊓_ : A → A → A
isFiniteHeightLattice : IsFiniteHeightLattice A height _≈_ _⊔_ _⊓_ {{isFiniteHeightLattice}} : IsFiniteHeightLattice A height _≈_ _⊔_ _⊓_
open IsFiniteHeightLattice isFiniteHeightLattice public open IsFiniteHeightLattice isFiniteHeightLattice public

109
Lattice/AboveBelow.agda
View File

@ -79,8 +79,9 @@ data _≈_ : AboveBelow → AboveBelow → Set a where
≈-dec [ x ] ⊥ = no λ () ≈-dec [ x ] ⊥ = no λ ()
≈-dec [ x ] ⊤ = no λ () ≈-dec [ x ] ⊤ = no λ ()
≈-Decidable : IsDecidable _≈_ instance
≈-Decidable = record { R-dec = ≈-dec } ≈-Decidable : IsDecidable _≈_
≈-Decidable = record { R-dec = ≈-dec }
-- Any object can be wrapped in an 'above below' to make it a lattice, -- Any object can be wrapped in an 'above below' to make it a lattice,
-- since ⊤ and ⊥ are the largest and least elements, and the rest are left -- since ⊤ and ⊥ are the largest and least elements, and the rest are left
@ -175,14 +176,15 @@ module Plain (x : A) where
⊔-idemp ⊥ = ≈-⊥-⊥ ⊔-idemp ⊥ = ≈-⊥-⊥
⊔-idemp [ x ] rewrite x≈y⇒[x]⊔[y]≡[x] (≈₁-refl {x}) = ≈-refl ⊔-idemp [ x ] rewrite x≈y⇒[x]⊔[y]≡[x] (≈₁-refl {x}) = ≈-refl
isJoinSemilattice : IsSemilattice AboveBelow _≈_ _⊔_ instance
isJoinSemilattice = record isJoinSemilattice : IsSemilattice AboveBelow _≈_ _⊔_
{ ≈-equiv = ≈-equiv isJoinSemilattice = record
; ≈-⊔-cong = ≈-⊔-cong { ≈-equiv = ≈-equiv
; ⊔-assoc = ⊔-assoc ; ≈-⊔-cong = ≈-⊔-cong
; ⊔-comm = ⊔-comm ; ⊔-assoc = ⊔-assoc
; ⊔-idemp = ⊔-idemp ; ⊔-comm = ⊔-comm
} ; ⊔-idemp = ⊔-idemp
}
_⊓_ : AboveBelow → AboveBelow → AboveBelow _⊓_ : AboveBelow → AboveBelow → AboveBelow
⊥ ⊓ x = ⊥ ⊥ ⊓ x = ⊥
@ -268,14 +270,15 @@ module Plain (x : A) where
⊓-idemp ⊤ = ≈-⊤-⊤ ⊓-idemp ⊤ = ≈-⊤-⊤
⊓-idemp [ x ] rewrite x≈y⇒[x]⊓[y]≡[x] (≈₁-refl {x}) = ≈-refl ⊓-idemp [ x ] rewrite x≈y⇒[x]⊓[y]≡[x] (≈₁-refl {x}) = ≈-refl
isMeetSemilattice : IsSemilattice AboveBelow _≈_ _⊓_ instance
isMeetSemilattice = record isMeetSemilattice : IsSemilattice AboveBelow _≈_ _⊓_
{ ≈-equiv = ≈-equiv isMeetSemilattice = record
; ≈-⊔-cong = ≈-⊓-cong { ≈-equiv = ≈-equiv
; ⊔-assoc = ⊓-assoc ; ≈-⊔-cong = ≈-⊓-cong
; ⊔-comm = ⊓-comm ; ⊔-assoc = ⊓-assoc
; ⊔-idemp = ⊓-idemp ; ⊔-comm = ⊓-comm
} ; ⊔-idemp = ⊓-idemp
}
absorb-⊔-⊓ : ∀ (ab₁ ab₂ : AboveBelow) → (ab₁ ⊔ (ab₁ ⊓ ab₂)) ≈ ab₁ absorb-⊔-⊓ : ∀ (ab₁ ab₂ : AboveBelow) → (ab₁ ⊔ (ab₁ ⊓ ab₂)) ≈ ab₁
absorb-⊔-⊓ ⊥ ab₂ rewrite ⊥⊓x≡⊥ ab₂ = ≈-⊥-⊥ absorb-⊔-⊓ ⊥ ab₂ rewrite ⊥⊓x≡⊥ ab₂ = ≈-⊥-⊥
@ -300,21 +303,22 @@ module Plain (x : A) where
... | no x̷≈y rewrite x̷≈y⇒[x]⊔[y]≡⊤ x̷≈y rewrite x⊓⊤≡x [ x ] = ≈-refl ... | no x̷≈y rewrite x̷≈y⇒[x]⊔[y]≡⊤ x̷≈y rewrite x⊓⊤≡x [ x ] = ≈-refl
isLattice : IsLattice AboveBelow _≈_ _⊔_ _⊓_ instance
isLattice = record isLattice : IsLattice AboveBelow _≈_ _⊔_ _⊓_
{ joinSemilattice = isJoinSemilattice isLattice = record
; meetSemilattice = isMeetSemilattice { joinSemilattice = isJoinSemilattice
; absorb-⊔-⊓ = absorb-⊔-⊓ ; meetSemilattice = isMeetSemilattice
; absorb-⊓-⊔ = absorb-⊓-⊔ ; absorb-⊔-⊓ = absorb-⊔-⊓
} ; absorb-⊓-⊔ = absorb-⊓-⊔
}
lattice : Lattice AboveBelow lattice : Lattice AboveBelow
lattice = record lattice = record
{ _≈_ = _≈_ { _≈_ = _≈_
; _⊔_ = _⊔_ ; _⊔_ = _⊔_
; _⊓_ = _⊓_ ; _⊓_ = _⊓_
; isLattice = isLattice ; isLattice = isLattice
} }
open IsLattice isLattice using (_≼_; _≺_; ⊔-Monotonicˡ; ⊔-Monotonicʳ) public open IsLattice isLattice using (_≼_; _≺_; ⊔-Monotonicˡ; ⊔-Monotonicʳ) public
@ -360,25 +364,26 @@ module Plain (x : A) where
isLongest {⊥} (step {_} {[ x ]} _ (≈-lift _) (step [x]≺y y≈z c@(step _ _ _))) isLongest {⊥} (step {_} {[ x ]} _ (≈-lift _) (step [x]≺y y≈z c@(step _ _ _)))
rewrite [x]≺y⇒y≡⊤ _ _ [x]≺y with ≈-⊤-⊤ ← y≈z = ⊥-elim (¬-Chain-⊤ c) rewrite [x]≺y⇒y≡⊤ _ _ [x]≺y with ≈-⊤-⊤ ← y≈z = ⊥-elim (¬-Chain-⊤ c)
fixedHeight : IsLattice.FixedHeight isLattice 2 instance
fixedHeight = record fixedHeight : IsLattice.FixedHeight isLattice 2
{ ⊥ = ⊥ fixedHeight = record
; ⊤ = ⊤ { ⊥ = ⊥
; longestChain = longestChain ; ⊤ = ⊤
; bounded = isLongest ; longestChain = longestChain
} ; bounded = isLongest
}
isFiniteHeightLattice : IsFiniteHeightLattice AboveBelow 2 _≈_ _⊔_ _⊓_ isFiniteHeightLattice : IsFiniteHeightLattice AboveBelow 2 _≈_ _⊔_ _⊓_
isFiniteHeightLattice = record isFiniteHeightLattice = record
{ isLattice = isLattice { isLattice = isLattice
; fixedHeight = fixedHeight ; fixedHeight = fixedHeight
} }
finiteHeightLattice : FiniteHeightLattice AboveBelow finiteHeightLattice : FiniteHeightLattice AboveBelow
finiteHeightLattice = record finiteHeightLattice = record
{ height = 2 { height = 2
; _≈_ = _≈_ ; _≈_ = _≈_
; _⊔_ = _⊔_ ; _⊔_ = _⊔_
; _⊓_ = _⊓_ ; _⊓_ = _⊓_
; isFiniteHeightLattice = isFiniteHeightLattice ; isFiniteHeightLattice = isFiniteHeightLattice
} }

117
Lattice/FiniteMap.agda
View File

@ -3,15 +3,16 @@ open import Relation.Binary.PropositionalEquality as Eq
using (_≡_;refl; sym; trans; cong; subst) using (_≡_;refl; sym; trans; cong; subst)
open import Agda.Primitive using (Level) renaming (_⊔_ to _⊔ℓ_) open import Agda.Primitive using (Level) renaming (_⊔_ to _⊔ℓ_)
open import Data.List using (List; _∷_; []) open import Data.List using (List; _∷_; [])
open import Data.Unit using (⊤)
module Lattice.FiniteMap {A : Set} {B : Set} module Lattice.FiniteMap (A : Set) (B : Set)
{_≈₂_ : B → B → Set} {_≈₂_ : B → B → Set}
{_⊔₂_ : B → B → B} {_⊓₂_ : B → B → B} {_⊔₂_ : B → B → B} {_⊓₂_ : B → B → B}
(≡-Decidable-A : IsDecidable {_} {A} _≡_) {{≡-Decidable-A : IsDecidable {_} {A} _≡_}}
(lB : IsLattice B _≈₂_ _⊔₂_ _⊓₂_) where {{lB : IsLattice B _≈₂_ _⊔₂_ _⊓₂_}} (dummy : ⊤) where
open IsLattice lB using () renaming (_≼_ to _≼₂_) open IsLattice lB using () renaming (_≼_ to _≼₂_)
open import Lattice.Map ≡-Decidable-A lB as Map open import Lattice.Map A B dummy as Map
using using
( Map ( Map
; ⊔-equal-keys ; ⊔-equal-keys
@ -85,11 +86,12 @@ module WithKeys (ks : List A) where
_≈_ : FiniteMap → FiniteMap → Set _≈_ : FiniteMap → FiniteMap → Set
_≈_ (m₁ , _) (m₂ , _) = m₁ ≈ᵐ m₂ _≈_ (m₁ , _) (m₂ , _) = m₁ ≈ᵐ m₂
≈₂-Decidable⇒≈-Decidable : IsDecidable _≈₂_ → IsDecidable _≈_ instance
≈₂-Decidable⇒≈-Decidable ≈₂-Decidable = record ≈-Decidable : {{ IsDecidable _≈₂_ }} → IsDecidable _≈_
{ R-dec = λ fm₁ fm₂ → IsDecidable.R-dec (≈ᵐ-Decidable ≈₂-Decidable) ≈-Decidable {{≈₂-Decidable}} = record
(proj₁ fm₁) (proj₁ fm₂) { R-dec = λ fm₁ fm₂ → IsDecidable.R-dec (≈ᵐ-Decidable {{≈₂-Decidable}})
} (proj₁ fm₁) (proj₁ fm₂)
}
_⊔_ : FiniteMap → FiniteMap → FiniteMap _⊔_ : FiniteMap → FiniteMap → FiniteMap
_⊔_ (m₁ , km₁≡ks) (m₂ , km₂≡ks) = _⊔_ (m₁ , km₁≡ks) (m₂ , km₂≡ks) =
@ -142,46 +144,47 @@ module WithKeys (ks : List A) where
IsEquivalence.≈-trans ≈ᵐ-equiv {m₁} {m₂} {m₃} IsEquivalence.≈-trans ≈ᵐ-equiv {m₁} {m₂} {m₃}
} }
isUnionSemilattice : IsSemilattice FiniteMap _≈_ _⊔_ instance
isUnionSemilattice = record isUnionSemilattice : IsSemilattice FiniteMap _≈_ _⊔_
{ ≈-equiv = ≈-equiv isUnionSemilattice = record
; ≈-⊔-cong = { ≈-equiv = ≈-equiv
λ {(m₁ , _)} {(m₂ , _)} {(m₃ , _)} {(m₄ , _)} m₁≈m₂ m₃≈m₄ → ; ≈-⊔-cong =
≈ᵐ-⊔ᵐ-cong {m₁} {m₂} {m₃} {m₄} m₁≈m₂ m₃≈m₄ λ {(m₁ , _)} {(m₂ , _)} {(m₃ , _)} {(m₄ , _)} m₁≈m₂ m₃≈m₄ →
; ⊔-assoc = λ (m₁ , _) (m₂ , _) (m₃ , _) → ⊔ᵐ-assoc m₁ m₂ m₃ ≈ᵐ-⊔ᵐ-cong {m₁} {m₂} {m₃} {m₄} m₁≈m₂ m₃≈m₄
; ⊔-comm = λ (m₁ , _) (m₂ , _) → ⊔ᵐ-comm m₁ m₂ ; ⊔-assoc = λ (m₁ , _) (m₂ , _) (m₃ , _) → ⊔ᵐ-assoc m₁ m₂ m₃
; ⊔-idemp = λ (m , _) → ⊔ᵐ-idemp m ; ⊔-comm = λ (m₁ , _) (m₂ , _) → ⊔ᵐ-comm m₁ m₂
} ; ⊔-idemp = λ (m , _) → ⊔ᵐ-idemp m
}
isIntersectSemilattice : IsSemilattice FiniteMap _≈_ _⊓_ isIntersectSemilattice : IsSemilattice FiniteMap _≈_ _⊓_
isIntersectSemilattice = record isIntersectSemilattice = record
{ ≈-equiv = ≈-equiv { ≈-equiv = ≈-equiv
; ≈-⊔-cong = ; ≈-⊔-cong =
λ {(m₁ , _)} {(m₂ , _)} {(m₃ , _)} {(m₄ , _)} m₁≈m₂ m₃≈m₄ → λ {(m₁ , _)} {(m₂ , _)} {(m₃ , _)} {(m₄ , _)} m₁≈m₂ m₃≈m₄ →
≈ᵐ-⊓ᵐ-cong {m₁} {m₂} {m₃} {m₄} m₁≈m₂ m₃≈m₄ ≈ᵐ-⊓ᵐ-cong {m₁} {m₂} {m₃} {m₄} m₁≈m₂ m₃≈m₄
; ⊔-assoc = λ (m₁ , _) (m₂ , _) (m₃ , _) → ⊓ᵐ-assoc m₁ m₂ m₃ ; ⊔-assoc = λ (m₁ , _) (m₂ , _) (m₃ , _) → ⊓ᵐ-assoc m₁ m₂ m₃
; ⊔-comm = λ (m₁ , _) (m₂ , _) → ⊓ᵐ-comm m₁ m₂ ; ⊔-comm = λ (m₁ , _) (m₂ , _) → ⊓ᵐ-comm m₁ m₂
; ⊔-idemp = λ (m , _) → ⊓ᵐ-idemp m ; ⊔-idemp = λ (m , _) → ⊓ᵐ-idemp m
} }
isLattice : IsLattice FiniteMap _≈_ _⊔_ _⊓_ isLattice : IsLattice FiniteMap _≈_ _⊔_ _⊓_
isLattice = record isLattice = record
{ joinSemilattice = isUnionSemilattice { joinSemilattice = isUnionSemilattice
; meetSemilattice = isIntersectSemilattice ; meetSemilattice = isIntersectSemilattice
; absorb-⊔-⊓ = λ (m₁ , _) (m₂ , _) → absorb-⊔ᵐ-⊓ᵐ m₁ m₂ ; absorb-⊔-⊓ = λ (m₁ , _) (m₂ , _) → absorb-⊔ᵐ-⊓ᵐ m₁ m₂
; absorb-⊓-⊔ = λ (m₁ , _) (m₂ , _) → absorb-⊓ᵐ-⊔ᵐ m₁ m₂ ; absorb-⊓-⊔ = λ (m₁ , _) (m₂ , _) → absorb-⊓ᵐ-⊔ᵐ m₁ m₂
} }
lattice : Lattice FiniteMap
lattice = record
{ _≈_ = _≈_
; _⊔_ = _⊔_
; _⊓_ = _⊓_
; isLattice = isLattice
}
open IsLattice isLattice using (_≼_; ⊔-Monotonicˡ; ⊔-Monotonicʳ) public open IsLattice isLattice using (_≼_; ⊔-Monotonicˡ; ⊔-Monotonicʳ) public
lattice : Lattice FiniteMap
lattice = record
{ _≈_ = _≈_
; _⊔_ = _⊔_
; _⊓_ = _⊓_
; isLattice = isLattice
}
m₁≼m₂⇒m₁[k]≼m₂[k] : ∀ (fm₁ fm₂ : FiniteMap) {k : A} {v₁ v₂ : B} → m₁≼m₂⇒m₁[k]≼m₂[k] : ∀ (fm₁ fm₂ : FiniteMap) {k : A} {v₁ v₂ : B} →
fm₁ ≼ fm₂ → (k , v₁) ∈ fm₁ → (k , v₂) ∈ fm₂ → v₁ ≼₂ v₂ fm₁ ≼ fm₂ → (k , v₁) ∈ fm₁ → (k , v₂) ∈ fm₂ → v₁ ≼₂ v₂
m₁≼m₂⇒m₁[k]≼m₂[k] (m₁ , _) (m₂ , _) m₁≼m₂ k,v₁∈m₁ k,v₂∈m₂ = m₁≼m₂⇒m₁[k]ᵐ≼m₂[k]ᵐ m₁ m₂ m₁≼m₂ k,v₁∈m₁ k,v₂∈m₂ m₁≼m₂⇒m₁[k]≼m₂[k] (m₁ , _) (m₂ , _) m₁≼m₂ k,v₁∈m₁ k,v₂∈m₂ = m₁≼m₂⇒m₁[k]ᵐ≼m₂[k]ᵐ m₁ m₂ m₁≼m₂ k,v₁∈m₁ k,v₂∈m₂
@ -194,7 +197,7 @@ module WithKeys (ks : List A) where
module GeneralizedUpdate module GeneralizedUpdate
{l} {L : Set l} {l} {L : Set l}
{_≈ˡ_ : L → L → Set l} {_⊔ˡ_ : L → L → L} {_⊓ˡ_ : L → L → L} {_≈ˡ_ : L → L → Set l} {_⊔ˡ_ : L → L → L} {_⊓ˡ_ : L → L → L}
(lL : IsLattice L _≈ˡ_ _⊔ˡ_ _⊓ˡ_) {{lL : IsLattice L _≈ˡ_ _⊔ˡ_ _⊓ˡ_}}
(f : L → FiniteMap) (f-Monotonic : Monotonic (IsLattice._≼_ lL) _≼_ f) (f : L → FiniteMap) (f-Monotonic : Monotonic (IsLattice._≼_ lL) _≼_ f)
(g : A → L → B) (g-Monotonicʳ : ∀ k → Monotonic (IsLattice._≼_ lL) _≼₂_ (g k)) (g : A → L → B) (g-Monotonicʳ : ∀ k → Monotonic (IsLattice._≼_ lL) _≼₂_ (g k))
(ks : List A) where (ks : List A) where
@ -208,7 +211,7 @@ module WithKeys (ks : List A) where
f' l = (f l) updating ks via (updater l) f' l = (f l) updating ks via (updater l)
f'-Monotonic : Monotonic _≼ˡ_ _≼_ f' f'-Monotonic : Monotonic _≼ˡ_ _≼_ f'
f'-Monotonic {l₁} {l₂} l₁≼l₂ = f'-Monotonicᵐ lL (proj₁ ∘ f) f-Monotonic g g-Monotonicʳ ks l₁≼l₂ f'-Monotonic {l₁} {l₂} l₁≼l₂ = f'-Monotonicᵐ (proj₁ ∘ f) f-Monotonic g g-Monotonicʳ ks l₁≼l₂
f'-∈k-forward : ∀ {k l} → k ∈k (f l) → k ∈k (f' l) f'-∈k-forward : ∀ {k l} → k ∈k (f l) → k ∈k (f' l)
f'-∈k-forward {k} {l} = updatingᵐ-via-∈k-forward (proj₁ (f l)) ks (updater l) f'-∈k-forward {k} {l} = updatingᵐ-via-∈k-forward (proj₁ (f l)) ks (updater l)
@ -253,7 +256,7 @@ module WithKeys (ks : List A) where
open WithKeys public open WithKeys public
module IterProdIsomorphism where module IterProdIsomorphism where
open import Data.Unit using (⊤; tt) open import Data.Unit using (tt)
open import Lattice.Unit using () open import Lattice.Unit using ()
renaming renaming
( _≈_ to _≈ᵘ_ ( _≈_ to _≈ᵘ_
@ -264,7 +267,7 @@ module IterProdIsomorphism where
; ≈-equiv to ≈ᵘ-equiv ; ≈-equiv to ≈ᵘ-equiv
; fixedHeight to fixedHeightᵘ ; fixedHeight to fixedHeightᵘ
) )
open import Lattice.IterProd _≈₂_ _≈ᵘ_ _⊔₂_ _⊔ᵘ_ _⊓₂_ _⊓ᵘ_ lB isLatticeᵘ open import Lattice.IterProd B ⊤ dummy
as IP as IP
using (IterProd) using (IterProd)
open IsLattice lB using () open IsLattice lB using ()
@ -299,11 +302,11 @@ module IterProdIsomorphism where
_⊆ᵐ_ fm₁ fm₂ = subset-impl (proj₁ (proj₁ fm₁)) (proj₁ (proj₁ fm₂)) _⊆ᵐ_ fm₁ fm₂ = subset-impl (proj₁ (proj₁ fm₁)) (proj₁ (proj₁ fm₂))
_≈ⁱᵖ_ : ∀ {n : ℕ} → IterProd n → IterProd n → Set _≈ⁱᵖ_ : ∀ {n : ℕ} → IterProd n → IterProd n → Set
_≈ⁱᵖ_ {n} = IP._≈_ n _≈ⁱᵖ_ {n} = IP._≈_ {n}
_⊔ⁱᵖ_ : ∀ {ks : List A} → _⊔ⁱᵖ_ : ∀ {ks : List A} →
IterProd (length ks) → IterProd (length ks) → IterProd (length ks) IterProd (length ks) → IterProd (length ks) → IterProd (length ks)
_⊔ⁱᵖ_ {ks} = IP._⊔_ (length ks) _⊔ⁱᵖ_ {ks} = IP._⊔_ {length ks}
_∈ᵐ_ : ∀ {ks : List A} → A × B → FiniteMap ks → Set _∈ᵐ_ : ∀ {ks : List A} → A × B → FiniteMap ks → Set
_∈ᵐ_ {ks} = _∈_ ks _∈ᵐ_ {ks} = _∈_ ks
@ -320,7 +323,7 @@ module IterProdIsomorphism where
from-to-inverseˡ : ∀ {ks : List A} (uks : Unique ks) → from-to-inverseˡ : ∀ {ks : List A} (uks : Unique ks) →
IsInverseˡ (_≈_ ks) (_≈ⁱᵖ_ {length ks}) IsInverseˡ (_≈_ ks) (_≈ⁱᵖ_ {length ks})
(from {ks}) (to {ks} uks) (from {ks}) (to {ks} uks)
from-to-inverseˡ {[]} _ _ = IsEquivalence.≈-refl (IP.≈-equiv 0) from-to-inverseˡ {[]} _ _ = IsEquivalence.≈-refl (IP.≈-equiv {0})
from-to-inverseˡ {k ∷ ks'} (push k≢ks' uks') (v , rest) from-to-inverseˡ {k ∷ ks'} (push k≢ks' uks') (v , rest)
with ((fm' , ufm') , refl) ← to uks' rest in p rewrite sym p = with ((fm' , ufm') , refl) ← to uks' rest in p rewrite sym p =
(IsLattice.≈-refl lB , from-to-inverseˡ {ks'} uks' rest) (IsLattice.≈-refl lB , from-to-inverseˡ {ks'} uks' rest)
@ -522,7 +525,7 @@ module IterProdIsomorphism where
fm₂⊆fm₁ : to uks ip₂ ⊆ᵐ to uks ip₁ fm₂⊆fm₁ : to uks ip₂ ⊆ᵐ to uks ip₁
fm₂⊆fm₁ = inductive-step (≈₂-sym v₁≈v₂) fm₂⊆fm₁ = inductive-step (≈₂-sym v₁≈v₂)
(IP.≈-sym (length ks') rest₁≈rest₂) (IP.≈-sym {length ks'} rest₁≈rest₂)
from-⊔-distr : ∀ {ks : List A} → (fm₁ fm₂ : FiniteMap ks) → from-⊔-distr : ∀ {ks : List A} → (fm₁ fm₂ : FiniteMap ks) →
_≈ⁱᵖ_ {length ks} (from (_⊔_ _ fm₁ fm₂)) _≈ⁱᵖ_ {length ks} (from (_⊔_ _ fm₁ fm₂))
@ -545,7 +548,7 @@ module IterProdIsomorphism where
rewrite from-rest (_⊔_ _ fm₁ fm₂) rewrite from-rest fm₁ rewrite from-rest fm₂ rewrite from-rest (_⊔_ _ fm₁ fm₂) rewrite from-rest fm₁ rewrite from-rest fm₂
= ( IsLattice.≈-refl lB = ( IsLattice.≈-refl lB
, IsEquivalence.≈-trans , IsEquivalence.≈-trans
(IP.≈-equiv (length ks)) (IP.≈-equiv {length ks})
(from-preserves-≈ {_} {pop (_⊔_ _ fm₁ fm₂)} (from-preserves-≈ {_} {pop (_⊔_ _ fm₁ fm₂)}
{_⊔_ _ (pop fm₁) (pop fm₂)} {_⊔_ _ (pop fm₁) (pop fm₂)}
(pop-⊔-distr fm₁ fm₂)) (pop-⊔-distr fm₁ fm₂))
@ -610,15 +613,15 @@ module IterProdIsomorphism where
in in
(v' , (v₁⊔v₂≈v' , there v'∈fm')) (v' , (v₁⊔v₂≈v' , there v'∈fm'))
module WithUniqueKeysAndFixedHeight {ks : List A} (uks : Unique ks) (≈₂-Decidable : IsDecidable _≈₂_) (h₂ : ℕ) (fhB : FixedHeight₂ h₂) where module WithUniqueKeysAndFixedHeight {ks : List A} (uks : Unique ks) {{≈₂-Decidable : IsDecidable _≈₂_}} {h₂ : ℕ} {{fhB : FixedHeight₂ h₂}} where
import Isomorphism import Isomorphism
open Isomorphism.TransportFiniteHeight open Isomorphism.TransportFiniteHeight
(IP.isFiniteHeightLattice (length ks) ≈₂-Decidable ≈ᵘ-Decidable h₂ 0 fhB fixedHeightᵘ) (isLattice ks) (IP.isFiniteHeightLattice {k = length ks} {{fhB = fixedHeightᵘ}}) (isLattice ks)
{f = to uks} {g = from {ks}} {f = to uks} {g = from {ks}}
(to-preserves-≈ uks) (from-preserves-≈ {ks}) (to-preserves-≈ uks) (from-preserves-≈ {ks})
(to-⊔-distr uks) (from-⊔-distr {ks}) (to-⊔-distr uks) (from-⊔-distr {ks})
(from-to-inverseʳ uks) (from-to-inverseˡ uks) (from-to-inverseʳ uks) (from-to-inverseˡ uks)
using (isFiniteHeightLattice; finiteHeightLattice) public using (isFiniteHeightLattice; finiteHeightLattice; fixedHeight) public
-- Helpful lemma: all entries of the 'bottom' map are assigned to bottom. -- Helpful lemma: all entries of the 'bottom' map are assigned to bottom.
@ -626,5 +629,5 @@ module IterProdIsomorphism where
⊥-contains-bottoms : ∀ {k : A} {v : B} → (k , v) ∈ᵐ ⊥ → v ≡ (Height.⊥ fhB) ⊥-contains-bottoms : ∀ {k : A} {v : B} → (k , v) ∈ᵐ ⊥ → v ≡ (Height.⊥ fhB)
⊥-contains-bottoms {k} {v} k,v∈⊥ ⊥-contains-bottoms {k} {v} k,v∈⊥
rewrite IP.⊥-built (length ks) ≈₂-Decidable ≈ᵘ-Decidable h₂ 0 fhB fixedHeightᵘ = rewrite IP.⊥-built {length ks} {{fhB = fixedHeightᵘ}} =
to-build uks k v k,v∈⊥ to-build uks k v k,v∈⊥

95
Lattice/IterProd.agda
View File

@ -1,14 +1,15 @@
open import Lattice open import Lattice
open import Data.Unit using (⊤)
-- Due to universe levels, it becomes relatively annoying to handle the case -- Due to universe levels, it becomes relatively annoying to handle the case
-- where the levels of A and B are not the same. For the time being, constrain -- where the levels of A and B are not the same. For the time being, constrain
-- them to be the same. -- them to be the same.
module Lattice.IterProd {a} {A B : Set a} module Lattice.IterProd {a} (A B : Set a)
(_≈₁_ : A → A → Set a) (_≈₂_ : B → B → Set a) {_≈₁_ : A → A → Set a} {_≈₂_ : B → B → Set a}
(_⊔₁_ : A → A → A) (_⊔₂_ : B → B → B) {_⊔₁_ : A → A → A} {_⊔₂_ : B → B → B}
(_⊓₁_ : A → A → A) (_⊓₂_ : B → B → B) {_⊓₁_ : A → A → A} {_⊓₂_ : B → B → B}
(lA : IsLattice A _≈₁_ _⊔₁_ _⊓₁_) (lB : IsLattice B _≈₂_ _⊔₂_ _⊓₂_) where {{lA : IsLattice A _≈₁_ _⊔₁_ _⊓₁_}} {{lB : IsLattice B _≈₂_ _⊔₂_ _⊓₂_}} (dummy : ⊤) where
open import Agda.Primitive using (lsuc) open import Agda.Primitive using (lsuc)
open import Data.Nat using (ℕ; zero; suc; _+_) open import Data.Nat using (ℕ; zero; suc; _+_)
@ -119,49 +120,55 @@ private
_⊓₁_ (Everything._⊓_ everythingRest) _⊓₁_ (Everything._⊓_ everythingRest)
lA (Everything.isLattice everythingRest) as P lA (Everything.isLattice everythingRest) as P
module _ (k : ℕ) where module _ {k : ℕ} where
open Everything (everything k) using (_≈_; _⊔_; _⊓_; isLattice) public open Everything (everything k) using (_≈_; _⊔_; _⊓_) public
open Lattice.IsLattice isLattice public open Lattice.IsLattice (Everything.isLattice (everything k)) public
lattice : Lattice (IterProd k) instance
lattice = record isLattice = Everything.isLattice (everything k)
{ _≈_ = _≈_
; _⊔_ = _⊔_
; _⊓_ = _⊓_
; isLattice = isLattice
}
module _ (≈₁-Decidable : IsDecidable _≈₁_) (≈₂-Decidable : IsDecidable _≈₂_) lattice : Lattice (IterProd k)
(h₁ h₂ : ℕ) lattice = record
(fhA : FixedHeight₁ h₁) (fhB : FixedHeight₂ h₂) where { _≈_ = _≈_
private
required : RequiredForFixedHeight
required = record
{ ≈₁-Decidable = ≈₁-Decidable
; ≈₂-Decidable = ≈₂-Decidable
; h₁ = h₁
; h₂ = h₂
; fhA = fhA
; fhB = fhB
}
fixedHeight = IsFiniteHeightWithBotAndDecEq.fixedHeight (Everything.isFiniteHeightIfSupported (everything k) required)
isFiniteHeightLattice = record
{ isLattice = isLattice
; fixedHeight = fixedHeight
}
finiteHeightLattice : FiniteHeightLattice (IterProd k)
finiteHeightLattice = record
{ height = IsFiniteHeightWithBotAndDecEq.height (Everything.isFiniteHeightIfSupported (everything k) required)
; _≈_ = _≈_
; _⊔_ = _⊔_ ; _⊔_ = _⊔_
; _⊓_ = _⊓_ ; _⊓_ = _⊓_
; isFiniteHeightLattice = isFiniteHeightLattice ; isLattice = isLattice
} }
⊥-built : Height.⊥ fixedHeight ≡ (build (Height.⊥ fhA) (Height.⊥ fhB) k) module _ {{≈₁-Decidable : IsDecidable _≈₁_}} {{≈₂-Decidable : IsDecidable _≈₂_}}
⊥-built = IsFiniteHeightWithBotAndDecEq.⊥-correct (Everything.isFiniteHeightIfSupported (everything k) required) {h₁ h₂ : ℕ}
{{fhA : FixedHeight₁ h₁}} {{fhB : FixedHeight₂ h₂}} where
private
isFiniteHeightWithBotAndDecEq =
Everything.isFiniteHeightIfSupported (everything k)
record
{ ≈₁-Decidable = ≈₁-Decidable
; ≈₂-Decidable = ≈₂-Decidable
; h₁ = h₁
; h₂ = h₂
; fhA = fhA
; fhB = fhB
}
open IsFiniteHeightWithBotAndDecEq isFiniteHeightWithBotAndDecEq using (height; ⊥-correct)
instance
fixedHeight = IsFiniteHeightWithBotAndDecEq.fixedHeight isFiniteHeightWithBotAndDecEq
isFiniteHeightLattice = record
{ isLattice = isLattice
; fixedHeight = fixedHeight
}
finiteHeightLattice : FiniteHeightLattice (IterProd k)
finiteHeightLattice = record
{ height = height
; _≈_ = _≈_
; _⊔_ = _⊔_
; _⊓_ = _⊓_
; isFiniteHeightLattice = isFiniteHeightLattice
}
⊥-built : Height.⊥ fixedHeight ≡ (build (Height.⊥ fhA) (Height.⊥ fhB) k)
⊥-built = ⊥-correct

12
Lattice/Map.agda
View File

@ -1,12 +1,14 @@
open import Lattice open import Lattice
open import Relation.Binary.PropositionalEquality as Eq using (_≡_; refl; sym; trans; cong; subst) open import Relation.Binary.PropositionalEquality as Eq using (_≡_; refl; sym; trans; cong; subst)
open import Agda.Primitive using (Level) renaming (_⊔_ to _⊔ℓ_) open import Agda.Primitive using (Level) renaming (_⊔_ to _⊔ℓ_)
open import Data.Unit using (⊤)
module Lattice.Map {a b : Level} {A : Set a} {B : Set b} module Lattice.Map {a b : Level} (A : Set a) (B : Set b)
{_≈₂_ : B → B → Set b} {_≈₂_ : B → B → Set b}
{_⊔₂_ : B → B → B} {_⊓₂_ : B → B → B} {_⊔₂_ : B → B → B} {_⊓₂_ : B → B → B}
(≡-Decidable-A : IsDecidable {a} {A} _≡_) {{≡-Decidable-A : IsDecidable {a} {A} _≡_}}
(lB : IsLattice B _≈₂_ _⊔₂_ _⊓₂_) where {{lB : IsLattice B _≈₂_ _⊔₂_ _⊓₂_}}
(dummy : ⊤) where
open import Data.List.Membership.Propositional as MemProp using () renaming (_∈_ to _∈ˡ_) open import Data.List.Membership.Propositional as MemProp using () renaming (_∈_ to _∈ˡ_)
@ -626,7 +628,7 @@ Expr-Provenance-≡ {k} {v} e k,v∈e
with (v' , (p , k,v'∈e)) ← Expr-Provenance k e (forget k,v∈e) with (v' , (p , k,v'∈e)) ← Expr-Provenance k e (forget k,v∈e)
rewrite Map-functional {m = ⟦ e ⟧} k,v∈e k,v'∈e = p rewrite Map-functional {m = ⟦ e ⟧} k,v∈e k,v'∈e = p
module _ (≈₂-Decidable : IsDecidable _≈₂_) where module _ {{≈₂-Decidable : IsDecidable _≈₂_}} where
open IsDecidable ≈₂-Decidable using () renaming (R-dec to ≈₂-dec) open IsDecidable ≈₂-Decidable using () renaming (R-dec to ≈₂-dec)
private module _ where private module _ where
data SubsetInfo (m₁ m₂ : Map) : Set (a ⊔ℓ b) where data SubsetInfo (m₁ m₂ : Map) : Set (a ⊔ℓ b) where
@ -1031,7 +1033,7 @@ updating-via-k∉ks-backward m = transform-k∉ks-backward
module _ {l} {L : Set l} module _ {l} {L : Set l}
{_≈ˡ_ : L → L → Set l} {_⊔ˡ_ : L → L → L} {_⊓ˡ_ : L → L → L} {_≈ˡ_ : L → L → Set l} {_⊔ˡ_ : L → L → L} {_⊓ˡ_ : L → L → L}
(lL : IsLattice L _≈ˡ_ _⊔ˡ_ _⊓ˡ_) where {{lL : IsLattice L _≈ˡ_ _⊔ˡ_ _⊓ˡ_}} where
open IsLattice lL using () renaming (_≼_ to _≼ˡ_) open IsLattice lL using () renaming (_≼_ to _≼ˡ_)
module _ (f : L → Map) (f-Monotonic : Monotonic _≼ˡ_ _≼_ f) module _ (f : L → Map) (f-Monotonic : Monotonic _≼ˡ_ _≼_ f)

5
Lattice/MapSet.agda
View File

@ -1,8 +1,9 @@
open import Lattice open import Lattice
open import Relation.Binary.PropositionalEquality as Eq using (_≡_; refl; sym; trans; cong; subst) open import Relation.Binary.PropositionalEquality as Eq using (_≡_; refl; sym; trans; cong; subst)
open import Agda.Primitive using (Level) renaming (_⊔_ to _⊔ℓ_) open import Agda.Primitive using (Level) renaming (_⊔_ to _⊔ℓ_)
open import Data.Unit using (⊤)
module Lattice.MapSet {a : Level} {A : Set a} (≡-Decidable-A : IsDecidable (_≡_ {a} {A})) where module Lattice.MapSet {a : Level} (A : Set a) {{≡-Decidable-A : IsDecidable (_≡_ {a} {A})}} (dummy : ⊤) where
open import Data.List using (List; map) open import Data.List using (List; map)
open import Data.Product using (_,_; proj₁) open import Data.Product using (_,_; proj₁)
@ -11,7 +12,7 @@ open import Function using (_∘_)
open import Lattice.Unit using (⊤; tt) renaming (_≈_ to _≈₂_; _⊔_ to _⊔₂_; _⊓_ to _⊓₂_; isLattice to ⊤-isLattice) open import Lattice.Unit using (⊤; tt) renaming (_≈_ to _≈₂_; _⊔_ to _⊔₂_; _⊓_ to _⊓₂_; isLattice to ⊤-isLattice)
import Lattice.Map import Lattice.Map
private module UnitMap = Lattice.Map ≡-Decidable-A ⊤-isLattice private module UnitMap = Lattice.Map A ⊤ dummy
open UnitMap open UnitMap
using (Map; Expr; ⟦_⟧) using (Map; Expr; ⟦_⟧)
renaming renaming

5
Lattice/Unit.agda
View File

@ -28,8 +28,9 @@ _≈_ = _≡_
≈-dec : Decidable _≈_ ≈-dec : Decidable _≈_
≈-dec = _≟_ ≈-dec = _≟_
≈-Decidable : IsDecidable _≈_ instance
≈-Decidable = record { R-dec = ≈-dec } ≈-Decidable : IsDecidable _≈_
≈-Decidable = record { R-dec = ≈-dec }
_⊔_ : ⊤ → ⊤ → ⊤ _⊔_ : ⊤ → ⊤ → ⊤
tt ⊔ tt = tt tt ⊔ tt = tt

3
Utils.agda
View File

@ -103,3 +103,6 @@ _∨_ P Q a = P a ⊎ Q a
_∧_ : ∀ {a p₁ p₂} {A : Set a} (P : A → Set p₁) (Q : A → Set p₂) → _∧_ : ∀ {a p₁ p₂} {A : Set a} (P : A → Set p₁) (Q : A → Set p₂) →
A → Set (p₁ ⊔ℓ p₂) A → Set (p₁ ⊔ℓ p₂)
_∧_ P Q a = P a × Q a _∧_ P Q a = P a × Q a
it : ∀ {a} {A : Set a} {{_ : A}} → A
it {{x}} = x