40338c8 · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

Just use Qualified name for dcons

commit40338c8e3632b134f51fc2df62f1c9bf98f1742c authorGary Burgess <gary.burgess@gmail.com> dateThu 27 Feb 2014, 13:04 (13 years ago) parenteeb5c85

4 files changed+9−17

compare with golang

unifiedsplit

src/Language/PureScript/CodeGen/JS.hs+1−1 src/Language/PureScript/TypeChecker.hs+4−12 src/Language/PureScript/TypeChecker/Monad.hs+1−1 src/Language/PureScript/TypeChecker/Types.hs+3−3

src/Language/PureScript/CodeGen/JS.hs+1−1

@@ -308,7 +308,7 @@ binderToJs m e varName done (NamedBinder ident binder) = do

308308--

309309isOnlyConstructor :: ModuleName -> Environment -> Qualified ProperName -> Bool

310310isOnlyConstructor m e ctor =

311− let ty = fromMaybe (error "Data constructor not found") $ qualify m ctor `M.lookup` dataConstructors e

311+ let ty = fromMaybe (error "Data constructor not found") $ ctor `M.lookup` dataConstructors e

312312 in numConstructors ty == 1

313313 where

314314 numConstructors ty = length $ filter (((==) `on` typeConstructor) ty) $ M.elems $ dataConstructors e

src/Language/PureScript/TypeChecker.hs+4−12

@@ -49,11 +49,10 @@ addDataType moduleName name args dctors ctorKind = do

4949addDataConstructor :: ModuleName -> ProperName -> [String] -> ProperName -> [Type] -> Check ()

5050addDataConstructor moduleName name args dctor tys = do

5151 env <- getEnv

52− dataConstructorIsNotDefined moduleName dctor

5352 let retTy = foldl TypeApp (TypeConstructor (Qualified (Just moduleName) name)) (map TypeVar args)

5453 let dctorTy = foldr function retTy tys

5554 let polyType = mkForAll args dctorTy

56− putEnv $ env { dataConstructors = M.insert (moduleName, dctor) (qualifyAllUnqualifiedNames moduleName env polyType) (dataConstructors env) }

55+ putEnv $ env { dataConstructors = M.insert (Qualified (Just moduleName) dctor) (qualifyAllUnqualifiedNames moduleName env polyType) (dataConstructors env) }

5756

5857addTypeSynonym :: ModuleName -> ProperName -> [String] -> Type -> Kind -> Check ()

5958addTypeSynonym moduleName name args ty kind = do

@@ -67,12 +66,6 @@ typeIsNotDefined moduleName name = do

6766 guardWith (show name ++ " is already defined") $

6867 not $ M.member (moduleName, name) (types env)

6968

70−dataConstructorIsNotDefined :: ModuleName -> ProperName -> Check ()

71−dataConstructorIsNotDefined moduleName dctor = do

72− env <- getEnv

73− guardWith (show dctor ++ " is already defined") $

74− not $ M.member (moduleName, dctor) (dataConstructors env)

75−

7669valueIsNotDefined :: ModuleName -> Ident -> Check ()

7770valueIsNotDefined moduleName name = do

7871 env <- getEnv

@@ -221,12 +214,11 @@ typeCheckAll mainModuleName currentModule (d@(ImportDeclaration moduleName ident

221214 Just (k, _) -> do

222215 guardWith (show currentModule ++ "." ++ show pn ++ " is already defined") $ (currentModule, pn) `M.notMember` types env

223216 modifyEnv (\e -> e { types = M.insert (currentModule, pn) (k, DataAlias moduleName pn) (types e) })

224− let keys = map (snd . fst) . filter (\(_, fn) -> fn `constructs` pn) . M.toList . dataConstructors $ env

217+ let keys = map fst . filter (\(_, fn) -> fn `constructs` pn) . M.toList . dataConstructors $ env

225218 forM_ keys $ \dctor ->

226− case (moduleName, dctor) `M.lookup` dataConstructors env of

219+ case dctor `M.lookup` dataConstructors env of

227220 Just ctorTy -> do

228− guardWith (show currentModule ++ "." ++ show dctor ++ " is already defined") $ (currentModule, dctor) `M.notMember` dataConstructors env

229− modifyEnv (\e -> e { dataConstructors = M.insert (currentModule, dctor) ctorTy (dataConstructors e) })

221+ modifyEnv (\e -> e { dataConstructors = M.insert dctor ctorTy (dataConstructors e) })

230222 Nothing -> throwError (show moduleName ++ "." ++ show dctor ++ " is undefined")

231223 shadowTypeClassInstances env = do

232224 let instances = filter (\tcd ->

src/Language/PureScript/TypeChecker/Monad.hs+1−1

@@ -101,7 +101,7 @@ data Environment = Environment {

101101 -- |

102102 -- Data constructors currently in scope, along with their associated data type constructors

103103 --

104− , dataConstructors :: M.Map (ModuleName, ProperName) Type

104+ , dataConstructors :: M.Map (Qualified ProperName) Type

105105 -- |

106106 -- Type synonyms currently in scope

107107 --

src/Language/PureScript/TypeChecker/Types.hs+3−3

@@ -545,7 +545,7 @@ infer' (Var var) = do

545545infer' v@(Constructor c) = do

546546 env <- getEnv

547547 Just moduleName <- checkCurrentModule <$> get

548− case M.lookup (qualify moduleName c) (dataConstructors env) of

548+ case M.lookup c (dataConstructors env) of

549549 Nothing -> throwError $ "Constructor " ++ show c ++ " is undefined"

550550 Just ty -> do ty' <- introduceSkolemScope <=< replaceAllTypeSynonyms $ ty

551551 return $ TypedValue True v ty'

@@ -596,7 +596,7 @@ inferBinder val (VarBinder name) = return $ M.singleton name val

596596inferBinder val (ConstructorBinder ctor binders) = do

597597 env <- getEnv

598598 Just moduleName <- checkCurrentModule <$> get

599− case M.lookup (qualify moduleName ctor) (dataConstructors env) of

599+ case M.lookup ctor (dataConstructors env) of

600600 Just ty -> do

601601 (_, fn) <- instantiatePolyTypeWithUnknowns (error "Data constructor types cannot contains constraints") ty

602602 go binders fn

@@ -806,7 +806,7 @@ check' (Accessor prop val) ty = do

806806check' (Constructor c) ty = do

807807 env <- getEnv

808808 Just moduleName <- checkCurrentModule <$> get

809− case M.lookup (qualify moduleName c) (dataConstructors env) of

809+ case M.lookup c (dataConstructors env) of

810810 Nothing -> throwError $ "Constructor " ++ show c ++ " is undefined"

811811 Just ty1 -> do

812812 repl <- introduceSkolemScope <=< replaceAllTypeSynonyms $ ty1