forked from grin-compiler/ghc-wpc
-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Turn EvTerm (almost) into CoreExpr (#14691)
Ideally, I'd like to do
type EvTerm = CoreExpr
and the type checker builds the evidence terms as it goes. This failed,
becuase the evidence for `Typeable` refers to local identifiers that are
added *after* the typechecker solves constraints. Therefore, `EvTerm`
stays a data type with two constructors: `EvExpr` for `CoreExpr`
evidence, and `EvTypeable` for the others.
Delted `Note [Memoising typeOf]`, its reference (and presumably
relevance) was removed in 8fa4bf9.
Differential Revision: https://phabricator.haskell.org/D4341- Loading branch information
Showing
20 changed files
with
363 additions
and
341 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
|
|
@@ -471,6 +471,7 @@ Library | |
| TcTypeable | ||
| TcType | ||
| TcEvidence | ||
| TcEvTerm | ||
| TcUnify | ||
| TcInteract | ||
| TcCanonical | ||
|
|
||
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,69 @@ | ||
|
|
||
| -- (those who have too heavy dependencies for TcEvidence) | ||
| module TcEvTerm | ||
| ( evDelayedError, evCallStack ) | ||
| where | ||
|
|
||
| import GhcPrelude | ||
|
|
||
| import FastString | ||
| import Type | ||
| import CoreSyn | ||
| import MkCore | ||
| import Literal ( Literal(..) ) | ||
| import TcEvidence | ||
| import HscTypes | ||
| import DynFlags | ||
| import Name | ||
| import Module | ||
| import CoreUtils | ||
| import PrelNames | ||
| import SrcLoc | ||
|
|
||
| -- Used with Opt_DeferTypeErrors | ||
| -- See Note [Deferring coercion errors to runtime] | ||
| -- in TcSimplify | ||
| evDelayedError :: Type -> FastString -> EvExpr | ||
| evDelayedError ty msg | ||
| = Var errorId `mkTyApps` [getRuntimeRep ty, ty] `mkApps` [litMsg] | ||
| where | ||
| errorId = tYPE_ERROR_ID | ||
| litMsg = Lit (MachStr (fastStringToByteString msg)) | ||
|
|
||
| -- Dictionary for CallStack implicit parameters | ||
| evCallStack :: (MonadThings m, HasModule m, HasDynFlags m) => | ||
| EvCallStack -> m EvExpr | ||
| -- See Note [Overview of implicit CallStacks] in TcEvidence.hs | ||
| evCallStack cs = do | ||
| df <- getDynFlags | ||
| m <- getModule | ||
| srcLocDataCon <- lookupDataCon srcLocDataConName | ||
| let mkSrcLoc l = mkCoreConApps srcLocDataCon <$> | ||
| sequence [ mkStringExprFS (unitIdFS $ moduleUnitId m) | ||
| , mkStringExprFS (moduleNameFS $ moduleName m) | ||
| , mkStringExprFS (srcSpanFile l) | ||
| , return $ mkIntExprInt df (srcSpanStartLine l) | ||
| , return $ mkIntExprInt df (srcSpanStartCol l) | ||
| , return $ mkIntExprInt df (srcSpanEndLine l) | ||
| , return $ mkIntExprInt df (srcSpanEndCol l) | ||
| ] | ||
|
|
||
| emptyCS <- Var <$> lookupId emptyCallStackName | ||
|
|
||
| pushCSVar <- lookupId pushCallStackName | ||
| let pushCS name loc rest = | ||
| mkCoreApps (Var pushCSVar) [mkCoreTup [name, loc], rest] | ||
|
|
||
| let mkPush name loc tm = do | ||
| nameExpr <- mkStringExprFS name | ||
| locExpr <- mkSrcLoc loc | ||
| -- at this point tm :: IP sym CallStack | ||
| -- but we need the actual CallStack to pass to pushCS, | ||
| -- so we use unwrapIP to strip the dictionary wrapper | ||
| -- See Note [Overview of implicit CallStacks] | ||
| let ip_co = unwrapIP (exprType tm) | ||
| return (pushCS nameExpr locExpr (Cast tm ip_co)) | ||
|
|
||
| case cs of | ||
| EvCsPushCall name loc tm -> mkPush (occNameFS $ getOccName name) loc tm | ||
| EvCsEmpty -> return emptyCS |
Oops, something went wrong.