86 lines
2.0 KiB
Idris
86 lines
2.0 KiB
Idris
module Misc
|
|
|
|
import Control.Monad.RWS
|
|
import Control.Monad.Identity
|
|
import Control.Monad.Either
|
|
|
|
import Data.Nat
|
|
|
|
%default total
|
|
|
|
public export
|
|
Index : Type
|
|
Index = Nat
|
|
|
|
public export
|
|
Name : Type
|
|
Name = String
|
|
|
|
public export
|
|
PI : Type -> Type
|
|
PI = EitherT String (RWS () (List String) Nat)
|
|
|
|
public export
|
|
resolve : PI a -> Either String (a, List String)
|
|
resolve a = case runRWS (runEitherT a) () 0 of
|
|
(Left e, _) => Left e
|
|
(Right r, _, s) => Right (r, s)
|
|
|
|
public export
|
|
oops : String -> PI a
|
|
oops = left
|
|
|
|
public export
|
|
guardS : String -> Bool -> PI ()
|
|
guardS str True = pure ()
|
|
guardS str False = oops str
|
|
|
|
|
|
public export
|
|
fresh : PI Nat
|
|
fresh = do
|
|
i <- get
|
|
put (S i)
|
|
pure i
|
|
|
|
public export
|
|
logS : String -> PI ()
|
|
logS = tell . (:: [])
|
|
|
|
public export
|
|
lteTransp : LTE a b -> a = c -> b = d -> LTE c d
|
|
lteTransp p Refl Refl = p
|
|
|
|
public export
|
|
lteS : {n : _} -> LTE n (S n)
|
|
lteS {n = Z} = LTEZero
|
|
lteS {n = S n} = LTESucc lteS
|
|
|
|
public export
|
|
lteSplit : {m : _} -> LTE n m -> Either (n = m) (LT n m)
|
|
lteSplit {m = Z} LTEZero = Left Refl
|
|
lteSplit {m = S m} LTEZero = Right (LTESucc LTEZero)
|
|
lteSplit {m = S m} (LTESucc p) = case lteSplit p of
|
|
Left p2 => Left (cong S p2)
|
|
Right p2 => Right (LTESucc p2)
|
|
|
|
public export
|
|
minusLte : {m,n : _} -> LTE (minus n (S m)) n
|
|
minusLte {n = Z} = LTEZero
|
|
minusLte {n = S n} {m = Z} = rewrite minusZeroRight n in lteSuccRight reflexive
|
|
minusLte {n = S n} {m = S m} = lteSuccRight (minusLte {n = n} {m = m})
|
|
|
|
public export
|
|
prevEq : (i, j : Nat) -> S i = S j -> i = j
|
|
prevEq Z Z Refl = Refl
|
|
prevEq (S i) (S _) Refl = Refl
|
|
|
|
public export
|
|
natEqDecid : (n, m : Nat) -> Either (Not (n = m)) (n = m)
|
|
natEqDecid Z Z = Right Refl
|
|
natEqDecid (S _) Z = Left absurd
|
|
natEqDecid Z (S _) = Left absurd
|
|
natEqDecid (S n) (S m) = case natEqDecid n m of
|
|
Right p => Right (cong S p)
|
|
Left p => Left (p . prevEq n m)
|