git.iko.soy/Idris-dev
on master help sign in
More informative case failure errors, cleanup
commit3e50b1baeba111fd6281aa90026c980e94603b99 authorBenjamin Saunders <besaunde@sfu.ca> dateWed 26 Jun 2013, 12:12 (13 years ago) parent6a48a25
2 files changed+29−17
compare with master
unifiedsplit
llvm/defs.c+20−13 src/IRTS/CodegenLLVM.hs+9−4
llvm/defs.c+20−13
@@ -5,26 +5,33 @@ void putStr(const char *str) {
55 fputs(str, stdout);
66}
77
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)
99{
10− mpz_set_ui(n, (unsigned int)(ull >> 32)); /* n = (unsigned int)(ull >> 32) */
11− mpz_mul_2exp(n, n, 32); /* n <<= 32 */
12− mpz_add_ui(n, n, (unsigned int)ull); /* n += (unsigned int)ull */
10+ mpz_init_set_ui(n, (unsigned int)(ull >> 32)); /* n = (unsigned int)(ull >> 32) */
11+ mpz_mul_2exp(n, n, 32); /* n <<= 32 */
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 */
1320}
1421
1522unsigned long long mpz_get_ull(mpz_t n)
1623{
17− unsigned int lo, hi;
18− mpz_t tmp;
24+ unsigned int lo, hi;
25+ mpz_t tmp;
1926
20− mpz_init( tmp );
21− mpz_mod_2exp( tmp, n, 64 ); /* tmp = (lower 64 bits of n) */
27+ mpz_init( tmp );
28+ mpz_mod_2exp( tmp, n, 64 ); /* tmp = (lower 64 bits of n) */
2229
23− lo = mpz_get_ui( tmp ); /* lo = tmp & 0xffffffff */
24− mpz_div_2exp( tmp, tmp, 32 ); /* tmp >>= 32 */
25− hi = mpz_get_ui( tmp ); /* hi = tmp & 0xffffffff */
30+ lo = mpz_get_ui( tmp ); /* lo = tmp & 0xffffffff */
31+ mpz_div_2exp( tmp, tmp, 32 ); /* tmp >>= 32 */
32+ hi = mpz_get_ui( tmp ); /* hi = tmp & 0xffffffff */
2633
27− mpz_clear( tmp );
34+ mpz_clear( tmp );
2835
29− return (((unsigned long long)hi) << 32) + lo;
36+ return (((unsigned long long)hi) << 32) + lo;
3037}
src/IRTS/CodegenLLVM.hs+9−4
@@ -200,7 +200,7 @@ cgDef (SFun name argNames _ expr) = do
200200 case r of
201201 Nothing -> terminate $ Unreachable []
202202 Just r' -> terminate $ Ret (Just r') [])
203− (CGR arch (Name . show $ name))
203+ (CGR arch (show name))
204204 (CGS 0 nextGlobal (Name "begin") [] (map (Just . LocalReference . Name . show) argNames) S.empty)
205205 entryTerm = case bbs of
206206 [] -> Do $ Ret Nothing []
@@ -235,10 +235,13 @@ data CGS = CGS { nextName :: Word
235235 }
236236
237237data CGR = CGR { target :: String
238− , funcName :: Name }
238+ , funcName :: String }
239239
240240type Codegen = RWS CGR CGW CGS
241241
242+getFuncName :: Codegen String
243+getFuncName = asks funcName
244+
242245getGlobalUnName :: Codegen Name
243246getGlobalUnName = do
244247 i <- gets nextGlobalName
@@ -532,7 +535,8 @@ cgChainCase caseValPtr defExp alts = do
532535 newBlock elseName
533536 return result
534537 modify $ \s -> s { lexenv = initEnv }
535− defaultVal <- cgExpr (fromMaybe (SError "Inexhaustive case failure") defExp)
538+ fname <- getFuncName
539+ defaultVal <- cgExpr (fromMaybe (SError $ "Inexhaustive case failure in " ++ fname) defExp)
536540 defaultBlock <- gets currentBlockName
537541 defaultEnv <- gets lexenv
538542 defResult <- case defaultVal of
@@ -560,7 +564,8 @@ finishCase initEnv exitBlockName results = do
560564cgDefaultAlt :: Name -> Name -> Maybe SExp -> Codegen (Maybe (Operand, Name, Env))
561565cgDefaultAlt exitName name exp = do
562566 newBlock name
563− val <- cgExpr (fromMaybe (SError "Inexhaustive case failure") exp)
567+ fname <- getFuncName
568+ val <- cgExpr (fromMaybe (SError $ "Inexhaustive case failure in " ++ fname) exp)
564569 env <- gets lexenv
565570 block <- gets currentBlockName
566571 case val of