@@ -46,7 +46,7 @@ simplify :: Bool -> DExp -> State (DDefs, Int) SExp
46simplify tl (DV (Loc i)) = return (SV (Loc i))
46simplify tl (DV (Loc i)) = return (SV (Loc i))
47simplify tl (DV (Glob x))
47simplify tl (DV (Glob x))
48 = do ctxt <- ldefs
48 = do ctxt <- ldefs
49− case lookupCtxt x ctxt of
49+ case lookupCtxtExact x ctxt of
50 [DConstructor _ t 0] -> return $ SCon t x []
50 [DConstructor _ t 0] -> return $ SCon t x []
51 _ -> return $ SV (Glob x)
51 _ -> return $ SV (Glob x)
52simplify tl (DApp tc n args) = do args' <- mapM sVar args
52simplify tl (DApp tc n args) = do args' <- mapM sVar args
@@ -88,7 +88,7 @@ simplify tl (DError str) = return $ SError str
89sVar (DV (Glob x))
89sVar (DV (Glob x))
90 = do ctxt <- ldefs
90 = do ctxt <- ldefs
91− case lookupCtxt x ctxt of
91+ case lookupCtxtExact x ctxt of
92 [DConstructor _ t 0] -> sVar (DC t x [])
92 [DConstructor _ t 0] -> sVar (DC t x [])
93 _ -> return (Glob x, Nothing)
93 _ -> return (Glob x, Nothing)
94sVar (DV x) = return (x, Nothing)
94sVar (DV x) = return (x, Nothing)
@@ -136,7 +136,7 @@ scopecheck ctxt envTop tm = sc envTop tm where
136 sc env (SV (Glob n)) =
136 sc env (SV (Glob n)) =
137 case lookup n (reverse env) of -- most recent first
137 case lookup n (reverse env) of -- most recent first
138 Just i -> do lvar i; return (SV (Loc i))
138 Just i -> do lvar i; return (SV (Loc i))
139− Nothing -> case lookupCtxt n ctxt of
139+ Nothing -> case lookupCtxtExact n ctxt of
140 [DConstructor _ i ar] ->
140 [DConstructor _ i ar] ->
141 if True -- ar == 0
141 if True -- ar == 0
142 then return (SCon i n [])
142 then return (SCon i n [])
@@ -146,7 +146,7 @@ scopecheck ctxt envTop tm = sc envTop tm where
146 [] -> fail $ "Codegen error: No such variable " ++ show n
146 [] -> fail $ "Codegen error: No such variable " ++ show n
147 sc env (SApp tc f args)
147 sc env (SApp tc f args)
148 = do args' <- mapM (scVar env) args
148 = do args' <- mapM (scVar env) args
149− case lookupCtxt f ctxt of
149+ case lookupCtxtExact f ctxt of
150 [DConstructor n tag ar] ->
150 [DConstructor n tag ar] ->
151 if True -- (ar == length args)
151 if True -- (ar == length args)
152 then return $ SCon tag n args'
152 then return $ SCon tag n args'
@@ -160,7 +160,7 @@ scopecheck ctxt envTop tm = sc envTop tm where
160 return $ SForeign l ty f args'
160 return $ SForeign l ty f args'
161 sc env (SCon tag f args)
161 sc env (SCon tag f args)
162 = do args' <- mapM (scVar env) args
162 = do args' <- mapM (scVar env) args
163− case lookupCtxt f ctxt of
163+ case lookupCtxtExact f ctxt of
164 [DConstructor n tag ar] ->
164 [DConstructor n tag ar] ->
165 if True -- (ar == length args)
165 if True -- (ar == length args)
166 then return $ SCon tag n args'
166 then return $ SCon tag n args'
@@ -197,7 +197,7 @@ scopecheck ctxt envTop tm = sc envTop tm where
197 scVar env (Glob n) =
197 scVar env (Glob n) =
198 case lookup n (reverse env) of -- most recent first
198 case lookup n (reverse env) of -- most recent first
199 Just i -> do lvar i; return (Loc i)
199 Just i -> do lvar i; return (Loc i)
200− Nothing -> case lookupCtxt n ctxt of
200+ Nothing -> case lookupCtxtExact n ctxt of
201 [DConstructor _ i ar] ->
201 [DConstructor _ i ar] ->
202 fail $ "Codegen error : can't pass constructor here"
202 fail $ "Codegen error : can't pass constructor here"
203 [_] -> return (Glob n)
203 [_] -> return (Glob n)
@@ -207,7 +207,7 @@ scopecheck ctxt envTop tm = sc envTop tm where
208 scalt env (SConCase _ i n args e)
208 scalt env (SConCase _ i n args e)
209 = do let env' = env ++ zip args [length env..]
209 = do let env' = env ++ zip args [length env..]
210− tag <- case lookupCtxt n ctxt of
210+ tag <- case lookupCtxtExact n ctxt of
211 [DConstructor _ i ar] ->
211 [DConstructor _ i ar] ->
212 if True -- (length args == ar)
212 if True -- (length args == ar)
213 then return i
213 then return i