[project @ 1996-01-08 20:28:12 by partain]
[ghc.git] / ghc / compiler / typecheck / Spec.lhs
1 %
2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
3 %
4 %************************************************************************
5 %*                                                                      *
6 \section[Spec]{Specialisation of variables}
7 %*                                                                      *
8 %************************************************************************
9
10 One thing which happens {\em a lot} is the instantiation of a type scheme
11 caused by the occurrence of a variable.  It is so important that it
12 is written below in a very ``open-code'' fashion.  All the modular monadery
13 is discarded, and we work directly in terms of the underlying representations.
14 In particular, this function knows about
15
16         - the TcM monad
17         - the representation of UniTypes
18
19 \begin{code}
20 #include "HsVersions.h"
21
22 module Spec ( specId, specTy ) where
23
24 import AbsSyn
25 import TcMonadFns       ( copyTyVars, newDicts )
26 import TcMonad
27
28 import AbsUniType       {- ( instantiateTauTy, instantiateThetaTy,
29                           cloneTyVarFromTemplate, splitType
30                         ) -} -- pragmas want to see it all!
31 import Id               ( getIdUniType, mkInstId, DictVar(..) )
32 import Inst             -- ( mkMethod, InstOrigin(..), Inst, InstTemplate, SpecInfo )
33 import LIE
34 import Subst            ( getSubstTyVarUnique )
35 import UniType          -- known **GRIEVOUS** violation of UniType abstractness!!!
36 import SplitUniq
37 import Unique
38 import Util
39 \end{code}
40
41 %************************************************************************
42 %*                                                                      *
43 \subsection[Spec-specId]{Instantiating an Id}
44 %*                                                                      *
45 %************************************************************************
46
47 @specId@ takes an @Id@ and implements the SPEC and REL rules
48 returning
49         - the id applied to suitable types and dictionaries
50         - the LIE
51         - its instantiated tau type
52
53 For efficiency, it knows about the TcM implementation.
54
55 \begin{code}
56 specId :: Id -> NF_TcM (TypecheckedExpr, LIE, TauType)
57
58 specId id sw_chkr dtys subst uniq errs src_loc
59   = case (spec_sigma subst uniq src_loc id (getIdUniType id)) of
60       (result, subst2) -> (result, subst2, errs)
61 \end{code}
62
63 \begin{code}
64 spec_sigma :: Subst             -- TyVar unique supply inside *here*
65            -> SplitUniqSupply   -- "normal" unique supply
66            -> SrcLoc
67            -> Id
68            -> UniType
69            -> ((TypecheckedExpr, LIE, TauType), Subst)
70
71 spec_sigma subst uniq src_loc id (UniSyn _ _ ty)
72   = spec_sigma subst uniq src_loc id ty
73
74 spec_sigma subst uniq src_loc id ty@(UniForall _ _)
75   = collect [] [] subst ty
76   where
77     collect tenv tyvar_tys subst (UniForall tyvar ty)
78       = case (getSubstTyVarUnique subst) of
79           (subst', u) ->
80               collect ((tyvar, new_tyvar_ty) : tenv)
81                       (new_tyvar_ty : tyvar_tys)
82                       subst' ty
83               where
84                 new_tyvar_ty = UniTyVar (cloneTyVarFromTemplate tyvar u)
85
86     collect tenv tyvar_tys subst ty
87       = spec_rho tenv (reverse tyvar_tys) subst uniq src_loc id ty
88
89 spec_sigma subst uniq src_loc id tau_ty
90         -- Not polymorphic => cannot be overloaded
91   = ((Var id, nullLIE, tau_ty), subst)
92 \end{code}
93
94 \begin{code}
95 spec_rho :: [(TyVarTemplate, UniType)] -> [UniType]
96          -> Subst -> SplitUniqSupply -> SrcLoc
97          -> Id -> UniType
98          -> ((TypecheckedExpr, LIE, TauType), Subst)
99
100 spec_rho tenv tys subst uniqs src_loc id (UniSyn _ _ ty)
101   = spec_rho tenv tys subst uniqs src_loc id ty
102
103 spec_rho tenv tys subst uniqs src_loc id (UniFun (UniDict _ _) ty)
104   = ((Var inst_id, unitLIE method, instantiateTauTy tenv tau_ty),
105      subst)
106   where
107     method  = mkMethod u id tys (OccurrenceOf id src_loc)
108     inst_id = mkInstId method
109     u       = getSUnique uniqs
110     tau_ty  = discard_dicts ty
111
112     discard_dicts (UniFun (UniDict _ _) ty) = discard_dicts ty
113     discard_dicts other_ty                  = other_ty
114
115 spec_rho tenv tys subst uniqs src_loc id tau_ty
116   = ((TyApp (Var id) tys, nullLIE, instantiateTauTy tenv tau_ty),
117      subst)
118 \end{code}
119
120
121 %************************************************************************
122 %*                                                                      *
123 \subsection[Spec-specTy]{Instantiating a type}
124 %*                                                                      *
125 %************************************************************************
126
127 @specTy@ takes a polymorphic type, and instantiates it with fresh type
128 variables. It strips off the context part, gets fresh dictionary
129 variables for each predicate in the context.  It returns
130
131         - a list of the dictionary variables (remember they contain
132           their types)
133         - an instantiated tau-type
134
135 The returned values are fixed points of the current substitution
136 though the arguments may not be.
137
138 \begin{code}
139 specTy :: InstOrigin -> SigmaType -> NF_TcM ([TyVar], [Inst], TauType)
140
141 specTy origin sigma_ty
142   = let
143         (old_tyvars, theta, tau_ty) = splitType sigma_ty
144     in
145          -- make new tyvars for each of the universally quantified type vars
146     copyTyVars old_tyvars           `thenNF_Tc` \ (inst_env, new_tyvars, _) ->
147
148          -- instantiate the tau type
149     let
150         tau_ty' = instantiateTauTy inst_env tau_ty
151     in
152          -- instantiate the dictionary types
153     newDicts origin (instantiateThetaTy inst_env theta) `thenNF_Tc` \ dicts ->
154
155          -- return the list of tyvars, the list of dicts and the tau type
156     returnNF_Tc ( new_tyvars, dicts, tau_ty' )
157 \end{code}
158