llvm-ffi-tools (empty) → 0.0

raw patch · 7 files changed

+258/−0 lines, 7 filesdep +basedep +bytestringdep +containerssetup-changed

Dependencies added: base, bytestring, containers, regex-posix, utility-ht

Files

• LICENSE +47/−0
• Setup.lhs +3/−0
• llvm-ffi-tools.cabal +62/−0
• src/DiffFFI.hs +46/−0
• src/FunctionMangler.hs +9/−0
• src/FunctionMangulation.hs +68/−0
• src/IntrinsicMangler.hs +23/−0

@@ -0,0 +1,47 @@+======================================================================+Haskell LLVM Bindings Release License+======================================================================+University of Illinois/NCSA+Open Source License++Copyright (c) 2014-2016 Henning Thielemann+Copyright (c) 2007-2009 Bryan O'Sullivan+All rights reserved.++Developed by:++    Henning Thielemann <llvm@henning-thielemann.de>++    Bryan O'Sullivan <bos@serpentine.com>+    http://www.serpentine.com/blog/++    Lennart Augustsson <lennart@augustsson.net>++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal with the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimers.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimers in the documentation and/or other materials provided+      with the distribution.++    * Neither the names of Bryan O'Sullivan, University of Illinois at+      Urbana-Champaign, nor the names of its contributors may be used+      to endorse or promote products derived from this Software+      without specific prior written permission.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE CONTRIBUTORS OR COPYRIGHT HOLDERS BE LIABLE FOR+ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF+CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS WITH THE SOFTWARE.

@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain

@@ -0,0 +1,62 @@+Name:          llvm-ffi-tools+Version:       0.0+License:       BSD3+License-File:  LICENSE+Synopsis:      Tools for maintaining the llvm-ffi package+Description:+  The package contains tools for maintaining the FFI interface to LLVM+  in the @llvm-ffi@ package+  <http://hackage.haskell.org/package/llvm-ffi>.+  Most notably there is the @llvm-function-mangler@+  that converts LLVM-C bindings to Haskell foreign imports.+Author:        Henning Thielemann, Bryan O'Sullivan, Lennart Augustsson+Maintainer:    Henning Thielemann <llvm@henning-thielemann.de>+Homepage:      http://haskell.org/haskellwiki/LLVM+Stability:     experimental+Category:      Compilers/Interpreters, Code Generation+Tested-With:   GHC==7.4.2, GHC==7.6.3, GHC==7.8.4, GHC==8.0.1+Cabal-Version: >= 1.8+Build-Type:    Simple++Source-Repository head+  Type:     darcs+  Location: http://hub.darcs.net/thielema/llvm-ffi-tools/++Source-Repository this+  Tag:      0.0+  Type:     darcs+  Location: http://hub.darcs.net/thielema/llvm-ffi-tools/++Executable llvm-diff-ffi+  Build-Depends:+    utility-ht >=0.0.9 && <0.1,+    regex-posix >=0.95 && <0.96,+    containers >=0.4 && <0.6,+    base >=4.5 && <5++  Hs-Source-Dirs: src+  GHC-Options: -Wall+  Main-Is: DiffFFI.hs+  Other-Modules: FunctionMangulation++Executable llvm-function-mangler+  Build-Depends:+    utility-ht >=0.0.9 && <0.1,+    regex-posix >=0.95 && <0.96,+    containers >=0.4 && <0.6,+    base >=4.5 && <5++  Hs-Source-Dirs: src+  GHC-Options: -Wall+  Main-Is: FunctionMangler.hs+  Other-Modules: FunctionMangulation++Executable llvm-intrinsic-mangler+  Build-Depends:+    bytestring >=0.9 && <0.11,+    regex-posix >=0.95 && <0.96,+    base >=4.5 && <5++  Hs-Source-Dirs: src+  GHC-Options: -Wall+  Main-Is: IntrinsicMangler.hs

@@ -0,0 +1,46 @@+module Main (main) where++import FunctionMangulation (pattern, rewriteFunction)++import Text.Regex.Posix ((=~))++import qualified Data.Map as Map+import Data.Map (Map)+import Data.Maybe (mapMaybe)++import Control.Monad (forM_)++import System.Environment (getArgs)+import System.Exit (exitFailure)+import System.IO (hPutStrLn, stderr)+++cFunctions :: String -> Map String String+cFunctions s =+   let f (_:ret:name:params:_) =+            Just ("LLVM" ++ name, rewriteFunction ret name params)+       f _ = Nothing+   in  Map.fromList $ mapMaybe f (s =~ pattern)++hsFunctions :: String -> Map String String+hsFunctions s =+   let pat = "\"([a-zA-Z0-9_]+)\"[ \t\n]+([a-zA-Z0-9_']+)"+       f (_:cname:hsname:_) = Just (cname, hsname)+       f _ = Nothing+   in  Map.fromList $ mapMaybe f (s =~ pat)++main :: IO ()+main = do+  args <- getArgs+  case args of+    [cFile, hsFile] -> do+              c <- cFunctions `fmap` readFile cFile+              hs <- hsFunctions `fmap` readFile hsFile+              putStrLn "In C, not Haskell:"+              forM_ (Map.toAscList $ Map.difference c hs) $ \(_, hsfunc) ->+                    putStrLn hsfunc+              putStrLn "In Haskell, not C:"+              forM_ (Map.keys $ Map.difference hs c) $ putStrLn . ("  "++)+    _ -> do+         hPutStrLn stderr "Usage: DiffFFI cFile hsFile"+         exitFailure

@@ -0,0 +1,9 @@+module Main (main) where++import FunctionMangulation (rewrite)++import Data.List (intercalate)+++main :: IO ()+main = interact (intercalate "\n\n" . concat . rewrite) >> putStr "\n"

@@ -0,0 +1,68 @@+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+      -- ToDo: we need two variants of rename+      Just suffix -> rename suffix+      Nothing -> rename t++rename :: String -> String+rename cname =+   case cname of+      "Bool" -> "LLVM.Bool"+      "int" -> "CInt"+      "unsigned" -> "CUInt"+      "long long" -> "CLLong"+      "unsigned long long" -> "CULLong"+      "void" -> "()"+      "const char *" -> "CString"+      "char *" -> "CString"+      "size_t" -> "CSize"+      _ ->+         case ListHT.viewR cname of+            Just (ps,'*') -> "(Ptr " ++ rename ps ++ ")"+            _ -> trim cname++dropName :: String -> String+dropName s =+   case s =~ "^((const )?[A-Za-z0-9_]+( \\*+)?) ?[A-Za-z0-9]*$" of+      ((_:typ:_):_) -> typ+      _ -> "{- oops! -} " ++ s++rewriteFunction :: String -> String -> String -> String+rewriteFunction cret cname cparams =+    let ret = "IO " ++ renameType (trim cret)+        params = map renameParam . ListHT.chop (==',') $ cparams+        params' = if params == ["()"] then [] else params+        name = let (n:ame) = cname in toLower n : ame+    in foreign ++ "\"LLVM" ++ cname ++ "\" " ++ name +++           "\n    :: " ++ intercalate " -> " (params' ++ [ret])+  where renameParam = renameType . dropName . trim+        foreign = "foreign import ccall unsafe "++rewrite :: String -> [[String]]+rewrite s = do+    matches <- s =~~ pattern+    forM matches $ \(_:cret:cname:cparams:_) ->+         return (rewriteFunction cret cname cparams)

@@ -0,0 +1,23 @@+module Main (main) where++import qualified Data.ByteString.Char8 as C+import Text.Regex.Posix ((=~~))+import Control.Monad (forM_)+import Data.Maybe (catMaybes)+++maybeName :: C.ByteString -> Maybe C.ByteString+maybeName line = do+  ((_:name:_):_) <- line =~~ "^[ \t]*([a-z0-9_]+),[ \t]*//[ \t]*llvm\\."+  return name++main :: IO ()+main = do+  input <- (catMaybes . map maybeName . C.lines) `fmap` C.getContents++  putStrLn "-- automatically generated file - do not edit!"+  putStrLn "module LLVM.Core.Intrinsics (Intrinsic(..)) where"+  putStrLn "data Intrinsic ="+  putStrLn "      NotIntrinsic"+  forM_ input $ C.putStrLn . (C.append (C.pack "    | I_"))+  putStrLn "    deriving (Eq, Ord, Enum, Show)"