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

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

-- | Canonical reference to a Futhark code file.  Does not include the
-- @.fut@ extension.  This is most often a path relative to the
-- current working directory of the compiler.
data ImportName = ImportName Posix.FilePath SrcLoc
  deriving (ImportName -> ImportName -> Bool
(ImportName -> ImportName -> Bool)
-> (ImportName -> ImportName -> Bool) -> Eq ImportName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportName -> ImportName -> Bool
$c/= :: ImportName -> ImportName -> Bool
== :: ImportName -> ImportName -> Bool
$c== :: ImportName -> ImportName -> Bool
Eq, Eq ImportName
Eq ImportName
-> (ImportName -> ImportName -> Ordering)
-> (ImportName -> ImportName -> Bool)
-> (ImportName -> ImportName -> Bool)
-> (ImportName -> ImportName -> Bool)
-> (ImportName -> ImportName -> Bool)
-> (ImportName -> ImportName -> ImportName)
-> (ImportName -> ImportName -> ImportName)
-> Ord ImportName
ImportName -> ImportName -> Bool
ImportName -> ImportName -> Ordering
ImportName -> ImportName -> ImportName
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
min :: ImportName -> ImportName -> ImportName
$cmin :: ImportName -> ImportName -> ImportName
max :: ImportName -> ImportName -> ImportName
$cmax :: ImportName -> ImportName -> ImportName
>= :: ImportName -> ImportName -> Bool
$c>= :: ImportName -> ImportName -> Bool
> :: ImportName -> ImportName -> Bool
$c> :: ImportName -> ImportName -> Bool
<= :: ImportName -> ImportName -> Bool
$c<= :: ImportName -> ImportName -> Bool
< :: ImportName -> ImportName -> Bool
$c< :: ImportName -> ImportName -> Bool
compare :: ImportName -> ImportName -> Ordering
$ccompare :: ImportName -> ImportName -> Ordering
Ord, Int -> ImportName -> ShowS
[ImportName] -> ShowS
ImportName -> FilePath
(Int -> ImportName -> ShowS)
-> (ImportName -> FilePath)
-> ([ImportName] -> ShowS)
-> Show ImportName
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ImportName] -> ShowS
$cshowList :: [ImportName] -> ShowS
show :: ImportName -> FilePath
$cshow :: ImportName -> FilePath
showsPrec :: Int -> ImportName -> ShowS
$cshowsPrec :: Int -> ImportName -> ShowS
Show)

instance Located ImportName where
  locOf :: ImportName -> Loc
locOf (ImportName FilePath
_ SrcLoc
loc) = SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf SrcLoc
loc

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

-- | 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 -> SrcLoc -> ImportName
mkImportFrom :: ImportName -> FilePath -> SrcLoc -> ImportName
mkImportFrom (ImportName FilePath
includer SrcLoc
_) FilePath
includee
  | FilePath -> Bool
Posix.isAbsolute FilePath
includee = FilePath -> SrcLoc -> ImportName
ImportName FilePath
includee
  | Bool
otherwise = FilePath -> SrcLoc -> ImportName
ImportName (FilePath -> SrcLoc -> ImportName)
-> FilePath -> SrcLoc -> ImportName
forall a b. (a -> b) -> a -> b
$ ShowS
Posix.normalise ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
Posix.joinPath ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath]
includer' [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
includee'
  where
    ([FilePath]
dotdots, [FilePath]
includee') = (FilePath -> Bool) -> [FilePath] -> ([FilePath], [FilePath])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (FilePath
"../" FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
==) ([FilePath] -> ([FilePath], [FilePath]))
-> [FilePath] -> ([FilePath], [FilePath])
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
Posix.splitPath FilePath
includee
    includer_parts :: [FilePath]
includer_parts = [FilePath] -> [FilePath]
forall a. [a] -> [a]
init ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
Posix.splitPath FilePath
includer
    includer' :: [FilePath]
includer'
      | [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
dotdots Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
includer_parts =
        Int -> FilePath -> [FilePath]
forall a. Int -> a -> [a]
replicate ([FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
dotdots Int -> Int -> Int
forall a. Num a => a -> a -> a
- [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
includer_parts) FilePath
"../"
      | Bool
otherwise =
        Int -> [FilePath] -> [FilePath]
forall a. Int -> [a] -> [a]
dropLast ([FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
dotdots) [FilePath]
includer_parts

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

-- | Produce a human-readable canonicalized string from an
-- 'ImportName'.
includeToString :: ImportName -> String
includeToString :: ImportName -> FilePath
includeToString (ImportName FilePath
s SrcLoc
_) = ShowS
Posix.normalise ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ FilePath -> ShowS
Posix.makeRelative FilePath
"/" 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,
    FileModule -> Env
fileEnv :: Env,
    FileModule -> Prog
fileProg :: Prog
  }

-- | A mapping from import names to imports.  The ordering is significant.
type Imports = [(String, 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
/= :: Namespace -> Namespace -> Bool
$c/= :: Namespace -> Namespace -> Bool
== :: Namespace -> Namespace -> Bool
$c== :: 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
min :: Namespace -> Namespace -> Namespace
$cmin :: Namespace -> Namespace -> Namespace
max :: Namespace -> Namespace -> Namespace
$cmax :: Namespace -> Namespace -> Namespace
>= :: Namespace -> Namespace -> Bool
$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
compare :: Namespace -> Namespace -> Ordering
$ccompare :: Namespace -> Namespace -> Ordering
Ord, Int -> Namespace -> ShowS
[Namespace] -> ShowS
Namespace -> FilePath
(Int -> Namespace -> ShowS)
-> (Namespace -> FilePath)
-> ([Namespace] -> ShowS)
-> Show Namespace
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Namespace] -> ShowS
$cshowList :: [Namespace] -> ShowS
show :: Namespace -> FilePath
$cshow :: Namespace -> FilePath
showsPrec :: Int -> Namespace -> ShowS
$cshowsPrec :: Int -> Namespace -> ShowS
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
enumFromThenTo :: Namespace -> Namespace -> Namespace -> [Namespace]
$cenumFromThenTo :: Namespace -> Namespace -> Namespace -> [Namespace]
enumFromTo :: Namespace -> Namespace -> [Namespace]
$cenumFromTo :: Namespace -> Namespace -> [Namespace]
enumFromThen :: Namespace -> Namespace -> [Namespace]
$cenumFromThen :: Namespace -> Namespace -> [Namespace]
enumFrom :: Namespace -> [Namespace]
$cenumFrom :: Namespace -> [Namespace]
fromEnum :: Namespace -> Int
$cfromEnum :: Namespace -> Int
toEnum :: Int -> Namespace
$ctoEnum :: Int -> Namespace
pred :: Namespace -> Namespace
$cpred :: Namespace -> Namespace
succ :: Namespace -> Namespace
$csucc :: 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 FunSig
  deriving (Int -> Mod -> ShowS
[Mod] -> ShowS
Mod -> FilePath
(Int -> Mod -> ShowS)
-> (Mod -> FilePath) -> ([Mod] -> ShowS) -> Show Mod
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Mod] -> ShowS
$cshowList :: [Mod] -> ShowS
show :: Mod -> FilePath
$cshow :: Mod -> FilePath
showsPrec :: Int -> Mod -> ShowS
$cshowsPrec :: Int -> Mod -> ShowS
Show)

-- | A parametric functor consists of a set of abstract types, the
-- environment of its parameter, and the resulting module type.
data FunSig = FunSig
  { FunSig -> TySet
funSigAbs :: TySet,
    FunSig -> Mod
funSigMod :: Mod,
    FunSig -> MTy
funSigMty :: MTy
  }
  deriving (Int -> FunSig -> ShowS
[FunSig] -> ShowS
FunSig -> FilePath
(Int -> FunSig -> ShowS)
-> (FunSig -> FilePath) -> ([FunSig] -> ShowS) -> Show FunSig
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [FunSig] -> ShowS
$cshowList :: [FunSig] -> ShowS
show :: FunSig -> FilePath
$cshow :: FunSig -> FilePath
showsPrec :: Int -> FunSig -> ShowS
$cshowsPrec :: Int -> FunSig -> ShowS
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 -> ShowS
[MTy] -> ShowS
MTy -> FilePath
(Int -> MTy -> ShowS)
-> (MTy -> FilePath) -> ([MTy] -> ShowS) -> Show MTy
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MTy] -> ShowS
$cshowList :: [MTy] -> ShowS
show :: MTy -> FilePath
$cshow :: MTy -> FilePath
showsPrec :: Int -> MTy -> ShowS
$cshowsPrec :: Int -> MTy -> ShowS
Show)

-- | A binding from a name to its definition as a type.
data TypeBinding = TypeAbbr Liftedness [TypeParam] StructType
  deriving (TypeBinding -> TypeBinding -> Bool
(TypeBinding -> TypeBinding -> Bool)
-> (TypeBinding -> TypeBinding -> Bool) -> Eq TypeBinding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeBinding -> TypeBinding -> Bool
$c/= :: TypeBinding -> TypeBinding -> Bool
== :: TypeBinding -> TypeBinding -> Bool
$c== :: TypeBinding -> TypeBinding -> Bool
Eq, Int -> TypeBinding -> ShowS
[TypeBinding] -> ShowS
TypeBinding -> FilePath
(Int -> TypeBinding -> ShowS)
-> (TypeBinding -> FilePath)
-> ([TypeBinding] -> ShowS)
-> Show TypeBinding
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TypeBinding] -> ShowS
$cshowList :: [TypeBinding] -> ShowS
show :: TypeBinding -> FilePath
$cshow :: TypeBinding -> FilePath
showsPrec :: Int -> TypeBinding -> ShowS
$cshowsPrec :: Int -> TypeBinding -> ShowS
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 [TypeParam] StructType
  deriving (Int -> BoundV -> ShowS
[BoundV] -> ShowS
BoundV -> FilePath
(Int -> BoundV -> ShowS)
-> (BoundV -> FilePath) -> ([BoundV] -> ShowS) -> Show BoundV
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [BoundV] -> ShowS
$cshowList :: [BoundV] -> ShowS
show :: BoundV -> FilePath
$cshow :: BoundV -> FilePath
showsPrec :: Int -> BoundV -> ShowS
$cshowsPrec :: Int -> BoundV -> ShowS
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
envSigTable :: M.Map VName MTy,
    Env -> Map VName Mod
envModTable :: M.Map VName Mod,
    Env -> NameMap
envNameMap :: NameMap
  }
  deriving (Int -> Env -> ShowS
[Env] -> ShowS
Env -> FilePath
(Int -> Env -> ShowS)
-> (Env -> FilePath) -> ([Env] -> ShowS) -> Show Env
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Env] -> ShowS
$cshowList :: [Env] -> ShowS
show :: Env -> FilePath
$cshow :: Env -> FilePath
showsPrec :: Int -> Env -> ShowS
$cshowsPrec :: Int -> Env -> ShowS
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
  ppr :: Namespace -> Doc
ppr Namespace
Term = FilePath -> Doc
text FilePath
"name"
  ppr Namespace
Type = FilePath -> Doc
text FilePath
"type"
  ppr Namespace
Signature = FilePath -> Doc
text FilePath
"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
  ppr :: MTy -> Doc
ppr = Mod -> Doc
forall a. Pretty a => a -> Doc
ppr (Mod -> Doc) -> (MTy -> Mod) -> MTy -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MTy -> Mod
mtyMod

instance Pretty Mod where
  ppr :: Mod -> Doc
ppr (ModEnv Env
e) = Env -> Doc
forall a. Pretty a => a -> Doc
ppr Env
e
  ppr (ModFun (FunSig TySet
_ Mod
mod MTy
mty)) = Mod -> Doc
forall a. Pretty a => a -> Doc
ppr Mod
mod Doc -> Doc -> Doc
<+> FilePath -> Doc
text FilePath
"->" Doc -> Doc -> Doc
</> MTy -> Doc
forall a. Pretty a => a -> Doc
ppr MTy
mty

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