GaloisInc/cryptol
1
1
Fork 0
mirror of https://github.com/GaloisInc/cryptol.git synced 2024-12-28 02:15:31 +03:00
Code Issues Projects Releases Wiki Activity

fix problems uncovered by hackage and stackage

Browse Source
This commit is contained in:
Adam C. Foltzer 2015-03-25 11:13:46 -07:00
parent 7deef9c8b2
commit 7ec1106eeb
2 changed files with 9 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
cryptol.cabal
View File

@ -40,7 +40,7 @@ flag self-contained
library library
Default-language: Default-language:
Haskell98 Haskell98
Build-depends: base >= 4.6, Build-depends: base >= 4.6 && < 5,
array >= 0.4, array >= 0.4,
async >= 2.0, async >= 2.0,
containers >= 0.5, containers >= 0.5,

17
src/Cryptol/Transform/Specialize.hs
View File

@ -80,7 +80,7 @@ specializeExpr expr =
ESel e s -> ESel <$> specializeExpr e <*> pure s ESel e s -> ESel <$> specializeExpr e <*> pure s
EIf e1 e2 e3 -> EIf <$> specializeExpr e1 <*> specializeExpr e2 <*> specializeExpr e3 EIf e1 e2 e3 -> EIf <$> specializeExpr e1 <*> specializeExpr e2 <*> specializeExpr e3
EComp t e mss -> EComp t <$> specializeExpr e <*> traverse (traverse specializeMatch) mss EComp t e mss -> EComp t <$> specializeExpr e <*> traverse (traverse specializeMatch) mss
-- ^ Bindings within list comprehensions always have monomorphic types. -- Bindings within list comprehensions always have monomorphic types.
EVar {} -> specializeConst expr EVar {} -> specializeConst expr
ETAbs t e -> do ETAbs t e -> do
cache <- getSpecCache cache <- getSpecCache
@ -88,10 +88,10 @@ specializeExpr expr =
e' <- specializeExpr e e' <- specializeExpr e
setSpecCache cache setSpecCache cache
return (ETAbs t e') return (ETAbs t e')
-- ^ We need to make sure that after processing `e`, no -- We need to make sure that after processing `e`, no specialized
-- specialized decls mentioning type variable `t` escape outside -- decls mentioning type variable `t` escape outside the
-- the `ETAbs`. To avoid this, we reset to an empty SpecCache -- `ETAbs`. To avoid this, we reset to an empty SpecCache while we
-- while we run `specializeExpr e`, and restore it afterward: this -- run `specializeExpr e`, and restore it afterward: this
-- effectively prevents the specializer from registering any type -- effectively prevents the specializer from registering any type
-- instantiations involving `t` for any decls bound outside the -- instantiations involving `t` for any decls bound outside the
-- scope of `t`. -- scope of `t`.
@ -121,7 +121,7 @@ withDeclGroups :: [DeclGroup] -> SpecM a
withDeclGroups dgs action = do withDeclGroups dgs action = do
let decls = concatMap groupDecls dgs let decls = concatMap groupDecls dgs
let newCache = Map.fromList [ (dName d, (d, emptyTM)) | d <- decls ] let newCache = Map.fromList [ (dName d, (d, emptyTM)) | d <- decls ]
-- | We assume that the names bound in dgs are disjoint from the other names in scope. -- We assume that the names bound in dgs are disjoint from the other names in scope.
modifySpecCache (Map.union newCache) modifySpecCache (Map.union newCache)
result <- action result <- action
-- Then reassemble the DeclGroups. -- Then reassemble the DeclGroups.
@ -137,10 +137,10 @@ withDeclGroups dgs action = do
else return [Recursive ds'] else return [Recursive ds']
splitDeclGroup (NonRecursive d) = map NonRecursive <$> splitDecl d splitDeclGroup (NonRecursive d) = map NonRecursive <$> splitDecl d
dgs' <- concat <$> traverse splitDeclGroup dgs dgs' <- concat <$> traverse splitDeclGroup dgs
-- | Get updated map of only the local entries we added. -- Get updated map of only the local entries we added.
newCache' <- flip Map.intersection newCache <$> getSpecCache newCache' <- flip Map.intersection newCache <$> getSpecCache
let nameTable = fmap (fmap fst . snd) newCache' let nameTable = fmap (fmap fst . snd) newCache'
-- | Remove local definitions from the cache. -- Remove local definitions from the cache.
modifySpecCache (flip Map.difference newCache) modifySpecCache (flip Map.difference newCache)
return (result, dgs', nameTable) return (result, dgs', nameTable)
@ -342,4 +342,3 @@ allPublicQNames =
traverseSnd :: Functor f => (b -> f c) -> (a, b) -> f (a, c) traverseSnd :: Functor f => (b -> f c) -> (a, b) -> f (a, c)
traverseSnd f (x, y) = (,) x <$> f y traverseSnd f (x, y) = (,) x <$> f y