packages feed

fficxx-runtime (empty) → 0.1

raw patch · 5 files changed

+253/−0 lines, 5 filesdep +basesetup-changed

Dependencies added: base

Files

+ LICENSE view
@@ -0,0 +1,25 @@+The following license covers this documentation, and the source code, except+where otherwise indicated.++Copyright 2011-2013, Ian-Woo Kim. All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+  list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO+EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.lhs view
@@ -0,0 +1,10 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> import Distribution.PackageDescription+> --import System.Process+> main = defaultMain+> --main = defaultMainWithHooks testUserHooks+> --testUserHooks = simpleUserHooks { +>  --   preConf = \_ _ -> runCommand "cd rootcode; make; cd .." >>return emptyHookedBuildInfo+>   --  }
+ csrc/MacroPatternMatch.h view
@@ -0,0 +1,20 @@+#ifndef __MACROPATTERNMATCH__+#define __MACROPATTERNMATCH__ +++#define CAT(a,...) PRIMITIVE_CAT(a, __VA_ARGS__ )+#define PRIMITIVE_CAT(a,...) a ## __VA_ARGS__ ++#define IIF(c) PRIMITIVE_CAT(IIF_, c)+#define IIF_0(t, ...) __VA_ARGS__+#define IIF_1(t, ...) t ++#define CHECK_N(x, n, ... ) n +#define CHECK(...) CHECK_N (__VA_ARGS__, 0, ) +#define PROBE(x) x, 1,++#define IS_PAREN(x) CHECK(IS_PAREN_PROBE x)+#define IS_PAREN_PROBE(...) PROBE(~)++#endif // __MACROPATTERNMATCH__ +
+ fficxx-runtime.cabal view
@@ -0,0 +1,29 @@+Name:		fficxx-runtime+Version:	0.1+Synopsis:	Runtime for fficxx-generated library+Description: 	Runtime for fficxx-generated library+License:        BSD3+License-file:	LICENSE+Author:		Ian-Woo Kim+Maintainer: 	Ian-Woo Kim <ianwookim@gmail.com>+Build-Type: 	Simple+Category:       FFI Tools+Cabal-Version:  >= 1.8+Data-files: ++Source-repository head+  type: git+  location: http://www.github.com/wavewave/fficxx-runtime++Library+  hs-source-dirs: lib+  ghc-options: 	-Wall -funbox-strict-fields -fno-warn-unused-do-bind+  ghc-prof-options: -caf-all -auto-all+  Build-Depends: +                   base == 4.*++  Exposed-Modules: +                   FFICXX.Runtime.Cast++  Include-dirs:    csrc+  Install-includes: MacroPatternMatch.h
+ lib/FFICXX/Runtime/Cast.hs view
@@ -0,0 +1,169 @@+{-# LANGUAGE ForeignFunctionInterface, TypeFamilies, MultiParamTypeClasses, +             FlexibleInstances, TypeSynonymInstances, +             EmptyDataDecls, ExistentialQuantification, ScopedTypeVariables, +             GADTs #-}++-----------------------------------------------------------------------------+-- |+-- Module      : FFICXX.Runtime.Cast+-- Copyright   : (c) 2011-2013 Ian-Woo Kim+--+-- License     : BSD3+-- Maintainer  : Ian-Woo Kim <ianwookim@gmail.com>+-- Stability   : experimental+-- Portability : GHC+--+-----------------------------------------------------------------------------++module FFICXX.Runtime.Cast where++import Data.Word+import Foreign.C            +import Foreign.Ptr+import Foreign.ForeignPtr+import Foreign.Marshal.Array++import System.IO.Unsafe++class Castable a b where+  cast :: a -> b +  uncast :: b -> a ++class FPtr a where+  type Raw a :: *+  get_fptr :: a -> ForeignPtr (Raw a) +  cast_fptr_to_obj :: ForeignPtr (Raw a) -> a++class Existable a where+  data Exist a :: *  ++data BottomType++class GADTTypeable a where+  data GADTType a :: * -> *+  data EGADTType a :: *+++++{-+-- eliminate this for the time being to have a solution with Repl+instance Castable a a where+  cast = id+  uncast = id+-}++instance Castable () () where+  cast = id +  uncast = id ++instance Castable Int CInt where+  cast = fromIntegral +  uncast = fromIntegral++instance Castable Word CUInt where+  cast = fromIntegral+  uncast = fromIntegral+  +instance Castable Double CDouble where+  cast = realToFrac+  uncast = realToFrac ++instance Castable [Double] (Ptr CDouble) where+  cast xs = unsafePerformIO (newArray (map realToFrac xs))+  uncast _c_xs = undefined ++instance Castable [Int] (Ptr CInt) where+  cast xs = unsafePerformIO (newArray (map fromIntegral xs))+  uncast _c_xs = undefined ++instance Castable String CString where+  cast x = unsafePerformIO (newCString x)+  uncast x = unsafePerformIO (peekCString x) ++instance Castable [String] (Ptr CString) where+  cast xs = unsafePerformIO (mapM  newCString xs >>= newArray)+  uncast _c_xs = undefined++instance (Castable a a', Castable b b') => Castable (a->b) (a'->b') where+  cast f = cast . f . uncast+  uncast f = uncast . f . cast +++xformnull :: (Castable a ca) => (IO ca) -> IO a+xformnull f = f >>= return . uncast++xform0 :: (Castable a ca, Castable y cy) +       => (ca -> IO cy) -> a -> IO y+xform0 f a = f (cast a) >>= return . uncast ++xform1 :: (Castable a ca, Castable x1 cx1, Castable y cy) +       => (ca -> cx1 -> IO cy) -> a -> x1 -> IO y+xform1 f a x1 = f (cast a) (cast x1) >>= return . uncast ++xform2 :: (Castable a ca, Castable x1 cx1, Castable x2 cx2, Castable y cy) +       => (ca -> cx1 -> cx2 -> IO cy) -> a -> x1 -> x2-> IO y+xform2 f a x1 x2 = f (cast a) (cast x1) (cast x2) >>= return . uncast ++xform3 :: (Castable a ca, Castable x1 cx1, Castable x2 cx2, Castable x3 cx3, Castable y cy) +       => (ca -> cx1 -> cx2 -> cx3 -> IO cy) -> a -> x1 -> x2 -> x3 -> IO y+xform3 f a x1 x2 x3 = f (cast a) (cast x1) (cast x2) (cast x3) >>= return . uncast ++xform4 :: (Castable a ca, Castable x1 cx1, Castable x2 cx2, Castable x3 cx3, Castable x4 cx4, Castable y cy) +       => (ca -> cx1 -> cx2 -> cx3 -> cx4 -> IO cy) -> a -> x1 -> x2 -> x3 -> x4 -> IO y+xform4 f a x1 x2 x3 x4 = f (cast a) (cast x1) (cast x2) (cast x3) (cast x4) >>= return . uncast ++xform5 :: (Castable a ca, Castable x1 cx1, Castable x2 cx2, Castable x3 cx3, Castable x4 cx4,+           Castable x5 cx5, Castable y cy) +       => (ca -> cx1 -> cx2 -> cx3 -> cx4 -> cx5 -> IO cy) -> a -> x1 -> x2 -> x3 -> x4 -> x5 -> IO y+xform5 f a x1 x2 x3 x4 x5 = f (cast a) (cast x1) (cast x2) (cast x3) (cast x4) (cast x5) >>= return . uncast ++xform6 :: (Castable a ca, Castable x1 cx1, Castable x2 cx2, Castable x3 cx3, Castable x4 cx4,+           Castable x5 cx5, Castable x6 cx6, Castable y cy) +       => (ca -> cx1 -> cx2 -> cx3 -> cx4 -> cx5 -> cx6 -> IO cy) +          -> a -> x1 -> x2 -> x3 -> x4 -> x5 -> x6 -> IO y+xform6 f a x1 x2 x3 x4 x5 x6 = +  f (cast a) (cast x1) (cast x2) (cast x3) (cast x4) (cast x5) (cast x6) +  >>= return . uncast ++xform7 :: (Castable a ca, Castable x1 cx1, Castable x2 cx2, Castable x3 cx3, Castable x4 cx4,+           Castable x5 cx5, Castable x6 cx6, Castable x7 cx7, Castable y cy) +       => (ca -> cx1 -> cx2 -> cx3 -> cx4 -> cx5 -> cx6 -> cx7 -> IO cy) +          -> a -> x1 -> x2 -> x3 -> x4 -> x5 -> x6 -> x7 -> IO y+xform7 f a x1 x2 x3 x4 x5 x6 x7 = +  f (cast a) (cast x1) (cast x2) (cast x3) (cast x4) (cast x5) (cast x6) (cast x7)+  >>= return . uncast ++xform8 :: (Castable a ca, Castable x1 cx1, Castable x2 cx2, Castable x3 cx3, Castable x4 cx4,+           Castable x5 cx5, Castable x6 cx6, Castable x7 cx7, Castable x8 cx8, Castable y cy) +       => (ca -> cx1 -> cx2 -> cx3 -> cx4 -> cx5 -> cx6 -> cx7 -> cx8 -> IO cy) +          -> a -> x1 -> x2 -> x3 -> x4 -> x5 -> x6 -> x7 -> x8 -> IO y+xform8 f a x1 x2 x3 x4 x5 x6 x7 x8 = +  f (cast a) (cast x1) (cast x2) (cast x3) (cast x4) (cast x5) (cast x6) (cast x7) (cast x8)+  >>= return . uncast ++xform9 :: (Castable a ca, Castable x1 cx1, Castable x2 cx2, Castable x3 cx3, Castable x4 cx4,+           Castable x5 cx5, Castable x6 cx6, Castable x7 cx7, Castable x8 cx8, Castable x9 cx9, +           Castable y cy) +       => (ca -> cx1 -> cx2 -> cx3 -> cx4 -> cx5 -> cx6 -> cx7 -> cx8 -> cx9 -> IO cy) +          -> a -> x1 -> x2 -> x3 -> x4 -> x5 -> x6 -> x7 -> x8 -> x9 -> IO y+xform9 f a x1 x2 x3 x4 x5 x6 x7 x8 x9 = +  f (cast a) (cast x1) (cast x2) (cast x3) (cast x4) (cast x5) (cast x6) (cast x7) (cast x8) (cast x9)+  >>= return . uncast ++xform10 :: (Castable a ca, Castable x1 cx1, Castable x2 cx2, Castable x3 cx3, Castable x4 cx4,+            Castable x5 cx5, Castable x6 cx6, Castable x7 cx7, Castable x8 cx8, Castable x9 cx9,  +            Castable x10 cx10, Castable y cy) +       => (ca -> cx1 -> cx2 -> cx3 -> cx4 -> cx5 -> cx6 -> cx7 -> cx8 -> cx9 -> cx10 -> IO cy) +          -> a -> x1 -> x2 -> x3 -> x4 -> x5 -> x6 -> x7 -> x8 -> x9 -> x10 -> IO y+xform10 f a x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 = +  f (cast a) (cast x1) (cast x2) (cast x3) (cast x4) (cast x5) (cast x6) (cast x7) (cast x8) (cast x9) (cast x10) >>= return . uncast ++xform11 :: (Castable a ca, Castable x1 cx1, Castable x2 cx2, Castable x3 cx3, Castable x4 cx4,+            Castable x5 cx5, Castable x6 cx6, Castable x7 cx7, Castable x8 cx8, Castable x9 cx9,  +            Castable x10 cx10, Castable x11 cx11, Castable y cy) +       => (ca -> cx1 -> cx2 -> cx3 -> cx4 -> cx5 -> cx6 -> cx7 -> cx8 -> cx9 -> cx10 -> cx11 -> IO cy) +          -> a -> x1 -> x2 -> x3 -> x4 -> x5 -> x6 -> x7 -> x8 -> x9 -> x10 -> x11 -> IO y+xform11 f a x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 = +  f (cast a) (cast x1) (cast x2) (cast x3) (cast x4) (cast x5) (cast x6) (cast x7) (cast x8) (cast x9) (cast x10) (cast x11)  >>= return . uncast +