-- | Definitions of various semantic objects (*not* the Futhark
-- semantics themselves).
module Language.Futhark.Semantic
  ( ImportName,
    mkInitialImport,
    mkImportFrom,
    includeToFilePath,
    includeToString,
    includeToText,
    FileModule (..),
    Imports,
    Namespace (..),
    Env (..),
    TySet,
    FunModType (..),
    NameMap,
    BoundV (..),
    Mod (..),
    TypeBinding (..),
    MTy (..),
  )
where

import Data.Map.Strict qualified as M
import Data.Text qualified as T
import Futhark.Util (fromPOSIX, toPOSIX)
import Futhark.Util.Pretty
import Language.Futhark
import System.FilePath qualified as Native
import System.FilePath.Posix qualified as Posix
import Prelude hiding (mod)

-- | Create an import name immediately from a file path specified by
-- the user.
mkInitialImport :: Native.FilePath -> ImportName
mkInitialImport :: FilePath -> ImportName
mkInitialImport = FilePath -> ImportName
ImportName (FilePath -> ImportName)
-> (FilePath -> FilePath) -> FilePath -> ImportName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
Posix.normalise (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
toPOSIX

-- | We resolve '..' paths here and assume that no shenanigans are
-- going on with symbolic links.  If there is, too bad.  Don't do
-- that.
mkImportFrom :: ImportName -> String -> ImportName
mkImportFrom :: ImportName -> FilePath -> ImportName
mkImportFrom (ImportName FilePath
includer) FilePath
includee
  | FilePath -> Bool
Posix.isAbsolute FilePath
includee = FilePath -> ImportName
ImportName FilePath
includee
  | Bool
otherwise =
      FilePath -> ImportName
ImportName (FilePath -> ImportName)
-> ([FilePath] -> FilePath) -> [FilePath] -> ImportName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
Posix.normalise (FilePath -> FilePath)
-> ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
Posix.joinPath ([FilePath] -> FilePath)
-> ([FilePath] -> [FilePath]) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath] -> [FilePath]
forall {a}. (Eq a, IsString a) => [a] -> [a] -> [a]
resolveDotDot [] ([FilePath] -> ImportName) -> [FilePath] -> ImportName
forall a b. (a -> b) -> a -> b
$
        [FilePath] -> [FilePath]
forall a. HasCallStack => [a] -> [a]
init (FilePath -> [FilePath]
Posix.splitPath FilePath
includer) [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath]
Posix.splitPath FilePath
includee
  where
    resolveDotDot :: [a] -> [a] -> [a]
resolveDotDot [a]
parts [] = [a] -> [a]
forall a. [a] -> [a]
reverse [a]
parts
    resolveDotDot parts :: [a]
parts@(a
"../" : [a]
_) (a
"../" : [a]
todo) = [a] -> [a] -> [a]
resolveDotDot (a
"../" a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
parts) [a]
todo
    resolveDotDot (a
_ : [a]
parts) (a
"../" : [a]
todo) = [a] -> [a] -> [a]
resolveDotDot [a]
parts [a]
todo
    resolveDotDot [a]
parts (a
p : [a]
todo) = [a] -> [a] -> [a]
resolveDotDot (a
p a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
parts) [a]
todo

-- | Create a @.fut@ file corresponding to an 'ImportName'.
includeToFilePath :: ImportName -> Native.FilePath
includeToFilePath :: ImportName -> FilePath
includeToFilePath (ImportName FilePath
s) = FilePath -> FilePath
fromPOSIX (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
Posix.normalise FilePath
s FilePath -> FilePath -> FilePath
Posix.<.> FilePath
"fut"

-- | Produce a human-readable canonicalized string from an
-- 'ImportName'.
includeToString :: ImportName -> String
includeToString :: ImportName -> FilePath
includeToString (ImportName FilePath
s) = FilePath -> FilePath
Posix.normalise FilePath
s

-- | Produce a human-readable canonicalized text from an
-- 'ImportName'.
includeToText :: ImportName -> T.Text
includeToText :: ImportName -> Text
includeToText (ImportName FilePath
s) = FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
Posix.normalise FilePath
s

-- | The result of type checking some file.  Can be passed to further
-- invocations of the type checker.
data FileModule = FileModule
  { -- | Abstract types.
    FileModule -> TySet
fileAbs :: TySet,
    -- | The environment made available when importing this module.
    FileModule -> Env
fileEnv :: Env,
    FileModule -> Prog
fileProg :: Prog,
    -- | The environment at the bottom of the file.  Includes local
    -- parts.
    FileModule -> Env
fileScope :: Env
  }

-- | A mapping from import names to imports.  The ordering is significant.
type Imports = [(ImportName, FileModule)]

-- | The space inhabited by a name.
data Namespace
  = -- | Functions and values.
    Term
  | Type
  | Signature
  deriving (Namespace -> Namespace -> Bool
(Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Bool) -> Eq Namespace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Namespace -> Namespace -> Bool
== :: Namespace -> Namespace -> Bool
$c/= :: Namespace -> Namespace -> Bool
/= :: Namespace -> Namespace -> Bool
Eq, Eq Namespace
Eq Namespace =>
(Namespace -> Namespace -> Ordering)
-> (Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Namespace)
-> (Namespace -> Namespace -> Namespace)
-> Ord Namespace
Namespace -> Namespace -> Bool
Namespace -> Namespace -> Ordering
Namespace -> Namespace -> Namespace
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Namespace -> Namespace -> Ordering
compare :: Namespace -> Namespace -> Ordering
$c< :: Namespace -> Namespace -> Bool
< :: Namespace -> Namespace -> Bool
$c<= :: Namespace -> Namespace -> Bool
<= :: Namespace -> Namespace -> Bool
$c> :: Namespace -> Namespace -> Bool
> :: Namespace -> Namespace -> Bool
$c>= :: Namespace -> Namespace -> Bool
>= :: Namespace -> Namespace -> Bool
$cmax :: Namespace -> Namespace -> Namespace
max :: Namespace -> Namespace -> Namespace
$cmin :: Namespace -> Namespace -> Namespace
min :: Namespace -> Namespace -> Namespace
Ord, Int -> Namespace -> FilePath -> FilePath
[Namespace] -> FilePath -> FilePath
Namespace -> FilePath
(Int -> Namespace -> FilePath -> FilePath)
-> (Namespace -> FilePath)
-> ([Namespace] -> FilePath -> FilePath)
-> Show Namespace
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> Namespace -> FilePath -> FilePath
showsPrec :: Int -> Namespace -> FilePath -> FilePath
$cshow :: Namespace -> FilePath
show :: Namespace -> FilePath
$cshowList :: [Namespace] -> FilePath -> FilePath
showList :: [Namespace] -> FilePath -> FilePath
Show, Int -> Namespace
Namespace -> Int
Namespace -> [Namespace]
Namespace -> Namespace
Namespace -> Namespace -> [Namespace]
Namespace -> Namespace -> Namespace -> [Namespace]
(Namespace -> Namespace)
-> (Namespace -> Namespace)
-> (Int -> Namespace)
-> (Namespace -> Int)
-> (Namespace -> [Namespace])
-> (Namespace -> Namespace -> [Namespace])
-> (Namespace -> Namespace -> [Namespace])
-> (Namespace -> Namespace -> Namespace -> [Namespace])
-> Enum Namespace
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Namespace -> Namespace
succ :: Namespace -> Namespace
$cpred :: Namespace -> Namespace
pred :: Namespace -> Namespace
$ctoEnum :: Int -> Namespace
toEnum :: Int -> Namespace
$cfromEnum :: Namespace -> Int
fromEnum :: Namespace -> Int
$cenumFrom :: Namespace -> [Namespace]
enumFrom :: Namespace -> [Namespace]
$cenumFromThen :: Namespace -> Namespace -> [Namespace]
enumFromThen :: Namespace -> Namespace -> [Namespace]
$cenumFromTo :: Namespace -> Namespace -> [Namespace]
enumFromTo :: Namespace -> Namespace -> [Namespace]
$cenumFromThenTo :: Namespace -> Namespace -> Namespace -> [Namespace]
enumFromThenTo :: Namespace -> Namespace -> Namespace -> [Namespace]
Enum)

-- | A mapping of abstract types to their liftedness.
type TySet = M.Map (QualName VName) Liftedness

-- | Representation of a module, which is either a plain environment,
-- or a parametric module ("functor" in SML).
data Mod
  = ModEnv Env
  | ModFun FunModType
  deriving (Int -> Mod -> FilePath -> FilePath
[Mod] -> FilePath -> FilePath
Mod -> FilePath
(Int -> Mod -> FilePath -> FilePath)
-> (Mod -> FilePath) -> ([Mod] -> FilePath -> FilePath) -> Show Mod
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> Mod -> FilePath -> FilePath
showsPrec :: Int -> Mod -> FilePath -> FilePath
$cshow :: Mod -> FilePath
show :: Mod -> FilePath
$cshowList :: [Mod] -> FilePath -> FilePath
showList :: [Mod] -> FilePath -> FilePath
Show)

-- | A parametric functor consists of a set of abstract types, the
-- environment of its parameter, and the resulting module type.
data FunModType = FunModType
  { FunModType -> TySet
funModTypeAbs :: TySet,
    FunModType -> Mod
funModTypeMod :: Mod,
    FunModType -> MTy
funModTypeMty :: MTy
  }
  deriving (Int -> FunModType -> FilePath -> FilePath
[FunModType] -> FilePath -> FilePath
FunModType -> FilePath
(Int -> FunModType -> FilePath -> FilePath)
-> (FunModType -> FilePath)
-> ([FunModType] -> FilePath -> FilePath)
-> Show FunModType
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> FunModType -> FilePath -> FilePath
showsPrec :: Int -> FunModType -> FilePath -> FilePath
$cshow :: FunModType -> FilePath
show :: FunModType -> FilePath
$cshowList :: [FunModType] -> FilePath -> FilePath
showList :: [FunModType] -> FilePath -> FilePath
Show)

-- | Representation of a module type.
data MTy = MTy
  { -- | Abstract types in the module type.
    MTy -> TySet
mtyAbs :: TySet,
    MTy -> Mod
mtyMod :: Mod
  }
  deriving (Int -> MTy -> FilePath -> FilePath
[MTy] -> FilePath -> FilePath
MTy -> FilePath
(Int -> MTy -> FilePath -> FilePath)
-> (MTy -> FilePath) -> ([MTy] -> FilePath -> FilePath) -> Show MTy
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> MTy -> FilePath -> FilePath
showsPrec :: Int -> MTy -> FilePath -> FilePath
$cshow :: MTy -> FilePath
show :: MTy -> FilePath
$cshowList :: [MTy] -> FilePath -> FilePath
showList :: [MTy] -> FilePath -> FilePath
Show)

-- | A binding from a name to its definition as a type.  We allow a
-- return type here to support type abbreviations that hide some inner
-- sizes (these must necessarily be 'Lifted' or 'SizeLifted').
data TypeBinding = TypeAbbr Liftedness [TypeParam] StructRetType
  deriving (TypeBinding -> TypeBinding -> Bool
(TypeBinding -> TypeBinding -> Bool)
-> (TypeBinding -> TypeBinding -> Bool) -> Eq TypeBinding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeBinding -> TypeBinding -> Bool
== :: TypeBinding -> TypeBinding -> Bool
$c/= :: TypeBinding -> TypeBinding -> Bool
/= :: TypeBinding -> TypeBinding -> Bool
Eq, Int -> TypeBinding -> FilePath -> FilePath
[TypeBinding] -> FilePath -> FilePath
TypeBinding -> FilePath
(Int -> TypeBinding -> FilePath -> FilePath)
-> (TypeBinding -> FilePath)
-> ([TypeBinding] -> FilePath -> FilePath)
-> Show TypeBinding
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> TypeBinding -> FilePath -> FilePath
showsPrec :: Int -> TypeBinding -> FilePath -> FilePath
$cshow :: TypeBinding -> FilePath
show :: TypeBinding -> FilePath
$cshowList :: [TypeBinding] -> FilePath -> FilePath
showList :: [TypeBinding] -> FilePath -> FilePath
Show)

-- | Type parameters, list of parameter types (optinally named), and
-- return type.  The type parameters are in scope in both parameter
-- types and the return type.  Non-functional values have only a
-- return type.
data BoundV = BoundV
  { BoundV -> [TypeParam]
boundValTParams :: [TypeParam],
    BoundV -> StructType
boundValType :: StructType
  }
  deriving (Int -> BoundV -> FilePath -> FilePath
[BoundV] -> FilePath -> FilePath
BoundV -> FilePath
(Int -> BoundV -> FilePath -> FilePath)
-> (BoundV -> FilePath)
-> ([BoundV] -> FilePath -> FilePath)
-> Show BoundV
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> BoundV -> FilePath -> FilePath
showsPrec :: Int -> BoundV -> FilePath -> FilePath
$cshow :: BoundV -> FilePath
show :: BoundV -> FilePath
$cshowList :: [BoundV] -> FilePath -> FilePath
showList :: [BoundV] -> FilePath -> FilePath
Show)

-- | A mapping from names (which always exist in some namespace) to a
-- unique (tagged) name.
type NameMap = M.Map (Namespace, Name) (QualName VName)

-- | Modules produces environment with this representation.
data Env = Env
  { Env -> Map VName BoundV
envVtable :: M.Map VName BoundV,
    Env -> Map VName TypeBinding
envTypeTable :: M.Map VName TypeBinding,
    Env -> Map VName MTy
envModTypeTable :: M.Map VName MTy,
    Env -> Map VName Mod
envModTable :: M.Map VName Mod,
    Env -> NameMap
envNameMap :: NameMap
  }
  deriving (Int -> Env -> FilePath -> FilePath
[Env] -> FilePath -> FilePath
Env -> FilePath
(Int -> Env -> FilePath -> FilePath)
-> (Env -> FilePath) -> ([Env] -> FilePath -> FilePath) -> Show Env
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> Env -> FilePath -> FilePath
showsPrec :: Int -> Env -> FilePath -> FilePath
$cshow :: Env -> FilePath
show :: Env -> FilePath
$cshowList :: [Env] -> FilePath -> FilePath
showList :: [Env] -> FilePath -> FilePath
Show)

instance Semigroup Env where
  Env Map VName BoundV
vt1 Map VName TypeBinding
tt1 Map VName MTy
st1 Map VName Mod
mt1 NameMap
nt1 <> :: Env -> Env -> Env
<> Env Map VName BoundV
vt2 Map VName TypeBinding
tt2 Map VName MTy
st2 Map VName Mod
mt2 NameMap
nt2 =
    Map VName BoundV
-> Map VName TypeBinding
-> Map VName MTy
-> Map VName Mod
-> NameMap
-> Env
Env (Map VName BoundV
vt1 Map VName BoundV -> Map VName BoundV -> Map VName BoundV
forall a. Semigroup a => a -> a -> a
<> Map VName BoundV
vt2) (Map VName TypeBinding
tt1 Map VName TypeBinding
-> Map VName TypeBinding -> Map VName TypeBinding
forall a. Semigroup a => a -> a -> a
<> Map VName TypeBinding
tt2) (Map VName MTy
st1 Map VName MTy -> Map VName MTy -> Map VName MTy
forall a. Semigroup a => a -> a -> a
<> Map VName MTy
st2) (Map VName Mod
mt1 Map VName Mod -> Map VName Mod -> Map VName Mod
forall a. Semigroup a => a -> a -> a
<> Map VName Mod
mt2) (NameMap
nt1 NameMap -> NameMap -> NameMap
forall a. Semigroup a => a -> a -> a
<> NameMap
nt2)

instance Pretty Namespace where
  pretty :: forall ann. Namespace -> Doc ann
pretty Namespace
Term = Doc ann
"name"
  pretty Namespace
Type = Doc ann
"type"
  pretty Namespace
Signature = Doc ann
"module type"

instance Monoid Env where
  mempty :: Env
mempty = Map VName BoundV
-> Map VName TypeBinding
-> Map VName MTy
-> Map VName Mod
-> NameMap
-> Env
Env Map VName BoundV
forall a. Monoid a => a
mempty Map VName TypeBinding
forall a. Monoid a => a
mempty Map VName MTy
forall a. Monoid a => a
mempty Map VName Mod
forall a. Monoid a => a
mempty NameMap
forall a. Monoid a => a
mempty

instance Pretty MTy where
  pretty :: forall ann. MTy -> Doc ann
pretty = Mod -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Mod -> Doc ann
pretty (Mod -> Doc ann) -> (MTy -> Mod) -> MTy -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MTy -> Mod
mtyMod

instance Pretty Mod where
  pretty :: forall ann. Mod -> Doc ann
pretty (ModEnv Env
e) = Env -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Env -> Doc ann
pretty Env
e
  pretty (ModFun (FunModType TySet
_ Mod
mod MTy
mty)) = Mod -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Mod -> Doc ann
pretty Mod
mod Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"->" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
</> MTy -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. MTy -> Doc ann
pretty MTy
mty

instance Pretty Env where
  pretty :: forall ann. Env -> Doc ann
pretty (Env Map VName BoundV
vtable Map VName TypeBinding
ttable Map VName MTy
sigtable Map VName Mod
modtable NameMap
_) =
    Doc ann -> Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a -> Doc a
nestedBlock Doc ann
"{" Doc ann
"}" (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$
      [Doc ann] -> Doc ann
forall a. [Doc a] -> Doc a
stack ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$
        Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
line ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$
          [[Doc ann]] -> [Doc ann]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ ((VName, TypeBinding) -> Doc ann)
-> [(VName, TypeBinding)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (VName, TypeBinding) -> Doc ann
forall {v} {ann}. IsName v => (v, TypeBinding) -> Doc ann
renderTypeBind (Map VName TypeBinding -> [(VName, TypeBinding)]
forall k a. Map k a -> [(k, a)]
M.toList Map VName TypeBinding
ttable),
              ((VName, BoundV) -> Doc ann) -> [(VName, BoundV)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (VName, BoundV) -> Doc ann
forall {v} {ann}. IsName v => (v, BoundV) -> Doc ann
renderValBind (Map VName BoundV -> [(VName, BoundV)]
forall k a. Map k a -> [(k, a)]
M.toList Map VName BoundV
vtable),
              ((VName, MTy) -> Doc ann) -> [(VName, MTy)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (VName, MTy) -> Doc ann
forall {v} {b} {ann}. IsName v => (v, b) -> Doc ann
renderModType (Map VName MTy -> [(VName, MTy)]
forall k a. Map k a -> [(k, a)]
M.toList Map VName MTy
sigtable),
              ((VName, Mod) -> Doc ann) -> [(VName, Mod)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (VName, Mod) -> Doc ann
forall {v} {a} {ann}. (IsName v, Pretty a) => (v, a) -> Doc ann
renderMod (Map VName Mod -> [(VName, Mod)]
forall k a. Map k a -> [(k, a)]
M.toList Map VName Mod
modtable)
            ]
    where
      renderTypeBind :: (v, TypeBinding) -> Doc ann
renderTypeBind (v
name, TypeAbbr Liftedness
l [TypeParam]
tps StructRetType
tp) =
        Liftedness -> Doc ann
forall {a}. IsString a => Liftedness -> a
p Liftedness
l
          Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> v -> Doc ann
forall a. v -> Doc a
forall v a. IsName v => v -> Doc a
prettyName v
name
          Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat ((TypeParam -> Doc ann) -> [TypeParam] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map ((Doc ann
" " <>) (Doc ann -> Doc ann)
-> (TypeParam -> Doc ann) -> TypeParam -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeParam -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeParam -> Doc ann
pretty) [TypeParam]
tps)
          Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" ="
            Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> StructRetType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. StructRetType -> Doc ann
pretty StructRetType
tp
        where
          p :: Liftedness -> a
p Liftedness
Lifted = a
"type^"
          p Liftedness
SizeLifted = a
"type~"
          p Liftedness
Unlifted = a
"type"
      renderValBind :: (v, BoundV) -> Doc ann
renderValBind (v
name, BoundV [TypeParam]
tps StructType
t) =
        Doc ann
"val"
          Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> v -> Doc ann
forall a. v -> Doc a
forall v a. IsName v => v -> Doc a
prettyName v
name
          Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat ((TypeParam -> Doc ann) -> [TypeParam] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map ((Doc ann
" " <>) (Doc ann -> Doc ann)
-> (TypeParam -> Doc ann) -> TypeParam -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeParam -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TypeParam -> Doc ann
pretty) [TypeParam]
tps)
          Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" ="
            Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> StructType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. StructType -> Doc ann
pretty StructType
t
      renderModType :: (v, b) -> Doc ann
renderModType (v
name, b
_sig) =
        Doc ann
"module type" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> v -> Doc ann
forall a. v -> Doc a
forall v a. IsName v => v -> Doc a
prettyName v
name
      renderMod :: (v, a) -> Doc ann
renderMod (v
name, a
mod) =
        Doc ann
"module" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> v -> Doc ann
forall a. v -> Doc a
forall v a. IsName v => v -> Doc a
prettyName v
name Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" =" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
mod