diff --git a/lib/Quox/Syntax/Term/Split.idr b/lib/Quox/Syntax/Term/Split.idr index 091b227..621ecd8 100644 --- a/lib/Quox/Syntax/Term/Split.idr +++ b/lib/Quox/Syntax/Term/Split.idr @@ -3,84 +3,50 @@ module Quox.Syntax.Term.Split import Quox.Syntax.Term.Base import Quox.Syntax.Term.Subst -import Data.So +import Quox.No import Data.Vect %default total -public export -data IsLam : Pred $ Term {} where ItIsLam : IsLam $ Lam x body - public export %inline -isLam : Dec1 IsLam -isLam (TYPE _) = No $ \case _ impossible -isLam (Pi {}) = No $ \case _ impossible -isLam (Lam {}) = Yes ItIsLam -isLam (Eq {}) = No $ \case _ impossible -isLam (DLam {}) = No $ \case _ impossible -isLam (E _) = No $ \case _ impossible -isLam (CloT {}) = No $ \case _ impossible -isLam (DCloT {}) = No $ \case _ impossible +isLam : Term {} -> Bool +isLam (Lam {}) = True +isLam _ = False public export 0 NotLam : Pred $ Term {} -NotLam = Not . IsLam +NotLam = No . isLam -public export -data IsDLam : Pred $ Term {} where ItIsDLam : IsDLam $ DLam i body - public export %inline -isDLam : Dec1 IsDLam -isDLam (TYPE _) = No $ \case _ impossible -isDLam (Pi {}) = No $ \case _ impossible -isDLam (Eq {}) = No $ \case _ impossible -isDLam (Lam {}) = No $ \case _ impossible -isDLam (DLam {}) = Yes ItIsDLam -isDLam (E _) = No $ \case _ impossible -isDLam (CloT {}) = No $ \case _ impossible -isDLam (DCloT {}) = No $ \case _ impossible +isDLam : Term {} -> Bool +isDLam (DLam {}) = True +isDLam _ = False public export 0 NotDLam : Pred $ Term {} -NotDLam = Not . IsDLam +NotDLam = No . isDLam -public export -data IsApp : Pred $ Elim {} where ItIsApp : IsApp $ f :@ s - public export %inline -isApp : Dec1 IsApp -isApp (F _) = No $ \case _ impossible -isApp (B _) = No $ \case _ impossible -isApp (_ :@ _) = Yes ItIsApp -isApp (_ :% _) = No $ \case _ impossible -isApp (_ :# _) = No $ \case _ impossible -isApp (CloE {}) = No $ \case _ impossible -isApp (DCloE {}) = No $ \case _ impossible +isApp : Elim {} -> Bool +isApp (_ :@ _) = True +isApp _ = False public export 0 NotApp : Pred $ Elim {} -NotApp = Not . IsApp +NotApp = No . isApp -public export -data IsDApp : Pred $ Elim {} where ItIsDApp : IsDApp $ f :% d - public export %inline -isDApp : Dec1 IsDApp -isDApp (F _) = No $ \case _ impossible -isDApp (B _) = No $ \case _ impossible -isDApp (_ :@ _) = No $ \case _ impossible -isDApp (_ :% _) = Yes ItIsDApp -isDApp (_ :# _) = No $ \case _ impossible -isDApp (CloE {}) = No $ \case _ impossible -isDApp (DCloE {}) = No $ \case _ impossible +isDApp : Elim {} -> Bool +isDApp (_ :% _) = True +isDApp _ = False public export 0 NotDApp : Pred $ Elim {} -NotDApp = Not . IsDApp +NotDApp = No . isDApp infixl 9 :@@ @@ -98,9 +64,9 @@ record GetArgs q d n where export getArgs' : Elim q d n -> List (Term q d n) -> GetArgs q d n -getArgs' fun args with (isApp fun) - getArgs' (f :@ a) args | Yes _ = getArgs' f (a :: args) - getArgs' fun args | No no = GotArgs {fun, args, notApp = no} +getArgs' fun args = case nchoose $ isApp fun of + Left y => let f :@ a = fun in getArgs' f (a :: args) + Right n => GotArgs {fun, args, notApp = n} ||| splits an application into its head and arguments. if it's not an ||| application then the list is just empty @@ -124,9 +90,9 @@ record GetDArgs q d n where export getDArgs' : Elim q d n -> List (Dim d) -> GetDArgs q d n -getDArgs' fun args with (isDApp fun) - getDArgs' (f :% a) args | Yes yes = getDArgs' f (a :: args) - getDArgs' fun args | No no = GotDArgs {fun, args, notDApp = no} +getDArgs' fun args = case nchoose $ isDApp fun of + Left y => let f :% d = fun in getDArgs' f (d :: args) + Right n => GotDArgs {fun, args, notDApp = n} ||| splits a dimension application into its head and arguments. if it's not an ||| d application then the list is just empty @@ -172,11 +138,10 @@ export getLams' : forall lams, rest. Vect lams Name -> Term q d rest -> (0 eq : lams + n = rest) -> GetLams q d n -getLams' xs s eq with (isLam s) - getLams' xs (Lam x sbody) Refl | Yes _ = - let body = assert_smaller (Lam x sbody) sbody.term in - getLams' (x :: xs) body Refl - getLams' xs s eq | No no = GotLams xs s eq no +getLams' xs s Refl = case nchoose $ isLam s of + Left y => let Lam x body = s in + getLams' (x :: xs) (assert_smaller s body.term) Refl + Right n => GotLams xs s Refl n export %inline getLams : Term q d n -> GetLams q d n @@ -196,11 +161,10 @@ export getDLams' : forall lams, rest. Vect lams Name -> Term q rest n -> (0 eq : lams + d = rest) -> GetDLams q d n -getDLams' is s eq with (isDLam s) - getDLams' is (DLam i sbody) Refl | Yes _ = - let body = assert_smaller (DLam i sbody) sbody.term in - getDLams' (i :: is) body Refl - getDLams' is s eq | No no = GotDLams is s eq no +getDLams' is s Refl = case nchoose $ isDLam s of + Left y => let DLam i body = s in + getDLams' (i :: is) (assert_smaller s body.term) Refl + Right n => GotDLams is s Refl n export %inline getDLams : Term q d n -> GetDLams q d n