diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,202 @@ + + Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS + + APPENDIX: How to apply the Apache License to your work. + + To apply the Apache License to your work, attach the following + boilerplate notice, with the fields enclosed by brackets "[]" + replaced with your own identifying information. (Don't include + the brackets!) The text should be enclosed in the appropriate + comment syntax for the file format. We also recommend that a + file or class name and description of purpose be included on the + same "printed page" as the copyright notice for easier + identification within third-party archives. + + Copyright [yyyy] [name of copyright owner] + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,18 @@ +-- This file is part of Hoppy. +-- +-- Copyright 2016 Bryan Gardiner +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. + +import Distribution.Simple +main = defaultMain diff --git a/hoppy-std.cabal b/hoppy-std.cabal new file mode 100644 --- /dev/null +++ b/hoppy-std.cabal @@ -0,0 +1,44 @@ +name: hoppy-std +version: 0.1.0 +synopsis: C++ FFI generator - Standard library bindings +homepage: http://khumba.net/projects/hoppy +license: Apache-2.0 +license-file: LICENSE +author: Bryan Gardiner +maintainer: Bryan Gardiner +copyright: Copyright 2015-2016 Bryan Gardiner +category: Foreign +build-type: Simple +cabal-version: >=1.10 +description: + Hoppy generates Haskell bindings to C++ libraries. + . + This package contains definitions for the C++ standard library. + +data-files: + include/hoppy/std/iterator.hpp + , include/hoppy/std/map.hpp + , include/hoppy/std/set.hpp + , include/hoppy/std/utility.hpp + +library + exposed-modules: + Foreign.Hoppy.Generator.Std + , Foreign.Hoppy.Generator.Std.Iterator + , Foreign.Hoppy.Generator.Std.List + , Foreign.Hoppy.Generator.Std.Map + , Foreign.Hoppy.Generator.Std.Pair + , Foreign.Hoppy.Generator.Std.Set + , Foreign.Hoppy.Generator.Std.String + , Foreign.Hoppy.Generator.Std.Vector + other-modules: + Foreign.Hoppy.Generator.Std.Internal + , Paths_hoppy_std + build-depends: + base >=4.7 && <4.9 + , filepath >=1.0 && <1.5 + , haskell-src >=1.0 && <1.1 + , hoppy-generator >=0.1 && <0.2 + hs-source-dirs: src + ghc-options: -W -fwarn-incomplete-patterns -fwarn-unused-do-bind + default-language: Haskell2010 diff --git a/include/hoppy/std/iterator.hpp b/include/hoppy/std/iterator.hpp new file mode 100644 --- /dev/null +++ b/include/hoppy/std/iterator.hpp @@ -0,0 +1,40 @@ +#ifndef HOPPY_STD_ITERATOR_HPP +#define HOPPY_STD_ITERATOR_HPP + +// This file is part of Hoppy. +// +// Copyright 2015-2016 Bryan Gardiner +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. + +#include + +namespace hoppy { +namespace iterator { + +template +T& put(Iter* self, const T& value) { + return (**self = value); +} + +template +typename Container::iterator deconst( + typename Container::const_iterator iterator, + Container& container) { + return container.erase(iterator, iterator); +} + +} // namespace iterator +} // namespace hoppy + +#endif diff --git a/include/hoppy/std/map.hpp b/include/hoppy/std/map.hpp new file mode 100644 --- /dev/null +++ b/include/hoppy/std/map.hpp @@ -0,0 +1,43 @@ +#ifndef HOPPY_STD_MAP_HPP +#define HOPPY_STD_MAP_HPP + +// This file is part of Hoppy. +// +// Copyright 2015-2016 Bryan Gardiner +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. + +#include + +namespace hoppy { +namespace map { + +template +const K& getIteratorKey(const typename std::map::const_iterator& iterator) { + return iterator->first; +} + +template +V& getIteratorValue(typename std::map::iterator& iterator) { + return iterator->second; +} + +template +const V& getIteratorValue(const typename std::map::const_iterator& iterator) { + return iterator->second; +} + +} // namespace map +} // namespace hoppy + +#endif diff --git a/include/hoppy/std/set.hpp b/include/hoppy/std/set.hpp new file mode 100644 --- /dev/null +++ b/include/hoppy/std/set.hpp @@ -0,0 +1,38 @@ +#ifndef HOPPY_STD_SET_HPP +#define HOPPY_STD_SET_HPP + +// This file is part of Hoppy. +// +// Copyright 2015-2016 Bryan Gardiner +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. + +#include + +namespace hoppy { +namespace set { + +template +bool insert(std::set& set, const T& value) { + return set.insert(value).second; +} + +template +typename std::set::iterator insertAndGetIterator(std::set& set, const T& value) { + return set.insert(value).first; +} + +} // namespace set +} // namespace hoppy + +#endif diff --git a/include/hoppy/std/utility.hpp b/include/hoppy/std/utility.hpp new file mode 100644 --- /dev/null +++ b/include/hoppy/std/utility.hpp @@ -0,0 +1,48 @@ +#ifndef HOPPY_STD_UTILITY_HPP +#define HOPPY_STD_UTILITY_HPP + +// This file is part of Hoppy. +// +// Copyright 2015-2016 Bryan Gardiner +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. + +#include + +namespace hoppy { +namespace utility { + +template +A& pairFirst(std::pair& pair) { + return pair.first; +} + +template +const A& pairFirst(const std::pair& pair) { + return pair.first; +} + +template +B& pairSecond(std::pair& pair) { + return pair.second; +} + +template +const B& pairSecond(const std::pair& pair) { + return pair.second; +} + +} // namespace utility +} // namespace hoppy + +#endif diff --git a/src/Foreign/Hoppy/Generator/Std.hs b/src/Foreign/Hoppy/Generator/Std.hs new file mode 100644 --- /dev/null +++ b/src/Foreign/Hoppy/Generator/Std.hs @@ -0,0 +1,45 @@ +-- This file is part of Hoppy. +-- +-- Copyright 2015-2016 Bryan Gardiner +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. + +-- | Bindings for @std@ that aren't in other modules. +module Foreign.Hoppy.Generator.Std ( + ValueConversion (..), + mod_std, + c_string, + ) where + +import Foreign.Hoppy.Generator.Spec +import Foreign.Hoppy.Generator.Std.String (c_string) + +{-# ANN module "HLint: ignore Use camelCase" #-} + +-- | Specifies how values in a collection should be converted when converting +-- the collection as a whole. +data ValueConversion = + ConvertPtr + -- ^ A C++ value of type @t@ will convert to a foreign value of type @'TPtr' + -- t@. + | ConvertValue + -- ^ A C++ value of type @t@ will convert to a foreign value of type @t@. + -- For an object type ('TObj'), the class must have conversions + -- ('ClassConversion'). + deriving (Bounded, Enum, Eq, Ord, Show) + +-- | Include @std::string@. +mod_std :: Module +mod_std = moduleModify' (makeModule "std" "std.hpp" "std.cpp") $ + moduleAddExports + [ ExportClass c_string ] diff --git a/src/Foreign/Hoppy/Generator/Std/Internal.hs b/src/Foreign/Hoppy/Generator/Std/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Foreign/Hoppy/Generator/Std/Internal.hs @@ -0,0 +1,35 @@ +-- This file is part of Hoppy. +-- +-- Copyright 2015-2016 Bryan Gardiner +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. + +-- | Package-specific utilities. +module Foreign.Hoppy.Generator.Std.Internal ( + includeHelper, + ) where + +import Foreign.Hoppy.Generator.Spec (Include, includeLocal) +import Paths_hoppy_std (getDataFileName) +import System.IO.Unsafe (unsafePerformIO) +import System.FilePath (()) + +includeDir :: FilePath +{-# NOINLINE includeDir #-} +includeDir = unsafePerformIO $ getDataFileName $ "include" "hoppy" "std" + +-- | Returns a C++ include pointing to the header specified, within the +-- installed location corresponding to the @include/hoppy/std@ path in the @std@ +-- sources. (Example: @includeHelper \"utility.hpp\"@) +includeHelper :: FilePath -> Include +includeHelper filename = includeLocal $ includeDir filename diff --git a/src/Foreign/Hoppy/Generator/Std/Iterator.hs b/src/Foreign/Hoppy/Generator/Std/Iterator.hs new file mode 100644 --- /dev/null +++ b/src/Foreign/Hoppy/Generator/Std/Iterator.hs @@ -0,0 +1,162 @@ +-- This file is part of Hoppy. +-- +-- Copyright 2015-2016 Bryan Gardiner +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. + +-- | Support for STL-style iterators. The functions in this module modify a +-- class to add functionality that is provided by different types of STL +-- iterators. In the method pseudotypes documented here, the parameter types +-- are 'Type's, and all methods are nonpure. +module Foreign.Hoppy.Generator.Std.Iterator ( + IteratorMutability (..), + makeTrivialIterator, + makeForwardIterator, + makeBidirectionalIterator, + makeRandomIterator, + ) where + +import Data.Maybe (catMaybes, isJust) +import Foreign.Hoppy.Generator.Spec ( + Class, + MethodApplicability (MNormal), + Operator ( + OpAdd, + OpAddAssign, + OpArray, + OpDecPre, + OpDeref, + OpIncPre, + OpSubtract, + OpSubtractAssign), + Purity (Nonpure), + Type (TConst, TObj, TObjToHeap, TPtr, TRef, TVoid), + addReqIncludes, + classAddCtors, + classAddMethods, + ident2, + makeFnMethod, + mkConstMethod', + mkCtor, + mkMethod', + ) +import Foreign.Hoppy.Generator.Spec.ClassFeature ( + ClassFeature (Assignable, Copyable, Equatable), + classAddFeatures, + ) +import Foreign.Hoppy.Generator.Std.Internal (includeHelper) + +-- | Whether an iterator may be used to modify the underlying collection. +data IteratorMutability = Constant | Mutable + deriving (Eq, Ord, Show) + +-- | @makeTrivialIteartor mutable valueTypeMaybe cls@ turns a class into a +-- trivial iterator, adding: +-- +-- * A default constructor named @new@. +-- +-- * The class features 'Assignable', 'Copyable', and 'Equatable'. +-- +-- * __operator*:__ @getConst :: this -> 'TRef' ('TConst' valueType)@; if +-- @valueTypeMaybe@ is present. +-- +-- * __operator*:__ @get :: this -> 'TRef' valueType@; if @valueTypeMaybe@ is +-- present and @mutable@ is 'Mutable'. +-- +-- * __*iter = x:__ @put :: this -> valueType -> 'TVoid'@; if @valueTypeMaybe@ +-- is present and @mutable@ is 'Mutable'. +makeTrivialIterator :: IteratorMutability -> Maybe Type -> Class -> Class +makeTrivialIterator mutable valueTypeMaybe cls = + (if isJust valueTypeMaybe && mutable == Mutable + then addReqIncludes [includeHelper "iterator.hpp"] + else id) $ + classAddFeatures [Assignable, Copyable, Equatable] $ + classAddCtors ctors $ + classAddMethods methods cls + where ctors = + [ mkCtor "new" [] + ] + methods = + catMaybes + [ do valueType <- valueTypeMaybe + Mutable <- Just mutable + return $ mkMethod' OpDeref "get" [] $ TRef valueType + , do valueType <- valueTypeMaybe + return $ mkConstMethod' OpDeref "getConst" [] $ TRef $ TConst valueType + , do valueType <- valueTypeMaybe + Mutable <- Just mutable + return $ + makeFnMethod (ident2 "hoppy" "iterator" "put") "put" + MNormal Nonpure [TPtr $ TObj cls, valueType] TVoid + ] + +-- | Turns a class into a forward iterator, including everything from +-- 'makeTrivialIterator' plus the pre-increment operator: +-- +-- * __operator++:__ @next :: this -> 'TRef' ('TObj' cls)@. +makeForwardIterator :: IteratorMutability -> Maybe Type -> Class -> Class +makeForwardIterator mutable valueTypeMaybe cls = + classAddMethods methods $ + makeTrivialIterator mutable valueTypeMaybe cls + where methods = + [ mkMethod' OpIncPre "next" [] $ TRef $ TObj cls + ] + +-- | Turns a class into a bidirectional iterator, including everything from +-- 'makeForwardIterator' plus the pre-decrement operator: +-- +-- * __operator--:__ @prev :: this -> 'TRef' ('TObj' cls)@. +makeBidirectionalIterator :: IteratorMutability -> Maybe Type -> Class -> Class +makeBidirectionalIterator mutability valueTypeMaybe cls = + classAddMethods methods $ + makeForwardIterator mutability valueTypeMaybe cls + where methods = + [ mkMethod' OpDecPre "prev" [] $ TRef $ TObj cls + ] + +-- | @makeRandomIterator mutable valueTypeMaybe distanceType cls@ turns a class +-- into a random iterator, including everything from 'makeBidirectionalIterator' +-- plus some methods: +-- +-- * __operator+=:__ @add :: this -> distanceType -> 'TRef' ('TObj' cls)@. +-- +-- * __operator+:__ @plusNew :: this -> distanceType -> 'TObjToHeap' cls@. +-- +-- * __operator-=:__ @subtract :: distanceType -> 'TRef' ('TObj' cls)@. +-- +-- * __operator-:__ @minusNew :: distanceType -> 'TObjToHeap' cls@. +-- +-- * __operator-:__ @difference :: this -> this -> distanceType@. +-- +-- * __operator[]:__ @atConst :: distanceType -> 'TRef' ('TConst' valueType)@; +-- if @valueTypeMaybe@ is present. +-- +-- * __operator[]:__ @at :: distanceType -> 'TRef' valueType@; if +-- @valueTypeMaybe@ is present and @mutable@ is 'Mutable'. +makeRandomIterator :: IteratorMutability -> Maybe Type -> Type -> Class -> Class +makeRandomIterator mutable valueTypeMaybe distanceType cls = + classAddMethods methods $ + makeBidirectionalIterator mutable valueTypeMaybe cls + where methods = + catMaybes + [ Just $ mkMethod' OpAdd "plusNew" [distanceType] $ TObjToHeap cls + , Just $ mkMethod' OpAddAssign "add" [distanceType] $ TRef $ TObj cls + , Just $ mkMethod' OpSubtract "minusNew" [distanceType] $ TObjToHeap cls + , Just $ mkMethod' OpSubtract "difference" [TObj cls] distanceType + , Just $ mkMethod' OpSubtractAssign "subtract" [distanceType] $ TRef $ TObj cls + , do valueType <- valueTypeMaybe + Mutable <- Just mutable + return $ mkMethod' OpArray "at" [distanceType] $ TRef valueType + , do valueType <- valueTypeMaybe + return $ mkConstMethod' OpArray "atConst" [distanceType] $ TRef $ TConst valueType + ] diff --git a/src/Foreign/Hoppy/Generator/Std/List.hs b/src/Foreign/Hoppy/Generator/Std/List.hs new file mode 100644 --- /dev/null +++ b/src/Foreign/Hoppy/Generator/Std/List.hs @@ -0,0 +1,241 @@ +-- This file is part of Hoppy. +-- +-- Copyright 2015-2016 Bryan Gardiner +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. + +{-# LANGUAGE CPP #-} + +-- | Bindings for @std::list@. +module Foreign.Hoppy.Generator.Std.List ( + Options (..), + defaultOptions, + Contents (..), + instantiate, + instantiate', + toExports, + ) where + +import Control.Monad (forM_, when) +#if !MIN_VERSION_base(4,8,0) +import Data.Monoid (mconcat) +#endif +import Foreign.Hoppy.Generator.Language.Haskell ( + HsTypeSide (HsHsSide), + addImports, + cppTypeToHsTypeAndUse, + indent, + ln, + prettyPrint, + sayLn, + saysLn, + toHsDataTypeName, + toHsMethodName', + ) +import Foreign.Hoppy.Generator.Spec +import Foreign.Hoppy.Generator.Spec.ClassFeature ( + ClassFeature (Assignable, Comparable, Copyable, Equatable), + classAddFeatures, + ) +import Foreign.Hoppy.Generator.Std (ValueConversion (ConvertPtr, ConvertValue)) +import Foreign.Hoppy.Generator.Std.Iterator +import Foreign.Hoppy.Generator.Version (collect, just, test) + +-- | Options for instantiating the list classes. +data Options = Options + { optListClassFeatures :: [ClassFeature] + -- ^ Additional features to add to the @std::list@ class. Lists are always + -- 'Assignable' and 'Copyable', but you may want to add 'Equatable' and + -- 'Comparable' if your value type supports those. + , optValueConversion :: Maybe ValueConversion + } + +-- | The default options have no additional 'ClassFeature's. +defaultOptions :: Options +defaultOptions = Options [] Nothing + +-- | A set of instantiated list classes. +data Contents = Contents + { c_list :: Class -- ^ @std::list\@ + , c_iterator :: Class -- ^ @std::list\::iterator@ + , c_constIterator :: Class -- ^ @std::list\::const_iterator@ + } + +-- | @instantiate className t tReqs@ creates a set of bindings for an +-- instantiation of @std::list@ and associated types (e.g. iterators). In the +-- result, the 'c_list' class has an external name of @className@, and the +-- iterator classes are further suffixed with @\"Iterator\"@ and +-- @\"ConstIterator\"@ respectively. +instantiate :: String -> Type -> Reqs -> Contents +instantiate listName t tReqs = instantiate' listName t tReqs defaultOptions + +-- | 'instantiate' with additional options. +instantiate' :: String -> Type -> Reqs -> Options -> Contents +instantiate' listName t tReqs opts = + let reqs = mconcat [tReqs, reqInclude $ includeStd "list"] + iteratorName = listName ++ "Iterator" + constIteratorName = listName ++ "ConstIterator" + features = Assignable : Copyable : optListClassFeatures opts + + list = + (case optValueConversion opts of + Nothing -> id + Just conversion -> addAddendumHaskell $ makeAddendum conversion) $ + addReqs reqs $ + classAddFeatures features $ + makeClass (ident1T "std" "list" [t]) (Just $ toExtName listName) [] + [ mkCtor "new" [] + ] $ + collect + [ just $ mkMethod' "back" "back" [] $ TRef t + , just $ mkConstMethod' "back" "backConst" [] $ TRef $ TConst t + , just $ mkMethod' "begin" "begin" [] $ TObjToHeap iterator + , just $ mkConstMethod' "begin" "beginConst" [] $ TObjToHeap constIterator + , just $ mkMethod "clear" [] TVoid + , just $ mkConstMethod "empty" [] TBool + , just $ mkMethod' "end" "end" [] $ TObjToHeap iterator + , just $ mkConstMethod' "end" "endConst" [] $ TObjToHeap constIterator + , just $ mkMethod' "erase" "erase" [TObj iterator] TVoid + , just $ mkMethod' "erase" "eraseRange" [TObj iterator, TObj iterator] TVoid + , just $ mkMethod' "front" "front" [] $ TRef t + , just $ mkConstMethod' "front" "frontConst" [] $ TRef $ TConst t + , just $ mkMethod' "insert" "insert" [TObj iterator, t] TVoid + , just $ mkMethod' "insert" "insertAndGetIterator" + [TObj iterator, t] $ TObjToHeap iterator + , just $ mkConstMethod' "max_size" "maxSize" [] TSize + , test (elem Comparable features) $ mkMethod "merge" [TRef $ TObj list] TVoid + -- TODO merge(list&, Comparator) + , just $ mkMethod' "pop_back" "popBack" [] TVoid + , just $ mkMethod' "pop_front" "popFront" [] TVoid + , just $ mkMethod' "push_back" "pushBack" [t] TVoid + , just $ mkMethod' "push_front" "pushFront" [t] TVoid + , test (elem Equatable features) $ mkMethod "remove" [t] TVoid + -- TODO remove_if(UnaryPredicate) + , just $ mkMethod' "resize" "resize" [TSize] TVoid + , just $ mkMethod' "resize" "resizeWith" [TSize, t] TVoid + , just $ mkMethod "reverse" [] TVoid + , just $ mkConstMethod "size" [] TSize + , test (elem Comparable features) $ mkMethod "sort" [] TVoid + -- TODO sort(Comparator) + , just $ mkMethod' "splice" "spliceAll" [TObj iterator, TRef $ TObj list] TVoid + , just $ mkMethod' "splice" "spliceOne" + [TObj iterator, TRef $ TObj list, TObj iterator] TVoid + , just $ mkMethod' "splice" "spliceRange" + [TObj iterator, TRef $ TObj list, TObj iterator, TObj iterator] TVoid + , just $ mkMethod "swap" [TRef $ TObj list] TVoid + , test (Equatable `elem` features) $ mkMethod "unique" [] TVoid + -- TODO unique(BinaryPredicate) + ] + + iterator = + addReqs reqs $ + makeBidirectionalIterator Mutable (Just t) $ + makeClass (identT' [("std", Nothing), ("list", Just [t]), ("iterator", Nothing)]) + (Just $ toExtName iteratorName) [] [] [] + + constIterator = + addReqs reqs $ + makeBidirectionalIterator Constant (Just t) $ + makeClass (identT' [("std", Nothing), ("list", Just [t]), ("const_iterator", Nothing)]) + (Just $ toExtName constIteratorName) + [] + [ mkCtor "newFromConst" [TObj iterator] + ] + [ makeFnMethod (ident2 "hoppy" "iterator" "deconst") "deconst" MConst Nonpure + [TObj constIterator, TRef $ TObj list] $ TObjToHeap iterator + ] + + -- The addendum for the list class contains HasContents and FromContents + -- instances. + makeAddendum conversion = do + addImports $ mconcat [hsImport1 "Prelude" "($)", + hsImportForPrelude, + hsImportForRuntime] + when (conversion == ConvertValue) $ + addImports $ hsImport1 "Prelude" "(=<<)" + + forM_ [Const, Nonconst] $ \cst -> do + let hsDataTypeName = toHsDataTypeName cst list + hsValueType <- + cppTypeToHsTypeAndUse HsHsSide $ + (case conversion of + ConvertPtr -> TPtr + ConvertValue -> id) $ + case cst of + Const -> TConst t + Nonconst -> t + + -- Generate const and nonconst HasContents instances. + ln + saysLn ["instance HoppyFHR.HasContents ", hsDataTypeName, + " (", prettyPrint hsValueType, ") where"] + indent $ do + sayLn "toContents this' = do" + indent $ do + let listBegin = case cst of + Const -> "beginConst" + Nonconst -> "begin" + listEnd = case cst of + Const -> "endConst" + Nonconst -> "end" + iter = case cst of + Const -> constIterator + Nonconst -> iterator + iterGet = case cst of + Const -> "getConst" + Nonconst -> "get" + saysLn ["empty' <- ", toHsMethodName' list "empty", " this'"] + sayLn "if empty' then HoppyP.return [] else" + indent $ do + saysLn ["HoppyFHR.withScopedPtr (", toHsMethodName' list listBegin, + " this') $ \\begin' ->"] + saysLn ["HoppyFHR.withScopedPtr (", toHsMethodName' list listEnd, + " this') $ \\iter' ->"] + sayLn "go' iter' begin' []" + sayLn "where" + indent $ do + sayLn "go' iter' begin' acc' = do" + indent $ do + saysLn ["stop' <- ", toHsMethodName' iter OpEq, " iter' begin'"] + sayLn "if stop' then HoppyP.return acc' else do" + indent $ do + saysLn ["_ <- ", toHsMethodName' iter "prev", " iter'"] + saysLn ["value' <- ", + case conversion of + ConvertPtr -> "" + ConvertValue -> "HoppyFHR.decode =<< ", + toHsMethodName' iter iterGet, " iter'"] + sayLn "go' iter' begin' $ value':acc'" + + -- Only generate a nonconst FromContents instance. + when (cst == Nonconst) $ do + ln + saysLn ["instance HoppyFHR.FromContents ", hsDataTypeName, + " (", prettyPrint hsValueType, ") where"] + indent $ do + sayLn "fromContents values' = do" + indent $ do + saysLn ["list' <- ", toHsMethodName' list "new"] + saysLn ["HoppyP.mapM_ (", toHsMethodName' list "pushBack", " list') values'"] + sayLn "HoppyP.return list'" + + in Contents + { c_list = list + , c_iterator = iterator + , c_constIterator = constIterator + } + +-- | Converts an instantiation into a list of exports to be included in a +-- module. +toExports :: Contents -> [Export] +toExports m = map (ExportClass . ($ m)) [c_list, c_iterator, c_constIterator] diff --git a/src/Foreign/Hoppy/Generator/Std/Map.hs b/src/Foreign/Hoppy/Generator/Std/Map.hs new file mode 100644 --- /dev/null +++ b/src/Foreign/Hoppy/Generator/Std/Map.hs @@ -0,0 +1,266 @@ +-- This file is part of Hoppy. +-- +-- Copyright 2015-2016 Bryan Gardiner +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. + +{-# LANGUAGE CPP #-} + +-- | Bindings for @std::map@. +module Foreign.Hoppy.Generator.Std.Map ( + Options (..), + defaultOptions, + Contents (..), + instantiate, + instantiate', + toExports, + ) where + +import Control.Monad (forM_, when) +#if !MIN_VERSION_base(4,8,0) +import Data.Monoid (mconcat) +#endif +import Foreign.Hoppy.Generator.Language.Haskell ( + HsTypeSide (HsHsSide), + addImports, + cppTypeToHsTypeAndUse, + indent, + ln, + prettyPrint, + sayLn, + saysLn, + toHsDataTypeName, + toHsMethodName', + ) +import Foreign.Hoppy.Generator.Spec +import Foreign.Hoppy.Generator.Spec.ClassFeature ( + ClassFeature (Assignable, Copyable), + classAddFeatures, + ) +import Foreign.Hoppy.Generator.Std (ValueConversion (ConvertPtr, ConvertValue)) +import Foreign.Hoppy.Generator.Std.Internal (includeHelper) +import Foreign.Hoppy.Generator.Std.Iterator + +-- | Options for instantiating the map classes. +data Options = Options + { optMapClassFeatures :: [ClassFeature] + -- ^ Additional features to add to the @std::map@ class. Maps are always + -- 'Assignable' and 'Copyable'. + , optKeyConversion :: Maybe ValueConversion + -- ^ How to convert values of the key type. + , optValueConversion :: Maybe ValueConversion + -- ^ How to convert values of the value type. + } + +-- | The default options have no additional 'ClassFeature's. +defaultOptions :: Options +defaultOptions = Options [] Nothing Nothing + +-- | A set of instantiated map classes. +data Contents = Contents + { c_map :: Class -- ^ @std::map\@ + , c_iterator :: Class -- ^ @std::map\::iterator@ + , c_constIterator :: Class -- ^ @std::map\::const_iterator@ + } + +-- | @instantiate className k v reqs@ creates a set of bindings for an +-- instantiation of @std::map\@ and associated types (e.g. iterators). +-- In the result, the 'c_map' class has an external name of @className@, and the +-- iterator classes are further suffixed with @\"Iterator\"@ and +-- @\"ConstIterator\"@ respectively. +instantiate :: String -> Type -> Type -> Reqs -> Contents +instantiate mapName k v reqs = instantiate' mapName k v reqs defaultOptions + +-- | 'instantiate' with additional options. +instantiate' :: String -> Type -> Type -> Reqs -> Options -> Contents +instantiate' mapName k v userReqs opts = + let extName = toExtName mapName + reqs = mconcat + [ userReqs + , reqInclude $ includeHelper "map.hpp" + , reqInclude $ includeStd "map" + ] + iteratorName = mapName ++ "Iterator" + constIteratorName = mapName ++ "ConstIterator" + + getIteratorKeyIdent = ident2T "hoppy" "map" "getIteratorKey" [k, v] + getIteratorValueIdent = ident2T "hoppy" "map" "getIteratorValue" [k, v] + + map = + (case (optKeyConversion opts, optValueConversion opts) of + (Nothing, Nothing) -> id + (Just keyConv, Just valueConv) -> addAddendumHaskell $ makeAddendum keyConv valueConv + (maybeKeyConv, maybeValueConv) -> + error $ concat + ["Error instantiating std::map<", show k, ", ", show v, "> (external name ", + show extName, "), key and value conversions must either both be specified or ", + "absent; they are, repectively, ", show maybeKeyConv, " and ", show maybeValueConv, + "."]) $ + addReqs reqs $ + classAddFeatures (Assignable : Copyable : optMapClassFeatures opts) $ + makeClass (ident1T "std" "map" [k, v]) (Just extName) [] + [ mkCtor "new" [] + ] + [ mkMethod' "at" "at" [k] $ TRef v + , mkConstMethod' "at" "atConst" [k] $ TRef $ TConst v + , mkMethod' "begin" "begin" [] $ TObjToHeap iterator + , mkConstMethod' "begin" "beginConst" [] $ TObjToHeap constIterator + , mkMethod "clear" [] TVoid + , mkConstMethod "count" [k] TSize + , mkConstMethod "empty" [] TBool + , mkMethod' "end" "end" [] $ TObjToHeap iterator + , mkConstMethod' "end" "endConst" [] $ TObjToHeap constIterator + -- equal_range: find is good enough. + , mkMethod' "erase" "erase" [TObj iterator] TVoid + , mkMethod' "erase" "eraseKey" [k] TSize + , mkMethod' "erase" "eraseRange" [TObj iterator, TObj iterator] TVoid + , mkMethod' "find" "find" [k] $ TObjToHeap iterator + , mkConstMethod' "find" "findConst" [k] $ TObjToHeap constIterator + -- TODO insert + -- lower_bound: find is good enough. + , mkConstMethod' "max_size" "maxSize" [] TSize + , mkConstMethod "size" [] TSize + , mkMethod "swap" [TRef $ TObj map] TVoid + -- upper_bound: find is good enough. + , mkMethod OpArray [k] $ TRef v + ] + + iterator = + addReqs reqs $ + makeBidirectionalIterator Mutable Nothing $ + makeClass (identT' [("std", Nothing), + ("map", Just [k, v]), + ("iterator", Nothing)]) + (Just $ toExtName iteratorName) [] [] + [ makeFnMethod getIteratorKeyIdent "getKey" MConst Nonpure + [TObj iterator] $ TRef $ TConst k + , makeFnMethod getIteratorValueIdent "getValue" MNormal Nonpure + [TRef $ TObj iterator] $ TRef v + , makeFnMethod getIteratorValueIdent "getValueConst" MConst Nonpure + [TObj iterator] $ TRef $ TConst v + ] + + constIterator = + addReqs reqs $ + makeBidirectionalIterator Constant Nothing $ + makeClass (identT' [("std", Nothing), + ("map", Just [k, v]), + ("const_iterator", Nothing)]) + (Just $ toExtName constIteratorName) + [] + [ mkCtor "newFromConst" [TObj iterator] + ] + [ makeFnMethod (ident2 "hoppy" "iterator" "deconst") "deconst" MConst Nonpure + [TObj constIterator, TRef $ TObj map] $ TObjToHeap iterator + , makeFnMethod getIteratorKeyIdent "getKey" MConst Nonpure + [TObj constIterator] $ TRef $ TConst k + , makeFnMethod getIteratorValueIdent "getValueConst" MConst Nonpure + [TObj constIterator] $ TRef $ TConst v + ] + + -- The addendum for the map class contains HasContents and FromContents + -- instances with that work with key-value pairs. + makeAddendum keyConv valueConv = do + addImports $ mconcat [hsImports "Prelude" ["($)", "(=<<)"], + hsImportForPrelude, + hsImportForRuntime] + + forM_ [Const, Nonconst] $ \cst -> do + let hsDataTypeName = toHsDataTypeName cst map + + keyHsType <- + cppTypeToHsTypeAndUse HsHsSide $ + (case keyConv of + ConvertPtr -> TPtr + ConvertValue -> id) $ + TConst k + + valueHsType <- + cppTypeToHsTypeAndUse HsHsSide $ + (case valueConv of + ConvertPtr -> TPtr + ConvertValue -> id) $ + case cst of + Const -> TConst v + Nonconst -> v + + -- Generate const and nonconst HasContents instances. + ln + saysLn ["instance HoppyFHR.HasContents ", hsDataTypeName, + " ((", prettyPrint keyHsType, "), (", prettyPrint valueHsType, ")) where"] + indent $ do + sayLn "toContents this' = do" + indent $ do + let mapBegin = case cst of + Const -> "beginConst" + Nonconst -> "begin" + mapEnd = case cst of + Const -> "endConst" + Nonconst -> "end" + iter = case cst of + Const -> constIterator + Nonconst -> iterator + iterGetValue = case cst of + Const -> "getValueConst" + Nonconst -> "getValue" + saysLn ["empty' <- ", toHsMethodName' map "empty", " this'"] + sayLn "if empty' then HoppyP.return [] else" + indent $ do + saysLn ["HoppyFHR.withScopedPtr (", toHsMethodName' map mapBegin, + " this') $ \\begin' ->"] + saysLn ["HoppyFHR.withScopedPtr (", toHsMethodName' map mapEnd, + " this') $ \\iter' ->"] + sayLn "go' iter' begin' []" + sayLn "where" + indent $ do + sayLn "go' iter' begin' acc' = do" + indent $ do + saysLn ["stop' <- ", toHsMethodName' iter OpEq, " iter' begin'"] + sayLn "if stop' then HoppyP.return acc' else do" + indent $ do + saysLn ["_ <- ", toHsMethodName' iter "prev", " iter'"] + saysLn ["key' <- ", + case keyConv of + ConvertPtr -> "" + ConvertValue -> "HoppyFHR.decode =<< ", + toHsMethodName' iter "getKey", " iter'"] + saysLn ["value' <- ", + case valueConv of + ConvertPtr -> "" + ConvertValue -> "HoppyFHR.decode =<< ", + toHsMethodName' iter iterGetValue, " iter'"] + sayLn "go' iter' begin' $ (key', value'):acc'" + + -- Only generate a nonconst FromContents instance. + when (cst == Nonconst) $ do + ln + saysLn ["instance HoppyFHR.FromContents ", hsDataTypeName, + " ((", prettyPrint keyHsType, "), (", prettyPrint valueHsType, ")) where"] + indent $ do + sayLn "fromContents values' = do" + indent $ do + saysLn ["map' <- ", toHsMethodName' map "new"] + saysLn ["HoppyP.mapM_ (\\(k, v) -> HoppyP.flip HoppyFHR.assign v =<< ", + toHsMethodName' map "at", " map' k) values'"] + sayLn "HoppyP.return map'" + + in Contents + { c_map = map + , c_iterator = iterator + , c_constIterator = constIterator + } + +-- | Converts an instantiation into a list of exports to be included in a +-- module. +toExports :: Contents -> [Export] +toExports m = map (ExportClass . ($ m)) [c_map, c_iterator, c_constIterator] diff --git a/src/Foreign/Hoppy/Generator/Std/Pair.hs b/src/Foreign/Hoppy/Generator/Std/Pair.hs new file mode 100644 --- /dev/null +++ b/src/Foreign/Hoppy/Generator/Std/Pair.hs @@ -0,0 +1,97 @@ +-- This file is part of Hoppy. +-- +-- Copyright 2015-2016 Bryan Gardiner +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. + +{-# LANGUAGE CPP #-} + +-- | Bindings for @std::pair@. +module Foreign.Hoppy.Generator.Std.Pair ( + Options (..), + defaultOptions, + Contents (..), + instantiate, + instantiate', + toExports, + ) where + +#if !MIN_VERSION_base(4,8,0) +import Data.Monoid (mconcat) +#endif +import Foreign.Hoppy.Generator.Spec +import Foreign.Hoppy.Generator.Spec.ClassFeature ( + ClassFeature (Assignable, Copyable), + classAddFeatures, + ) +import Foreign.Hoppy.Generator.Std.Internal (includeHelper) +import Foreign.Hoppy.Generator.Version (CppVersion (Cpp2011), activeCppVersion, collect, just, test) + +-- | Options for instantiating @pair@. +data Options = Options + { optPairClassFeatures :: [ClassFeature] + -- ^ Additional features to add to the @std::pair@ class. Pairs are always + -- 'Assignable' and 'Copyable'. + } + +-- | The default options have no additional 'ClassFeature's. +defaultOptions :: Options +defaultOptions = Options [] + +-- | A set of instantiated pair classes. +data Contents = Contents + { c_pair :: Class -- ^ @std::pair\@ + } + +-- | @instantiate className a b reqs@ creates a set of bindings for an +-- instantiation of @std::pair\@. In the result, the 'c_pair' class has +-- an external name of @className@. +instantiate :: String -> Type -> Type -> Reqs -> Contents +instantiate pairName a b reqs = instantiate' pairName a b reqs defaultOptions + +-- | 'instantiate' with additional options. +instantiate' :: String -> Type -> Type -> Reqs -> Options -> Contents +instantiate' pairName a b userReqs opts = + let reqs = mconcat + [ userReqs + , reqInclude $ includeHelper "utility.hpp" + , reqInclude $ includeStd "utility" + ] + + pair = + addReqs reqs $ + classAddFeatures (Assignable : Copyable : optPairClassFeatures opts) $ + makeClass (ident1T "std" "pair" [a, b]) (Just $ toExtName pairName) [] + [ mkCtor "new" [] + , mkCtor "newWith" [a, b] + ] $ + collect + [ just $ makeFnMethod (ident2 "hoppy" "utility" "pairFirst") "first" MNormal Nonpure + [TRef $ TObj pair] $ TRef a + , just $ makeFnMethod (ident2 "hoppy" "utility" "pairFirst") "firstConst" MConst Nonpure + [TRef $ TObj pair] $ TRef $ TConst a + , just $ makeFnMethod (ident2 "hoppy" "utility" "pairSecond") "second" MNormal Nonpure + [TRef $ TObj pair] $ TRef b + , just $ makeFnMethod (ident2 "hoppy" "utility" "pairSecond") "secondConst" MConst Nonpure + [TRef $ TObj pair] $ TRef $ TConst b + , test (activeCppVersion >= Cpp2011) $ mkMethod "swap" [TRef $ TObj pair] TVoid + ] + + in Contents + { c_pair = pair + } + +-- | Converts an instantiation into a list of exports to be included in a +-- module. +toExports :: Contents -> [Export] +toExports m = map (ExportClass . ($ m)) [c_pair] diff --git a/src/Foreign/Hoppy/Generator/Std/Set.hs b/src/Foreign/Hoppy/Generator/Std/Set.hs new file mode 100644 --- /dev/null +++ b/src/Foreign/Hoppy/Generator/Std/Set.hs @@ -0,0 +1,204 @@ +-- This file is part of Hoppy. +-- +-- Copyright 2015-2016 Bryan Gardiner +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. + +{-# LANGUAGE CPP #-} + +-- | Bindings for @std::set@. +module Foreign.Hoppy.Generator.Std.Set ( + Options (..), + defaultOptions, + Contents (..), + instantiate, + instantiate', + toExports, + ) where + +import Control.Monad (forM, when) +#if !MIN_VERSION_base(4,8,0) +import Data.Monoid (mconcat) +#endif +import Foreign.Hoppy.Generator.Language.Haskell ( + HsTypeSide (HsHsSide), + addImports, + cppTypeToHsTypeAndUse, + indent, + ln, + prettyPrint, + sayLn, + saysLn, + toHsCastMethodName, + toHsDataTypeName, + toHsMethodName', + ) +import Foreign.Hoppy.Generator.Spec +import Foreign.Hoppy.Generator.Spec.ClassFeature ( + ClassFeature (Assignable, Comparable, Copyable), + classAddFeatures, + ) +import Foreign.Hoppy.Generator.Std (ValueConversion (ConvertPtr, ConvertValue)) +import Foreign.Hoppy.Generator.Std.Internal (includeHelper) +import Foreign.Hoppy.Generator.Std.Iterator + +-- | Options for instantiating the set classes. +data Options = Options + { optSetClassFeatures :: [ClassFeature] + -- ^ Additional features to add to the @std::set@ class. Sets are always + -- 'Assignable', 'Comparable', and 'Copyable', but you may want to add + -- 'Foreign.Hoppy.Generator.Spec.ClassFeature.Equatable' if your value type + -- supports those. + , optValueConversion :: Maybe ValueConversion + } + +-- | The default options have no additional 'ClassFeature's. +defaultOptions :: Options +defaultOptions = Options [] Nothing + +-- | A set of instantiated set classes. +data Contents = Contents + { c_set :: Class -- ^ @std::set\@ + , c_iterator :: Class -- ^ @std::set\::iterator@ + } + +-- | @instantiate className t tReqs@ creates a set of bindings for an +-- instantiation of @std::set@ and associated types (e.g. iterators). In the +-- result, the 'c_set' class has an external name of @className@, and the +-- iterator class is further suffixed with @\"Iterator\"@. +instantiate :: String -> Type -> Reqs -> Contents +instantiate setName t tReqs = instantiate' setName t tReqs defaultOptions + +-- | 'instantiate' with additional options. +instantiate' :: String -> Type -> Reqs -> Options -> Contents +instantiate' setName t tReqs opts = + let reqs = mconcat + [ tReqs + , reqInclude $ includeHelper "set.hpp" + , reqInclude $ includeStd "set" + ] + iteratorName = setName ++ "Iterator" + + set = + (case optValueConversion opts of + Nothing -> id + Just conversion -> addAddendumHaskell $ makeAddendum conversion) $ + addReqs reqs $ + classAddFeatures (Assignable : Comparable : Copyable : optSetClassFeatures opts) $ + makeClass (ident1T "std" "set" [t]) (Just $ toExtName setName) [] + [ mkCtor "new" [] + ] + [ mkConstMethod "begin" [] $ TObjToHeap iterator + , mkMethod "clear" [] TVoid + , mkConstMethod "count" [t] TSize + -- TODO count + , mkConstMethod "empty" [] TBool + , mkConstMethod "end" [] $ TObjToHeap iterator + -- equalRange: find is good enough. + , mkMethod' "erase" "erase" [TObj iterator] TVoid + , mkMethod' "erase" "eraseRange" [TObj iterator, TObj iterator] TVoid + , mkMethod "find" [t] $ TObjToHeap iterator + , makeFnMethod (ident2 "hoppy" "set" "insert") "insert" + MNormal Nonpure [TRef $ TObj set, t] TBool + , makeFnMethod (ident2 "hoppy" "set" "insertAndGetIterator") "insertAndGetIterator" + MNormal Nonpure [TRef $ TObj set, t] $ TObjToHeap iterator + -- lower_bound: find is good enough. + , mkConstMethod' "max_size" "maxSize" [] TSize + , mkConstMethod "size" [] TSize + , mkMethod "swap" [TRef $ TObj set] TVoid + -- upper_bound: find is good enough. + ] + + -- Set iterators are always constant, because modifying elements in place + -- will break the internal order of the set. + iterator = + addReqs reqs $ + makeBidirectionalIterator Constant (Just t) $ + makeClass (identT' [("std", Nothing), ("set", Just [t]), ("iterator", Nothing)]) + (Just $ toExtName iteratorName) [] [] [] + + -- The addendum for the set class contains HasContents and FromContents + -- instances. + makeAddendum conversion = do + addImports $ mconcat [hsImport1 "Prelude" "($)", + hsImportForPrelude, + hsImportForRuntime] + when (conversion == ConvertValue) $ + addImports $ mconcat [hsImport1 "Prelude" "(=<<)"] + + let hsDataNameConst = toHsDataTypeName Const set + hsDataName = toHsDataTypeName Nonconst set + [hsValueTypeConst, hsValueType] <- forM [Const, Nonconst] $ \cst -> + cppTypeToHsTypeAndUse HsHsSide $ + (case conversion of + ConvertPtr -> TPtr + ConvertValue -> id) $ + case cst of + Const -> TConst t + Nonconst -> t + + -- Generate const and nonconst HasContents instances. + ln + saysLn ["instance HoppyFHR.HasContents ", hsDataNameConst, + " (", prettyPrint hsValueTypeConst, ") where"] + indent $ do + sayLn "toContents this' = do" + indent $ do + saysLn ["empty' <- ", toHsMethodName' set "empty", " this'"] + sayLn "if empty' then HoppyP.return [] else" + indent $ do + saysLn ["HoppyFHR.withScopedPtr (", toHsMethodName' set "begin", + " this') $ \\begin' ->"] + saysLn ["HoppyFHR.withScopedPtr (", toHsMethodName' set "end", + " this') $ \\iter' ->"] + sayLn "go' iter' begin' []" + sayLn "where" + indent $ do + sayLn "go' iter' begin' acc' = do" + indent $ do + saysLn ["stop' <- ", toHsMethodName' iterator OpEq, " iter' begin'"] + sayLn "if stop' then HoppyP.return acc' else do" + indent $ do + saysLn ["_ <- ", toHsMethodName' iterator "prev", " iter'"] + saysLn ["value' <- ", + case conversion of + ConvertPtr -> "" + ConvertValue -> "HoppyFHR.decode =<< ", + toHsMethodName' iterator "getConst", " iter'"] + sayLn "go' iter' begin' $ value':acc'" + ln + saysLn ["instance HoppyFHR.HasContents ", hsDataName, + " (", prettyPrint hsValueTypeConst, ") where"] + indent $ + saysLn ["toContents = HoppyFHR.toContents . ", toHsCastMethodName Const set] + + -- Only generate a nonconst FromContents instance. + ln + saysLn ["instance HoppyFHR.FromContents ", hsDataName, + " (", prettyPrint hsValueType, ") where"] + indent $ do + sayLn "fromContents values' = do" + indent $ do + saysLn ["set' <- ", toHsMethodName' set "new"] + saysLn ["HoppyP.mapM_ (", toHsMethodName' set "insert", " set') values'"] + sayLn "HoppyP.return set'" + + in Contents + { c_set = set + , c_iterator = iterator + } + +-- | Converts an instantiation into a list of exports to be included in a +-- module. +toExports :: Contents -> [Export] +toExports m = map (ExportClass . ($ m)) [c_set, c_iterator] diff --git a/src/Foreign/Hoppy/Generator/Std/String.hs b/src/Foreign/Hoppy/Generator/Std/String.hs new file mode 100644 --- /dev/null +++ b/src/Foreign/Hoppy/Generator/Std/String.hs @@ -0,0 +1,62 @@ +-- This file is part of Hoppy. +-- +-- Copyright 2015-2016 Bryan Gardiner +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. + +{-# LANGUAGE CPP #-} + +-- | Bindings for @std::string@. +module Foreign.Hoppy.Generator.Std.String (c_string) where + +#if !MIN_VERSION_base(4,8,0) +import Data.Monoid (mconcat) +#endif +import Foreign.Hoppy.Generator.Language.Haskell (addImports, sayLn) +import Foreign.Hoppy.Generator.Spec +import Foreign.Hoppy.Generator.Spec.ClassFeature +import Language.Haskell.Syntax ( + HsName (HsIdent), + HsQName (UnQual), + HsType (HsTyCon), + ) + +-- | @std::string@ +c_string :: Class +c_string = + addReqIncludes [includeStd "string"] $ + classAddFeatures [Assignable, Comparable, Copyable, Equatable] $ + classModifyConversion + (\c -> c { classHaskellConversion = + Just ClassHaskellConversion + { classHaskellConversionType = do + addImports hsImportForPrelude + return $ HsTyCon $ UnQual $ HsIdent "HoppyP.String" + , classHaskellConversionToCppFn = do + addImports $ mconcat [hsImportForPrelude, hsImportForForeignC] + sayLn "HoppyP.flip HoppyFC.withCString stdString_newFromCString" + , classHaskellConversionFromCppFn = do + addImports $ mconcat [hsImport1 "Control.Monad" "(<=<)", hsImportForForeignC] + sayLn "HoppyFC.peekCString <=< stdString_c_str" + } + }) $ + makeClass (ident1 "std" "string") (Just $ toExtName "StdString") + [] + [ mkCtor "new" [] + , mkCtor "newFromCString" [TPtr $ TConst TChar] + ] + [ mkConstMethod' "at" "at" [TInt] $ TRef TChar + , mkConstMethod' "at" "get" [TInt] TChar + , mkConstMethod "c_str" [] $ TPtr $ TConst TChar + , mkConstMethod "size" [] TSize + ] diff --git a/src/Foreign/Hoppy/Generator/Std/Vector.hs b/src/Foreign/Hoppy/Generator/Std/Vector.hs new file mode 100644 --- /dev/null +++ b/src/Foreign/Hoppy/Generator/Std/Vector.hs @@ -0,0 +1,207 @@ +-- This file is part of Hoppy. +-- +-- Copyright 2015-2016 Bryan Gardiner +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. + +{-# LANGUAGE CPP #-} + +-- | Bindings for @std::vector@. +module Foreign.Hoppy.Generator.Std.Vector ( + Options (..), + defaultOptions, + Contents (..), + instantiate, + instantiate', + toExports, + ) where + +import Control.Monad (forM_, when) +#if !MIN_VERSION_base(4,8,0) +import Data.Monoid (mconcat) +#endif +import Foreign.Hoppy.Generator.Language.Haskell ( + HsTypeSide (HsHsSide), + addImports, + cppTypeToHsTypeAndUse, + indent, + ln, + prettyPrint, + sayLn, + saysLn, + toHsDataTypeName, + toHsMethodName', + ) +import Foreign.Hoppy.Generator.Spec +import Foreign.Hoppy.Generator.Spec.ClassFeature ( + ClassFeature (Assignable, Copyable), + classAddFeatures, + ) +import Foreign.Hoppy.Generator.Std (ValueConversion (ConvertPtr, ConvertValue)) +import Foreign.Hoppy.Generator.Std.Iterator +import Foreign.Hoppy.Generator.Version (CppVersion (Cpp2011), activeCppVersion, collect, just, test) + +-- | Options for instantiating the vector classes. +data Options = Options + { optVectorClassFeatures :: [ClassFeature] + -- ^ Additional features to add to the @std::vector@ class. Vectors are + -- always 'Assignable' and 'Copyable', but you may want to add + -- 'Foreign.Hoppy.Generator.Spec.ClassFeature.Equatable' and + -- 'Foreign.Hoppy.Generator.Spec.ClassFeature.Comparable' if your value type + -- supports those. + , optValueConversion :: Maybe ValueConversion + } + +-- | The default options have no additional 'ClassFeature's. +defaultOptions :: Options +defaultOptions = Options [] Nothing + +-- | A set of instantiated vector classes. +data Contents = Contents + { c_vector :: Class -- ^ @std::vector\@ + , c_iterator :: Class -- ^ @std::vector\::iterator@ + , c_constIterator :: Class -- ^ @std::vector\::const_iterator@ + } + +-- | @instantiate className t tReqs@ creates a set of bindings for an +-- instantiation of @std::vector@ and associated types (e.g. iterators). In the +-- result, the 'c_vector' class has an external name of @className@, and the +-- iterator classes are further suffixed with @\"Iterator\"@ and +-- @\"ConstIterator\"@ respectively. +instantiate :: String -> Type -> Reqs -> Contents +instantiate vectorName t tReqs = instantiate' vectorName t tReqs defaultOptions + +-- | 'instantiate' with additional options. +instantiate' :: String -> Type -> Reqs -> Options -> Contents +instantiate' vectorName t tReqs opts = + let reqs = mconcat [tReqs, reqInclude $ includeStd "vector"] + iteratorName = vectorName ++ "Iterator" + constIteratorName = vectorName ++ "ConstIterator" + + vector = + (case optValueConversion opts of + Nothing -> id + Just conversion -> addAddendumHaskell $ makeAddendum conversion) $ + addReqs reqs $ + classAddFeatures (Assignable : Copyable : optVectorClassFeatures opts) $ + makeClass (ident1T "std" "vector" [t]) (Just $ toExtName vectorName) [] + [ mkCtor "new" [] + ] $ + collect + [ just $ mkMethod' "at" "at" [TSize] $ TRef t + , just $ mkConstMethod' "at" "atConst" [TSize] $ TRef $ TConst t + , just $ mkMethod' "back" "back" [] $ TRef t + , just $ mkConstMethod' "back" "backConst" [] $ TRef $ TConst t + , just $ mkMethod' "begin" "begin" [] $ TObjToHeap iterator + , just $ mkConstMethod' "begin" "beginConst" [] $ TObjToHeap constIterator + , just $ mkConstMethod "capacity" [] TSize + , just $ mkMethod "clear" [] TVoid + , just $ mkConstMethod "empty" [] TBool + , just $ mkMethod' "end" "end" [] $ TObjToHeap iterator + , just $ mkConstMethod' "end" "endConst" [] $ TObjToHeap constIterator + , just $ mkMethod' "erase" "erase" [TObj iterator] TVoid + , just $ mkMethod' "erase" "eraseRange" [TObj iterator, TObj iterator] TVoid + , just $ mkMethod' "front" "front" [] $ TRef t + , just $ mkConstMethod' "front" "frontConst" [] $ TRef $ TConst t + , just $ mkMethod' "insert" "insert" [TObj iterator, TRef $ TConst t] TVoid + , just $ mkMethod' "insert" "insertAndGetIterator" + [TObj iterator, t] $ TObjToHeap iterator + , just $ mkConstMethod' "max_size" "maxSize" [] TSize + , just $ mkMethod' "pop_back" "popBack" [] TVoid + , just $ mkMethod' "push_back" "pushBack" [t] TVoid + , just $ mkMethod "reserve" [TSize] TVoid + , just $ mkMethod' "resize" "resize" [TSize] TVoid + , just $ mkMethod' "resize" "resizeWith" [TSize, t] TVoid + , test (activeCppVersion >= Cpp2011) $ mkMethod' "shrink_to_fit" "shrinkToFit" [] TVoid + , just $ mkConstMethod "size" [] TSize + , just $ mkMethod "swap" [TRef $ TObj vector] TVoid + ] + + iterator = + addReqs reqs $ + makeRandomIterator Mutable (Just t) TPtrdiff $ + makeClass (identT' [("std", Nothing), ("vector", Just [t]), ("iterator", Nothing)]) + (Just $ toExtName iteratorName) [] [] [] + + constIterator = + addReqs reqs $ + makeRandomIterator Constant (Just t) TPtrdiff $ + makeClass (identT' [("std", Nothing), ("vector", Just [t]), ("const_iterator", Nothing)]) + (Just $ toExtName constIteratorName) [] + [ mkCtor "newFromNonconst" [TObj iterator] + ] + [ makeFnMethod (ident2 "hoppy" "iterator" "deconst") "deconst" MConst Nonpure + [TObj constIterator, TRef $ TObj vector] $ TObjToHeap iterator + ] + + -- The addendum for the vector class contains HasContents and FromContents + -- instances. + makeAddendum conversion = do + addImports $ mconcat [hsImports "Prelude" ["($)", "(-)"], + hsImportForPrelude, + hsImportForRuntime] + when (conversion == ConvertValue) $ + addImports $ hsImport1 "Control.Monad" "(<=<)" + + forM_ [Const, Nonconst] $ \cst -> do + let hsDataTypeName = toHsDataTypeName cst vector + hsValueType <- + cppTypeToHsTypeAndUse HsHsSide $ + (case conversion of + ConvertPtr -> TPtr + ConvertValue -> id) $ + case cst of + Const -> TConst t + Nonconst -> t + + -- Generate const and nonconst HasContents instances. + ln + saysLn ["instance HoppyFHR.HasContents ", hsDataTypeName, + " (", prettyPrint hsValueType, ") where"] + indent $ do + sayLn "toContents this' = do" + indent $ do + let vectorAt = case cst of + Const -> "atConst" + Nonconst -> "at" + saysLn ["size' <- ", toHsMethodName' vector "size", " this'"] + saysLn ["HoppyP.mapM (", + case conversion of + ConvertPtr -> "" + ConvertValue -> "HoppyFHR.decode <=< ", + toHsMethodName' vector vectorAt, " this') [0..size'-1]"] + + -- Only generate a nonconst FromContents instance. + when (cst == Nonconst) $ do + ln + saysLn ["instance HoppyFHR.FromContents ", hsDataTypeName, + " (", prettyPrint hsValueType, ") where"] + indent $ do + sayLn "fromContents values' = do" + indent $ do + saysLn ["vector' <- ", toHsMethodName' vector "new"] + saysLn [toHsMethodName' vector "reserve", + " vector' $ HoppyFHR.coerceIntegral $ HoppyP.length values'"] + saysLn ["HoppyP.mapM_ (", toHsMethodName' vector "pushBack", " vector') values'"] + sayLn "HoppyP.return vector'" + + in Contents + { c_vector = vector + , c_iterator = iterator + , c_constIterator = constIterator + } + +-- | Converts an instantiation into a list of exports to be included in a +-- module. +toExports :: Contents -> [Export] +toExports m = map (ExportClass . ($ m)) [c_vector, c_iterator, c_constIterator]