Print failed pattern match error messages to stderr

This commit is contained in:
Benjamin Saunders 2013-10-08 15:54:43 -07:00
parent 7a43e68a21
commit c614366f83
2 changed files with 8 additions and 4 deletions

View File

@ -11,6 +11,10 @@ void putStr(const char *str) {
fputs(str, stdout);
}
void putErr(const char *str) {
fputs(str, stderr);
}
void mpz_init_set_ull(mpz_t n, unsigned long long ull)
{
mpz_init_set_ui(n, (unsigned int)(ull >> 32)); /* n = (unsigned int)(ull >> 32) */

View File

@ -193,7 +193,7 @@ initDefs tgt =
, exfun "__idris_gmpFree" VoidType [ptrI8, intPtr] False
, exfun "__idris_strRev" ptrI8 [ptrI8] False
, exfun "strtoll" (IntegerType 64) [ptrI8, PointerType ptrI8 (AddrSpace 0), IntegerType 32] False
, exfun "putStr" VoidType [ptrI8] False
, exfun "putErr" VoidType [ptrI8] False
, exVar (stdinName tgt) ptrI8
, exVar (stdoutName tgt) ptrI8
, exVar (stderrName tgt) ptrI8
@ -245,7 +245,7 @@ getStdErr = ConstantOperand . C.GlobalReference . Name . stderrName <$> asks tar
codegen :: Target -> [SDecl] -> Module
codegen tgt defs = Module "idris" (Just . dataLayout $ tgt) (Just . triple $ tgt) (initDefs tgt ++ globals ++ gendefs)
where
(gendefs, _, globals) = runRWS (mapM cgDef defs) tgt 0
(gendefs, _, globals) = runRWS (mapM cgDef defs) tgt initialMGS
valueType :: Type
valueType = NamedTypeReference (Name "valTy")
@ -538,7 +538,7 @@ cgExpr SNothing = return . Just . ConstantOperand $ nullValue
cgExpr (SError msg) = do
str <- addGlobal' (ArrayType (2 + fromIntegral (length msg)) (IntegerType 8))
(cgConst' (TT.Str (msg ++ "\n")))
inst' $ simpleCall "putStr" [ConstantOperand $ C.GetElementPtr True str [ C.Int 32 0
inst' $ simpleCall "putErr" [ConstantOperand $ C.GetElementPtr True str [ C.Int 32 0
, C.Int 32 0]]
inst' Call { isTailCall = True
, callingConvention = CC.C
@ -810,7 +810,7 @@ addGlobal' ty val = do
ensureCDecl :: String -> FType -> [FType] -> Codegen Operand
ensureCDecl name rty argtys = do
syms <- gets foreignSyms
unless (S.member name syms) $
unless (S.member name syms) $ -- TODO: Perform a runtime check of declared type consistency here
do addGlobal (ffunDecl name rty argtys)
modify $ \s -> s { foreignSyms = S.insert name (foreignSyms s) }
return $ ConstantOperand (C.GlobalReference (Name name))