1-- |
2-- Module      :  Cryptol.TypeCheck.PP
3-- Copyright   :  (c) 2013-2016 Galois, Inc.
4-- License     :  BSD3
5-- Maintainer  :  cryptol@galois.com
6-- Stability   :  provisional
7-- Portability :  portable
8
9{-# LANGUAGE Safe #-}
10{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}
11module Cryptol.TypeCheck.PP
12  ( NameMap, WithNames(..)
13  , emptyNameMap
14  , ppWithNamesPrec, ppWithNames
15  , nameList
16  , dump
17  , module Cryptol.Utils.PP
18  ) where
19
20import           Data.IntMap (IntMap)
21import qualified Data.IntMap as IntMap
22import           Data.List(transpose)
23import           Cryptol.Utils.PP
24
25
26type NameMap = IntMap String
27
28emptyNameMap :: NameMap
29emptyNameMap = IntMap.empty
30
31-- | This packages together a type with some names to be used to display
32-- the variables.  It is used for pretty printing types.
33data WithNames a = WithNames a NameMap
34
35ppWithNamesPrec :: PP (WithNames a) => NameMap -> Int -> a -> Doc
36ppWithNamesPrec names prec t = ppPrec prec (WithNames t names)
37
38ppWithNames :: PP (WithNames a) => NameMap -> a -> Doc
39ppWithNames names t = ppWithNamesPrec names 0 t
40
41dump :: PP (WithNames a) => a -> String
42dump x = show (ppWithNames IntMap.empty x)
43
44-- | Compute the n-th variant of a name (e.g., @a5@).
45nameVariant :: Int -> String -> String
46nameVariant 0 x   = x
47nameVariant n x   = x ++ show n
48
49-- | Compute all variants of a name: @a, a1, a2, a3, ...@
50nameVariants :: String -> [String]
51nameVariants x = map (`nameVariant` x) [ 0 .. ]
52
53-- | Expand a list of base names into an infinite list of variations.
54nameList :: [String] -> [String]
55nameList names = concat $ transpose $ map nameVariants baseNames
56  where
57  baseNames | null names = map (:[]) [ 'a' .. 'z' ]
58            | otherwise  = names
59
60
61