ghc-typelits-presburger-0.2.0.2: examples/simple-arith.hs

{-# LANGUAGE DataKinds, TypeOperators, GADTs, TypeFamilies, ExplicitForAll, FlexibleContexts, EmptyCase #-}
{-# OPTIONS_GHC -fplugin GHC.TypeLits.Presburger #-}
module Main where
import Data.Type.Equality
import GHC.TypeLits       (Nat, type (<=), type (*), type (+), type (<=?), CmpNat)
import Proof.Propositional (Empty(..))
import Proof.Propositional (IsTrue(Witness))
import Data.Singletons.Prelude hiding (type (<=))
import Data.Void

type n <=! m = IsTrue (n <=? m)
infix 4 <=!

natLeqZero :: ((n <=? 0) ~ 'True) => proxy n -> n :~: 0
natLeqZero _ = Refl

-- (%:<=?) :: Sing n -> Sing m -> Sing (n <=? m)
-- n %:<=? m = case sCompare n m of
--   SLT -> STrue
--   SEQ -> STrue
--   SGT -> SFalse

-- natLeqZero :: IsTrue (n <=? 0) -> Sing n -> n :~: 0
-- natLeqZero Witness Zero = Refl


-- hoge :: ((n + 1 <=? n) ~ 'False) => ()
-- hoge = ()

-- fuga :: ((n + 1 <=? 0) ~ 'False) => ()
-- fuga = ()

-- bar :: ((2 * (n + 1)) ~ ((2 * n) + 2)) => proxy n -> ()
-- bar _ = ()

-- trans :: proxy n -> proxy m -> n <=! m -> (n + 1) <=! (m + 1)
-- trans _ _  Witness = Witness

-- eqv :: proxy n -> proxy m -> (n <=? m) :~: ((n + 1) <=? (m + 1))
-- eqv _ _ = Refl

-- leqSucc :: proxy n -> proxy m -> IsTrue ((n + 1) :<= m) -> CmpNat n m :~: 'LT
-- leqSucc _ _ Witness = Refl


-- predSucc :: forall proxy n. Empty (n <=! 0) => proxy n -> IsTrue (n + 1 <=? 2 * n)
-- predSucc _ = Witness

main :: IO ()
main = putStrLn "finished"

-- succLEqLTSucc :: Sing m -> Compare 0 (m + 1) :~: 'LT
-- succLEqLTSucc _ = Refl


-- succCompare :: Sing (n :: Nat) -> Sing m -> CmpNat n m :~: CmpNat (n + 1) (m + 1)
-- succCompare _ _ = Refl

eqToRefl :: Sing (n :: Nat) -> Sing (m :: Nat) -> CmpNat n m :~: 'EQ -> n :~: m
eqToRefl _n _m Refl = Refl