mirror of
https://github.com/GaloisInc/cryptol.git
synced 2024-11-28 17:33:13 +03:00
add NFData instances for many cryptol types
add more benchmarks as well
This commit is contained in:
parent
e9c85a3925
commit
4e6dcaa026
@ -5,9 +5,9 @@
|
|||||||
-- Maintainer : cryptol@galois.com
|
-- Maintainer : cryptol@galois.com
|
||||||
-- Stability : provisional
|
-- Stability : provisional
|
||||||
-- Portability : portable
|
-- Portability : portable
|
||||||
module Main where
|
|
||||||
|
|
||||||
import Control.DeepSeq
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
module Main where
|
||||||
|
|
||||||
import qualified Data.Text.Lazy as T
|
import qualified Data.Text.Lazy as T
|
||||||
import qualified Data.Text.Lazy.IO as T
|
import qualified Data.Text.Lazy.IO as T
|
||||||
@ -20,7 +20,10 @@ import qualified Cryptol.Parser as P
|
|||||||
import qualified Cryptol.Parser.AST as P
|
import qualified Cryptol.Parser.AST as P
|
||||||
import qualified Cryptol.Parser.NoInclude as P
|
import qualified Cryptol.Parser.NoInclude as P
|
||||||
|
|
||||||
import qualified Cryptol.TypeCheck as T
|
import qualified Cryptol.Symbolic as S
|
||||||
|
|
||||||
|
import qualified Cryptol.TypeCheck as T
|
||||||
|
import qualified Cryptol.TypeCheck.AST as T
|
||||||
|
|
||||||
import Criterion.Main
|
import Criterion.Main
|
||||||
|
|
||||||
@ -30,11 +33,26 @@ main = defaultMain [
|
|||||||
parser "Prelude" "lib/Cryptol.cry"
|
parser "Prelude" "lib/Cryptol.cry"
|
||||||
, parser "BigSequence" "bench/data/BigSequence.cry"
|
, parser "BigSequence" "bench/data/BigSequence.cry"
|
||||||
, parser "BigSequenceHex" "bench/data/BigSequenceHex.cry"
|
, parser "BigSequenceHex" "bench/data/BigSequenceHex.cry"
|
||||||
|
, parser "AES" "bench/data/AES.cry"
|
||||||
]
|
]
|
||||||
, bgroup "typechecker" [
|
, bgroup "typechecker" [
|
||||||
tc "Prelude" "lib/Cryptol.cry"
|
tc "Prelude" "lib/Cryptol.cry"
|
||||||
, tc "BigSequence" "bench/data/BigSequence.cry"
|
, tc "BigSequence" "bench/data/BigSequence.cry"
|
||||||
, tc "BigSequenceHex" "bench/data/BigSequenceHex.cry"
|
, tc "BigSequenceHex" "bench/data/BigSequenceHex.cry"
|
||||||
|
, tc "AES" "bench/data/AES.cry"
|
||||||
|
]
|
||||||
|
, bgroup "conc_eval" [
|
||||||
|
ceval "AES" "bench/data/AES.cry" "bench bench_data"
|
||||||
|
]
|
||||||
|
, bgroup "sym_eval" [
|
||||||
|
seval False "AES" "bench/data/AES.cry" "aesEncrypt (zero, zero)"
|
||||||
|
, seval False "ZUC"
|
||||||
|
"bench/data/ZUC.cry" "ZUC_isResistantToCollisionAttack"
|
||||||
|
]
|
||||||
|
, bgroup "sym_eval_ite" [
|
||||||
|
seval True "aesEncrypt" "bench/data/AES.cry" "aesEncrypt (zero, zero)"
|
||||||
|
, seval True "ZUC"
|
||||||
|
"bench/data/ZUC.cry" "ZUC_isResistantToCollisionAttack"
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
|
|
||||||
@ -42,7 +60,7 @@ main = defaultMain [
|
|||||||
parser :: String -> FilePath -> Benchmark
|
parser :: String -> FilePath -> Benchmark
|
||||||
parser name path =
|
parser name path =
|
||||||
env (T.readFile path) $ \(~bytes) ->
|
env (T.readFile path) $ \(~bytes) ->
|
||||||
bench name $ whnfIO $ do
|
bench name $ nfIO $ do
|
||||||
let cfg = P.defaultConfig
|
let cfg = P.defaultConfig
|
||||||
{ P.cfgSource = path
|
{ P.cfgSource = path
|
||||||
, P.cfgPreProc = P.guessPreProc path
|
, P.cfgPreProc = P.guessPreProc path
|
||||||
@ -73,15 +91,37 @@ tc name path =
|
|||||||
M.renameModule npm
|
M.renameModule npm
|
||||||
return (scm, menv')
|
return (scm, menv')
|
||||||
in env setup $ \ ~(scm, menv) ->
|
in env setup $ \ ~(scm, menv) ->
|
||||||
bench name $ whnfIO $ M.runModuleM menv $ do
|
bench name $ nfIO $ M.runModuleM menv $ do
|
||||||
let act = M.TCAction { M.tcAction = T.tcModule
|
let act = M.TCAction { M.tcAction = T.tcModule
|
||||||
, M.tcLinter = M.moduleLinter (P.thing (P.mName scm)) }
|
, M.tcLinter = M.moduleLinter (P.thing (P.mName scm)) }
|
||||||
M.typecheck act scm =<< M.importIfacesTc (map P.thing (P.mImports scm))
|
M.typecheck act scm =<< M.importIfacesTc (map P.thing (P.mImports scm))
|
||||||
|
|
||||||
-- FIXME: this should only throw off the first benchmark run, but still...
|
ceval :: String -> FilePath -> T.Text -> Benchmark
|
||||||
instance NFData P.Module where
|
ceval name path expr =
|
||||||
rnf _ = ()
|
let setup = do
|
||||||
|
menv <- M.initialModuleEnv
|
||||||
|
(Right (texpr, menv'), _) <- M.runModuleM menv $ do
|
||||||
|
m <- M.loadModuleByPath path
|
||||||
|
M.setFocusedModule (T.mName m)
|
||||||
|
let Right pexpr = P.parseExpr expr
|
||||||
|
(_, texpr, _) <- M.checkExpr pexpr
|
||||||
|
return texpr
|
||||||
|
return (texpr, menv')
|
||||||
|
in env setup $ \ ~(texpr, menv) ->
|
||||||
|
bench name $ nfIO $ M.runModuleM menv $ M.evalExpr texpr
|
||||||
|
|
||||||
-- FIXME: this should only throw off the first benchmark run, but still...
|
seval :: Bool-> String -> FilePath -> T.Text -> Benchmark
|
||||||
instance NFData M.ModuleEnv where
|
seval useIte name path expr =
|
||||||
rnf _ = ()
|
let setup = do
|
||||||
|
menv <- M.initialModuleEnv
|
||||||
|
(Right (texpr, menv'), _) <- M.runModuleM menv $ do
|
||||||
|
m <- M.loadModuleByPath path
|
||||||
|
M.setFocusedModule (T.mName m)
|
||||||
|
let Right pexpr = P.parseExpr expr
|
||||||
|
(_, texpr, _) <- M.checkExpr pexpr
|
||||||
|
return texpr
|
||||||
|
return (texpr, menv')
|
||||||
|
in env setup $ \ ~(texpr, menv) ->
|
||||||
|
bench name $ flip nf texpr $ \texpr' ->
|
||||||
|
let senv = S.evalDecls (S.emptyEnv useIte) (S.allDeclGroups menv)
|
||||||
|
in S.evalExpr senv texpr'
|
||||||
|
@ -8,7 +8,7 @@
|
|||||||
|
|
||||||
{-# LANGUAGE FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
{-# LANGUAGE Safe #-}
|
{-# LANGUAGE Safe #-}
|
||||||
|
{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
|
||||||
module Cryptol.Eval.Env where
|
module Cryptol.Eval.Env where
|
||||||
|
|
||||||
import Cryptol.Eval.Value
|
import Cryptol.Eval.Value
|
||||||
@ -17,6 +17,9 @@ import Cryptol.Utils.PP
|
|||||||
|
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
|
|
||||||
|
import GHC.Generics (Generic)
|
||||||
|
import Control.DeepSeq
|
||||||
|
|
||||||
#if __GLASGOW_HASKELL__ < 710
|
#if __GLASGOW_HASKELL__ < 710
|
||||||
import Data.Monoid (Monoid(..))
|
import Data.Monoid (Monoid(..))
|
||||||
#endif
|
#endif
|
||||||
@ -28,7 +31,7 @@ type ReadEnv = EvalEnv
|
|||||||
data EvalEnv = EvalEnv
|
data EvalEnv = EvalEnv
|
||||||
{ envVars :: Map.Map QName Value
|
{ envVars :: Map.Map QName Value
|
||||||
, envTypes :: Map.Map TVar TValue
|
, envTypes :: Map.Map TVar TValue
|
||||||
}
|
} deriving (Generic, NFData)
|
||||||
|
|
||||||
instance Monoid EvalEnv where
|
instance Monoid EvalEnv where
|
||||||
mempty = EvalEnv
|
mempty = EvalEnv
|
||||||
|
@ -11,7 +11,7 @@
|
|||||||
{-# LANGUAGE FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
{-# LANGUAGE Safe #-}
|
{-# LANGUAGE Safe #-}
|
||||||
|
{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
|
||||||
module Cryptol.Eval.Value where
|
module Cryptol.Eval.Value where
|
||||||
|
|
||||||
import qualified Cryptol.Eval.Arch as Arch
|
import qualified Cryptol.Eval.Arch as Arch
|
||||||
@ -26,6 +26,8 @@ import Data.List(genericTake)
|
|||||||
import Data.Bits (setBit,testBit,(.&.),shiftL)
|
import Data.Bits (setBit,testBit,(.&.),shiftL)
|
||||||
import Numeric (showIntAtBase)
|
import Numeric (showIntAtBase)
|
||||||
|
|
||||||
|
import GHC.Generics (Generic)
|
||||||
|
import Control.DeepSeq
|
||||||
|
|
||||||
-- Utilities -------------------------------------------------------------------
|
-- Utilities -------------------------------------------------------------------
|
||||||
|
|
||||||
@ -75,8 +77,9 @@ finTValue tval =
|
|||||||
|
|
||||||
-- Values ----------------------------------------------------------------------
|
-- Values ----------------------------------------------------------------------
|
||||||
|
|
||||||
data BV = BV !Integer !Integer -- ^ width, value
|
-- | width, value
|
||||||
-- The value may contain junk bits
|
-- The value may contain junk bits
|
||||||
|
data BV = BV !Integer !Integer deriving (Generic, NFData)
|
||||||
|
|
||||||
-- | Smart constructor for 'BV's that checks for the width limit
|
-- | Smart constructor for 'BV's that checks for the width limit
|
||||||
mkBv :: Integer -> Integer -> BV
|
mkBv :: Integer -> Integer -> BV
|
||||||
@ -95,12 +98,13 @@ data GenValue b w
|
|||||||
| VStream [GenValue b w] -- @ [inf]a @
|
| VStream [GenValue b w] -- @ [inf]a @
|
||||||
| VFun (GenValue b w -> GenValue b w) -- functions
|
| VFun (GenValue b w -> GenValue b w) -- functions
|
||||||
| VPoly (TValue -> GenValue b w) -- polymorphic values (kind *)
|
| VPoly (TValue -> GenValue b w) -- polymorphic values (kind *)
|
||||||
|
deriving (Generic, NFData)
|
||||||
|
|
||||||
type Value = GenValue Bool BV
|
type Value = GenValue Bool BV
|
||||||
|
|
||||||
-- | An evaluated type.
|
-- | An evaluated type.
|
||||||
-- These types do not contain type variables, type synonyms, or type functions.
|
-- These types do not contain type variables, type synonyms, or type functions.
|
||||||
newtype TValue = TValue { tValTy :: Type }
|
newtype TValue = TValue { tValTy :: Type } deriving (Generic, NFData)
|
||||||
|
|
||||||
instance Show TValue where
|
instance Show TValue where
|
||||||
showsPrec p (TValue v) = showsPrec p v
|
showsPrec p (TValue v) = showsPrec p v
|
||||||
|
@ -8,7 +8,7 @@
|
|||||||
|
|
||||||
{-# LANGUAGE CPP #-}
|
{-# LANGUAGE CPP #-}
|
||||||
{-# LANGUAGE PatternGuards #-}
|
{-# LANGUAGE PatternGuards #-}
|
||||||
|
{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
|
||||||
module Cryptol.ModuleSystem.Env where
|
module Cryptol.ModuleSystem.Env where
|
||||||
|
|
||||||
#ifndef RELOCATABLE
|
#ifndef RELOCATABLE
|
||||||
@ -33,6 +33,9 @@ import System.Environment(getExecutablePath)
|
|||||||
import System.FilePath ((</>), normalise, joinPath, splitPath, takeDirectory)
|
import System.FilePath ((</>), normalise, joinPath, splitPath, takeDirectory)
|
||||||
import qualified Data.List as List
|
import qualified Data.List as List
|
||||||
|
|
||||||
|
import GHC.Generics (Generic)
|
||||||
|
import Control.DeepSeq
|
||||||
|
|
||||||
#if __GLASGOW_HASKELL__ < 710
|
#if __GLASGOW_HASKELL__ < 710
|
||||||
import Data.Monoid (Monoid(..))
|
import Data.Monoid (Monoid(..))
|
||||||
#endif
|
#endif
|
||||||
@ -49,10 +52,11 @@ data ModuleEnv = ModuleEnv
|
|||||||
, meMonoBinds :: !Bool
|
, meMonoBinds :: !Bool
|
||||||
, meSolverConfig :: T.SolverConfig
|
, meSolverConfig :: T.SolverConfig
|
||||||
, meCoreLint :: CoreLint
|
, meCoreLint :: CoreLint
|
||||||
}
|
} deriving (Generic, NFData)
|
||||||
|
|
||||||
data CoreLint = NoCoreLint -- ^ Don't run core lint
|
data CoreLint = NoCoreLint -- ^ Don't run core lint
|
||||||
| CoreLint -- ^ Run core lint
|
| CoreLint -- ^ Run core lint
|
||||||
|
deriving (Generic, NFData)
|
||||||
|
|
||||||
resetModuleEnv :: ModuleEnv -> ModuleEnv
|
resetModuleEnv :: ModuleEnv -> ModuleEnv
|
||||||
resetModuleEnv env = env
|
resetModuleEnv env = env
|
||||||
@ -159,7 +163,7 @@ loadModuleEnv processIface me = do
|
|||||||
|
|
||||||
newtype LoadedModules = LoadedModules
|
newtype LoadedModules = LoadedModules
|
||||||
{ getLoadedModules :: [LoadedModule]
|
{ getLoadedModules :: [LoadedModule]
|
||||||
} deriving (Show)
|
} deriving (Show, Generic, NFData)
|
||||||
-- ^ Invariant: All the dependencies of any module `m` must precede `m` in the list.
|
-- ^ Invariant: All the dependencies of any module `m` must precede `m` in the list.
|
||||||
|
|
||||||
instance Monoid LoadedModules where
|
instance Monoid LoadedModules where
|
||||||
@ -172,7 +176,7 @@ data LoadedModule = LoadedModule
|
|||||||
, lmFilePath :: FilePath
|
, lmFilePath :: FilePath
|
||||||
, lmInterface :: Iface
|
, lmInterface :: Iface
|
||||||
, lmModule :: T.Module
|
, lmModule :: T.Module
|
||||||
} deriving (Show)
|
} deriving (Show, Generic, NFData)
|
||||||
|
|
||||||
isLoaded :: ModName -> LoadedModules -> Bool
|
isLoaded :: ModName -> LoadedModules -> Bool
|
||||||
isLoaded mn lm = any ((mn ==) . lmName) (getLoadedModules lm)
|
isLoaded mn lm = any ((mn ==) . lmName) (getLoadedModules lm)
|
||||||
@ -213,7 +217,7 @@ data DynamicEnv = DEnv
|
|||||||
{ deNames :: R.NamingEnv
|
{ deNames :: R.NamingEnv
|
||||||
, deDecls :: [T.DeclGroup]
|
, deDecls :: [T.DeclGroup]
|
||||||
, deEnv :: EvalEnv
|
, deEnv :: EvalEnv
|
||||||
}
|
} deriving (Generic, NFData)
|
||||||
|
|
||||||
instance Monoid DynamicEnv where
|
instance Monoid DynamicEnv where
|
||||||
mempty = DEnv
|
mempty = DEnv
|
||||||
|
@ -7,6 +7,7 @@
|
|||||||
-- Portability : portable
|
-- Portability : portable
|
||||||
|
|
||||||
{-# LANGUAGE PatternGuards #-}
|
{-# LANGUAGE PatternGuards #-}
|
||||||
|
{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
|
||||||
module Cryptol.ModuleSystem.Interface (
|
module Cryptol.ModuleSystem.Interface (
|
||||||
Iface(..)
|
Iface(..)
|
||||||
, IfaceDecls(..)
|
, IfaceDecls(..)
|
||||||
@ -26,6 +27,9 @@ import Cryptol.Utils.PP
|
|||||||
|
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
|
|
||||||
|
import GHC.Generics (Generic)
|
||||||
|
import Control.DeepSeq
|
||||||
|
|
||||||
#if __GLASGOW_HASKELL__ < 710
|
#if __GLASGOW_HASKELL__ < 710
|
||||||
import Data.Monoid (Monoid(..))
|
import Data.Monoid (Monoid(..))
|
||||||
#endif
|
#endif
|
||||||
@ -35,13 +39,13 @@ data Iface = Iface
|
|||||||
{ ifModName :: ModName
|
{ ifModName :: ModName
|
||||||
, ifPublic :: IfaceDecls
|
, ifPublic :: IfaceDecls
|
||||||
, ifPrivate :: IfaceDecls
|
, ifPrivate :: IfaceDecls
|
||||||
} deriving (Show)
|
} deriving (Show, Generic, NFData)
|
||||||
|
|
||||||
data IfaceDecls = IfaceDecls
|
data IfaceDecls = IfaceDecls
|
||||||
{ ifTySyns :: Map.Map QName [IfaceTySyn]
|
{ ifTySyns :: Map.Map QName [IfaceTySyn]
|
||||||
, ifNewtypes :: Map.Map QName [IfaceNewtype]
|
, ifNewtypes :: Map.Map QName [IfaceNewtype]
|
||||||
, ifDecls :: Map.Map QName [IfaceDecl]
|
, ifDecls :: Map.Map QName [IfaceDecl]
|
||||||
} deriving (Show)
|
} deriving (Show, Generic, NFData)
|
||||||
|
|
||||||
instance Monoid IfaceDecls where
|
instance Monoid IfaceDecls where
|
||||||
mempty = IfaceDecls Map.empty Map.empty Map.empty
|
mempty = IfaceDecls Map.empty Map.empty Map.empty
|
||||||
@ -84,7 +88,7 @@ data IfaceDecl = IfaceDecl
|
|||||||
, ifDeclInfix :: Bool
|
, ifDeclInfix :: Bool
|
||||||
, ifDeclFixity :: Maybe Fixity
|
, ifDeclFixity :: Maybe Fixity
|
||||||
, ifDeclDoc :: Maybe String
|
, ifDeclDoc :: Maybe String
|
||||||
} deriving (Show)
|
} deriving (Show, Generic, NFData)
|
||||||
|
|
||||||
mkIfaceDecl :: Decl -> IfaceDecl
|
mkIfaceDecl :: Decl -> IfaceDecl
|
||||||
mkIfaceDecl d = IfaceDecl
|
mkIfaceDecl d = IfaceDecl
|
||||||
|
@ -7,7 +7,7 @@
|
|||||||
-- Portability : portable
|
-- Portability : portable
|
||||||
|
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
|
{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
|
||||||
module Cryptol.ModuleSystem.Monad where
|
module Cryptol.ModuleSystem.Monad where
|
||||||
|
|
||||||
import Cryptol.Eval.Env (EvalEnv)
|
import Cryptol.Eval.Env (EvalEnv)
|
||||||
@ -30,6 +30,9 @@ import Data.Function (on)
|
|||||||
import Data.Maybe (isJust)
|
import Data.Maybe (isJust)
|
||||||
import MonadLib
|
import MonadLib
|
||||||
|
|
||||||
|
import GHC.Generics (Generic)
|
||||||
|
import Control.DeepSeq
|
||||||
|
|
||||||
#if __GLASGOW_HASKELL__ < 710
|
#if __GLASGOW_HASKELL__ < 710
|
||||||
import Control.Applicative (Applicative(..))
|
import Control.Applicative (Applicative(..))
|
||||||
#endif
|
#endif
|
||||||
@ -39,7 +42,7 @@ import Control.Applicative (Applicative(..))
|
|||||||
data ImportSource
|
data ImportSource
|
||||||
= FromModule P.ModName
|
= FromModule P.ModName
|
||||||
| FromImport (Located P.Import)
|
| FromImport (Located P.Import)
|
||||||
deriving (Show)
|
deriving (Show,Generic,NFData)
|
||||||
|
|
||||||
instance Eq ImportSource where
|
instance Eq ImportSource where
|
||||||
(==) = (==) `on` importedModule
|
(==) = (==) `on` importedModule
|
||||||
@ -82,6 +85,23 @@ data ModuleError
|
|||||||
-- ^ Two modules loaded from different files have the same module name
|
-- ^ Two modules loaded from different files have the same module name
|
||||||
deriving (Show)
|
deriving (Show)
|
||||||
|
|
||||||
|
instance NFData ModuleError where
|
||||||
|
rnf e = case e of
|
||||||
|
ModuleNotFound src path -> src `deepseq` path `deepseq` ()
|
||||||
|
CantFindFile path -> path `deepseq` ()
|
||||||
|
OtherIOError path exn -> path `deepseq` exn `seq` ()
|
||||||
|
ModuleParseError source err -> source `deepseq` err `deepseq` ()
|
||||||
|
RecursiveModules mods -> mods `deepseq` ()
|
||||||
|
RenamerErrors src errs -> src `deepseq` errs `deepseq` ()
|
||||||
|
NoPatErrors src errs -> src `deepseq` errs `deepseq` ()
|
||||||
|
NoIncludeErrors src errs -> src `deepseq` errs `deepseq` ()
|
||||||
|
TypeCheckingFailed src errs -> src `deepseq` errs `deepseq` ()
|
||||||
|
ModuleNameMismatch expected found ->
|
||||||
|
expected `deepseq` found `deepseq` ()
|
||||||
|
DuplicateModuleName name path1 path2 ->
|
||||||
|
name `deepseq` path1 `deepseq` path2 `deepseq` ()
|
||||||
|
OtherFailure x -> x `deepseq` ()
|
||||||
|
|
||||||
instance PP ModuleError where
|
instance PP ModuleError where
|
||||||
ppPrec _ e = case e of
|
ppPrec _ e = case e of
|
||||||
|
|
||||||
@ -184,7 +204,7 @@ duplicateModuleName name path1 path2 =
|
|||||||
data ModuleWarning
|
data ModuleWarning
|
||||||
= TypeCheckWarnings [(Range,T.Warning)]
|
= TypeCheckWarnings [(Range,T.Warning)]
|
||||||
| RenamerWarnings [RenamerWarning]
|
| RenamerWarnings [RenamerWarning]
|
||||||
deriving (Show)
|
deriving (Show,Generic,NFData)
|
||||||
|
|
||||||
instance PP ModuleWarning where
|
instance PP ModuleWarning where
|
||||||
ppPrec _ w = case w of
|
ppPrec _ w = case w of
|
||||||
|
@ -1,18 +1,21 @@
|
|||||||
|
{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
|
||||||
module Cryptol.ModuleSystem.Name where
|
module Cryptol.ModuleSystem.Name where
|
||||||
|
|
||||||
|
import GHC.Generics (Generic)
|
||||||
|
import Control.DeepSeq
|
||||||
|
|
||||||
-- | Module names are just namespaces.
|
-- | Module names are just namespaces.
|
||||||
--
|
--
|
||||||
-- INVARIANT: the list of strings should never be empty in a valid module name.
|
-- INVARIANT: the list of strings should never be empty in a valid module name.
|
||||||
newtype ModName = ModName [String]
|
newtype ModName = ModName [String]
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show,Generic,NFData)
|
||||||
|
|
||||||
data Name = Name String
|
data Name = Name String
|
||||||
| NewName Pass Int
|
| NewName Pass Int
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show,Generic,NFData)
|
||||||
|
|
||||||
data QName = QName (Maybe ModName) Name
|
data QName = QName (Maybe ModName) Name
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show,Generic,NFData)
|
||||||
|
|
||||||
-- XXX It would be nice to also mark this as a name that doesn't need to be
|
-- XXX It would be nice to also mark this as a name that doesn't need to be
|
||||||
-- resolved, if it's going to be created before renaming.
|
-- resolved, if it's going to be created before renaming.
|
||||||
@ -30,4 +33,4 @@ unqual (QName _ n) = n
|
|||||||
|
|
||||||
|
|
||||||
data Pass = NoPat | MonoValues
|
data Pass = NoPat | MonoValues
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show,Generic,NFData)
|
||||||
|
@ -6,6 +6,7 @@
|
|||||||
-- Stability : provisional
|
-- Stability : provisional
|
||||||
-- Portability : portable
|
-- Portability : portable
|
||||||
|
|
||||||
|
{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
|
||||||
module Cryptol.ModuleSystem.NamingEnv where
|
module Cryptol.ModuleSystem.NamingEnv where
|
||||||
|
|
||||||
import Cryptol.ModuleSystem.Interface
|
import Cryptol.ModuleSystem.Interface
|
||||||
@ -19,6 +20,9 @@ import Cryptol.Utils.Panic (panic)
|
|||||||
import Data.Maybe (catMaybes)
|
import Data.Maybe (catMaybes)
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
|
|
||||||
|
import GHC.Generics (Generic)
|
||||||
|
import Control.DeepSeq
|
||||||
|
|
||||||
#if __GLASGOW_HASKELL__ < 710
|
#if __GLASGOW_HASKELL__ < 710
|
||||||
import Control.Applicative (Applicative, (<$>), (<*>), pure)
|
import Control.Applicative (Applicative, (<$>), (<*>), pure)
|
||||||
import Data.Monoid (Monoid(..))
|
import Data.Monoid (Monoid(..))
|
||||||
@ -30,7 +34,7 @@ import Data.Traversable (traverse)
|
|||||||
|
|
||||||
data NameOrigin = Local (Located QName)
|
data NameOrigin = Local (Located QName)
|
||||||
| Imported QName
|
| Imported QName
|
||||||
deriving (Show)
|
deriving (Show,Generic,NFData)
|
||||||
|
|
||||||
instance PP NameOrigin where
|
instance PP NameOrigin where
|
||||||
ppPrec _ o = case o of
|
ppPrec _ o = case o of
|
||||||
@ -47,13 +51,13 @@ instance PP NameOrigin where
|
|||||||
data EName = EFromBind (Located QName)
|
data EName = EFromBind (Located QName)
|
||||||
| EFromNewtype (Located QName)
|
| EFromNewtype (Located QName)
|
||||||
| EFromMod QName
|
| EFromMod QName
|
||||||
deriving (Show)
|
deriving (Show, Generic, NFData)
|
||||||
|
|
||||||
data TName = TFromParam QName
|
data TName = TFromParam QName
|
||||||
| TFromSyn (Located QName)
|
| TFromSyn (Located QName)
|
||||||
| TFromNewtype (Located QName)
|
| TFromNewtype (Located QName)
|
||||||
| TFromMod QName
|
| TFromMod QName
|
||||||
deriving (Show)
|
deriving (Show, Generic, NFData)
|
||||||
|
|
||||||
class HasQName a where
|
class HasQName a where
|
||||||
qname :: a -> QName
|
qname :: a -> QName
|
||||||
@ -93,7 +97,7 @@ data NamingEnv = NamingEnv { neExprs :: Map.Map QName [EName]
|
|||||||
, neTypes :: Map.Map QName [TName]
|
, neTypes :: Map.Map QName [TName]
|
||||||
-- ^ Type renaming environment
|
-- ^ Type renaming environment
|
||||||
, neFixity:: Map.Map QName [Fixity]
|
, neFixity:: Map.Map QName [Fixity]
|
||||||
} deriving (Show)
|
} deriving (Show, Generic, NFData)
|
||||||
|
|
||||||
instance Monoid NamingEnv where
|
instance Monoid NamingEnv where
|
||||||
mempty =
|
mempty =
|
||||||
|
@ -10,7 +10,7 @@
|
|||||||
{-# LANGUAGE FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
{-# LANGUAGE MultiWayIf #-}
|
{-# LANGUAGE MultiWayIf #-}
|
||||||
{-# LANGUAGE RecordWildCards #-}
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
|
{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
|
||||||
module Cryptol.ModuleSystem.Renamer (
|
module Cryptol.ModuleSystem.Renamer (
|
||||||
NamingEnv(), shadowing
|
NamingEnv(), shadowing
|
||||||
, BindsNames(..)
|
, BindsNames(..)
|
||||||
@ -31,6 +31,9 @@ import Cryptol.Utils.PP
|
|||||||
import MonadLib
|
import MonadLib
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
|
|
||||||
|
import GHC.Generics (Generic)
|
||||||
|
import Control.DeepSeq
|
||||||
|
|
||||||
#if __GLASGOW_HASKELL__ < 710
|
#if __GLASGOW_HASKELL__ < 710
|
||||||
import Control.Applicative(Applicative(..),(<$>))
|
import Control.Applicative(Applicative(..),(<$>))
|
||||||
import Data.Foldable (foldMap)
|
import Data.Foldable (foldMap)
|
||||||
@ -67,7 +70,7 @@ data RenamerError
|
|||||||
|
|
||||||
| InvalidConstraint Type
|
| InvalidConstraint Type
|
||||||
-- ^ When it's not possible to produce a Prop from a Type.
|
-- ^ When it's not possible to produce a Prop from a Type.
|
||||||
deriving (Show)
|
deriving (Show,Generic,NFData)
|
||||||
|
|
||||||
instance PP RenamerError where
|
instance PP RenamerError where
|
||||||
ppPrec _ e = case e of
|
ppPrec _ e = case e of
|
||||||
@ -115,7 +118,7 @@ instance PP RenamerError where
|
|||||||
|
|
||||||
data RenamerWarning
|
data RenamerWarning
|
||||||
= SymbolShadowed NameOrigin [NameOrigin]
|
= SymbolShadowed NameOrigin [NameOrigin]
|
||||||
deriving (Show)
|
deriving (Show,Generic,NFData)
|
||||||
|
|
||||||
instance PP RenamerWarning where
|
instance PP RenamerWarning where
|
||||||
ppPrec _ (SymbolShadowed new originals) =
|
ppPrec _ (SymbolShadowed new originals) =
|
||||||
|
@ -11,6 +11,7 @@
|
|||||||
{-# LANGUAGE RecordWildCards #-}
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
{-# LANGUAGE DeriveFoldable #-}
|
{-# LANGUAGE DeriveFoldable #-}
|
||||||
{-# LANGUAGE DeriveTraversable #-}
|
{-# LANGUAGE DeriveTraversable #-}
|
||||||
|
{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
|
||||||
module Cryptol.Parser.AST
|
module Cryptol.Parser.AST
|
||||||
( -- * Names
|
( -- * Names
|
||||||
ModName(..), {-splitNamespace, parseModName, nsChar,-} modRange
|
ModName(..), {-splitNamespace, parseModName, nsChar,-} modRange
|
||||||
@ -78,6 +79,9 @@ import Data.Bits(shiftR)
|
|||||||
import Data.Maybe (catMaybes)
|
import Data.Maybe (catMaybes)
|
||||||
import Numeric(showIntAtBase)
|
import Numeric(showIntAtBase)
|
||||||
|
|
||||||
|
import GHC.Generics (Generic)
|
||||||
|
import Control.DeepSeq
|
||||||
|
|
||||||
#if __GLASGOW_HASKELL__ < 710
|
#if __GLASGOW_HASKELL__ < 710
|
||||||
import Data.Foldable (Foldable(..))
|
import Data.Foldable (Foldable(..))
|
||||||
import Data.Monoid (Monoid(..))
|
import Data.Monoid (Monoid(..))
|
||||||
@ -101,7 +105,7 @@ newtype Program = Program [TopDecl]
|
|||||||
data Module = Module { mName :: Located ModName
|
data Module = Module { mName :: Located ModName
|
||||||
, mImports :: [Located Import]
|
, mImports :: [Located Import]
|
||||||
, mDecls :: [TopDecl]
|
, mDecls :: [TopDecl]
|
||||||
} deriving (Show)
|
} deriving (Show, Generic, NFData)
|
||||||
|
|
||||||
modRange :: Module -> Range
|
modRange :: Module -> Range
|
||||||
modRange m = rCombs $ catMaybes
|
modRange m = rCombs $ catMaybes
|
||||||
@ -115,7 +119,7 @@ modRange m = rCombs $ catMaybes
|
|||||||
data TopDecl = Decl (TopLevel Decl)
|
data TopDecl = Decl (TopLevel Decl)
|
||||||
| TDNewtype (TopLevel Newtype)
|
| TDNewtype (TopLevel Newtype)
|
||||||
| Include (Located FilePath)
|
| Include (Located FilePath)
|
||||||
deriving (Show)
|
deriving (Show,Generic,NFData)
|
||||||
|
|
||||||
data Decl = DSignature [LQName] Schema
|
data Decl = DSignature [LQName] Schema
|
||||||
| DFixity !Fixity [LQName]
|
| DFixity !Fixity [LQName]
|
||||||
@ -124,13 +128,13 @@ data Decl = DSignature [LQName] Schema
|
|||||||
| DPatBind Pattern Expr
|
| DPatBind Pattern Expr
|
||||||
| DType TySyn
|
| DType TySyn
|
||||||
| DLocated Decl Range
|
| DLocated Decl Range
|
||||||
deriving (Eq,Show)
|
deriving (Eq,Show,Generic,NFData)
|
||||||
|
|
||||||
-- | An import declaration.
|
-- | An import declaration.
|
||||||
data Import = Import { iModule :: ModName
|
data Import = Import { iModule :: ModName
|
||||||
, iAs :: Maybe ModName
|
, iAs :: Maybe ModName
|
||||||
, iSpec :: Maybe ImportSpec
|
, iSpec :: Maybe ImportSpec
|
||||||
} deriving (Eq,Show)
|
} deriving (Eq,Show,Generic,NFData)
|
||||||
|
|
||||||
-- | The list of names following an import.
|
-- | The list of names following an import.
|
||||||
--
|
--
|
||||||
@ -139,10 +143,10 @@ data Import = Import { iModule :: ModName
|
|||||||
-- present.
|
-- present.
|
||||||
data ImportSpec = Hiding [Name]
|
data ImportSpec = Hiding [Name]
|
||||||
| Only [Name]
|
| Only [Name]
|
||||||
deriving (Eq,Show)
|
deriving (Eq,Show,Generic,NFData)
|
||||||
|
|
||||||
data TySyn = TySyn LQName [TParam] Type
|
data TySyn = TySyn LQName [TParam] Type
|
||||||
deriving (Eq,Show)
|
deriving (Eq,Show,Generic,NFData)
|
||||||
|
|
||||||
{- | Bindings. Notes:
|
{- | Bindings. Notes:
|
||||||
|
|
||||||
@ -165,17 +169,17 @@ data Bind = Bind { bName :: LQName -- ^ Defined thing
|
|||||||
, bPragmas :: [Pragma] -- ^ Optional pragmas
|
, bPragmas :: [Pragma] -- ^ Optional pragmas
|
||||||
, bMono :: Bool -- ^ Is this a monomorphic binding
|
, bMono :: Bool -- ^ Is this a monomorphic binding
|
||||||
, bDoc :: Maybe String -- ^ Optional doc string
|
, bDoc :: Maybe String -- ^ Optional doc string
|
||||||
} deriving (Eq,Show)
|
} deriving (Eq,Show,Generic,NFData)
|
||||||
|
|
||||||
type LBindDef = Located BindDef
|
type LBindDef = Located BindDef
|
||||||
|
|
||||||
data BindDef = DPrim
|
data BindDef = DPrim
|
||||||
| DExpr Expr
|
| DExpr Expr
|
||||||
deriving (Eq,Show)
|
deriving (Eq,Show,Generic,NFData)
|
||||||
|
|
||||||
data Fixity = Fixity { fAssoc :: !Assoc
|
data Fixity = Fixity { fAssoc :: !Assoc
|
||||||
, fLevel :: !Int
|
, fLevel :: !Int
|
||||||
} deriving (Eq,Show)
|
} deriving (Eq,Show,Generic,NFData)
|
||||||
|
|
||||||
data FixityCmp = FCError
|
data FixityCmp = FCError
|
||||||
| FCLeft
|
| FCLeft
|
||||||
@ -198,12 +202,12 @@ defaultFixity = Fixity LeftAssoc 100
|
|||||||
|
|
||||||
data Pragma = PragmaNote String
|
data Pragma = PragmaNote String
|
||||||
| PragmaProperty
|
| PragmaProperty
|
||||||
deriving (Eq,Show)
|
deriving (Eq,Show,Generic,NFData)
|
||||||
|
|
||||||
data Newtype = Newtype { nName :: LQName -- ^ Type name
|
data Newtype = Newtype { nName :: LQName -- ^ Type name
|
||||||
, nParams :: [TParam] -- ^ Type params
|
, nParams :: [TParam] -- ^ Type params
|
||||||
, nBody :: [Named Type] -- ^ Constructor
|
, nBody :: [Named Type] -- ^ Constructor
|
||||||
} deriving (Eq,Show)
|
} deriving (Eq,Show,Generic,NFData)
|
||||||
|
|
||||||
-- | Input at the REPL, which can either be an expression or a @let@
|
-- | Input at the REPL, which can either be an expression or a @let@
|
||||||
-- statement.
|
-- statement.
|
||||||
@ -214,19 +218,19 @@ data ReplInput = ExprInput Expr
|
|||||||
-- | Export information for a declaration.
|
-- | Export information for a declaration.
|
||||||
data ExportType = Public
|
data ExportType = Public
|
||||||
| Private
|
| Private
|
||||||
deriving (Eq,Show,Ord)
|
deriving (Eq,Show,Ord,Generic,NFData)
|
||||||
|
|
||||||
data TopLevel a = TopLevel { tlExport :: ExportType
|
data TopLevel a = TopLevel { tlExport :: ExportType
|
||||||
, tlDoc :: Maybe (Located String)
|
, tlDoc :: Maybe (Located String)
|
||||||
, tlValue :: a
|
, tlValue :: a
|
||||||
} deriving (Show)
|
} deriving (Show,Generic,NFData)
|
||||||
|
|
||||||
instance Functor TopLevel where
|
instance Functor TopLevel where
|
||||||
fmap f tl = tl { tlValue = f (tlValue tl) }
|
fmap f tl = tl { tlValue = f (tlValue tl) }
|
||||||
|
|
||||||
data ExportSpec = ExportSpec { eTypes :: Set.Set QName
|
data ExportSpec = ExportSpec { eTypes :: Set.Set QName
|
||||||
, eBinds :: Set.Set QName
|
, eBinds :: Set.Set QName
|
||||||
} deriving (Show)
|
} deriving (Show,Generic,NFData)
|
||||||
|
|
||||||
instance Monoid ExportSpec where
|
instance Monoid ExportSpec where
|
||||||
mempty = ExportSpec { eTypes = mempty, eBinds = mempty }
|
mempty = ExportSpec { eTypes = mempty, eBinds = mempty }
|
||||||
@ -261,12 +265,12 @@ data NumInfo = BinLit Int -- ^ n-digit binary literal
|
|||||||
| HexLit Int -- ^ n-digit hex literal
|
| HexLit Int -- ^ n-digit hex literal
|
||||||
| CharLit -- ^ character literal
|
| CharLit -- ^ character literal
|
||||||
| PolyLit Int -- ^ polynomial literal
|
| PolyLit Int -- ^ polynomial literal
|
||||||
deriving (Eq,Show)
|
deriving (Eq,Show,Generic,NFData)
|
||||||
|
|
||||||
-- | Literals.
|
-- | Literals.
|
||||||
data Literal = ECNum Integer NumInfo -- ^ @0x10@ (HexLit 2)
|
data Literal = ECNum Integer NumInfo -- ^ @0x10@ (HexLit 2)
|
||||||
| ECString String -- ^ @\"hello\"@
|
| ECString String -- ^ @\"hello\"@
|
||||||
deriving (Eq,Show)
|
deriving (Eq,Show,Generic,NFData)
|
||||||
|
|
||||||
data Expr = EVar QName -- ^ @ x @
|
data Expr = EVar QName -- ^ @ x @
|
||||||
| ELit Literal -- ^ @ 0x10 @
|
| ELit Literal -- ^ @ 0x10 @
|
||||||
@ -288,11 +292,11 @@ data Expr = EVar QName -- ^ @ x @
|
|||||||
|
|
||||||
| EParens Expr -- ^ @ (e) @ (Removed by Fixity)
|
| EParens Expr -- ^ @ (e) @ (Removed by Fixity)
|
||||||
| EInfix Expr (LQName) Fixity Expr-- ^ @ a + b @ (Removed by Fixity)
|
| EInfix Expr (LQName) Fixity Expr-- ^ @ a + b @ (Removed by Fixity)
|
||||||
deriving (Eq,Show)
|
deriving (Eq,Show,Generic,NFData)
|
||||||
|
|
||||||
data TypeInst = NamedInst (Named Type)
|
data TypeInst = NamedInst (Named Type)
|
||||||
| PosInst Type
|
| PosInst Type
|
||||||
deriving (Eq,Show)
|
deriving (Eq,Show,Generic,NFData)
|
||||||
|
|
||||||
|
|
||||||
{- | Selectors are used for projecting from various components.
|
{- | Selectors are used for projecting from various components.
|
||||||
@ -312,11 +316,11 @@ data Selector = TupleSel Int (Maybe Int)
|
|||||||
| ListSel Int (Maybe Int)
|
| ListSel Int (Maybe Int)
|
||||||
-- ^ List selection.
|
-- ^ List selection.
|
||||||
-- Optionally specifies the length of the list.
|
-- Optionally specifies the length of the list.
|
||||||
deriving (Eq,Show,Ord)
|
deriving (Eq,Show,Ord,Generic,NFData)
|
||||||
|
|
||||||
data Match = Match Pattern Expr -- ^ p <- e
|
data Match = Match Pattern Expr -- ^ p <- e
|
||||||
| MatchLet Bind
|
| MatchLet Bind
|
||||||
deriving (Eq,Show)
|
deriving (Eq,Show,Generic,NFData)
|
||||||
|
|
||||||
data Pattern = PVar LName -- ^ @ x @
|
data Pattern = PVar LName -- ^ @ x @
|
||||||
| PWild -- ^ @ _ @
|
| PWild -- ^ @ _ @
|
||||||
@ -326,27 +330,27 @@ data Pattern = PVar LName -- ^ @ x @
|
|||||||
| PTyped Pattern Type -- ^ @ x : [8] @
|
| PTyped Pattern Type -- ^ @ x : [8] @
|
||||||
| PSplit Pattern Pattern -- ^ @ (x # y) @
|
| PSplit Pattern Pattern -- ^ @ (x # y) @
|
||||||
| PLocated Pattern Range -- ^ Location information
|
| PLocated Pattern Range -- ^ Location information
|
||||||
deriving (Eq,Show)
|
deriving (Eq,Show,Generic,NFData)
|
||||||
|
|
||||||
|
|
||||||
data Named a = Named { name :: Located Name, value :: a }
|
data Named a = Named { name :: Located Name, value :: a }
|
||||||
deriving (Eq,Show,Foldable,Traversable)
|
deriving (Eq,Show,Foldable,Traversable,Generic,NFData)
|
||||||
|
|
||||||
instance Functor Named where
|
instance Functor Named where
|
||||||
fmap f x = x { value = f (value x) }
|
fmap f x = x { value = f (value x) }
|
||||||
|
|
||||||
|
|
||||||
data Schema = Forall [TParam] [Prop] Type (Maybe Range)
|
data Schema = Forall [TParam] [Prop] Type (Maybe Range)
|
||||||
deriving (Eq,Show)
|
deriving (Eq,Show,Generic,NFData)
|
||||||
|
|
||||||
data Kind = KNum | KType
|
data Kind = KNum | KType
|
||||||
deriving (Eq,Show)
|
deriving (Eq,Show,Generic,NFData)
|
||||||
|
|
||||||
data TParam = TParam { tpName :: Name
|
data TParam = TParam { tpName :: Name
|
||||||
, tpKind :: Maybe Kind
|
, tpKind :: Maybe Kind
|
||||||
, tpRange :: Maybe Range
|
, tpRange :: Maybe Range
|
||||||
}
|
}
|
||||||
deriving (Eq,Show)
|
deriving (Eq,Show,Generic,NFData)
|
||||||
|
|
||||||
tpQName :: TParam -> QName
|
tpQName :: TParam -> QName
|
||||||
tpQName = mkUnqual . tpName
|
tpQName = mkUnqual . tpName
|
||||||
@ -366,7 +370,7 @@ data Type = TFun Type Type -- ^ @[8] -> [8]@
|
|||||||
| TLocated Type Range -- ^ Location information
|
| TLocated Type Range -- ^ Location information
|
||||||
| TParens Type -- ^ @ (ty) @
|
| TParens Type -- ^ @ (ty) @
|
||||||
| TInfix Type LQName Fixity Type -- ^ @ ty + ty @
|
| TInfix Type LQName Fixity Type -- ^ @ ty + ty @
|
||||||
deriving (Eq,Show)
|
deriving (Eq,Show,Generic,NFData)
|
||||||
|
|
||||||
data Prop = CFin Type -- ^ @ fin x @
|
data Prop = CFin Type -- ^ @ fin x @
|
||||||
| CEqual Type Type -- ^ @ x == 10 @
|
| CEqual Type Type -- ^ @ x == 10 @
|
||||||
@ -376,7 +380,7 @@ data Prop = CFin Type -- ^ @ fin x @
|
|||||||
| CLocated Prop Range -- ^ Location information
|
| CLocated Prop Range -- ^ Location information
|
||||||
|
|
||||||
| CType Type -- ^ After parsing
|
| CType Type -- ^ After parsing
|
||||||
deriving (Eq,Show)
|
deriving (Eq,Show,Generic,NFData)
|
||||||
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
@ -8,6 +8,7 @@
|
|||||||
|
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE PatternGuards #-}
|
{-# LANGUAGE PatternGuards #-}
|
||||||
|
{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
|
||||||
module Cryptol.Parser.LexerUtils where
|
module Cryptol.Parser.LexerUtils where
|
||||||
|
|
||||||
import Cryptol.Parser.Position
|
import Cryptol.Parser.Position
|
||||||
@ -22,6 +23,8 @@ import Data.Text.Lazy (Text)
|
|||||||
import qualified Data.Text.Lazy as T
|
import qualified Data.Text.Lazy as T
|
||||||
import Data.Word(Word8)
|
import Data.Word(Word8)
|
||||||
|
|
||||||
|
import GHC.Generics (Generic)
|
||||||
|
import Control.DeepSeq
|
||||||
|
|
||||||
data Config = Config
|
data Config = Config
|
||||||
{ cfgSource :: !FilePath -- ^ File that we are working on
|
{ cfgSource :: !FilePath -- ^ File that we are working on
|
||||||
@ -352,14 +355,14 @@ virt cfg pos x = Located { srcRange = Range
|
|||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
|
||||||
data Token = Token { tokenType :: TokenT, tokenText :: Text }
|
data Token = Token { tokenType :: TokenT, tokenText :: Text }
|
||||||
deriving Show
|
deriving (Show, Generic, NFData)
|
||||||
|
|
||||||
-- | Virtual tokens, inserted by layout processing.
|
-- | Virtual tokens, inserted by layout processing.
|
||||||
data TokenV = VCurlyL| VCurlyR | VSemi
|
data TokenV = VCurlyL| VCurlyR | VSemi
|
||||||
deriving (Eq,Show)
|
deriving (Eq,Show,Generic,NFData)
|
||||||
|
|
||||||
data TokenW = BlockComment | LineComment | Space | DocStr
|
data TokenW = BlockComment | LineComment | Space | DocStr
|
||||||
deriving (Eq,Show)
|
deriving (Eq,Show,Generic,NFData)
|
||||||
|
|
||||||
data TokenKW = KW_Arith
|
data TokenKW = KW_Arith
|
||||||
| KW_Bit
|
| KW_Bit
|
||||||
@ -393,7 +396,7 @@ data TokenKW = KW_Arith
|
|||||||
| KW_infixr
|
| KW_infixr
|
||||||
| KW_infix
|
| KW_infix
|
||||||
| KW_primitive
|
| KW_primitive
|
||||||
deriving (Eq,Show)
|
deriving (Eq,Show,Generic,NFData)
|
||||||
|
|
||||||
-- | The named operators are a special case for parsing types, and 'Other' is
|
-- | The named operators are a special case for parsing types, and 'Other' is
|
||||||
-- used for all other cases that lexed as an operator.
|
-- used for all other cases that lexed as an operator.
|
||||||
@ -401,7 +404,7 @@ data TokenOp = Plus | Minus | Mul | Div | Exp | Mod
|
|||||||
| Equal | LEQ | GEQ
|
| Equal | LEQ | GEQ
|
||||||
| Complement | Hash
|
| Complement | Hash
|
||||||
| Other [String] String
|
| Other [String] String
|
||||||
deriving (Eq,Show)
|
deriving (Eq,Show,Generic,NFData)
|
||||||
|
|
||||||
data TokenSym = Bar
|
data TokenSym = Bar
|
||||||
| ArrL | ArrR | FatArrR
|
| ArrL | ArrR | FatArrR
|
||||||
@ -419,7 +422,7 @@ data TokenSym = Bar
|
|||||||
| CurlyL | CurlyR
|
| CurlyL | CurlyR
|
||||||
| TriL | TriR
|
| TriL | TriR
|
||||||
| Underscore
|
| Underscore
|
||||||
deriving (Eq,Show)
|
deriving (Eq,Show,Generic,NFData)
|
||||||
|
|
||||||
data TokenErr = UnterminatedComment
|
data TokenErr = UnterminatedComment
|
||||||
| UnterminatedString
|
| UnterminatedString
|
||||||
@ -427,7 +430,7 @@ data TokenErr = UnterminatedComment
|
|||||||
| InvalidString
|
| InvalidString
|
||||||
| InvalidChar
|
| InvalidChar
|
||||||
| LexicalError
|
| LexicalError
|
||||||
deriving (Eq,Show)
|
deriving (Eq,Show,Generic,NFData)
|
||||||
|
|
||||||
data TokenT = Num Integer Int Int -- ^ value, base, number of digits
|
data TokenT = Num Integer Int Int -- ^ value, base, number of digits
|
||||||
| ChrLit Char -- ^ character literal
|
| ChrLit Char -- ^ character literal
|
||||||
@ -440,7 +443,7 @@ data TokenT = Num Integer Int Int -- ^ value, base, number of digits
|
|||||||
| White TokenW -- ^ white space token
|
| White TokenW -- ^ white space token
|
||||||
| Err TokenErr -- ^ error token
|
| Err TokenErr -- ^ error token
|
||||||
| EOF
|
| EOF
|
||||||
deriving (Eq,Show)
|
deriving (Eq,Show,Generic,NFData)
|
||||||
|
|
||||||
instance PP Token where
|
instance PP Token where
|
||||||
ppPrec _ (Token _ s) = text (T.unpack s)
|
ppPrec _ (Token _ s) = text (T.unpack s)
|
||||||
|
@ -7,7 +7,7 @@
|
|||||||
-- Portability : portable
|
-- Portability : portable
|
||||||
|
|
||||||
{-# LANGUAGE RecordWildCards #-}
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
|
{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
|
||||||
module Cryptol.Parser.NoInclude
|
module Cryptol.Parser.NoInclude
|
||||||
( removeIncludesModule
|
( removeIncludesModule
|
||||||
, IncludeError(..), ppIncludeError
|
, IncludeError(..), ppIncludeError
|
||||||
@ -28,6 +28,9 @@ import MonadLib
|
|||||||
import qualified Control.Exception as X
|
import qualified Control.Exception as X
|
||||||
import System.FilePath (takeDirectory,(</>),isAbsolute)
|
import System.FilePath (takeDirectory,(</>),isAbsolute)
|
||||||
|
|
||||||
|
import GHC.Generics (Generic)
|
||||||
|
import Control.DeepSeq
|
||||||
|
|
||||||
#if MIN_VERSION_directory(1,2,2)
|
#if MIN_VERSION_directory(1,2,2)
|
||||||
import System.Directory (makeAbsolute)
|
import System.Directory (makeAbsolute)
|
||||||
#else
|
#else
|
||||||
@ -50,7 +53,7 @@ data IncludeError
|
|||||||
= IncludeFailed (Located FilePath)
|
= IncludeFailed (Located FilePath)
|
||||||
| IncludeParseError ParseError
|
| IncludeParseError ParseError
|
||||||
| IncludeCycle [Located FilePath]
|
| IncludeCycle [Located FilePath]
|
||||||
deriving (Show)
|
deriving (Show,Generic,NFData)
|
||||||
|
|
||||||
ppIncludeError :: IncludeError -> Doc
|
ppIncludeError :: IncludeError -> Doc
|
||||||
ppIncludeError ie = case ie of
|
ppIncludeError ie = case ie of
|
||||||
|
@ -13,6 +13,7 @@
|
|||||||
{-# LANGUAGE PatternGuards #-}
|
{-# LANGUAGE PatternGuards #-}
|
||||||
{-# LANGUAGE FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
{-# LANGUAGE RecordWildCards #-}
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
|
{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
|
||||||
module Cryptol.Parser.NoPat (RemovePatterns(..),Error(..)) where
|
module Cryptol.Parser.NoPat (RemovePatterns(..),Error(..)) where
|
||||||
|
|
||||||
import Cryptol.Parser.AST
|
import Cryptol.Parser.AST
|
||||||
@ -26,6 +27,9 @@ import Data.Maybe(maybeToList)
|
|||||||
import Data.Either(partitionEithers)
|
import Data.Either(partitionEithers)
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
|
|
||||||
|
import GHC.Generics (Generic)
|
||||||
|
import Control.DeepSeq
|
||||||
|
|
||||||
#if __GLASGOW_HASKELL__ < 710
|
#if __GLASGOW_HASKELL__ < 710
|
||||||
import Control.Applicative(Applicative(..),(<$>),(<$))
|
import Control.Applicative(Applicative(..),(<$>),(<$))
|
||||||
import Data.Traversable(traverse)
|
import Data.Traversable(traverse)
|
||||||
@ -445,7 +449,7 @@ data Error = MultipleSignatures QName [Located Schema]
|
|||||||
| MultipleFixities QName [Range]
|
| MultipleFixities QName [Range]
|
||||||
| FixityNoBind (Located QName)
|
| FixityNoBind (Located QName)
|
||||||
| MultipleDocs QName [Range]
|
| MultipleDocs QName [Range]
|
||||||
deriving (Show)
|
deriving (Show,Generic,NFData)
|
||||||
|
|
||||||
instance Functor NoPatM where fmap = liftM
|
instance Functor NoPatM where fmap = liftM
|
||||||
instance Applicative NoPatM where pure = return; (<*>) = ap
|
instance Applicative NoPatM where pure = return; (<*>) = ap
|
||||||
|
@ -7,6 +7,7 @@
|
|||||||
-- Portability : portable
|
-- Portability : portable
|
||||||
|
|
||||||
{-# LANGUAGE Safe, PatternGuards #-}
|
{-# LANGUAGE Safe, PatternGuards #-}
|
||||||
|
{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
|
||||||
module Cryptol.Parser.ParserUtils where
|
module Cryptol.Parser.ParserUtils where
|
||||||
|
|
||||||
import Cryptol.Parser.AST
|
import Cryptol.Parser.AST
|
||||||
@ -22,6 +23,9 @@ import Control.Monad(liftM,ap,unless)
|
|||||||
import Data.Text.Lazy (Text)
|
import Data.Text.Lazy (Text)
|
||||||
import qualified Data.Text.Lazy as T
|
import qualified Data.Text.Lazy as T
|
||||||
|
|
||||||
|
import GHC.Generics (Generic)
|
||||||
|
import Control.DeepSeq
|
||||||
|
|
||||||
#if __GLASGOW_HASKELL__ < 710
|
#if __GLASGOW_HASKELL__ < 710
|
||||||
import Control.Applicative ((<$>),Applicative(..))
|
import Control.Applicative ((<$>),Applicative(..))
|
||||||
import Data.Traversable (mapM)
|
import Data.Traversable (mapM)
|
||||||
@ -61,7 +65,7 @@ lexerP k = P $ \cfg p (S ts) ->
|
|||||||
|
|
||||||
data ParseError = HappyError FilePath Position (Maybe Token)
|
data ParseError = HappyError FilePath Position (Maybe Token)
|
||||||
| HappyErrorMsg Range String
|
| HappyErrorMsg Range String
|
||||||
deriving Show
|
deriving (Show, Generic, NFData)
|
||||||
|
|
||||||
newtype S = S [Located Token]
|
newtype S = S [Located Token]
|
||||||
|
|
||||||
|
@ -7,23 +7,27 @@
|
|||||||
-- Portability : portable
|
-- Portability : portable
|
||||||
|
|
||||||
{-# LANGUAGE Safe #-}
|
{-# LANGUAGE Safe #-}
|
||||||
|
{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
|
||||||
module Cryptol.Parser.Position where
|
module Cryptol.Parser.Position where
|
||||||
|
|
||||||
import Data.Text.Lazy (Text)
|
import Data.Text.Lazy (Text)
|
||||||
import qualified Data.Text.Lazy as T
|
import qualified Data.Text.Lazy as T
|
||||||
|
|
||||||
|
import GHC.Generics (Generic)
|
||||||
|
import Control.DeepSeq
|
||||||
|
|
||||||
import Cryptol.Utils.PP
|
import Cryptol.Utils.PP
|
||||||
|
|
||||||
data Located a = Located { srcRange :: !Range, thing :: a }
|
data Located a = Located { srcRange :: !Range, thing :: a }
|
||||||
deriving (Eq,Show)
|
deriving (Eq,Show,Generic,NFData)
|
||||||
|
|
||||||
data Position = Position { line :: !Int, col :: !Int }
|
data Position = Position { line :: !Int, col :: !Int }
|
||||||
deriving (Eq,Ord,Show)
|
deriving (Eq,Ord,Show,Generic,NFData)
|
||||||
|
|
||||||
data Range = Range { from :: !Position
|
data Range = Range { from :: !Position
|
||||||
, to :: !Position
|
, to :: !Position
|
||||||
, source :: FilePath }
|
, source :: FilePath }
|
||||||
deriving (Eq,Show)
|
deriving (Eq,Show,Generic,NFData)
|
||||||
|
|
||||||
-- | An empty range.
|
-- | An empty range.
|
||||||
--
|
--
|
||||||
|
@ -6,6 +6,7 @@
|
|||||||
-- Stability : provisional
|
-- Stability : provisional
|
||||||
-- Portability : portable
|
-- Portability : portable
|
||||||
|
|
||||||
|
{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
|
||||||
module Cryptol.Prims.Syntax
|
module Cryptol.Prims.Syntax
|
||||||
( TFun(..), tBinOpPrec, tfunNames
|
( TFun(..), tBinOpPrec, tfunNames
|
||||||
) where
|
) where
|
||||||
@ -14,6 +15,8 @@ import Cryptol.ModuleSystem.Name (QName,Name(Name),mkUnqual)
|
|||||||
import Cryptol.Utils.PP
|
import Cryptol.Utils.PP
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
|
|
||||||
|
import GHC.Generics (Generic)
|
||||||
|
import Control.DeepSeq
|
||||||
|
|
||||||
-- | Built-in types.
|
-- | Built-in types.
|
||||||
data TFun
|
data TFun
|
||||||
@ -35,7 +38,7 @@ data TFun
|
|||||||
| TCLenFromThenTo -- ^ @ : Num -> Num -> Num -> Num@
|
| TCLenFromThenTo -- ^ @ : Num -> Num -> Num -> Num@
|
||||||
-- Example: @[ 1, 5 .. 9 ] :: [lengthFromThenTo 1 5 9][b]@
|
-- Example: @[ 1, 5 .. 9 ] :: [lengthFromThenTo 1 5 9][b]@
|
||||||
|
|
||||||
deriving (Show, Eq, Ord, Bounded, Enum)
|
deriving (Show, Eq, Ord, Bounded, Enum, Generic, NFData)
|
||||||
|
|
||||||
|
|
||||||
tBinOpPrec :: Map.Map TFun (Assoc,Int)
|
tBinOpPrec :: Map.Map TFun (Assoc,Int)
|
||||||
|
@ -10,6 +10,7 @@
|
|||||||
{-# LANGUAGE RecordWildCards #-}
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
{-# LANGUAGE PatternGuards #-}
|
{-# LANGUAGE PatternGuards #-}
|
||||||
{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}
|
{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}
|
||||||
|
{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
|
||||||
module Cryptol.TypeCheck.AST
|
module Cryptol.TypeCheck.AST
|
||||||
( module Cryptol.TypeCheck.AST
|
( module Cryptol.TypeCheck.AST
|
||||||
, TFun(..)
|
, TFun(..)
|
||||||
@ -35,6 +36,9 @@ import Cryptol.Utils.Panic(panic)
|
|||||||
import Cryptol.TypeCheck.PP
|
import Cryptol.TypeCheck.PP
|
||||||
import Cryptol.TypeCheck.Solver.InfNat
|
import Cryptol.TypeCheck.Solver.InfNat
|
||||||
|
|
||||||
|
import GHC.Generics (Generic)
|
||||||
|
import Control.DeepSeq
|
||||||
|
|
||||||
import Data.Map (Map)
|
import Data.Map (Map)
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
import qualified Data.IntMap as IntMap
|
import qualified Data.IntMap as IntMap
|
||||||
@ -48,7 +52,7 @@ data Module = Module { mName :: ModName
|
|||||||
, mTySyns :: Map QName TySyn
|
, mTySyns :: Map QName TySyn
|
||||||
, mNewtypes :: Map QName Newtype
|
, mNewtypes :: Map QName Newtype
|
||||||
, mDecls :: [DeclGroup]
|
, mDecls :: [DeclGroup]
|
||||||
} deriving Show
|
} deriving (Show, Generic, NFData)
|
||||||
|
|
||||||
|
|
||||||
-- | Kinds, classify types.
|
-- | Kinds, classify types.
|
||||||
@ -56,13 +60,13 @@ data Kind = KType
|
|||||||
| KNum
|
| KNum
|
||||||
| KProp
|
| KProp
|
||||||
| Kind :-> Kind
|
| Kind :-> Kind
|
||||||
deriving (Eq,Show)
|
deriving (Eq, Show, Generic, NFData)
|
||||||
infixr 5 :->
|
infixr 5 :->
|
||||||
|
|
||||||
|
|
||||||
-- | The types of polymorphic values.
|
-- | The types of polymorphic values.
|
||||||
data Schema = Forall { sVars :: [TParam], sProps :: [Prop], sType :: Type }
|
data Schema = Forall { sVars :: [TParam], sProps :: [Prop], sType :: Type }
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show, Generic, NFData)
|
||||||
|
|
||||||
-- | Type synonym.
|
-- | Type synonym.
|
||||||
data TySyn = TySyn { tsName :: QName -- ^ Name
|
data TySyn = TySyn { tsName :: QName -- ^ Name
|
||||||
@ -70,21 +74,21 @@ data TySyn = TySyn { tsName :: QName -- ^ Name
|
|||||||
, tsConstraints :: [Prop] -- ^ Ensure body is OK
|
, tsConstraints :: [Prop] -- ^ Ensure body is OK
|
||||||
, tsDef :: Type -- ^ Definition
|
, tsDef :: Type -- ^ Definition
|
||||||
}
|
}
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show, Generic, NFData)
|
||||||
|
|
||||||
-- | Named records
|
-- | Named records
|
||||||
data Newtype = Newtype { ntName :: QName
|
data Newtype = Newtype { ntName :: QName
|
||||||
, ntParams :: [TParam]
|
, ntParams :: [TParam]
|
||||||
, ntConstraints :: [Prop]
|
, ntConstraints :: [Prop]
|
||||||
, ntFields :: [(Name,Type)]
|
, ntFields :: [(Name,Type)]
|
||||||
} deriving (Show)
|
} deriving (Show, Generic, NFData)
|
||||||
|
|
||||||
-- | Type parameters.
|
-- | Type parameters.
|
||||||
data TParam = TParam { tpUnique :: !Int -- ^ Parameter identifier
|
data TParam = TParam { tpUnique :: !Int -- ^ Parameter identifier
|
||||||
, tpKind :: Kind -- ^ Kind of parameter
|
, tpKind :: Kind -- ^ Kind of parameter
|
||||||
, tpName :: Maybe QName-- ^ Name from source, if any.
|
, tpName :: Maybe QName-- ^ Name from source, if any.
|
||||||
}
|
}
|
||||||
deriving (Show)
|
deriving (Show, Generic, NFData)
|
||||||
|
|
||||||
instance Eq TParam where
|
instance Eq TParam where
|
||||||
x == y = tpUnique x == tpUnique y
|
x == y = tpUnique x == tpUnique y
|
||||||
@ -113,7 +117,7 @@ data Type = TCon TCon [Type]
|
|||||||
| TRec [(Name,Type)]
|
| TRec [(Name,Type)]
|
||||||
-- ^ Record type
|
-- ^ Record type
|
||||||
|
|
||||||
deriving (Show,Eq,Ord)
|
deriving (Show,Eq,Ord,Generic,NFData)
|
||||||
|
|
||||||
-- | The type is supposed to be of kind `KProp`
|
-- | The type is supposed to be of kind `KProp`
|
||||||
type Prop = Type
|
type Prop = Type
|
||||||
@ -129,11 +133,11 @@ data TVar = TVFree !Int Kind (Set TVar) Doc
|
|||||||
|
|
||||||
|
|
||||||
| TVBound !Int Kind
|
| TVBound !Int Kind
|
||||||
deriving Show
|
deriving (Show,Generic,NFData)
|
||||||
|
|
||||||
-- | Type constants.
|
-- | Type constants.
|
||||||
data TCon = TC TC | PC PC | TF TFun
|
data TCon = TC TC | PC PC | TF TFun
|
||||||
deriving (Show,Eq,Ord)
|
deriving (Show,Eq,Ord,Generic,NFData)
|
||||||
|
|
||||||
-- | Built-in type constants.
|
-- | Built-in type constants.
|
||||||
|
|
||||||
@ -147,7 +151,7 @@ data PC = PEqual -- ^ @_ == _@
|
|||||||
| PHas Selector -- ^ @Has sel type field@ does not appear in schemas
|
| PHas Selector -- ^ @Has sel type field@ does not appear in schemas
|
||||||
| PArith -- ^ @Arith _@
|
| PArith -- ^ @Arith _@
|
||||||
| PCmp -- ^ @Cmp _@
|
| PCmp -- ^ @Cmp _@
|
||||||
deriving (Show,Eq,Ord)
|
deriving (Show,Eq,Ord,Generic,NFData)
|
||||||
|
|
||||||
-- | 1-1 constants.
|
-- | 1-1 constants.
|
||||||
data TC = TCNum Integer -- ^ Numbers
|
data TC = TCNum Integer -- ^ Numbers
|
||||||
@ -157,10 +161,10 @@ data TC = TCNum Integer -- ^ Numbers
|
|||||||
| TCFun -- ^ @_ -> _@
|
| TCFun -- ^ @_ -> _@
|
||||||
| TCTuple Int -- ^ @(_, _, _)@
|
| TCTuple Int -- ^ @(_, _, _)@
|
||||||
| TCNewtype UserTC -- ^ user-defined, @T@
|
| TCNewtype UserTC -- ^ user-defined, @T@
|
||||||
deriving (Show,Eq,Ord)
|
deriving (Show,Eq,Ord,Generic,NFData)
|
||||||
|
|
||||||
data UserTC = UserTC QName Kind
|
data UserTC = UserTC QName Kind
|
||||||
deriving Show
|
deriving (Show,Generic,NFData)
|
||||||
|
|
||||||
instance Eq UserTC where
|
instance Eq UserTC where
|
||||||
UserTC x _ == UserTC y _ = x == y
|
UserTC x _ == UserTC y _ = x == y
|
||||||
@ -237,19 +241,19 @@ data Expr = EList [Expr] Type -- ^ List value (with type of elements)
|
|||||||
|
|
||||||
| EWhere Expr [DeclGroup]
|
| EWhere Expr [DeclGroup]
|
||||||
|
|
||||||
deriving Show
|
deriving (Show, Generic, NFData)
|
||||||
|
|
||||||
|
|
||||||
data Match = From QName Type Expr-- ^ do we need this type? it seems like it
|
data Match = From QName Type Expr-- ^ do we need this type? it seems like it
|
||||||
-- can be computed from the expr
|
-- can be computed from the expr
|
||||||
| Let Decl
|
| Let Decl
|
||||||
deriving Show
|
deriving (Show, Generic, NFData)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
data DeclGroup = Recursive [Decl] -- ^ Mutually recursive declarations
|
data DeclGroup = Recursive [Decl] -- ^ Mutually recursive declarations
|
||||||
| NonRecursive Decl -- ^ Non-recursive declaration
|
| NonRecursive Decl -- ^ Non-recursive declaration
|
||||||
deriving Show
|
deriving (Show,Generic,NFData)
|
||||||
|
|
||||||
groupDecls :: DeclGroup -> [Decl]
|
groupDecls :: DeclGroup -> [Decl]
|
||||||
groupDecls dg = case dg of
|
groupDecls dg = case dg of
|
||||||
@ -263,11 +267,11 @@ data Decl = Decl { dName :: QName
|
|||||||
, dInfix :: !Bool
|
, dInfix :: !Bool
|
||||||
, dFixity :: Maybe Fixity
|
, dFixity :: Maybe Fixity
|
||||||
, dDoc :: Maybe String
|
, dDoc :: Maybe String
|
||||||
} deriving (Show)
|
} deriving (Show,Generic,NFData)
|
||||||
|
|
||||||
data DeclDef = DPrim
|
data DeclDef = DPrim
|
||||||
| DExpr Expr
|
| DExpr Expr
|
||||||
deriving (Show)
|
deriving (Show,Generic,NFData)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -10,7 +10,7 @@
|
|||||||
|
|
||||||
{-# LANGUAGE Safe #-}
|
{-# LANGUAGE Safe #-}
|
||||||
{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}
|
{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}
|
||||||
|
{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
|
||||||
module Cryptol.TypeCheck.InferTypes where
|
module Cryptol.TypeCheck.InferTypes where
|
||||||
|
|
||||||
import Cryptol.TypeCheck.AST
|
import Cryptol.TypeCheck.AST
|
||||||
@ -27,13 +27,14 @@ import qualified Data.Set as Set
|
|||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
import qualified Data.IntMap as IntMap
|
import qualified Data.IntMap as IntMap
|
||||||
|
|
||||||
|
import GHC.Generics (Generic)
|
||||||
|
import Control.DeepSeq
|
||||||
|
|
||||||
data SolverConfig = SolverConfig
|
data SolverConfig = SolverConfig
|
||||||
{ solverPath :: FilePath -- ^ The SMT solver to invoke
|
{ solverPath :: FilePath -- ^ The SMT solver to invoke
|
||||||
, solverArgs :: [String] -- ^ Additional arguments to pass to the solver
|
, solverArgs :: [String] -- ^ Additional arguments to pass to the solver
|
||||||
, solverVerbose :: Int -- ^ How verbose to be when type-checking
|
, solverVerbose :: Int -- ^ How verbose to be when type-checking
|
||||||
} deriving Show
|
} deriving (Show, Generic, NFData)
|
||||||
|
|
||||||
|
|
||||||
-- | The types of variables in the environment.
|
-- | The types of variables in the environment.
|
||||||
@ -60,7 +61,7 @@ data Goal = Goal
|
|||||||
{ goalSource :: ConstraintSource -- ^ With it is about
|
{ goalSource :: ConstraintSource -- ^ With it is about
|
||||||
, goalRange :: Range -- ^ Part of source code that caused goal
|
, goalRange :: Range -- ^ Part of source code that caused goal
|
||||||
, goal :: Prop -- ^ What needs to be proved
|
, goal :: Prop -- ^ What needs to be proved
|
||||||
} deriving Show
|
} deriving (Show,Generic,NFData)
|
||||||
|
|
||||||
data HasGoal = HasGoal
|
data HasGoal = HasGoal
|
||||||
{ hasName :: !Int
|
{ hasName :: !Int
|
||||||
@ -73,7 +74,7 @@ data DelayedCt = DelayedCt
|
|||||||
, dctForall :: [TParam]
|
, dctForall :: [TParam]
|
||||||
, dctAsmps :: [Prop]
|
, dctAsmps :: [Prop]
|
||||||
, dctGoals :: [Goal]
|
, dctGoals :: [Goal]
|
||||||
} deriving Show
|
} deriving (Show,Generic,NFData)
|
||||||
|
|
||||||
data Solved = Solved (Maybe Subst) [Goal] -- ^ Solved, assuming the sub-goals.
|
data Solved = Solved (Maybe Subst) [Goal] -- ^ Solved, assuming the sub-goals.
|
||||||
| Unsolved -- ^ We could not solved the goal.
|
| Unsolved -- ^ We could not solved the goal.
|
||||||
@ -83,7 +84,7 @@ data Solved = Solved (Maybe Subst) [Goal] -- ^ Solved, assuming the sub-goals.
|
|||||||
data Warning = DefaultingKind P.TParam P.Kind
|
data Warning = DefaultingKind P.TParam P.Kind
|
||||||
| DefaultingWildType P.Kind
|
| DefaultingWildType P.Kind
|
||||||
| DefaultingTo Doc Type
|
| DefaultingTo Doc Type
|
||||||
deriving Show
|
deriving (Show,Generic,NFData)
|
||||||
|
|
||||||
-- | Various errors that might happen during type checking/inference
|
-- | Various errors that might happen during type checking/inference
|
||||||
data Error = ErrorMsg Doc
|
data Error = ErrorMsg Doc
|
||||||
@ -162,7 +163,7 @@ data Error = ErrorMsg Doc
|
|||||||
| AmbiguousType [QName]
|
| AmbiguousType [QName]
|
||||||
|
|
||||||
|
|
||||||
deriving Show
|
deriving (Show,Generic,NFData)
|
||||||
|
|
||||||
-- | Information about how a constraint came to be, used in error reporting.
|
-- | Information about how a constraint came to be, used in error reporting.
|
||||||
data ConstraintSource
|
data ConstraintSource
|
||||||
@ -176,10 +177,10 @@ data ConstraintSource
|
|||||||
| CtDefaulting -- ^ Just defaulting on the command line
|
| CtDefaulting -- ^ Just defaulting on the command line
|
||||||
| CtPartialTypeFun TyFunName -- ^ Use of a partial type function.
|
| CtPartialTypeFun TyFunName -- ^ Use of a partial type function.
|
||||||
| CtImprovement
|
| CtImprovement
|
||||||
deriving Show
|
deriving (Show,Generic,NFData)
|
||||||
|
|
||||||
data TyFunName = UserTyFun QName | BuiltInTyFun TFun
|
data TyFunName = UserTyFun QName | BuiltInTyFun TFun
|
||||||
deriving Show
|
deriving (Show,Generic,NFData)
|
||||||
|
|
||||||
instance PP TyFunName where
|
instance PP TyFunName where
|
||||||
ppPrec c (UserTyFun x) = ppPrec c x
|
ppPrec c (UserTyFun x) = ppPrec c x
|
||||||
|
@ -12,6 +12,7 @@
|
|||||||
#else
|
#else
|
||||||
{-# LANGUAGE DoRec #-}
|
{-# LANGUAGE DoRec #-}
|
||||||
#endif
|
#endif
|
||||||
|
{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
|
||||||
module Cryptol.TypeCheck.Monad
|
module Cryptol.TypeCheck.Monad
|
||||||
( module Cryptol.TypeCheck.Monad
|
( module Cryptol.TypeCheck.Monad
|
||||||
, module Cryptol.TypeCheck.InferTypes
|
, module Cryptol.TypeCheck.InferTypes
|
||||||
@ -37,6 +38,9 @@ import MonadLib
|
|||||||
import qualified Control.Applicative as A
|
import qualified Control.Applicative as A
|
||||||
import Control.Monad.Fix(MonadFix(..))
|
import Control.Monad.Fix(MonadFix(..))
|
||||||
|
|
||||||
|
import GHC.Generics (Generic)
|
||||||
|
import Control.DeepSeq
|
||||||
|
|
||||||
#if __GLASGOW_HASKELL__ < 710
|
#if __GLASGOW_HASKELL__ < 710
|
||||||
import Data.Functor
|
import Data.Functor
|
||||||
#endif
|
#endif
|
||||||
@ -59,7 +63,7 @@ data InferInput = InferInput
|
|||||||
data NameSeeds = NameSeeds
|
data NameSeeds = NameSeeds
|
||||||
{ seedTVar :: !Int
|
{ seedTVar :: !Int
|
||||||
, seedGoal :: !Int
|
, seedGoal :: !Int
|
||||||
} deriving Show
|
} deriving (Show, Generic, NFData)
|
||||||
|
|
||||||
-- | The initial seeds, used when checking a fresh program.
|
-- | The initial seeds, used when checking a fresh program.
|
||||||
nameSeeds :: NameSeeds
|
nameSeeds :: NameSeeds
|
||||||
|
@ -8,6 +8,7 @@
|
|||||||
|
|
||||||
{-# LANGUAGE Safe #-}
|
{-# LANGUAGE Safe #-}
|
||||||
{-# LANGUAGE PatternGuards #-}
|
{-# LANGUAGE PatternGuards #-}
|
||||||
|
{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
|
||||||
module Cryptol.Utils.PP where
|
module Cryptol.Utils.PP where
|
||||||
|
|
||||||
import Cryptol.ModuleSystem.Name
|
import Cryptol.ModuleSystem.Name
|
||||||
@ -18,6 +19,8 @@ import qualified Data.Monoid as M
|
|||||||
import Data.String (IsString(..))
|
import Data.String (IsString(..))
|
||||||
import qualified Text.PrettyPrint as PJ
|
import qualified Text.PrettyPrint as PJ
|
||||||
|
|
||||||
|
import GHC.Generics (Generic)
|
||||||
|
import Control.DeepSeq
|
||||||
|
|
||||||
-- | How to display names.
|
-- | How to display names.
|
||||||
newtype NameEnv = NameEnv (Map QName NameInfo)
|
newtype NameEnv = NameEnv (Map QName NameInfo)
|
||||||
@ -43,7 +46,7 @@ instance M.Monoid NameEnv where
|
|||||||
mempty = NameEnv Map.empty
|
mempty = NameEnv Map.empty
|
||||||
mappend (NameEnv a) (NameEnv b) = NameEnv (Map.union a b)
|
mappend (NameEnv a) (NameEnv b) = NameEnv (Map.union a b)
|
||||||
|
|
||||||
newtype Doc = Doc (NameEnv -> PJ.Doc)
|
newtype Doc = Doc (NameEnv -> PJ.Doc) deriving (Generic, NFData)
|
||||||
|
|
||||||
runDoc :: NameEnv -> Doc -> PJ.Doc
|
runDoc :: NameEnv -> Doc -> PJ.Doc
|
||||||
runDoc names (Doc f) = f names
|
runDoc names (Doc f) = f names
|
||||||
@ -73,7 +76,7 @@ optParens b body | b = parens body
|
|||||||
|
|
||||||
-- | Information about associativity.
|
-- | Information about associativity.
|
||||||
data Assoc = LeftAssoc | RightAssoc | NonAssoc
|
data Assoc = LeftAssoc | RightAssoc | NonAssoc
|
||||||
deriving (Show,Eq)
|
deriving (Show,Eq,Generic,NFData)
|
||||||
|
|
||||||
-- | Information about an infix expression of some sort.
|
-- | Information about an infix expression of some sort.
|
||||||
data Infix op thing = Infix
|
data Infix op thing = Infix
|
||||||
|
Loading…
Reference in New Issue
Block a user