git.iko.soy/Idris-dev
on master help sign in
Start of FFI infrastructure
f5e4128David Christiansen
idris.cabal+1−1
compare with master
unifiedsplit
@@ -100,7 +100,7 @@ Executable idris
100 haskeline>=0.7, split, directory,
100 haskeline>=0.7, split, directory,
101 containers, process, transformers, filepath,
101 containers, process, transformers, filepath,
102 directory, binary, bytestring, pretty,
102 directory, binary, bytestring, pretty,
103− language-java>=0.2.2
103+ language-java>=0.2.2, libffi, unix
104
104
105 Extensions: MultiParamTypeClasses, FunctionalDependencies,
105 Extensions: MultiParamTypeClasses, FunctionalDependencies,
106 FlexibleInstances, TemplateHaskell
106 FlexibleInstances, TemplateHaskell
src/Core/Execute.hs+44−2
@@ -8,6 +8,10 @@ import Core.Evaluate
8
8
9import Debug.Trace
9import Debug.Trace
10
10
11+import Foreign.LibFFI
12+import Foreign.Ptr (nullPtr)
13+import System.Posix.DynamicLinker
14+
11-- | Attempt to perform a side effect. Return either Just the next step in
15-- | Attempt to perform a side effect. Return either Just the next step in
12-- evaluation (after performing the side effect through IO), or Nothing if no
16-- evaluation (after performing the side effect through IO), or Nothing if no
13-- IO was performed.
17-- IO was performed.
@@ -26,7 +30,45 @@ execute tm = do stepped <- step tm
26 Nothing -> return tm
30 Nothing -> return tm
27 Just tm' -> execute tm'
31 Just tm' -> execute tm'
28
32
33+data FTy = FInt | FFloat | FChar | FString | FPtr | FUnit deriving Show
34+
35+data Foreign = FFun String [FTy] FTy deriving Show
36+
37+call :: Foreign -> [TT Name] -> Idris (TT Name)
38+call (FFun name argTypes retType) args = undefined
39+
40+foreignFromTT :: TT Name -> Maybe Foreign
41+foreignFromTT t = case (unApply t) of
42+ (_, [(Constant (Str name)), args, ret]) ->
43+ do trace (show $ unList args) $ return ()
44+ argTy <- unList args
45+ argFTy <- sequence $ map getFTy argTy
46+ retFTy <- getFTy ret
47+ return $ FFun name argFTy retFTy
48+ _ -> Nothing
49+
50+getFTy :: TT Name -> Maybe FTy
51+getFTy (P _ (UN t) _) = case t of
52+ "FInt" -> Just FInt
53+ "FFloat" -> Just FFloat
54+ "FChar" -> Just FChar
55+ "FString" -> Just FString
56+ "FPtr" -> Just FPtr
57+ "FUnit" -> Just FUnit
58+ _ -> Nothing
59+getFTy _ = Nothing
60+
61+unList :: TT Name -> Maybe [TT Name]
62+unList tm = case unApply tm of
63+ (nil, [_]) -> Just []
64+ (cons, ([_, x, xs])) ->
65+ do rest <- unList xs
66+ return $ x:rest
67+ (f, args) -> Nothing
29
68
30stepForeign :: [TT Name] -> Idris (TT Name)
69stepForeign :: [TT Name] -> Idris (TT Name)
31−stepForeign args = do iputStrLn $ "FOREIGN CALL" ++ show args
70+stepForeign (ty:fn:args) = do iputStrLn $ "FOREIGN CALL " ++ show (ty:fn:args)
71+ iputStrLn $ show $ foreignFromTT fn
72+ iputStrLn ""
32− return $ mkApp (P Bound (UN "mkForeign") Erased) args
73+ return $ mkApp (P Bound (UN "mkForeign") Erased) args
74+stepForeign _ = fail "Tried to call foreign function that wasn't mkForeign"