X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fspecialise%2FSpecEnv.lhs;fp=ghc%2Fcompiler%2Fspecialise%2FSpecEnv.lhs;h=0000000000000000000000000000000000000000;hb=69e14f75a4b031e489b7774914e5a176409cea78;hp=d14ed2dceca17083182e30bea76da125d145d9be;hpb=c9dfd084e476b18290e964e5e5d66adf0771b9e6;p=ghc-hetmet.git

diff --git a/ghc/compiler/specialise/SpecEnv.lhs b/ghc/compiler/specialise/SpecEnv.lhs
deleted file mode 100644
index d14ed2d..0000000
--- a/ghc/compiler/specialise/SpecEnv.lhs
+++ /dev/null
@@ -1,172 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
-%
-\section[SpecEnv]{Specialisation info about an @Id@}
-
-\begin{code}
-module SpecEnv (
-	SpecEnv,
-	emptySpecEnv, isEmptySpecEnv,
-	specEnvValues, specEnvToList, specEnvFromList,
-	addToSpecEnv, lookupSpecEnv, substSpecEnv
-    ) where
-
-#include "HsVersions.h"
-
-import Var		( TyVar )
-import VarEnv
-import VarSet
-import Type		( Type, fullSubstTy, substTyVar )
-import Unify		( unifyTyListsX, matchTys )
-import Outputable
-import Maybes
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-\section{SpecEnv}
-%*									*
-%************************************************************************
-
-\begin{code}
-data SpecEnv value 
-  = EmptySE 
-  | SpecEnv [([TyVar], 	-- Really a set, but invariably small,
-			-- so kept as a list
-	      [Type], 
-	      value)]
-
-specEnvValues :: SpecEnv value -> [value]
-specEnvValues EmptySE         = []
-specEnvValues (SpecEnv alist) = [val | (_,_,val) <- alist]
-
-specEnvToList :: SpecEnv value -> [([TyVar], [Type], value)]
-specEnvToList EmptySE         = []
-specEnvToList (SpecEnv alist) = alist
-
-specEnvFromList :: [([TyVar], [Type], value)] -> SpecEnv value
-	-- Assumes the list is in appropriate order
-specEnvFromList []    = EmptySE
-specEnvFromList alist = SpecEnv alist
-\end{code}
-
-In some SpecEnvs overlap is prohibited; that is, no pair of templates unify.
-
-In others, overlap is permitted, but only in such a way that one can make
-a unique choice when looking up.  That is, overlap is only permitted if
-one template matches the other, or vice versa.  So this is ok:
-
-  [a]  [Int]
-
-but this is not
-
-  (Int,a)  (b,Int)
-
-If overlap is permitted, the list is kept most specific first, so that
-the first lookup is the right choice.
-
-
-For now we just use association lists.
-
-\begin{code}
-emptySpecEnv :: SpecEnv a
-emptySpecEnv = EmptySE
-
-isEmptySpecEnv EmptySE = True
-isEmptySpecEnv _       = False
-\end{code}
-
-@lookupSpecEnv@ looks up in a @SpecEnv@, using a one-way match.  Since the env is kept
-ordered, the first match must be the only one.
-The thing we are looking up can have an
-arbitrary "flexi" part.
-
-\begin{code}
-lookupSpecEnv :: SDoc		-- For error report
-	      -> SpecEnv value	-- The envt
-	      -> [Type]		-- Key
-	      -> Maybe (TyVarEnv Type, value)
-		     
-lookupSpecEnv doc EmptySE key = Nothing
-lookupSpecEnv doc (SpecEnv alist) key
-  = find alist
-  where
-    find [] = Nothing
-    find ((tpl_tyvars, tpl, val) : rest)
-      = case matchTys tpl_tyvars tpl key of
-	  Nothing                 -> find rest
-	  Just (subst, leftovers) -> ASSERT( null leftovers )
-				     Just (subst, val)
-\end{code}
-
-@addToSpecEnv@ extends a @SpecEnv@, checking for overlaps.
-
-A boolean flag controls overlap reporting.
-
-True => overlap is permitted, but only if one template matches the other;
-        not if they unify but neither is 
-
-\begin{code}
-addToSpecEnv :: Bool                            -- True <=> overlap permitted
-             -> SpecEnv value			-- Envt
-	     -> [TyVar] -> [Type] -> value	-- New item
-	     -> MaybeErr (SpecEnv value)	-- Success...
-		          ([Type], value)	-- Failure: Offending overlap
-
-addToSpecEnv overlap_ok spec_env ins_tvs ins_tys value
-  = case spec_env of
-       EmptySE       -> returnMaB (SpecEnv [ins_item])
-       SpecEnv alist -> insert alist    `thenMaB` \ alist' ->
-                        returnMaB (SpecEnv alist')
-  where
-    ins_item = (ins_tvs, ins_tys, value)
-
-    insert [] = returnMaB [ins_item]
-    insert alist@(cur_item@(tpl_tvs, tpl_tys, val) : rest)
-
-	-- FAIL if:
-	-- (a) they are the same, or
-	-- (b) they unify, and any sort of overlap is prohibited,
-	-- (c) they unify but neither is more specific than t'other
-      |  identical 
-      || (unifiable && not overlap_ok)
-      || (unifiable && not (ins_item_more_specific || cur_item_more_specific))
-      =  failMaB (tpl_tys, val)
-
-	-- New item is an instance of current item, so drop it here
-      | ins_item_more_specific	= returnMaB (ins_item : alist)
-
-	-- Otherwise carry on
-      | otherwise  = insert rest     `thenMaB` \ rest' ->
-                     returnMaB (cur_item : rest')
-      where
-        unifiable = maybeToBool (unifyTyListsX (ins_tvs ++ tpl_tvs) tpl_tys ins_tys)
-        ins_item_more_specific = maybeToBool (matchTys tpl_tvs tpl_tys ins_tys)
-        cur_item_more_specific = maybeToBool (matchTys ins_tvs ins_tys tpl_tys)
-	identical = ins_item_more_specific && cur_item_more_specific
-\end{code}
-
-Finally, during simplification we must apply the current substitution to
-the SpecEnv.
-
-\begin{code}
-substSpecEnv :: TyVarEnv Type -> IdOrTyVarSet 
-	     -> (TyVarEnv Type -> IdOrTyVarSet -> val -> val)
-	     -> SpecEnv val -> SpecEnv val
-substSpecEnv ty_subst in_scope val_fn EmptySE = EmptySE
-substSpecEnv ty_subst in_scope val_fn (SpecEnv alist)
-  = SpecEnv (map subst alist)
-  where
-    subst (tpl_tyvars, tpl_tys, val)
-	= (tpl_tyvars', 
-	   map (fullSubstTy ty_subst' in_scope') tpl_tys, 
-	   val_fn ty_subst' in_scope' val)
-	where
-	  (ty_subst', in_scope', tpl_tyvars') = go ty_subst in_scope [] tpl_tyvars
-
-	  go s i acc []       = (s, i, reverse acc)
-	  go s i acc (tv:tvs) = case substTyVar s i tv of
-				  (s', i', tv') -> go s' i' (tv' : acc) tvs
-\end{code}