language-c-inline 0.5.0.0 → 0.6.0.0

raw patch · 14 files changed

+151/−77 lines, 14 files

Files

• LICENSE +1/−1
• Language/C/Inline/Hint.hs +85/−0
• Language/C/Inline/ObjC.hs +25/−19
• Language/C/Inline/ObjC/Marshal.hs +1/−42
• README.md +9/−2
• language-c-inline.cabal +16/−3
• tests/objc/app/App.hs +3/−3
• tests/objc/app/AppDelegate.hs +1/−1
• tests/objc/app/Makefile +2/−1
• tests/objc/concept/TestInlineObjC.hs +1/−1
• tests/objc/minimal/Main.hs +3/−1
• tests/objc/record/Main.hs +1/−1
• tests/objc/record/Makefile +2/−1
• tests/objc/record/Particle.hs +1/−1

@@ -1,4 +1,4 @@-Copyright (c) [2013] Manuel M T Chakravarty.  All rights reserved.+Copyright (c) [2013..2014] Manuel M T Chakravarty.  All rights reserved.  Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:

@@ -0,0 +1,85 @@+{-# LANGUAGE TemplateHaskell, GADTs, FlexibleInstances #-}++-- |+-- Module      : Language.C.Inline.Hint+-- Copyright   : [2013..2014] Manuel M T Chakravarty+-- License     : BSD3+--+-- Maintainer  : Manuel M T Chakravarty <chak@justtesting.org>+-- Stability   : experimental+-- Portability : non-portable (GHC extensions)+--+-- This module provides the definition of marshalling hints.++module Language.C.Inline.Hint (+  -- * Annotations+  Annotated(..), (<:), void,+  +  -- * Hints+  Hint(..), +  +  -- * Querying of annotated entities+  haskellTypeOf, stripAnnotation+) where++  -- common libraries+import Language.Haskell.TH        as TH+import Language.Haskell.TH.Syntax as TH++  -- quasi-quotation libraries+import Language.C.Quote           as QC++  -- friends+import Language.C.Inline.Error+++-- |Annotating entities with hints.+--+data Annotated e where+  (:>)  :: Hint hint => e    -> hint -> Annotated e         -- ^explicit marshalling hint+  Typed ::              Name         -> Annotated Name      -- ^marshalling implicitly defined by name's type++-- |We provide additional syntax where the hint is to the left of the annotated entity.+--+(<:) :: Hint hint => hint -> e -> Annotated e+(<:) = flip (:>)++-- |Annotation for irrelevant results+--+void :: e -> Annotated e+void = (''() <:)++-- Hints imply marshalling strategies, which include source and destination types for marshalling.+--+class Hint hint where+  haskellType :: hint -> Q TH.Type+  +instance Hint Name where   -- must be a type name+  haskellType = conT+      +instance Hint (Q TH.Type) where+  haskellType = id++-- |Determine the Haskell type implied for the given annotated entity.+--+haskellTypeOf :: Annotated e -> Q TH.Type+haskellTypeOf (_ :> hint)  = haskellType hint+haskellTypeOf (Typed name)+  = do+    { info <- reify name+    ; case info of+        ClassOpI _ ty _ _ -> return ty+        VarI     _ ty _ _ -> return ty+        nonVarInfo    -> +          do+          { reportErrorAndFail QC.ObjC $ +              "expected '" ++ show name ++ "' to be a typed variable name, but it is " ++ +              show (TH.ppr nonVarInfo)+          }+    }++-- |Remove the annotation.+--+stripAnnotation :: Annotated e -> e+stripAnnotation (e :> hint)  = e+stripAnnotation (Typed name) = name

@@ -17,20 +17,23 @@   module Foreign.C.Types, CString, CStringLen, CWString, CWStringLen, Errno,    -- * Combinators for inline Objective-C -  objc_import, objc_interface, objc_implementation, objc, objc_emit+  objc_import, objc_interface, objc_implementation, objc, objc_emit,+  +  -- * Marshalling annotations+  Annotated(..), (<:), void ) where    -- common libraries import Control.Applicative-import Control.Monad+import Control.Monad              hiding (void) import Data.Array import Data.Dynamic import Data.IORef import Data.List-import Foreign.C                  as C+import Foreign.C                  as C  import Foreign.C.String           as C import Foreign.C.Types-import Foreign.Marshal            as C+import Foreign.Marshal            as C  hiding (void) import Language.Haskell.TH        as TH import Language.Haskell.TH.Syntax as TH import System.FilePath@@ -43,6 +46,7 @@    -- friends import Language.C.Inline.Error+import Language.C.Inline.Hint import Language.C.Inline.State import Language.C.Inline.ObjC.Marshal @@ -86,18 +90,19 @@ -- the Haskell variable refers to a CAF, it will be a nullary function in C — after all, a thunk may still need to be -- evaluated.) ---objc_implementation :: [TH.Name] -> [QC.Definition] -> Q [TH.Dec]-objc_implementation vars defs+objc_implementation :: [Annotated TH.Name] -> [QC.Definition] -> Q [TH.Dec]+objc_implementation ann_vars defs   = do-    { mapM_ exportVar vars+    { mapM_ exportVar ann_vars     ; stashObjC_m defs     ; return []     }   where-    exportVar var+    exportVar ann_var       = do         {   -- Determine the argument and result types of the exported Haskell function-        ; (tvs, argTys, inIO, resTy) <- splitHaskellType <$> determineVarType var+        ; let var = stripAnnotation ann_var+        ; (tvs, argTys, inIO, resTy) <- splitHaskellType <$> haskellTypeOf ann_var              -- Determine C types         ; cArgTys <- mapM (haskellTypeToCType ObjC) argTys@@ -175,25 +180,26 @@ -- |Inline Objective-C expression. -- -- The inline expression will be wrapped in a C function whose arguments are marshalled versions of the Haskell--- variables given in the first argument and whose return value will be marshalled to the Haskell type given by the--- second argument.+-- variables given in the first argument. The marshalling of the variables and of the result is determined by the+-- marshalling annotations at the variables and the inline expression. ---objc :: [TH.Name] -> TH.Name -> QC.Exp -> Q TH.Exp-objc vars resTy e+objc :: [Annotated TH.Name] -> Annotated QC.Exp -> Q TH.Exp+objc ann_vars ann_e   = {- tryWithPlaceholder $ -} do  -- FIXME: catching the 'fail' purges all reported errors :(     {   -- Sanity check of arguments-    ; varTys <- mapM determineVarType vars-    ; checkTypeName resTy+    ; let vars = map stripAnnotation ann_vars+    ; varTys <- mapM haskellTypeOf ann_vars+    ; resTy  <- haskellTypeOf ann_e          -- Determine C types     ; cArgTys <- mapM (haskellTypeToCType ObjC) varTys-    ; cResTy  <- haskellTypeNameToCType ObjC resTy+    ; cResTy  <- haskellTypeToCType ObjC resTy          -- Determine the bridging type and the marshalling code     ; (bridgeArgTys, cBridgeArgTys, hsArgMarshallers, cArgMarshallers) <-         unzip4 <$> zipWithM generateHaskellToCMarshaller varTys cArgTys     ; (bridgeResTy,  cBridgeResTy,  hsResMarshaller,  cResMarshaller)  <--        generateCToHaskellMarshaller (ConT resTy) cResTy+        generateCToHaskellMarshaller resTy cResTy          -- Haskell type of the foreign wrapper function     ; let hsWrapperTy = haskellWrapperType [] bridgeArgTys bridgeResTy@@ -209,8 +215,8 @@     ; cArgVars <- mapM (newName . nameBase) vars     ; let (wrapperProto, wrapperDef)             = generateCWrapper cwrapperName cArgTys vars cArgMarshallers cBridgeArgTys cArgVars-                               e-                               (ConT resTy) cResTy cResMarshaller cBridgeResTy+                               (stripAnnotation ann_e)+                               resTy cResTy cResMarshaller cBridgeResTy     ; stashObjC_h wrapperProto     ; stashObjC_m wrapperDef 

@@ -14,11 +14,8 @@ -- FIXME: Some of the code can go into a module for general marshalling, as only some of it is ObjC-specific.  module Language.C.Inline.ObjC.Marshal (-  -- * Auxilliary functions-  determineVarType, checkTypeName,-     -- * Determine corresponding foreign types of Haskell types-  haskellTypeToCType, haskellTypeNameToCType,+  haskellTypeToCType,      -- * Marshaller types   HaskellMarshaller, CMarshaller,@@ -45,44 +42,6 @@    -- friends import Language.C.Inline.Error----- Auxilliary functions--- ------------------------ |Check that the given TH name is that of a Haskell variable and determine its type.----determineVarType :: TH.Name -> Q TH.Type-determineVarType vname-  = do-    { vinfo <- reify vname-    ; case vinfo of-        VarI _ ty _ _ -> return ty-        nonVarInfo    -> -          do-          { reportErrorAndFail QC.ObjC $ -              "expected '" ++ show vname ++ "' to be a variable name, but it is " ++ -              show (TH.ppr nonVarInfo)-          }-    }---- |Check that the given TH name is that of a Haskell type constructor.----checkTypeName :: TH.Name -> Q ()-checkTypeName tyname-  = do-    { tyinfo <- reify tyname-    ; case tyinfo of-        TyConI (DataD {})    -> return ()-        TyConI (NewtypeD {}) -> return ()-        TyConI (TySynD {})   -> return ()-        nonTyInfo  -> -          do-          { reportErrorAndFail QC.ObjC $ -              "expected '" ++ show tyname ++ "' to be a type name, but it is " ++ -              show (TH.ppr nonTyInfo)-          }-    }   -- Determine foreign types

@@ -3,6 +3,8 @@  This library uses Template Haskell and `language-c-quote`, a quasi-quotation library for C-like languages, to provide inline C and Objective-C in Haskell. It extracts the C/Objective-C code automatically, when compiling the Haskell program, and generates marshalling code for common types. The wiki on GitHub details the [motivation](https://github.com/mchakravarty/language-c-inline/wiki/Motivation) for this approach. +For further motivation, have a look at the slides of my YOW! Lambda Jam 2014 talk [Foreign Inline Code in Haskell](https://speakerdeck.com/mchakravarty/foreign-inline-code-in-haskell).+ Building -------- @@ -18,14 +20,19 @@ * Execute `cd tests/objc/concept; make`. * Now run the demo executable with `./InlineObjC`. +To build an example class wrapping a Haskell record, do the following:++* Execute `cd tests/objc/record; make`.+* Now run the demo executable with `./Particle`.+ To build the more complex Haskell interpreter app:  * Execute `cd tests/objc/app; make`. * Now `open -a HSApp.app`. -I tested it with Haskell Platform 2013.2.0.0 (which includes GHC 7.6.3) and it requires the latest version of `language-c-quote`, which is 0.7.6.+I tested it with Haskell Platform 2013.2.0.0 (which includes GHC 7.6.3) and it requires the latest version of `language-c-quote`, which is currently 0.7.7.  Status ====== -The library is still in its early stages. At the moment automatic marshalling support is limited to strings and boxed Haskell values represented as stable pointers in C land. However, it is quite easy to add more types, and I do welcome pull request!+The library is in beta and so far focuses on Objective-C. Automatic marshalling support is still somewhat limited. However, it is quite easy to add more types, and I do welcome pull request!

@@ -1,7 +1,7 @@ Name:                   language-c-inline-Version:                0.5.0.0+Version:                0.6.0.0 Cabal-version:          >= 1.9.2-Tested-with:            GHC == 7.6.3+Tested-with:            GHC == 7.6.3, GHC == 7.8.2 Build-type:             Simple  Synopsis:               Inline C & Objective-C code in Haskell for language interoperability@@ -10,12 +10,15 @@                         without a dedicated bridge or binding. Here is a tiny example:                         .                         > nslog :: String -> IO ()-                        > nslog msg = $(objc ['msg] ''() [cexp| NSLog(@"Here is a message from Haskell: %@", msg) |])+                        > nslog msg = $(objc ['msg :> ''String] (void [cexp| NSLog(@"Here is a message from Haskell: %@", msg) |]))                         .                         For more information, see <https://github.com/mchakravarty/language-c-inline/wiki>.                         .                         Known bugs: <https://github.com/mchakravarty/language-c-inline/issues>                         .+                        * New in 0.6.0.0: Introduction of explicit marshalling hints (for more flexibility and support of+                        GHC 7.8's untyped Template Haskell quotations)+                        .                         * New in 0.5.0.0: Marshalling of numeric types                         .                         * New in 0.4.0.0: Maybe types are marshalled as pointers that may be nil & bug fixes.@@ -61,6 +64,10 @@   Type:                 git   Location:             git://github.com/mchakravarty/language-c-inline.git +Flag ManualTests+  Description:         Enables tests that require manual intervention.+  Default:             False+ Library   Build-depends:        array,                         base              >= 4.0 && < 5,@@ -73,6 +80,7 @@   Exposed-modules:      Language.C.Inline.ObjC    Other-modules:        Language.C.Inline.Error+                        Language.C.Inline.Hint                         Language.C.Inline.State                         Language.C.Inline.ObjC.Marshal @@ -80,6 +88,11 @@  -- Doesn't work!!! Use the Makefile in the tests/ instead. (How can we get cabal to compile & link the generated ObjC files?) Test-Suite concept+  if flag(ManualTests)+     Buildable:         True+  else+     Buildable:         False+   Build-depends:        base              >= 4.0 && < 5,                         language-c-quote,                         language-c-inline

@@ -13,8 +13,8 @@   main :: IO ()-main = $(objc [] ''()-          [cexp| NSApplicationMain (0, NULL) |])-                   -- 'NSApplicationMain' ignores its argc and argv arguments anyway+main = $(objc [] $+          void [cexp| NSApplicationMain (0, NULL) |])+                        -- 'NSApplicationMain' ignores its argc and argv arguments anyway  objc_emit

@@ -65,7 +65,7 @@ |]  -objc_implementation ['launchMsg, 'start, 'evalExpr, 'loadModule] [cunit|+objc_implementation [Typed 'launchMsg, Typed 'start, Typed 'evalExpr, Typed 'loadModule] [cunit|  @interface AppDelegate () 

@@ -1,5 +1,6 @@ HC      = ghc-CFLAGS  = -fobjc-arc -I$(shell $(HC) --print-libdir)/include+LIBDIR  = $(shell $(HC) --print-libdir)+CFLAGS  = -fobjc-arc -I$(LIBDIR)/include -I$(LIBDIR)/../../includes HCFLAGS = LDFLAGS = -package template-haskell -package language-c-quote -package language-c-inline -package hint \           -framework Cocoa -optl-ObjC -threaded

@@ -11,7 +11,7 @@ dumpURL :: String -> IO () dumpURL urlString   = do-    { urlData <- $(objc ['urlString] ''String [cexp| +    { urlData <- $(objc ['urlString :> ''String] $ ''String <: [cexp|                     [NSString stringWithContentsOfURL:[NSURL URLWithString:urlString]                              encoding:NSUTF8StringEncoding                               error:NULL] 

@@ -3,11 +3,13 @@ import Language.C.Quote.ObjC import Language.C.Inline.ObjC +import Language.Haskell.TH  objc_import ["<Foundation/Foundation.h>"]  nslog :: String -> IO ()-nslog msg = $(objc ['msg] ''() [cexp| NSLog(@"Here is a message from Haskell: %@", msg) |])++nslog msg = $(objc ['msg :> ''String] (void [cexp| NSLog(@"Here is a message from Haskell: %@", msg) |]))  objc_emit 

@@ -6,7 +6,7 @@ objc_import ["<Foundation/Foundation.h>", "Particle_objc.h"]  go :: IO ()-go = $(objc [] ''() [cexp| ({ +go = $(objc [] $ void [cexp| ({      typename Particle *particle = [Particle particleWithMass:1.0];      NSLog(@"The mass is %f", particle.mass);    }) |])

@@ -1,5 +1,6 @@ HC      = ghc-CFLAGS  = -fobjc-arc -I$(shell $(HC) --print-libdir)/include+LIBDIR  = $(shell $(HC) --print-libdir)+CFLAGS  = -fobjc-arc -I$(LIBDIR)/include -I$(LIBDIR)/../../includes HCFLAGS = LDFLAGS = -package template-haskell -package language-c-quote -package language-c-inline -framework Foundation 

@@ -52,7 +52,7 @@ |]  -objc_implementation ['newParticle, 'particleMass] [cunit|+objc_implementation [Typed 'newParticle, Typed 'particleMass] [cunit|  @interface Particle ()