agda-spa/Main.agda
Danila Fedorin 1b1b80465c Use named modules to avoid having to pass redundant parameters
Signed-off-by: Danila Fedorin <danila.fedorin@gmail.com>
2024-03-09 21:46:15 -08:00

58 lines
2.8 KiB
Agda
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

module Main where
open import IO
open import Level using (0)
open import Data.Nat.Show using (show)
open import Data.List using (List; _∷_; []; foldr)
open import Data.String using (String; _++_) renaming (_≟_ to _≟ˢ_)
open import Data.Unit using (; tt) renaming (_≟_ to _≟ᵘ_)
open import Data.Product using (_,_; _×_; proj₁; proj₂)
open import Data.List.Relation.Unary.All using (_∷_; [])
open import Relation.Binary.PropositionalEquality as Eq using (_≡_; sym; subst; refl; trans)
open import Relation.Nullary using (¬_)
open import Utils using (Unique; push; empty)
xyzw : List String
xyzw = "x" "y" "z" "w" []
xyzw-Unique : Unique xyzw
xyzw-Unique = push ((λ ()) (λ ()) (λ ()) []) (push ((λ ()) (λ ()) []) (push ((λ ()) []) (push [] empty)))
open import Lattice using (IsFiniteHeightLattice; FiniteHeightLattice; Monotonic)
open import Lattice.AboveBelow _≡_ (record { ≈-refl = refl; ≈-sym = sym; ≈-trans = trans }) _≟ᵘ_ as AB using () renaming (≈-dec to ≈ᵘ-dec)
open AB.Plain using () renaming (finiteHeightLattice to finiteHeightLatticeᵘ)
showAboveBelow : AB.AboveBelow String
showAboveBelow AB. = ""
showAboveBelow AB.⊥ = ""
showAboveBelow (AB.[_] tt) = "()"
fhlᵘ = finiteHeightLatticeᵘ (Data.Unit.tt)
import Lattice.Bundles.FiniteValueMap
open Lattice.Bundles.FiniteValueMap.FromFiniteHeightLattice String AB.AboveBelow _≟ˢ_ fhlᵘ xyzw-Unique ≈ᵘ-dec using (FiniteMap; ≈-dec) renaming (finiteHeightLattice to fhlⁱᵖ)
showMap : FiniteMap String
showMap ((kvs , _) , _) = "{" ++ foldr (λ (x , y) rest x ++ "" ++ showAboveBelow y ++ ", " ++ rest) "" kvs ++ "}"
open FiniteHeightLattice fhlⁱᵖ using (_≈_; _⊔_; _⊓_; ⊔-idemp; _≼_; ≈-⊔-cong; ≈-refl; ≈-trans; ≈-sym; ⊔-assoc; ⊔-comm; ⊔-Monotonicˡ)
open import Relation.Binary.Reasoning.Base.Single _≈_ (λ {m} ≈-refl {m}) (λ {m₁} {m₂} {m₃} ≈-trans {m₁} {m₂} {m₃}) -- why am I having to eta-expand here?
smallestMap = proj₁ (proj₁ (proj₁ (FiniteHeightLattice.fixedHeight fhlⁱᵖ)))
largestMap = proj₂ (proj₁ (proj₁ (FiniteHeightLattice.fixedHeight fhlⁱᵖ)))
dumb : FiniteMap
dumb = ((("x" , AB.[_] tt) ("y" , AB.⊥) ("z" , AB.⊥) ("w" , AB.⊥) [] , xyzw-Unique) , refl)
dumbFunction : FiniteMap FiniteMap
dumbFunction = _⊔_ dumb
dumbFunction-Monotonic : Monotonic _≼_ _≼_ dumbFunction
dumbFunction-Monotonic {m₁} {m₂} m₁≼m₂ = ⊔-Monotonicˡ dumb {m₁} {m₂} m₁≼m₂
open import Fixedpoint {0} {FiniteMap} {8} {_≈_} {_⊔_} {_⊓_} ≈-dec (FiniteHeightLattice.isFiniteHeightLattice fhlⁱᵖ) dumbFunction (λ {m₁} {m₂} m₁≼m₂ dumbFunction-Monotonic {m₁} {m₂} m₁≼m₂)
main = run {0} (putStrLn (showMap aᶠ))