From 45b3403002bcddfd9a7f5e2da07a3e87592d1a59 Mon Sep 17 00:00:00 2001 From: Troels Henriksen Date: Mon, 23 Oct 2023 16:18:57 +0200 Subject: [PATCH] New formatter. --- src/Futhark/CLI/REPL.hs | 3 +- .../CodeGen/Backends/GenericPython/AST.hs | 26 ++++---- src/Futhark/CodeGen/ImpCode.hs | 34 +++++++--- src/Futhark/CodeGen/ImpCode/GPU.hs | 63 ++++++++++--------- src/Futhark/CodeGen/ImpGen/GPU/SegHist.hs | 21 ++++--- src/Futhark/CodeGen/ImpGen/GPU/SegRed.hs | 10 +-- src/Futhark/IR/GPU/Op.hs | 14 +++-- src/Futhark/IR/Pretty.hs | 46 +++++++------- src/Futhark/IR/SOACS/SOAC.hs | 60 +++++++++--------- src/Futhark/IR/SegOp.hs | 52 +++++++-------- src/Futhark/IR/Syntax.hs | 6 +- src/Futhark/IR/Syntax/Core.hs | 4 +- src/Futhark/Internalise/Exps.hs | 9 ++- .../ArrayShortCircuiting/DataStructs.hs | 37 +++++------ src/Futhark/Optimise/BlkRegTiling.hs | 44 ++++++++----- src/Futhark/Test.hs | 10 +-- src/Language/Futhark/Interpreter.hs | 9 +-- src/Language/Futhark/Pretty.hs | 49 ++++++++------- src/Language/Futhark/Semantic.hs | 12 ++-- src/Language/Futhark/TypeChecker.hs | 4 +- .../Futhark/TypeChecker/Consumption.hs | 24 ++++--- src/Language/Futhark/TypeChecker/Modules.hs | 21 ++++--- src/Language/Futhark/TypeChecker/Monad.hs | 2 +- src/Language/Futhark/TypeChecker/Terms.hs | 51 +++++++-------- .../Futhark/TypeChecker/Terms/Monad.hs | 22 ++++--- src/Language/Futhark/TypeChecker/Terms/Pat.hs | 12 ++-- src/Language/Futhark/TypeChecker/Types.hs | 15 +++-- src/Language/Futhark/TypeChecker/Unify.hs | 45 +++++++------ 28 files changed, 396 insertions(+), 309 deletions(-) diff --git a/src/Futhark/CLI/REPL.hs b/src/Futhark/CLI/REPL.hs index 0bdb038c7c..cbd36b182b 100644 --- a/src/Futhark/CLI/REPL.hs +++ b/src/Futhark/CLI/REPL.hs @@ -411,7 +411,8 @@ typeCommand = genTypeCommand parseExp T.checkExp $ \(ps, e) -> then annotate italicized $ "\n\nPolymorphic in" - <+> mconcat (intersperse " " $ map pretty ps) <> "." + <+> mconcat (intersperse " " $ map pretty ps) + <> "." else mempty mtypeCommand :: Command diff --git a/src/Futhark/CodeGen/Backends/GenericPython/AST.hs b/src/Futhark/CodeGen/Backends/GenericPython/AST.hs index e13b2cec05..460898a8ee 100644 --- a/src/Futhark/CodeGen/Backends/GenericPython/AST.hs +++ b/src/Futhark/CodeGen/Backends/GenericPython/AST.hs @@ -127,26 +127,26 @@ instance Pretty PyStmt where "if" <+> pretty cond <> ":" - indent 2 "pass" + indent 2 "pass" pretty (If cond [] fbranch) = "if" <+> pretty cond <> ":" - indent 2 "pass" - "else:" - indent 2 (stack $ map pretty fbranch) + indent 2 "pass" + "else:" + indent 2 (stack $ map pretty fbranch) pretty (If cond tbranch []) = "if" <+> pretty cond <> ":" - indent 2 (stack $ map pretty tbranch) + indent 2 (stack $ map pretty tbranch) pretty (If cond tbranch fbranch) = "if" <+> pretty cond <> ":" - indent 2 (stack $ map pretty tbranch) - "else:" - indent 2 (stack $ map pretty fbranch) + indent 2 (stack $ map pretty tbranch) + "else:" + indent 2 (stack $ map pretty fbranch) pretty (Try pystms pyexcepts) = "try:" indent 2 (stack $ map pretty pystms) @@ -155,19 +155,19 @@ instance Pretty PyStmt where "while" <+> pretty cond <> ":" - indent 2 (stack $ map pretty body) + indent 2 (stack $ map pretty body) pretty (For i what body) = "for" <+> pretty i <+> "in" <+> pretty what <> ":" - indent 2 (stack $ map pretty body) + indent 2 (stack $ map pretty body) pretty (With what body) = "with" <+> pretty what <> ":" - indent 2 (stack $ map pretty body) + indent 2 (stack $ map pretty body) pretty (Assign e1 e2) = pretty e1 <+> "=" <+> pretty e2 pretty (AssignOp op e1 e2) = pretty e1 <+> pretty (op ++ "=") <+> pretty e2 pretty (Comment s body) = "#" <> pretty s stack (map pretty body) @@ -190,14 +190,14 @@ instance Pretty PyFunDef where <+> pretty fname <> parens (commasep $ map pretty params) <> ":" - indent 2 (stack (map pretty body)) + indent 2 (stack (map pretty body)) instance Pretty PyClassDef where pretty (Class cname body) = "class" <+> pretty cname <> ":" - indent 2 (stack (map pretty body)) + indent 2 (stack (map pretty body)) instance Pretty PyExcept where pretty (Catch pyexp stms) = diff --git a/src/Futhark/CodeGen/ImpCode.hs b/src/Futhark/CodeGen/ImpCode.hs index c3a28bfe0e..ea962fc1af 100644 --- a/src/Futhark/CodeGen/ImpCode.hs +++ b/src/Futhark/CodeGen/ImpCode.hs @@ -574,9 +574,15 @@ instance (Pretty op) => Pretty (Code op) where pretty (Free name space) = "free" <> parens (pretty name) <> pretty space pretty (Write name i bt space vol val) = - pretty name <> langle <> vol' <> pretty bt <> pretty space <> rangle <> brackets (pretty i) - <+> "<-" - <+> pretty val + pretty name + <> langle + <> vol' + <> pretty bt + <> pretty space + <> rangle + <> brackets (pretty i) + <+> "<-" + <+> pretty val where vol' = case vol of Volatile -> "volatile " @@ -584,7 +590,13 @@ instance (Pretty op) => Pretty (Code op) where pretty (Read name v is bt space vol) = pretty name <+> "<-" - <+> pretty v <> langle <> vol' <> pretty bt <> pretty space <> rangle <> brackets (pretty is) + <+> pretty v + <> langle + <> vol' + <> pretty bt + <> pretty space + <> rangle + <> brackets (pretty is) where vol' = case vol of Volatile -> "volatile " @@ -602,14 +614,17 @@ instance (Pretty op) => Pretty (Code op) where <> (parens . align) ( foldMap (brackets . pretty) shape <> "," - p dst dstspace dstoffset dststrides + p dst dstspace dstoffset dststrides <> "," - p src srcspace srcoffset srcstrides + p src srcspace srcoffset srcstrides ) where p mem space offset strides = - pretty mem <> pretty space <> "+" <> pretty offset - <+> foldMap (brackets . pretty) strides + pretty mem + <> pretty space + <> "+" + <> pretty offset + <+> foldMap (brackets . pretty) strides pretty (If cond tbranch fbranch) = "if" <+> pretty cond @@ -626,7 +641,8 @@ instance (Pretty op) => Pretty (Code op) where "call" <+> commasep (map pretty dests) <+> "<-" - <+> pretty fname <> parens (commasep $ map pretty args) + <+> pretty fname + <> parens (commasep $ map pretty args) pretty (Comment s code) = "--" <+> pretty s pretty code pretty (DebugPrint desc (Just e)) = diff --git a/src/Futhark/CodeGen/ImpCode/GPU.hs b/src/Futhark/CodeGen/ImpCode/GPU.hs index 0fd66556d0..b3ba2fcef1 100644 --- a/src/Futhark/CodeGen/ImpCode/GPU.hs +++ b/src/Futhark/CodeGen/ImpCode/GPU.hs @@ -105,15 +105,17 @@ instance Pretty HostOp where pretty (GetSize dest key size_class) = pretty dest <+> "<-" - <+> "get_size" <> parens (commasep [pretty key, pretty size_class]) + <+> "get_size" + <> parens (commasep [pretty key, pretty size_class]) pretty (GetSizeMax dest size_class) = pretty dest <+> "<-" <+> "get_size_max" <> parens (pretty size_class) pretty (CmpSizeLe dest name size_class x) = pretty dest <+> "<-" - <+> "get_size" <> parens (commasep [pretty name, pretty size_class]) - <+> "<" - <+> pretty x + <+> "get_size" + <> parens (commasep [pretty name, pretty size_class]) + <+> "<" + <+> pretty x pretty (CallKernel c) = pretty c @@ -211,15 +213,18 @@ instance Pretty KernelOp where pretty (GetGroupId dest i) = pretty dest <+> "<-" - <+> "get_group_id" <> parens (pretty i) + <+> "get_group_id" + <> parens (pretty i) pretty (GetLocalId dest i) = pretty dest <+> "<-" - <+> "get_local_id" <> parens (pretty i) + <+> "get_local_id" + <> parens (pretty i) pretty (GetLocalSize dest i) = pretty dest <+> "<-" - <+> "get_local_size" <> parens (pretty i) + <+> "get_local_size" + <> parens (pretty i) pretty (GetLockstepWidth dest) = pretty dest <+> "<-" @@ -242,68 +247,68 @@ instance Pretty KernelOp where pretty old <+> "<-" <+> "atomic_add_" - <> pretty t - <> parens (commasep [pretty arr <> brackets (pretty ind), pretty x]) + <> pretty t + <> parens (commasep [pretty arr <> brackets (pretty ind), pretty x]) pretty (Atomic _ (AtomicFAdd t old arr ind x)) = pretty old <+> "<-" <+> "atomic_fadd_" - <> pretty t - <> parens (commasep [pretty arr <> brackets (pretty ind), pretty x]) + <> pretty t + <> parens (commasep [pretty arr <> brackets (pretty ind), pretty x]) pretty (Atomic _ (AtomicSMax t old arr ind x)) = pretty old <+> "<-" <+> "atomic_smax" - <> pretty t - <> parens (commasep [pretty arr <> brackets (pretty ind), pretty x]) + <> pretty t + <> parens (commasep [pretty arr <> brackets (pretty ind), pretty x]) pretty (Atomic _ (AtomicSMin t old arr ind x)) = pretty old <+> "<-" <+> "atomic_smin" - <> pretty t - <> parens (commasep [pretty arr <> brackets (pretty ind), pretty x]) + <> pretty t + <> parens (commasep [pretty arr <> brackets (pretty ind), pretty x]) pretty (Atomic _ (AtomicUMax t old arr ind x)) = pretty old <+> "<-" <+> "atomic_umax" - <> pretty t - <> parens (commasep [pretty arr <> brackets (pretty ind), pretty x]) + <> pretty t + <> parens (commasep [pretty arr <> brackets (pretty ind), pretty x]) pretty (Atomic _ (AtomicUMin t old arr ind x)) = pretty old <+> "<-" <+> "atomic_umin" - <> pretty t - <> parens (commasep [pretty arr <> brackets (pretty ind), pretty x]) + <> pretty t + <> parens (commasep [pretty arr <> brackets (pretty ind), pretty x]) pretty (Atomic _ (AtomicAnd t old arr ind x)) = pretty old <+> "<-" <+> "atomic_and" - <> pretty t - <> parens (commasep [pretty arr <> brackets (pretty ind), pretty x]) + <> pretty t + <> parens (commasep [pretty arr <> brackets (pretty ind), pretty x]) pretty (Atomic _ (AtomicOr t old arr ind x)) = pretty old <+> "<-" <+> "atomic_or" - <> pretty t - <> parens (commasep [pretty arr <> brackets (pretty ind), pretty x]) + <> pretty t + <> parens (commasep [pretty arr <> brackets (pretty ind), pretty x]) pretty (Atomic _ (AtomicXor t old arr ind x)) = pretty old <+> "<-" <+> "atomic_xor" - <> pretty t - <> parens (commasep [pretty arr <> brackets (pretty ind), pretty x]) + <> pretty t + <> parens (commasep [pretty arr <> brackets (pretty ind), pretty x]) pretty (Atomic _ (AtomicCmpXchg t old arr ind x y)) = pretty old <+> "<-" <+> "atomic_cmp_xchg" - <> pretty t - <> parens (commasep [pretty arr <> brackets (pretty ind), pretty x, pretty y]) + <> pretty t + <> parens (commasep [pretty arr <> brackets (pretty ind), pretty x, pretty y]) pretty (Atomic _ (AtomicXchg t old arr ind x)) = pretty old <+> "<-" <+> "atomic_xchg" - <> pretty t - <> parens (commasep [pretty arr <> brackets (pretty ind), pretty x]) + <> pretty t + <> parens (commasep [pretty arr <> brackets (pretty ind), pretty x]) instance FreeIn KernelOp where freeIn' (Atomic _ op) = freeIn' op diff --git a/src/Futhark/CodeGen/ImpGen/GPU/SegHist.hs b/src/Futhark/CodeGen/ImpGen/GPU/SegHist.hs index 8de9b2e2cb..3bfb5e8d1a 100644 --- a/src/Futhark/CodeGen/ImpGen/GPU/SegHist.hs +++ b/src/Futhark/CodeGen/ImpGen/GPU/SegHist.hs @@ -460,8 +460,10 @@ histKernelGlobalPass map_pes num_groups group_size space slugs kbody histograms dest_shape' = map pe64 $ shapeDims dest_shape flat_bucket = flattenIndex dest_shape' bucket' bucket_in_bounds = - chk_beg .<=. flat_bucket - .&&. flat_bucket .<. (chk_beg + hist_H_chk) + chk_beg + .<=. flat_bucket + .&&. flat_bucket + .<. (chk_beg + hist_H_chk) .&&. inBounds (Slice (map DimFix bucket')) dest_shape' vs_params = takeLast (length vs') $ lambdaParams lam @@ -760,8 +762,10 @@ histKernelLocalPass flat_bucket = flattenIndex dest_shape' bucket' bucket_in_bounds = inBounds (Slice (map DimFix bucket')) dest_shape' - .&&. chk_beg .<=. flat_bucket - .&&. flat_bucket .<. (chk_beg + tvExp hist_H_chk) + .&&. chk_beg + .<=. flat_bucket + .&&. flat_bucket + .<. (chk_beg + tvExp hist_H_chk) bucket_is = [sExt64 thread_local_subhisto_i, flat_bucket - chk_beg] vs_params = takeLast (length vs') $ lambdaParams lam @@ -1025,11 +1029,14 @@ localMemoryCase map_pes hist_T space hist_H hist_el_size hist_N _ slugs kbody = -- asymptotically efficient. This mostly matters for the segmented -- case. let pick_local = - hist_Nin .>=. hist_H + hist_Nin + .>=. hist_H .&&. (local_mem_needed .<=. tvExp hist_L) .&&. (hist_S .<=. max_S) - .&&. hist_C .<=. hist_B - .&&. tvExp hist_M .>. 0 + .&&. hist_C + .<=. hist_B + .&&. tvExp hist_M + .>. 0 run = do emit $ Imp.DebugPrint "## Using local memory" Nothing diff --git a/src/Futhark/CodeGen/ImpGen/GPU/SegRed.hs b/src/Futhark/CodeGen/ImpGen/GPU/SegRed.hs index 3c157d05e4..4e13244889 100644 --- a/src/Futhark/CodeGen/ImpGen/GPU/SegRed.hs +++ b/src/Futhark/CodeGen/ImpGen/GPU/SegRed.hs @@ -319,8 +319,8 @@ smallSegmentsReduction (Pat segred_pes) num_groups group_size space reds body = .>. 0 .&&. isActive (init $ zip gtids dims) .&&. ltid - .<. segment_size - * segments_per_group + .<. segment_size + * segments_per_group ) in_bounds out_of_bounds @@ -345,8 +345,8 @@ smallSegmentsReduction (Pat segred_pes) num_groups group_size space reds body = ( sExt64 group_id' * segments_per_group + sExt64 ltid - .<. num_segments - .&&. ltid + .<. num_segments + .&&. ltid .<. segments_per_group ) $ forM_ (zip segred_pes (concat reds_arrs)) @@ -603,7 +603,7 @@ computeThreadChunkSize Noncommutative _ thread_index elements_per_thread num_ele is_last_thread = Imp.unCount num_elements .<. (thread_index + 1) - * Imp.unCount elements_per_thread + * Imp.unCount elements_per_thread reductionStageZero :: KernelConstants -> diff --git a/src/Futhark/IR/GPU/Op.hs b/src/Futhark/IR/GPU/Op.hs index 60d70dc327..8a5274ba25 100644 --- a/src/Futhark/IR/GPU/Op.hs +++ b/src/Futhark/IR/GPU/Op.hs @@ -110,8 +110,11 @@ instance PP.Pretty SegVirt where instance PP.Pretty KernelGrid where pretty (KernelGrid num_groups group_size) = - "groups=" <> pretty num_groups <> PP.semi - <+> "groupsize=" <> pretty group_size + "groups=" + <> pretty num_groups + <> PP.semi + <+> "groupsize=" + <> pretty group_size instance PP.Pretty SegLevel where pretty (SegThread virt grid) = @@ -219,9 +222,10 @@ instance PP.Pretty SizeOp where pretty (GetSizeMax size_class) = "get_size_max" <> parens (commasep [pretty size_class]) pretty (CmpSizeLe name size_class x) = - "cmp_size" <> parens (commasep [pretty name, pretty size_class]) - <+> "<=" - <+> pretty x + "cmp_size" + <> parens (commasep [pretty name, pretty size_class]) + <+> "<=" + <+> pretty x pretty (CalcNumGroups w max_num_groups group_size) = "calc_num_groups" <> parens (commasep [pretty w, pretty max_num_groups, pretty group_size]) diff --git a/src/Futhark/IR/Pretty.hs b/src/Futhark/IR/Pretty.hs index 164e618d40..77e3443c7e 100644 --- a/src/Futhark/IR/Pretty.hs +++ b/src/Futhark/IR/Pretty.hs @@ -196,7 +196,8 @@ instance Pretty BasicOp where Array {} -> brackets $ commastack $ map pretty es _ -> brackets $ commasep $ map pretty es <+> colon - <+> "[]" <> pretty rt + <+> "[]" + <> pretty rt pretty (BinOp bop x y) = pretty bop <> parens (pretty x <> comma <+> pretty y) pretty (CmpOp op x y) = pretty op <> parens (pretty x <> comma <+> pretty y) pretty (ConvOp conv x) = @@ -270,13 +271,13 @@ instance (PrettyRep rep) => Pretty (Exp rep) where pretty (Match [c] [Case [Just (BoolValue True)] t] f (MatchDec ret ifsort)) = "if" <> info' - <+> pretty c - "then" - <+> maybeNest t - <+> "else" - <+> maybeNest f - colon - <+> ppTupleLines' (map pretty ret) + <+> pretty c + "then" + <+> maybeNest t + <+> "else" + <+> maybeNest f + colon + <+> ppTupleLines' (map pretty ret) where info' = case ifsort of MatchNormal -> mempty @@ -300,8 +301,8 @@ instance (PrettyRep rep) => Pretty (Exp rep) where applykw <+> pretty (nameToString fname) <> apply (map (align . prettyArg) args) - colon - <+> braces (commasep $ map prettyRet ret) + colon + <+> braces (commasep $ map prettyRet ret) where prettyArg (arg, Consume) = "*" <> pretty arg prettyArg (arg, _) = pretty arg @@ -318,9 +319,11 @@ instance (PrettyRep rep) => Pretty (Exp rep) where ForLoop i it bound -> "for" <+> align - ( pretty i <> ":" <> pretty it - <+> "<" - <+> align (pretty bound) + ( pretty i + <> ":" + <> pretty it + <+> "<" + <+> align (pretty bound) ) WhileLoop cond -> "while" <+> pretty cond @@ -335,12 +338,13 @@ instance (PrettyRep rep) => Pretty (Exp rep) where where ppInput (shape, arrs, op) = parens - ( pretty shape <> comma - <+> ppTuple' (map pretty arrs) - <> case op of - Nothing -> mempty - Just (op', nes) -> - comma parens (pretty op' <> comma ppTuple' (map pretty nes)) + ( pretty shape + <> comma + <+> ppTuple' (map pretty arrs) + <> case op of + Nothing -> mempty + Just (op', nes) -> + comma parens (pretty op' <> comma ppTuple' (map pretty nes)) ) instance (PrettyRep rep) => Pretty (Lambda rep) where @@ -388,9 +392,9 @@ instance (PrettyRep rep) => Pretty (FunDef rep) where <> pretty p_name <> "\"" <> comma - ppTupleLines' (map pretty p_entry) + ppTupleLines' (map pretty p_entry) <> comma - ppTupleLines' (map pretty ret_entry) + ppTupleLines' (map pretty ret_entry) ) instance Pretty OpaqueType where diff --git a/src/Futhark/IR/SOACS/SOAC.hs b/src/Futhark/IR/SOACS/SOAC.hs index 488694381c..c0bbbb744b 100644 --- a/src/Futhark/IR/SOACS/SOAC.hs +++ b/src/Futhark/IR/SOACS/SOAC.hs @@ -937,9 +937,9 @@ instance (PrettyRep rep) => PP.Pretty (SOAC rep) where ( PP.align $ pretty lam <> comma - PP.braces (commasep $ map pretty args) + PP.braces (commasep $ map pretty args) <> comma - PP.braces (commasep $ map pretty vec) + PP.braces (commasep $ map pretty vec) ) pretty (JVP lam args vec) = "jvp" @@ -947,9 +947,9 @@ instance (PrettyRep rep) => PP.Pretty (SOAC rep) where ( PP.align $ pretty lam <> comma - PP.braces (commasep $ map pretty args) + PP.braces (commasep $ map pretty args) <> comma - PP.braces (commasep $ map pretty vec) + PP.braces (commasep $ map pretty vec) ) pretty (Stream size arrs acc lam) = ppStream size arrs acc lam @@ -964,31 +964,31 @@ instance (PrettyRep rep) => PP.Pretty (SOAC rep) where <> (parens . align) ( pretty w <> comma - ppTuple' (map pretty arrs) + ppTuple' (map pretty arrs) <> comma - pretty map_lam + pretty map_lam ) | null scans = "redomap" <> (parens . align) ( pretty w <> comma - ppTuple' (map pretty arrs) + ppTuple' (map pretty arrs) <> comma - PP.braces (mconcat $ intersperse (comma <> PP.line) $ map pretty reds) + PP.braces (mconcat $ intersperse (comma <> PP.line) $ map pretty reds) <> comma - pretty map_lam + pretty map_lam ) | null reds = "scanomap" <> (parens . align) ( pretty w <> comma - ppTuple' (map pretty arrs) + ppTuple' (map pretty arrs) <> comma - PP.braces (mconcat $ intersperse (comma <> PP.line) $ map pretty scans) + PP.braces (mconcat $ intersperse (comma <> PP.line) $ map pretty scans) <> comma - pretty map_lam + pretty map_lam ) pretty (Screma w arrs form) = ppScrema w arrs form @@ -1000,13 +1000,13 @@ ppScrema w arrs (ScremaForm scans reds map_lam) = <> (parens . align) ( pretty w <> comma - ppTuple' (map pretty arrs) + ppTuple' (map pretty arrs) <> comma - PP.braces (mconcat $ intersperse (comma <> PP.line) $ map pretty scans) + PP.braces (mconcat $ intersperse (comma <> PP.line) $ map pretty scans) <> comma - PP.braces (mconcat $ intersperse (comma <> PP.line) $ map pretty reds) + PP.braces (mconcat $ intersperse (comma <> PP.line) $ map pretty reds) <> comma - pretty map_lam + pretty map_lam ) -- | Prettyprint the given Stream. @@ -1017,11 +1017,11 @@ ppStream size arrs acc lam = <> (parens . align) ( pretty size <> comma - ppTuple' (map pretty arrs) + ppTuple' (map pretty arrs) <> comma - ppTuple' (map pretty acc) + ppTuple' (map pretty acc) <> comma - pretty lam + pretty lam ) -- | Prettyprint the given Scatter. @@ -1032,11 +1032,11 @@ ppScatter w arrs lam dests = <> (parens . align) ( pretty w <> comma - ppTuple' (map pretty arrs) + ppTuple' (map pretty arrs) <> comma - pretty lam + pretty lam <> comma - commasep (map pretty dests) + commasep (map pretty dests) ) instance (PrettyRep rep) => Pretty (Scan rep) where @@ -1052,7 +1052,7 @@ instance (PrettyRep rep) => Pretty (Reduce rep) where ppComm comm <> pretty red_lam <> comma - PP.braces (commasep $ map pretty red_nes) + PP.braces (commasep $ map pretty red_nes) -- | Prettyprint the given histogram operation. ppHist :: @@ -1067,20 +1067,20 @@ ppHist w arrs ops bucket_fun = <> parens ( pretty w <> comma - ppTuple' (map pretty arrs) + ppTuple' (map pretty arrs) <> comma - PP.braces (mconcat $ intersperse (comma <> PP.line) $ map ppOp ops) + PP.braces (mconcat $ intersperse (comma <> PP.line) $ map ppOp ops) <> comma - pretty bucket_fun + pretty bucket_fun ) where ppOp (HistOp dest_w rf dests nes op) = pretty dest_w <> comma - <+> pretty rf + <+> pretty rf <> comma - <+> PP.braces (commasep $ map pretty dests) + <+> PP.braces (commasep $ map pretty dests) <> comma - ppTuple' (map pretty nes) + ppTuple' (map pretty nes) <> comma - pretty op + pretty op diff --git a/src/Futhark/IR/SegOp.hs b/src/Futhark/IR/SegOp.hs index 30f6a0d397..c54be04260 100644 --- a/src/Futhark/IR/SegOp.hs +++ b/src/Futhark/IR/SegOp.hs @@ -874,9 +874,9 @@ instance (PrettyRep rep) => Pretty (SegBinOp rep) where pretty (SegBinOp comm lam nes shape) = PP.braces (PP.commasep $ map pretty nes) <> PP.comma - pretty shape + pretty shape <> PP.comma - comm' + comm' <> pretty lam where comm' = case comm of @@ -887,47 +887,47 @@ instance (PrettyRep rep, PP.Pretty lvl) => PP.Pretty (SegOp lvl rep) where pretty (SegMap lvl space ts body) = "segmap" <> pretty lvl - PP.align (pretty space) - <+> PP.colon - <+> ppTuple' (map pretty ts) - <+> PP.nestedBlock "{" "}" (pretty body) + PP.align (pretty space) + <+> PP.colon + <+> ppTuple' (map pretty ts) + <+> PP.nestedBlock "{" "}" (pretty body) pretty (SegRed lvl space reds ts body) = "segred" <> pretty lvl - PP.align (pretty space) - PP.parens (mconcat $ intersperse (PP.comma <> PP.line) $ map pretty reds) - PP.colon - <+> ppTuple' (map pretty ts) - <+> PP.nestedBlock "{" "}" (pretty body) + PP.align (pretty space) + PP.parens (mconcat $ intersperse (PP.comma <> PP.line) $ map pretty reds) + PP.colon + <+> ppTuple' (map pretty ts) + <+> PP.nestedBlock "{" "}" (pretty body) pretty (SegScan lvl space scans ts body) = "segscan" <> pretty lvl - PP.align (pretty space) - PP.parens (mconcat $ intersperse (PP.comma <> PP.line) $ map pretty scans) - PP.colon - <+> ppTuple' (map pretty ts) - <+> PP.nestedBlock "{" "}" (pretty body) + PP.align (pretty space) + PP.parens (mconcat $ intersperse (PP.comma <> PP.line) $ map pretty scans) + PP.colon + <+> ppTuple' (map pretty ts) + <+> PP.nestedBlock "{" "}" (pretty body) pretty (SegHist lvl space ops ts body) = "seghist" <> pretty lvl - PP.align (pretty space) - PP.parens (mconcat $ intersperse (PP.comma <> PP.line) $ map ppOp ops) - PP.colon - <+> ppTuple' (map pretty ts) - <+> PP.nestedBlock "{" "}" (pretty body) + PP.align (pretty space) + PP.parens (mconcat $ intersperse (PP.comma <> PP.line) $ map ppOp ops) + PP.colon + <+> ppTuple' (map pretty ts) + <+> PP.nestedBlock "{" "}" (pretty body) where ppOp (HistOp w rf dests nes shape op) = pretty w <> PP.comma - <+> pretty rf + <+> pretty rf <> PP.comma - PP.braces (PP.commasep $ map pretty dests) + PP.braces (PP.commasep $ map pretty dests) <> PP.comma - PP.braces (PP.commasep $ map pretty nes) + PP.braces (PP.commasep $ map pretty nes) <> PP.comma - pretty shape + pretty shape <> PP.comma - pretty op + pretty op instance CanBeAliased (SegOp lvl) where addOpAliases aliases = runIdentity . mapSegOpM alias diff --git a/src/Futhark/IR/Syntax.hs b/src/Futhark/IR/Syntax.hs index ece75159b0..df601318ea 100644 --- a/src/Futhark/IR/Syntax.hs +++ b/src/Futhark/IR/Syntax.hs @@ -455,12 +455,12 @@ deriving instance (RepTypes rep) => Ord (Exp rep) -- | For-loop or while-loop? data LoopForm = ForLoop + -- | The loop iterator var VName - -- ^ The loop iterator var + -- | The type of the loop iterator var IntType - -- ^ The type of the loop iterator var + -- | The number of iterations. SubExp - -- ^ The number of iterations. | WhileLoop VName deriving (Eq, Ord, Show) diff --git a/src/Futhark/IR/Syntax/Core.hs b/src/Futhark/IR/Syntax/Core.hs index f5080fa575..f120801338 100644 --- a/src/Futhark/IR/Syntax/Core.hs +++ b/src/Futhark/IR/Syntax/Core.hs @@ -425,10 +425,10 @@ sliceSlice (Slice jslice) (Slice islice) = Slice $ sliceSlice' jslice islice -- | A dimension in a 'FlatSlice'. data FlatDimIndex d = FlatDimIndex + -- | Number of elements in dimension d - -- ^ Number of elements in dimension + -- | Stride of dimension d - -- ^ Stride of dimension deriving (Eq, Ord, Show) instance Traversable FlatDimIndex where diff --git a/src/Futhark/Internalise/Exps.hs b/src/Futhark/Internalise/Exps.hs index 37470a8e74..912f9f7865 100644 --- a/src/Futhark/Internalise/Exps.hs +++ b/src/Futhark/Internalise/Exps.hs @@ -1699,9 +1699,12 @@ isIntrinsicFunction qname args loc = do old_dim <- I.arraysSize 0 <$> mapM lookupType arrs dim_ok <- letSubExp "dim_ok" <=< toExp $ - pe64 old_dim .==. pe64 n' * pe64 m' - .&&. pe64 n' .>=. 0 - .&&. pe64 m' .>=. 0 + pe64 old_dim .==. pe64 n' + * pe64 m' + .&&. pe64 n' + .>=. 0 + .&&. pe64 m' + .>=. 0 dim_ok_cert <- assert "dim_ok_cert" diff --git a/src/Futhark/Optimise/ArrayShortCircuiting/DataStructs.hs b/src/Futhark/Optimise/ArrayShortCircuiting/DataStructs.hs index d3e9c2ed76..c6260f451c 100644 --- a/src/Futhark/Optimise/ArrayShortCircuiting/DataStructs.hs +++ b/src/Futhark/Optimise/ArrayShortCircuiting/DataStructs.hs @@ -119,14 +119,14 @@ type FreeVarSubsts = M.Map VName (TPrimExp Int64 VName) -- | Coalesced Access Entry data Coalesced = Coalesced + -- | the kind of coalescing CoalescedKind - -- ^ the kind of coalescing - ArrayMemBound - -- ^ destination mem_block info @f_m_x[i]@ (must be ArrayMem) + -- | destination mem_block info @f_m_x[i]@ (must be ArrayMem) -- (Maybe IxFun) -- the inverse ixfun of a coalesced array, such that -- -- ixfuns can be correctly constructed for aliases; + ArrayMemBound + -- | substitutions for free vars in index function FreeVarSubsts - -- ^ substitutions for free vars in index function data CoalsEntry = CoalsEntry { -- | destination memory block @@ -222,26 +222,27 @@ instance Pretty ArrayMemBound where instance Pretty Coalesced where pretty (Coalesced knd mbd _) = "(Kind:" - <+> pretty knd <> ", membds:" - <+> pretty mbd -- <> ", subs:" <+> pretty subs - <> ")" - <+> "\n" + <+> pretty knd + <> ", membds:" + <+> pretty mbd -- <> ", subs:" <+> pretty subs + <> ")" + <+> "\n" instance Pretty CoalsEntry where pretty etry = "{" <+> "Dstmem:" <+> pretty (dstmem etry) - <> ", AliasMems:" - <+> pretty (alsmem etry) - <+> ", optdeps:" - <+> pretty (M.toList $ optdeps etry) - <+> ", memrefs:" - <+> pretty (memrefs etry) - <+> ", vartab:" - <+> pretty (M.toList $ vartab etry) - <+> "}" - <+> "\n" + <> ", AliasMems:" + <+> pretty (alsmem etry) + <+> ", optdeps:" + <+> pretty (M.toList $ optdeps etry) + <+> ", memrefs:" + <+> pretty (memrefs etry) + <+> ", vartab:" + <+> pretty (M.toList $ vartab etry) + <+> "}" + <+> "\n" -- | Compute the union of two 'CoalsEntry'. If two 'CoalsEntry' do not refer to -- the same destination memory and use the same index function, the first diff --git a/src/Futhark/Optimise/BlkRegTiling.hs b/src/Futhark/Optimise/BlkRegTiling.hs index 1e72b18d53..0500f81bed 100644 --- a/src/Futhark/Optimise/BlkRegTiling.hs +++ b/src/Futhark/Optimise/BlkRegTiling.hs @@ -173,10 +173,16 @@ kkLoopBody -- is garbage anyways and should not be written. -- so fits_ij should be always true!!! - le64 iii + le64 i + pe64 ry * le64 ltid_y - .<. pe64 height_A - .&&. le64 jjj + le64 j + pe64 rx * le64 ltid_x - .<. pe64 width_B + le64 iii + + le64 i + + pe64 ry + * le64 ltid_y + .<. pe64 height_A + .&&. le64 jjj + + le64 j + + pe64 rx + * le64 ltid_x + .<. pe64 width_B ) ( do a <- index "a" as [i] @@ -255,7 +261,8 @@ kkLoopBody letSubExp (str_A ++ "_elem") =<< eIf ( toExp $ - le64 gtid .<. pe64 parlen_X + le64 gtid + .<. pe64 parlen_X .&&. if epilogue then le64 a_seqdim_idx .<. pe64 common_dim else true @@ -376,8 +383,10 @@ mmBlkRegTilingAcc env (Let pat aux (Op (SegOp (SegMap SegThread {} seg_space ts letTupExp "redomap_res_if" =<< eIf ( toExp $ - le64 full_tiles .==. pe64 rk - .||. pe64 common_dim .==. (pe64 tk * le64 full_tiles + le64 ttt) + le64 full_tiles + .==. pe64 rk + .||. pe64 common_dim + .==. (pe64 tk * le64 full_tiles + le64 ttt) ) (resultBodyM $ map Var prologue_res_list) ( do @@ -460,8 +469,10 @@ mmBlkRegTilingAcc env (Let pat aux (Op (SegOp (SegMap SegThread {} seg_space ts letSubExp "res_elem" =<< eIf ( toExp $ - le64 gtid_y .<. pe64 height_A - .&&. le64 gtid_x .<. pe64 width_B + le64 gtid_y + .<. pe64 height_A + .&&. le64 gtid_x + .<. pe64 width_B ) ( do addStms code2_subs @@ -608,8 +619,10 @@ mmBlkRegTilingNrm env (Let pat aux (Op (SegOp (SegMap SegThread {} seg_space ts letSubExp "res_elem" =<< eIf ( toExp $ - le64 gtid_y .<. pe64 height_A - .&&. le64 gtid_x .<. pe64 width_B + le64 gtid_y + .<. pe64 height_A + .&&. le64 gtid_x + .<. pe64 width_B ) ( do addStms code2' @@ -1251,9 +1264,12 @@ doRegTiling3D (Let pat aux (Op (SegOp old_kernel))) letTupExp' "res_elem" =<< eIf ( toExp $ - le64 gtid_y .<. pe64 d_Ky - .&&. le64 gtid_x .<. pe64 d_Kx - .&&. le64 gtid_z .<. pe64 d_M + le64 gtid_y + .<. pe64 d_Ky + .&&. le64 gtid_x + .<. pe64 d_Kx + .&&. le64 gtid_z + .<. pe64 d_M ) ( do addStms code2' diff --git a/src/Futhark/Test.hs b/src/Futhark/Test.hs index 78e5244d0a..7ddaea6233 100644 --- a/src/Futhark/Test.hs +++ b/src/Futhark/Test.hs @@ -300,11 +300,11 @@ testRunReferenceOutput :: FilePath -> T.Text -> TestRun -> FilePath testRunReferenceOutput prog entry tr = "data" takeBaseName prog - <> ":" - <> T.unpack entry - <> "-" - <> map clean (T.unpack (runDescription tr)) - <.> "out" + <> ":" + <> T.unpack entry + <> "-" + <> map clean (T.unpack (runDescription tr)) + <.> "out" where clean '/' = '_' -- Would this ever happen? clean ' ' = '_' diff --git a/src/Language/Futhark/Interpreter.hs b/src/Language/Futhark/Interpreter.hs index b3aeb27543..cbad3372a7 100644 --- a/src/Language/Futhark/Interpreter.hs +++ b/src/Language/Futhark/Interpreter.hs @@ -1402,7 +1402,7 @@ initialCtx = <+> dquotes (prettyValue x) <+> "and" <+> dquotes (prettyValue y) - <> "." + <> "." where bopDef' (valf, retf, op) (x, y) = do x' <- valf x @@ -1419,7 +1419,7 @@ initialCtx = bad noLoc mempty . docText $ "Cannot apply function to argument" <+> dquotes (prettyValue x) - <> "." + <> "." where unopDef' (valf, retf, op) x = do x' <- valf x @@ -1436,7 +1436,8 @@ initialCtx = _ -> bad noLoc mempty . docText $ "Cannot apply operator to argument" - <+> dquotes (prettyValue v) <> "." + <+> dquotes (prettyValue v) + <> "." def "!" = Just $ @@ -1995,7 +1996,7 @@ checkEntryArgs entry args entry_t "Entry point " <> dquotes (prettyName entry) <> " expects input of type(s)" - indent 2 (stack (map pretty param_ts)) + indent 2 (stack (map pretty param_ts)) -- | Execute the named function on the given arguments; may fail -- horribly if these are ill-typed. diff --git a/src/Language/Futhark/Pretty.hs b/src/Language/Futhark/Pretty.hs index c6c3d28fd5..d144719f16 100644 --- a/src/Language/Futhark/Pretty.hs +++ b/src/Language/Futhark/Pretty.hs @@ -258,9 +258,9 @@ prettyAppExp _ (LetFun fname (tparams, params, retdecl, rettype, e) body _) = "let" <+> hsep (prettyName fname : map pretty tparams ++ map pretty params) <> retdecl' - <+> equals - indent 2 (pretty e) - letBody body + <+> equals + indent 2 (pretty e) + letBody body where retdecl' = case (pretty <$> unAnnot rettype) `mplus` (pretty <$> retdecl) of Just rettype' -> colon <+> align rettype' @@ -270,9 +270,9 @@ prettyAppExp _ (LetWith dest src idxs ve body _) "let" <+> pretty dest <> list (map pretty idxs) - <+> equals - <+> align (pretty ve) - letBody body + <+> equals + <+> align (pretty ve) + letBody body | otherwise = "let" <+> pretty dest @@ -374,8 +374,8 @@ prettyExp p (Lambda params body rettype _ _) = "\\" <> hsep (map pretty params) <> ppAscription rettype - <+> "->" - indent 2 (align (pretty body)) + <+> "->" + indent 2 (align (pretty body)) prettyExp _ (OpSection binop _ _) = parens $ pretty binop prettyExp _ (OpSectionLeft binop _ x _ _ _) = @@ -484,8 +484,8 @@ prettyModExp p (ModLambda param maybe_sig body _) = "\\" <> pretty param <> maybe_sig' - <+> "->" - indent 2 (pretty body) + <+> "->" + indent 2 (pretty body) where maybe_sig' = case maybe_sig of Nothing -> mempty @@ -501,10 +501,11 @@ instance Pretty Liftedness where instance (Eq vn, IsName vn, Annot f) => Pretty (TypeBindBase f vn) where pretty (TypeBind name l params te rt _ _) = - "type" <> pretty l - <+> hsep (prettyName name : map pretty params) - <+> equals - <+> maybe (pretty te) pretty (unAnnot rt) + "type" + <> pretty l + <+> hsep (prettyName name : map pretty params) + <+> equals + <+> maybe (pretty te) pretty (unAnnot rt) instance (Eq vn, IsName vn) => Pretty (TypeParamBase vn) where pretty (TypeParamDim name _) = brackets $ prettyName name @@ -514,16 +515,16 @@ instance (Eq vn, IsName vn, Annot f) => Pretty (ValBindBase f vn) where pretty (ValBind entry name retdecl rettype tparams args body _ attrs _) = mconcat (map ((<> line) . prettyAttr) attrs) <> fun - <+> align - ( sep - ( prettyName name - : map pretty tparams - ++ map pretty args - ++ retdecl' - ++ ["="] - ) - ) - indent 2 (pretty body) + <+> align + ( sep + ( prettyName name + : map pretty tparams + ++ map pretty args + ++ retdecl' + ++ ["="] + ) + ) + indent 2 (pretty body) where fun | isJust entry = "entry" diff --git a/src/Language/Futhark/Semantic.hs b/src/Language/Futhark/Semantic.hs index 4e568eeea8..c425694510 100644 --- a/src/Language/Futhark/Semantic.hs +++ b/src/Language/Futhark/Semantic.hs @@ -177,9 +177,9 @@ instance Pretty Env where renderTypeBind (name, TypeAbbr l tps tp) = p l <+> prettyName name - <> mconcat (map ((" " <>) . pretty) tps) - <> " =" - <+> pretty tp + <> mconcat (map ((" " <>) . pretty) tps) + <> " =" + <+> pretty tp where p Lifted = "type^" p SizeLifted = "type~" @@ -187,9 +187,9 @@ instance Pretty Env where renderValBind (name, BoundV tps t) = "val" <+> prettyName name - <> mconcat (map ((" " <>) . pretty) tps) - <> " =" - <+> pretty t + <> mconcat (map ((" " <>) . pretty) tps) + <> " =" + <+> pretty t renderModType (name, _sig) = "module type" <+> prettyName name renderMod (name, mod) = diff --git a/src/Language/Futhark/TypeChecker.hs b/src/Language/Futhark/TypeChecker.hs index c81862dea5..b08d699d94 100644 --- a/src/Language/Futhark/TypeChecker.hs +++ b/src/Language/Futhark/TypeChecker.hs @@ -160,8 +160,8 @@ dupDefinitionError space name loc1 loc2 = <+> pretty space <+> prettyName name <> "." - "Previously defined at" - <+> pretty (locStr loc2) + "Previously defined at" + <+> pretty (locStr loc2) <> "." checkForDuplicateDecs :: [DecBase NoInfo Name] -> TypeM () diff --git a/src/Language/Futhark/TypeChecker/Consumption.hs b/src/Language/Futhark/TypeChecker/Consumption.hs index 9b3ed5113b..db46f25d90 100644 --- a/src/Language/Futhark/TypeChecker/Consumption.hs +++ b/src/Language/Futhark/TypeChecker/Consumption.hs @@ -168,7 +168,8 @@ returnAliased :: Name -> SrcLoc -> CheckM () returnAliased name loc = addError loc mempty . withIndexLink "return-aliased" $ "Unique-typed return value is aliased to" - <+> dquotes (prettyName name) <> ", which is not consumable." + <+> dquotes (prettyName name) + <> ", which is not consumable." uniqueReturnAliased :: SrcLoc -> CheckM () uniqueReturnAliased loc = @@ -251,7 +252,7 @@ bindingPat p t = fmap (second (second (unscope (patNames p)))) . local bind bind env = env { envVtable = - foldr (uncurry M.insert) (envVtable env) (fmap f (matchPat p t)) + foldr (uncurry M.insert . f) (envVtable env) (matchPat p t) } where f (v, (_, als)) = (v, Consumable $ second (S.insert (AliasBound v)) als) @@ -264,7 +265,7 @@ bindingParam p m = do bind env = env { envVtable = - foldr (uncurry M.insert) (envVtable env) (fmap f (patternMap p)) + foldr (uncurry M.insert . f) (envVtable env) (patternMap p) } f (v, t) | diet t == Consume = (v, Consumable $ t `setAliases` S.singleton (AliasBound v)) @@ -305,8 +306,10 @@ checkIfConsumed rloc als = do v' <- describeVar v addError rloc mempty . withIndexLink "use-after-consume" $ "Using" - <+> v' <> ", but this was consumed at" - <+> pretty (locStrRel rloc wloc) <> ". (Possibly through aliases.)" + <+> v' + <> ", but this was consumed at" + <+> pretty (locStrRel rloc wloc) + <> ". (Possibly through aliases.)" consumed :: Consumed -> CheckM () consumed vs = modify $ \s -> s {stateConsumed = stateConsumed s <> vs} @@ -597,7 +600,8 @@ convergeLoopParam loop_loc param body_cons body_als = do "Return value for consuming loop parameter" <+> dquotes (prettyName pat_v) <+> "aliases" - <+> dquotes (prettyName v) <> "." + <+> dquotes (prettyName v) + <> "." (cons, obs) <- get unless (S.null $ aliases t `S.intersection` cons) $ lift . addError loop_loc mempty $ @@ -668,7 +672,7 @@ checkLoop loop_loc (param, arg, form, body) = do "Loop body uses" <+> v' <> " (or an alias)," - "but this is consumed by the initial loop argument." + "but this is consumed by the initial loop argument." v <- VName "internal_loop_result" <$> incCounter modify $ \s -> s {stateNames = M.insert v (NameLoopRes (srclocOf loop_loc)) $ stateNames s} @@ -959,9 +963,9 @@ checkGlobalAliases loc params body_t = do "Function result aliases the free variable " <> dquotes (prettyName v) <> "." - "Use" - <+> dquotes "copy" - <+> "to break the aliasing." + "Use" + <+> dquotes "copy" + <+> "to break the aliasing." -- | Type-check a value definition. This also infers a new return -- type that may be more unique than previously. diff --git a/src/Language/Futhark/TypeChecker/Modules.hs b/src/Language/Futhark/TypeChecker/Modules.hs index 23d141b37f..7d718091fc 100644 --- a/src/Language/Futhark/TypeChecker/Modules.hs +++ b/src/Language/Futhark/TypeChecker/Modules.hs @@ -207,7 +207,10 @@ refineEnv loc tset env tname ps t else typeError loc mempty $ "Cannot refine a type having" - <+> tpMsg ps <> " with a type having " <> tpMsg cur_ps <> "." + <+> tpMsg ps + <> " with a type having " + <> tpMsg cur_ps + <> "." | otherwise = typeError loc mempty $ dquotes (pretty tname) <+> "is not an abstract type in the module type." where @@ -367,14 +370,16 @@ ppTypeAbbr :: [VName] -> QualName VName -> (Liftedness, [TypeParam], StructRetTy ppTypeAbbr abs name (l, ps, RetType [] (Scalar (TypeVar _ tn args))) | qualLeaf tn `elem` abs, map typeParamToArg ps == args = - "type" <> pretty l - <+> pretty name - <+> hsep (map pretty ps) + "type" + <> pretty l + <+> pretty name + <+> hsep (map pretty ps) ppTypeAbbr _ name (l, ps, t) = - "type" <> pretty l - <+> hsep (pretty name : map pretty ps) - <+> equals - <+> nest 2 (align (pretty t)) + "type" + <> pretty l + <+> hsep (pretty name : map pretty ps) + <+> equals + <+> nest 2 (align (pretty t)) -- | Return new renamed/abstracted env, as well as a mapping from -- names in the signature to names in the new env. This is used for diff --git a/src/Language/Futhark/TypeChecker/Monad.hs b/src/Language/Futhark/TypeChecker/Monad.hs index 07671197f8..26cb28097f 100644 --- a/src/Language/Futhark/TypeChecker/Monad.hs +++ b/src/Language/Futhark/TypeChecker/Monad.hs @@ -153,7 +153,7 @@ underscoreUse loc name = typeError loc mempty $ "Use of" <+> dquotes (pretty name) - <> ": variables prefixed with underscore may not be accessed." + <> ": variables prefixed with underscore may not be accessed." -- | A mapping from import import names to 'Env's. This is used to -- resolve @import@ declarations. diff --git a/src/Language/Futhark/TypeChecker/Terms.hs b/src/Language/Futhark/TypeChecker/Terms.hs index e91d1094fd..d70e82dc16 100644 --- a/src/Language/Futhark/TypeChecker/Terms.hs +++ b/src/Language/Futhark/TypeChecker/Terms.hs @@ -388,7 +388,8 @@ checkExp (RecordLit fs loc) = do "Field" <+> dquotes (pretty f) <+> "previously defined at" - <+> pretty (locStrRel rloc sloc) <> "." + <+> pretty (locStrRel rloc sloc) + <> "." Nothing -> pure () checkExp (ArrayLit all_es _ loc) = -- Construct the result type and unify all elements with it. We @@ -1067,13 +1068,13 @@ checkApply loc (fname, prev_applied) ftype argexp = do <+> fname' <+> "to argument #" <> pretty (prev_applied + 1) - <+> dquotes (shorten $ group $ pretty argexp) + <+> dquotes (shorten $ group $ pretty argexp) <> "," - "as" - <+> fname' - <+> "only takes" - <+> pretty prev_applied - <+> arguments + "as" + <+> fname' + <+> "only takes" + <+> pretty prev_applied + <+> arguments <> "." where arguments @@ -1234,19 +1235,19 @@ causalityCheck binding_body = do <+> "needed for type of" <+> what <> colon - indent 2 (pretty t) - "But" - <+> dquotes (prettyName d) - <+> "is computed at" - <+> pretty (locStrRel loc dloc) + indent 2 (pretty t) + "But" + <+> dquotes (prettyName d) + <+> "is computed at" + <+> pretty (locStrRel loc dloc) <> "." - "" - "Hint:" - <+> align - ( textwrap "Bind the expression producing" - <+> dquotes (prettyName d) - <+> "with 'let' beforehand." - ) + "" + "Hint:" + <+> align + ( textwrap "Bind the expression producing" + <+> dquotes (prettyName d) + <+> "with 'let' beforehand." + ) -- | Traverse the expression, emitting warnings and errors for various -- problems: @@ -1393,7 +1394,7 @@ fixOverloadedTypes tyvars_at_toplevel = "Type is ambiguous (could be one of" <+> commasep (map pretty ots) <> ")." - "Add a type annotation to disambiguate the type." + "Add a type annotation to disambiguate the type." fixOverloaded (v, NoConstraint _ usage) = do -- See #1552. unify usage (Scalar (TypeVar mempty (qualName v) [])) $ @@ -1416,7 +1417,7 @@ fixOverloadedTypes tyvars_at_toplevel = "Type is ambiguous (must be a sum type with constructors:" <+> pretty (Sum cs) <> ")." - "Add a type annotation to disambiguate the type." + "Add a type annotation to disambiguate the type." fixOverloaded (v, Size Nothing (Usage Nothing loc)) = typeError loc mempty . withIndexLink "ambiguous-size" $ "Ambiguous size" <+> dquotes (prettyName v) <> "." @@ -1540,10 +1541,10 @@ verifyFunctionParams fname params = "refers to size" <+> dquotes (prettyName d) <> comma - textwrap "which will not be accessible to the caller" + textwrap "which will not be accessible to the caller" <> comma - textwrap "possibly because it is nested in a tuple or record." - textwrap "Consider ascribing an explicit type that does not reference " + textwrap "possibly because it is nested in a tuple or record." + textwrap "Consider ascribing an explicit type that does not reference " <> dquotes (prettyName d) <> "." | otherwise = verifyParams forbidden' ps @@ -1638,7 +1639,7 @@ closeOverTypes defname defloc tparams paramts ret substs = do <+> "in parameter of" <+> dquotes (prettyName defname) <> ", which is inferred as:" - indent 2 (pretty t) + indent 2 (pretty t) | k `S.member` produced_sizes = pure $ Just $ Right k closeOver (_, _) = diff --git a/src/Language/Futhark/TypeChecker/Terms/Monad.hs b/src/Language/Futhark/TypeChecker/Terms/Monad.hs index a5e395a9bb..35d47ff482 100644 --- a/src/Language/Futhark/TypeChecker/Terms/Monad.hs +++ b/src/Language/Futhark/TypeChecker/Terms/Monad.hs @@ -112,12 +112,14 @@ instance Pretty Checking where case f of Nothing -> "Cannot apply function to" - <+> dquotes (shorten $ group $ pretty e) <> " (invalid type)." + <+> dquotes (shorten $ group $ pretty e) + <> " (invalid type)." Just fname -> "Cannot apply" <+> dquotes (pretty fname) <+> "to" - <+> dquotes (align $ shorten $ group $ pretty e) <> " (invalid type)." + <+> dquotes (align $ shorten $ group $ pretty e) + <> " (invalid type)." pretty (CheckingReturn expected actual) = "Function body does not have expected type." "Expected:" @@ -159,24 +161,24 @@ instance Pretty Checking where "Type mismatch when updating record field" <+> dquotes fs' <> "." - "Existing:" - <+> align (pretty expected) - "New: " - <+> align (pretty actual) + "Existing:" + <+> align (pretty expected) + "New: " + <+> align (pretty actual) where fs' = mconcat $ punctuate "." $ map pretty fs pretty (CheckingRequired [expected] actual) = "Expression must must have type" <+> pretty expected <> "." - "Actual type:" - <+> align (pretty actual) + "Actual type:" + <+> align (pretty actual) pretty (CheckingRequired expected actual) = "Type of expression must must be one of " <+> expected' <> "." - "Actual type:" - <+> align (pretty actual) + "Actual type:" + <+> align (pretty actual) where expected' = commasep (map pretty expected) pretty (CheckingBranches t1 t2) = diff --git a/src/Language/Futhark/TypeChecker/Terms/Pat.hs b/src/Language/Futhark/TypeChecker/Terms/Pat.hs index 07cbdeabf3..30eb41853c 100644 --- a/src/Language/Futhark/TypeChecker/Terms/Pat.hs +++ b/src/Language/Futhark/TypeChecker/Terms/Pat.hs @@ -263,11 +263,13 @@ checkPat' sizes (PatConstr n NoInfo ps loc) (Ascribed (Scalar (Sum cs))) | Just ts <- M.lookup n cs = do when (length ps /= length ts) $ typeError loc mempty $ - "Pattern #" <> pretty n <> " expects" - <+> pretty (length ps) - <+> "constructor arguments, but type provides" - <+> pretty (length ts) - <+> "arguments." + "Pattern #" + <> pretty n + <> " expects" + <+> pretty (length ps) + <+> "constructor arguments, but type provides" + <+> pretty (length ts) + <+> "arguments." ps' <- zipWithM (checkPat' sizes) ps $ map Ascribed ts pure $ PatConstr n (Info (Scalar (Sum cs))) ps' loc checkPat' sizes (PatConstr n NoInfo ps loc) (Ascribed t) = do diff --git a/src/Language/Futhark/TypeChecker/Types.hs b/src/Language/Futhark/TypeChecker/Types.hs index 73b9aa9ecd..7ad13e9fdf 100644 --- a/src/Language/Futhark/TypeChecker/Types.hs +++ b/src/Language/Futhark/TypeChecker/Types.hs @@ -259,7 +259,8 @@ evalTypeExp ote@TEApply {} = do <+> "requires" <+> pretty (length ps) <+> "arguments, but provided" - <+> pretty (length targs) <> "." + <+> pretty (length targs) + <> "." else do (targs', dims, substs) <- unzip3 <$> zipWithM checkArgApply ps targs pure @@ -314,7 +315,8 @@ evalTypeExp ote@TEApply {} = do "Type argument" <+> pretty a <+> "not valid for a type parameter" - <+> pretty p <> "." + <+> pretty p + <> "." -- | Check a type expression, producing: -- @@ -359,7 +361,8 @@ checkForDuplicateNames tps pats = (`evalStateT` mempty) $ do "Name" <+> dquotes (pretty v) <+> "also bound at" - <+> pretty (locStr prev_loc) <> "." + <+> pretty (locStr prev_loc) + <> "." Nothing -> modify $ M.insert (ns, v) loc @@ -379,7 +382,8 @@ checkForDuplicateNamesInType = check mempty "Name" <+> dquotes (pretty v) <+> "also bound at" - <+> pretty (locStr prev_loc) <> "." + <+> pretty (locStr prev_loc) + <> "." check seen (TEArrow (Just v) t1 t2 loc) | Just prev_loc <- M.lookup v seen = @@ -433,7 +437,8 @@ checkTypeParams ps m = "Type parameter" <+> dquotes (pretty v) <+> "previously defined at" - <+> pretty (locStr prev) <> "." + <+> pretty (locStr prev) + <> "." Nothing -> do modify $ M.insert (ns, v) loc lift $ checkName ns v loc diff --git a/src/Language/Futhark/TypeChecker/Unify.hs b/src/Language/Futhark/TypeChecker/Unify.hs index 08867b6d52..a53cb14331 100644 --- a/src/Language/Futhark/TypeChecker/Unify.hs +++ b/src/Language/Futhark/TypeChecker/Unify.hs @@ -58,7 +58,8 @@ instance Pretty BreadCrumb where indent 2 (pretty t2) pretty (MatchingFields fields) = "When matching types of record field" - <+> dquotes (mconcat $ punctuate "." $ map pretty fields) <> dot + <+> dquotes (mconcat $ punctuate "." $ map pretty fields) + <> dot pretty (MatchingConstructor c) = "When matching types of constructor" <+> dquotes (pretty c) <> dot pretty (Matching s) = @@ -188,12 +189,14 @@ data Rigidity = Rigid RigidSource | Nonrigid prettySource :: SrcLoc -> SrcLoc -> RigidSource -> Doc () prettySource ctx loc (RigidRet Nothing) = "is unknown size returned by function at" - <+> pretty (locStrRel ctx loc) <> "." + <+> pretty (locStrRel ctx loc) + <> "." prettySource ctx loc (RigidRet (Just fname)) = "is unknown size returned by" <+> dquotes (pretty fname) <+> "at" - <+> pretty (locStrRel ctx loc) <> "." + <+> pretty (locStrRel ctx loc) + <> "." prettySource ctx loc (RigidArg fname arg) = "is value of argument" indent 2 (shorten (pretty arg)) @@ -209,7 +212,7 @@ prettySource ctx loc (RigidSlice d slice) = indent 2 (shorten (pretty slice)) d_desc <> "at" - <+> pretty (locStrRel ctx loc) + <+> pretty (locStrRel ctx loc) <> "." where d_desc = case d of @@ -231,21 +234,22 @@ prettySource ctx loc (RigidOutOfScope boundloc v) = <> " going out of scope at " <> pretty (locStrRel ctx loc) <> "." - "Originally bound at " + "Originally bound at " <> pretty (locStrRel ctx boundloc) <> "." prettySource ctx loc RigidCoerce = "is an unknown size arising from empty dimension in coercion at" - <+> pretty (locStrRel ctx loc) <> "." + <+> pretty (locStrRel ctx loc) + <> "." prettySource _ _ RigidUnify = "is an artificial size invented during unification of functions with anonymous sizes." prettySource ctx loc (RigidCond t1 t2) = "is unknown due to conditional expression at " <> pretty (locStrRel ctx loc) <> "." - "One branch returns array of type: " + "One branch returns array of type: " <> align (pretty t1) - "The other an array of type: " + "The other an array of type: " <> align (pretty t2) -- | Retrieve notes describing the purpose or origin of the given @@ -585,7 +589,8 @@ occursCheck usage bcs vn tp = "Occurs check: cannot instantiate" <+> prettyName vn <+> "with" - <+> pretty tp <> "." + <+> pretty tp + <> "." scopeCheck :: (MonadUnify m) => @@ -857,7 +862,9 @@ mustBeOneOf ts usage t = do unifyError usage mempty noBreadCrumbs $ "Cannot unify type" <+> dquotes (pretty t) - <+> "with any of " <> commasep (map pretty ts) <> "." + <+> "with any of " + <> commasep (map pretty ts) + <> "." linkVarToTypes :: (MonadUnify m) => Usage -> VName -> [PrimType] -> m () linkVarToTypes usage vn ts = do @@ -872,22 +879,23 @@ linkVarToTypes usage vn ts = do <+> "but also one of" <+> commasep (map pretty vn_ts) <+> "due to" - <+> pretty vn_usage <> "." + <+> pretty vn_usage + <> "." ts' -> modifyConstraints $ M.insert vn (lvl, Overloaded ts' usage) Just (_, HasConstrs _ _ vn_usage) -> unifyError usage mempty noBreadCrumbs $ "Type constrained to one of" <+> commasep (map pretty ts) - <> ", but also inferred to be sum type due to" - <+> pretty vn_usage - <> "." + <> ", but also inferred to be sum type due to" + <+> pretty vn_usage + <> "." Just (_, HasFields _ _ vn_usage) -> unifyError usage mempty noBreadCrumbs $ "Type constrained to one of" <+> commasep (map pretty ts) - <> ", but also inferred to be record due to" - <+> pretty vn_usage - <> "." + <> ", but also inferred to be record due to" + <+> pretty vn_usage + <> "." Just (lvl, _) -> modifyConstraints $ M.insert vn (lvl, Overloaded ts usage) Nothing -> unifyError usage mempty noBreadCrumbs $ @@ -1118,7 +1126,8 @@ mustHaveFieldWith onDims usage bound bcs l t = do "Attempt to access field" <+> dquotes (pretty l) <+> " of value of type" - <+> pretty (toStructural t) <> "." + <+> pretty (toStructural t) + <> "." _ -> do unify usage t $ Scalar $ Record $ M.singleton l l_type pure l_type