<commit_before>{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE FlexibleInstances    #-}
-- | Futhark prettyprinter.  This module defines 'Pretty' instances
-- for the AST defined in "Futhark.Representation.AST.Syntax",
-- but also a number of convenience functions if you don't want to use
-- the interface from 'Pretty'.
module Futhark.Representation.AST.Pretty
  ( prettyTuple
  , pretty
  , PrettyAnnot (..)
  , PrettyLore (..)
  , ppTuple'
  , bindingAnnotation
  , ppArray
  )
  where

import           Data.Array                                     (elems,
                                                                 listArray)
import           Data.Maybe
import           Data.Monoid

import           Futhark.Util.Pretty

import           Futhark.Representation.AST.Attributes.Patterns
import           Futhark.Representation.AST.Syntax
import           Futhark.Util

-- | Class for values that may have some prettyprinted annotation.
class PrettyAnnot a where
  ppAnnot :: a -> Maybe Doc

instance PrettyAnnot (PatElemT (TypeBase shape u)) where
  ppAnnot = const Nothing

instance PrettyAnnot (ParamT (TypeBase shape u)) where
  ppAnnot = const Nothing

instance PrettyAnnot () where
  ppAnnot = const Nothing

-- | The class of lores whose annotations can be prettyprinted.
class (Annotations lore,
       Pretty (RetType lore),
       Pretty (BranchType lore),
       Pretty (ParamT (FParamAttr lore)),
       Pretty (ParamT (LParamAttr lore)),
       Pretty (PatElemT (LetAttr lore)),
       PrettyAnnot (PatElem lore),
       PrettyAnnot (FParam lore),
       PrettyAnnot (LParam lore),
       Pretty (Op lore)) => PrettyLore lore where
  ppExpLore :: ExpAttr lore -> Exp lore -> Maybe Doc
  ppExpLore _ (If _ _ _ (IfAttr ts _)) =
    Just $ text "-- Branch returns:" <+> ppTuple' ts
  ppExpLore _ _ = Nothing

commastack :: [Doc] -> Doc
commastack = align . stack . punctuate comma

instance Pretty NoUniqueness where
  ppr _ = mempty

instance Pretty Commutativity where
  ppr Commutative    = text "commutative"
  ppr Noncommutative = text "noncommutative"

-- | Print an array value, using the given function for printing
-- elements and element types.
ppArray :: (TypeBase Rank NoUniqueness -> Doc) -> (PrimValue -> Doc) -> Value -> Doc
ppArray _ pprim (PrimVal v) = pprim v
ppArray pt _ (ArrayVal _ t shape)
  | product shape == 0 = text "empty" <> parens (pt row_t)
  where row_t = Array t (Rank $ length shape - 1) NoUniqueness
ppArray pt pprim (ArrayVal a t (_:rowshape@(_:_))) =
  brackets $ commastack
  [ ppArray pt pprim $ ArrayVal (listArray (0, rowsize-1) a') t rowshape
  | a' <- chunk rowsize $ elems a ]
  where rowsize = product rowshape
ppArray _ pprim (ArrayVal a _ _) =
  brackets $ commasep $ map pprim $ elems a

instance Pretty Value where
  ppr = ppArray ppr ppr

instance Pretty Shape where
  ppr = brackets . commasep . map ppr . shapeDims

instance Pretty a => Pretty (Ext a) where
  ppr (Free e) = ppr e
  ppr (Ext x)  = text "?" <> text (show x)

instance Pretty ExtShape where
  ppr = brackets . commasep . map ppr . shapeDims

instance Pretty Space where
  ppr DefaultSpace = mempty
  ppr (Space s)    = text "@" <> text s

instance Pretty u => Pretty (TypeBase Shape u) where
  ppr (Prim et) = ppr et
  ppr (Array et (Shape ds) u) =
    ppr u <> mconcat (map (brackets . ppr) ds) <> ppr et
  ppr (Mem s DefaultSpace) = text "mem" <> parens (ppr s)
  ppr (Mem s (Space sp)) = text "mem" <> parens (ppr s) <> text "@" <> text sp

instance Pretty u => Pretty (TypeBase ExtShape u) where
  ppr (Prim et) = ppr et
  ppr (Array et (Shape ds) u) =
    ppr u <> mconcat (map (brackets . ppr) ds) <> ppr et
  ppr (Mem s DefaultSpace) = text "mem" <> parens (ppr s)
  ppr (Mem s (Space sp)) = text "mem" <> parens (ppr s) <> text "@" <> text sp

instance Pretty u => Pretty (TypeBase Rank u) where
  ppr (Prim et) = ppr et
  ppr (Array et (Rank n) u) =
    ppr u <> mconcat (replicate n $ brackets mempty) <> ppr et
  ppr (Mem s DefaultSpace) = text "mem" <> parens (ppr s)
  ppr (Mem s (Space sp)) = text "mem" <> parens (ppr s) <> text "@" <> text sp

instance Pretty Ident where
  ppr ident = ppr (identType ident) <+> ppr (identName ident)

instance Pretty SubExp where
  ppr (Var v)      = ppr v
  ppr (Constant v) = ppr v

instance Pretty Certificates where
  ppr (Certificates []) = empty
  ppr (Certificates cs) = text "<" <> commasep (map ppr cs) <> text ">"

instance PrettyLore lore => Pretty (Body lore) where
  ppr (Body _ stms res)
    | null stms = braces (commasep $ map ppr res)
    | otherwise = stack (map ppr $ stmsToList stms) </>
                  text "in" <+> braces (commasep $ map ppr res)

bindingAnnotation :: PrettyLore lore => Stm lore -> Doc -> Doc
bindingAnnotation bnd =
  case mapMaybe ppAnnot $ patternElements $ stmPattern bnd of
    []     -> id
    annots -> (stack annots </>)

instance Pretty (PatElemT attr) => Pretty (PatternT attr) where
  ppr pat = ppPattern (patternContextElements pat) (patternValueElements pat)

instance Pretty (PatElemT b) => Pretty (PatElemT (a,b)) where
  ppr = ppr . fmap snd
<commit_msg>Pretty instance for Stms.<commit_after>{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE FlexibleInstances    #-}
-- | Futhark prettyprinter.  This module defines 'Pretty' instances
-- for the AST defined in "Futhark.Representation.AST.Syntax",
-- but also a number of convenience functions if you don't want to use
-- the interface from 'Pretty'.
module Futhark.Representation.AST.Pretty
  ( prettyTuple
  , pretty
  , PrettyAnnot (..)
  , PrettyLore (..)
  , ppTuple'
  , bindingAnnotation
  , ppArray
  )
  where

import           Data.Array                                     (elems,
                                                                 listArray)
import           Data.Maybe
import           Data.Monoid

import           Futhark.Util.Pretty

import           Futhark.Representation.AST.Attributes.Patterns
import           Futhark.Representation.AST.Syntax
import           Futhark.Util

-- | Class for values that may have some prettyprinted annotation.
class PrettyAnnot a where
  ppAnnot :: a -> Maybe Doc

instance PrettyAnnot (PatElemT (TypeBase shape u)) where
  ppAnnot = const Nothing

instance PrettyAnnot (ParamT (TypeBase shape u)) where
  ppAnnot = const Nothing

instance PrettyAnnot () where
  ppAnnot = const Nothing

-- | The class of lores whose annotations can be prettyprinted.
class (Annotations lore,
       Pretty (RetType lore),
       Pretty (BranchType lore),
       Pretty (ParamT (FParamAttr lore)),
       Pretty (ParamT (LParamAttr lore)),
       Pretty (PatElemT (LetAttr lore)),
       PrettyAnnot (PatElem lore),
       PrettyAnnot (FParam lore),
       PrettyAnnot (LParam lore),
       Pretty (Op lore)) => PrettyLore lore where
  ppExpLore :: ExpAttr lore -> Exp lore -> Maybe Doc
  ppExpLore _ (If _ _ _ (IfAttr ts _)) =
    Just $ text "-- Branch returns:" <+> ppTuple' ts
  ppExpLore _ _ = Nothing

commastack :: [Doc] -> Doc
commastack = align . stack . punctuate comma

instance Pretty NoUniqueness where
  ppr _ = mempty

instance Pretty Commutativity where
  ppr Commutative    = text "commutative"
  ppr Noncommutative = text "noncommutative"

-- | Print an array value, using the given function for printing
-- elements and element types.
ppArray :: (TypeBase Rank NoUniqueness -> Doc) -> (PrimValue -> Doc) -> Value -> Doc
ppArray _ pprim (PrimVal v) = pprim v
ppArray pt _ (ArrayVal _ t shape)
  | product shape == 0 = text "empty" <> parens (pt row_t)
  where row_t = Array t (Rank $ length shape - 1) NoUniqueness
ppArray pt pprim (ArrayVal a t (_:rowshape@(_:_))) =
  brackets $ commastack
  [ ppArray pt pprim $ ArrayVal (listArray (0, rowsize-1) a') t rowshape
  | a' <- chunk rowsize $ elems a ]
  where rowsize = product rowshape
ppArray _ pprim (ArrayVal a _ _) =
  brackets $ commasep $ map pprim $ elems a

instance Pretty Value where
  ppr = ppArray ppr ppr

instance Pretty Shape where
  ppr = brackets . commasep . map ppr . shapeDims

instance Pretty a => Pretty (Ext a) where
  ppr (Free e) = ppr e
  ppr (Ext x)  = text "?" <> text (show x)

instance Pretty ExtShape where
  ppr = brackets . commasep . map ppr . shapeDims

instance Pretty Space where
  ppr DefaultSpace = mempty
  ppr (Space s)    = text "@" <> text s

instance Pretty u => Pretty (TypeBase Shape u) where
  ppr (Prim et) = ppr et
  ppr (Array et (Shape ds) u) =
    ppr u <> mconcat (map (brackets . ppr) ds) <> ppr et
  ppr (Mem s DefaultSpace) = text "mem" <> parens (ppr s)
  ppr (Mem s (Space sp)) = text "mem" <> parens (ppr s) <> text "@" <> text sp

instance Pretty u => Pretty (TypeBase ExtShape u) where
  ppr (Prim et) = ppr et
  ppr (Array et (Shape ds) u) =
    ppr u <> mconcat (map (brackets . ppr) ds) <> ppr et
  ppr (Mem s DefaultSpace) = text "mem" <> parens (ppr s)
  ppr (Mem s (Space sp)) = text "mem" <> parens (ppr s) <> text "@" <> text sp

instance Pretty u => Pretty (TypeBase Rank u) where
  ppr (Prim et) = ppr et
  ppr (Array et (Rank n) u) =
    ppr u <> mconcat (replicate n $ brackets mempty) <> ppr et
  ppr (Mem s DefaultSpace) = text "mem" <> parens (ppr s)
  ppr (Mem s (Space sp)) = text "mem" <> parens (ppr s) <> text "@" <> text sp

instance Pretty Ident where
  ppr ident = ppr (identType ident) <+> ppr (identName ident)

instance Pretty SubExp where
  ppr (Var v)      = ppr v
  ppr (Constant v) = ppr v

instance Pretty Certificates where
  ppr (Certificates []) = empty
  ppr (Certificates cs) = text "<" <> commasep (map ppr cs) <> text ">"

instance PrettyLore lore => Pretty (Stms lore) where
  ppr = stack . map ppr . stmsToList

instance PrettyLore lore => Pretty (Body lore) where
  ppr (Body _ stms res)
    | null stms = braces (commasep $ map ppr res)
    | otherwise = stack (map ppr $ stmsToList stms) </>
                  text "in" <+> braces (commasep $ map ppr res)

bindingAnnotation :: PrettyLore lore => Stm lore -> Doc -> Doc
bindingAnnotation bnd =
  case mapMaybe ppAnnot $ patternElements $ stmPattern bnd of
    []     -> id
    annots -> (stack annots </>)

instance Pretty (PatElemT attr) => Pretty (PatternT attr) where
  ppr pat = ppPattern (patternContextElements pat) (patternValueElements pat)

instance Pretty (PatElemT b) => Pretty (PatElemT (a,b)) where
  ppr = ppr . fmap snd

{'fraction_non_alphanumeric': 0.10515247108307045, 'fraction_numerical': 0.0007647452442405124, 'mean_word_length': 2.8834446919079437, 'pattern_counts': {'":': 0, '<': 63, '<?xml version=': 0, '>': 106, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 6, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5550920', 'n_tokens_mistral': 3512, 'n_tokens_neox': 3392, 'n_words': 1249}