Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
43 changes: 43 additions & 0 deletions src/Control/Unification.hs
Original file line number Diff line number Diff line change
Expand Up @@ -71,6 +71,7 @@ module Control.Unification
, getFreeVarsAll
, applyBindingsAll
, freshenAll
, freshenAndFree
-- subsumesAll -- to ensure that there's a single coherent substitution allowing the schema to subsume all the terms in some collection.

-- * Helper functions
Expand Down Expand Up @@ -386,6 +387,48 @@ freshenAll ts0 = evalStateT (mapM loop ts0) IM.empty
modify' $ IM.insert i (Right v')
return v'

-- | Like 'freshenAll', but also ignore any existing bindings affecting the
-- terms.
--
-- This is useful when the terms come from a different binding environment
-- and have had their bindings applied.
--
-- Then 'freshenAndFree' ensures that no free variables are or will be
-- accidentally captured in the current environment.
--
-- For instance, let's say you inferred the type of @id = λx.x@ as @UVar 1 -> UVar 1@.
-- You may store this type in an interface file of some kind.
-- Next time your program is run, it is asked to typecheck another term,
-- which involves @id@. From the interface file you find that @id@ has type
-- @UVar 1 -> UVar 1@, but what does @UVar 1@ refer to? It is supposed to
-- be free (because the type of @id@ had its bindings applied before
-- exporting, see 'applyBindings'). But in the current binding environment,
-- @UVar 1@ may be already used to refer to something else, resulting in
-- a variable capture. Applying 'freshenAndFree' returns an
-- alpha-equivalent term, say, @UVar 17 -> UVar 17@, such that 17 is
-- a fresh free variable in the current environment.
freshenAndFree
:: ( BindingMonad t v m
, Traversable s
)
=> s (UTerm t v) -- ^
-> m (s (UTerm t v)) -- ^
freshenAndFree ts0 = evalStateT (mapM loop ts0) IM.empty
where
loop t0 = do
t0 <- lift $ semiprune t0
case t0 of
UTerm t -> UTerm <$> mapM loop t
UVar v -> do
let i = getVarID v
seenVars <- get
case IM.lookup i seenVars of
Just t -> return t
Nothing -> do
v' <- lift $ UVar <$> freeVar
put $! IM.insert i v' seenVars
return v'

----------------------------------------------------------------
----------------------------------------------------------------
-- BUG: have to give the signatures for Haddock :(
Expand Down
2 changes: 1 addition & 1 deletion unification-fd.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -30,7 +30,7 @@ Tested-With:
GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2

Extra-source-files:
AUTHORS, README, CHANGELOG
AUTHORS, README.md, CHANGELOG
Source-Repository head
Type: darcs
Location: http://community.haskell.org/~wren/unification-fd
Expand Down