git.iko.soy/Idris-dev
on master help sign in
More informative case failure errors, cleanup
3e50b1bBenjamin Saunders
llvm/defs.c+20−13
compare with master
unifiedsplit
@@ -5,26 +5,33 @@ void putStr(const char *str) {
5 fputs(str, stdout);
5 fputs(str, stdout);
6}
6}
7
7
8−void mpz_set_ull(mpz_t n, unsigned long long ull)
8+void mpz_init_set_ull(mpz_t n, unsigned long long ull)
9{
9{
10− mpz_set_ui(n, (unsigned int)(ull >> 32)); /* n = (unsigned int)(ull >> 32) */
10+ mpz_init_set_ui(n, (unsigned int)(ull >> 32)); /* n = (unsigned int)(ull >> 32) */
11− mpz_mul_2exp(n, n, 32); /* n <<= 32 */
11+ mpz_mul_2exp(n, n, 32); /* n <<= 32 */
12− mpz_add_ui(n, n, (unsigned int)ull); /* n += (unsigned int)ull */
12+ mpz_add_ui(n, n, (unsigned int)ull); /* n += (unsigned int)ull */
13+}
14+
15+void mpz_init_set_sll(mpz_t n, long long sll)
16+{
17+ mpz_init_set_si(n, (int)(sll >> 32)); /* n = (int)sll >> 32 */
18+ mpz_mul_2exp(n, n, 32 ); /* n <<= 32 */
19+ mpz_add_ui(n, n, (unsigned int)sll); /* n += (unsigned int)sll */
13}
20}
14
21
15unsigned long long mpz_get_ull(mpz_t n)
22unsigned long long mpz_get_ull(mpz_t n)
16{
23{
17− unsigned int lo, hi;
24+ unsigned int lo, hi;
18− mpz_t tmp;
25+ mpz_t tmp;
19
26
20− mpz_init( tmp );
27+ mpz_init( tmp );
21− mpz_mod_2exp( tmp, n, 64 ); /* tmp = (lower 64 bits of n) */
28+ mpz_mod_2exp( tmp, n, 64 ); /* tmp = (lower 64 bits of n) */
22
29
23− lo = mpz_get_ui( tmp ); /* lo = tmp & 0xffffffff */
30+ lo = mpz_get_ui( tmp ); /* lo = tmp & 0xffffffff */
24− mpz_div_2exp( tmp, tmp, 32 ); /* tmp >>= 32 */
31+ mpz_div_2exp( tmp, tmp, 32 ); /* tmp >>= 32 */
25− hi = mpz_get_ui( tmp ); /* hi = tmp & 0xffffffff */
32+ hi = mpz_get_ui( tmp ); /* hi = tmp & 0xffffffff */
26
33
27− mpz_clear( tmp );
34+ mpz_clear( tmp );
28
35
29− return (((unsigned long long)hi) << 32) + lo;
36+ return (((unsigned long long)hi) << 32) + lo;
30}
37}
src/IRTS/CodegenLLVM.hs+9−4
@@ -200,7 +200,7 @@ cgDef (SFun name argNames _ expr) = do
200 case r of
200 case r of
201 Nothing -> terminate $ Unreachable []
201 Nothing -> terminate $ Unreachable []
202 Just r' -> terminate $ Ret (Just r') [])
202 Just r' -> terminate $ Ret (Just r') [])
203− (CGR arch (Name . show $ name))
203+ (CGR arch (show name))
204 (CGS 0 nextGlobal (Name "begin") [] (map (Just . LocalReference . Name . show) argNames) S.empty)
204 (CGS 0 nextGlobal (Name "begin") [] (map (Just . LocalReference . Name . show) argNames) S.empty)
205 entryTerm = case bbs of
205 entryTerm = case bbs of
206 [] -> Do $ Ret Nothing []
206 [] -> Do $ Ret Nothing []
@@ -235,10 +235,13 @@ data CGS = CGS { nextName :: Word
235 }
235 }
236
236
237data CGR = CGR { target :: String
237data CGR = CGR { target :: String
238− , funcName :: Name }
238+ , funcName :: String }
239
239
240type Codegen = RWS CGR CGW CGS
240type Codegen = RWS CGR CGW CGS
241
241
242+getFuncName :: Codegen String
243+getFuncName = asks funcName
244+
242getGlobalUnName :: Codegen Name
245getGlobalUnName :: Codegen Name
243getGlobalUnName = do
246getGlobalUnName = do
244 i <- gets nextGlobalName
247 i <- gets nextGlobalName
@@ -532,7 +535,8 @@ cgChainCase caseValPtr defExp alts = do
532 newBlock elseName
535 newBlock elseName
533 return result
536 return result
534 modify $ \s -> s { lexenv = initEnv }
537 modify $ \s -> s { lexenv = initEnv }
538+ fname <- getFuncName
535− defaultVal <- cgExpr (fromMaybe (SError "Inexhaustive case failure") defExp)
539+ defaultVal <- cgExpr (fromMaybe (SError $ "Inexhaustive case failure in " ++ fname) defExp)
536 defaultBlock <- gets currentBlockName
540 defaultBlock <- gets currentBlockName
537 defaultEnv <- gets lexenv
541 defaultEnv <- gets lexenv
538 defResult <- case defaultVal of
542 defResult <- case defaultVal of
@@ -560,7 +564,8 @@ finishCase initEnv exitBlockName results = do
560cgDefaultAlt :: Name -> Name -> Maybe SExp -> Codegen (Maybe (Operand, Name, Env))
564cgDefaultAlt :: Name -> Name -> Maybe SExp -> Codegen (Maybe (Operand, Name, Env))
561cgDefaultAlt exitName name exp = do
565cgDefaultAlt exitName name exp = do
562 newBlock name
566 newBlock name
567+ fname <- getFuncName
563− val <- cgExpr (fromMaybe (SError "Inexhaustive case failure") exp)
568+ val <- cgExpr (fromMaybe (SError $ "Inexhaustive case failure in " ++ fname) exp)
564 env <- gets lexenv
569 env <- gets lexenv
565 block <- gets currentBlockName
570 block <- gets currentBlockName
566 case val of
571 case val of