module FunctionMangulation ( pattern , rewrite , rewriteFunction ) where import Text.Regex.Posix ((=~), (=~~)) import Control.Monad (forM) import qualified Data.List.HT as ListHT import Data.Char (toLower) import Data.List.HT (maybePrefixOf) import Data.String.HT (trim) import Data.List (intercalate) pattern :: String pattern = "^([A-Za-z0-9_ ]+ ?\\*?)[ \t\n]*" ++ "LLVM([A-Za-z0-9_]+)\\(([][a-zA-Z0-9_*, \t\n]+)\\);" renameType :: String -> String renameType t = case maybePrefixOf "LLVM" t of Just suffix -> rename suffix Nothing -> rename t rename :: String -> String rename cname = case cname of "Bool" -> "LLVM.Bool" "int" -> "CInt" "unsigned" -> "CUInt" "const unsigned" -> "CUInt" "long long" -> "CLLong" "unsigned long long" -> "CULLong" "void" -> "()" "const char *" -> "CString" "float" -> "CFloat" "double" -> "CDouble" "char *" -> "CString" "size_t" -> "CSize" "uint8_t" -> "Word8" "uint16_t" -> "Word16" "uint32_t" -> "Word32" "uint64_t" -> "Word64" "const uint64_t []" -> "Ptr Word64" _ -> case ListHT.viewR cname of Just (ps,'*') -> "(Ptr " ++ rename (trim ps) ++ ")" _ -> trim cname dropName :: String -> String dropName s = case s =~ "^((const )?(unsigned long long|[A-Za-z0-9_]+)( \\*+)?) ?[A-Za-z0-9_]*(\\[\\])?$" of ((_:typ:_:_:_:"[]":_):_) -> typ ++ " []" ((_:typ:_):_) -> typ _ -> "{- oops! -} " ++ s rewriteFunction :: String -> String -> String -> String rewriteFunction cret cname cparams = let ret = "IO " ++ renameType (trim cret) renameParam = renameType . dropName . trim params = map renameParam . ListHT.chop (==',') $ cparams params' = if params == ["()"] then [] else params name = let (n:ame) = cname in toLower n : ame in "foreign import ccall unsafe \"LLVM" ++ cname ++ "\" " ++ name ++ "\n :: " ++ intercalate " -> " (params' ++ [ret]) rewrite :: String -> [[String]] rewrite s = do matches <- s =~~ pattern forM matches $ \(_:cret:cname:cparams:_) -> return (rewriteFunction cret cname cparams)