mirror of
https://github.com/idris-lang/Idris2.git
synced 2024-09-21 02:07:25 +03:00
Merge pull request #501 from ohad/undotting-subsingletons
Take into account syntactic sub-singletons when dotting in patterns
This commit is contained in:
commit
78ecd8a9f1
@ -315,11 +315,17 @@ mutual
|
||||
else pure ()
|
||||
checkPatTyValid fc defs env _ _ _ = pure ()
|
||||
|
||||
dotErased : {auto c : Ref Ctxt Defs} ->
|
||||
dotErased : {auto c : Ref Ctxt Defs} -> (argty : NF vars) ->
|
||||
Maybe Name -> Nat -> ElabMode -> RigCount -> RawImp -> Core RawImp
|
||||
dotErased mn argpos (InLHS lrig ) rig tm
|
||||
dotErased argty mn argpos (InLHS lrig ) rig tm
|
||||
= if not (isErased lrig) && isErased rig
|
||||
then
|
||||
then do
|
||||
-- if the argument type aty has a single constructor, there's no need
|
||||
-- to dot it
|
||||
mconsCount <- countConstructors argty
|
||||
if mconsCount == Just 1 || mconsCount == Just 0
|
||||
then pure tm
|
||||
else
|
||||
-- if argpos is an erased position of 'n', leave it, otherwise dot if
|
||||
-- necessary
|
||||
do defs <- get Ctxt
|
||||
@ -328,8 +334,21 @@ mutual
|
||||
if argpos `elem` safeErase gdef
|
||||
then pure tm
|
||||
else pure $ dotTerm tm
|
||||
else pure tm
|
||||
else pure tm
|
||||
where
|
||||
||| Count the constructors of a fully applied concrete datatype
|
||||
countConstructors : NF vars -> Core (Maybe Nat)
|
||||
countConstructors (NTCon _ tycName _ n args) =
|
||||
if length args == n
|
||||
then do defs <- get Ctxt
|
||||
Just gdef <- lookupCtxtExact tycName (gamma defs)
|
||||
| Nothing => pure Nothing
|
||||
let (TCon _ _ _ _ _ _ datacons _) = gdef.definition
|
||||
| _ => pure Nothing
|
||||
pure (Just (length datacons))
|
||||
else pure Nothing
|
||||
countConstructors _ = pure Nothing
|
||||
|
||||
dotTerm : RawImp -> RawImp
|
||||
dotTerm tm
|
||||
= case tm of
|
||||
@ -340,7 +359,7 @@ mutual
|
||||
IAs _ _ _ (Implicit _ _) => tm
|
||||
IAs fc p t arg => IAs fc p t (IMustUnify fc ErasedArg tm)
|
||||
_ => IMustUnify (getFC tm) ErasedArg tm
|
||||
dotErased _ _ _ _ tm = pure tm
|
||||
dotErased _ _ _ _ _ tm = pure tm
|
||||
|
||||
-- Check the rest of an application given the argument type and the
|
||||
-- raw argument. We choose elaboration order depending on whether we know
|
||||
@ -367,7 +386,7 @@ mutual
|
||||
checkRestApp rig argRig elabinfo nest env fc tm x aty sc
|
||||
(n, argpos) arg_in expargs impargs knownret expty
|
||||
= do defs <- get Ctxt
|
||||
arg <- dotErased n argpos (elabMode elabinfo) argRig arg_in
|
||||
arg <- dotErased aty n argpos (elabMode elabinfo) argRig arg_in
|
||||
kr <- if knownret
|
||||
then pure True
|
||||
else do sc' <- sc defs (toClosure defaultOpts env (Erased fc False))
|
||||
|
Loading…
Reference in New Issue
Block a user