From 024e3ccc071212a84bc12415eaac531ffa6b3454 Mon Sep 17 00:00:00 2001 From: Troels Henriksen Date: Fri, 3 Jan 2025 20:05:56 +0100 Subject: [PATCH] Careful with patternType. --- src/Language/Futhark/TypeChecker/Terms2.hs | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/Language/Futhark/TypeChecker/Terms2.hs b/src/Language/Futhark/TypeChecker/Terms2.hs index 77486e00e8..c24e303048 100644 --- a/src/Language/Futhark/TypeChecker/Terms2.hs +++ b/src/Language/Futhark/TypeChecker/Terms2.hs @@ -595,13 +595,13 @@ checkPat' (PatConstr n NoInfo ps loc) (Ascribed t) = do ps' <- forM ps $ \p -> do p_t <- newType (srclocOf p) Lifted "t" Observe checkPat' p $ Ascribed p_t - t' <- newTypeWithConstr loc "t" Observe n $ map (toType . patternType) ps' + t' <- newTypeWithConstr loc "t" Observe n =<< mapM (asType . patternType) ps' ctEq (Reason (locOf loc)) t' t t'' <- asStructType t' pure $ PatConstr n (Info $ toParam Observe t'') ps' loc checkPat' (PatConstr n NoInfo ps loc) NoneInferred = do ps' <- mapM (`checkPat'` NoneInferred) ps - t <- newTypeWithConstr loc "t" Observe n $ map (toType . patternType) ps' + t <- newTypeWithConstr loc "t" Observe n =<< mapM (asType . patternType) ps' t' <- asStructType t pure $ PatConstr n (Info $ toParam Observe t') ps' loc @@ -807,13 +807,13 @@ checkCases :: Type -> NE.NonEmpty (CaseBase NoInfo VName) -> TermM (NE.NonEmpty (CaseBase Info VName), Type) -checkCases mt rest_cs = - case NE.uncons rest_cs of - (c, Nothing) -> do - (c', t) <- checkCase mt c - pure (NE.singleton c', t) - (c, Just cs) -> do - (c', c_t) <- checkCase mt c +checkCases mt rest_cs = do + let (c, rest_cs') = NE.uncons rest_cs + (c', c_t) <- checkCase mt c + case rest_cs' of + Nothing -> + pure (NE.singleton c', c_t) + Just cs -> do (cs', cs_t) <- checkCases mt cs ctEq (ReasonBranches (locOf c) c_t cs_t) c_t cs_t pure (NE.cons c' cs', c_t)