git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Name resolution up the module hierarchy, allowing names in the global module to be referenced.
commit96edff244516d1bfd40fb5158fc74999c7ae06c6 authorPhil Freeman <paf31@cantab.net> dateFri 29 Nov 2013, 13:48 (13 years ago) parent3eec9f0
4 files changed+34−13
examples/passing/NameResolution.purs+15 src/Language/PureScript/Names.hs+5−1 src/Language/PureScript/TypeChecker/Monad.hs+9 src/Language/PureScript/TypeChecker/Types.hs+5−12
examples/passing/NameResolution.pursnew file+15
@@ -0,0 +1,15 @@
1+foo = \x -> x
2+
3+module A where
4+ bar = foo
5+
6+ module B where
7+
8+ abc = foo
9+ xyz = bar
10+
11+ foo = \x y -> x
12+
13+ baz = foo
14+
15+ abc = A:B:abc
src/Language/PureScript/Names.hs+5−1
@@ -17,7 +17,7 @@
1717module Language.PureScript.Names where
1818
1919import Data.Data
20−import Data.List (intercalate)
20+import Data.List (inits, intercalate)
2121
2222data Ident = Ident String | Op String deriving (Eq, Ord, Data, Typeable)
2323
@@ -49,3 +49,7 @@ instance (Show a) => Show (Qualified a) where
4949qualify :: ModulePath -> Qualified a -> (ModulePath, a)
5050qualify mp (Qualified (ModulePath []) a) = (mp, a)
5151qualify _ (Qualified mp a) = (mp, a)
52+
53+nameResolution :: ModulePath -> Qualified a -> [(ModulePath, a)]
54+nameResolution (ModulePath mp) (Qualified (ModulePath []) a) = [ (ModulePath mp', a) | mp' <- reverse $ inits mp ]
55+nameResolution _ (Qualified mp a) = [(mp, a)]
src/Language/PureScript/TypeChecker/Monad.hs+9
@@ -62,6 +62,15 @@ bindLocalVariables bindings action = do
6262 modulePath <- checkModulePath `fmap` get
6363 bindNames (M.fromList $ flip map bindings $ \(name, ty) -> ((modulePath, name), (ty, LocalVariable))) action
6464
65+lookupVariable :: (Functor m, MonadState CheckState m, MonadError String m) => Qualified Ident -> m Type
66+lookupVariable var = do
67+ env <- getEnv
68+ modulePath <- checkModulePath <$> get
69+ let tries = map (First . flip M.lookup (names env)) (nameResolution modulePath var)
70+ case getFirst (mconcat tries) of
71+ Nothing -> throwError $ show var ++ " is undefined"
72+ Just (ty, _) -> return ty
73+
6574data AnyUnifiable where
6675 AnyUnifiable :: forall t. (Unifiable t) => t -> AnyUnifiable
6776
src/Language/PureScript/TypeChecker/Types.hs+5−12
@@ -325,11 +325,8 @@ infer' app@(App _ _) = do
325325 checkFunctionApplications ft argss ret
326326 return ret
327327infer' (Var var@(Qualified mp name)) = do
328− env <- getEnv
329− modulePath <- checkModulePath `fmap` get
330− case M.lookup (qualify modulePath var) (names env) of
331− Nothing -> throwError $ show var ++ " is undefined"
332− Just (ty, _) -> replaceAllTypeSynonyms ty
328+ ty <- lookupVariable var
329+ replaceAllTypeSynonyms ty
333330infer' (Block ss) = do
334331 ret <- fresh
335332 (allCodePathsReturn, _) <- checkBlock M.empty ret ss
@@ -613,13 +610,9 @@ check' app@(App _ _) ret = do
613610 ft <- infer f
614611 checkFunctionApplications ft argss ret
615612check' v@(Var var@(Qualified mp name)) ty = do
616− env <- getEnv
617− modulePath <- checkModulePath <$> get
618− case M.lookup (qualify modulePath var) (names env) of
619− Nothing -> throwError $ show var ++ " is undefined"
620− Just (ty1, _) -> do
621− repl <- replaceAllTypeSynonyms ty1
622− repl `subsumes` ty
613+ ty1 <- lookupVariable var
614+ repl <- replaceAllTypeSynonyms ty1
615+ repl `subsumes` ty
623616check' (TypedValue val ty1) ty2 = do
624617 kind <- liftCheck $ kindOf ty1
625618 guardWith ("Expected type of kind *, was " ++ prettyPrintKind kind) $ kind == Star