idris-lang/Idris2
1
1
Fork 0
mirror of https://github.com/idris-lang/Idris2.git synced 2024-11-28 11:05:17 +03:00
Code Issues Projects Releases Wiki Activity

Improve RefC foreign function support

Browse Source
This commit is contained in:
Robert Wright 2021-04-21 13:11:07 +01:00 committed by G. Allais
parent d961c0488c
commit 51ddcad3b8
1 changed files with 10 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
src/Compiler/RefC/RefC.idr
View File

@ -803,7 +803,7 @@ emitFDef : {auto oft : Ref OutfileText Output}
-> (funcName:Name)
-> (arglist:List (String, String, CFType))
-> Core ()
emitFDef funcName [] = emit EmptyFC $ cName funcName ++ "(void)"
emitFDef funcName [] = emit EmptyFC $ "Value *" ++ cName funcName ++ "(void)"
emitFDef funcName ((varType, varName, varCFType) :: xs) = do
emit EmptyFC $ "Value *" ++ cName funcName
emit EmptyFC "("
@ -906,7 +906,7 @@ createCFunctions n (MkACon tag arity nt) = do
emit EmptyFC $ ( "// Constructor tag " ++ show tag ++ " arity " ++ show arity) -- Nothing to compile here
createCFunctions n (MkAForeign ccs fargs (CFIORes ret)) = do
createCFunctions n (MkAForeign ccs fargs ret) = do
case extractFFILocation "C" ccs of
Nothing => assert_total $ idris_crash ("INTERNAL ERROR: FFI not found for " ++ cName n)
-- not really total but this way this internal error does not contaminate everything else
@ -939,24 +939,28 @@ createCFunctions n (MkAForeign ccs fargs (CFIORes ret)) = do
increaseIndentation
emit EmptyFC $ " // ffi call to " ++ fctName
case ret of
CFUnit => do
CFIORes CFUnit => do
emit EmptyFC $ fctName
++ "("
++ showSep ", " (map (\(_, vn, vt) => extractValue vt vn) (discardLastArgument typeVarNameArgList))
++ ");"
emit EmptyFC "return NULL;"
_ => do
CFIORes ret => do
emit EmptyFC $ cTypeOfCFType ret ++ " retVal = " ++ fctName
++ "("
++ showSep ", " (map (\(_, vn, vt) => extractValue vt vn) (discardLastArgument typeVarNameArgList))
++ ");"
emit EmptyFC $ "return (Value*)" ++ packCFType ret "retVal" ++ ";"
_ => do
emit EmptyFC $ cTypeOfCFType ret ++ " retVal = " ++ fctName
++ "("
++ showSep ", " (map (\(_, vn, vt) => extractValue vt vn) typeVarNameArgList)
++ ");"
emit EmptyFC $ "return (Value*)" ++ packCFType ret "retVal" ++ ";"
decreaseIndentation
emit EmptyFC "}"
createCFunctions n (MkAForeign ccs fargs ret) = assert_total $ idris_crash ("INTERNAL ERROR: Unable to deal with return values that are not CFIORes: " ++ cName n)
-- not really total but this way this internal error does not contaminate everything else
createCFunctions n (MkAError exp) = assert_total $ idris_crash ("INTERNAL ERROR: Error with expression: " ++ show exp)
-- not really total but this way this internal error does not contaminate everything else