@@ -42,32 +42,18 @@ annotateRec
4242annotateRec _ sc a = go sc a where
4343 go :: forall a . Resolvable a => Scope -> a -> a
4444 go sc a
45- | ReferenceV <- getL nameCtx sc
46- , Just (Refl :: QName (Scoped l ) :~: a ) <- eqT
47- = lookupValue (fmap sLoc a) sc <$ a
48- | ReferenceT <- getL nameCtx sc
49- , Just (Refl :: QName (Scoped l ) :~: a ) <- eqT
50- = lookupType (fmap sLoc a) sc <$ a
51- | ReferenceUV <- getL nameCtx sc
52- , Just (Refl :: Name (Scoped l ) :~: a ) <- eqT
53- = lookupMethod (fmap sLoc a) sc <$ a
54- | ReferenceUT <- getL nameCtx sc
55- , Just (Refl :: QName (Scoped l ) :~: a ) <- eqT
56- = lookupAssociatedType (fmap sLoc a) sc <$ a
57- | BindingV <- getL nameCtx sc
58- , Just (Refl :: Name (Scoped l ) :~: a ) <- eqT
59- = Scoped ValueBinder (sLoc . ann $ a) <$ a
60- | BindingT <- getL nameCtx sc
61- , Just (Refl :: Name (Scoped l ) :~: a ) <- eqT
62- = Scoped TypeBinder (sLoc . ann $ a) <$ a
45+ | Just (Refl :: QName (Scoped l ) :~: a ) <- eqT
46+ = lookupQName (fmap sLoc a) sc <$ a
47+ | Just (Refl :: Name (Scoped l ) :~: a ) <- eqT
48+ = lookupName (fmap sLoc a) sc <$ a
6349 | Just (Refl :: FieldUpdate (Scoped l ) :~: a ) <- eqT
6450 = case a of
65- FieldPun l n -> FieldPun l (lookupValue (sLoc <$> n ) sc <$ n )
51+ FieldPun l qname -> FieldPun l (lookupQName (sLoc <$> qname ) sc <$ qname )
6652 FieldWildcard l -> FieldWildcard (Scoped (RecExpWildcard namesRes) (sLoc l)) where
6753 namesRes = do
6854 f <- sc ^. wcNames
69- let qn = setAnn (sLoc l) (UnQual () (annName (wcFieldName f)))
70- case lookupValue qn sc of
55+ let qname = setAnn (sLoc l) (UnQual () (annName (wcFieldName f)))
56+ case lookupQName qname sc of
7157 Scoped info@ (GlobalSymbol _ _) _ -> return (wcFieldName f,info)
7258 Scoped info@ (LocalValue _) _ -> return (wcFieldName f,info)
7359 _ -> []
@@ -77,60 +63,74 @@ annotateRec _ sc a = go sc a where
7763 = let
7864 namesRes = do
7965 f <- sc ^. wcNames
80- let qn = UnQual () (annName (wcFieldName f))
81- Scoped (GlobalSymbol symbol _) _ <- return (lookupValue qn sc )
66+ let qname = UnQual () (annName (wcFieldName f))
67+ Scoped (GlobalSymbol symbol _) _ <- return (lookupQName qname (exprV sc) )
8268 return (symbol {symbolModule = wcFieldModuleName f})
83- in PFieldWildcard (Scoped (RecPatWildcard namesRes) (sLoc l))
69+ in PFieldWildcard (Scoped (RecPatWildcard namesRes) (sLoc l))
8470 | otherwise
8571 = rmap go sc a
8672
87- lookupValue :: QName l -> Scope -> Scoped l
88- lookupValue (Special l _) _ = Scoped None l
89- lookupValue qn sc = Scoped nameInfo (ann qn)
90- where
91- nameInfo =
92- case Local. lookupValue qn $ getL lTable sc of
93- Right -> LocalValue r
94- _ ->
95- case Global. lookupValue qn $ getL gTable sc of
96- Global. SymbolFound-> GlobalSymbol r (sQName qn)
97- Global. Error-> ScopeError e
98- Global. Special-> None
99-
100- lookupType :: QName l -> Scope -> Scoped l
101- lookupType (Special l _) _ = Scoped None l
102- lookupType qn sc = Scoped nameInfo (ann qn)
103- where
104- nameInfo =
105- case Global. lookupType qn $ getL gTable sc of
106- Global. SymbolFound-> GlobalSymbol r (sQName qn)
107- Global. Error-> ScopeError e
108- Global. Special-> None
109-
110- lookupMethod :: Name l -> Scope -> Scoped l
111- lookupMethod n sc = Scoped nameInfo (ann qn)
112- where
113- nameInfo =
114- case Global. lookupMethodOrAssociate qn $ getL gTable sc of
115- Global. SymbolFound-> GlobalSymbol r (sQName qn)
116- Global. Error-> ScopeError e
117- Global. Special-> None
118- qn = qualifyName (getL instQual sc) n
119-
120- lookupAssociatedType :: QName l -> Scope -> Scoped l
121- lookupAssociatedType qn sc = Scoped nameInfo (ann qn)
122- where
123- nameInfo =
124- case Global. lookupMethodOrAssociate qn' $ getL gTable sc of
125- Global. SymbolFound-> GlobalSymbol r (sQName qn)
126- Global. Error-> ScopeError e
127- Global. Special-> None
128- qn' = case qn of
129- UnQual _ n -> qualifyName (getL instQual sc) n
130- _ -> qn
73+
74+ lookupQName :: QName l -> Scope -> Scoped l
75+ lookupQName (Special l _) _ = Scoped None l
76+ lookupQName qname scope = Scoped nameInfo (ann qname) where
77+
78+ nameInfo = case getL nameCtx scope of
79+
80+ ReferenceV -> case Local. lookupValue qname (getL lTable scope) of
81+ Right -> LocalValue srcloc
82+ _ ->
83+ checkUniqueness (Global. lookupValue qname globalTable)
84+
85+ ReferenceT ->
86+ checkUniqueness (Global. lookupType qname globalTable)
87+
88+ ReferenceUT ->
89+ checkUniqueness (Global. lookupMethodOrAssociate qname' globalTable) where
90+ qname' = case qname of
91+ UnQual _ name -> qualifyName (getL instQual scope) name
92+ _ -> qname
93+
94+ _ -> None
95+
96+ globalTable = getL gTable scope
97+
98+ checkUniqueness symbols = case symbols of
99+ [] -> ScopeError (ENotInScope qname)
100+ [symbol] -> GlobalSymbol symbol (sQName qname)
101+ _ -> ScopeError (EAmbiguous qname symbols)
102+
103+
104+ lookupName :: Name l -> Scope -> Scoped l
105+ lookupName name scope = Scoped nameInfo (ann name) where
106+
107+ nameInfo = case getL nameCtx scope of
108+
109+ ReferenceUV ->
110+ checkUniqueness qname (Global. lookupMethodOrAssociate qname globalTable) where
111+ qname = qualifyName (getL instQual scope) name
112+
113+ SignatureV ->
114+ checkUniqueness qname (Global. lookupValue qname globalTable) where
115+ qname = qualifyName (Just (getL moduName scope)) name
116+
117+ BindingV -> ValueBinder
118+
119+ BindingT -> TypeBinder
120+
121+ _ -> None
122+
123+ globalTable = getL gTable scope
124+
125+ checkUniqueness qname symbols = case symbols of
126+ [] -> ScopeError (ENotInScope qname)
127+ [symbol] -> GlobalSymbol symbol (sQName qname)
128+ _ -> ScopeError (EAmbiguous qname symbols)
129+
131130
132131qualifyName :: Maybe UnAnn. ModuleName-> Name l -> QName l
133132qualifyName Nothing n = UnQual (ann n) n
134- qualifyName (Just (UnAnn. ModuleName= Qual (ann n) annotatedModuleName n
135- where
133+ qualifyName (Just (UnAnn. ModuleName=
134+ Qual (ann n) annotatedModuleName n where
136135 annotatedModuleName = ModuleName (ann n) moduleName
136+
0 commit comments