96edff2 · rowtype-yoga/purescript-native

examples/passing/NameResolution.pursnew file+15

compare with golang

unifiedsplit

@@ -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 @@

17module Language.PureScript.Names where

18

19import Data.Data

20−import Data.List (intercalate)

20+import Data.List (inits, intercalate)

21

22data Ident = Ident String | Op String deriving (Eq, Ord, Data, Typeable)

23

@@ -49,3 +49,7 @@ instance (Show a) => Show (Qualified a) where

49qualify :: ModulePath -> Qualified a -> (ModulePath, a)

50qualify mp (Qualified (ModulePath []) a) = (mp, a)

51qualify _ (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

62 modulePath <- checkModulePath `fmap` get

63 bindNames (M.fromList $ flip map bindings $ \(name, ty) -> ((modulePath, name), (ty, LocalVariable))) action

64

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+

65data AnyUnifiable where

74data AnyUnifiable where

66 AnyUnifiable :: forall t. (Unifiable t) => t -> AnyUnifiable

75 AnyUnifiable :: forall t. (Unifiable t) => t -> AnyUnifiable

67

76

src/Language/PureScript/TypeChecker/Types.hs+5−12

@@ -325,11 +325,8 @@ infer' app@(App _ _) = do

325 checkFunctionApplications ft argss ret

326 return ret

327infer' (Var var@(Qualified mp name)) = do

328− env <- getEnv

328+ ty <- lookupVariable var

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

329+ replaceAllTypeSynonyms ty

333infer' (Block ss) = do

330infer' (Block ss) = do

334 ret <- fresh

331 ret <- fresh

335 (allCodePathsReturn, _) <- checkBlock M.empty ret ss

332 (allCodePathsReturn, _) <- checkBlock M.empty ret ss

@@ -613,13 +610,9 @@ check' app@(App _ _) ret = do

613 ft <- infer f

610 ft <- infer f

614 checkFunctionApplications ft argss ret

611 checkFunctionApplications ft argss ret

615check' v@(Var var@(Qualified mp name)) ty = do

612check' v@(Var var@(Qualified mp name)) ty = do

616− env <- getEnv

613+ ty1 <- lookupVariable var

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

614+ repl <- replaceAllTypeSynonyms ty1

622− repl `subsumes` ty

615+ repl `subsumes` ty

623check' (TypedValue val ty1) ty2 = do

616check' (TypedValue val ty1) ty2 = do

624 kind <- liftCheck $ kindOf ty1

617 kind <- liftCheck $ kindOf ty1

625 guardWith ("Expected type of kind *, was " ++ prettyPrintKind kind) $ kind == Star

618 guardWith ("Expected type of kind *, was " ++ prettyPrintKind kind) $ kind == Star