git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
General tidying, better approach to recursive functions with a top-level quantifier
50cf905Phil Freeman
src/Language/PureScript/TypeChecker/Types.hs+13−37
@@ -155,10 +155,18 @@ typeOf :: Maybe Ident -> Value -> Check Type
155typeOf name val = do
155typeOf name val = do
156 (ty, sub, checks) <- runSubst $ case name of
156 (ty, sub, checks) <- runSubst $ case name of
157 Just ident | isFunction val ->
157 Just ident | isFunction val ->
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
158− do me <- fresh
166+ me <- fresh
159− ty <- infer (M.singleton ident me) val
167+ ty <- infer (M.singleton ident me) val
160− ty `subsumes` me
168+ ty ~~ me
161− return ty
169+ return ty
162 _ -> infer M.empty val
170 _ -> infer M.empty val
163 escapeCheck checks ty sub
171 escapeCheck checks ty sub
164 return $ varIfUnknown $ desaturateAllTypeSynonyms $ setifyAll ty
172 return $ varIfUnknown $ desaturateAllTypeSynonyms $ setifyAll ty
@@ -179,40 +187,8 @@ setify = rowFromList . first (M.toList . M.fromList) . rowToList
179setifyAll :: (D.Data d) => d -> d
187setifyAll :: (D.Data d) => d -> d
180setifyAll = everywhere (mkT setify)
188setifyAll = everywhere (mkT setify)
181
189
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−
189varIfUnknown :: Type -> Type
190varIfUnknown :: Type -> Type
190−varIfUnknown ty =
191+varIfUnknown ty = mkForAll (sort . map ((:) 'u' . show) . nub $ unknowns ty) 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
216
192
217replaceTypeVars :: M.Map String Type -> Type -> Type
193replaceTypeVars :: M.Map String Type -> Type -> Type
218replaceTypeVars m = everywhere (mkT replace)
194replaceTypeVars m = everywhere (mkT replace)