Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : supercompiler
http://hackage.haskell.org/trac/ghc/changeset/8b3355f390e15ca2aa96bdb7fe84d5edf58f1ab1 >--------------------------------------------------------------- commit 8b3355f390e15ca2aa96bdb7fe84d5edf58f1ab1 Author: Max Bolingbroke <batterseapo...@hotmail.com> Date: Tue Apr 24 10:36:18 2012 +0100 Comments and commoning-up of InstanceMatching >--------------------------------------------------------------- compiler/supercompile/Supercompile/Drive/MSG.hs | 10 +++------- compiler/supercompile/Supercompile/Drive/Match.hs | 7 ------- .../supercompile/Supercompile/Evaluator/Syntax.hs | 10 ++++++++++ 3 files changed, 13 insertions(+), 14 deletions(-) diff --git a/compiler/supercompile/Supercompile/Drive/MSG.hs b/compiler/supercompile/Supercompile/Drive/MSG.hs index 857bc91..b7f4c36 100644 --- a/compiler/supercompile/Supercompile/Drive/MSG.hs +++ b/compiler/supercompile/Supercompile/Drive/MSG.hs @@ -41,6 +41,9 @@ import qualified Data.Set as S import qualified Data.Foldable as Foldable +-- FIXME: we probably need to enforce the kind invariant explicitly + + pprTraceSC :: String -> SDoc -> a -> a --pprTraceSC _ _ = id --pprTraceSC = pprTrace @@ -368,13 +371,6 @@ msg :: MSGMode -- ^ How to match msg mm s_l s_r = runMSG' (msgWithReason mm s_l s_r) -data InstanceMatching = NoInstances | InstancesOfGeneralised | AllInstances - -mayInstantiate :: InstanceMatching -> Generalised -> Bool -mayInstantiate NoInstances _ = False -mayInstantiate InstancesOfGeneralised gen = gen -mayInstantiate AllInstances _ = True - data MSGMatchResult = RightIsInstance Heap Renaming Stack | RightGivesTypeGen Renaming State Renaming diff --git a/compiler/supercompile/Supercompile/Drive/Match.hs b/compiler/supercompile/Supercompile/Drive/Match.hs index 82c7000..86c5d42 100644 --- a/compiler/supercompile/Supercompile/Drive/Match.hs +++ b/compiler/supercompile/Supercompile/Drive/Match.hs @@ -87,13 +87,6 @@ matchRnEnv2 f x y = mkRnEnv2 (mkInScopeSet (f x `unionVarSet` f y)) -- mx1 `mplus` mx2 = Match $ unMatch mx1 `mplus` unMatch mx2 -data InstanceMatching = NoInstances | InstancesOfGeneralised | AllInstances - -mayInstantiate :: InstanceMatching -> Generalised -> Bool -mayInstantiate NoInstances _ = False -mayInstantiate InstancesOfGeneralised gen = gen -mayInstantiate AllInstances _ = True - data MatchMode = MM { matchInstanceMatching :: InstanceMatching, matchCommonHeapVars :: InScopeSet diff --git a/compiler/supercompile/Supercompile/Evaluator/Syntax.hs b/compiler/supercompile/Supercompile/Evaluator/Syntax.hs index 850ee48..885d019 100644 --- a/compiler/supercompile/Supercompile/Evaluator/Syntax.hs +++ b/compiler/supercompile/Supercompile/Evaluator/Syntax.hs @@ -183,6 +183,13 @@ qaToAnswer qa = case qa of Answer a -> Just a; Question _ -> Nothing type Generalised = Bool +data InstanceMatching = NoInstances | InstancesOfGeneralised | AllInstances + +mayInstantiate :: InstanceMatching -> Generalised -> Bool +mayInstantiate NoInstances _ = False +mayInstantiate InstancesOfGeneralised gen = gen +mayInstantiate AllInstances _ = True + type UnnormalisedState = (Deeds, Heap, Stack, In AnnedTerm) type State = (Deeds, Heap, Stack, Anned QA) @@ -254,6 +261,9 @@ letBound :: In AnnedTerm -> HeapBinding letBound in_e = HB LetBound (Right in_e) -- INVARIANT: the Heap might contain bindings for TyVars as well, but will only map them to lambdaBound/generalised +-- TODO: when we lambda-abstract over lambdaBounds, we implicitly rely on the fact that the lambdaBound IdInfo will work +-- out properly (unfortunately lambda-bounds can't be brought into scope all at the same time). We should probably fix +-- this -- perhaps by zapping all lambdaBound IdInfo when we abstract. type PureHeap = M.Map (Out Var) HeapBinding data Heap = Heap PureHeap InScopeSet _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
