@@ -155,10 +155,18 @@ typeOf :: Maybe Ident -> Value -> Check Type
155155typeOf name val = do
156156 (ty, sub, checks) <- runSubst $ case name of
157157 Just ident | isFunction val ->
158− do me <- fresh
159− ty <- infer (M.singleton ident me) val
160− ty `subsumes` me
161− return ty
158+ case val of
159+ TypedValue val ty -> do
160+ kind <- lift $ kindOf ty
161+ guardWith ("Expected type of kind *, was " ++ prettyPrintKind kind) $ kind == Star
162+ ty' <- lift $ replaceAllTypeSynonyms ty
163+ check (M.singleton ident ty) val ty'
164+ return ty'
165+ _ -> do
166+ me <- fresh
167+ ty <- infer (M.singleton ident me) val
168+ ty ~~ me
169+ return ty
162170 _ -> infer M.empty val
163171 escapeCheck checks ty sub
164172 return $ varIfUnknown $ desaturateAllTypeSynonyms $ setifyAll ty
@@ -179,40 +187,8 @@ setify = rowFromList . first (M.toList . M.fromList) . rowToList
179187setifyAll :: (D.Data d) => d -> d
180188setifyAll = everywhere (mkT setify)
181189
182−findTypeVars :: (D.Data d) => d -> [String]
183−findTypeVars = everything (++) (mkQ [] f)
184− where
185− f :: Type -> [String]
186− f (TypeVar v) = [v]
187− f _ = []
188−
189190varIfUnknown :: Type -> Type
190−varIfUnknown ty =
191− let
192− (ty', m) = flip runState M.empty $ everywhereM (flip extM g $ mkM f) ty
193− in
194− mkForAll (sort $ nub $ M.elems m ++ findTypeVars ty) ty'
195− where
196− f :: Type -> State (M.Map Int String) Type
197− f (TUnknown (Unknown n)) = do
198− m <- get
199− case M.lookup n m of
200− Nothing -> do
201− let name = 't' : show (M.size m)
202− put $ M.insert n name m
203− return $ TypeVar name
204− Just name -> return $ TypeVar name
205− f t = return t
206− g :: Row -> State (M.Map Int String) Row
207− g (RUnknown (Unknown n)) = do
208− m <- get
209− case M.lookup n m of
210− Nothing -> do
211− let name = 'r' : show (M.size m)
212− put $ M.insert n name m
213− return $ RowVar name
214− Just name -> return $ RowVar name
215− g r = return r
191+varIfUnknown ty = mkForAll (sort . map ((:) 'u' . show) . nub $ unknowns ty) ty
216192
217193replaceTypeVars :: M.Map String Type -> Type -> Type
218194replaceTypeVars m = everywhere (mkT replace)