agda-spa/Main.agda

56 lines
2.8 KiB
Agda
Raw Normal View History

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 (Data.Unit.tt) using () renaming (finiteHeightLattice to fhlᵘ)
showAboveBelow : AB.AboveBelow String
showAboveBelow AB. = ""
showAboveBelow AB.⊥ = ""
showAboveBelow (AB.[_] 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ᶠ))