packages feed

clr-inline (empty) → 0.1.0.0

raw patch · 20 files changed

+1276/−0 lines, 20 filesdep +Cabaldep +basedep +bytestringsetup-changed

Dependencies added: Cabal, base, bytestring, clr-host, clr-inline, clr-marshal, containers, criterion, directory, extra, filepath, here, hspec, lens, process, template-haskell, temporary, text, transformers

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for clr-inline++## 0.1.0.0  -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2017, Jose Iborra++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.++    * Neither the name of Jose Iborra nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"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+OWNER OR CONTRIBUTORS 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.
+ README.md view
@@ -0,0 +1,108 @@+clr-inline+==============+[![Unix build status](https://gitlab.com/tim-m89/clr-haskell/badges/master/build.svg)](https://gitlab.com/tim-m89/clr-haskell/commits/master)+[![Windows Build Status](https://img.shields.io/appveyor/ci/TimMatthews/clr-haskell.svg?label=Windows%20build)](https://ci.appveyor.com/project/tim-m89/clr-haskell)++**NOTE: you will need GHC >= 8.2 to use this package in Windows.++What is clr-inline+=======================+**clr-inline** provides a quasiquoter to inline F# and C# code in Haskell modules. +It was inspired by [`inline-java`], [`inline-c`] and [`inline-r`], and it is implemented+on top of [clr-host][clr-host] and [clr-marshal][clr-marshal] packages.++[clr-host]: https://gitlab.com/tim-m89/clr-haskell/tree/master/libs/clr-host+[clr-marshal]: https://gitlab.com/tim-m89/clr-haskell/tree/master/libs/clr-marshal+[inline-java]: http://hackage.haskell.org/package/inline-java+[inline-r]: http://hackage.haskell.org/package/inline-r+[inline-c]: http://hackage.haskell.org/package/inline-c++Example+==========++Graphical hello world using F# Winforms:++```haskell+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+module Main where++import Clr.Inline++[fsharp|+  open System.Windows.Forms+       |]++main = do+  startClr+  let text = "Hello from Haskell"+  [fsharp|+        let form = new Form(Text=$text:string)+        let button = new Button(Text="Click Me!", Dock=DockStyle.Fill)+        button.Click.Add(fun _ -> MessageBox.Show($text, "Hey!") |> ignore)+        form.Controls.Add(button)+        Application.Run(form)+         |]+```+Features+==========+* Inline F# / C# in Haskell.+* Automatic unmarshalling of CLR primitive types into Haskell.+* Reference types support including arrays and generics.+* Refer to Haskell non-function values inside F# / C# quotations.++Getting Started+===================+Install the `clr-inline` package from Hackage using your preferred package manager:++    $ cabal install clr-inline+    $ stack install clr-inline++By default, `.Net` is used in Windows and `mono` in other systems. +This is driven by Cabal flags in the `clr-host` package.++Requirements+================+`clr-inline` requires GHC >=8.0 for `mono`, and either GHC >=8.2 or a [linker preprocessor] for `.Net`.++[linker preprocessor]: https://gitlab.com/tim-m89/clr-haskell/tree/master/utils/clr-win-linker++Cabal requires that the CLR compiler is in the application path at `cabal configure` time. +The module `Clr.Inline.Cabal` provides an optional Cabal user hook that can be added to a cabal+ Setup script to check for this automatically++The quasiquoters look for the F#/C# compiler binaries in the+application path. External dependencies and additional search paths can be provided to+the quasiquoter as configuration. Configuration creates a new quasiquoter;+since GHC does not allow calling a quasiquoter from the same module where it is+defined, the recommended practice is to configure the quasiquoters in a +dedicated Config module. Example configuration for WPF dependencies:++```haskell+module WpfDeps where++import Clr.Inline+import Clr.Inline.Config++wpf =+  fsharp' $+    defaultConfig+    { configDependencies =+        [ "System.Xaml"+        , "WindowsBase"+        , "PresentationCore"+        , "PresentationFramework"+        ]+    }+```+++LICENSE+==========++Copyright (c) 2017 Jose Iborra++clr-inline is free software and may be redistributed under the terms+specified in the [LICENSE](LICENSE) file.
+ Setup.hs view
@@ -0,0 +1,19 @@+import Clr.Host.Config+import Clr.Inline.Config+import Distribution.Simple+import Distribution.Simple.LocalBuildInfo+import Distribution.Simple.Program+import Distribution.Verbosity as Verbosity++main = defaultMainWithHooks simpleUserHooks { confHook = checkCompilers }++checkCompilers gh cf = do+  lbi <- confHook simpleUserHooks gh cf+  _ <- requireProgram Verbosity.normal csharpCompiler (withPrograms lbi)+  _ <- requireProgram Verbosity.normal fsharpCompiler (withPrograms lbi)+  return lbi++fsharpCompiler, csharpCompiler :: Program+csharpCompiler = simpleProgram (configCSharpPath defaultConfig)+fsharpCompiler = simpleProgram (configFSharpPath defaultConfig)+
+ bench/Main.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeInType #-}++import Clr.Inline+import Criterion+import Criterion.Main+import Data.Text++i :: Int+i = 7++s :: String+s = "Hello world"++t :: Text+t = pack "Hello World"++[fsharp|+module Global =+   let today = System.DateTime.Today+   let hello = "Hello World" |]++main :: IO ()+main = do+  startClr+  o <- [fsharp| System.DateTime{System.DateTime.Today}|]+  defaultMain+    [+      bench "invoke" $ whnfIO [fsharp| () |]+    , bench "unmarshal int" $ whnfIO [fsharp| int { 7 } |]+    , bench "unmarshal string" $ whnfIO [fsharp| string { Global.hello }|]+    , bench "unmarshal text" $ whnfIO [fsharp| text{ Global.hello }|]+    , bench "unmarshal object" $ whnfIO [fsharp| System.DateTime{Global.today}|]+    , bench "marshal int" $ whnfIO [fsharp| ignore <| $i:int|]+    , bench "marshal string" $ whnfIO [fsharp| ignore <| $s:string|]+    , bench "marshal text" $ whnfIO [fsharp| ignore <| $t:text|]+    , bench "marshal object" $ whnfIO [fsharp| ignore <| $o:System.DateTime|]+    ]
+ clr-inline.cabal view
@@ -0,0 +1,70 @@+name:                clr-inline+version:             0.1.0.0+synopsis:            Quasiquoters for inline C# and F#+description:         Please see README.md+license:             BSD3+license-file:        LICENSE+author:              Jose Iborra+maintainer:          pepeiborra@gmail.com+copyright:           2017 Jose Iborra+category:            Language, FFI, CLR, .NET+build-type:          Simple+homepage:            https://gitlab.com/tim-m89/clr-haskell+bug-reports:         https://gitlab.com/tim-m89/clr-haskell/issues +extra-source-files:  +  CHANGELOG.md +  README.md+cabal-version:       >=1.10++source-repository head+    type:            git+    location:        https://gitlab.com/tim-m89/clr-haskell/tree/master   ++library+  hs-source-dirs:      src+  exposed-modules:     Clr.Inline +                       Clr.Inline.Cabal+                       Clr.Inline.Config+  other-modules:       +                       Clr.CSharp.Inline+                       Clr.FSharp.Inline+                       Clr.Inline.State+                       Clr.Inline.Types+                       Clr.Inline.Utils+                       Clr.Inline.Utils.Parse+                       Clr.Inline.Utils.Embed+                       Clr.Inline.Quoter+                       Clr.FSharp.Gen+  build-depends:        base >=4.9 && <4.10,+                        bytestring,+                        Cabal,+                        clr-host,+                        clr-marshal,+                        containers,+                        directory,+                        extra,+                        filepath,+                        here,+                        lens,+                        process,+                        template-haskell,+                        temporary,+                        text,+                        transformers+  default-language:    Haskell2010+  ghc-options:         -Wall -Wno-name-shadowing++benchmark    benchmark+  type: exitcode-stdio-1.0+  main-is:             Main.hs+  hs-source-dirs:      bench+  build-depends:       base, clr-inline, criterion, text+  default-language:    Haskell2010++test-suite spec+  type: exitcode-stdio-1.0+  main-is:             Spec.hs+  hs-source-dirs:      test+  build-depends:       base, clr-inline, hspec, text+  default-language:    Haskell2010+  other-modules:       InlineSpec
+ src/Clr/CSharp/Inline.hs view
@@ -0,0 +1,118 @@+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# LANGUAGE LambdaCase          #-}+{-# LANGUAGE NamedFieldPuns      #-}+{-# LANGUAGE RecordWildCards     #-}+{-# LANGUAGE TypeInType          #-}+module Clr.CSharp.Inline (csharp, csharp') where++import           Clr.Inline.Config+import           Clr.Inline.Quoter+import           Clr.Inline.Utils+import           Clr.Inline.Utils.Embed+import           Clr.Inline.Types+import           Control.Monad+import           Control.Monad.Trans.Writer+import qualified Data.ByteString            as BS+import           Data.List+import qualified Data.Map as Map+import           Data.Proxy+import           Language.Haskell.TH+import           Language.Haskell.TH.Quote+import           System.Directory+import           System.FilePath            ((<.>), (</>))+import           System.IO.Temp+import           System.Process+import           Text.Printf++-- | Quasiquoter for C# declarations and expressions.+--   A quasiquote is a block of C# statements wrapped in curly braces+--   preceded by the C# return type.+--   Examples:+--+-- @+-- example :: IO (Clr "int[]")+-- example = do+--  [csharp| Console.WriteLine("Hello CLR inline !!!"); |]+--  i <- [csharp| int { return 2; }|]+--  [csharp| int[] {  int[] a = new int[4]{0,0,0,0};+--                    for(int i=0; i < 4; i++) {+--                      a[i] = i;+--                    }+--                    return a;+--                 }|]+-- @+--+--   See the documentation for 'fsharp' for details on the quotation+--   and antiquotation syntaxes.+--  This quasiquoter is implicitly configured with the 'defaultConfig'.+csharp :: QuasiQuoter+csharp = csharp' defaultConfig++name :: Proxy "csharp"+name = Proxy++-- | Explicit configuration version of 'csharp'.+csharp' :: ClrInlineConfig -> QuasiQuoter+csharp' cfg = QuasiQuoter+    { quoteExp  = csharpExp cfg+    , quotePat  = error "Clr.CSharp.Inline: quotePat"+    , quoteType = error "Clr.CSharp.Inline: quoteType"+    , quoteDec  = csharpDec cfg+    }++csharpExp :: ClrInlineConfig -> String -> Q Exp+csharpExp cfg =+  clrQuoteExp+    name+    (compile cfg)+csharpDec :: ClrInlineConfig -> String -> Q [Dec]+csharpDec cfg = clrQuoteDec name $ compile cfg+++genCode :: ClrInlinedGroup "csharp" -> String+genCode ClrInlinedGroup {units, mod} =+  unlines $+  execWriter $ do+    yield $ printf "namespace %s {" (getNamespace mod)+    forM_ units $ \case+      ClrInlinedDec _ body ->+        yield body+      ClrInlinedExp{} ->+        return ()+    yield $ printf "public class %s {" (getClassName mod)+    forM_ units $ \case+      ClrInlinedDec{} ->+        return ()+      ClrInlinedExp exp@ClrInlinedExpDetails {..} -> do+        yield $+          printf+            "    public static %s %s (%s) { "+            returnType+            (getMethodName exp)+            (intercalate ", " [printf "%s %s" t a | (a, ClrType t) <- Map.toList args])+        yield $ printf "#line %d \"%s\"" (fst $ loc_start loc) (loc_filename loc)+        forM_ (lines body) $ \l -> yield $ printf "        %s" l+        yield "}"+    yield "}}"++compile :: ClrInlineConfig -> ClrInlinedGroup "csharp" -> IO ClrBytecode+compile ClrInlineConfig{..} m@ClrInlinedGroup {..} = do+    temp <- getTemporaryDirectory+    dir <- createTempDirectory temp "inline-csharp"+    let ass = getAssemblyName name mod+    let src = dir </> ass <.> ".cs"+        tgt = dir </> ass <.> ".dll"+    writeFile src (genCode m)+    callCommand $+      unwords $+      execWriter $ do+        yield configCSharpPath+        yield "-target:library"+        yield $ "-out:" ++ tgt+        when configDebugSymbols $ yield "-debug"+        forM_ configExtraIncludeDirs $ \dir -> yield $ "-lib:" ++ dir+        forM_ configDependencies $ \name -> yield $ "-reference:" ++ name+        yieldAll configCustomCompilerFlags+        yield src+    bcode <- BS.readFile tgt+    return $ ClrBytecode bcode
+ src/Clr/FSharp/Gen.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards   #-}+{-# LANGUAGE TypeInType        #-}+module Clr.FSharp.Gen (name, compile) where++import           Clr.Inline.Config+import           Clr.Inline.Quoter+import           Clr.Inline.Utils+import           Clr.Inline.Utils.Embed+import           Clr.Inline.Types+import           Control.Monad+import           Control.Monad.Trans.Writer+import qualified Data.ByteString                 as BS+import qualified Data.Map as Map+import           Data.Proxy+import           Language.Haskell.TH.Syntax+import           System.Directory+import           System.FilePath                 ((<.>), (</>))+import           System.IO.Temp+import           System.Process+import           Text.Printf++name :: Proxy "fsharp"+name = Proxy++genCode :: ClrInlinedGroup "fsharp" -> String+genCode ClrInlinedGroup {units, mod} =+  unlines $+  execWriter $ do+    yield $ printf "namespace %s" (getNamespace mod)+    forM_ units $ \case+      ClrInlinedDec _ body -> yield body+      ClrInlinedExp {} -> return ()+    yield $ printf "type %s =" (getClassName mod)+    forM_ units $ \case+      ClrInlinedDec {} -> return ()+      ClrInlinedExp exp@ClrInlinedExpDetails {..} -> do+        let argsString =+              case Map.toList args of+                [] -> "()"+                other -> unwords [printf "(%s:%s)" a t | (a, ClrType t) <- other]+        yield $ printf   "  static member %s %s =" (getMethodName exp) argsString+        yield $ printf "#line %d \"%s\"" (fst $ loc_start loc) (loc_filename loc)+        forM_ (lines body) $ \l ->+          yield $ printf "        %s" l++compile :: ClrInlineConfig -> ClrInlinedGroup "fsharp" -> IO ClrBytecode+compile ClrInlineConfig {..} m@ClrInlinedGroup {..} = do+  temp <- getTemporaryDirectory+  let ass = getAssemblyName name mod+  dir <- createTempDirectory temp "inline-fsharp"+  let src = dir </> ass <.> ".fs"+      tgt = dir </> ass <.> ".dll"+  writeFile src (genCode m)+  callCommand $+    unwords $+    execWriter $ do+      yield configFSharpPath+      yield "--nologo"+      yield "--target:library"+      yield $ "--out:" ++ tgt+      when configDebugSymbols $ yield "--debug:embedded"+      forM_ configExtraIncludeDirs $ \dir -> yield $ "--lib:" ++ dir+      forM_ configDependencies $ \name -> yield $ "--reference:" ++ name+      yieldAll configCustomCompilerFlags+      yield src+  bcode <- BS.readFile tgt+  return $ ClrBytecode bcode
+ src/Clr/FSharp/Inline.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE NamedFieldPuns      #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Clr.FSharp.Inline+  ( fsharp+  , fsharp'+  ) where++import           Clr.FSharp.Gen+import           Clr.Inline.Config+import           Clr.Inline.Quoter+import           Language.Haskell.TH+import           Language.Haskell.TH.Quote++-- | F# declaration and expression quasiquoter.+--   Declarations can include open statements, types or even modules.+--  Example declaration:+--+-- @+-- [fsharp|+--   open System+--   open System.Collections.Generic+--   module Globals =+--      let mutable today = DateTime.Today+-- |]+-- @+--+--  Expressions are wrapped in a curly braces block @{}@ that+--  fixes the return type. An F# expression quotation can refer to+--  a Haskell binding @x@ using the syntax @($x:type)@ where type is+--  a string denoting an F# type and is only required on the first usage, and the parentheses+--  are optional. F# types are mapped to Haskell types via the 'Quotable' class.+--  An antiquotation @$x:type@+--  is well-scoped if there exists a variable @x@ with a Haskell type @U@ in+--  the Haskell context such that there exists an instance+--  @Quotable type clr marshall U@ for some @clr@ and @marshall@.+--+--  An F# expression returns an IO computation that+--  produces a value of the quoted result type if said type is 'Quotable'.+--  Example expressions:+--+-- @+-- hello :: IO (Int, Clr \"System.DateTime")+-- hello = do+--   let year = 2017 :: Int+--   aClr <- [fsharp| DateTime{ DateTime($year:int,04,10)} |]+--   anInt <- [fsharp| int{ ($aClr:System.DateTime).Year + $year:int + $year}|]+--   return (anInt, anClr)+-- @+--+--  CLR Reference types are modelled in Haskell as 'Clr' values, indexed with the+--  name of their F# type as a type level symbol. String equivalence is a poor+--  substitute for type equality, so for two 'Clr' values to have the same type+--  they must be indexed by exactly the same string.+--+--  This quasiquoter is implicitly configured with the 'defaultConfig'.+fsharp :: QuasiQuoter+fsharp = fsharp' defaultConfig++-- | Explicit configuration version of 'fsharp'.+fsharp' :: ClrInlineConfig -> QuasiQuoter+fsharp' cfg = QuasiQuoter+    { quoteExp  = fsharpExp cfg+    , quotePat  = error "Clr.FSharp.Inline: quotePat"+    , quoteType = error "Clr.FSharp.Inline: quoteType"+    , quoteDec  = fsharpDec cfg+    }++fsharpExp :: ClrInlineConfig -> String -> Q Exp+fsharpExp cfg =+  clrQuoteExp+    name+    (compile cfg)++fsharpDec :: ClrInlineConfig -> String -> Q [Dec]+fsharpDec = clrQuoteDec name . compile+
+ src/Clr/Inline.hs view
@@ -0,0 +1,21 @@+module Clr.Inline+  ( csharp+  , csharp'+  , fsharp+  , fsharp'+  , startClr+  , Quotable+  -- * Reexports for generated code+  , FunPtr+  , BStr(..)+  , TextBStr(..)+  , Clr(..)+  , ClrPtr(..)+  )where++import           Clr.CSharp.Inline+import           Clr.FSharp.Inline+import           Clr.Host+import           Clr.Host.BStr+import           Clr.Inline.Types+import           Foreign
+ src/Clr/Inline/Cabal.hs view
@@ -0,0 +1,37 @@+module Clr.Inline.Cabal (ensureFSharp, ensureCSharp) where++import Clr.Host.Config+import Clr.Inline.Config+import Distribution.Simple+import Distribution.Simple.LocalBuildInfo+import Distribution.Simple.Program+import Distribution.Verbosity as Verbosity++-- | Add this to your Cabal Setup.hs driver in order to require the+--   the F# compiler is in the path.+--+-- @+--  import Clr.Inline.Cabal+--  import Distribution.Simple+--+--  main = defaultMainWithHooks $ ensureFSharp simpleUserHooks+-- @+--+ensureFSharp :: UserHooks -> UserHooks+ensureFSharp userHooks =+  userHooks {confHook = check fsharpCompiler (confHook userHooks)}++-- | Add this to your Cabal Setup.hs driver in order to require the+--   the C# compiler is in the path.+ensureCSharp :: UserHooks -> UserHooks+ensureCSharp userHooks =+  userHooks {confHook = check csharpCompiler (confHook userHooks)}++fsharpCompiler, csharpCompiler :: Program+csharpCompiler = simpleProgram (configCSharpPath defaultConfig)+fsharpCompiler = simpleProgram (configFSharpPath defaultConfig)++check pgm base gh cf = do+  lbi <- base gh cf+  _ <- requireProgram Verbosity.normal pgm (withPrograms lbi)+  return lbi
+ src/Clr/Inline/Config.hs view
@@ -0,0 +1,19 @@+module Clr.Inline.Config where++import Clr.Host.Config++data ClrInlineConfig = ClrInlineConfig+  { configFSharpPath :: FilePath+  , configCSharpPath :: FilePath+  , configDependencies :: [String]+  , configExtraIncludeDirs :: [FilePath]+  , configDebugSymbols :: Bool+  , configCustomCompilerFlags :: [String]+  }++defaultMonoConfig, defaultDotNetConfig, defaultConfig :: ClrInlineConfig+defaultMonoConfig = ClrInlineConfig "fsharpc" "mcs" [] [] False []+defaultDotNetConfig  = ClrInlineConfig "fsc" "csc" [] [] False []+defaultConfig = case defaultHostConfig of+                  ClrHostConfig ClrHostMono -> defaultMonoConfig+                  ClrHostConfig ClrHostDotNet -> defaultDotNetConfig
+ src/Clr/Inline/Quoter.hs view
@@ -0,0 +1,176 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE PartialTypeSignatures #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Clr.Inline.Quoter where++import Clr.Marshal.Host (GetMethodStubDelegate, makeGetMethodStubDelegate, unsafeGetPointerToMethod)+import Clr.Host.BStr+import Clr.Marshal+import Clr.Inline.State+import Clr.Inline.Types+import Clr.Inline.Utils.Parse+import Clr.Inline.Utils.Embed+import Control.Lens+import Data.Char+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Maybe+import Data.Typeable+import Foreign.Ptr+import GHC.TypeLits+import Language.Haskell.TH+import Language.Haskell.TH.Syntax+import System.IO.Unsafe+import Text.Printf++data ClrInlinedExpDetails (language :: Symbol) argType = ClrInlinedExpDetails+  { language :: Proxy language+  , unitId :: Int+  , stubName :: Name+  , body :: String+  , args :: Map String argType+  , loc  :: Loc+  , returnType :: String+  }++data ClrInlinedUnit (language :: Symbol) argType+  = ClrInlinedExp (ClrInlinedExpDetails language argType)+  | ClrInlinedDec (Proxy language) String++makePrisms ''ClrInlinedUnit+makeLensesFor [("args","_args")] ''ClrInlinedExpDetails++data ClrInlinedGroup language = ClrInlinedGroup+  { mod :: Module+  , units :: [ClrInlinedUnit language ClrType]+  }++getNamespace :: Module -> String+getNamespace (Module (PkgName pkg) _) = printf "Clr.Inline.%s" pkg+getMethodName ClrInlinedExpDetails{..} = printf "%s_quote_%d" (symbolVal language) unitId+getMethodName :: KnownSymbol language => ClrInlinedExpDetails language a -> String+getClassName :: Module -> String+getClassName (Module _ (ModName n)) = n+getAssemblyName, getFullClassName :: KnownSymbol language => Proxy language -> Module -> String+getAssemblyName language (Module (PkgName p) (ModName m)) = printf "%s_%s_%s" p m (symbolVal language)+getFullClassName language mod =+  printf+    "%s.%s, %s, Version=0.0.0.0, Culture=neutral, PublicKeyToken=null"+    (getNamespace mod)+    (getClassName mod)+    (getAssemblyName language mod)++toClrArg :: String -> String+toClrArg x = "arg_" ++ x+++getValueName :: String -> Q Name+getValueName a = fromMaybe (error $ "Identifier not in scope: " ++ a) <$> lookupValueName a++generateFFIStub :: KnownSymbol language => ClrInlinedExpDetails language String -> Q [Dec]+generateFFIStub ClrInlinedExpDetails{..} = do+  resTy <- [t| IO $(lookupQuotableMarshalType returnType)|]+  argsTyped <- traverse lookupQuotableMarshalType args+  let funTy = return $ foldr (\t u -> ArrowT `AppT` t `AppT` u) resTy (Map.elems argsTyped)+  -- This is what we'd like to write:+  -- [d| foreign import ccall "dynamic" $stubName :: $([t|FunPtr $funTy -> $funTy|]) |]+  -- Unfort. splicing languages into foreign import decl is not supported, so we have to write:+  -- TODO Convert every type to its Marshalled counterpart+  ffiStub <- ForeignD . ImportF CCall Safe "dynamic" stubName <$> [t|FunPtr $funTy -> $funTy|]+  return [ffiStub]++getMethodStubRaw :: (GetMethodStubDelegate a)+getMethodStubRaw = unsafeDupablePerformIO $ makeGetMethodStubDelegate <$> unsafeGetPointerToMethod "GetMethodStub"++invoke :: String -> String -> FunPtr a+invoke c m = unsafeDupablePerformIO $ marshal c $ \c -> marshal m $ \m -> return $ getMethodStubRaw c m (BStr nullPtr)++generateClrCall :: KnownSymbol language => Module -> ClrInlinedExpDetails language a -> ExpQ+generateClrCall mod exp@ClrInlinedExpDetails{..} = do+  let argExps =+        [ [| marshal $(varE =<< getValueName a)|]+        | a <- Map.keys args+        ]+      roll m f = [|$m . ($f .)|]+  [| do unembedBytecode+        let stub = invoke $(liftString $ getFullClassName language mod) $(liftString $ getMethodName exp)+        let stub_f = $(varE stubName) stub+        result <- $(foldr roll [|id|] argExps) stub_f+        unmarshalAuto (Proxy :: $([t| Proxy $(litT $ strTyLit returnType) |])) result+    |]++-- | Runs after the whole module has been loaded and is responsible for generating:+--     - A clr assembly with all the inline code, embedding it into the module.+clrGenerator+  :: forall language . KnownSymbol language+  => Proxy language -> Module -> (ClrInlinedGroup language -> IO ClrBytecode) -> Q ()+clrGenerator language hsmod compile = do+  FinalizerState {wrappers} <- getFinalizerState @(ClrInlinedUnit language String)+  typedWrappers <-+        mapMOf (traversed . _ClrInlinedExp . _args) (fmap (Map.mapKeysMonotonic toClrArg) . traverse lookupQuotableClrType) wrappers+  let mod = ClrInlinedGroup hsmod typedWrappers+  _ <- runIO $ compile mod+  -- Embed the bytecodes+  embedBytecode (symbolVal language) =<< runIO (compile mod)+++-- | Quasiquoter for expressions. Responsible for:+--      - Installing a finalizer to generate the bytecodes+--      - Generating the foreign import wrapper.+--      - Splicing in the computation that loads the bytecodes, gets a function pointer through the keyhole, and calls it.+clrQuoteExp+  :: forall language.+     KnownSymbol language+  => Proxy language -> (ClrInlinedGroup language -> IO ClrBytecode) -> String -> Q Exp+clrQuoteExp language clrCompile body = do+  count <- getFinalizerCount @(ClrInlinedUnit language String)+  mod <- thisModule+  stubName <- newName $ printf "%s_stub_%d" (symbolVal language) count+  loc <- location+  let ParseResult parsedBody resultType antis = parse toClrArg body+  let inlinedUnit =+        ClrInlinedExpDetails+          language+          count+          stubName+          (normaliseLineEndings parsedBody)+          antis+          loc+          resultType+  pushWrapperGen (clrGenerator language mod clrCompile) $ return (ClrInlinedExp inlinedUnit :: ClrInlinedUnit language String)+  --+  -- splice in a proxy datatype for the late bound class, used to delay the type checking of the stub call+  addTopDecls =<< generateFFIStub inlinedUnit+  --+  -- splice in the bytecode load and call to the stub+  generateClrCall mod inlinedUnit++-- | Quasi quoter for declaration in the clr language.+--   Does not splice anything onto the Haskell source.+clrQuoteDec :: forall language . KnownSymbol language => Proxy language -> (ClrInlinedGroup language -> IO ClrBytecode) -> String -> Q [Dec]+clrQuoteDec language clrCompile body = do+  mod <- thisModule+  pushWrapperGen (clrGenerator language mod clrCompile) $ do+    let nbody = normaliseLineEndings body+        ws =+          [ (white, line)+          | l <- lines nbody+          , let (white, line) = span isSpace l+          , not (null line)+          ]+        allEqual (x:y:xx) = x == y && allEqual (y : xx)+        allEqual _ = True+        body' =+          if allEqual (map fst ws)+            then unlines (map snd ws)+            else nbody+    return (ClrInlinedDec language body' :: ClrInlinedUnit language String)+  return mempty+
+ src/Clr/Inline/State.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TypeApplications #-}+module Clr.Inline.State where++import Control.Monad+import Data.Typeable+import Language.Haskell.TH as TH+import Language.Haskell.TH.Syntax as TH++data FinalizerState a = FinalizerState+  { finalizerCount :: Int+  , wrappers :: [a]+  }++initialFinalizerState :: FinalizerState a+initialFinalizerState = FinalizerState 0 []++getFinalizerState :: forall a . Typeable a => Q (FinalizerState a)+getFinalizerState = TH.getQ >>= \case+    Nothing -> do+      TH.putQ (initialFinalizerState @ a)+      return initialFinalizerState+    Just st -> return st++setFinalizerState :: Typeable a => FinalizerState a -> Q ()+setFinalizerState = TH.putQ++getFinalizerCount :: forall a. Typeable a => Q Int+getFinalizerCount = finalizerCount <$> getFinalizerState @ a++incrementFinalizerCount :: forall a. Typeable a => Q ()+incrementFinalizerCount =+    getFinalizerState @ a >>= \FinalizerState{..} ->+    setFinalizerState FinalizerState{finalizerCount = finalizerCount + 1, ..}++decrementFinalizerCount :: forall a . Typeable a => Q ()+decrementFinalizerCount =+    getFinalizerState @ a >>= \FinalizerState{..} ->+    setFinalizerState FinalizerState{finalizerCount = max 0 (finalizerCount - 1), ..}++isLastFinalizer :: forall a . Typeable a => Q Bool+isLastFinalizer =+  getFinalizerState @a >>= \FinalizerState {..} -> return $ finalizerCount == 0++pushWrapper :: forall a . Typeable a => a -> Q ()+pushWrapper w =+    getFinalizerState @ a >>= \FinalizerState{..} ->+    setFinalizerState FinalizerState{wrappers = w:wrappers, ..}++pushWrapperGen :: forall a . Typeable a => Q () -> Q a -> Q ()+pushWrapperGen actionIfLast gen = do+    incrementFinalizerCount @ a+    TH.addModFinalizer $ do+      decrementFinalizerCount @ a+      pushWrapper =<< gen+      isLast <- isLastFinalizer @ a+      when isLast actionIfLast
+ src/Clr/Inline/Types.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE FlexibleInstances      #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses  #-}+{-# LANGUAGE TemplateHaskell        #-}+{-# LANGUAGE TypeInType             #-}+{-# LANGUAGE TypeFamilies           #-}+{-# LANGUAGE ViewPatterns           #-}+module Clr.Inline.Types where++import           Clr.Host.BStr+import           Clr.Marshal+import           Clr.Marshal.Host+import           Data.Int+import           Data.IORef+import           Data.Maybe+import           Data.Proxy+import           Data.Text            (Text)+import           Data.Word+import           Foreign+import           GHC.TypeLits+import           Language.Haskell.TH+import           System.IO.Unsafe++-- | A pointer to a Clr object.+--   The only way to access the contents is via clr-inline quotations.+newtype ClrPtr (name::Symbol)= ClrPtr Int64++-- | A wrapper around a 'ClrPtr', which will be released once this+--   wrapper is no longer referenced.+--   The only way to access the contents is in clr-inline quotations.+data Clr (name::Symbol) = Clr (ClrPtr name) (IORef ())++foreign import ccall "dynamic" releaseObject :: FunPtr (Int64 -> IO ()) -> (Int64 -> IO ())++instance Unmarshal (ClrPtr n) (Clr n) where+  unmarshal o@(ClrPtr id) = do+    ref <- newIORef ()+    _ <- mkWeakIORef ref $ do+      let f = unsafeDupablePerformIO (unsafeGetPointerToMethod "ReleaseObject")+      releaseObject f id+    return (Clr o ref)++instance Marshal (Clr n) (ClrPtr n) where+  marshal (Clr ptr ref) f = do+    () <- readIORef ref+    f ptr++newtype ClrType = ClrType {getClrType :: String} deriving Show++newtype TextBStr = TextBStr BStr+instance Unmarshal TextBStr Text where unmarshal (TextBStr t) = unmarshal t+instance Marshal Text TextBStr where marshal x f = marshal x (f . TextBStr)++-- | Extensible mapping between quotable CLR types and Haskell types+class Unmarshal marshal haskell =>+         Quotable (quoted::Symbol) (clr::Symbol)    marshal     haskell | marshal -> haskell clr+instance Quotable "bool"           "System.Boolean" Bool        Bool+instance Quotable "double"         "System.Double"  Double      Double+instance Quotable "int"            "System.Int32"   Int         Int+instance Quotable "int16"          "System.Int16"   Int16       Int16+instance Quotable "int32"          "System.Int32"   Int32       Int32+instance Quotable "int64"          "System.Int64"   Int64       Int64+instance Quotable "long"           "System.Int64"   Int64       Int64+instance Quotable "uint16"         "System.UInt16"  Word16      Word16+instance Quotable "word16"         "System.UInt16"  Word16      Word16+instance Quotable "uint32"         "System.UInt32"  Word32      Word32+instance Quotable "word32"         "System.UInt32"  Word32      Word32+instance Quotable "uint64"         "System.UInt64"  Word64      Word64+instance Quotable "word64"         "System.UInt64"  Word64      Word64+instance Quotable "string"         "System.String"  BStr        String+instance Quotable "text"           "System.String"  TextBStr    Text+instance Quotable "void"           "System.Void"    ()          ()+-- | All reference types are handled by this instance.+instance Quotable a                a                (ClrPtr a)  (Clr a)++lookupQuotable :: Show a => ([InstanceDec] -> a) -> String -> Q a+lookupQuotable extract quote = do+  let ty = LitT (StrTyLit quote)+  a <- newName "clr"+  b <- newName "rep"+  c <- newName "haskell"+  instances <- reifyInstances ''Quotable [ ty, VarT a, VarT b, VarT c ]+  return $ extract instances++lookupQuotableClrType :: String -> Q ClrType+lookupQuotableClrType s = lookupQuotable extractClrType s+    where+      extractClrType instances = fromMaybe (general instances) $ listToMaybe $ mapMaybe specific instances+      specific (InstanceD _ _ (_ `AppT` _ `AppT` LitT (StrTyLit s) `AppT` _ `AppT` _) _) = Just $ ClrType s+      specific _ = Nothing+      general [InstanceD _ _ (_ `AppT` quote `AppT` clr `AppT` _ `AppT` _) _] | quote == clr = ClrType s+      general _ = error $ "Overlapping instances for Quotable " ++ s++lookupQuotableMarshalType :: String -> Q Type+lookupQuotableMarshalType s = lookupQuotable extractMarshalType s+  where+    extractMarshalType instances = fromMaybe (general instances) $ listToMaybe $ mapMaybe specific instances+    specific (InstanceD _ _ (_ `AppT` quote `AppT` clr `AppT` _ `AppT` _) _) | quote == clr = Nothing+    specific (InstanceD _ _ (_ `AppT` _ `AppT` _ `AppT` marshalTy `AppT` _) _) = Just marshalTy+    specific _ = Nothing+    general [InstanceD _ _ (_ `AppT` quote `AppT` clr `AppT` AppT (ConT clrPtr) _ `AppT` _) _] | quote == clr && clrPtr == ''ClrPtr = AppT (ConT clrPtr) (LitT (StrTyLit s))+    general _ = error $ "Overlapping instances for Quotable " ++ s++unmarshalAuto :: Quotable quote clr a unmarshal => Proxy quote -> a -> IO unmarshal+unmarshalAuto _ = unmarshal
+ src/Clr/Inline/Utils.hs view
@@ -0,0 +1,8 @@+module Clr.Inline.Utils where++import           Control.Monad.Trans.Writer++yield :: Monad m => t -> WriterT [t] m ()+yield x = tell [x]+yieldAll :: Monad m => w -> WriterT w m ()+yieldAll = tell
+ src/Clr/Inline/Utils/Embed.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE LambdaCase          #-}+{-# LANGUAGE RecordWildCards     #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StaticPointers      #-}+{-# LANGUAGE TemplateHaskell     #-}+module Clr.Inline.Utils.Embed where++import           Clr.Marshal.Host+import           Control.Monad+import           Data.ByteString            (ByteString)+import qualified Data.ByteString            as BS+import           Foreign+import           GHC.StaticPtr+import           Language.Haskell.TH        as TH+import           Language.Haskell.TH.Syntax as TH+import           System.IO.Unsafe++-- | A wrapper for clr bytecode.+newtype ClrBytecode = ClrBytecode+  { bytecode :: ByteString+  }++instance TH.Lift ClrBytecode where+  lift ClrBytecode{..} =+      [| ClrBytecode+           (BS.pack $(TH.lift (BS.unpack bytecode)))+       |]++-- | TH action that embeds bytecode in the current module via a top level+--   declaration of a StaticPtr+embedBytecode :: String -> ClrBytecode -> Q ()+embedBytecode name bs = do+    ptr <- TH.newName $ name ++ "_inlineclr__bytecode"+    TH.addTopDecls =<<+      sequence+        [ TH.sigD ptr [t| StaticPtr ClrBytecode |]+        , TH.valD (TH.varP ptr) (TH.normalB [| static $(TH.lift bs) |]) []+        ]++-- | Idempotent action that reads the embedded bytecodes in a module+--   by querying the table of static pointers+unembedBytecode :: IO ()+{-# NOINLINE unembedBytecode #-}+unembedBytecode = doit `seq` return ()+  where+    {-# NOINLINE doit #-}+    doit = unsafePerformIO $ do+      keys <- staticPtrKeys+      forM_ keys $+        unsafeLookupStaticPtr >=> \case+          Just (sptr :: StaticPtr ClrBytecode) -> do+            let ClrBytecode bytes = deRefStaticPtr sptr+            loadBytecode bytes+          _ -> return ()++foreign import ccall "dynamic" assemblyLoad :: FunPtr (Ptr Int -> Int -> IO()) -> (Ptr Int -> Int -> IO ())++-- | Idempotent function that loads the bytecodes embedded in the static table for this module+loadBytecode :: ByteString -> IO ()+loadBytecode bs =+  unsafeGetPointerToMethod "LoadAssemblyFromBytes" >>= \f ->+  BS.useAsCStringLen bs $ \(ptr,len) -> assemblyLoad f (castPtr ptr) len
+ src/Clr/Inline/Utils/Parse.hs view
@@ -0,0 +1,85 @@+module Clr.Inline.Utils.Parse where++import Control.Lens+import Data.Char+import Data.List.Extra+import Data.Map (Map)+import qualified Data.Map as Map++data Token =+    Other String+  | Antiquote String (Maybe String)+  deriving Show++-- TODO tokenizing quoted strings+tokenized :: Iso' String [Token]+tokenized = iso (tokenize (Other [])) untokenize+  where+    tokenize :: Token -> String -> [Token]+    -- Tokenizing inside clr code+    tokenize (Other acc) [] = [Other (reverse acc)]+    -- Start an antiquote+    tokenize (Other acc) ('$':rest) = Other (reverse acc) : tokenize (Antiquote "" Nothing) rest+    -- Escape F# array notation+    tokenize (Other ('~':'|':acc)) (']':rest) = tokenize (Other (']':'|':acc)) rest+    tokenize (Other ('~':'[':acc)) ('|':rest) = tokenize (Other ('|':'[':acc)) rest+    tokenize (Other acc) (c  :rest) = tokenize (Other (c:acc)) rest+    -- Tokenizing inside an antiquote+    tokenize (Antiquote s t) [] = [Antiquote (reverse s) (reverse <$> t)]+    tokenize (Antiquote s t) (c : rest) | isBreak c = Antiquote (reverse s) (reverse <$> t) : tokenize (Other [c]) rest+    tokenize (Antiquote s Nothing)  (':':rest) = tokenize (Antiquote s (Just "")) rest+    tokenize (Antiquote s Nothing)  (c  :rest) = tokenize (Antiquote (c:s) Nothing) rest+    tokenize (Antiquote s (Just t)) (c  :rest) = tokenize (Antiquote s (Just (c:t))) rest++    untokenize :: [Token] -> String+    untokenize [] = []+    untokenize (Other s: rest) = s ++ untokenize rest+    untokenize (Antiquote v Nothing  : rest) = '$' : v ++ untokenize rest+    untokenize (Antiquote v (Just t) : rest) = '$' : v ++ ':' : t ++ untokenize rest++    isBreak c = isSpace c ||  c == ')'++-- | Looks for antiquotes of the form $foo in the given string+--   Returns the antiquotes found, and a new string with the+--   antiquotes transformed+extractArgs :: (String -> String) -> String -> (Map String String, String)+extractArgs transf = mapAccumROf (tokenized.traversed) f mempty+  where+    f acc (Other s) = (acc, Other s)+    f acc (Antiquote v (Just t)) = (Map.insert v t acc, Other (transf v))+    f acc (Antiquote v Nothing)+      | Just _ <- acc ^? at v = (acc, Other (transf v))+      | otherwise = error $ "The first occurrence of an antiquote must include a type ann. (" ++ v ++ ")"++-- | Fix different systems silly line ending conventions+--   https://ghc.haskell.org/trac/ghc/ticket/11215+normaliseLineEndings :: String -> String+normaliseLineEndings []            = []+normaliseLineEndings ('\r':'\n':s) = '\n' : normaliseLineEndings s -- windows+normaliseLineEndings ('\r':s)      = '\n' : normaliseLineEndings s -- old OS X+normaliseLineEndings (  c :s)      =   c  : normaliseLineEndings s++initAndLast :: String -> Maybe (String, Char)+initAndLast = loopInitAndLast id where+  loopInitAndLast _   [ ]    = Nothing+  loopInitAndLast acc [x]    = Just (acc "", x)+  loopInitAndLast acc (x:xx) = loopInitAndLast (acc . (x:)) xx++-- | Parses expressions of the form "ty{e}" and returns (ty, e)+parseBody :: String -> (String, String)+parseBody e =+  case span ('{' /=) (trim e) of+    (typeString, exp') ->+      case initAndLast (drop 1 exp') of+        Just (exp,'}') -> (trim typeString, exp)+        _ -> ("void", e)++data ParseResult = ParseResult+  { body, returnType :: String+  , args :: Map String String+  }++parse :: (String -> String) -> String -> ParseResult+parse transf inline = ParseResult b ret args where+  (ret, inline') = parseBody inline+  (args, b) = extractArgs transf inline'
+ test/InlineSpec.hs view
@@ -0,0 +1,159 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+module InlineSpec where++import Control.Concurrent+import Control.Monad+import Clr.Inline+import Data.Int+import Data.Text as Text (pack)+import Data.Word+import Test.Hspec+import System.Mem+import System.Mem.Weak++[csharp| using System;+         using System.Collections.Generic;+       |]++[fsharp|+open System+open System.Collections.Generic+|]++type SystemDateTime = Clr "System.DateTime"+type DateTime = Clr "DateTime"++main = hspec spec++h_i   = 2 :: Int+h_i16 = 2 :: Int16+h_i32 = 2 :: Int32+h_i64 = 2 :: Int64+h_w16 = 1 :: Word16+h_w32 = 1 :: Word32+h_w64 = 1 :: Word64+h_d = 2.2 :: Double+h_b = False+h_s = "Hello from Haskell"+h_t = Text.pack h_s++spec :: Spec+spec = beforeAll_ startClr $ do++  it "F# inlines pick up imports" $+    [fsharp| ignore <| Dictionary<int,int>() |]++  it "C# inlines pick up imports" $+    [csharp| var foo = new Dictionary<int,int>(); return ;|]++  it "F# inlines return all primitive types" $ do+    [fsharp| int{2}|] `shouldReturn` 2+    [fsharp| bool{false}|] `shouldReturn` False+    [fsharp| double{2.2}|] `shouldReturn` 2.2+    [fsharp| int16{2s}|] `shouldReturn` 2+    [fsharp| int32{2}|] `shouldReturn` 2+    [fsharp| int64{2L}|] `shouldReturn` 2+    [fsharp| long{2L}|] `shouldReturn` 2+    [fsharp| uint16{2us}|] `shouldReturn` 2+    [fsharp| word16{2us}|] `shouldReturn` 2+    [fsharp| uint32{2u}|] `shouldReturn` 2+    [fsharp| word32{2u}|] `shouldReturn` 2+    [fsharp| uint64{2UL}|] `shouldReturn` 2+    [fsharp| word64{2UL}|] `shouldReturn` 2+    [fsharp| text{"hello"}|] `shouldReturn` pack "hello"+    [fsharp| string{"hello"}|] `shouldReturn` "hello"++  it "F# inlines return reference types" $ do+    date <- [fsharp| DateTime{ DateTime.Today}|]+    return ()++  it "F# supports antiquoting int" $+    [fsharp|bool{$h_i:int = 2}|] `shouldReturn` True+  it "F# supports antiquoting int16" $+    [fsharp|bool{$h_i16:int16 = 2s}|] `shouldReturn` True+  it "F# supports antiquoting int32" $+    [fsharp|bool{$h_i32:int32 = 2}|] `shouldReturn` True+  it "F# supports antiquoting int64" $+    [fsharp|bool{$h_i64:int64 = 2L}|] `shouldReturn` True+  it "F# supports antiquoting long" $+    [fsharp|bool{$h_i64:long  = 2L}|] `shouldReturn` True+  it "F# supports antiquoting uint16" $+    [fsharp|bool{$h_w16:uint16 = 1us}|] `shouldReturn` True+  it "F# supports antiquoting uint32" $+    [fsharp|bool{$h_w32:uint32 = 1u}|] `shouldReturn` True+  it "F# supports antiquoting uint64" $+    [fsharp|bool{$h_w64:uint64 = 1UL}|] `shouldReturn` True+  it "F# supports antiquoting bool" $+    [fsharp|bool{$h_b:bool = false}|] `shouldReturn` True+  it "F# supports antiquoting double" $+    [fsharp|bool{$h_d:double = 2.2}|] `shouldReturn` True+  it "F# supports antiquoting string" $+    [fsharp|bool{$h_s:string = "Hello from Haskell"}|] `shouldReturn` True+  it "F# supports antiquoting text" $+    [fsharp|bool{$h_t:text = "Hello from Haskell"}|] `shouldReturn` True++  it "F# handles two antiquotations" $+    [fsharp|bool{$h_i32:int32 + $h_i:int = 4}|] `shouldReturn` True++  it "F# tuples are handled correctly" $ do+    tuple <- [fsharp| int*bool{8,true}|]+    [fsharp| bool{snd $tuple:int*bool}|] `shouldReturn` True+    [fsharp| int {fst $tuple:int*bool}|] `shouldReturn` 8++  it "Reference types are released when Haskell GCs them" $ do+    !tuple <-+      [fsharp|WeakReference*Object{+           let d = obj()+           let w = WeakReference(d)+           (w,d)}|]+    !w <- [fsharp|WeakReference{fst $tuple:WeakReference*Object}|]+    gcUntil [fsharp|bool{System.GC.Collect(); not ($w:WeakReference).IsAlive}|]++  it "But not any earlier" $ do+    tuple <-+      [fsharp|WeakReference*Object{+           let d = Object()+           let w = WeakReference(d)+           if not (Object.ReferenceEquals(w.Target,d)) then+               failwithf "This is not a good test(%O,%O)" w.Target d+           (w,d)}|]+    w <- [fsharp|WeakReference{fst $tuple:WeakReference*Object}|]+    d <- [fsharp|Object{snd $tuple:WeakReference*Object}|]+    performGC+    threadDelay 50000+    [fsharp|bool{+           GC.Collect()+           let res = ($w:WeakReference).IsAlive+           GC.KeepAlive($d:Object)+           res}+           |] `shouldReturn` True++  it "F# generics are handled" $ do+        dict <- [fsharp| Map<int,string> {+                    [ 1,"Foo" ; 2, "bar" ] |> Map.ofSeq+                 }|]+        [fsharp| string{ ($dict:Map<int,string>).[1] }|]+          `shouldReturn` "Foo"++  it "C# arrays are handled" $ do+      i_array <- [csharp| int[] {+                        int[] a = new int[4]{0,0,0,0};+                        for(int i=0; i < 4; i++) {+                          a[i] = i;+                        }+                        return a;+                        }|]+      [csharp|int{return ($i_array:int[])[2];}|] `shouldReturn` 2++gcUntil cond = do+  let loop 10 = error "gc: tried too many times"+      loop i  = do+        performGC+        threadDelay (i * 10000)+        success <- cond+        unless success $ loop (i+1)+  loop 0
+ test/Spec.hs view
@@ -0,0 +1,6 @@++import qualified InlineSpec+import Test.Hspec++main :: IO ()+main = hspec InlineSpec.spec