Add a lattice instance for products

Signed-off-by: Danila Fedorin <danila.fedorin@gmail.com>

Lattice.agda

@@ -256,7 +256,8 @@ module SemilatticeInstances where
                 }
             }
 
-private module NatInstances where
+module LatticeInstances where
+    module ForNat where
         open Nat
         open NatProps
         open Eq
@@ -298,11 +299,55 @@ private module NatInstances where
                 }
             }
 
-    -- ProdSemilattice : {a : Level} → {A B : Set a} → {{ Semilattice A }} → {{ Semilattice B }} → Semilattice (A × B)
-    -- ProdSemilattice {a} {A} {B} {{slA}} {{slB}} = record
-    --     { _≼_ = λ (a₁ ,  b₁) (a₂ , b₂) → Semilattice._≼_ slA a₁ a₂ × Semilattice._≼_ slB b₁ b₂
-    --     ; _⊔_ = λ (a₁ ,  b₁) (a₂ , b₂) → (Semilattice._⊔_ slA a₁ a₂ , Semilattice._⊔_ slB b₁ b₂)
-    --     ; isSemilattice = record
-    --         {
-    --         }
-    --     }
+    module ForProd {a} {A B : Set a} (lA : Lattice A) (lB : Lattice B) where
+        private
+            _≼₁_ = Lattice._≼_ lA
+            _≼₂_ = Lattice._≼_ lB
+
+            _⊔₁_ = Lattice._⊔_ lA
+            _⊔₂_ = Lattice._⊔_ lB
+
+            _⊓₁_ = Lattice._⊓_ lA
+            _⊓₂_ = Lattice._⊓_ lB
+
+            joinA = record { _≼_ = _≼₁_; _⊔_ = _⊔₁_; isSemilattice = Lattice.joinSemilattice lA }
+            joinB = record { _≼_ = _≼₂_; _⊔_ = _⊔₂_; isSemilattice = Lattice.joinSemilattice lB }
+
+
+            meetA = record { _≼_ = λ a b → b ≼₁ a; _⊔_ = _⊓₁_; isSemilattice = Lattice.meetSemilattice lA }
+            meetB = record { _≼_ = λ a b → b ≼₂ a; _⊔_ = _⊓₂_; isSemilattice = Lattice.meetSemilattice lB }
+
+            module ProdJoin = SemilatticeInstances.ForProd joinA joinB
+            module ProdMeet = SemilatticeInstances.ForProd meetA meetB
+
+
+            _≼_ = Semilattice._≼_ ProdJoin.ProdSemilattice
+            _⊔_ = Semilattice._⊔_ ProdJoin.ProdSemilattice
+            _⊓_ = Semilattice._⊔_ ProdMeet.ProdSemilattice
+
+        open Eq
+        open Data.Product
+
+        private
+            absorb-⊔-⊓ : (p₁ p₂ : A × B) → p₁ ⊔ (p₁ ⊓ p₂) ≡ p₁
+            absorb-⊔-⊓ (a₁ , b₁) (a₂ , b₂)
+                rewrite Lattice.absorb-⊔-⊓ lA a₁ a₂
+                rewrite Lattice.absorb-⊔-⊓ lB b₁ b₂ = refl
+
+            absorb-⊓-⊔ : (p₁ p₂ : A × B) → p₁ ⊓ (p₁ ⊔ p₂) ≡ p₁
+            absorb-⊓-⊔ (a₁ , b₁) (a₂ , b₂)
+                rewrite Lattice.absorb-⊓-⊔ lA a₁ a₂
+                rewrite Lattice.absorb-⊓-⊔ lB b₁ b₂ = refl
+
+        ProdLattice : Lattice (A × B)
+        ProdLattice = record
+            { _≼_ = _≼_
+            ; _⊔_ = _⊔_
+            ; _⊓_ = _⊓_
+            ; isLattice = record
+                { joinSemilattice = Semilattice.isSemilattice ProdJoin.ProdSemilattice
+                ; meetSemilattice = Semilattice.isSemilattice ProdMeet.ProdSemilattice
+                ; absorb-⊔-⊓ = absorb-⊔-⊓
+                ; absorb-⊓-⊔ = absorb-⊓-⊔
+                }
+            }