├── .github └── workflows │ └── workflow.yaml ├── .gitignore ├── H ├── H.cabal ├── H.ghci ├── H.hs ├── LICENSE └── Setup.hs ├── IHaskell ├── .gitignore ├── ChangeLog.markdown ├── LICENSE ├── Setup.hs ├── examples │ └── tutorial-ihaskell-inline-r.ipynb ├── ihaskell-inline-r.cabal └── src │ └── IHaskell │ └── Display │ └── InlineR.hs ├── LICENSE ├── README.md ├── docs ├── .gitignore ├── Gemfile ├── Gemfile.lock ├── README.md ├── _config.yml ├── _data │ └── nav_docs.yml ├── _includes │ └── nav_docs.html ├── _layouts │ ├── default.html │ ├── single.html │ └── twocol.html ├── circle.yml ├── css │ ├── pygments.css │ └── site.css ├── docs │ ├── architectural-overview.md │ ├── build-and-install.md │ ├── casts-and-coercions.md │ ├── catching-runtime-errors.md │ ├── differences-repl-source.md │ ├── evaluating-r-expressions.md │ ├── faq.md │ ├── how-r-interpreter-is-embedded.md │ ├── how-to-analyze-r-values.md │ ├── implementation-of-quasiquoters.md │ ├── index.md │ ├── inline-r-with-IHaskell.md │ ├── internal-structures.md │ ├── internals-introduction.md │ ├── managing-memory.md │ ├── memory-allocation.md │ ├── r-monad.md │ ├── r-values-and-side-effects.md │ ├── splicing-haskell-values-in-r.md │ ├── using-h.md │ └── vectors.md ├── downloads.md ├── gemset.nix ├── img │ ├── cluster-1-thumb.png │ ├── cluster-1.png │ ├── expVsrec-thumb.png │ ├── expVsrec.png │ ├── notebook-1-thumb.png │ └── notebook-1.png ├── index.html ├── shell.nix └── support.md ├── etc └── Dockerfile ├── examples ├── HaskellR-examples.cabal ├── LICENSE ├── RelaxWithNM.hs ├── fft │ └── Main.hs ├── fib │ ├── Fib.hs │ └── Main.hs ├── nls │ ├── Main.hs │ ├── nls.H │ └── system.hs └── nls2 │ ├── Main.hs │ ├── nls2.H │ └── system.hs ├── inline-r ├── CHANGELOG.md ├── LICENSE ├── R │ └── collectAntis.R ├── Setup.hs ├── cbits │ ├── missing_r.c │ └── missing_r.h ├── inline-r.buildinfo ├── inline-r.cabal ├── src │ ├── Control │ │ ├── Memory │ │ │ └── Region.hs │ │ └── Monad │ │ │ └── R │ │ │ ├── Class.hs │ │ │ └── Internal.hs │ ├── Data │ │ └── Vector │ │ │ ├── SEXP.hs │ │ │ └── SEXP │ │ │ ├── Base.hs │ │ │ ├── Mutable.hs │ │ │ └── Mutable │ │ │ └── Internal.hs │ ├── Foreign │ │ ├── R.hs │ │ └── R │ │ │ ├── Constraints.hs │ │ │ ├── Context.hsc │ │ │ ├── Embedded.hsc │ │ │ ├── Encoding.hsc │ │ │ ├── Error.hsc │ │ │ ├── EventLoop.hsc │ │ │ ├── Internal.hs │ │ │ ├── Parse.hsc │ │ │ ├── Type.hs-boot │ │ │ └── Type.hsc │ ├── H │ │ ├── Prelude.hs │ │ └── Prelude │ │ │ └── Interactive.hs │ ├── Internal │ │ └── Error.hs │ └── Language │ │ ├── R.hs │ │ └── R │ │ ├── Debug.hs │ │ ├── Event.hs │ │ ├── GC.hs │ │ ├── Globals.hs │ │ ├── HExp.hs │ │ ├── Instance.hs │ │ ├── Internal.hs │ │ ├── Internal.hs-boot │ │ ├── Internal │ │ ├── FunWrappers.hs │ │ └── FunWrappers │ │ │ └── TH.hs │ │ ├── Literal.hs │ │ ├── Matcher.hs │ │ └── QQ.hs └── tests │ ├── R │ ├── arith-vector.R │ ├── arith.R │ ├── empty.R │ ├── fact.R │ ├── fib-benchmark.R │ └── fib.R │ ├── Test │ ├── Constraints.hs │ ├── Event.hs │ ├── FunPtr.hs │ ├── GC.hs │ ├── Matcher.hs │ ├── Regions.hs │ ├── Scripts.hs │ └── Vector.hs │ ├── bench-hexp.hs │ ├── bench-qq.hs │ ├── ghci │ └── qq-benchmarks.ghci │ ├── shootout │ ├── binarytrees.R │ ├── fannkuchredux.R │ ├── fasta.R │ ├── fastaredux.R │ ├── knucleotide.R │ ├── mandelbrot-noout.R │ ├── mandelbrot.R │ ├── nbody.R │ ├── pidigits.R │ ├── regexdna.R │ ├── reversecomplement.R │ ├── spectralnorm-math.R │ └── spectralnorm.R │ ├── test-env1.hs │ ├── test-env2.hs │ ├── test-qq.hs │ ├── test-shootout.hs │ ├── tests.hs │ └── vector.hs ├── nixpkgs.nix ├── pkg └── windows │ ├── Cygwin │ └── Cygwin.wxs │ ├── H-Bundle.wxs │ ├── H │ ├── H.wxs │ ├── Hb.wxs │ ├── WixUI_FeatureTree2.wxs │ ├── WixUI_en-us.wxl │ └── utils │ │ ├── H terminal.bat │ │ ├── License.rtf │ │ ├── find-reg.bat │ │ ├── install-h.bat │ │ └── install-h.sh │ ├── HP │ └── HP.wxs │ ├── License.rtf │ ├── Makefile │ ├── Process.rtf │ ├── R │ └── R.wxs │ ├── README │ └── Version.wxi ├── shell-lts-19.nix ├── shell-lts-20.nix ├── shell-lts-21.nix ├── shell-nightly.nix ├── shell.nix ├── stack-lts-19.yaml ├── stack-lts-19.yaml.lock ├── stack-lts-20.yaml ├── stack-lts-20.yaml.lock ├── stack-lts-21.yaml ├── stack-lts-21.yaml.lock ├── stack-nightly.yaml ├── stack-nightly.yaml.lock ├── stack.yaml └── stack.yaml.lock /.github/workflows/workflow.yaml: -------------------------------------------------------------------------------- 1 | name: Continuous integration 2 | on: 3 | push: 4 | branches: 5 | - master 6 | pull_request: 7 | 8 | jobs: 9 | build: 10 | name: Build - Windows 11 | runs-on: windows-latest 12 | steps: 13 | - name: Install dependencies 14 | run: | 15 | choco install -y haskell-stack 16 | choco install -y r --version 4.0.0 17 | - uses: actions/checkout@v4 18 | - name: Get Stack snapshot install directory 19 | id: stack-snapshot 20 | # NOTE: `stack path` must run at least once prior to caching to ensure the directory 21 | # exists and is populated. 22 | run: | 23 | stack path --snapshot-install-root 24 | "dir=$(stack path --snapshot-install-root)" | Out-File -FilePath $env:GITHUB_OUTPUT -Append 25 | - uses: actions/cache@v4 26 | with: 27 | path: ${{ steps.stack-snapshot.outputs.dir }} 28 | key: ${{ runner.os }}-stack-${{ hashFiles('**/*.cabal') }} 29 | restore-keys: ${{ runner.os }}-stack- 30 | - name: Build 31 | run: | 32 | stack build inline-r H ` 33 | --extra-lib-dirs="C:/Program files/R/R-4.0.0/bin/x64" ` 34 | --extra-include-dirs="C:/Program files/R/R-4.0.0/include" 35 | test: 36 | name: Build & Test - ${{ matrix.os }} - ${{ matrix.stack_yaml }} 37 | strategy: 38 | fail-fast: false 39 | matrix: 40 | os: 41 | - macos-latest 42 | - ubuntu-latest 43 | stack_yaml: 44 | - stack.yaml 45 | - stack-lts-19.yaml 46 | - stack-lts-20.yaml 47 | - stack-lts-21.yaml 48 | - stack-nightly.yaml 49 | runs-on: ${{ matrix.os }} 50 | steps: 51 | - uses: actions/checkout@v4 52 | - uses: nixbuild/nix-quick-install-action@master 53 | - uses: nix-community/cache-nix-action@main 54 | with: 55 | primary-key: nix-${{ runner.os }}-${{ runner.arch }}-${{ hashFiles('**/*.nix', '**/flake.lock') }} 56 | restore-prefixes-first-match: nix-${{ runner.os }}-${{ runner.arch }} 57 | - name: Install Stack 58 | run: | 59 | nix-env --file ./nixpkgs.nix --install --attr stack 60 | - name: Get Stack snapshot install directory 61 | id: stack-snapshot 62 | # NOTE: `stack path` must run at least once prior to caching to ensure the directory 63 | # exists and is populated. 64 | # NOTE: The renaming of the stack.yaml file is a workaround for 65 | # https://github.com/commercialhaskell/stack/issues/5028. 66 | run: | 67 | [ ${{ matrix.stack_yaml }} = stack.yaml ] || mv ${{ matrix.stack_yaml }} stack.yaml 68 | stack --nix path --snapshot-install-root 69 | echo "dir=$(stack --nix path --snapshot-install-root)" > "${GITHUB_OUTPUT}" 70 | - uses: actions/cache@v4 71 | with: 72 | path: ${{ steps.stack-snapshot.outputs.dir }} 73 | key: ${{ runner.os }}-stack-${{ hashFiles('**/*.cabal') }} 74 | restore-keys: ${{ runner.os }}-stack- 75 | - name: Build 76 | run: | 77 | stack --nix build 78 | - name: Test 79 | if: ${{ runner.os == 'Linux' }} 80 | run: | 81 | stack --nix test 82 | - name: Test IHaskell jupyter notebook example 83 | if: ${{ runner.os == 'Linux' }} 84 | run: | 85 | stack --nix install 86 | export PATH="$HOME/.local/bin:$PATH" 87 | stack --nix exec -- ihaskell install 88 | stack --nix exec -- jupyter nbconvert --to notebook --execute --inplace ./IHaskell/examples/tutorial-ihaskell-inline-r.ipynb 89 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | dist-newstyle 3 | .cabal-sandbox 4 | cabal.sandbox.config 5 | .stack-work 6 | *.wixobj 7 | *.msi 8 | *.wixpdb 9 | -------------------------------------------------------------------------------- /H/H.cabal: -------------------------------------------------------------------------------- 1 | name: H 2 | version: 1.0.0 3 | license: BSD3 4 | license-file: LICENSE 5 | copyright: Copyright (c) 2013-2015 Amgen, Inc. 6 | Copyright (c) 2015-2018 Tweag I/O Limited. 7 | author: Mathieu Boespflug, Facundo Dominguez, Alexander Vershilov 8 | maintainer: Mathieu Boespflug 9 | build-type: Simple 10 | Category: FFI 11 | Synopsis: The Haskell/R mixed programming environment. 12 | description: This package is part of the HaskellR project. 13 | homepage: https://tweag.github.io/HaskellR 14 | cabal-version: >=1.10 15 | extra-source-files: H.ghci 16 | 17 | source-repository head 18 | type: git 19 | location: git://github.com/tweag/HaskellR.git 20 | subdir: H 21 | 22 | executable H 23 | main-is: H.hs 24 | other-modules: Paths_H 25 | build-depends: base >= 4.6 && < 5 26 | , bytestring >= 0.10 && <0.13 27 | , cmdargs >= 0.10.5 && <0.11 28 | , file-embed >= 0.0.7 && <0.1 29 | , process >= 1.2 && <1.7 30 | , temporary >= 1.2.0.3 && <1.4 31 | default-language: Haskell2010 32 | ghc-options: -Werror=unused-packages -Wall -threaded 33 | -------------------------------------------------------------------------------- /H/H.ghci: -------------------------------------------------------------------------------- 1 | -- Copyright: (C) 2013 Amgen, Inc. 2 | :set -fno-ghci-sandbox 3 | :set -XDataKinds 4 | :set -XGADTs 5 | :set -XPartialTypeSignatures 6 | :set -XOverloadedLists 7 | :set -XQuasiQuotes 8 | :set -XScopedTypeVariables 9 | :set -XTemplateHaskell 10 | :set -XViewPatterns 11 | 12 | import H.Prelude.Interactive as H.Prelude 13 | 14 | Language.R.Instance.initialize Language.R.Instance.defaultConfig 15 | -------------------------------------------------------------------------------- /H/H.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Copyright: (C) 2013 Amgen, Inc. 3 | -- 4 | 5 | {-# LANGUAGE DeriveDataTypeable #-} 6 | {-# LANGUAGE NamedFieldPuns #-} 7 | {-# LANGUAGE TemplateHaskell #-} 8 | 9 | module Main where 10 | 11 | import Data.ByteString (hPut) 12 | import Data.FileEmbed (embedFile) 13 | import Data.Version ( showVersion ) 14 | import System.Console.CmdArgs 15 | import System.Exit (exitWith) 16 | import System.IO (hClose) 17 | import System.IO.Temp (withSystemTempFile) 18 | import System.Process 19 | 20 | import qualified Paths_H 21 | 22 | data H = H 23 | { configFiles :: [FilePath] 24 | , configInteractive :: FilePath 25 | } deriving (Eq, Data, Typeable, Show) 26 | 27 | cmdSpec :: H 28 | cmdSpec = H 29 | { configFiles = def &= args &= typ "-- [GHCi options]" 30 | , configInteractive = "ghci" &= explicit &= name "interactive" &= help "Run interpreter" &= opt "ghci" &= typ "ghci" &= help "Set an alternative haskell interpreter." 31 | } 32 | &= program "H" &= 33 | help "H wrapper over ghci. " &= 34 | summary ("H version " ++ showVersion Paths_H.version ++ 35 | "\nCopyright (C) 2013-2014 Amgen, Inc." ++ 36 | "\nCopyright (C) 2015 Tweag I/O Limited.") 37 | -- TODO: add details clause 38 | 39 | main :: IO () 40 | main = do 41 | config <- cmdArgs cmdSpec 42 | case config of 43 | H {configFiles, configInteractive} -> withSystemTempFile "H.ghci" $ \cfg h -> do 44 | hPut h $(embedFile "H.ghci") >> hClose h 45 | let argv = configFiles ++ ["-v0", "-ghci-script", cfg] 46 | (_,_,_,ph) <- 47 | createProcess (proc configInteractive argv) 48 | { std_in = Inherit 49 | , std_out = Inherit 50 | , delegate_ctlc = True 51 | } 52 | exitWith =<< waitForProcess ph 53 | -------------------------------------------------------------------------------- /H/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013-2015 Amgen, Inc. 2 | Copyright (c) 2015 Tweag I/O Limited. 3 | 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions 8 | are met: 9 | 1. Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 2. Redistributions in binary form must reproduce the above copyright 12 | notice, this list of conditions and the following disclaimer in the 13 | documentation and/or other materials provided with the distribution. 14 | 3. The names of the author may not be used to endorse or promote 15 | products derived from this software without specific prior written 16 | permission. 17 | 18 | THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND 19 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 20 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 21 | ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE 22 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 23 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 24 | OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 25 | HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 26 | LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 27 | OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 28 | SUCH DAMAGE. 29 | -------------------------------------------------------------------------------- /H/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | 3 | main :: IO () 4 | main = defaultMain 5 | 6 | -------------------------------------------------------------------------------- /IHaskell/.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | cabal-dev 3 | *.o 4 | *.hi 5 | *.chi 6 | *.chs.h 7 | *.dyn_o 8 | *.dyn_hi 9 | .virtualenv 10 | .hpc 11 | .hsenv 12 | .cabal-sandbox/ 13 | cabal.sandbox.config 14 | *.prof 15 | *.aux 16 | *.hp 17 | -------------------------------------------------------------------------------- /IHaskell/ChangeLog.markdown: -------------------------------------------------------------------------------- 1 | # 0.1.1.1 2 | 3 | ### Fixed 4 | - Fix image generation with `[rplot|]` [Issue #320](https://github.com/tweag/HaskellR/issues/320) 5 | 6 | -------------------------------------------------------------------------------- /IHaskell/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2015 Tweag I/O Limited. 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions 7 | are met: 8 | 1. Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 2. Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in the 12 | documentation and/or other materials provided with the distribution. 13 | 3. The names of the author may not be used to endorse or promote 14 | products derived from this software without specific prior written 15 | permission. 16 | 17 | THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND 18 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 19 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 20 | ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE 21 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 22 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 23 | OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 24 | HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 25 | LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 26 | OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 27 | SUCH DAMAGE. 28 | -------------------------------------------------------------------------------- /IHaskell/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /IHaskell/ihaskell-inline-r.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.0 2 | name: ihaskell-inline-r 3 | version: 0.1.1.1 4 | synopsis: Embed R quasiquotes and plots in IHaskell notebooks. 5 | description: Embed R quasiquotes and plots in IHaskell notebooks. 6 | homepage: https://tweag.github.io/HaskellR/ 7 | license: BSD3 8 | license-file: LICENSE 9 | author: Mathieu Boespflug, Alexander Vershilov 10 | maintainer: Alexander Vershilov 11 | copyright: Copyright (c) 2015, Tweag I/O Limited. 12 | category: Development 13 | build-type: Simple 14 | extra-source-files: ChangeLog.markdown 15 | 16 | library 17 | exposed-modules: IHaskell.Display.InlineR 18 | build-depends: base >=4.7 && <5 19 | ,inline-r >=0.6.0.1 && <1.11 20 | ,ihaskell >=0.10.2.2 && <0.12 21 | ,ihaskell-blaze >=0.3.0.1 && <0.4 22 | ,blaze-html >=0.9.1.2 && <0.10 23 | ,bytestring >=0.10.12.0 && <0.13 24 | ,base64-bytestring >=1.1.0.0 && <1.3 25 | ,template-haskell >=2.16.0.0 && <2.22 26 | ,temporary >=1.2 && <1.4 27 | other-extensions: TemplateHaskell 28 | QuasiQuotes 29 | hs-source-dirs: src 30 | default-language: Haskell2010 31 | ghc-options: -Werror=unused-packages -Wall 32 | 33 | source-repository head 34 | type: git 35 | location: https://github.com/tweag/HaskellR.git 36 | subdir: IHaskell 37 | -------------------------------------------------------------------------------- /IHaskell/src/IHaskell/Display/InlineR.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Copyright: 2015 (C) Tweag I/O Limited 3 | 4 | {-# LANGUAGE QuasiQuotes #-} 5 | {-# LANGUAGE TemplateHaskell #-} 6 | {-# OPTIONS_GHC -fno-warn-missing-fields #-} 7 | module IHaskell.Display.InlineR 8 | ( r 9 | , rprint 10 | , rgraph 11 | , Language.R.Instance.runRegion 12 | ) where 13 | 14 | import Control.Applicative 15 | import Control.Monad (when) 16 | import qualified Data.ByteString as BS 17 | import qualified Data.ByteString.Base64 as Base64 18 | import qualified Data.ByteString.Char8 as Char 19 | import Data.Monoid 20 | import H.Prelude.Interactive as H -- we use provide instances to IO Monad 21 | import IHaskell.Display 22 | import IHaskell.Display.Blaze() 23 | import Language.Haskell.TH.Quote 24 | import Language.R.Instance 25 | import System.IO (hClose) 26 | import System.IO.Temp (withSystemTempFile) 27 | import qualified Text.Blaze.Html5 as BH 28 | import qualified Text.Blaze.Html5.Attributes as BH 29 | import Prelude -- Silence AMP warning 30 | 31 | rprint :: QuasiQuoter 32 | rprint = QuasiQuoter { quoteExp = \s -> [| do H.p $(quoteExp r s) |] } 33 | 34 | rgraph :: QuasiQuoter 35 | rgraph = QuasiQuoter { quoteExp = \s -> 36 | [| withSystemTempFile "ihaskell-inline-r-.png" $ \path h -> do 37 | hClose h 38 | _ <- [r| png(filename=path_hs, width=480, height=480, bg="white"); |] 39 | H.p $(quoteExp r s) 40 | _ <- [r| dev.off() |] 41 | encoded <- Base64.encode <$> BS.readFile path 42 | when (BS.null encoded) $ 43 | fail "No graphical output." 44 | display $ 45 | BH.img BH.! 46 | BH.src (BH.unsafeByteStringValue 47 | (Char.pack "data:image/png;base64," <> encoded)) 48 | |] } 49 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013-2015 Amgen, Inc. 2 | Copyright (c) 2015 Tweag I/O Limited. 3 | 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions 8 | are met: 9 | 1. Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 2. Redistributions in binary form must reproduce the above copyright 12 | notice, this list of conditions and the following disclaimer in the 13 | documentation and/or other materials provided with the distribution. 14 | 3. The names of the author may not be used to endorse or promote 15 | products derived from this software without specific prior written 16 | permission. 17 | 18 | THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND 19 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 20 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 21 | ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE 22 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 23 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 24 | OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 25 | HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 26 | LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 27 | OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 28 | SUCH DAMAGE. 29 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # The HaskellR project 2 | 3 | ![Continuous integration](https://github.com/tweag/HaskellR/workflows/Continuous%20integration/badge.svg?branch=master) 4 | 5 | * Website: https://tweag.github.io/HaskellR 6 | * Mailing list: [Google Groups](https://groups.google.com/group/haskellr) 7 | 8 | The HaskellR project provides an environment for efficiently 9 | processing data using Haskell or R code, interchangeably. HaskellR 10 | allows Haskell functions to seamlessly call R functions and *vice 11 | versa*. It provides the Haskell programmer with the full breadth of 12 | existing R libraries and extensions for numerical computation, 13 | statistical analysis and machine learning. 14 | 15 | ## Getting Started & Documentation 16 | 17 | All documentation is available on the 18 | [HaskellR website](https://tweag.github.io/HaskellR). 19 | 20 | ## Developing HaskellR 21 | 22 | This project uses Stack. See the [stack documentation][stack-docs] for 23 | further information on how to build, run tests and benchmarks, or 24 | build the API documentation. You can do all of that at once with 25 | 26 | ``` 27 | $ stack build --test --haddock --bench 28 | ``` 29 | 30 | Optionally, pass in the `--nix` flag to all commands if you have the 31 | [Nix][nix] package manager installed. Nix can populate a *local* build 32 | environment including all necessary system dependencies without 33 | touching your global filesystem. Use it as a cross-platform 34 | alternative to Docker. 35 | 36 | [nix]: http://nixos.org/nix 37 | [stack-docs]: https://docs.haskellstack.org/en/stable/GUIDE/ 38 | 39 | ## License 40 | 41 | Copyright (c) 2013-2015 Amgen, Inc. 42 | Copyright (c) 2015-2022 Tweag I/O Limited. 43 | 44 | All rights reserved. 45 | 46 | HaskellR is free software, and may be redistributed under the terms 47 | specified in the [LICENSE](LICENSE) file. 48 | -------------------------------------------------------------------------------- /docs/.gitignore: -------------------------------------------------------------------------------- 1 | _site/ 2 | -------------------------------------------------------------------------------- /docs/Gemfile: -------------------------------------------------------------------------------- 1 | source 'https://rubygems.org' 2 | gem 'github-pages', group: :jekyll_plugins 3 | -------------------------------------------------------------------------------- /docs/Gemfile.lock: -------------------------------------------------------------------------------- 1 | GEM 2 | remote: https://rubygems.org/ 3 | specs: 4 | RedCloth (4.2.9) 5 | activesupport (7.0.2.2) 6 | concurrent-ruby (~> 1.0, >= 1.0.2) 7 | i18n (>= 1.6, < 2) 8 | minitest (>= 5.1) 9 | tzinfo (~> 2.0) 10 | addressable (2.4.0) 11 | coffee-script (2.4.1) 12 | coffee-script-source 13 | execjs 14 | coffee-script-source (1.12.2) 15 | colorator (0.1) 16 | concurrent-ruby (1.1.9) 17 | ethon (0.15.0) 18 | ffi (>= 1.15.0) 19 | execjs (2.8.1) 20 | faraday (1.9.3) 21 | faraday-em_http (~> 1.0) 22 | faraday-em_synchrony (~> 1.0) 23 | faraday-excon (~> 1.1) 24 | faraday-httpclient (~> 1.0) 25 | faraday-multipart (~> 1.0) 26 | faraday-net_http (~> 1.0) 27 | faraday-net_http_persistent (~> 1.0) 28 | faraday-patron (~> 1.0) 29 | faraday-rack (~> 1.0) 30 | faraday-retry (~> 1.0) 31 | ruby2_keywords (>= 0.0.4) 32 | faraday-em_http (1.0.0) 33 | faraday-em_synchrony (1.0.0) 34 | faraday-excon (1.1.0) 35 | faraday-httpclient (1.0.1) 36 | faraday-multipart (1.0.3) 37 | multipart-post (>= 1.2, < 3) 38 | faraday-net_http (1.0.1) 39 | faraday-net_http_persistent (1.2.0) 40 | faraday-patron (1.0.0) 41 | faraday-rack (1.0.0) 42 | faraday-retry (1.0.3) 43 | ffi (1.15.5) 44 | gemoji (2.1.0) 45 | github-pages (73) 46 | RedCloth (= 4.2.9) 47 | github-pages-health-check (= 1.1.0) 48 | jekyll (= 3.0.4) 49 | jekyll-coffeescript (= 1.0.1) 50 | jekyll-feed (= 0.5.1) 51 | jekyll-gist (= 1.4.0) 52 | jekyll-github-metadata (= 1.11.0) 53 | jekyll-mentions (= 1.1.2) 54 | jekyll-paginate (= 1.1.0) 55 | jekyll-redirect-from (= 0.10.0) 56 | jekyll-sass-converter (= 1.3.0) 57 | jekyll-seo-tag (= 1.3.3) 58 | jekyll-sitemap (= 0.10.0) 59 | jekyll-textile-converter (= 0.1.0) 60 | jemoji (= 0.6.2) 61 | kramdown (= 1.10.0) 62 | liquid (= 3.0.6) 63 | mercenary (~> 0.3) 64 | rdiscount (= 2.1.8) 65 | redcarpet (= 3.3.3) 66 | rouge (= 1.10.1) 67 | terminal-table (~> 1.4) 68 | github-pages-health-check (1.1.0) 69 | addressable (~> 2.3) 70 | net-dns (~> 0.8) 71 | octokit (~> 4.0) 72 | public_suffix (~> 1.4) 73 | typhoeus (~> 0.7) 74 | html-pipeline (2.14.0) 75 | activesupport (>= 2) 76 | nokogiri (>= 1.4) 77 | i18n (1.9.1) 78 | concurrent-ruby (~> 1.0) 79 | jekyll (3.0.4) 80 | colorator (~> 0.1) 81 | jekyll-sass-converter (~> 1.0) 82 | jekyll-watch (~> 1.1) 83 | kramdown (~> 1.3) 84 | liquid (~> 3.0) 85 | mercenary (~> 0.3.3) 86 | rouge (~> 1.7) 87 | safe_yaml (~> 1.0) 88 | jekyll-coffeescript (1.0.1) 89 | coffee-script (~> 2.2) 90 | jekyll-feed (0.5.1) 91 | jekyll-gist (1.4.0) 92 | octokit (~> 4.2) 93 | jekyll-github-metadata (1.11.0) 94 | octokit (~> 4.0) 95 | jekyll-mentions (1.1.2) 96 | html-pipeline (~> 2.3) 97 | jekyll (~> 3.0) 98 | jekyll-paginate (1.1.0) 99 | jekyll-redirect-from (0.10.0) 100 | jekyll (>= 2.0) 101 | jekyll-sass-converter (1.3.0) 102 | sass (~> 3.2) 103 | jekyll-seo-tag (1.3.3) 104 | jekyll (~> 3.0) 105 | jekyll-sitemap (0.10.0) 106 | jekyll-textile-converter (0.1.0) 107 | RedCloth (~> 4.0) 108 | jekyll-watch (1.5.1) 109 | listen (~> 3.0) 110 | jemoji (0.6.2) 111 | gemoji (~> 2.0) 112 | html-pipeline (~> 2.2) 113 | jekyll (>= 3.0) 114 | kramdown (1.10.0) 115 | liquid (3.0.6) 116 | listen (3.7.1) 117 | rb-fsevent (~> 0.10, >= 0.10.3) 118 | rb-inotify (~> 0.9, >= 0.9.10) 119 | mercenary (0.3.6) 120 | mini_portile2 (2.8.0) 121 | minitest (5.15.0) 122 | multipart-post (2.1.1) 123 | net-dns (0.9.0) 124 | nokogiri (1.13.9) 125 | mini_portile2 (~> 2.8.0) 126 | racc (~> 1.4) 127 | octokit (4.22.0) 128 | faraday (>= 0.9) 129 | sawyer (~> 0.8.0, >= 0.5.3) 130 | public_suffix (1.5.3) 131 | racc (1.6.0) 132 | rb-fsevent (0.11.1) 133 | rb-inotify (0.10.1) 134 | ffi (~> 1.0) 135 | rdiscount (2.1.8) 136 | redcarpet (3.3.3) 137 | rouge (1.10.1) 138 | ruby2_keywords (0.0.5) 139 | safe_yaml (1.0.5) 140 | sass (3.7.4) 141 | sass-listen (~> 4.0.0) 142 | sass-listen (4.0.0) 143 | rb-fsevent (~> 0.9, >= 0.9.4) 144 | rb-inotify (~> 0.9, >= 0.9.7) 145 | sawyer (0.8.2) 146 | addressable (>= 2.3.5) 147 | faraday (> 0.8, < 2.0) 148 | terminal-table (1.8.0) 149 | unicode-display_width (~> 1.1, >= 1.1.1) 150 | typhoeus (0.8.0) 151 | ethon (>= 0.8.0) 152 | tzinfo (2.0.4) 153 | concurrent-ruby (~> 1.0) 154 | unicode-display_width (1.8.0) 155 | 156 | PLATFORMS 157 | ruby 158 | 159 | DEPENDENCIES 160 | github-pages 161 | 162 | BUNDLED WITH 163 | 2.2.22 164 | -------------------------------------------------------------------------------- /docs/README.md: -------------------------------------------------------------------------------- 1 | HaskellR website 2 | ================ 3 | 4 | This branch contains the source for the HaskellR website, deployed at 5 | https://tweag.github.io/HaskellR. To test locally, 6 | 7 | ~~~ 8 | $ gem install jekyll 9 | $ jekyll serve --baseurl '' 10 | ~~~ 11 | 12 | To update ruby package versions recorded in `Gemfile.lock`: 13 | 14 | ~~~ 15 | $ bundle update 16 | $ nix-shell -p bundix 17 | [nix-shell:docs] $ bundix -l 18 | ~~~ 19 | -------------------------------------------------------------------------------- /docs/_config.yml: -------------------------------------------------------------------------------- 1 | --- 2 | name: HaskellR 3 | description: The full power of R in Haskell. 4 | url: https://tweag.github.io 5 | baseurl: /HaskellR 6 | highlighter: rouge 7 | markdown: kramdown 8 | exclude: 9 | - Gemfile 10 | - Gemfile.lock 11 | - README.md 12 | - circle.yml 13 | defaults: 14 | - scope: 15 | path: docs 16 | type: pages 17 | values: 18 | layout: twocol 19 | sass: 20 | style: compressed 21 | sass_dir: _css 22 | --- 23 | -------------------------------------------------------------------------------- /docs/_data/nav_docs.yml: -------------------------------------------------------------------------------- 1 | - title: Quick Start 2 | items: 3 | - id: build-and-install 4 | title: Building and Installing HaskellR 5 | - id: using-h 6 | title: Using H 7 | - title: Tutorial 8 | items: 9 | - id: evaluating-r-expressions 10 | title: Evaluating R expressions in GHCi 11 | - id: splicing-haskell-values-in-r 12 | title: Splicing Haskell values in R 13 | - id: r-monad 14 | title: The R monad 15 | - id: how-to-analyze-r-values 16 | title: How to analyze R values in Haskell 17 | - id: vectors 18 | title: Vectors 19 | - id: casts-and-coercions 20 | title: Casts and coercions 21 | - id: managing-memory 22 | title: Managing memory 23 | - id: catching-runtime-errors 24 | title: Catching runtime errors 25 | - id: differences-repl-source 26 | title: Interactive vs. source files 27 | - title: inline-r Internals 28 | items: 29 | - id: internals-introduction 30 | title: Introduction 31 | - id: architectural-overview 32 | title: Architectural overview 33 | items: 34 | - id: rationale 35 | title: rationale 36 | - id: internal-structures 37 | title: Internal Structures 38 | items: 39 | - id: a-native-view-of-expressions 40 | title: A native view of expressions 41 | - id: a-form-indexed-native-view-of-expressions 42 | title: A form indexed native view of expresions 43 | - id: implementation-of-quasiquoters 44 | title: Implementation of quasiquoters 45 | - id: how-r-interpreter-is-embedded 46 | title: How the R interpreter is embedded 47 | - id: memory-allocation 48 | title: Memory allocation 49 | - title: Other documents 50 | items: 51 | - id: inline-r-with-IHaskell 52 | title: Using inline-r with IHaskell 53 | - id: faq 54 | title: The HaskellR FAQ 55 | -------------------------------------------------------------------------------- /docs/_includes/nav_docs.html: -------------------------------------------------------------------------------- 1 |
2 | 3 | {% for section in site.data.nav_docs %} 4 |
5 |

{{ section.title }}

6 |
    7 | {% for item in section.items %} 8 |
  • 9 | {{ item.title }} 10 | {% if item.subitems %} 11 |
      12 | {% for subitem in item.subitems %} 13 |
    • 14 | {{ subitem.title }} 15 |
      • 16 | {% endfor %} 17 |
    18 | {% endif %} 19 |
    • 20 | {% endfor %} 21 |
22 |
23 | {% endfor %} 24 |
25 | -------------------------------------------------------------------------------- /docs/_layouts/default.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | HaskellR - Programming R in Haskell 8 | 9 | 10 | 11 | 12 | 13 |
14 |
15 |
16 | H/R 17 |
18 | 25 | Fork me on GitHub 26 |
27 |
28 | 29 | {{ content }} 30 | 31 |
32 |
33 | 41 |
42 | 43 | 44 | -------------------------------------------------------------------------------- /docs/_layouts/single.html: -------------------------------------------------------------------------------- 1 | --- 2 | layout: default 3 | --- 4 |
5 |

{{ page.title }}

6 | {{ content }} 7 |
8 | -------------------------------------------------------------------------------- /docs/_layouts/twocol.html: -------------------------------------------------------------------------------- 1 | --- 2 | layout: default 3 | --- 4 |
5 |

Documentation

6 |
7 |
8 |
9 |

{{ page.$title }}

10 | {{ content }} 11 |
12 |
13 |
14 |
15 |

Other resources

16 |
    17 |
  1. Library documentation on
    Stackage
    2. 18 |
  2. IFL 2014 paper:
    Project H: Programming R in Haskell
    3. 19 |
20 |
21 |
22 |
23 | {% include nav_docs.html %} 24 |
25 |
26 |
27 |
28 |
29 | -------------------------------------------------------------------------------- /docs/circle.yml: -------------------------------------------------------------------------------- 1 | general: 2 | branches: 3 | ignore: 4 | - gh-pages 5 | -------------------------------------------------------------------------------- /docs/docs/build-and-install.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: Building and installing HaskellR 3 | id: build-and-install 4 | --- 5 | 6 | *Note: if you prefer to use your system's globally installed packages 7 | and to install from Hackage, see the section below. If you run into 8 | any issues see the [support](../support.html) page.* 9 | 10 | The easiest way to get started on Linux or OS X is using 11 | [Stack][stack] and its built-in [Nix][nix] support: 12 | 13 | ~~~ 14 | $ git clone http://github.com/tweag/HaskellR 15 | $ cd HaskellR 16 | $ git tag -l # list releases 17 | $ git checkout v # skip if you want the master branch 18 | $ stack --nix build 19 | ~~~ 20 | 21 | You can make passing `--nix` to all Stack commands implicit by adding 22 | 23 | ~~~ 24 | nix: 25 | enable: true 26 | ~~~ 27 | 28 | to your `stack.yaml`. Alternatively, use Docker, which like Nix 29 | obviates the need to install any dependencies globally on your system: 30 | 31 | ~~~ 32 | $ stack --docker build 33 | ~~~ 34 | 35 | [stack]: http://haskellstack.org 36 | [nix]: http://nixos.org/nix 37 | 38 | ## Non sandboxed builds from Hackage 39 | 40 | If you'd rather use your system's globally installed packages, here 41 | are the system dependencies we rely on: 42 | 43 | * [pkg-config][pkg-config], 44 | * `R` version 3.0.2 or later (3.1 or later required for test suite). 45 | * (Optional) ZeroMQ 3.0 or later. 46 | * (Optional) Jupyter/IPython version 3.2 or later. 47 | 48 | [pkg-config]: https://www.freedesktop.org/wiki/Software/pkg-config/ 49 | 50 | **OS X users:** use Homebrew to install dependencies, e.g. 51 | 52 | ~~~ 53 | $ brew update 54 | $ brew tap homebrew/science 55 | $ brew install r zeromq 56 | $ pip install ipython # Only needed for IHaskell support 57 | ~~~ 58 | 59 | **Windows users:** Only `inline-r` and `H` are supported (no Jupyter 60 | support yet). After installing R somewhere on your system, you'll need 61 | to pass additional flags when building and installing, as in the 62 | following example: 63 | 64 | ~~~ 65 | $ stack build H --extra-lib-dirs=C:\R\bin\i386 --extra-include-dirs=C:\R\include 66 | ~~~ 67 | 68 | Once the system dependencies are installed, you can install H or the 69 | Jupyter kernel as below. 70 | 71 | ## Installing H 72 | 73 | You can launch the H interactive environment locally: 74 | 75 | ~~~ 76 | $ stack [--nix|--docker] exec H 77 | ~~~ 78 | 79 | But you can also install it user-globally to `~/.local/bin`: 80 | 81 | ~~~ 82 | $ stack build --copy-bins H 83 | ~~~ 84 | 85 | Make sure to include the installation directory in your `PATH`. On 86 | UNIX systems: 87 | 88 | ~~~ 89 | $ export PATH=~/.local/bin:$PATH 90 | ~~~ 91 | 92 | ## Installing Jupyter/IHaskell support for inline-r 93 | 94 | H is a very basic interactive environment. It is easy to install. If 95 | you would like a more featureful environment, HaskellR includes 96 | a plugin for Jupyter's [IHaskell][ihaskell] kernel. Since the latter 97 | depends on a number of system libraries that may or may not be 98 | installed using exactly the right configuration by your distribution, 99 | on Linux and OS X it is recommended to use Stack's Nix or Docker 100 | support to get reliable installs. 101 | 102 | [ihaskell]: https://github.com/gibiansky/IHaskell 103 | 104 | ~~~ 105 | $ stack [--docker|--nix] exec ihaskell install 106 | ~~~ 107 | 108 | Now, you can open a new Jupyter notebook in your browser using 109 | 110 | ~~~ 111 | $ stack [--docker|--nix] exec jupyter notebook 112 | ~~~ 113 | 114 | After launching the Jupyter notebook server you can visit 115 | 116 | ~~~ 117 | http://localhost:8888/notebooks/IHaskell/examples/tutorial-ihaskell-inline-r.ipynb 118 | ~~~ 119 | 120 | in your browser for an interactive tutorial, which is available in 121 | static form [here][tutorial]. 122 | 123 | [tutorial]: https://github.com/tweag/HaskellR/blob/master/IHaskell/examples/tutorial-ihaskell-inline-r.ipynb 124 | -------------------------------------------------------------------------------- /docs/docs/casts-and-coercions.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: Casts and coercions 3 | id: casts-and-coercions 4 | --- 5 | 6 | Type indexing `SEXP`'s makes it possible to precisely characterize the 7 | set of values that a function can accept as argument or return as 8 | a result, but this only works well when the forms of R values are 9 | known *a priori*, which is not always the case. In particular, the 10 | type of the result of a call to the `r` quasiquoter is always 11 | `SomeSEXP`, meaning that the form of the result is not statically 12 | known. If the result needs to be passed to a function with a precise 13 | signature, say `SEXP s R.Real -> SEXP s R.Logical`, one option is to 14 | discover the form of the result, by first performing pattern matching 15 | on the result before passing it to the function: 16 | 17 | ~~~ haskell 18 | f :: SEXP s R.Real -> SEXP s R.Logical 19 | 20 | g = do SomeSEXP x <- [r| 1 + 1 |] 21 | case x of 22 | (hexp -> R.Int v) -> return (f x) 23 | _ -> error "Not an int." 24 | ~~~ 25 | 26 | But pattern matching in this manner can be verbose, and sometimes the 27 | user knows more than the type checker does. In the example above, we 28 | know that `[r| 1 + 1 |]` will always return a real. We can use *casts* 29 | or *coercions* to inform the type checker of this: 30 | 31 | ~~~ haskell 32 | f :: SEXP s R.Real -> SEXP s R.Logical 33 | 34 | g = do x <- [r| 1 + 1 |] 35 | return $ f (R.SInt `R.cast` x) 36 | ~~~ 37 | 38 | A *cast* introduces a dynamic form check at runtime to verify that the 39 | form of the result was indeed of the specified type. This dynamic type 40 | check has a (very small) runtime cost. Note the type of `cast`: 41 | 42 | ~~~ haskell 43 | cast :: SSEXPTYPE a -> SomeSEXP s -> SEXP s a 44 | ~~~ 45 | 46 | `SSEXPTYPE a` is a so-called singleton [type family][ghc-manual-tf]. 47 | To each `SEXPTYPE` corresponds a `SSEXPTYPE a` and vice versa: `Int :: 48 | SEXPTYPE` has `SInt :: SSEXPTYPE Int`, `Char :: SEXPTYPE` has 49 | `SChar :: SSEXPTYPE Char`, etc. The only point of using 50 | [singleton][hackage-singletons] types here is to make the type of the 51 | result of `cast` be determined by the type of its arguments. 52 | 53 | If the user is extra sure about the form, she may use *coercions* to 54 | avoid even the dynamic check, when the situation warrants it (say in 55 | tight loops). This is done with 56 | 57 | ~~~ haskell 58 | unsafeCoerce :: SEXP s a -> SEXP s b 59 | ~~~ 60 | 61 | This function is highly unsafe - it is `inline-r`'s equivalent to 62 | Haskell's `System.IO.Unsafe.unsafeCoerce`. It is a trapdoor that can 63 | break type safety: if the form of the argument happens to not match 64 | the expected form at runtime then a segfault may result, or worse, 65 | silent memory corruption. 66 | 67 | [ghc-manual-tf]: https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/type-families.html 68 | [singletons]: http://hackage.haskell.org/package/singletons 69 | -------------------------------------------------------------------------------- /docs/docs/catching-runtime-errors.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: Catching runtime errors 3 | id: catching-runtime-errors 4 | --- 5 | 6 | Evaluating R expressions may result in runtime errors. All errors are 7 | wrapped in the `Foreign.R.Error.RError` exception that carries the 8 | error message. 9 | 10 | H> (H.printQuote [r| plot() |]) 11 | `catch` (\(H.RError msg) -> putStrLn msg) 12 | Error in xy.coords(x, y, xlabel, ylabel, log) : 13 | argument "x" is missing, with no default 14 | -------------------------------------------------------------------------------- /docs/docs/differences-repl-source.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: Differences when using H from compiled Haskell modules 3 | id: differences-repl-source 4 | --- 5 | 6 | There are two ways to use `inline-r`. The simplest is at an 7 | interactive prompt, such as H or IHaskell, for interacting with R in 8 | the small. But we support equally well writing full blown programs 9 | that interact with R in elaborate and intricate ways, possibly even 10 | multiple instances of R, using the `inline-r` library. 11 | 12 | For simplicity, at the H interactive prompt, every function in the 13 | R library is either pure or lifted to the `IO` monad. This is because 14 | the prompt itself is an instance of the `IO` monad. However, in large 15 | projects, one would like to enforce static guarantees about the 16 | R interpreter being properly initialized before attempting to invoke 17 | any of its internal functions. Hence, in `.hs` source files `inline-r` 18 | instead lifts all functions to the `R` monad, which provides stronger 19 | static guarantees than the `IO` monad. This parametricity over the 20 | underlying monad is achieved by introducing the `MonadR` class, as 21 | explained in previous sections. 22 | 23 | To avoid having multiple instances of `MonadR` lying around, it is 24 | important NOT to import `Language.R.Instance.Interactive` in compiled 25 | code - that module should only be loaded in an interactive session. 26 | 27 | ## "Hello World!" from source 28 | 29 | Another major difference between interactive sessions and compiled 30 | programs linked against `inline-r` directly is that one needs to 31 | handle R initialization and configuration explicitly in compiled 32 | programs, while `H --interactive` takes care of this for us. Here is 33 | a template small program using the `inline-r` library: 34 | 35 | ~~~ haskell 36 | {-# LANGUAGE QuasiQuotes #-} 37 | module Main where 38 | 39 | import qualified Foreign.R as R 40 | import Foreign.R (SEXP, SEXPTYPE) 41 | import Language.R.Instance as R 42 | import Language.R.QQ 43 | 44 | hello :: String -> R s () 45 | hello name = do 46 | [r| print(s_hs) |] 47 | return () 48 | where 49 | s = "Hello, " ++ name ++ "!" 50 | 51 | main :: IO () 52 | main = do 53 | putStrLn "Name?" 54 | name <- getLine 55 | R.withEmbeddedR R.defaultConfig $ R.runRegion $ hello name 56 | ~~~ 57 | -------------------------------------------------------------------------------- /docs/docs/evaluating-r-expressions.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: Evaluating R expressions in H 3 | id: evaluating-r-expressions 4 | --- 5 | 6 | At the H interactive prompt, the most convenient way to interact with 7 | R is through quasiquotation. `r` is a quasiquoter that constructs an 8 | R expression, ships it off to R and has the expression evaluated by R, 9 | yielding a value. 10 | 11 | H> [r| 1 |] 12 | 0x00007f355520ab38 13 | 14 | We do not normally manipulate R values directly, instead leaving them 15 | alone for R to manage. In Haskell, we manipulate *handles* to 16 | R values, rather than the values themselves directly. Handles have 17 | types of the form `SEXP s a`, which is actually a type synonym for 18 | a pointer type, so values of type `SEXP s a` are not terribly 19 | interesting in their own right: they are just memory addresses, as 20 | seen above. However, one can use `H.print` to ask R to show us the 21 | value pointed to by a handle: 22 | 23 | H> H.printQuote [r| 1 + 1 |] 24 | [1] 2 25 | H> H.printQuote [r| x <- 1; x + 2 |] 26 | [1] 3 27 | H> H.printQuote [r| x |] 28 | [1] 1 29 | 30 | In the following, we will loosely identify *handles to R values* and 31 | *R values*, since the distinction between the two is seldom relevant. 32 | 33 | The `r` quasiquoter hides much of the heavy lifting of building 34 | expressions ourselves, allowing us to conveniently use R syntax to 35 | denote R expressions. The next sections document some advanced uses of 36 | quasiquotes. But for now, note that `r` is not the only quasiquoter 37 | and one is free to implement [new quasiquoters][quasiquotation] if 38 | needed. One such alternative quasiquoter is `rexp`, also defined in H, 39 | which acts in much the same way as `r`, except that it returns 40 | R expressions unevaluated: 41 | 42 | H> H.printQuote [rexp| 1 + 1 |] 43 | expression(1+1) 44 | 45 | Because quasiquoters ask R itself to parse expressions, at quasiquote 46 | expansion time, H itself need not implement its own R parser. This 47 | means that the entirety of R’s syntax is supported, and that it is 48 | possible to take advantage of any future additions to the R syntax for 49 | free in H, without any extra effort. 50 | 51 | [quasiquotation]: http://dl.acm.org/citation.cfm?id=1291211 52 | 53 | In H, graphical facilities are readily available. For example: 54 | 55 | H> [r| plot(cars) |] 56 | 57 | NOTE: if you resize the graphics window, you'll notice that this 58 | window might not be repainted. In fact, the window might not even 59 | close properly. The reason for this is because since H is a thin 60 | wrapper around GHCi, and 61 | [there is currently no way](differences-repl-source.html) to mesh 62 | GHCi's read-eval-print loop with R's event loop, events must be 63 | processed manually, by calling `H.refresh` at the prompt. IHaskell 64 | does not have this limitation. 65 | -------------------------------------------------------------------------------- /docs/docs/faq.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: The HaskellR FAQ 3 | id: faq 4 | --- 5 | 6 | 7 | #### Why do I get a stack limit error when using GHCi or Jupyter and how can I fix it? 8 | 9 | R incorporates a stack usage check. This check only works reliably 10 | when run from a program's main thread. By default, GHCi evaluates all 11 | code in a worker thread as a form of isolation, rather than on the 12 | main thread. This leads to errors like the following when evaluating 13 | code in GHCi: 14 | 15 | ~~~ 16 | Error: C stack usage 140730332267004 is too close to the limit 17 | ~~~ 18 | 19 | The fix is to turn off GHCi sandboxing, by passing the 20 | `-fno-ghci-sandbox` when invoking GHCi. This forces GHCi to evaluate 21 | the code from its main thread. The H wrapper around GHCi does this for 22 | you. 23 | 24 | If you get this error in a Jupyter notebook, you can add 25 | `:set -fno-ghci-sandbox` to `~/.ihaskell/rc.hs`. If the file didn't 26 | exist previously just create it. 27 | 28 | #### Why does loading the HaskellR code itself in GHCi fail in GHC 29 | 7.10.2 or earlier? 30 | 31 | For instance, something like the following to compile `inline-r` and 32 | friends in GHCi fails: 33 | 34 | ~~~ 35 | $ stack repl 36 | ~~~ 37 | 38 | This is a known issue with GHC, tracked as 39 | [Trac ticket #10458][trac-10458]. 40 | 41 | [trac-10458]: https://ghc.haskell.org/trac/ghc/ticket/10458 42 | 43 | #### Why does stack say that R is missing or bad? 44 | 45 | Even if R is installed in a standard location, stack might fail 46 | to link it. 47 | 48 | ~~~ 49 | $ stack install 50 | inline-r> configure 51 | inline-r> Configuring inline-r-1.0.1... 52 | inline-r> Error: Cabal-simple_DY68M0FN_3.8.1.0_ghc-9.4.7: Missing dependency on a 53 | inline-r> foreign library: 54 | inline-r> * Missing (or bad) C library: R 55 | ... 56 | ~~~ 57 | 58 | In that case, it is helpful to see the actual output of the linker for diagnosing. 59 | 60 | ~~~ 61 | $ stack install --cabal-verbosity 3 62 | ~~~ 63 | 64 | You will have to look for the output corresponding to invocations of `gcc` and `ld`. 65 | Linking might fail for reasons specific to the environment in which `inline-r` is 66 | built. See for instance [#427][] or the next question about linker errors. In these 67 | cases, a workaround is to use Nix to install the system dependencies. 68 | 69 | [#427]: https://github.com/tweag/HaskellR/issues/427 70 | 71 | #### How do I fix linker errors? 72 | 73 | Most systems use the historic `ld.bfd` linker by default. However, 74 | some versions of this linker has a [bug][ld-pie-bug] preventing the 75 | linker from handling relocations properly. You might be seeing linker 76 | errors like the following: 77 | 78 | ~~~ 79 | /usr/bin/ld: .stack-work/dist/x86_64-linux/Cabal-1.18.1.5/build/IHaskell/Display/InlineR.dyn_o: relocation R_X86_64_PC32 against symbol `ihaskellzminlinezmrzm0zi1zi0zi0_IHaskellziDisplayziInlineR_rprint5_closure' can not be used when making a shared object; recompile with -fPIC 80 | /usr/bin/ld: final link failed: Bad value 81 | collect2: error: ld returned 1 exit status 82 | ~~~ 83 | 84 | The fix is to either upgrade your linker, or on some systems it might also work 85 | to switch to the gold linker. On Ubuntu, you can do this with: 86 | 87 | ~~~ 88 | # update-alternatives --install "/usr/bin/ld" "ld" "/usr/bin/ld.gold" 20 89 | # update-alternatives --install "/usr/bin/ld" "ld" "/usr/bin/ld.bfd" 10 90 | # update-alternatives --config ld 91 | ~~~ 92 | 93 | Stackage LTS Docker images use the `ld.gold` linker by default for 94 | this reason, so aren't affected by the bug. 95 | 96 | [ld-pie-bug]: https://sourceware.org/bugzilla/show_bug.cgi?id=17689 97 | 98 | #### What if I still get linker errors (e.g. on Fedora)? 99 | 100 | You may be running into https://github.com/tweag/HaskellR/issues/257. 101 | The recommended course of action is to apply one of the workarounds 102 | listed there. This is an upstream issue in Cabal. 103 | 104 | ### What if I get protection stack overflow? 105 | 106 | If you have protection stack overflow, it means that you have too 107 | many objects protected by inline-r. This happens when you write 108 | recursive functions in a single resource region. You can solve it 109 | by adding an explicit subregion, as in 110 | 111 | ~~~ 112 | function = R.runRegion $ do 113 | let xs = [1..10000000] :: [Double] 114 | Fold.foldM 115 | ( Fold.FoldM 116 | {- 1 -} (\acc _ -> io $ runRegion $ fmap (fromSEXP . R.cast R.SReal) [r| 1 |]) 117 | (return (0::Double)) 118 | return) xs 119 | ~~~ 120 | 121 | In `{- 1 -}` we are creating a nested region so all temporary values from 122 | that region will be unprotected on exit from the region. 123 | -------------------------------------------------------------------------------- /docs/docs/how-r-interpreter-is-embedded.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: How the R interpreter is embedded 3 | id: how-r-interpreter-is-embedded 4 | --- 5 | 6 | We embed an instance of the R interpreter using R's C API, documented 7 | in the [Writing R extensions][R-exts] document. R only allows at most 8 | one instance of the interpreter in any given process. Furthermore, 9 | R's C API has the following important constraints: 10 | 11 | * *it is not reentrant*, so only one thread should be accessing the 12 | R interpreter at any one time, 13 | * the R interpreter *must* be running on the program's main thread. 14 | Otherwise you'll experience weird behaviour. See the 15 | [FAQ](faq.html). 16 | 17 | [R-exts]: http://cran.r-project.org/doc/manuals/r-release/R-exts.html 18 | 19 | ### The threading model 20 | 21 | In `inline-r`, single-threaded access is all but statically 22 | guaranteed, thanks to the `R` monad. For flexibility, entering the 23 | R monad is kept separate from initialization of the R instance via 24 | `withEmbeddedR`, but `runRegion` should be called only once, near the 25 | beginning of `main`. Arbitrary `IO` actions can be lifted into the `R` 26 | monad, but not `forkIO` actions. `forkIO` forks `IO` actions, but 27 | there is no way to interact with an R interpreter from the `IO` monad 28 | if you call `runRegion` only once from the main thread. At any rate, 29 | not if you keep to the API provided by the `Language.R.*` modules. 30 | 31 | There is a backdoor if you really need it, called `unsafeRToIO`. But 32 | as its name implies, calling it is at your own risks! 33 | 34 | R insists that the interpreter should be run from the main thread. 35 | Therefore, do not call `withEmbeddedR` from any other thread than the 36 | main thread of the program. On some platforms, including OS X, 37 | violating this assumption breaks all graphical event processing. On 38 | all platforms, violating this assumption leads to strange call stack 39 | and signaling issues. 40 | 41 | The above constraint is a problem for H: GHCi insists on running the 42 | read-eval-print loop on the main thread, while R insists on running 43 | its own event processing loop in the main thread as well. Since there 44 | is no way to mesh GHCi's loop with R's event loop, we have no other 45 | option but to force the user to trigger event processing iterations 46 | explicitly. This is done by calling the `Language.R.Event.refresh` 47 | action. Other interactive interfaces may or may not have this 48 | limitation. 49 | -------------------------------------------------------------------------------- /docs/docs/implementation-of-quasiquoters.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: Implementation of quasiquoters 3 | id: implementation-of-quasiquoters 4 | --- 5 | 6 | Given an R expression, represented as a `String`, a quasiquote expands 7 | to a function whose body is the given expression, and the arguments 8 | are any antiquotations appearing in the expression. 9 | 10 | For this function to be available at runtime, we must construct it 11 | somehow. There are two possible approaches. Historically, `inline-r` 12 | parsed a quasiquotation once at compile-time, then used code 13 | generation to generate a Haskell expression that recreates the 14 | resulting AST at runtime. It is much simpler, however, to express the 15 | `SEXP` value as the result of parsing a string constructed at compile 16 | time. Parsing the function expression is delegated to R at runtime. 17 | Parsing the same expression over and over during runtime can be 18 | onerous when in the middle of a tight loop. But since parsing is 19 | morally a pure function, we can wrap the call to R's `parse()` 20 | function `unsafePerformIO` to make it eligible for let-floating. If 21 | the `parse()` call is floated all the way to the top, then computing 22 | its value will be shared for the lifetime of the program. 23 | 24 | For example, `[r| 1 + 1 |]` expands to something morally equivalent 25 | to the following: 26 | 27 | ~~~ haskell 28 | let sx = unsafePerformIO (parse "function(){ 1 + 1 }") 29 | in eval (apply sx []) 30 | ~~~ 31 | 32 | Use the `-ddump-simpl` GHC option to see what a quasiquotation truly 33 | expands to. 34 | -------------------------------------------------------------------------------- /docs/docs/index.md: -------------------------------------------------------------------------------- 1 | --- 2 | layout: twocol 3 | --- 4 | 5 | Start [here](build-and-install.html). 6 | -------------------------------------------------------------------------------- /docs/docs/inline-r-with-IHaskell.md: -------------------------------------------------------------------------------- 1 | --- 2 | id: inline-r-with-IHaskell 3 | title: Using inline-r with IHaskell 4 | --- 5 | 6 | HaskellR features integration with [Jupyter](https://jupyter.org/) and 7 | the [IHaskell][ihaskell] kernel for interactively authoring notebooks 8 | replete with plots, formulas, R code and Haskell code. 9 | 10 | See "Building and installing" to get started and the 11 | [tutorial notebook](https://github.com/tweag/HaskellR/blob/master/IHaskell/examples/tutorial-ihaskell-inline-r.ipynb) 12 | in the repository for a walkthrough. 13 | 14 | [ihaskell]: https://github.com/gibiansky/IHaskell 15 | -------------------------------------------------------------------------------- /docs/docs/internals-introduction.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: Introduction 3 | id: internals-introduction 4 | --- 5 | 6 | This is a guide to the internal structures and inner workings of H, 7 | documenting the design rationale and possible variations. 8 | -------------------------------------------------------------------------------- /docs/docs/managing-memory.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: Managing memory 3 | id: managing-memory 4 | --- 5 | 6 | One tricky aspect of bridging two languages with automatic memory 7 | management such as R and Haskell is that we must be careful that the 8 | garbage collectors (GC) of both languages see eye-to-eye. The embedded 9 | R instance manages objects in its own heap, separate from the heap 10 | that the GHC runtime manages. However, objects from one heap can 11 | reference objects in the other heap and the other way around. This can 12 | make garbage collection unsafe because neither GC's have a global view 13 | of the object graph, only a partial view corresponding to the objects 14 | in the heaps of each GC. 15 | 16 | Memory protection 17 | ----------------- 18 | 19 | Fortunately, R provides a mechanism to "protect" objects from garbage 20 | collection until they are unprotected. We can use this mechanism to 21 | prevent R's GC from deallocating objects that are still referenced by 22 | at least one object in the Haskell heap. 23 | 24 | One particular difficulty with protection is that one must not forget 25 | to unprotect objects that have been protected, in order to avoid 26 | memory leaks. `inline-r` uses "regions" for pinning an object in 27 | memory and guaranteeing unprotection when the control flow exits 28 | a region. 29 | 30 | Memory regions 31 | -------------- 32 | 33 | There is currently one global region for R values, but in the future 34 | `inline-r` will have support for multiple (nested) regions. A region 35 | is opened with the `runRegion` action, which creates a new region and 36 | executes the given action in the scope of that region. All allocation 37 | of R values during the course of the execution of the given action 38 | will happen within this new region. All such values will remain 39 | protected (i.e. pinned in memory) within the region. Once the action 40 | returns, all allocated R values are marked as deallocatable garbage 41 | all at once. 42 | 43 | ~~~ haskell 44 | runRegion :: (forall s . R s a) -> IO a 45 | ~~~ 46 | 47 | Automatic memory management 48 | --------------------------- 49 | 50 | Nested regions work well as a memory management discipline for simple 51 | scenarios when the lifetime of an object can easily be made to fit 52 | within nested scopes. For more complex scenarios, it is often much 53 | easier to let memory be managed completely automatically, though at 54 | the cost of some memory overhead and performance penalty. `inline-r` 55 | provides a mechanism to attach finalizers to R values. This mechanism 56 | piggybacks Haskell's GC to notify R's GC when it is safe to deallocate 57 | a value. 58 | 59 | ~~~ haskell 60 | automatic :: MonadR m => R.SEXP s a -> m (R.SEXP G a) 61 | ~~~ 62 | 63 | In this way, values may be deallocated far earlier than reaching the 64 | end of a region: As soon as Haskell's GC recognizes a value to no 65 | longer be reachable, and if the R GC agrees, the value is prone to be 66 | deallocated. Because automatic values have a lifetime independent of 67 | the scope of the current region, they are tagged with the global 68 | region `G` (a type synonym for `GlobalRegion`). 69 | 70 | For example: 71 | 72 | ~~~ haskell 73 | do x <- [r| 1:1000 |] 74 | y <- [r| 2 |] 75 | return $ automatic [r| x_hs * y_hs |] 76 | ~~~ 77 | 78 | Automatic values can be mixed freely with other values. 79 | 80 | Diagnosing memory problems 81 | -------------------------- 82 | 83 | A good way to stress test whether R values are being protected 84 | adequately is to turn on `gctorture`: 85 | 86 | ~~~ haskell 87 | main = withEmbeddedR $ do 88 | [r| gctorture2(1, 0, TRUE) |] 89 | ... 90 | ~~~ 91 | 92 | This instructs R to run a GC sweep at every allocation, hence making 93 | it much more likely to detect inadequately protected objects. It is 94 | recommended to use a version of R that has been compiled with 95 | `--enable-strict-barrier`. 96 | 97 | See the Haddock generated documentation for the `Language.R.GC` module 98 | for further details, and the R documentation for `gctorture()`. 99 | -------------------------------------------------------------------------------- /docs/docs/r-monad.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: The R monad 3 | id: r-monad 4 | --- 5 | 6 | All expressions like 7 | 8 | ~~~ 9 | [r| ... |] :: MonadR m => m (SEXP s b) 10 | H.print sexp :: MonadR m => m () 11 | H.eval sexp :: MonadR m => m (SEXP s b) 12 | ~~~ 13 | 14 | are computations in a monad instantiating `MonadR`. 15 | 16 | ~~~ haskell 17 | class (Applicative m, MonadIO m) => MonadR m where 18 | io :: IO a -> m a 19 | ~~~ 20 | 21 | These monads ensure that: 22 | 23 | 1. the R interpreter is initialized; 24 | 1. resources managed by the R interpreter do not extrude its 25 | lifetime; 26 | 1. constraints concerning on which system thread the R interpreter 27 | can run are respected. 28 | 29 | There are two instances of `MonadR`: `IO` and `R`. Which instance one 30 | uses depends on the context: the `IO` monad in an interactive session, 31 | the `R` monad in compiled code. 32 | 33 | Interactive frontends such as H and IHaskell bring the `IO` instance 34 | into scope. In source files, you should not use this instance and 35 | instead use the `R` monad, for better static guarantees. Functions are 36 | provided in the `Language.R.Instance` module to initialize R and to 37 | run `R` computations in the `IO` monad: 38 | 39 | ~~~ haskell 40 | withEmbeddedR :: Config -> IO a -> IO a 41 | runRegion :: (forall s . R s a) -> IO a 42 | io :: IO a -> R s a 43 | unsafeRToIO :: R s a -> IO a 44 | ~~~ 45 | 46 | The `IO` monad is used in interactive sessions as a mere convenience. 47 | It allows evaluating expressions without the need to wrap every 48 | command at the prompt with a function to run the `R` monad. The `IO` 49 | monad is in theory not as safe as the `R` monad, because it does not 50 | statically guarantee that R has been properly initialized, but in the 51 | context of an interactive session this is superfluous as the 52 | `H --interactive` command takes care of initialization at startup. 53 | -------------------------------------------------------------------------------- /docs/docs/r-values-and-side-effects.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: R values and side effects 3 | id: r-values-and-side-effects 4 | --- 5 | 6 | As explained previously, values of type `SEXP s a` are in fact pointers 7 | to structures stored on the R heap, an area of memory managed by the 8 | R interpreter. As such, one must take heed of the following two 9 | observations when using a pure function such as `hexp` to dereference 10 | such pointers. 11 | 12 | First, just like regular Haskell values are allocated on the GHC heap 13 | and managed by the GHC runtime, values pointed to by `SEXP`'s are 14 | allocated on the R heap, managed by the R runtime. Therefore, the 15 | lifetime of a SEXP value cannot extrude the lifetime of the R runtime 16 | itself, just as any Haskell value becomes garbage once the GHC runtime 17 | is terminated. That is, never invoke `hexp` on a value outside of the 18 | dynamic scope of `runR`. This isn't a problem in practice, because 19 | `runR` should be invoked only once, in the `main` function of the 20 | program`, just as the GHC runtime is initialized and terminated only 21 | once, at the entry point of the binary (i.e., C's main() function). 22 | 23 | The second observation is that the `hexp` view function does pointer 24 | dereferencing, which is a side-effect, yet it claims to be a pure 25 | function. The pointer that is being dereferenced is the argument to 26 | the function, of type `SEXP s a`. The reason dereferencing a pointer is 27 | considered an effect is because its value depends on the state of the 28 | global memory at the time when it occurs. This is because a pointer 29 | identifies a memory location, called a *cell*, whose content can be 30 | mutated. 31 | 32 | Why then, does `hexp` claim to be pure? The reason is that `inline-r` 33 | assumes and encourages a restricted mode of use of R that rules out 34 | mutation of the content of any cell. In the absence of mutation, 35 | dereferencing a pointer will always yield the same value, so no longer 36 | needs to be classified as an effect. The restricted mode of use in 37 | question bans any use of side-effects that break referential 38 | transparency. So-called *benign* side-effects, extremely common in R, 39 | do not compromise referential transparency and so are allowed. 40 | 41 | Is such an assumption reasonable? After all, many R functions use 42 | mutation and other side effects internally. However, it is also the 43 | case that R uses *value semantics*, not *reference semantics*. That 44 | is, including when passing arguments to functions, variables are 45 | always bound to values, not to references to those values. Therefore, 46 | given *e.g.* a global binding `x <- c(1, 2, 3)`, no call to any 47 | function `f(x)` will alter the *value* of x, because all side-effects 48 | of functions act on *copies* of `x` (the formal parameter of the 49 | function doesn't share a reference). For example: 50 | 51 | ~~~ r 52 | > x <- c(1,2,3) 53 | > f <- function(y) y[1] <- 42 54 | > f(x) 55 | > x 56 | [1] 1 2 3 57 | ~~~ 58 | 59 | Furthermore, in R, closures capture copies of their environment, so 60 | that even the following preserves the value of `x`: 61 | 62 | ~~~ r 63 | > x <- c(1,2,3) 64 | > f <- function() x[1] <- 42 65 | > f() 66 | > x 67 | [1] 1 2 3 68 | ~~~ 69 | 70 | The upshot is that due to its value semantics, R effectively limits 71 | the scope of any mutation effects to the lexical scope of the 72 | function. Therefore, any function whose only side-effect is mutation 73 | is safe to call from a pure context. 74 | 75 | Conversely, evaluating any `SEXP` in a pure context in Haskell is 76 | *unsafe* in the presence of mutation of the global environment. For 77 | example, 78 | 79 | ~~~ haskell 80 | f :: SEXP s a -> (R s SomeSEXP,HExp a) 81 | f x = let h = hexp x 82 | in ([r| x_hs <- 'hello' |], h) 83 | ~~~ 84 | 85 | The value of the expression `snd (f x)` depends on whether it is evaluated 86 | before or after evaluating the monadic computation `fst (f x)`. 87 | 88 | *Note:* `inline-r` merely encourages, but has of course no way of 89 | *enforcing* a principled use of R that keeps to benign side-effects, 90 | because owing to the dynamic typing of R code, there is no precise 91 | static analysis that can detect bad side-effects. 92 | -------------------------------------------------------------------------------- /docs/docs/splicing-haskell-values-in-r.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: Splicing Haskell values in R 3 | id: splicing-haskell-values-in-r 4 | --- 5 | 6 | Haskell values can be used in R code given to quasiquoters. When 7 | a Haskell value is bound to a name in the lexical scope surrounding 8 | a quasi-quote, the quasi-quote may suffix the name with `_hs` in order 9 | to splice the Haskell value. 10 | 11 | H> let x = 2 :: Double 12 | H> p [r| x_hs + x_hs |] 13 | [1] 4 14 | 15 | H> let f x = return (x + 1) :: R s Double 16 | H> p [r| f_hs(1) |] 17 | [1] 2 18 | 19 | H> x <- [r| 1 + 1 |] 20 | H> p [r| 1 + x_hs |] 21 | [1] 3 22 | 23 | ## Defining spliceable types 24 | 25 | Not all values can be spliced --- only values of certain types. The 26 | set of spliceable types is not fixed and new types can be added as 27 | needed. To splice a value, its type needs to be an instance of the 28 | `H.Literal` class which defines conversion functions between Haskell 29 | and R values. 30 | 31 | ~~~ haskell 32 | class Literal a b | a -> b where 33 | mkSEXP :: a -> SEXP s b 34 | fromSEXP :: SEXP s c -> a 35 | ~~~ 36 | 37 | See the [Haddock API documentation][stackage-inline-r] of the 38 | `Language.R.Literal` for a list of predefined instances. 39 | 40 | `mkSEXP` and `fromSEXP` can be defined so that either the values on 41 | both sides share memory or the data is copied. When memory is shared, 42 | special care is needed to prevent garbage collection on either Haskell 43 | or R sides to invalidate values pointed by the other side. See 44 | [Managing memory](managing-memory.html). 45 | 46 | Note that as a general rule, in `inline-r` we avoid any conversion to 47 | and from R values. The reason is that such conversions have runtime 48 | costs, thus incurring a performance overhead when interoperating with 49 | R. The `Literal` type class is only a convenience for expressing 50 | R values using Haskell literals. Contrary to arbitrary values, 51 | literals are typically small, and some of the conversion work can be 52 | inlined and executed at compile time, ahead of runtime. 53 | 54 | [stackage-inline-r]: http://www.stackage.org/package/inline-r 55 | -------------------------------------------------------------------------------- /docs/docs/using-h.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: Using H 3 | id: using-h 4 | --- 5 | 6 | H is an interactive environment, built on top of a library called 7 | `inline-r`. The library can be used from Haskell source files, while 8 | H is implemented as a thin wrapper around GHCi. The H command is 9 | a wrapper script that fires up a GHCi session set up just the right 10 | way for interacting with R. 11 | 12 | Setting up H 13 | ------------ 14 | 15 | In Windows, make sure the file `R.dll` appears in some folder listed 16 | in the `PATH` environment variable. In Unix-like systems, `libR.so` 17 | should be located within reach of the dynamic linker 18 | (`LD_LIBRARY_PATH`, `/etc/ld.so.conf`, etc). 19 | 20 | After [installing](build-and-install.html) H, type the following at 21 | a command prompt: 22 | 23 | $ H 24 | 25 | This will start GHCi, loading the H environment and bringing the 26 | relevant definitions into scope. In addition, an instance of the 27 | R interpreter will be started. 28 | 29 | Alternatively, one can also try: 30 | 31 | $ ghci -ghci-script H.ghci 32 | 33 | where `H.ghci` is included in the 34 | [source distribution](http://hackage.haskell.org/package/H) for H. 35 | (NB: for security reasons, you must ensure that `H.ghci` is not world 36 | writeable.) 37 | 38 | On Windows, both H and GHCi work best from the `cmd.exe` terminal, as 39 | opposed to MinGW (both ought work, but MinGW currently triggers bug 40 | [#7056](https://ghc.haskell.org/trac/ghc/ticket/7056) in GHC). 41 | 42 | An H primer 43 | ----------- 44 | 45 | In an H interactive session, one has full access to both Haskell, 46 | 47 | H> 1 + 1 48 | 2 49 | H> let it = [1, 2, 3] ++ [4, 5, 6] 50 | H> print it 51 | [1, 2, 3, 4, 5, 6] 52 | 53 | and R, through a mechanism called *quasiquotation* (see the 54 | [Haskel Wiki](https://wiki.haskell.org/Quasiquotation) for more about 55 | quasiquotation), 56 | 57 | H> it <- [r| 1 + 1 |] 58 | H> printR it 59 | [1] 2 60 | H> it <- [r| append(c(1, 2, 3), c(4, 5, 6)) |] 61 | H> printR it 62 | [1] 1 2 3 4 5 6 63 | H> p [r| R.home() |] 64 | [1] "/usr/lib/R" 65 | 66 | One can mix and match both Haskell and R code, which is delimited from 67 | Haskell code using annotated "Oxford brackets" - anything in between 68 | `[r|` and `|]`. The text between the brackets is said to be 69 | *quasiquoted*. It is first fed to R to be parsed, then evaluated. 70 | Printing the resulting value can be done with the help of 71 | `[r| print(...) |]` or `p`. We have that 72 | 73 | p mx = do { x <- mx; [r| print(x_hs) |] } 74 | 75 | Expressions are evaluated in their own local R environment, which 76 | inherits from the global environment. So assignments aren't visible 77 | from one quasiquote to another. But you can use the "super-assignment" 78 | `<<-` operator if you really need to: 79 | 80 | H> p [r| x <<- 1 |] 81 | [1] 1 82 | H> p [r| x |] 83 | [1] 1 84 | H> p [r| x <<- 2 |] 85 | [1] 2 86 | H> p [r| x |] 87 | [1] 2 88 | H> p [r| x <- 3 |] 89 | [1] 3 90 | H> p [r| x |] 91 | [1] 2 92 | 93 | Quasiquotes can refer to any values bound in the GHCi environment that 94 | are in scope, through *splicing*. In order to distinguish between 95 | variables bound in the R environment and those bound in the GHCi 96 | environment, H uses the following convention: 97 | 98 | > Haskell values are referred to within an R quasiquote by appending 99 | > `_hs` to its name. 100 | 101 | For example: 102 | 103 | H> let x = 2 :: Double 104 | H> let y = 4 :: Double 105 | H> p [r| x_hs + y_hs |] 106 | [1] 6 107 | 108 | Only variables of certain types can be *spliced* in quasiquotes in 109 | this way. H currently supports atomic numeric types such as doubles, 110 | lists over these numeric types, but also functions over these types: 111 | 112 | H> let f x = return (x + 1) :: R s Double 113 | H> p [r| f_hs(1) |] 114 | [1] 2 115 | 116 | Currently, functions must be lifted to the `R` monad in order to be 117 | spliceable. The `R` monad is a type constructor taking two parameters: 118 | the first one is always `s` and refers to the state of the monad, 119 | while the second one is the type of the result of the function when 120 | executed. 121 | 122 | Running examples 123 | ---------------- 124 | 125 | Some interactive examples of using H are located in the folders: 126 | 127 | * `examples/nls` 128 | * `examples/nls2` 129 | 130 | The following commands can be used to run these examples: 131 | 132 | $ cd examples/ 133 | $ H -- -ghci-script .H 134 | -------------------------------------------------------------------------------- /docs/docs/vectors.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: Vectors 3 | id: vectors 4 | --- 5 | 6 | Most data items in R are vectors, e.g. integers, reals, characters, 7 | etc. `inline-r` supports constructing and manipulating R vectors 8 | entirely in Haskell, without invoking the R interpreter, and using the 9 | same API as the de facto standard 10 | [vector](http://hackage.haskell.org/package/vector) package. 11 | Conversely, any data that is stored as an R vector rather than some 12 | other vector type can be fed to R functions without any prior 13 | conversion or copying. Considering that the memory layout of an 14 | R vector is practically as efficient as any other unboxed 15 | representation, programs that interact with the R interpreter 16 | frequently should consider using R vectors as a representation by 17 | default. 18 | 19 | Please refer to the Haddock generated documentation of the 20 | `Data.Vector.SEXP` and `Data.Vector.SEXP.Mutable` modules for a full 21 | reference on the vector API supported by `inline-r`. 22 | 23 | -------------------------------------------------------------------------------- /docs/downloads.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: Downloads 3 | layout: single 4 | id: downloads 5 | --- 6 | 7 | ## Build from source 8 | 9 | All sources are available on [Hackage](https://hackage.haskell.org). 10 | See the ["Getting started"](docs/build-and-install.html) section of 11 | the Documentation for how to build a release. 12 | 13 | ## Development 14 | 15 | See the README file on the 16 | [Github repository page](https://github.com/tweag/HaskellR). 17 | -------------------------------------------------------------------------------- /docs/img/cluster-1-thumb.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tweag/HaskellR/a531954bf3b5d340a06674b8a289e6cfc4ddf46e/docs/img/cluster-1-thumb.png -------------------------------------------------------------------------------- /docs/img/cluster-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tweag/HaskellR/a531954bf3b5d340a06674b8a289e6cfc4ddf46e/docs/img/cluster-1.png -------------------------------------------------------------------------------- /docs/img/expVsrec-thumb.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tweag/HaskellR/a531954bf3b5d340a06674b8a289e6cfc4ddf46e/docs/img/expVsrec-thumb.png -------------------------------------------------------------------------------- /docs/img/expVsrec.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tweag/HaskellR/a531954bf3b5d340a06674b8a289e6cfc4ddf46e/docs/img/expVsrec.png -------------------------------------------------------------------------------- /docs/img/notebook-1-thumb.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tweag/HaskellR/a531954bf3b5d340a06674b8a289e6cfc4ddf46e/docs/img/notebook-1-thumb.png -------------------------------------------------------------------------------- /docs/img/notebook-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tweag/HaskellR/a531954bf3b5d340a06674b8a289e6cfc4ddf46e/docs/img/notebook-1.png -------------------------------------------------------------------------------- /docs/shell.nix: -------------------------------------------------------------------------------- 1 | with (import ../nixpkgs.nix { }); 2 | 3 | stdenv.mkDerivation rec { 4 | name = "HaskellR-site"; 5 | 6 | buildInputs = [ (bundlerEnv { 7 | name = "HaskellR-site-bundler"; 8 | gemfile = ./Gemfile; 9 | lockfile = ./Gemfile.lock; 10 | gemset = ./gemset.nix; 11 | }) jekyll nodejs ]; 12 | } 13 | -------------------------------------------------------------------------------- /docs/support.md: -------------------------------------------------------------------------------- 1 | --- 2 | layout: single 3 | --- 4 | 5 | ## Need help? 6 | 7 | There are multiple support channels available in case you need help. 8 | 9 | * Common issues are covered by the [FAQ](docs/faq.html). 10 | * For general questions, comments, feedback and community support 11 | please write a message to the 12 | [HaskellR mailing list](https://groups.google.com/group/haskellr). 13 | * If you spot a bug, typo or have feature requests please 14 | [open an issue](https://github.com/tweag/HaskellR/issues/new). 15 | * [Tweag I/O](http://tweag.io) provides professional support, see 16 | [below](#professional-support). 17 | 18 | [Stack Overflow](http://stackoverflow.com/questions/tagged/haskell) 19 | and the `#haskell` IRC channel on Freenode are good resources for 20 | asking questions and finding answers regarding Haskell. 21 | 22 | R, like Haskell, is an open source project with a vibrant user 23 | community. The best resources to get started are the 24 | [official R manuals](http://cran.r-project.org/manuals.html). If 25 | you're stuck, the community also has 26 | [several mailing lists](http://www.r-project.org/mail.html) and 27 | [extensive user contributed documentation](http://cran.r-project.org/other-docs.html). 28 | 29 | ## Professional support 30 | 31 | [Tweag I/O](http://tweag.io) provides professional support for H, 32 | inline-r and related packages of the HaskellR project. This provides 33 | you with direct access to the people who created it. Say 34 | [hello@tweag.io](mailto:hello@tweag.io) for enquiries about how we can 35 | assist you or for customized features. 36 | -------------------------------------------------------------------------------- /etc/Dockerfile: -------------------------------------------------------------------------------- 1 | FROM fpco/stack-build:lts-15 2 | MAINTAINER Mathieu Boespflug 3 | 4 | # Install system dependencies. 5 | RUN apt-add-repository ppa:marutter/rrutter \ 6 | && apt-get update \ 7 | && apt-get install -y --no-install-recommends \ 8 | libzmq3-dev \ 9 | python-dev \ 10 | python-pip \ 11 | r-base \ 12 | r-base-dev \ 13 | r-cran-ggplot2 \ 14 | && rm -rf /var/lib/apt/lists/* 15 | 16 | # Pin version for repeatability. 17 | RUN pip install 'ipython[all]==3.2.1' 18 | -------------------------------------------------------------------------------- /examples/HaskellR-examples.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.2 2 | name: HaskellR-examples 3 | version: 0.1.0.0 4 | license: BSD-3-Clause 5 | license-file: LICENSE 6 | copyright: Copyright (c) 2013-2015 Amgen, Inc. 7 | Copyright (c) 2015 Tweag I/O Limited. 8 | build-type: Simple 9 | Category: FFI 10 | Synopsis: Examples bundled with the HaskellR project 11 | description: This package is part of the HaskellR project. 12 | extra-source-files: 13 | nls/nls.H 14 | nls2/nls2.H 15 | 16 | source-repository head 17 | type: git 18 | location: git://github.com/tweag/HaskellR.git 19 | subdir: examples 20 | 21 | common common-config 22 | default-language: Haskell2010 23 | ghc-options: -Wall -threaded 24 | 25 | common common-deps 26 | build-depends: 27 | inline-r, 28 | base >= 4.6 && < 5, 29 | 30 | executable fft 31 | import: 32 | common-config, 33 | common-deps, 34 | main-is: Main.hs 35 | hs-source-dirs: fft 36 | 37 | executable fib 38 | import: 39 | common-config, 40 | common-deps, 41 | main-is: Main.hs 42 | hs-source-dirs: fib 43 | other-modules: Fib 44 | 45 | executable nls 46 | import: 47 | common-config, 48 | common-deps, 49 | main-is: Main.hs 50 | hs-source-dirs: nls 51 | build-depends: 52 | mwc-random >= 0.12 && <0.16, 53 | 54 | executable nls2 55 | import: 56 | common-config, 57 | common-deps, 58 | main-is: Main.hs 59 | hs-source-dirs: nls2 60 | build-depends: 61 | mwc-random >= 0.12 && <0.16, 62 | 63 | executable RelaxWithNM 64 | import: 65 | common-config, 66 | common-deps, 67 | main-is: RelaxWithNM.hs 68 | build-depends: 69 | deepseq >=1.4.4.0 && <1.6, 70 | integration >=0.2.1 && <0.3, 71 | temporary >= 1.2.0.3 && <1.4, 72 | -------------------------------------------------------------------------------- /examples/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013-2015 Amgen, Inc. 2 | Copyright (c) 2015 Tweag I/O Limited. 3 | 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions 8 | are met: 9 | 1. Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 2. Redistributions in binary form must reproduce the above copyright 12 | notice, this list of conditions and the following disclaimer in the 13 | documentation and/or other materials provided with the distribution. 14 | 3. The names of the author may not be used to endorse or promote 15 | products derived from this software without specific prior written 16 | permission. 17 | 18 | THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND 19 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 20 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 21 | ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE 22 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 23 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 24 | OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 25 | HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 26 | LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 27 | OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 28 | SUCH DAMAGE. 29 | -------------------------------------------------------------------------------- /examples/fft/Main.hs: -------------------------------------------------------------------------------- 1 | -- | Example originally inspired by 2 | -- . 3 | 4 | {-# LANGUAGE GADTs #-} 5 | {-# LANGUAGE QuasiQuotes #-} 6 | {-# LANGUAGE ScopedTypeVariables #-} 7 | {-# LANGUAGE ViewPatterns #-} 8 | 9 | module Main where 10 | 11 | import Data.Complex 12 | import qualified Language.R as R 13 | import Language.R (R) 14 | import Language.R.QQ 15 | 16 | -- Call R's FFT 17 | r_fft :: [Complex Double] -> R s [Complex Double] 18 | r_fft nums = do 19 | R.dynSEXP <$> [r| fft(nums_hs) |] 20 | 21 | main :: IO () 22 | main = R.withEmbeddedR R.defaultConfig $ do 23 | result <- R.runRegion $ r_fft [1,2,1] 24 | print result 25 | -------------------------------------------------------------------------------- /examples/fib/Fib.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE QuasiQuotes #-} 3 | {-# LANGUAGE ScopedTypeVariables #-} 4 | {-# LANGUAGE ViewPatterns #-} 5 | 6 | module Fib 7 | ( neg 8 | , fib 9 | , fact 10 | , factSexp 11 | ) where 12 | 13 | import H.Prelude as H 14 | import Foreign.R.Type as R 15 | import qualified Foreign.R as R 16 | import Data.Int (Int32) 17 | import Control.Applicative 18 | import Prelude -- Silence AMP warning 19 | 20 | neg :: SEXP s 'R.Logical 21 | -> SEXP s 'R.Int 22 | -> R s (R.SomeSEXP s) 23 | neg (fromSEXP -> R.TRUE) (fromSEXP -> n :: Int32) = [r| n_hs |] 24 | neg (fromSEXP -> R.FALSE) (fromSEXP -> n :: Int32) = [r| -n_hs |] 25 | neg (fromSEXP -> R.NA) (fromSEXP -> _ :: Int32) = [r| NA |] 26 | neg _ _ = error "Impossible." 27 | 28 | fib :: SEXP s 'R.Int -> R s (R.SomeSEXP s) 29 | fib (fromSEXP -> 1 :: Int32) = R.SomeSEXP <$> mkSEXP (1 :: Int32) 30 | fib (fromSEXP -> 2 :: Int32) = R.SomeSEXP <$> mkSEXP (1 :: Int32) 31 | fib (fromSEXP -> n :: Int32) = [r| fib_hs(n_hs - 1L) + fib_hs(n_hs - 2L) |] 32 | 33 | fact :: Int32 -> R s Int32 34 | fact 0 = return 1 35 | fact n = fmap (H.fromSEXP . R.cast R.SInt) [r| n_hs * fact_hs(n_hs - 1L) |] 36 | 37 | factSexp :: SEXP s 'R.Int -> R s (SEXP s 'R.Int) 38 | factSexp (fromSEXP -> 0 :: Int32) = mkSEXP (1::Int32) 39 | factSexp (fromSEXP -> n :: Int32) = fmap (H.fromSEXP.R.cast R.SInt) [r| n_hs * fact_hs(n_hs - 1L) |] 40 | -------------------------------------------------------------------------------- /examples/fib/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE QuasiQuotes #-} 2 | module Main where 3 | 4 | import Fib 5 | 6 | import qualified H.Prelude as H 7 | import Language.R.QQ 8 | 9 | main :: IO () 10 | main = H.withEmbeddedR H.defaultConfig $ H.runRegion $ do 11 | let p x = [r| print(x_hs) |] >> return () 12 | p =<< [r| "test" |] 13 | p =<< [r| 1+2 |] 14 | H.io $ putStrLn "[r| neg_hs(TRUE, 5L) |]" 15 | p =<< [r| neg_hs(TRUE, 5L) |] 16 | H.io $ putStrLn "[r| neg_hs(FALSE, 6L) |]" 17 | p =<< [r| neg_hs(FALSE, 6L) |] 18 | H.io $ putStrLn "[r| neg_hs(NA, 7L) |]" 19 | p =<< [r| neg_hs(NA, 7L) |] 20 | H.io $ putStrLn "[r| fib_hs(1L) |]" 21 | p =<< [r| fib_hs(1L) |] 22 | H.io $ putStrLn "[r| fib_hs(10L) |]" 23 | p =<< [r| fib_hs(10L) |] 24 | H.io $ putStrLn "[r| fact_hs(0L) |]" 25 | p =<< [r| fact_hs(0L) |] 26 | H.io $ putStrLn "[r| fact_hs(7L) |]" 27 | p =<< [r| fact_hs(7L) |] 28 | H.io $ putStrLn "[r| factSexp_hs(7L) |]" 29 | p =<< [r| factSexp_hs(7L) |] 30 | -------------------------------------------------------------------------------- /examples/nls/Main.hs: -------------------------------------------------------------------------------- 1 | -- | Dummy module intended to inform the user how this example should 2 | -- be run. 3 | module Main where 4 | 5 | import System.Exit (exitFailure) 6 | 7 | main :: IO () 8 | main = do 9 | putStrLn $ concat [ "This example is intended to be executed by feeding" 10 | , " the script into the H interpretter, e.g." 11 | , " 'H -- -ghci-script nls.hs'" 12 | ] 13 | exitFailure 14 | -------------------------------------------------------------------------------- /examples/nls/nls.H: -------------------------------------------------------------------------------- 1 | -- Initializing R runtime and all constants 2 | -- Copyright: (C) 2013 Amgen, Inc. 3 | :m +Control.Monad 4 | :set -XQuasiQuotes 5 | :load system.hs 6 | let next = putStrLn "" >> void (getLine) 7 | :{ 8 | putStrLn $ 9 | unlines [ "In this demo we will run H using haskell callbacks" 10 | , "and discuss some issues with current implementation" 11 | , "and possibilities." 12 | , "" 13 | , "Files that are used:" 14 | , " * nls.H - file with script itself" 15 | , " * .ghci - ghci config file, will be integrated soon" 16 | , " * system.hs - haskell module that is used in callbacks" 17 | , "" 18 | , "How to run this example:" 19 | , " H -- -ghci-script H/H.ghci -ghci-script nls.H" 20 | , "You will need mwc-random package to be installed" 21 | ] 22 | :} 23 | next 24 | :{ 25 | putStrLn $ 26 | unlines [ "Prelare points in R:" 27 | , "We are creating 'xs' points with R command [r| xs <- c(1:100) |]" 28 | , " [r| ... |] creates expression and evaluates it" 29 | , "" 30 | , "To evaluate command you may use one of the following functions:" 31 | , " H.evalIO - strictly evaluates expression in IO Monad" 32 | , " H.eval_ - evaluate expression in IO Monad discarding result" 33 | , " (no output will be printed)" 34 | , " H.eval - pure lazy evaluation of the expression." 35 | , "" 36 | , "To print result one may use R facilities: " 37 | , " printR - prints expression like R does" 38 | , "" 39 | , "Thus we are calling: H.print [r| xs <<- c(1:100) |]" 40 | ] 41 | :} 42 | next 43 | putStrLn "printValue $ eval [r| xs <<- c(1:100) |] - result" 44 | printR =<< [r| xs <<- c(1:100) |] 45 | next 46 | :{ 47 | putStrLn $ 48 | unlines [ "Now for each point we want to calculate complicated function" 49 | , "of cause if example we will use simple example" 50 | , "But we wil use separate file for it" 51 | , "We are generating function x^2+2*x+5 with some random noise" 52 | , "with standart distribution (using mwc-random package)." 53 | ] 54 | :} 55 | next 56 | :{ 57 | putStrLn $ 58 | unlines [ "Now we want to use that function in R:" 59 | , "in order to use function we need to lift it on vector level" 60 | ] 61 | :} 62 | putStrLn "[r| ys <<- generate_lifted_hs(xs) |]" 63 | printR =<< [r| ys <<- generate_lifted_hs(xs) |] 64 | next 65 | putStrLn "[r| nlmod <<- nls( ys~a*xs*xs+b*xs+c, start=list( a = 0.13, b = 1.5, c = 0.4)) |]" 66 | printR =<< [r| nlmod <<- nls( ys~a*xs*xs+b*xs+c, start=list( a = 0.13, b = 1.5, c = 0.4)) |] 67 | next 68 | [r| plot(xs,ys,main="nls") |] 69 | [r| lines(xs,predict(nlmod), col = 2)|] 70 | getLine 71 | -------------------------------------------------------------------------------- /examples/nls/system.hs: -------------------------------------------------------------------------------- 1 | import H.Prelude 2 | import Data.Int 3 | import System.Random.MWC 4 | import System.Random.MWC.Distributions 5 | 6 | generate :: Int32 -> R s Double 7 | generate x = io $ 8 | withSystemRandom . asGenIO $ \gen -> 9 | let r = dx*dx+2*dx 10 | in do v <- standard gen 11 | return $ r*(1+0.05*v) 12 | where dx = fromIntegral x 13 | 14 | generate_lifted :: [Int32] -> R s [Double] 15 | generate_lifted = mapM generate 16 | -------------------------------------------------------------------------------- /examples/nls2/Main.hs: -------------------------------------------------------------------------------- 1 | -- | Dummy module intended to inform the user how this example should 2 | -- be run. 3 | module Main where 4 | 5 | import System.Exit (exitFailure) 6 | 7 | main :: IO () 8 | main = do 9 | putStrLn $ concat [ "This example is intended to be executed by feeding" 10 | , " the script into the H interpretter, e.g." 11 | , " 'H -- -ghci-script nls2.hs'" 12 | ] 13 | exitFailure 14 | -------------------------------------------------------------------------------- /examples/nls2/system.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ViewPatterns, GADTs #-} 2 | import H.Prelude 3 | import System.Random.MWC 4 | import System.Random.MWC.Distributions 5 | import qualified Foreign.R as R 6 | import Language.R.HExp 7 | import qualified Data.Vector.SEXP as Vector 8 | import Language.R.Debug as D 9 | import Data.List 10 | import Data.Int 11 | 12 | generate :: Int32 -> IO Double 13 | generate ix = 14 | withSystemRandom . asGenIO $ \gen -> 15 | -- Lets make some more interesting distribution: 16 | let r = (x-10)*(x-20)*(x-40)*(x-70) 17 | + 28*x*(log x) 18 | in do v <- standard gen 19 | return $ r * (1 + 0.01 * v) 20 | where x = fromIntegral ix 21 | 22 | generate_lifted :: [Int32] -> R s [Double] 23 | generate_lifted = io . (mapM generate) 24 | 25 | data Poly = Poly [Int] 26 | 27 | generate_polynomial :: Int -> String -> String 28 | generate_polynomial 0 s = "a0" 29 | generate_polynomial x s = "a" ++ Prelude.show x ++ "*" ++ intercalate "*" (replicate x s) ++ "+" ++ generate_polynomial (x-1) s 30 | 31 | generate_list :: Int -> String 32 | generate_list n = -- intercalate "," $ zipWith (\a b -> a++"="++show b) (map (\t->"a"++show t) [0..(n+1)]) (reverse lst) 33 | intercalate "," $ map (\i -> "a" ++ Prelude.show i ++ "=1") [0..n] 34 | where 35 | lst = [0.13, 1.5, 0.4, 19, 27, 7, 9 ] 36 | -- lst = [5600,1060,630,140,10,50,1] 37 | 38 | formula :: Int -> String -> String -> String 39 | formula n y x = "nls( "++y++" ~ "++generate_polynomial n x++", start=list("++generate_list n++"))" 40 | 41 | -------------------------------------------------------------------------------- /inline-r/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Change Log 2 | 3 | ## 1.0.1 - 2023-05-22 4 | * Populate `R_LIBS` environment variable when starting R (#393) 5 | * Map backslashes to forwardslashes in temp file names under Windows (#399) 6 | * Relax upper bounds for GHC 9.6 7 | * Fix imports for compatibility with mtl-2.3 (#414) 8 | 9 | ## 1.0.0 - 2022-11-11 10 | * Support for R >= 4.2. 11 | * Support for GHC 9 and GHC 9.2. 12 | * Breaking change: remove `unhexp`, `pokeInfo`, `mark` and `named`. 13 | * Breaking change: `HExp` no longer has a `Storable` instance. 14 | * Breaking change: some fields of SEXPInfo have been removed. 15 | * Breaking change: `Special` and `Primitive` constructors of `HExp` no 16 | longer carry any information. R-4.2 makes these forms completely 17 | opaque. 18 | * Process quasiquotes using an instance of the R interpreter in 19 | a separate process. This improves support on macOS. 20 | 21 | ## 0.10.5 - 2020-11-16 22 | * Support aeson >= 2 23 | 24 | ## 0.10.1 - 2018-03-12 25 | * MonadFail instance to R. 26 | 27 | ## 0.10 - 2018-03-10 28 | * inline-r supports running on FreeBSD 29 | * Fixed Lock system during QQ-generation 30 | * Support for new vector API. 31 | 32 | ## 0.9.2 - 2018-06-29 33 | * GHC 8.4 compatibility 34 | * Add Literal instance for 'Text' 35 | 36 | ## 0.9.1 - 2018-01-26 37 | * Droped c2hs usage. Fixes installation on macOS. 38 | * Fix QQ generation. Fixed possible resource free during QQ generation. 39 | 40 | ## 0.9.0.2 - 2016-10-23 41 | * Fix build on ghc-8.2. 42 | * Introduce Matcher API. 43 | 44 | ## 0.9.0 - 2016-06-20 45 | 46 | * Breaking change: Rewrite of the `H.Prelude` module API. 47 | * Reexport more modules from Language.R. 48 | * Windows support for inline-r and H. 49 | * Partially move away from c2hs internally: too many bugs on Windows. 50 | * Export `PrintR` type class. 51 | * Loosen the constraints of a few `HExp` constructors. 52 | * Deprecate `parseFile`, `parseText`, `string` and `strings`. 53 | 54 | ## 0.8.0 - 2016-01-24 55 | 56 | ### Changed 57 | 58 | * Rewritten R quasiquoter. Compile times now much faster than before 59 | for large quasiquotes. 60 | * Assignments are now local by default. Use <<- to assign in global 61 | environment. 62 | 63 | ### Added 64 | 65 | * vector-0.11 compatibility. 66 | * Included in LTS-5. 67 | * Vectors can now be sliced starting from arbitrary indexes. Slices 68 | were previously restricted to 0-based slices. 69 | 70 | ### Fixed 71 | 72 | * Memory tests are now --enable-strict-barrier clean. 73 | * Remove memory leak when allocating new vectors via 74 | `Data.Vector.SEXP` API. 75 | 76 | ## 0.7.3.0 - 2015-12-08 77 | 78 | * Skip R's own signal handlers during init. They would otherwise 79 | interfere with signal delivery e.g. regarding socket conditions. 80 | * stack --nix support. 81 | 82 | ## 0.7.2.0 - 2015-11-24 83 | 84 | * OS X El Capitan support. 85 | 86 | ## 0.7.1.0 - 2015-09-14 87 | 88 | * Fix vector copying. 89 | 90 | ## 0.7.0.0 - 2015-09-07 91 | 92 | * First public release. 93 | -------------------------------------------------------------------------------- /inline-r/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013-2015 Amgen, Inc. 2 | Copyright (c) 2015 Tweag I/O Limited. 3 | 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions 8 | are met: 9 | 1. Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 2. Redistributions in binary form must reproduce the above copyright 12 | notice, this list of conditions and the following disclaimer in the 13 | documentation and/or other materials provided with the distribution. 14 | 3. The names of the author may not be used to endorse or promote 15 | products derived from this software without specific prior written 16 | permission. 17 | 18 | THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND 19 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 20 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 21 | ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE 22 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 23 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 24 | OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 25 | HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 26 | LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 27 | OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 28 | SUCH DAMAGE. 29 | -------------------------------------------------------------------------------- /inline-r/R/collectAntis.R: -------------------------------------------------------------------------------- 1 | go <- function(e) { 2 | ty <- typeof(e) 3 | if (ty %in% c("language", "expression")) { 4 | lapply(e, go) 5 | } 6 | else if (ty == "symbol") { 7 | as.character(e) 8 | } 9 | else 10 | character(0) 11 | } 12 | 13 | cat(grep(pattern = "_hs$", value = TRUE, 14 | unique(unlist(recursive = TRUE, 15 | go(parse(file = input_file)))))) 16 | -------------------------------------------------------------------------------- /inline-r/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | 3 | main :: IO () 4 | main = defaultMain 5 | 6 | -------------------------------------------------------------------------------- /inline-r/cbits/missing_r.c: -------------------------------------------------------------------------------- 1 | // Copyright: (C) 2013 Amgen, Inc. 2 | 3 | #include "missing_r.h" 4 | #include 5 | #include 6 | 7 | static void freeHsSEXP(SEXP extPtr) 8 | { 9 | hs_free_fun_ptr(R_ExternalPtrAddr(extPtr)); 10 | } 11 | 12 | SEXP funPtrToSEXP(DL_FUNC pf) 13 | { 14 | static SEXP callsym, functionsym, nativesym; 15 | if(!callsym) callsym = install(".Call"); 16 | if(!functionsym) functionsym = install("function"); 17 | if(!nativesym) nativesym = install("native symbol"); 18 | SEXP value, formals; 19 | 20 | PROTECT(value = R_MakeExternalPtr(pf, nativesym, R_NilValue)); 21 | R_RegisterCFinalizerEx(value, freeHsSEXP, TRUE); 22 | PROTECT(value = lang3(callsym, value, R_DotsSymbol)); 23 | PROTECT(formals = CONS(R_MissingArg, R_NilValue)); 24 | SET_TAG(formals, R_DotsSymbol); 25 | PROTECT(value = lang4(functionsym, formals, value, R_NilValue)); 26 | UNPROTECT(4); 27 | return value; 28 | } 29 | 30 | // XXX Initializing isRInitialized to 0 here causes GHCi to fail with 31 | // a linking error in Windows x64. But initializing to 2 poses no 32 | // problem! 33 | int isRInitialized = 2; 34 | 35 | HsStablePtr rVariables; 36 | 37 | 38 | // List the prototypes of functions and variables that inline-r 39 | // uses from R. The purpose of this is to catch changes in the 40 | // C interface when upgrading R. 41 | #include 42 | int Rf_initEmbeddedR(int, char**); 43 | void Rf_endEmbeddedR(int); 44 | 45 | #ifndef mingw32_HOST_OS 46 | #include 47 | static void test_R_PolledEvents(){ void (*a)(void) = R_PolledEvents; }; 48 | static void test_R_wait_usec(){ int *a = &R_wait_usec; }; 49 | 50 | static void test_R_InputHandlers(){ InputHandler *a = R_InputHandlers; }; 51 | fd_set *R_checkActivity(int usec, int ignore_stdin); 52 | void R_runHandlers(InputHandler *handlers, fd_set *mask); 53 | InputHandler *addInputHandler(InputHandler *handlers, int fd, InputHandlerProc handler, int activity); 54 | int removeInputHandler(InputHandler **handlers, InputHandler *it); 55 | 56 | #include 57 | static void test_R_Interactive(){ 58 | Rboolean *a = &R_Interactive; 59 | int i=0; 60 | *a=i; 61 | }; 62 | static void test_R_SignalHandlers(){ int *a = &R_SignalHandlers; }; 63 | #endif 64 | 65 | int TYPEOF(SEXP x); 66 | static void test_R_NilValue(){ SEXP *a = &R_NilValue; }; 67 | static void test_R_UnboundValue(){ SEXP *a = &R_UnboundValue; }; 68 | static void test_R_MissingArg(){ SEXP *a = &R_MissingArg; }; 69 | static void test_R_BaseEnv(){ SEXP *a = &R_BaseEnv; }; 70 | static void test_R_EmptyEnv(){ SEXP *a = &R_EmptyEnv; }; 71 | static void test_R_GlobalEnv(){ SEXP *a = &R_GlobalEnv; }; 72 | 73 | #include 74 | static void test_R_interrupts_pending(){ int *a = &R_interrupts_pending; }; 75 | int OBJECT(SEXP x); 76 | int NAMED(SEXP x); 77 | int LEVELS(SEXP x); 78 | int MARK(SEXP x); 79 | int RDEBUG(SEXP x); 80 | int RTRACE(SEXP x); 81 | int RSTEP(SEXP x); 82 | SEXP ATTRIB(SEXP x); 83 | void SET_ATTRIB(SEXP, SEXP); 84 | SEXP Rf_getAttrib(SEXP, SEXP); 85 | Rboolean Rf_isS4(SEXP x); 86 | 87 | #include 88 | static void test_ParseStatus() { ParseStatus a = (int)0; }; 89 | SEXP R_ParseVector(SEXP, int, ParseStatus*, SEXP); 90 | 91 | // These variables are not in header files! 92 | extern void (*Rg_PolledEvents)(void); 93 | static void test_Rg_PolledEvents(){ void (*a)(void) = Rg_PolledEvents; }; 94 | extern int Rg_wait_usec; 95 | static void test_Rg_wait_usec(){ int *a = &Rg_wait_usec; }; 96 | extern int R_PPStackTop; 97 | static void test_R_PPStackTop(){ int *a = &R_PPStackTop; }; 98 | -------------------------------------------------------------------------------- /inline-r/cbits/missing_r.h: -------------------------------------------------------------------------------- 1 | // Copyright: (C) 2013 Amgen, Inc. 2 | 3 | #ifndef MISSING_R__H 4 | #define MISSING_R__H 5 | 6 | #include "HsFFI.h" 7 | #include 8 | #include 9 | 10 | /* Create a variadic R function given any function pointer. */ 11 | SEXP funPtrToSEXP(DL_FUNC pf); 12 | 13 | /* Indicates whether R has been initialized. */ 14 | extern int isRInitialized; 15 | 16 | /* R global variables for GHCi. */ 17 | extern HsStablePtr rVariables; 18 | 19 | #endif 20 | -------------------------------------------------------------------------------- /inline-r/inline-r.buildinfo: -------------------------------------------------------------------------------- 1 | if impl(ghc < 8.2.1) 2 | c-sources: 3 | src/Foreign/R.c 4 | -------------------------------------------------------------------------------- /inline-r/src/Control/Memory/Region.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Copyright: (C) 2013 Amgen, Inc. 3 | -- 4 | -- Phantom type indices for segregating values into "regions" of memory, which 5 | -- are markers that serve as static conservative approximations of the liveness 6 | -- of an object. That is, regions have scopes, and objects within a region are 7 | -- guaranteed to remain live within the scope of that region. 8 | 9 | {-# LANGUAGE TypeFamilies #-} 10 | {-# LANGUAGE TypeOperators #-} 11 | 12 | module Control.Memory.Region where 13 | 14 | import GHC.Exts (Constraint, RealWorld) 15 | 16 | -- | The global region is a special region whose scope extends all the way to 17 | -- the end of the program. As such, any object allocated within this region 18 | -- lives "forever". In this sense, it is the top-level region, whose scope 19 | -- includes all other regions. 20 | type GlobalRegion = RealWorld 21 | 22 | -- | Void is not a region. It is a placeholder marking the absence of region. 23 | -- Useful to tag objects that belong to no region at all. 24 | data Void 25 | 26 | -- | Convenient shorthand. 27 | type G = GlobalRegion 28 | 29 | -- | Convenient shorthand. 30 | type V = Void 31 | 32 | -- | A partial order on regions. In fact regions form a lattice, with 33 | -- 'GlobalRegion' being the supremum and 'Void' the infimum. 34 | type family a <= b :: Constraint 35 | type instance a <= a = () 36 | type instance a <= G = () 37 | type instance V <= b = () 38 | -------------------------------------------------------------------------------- /inline-r/src/Control/Monad/R/Class.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Copyright: (C) 2013 Amgen, Inc. 3 | -- 4 | 5 | {-# LANGUAGE TypeFamilies #-} 6 | {-# LANGUAGE DefaultSignatures #-} 7 | module Control.Monad.R.Class 8 | ( MonadR(..) 9 | , Region 10 | , acquireSome 11 | ) where 12 | 13 | import Control.Memory.Region 14 | import Foreign.R 15 | 16 | import Control.Applicative 17 | import Control.Monad.Catch (MonadCatch, MonadMask) 18 | import Control.Monad.Trans (MonadIO(..)) 19 | import Control.Monad.Primitive (PrimMonad, PrimState) 20 | import Prelude 21 | 22 | -- | The class of R interaction monads. For safety, in compiled code we normally 23 | -- use the 'Language.R.Instance.R' monad. For convenience, in a GHCi session, we 24 | -- normally use the 'IO' monad directly (by means of a 'MonadR' instance for 25 | -- 'IO', imported only in GHCi). 26 | class (Applicative m, MonadIO m, MonadCatch m, MonadMask m, PrimMonad m) 27 | => MonadR m where 28 | -- | Lift an 'IO' action. 29 | io :: IO a -> m a 30 | io = liftIO 31 | 32 | -- | Acquire ownership in the current region of the given object. This means 33 | -- that the liveness of the object is guaranteed so long as the current region 34 | -- remains active (the R garbage collector will not attempt to free it). 35 | acquire :: s ~ V => SEXP s a -> m (SEXP (Region m) a) 36 | default acquire :: (MonadIO m, Region m ~ G) => SEXP s a -> m (SEXP (Region m) a) 37 | acquire = liftIO . protect 38 | 39 | -- | A reification of an R execution context, i.e. a "session". 40 | data ExecContext m :: * 41 | 42 | -- | Get the current execution context. 43 | getExecContext :: m (ExecContext m) 44 | 45 | -- | Provides no static guarantees that resources do not extrude the scope of 46 | -- their region. Acquired resources are not freed automatically upon exit. 47 | -- For internal use only. 48 | unsafeRunWithExecContext :: m a -> ExecContext m -> IO a 49 | 50 | type Region m = PrimState m 51 | 52 | -- | 'acquire' for 'SomeSEXP'. 53 | acquireSome :: (MonadR m) => SomeSEXP V -> m (SomeSEXP (Region m)) 54 | acquireSome (SomeSEXP s) = SomeSEXP <$> acquire s 55 | -------------------------------------------------------------------------------- /inline-r/src/Control/Monad/R/Internal.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Copyright: (C) 2016 Tweag I/O Limited. 3 | 4 | {-# LANGUAGE FlexibleContexts #-} 5 | {-# LANGUAGE RankNTypes #-} 6 | {-# LANGUAGE ScopedTypeVariables #-} 7 | 8 | module Control.Monad.R.Internal where 9 | 10 | import Control.Memory.Region 11 | import Control.Monad.R.Class 12 | import Data.Proxy (Proxy(..)) 13 | import Data.Reflection (Reifies, reify) 14 | import Foreign.R (SEXP) 15 | 16 | newtype AcquireIO s = AcquireIO (forall ty. SEXP V ty -> IO (SEXP s ty)) 17 | 18 | withAcquire 19 | :: forall m r. 20 | (MonadR m) 21 | => (forall s. Reifies s (AcquireIO (Region m)) => Proxy s -> m r) 22 | -> m r 23 | withAcquire f = do 24 | cxt <- getExecContext 25 | reify (AcquireIO (\sx -> unsafeRunWithExecContext (acquire sx) cxt)) f 26 | -------------------------------------------------------------------------------- /inline-r/src/Data/Vector/SEXP/Base.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Copyright: (C) 2013 Amgen, Inc. 3 | -- 4 | 5 | {-# LANGUAGE ConstraintKinds #-} 6 | {-# LANGUAGE DataKinds #-} 7 | {-# LANGUAGE TypeFamilies #-} 8 | 9 | module Data.Vector.SEXP.Base where 10 | 11 | import Control.Memory.Region 12 | 13 | import Foreign.R.Type 14 | import Foreign.R (SEXP, SomeSEXP) 15 | 16 | import Data.Singletons (SingI) 17 | 18 | import Data.Complex (Complex) 19 | import Data.Word (Word8) 20 | import Data.Int (Int32) 21 | import Foreign.Storable (Storable) 22 | 23 | -- | Function from R types to the types of the representations of each element 24 | -- in the vector. 25 | type family ElemRep s (a :: SEXPTYPE) where 26 | ElemRep s 'Char = Word8 27 | ElemRep s 'Logical = Logical 28 | ElemRep s 'Int = Int32 29 | ElemRep s 'Real = Double 30 | ElemRep s 'Complex = Complex Double 31 | ElemRep s 'String = SEXP s 'Char 32 | ElemRep s 'Vector = SomeSEXP s 33 | ElemRep s 'Expr = SomeSEXP s 34 | ElemRep s 'Raw = Word8 35 | 36 | -- | 'ElemRep' in the form of a relation, for convenience. 37 | type E s a b = ElemRep s a ~ b 38 | 39 | -- | Constraint synonym for all operations on vectors. 40 | type VECTOR s ty a = (Storable a, IsVector ty, SingI ty) 41 | 42 | -- | Constraint synonym for all operations on vectors. 43 | type SVECTOR ty a = (Storable a, IsVector ty, SingI ty, ElemRep V ty ~ a) 44 | -------------------------------------------------------------------------------- /inline-r/src/Data/Vector/SEXP/Mutable/Internal.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Copyright: (C) 2016 Tweag I/O Limited. 3 | 4 | {-# LANGUAGE FlexibleContexts #-} 5 | {-# LANGUAGE FlexibleInstances #-} 6 | {-# LANGUAGE MultiParamTypeClasses #-} 7 | {-# LANGUAGE ScopedTypeVariables #-} 8 | {-# LANGUAGE TypeFamilies #-} 9 | {-# LANGUAGE TypeOperators #-} 10 | {-# LANGUAGE UndecidableInstances #-} 11 | {-# LANGUAGE ViewPatterns #-} 12 | {-# LANGUAGE CPP #-} 13 | 14 | module Data.Vector.SEXP.Mutable.Internal 15 | ( MVector(..) 16 | , W(..) 17 | , withW 18 | , proxyW 19 | , unsafeToPtr 20 | , release 21 | , unsafeRelease 22 | ) where 23 | 24 | import Control.Memory.Region 25 | import qualified Foreign.R as R 26 | 27 | import Control.Monad.Primitive (unsafePrimToPrim) 28 | import Control.Monad.R.Internal 29 | import Data.Int (Int32) 30 | import Data.Proxy (Proxy(..)) 31 | import Data.Reflection (Reifies(..)) 32 | import Data.Singletons (fromSing, sing) 33 | import qualified Data.Vector.Generic.Mutable as G 34 | import Data.Vector.SEXP.Base 35 | import Foreign (Storable(..), Ptr, castPtr) 36 | import Foreign.Marshal.Array (advancePtr, copyArray, moveArray) 37 | import Foreign.R (SEXP) 38 | import Foreign.R.Type (SSEXPTYPE) 39 | import Internal.Error 40 | 41 | -- | Mutable R vector. Represented in memory with the same header as 'SEXP' 42 | -- nodes. The second type parameter is phantom, reflecting at the type level the 43 | -- tag of the vector when viewed as a 'SEXP'. The tag of the vector and the 44 | -- representation type are related via 'ElemRep'. 45 | data MVector s ty a = MVector 46 | { mvectorBase :: {-# UNPACK #-} !(SEXP s ty) 47 | , mvectorOffset :: {-# UNPACK #-} !Int32 48 | , mvectorLength :: {-# UNPACK #-} !Int32 49 | } 50 | 51 | -- | Internal wrapper type for reflection. First type parameter is the reified 52 | -- type to reflect. 53 | newtype W t ty s a = W { unW :: MVector s ty a } 54 | 55 | instance (Reifies t (AcquireIO s), VECTOR s ty a) => G.MVector (W t ty) a where 56 | #if MIN_VERSION_vector(0,11,0) 57 | basicInitialize _ = return () 58 | #endif 59 | {-# INLINE basicLength #-} 60 | basicLength (unW -> MVector _ _ len) = fromIntegral len 61 | 62 | {-# INLINE basicUnsafeSlice #-} 63 | basicUnsafeSlice j m (unW -> MVector ptr off _len) = 64 | W $ MVector ptr (off + fromIntegral j) (fromIntegral m) 65 | 66 | {-# INLINE basicOverlaps #-} 67 | basicOverlaps (unW -> MVector ptr1 off1 len1) (unW -> MVector ptr2 off2 len2) = 68 | ptr1 == ptr2 && (off2 < off1 + len1 || off1 < off2 + len2) 69 | 70 | {-# INLINE basicUnsafeNew #-} 71 | basicUnsafeNew n 72 | -- R calls using allocVector() for CHARSXP "defunct"... 73 | | fromSing (sing :: SSEXPTYPE ty) == R.Char = 74 | failure "Data.Vector.SEXP.Mutable.new" 75 | "R character vectors are immutable and globally cached. Use 'mkChar' instead." 76 | | otherwise = do 77 | sx <- unsafePrimToPrim (acquireIO =<< R.allocVector (sing :: SSEXPTYPE ty) n) 78 | return $ W $ MVector (R.unsafeRelease sx) 0 (fromIntegral n) 79 | where 80 | AcquireIO acquireIO = reflect (Proxy :: Proxy t) 81 | 82 | {-# INLINE basicUnsafeRead #-} 83 | basicUnsafeRead (unW -> mv) i = 84 | unsafePrimToPrim $ peekElemOff (unsafeToPtr mv) i 85 | 86 | {-# INLINE basicUnsafeWrite #-} 87 | basicUnsafeWrite (unW -> mv) i x = 88 | unsafePrimToPrim $ pokeElemOff (unsafeToPtr mv) i x 89 | 90 | {-# INLINE basicUnsafeCopy #-} 91 | basicUnsafeCopy w1@(unW -> mv1) (unW -> mv2) = unsafePrimToPrim $ do 92 | copyArray (unsafeToPtr mv1) 93 | (unsafeToPtr mv2) 94 | (G.basicLength w1) 95 | 96 | {-# INLINE basicUnsafeMove #-} 97 | basicUnsafeMove w1@(unW -> mv1) (unW -> mv2) = unsafePrimToPrim $ do 98 | moveArray (unsafeToPtr mv1) 99 | (unsafeToPtr mv2) 100 | (G.basicLength w1) 101 | 102 | unsafeToPtr :: Storable a => MVector s ty a -> Ptr a 103 | unsafeToPtr (MVector sx off _) = 104 | castPtr (R.unsafeSEXPToVectorPtr sx) `advancePtr` fromIntegral off 105 | 106 | proxyW :: Monad m => m (W t ty s a) -> proxy t -> m (MVector s ty a) 107 | proxyW m _ = fmap unW m 108 | 109 | withW :: proxy t -> MVector s ty a -> W t ty s a 110 | withW _ v = W v 111 | 112 | release :: (s' <= s) => MVector s ty a -> MVector s' ty a 113 | release = unsafeRelease 114 | 115 | unsafeRelease :: MVector s ty a -> MVector s' ty a 116 | unsafeRelease (MVector b o l) = MVector (R.unsafeRelease b) o l 117 | -------------------------------------------------------------------------------- /inline-r/src/Foreign/R/Constraints.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Copyright: (C) 2013 Amgen, Inc. 3 | -- 4 | -- R-specific predicates for encoding form constraints in type signatures. There 5 | -- are no actual bindings in this module. 6 | 7 | {-# LANGUAGE ConstraintKinds #-} 8 | {-# LANGUAGE DataKinds #-} 9 | {-# LANGUAGE PolyKinds #-} 10 | {-# LANGUAGE TypeFamilies #-} 11 | {-# LANGUAGE TypeOperators #-} 12 | 13 | module Foreign.R.Constraints where 14 | 15 | import GHC.Exts (Constraint) 16 | import {-# SOURCE #-} Foreign.R.Type (SEXPTYPE(..)) 17 | 18 | infix 1 :∈ 19 | 20 | -- | The predicate @a :∈ as@ states that @a@ is a member type of the set @as@. 21 | type family (a :: SEXPTYPE) :∈ (as :: [SEXPTYPE]) :: Constraint where 22 | 'Any :∈ as = () 23 | a :∈ (a ': as) = () 24 | a :∈ (b ': as) = a :∈ as 25 | 26 | -- | Non unicode wrapper for the ':∈' type family. 27 | type In a b = a :∈ b 28 | -------------------------------------------------------------------------------- /inline-r/src/Foreign/R/Context.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CApiFFI #-} 2 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE TemplateHaskell #-} 5 | 6 | -- | 7 | -- Copyright: 2018 (C) Tweag I/O Limited. 8 | -- 9 | -- inline-c context. 10 | module Foreign.R.Context 11 | ( rCtx 12 | , SEXPREC 13 | , SEXP0(..) 14 | , Logical(..) 15 | ) where 16 | 17 | import Data.Complex 18 | import qualified Data.Map as Map 19 | import Foreign.C 20 | import Foreign.Ptr 21 | import Foreign.Storable 22 | import Language.C.Types (TypeSpecifier(TypeName)) 23 | import Language.C.Inline.Context (Context(..)) 24 | import Internal.Error 25 | 26 | #include 27 | 28 | data SEXPREC 29 | 30 | newtype {-# CTYPE "SEXP" #-} SEXP0 = SEXP0 { unSEXP0 :: Ptr SEXPREC } 31 | deriving ( Eq 32 | , Ord 33 | , Storable 34 | ) 35 | 36 | instance Show SEXP0 where 37 | show (SEXP0 ptr) = show ptr 38 | 39 | -- | R uses three-valued logic. 40 | data {-# CTYPE "Logical" #-} Logical = FALSE 41 | | TRUE 42 | | NA 43 | -- XXX no Enum instance because NA = INT_MIN, not representable as an Int on 44 | -- 32-bit systems. 45 | deriving (Eq, Ord, Show) 46 | 47 | instance Storable Logical where 48 | sizeOf _ = sizeOf (undefined :: CInt) 49 | alignment _ = alignment (undefined :: CInt) 50 | poke ptr FALSE = poke (castPtr ptr) (0 :: CInt) 51 | poke ptr TRUE = poke (castPtr ptr) (1 :: CInt) 52 | -- Currently NA_LOGICAL = INT_MIN. 53 | poke ptr NA = poke (castPtr ptr) (#{const INT_MIN} :: CInt) 54 | peek ptr = do 55 | x <- peek (castPtr ptr) 56 | case x :: CInt of 57 | 0 -> return FALSE 58 | 1 -> return TRUE 59 | #{const INT_MIN} -> return NA 60 | _ -> failure "Storable Logical peek" "Not a Logical." 61 | 62 | rCtx :: Context 63 | rCtx = mempty { ctxTypesTable = Map.fromList tytabs } 64 | where 65 | tytabs = 66 | [ (TypeName "SEXP", [t| SEXP0 |]) 67 | , (TypeName "Rcomplex", [t| Complex Double |]) 68 | ] 69 | -------------------------------------------------------------------------------- /inline-r/src/Foreign/R/Embedded.hsc: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Copyright: (C) 2013 Amgen, Inc. 3 | -- 4 | -- Bindings for @@, containing entry points for running an 5 | -- instance of R embedded within another program. 6 | 7 | {-# LANGUAGE CPP #-} 8 | {-# LANGUAGE ForeignFunctionInterface #-} 9 | {-# LANGUAGE ViewPatterns #-} 10 | 11 | {-# OPTIONS_GHC -fno-warn-unused-matches #-} 12 | module Foreign.R.Embedded 13 | ( initEmbeddedR 14 | , endEmbeddedR 15 | ) where 16 | 17 | import Foreign 18 | import Foreign.C 19 | 20 | #include 21 | #include "missing_r.h" 22 | 23 | -- | Initialize R. 24 | initEmbeddedR :: Int -> Ptr CString -> IO () 25 | initEmbeddedR (fromIntegral -> argc) argv = c_initEmbeddedR argc argv 26 | 27 | foreign import ccall safe "Rembedded.h Rf_initEmbeddedR" c_initEmbeddedR 28 | :: CInt -> Ptr CString -> IO () 29 | 30 | endEmbeddedR :: Int -> IO () 31 | endEmbeddedR (fromIntegral -> retCode) = c_endEmbeddedR retCode 32 | 33 | foreign import ccall safe "Rembedded.h Rf_endEmbeddedR" c_endEmbeddedR 34 | :: CInt -> IO () 35 | -------------------------------------------------------------------------------- /inline-r/src/Foreign/R/Encoding.hsc: -------------------------------------------------------------------------------- 1 | -- | Character encodings. 2 | 3 | #include 4 | 5 | module Foreign.R.Encoding where 6 | 7 | -- | Content encoding. 8 | data CEType 9 | = CE_Native 10 | | CE_UTF8 11 | | CE_Latin1 12 | | CE_Bytes 13 | | CE_Symbol 14 | | CE_Any 15 | deriving (Eq, Show) 16 | 17 | instance Enum CEType where 18 | fromEnum CE_Native = #const CE_NATIVE 19 | fromEnum CE_UTF8 = #const CE_UTF8 20 | fromEnum CE_Latin1 = #const CE_LATIN1 21 | fromEnum CE_Bytes = #const CE_BYTES 22 | fromEnum CE_Symbol = #const CE_SYMBOL 23 | fromEnum CE_Any = #const CE_ANY 24 | toEnum i = case i of 25 | (#const CE_NATIVE) -> CE_Native 26 | (#const CE_UTF8) -> CE_UTF8 27 | (#const CE_LATIN1) -> CE_Latin1 28 | (#const CE_BYTES) -> CE_Bytes 29 | (#const CE_SYMBOL) -> CE_Symbol 30 | (#const CE_ANY) -> CE_Any 31 | _ -> error "CEType.fromEnum: unknown tag" 32 | -------------------------------------------------------------------------------- /inline-r/src/Foreign/R/Error.hsc: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Copyright: (C) 2013 Amgen, Inc. 3 | -- 4 | -- Exception type wrapping errors thrown by the R runtime. 5 | 6 | {-# LANGUAGE CPP #-} 7 | {-# LANGUAGE DeriveDataTypeable #-} 8 | module Foreign.R.Error 9 | ( RError(..) 10 | ) where 11 | 12 | import Control.Exception 13 | import Data.Typeable 14 | 15 | data RError = RError String 16 | deriving ( Typeable ) 17 | 18 | instance Show RError where 19 | show (RError s) = "R Runtime Error: " ++ s 20 | 21 | instance Exception RError 22 | -------------------------------------------------------------------------------- /inline-r/src/Foreign/R/Parse.hsc: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Copyright: (C) 2013 Amgen, Inc. 3 | -- 4 | -- Bindings for @@. 5 | 6 | {-# LANGUAGE CPP #-} 7 | {-# LANGUAGE CApiFFI #-} 8 | {-# LANGUAGE ConstraintKinds #-} 9 | {-# LANGUAGE ViewPatterns #-} 10 | {-# LANGUAGE DataKinds #-} 11 | {-# LANGUAGE ForeignFunctionInterface #-} 12 | 13 | #include 14 | #include 15 | module Foreign.R.Parse 16 | ( parseVector 17 | , ParseStatus(..) 18 | ) where 19 | 20 | import Foreign.R.Constraints 21 | import qualified Foreign.R as R 22 | 23 | import Foreign 24 | import Foreign.C 25 | 26 | -- | The return code of a call to 'parseVector', indicating whether the parser 27 | -- failed or succeeded. 28 | data ParseStatus 29 | = PARSE_NULL 30 | | PARSE_OK 31 | | PARSE_INCOMPLETE 32 | | PARSE_ERROR 33 | | PARSE_EOF 34 | deriving (Eq, Show) 35 | 36 | instance Enum ParseStatus where 37 | fromEnum PARSE_NULL = #const PARSE_NULL 38 | fromEnum PARSE_OK = #const PARSE_OK 39 | fromEnum PARSE_INCOMPLETE = #const PARSE_INCOMPLETE 40 | fromEnum PARSE_ERROR = #const PARSE_ERROR 41 | fromEnum PARSE_EOF = #const PARSE_EOF 42 | toEnum i = case i of 43 | (#const PARSE_NULL) -> PARSE_NULL 44 | (#const PARSE_OK) -> PARSE_OK 45 | (#const PARSE_INCOMPLETE) -> PARSE_INCOMPLETE 46 | (#const PARSE_ERROR) -> PARSE_ERROR 47 | (#const PARSE_EOF) -> PARSE_EOF 48 | _ -> error "ParseStatus.fromEnum: can't mach value" 49 | 50 | -- | @parseVector text num status source@ parses the input string into an AST. 51 | -- @source@, if provided, names the origin of @text@ (e.g. a filename). @num@ 52 | -- limits the number of expressions to parse, or @-1@ if no limit. 53 | 54 | -- TODO: use ParseStatus or write a wrapper for parseVector. 55 | parseVector 56 | :: (In a [R.Nil, R.String]) 57 | => R.SEXP s R.String 58 | -> Int 59 | -> Ptr CInt 60 | -> R.SEXP s a 61 | -> IO (R.SEXP s R.Expr) 62 | parseVector (R.unsexp -> s) (fromIntegral -> cnt) reti (R.unsexp -> input) = 63 | R.sexp <$> c_parseVector s cnt reti input 64 | 65 | foreign import ccall "R_ext/Parse.h R_ParseVector" c_parseVector 66 | :: R.SEXP0 -> CInt -> Ptr CInt -> R.SEXP0 -> IO R.SEXP0 67 | -------------------------------------------------------------------------------- /inline-r/src/Foreign/R/Type.hs-boot: -------------------------------------------------------------------------------- 1 | module Foreign.R.Type where 2 | 3 | data SEXPTYPE 4 | = Nil 5 | | Symbol 6 | | List 7 | | Closure 8 | | Env 9 | | Promise 10 | | Lang 11 | | Special 12 | | Builtin 13 | | Char 14 | | Logical 15 | | Int 16 | | Real 17 | | Complex 18 | | String 19 | | DotDotDot 20 | | Any 21 | | Vector 22 | | Expr 23 | | Bytecode 24 | | ExtPtr 25 | | WeakRef 26 | | Raw 27 | | S4 28 | | New 29 | | Free 30 | | Fun 31 | -------------------------------------------------------------------------------- /inline-r/src/H/Prelude.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- | Copyright: (C) 2013 Amgen, Inc. 3 | -- 4 | -- DEPRECATED: use "Language.R" instead. 5 | 6 | {-# LANGUAGE CPP #-} 7 | 8 | module H.Prelude 9 | ( module Language.R.Instance 10 | , module Control.Monad.R.Class 11 | , module Foreign.R.Error 12 | -- * Language.R functions 13 | , module Language.R 14 | -- Not supported on Windows. 15 | #ifndef mingw32_HOST_OS 16 | , module Language.R.Event 17 | #endif 18 | , module Language.R.HExp 19 | , module Language.R.Literal 20 | , module Language.R.QQ 21 | -- * Globals 22 | , module Language.R.Globals 23 | ) where 24 | 25 | import Control.Monad.R.Class 26 | import Language.R.HExp 27 | 28 | -- Reexported modules. 29 | import Language.R hiding (SEXPTYPE(..)) 30 | #ifndef mingw32_HOST_OS 31 | import Language.R.Event (refresh) 32 | #endif 33 | import Language.R.Globals 34 | import Language.R.Instance 35 | import Language.R.Literal 36 | import Language.R.QQ 37 | import Foreign.R.Error 38 | -------------------------------------------------------------------------------- /inline-r/src/H/Prelude/Interactive.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Copyright: (C) 2013 Amgen, Inc. 3 | -- 4 | -- This class is not meant to be imported in any other circumstance than in 5 | -- a GHCi session. 6 | 7 | {-# LANGUAGE TypeFamilies #-} 8 | 9 | {-# OPTIONS_GHC -fno-warn-orphans #-} 10 | module H.Prelude.Interactive 11 | ( module H.Prelude 12 | , PrintR(..) 13 | , p 14 | , printQuote 15 | ) 16 | where 17 | 18 | import qualified Foreign.R as R 19 | import H.Prelude hiding (withEmbeddedR) 20 | 21 | instance MonadR IO where 22 | io = id 23 | data ExecContext IO = ExecContext 24 | getExecContext = return ExecContext 25 | unsafeRunWithExecContext = const 26 | 27 | class PrintR a where 28 | printR :: MonadR m => a -> m () 29 | 30 | instance PrintR (SEXP s a) where 31 | printR = io . R.printValue 32 | 33 | instance PrintR (R.SomeSEXP s) where 34 | printR s = R.unSomeSEXP s printR 35 | 36 | -- | A form of the 'printR' function that is more convenient in an interactive 37 | -- session. 38 | p :: (MonadR m, PrintR a) => m a -> m () 39 | p = (>>= printR) 40 | 41 | -- | A form of the 'printR' function that is more convenient in an interactive 42 | -- session. 43 | {-# DEPRECATED printQuote "Use 'p' instead." #-} 44 | printQuote :: (MonadR m, PrintR a) => m a -> m () 45 | printQuote = p 46 | -------------------------------------------------------------------------------- /inline-r/src/Internal/Error.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Copyright: (C) 2013 Amgen, Inc. 3 | -- 4 | -- Wrappers around 'error' that classify problems into whether these are bugs 5 | -- internal to H, or whether they are due to a mistake by the user. 6 | -- 7 | -- This module should only be imported by H modules and not reexported. 8 | 9 | {-# LANGUAGE DeriveDataTypeable #-} 10 | 11 | module Internal.Error 12 | ( failure 13 | , violation 14 | , impossible 15 | , unimplemented 16 | ) where 17 | 18 | import Control.Exception 19 | import Data.Typeable 20 | 21 | data Violation = Violation String String deriving ( Typeable ) 22 | data Failure = Failure String String deriving ( Typeable ) 23 | 24 | instance Show Failure where 25 | show (Failure f m) = f ++ ":" ++ m 26 | 27 | instance Show Violation where 28 | show (Violation f m) = "Bug in " ++ f ++ ", please report: " ++ m 29 | 30 | instance Exception Violation 31 | instance Exception Failure 32 | 33 | -- | User error. 34 | failure :: String -- ^ Function name 35 | -> String -- ^ Error message 36 | -> a 37 | failure f msg = throw $ Failure f msg 38 | 39 | -- | An internal invariant has been violated. That's a bug. 40 | violation :: String -- ^ Function name 41 | -> String -- ^ Error message 42 | -> a 43 | violation f msg = throw $ Violation f msg 44 | 45 | -- | A violation that should have been made impossible by the type system was 46 | -- not. 47 | impossible :: String -- ^ Function name 48 | -> a 49 | impossible f = violation f "The impossible happened." 50 | 51 | -- | Feature not yet implemented. 52 | unimplemented :: String 53 | -> a 54 | unimplemented f = failure f "Unimplemented." 55 | -------------------------------------------------------------------------------- /inline-r/src/Language/R/GC.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Copyright: (C) 2013 Amgen, Inc. 3 | -- 4 | -- Facilities to get Haskell's garbage collector to manage the liveness of 5 | -- values allocated on the R heap. By default, R values remain live so long as 6 | -- the current region is extant. The R garbage collector may only free them 7 | -- after the end of the region. Sometimes, this discipline incurs too high of 8 | -- a memory usage and nested regions are not always a solution. 9 | -- 10 | -- This module enables registering a callback with the GHC garbage collector. In 11 | -- this way, when the GHC garbage collector detects that a value is no longer 12 | -- live, we can notify the R garbage collector of this fact. The R garbage 13 | -- collector is then free to deallocate the memory associated with the value 14 | -- soon after that. 15 | -- 16 | -- This module hence offers an alternative, more flexible memory management 17 | -- discipline, at a performance cost. In particular, collections of many small, 18 | -- short-lived objects are best managed using regions. 19 | 20 | module Language.R.GC 21 | ( automatic 22 | , automaticSome 23 | ) where 24 | 25 | import Control.Memory.Region 26 | import Control.Monad.R.Class 27 | import Control.Exception 28 | import Foreign.R (SomeSEXP(..)) 29 | import qualified Foreign.R as R 30 | import System.Mem.Weak (addFinalizer) 31 | 32 | -- | Declare memory management for this value to be automatic. That is, the 33 | -- memory associated with it may be freed as soon as the garbage collector 34 | -- notices that it is safe to do so. 35 | -- 36 | -- Values with automatic memory management are tagged with the global region. 37 | -- The reason is that just like for other global values, deallocation of the 38 | -- value can never be observed. Indeed, it is a mere "optimization" to 39 | -- deallocate the value sooner - it would still be semantically correct to never 40 | -- deallocate it at all. 41 | automatic :: MonadR m => R.SEXP s a -> m (R.SEXP G a) 42 | automatic s = io $ mask_ $ do 43 | R.preserveObject s' 44 | s' `addFinalizer` (R.releaseObject (R.unsafeRelease s')) 45 | return s' 46 | where 47 | s' = R.unsafeRelease s 48 | 49 | -- | 'automatic' for 'SomeSEXP'. 50 | automaticSome :: MonadR m => R.SomeSEXP s -> m (R.SomeSEXP G) 51 | automaticSome (SomeSEXP s) = io $ mask_ $ do 52 | R.preserveObject s' 53 | s' `addFinalizer` (R.releaseObject s') 54 | return $ SomeSEXP s' 55 | where 56 | s' = R.unsafeRelease s 57 | -------------------------------------------------------------------------------- /inline-r/src/Language/R/Globals.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE DataKinds #-} 3 | 4 | -- | 5 | -- Copyright: (C) 2013 Amgen, Inc. 6 | -- 7 | -- Global variables used by the R interpreter. All are constant, but the values 8 | -- of some of them may change over time (e.g. the global environment). 9 | 10 | {-# OPTIONS_GHC -fno-warn-missing-signatures #-} 11 | 12 | module Language.R.Globals 13 | ( baseEnv 14 | , emptyEnv 15 | , globalEnv 16 | , nilValue 17 | , missingArg 18 | , unboundValue 19 | -- * R Internal constants 20 | , isRInteractive 21 | , signalHandlersPtr 22 | #ifndef mingw32_HOST_OS 23 | , inputHandlers 24 | #endif 25 | -- * R global constants 26 | -- $ghci-bug 27 | , pokeRVariables 28 | ) where 29 | 30 | import Control.Memory.Region 31 | import Control.Monad ((<=<)) 32 | import Foreign 33 | ( Ptr 34 | , StablePtr 35 | , deRefStablePtr 36 | , newStablePtr 37 | , peek 38 | , poke 39 | ) 40 | import Foreign.C.Types (CInt) 41 | import Foreign.R (SEXP) 42 | import qualified Foreign.R as R 43 | #ifndef mingw32_HOST_OS 44 | import qualified Foreign.R.EventLoop as R 45 | #endif 46 | import System.IO.Unsafe (unsafePerformIO) 47 | 48 | -- $ghci-bug 49 | -- The main reason to have all R constants referenced with a StablePtr 50 | -- is that variables in shared libraries are linked incorrectly by GHCi with 51 | -- loaded code. 52 | -- 53 | -- The workaround is to grab all variables in the ghci session for the loaded 54 | -- code to use them, that is currently done by the H.ghci script. 55 | -- 56 | -- Upstream ticket: 57 | 58 | type RVariables = 59 | ( Ptr (SEXP G 'R.Env) 60 | , Ptr (SEXP G 'R.Env) 61 | , Ptr (SEXP G 'R.Env) 62 | , Ptr (SEXP G 'R.Nil) 63 | , Ptr (SEXP G 'R.Symbol) 64 | , Ptr (SEXP G 'R.Symbol) 65 | , Ptr CInt 66 | , Ptr CInt 67 | #ifndef mingw32_HOST_OS 68 | , Ptr (Ptr R.InputHandler) 69 | #endif 70 | ) 71 | 72 | -- | Stores R variables in a static location. This makes the variables' 73 | -- addresses accesible after reloading in GHCi. 74 | foreign import ccall "missing_r.h &" rVariables :: Ptr (StablePtr RVariables) 75 | 76 | pokeRVariables :: RVariables -> IO () 77 | pokeRVariables = poke rVariables <=< newStablePtr 78 | 79 | ( baseEnvPtr 80 | , emptyEnvPtr 81 | , globalEnvPtr 82 | , nilValuePtr 83 | , unboundValuePtr 84 | , missingArgPtr 85 | , isRInteractive 86 | , signalHandlersPtr 87 | #ifndef mingw32_HOST_OS 88 | , inputHandlersPtr 89 | #endif 90 | ) = unsafePerformIO $ peek rVariables >>= deRefStablePtr 91 | 92 | -- | Special value to which all symbols unbound in the current environment 93 | -- resolve to. 94 | unboundValue :: SEXP G 'R.Symbol 95 | unboundValue = unsafePerformIO $ peek unboundValuePtr 96 | 97 | -- | R's @NULL@ value. 98 | nilValue :: SEXP G 'R.Nil 99 | nilValue = unsafePerformIO $ peek nilValuePtr 100 | 101 | -- | Value substituted for all missing actual arguments of a function call. 102 | missingArg :: SEXP G 'R.Symbol 103 | missingArg = unsafePerformIO $ peek missingArgPtr 104 | 105 | -- | The base environment. 106 | baseEnv :: SEXP G 'R.Env 107 | baseEnv = unsafePerformIO $ peek baseEnvPtr 108 | 109 | -- | The empty environment. 110 | emptyEnv :: SEXP G 'R.Env 111 | emptyEnv = unsafePerformIO $ peek emptyEnvPtr 112 | 113 | -- | The global environment. 114 | globalEnv :: SEXP G 'R.Env 115 | globalEnv = unsafePerformIO $ peek globalEnvPtr 116 | 117 | #ifndef mingw32_HOST_OS 118 | inputHandlers :: Ptr R.InputHandler 119 | inputHandlers = unsafePerformIO $ peek inputHandlersPtr 120 | #endif 121 | -------------------------------------------------------------------------------- /inline-r/src/Language/R/Internal.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# Language ViewPatterns #-} 3 | 4 | module Language.R.Internal 5 | ( r1 6 | , r2 7 | , installIO 8 | ) where 9 | 10 | import Control.Memory.Region 11 | import qualified Foreign.R as R 12 | import Language.R 13 | 14 | import Data.ByteString as B 15 | import Foreign.C.String ( withCString ) 16 | 17 | inVoid :: R V z -> R V z 18 | inVoid = id 19 | {-# INLINE inVoid #-} 20 | 21 | -- | Call a pure unary R function of the given name in the global environment. 22 | r1 :: ByteString -> SEXP s a -> IO (SomeSEXP V) 23 | r1 fn a = 24 | useAsCString fn $ \cfn -> R.install cfn >>= \f -> 25 | R.withProtected (R.lang2 f (R.release a)) (unsafeRunRegion . inVoid . eval) 26 | 27 | -- | Call a pure binary R function. See 'r1' for additional comments. 28 | r2 :: ByteString -> SEXP s a -> SEXP s b -> IO (SomeSEXP V) 29 | r2 fn a b = 30 | useAsCString fn $ \cfn -> R.install cfn >>= \f -> 31 | R.withProtected (R.lang3 f (R.release a) (R.release b)) (unsafeRunRegion . inVoid . eval) 32 | 33 | -- | Internalize a symbol name. 34 | installIO :: String -> IO (SEXP V 'R.Symbol) 35 | installIO str = withCString str R.install 36 | -------------------------------------------------------------------------------- /inline-r/src/Language/R/Internal.hs-boot: -------------------------------------------------------------------------------- 1 | {-# Language DataKinds #-} 2 | 3 | module Language.R.Internal where 4 | 5 | import Control.Memory.Region 6 | import Data.ByteString (ByteString) 7 | import Foreign.R (SEXP, SomeSEXP(..)) 8 | import qualified Foreign.R.Type as R 9 | 10 | r1 :: ByteString -> SEXP s a -> IO (SomeSEXP V) 11 | r2 :: ByteString -> SEXP s a -> SEXP s b -> IO (SomeSEXP V) 12 | installIO :: String -> IO (SEXP V 'R.Symbol) 13 | -------------------------------------------------------------------------------- /inline-r/src/Language/R/Internal/FunWrappers.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Copyright: 2013 (C) Amgen, Inc 3 | -- 4 | -- Helpers for passing functions pointers between Haskell and R. 5 | 6 | {-# LANGUAGE ForeignFunctionInterface #-} 7 | {-# LANGUAGE TemplateHaskell #-} 8 | 9 | module Language.R.Internal.FunWrappers where 10 | 11 | import Foreign.R (SEXP0(..)) 12 | import Language.R.Internal.FunWrappers.TH 13 | import Foreign ( FunPtr ) 14 | 15 | foreign import ccall "wrapper" wrap0 :: IO SEXP0 -> IO (FunPtr (IO SEXP0)) 16 | 17 | foreign import ccall "wrapper" wrap1 18 | :: (SEXP0 -> IO SEXP0) -> IO (FunPtr (SEXP0 -> IO SEXP0)) 19 | 20 | foreign import ccall "wrapper" wrap2 21 | :: (SEXP0 -> SEXP0 -> IO SEXP0) 22 | -> IO (FunPtr (SEXP0 -> SEXP0 -> IO SEXP0)) 23 | 24 | foreign import ccall "wrapper" wrap3 25 | :: (SEXP0 -> SEXP0 -> SEXP0 -> IO SEXP0) 26 | -> IO (FunPtr (SEXP0 -> SEXP0 -> SEXP0 -> IO SEXP0)) 27 | 28 | $(thWrappers 4 12) 29 | -------------------------------------------------------------------------------- /inline-r/src/Language/R/Internal/FunWrappers/TH.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Copyright: (C) 2013 Amgen, Inc. 3 | 4 | {-# LANGUAGE DataKinds #-} 5 | {-# LANGUAGE TemplateHaskell #-} 6 | {-# LANGUAGE CPP #-} 7 | 8 | module Language.R.Internal.FunWrappers.TH 9 | ( thWrappers 10 | , thWrapper 11 | , thWrapperLiteral 12 | , thWrapperLiterals 13 | ) where 14 | 15 | import Internal.Error 16 | import qualified Foreign.R.Type as R 17 | 18 | import Control.Monad (replicateM) 19 | import Foreign (FunPtr) 20 | import Language.Haskell.TH 21 | 22 | -- XXX: If we build quotes that mention names imported from Foreign.R, then 23 | -- GHC panics because it fails to link in all adequate object files to 24 | -- resolve all R symbols. So instead we build the symbol names 25 | -- programmatically, using mkName... 26 | nSEXP0 :: Q Type 27 | nSEXP0 = conT (mkName "SEXP0") 28 | 29 | -- | Generate wrappers from n to m. 30 | thWrappers :: Int -> Int -> Q [Dec] 31 | thWrappers n m = mapM thWrapper [n..m] 32 | 33 | -- | Generate wrapper. 34 | -- 35 | -- Example for input 5: 36 | -- 37 | -- @ 38 | -- foreign import ccall \"wrapper\" wrap5 39 | -- :: ( SEXP a -> SEXP b -> SEXP c 40 | -- -> SEXP d -> SEXP e -> IO (SEXP f) 41 | -- ) 42 | -- -> IO (FunPtr ( SEXP a -> SEXP b -> SEXP c 43 | -- -> SEXP d -> SEXP e -> IO (SEXP f) 44 | -- ) 45 | -- ) 46 | -- @ 47 | thWrapper :: Int -> Q Dec 48 | thWrapper n = do 49 | let vars = map (mkName . return) $ take (n + 1) ['a'..] 50 | ty = go (map varT vars) 51 | forImpD cCall safe "wrapper" (mkName $ "wrap" ++ show n) $ 52 | [t| $ty -> IO (FunPtr $ty) |] 53 | where 54 | go :: [Q Type] -> Q Type 55 | go [] = impossible "thWrapper" 56 | go [_] = [t| IO $nSEXP0 |] 57 | go (_:xs) = [t| $nSEXP0 -> $(go xs) |] 58 | 59 | thWrapperLiterals :: Int -> Int -> Q [Dec] 60 | thWrapperLiterals n m = mapM thWrapperLiteral [n..m] 61 | 62 | -- | Generate Literal Instance for wrapper. 63 | -- 64 | -- Example for input 6: 65 | -- @ 66 | -- instance ( Literal a a0, Literal b b0, Literal c c0, Literal d d0, Literal e e0 67 | -- , Literal f f0, Literal g g0 68 | -- ) 69 | -- => Literal (a -> b -> c -> d -> e -> f -> IO g) R.ExtPtr where 70 | -- mkSEXP = funToSEXP wrap6 71 | -- fromSEXP = error \"Unimplemented.\" 72 | -- @ 73 | thWrapperLiteral :: Int -> Q Dec 74 | thWrapperLiteral n = do 75 | let s = varT =<< newName "s" 76 | names1 <- replicateM (n + 1) $ newName "a" 77 | names2 <- replicateM (n + 1) $ newName "i" 78 | let mkTy [] = impossible "thWrapperLiteral" 79 | mkTy [x] = [t| $nR $s $x |] 80 | mkTy (x:xs) = [t| $x -> $(mkTy xs) |] 81 | ctx = cxt $ 82 | #if MIN_VERSION_template_haskell(2,10,0) 83 | [AppT (ConT (mkName "NFData")) <$> varT (last names1)] ++ 84 | #else 85 | [classP (mkName "NFData") [varT (last names1)]] ++ 86 | #endif 87 | zipWith f (map varT names1) (map varT names2) 88 | where 89 | #if MIN_VERSION_template_haskell(2,10,0) 90 | f tv1 tv2 = foldl AppT (ConT (mkName "Literal")) <$> sequence [tv1, tv2] 91 | #else 92 | f tv1 tv2 = classP (mkName "Literal") [tv1, tv2] 93 | #endif 94 | -- XXX: Ideally would import these names from their defining module, but 95 | -- see GHC bug #1012. Using 'mkName' is a workaround. 96 | nR = conT $ mkName "R" 97 | nwrapn = varE $ mkName $ "wrap" ++ show n 98 | nfunToSEXP = varE $ mkName "Language.R.Literal.funToSEXP" 99 | nLiteral = conT $ mkName "Literal" 100 | instanceD ctx [t| $nLiteral $(mkTy $ map varT names1) 'R.ExtPtr |] 101 | [ funD (mkName "mkSEXPIO") 102 | [ clause [] (normalB [| $nfunToSEXP $nwrapn |]) [] ] 103 | , funD (mkName "fromSEXP") 104 | [ clause [] (normalB [| unimplemented "thWrapperLiteral fromSEXP" |]) [] ] 105 | ] 106 | -------------------------------------------------------------------------------- /inline-r/tests/R/arith-vector.R: -------------------------------------------------------------------------------- 1 | c(42.0) 2 | c(1,2) 3 | c(1)+c(2) 4 | c(1,2)*c(3,4) 5 | c(1,2,6,7)/c(3,4) 6 | -------------------------------------------------------------------------------- /inline-r/tests/R/arith.R: -------------------------------------------------------------------------------- 1 | 42.0 2 | 1 + 2 3 | 2 / 8 4 | 1 - 7 5 | (1 + 2 * 3) / 9 6 | (1 / 2 + 2 * 3) / 9 7 | -------------------------------------------------------------------------------- /inline-r/tests/R/empty.R: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tweag/HaskellR/a531954bf3b5d340a06674b8a289e6cfc4ddf46e/inline-r/tests/R/empty.R -------------------------------------------------------------------------------- /inline-r/tests/R/fact.R: -------------------------------------------------------------------------------- 1 | fact <- function(n) 2 | if(n == 0) 1 else n * fact(n - 1) 3 | 4 | fact(10) 5 | -------------------------------------------------------------------------------- /inline-r/tests/R/fib-benchmark.R: -------------------------------------------------------------------------------- 1 | fib <- function(n) { 2 | if(n == 0) return(1) 3 | if(n == 1) return(1) 4 | return(fib(n - 1) + fib(n - 2)) 5 | } 6 | 7 | cat("fib in plain R:\n") 8 | iterations <- 10 9 | t <- system.time( replicate(iterations, fib(18)) ) 10 | t / iterations 11 | -------------------------------------------------------------------------------- /inline-r/tests/R/fib.R: -------------------------------------------------------------------------------- 1 | fib <- function(n) { 2 | if(n == 0) return(1) 3 | if(n == 1) return(1) 4 | return(fib(n - 1) + fib(n - 2)) 5 | } 6 | -------------------------------------------------------------------------------- /inline-r/tests/Test/Constraints.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE ConstraintKinds #-} 3 | {-# LANGUAGE TypeOperators #-} 4 | module Test.Constraints 5 | ( tests ) 6 | where 7 | 8 | import Foreign.R.Constraints 9 | import qualified Foreign.R.Type as R 10 | 11 | import Test.Tasty 12 | import Test.Tasty.HUnit 13 | 14 | import Control.Monad (guard) 15 | 16 | prop_reflexivity :: (a :∈ '[a]) => R.SSEXPTYPE a -> Bool 17 | prop_reflexivity _ = True 18 | 19 | prop_rightExtension :: (a :∈ '[a, b]) => R.SSEXPTYPE a -> R.SSEXPTYPE b -> Bool 20 | prop_rightExtension _ _ = True 21 | 22 | prop_leftExtension :: (a :∈ '[b, a]) => R.SSEXPTYPE a -> R.SSEXPTYPE b -> Bool 23 | prop_leftExtension _ _ = True 24 | 25 | prop_rightAssociative :: (a :∈ '[a, b, c]) => R.SSEXPTYPE a -> R.SSEXPTYPE b -> R.SSEXPTYPE c -> Bool 26 | prop_rightAssociative _ _ _ = True 27 | 28 | prop_reverse :: (a :∈ '[c, b, a]) => R.SSEXPTYPE a -> R.SSEXPTYPE b -> R.SSEXPTYPE c -> Bool 29 | prop_reverse _ _ _ = True 30 | 31 | tests :: TestTree 32 | tests = testGroup "Constraints" 33 | [ testCase "reflexivity" $ guard $ prop_reflexivity a 34 | , testCase "right extension" $ guard $ prop_rightExtension a b 35 | , testCase "left extension" $ guard $ prop_leftExtension a b 36 | , testCase "right associativity" $ guard $ prop_rightAssociative a b c 37 | , testCase "reverse" $ guard $ prop_reverse a b c 38 | ] 39 | where 40 | a = R.SInt 41 | b = R.SReal 42 | c = R.SLogical 43 | -------------------------------------------------------------------------------- /inline-r/tests/Test/Event.hs: -------------------------------------------------------------------------------- 1 | -- | Tests for "Language.R.Event". 2 | 3 | {-# LANGUAGE CPP #-} 4 | module Test.Event where 5 | 6 | #ifndef mingw32_HOST_OS 7 | import Data.IORef (modifyIORef', newIORef, readIORef, writeIORef) 8 | import Foreign (FunPtr, Ptr, freeHaskellFunPtr) 9 | import qualified Foreign.R.EventLoop as R 10 | import H.Prelude 11 | import Language.R.Event 12 | import System.IO (hClose, hPutStrLn) 13 | import System.IO.Temp (withSystemTempFile) 14 | import System.Posix.IO 15 | ( OpenMode(..) 16 | , OpenFileFlags(..) 17 | , closeFd 18 | , defaultFileFlags 19 | , openFd 20 | ) 21 | import System.Posix.Types (Fd) 22 | #endif 23 | import Test.Tasty 24 | import Test.Tasty.HUnit 25 | 26 | #ifndef mingw32_HOST_OS 27 | foreign import ccall "wrapper" wrap 28 | :: (Ptr () -> IO ()) 29 | -> IO (FunPtr (Ptr () -> IO ())) 30 | #endif 31 | 32 | tests :: TestTree 33 | tests = testGroup "events" 34 | #ifdef mingw32_HOST_OS 35 | [] 36 | #else 37 | [ testCase "addInputHandler increases handler count" $ do 38 | withReadFd $ \fd -> do 39 | f <- wrap $ \_ -> return () 40 | ref1 <- newIORef (0 :: Int) 41 | forIH_ inputHandlers $ \_ -> modifyIORef' ref1 (+1) 42 | ih <- R.addInputHandler inputHandlers fd f 0 43 | ref2 <- newIORef 0 44 | forIH_ inputHandlers $ \_ -> modifyIORef' ref2 (+1) 45 | n1 <- readIORef ref1 46 | n2 <- readIORef ref2 47 | n1 @?= n2 - 1 48 | (@?= True) =<< R.removeInputHandler inputHandlers ih 49 | freeHaskellFunPtr f 50 | 51 | , testCase "removeInputHandler decreases handler count" $ do 52 | withReadFd $ \fd -> do 53 | f <- wrap $ \_ -> return () 54 | ih <- R.addInputHandler inputHandlers fd f 0 55 | (@?= True) =<< R.removeInputHandler inputHandlers ih 56 | freeHaskellFunPtr f 57 | 58 | , testCase "file events (select)" $ do 59 | withReadFd $ \fd -> do 60 | ref <- newIORef False 61 | f <- wrap $ \_ -> writeIORef ref True 62 | _ <- R.addInputHandler inputHandlers fd f 0 63 | runRegion $ refresh 64 | (@?= True) =<< readIORef ref 65 | freeHaskellFunPtr f 66 | -- XXX GHC bug: https://ghc.haskell.org/trac/ghc/ticket/10736 67 | {- 68 | , testCase "file events (poll)" $ do 69 | withReadFd $ \fd -> do 70 | mv <- newEmptyMVar 71 | f <- wrap $ \_ -> putMVar mv () 72 | _ <- R.addInputHandler inputHandlers fd f 0 73 | Just evtmgr <- getSystemEventManager 74 | runRegion $ void $ registerREvents evtmgr 75 | Just () <- timeout 1000000 $ takeMVar mv 76 | freeHaskellFunPtr f 77 | -} 78 | ] 79 | where 80 | withReadFd :: (Fd -> IO ()) -> IO () 81 | withReadFd action = 82 | withSystemTempFile "inline-r-" $ \path h -> do 83 | hPutStrLn h "hello" 84 | hClose h 85 | #if MIN_VERSION_unix(2,8,0) 86 | fd <- openFd path ReadOnly defaultFileFlags{ nonBlock = True } 87 | #else 88 | fd <- openFd path ReadOnly Nothing defaultFileFlags{ nonBlock = True } 89 | #endif 90 | action fd 91 | closeFd fd 92 | #endif 93 | -------------------------------------------------------------------------------- /inline-r/tests/Test/FunPtr.hs: -------------------------------------------------------------------------------- 1 | {-# Language FunctionalDependencies #-} 2 | {-# LANGUAGE UndecidableInstances #-} 3 | {-# Language GADTs #-} 4 | {-# Language TemplateHaskell #-} 5 | {-# Language ViewPatterns #-} 6 | {-# LANGUAGE RankNTypes #-} 7 | {-# LANGUAGE FlexibleInstances #-} 8 | {-# LANGUAGE MultiParamTypeClasses #-} 9 | {-# LANGUAGE DataKinds #-} 10 | {-# LANGUAGE ForeignFunctionInterface #-} 11 | {-# LANGUAGE QuasiQuotes #-} 12 | module Test.FunPtr 13 | ( tests ) 14 | where 15 | 16 | import Control.Memory.Region 17 | import H.Prelude 18 | import qualified Language.R.Internal.FunWrappers as R 19 | import qualified Foreign.R as R 20 | import qualified Foreign.R.Type as SingR 21 | import qualified Language.R.Internal as R (r2) 22 | 23 | import Test.Tasty hiding (defaultMain) 24 | import Test.Tasty.HUnit 25 | 26 | import Control.Applicative 27 | import Control.Concurrent.MVar 28 | import Control.Monad 29 | import Data.ByteString.Char8 30 | import Foreign (FunPtr, castFunPtr) 31 | import System.Mem.Weak 32 | import System.Mem 33 | import Prelude -- silence AMP warning 34 | 35 | data HaveWeak a b = HaveWeak 36 | (R.SEXP0 -> IO R.SEXP0) 37 | (MVar (Weak (FunPtr (R.SEXP0 -> IO R.SEXP0)))) 38 | 39 | foreign import ccall "missing_r.h funPtrToSEXP" funPtrToSEXP 40 | :: FunPtr () -> IO (R.SEXP s 'R.Any) 41 | 42 | instance Literal (HaveWeak a b) 'R.ExtPtr where 43 | mkSEXPIO (HaveWeak a box) = do 44 | z <- R.wrap1 a 45 | putMVar box =<< mkWeakPtr z Nothing 46 | fmap R.unsafeCoerce . funPtrToSEXP . castFunPtr $ z 47 | fromSEXP = error "not now" 48 | 49 | tests :: TestTree 50 | tests = testGroup "funptr" 51 | [ testCase "funptr is freed from R" $ do 52 | ((Nothing @=?) =<<) $ do 53 | hwr <- HaveWeak return <$> newEmptyMVar 54 | _ <- R.withProtected (mkSEXPIO hwr) $ 55 | \sf -> R.withProtected (mkSEXPIO (2::Double)) $ \z -> 56 | return $ R.r2 (Data.ByteString.Char8.pack ".Call") sf z 57 | replicateM_ 10 (R.allocVector SingR.SReal 1024 :: IO (R.SEXP V 'R.Real)) 58 | replicateM_ 10 R.gc 59 | replicateM_ 10 performGC 60 | (\(HaveWeak _ x) -> takeMVar x >>= deRefWeak) hwr 61 | , testCase "funptr works in quasi-quotes" $ 62 | (((2::Double) @=?) =<<) $ runRegion $ do 63 | let foo = (\x -> return $ x + 1) :: Double -> R s Double 64 | s <- [r| foo_hs(1) |] 65 | return $ dynSEXP s 66 | ] 67 | -------------------------------------------------------------------------------- /inline-r/tests/Test/GC.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE QuasiQuotes #-} 3 | 4 | module Test.GC 5 | ( tests ) 6 | where 7 | 8 | import Control.Memory.Region 9 | import H.Prelude 10 | import qualified Foreign.R as R 11 | import qualified Foreign.R.Type as SingR 12 | 13 | import Control.Exception (bracket) 14 | import Test.Tasty hiding (defaultMain) 15 | import Test.Tasty.HUnit 16 | import System.Directory 17 | 18 | import System.Mem (performMajorGC) 19 | 20 | -- These tests only work with a version of R compiled 21 | -- with --enable-strict-barrier. 22 | 23 | tests :: TestTree 24 | tests = testGroup "Automatic values" 25 | [ testCase "Live automatic not collected by GC" $ 26 | bracket getCurrentDirectory setCurrentDirectory $ const $ do 27 | ((assertBool "Automatic value was not collected" . isInt) =<<) $ do 28 | runRegion $ do 29 | x <- automatic =<< io (R.allocVector SingR.SInt 1024 :: IO (R.SEXP V 'R.Int)) 30 | io $ R.gc 31 | return $ R.typeOf x 32 | , testCase "Dead automatic collected by GC" $ 33 | bracket getCurrentDirectory setCurrentDirectory $ const $ do 34 | ((assertBool "Automatic value was collected" . not . isInt) =<<) $ do 35 | runRegion $ do 36 | _ <- [r| gctorture(TRUE) |] 37 | x <- automatic =<< io (R.allocVector SingR.SInt 1024 :: IO (R.SEXP V 'R.Int)) 38 | y <- return $ R.release x 39 | io $ performMajorGC 40 | _ <- io $ R.allocList 1 41 | return $! R.typeOf y 42 | ] 43 | where 44 | isInt (R.Int) = True 45 | isInt _ = False 46 | -------------------------------------------------------------------------------- /inline-r/tests/Test/Matcher.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE QuasiQuotes #-} 2 | {-# LANGUAGE TemplateHaskell #-} 3 | module Test.Matcher 4 | ( tests ) 5 | where 6 | 7 | import Control.Applicative 8 | import Data.Int 9 | import H.Prelude 10 | import qualified Foreign.R as R 11 | import Language.R.Matcher as P 12 | 13 | import Test.Tasty hiding (defaultMain) 14 | import Test.Tasty.HUnit 15 | 16 | tests :: TestTree 17 | tests = testGroup "matcher" 18 | [ testCase "null" $ ((True @=?) =<<) $ do 19 | runRegion $ do 20 | s <- [r| NULL |] 21 | Right t <- matchOnly (P.null *> pure True <|> pure False) s 22 | return t 23 | , testCase "s3: pass non s3" $ ((True @=?) =<<) $ do 24 | runRegion $ do 25 | s <- [r| c(1:10) |] 26 | Right t <- matchOnly (P.s3 ["matrix"] *> pure False <|> pure True) s 27 | return t 28 | , testCase "s3: matches matrix" $ ((True @=?) =<<) $ do 29 | runRegion $ do 30 | s <- [r| x <- matrix(c(1:10)); class(x) <- "shmatrix"; x |] 31 | Right t <- matchOnly (P.s3 ["shmatrix"] *> pure True <|> pure False) s 32 | return t 33 | , testCase "typeOf: reads type" $ ((R.Int @=?) =<<) $ do 34 | runRegion $ do 35 | s <- [r| matrix(c(1:10)) |] 36 | Right t <- matchOnly P.typeOf s 37 | return t 38 | , testCase "guardType: proceeds" $ ((True @=?) =<<) $ do 39 | runRegion $ do 40 | s <- [r| matrix(c(1:10)) |] 41 | Right t <- matchOnly (P.guardType R.Int *> pure True <|> pure False) s 42 | return t 43 | , testCase "guardType: fails" $ ((True @=?) =<<) $ do 44 | runRegion $ do 45 | s <- [r| 1.0 |] 46 | Right t <- matchOnly (P.guardType R.Int *> pure False <|> pure True ) s 47 | return t 48 | , testCase "someAttribute" $ (([2,3::Int32] @=?) =<<) $ do 49 | runRegion $ do 50 | s <- [r| matrix(c(1:6), 2,3) |] 51 | Right t <- matchOnly (P.someAttribute "dim") s 52 | return (fromSEXP (R.cast SInt t)) 53 | , testCase "someAttribute" $ (([2,3::Int32] @=?) =<<) $ do 54 | runRegion $ do 55 | s <- [r| matrix(c(1:6), 2,3) |] 56 | Right t <- matchOnly (P.attribute SInt "dim") s 57 | return (fromSEXP t) 58 | , testCase "getS3Class" $ ((["shmatrix"] @=?) =<<) $ do 59 | runRegion $ do 60 | s <- [r| x <- matrix(c(1:10),2,3); class(x) <- "shmatrix"; x |] 61 | Right t <- matchOnly P.getS3Class s 62 | return t 63 | ] 64 | -------------------------------------------------------------------------------- /inline-r/tests/Test/Regions.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE QuasiQuotes #-} 3 | {-# LANGUAGE CPP #-} 4 | {-# LANGUAGE ForeignFunctionInterface #-} 5 | 6 | module Test.Regions 7 | ( tests ) 8 | where 9 | 10 | import H.Prelude 11 | import qualified Foreign.R as R 12 | 13 | import Test.Tasty hiding (defaultMain) 14 | import Test.Tasty.HUnit 15 | import Foreign 16 | 17 | 18 | #include 19 | 20 | #if defined(R_VERSION) && R_VERSION >= R_Version(3, 1, 0) 21 | foreign import ccall "&R_PPStackTop" ppStackTop :: Ptr Int 22 | #endif 23 | 24 | assertBalancedStack :: IO () -> IO () 25 | #if defined(R_VERSION) && R_VERSION >= R_Version(3, 1, 0) 26 | assertBalancedStack m = do 27 | i <- peek ppStackTop 28 | m 29 | j <- peek ppStackTop 30 | assertEqual "protection stack should be balanced" i j 31 | #else 32 | assertBalancedStack m = do 33 | putStrLn "Warning: Cannot check stack balance on R < 3.1. Disabling check." 34 | m 35 | #endif 36 | 37 | -- XXX these tests are only effective when using a "hardened" version of 38 | -- R compiled with --enable-strict-barrier enabled, and with the R_GCTORTURE 39 | -- environment variable set. 40 | 41 | tests :: TestTree 42 | tests = testGroup "regions" 43 | [ testCase "qq-object-live-inside-extend" $ 44 | assertBalancedStack $ 45 | runRegion $ do 46 | R.SomeSEXP x <- [r| 1 |] 47 | _ <- [r| gc() |] 48 | io $ assertEqual "value is protected" R.Real (R.typeOf x) 49 | , testCase "mksexp-object-live-inside-extend" $ 50 | assertBalancedStack $ 51 | runRegion $ do 52 | x <- mkSEXP (1::Int32) 53 | _ <- [r| gc() |] 54 | io $ assertEqual "value is protected" R.Int (R.typeOf x) 55 | , testCase "runRegion-no-leaked-thunks" $ 56 | ((8 @=?) =<<) $ do 57 | z <- runRegion $ fmap dynSEXP [r| 5+3 |] 58 | _ <- runRegion $ [r| gc() |] >> return () 59 | return (z::Int32) 60 | ] 61 | -------------------------------------------------------------------------------- /inline-r/tests/Test/Scripts.hs: -------------------------------------------------------------------------------- 1 | -- | List of shootout programs to test. In its own module due to TH stage 2 | -- restriction. 3 | 4 | module Test.Scripts where 5 | 6 | import System.FilePath 7 | 8 | scripts :: [FilePath] 9 | scripts = map ("tests/shootout" ) 10 | [ "binarytrees.R" 11 | -- , "fannkuchredux.R" -- XXX takes long 12 | , "fasta.R" 13 | , "fastaredux.R" 14 | -- , "knucleotide.R" -- XXX seems to require command line arguments 15 | , "mandelbrot-noout.R" 16 | -- , "mandelbrot.R" -- XXX produces some binary output which causes readProcess to fail 17 | , "nbody.R" 18 | , "pidigits.R" 19 | -- , "regexdna.R" -- XXX seems to require command line arguments 20 | -- , "reversecomplement.R" -- XXX seems to require command line arguments 21 | , "spectralnorm-math.R" 22 | , "spectralnorm.R" 23 | ] 24 | -------------------------------------------------------------------------------- /inline-r/tests/bench-hexp.hs: -------------------------------------------------------------------------------- 1 | -- A benchmark comparing hexp with integer. 2 | -- 3 | -- To get the lowest results: 4 | -- 5 | -- * define integer as an unsafe foreign call 6 | -- 7 | -- * replace 'System.IO.Unsafe.unsafePerformIO' with 8 | -- 'Control.Monad.Primitive.unsafeInlineIO' in the definition 9 | -- of 'hexp' and 'Foreign.R.typeOf'. 10 | -- 11 | -- * Add an INLINE pragma for peekHExp 12 | -- 13 | -- > {-# INLINE peekHExp #-} 14 | -- 15 | -- * redefine hexp as 16 | -- 17 | -- > hexp :: SEXP a -> HExp a 18 | -- > hexp = unsafeInlineIO . peekHExp 19 | -- > {-# INLINE hexp #-} 20 | -- 21 | {-# LANGUAGE GADTs #-} 22 | {-# LANGUAGE DataKinds #-} 23 | 24 | import Foreign.R (integer, SEXP, SomeSEXP(..)) 25 | import qualified Foreign.R as R (SSEXPTYPE, SEXPTYPE(Int), typeOf, cast) 26 | import H.Prelude (withEmbeddedR, defaultConfig) 27 | import Language.R.Literal (mkSEXPIO) 28 | import Language.R.HExp (hexp, HExp(..)) 29 | import Data.Singletons (sing) 30 | 31 | import Control.Monad.Primitive 32 | import Criterion.Main 33 | import Data.Int 34 | import Data.Vector.SEXP (unsafeIndexM) 35 | import Foreign.Ptr (Ptr) 36 | import Foreign.Storable (peek) 37 | import System.IO.Unsafe (unsafePerformIO) 38 | 39 | 40 | main :: IO () 41 | main = withEmbeddedR H.Prelude.defaultConfig $ do 42 | x <- mkSEXPIO (1 :: Int32) 43 | defaultMain 44 | [ bgroup "vector access" 45 | [ bench "typeof>integer" $ whnfIO $ benchInteger x 46 | , bench "hexp>unsafeIndex" $ whnf benchHExp x 47 | , bench "unsafe-integer" $ whnfIO $ benchUncheckedInteger x 48 | , bench "hexp-cast" $ whnf benchCast (SomeSEXP x) 49 | 50 | -- , bench "unsafePerformIO" $ whnf unsafePerformIO $ return x 51 | -- , bench "unsafeInlineIO" $ whnf unsafeInlineIO $ return x 52 | -- , bench "(+)" $ whnf (\i -> i + 1) (1 :: Int) 53 | , bench "unsafePerformIO" $ whnf unsafePerformIO $ return x 54 | , bench "unsafeInlineIO" $ whnf unsafeInlineIO $ return x 55 | , bench "(+)" $ whnf (\i -> i + 1) (1 :: Int) 56 | ] 57 | ] 58 | 59 | benchInteger :: SEXP s 'R.Int -> IO Int32 60 | benchInteger x = do 61 | case R.typeOf x of 62 | R.Int -> integer x >>= (peek :: Ptr Int32 -> IO Int32) 63 | _ -> error "unexpected SEXP" 64 | 65 | benchHExp :: SEXP s a -> Int32 66 | benchHExp x = 67 | case hexp x of 68 | Int s -> unsafeInlineIO $ s `unsafeIndexM` 0 69 | _ -> error "unexpected SEXP" 70 | 71 | benchUncheckedInteger :: SEXP s 'R.Int -> IO Int32 72 | benchUncheckedInteger x = integer x >>= (peek :: Ptr Int32 -> IO Int32) 73 | 74 | benchCast :: SomeSEXP s -> Int32 75 | benchCast x = 76 | let y = R.cast (sing :: R.SSEXPTYPE 'R.Int) x 77 | in case hexp y of 78 |   Int s -> unsafeInlineIO $ s `unsafeIndexM` 0 79 | -------------------------------------------------------------------------------- /inline-r/tests/bench-qq.hs: -------------------------------------------------------------------------------- 1 | -- Copyright: (C) 2013 Amgen, Inc. 2 | -- 3 | -- This program executes the benchmark of the fib function using R and 4 | -- the compile-time qq. 5 | -- 6 | 7 | {-# LANGUAGE DataKinds #-} 8 | {-# LANGUAGE QuasiQuotes #-} 9 | {-# LANGUAGE ScopedTypeVariables #-} 10 | {-# LANGUAGE TemplateHaskell #-} 11 | {-# LANGUAGE ViewPatterns #-} 12 | 13 | import Foreign.R as R 14 | import Language.R as R 15 | import H.Prelude as H 16 | 17 | import Control.Applicative 18 | import Control.Monad (void) 19 | import Criterion.Main 20 | import Data.Int 21 | import Language.Haskell.TH.Quote 22 | 23 | import System.FilePath 24 | import Prelude -- Silence AMP warning 25 | 26 | fib :: Int -> Int 27 | fib 0 = 0 28 | fib 1 = 1 29 | fib n = fib (n-1) + fib (n-2) 30 | 31 | hFib :: SEXP s 'R.Int -> R s (SEXP s 'R.Int) 32 | hFib n@(H.fromSEXP -> 0 :: Int32) = fmap (flip R.asTypeOf n) [r| 0L |] 33 | hFib n@(H.fromSEXP -> 1 :: Int32) = fmap (flip R.asTypeOf n) [r| 1L |] 34 | hFib n = (`R.asTypeOf` n) <$> [r| hFib_hs(n_hs - 1L) + hFib_hs(n_hs - 2L) |] 35 | 36 | main :: IO () 37 | main = do 38 | H.withEmbeddedR H.defaultConfig $ runRegion $ do 39 | _ <- $(quoteExp (quoteFile r) ("tests" "R" "fib.R")) 40 | io $ defaultMain [ 41 | bgroup "fib" 42 | [ bench "pure Haskell" $ 43 | nf fib 18 44 | , bench "compile-time-qq" $ 45 | nfIO $ runRegion $ do 46 | _ <- [r| fib <<- function(n) {if (n == 1) return(1); if (n == 2) return(2); return(fib(n-1)+fib(n-2))} |] 47 | _ <- [r| fib(18) |] 48 | return () 49 | , bench "compile-time-qq-hybrid" $ 50 | nfIO $ runRegion $ void $ hFib =<< mkSEXP (18 :: Int32) 51 | ] 52 | ] 53 | -------------------------------------------------------------------------------- /inline-r/tests/ghci/qq-benchmarks.ghci: -------------------------------------------------------------------------------- 1 | :set -XDataKinds 2 | :set -XScopedTypeVariables 3 | 4 | :m +Data.Int 5 | import Criterion.Main 6 | import Language.Haskell.TH.Quote 7 | import qualified Foreign.R as R 8 | 9 | import Control.Applicative ((<$>)) 10 | import System.FilePath 11 | 12 | 13 | :{ 14 | let hFib :: Foreign.R.SEXP s Foreign.R.Int -> H.Prelude.R s (Foreign.R.SEXP s Foreign.R.Int) 15 | hFib n@(H.fromSEXP -> (0 :: Int32)) = fmap (flip R.asTypeOf n) [r| as.integer(0) |] 16 | hFib n@(H.fromSEXP -> (1 :: Int32)) = fmap (flip R.asTypeOf n) [r| as.integer(1) |] 17 | hFib n = 18 | (`R.asTypeOf` n) <$> 19 | [r| as.integer(hFib_hs(as.integer(n_hs - 1)) + hFib_hs(as.integer(n_hs - 2))) |] 20 | :} 21 | 22 | $(quoteExp (quoteFile r) ("tests" "R" "fib.R")) 23 | 24 | :{ 25 | defaultMain [ 26 | bgroup "fib" 27 | [ bench "runtime-qq" $ 28 | whnfIO $ [r| fib(10) |] 29 | , bench "runtime-qq-hybrid" $ 30 | whnfIO $ H.unsafeRToIO $ hFib $ H.mkSEXP (10 :: Int32) 31 | ] 32 | ] 33 | :} 34 | -------------------------------------------------------------------------------- /inline-r/tests/shootout/binarytrees.R: -------------------------------------------------------------------------------- 1 | # ------------------------------------------------------------------ 2 | # The Computer Language Shootout 3 | # http://shootout.alioth.debian.org/ 4 | # 5 | # Contributed by Leo Osvald 6 | # ------------------------------------------------------------------ 7 | 8 | tree <- function(item, depth) { 9 | if (depth == 0L) 10 | return(c(item, NA, NA)) 11 | # it is ridiculous that this doesn't help 12 | next_depth <- depth - 1L 13 | right_item <- 2L * item 14 | left_item <- right_item - 1L 15 | return(list(item, 16 | tree(left_item, next_depth), 17 | tree(right_item, next_depth))) 18 | } 19 | 20 | check <- function(tree) 21 | if(is.na(tree[[2]][[1]])) tree[[1]] else tree[[1]] + check(tree[[2]]) - check(tree[[3]]) 22 | 23 | binarytrees <- function(args) { 24 | n = if (length(args)) as.integer(args[[1]]) else 10L 25 | 26 | min_depth <- 4L 27 | max_depth <- max(min_depth + 2L, n) 28 | stretch_depth <- max_depth + 1L 29 | 30 | cat(sep="", "stretch tree of depth ", stretch_depth, "\t check: ", 31 | check(tree(0L, stretch_depth)), "\n") 32 | 33 | long_lived_tree <- tree(0L, max_depth) 34 | 35 | for (depth in seq(min_depth, max_depth, 2L)) { 36 | iterations <- as.integer(2^(max_depth - depth + min_depth)) 37 | check_sum <- sum(sapply( 38 | 1:iterations, 39 | function(i) check(tree(i, depth)) + check(tree(-i, depth)))) 40 | cat(sep="", iterations * 2L, "\t trees of depth ", depth, "\t check: ", 41 | check_sum, "\n") 42 | } 43 | 44 | cat(sep="", "long lived tree of depth ", max_depth, "\t check: ", 45 | check(long_lived_tree), "\n") 46 | } 47 | 48 | if (!exists("i_am_wrapper")) 49 | binarytrees(commandArgs(trailingOnly=TRUE)) 50 | -------------------------------------------------------------------------------- /inline-r/tests/shootout/fannkuchredux.R: -------------------------------------------------------------------------------- 1 | # ------------------------------------------------------------------ 2 | # The Computer Language Shootout 3 | # http://shootout.alioth.debian.org/ 4 | # 5 | # Contributed by Leo Osvald 6 | # ------------------------------------------------------------------ 7 | 8 | fannkuch <- function(n) { 9 | one_two = c(1, 2) 10 | two_one = c(2, 1) 11 | two_three = c(2, 3) 12 | three_two = c(3, 2) 13 | if (n > 3L) 14 | rxrange = 3:(n - 1) 15 | else 16 | rxrange = integer(0) 17 | 18 | max_flip_count <- 0L 19 | perm_sign <- TRUE 20 | checksum <- 0L 21 | perm1 <- 1:n 22 | count <- 0:(n - 1L) 23 | while (TRUE) { 24 | if (k <- perm1[[1L]]) { 25 | perm <- perm1 26 | flip_count <- 1L 27 | while ((kk <- perm[[k]]) > 1L) { 28 | k_range = 1:k 29 | perm[k_range] <- rev.default(perm[k_range]) 30 | flip_count <- flip_count + 1L 31 | k <- kk 32 | kk <- perm[[kk]] 33 | } 34 | max_flip_count <- max(max_flip_count, flip_count) 35 | checksum <- checksum + if (perm_sign) flip_count else -flip_count 36 | } 37 | 38 | # Use incremental change to generate another permutation 39 | if (perm_sign) { 40 | perm1[one_two] <- perm1[two_one] 41 | perm_sign = FALSE 42 | } else { 43 | perm1[two_three] <- perm1[three_two] 44 | perm_sign = TRUE 45 | was_break <- FALSE 46 | for (r in rxrange) { 47 | if (count[[r]]) { 48 | was_break <- TRUE 49 | break 50 | } 51 | count[[r]] <- r - 1L 52 | perm0 <- perm1[[1L]] 53 | perm1[1:r] <- perm1[2:(r + 1L)] 54 | perm1[[r + 1L]] <- perm0 55 | } 56 | if (!was_break) { 57 | r <- n 58 | if (!count[[r]]) { 59 | cat(checksum, "\n", sep="") 60 | return(max_flip_count) 61 | } 62 | } 63 | count[[r]] <- count[[r]] - 1L 64 | } 65 | } 66 | } 67 | 68 | fannkuchredux <- function(args) { 69 | n = if (length(args)) as.integer(args[[1]]) else 12L 70 | cat("Pfannkuchen(", n, ") = ", fannkuch(n), "\n", sep="") 71 | } 72 | 73 | if (!exists("i_am_wrapper")) 74 | fannkuchredux(commandArgs(trailingOnly=TRUE)) 75 | -------------------------------------------------------------------------------- /inline-r/tests/shootout/fasta.R: -------------------------------------------------------------------------------- 1 | # ------------------------------------------------------------------ 2 | # The Computer Language Shootout 3 | # http://shootout.alioth.debian.org/ 4 | # 5 | # Contributed by Leo Osvald 6 | # ------------------------------------------------------------------ 7 | width <- 60L 8 | myrandom_last <- 42L 9 | myrandom <- function(m) { 10 | myrandom_last <<- (myrandom_last * 3877L + 29573L) %% 139968L 11 | return(m * myrandom_last / 139968) 12 | } 13 | 14 | alu <- paste( 15 | "GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGG", 16 | "GAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGA", 17 | "CCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAAT", 18 | "ACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCA", 19 | "GCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGG", 20 | "AGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCC", 21 | "AGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAA", 22 | sep="", collapse="") 23 | 24 | iub <- matrix(c( 25 | c(0.27, 'a'), 26 | c(0.12, 'c'), 27 | c(0.12, 'g'), 28 | c(0.27, 't'), 29 | c(0.02, 'B'), 30 | c(0.02, 'D'), 31 | c(0.02, 'H'), 32 | c(0.02, 'K'), 33 | c(0.02, 'M'), 34 | c(0.02, 'N'), 35 | c(0.02, 'R'), 36 | c(0.02, 'S'), 37 | c(0.02, 'V'), 38 | c(0.02, 'W'), 39 | c(0.02, 'Y') 40 | ), 2) 41 | 42 | homosapiens <- matrix(c( 43 | c(0.3029549426680, 'a'), 44 | c(0.1979883004921, 'c'), 45 | c(0.1975473066391, 'g'), 46 | c(0.3015094502008, 't') 47 | ), 2) 48 | 49 | repeat_fasta <- function(s, count) { 50 | chars <- strsplit(s, split="")[[1]] 51 | len <- nchar(s) 52 | s2 <- c(chars, chars[1:width]) 53 | pos <- 1L 54 | while (count) { 55 | line <- min(width, count) 56 | next_pos <- pos + line 57 | cat(s2[pos:(next_pos - 1)], "\n", sep="") 58 | pos <- next_pos 59 | if (pos > len) pos <- pos - len 60 | count <- count - line 61 | } 62 | } 63 | 64 | random_fasta <- function(genelist, count) { 65 | psum <- cumsum(genelist[1,]) 66 | while (count) { 67 | line <- min(width, count) 68 | 69 | rs <- double(line) 70 | for (i in 1:line) 71 | rs[[i]] <- myrandom(1) 72 | 73 | cat(genelist[2, colSums(outer(psum, rs, "<")) + 1], "\n", sep='') 74 | count <- count - line 75 | } 76 | } 77 | 78 | fasta <- function(args) { 79 | n = if (length(args)) as.integer(args[[1]]) else 1000L 80 | cat(">ONE Homo sapiens alu\n") 81 | repeat_fasta(alu, 2 * n) 82 | cat(">TWO IUB ambiguity codes\n") 83 | random_fasta(iub, 3L * n) 84 | cat(">THREE Homo sapiens frequency\n") 85 | random_fasta(homosapiens, 5L * n) 86 | } 87 | 88 | if (!exists("i_am_wrapper")) 89 | fasta(commandArgs(trailingOnly=TRUE)) 90 | -------------------------------------------------------------------------------- /inline-r/tests/shootout/fastaredux.R: -------------------------------------------------------------------------------- 1 | # ------------------------------------------------------------------ 2 | # The Computer Language Shootout 3 | # http://shootout.alioth.debian.org/ 4 | # 5 | # Contributed by Leo Osvald 6 | # ------------------------------------------------------------------ 7 | width = 60L 8 | lookup_size = 4096L 9 | lookup_scale = as.double(lookup_size - 1L) 10 | 11 | alu = paste( 12 | "GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGG", 13 | "GAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGA", 14 | "CCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAAT", 15 | "ACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCA", 16 | "GCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGG", 17 | "AGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCC", 18 | "AGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAA", 19 | sep="", collapse="") 20 | 21 | iub = matrix(c( 22 | c(0.27, 'a'), 23 | c(0.12, 'c'), 24 | c(0.12, 'g'), 25 | c(0.27, 't'), 26 | c(0.02, 'B'), 27 | c(0.02, 'D'), 28 | c(0.02, 'H'), 29 | c(0.02, 'K'), 30 | c(0.02, 'M'), 31 | c(0.02, 'N'), 32 | c(0.02, 'R'), 33 | c(0.02, 'S'), 34 | c(0.02, 'V'), 35 | c(0.02, 'W'), 36 | c(0.02, 'Y') 37 | ), 2) 38 | 39 | homosapiens = matrix(c( 40 | c(0.3029549426680, 'a'), 41 | c(0.1979883004921, 'c'), 42 | c(0.1975473066391, 'g'), 43 | c(0.3015094502008, 't') 44 | ), 2) 45 | 46 | random <- 42L 47 | random_next_lookup <- function() { 48 | random <<- (random * 3877L + 29573L) %% 139968L 49 | return(random * (lookup_scale / 139968)) # TODO 50 | } 51 | 52 | repeat_fasta <- function(s, count) { 53 | chars = strsplit(s, split="")[[1]] 54 | len = nchar(s) 55 | s2 = c(chars, chars[1:width]) 56 | pos <- 1L 57 | while (count) { 58 | line = min(width, count) 59 | next_pos <- pos + line 60 | cat(s2[pos:(next_pos - 1)], "\n", sep="") 61 | pos <- next_pos 62 | if (pos > len) pos <- pos - len 63 | count <- count - line 64 | } 65 | } 66 | 67 | random_fasta <- function(genelist, count) { 68 | n = ncol(genelist) 69 | lookup <- integer(lookup_size) 70 | cprob_lookup <- cumsum(genelist[1, ]) * lookup_scale 71 | cprob_lookup[[n]] <- lookup_size - 1 72 | 73 | j <- 1L 74 | for (i in 1:lookup_size) { 75 | while (cprob_lookup[[j]] + 1L < i) 76 | j <- j + 1L 77 | lookup[[i]] <- j 78 | } 79 | 80 | while (count) { 81 | line <- min(width, count) 82 | 83 | rs <- double(line) 84 | for (i in 1:line) 85 | rs[[i]] <- random_next_lookup() 86 | 87 | inds <- lookup[rs + 1L] 88 | missed <- which(cprob_lookup[inds] < rs) 89 | if (length(missed)) 90 | repeat { 91 | inds[missed] <- inds[missed] + 1L 92 | missed <- which(cprob_lookup[inds] < rs) 93 | if (!length(missed)) 94 | break 95 | } 96 | 97 | cat(paste(genelist[2, inds], collapse="", sep=""), "\n", sep="") 98 | count <- count - line 99 | } 100 | 101 | } 102 | 103 | fastaredux <- function(args) { 104 | n = if (length(args)) as.integer(args[[1]]) else 1000L 105 | cat(">ONE Homo sapiens alu\n") 106 | repeat_fasta(alu, 2 * n) 107 | cat(">TWO IUB ambiguity codes\n") 108 | random_fasta(iub, 3L * n) 109 | cat(">THREE Homo sapiens frequency\n") 110 | random_fasta(homosapiens, 5L * n) 111 | } 112 | 113 | if (!exists("i_am_wrapper")) 114 | fastaredux(commandArgs(trailingOnly=TRUE)) 115 | -------------------------------------------------------------------------------- /inline-r/tests/shootout/knucleotide.R: -------------------------------------------------------------------------------- 1 | # ------------------------------------------------------------------ 2 | # The Computer Language Shootout 3 | # http://shootout.alioth.debian.org/ 4 | # 5 | # Contributed by Leo Osvald 6 | # ------------------------------------------------------------------ 7 | 8 | gen_freq <- function(seq, frame) { 9 | frame <- frame - 1L 10 | ns <- length(seq) - frame 11 | h <- new.env(emptyenv(), hash=TRUE) 12 | for (i in 1:ns) { 13 | subseq_str = paste(seq[i:(i + frame)], collapse="", sep="") 14 | if (exists(subseq_str, h, inherits=FALSE)) 15 | cnt <- get(subseq_str, h, inherits=FALSE) 16 | else 17 | cnt <- 0L 18 | assign(subseq_str, cnt + 1L, h) 19 | } 20 | return(sapply(ls(h), function(k) get(k, h, inherits=FALSE))) 21 | } 22 | 23 | sort_seq <- function(seq, len) { 24 | fs <- gen_freq(seq, len) 25 | seqs <- names(fs) 26 | inds <- order(-fs, seqs) 27 | cat(paste.(seqs[inds], 100 * fs[inds] / sum(fs), collapse="\n", digits=3), 28 | "\n") 29 | } 30 | 31 | find_seq <- function(seq, s) { 32 | freqs <- gen_freq(seq, nchar(s)) 33 | if (s %in% names(freqs)) 34 | return(freqs[[s]]) 35 | return(0L) 36 | } 37 | 38 | knucleotide <- function(args) { 39 | in_filename = args[[1]] 40 | f <- file(in_filename, "r") 41 | while (length(line <- readLines(f, n=1, warn=FALSE))) { 42 | first_char <- substr(line, 1L, 1L) 43 | if (first_char == '>' || first_char == ';') 44 | if (substr(line, 2L, 3L) == 'TH') 45 | break 46 | } 47 | 48 | n <- 0L 49 | cap <- 8L 50 | str_buf <- character(cap) 51 | while (length(line <- scan(f, what="", nmax=1, quiet=TRUE))) { 52 | first_char <- substr(line, 1L, 1L) 53 | if (first_char == '>' || first_char == ';') 54 | break 55 | n <- n + 1L 56 | # ensure O(N) resizing (instead of O(N^2)) 57 | str_buf[[cap <- if (cap < n) 2L * cap else cap]] <- "" 58 | str_buf[[n]] <- line 59 | } 60 | length(str_buf) <- n 61 | close(f) 62 | seq <- strsplit(paste(str_buf, collapse=""), split="")[[1]] 63 | 64 | for (frame in 1:2) 65 | sort_seq(seq, frame) 66 | for (s in c("GGT", "GGTA", "GGTATT", "GGTATTTTAATT", "GGTATTTTAATTTATAGT")) 67 | cat(find_seq(seq, tolower(s)), sep="\t", s, "\n") 68 | } 69 | 70 | paste. <- function (..., digits=16, sep=" ", collapse=NULL) { 71 | args <- list(...) 72 | if (length(args) == 0) 73 | if (length(collapse) == 0) character(0) 74 | else "" 75 | else { 76 | for(i in seq(along=args)) 77 | if(is.numeric(args[[i]])) 78 | args[[i]] <- as.character(round(args[[i]], digits)) 79 | else args[[i]] <- as.character(args[[i]]) 80 | .Internal(paste(args, sep, collapse)) 81 | } 82 | } 83 | 84 | if (!exists("i_am_wrapper")) 85 | knucleotide(commandArgs(trailingOnly=TRUE)) 86 | -------------------------------------------------------------------------------- /inline-r/tests/shootout/mandelbrot-noout.R: -------------------------------------------------------------------------------- 1 | # ------------------------------------------------------------------ 2 | # The Computer Language Shootout 3 | # http://shootout.alioth.debian.org/ 4 | # 5 | # Contributed by Leo Osvald 6 | # ------------------------------------------------------------------ 7 | 8 | lim <- 2 9 | iter <- 50 10 | # Turn off warnings that appear on Windows, so that we can compare 11 | # the output without the warning messages. 12 | options ( warn = -1) 13 | 14 | mandelbrot_noout <- function(args) { 15 | # Turn off warnings that appear on Windows, so that we can compare 16 | # the output without the warning messages. 17 | options ( warn = -1) 18 | n = if (length(args)) as.integer(args[[1]]) else 200L 19 | n_mod8 = n %% 8L 20 | pads <- if (n_mod8) rep.int(0, 8L - n_mod8) else integer(0) 21 | p <- rep(as.integer(rep.int(2, 8) ^ (7:0)), length.out=n) 22 | 23 | cat("P4\n") 24 | cat(n, n, "\n") 25 | for (y in 0:(n-1)) { 26 | c <- 2 * 0:(n-1) / n - 1.5 + 1i * (2 * y / n - 1) 27 | z <- rep(0+0i, n) 28 | i <- 0L 29 | while (i < 50) { # faster than for loop 30 | z <- z * z + c 31 | i <- i + 1L 32 | } 33 | bits <- as.integer(abs(z) <= 2) 34 | bytes <- as.raw(colSums(matrix(c(bits * p, pads), 8L))) 35 | } 36 | } 37 | 38 | if (!exists("i_am_wrapper")) 39 | mandelbrot_noout(commandArgs(trailingOnly=TRUE)) 40 | -------------------------------------------------------------------------------- /inline-r/tests/shootout/mandelbrot.R: -------------------------------------------------------------------------------- 1 | # ------------------------------------------------------------------ 2 | # The Computer Language Shootout 3 | # http://shootout.alioth.debian.org/ 4 | # 5 | # Contributed by Leo Osvald 6 | # ------------------------------------------------------------------ 7 | 8 | lim <- 2 9 | iter <- 50 10 | 11 | mandelbrot <- function(args) { 12 | n = if (length(args)) as.integer(args[[1]]) else 200L 13 | n_mod8 = n %% 8L 14 | pads <- if (n_mod8) rep.int(0, 8L - n_mod8) else integer(0) 15 | p <- rep(as.integer(rep.int(2, 8) ^ (7:0)), length.out=n) 16 | 17 | cat("P4\n") 18 | cat(n, n, "\n") 19 | bin_con <- pipe("cat", "wb") 20 | for (y in 0:(n-1)) { 21 | c <- 2 * 0:(n-1) / n - 1.5 + 1i * (2 * y / n - 1) 22 | z <- rep(0+0i, n) 23 | i <- 0L 24 | while (i < iter) { # faster than for loop 25 | z <- z * z + c 26 | i <- i + 1L 27 | } 28 | bits <- as.integer(abs(z) <= lim) 29 | bytes <- as.raw(colSums(matrix(c(bits * p, pads), 8L))) 30 | writeBin(bytes, bin_con) 31 | flush(bin_con) 32 | } 33 | } 34 | 35 | if (!exists("i_am_wrapper")) 36 | mandelbrot(commandArgs(trailingOnly=TRUE)) 37 | -------------------------------------------------------------------------------- /inline-r/tests/shootout/nbody.R: -------------------------------------------------------------------------------- 1 | # ------------------------------------------------------------------ 2 | # The Computer Language Shootout 3 | # http://shootout.alioth.debian.org/ 4 | # 5 | # Contributed by Leo Osvald 6 | # ------------------------------------------------------------------ 7 | 8 | pi <- 3.141592653589793 9 | solar_mass <- 4 * pi * pi 10 | days_per_year <- 365.24 11 | n_bodies <- 5 12 | 13 | body_x <- c( 14 | 0, # sun 15 | 4.84143144246472090e+00, # jupiter 16 | 8.34336671824457987e+00, # saturn 17 | 1.28943695621391310e+01, # uranus 18 | 1.53796971148509165e+01 # neptune 19 | ) 20 | body_y <- c( 21 | 0, # sun 22 | -1.16032004402742839e+00, # jupiter 23 | 4.12479856412430479e+00, # saturn 24 | -1.51111514016986312e+01, # uranus 25 | -2.59193146099879641e+01 # neptune 26 | ) 27 | body_z <- c( 28 | 0, # sun 29 | -1.03622044471123109e-01, # jupiter 30 | -4.03523417114321381e-01, # saturn 31 | -2.23307578892655734e-01, # uranus 32 | 1.79258772950371181e-01 # neptune 33 | ) 34 | 35 | body_vx <- c( 36 | 0, # sun 37 | 1.66007664274403694e-03 * days_per_year, # jupiter 38 | -2.76742510726862411e-03 * days_per_year, # saturn 39 | 2.96460137564761618e-03 * days_per_year, # uranus 40 | 2.68067772490389322e-03 * days_per_year # neptune 41 | ) 42 | body_vy <- c( 43 | 0, # sun 44 | 7.69901118419740425e-03 * days_per_year, # jupiter 45 | 4.99852801234917238e-03 * days_per_year, # saturn 46 | 2.37847173959480950e-03 * days_per_year, # uranus 47 | 1.62824170038242295e-03 * days_per_year # neptune 48 | ) 49 | body_vz <- c( 50 | 0, # sun 51 | -6.90460016972063023e-05 * days_per_year, # jupiter 52 | 2.30417297573763929e-05 * days_per_year, # saturn 53 | -2.96589568540237556e-05 * days_per_year, # uranus 54 | -9.51592254519715870e-05 * days_per_year # neptune 55 | ) 56 | 57 | body_mass <- c( 58 | solar_mass, # sun 59 | 9.54791938424326609e-04 * solar_mass, # jupiter 60 | 2.85885980666130812e-04 * solar_mass, # saturn 61 | 4.36624404335156298e-05 * solar_mass, # uranus 62 | 5.15138902046611451e-05 * solar_mass # neptune 63 | ) 64 | 65 | offset_momentum <- function() { 66 | body_vx[[1]] <<- -sum(body_vx * body_mass) / solar_mass 67 | body_vy[[1]] <<- -sum(body_vy * body_mass) / solar_mass 68 | body_vz[[1]] <<- -sum(body_vz * body_mass) / solar_mass 69 | } 70 | 71 | advance <- function(dt) { 72 | dxx <- outer(body_x, body_x, "-") # ~2x faster then nested for loops 73 | dyy <- outer(body_y, body_y, "-") 74 | dzz <- outer(body_z, body_z, "-") 75 | distance <- sqrt(dxx * dxx + dyy * dyy + dzz * dzz) 76 | mag <- dt / (distance * distance * distance) # ~fast as distance^3 77 | diag(mag) <- 0 78 | body_vx <<- body_vx - as.vector((dxx * mag) %*% body_mass) 79 | body_vy <<- body_vy - as.vector((dyy * mag) %*% body_mass) 80 | body_vz <<- body_vz - as.vector((dzz * mag) %*% body_mass) 81 | body_x <<- body_x + dt * body_vx 82 | body_y <<- body_y + dt * body_vy 83 | body_z <<- body_z + dt * body_vz 84 | } 85 | 86 | energy <- function() { 87 | dxx <- outer(body_x, body_x, "-") 88 | dyy <- outer(body_y, body_y, "-") 89 | dzz <- outer(body_z, body_z, "-") 90 | distance <- sqrt(dxx * dxx + dyy * dyy + dzz * dzz) 91 | q <- (body_mass %o% body_mass) / distance 92 | return(sum(0.5 * body_mass * 93 | (body_vx * body_vx + body_vy * body_vy + body_vz * body_vz)) - 94 | sum(q[upper.tri(q)])) 95 | } 96 | 97 | nbody <- function(args) { 98 | n = if (length(args)) as.integer(args[[1]]) else 1000L 99 | options(digits=9) 100 | offset_momentum() 101 | cat(energy(), "\n") 102 | for (i in 1:n) 103 | advance(0.01) 104 | cat(energy(), "\n") 105 | } 106 | 107 | if (!exists("i_am_wrapper")) 108 | nbody(commandArgs(trailingOnly=TRUE)) 109 | -------------------------------------------------------------------------------- /inline-r/tests/shootout/regexdna.R: -------------------------------------------------------------------------------- 1 | # ------------------------------------------------------------------ 2 | # The Computer Language Shootout 3 | # http://shootout.alioth.debian.org/ 4 | # 5 | # Contributed by Leo Osvald 6 | # ------------------------------------------------------------------ 7 | 8 | pattern1 <- c( 9 | "agggtaaa|tttaccct", 10 | "[cgt]gggtaaa|tttaccc[acg]", 11 | "a[act]ggtaaa|tttacc[agt]t", 12 | "ag[act]gtaaa|tttac[agt]ct", 13 | "agg[act]taaa|ttta[agt]cct", 14 | "aggg[acg]aaa|ttt[cgt]ccct", 15 | "agggt[cgt]aa|tt[acg]accct", 16 | "agggta[cgt]a|t[acg]taccct", 17 | "agggtaa[cgt]|[acg]ttaccct") 18 | 19 | pattern2 <- matrix(c( 20 | c("B", "(c|g|t)"), 21 | c("D", "(a|g|t)"), 22 | c("H", "(a|c|t)"), 23 | c("K", "(g|t)"), 24 | c("M", "(a|c)"), 25 | c("N", "(a|c|g|t)"), 26 | c("R", "(a|g)"), 27 | c("S", "(c|g)"), 28 | c("V", "(a|c|g)"), 29 | c("W", "(a|t)"), 30 | c("Y", "(c|t)") 31 | ), ncol=2, byrow=TRUE) 32 | 33 | match_count <- function(ms) { 34 | l <- length(ms[[1]]) 35 | fst <- ms[[1]][[1]] 36 | return(if (l > 1) l else if (fst != -1L) fst else 0) 37 | } 38 | 39 | regexdna <- function(args) { 40 | in_filename = args[[1]] 41 | f <- file(in_filename, "r") 42 | str <- paste(c(readLines(f), ""), collapse="\n") 43 | close(f) 44 | 45 | len1 <- nchar(str) 46 | str <- gsub(">.*\n|\n", "", str, perl=TRUE, useBytes=TRUE) 47 | len2 <- nchar(str) 48 | 49 | for (pat in pattern1) 50 | cat(pat, match_count(gregexpr(pat, str, useBytes=TRUE)), "\n") 51 | 52 | for (i in 1:nrow(pattern2)) 53 | str <- gsub(pattern2[[i, 1]], pattern2[[i, 2]], str, perl=TRUE, 54 | useBytes=TRUE) 55 | 56 | cat("", len1, len2, nchar(str), sep="\n") 57 | } 58 | 59 | if (!exists("i_am_wrapper")) 60 | regexdna(commandArgs(trailingOnly=TRUE)) 61 | -------------------------------------------------------------------------------- /inline-r/tests/shootout/reversecomplement.R: -------------------------------------------------------------------------------- 1 | # ------------------------------------------------------------------ 2 | # The Computer Language Shootout 3 | # http://shootout.alioth.debian.org/ 4 | # 5 | # Contributed by Leo Osvald 6 | # ------------------------------------------------------------------ 7 | 8 | codes <- c( 9 | "A", "C", "G", "T", "U", "M", "R", "W", "S", "Y", "K", "V", "H", "D", "B", 10 | "N") 11 | complements <- c( 12 | "T", "G", "C", "A", "A", "K", "Y", "W", "S", "R", "M", "B", "D", "H", "V", 13 | "N") 14 | comp_map <- NULL 15 | comp_map[codes] <- complements 16 | comp_map[tolower(codes)] <- complements 17 | 18 | reversecomplement <- function(args) { 19 | in_filename = args[[1]] 20 | f <- file(in_filename, "r") 21 | while (length(s <- readLines(f, n=1, warn=FALSE))) { 22 | codes <- strsplit(s, split="")[[1]] 23 | if (codes[[1]] == '>') 24 | cat(s, "\n", sep="") 25 | else { 26 | cat(paste(comp_map[codes], collapse=""), "\n", sep="") 27 | } 28 | } 29 | close(f) 30 | } 31 | 32 | if (!exists("i_am_wrapper")) 33 | reversecomplement(commandArgs(trailingOnly=TRUE)) 34 | -------------------------------------------------------------------------------- /inline-r/tests/shootout/spectralnorm-math.R: -------------------------------------------------------------------------------- 1 | # ------------------------------------------------------------------ 2 | # The Computer Language Shootout 3 | # http://shootout.alioth.debian.org/ 4 | # 5 | # Contributed by Leo Osvald 6 | # ------------------------------------------------------------------ 7 | 8 | spectralnorm_math <- function(args) { 9 | n = if (length(args)) as.integer(args[[1]]) else 100L 10 | options(digits=10) 11 | 12 | eval_A <- function(i, j) 1 / ((i + j - 2) * (i + j - 1) / 2 + i) 13 | 14 | m <- outer(seq(n), seq(n), FUN=eval_A) 15 | cat(sqrt(max(eigen(t(m) %*% m)$val)), "\n") 16 | } 17 | 18 | if (!exists("i_am_wrapper")) 19 | spectralnorm_math(commandArgs(trailingOnly=TRUE)) 20 | -------------------------------------------------------------------------------- /inline-r/tests/shootout/spectralnorm.R: -------------------------------------------------------------------------------- 1 | # ------------------------------------------------------------------ 2 | # The Computer Language Shootout 3 | # http://shootout.alioth.debian.org/ 4 | # 5 | # Contributed by Leo Osvald 6 | # ------------------------------------------------------------------ 7 | 8 | spectralnorm <- function(args) { 9 | n = if (length(args)) as.integer(args[[1]]) else 100L 10 | options(digits=10) 11 | 12 | eval_A <- function(i, j) 1 / ((i + j) * (i + j + 1) / 2 + i + 1) 13 | eval_A_times_u <- function(u) { 14 | ret <- double(n) 15 | for (i in 0:n1) { 16 | eval_A_col <- double(n) 17 | for (j in 0:n1) 18 | eval_A_col[[j + 1]] <- eval_A(i, j) 19 | ret[[i + 1]] <- u %*% eval_A_col 20 | } 21 | return(ret) 22 | } 23 | eval_At_times_u <- function(u) { 24 | ret <- double(n) 25 | for (i in 0:n1) { 26 | eval_At_col <- double(n) 27 | for (j in 0:n1) 28 | eval_At_col[[j + 1]] <- eval_A(j, i) 29 | ret[[i + 1]] <- u %*% eval_At_col 30 | } 31 | return(ret) 32 | } 33 | eval_AtA_times_u <- function(u) eval_At_times_u(eval_A_times_u(u)) 34 | 35 | n1 <- n - 1 36 | u <- rep(1, n) 37 | v <- rep(0, n) 38 | for (itr in seq(10)) { 39 | v <- eval_AtA_times_u(u) 40 | u <- eval_AtA_times_u(v) 41 | } 42 | 43 | cat(sqrt(sum(u * v) / sum(v * v)), "\n") 44 | } 45 | 46 | if (!exists("i_am_wrapper")) 47 | spectralnorm(commandArgs(trailingOnly=TRUE)) 48 | -------------------------------------------------------------------------------- /inline-r/tests/test-env1.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import qualified Language.R.Instance as R 4 | 5 | import System.Environment 6 | import Test.Tasty 7 | import Test.Tasty.HUnit 8 | 9 | tests :: TestTree 10 | tests = testCase "initialize respects R_LIBS env" $ do 11 | let somePath = "bogusfasdfassomePath" 12 | setEnv "R_LIBS" somePath 13 | _ <- R.initialize R.defaultConfig 14 | (somePath @=?) =<< getEnv "R_LIBS" 15 | 16 | main :: IO () 17 | main = defaultMain tests 18 | -------------------------------------------------------------------------------- /inline-r/tests/test-env2.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE QuasiQuotes #-} 2 | module Main where 3 | 4 | import H.Prelude as H 5 | import qualified Language.R.Instance as R 6 | 7 | import System.Environment.Blank as BlankEnv 8 | import Test.Tasty 9 | import Test.Tasty.HUnit 10 | 11 | tests :: TestTree 12 | tests = testCase "blank R_LIBS does not affect R's stdlib" $ do 13 | -- use an explcitly blank env R_LIBS="", see `System.Environment.setEnv` 14 | BlankEnv.setEnv "R_LIBS" "" True 15 | _ <- R.initialize R.defaultConfig 16 | ("TRUE" @=?) =<< runRegion 17 | (fromSomeSEXP <$> [r| deparse(.libPaths() == normalizePath(.Library,winslash="/")) |] :: R s String) 18 | 19 | main :: IO () 20 | main = defaultMain tests 21 | -------------------------------------------------------------------------------- /inline-r/tests/test-qq.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Copyright: (C) 2013 Amgen, Inc. 3 | -- 4 | -- Run H on a number of R programs of increasing size and complexity, comparing 5 | -- the output of H with the output of R. 6 | 7 | {-# LANGUAGE DataKinds #-} 8 | {-# LANGUAGE QuasiQuotes #-} 9 | {-# LANGUAGE ScopedTypeVariables #-} 10 | {-# LANGUAGE TemplateHaskell #-} 11 | {-# LANGUAGE ViewPatterns #-} 12 | {-# LANGUAGE OverloadedStrings #-} 13 | 14 | module Main where 15 | 16 | import qualified Foreign.R as R 17 | import H.Prelude as H 18 | import qualified Data.Vector.SEXP as SVector 19 | import qualified Data.Vector.SEXP.Mutable as SMVector 20 | import Control.Memory.Region 21 | import Data.Text (Text) 22 | 23 | import Control.Applicative 24 | import Control.Monad.Trans (liftIO) 25 | import Data.Int 26 | import Data.Singletons (sing) 27 | import Test.Tasty.HUnit hiding ((@=?)) 28 | import Prelude -- Silence AMP warning 29 | 30 | hFib :: SEXP s 'R.Int -> R s (SEXP s 'R.Int) 31 | hFib n@(H.fromSEXP -> 0 :: Int32) = fmap (flip R.asTypeOf n) [r| 0L |] 32 | hFib n@(H.fromSEXP -> 1 :: Int32) = fmap (flip R.asTypeOf n) [r| 1L |] 33 | hFib n = (`R.asTypeOf` n) <$> [r| hFib_hs(n_hs - 1L) + hFib_hs(n_hs - 2L) |] 34 | 35 | -- | Version of '(@=?)' that works in the R monad. 36 | (@=?) :: Literal a b => String -> a -> R s () 37 | expected @=? actual = liftIO $ do 38 | let actualstr = cast SString [rsafe| deparse(actual_hs) |] 39 | assertEqual "" expected (fromSEXP actualstr) 40 | 41 | main :: IO () 42 | main = H.withEmbeddedR H.defaultConfig $ H.runRegion $ do 43 | 44 | -- Placing it before enabling gctorture2 for speed. 45 | ("4181L" @=?) =<< hFib =<< H.mkSEXP (19 :: Int32) 46 | 47 | _ <- [r| gctorture2(1,0,TRUE) |] 48 | 49 | ("1" @=?) =<< [r| 1 |] 50 | 51 | ("1" @=?) =<< return [rsafe| 1 |] 52 | 53 | ("3" @=?) =<< [r| 1 + 2 |] 54 | 55 | ("3" @=?) =<< return [rsafe| base::`+`(1, 2) |] 56 | 57 | ("c(\"1\", \"2\", \"3\")" @=?) =<< [r| c(1,2,"3") |] 58 | 59 | ("2" @=?) =<< [r| x <<- 2 |] 60 | 61 | ("3" @=?) =<< [r| x+1 |] 62 | 63 | let y = (5::Double) 64 | ("6" @=?) =<< [r| y_hs + 1 |] 65 | 66 | _ <- [r| z <<- function(y) y_hs + y |] 67 | ("8" @=?) =<< [r| z(3) |] 68 | 69 | ("1:10" @=?) =<< [r| y <<- c(1:10) |] 70 | 71 | let foo1 = (\x -> (return $ x+1 :: R s Double)) 72 | let foo2 = (\x -> (return $ map (+1) x :: R s [Int32])) 73 | 74 | ("3" @=?) =<< [r| mapply(foo1_hs, 2) |] 75 | 76 | ("2:11" @=?) =<< [r| mapply(foo2_hs, y) |] 77 | 78 | ("43" @=?) =<< [r| x <<- 42 ; x + 1 |] 79 | 80 | let xs = [1,2,3]::[Double] 81 | ("c(1, 2, 3)" @=?) =<< [r| xs_hs |] 82 | 83 | ("8" @=?) =<< [r| foo1_hs(7) |] 84 | 85 | ("NULL" @=?) H.nilValue 86 | 87 | let foo3 = (\n -> fmap fromSomeSEXP [r| n_hs |]) :: Int32 -> R s Int32 88 | ("3L" @=?) =<< [r| foo3_hs(3L) |] 89 | 90 | let foo4 = (\n m -> return $ n + m) :: Double -> Double -> R s Double 91 | ("99" @=?) =<< [r| foo4_hs(33, 66) |] 92 | 93 | let fact (0 :: Int32) = return 1 :: R s Int32 94 | fact n = fmap dynSEXP [r| n_hs * fact_hs(n_hs - 1L) |] 95 | ("120L" @=?) =<< [r| fact_hs(5L) |] 96 | 97 | let foo5 = \(n :: Int32) -> return (n+1) :: R s Int32 98 | let apply :: R.SEXP s 'R.Closure -> Int32 -> R s (R.SomeSEXP s) 99 | apply n m = [r| n_hs(m_hs) |] 100 | ("29L" @=?) =<< [r| apply_hs(foo5_hs, 28L ) |] 101 | 102 | -- test Vector literal instance 103 | v1 <- do 104 | x <- SMVector.new 3 :: R s (SMVector.MVector s 'R.Int Int32) 105 | SMVector.unsafeWrite x 0 1 106 | SMVector.unsafeWrite x 1 2 107 | SMVector.unsafeWrite x 2 3 108 | return x 109 | let v2 = SMVector.release v1 :: SMVector.MVector V 'R.Int Int32 110 | ("c(7, 2, 3)" @=?) =<< [r| v = v2_hs; v[1] <- 7; v |] 111 | io . assertEqual "" "fromList [1,2,3]" . Prelude.show =<< SVector.unsafeFreeze v1 112 | 113 | let utf8string = "abcd çéõßø" :: String 114 | io . assertEqual "" utf8string =<< fromSEXP <$> R.cast (sing :: R.SSEXPTYPE 'R.String) <$> [r| utf8string_hs |] 115 | 116 | let utf8string1 = "abcd çéõßø" :: Text 117 | io . assertEqual "" utf8string1 =<< fromSEXP <$> R.cast (sing :: R.SSEXPTYPE 'R.String) <$> [r| utf8string1_hs |] 118 | 119 | -- Disable gctorture, otherwise test takes too long to execute. 120 | _ <- [r| gctorture2(0) |] 121 | let x = ([1] :: [Double]) 122 | ("3" @=?) =<< [r| v <- x_hs + 1 123 | v <- v + 1 124 | v |] 125 | 126 | return () 127 | -------------------------------------------------------------------------------- /inline-r/tests/test-shootout.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Copyright: (C) 2013 Amgen, Inc. 3 | -- 4 | -- Execute entries from the Great Language Shootout using R, quasiquotes and 5 | -- compare the output. 6 | -- 7 | {-# LANGUAGE CPP #-} 8 | {-# LANGUAGE TemplateHaskell #-} 9 | {-# LANGUAGE RankNTypes #-} 10 | 11 | module Main where 12 | 13 | import Test.Scripts 14 | 15 | import H.Prelude as H 16 | 17 | import Control.Monad (forM) 18 | import Control.Memory.Region 19 | import qualified Language.Haskell.TH as TH 20 | import qualified Language.Haskell.TH.Quote as TH 21 | import System.IO 22 | import System.IO.Silently (capture_) 23 | import System.Process 24 | import Test.Tasty 25 | import Test.Tasty.HUnit 26 | import Prelude 27 | 28 | inVoid :: R V s -> R V s 29 | inVoid = id 30 | 31 | main :: IO () 32 | main = do 33 | let qqs = 34 | $(do exps <- forM scripts $ \script -> do 35 | TH.runIO (readFile script) >>= TH.quoteExp r 36 | return $ TH.ListE exps) 37 | H.withEmbeddedR H.defaultConfig $ defaultMain $ 38 | testGroup "Quoted shootout programs" $ 39 | zipWith cmp scripts qqs 40 | where 41 | cmp script qq = testCase script $ do 42 | x <- readProcess "R" ["--slave"] =<< readFile script 43 | y <- capture_ $ H.unsafeRunRegion qq 44 | x @=? y 45 | -------------------------------------------------------------------------------- /nixpkgs.nix: -------------------------------------------------------------------------------- 1 | let 2 | # NixOS/Nixpkgs master on 2024-02-01 3 | rev = "a6fefb39e18b6ff828c04d59ea26d4988135bb88"; 4 | sha256 = "sha256-lsnvxt/1KCUgrV8KURXdZXRo+mLUZdc7o5H0MvYFOHQ="; 5 | in 6 | import ( 7 | fetchTarball { 8 | inherit sha256; 9 | url = "https://github.com/NixOS/nixpkgs/archive/${rev}.tar.gz"; 10 | } 11 | ) 12 | -------------------------------------------------------------------------------- /pkg/windows/Cygwin/Cygwin.wxs: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 12 | 14 | 15 | 16 | 18 | 19 | 20 | 21 | 22 | 23 | -------------------------------------------------------------------------------- /pkg/windows/H-Bundle.wxs: -------------------------------------------------------------------------------- 1 | 2 | 5 | 7 | 8 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 24 | 25 | 26 | 27 | -------------------------------------------------------------------------------- /pkg/windows/H/Hb.wxs: -------------------------------------------------------------------------------- 1 | 6 | 8 | 9 | 10 | 16 | 17 | 18 | 19 | -------------------------------------------------------------------------------- /pkg/windows/H/WixUI_FeatureTree2.wxs: -------------------------------------------------------------------------------- 1 | 2 | 10 | 11 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 1 50 | 51 | 52 | NOT Installed 53 | Installed AND PATCH 54 | 55 | 59 | 60 | Installed 61 | NOT Installed 62 | 1 63 | 64 | NOT Installed OR WixUI_InstallMode = "Change" 65 | Installed AND NOT PATCH 66 | Installed AND PATCH 67 | 68 | 1 69 | 70 | 1 71 | 1 72 | 1 73 | 1 74 | 75 | 76 | 77 | 78 | -------------------------------------------------------------------------------- /pkg/windows/H/WixUI_en-us.wxl: -------------------------------------------------------------------------------- 1 | 2 | 6 | 7 | 8 | Welcome to H installer wizard. 9 | 10 | H is a library which enables Haskell programs to interact with the R runtime. 11 | 12 | 13 | Click Install to begin with the installation. Click Back to review or change any of the installation settings. Click Cancel to exit the wizard. 14 | 15 | The installer will launch a terminal window where it will run all compilation 16 | steps, this may take a while (up to 10 minutes on a modern PC). 17 | Please don't close that window until the end of the process. Should any error 18 | occur, the terminal window will not be closed so the log output can be copied. 19 | 20 | 21 | -------------------------------------------------------------------------------- /pkg/windows/H/utils/H terminal.bat: -------------------------------------------------------------------------------- 1 | @ECHO OFF 2 | ::--------------------------------------------------------------------- 3 | :: Copyright: 2014 (c) EURL Tweag 4 | :: License: BSD-2 5 | :: 6 | :: This is a run script for H Terminal 7 | :: Usage: H terminal.bat 8 | SET RRegKeyPath="HKLM\Software\R-core\R" 9 | SET RRegKeyPath64="HKLM\Software\Wow6432Node\R-core\R" 10 | SET HRegKeyPath="HKLM\Software\Tweag\H" 11 | SET HRegKeyPath64="HKLM\Software\Wow6432Node\Tweag\H" 12 | SET CabalPath=%appdata%\cabal\bin 13 | 14 | FOR /F "skip=2 tokens=2*" %%A IN ('REG QUERY "%RRegKeyPath%" /v InstallPath 2^>nul') DO SET RRoot=%%B 15 | IF "x%RRoot%x"=="xx" FOR /F "skip=2 tokens=2*" %%A IN ('REG QUERY "%RRegKeyPath64%" /v InstallPath 2^>nul') DO SET RRoot=%%B 16 | 17 | FOR /F "skip=2 tokens=2*" %%A IN ('REG QUERY "%HRegKeyPath%" /v InstallPath 2^>nul') DO SET HRoot=%%B 18 | IF "x%HRoot%x"=="xx" FOR /F "skip=2 tokens=2*" %%A IN ('REG QUERY "%HRegKeyPath64%" /v InstallPath 2^>nul') DO SET HRoot=%%B 19 | 20 | SET ORIGINAL_PATH=%PATH% 21 | SET Path=%appdata%\cabal\bin;%RRoot%\bin;%RRoot%\bin\i386;%PATH% 22 | 23 | :: Check that H is installed 24 | :verify 25 | echo Verifying installation integrity 26 | %CabalPath%\H --version >nul 27 | IF /I %errorlevel%==0 goto run 28 | IF "x%ATTEMPT%x"=="xx" goto install 29 | goto enderror 30 | 31 | :install 32 | SET ATTEMPT=1 33 | echo %HRoot% 34 | "%HRoot%"\utils\install-h.bat 35 | goto verify 36 | 37 | :run 38 | ECHO Running H interactive session.. Please wait. 39 | CALL H --version 40 | CALL H --interactive 41 | 42 | :: SET RRegKeyPath= 43 | :cleanup 44 | SET PATH=%ORIGINAL_PATH% 45 | echo BYE! 46 | exit 47 | 48 | :enderror 49 | SET ATTEMPT= 50 | echo "Unable to run H after reinstall." 51 | PAUSE 52 | exit /B 1 53 | -------------------------------------------------------------------------------- /pkg/windows/H/utils/License.rtf: -------------------------------------------------------------------------------- 1 | {\rtf1\ansi\deff0\nouicompat{\fonttbl{\f0\fnil\fcharset0 Calibri;}} 2 | {\*\generator Riched20 6.3.9600}\viewkind4\uc1 3 | \pard\sa200\sl276\slmult1\f0\fs22\lang9 BSD-3 Clause License\par 4 | } 5 | -------------------------------------------------------------------------------- /pkg/windows/H/utils/find-reg.bat: -------------------------------------------------------------------------------- 1 | @echo OFF 2 | setlocal ENABLEEXTENSIONS 3 | if "%1"=="R" goto valuer 4 | if "%1"=="H" goto valueh 5 | if "%1"=="HP" goto valuehp 6 | if "%1"=="cygwin" goto valuecyg 7 | goto valueerr 8 | 9 | REM R Install Path 10 | :valuer 11 | set KEY_NAME="HKLM\Software\R-core\R32" 12 | set VALUE_NAME="InstallPath" 13 | goto run 14 | 15 | REM H Install Path 16 | :valueh 17 | set KEY_NAME="HKLM\Software\Tweag\H" 18 | set VALUE_NAME="InstallPath" 19 | goto run 20 | 21 | REM Haskell Platform Install Path 22 | :valuehp 23 | set KEY_NAME=HKLM\Software\Haskell\Haskell Platform\2013.2.0.0 24 | set VALUE_NAME="InstallDir" 25 | goto run 26 | 27 | REM Cygwin Install Path 28 | :valuecyg 29 | set KEY_NAME=HKLM\Software\Cygwin\setup 30 | set VALUE_NAME=rootdir 31 | goto run 32 | 33 | :run 34 | FOR /F "usebackq skip=2 tokens=1-5" %%A IN (`REG QUERY "%KEY_NAME%" /v "%VALUE_NAME%" 2^>nul`) DO ( 35 | echo %%C %%D %%E 36 | ) 37 | goto end 38 | 39 | :valueerr 40 | echo "Incorrect value (%1)" 41 | 42 | :end -------------------------------------------------------------------------------- /pkg/windows/H/utils/install-h.bat: -------------------------------------------------------------------------------- 1 | @ECHO OFF 2 | 3 | :: Options parsing 4 | IF "%~1"=="/hpath" SET HRoot=%~2 5 | IF "%~3"=="/greet" GOTO greet 6 | GOTO ungreet 7 | 8 | :greet 9 | ECHO "This terminal will run a compilation process. This may take a while." 10 | ECHO "Please don't close it until it will be finished." 11 | ECHO "In case if any error occur compilation terminal window will not be closed." 12 | ECHO "And you can copy error messages and logs, otherwise window will be closed automatically." 13 | :ungreet 14 | 15 | SET CRegKeyPath="HKLM\Software\Cygwin\setup" 16 | SET CRegKeyPath64="HKLM\Software\Wow6432Node\Cygwin\setup" 17 | SET HRegKeyPath="HKLM\Software\Tweag\H" 18 | SET HRegKeyPath64="HKLM\Software\Wow6432Node\Tweag\H" 19 | SET RRegKeyPath="HKLM\Software\R-core\R" 20 | SET RRegKeyPath64="HKLM\Software\Wow6432Node\R-core\R" 21 | SET CabalPath=%appdata%\cabal\bin 22 | 23 | :: Cygwin options 24 | 25 | if "x%CRoot%x"=="xx" FOR /F "skip=2 tokens=2*" %%A IN ('REG QUERY "%CRegKeyPath%" /v rootdir 2^>nul') DO SET CRoot=%%B 26 | if "x%CRoot%x"=="xx" FOR /F "skip=2 tokens=2*" %%A IN ('REG QUERY "%CRegKeyPath64%" /v rootdir 2^>nul') DO SET CRoot=%%B 27 | 28 | :: H options 29 | if "x%HRoot%x"=="xx" FOR /F "skip=2 tokens=2*" %%A IN ('REG QUERY "%HRegKeyPath%" /v InstallPath 2^>nul') DO SET HRoot=%%B 30 | if "x%HRoot%x"=="xx" FOR /F "skip=2 tokens=2*" %%A IN ('REG QUERY "%HRegKeyPath64%" /v InstallPath 2^>nul') DO SET HRoot=%%B 31 | 32 | :: R options 33 | if "x%RRoot%x"=="xx" FOR /F "skip=2 tokens=2*" %%A IN ('REG QUERY "%RRegKeyPath%" /v InstallPath 2^>nul') DO SET RRoot=%%B 34 | if "x%RRoot%x"=="xx" FOR /F "skip=2 tokens=2*" %%A IN ('REG QUERY "%RRegKeyPath64%" /v InstallPath 2^>nul') DO SET RRoot=%%B 35 | 36 | 37 | echo RRoot==%RRoot% 38 | echo HRoot==%HRoot% 39 | echo CRoot==%CRoot% 40 | :: Run installer 41 | chdir "%CRoot%"\bin 42 | bash --login -i "%HRoot%\utils\install-h.sh" 43 | if %errorlevel%==0 exit 44 | PAUSE 45 | exit /B 123 46 | -------------------------------------------------------------------------------- /pkg/windows/H/utils/install-h.sh: -------------------------------------------------------------------------------- 1 | # (c) 2014, EURL Tweag 2 | # Distributed under BSD-2 License. 3 | 4 | ####################################################################### 5 | # This script installs H into cabal (not sandboxed). 6 | # It should be run under cabal. This script will run 7 | # during the installation phase but can be also launch 8 | # manually by the user in order to install H. 9 | ####################################################################### 10 | 11 | # Carriage return, we need it to remove redundant returns 12 | # from the PATHs that are read from the registry 13 | # cr=$(echo -e "\r") 14 | # cn=$(echo -e "\n") 15 | 16 | 17 | # Will fix a H sources directory, for now 18 | echo "Initialize H" 19 | 20 | HHOME="$(cygpath "${HRoot}")" 21 | HSOURCE="${HHOME}/sources" # H Sources 22 | HUTILS="${HHOME}/utils" # H Utilities 23 | 24 | echo "H Directories:" 25 | echo " Home: $HHOME" 26 | echo " Sources: $HSOURCE" 27 | echo " Utilities: $HUTILS" 28 | 29 | echo "Initialize R" 30 | RPATH="$(cygpath "${RRoot}")" 31 | 32 | echo ".. exporting R path to the environment: $RPATH/bin" 33 | 34 | export PATH="$RPATH/bin:$PATH" 35 | R_HOME="$(R RHOME)" 36 | echo "R Directories:" 37 | echo " Base: $RPATH" 38 | echo " R_HOME: $R_HOME" 39 | 40 | # Prepare haskell platform and cabal. 41 | cabal update 42 | cabal install c2hs 43 | cabal install cabal-install 44 | echo "Initialize Haskell Platform." 45 | echo "Add user's cabal/bin folder to the PATH." 46 | export PATH="$(cygpath "${APPDATA}")/cabal/bin:$PATH" 47 | 48 | echo "Haskell Platform Directories:" 49 | echo " Binary Path: ${APPDATA}/cabal/bin" 50 | 51 | # now we need to check cabal version 52 | echo "Cabal version is: $(cabal --numeric-version)" 53 | echo "..no need to update cabal-install: skipping" 54 | 55 | echo "Build H" 56 | BUILDDIR="$(mktemp -d)" 57 | echo "Created a temporary build directory: $BUILDDIR" 58 | 59 | echo "Installing dependencies" 60 | cp -r "${HSOURCE}" "${BUILDDIR}" 61 | 62 | pushd "${BUILDDIR}" 63 | echo "Compiling H" 64 | cabal install \ 65 | --extra-include-dirs="$R_HOME/include" \ 66 | --extra-lib-dirs="$R_HOME/bin/i386" \ 67 | --with-c2hs=$(cygpath -w $(command -v c2hs)) 68 | echo "..Done" 69 | popd 70 | rm -rf "$BUILDDIR" 71 | -------------------------------------------------------------------------------- /pkg/windows/HP/HP.wxs: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 9 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | -------------------------------------------------------------------------------- /pkg/windows/License.rtf: -------------------------------------------------------------------------------- 1 | {\rtf1\ansi\ansicpg1252\deff0\nouicompat{\fonttbl{\f0\fnil\fcharset0 Calibri;}} 2 | {\*\generator Riched20 6.3.9600}\viewkind4\uc1 3 | \pard\sa200\sl276\slmult1\f0\fs22\lang9\'a9 2014 Amgen, All Rights Reserved.\par 4 | } 5 | -------------------------------------------------------------------------------- /pkg/windows/Makefile: -------------------------------------------------------------------------------- 1 | CANDLE=candle 2 | LIGHT=light 3 | HEAT=heat 4 | PANDOC=pandoc 5 | EXTS=-ext WixUtilExtension.dll -ext WixUIExtension.dll -ext WixBalExtension.dll 6 | VERSION=0.3.1 7 | HSourceDir=$(shell cygpath -ad H-$(VERSION)) 8 | export VERSION 9 | export HSourceDir 10 | 11 | HP_INSTALLER = HaskellPlatform-2013.2.0.0-setup.exe 12 | CYGWIN_INSTALLER = setup-x86.exe 13 | R_INSTALLER = R-3.1.0-win.exe 14 | 15 | H-Bundle.exe: HP/$(HP_INSTALLER) Cygwin/$(CYGWIN_INSTALLER) R/$(R_INSTALLER) 16 | H-Bundle.exe: H-Bundle.wxs R/R.wxs H/Hb.wxs HP/HP.wxs Cygwin/Cygwin.wxs H/H.msi 17 | $(CANDLE) H-Bundle.wxs R/R.wxs H/Hb.wxs HP/HP.wxs Cygwin/Cygwin.wxs $(EXTS) 18 | $(LIGHT) -out H-Bundle.exe H-Bundle.wixobj R.wixobj Hb.wixobj HP.wixobj Cygwin.wixobj $(EXTS) 19 | 20 | 21 | H/H.msi: H/H.wxs H/HSource.wxs 22 | $(CANDLE) -dSourceDir=H-$(VERSION) H/H.wxs H/HSource.wxs H/WixUI_FeatureTree2.wxs $(EXTS) 23 | $(LIGHT) -out H/H.msi H.wixobj HSource.wixobj WixUI_FeatureTree2.wixobj -loc H/WixUI_en-us.wxl $(EXTS) 24 | 25 | clean: 26 | -rm H/H.msi *.wixobj *.exe *.wixpdb H/HSource.wxs H/*.pdf 27 | 28 | H/HSource.wxs: H-$(VERSION) 29 | $(HEAT) dir "H-$(VERSION)" -ag -dr DirectorySources -cg HSource -template:fragment -srd -sfrag -out H/HSource.wxs -var env.HSourceDir 30 | 31 | prepare: H-$(VERSION) 32 | 33 | H-$(VERSION): 34 | mkdir H-$(VERSION) 35 | cp -r ../../src H-$(VERSION)/ 36 | 37 | prepare-pdf: H/H-user.pdf H/H-ints.pdf 38 | 39 | H/H-user.html: 40 | $(PANDOC) -f markdown -s -S --toc ../../doc/H-user.md -o $@ 41 | 42 | H/H-ints.html: 43 | $(PANDOC) -f markdown -s -S --toc ../../doc/H-ints.md -o $@ 44 | 45 | HP/$(HP_INSTALLER): 46 | wget https://www.haskell.org/platform/download/2013.2.0.0/$(HP_INSTALLER) -O HP/$(HP_INSTALLER) 47 | Cygwin/$(CYGWIN_INSTALLER): 48 | wget http://cygwin.com/$(CYGWIN_INSTALLER) -O Cygwin/$(CYGWIN_INSTALLER) 49 | R/$(R_INSTALLER): 50 | wget http://cran.r-project.org/bin/windows/base/$(R_INSTALLER) -O R/$(R_INSTALLER) 51 | 52 | 53 | -------------------------------------------------------------------------------- /pkg/windows/Process.rtf: -------------------------------------------------------------------------------- 1 | {\rtf1\ansi\ansicpg1252\deff0\nouicompat{\fonttbl{\f0\fnil\fcharset0 Calibri;}{\f1\fnil\fcharset2 Symbol;}} 2 | {\*\generator Riched20 6.3.9600}\viewkind4\uc1 3 | \pard\sa200\sl276\slmult1\f0\fs22\lang9\'a9 2014 Amgen, All Rights Reserved.\par 4 | This installer will run you thought the H installation procedure.\par 5 | All requirements will be checked and installed if needed, so it's\line possible that you will have to run included installers for other \line products:\par 6 | 7 | \pard{\pntext\f1\'B7\tab}{\*\pn\pnlvlblt\pnf1\pnindent0{\pntxtb\'B7}}\fi-360\li720\sa200\sl276\slmult1 R\par 8 | {\pntext\f1\'B7\tab}Haskell Platform\par 9 | {\pntext\f1\'B7\tab}Cygwin\par 10 | } 11 | -------------------------------------------------------------------------------- /pkg/windows/R/R.wxs: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 9 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | -------------------------------------------------------------------------------- /pkg/windows/README: -------------------------------------------------------------------------------- 1 | PREREQUISITES: 2 | 3 | 1. WiX Toolset 4 | 2. pandoc 5 | 3. Cygwin with make and wget. 6 | 4. Latex 7 | 8 | How to create a package: 9 | 10 | 1. Prepare sources to install. In order to do it, 11 | either download a release from github (or tag) 12 | or run 'make prepare' to install version from 13 | the current snapshot. 14 | 15 | 2. Prepare pdf documents. Run `make prepare-pdf` or if you 16 | have prepared pdfs place then into `H/H-ints.pdf` 17 | and `H/H-user.pdf`. 18 | 19 | 3. Export path to the WiX toolset 20 | 21 | export PATH=/cygdrive/c/Program\ Files/WiX\ Toolset\ v3.9/bin/:$PATH 22 | 23 | 4. Run `make` or run `make VERSION=` 24 | to identify the version of the installer with a 25 | specific label. 26 | -------------------------------------------------------------------------------- /pkg/windows/Version.wxi: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | -------------------------------------------------------------------------------- /shell-lts-19.nix: -------------------------------------------------------------------------------- 1 | builtins.import ./shell.nix { ghcAttr = "ghc90"; } 2 | -------------------------------------------------------------------------------- /shell-lts-20.nix: -------------------------------------------------------------------------------- 1 | builtins.import ./shell.nix { ghcAttr = "ghc92"; } 2 | -------------------------------------------------------------------------------- /shell-lts-21.nix: -------------------------------------------------------------------------------- 1 | builtins.import ./shell.nix { ghcAttr = "ghc94"; } 2 | -------------------------------------------------------------------------------- /shell-nightly.nix: -------------------------------------------------------------------------------- 1 | builtins.import ./shell.nix { ghcAttr = "ghc98"; } 2 | -------------------------------------------------------------------------------- /stack-lts-19.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-19.33 2 | 3 | packages: 4 | - examples 5 | - H 6 | - IHaskell 7 | - inline-r 8 | 9 | extra-deps: 10 | - ihaskell-blaze-0.3.0.1 11 | 12 | nix: 13 | shell-file: ./shell-lts-19.nix 14 | path: ["nixpkgs=./nixpkgs.nix"] 15 | -------------------------------------------------------------------------------- /stack-lts-19.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: 7 | - completed: 8 | hackage: ihaskell-blaze-0.3.0.1@sha256:57f0e79758d084da3a662d0909ba2b01e469200029fed495fc208ba5f59024fd,2161 9 | pantry-tree: 10 | sha256: 69fee7554a6410e45011c89d9e9547d18e2798e4f01ebd0426573b05e0e21696 11 | size: 223 12 | original: 13 | hackage: ihaskell-blaze-0.3.0.1 14 | snapshots: 15 | - completed: 16 | sha256: 6d1532d40621957a25bad5195bfca7938e8a06d923c91bc52aa0f3c41181f2d4 17 | size: 619204 18 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/33.yaml 19 | original: lts-19.33 20 | -------------------------------------------------------------------------------- /stack-lts-20.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-20.26 2 | 3 | packages: 4 | - examples 5 | - H 6 | - IHaskell 7 | - inline-r 8 | 9 | extra-deps: 10 | - ihaskell-blaze-0.3.0.1 11 | 12 | nix: 13 | shell-file: ./shell-lts-20.nix 14 | path: ["nixpkgs=./nixpkgs.nix"] 15 | -------------------------------------------------------------------------------- /stack-lts-20.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: 7 | - completed: 8 | hackage: ihaskell-blaze-0.3.0.1@sha256:57f0e79758d084da3a662d0909ba2b01e469200029fed495fc208ba5f59024fd,2161 9 | pantry-tree: 10 | sha256: 69fee7554a6410e45011c89d9e9547d18e2798e4f01ebd0426573b05e0e21696 11 | size: 223 12 | original: 13 | hackage: ihaskell-blaze-0.3.0.1 14 | snapshots: 15 | - completed: 16 | sha256: 5a59b2a405b3aba3c00188453be172b85893cab8ebc352b1ef58b0eae5d248a2 17 | size: 650475 18 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/26.yaml 19 | original: lts-20.26 20 | -------------------------------------------------------------------------------- /stack-lts-21.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-21.25 2 | 3 | packages: 4 | - examples 5 | - H 6 | - IHaskell 7 | - inline-r 8 | 9 | extra-deps: 10 | - ghc-parser-0.2.6.0 11 | - ihaskell-0.11.0.0 12 | - ihaskell-blaze-0.3.0.1 13 | - ipython-kernel-0.11.0.0 14 | 15 | nix: 16 | shell-file: ./shell-lts-21.nix 17 | path: ["nixpkgs=./nixpkgs.nix"] 18 | -------------------------------------------------------------------------------- /stack-lts-21.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: 7 | - completed: 8 | hackage: ghc-parser-0.2.6.0@sha256:0b0cbceb3bd2762cef201dc54ae302d7918bed23b2f85ffd99c1c8b6a9df32b6,1579 9 | pantry-tree: 10 | sha256: 02bb412e738063631d10750648b5c432d5df99599eaeff5050d92df6416df102 11 | size: 903 12 | original: 13 | hackage: ghc-parser-0.2.6.0 14 | - completed: 15 | hackage: ihaskell-0.11.0.0@sha256:beff2321a5d753d8d74509b6b1f4aebc9b466e32bb91d028dc60e08658184625,6729 16 | pantry-tree: 17 | sha256: 40e8d35f3a061ee0f22825f72c42edfd2352a9a05a4ac85190b6e13a00c23aff 18 | size: 2939 19 | original: 20 | hackage: ihaskell-0.11.0.0 21 | - completed: 22 | hackage: ihaskell-blaze-0.3.0.1@sha256:57f0e79758d084da3a662d0909ba2b01e469200029fed495fc208ba5f59024fd,2161 23 | pantry-tree: 24 | sha256: 69fee7554a6410e45011c89d9e9547d18e2798e4f01ebd0426573b05e0e21696 25 | size: 223 26 | original: 27 | hackage: ihaskell-blaze-0.3.0.1 28 | - completed: 29 | hackage: ipython-kernel-0.11.0.0@sha256:4e1c174037c4088b0113663d17c443fb6612e0f7639d28152c1e237816972550,2676 30 | pantry-tree: 31 | sha256: 56fb92a6761881b39a0a2e2835e9d6fecd0ad15310c2a5c854ea2abcc9e78ecd 32 | size: 792 33 | original: 34 | hackage: ipython-kernel-0.11.0.0 35 | snapshots: 36 | - completed: 37 | sha256: a81fb3877c4f9031e1325eb3935122e608d80715dc16b586eb11ddbff8671ecd 38 | size: 640086 39 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/21/25.yaml 40 | original: lts-21.25 41 | -------------------------------------------------------------------------------- /stack-nightly.yaml: -------------------------------------------------------------------------------- 1 | resolver: nightly-2024-02-05 2 | 3 | packages: 4 | - examples 5 | - H 6 | - IHaskell 7 | - inline-r 8 | 9 | extra-deps: 10 | - ihaskell-blaze-0.3.0.1 11 | 12 | nix: 13 | shell-file: ./shell-nightly.nix 14 | path: ["nixpkgs=./nixpkgs.nix"] 15 | -------------------------------------------------------------------------------- /stack-nightly.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: 7 | - completed: 8 | hackage: ihaskell-blaze-0.3.0.1@sha256:57f0e79758d084da3a662d0909ba2b01e469200029fed495fc208ba5f59024fd,2161 9 | pantry-tree: 10 | sha256: 69fee7554a6410e45011c89d9e9547d18e2798e4f01ebd0426573b05e0e21696 11 | size: 223 12 | original: 13 | hackage: ihaskell-blaze-0.3.0.1 14 | snapshots: 15 | - completed: 16 | sha256: 2523d9824f60f8eb181ddb58fbde9d78751a20a06a424057e73ca19eace11c7d 17 | size: 597454 18 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2024/2/5.yaml 19 | original: nightly-2024-02-05 20 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-22.8 2 | 3 | packages: 4 | - examples 5 | - H 6 | - IHaskell 7 | - inline-r 8 | 9 | extra-deps: 10 | - ihaskell-blaze-0.3.0.1 11 | 12 | nix: 13 | shell-file: ./shell.nix 14 | path: ["nixpkgs=./nixpkgs.nix"] 15 | -------------------------------------------------------------------------------- /stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: 7 | - completed: 8 | hackage: ihaskell-blaze-0.3.0.1@sha256:57f0e79758d084da3a662d0909ba2b01e469200029fed495fc208ba5f59024fd,2161 9 | pantry-tree: 10 | sha256: 69fee7554a6410e45011c89d9e9547d18e2798e4f01ebd0426573b05e0e21696 11 | size: 223 12 | original: 13 | hackage: ihaskell-blaze-0.3.0.1 14 | snapshots: 15 | - completed: 16 | sha256: 56ef9e03804cb4827866e762dc9752eeb392adda8f4811690da110dd9a165b9e 17 | size: 714105 18 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/8.yaml 19 | original: lts-22.8 20 | --------------------------------------------------------------------------------