@@ -125,15 +125,17 @@ checkDefs ctxt (con@(n, DConstructor _ _ _) : xs)
125125 return xs'
126126checkDefs ctxt ((n, DFun n' args exp) : xs)
127127 = do let sexp = evalState (simplify True exp) (ctxt, 0)
128− (exp', locs) <- runStateT (scopecheck ctxt (zip args [0..]) sexp) (length args)
128+ (exp', locs) <- runStateT (scopecheck n ctxt (zip args [0..]) sexp) (length args)
129129 xs' <- checkDefs ctxt xs
130130 return ((n, SFun n' args ((locs + 1) - length args) exp') : xs')
131131
132132lvar v = do i <- get
133133 put (max i v)
134134
135−scopecheck :: DDefs -> [(Name, Int)] -> SExp -> StateT Int TC SExp
136−scopecheck ctxt envTop tm = sc envTop tm where
135+scopecheck :: Name -> DDefs -> [(Name, Int)] -> SExp -> StateT Int TC SExp
136+scopecheck fn ctxt envTop tm = sc envTop tm where
137+ failsc err = fail $ "Codegen error in " ++ show fn ++ ":" ++ err
138+
137139 sc env (SV (Glob n)) =
138140 case lookup n (reverse env) of -- most recent first
139141 Just i -> do lvar i; return (SV (Loc i))
@@ -141,20 +143,20 @@ scopecheck ctxt envTop tm = sc envTop tm where
141143 Just (DConstructor _ i ar) ->
142144 if True -- ar == 0
143145 then return (SCon i n [])
144− else fail $ "Codegen error: Constructor " ++ show n ++
146+ else failsc $ "Constructor " ++ show n ++
145147 " has arity " ++ show ar
146148 Just _ -> return (SV (Glob n))
147− Nothing -> fail $ "Codegen error: No such variable " ++ show n
149+ Nothing -> failsc $ "No such variable " ++ show n
148150 sc env (SApp tc f args)
149151 = do args' <- mapM (scVar env) args
150152 case lookupCtxtExact f ctxt of
151153 Just (DConstructor n tag ar) ->
152154 if True -- (ar == length args)
153155 then return $ SCon tag n args'
154− else fail $ "Codegen error: Constructor " ++ show f ++
156+ else failsc $ "Constructor " ++ show f ++
155157 " has arity " ++ show ar
156158 Just _ -> return $ SApp tc f args'
157− Nothing -> fail $ "Codegen error: No such variable " ++ show f
159+ Nothing -> failsc $ "No such variable " ++ show f
158160 sc env (SForeign l ty f args)
159161 = do args' <- mapM (\ (t, a) -> do a' <- scVar env a
160162 return (t, a')) args
@@ -165,9 +167,9 @@ scopecheck ctxt envTop tm = sc envTop tm where
165167 Just (DConstructor n tag ar) ->
166168 if True -- (ar == length args)
167169 then return $ SCon tag n args'
168− else fail $ "Codegen error: Constructor " ++ show f ++
169− " has arity " ++ show ar
170− _ -> fail $ "Codegen error: No such constructor " ++ show f
170+ else failsc $ "Constructor " ++ show f ++
171+ " has arity " ++ show ar
172+ _ -> failsc $ "No such constructor " ++ show f
171173 sc env (SProj e i)
172174 = do e' <- scVar env e
173175 return (SProj e' i)
@@ -200,9 +202,9 @@ scopecheck ctxt envTop tm = sc envTop tm where
200202 Just i -> do lvar i; return (Loc i)
201203 Nothing -> case lookupCtxtExact n ctxt of
202204 Just (DConstructor _ i ar) ->
203− fail $ "Codegen error : can't pass constructor here"
205+ failsc $ "can't pass constructor here"
204206 Just _ -> return (Glob n)
205− Nothing -> fail $ "Codegen error: No such variable " ++ show n ++
207+ Nothing -> failsc $ "No such variable " ++ show n ++
206208 " in " ++ show tm ++ " " ++ show envTop
207209 scVar _ x = return x
208210
@@ -212,9 +214,9 @@ scopecheck ctxt envTop tm = sc envTop tm where
212214 Just (DConstructor _ i ar) ->
213215 if True -- (length args == ar)
214216 then return i
215− else fail $ "Codegen error: Constructor " ++ show n ++
217+ else failsc $ "Constructor " ++ show n ++
216218 " has arity " ++ show ar
217− _ -> fail $ "Codegen error: No constructor " ++ show n
219+ _ -> failsc $ "No constructor " ++ show n
218220 e' <- sc env' e
219221 return (SConCase (length env) tag n args e')
220222 scalt env (SConstCase c e) = do e' <- sc env e