on master help sign in
Print failed pattern match error messages to stderr
c614366Benjamin Saunders
llvm/defs.c+4
@@ -11,6 +11,10 @@ void putStr(const char *str) {
11 fputs(str, stdout);
11 fputs(str, stdout);
12}
12}
13
13
14+void putErr(const char *str) {
15+ fputs(str, stderr);
16+}
17+
14void mpz_init_set_ull(mpz_t n, unsigned long long ull)
18void mpz_init_set_ull(mpz_t n, unsigned long long ull)
15{
19{
16 mpz_init_set_ui(n, (unsigned int)(ull >> 32)); /* n = (unsigned int)(ull >> 32) */
20 mpz_init_set_ui(n, (unsigned int)(ull >> 32)); /* n = (unsigned int)(ull >> 32) */
src/IRTS/CodegenLLVM.hs+4−4
@@ -193,7 +193,7 @@ initDefs tgt =
193 , exfun "__idris_gmpFree" VoidType [ptrI8, intPtr] False
193 , exfun "__idris_gmpFree" VoidType [ptrI8, intPtr] False
194 , exfun "__idris_strRev" ptrI8 [ptrI8] False
194 , exfun "__idris_strRev" ptrI8 [ptrI8] False
195 , exfun "strtoll" (IntegerType 64) [ptrI8, PointerType ptrI8 (AddrSpace 0), IntegerType 32] False
195 , exfun "strtoll" (IntegerType 64) [ptrI8, PointerType ptrI8 (AddrSpace 0), IntegerType 32] False
196− , exfun "putStr" VoidType [ptrI8] False
196+ , exfun "putErr" VoidType [ptrI8] False
197 , exVar (stdinName tgt) ptrI8
197 , exVar (stdinName tgt) ptrI8
198 , exVar (stdoutName tgt) ptrI8
198 , exVar (stdoutName tgt) ptrI8
199 , exVar (stderrName tgt) ptrI8
199 , exVar (stderrName tgt) ptrI8
@@ -245,7 +245,7 @@ getStdErr = ConstantOperand . C.GlobalReference . Name . stderrName <$> asks tar
245codegen :: Target -> [SDecl] -> Module
245codegen :: Target -> [SDecl] -> Module
246codegen tgt defs = Module "idris" (Just . dataLayout $ tgt) (Just . triple $ tgt) (initDefs tgt ++ globals ++ gendefs)
246codegen tgt defs = Module "idris" (Just . dataLayout $ tgt) (Just . triple $ tgt) (initDefs tgt ++ globals ++ gendefs)
247 where
247 where
248− (gendefs, _, globals) = runRWS (mapM cgDef defs) tgt 0
248+ (gendefs, _, globals) = runRWS (mapM cgDef defs) tgt initialMGS
249
249
250valueType :: Type
250valueType :: Type
251valueType = NamedTypeReference (Name "valTy")
251valueType = NamedTypeReference (Name "valTy")
@@ -538,7 +538,7 @@ cgExpr SNothing = return . Just . ConstantOperand $ nullValue
538cgExpr (SError msg) = do
538cgExpr (SError msg) = do
539 str <- addGlobal' (ArrayType (2 + fromIntegral (length msg)) (IntegerType 8))
539 str <- addGlobal' (ArrayType (2 + fromIntegral (length msg)) (IntegerType 8))
540 (cgConst' (TT.Str (msg ++ "\n")))
540 (cgConst' (TT.Str (msg ++ "\n")))
541− inst' $ simpleCall "putStr" [ConstantOperand $ C.GetElementPtr True str [ C.Int 32 0
541+ inst' $ simpleCall "putErr" [ConstantOperand $ C.GetElementPtr True str [ C.Int 32 0
542 , C.Int 32 0]]
542 , C.Int 32 0]]
543 inst' Call { isTailCall = True
543 inst' Call { isTailCall = True
544 , callingConvention = CC.C
544 , callingConvention = CC.C
@@ -810,7 +810,7 @@ addGlobal' ty val = do
810ensureCDecl :: String -> FType -> [FType] -> Codegen Operand
810ensureCDecl :: String -> FType -> [FType] -> Codegen Operand
811ensureCDecl name rty argtys = do
811ensureCDecl name rty argtys = do
812 syms <- gets foreignSyms
812 syms <- gets foreignSyms
813− unless (S.member name syms) $
813+ unless (S.member name syms) $ -- TODO: Perform a runtime check of declared type consistency here
814 do addGlobal (ffunDecl name rty argtys)
814 do addGlobal (ffunDecl name rty argtys)
815 modify $ \s -> s { foreignSyms = S.insert name (foreignSyms s) }
815 modify $ \s -> s { foreignSyms = S.insert name (foreignSyms s) }
816 return $ ConstantOperand (C.GlobalReference (Name name))
816 return $ ConstantOperand (C.GlobalReference (Name name))