40338c8 · rowtype-yoga/purescript-native

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

on golang help sign in

Just use Qualified name for dcons

40338c8Gary Burgess13 years ago

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

compare with golang

unifiedsplit

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

308--

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

310isOnlyConstructor 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

312 in numConstructors ty == 1

313 where

314 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

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

50addDataConstructor moduleName name args dctor tys = do

51 env <- getEnv

52− dataConstructorIsNotDefined moduleName dctor

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

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

54 let dctorTy = foldr function retTy tys

53 let dctorTy = foldr function retTy tys

55 let polyType = mkForAll args dctorTy

54 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) }

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

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

59addTypeSynonym moduleName name args ty kind = do

58addTypeSynonym moduleName name args ty kind = do

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

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

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

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

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

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−

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

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

77valueIsNotDefined moduleName name = do

70valueIsNotDefined moduleName name = do

78 env <- getEnv

71 env <- getEnv

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

221 Just (k, _) -> do

214 Just (k, _) -> do

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

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

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

216 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

225 forM_ keys $ \dctor ->

218 forM_ keys $ \dctor ->

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

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

227 Just ctorTy -> do

220 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) })

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

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

231 shadowTypeClassInstances env = do

223 shadowTypeClassInstances env = do

232 let instances = filter (\tcd ->

224 let instances = filter (\tcd ->

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

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

101 -- |

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

103 --

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

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

105 -- |

106 -- Type synonyms currently in scope

107 --

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

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

545infer' v@(Constructor c) = do

546 env <- getEnv

547 Just moduleName <- checkCurrentModule <$> get

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

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

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

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

551 return $ TypedValue True v ty'

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

596inferBinder val (ConstructorBinder ctor binders) = do

597 env <- getEnv

598 Just moduleName <- checkCurrentModule <$> get

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

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

600 Just ty -> do

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

602 go binders fn

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

806check' (Constructor c) ty = do

807 env <- getEnv

808 Just moduleName <- checkCurrentModule <$> get

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

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

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

811 Just ty1 -> do

812 repl <- introduceSkolemScope <=< replaceAllTypeSynonyms $ ty1