hoppy-std 0.4.0 → 0.5.0
raw patch · 7 files changed
+622/−14 lines, 7 filesdep ~hoppy-generatorPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: hoppy-generator
API changes (from Hackage documentation)
+ Foreign.Hoppy.Generator.Std.Set: [c_constIterator] :: Contents -> Class
+ Foreign.Hoppy.Generator.Std.UnorderedMap: Contents :: Class -> Class -> Class -> Contents
+ Foreign.Hoppy.Generator.Std.UnorderedMap: Options :: [ClassFeature] -> Maybe ValueConversion -> Maybe ValueConversion -> Options
+ Foreign.Hoppy.Generator.Std.UnorderedMap: [c_constIterator] :: Contents -> Class
+ Foreign.Hoppy.Generator.Std.UnorderedMap: [c_iterator] :: Contents -> Class
+ Foreign.Hoppy.Generator.Std.UnorderedMap: [c_map] :: Contents -> Class
+ Foreign.Hoppy.Generator.Std.UnorderedMap: [optKeyConversion] :: Options -> Maybe ValueConversion
+ Foreign.Hoppy.Generator.Std.UnorderedMap: [optUnorderedMapClassFeatures] :: Options -> [ClassFeature]
+ Foreign.Hoppy.Generator.Std.UnorderedMap: [optValueConversion] :: Options -> Maybe ValueConversion
+ Foreign.Hoppy.Generator.Std.UnorderedMap: data Contents
+ Foreign.Hoppy.Generator.Std.UnorderedMap: data Options
+ Foreign.Hoppy.Generator.Std.UnorderedMap: defaultOptions :: Options
+ Foreign.Hoppy.Generator.Std.UnorderedMap: instantiate :: String -> Type -> Type -> Reqs -> Contents
+ Foreign.Hoppy.Generator.Std.UnorderedMap: instantiate' :: String -> Type -> Type -> Reqs -> Options -> Contents
+ Foreign.Hoppy.Generator.Std.UnorderedMap: toExports :: Contents -> [Export]
+ Foreign.Hoppy.Generator.Std.UnorderedSet: Contents :: Class -> Class -> Class -> Contents
+ Foreign.Hoppy.Generator.Std.UnorderedSet: Options :: [ClassFeature] -> Maybe ValueConversion -> Options
+ Foreign.Hoppy.Generator.Std.UnorderedSet: [c_constIterator] :: Contents -> Class
+ Foreign.Hoppy.Generator.Std.UnorderedSet: [c_iterator] :: Contents -> Class
+ Foreign.Hoppy.Generator.Std.UnorderedSet: [c_set] :: Contents -> Class
+ Foreign.Hoppy.Generator.Std.UnorderedSet: [optUnorderedSetClassFeatures] :: Options -> [ClassFeature]
+ Foreign.Hoppy.Generator.Std.UnorderedSet: [optValueConversion] :: Options -> Maybe ValueConversion
+ Foreign.Hoppy.Generator.Std.UnorderedSet: data Contents
+ Foreign.Hoppy.Generator.Std.UnorderedSet: data Options
+ Foreign.Hoppy.Generator.Std.UnorderedSet: defaultOptions :: Options
+ Foreign.Hoppy.Generator.Std.UnorderedSet: instantiate :: String -> Type -> Reqs -> Contents
+ Foreign.Hoppy.Generator.Std.UnorderedSet: instantiate' :: String -> Type -> Reqs -> Options -> Contents
+ Foreign.Hoppy.Generator.Std.UnorderedSet: toExports :: Contents -> [Export]
- Foreign.Hoppy.Generator.Std.Set: Contents :: Class -> Class -> Contents
+ Foreign.Hoppy.Generator.Std.Set: Contents :: Class -> Class -> Class -> Contents
Files
- hoppy-std.cabal +6/−2
- include/hoppy/std/unordered_map.hpp +43/−0
- include/hoppy/std/unordered_set.hpp +41/−0
- src/Foreign/Hoppy/Generator/Std/Set.hs +20/−8
- src/Foreign/Hoppy/Generator/Std/String.hs +22/−4
- src/Foreign/Hoppy/Generator/Std/UnorderedMap.hs +266/−0
- src/Foreign/Hoppy/Generator/Std/UnorderedSet.hs +224/−0
hoppy-std.cabal view
@@ -1,5 +1,5 @@ name: hoppy-std-version: 0.4.0+version: 0.5.0 synopsis: C++ FFI generator - Standard library bindings homepage: http://khumba.net/projects/hoppy license: Apache-2.0@@ -19,6 +19,8 @@ include/hoppy/std/iterator.hpp , include/hoppy/std/map.hpp , include/hoppy/std/set.hpp+ , include/hoppy/std/unordered_map.hpp+ , include/hoppy/std/unordered_set.hpp , include/hoppy/std/utility.hpp library@@ -30,6 +32,8 @@ , Foreign.Hoppy.Generator.Std.Pair , Foreign.Hoppy.Generator.Std.Set , Foreign.Hoppy.Generator.Std.String+ , Foreign.Hoppy.Generator.Std.UnorderedMap+ , Foreign.Hoppy.Generator.Std.UnorderedSet , Foreign.Hoppy.Generator.Std.Vector other-modules: Foreign.Hoppy.Generator.Std.Internal@@ -38,7 +42,7 @@ base >=4.7 && <5 , filepath >=1.0 && <1.5 , haskell-src >=1.0 && <1.1- , hoppy-generator >=0.4 && <0.5+ , hoppy-generator >=0.5 && <0.6 hs-source-dirs: src ghc-options: -W -fwarn-incomplete-patterns -fwarn-unused-do-bind default-language: Haskell2010
+ include/hoppy/std/unordered_map.hpp view
@@ -0,0 +1,43 @@+#ifndef HOPPY_STD_UNORDERED_MAP_HPP+#define HOPPY_STD_UNORDERED_MAP_HPP++// This file is part of Hoppy.+//+// Copyright 2015-2018 Bryan Gardiner <bog@khumba.net>+//+// 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 <unordered_map>++namespace hoppy {+namespace unordered_map {++template <typename K, typename V>+const K& getIteratorKey(const typename std::unordered_map<K, V>::const_iterator& iterator) {+ return iterator->first;+}++template <typename K, typename V>+V& getIteratorValue(typename std::unordered_map<K, V>::iterator& iterator) {+ return iterator->second;+}++template <typename K, typename V>+const V& getIteratorValue(const typename std::unordered_map<K, V>::const_iterator& iterator) {+ return iterator->second;+}++} // namespace unordered_map+} // namespace hoppy++#endif
+ include/hoppy/std/unordered_set.hpp view
@@ -0,0 +1,41 @@+#ifndef HOPPY_STD_UNORDERED_SET_HPP+#define HOPPY_STD_UNORDERED_SET_HPP++// This file is part of Hoppy.+//+// Copyright 2015-2018 Bryan Gardiner <bog@khumba.net>+//+// 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 <unordered_set>++namespace hoppy {+namespace unordered_set {++template <typename T>+bool insert(std::unordered_set<T>& set, const T& value) {+ return set.insert(value).second;+}++template <typename T>+typename std::unordered_set<T>::iterator insertAndGetIterator(+ std::unordered_set<T>& set,+ const T& value+) {+ return set.insert(value).first;+}++} // namespace unordered_set+} // namespace hoppy++#endif
src/Foreign/Hoppy/Generator/Std/Set.hs view
@@ -67,6 +67,7 @@ data Contents = Contents { c_set :: Class -- ^ @std::set\<T>@ , c_iterator :: Class -- ^ @std::set\<T>::iterator@+ , c_constIterator :: Class -- ^ @std::set\<T>::const_iterator@ } -- | @instantiate className t tReqs@ creates a set of bindings for an@@ -94,12 +95,14 @@ classAddFeatures (Assignable : Comparable : Copyable : optSetClassFeatures opts) $ makeClass (ident1T "std" "set" [t]) (Just $ toExtName setName) [] [ mkCtor "new" []- , mkConstMethod "begin" [] $ toGcT $ objT iterator+ , mkMethod' "begin" "begin" [] $ toGcT $ objT iterator+ , mkConstMethod' "begin" "beginConst" [] $ toGcT $ objT constIterator , mkMethod "clear" [] voidT , mkConstMethod "count" [t] sizeT -- TODO count , mkConstMethod "empty" [] boolT- , mkConstMethod "end" [] $ toGcT $ objT iterator+ , mkMethod' "end" "end" [] $ toGcT $ objT iterator+ , mkConstMethod' "end" "endConst" [] $ toGcT $ objT constIterator -- equalRange: find is good enough. , mkMethod' "erase" "erase" [objT iterator] voidT , mkMethod' "erase" "eraseRange" [objT iterator, objT iterator] voidT@@ -117,13 +120,21 @@ ] -- Set iterators are always constant, because modifying elements in place- -- will break the internal order of the set.+ -- will break the internal order of the set. That said, 'iterator' and+ -- 'const_iterator' aren't guaranteed to be the same type; only that+ -- 'iterator' is convertible to 'const_iterator'. iterator = addReqs reqs $ makeBidirectionalIterator Constant (Just t) $ makeClass (identT' [("std", Nothing), ("set", Just [t]), ("iterator", Nothing)]) (Just $ toExtName iteratorName) [] [] + constIterator =+ addReqs reqs $+ makeBidirectionalIterator Constant (Just t) $+ makeClass (identT' [("std", Nothing), ("set", Just [t]), ("const_iterator", Nothing)])+ (Just $ toExtName iteratorName) [] []+ -- The addendum for the set class contains HasContents and FromContents -- instances. makeAddendum conversion = do@@ -146,8 +157,8 @@ setConstCast <- toHsCastMethodName Const set setEmpty <- toHsClassEntityName set "empty"- setBegin <- toHsClassEntityName set "begin"- setEnd <- toHsClassEntityName set "end"+ setBeginConst <- toHsClassEntityName set "beginConst"+ setEndConst <- toHsClassEntityName set "endConst" iterEq <- toHsClassEntityName iterator OpEq iterGetConst <- toHsClassEntityName iterator "getConst" iterPrev <- toHsClassEntityName iterator "prev"@@ -162,8 +173,8 @@ saysLn ["empty' <- ", setEmpty, " this'"] sayLn "if empty' then HoppyP.return [] else do" indent $ do- saysLn ["begin' <- ", setBegin, " this'"]- saysLn ["iter' <- ", setEnd, " this'"]+ saysLn ["begin' <- ", setBeginConst, " this'"]+ saysLn ["iter' <- ", setEndConst, " this'"] sayLn "go' iter' begin' []" sayLn "where" indent $ do@@ -201,9 +212,10 @@ in Contents { c_set = set , 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_set, c_iterator]+toExports m = map (ExportClass . ($ m)) [c_set, c_iterator, c_constIterator]
src/Foreign/Hoppy/Generator/Std/String.hs view
@@ -22,7 +22,7 @@ #if !MIN_VERSION_base(4,8,0) import Data.Monoid (mconcat) #endif-import Foreign.Hoppy.Generator.Language.Haskell (addImports, sayLn)+import Foreign.Hoppy.Generator.Language.Haskell (addExport, addImports, indent, sayLn) import Foreign.Hoppy.Generator.Spec import Foreign.Hoppy.Generator.Types import Language.Haskell.Syntax (@@ -36,6 +36,7 @@ c_string = addReqIncludes [includeStd "string"] $ classAddFeatures [Assignable, Comparable, Copyable, Equatable] $+ addAddendumHaskell addendum $ classSetHaskellConversion ClassHaskellConversion { classHaskellConversionType = Just $ do@@ -43,16 +44,33 @@ return $ HsTyCon $ UnQual $ HsIdent "HoppyP.String" , classHaskellConversionToCppFn = Just $ do addImports $ mconcat [hsImportForPrelude, hsImportForForeignC]- sayLn "HoppyP.flip HoppyFC.withCString stdString_newFromCString"+ sayLn "HoppyP.flip HoppyFC.withCStringLen stdString_newFromCStringLen" , classHaskellConversionFromCppFn = Just $ do- addImports $ mconcat [hsImport1 "Control.Monad" "(<=<)", hsImportForForeignC]- sayLn "HoppyFC.peekCString <=< stdString_c_str"+ addImports $ mconcat [hsImport1 "Control.Applicative" "(<*)",+ hsImportForForeignC,+ hsImportForPrelude,+ hsImportForRuntime]+ sayLn "\\s -> do"+ indent $ do+ sayLn "p <- stdString_data s"+ sayLn "n <- stdString_size s"+ sayLn "HoppyFC.peekCStringLen (p, HoppyP.fromIntegral n) <* HoppyFHR.touchCppPtr s" } $ makeClass (ident1 "std" "string") (Just $ toExtName "StdString") [] [ mkCtor "new" [] , mkCtor "newFromCString" [ptrT $ constT charT]+ , mkCtor "newFromCStringLen_raw" [ptrT $ constT charT, sizeT] , mkMethod' "at" "at" [intT] $ refT charT , mkConstMethod' "at" "get" [intT] charT , mkConstMethod "c_str" [] $ ptrT $ constT charT+ , mkConstMethod "data" [] $ ptrT $ constT charT , mkConstMethod "size" [] sizeT ]+ where+ addendum = do+ addImports $ mconcat [hsImportForPrelude, hsImportForForeignC]+ addExport "stdString_newFromCStringLen"+ sayLn "stdString_newFromCStringLen :: HoppyFC.CStringLen -> HoppyP.IO StdString"+ sayLn "stdString_newFromCStringLen (p,n) ="+ indent $ do+ sayLn "stdString_newFromCStringLen_raw p (HoppyP.fromIntegral n)"
+ src/Foreign/Hoppy/Generator/Std/UnorderedMap.hs view
@@ -0,0 +1,266 @@+-- This file is part of Hoppy.+--+-- Copyright 2015-2018 Bryan Gardiner <bog@khumba.net>+--+-- 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::unordered_map@.+module Foreign.Hoppy.Generator.Std.UnorderedMap (+ 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,+ toHsClassEntityName,+ )+import Foreign.Hoppy.Generator.Spec+import Foreign.Hoppy.Generator.Std (ValueConversion (ConvertPtr, ConvertValue))+import Foreign.Hoppy.Generator.Std.Internal (includeHelper)+import Foreign.Hoppy.Generator.Std.Iterator+import Foreign.Hoppy.Generator.Types++-- | Options for instantiating the map classes.+data Options = Options+ { optUnorderedMapClassFeatures :: [ClassFeature]+ -- ^ Additional features to add to the @std::unordered_map@ class. UnorderedMaps 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::unordered_map\<K, V>@+ , c_iterator :: Class -- ^ @std::unordered_map\<K, V>::iterator@+ , c_constIterator :: Class -- ^ @std::unordered_map\<K, V>::const_iterator@+ }++-- | @instantiate className k v reqs@ creates a set of bindings for an+-- instantiation of @std::unordered_map\<k, v\>@ 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 "unordered_map.hpp"+ , reqInclude $ includeStd "unordered_map"+ ]+ iteratorName = mapName ++ "Iterator"+ constIteratorName = mapName ++ "ConstIterator"++ getIteratorKeyIdent = ident2T "hoppy" "unordered_map" "getIteratorKey" [k, v]+ getIteratorValueIdent = ident2T "hoppy" "unordered_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::unordered_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 : optUnorderedMapClassFeatures opts) $+ makeClass (ident1T "std" "unordered_map" [k, v]) (Just extName) []+ [ mkCtor "new" []+ , mkMethod' "at" "at" [k] $ refT v+ , mkConstMethod' "at" "atConst" [k] $ refT $ constT v+ , mkMethod' "begin" "begin" [] $ toGcT $ objT iterator+ , mkConstMethod' "begin" "beginConst" [] $ toGcT $ objT constIterator+ , mkMethod "clear" [] voidT+ , mkConstMethod "count" [k] sizeT+ , mkConstMethod "empty" [] boolT+ , mkMethod' "end" "end" [] $ toGcT $ objT iterator+ , mkConstMethod' "end" "endConst" [] $ toGcT $ objT constIterator+ -- equal_range: find is good enough.+ , mkMethod' "erase" "erase" [objT iterator] voidT+ , mkMethod' "erase" "eraseKey" [k] sizeT+ , mkMethod' "erase" "eraseRange" [objT iterator, objT iterator] voidT+ , mkMethod' "find" "find" [k] $ toGcT $ objT iterator+ , mkConstMethod' "find" "findConst" [k] $ toGcT $ objT constIterator+ -- TODO insert+ -- lower_bound: find is good enough.+ , mkConstMethod' "max_size" "maxSize" [] sizeT+ , mkConstMethod "size" [] sizeT+ , mkMethod "swap" [refT $ objT map] voidT+ -- upper_bound: find is good enough.+ , mkMethod OpArray [k] $ refT v+ ]++ iterator =+ addReqs reqs $+ makeForwardIterator Mutable Nothing $+ makeClass (identT' [("std", Nothing),+ ("unordered_map", Just [k, v]),+ ("iterator", Nothing)])+ (Just $ toExtName iteratorName) []+ [ makeFnMethod getIteratorKeyIdent "getKey" MConst Nonpure+ [objT iterator] $ refT $ constT k+ , makeFnMethod getIteratorValueIdent "getValue" MNormal Nonpure+ [refT $ objT iterator] $ refT v+ , makeFnMethod getIteratorValueIdent "getValueConst" MConst Nonpure+ [objT iterator] $ refT $ constT v+ ]++ constIterator =+ addReqs reqs $+ makeForwardIterator Constant Nothing $+ makeClass (identT' [("std", Nothing),+ ("unordered_map", Just [k, v]),+ ("const_iterator", Nothing)])+ (Just $ toExtName constIteratorName)+ []+ [ mkCtor "newFromConst" [objT iterator]+ , makeFnMethod (ident2 "hoppy" "iterator" "deconst") "deconst" MConst Nonpure+ [objT constIterator, refT $ objT map] $ toGcT $ objT iterator+ , makeFnMethod getIteratorKeyIdent "getKey" MConst Nonpure+ [objT constIterator] $ refT $ constT k+ , makeFnMethod getIteratorValueIdent "getValueConst" MConst Nonpure+ [objT constIterator] $ refT $ constT 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+ hsDataTypeName <- toHsDataTypeName cst map++ keyHsType <-+ cppTypeToHsTypeAndUse HsHsSide $+ (case keyConv of+ ConvertPtr -> ptrT+ ConvertValue -> id) $+ constT k++ valueHsType <-+ cppTypeToHsTypeAndUse HsHsSide $+ (case valueConv of+ ConvertPtr -> ptrT+ ConvertValue -> id) $+ case cst of+ Const -> constT 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+ mapEmpty <- toHsClassEntityName map "empty"+ mapBegin <- toHsClassEntityName map $ case cst of+ Const -> "beginConst"+ Nonconst -> "begin"+ mapEnd <- toHsClassEntityName map $ case cst of+ Const -> "endConst"+ Nonconst -> "end"+ let iter = case cst of+ Const -> constIterator+ Nonconst -> iterator+ iterEq <- toHsClassEntityName iter OpEq+ iterGetKey <- toHsClassEntityName iter "getKey"+ iterGetValue <- toHsClassEntityName iter $ case cst of+ Const -> "getValueConst"+ Nonconst -> "getValue"+ iterNext <- toHsClassEntityName iter "next"++ saysLn ["empty' <- ", mapEmpty, " this'"]+ sayLn "if empty' then HoppyP.return [] else do"+ indent $ do+ saysLn ["end' <- ", mapEnd, " this'"]+ saysLn ["iter' <- ", mapBegin, " this'"]+ sayLn "go' iter' end' []"+ sayLn "where"+ indent $ do+ sayLn "go' iter' end' acc' = do"+ indent $ do+ saysLn ["stop' <- ", iterEq, " iter' end'"]+ sayLn "if stop' then HoppyP.return (HoppyP.reverse acc') else do"+ indent $ do+ saysLn ["_ <- ", iterNext, " iter'"]+ saysLn ["key' <- ",+ case keyConv of+ ConvertPtr -> ""+ ConvertValue -> "HoppyFHR.decode =<< ",+ iterGetKey, " iter'"]+ saysLn ["value' <- ",+ case valueConv of+ ConvertPtr -> ""+ ConvertValue -> "HoppyFHR.decode =<< ",+ iterGetValue, " iter'"]+ sayLn "go' iter' end' $ (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+ mapNew <- toHsClassEntityName map "new"+ mapAt <- toHsClassEntityName map "at"+ saysLn ["map' <- ", mapNew]+ saysLn ["HoppyP.mapM_ (\\(k, v) -> HoppyP.flip HoppyFHR.assign v =<< ",+ mapAt, " 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]
+ src/Foreign/Hoppy/Generator/Std/UnorderedSet.hs view
@@ -0,0 +1,224 @@+-- This file is part of Hoppy.+--+-- Copyright 2015-2018 Bryan Gardiner <bog@khumba.net>+--+-- 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::unordered_set@.+module Foreign.Hoppy.Generator.Std.UnorderedSet (+ 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,+ toHsClassEntityName,+ )+import Foreign.Hoppy.Generator.Spec+import Foreign.Hoppy.Generator.Std (ValueConversion (ConvertPtr, ConvertValue))+import Foreign.Hoppy.Generator.Std.Internal (includeHelper)+import Foreign.Hoppy.Generator.Std.Iterator+import Foreign.Hoppy.Generator.Types++-- | Options for instantiating the set classes.+data Options = Options+ { optUnorderedSetClassFeatures :: [ClassFeature]+ -- ^ Additional features to add to the @std::unordered_set@ class. UnorderedSets 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::unordered_set\<T>@+ , c_iterator :: Class -- ^ @std::unordered_set\<T>::iterator@+ , c_constIterator :: Class -- ^ @std::unordered_set\<T>::const_iterator@+ }++-- | @instantiate className t tReqs@ creates a set of bindings for an+-- instantiation of @std::unordered_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 "unordered_set.hpp"+ , reqInclude $ includeStd "unordered_set"+ ]+ iteratorName = setName ++ "Iterator"++ set =+ (case optValueConversion opts of+ Nothing -> id+ Just conversion -> addAddendumHaskell $ makeAddendum conversion) $+ addReqs reqs $+ classAddFeatures (Assignable : Copyable : optUnorderedSetClassFeatures opts) $+ makeClass (ident1T "std" "unordered_set" [t]) (Just $ toExtName setName) []+ [ mkCtor "new" []+ , mkMethod' "begin" "begin" [] $ toGcT $ objT iterator+ , mkConstMethod' "begin" "beginConst" [] $ toGcT $ objT constIterator+ , mkMethod "clear" [] voidT+ , mkConstMethod "count" [t] sizeT+ -- TODO count+ , mkConstMethod "empty" [] boolT+ , mkMethod' "end" "end" [] $ toGcT $ objT iterator+ , mkConstMethod' "end" "endConst" [] $ toGcT $ objT constIterator+ -- equalRange: find is good enough.+ , mkMethod' "erase" "erase" [objT iterator] voidT+ , mkMethod' "erase" "eraseRange" [objT iterator, objT iterator] voidT+ , mkMethod "find" [t] $ toGcT $ objT iterator+ -- TODO Replace these with a single version that returns a (toGcT std::pair).+ , makeFnMethod (ident2 "hoppy" "unordered_set" "insert") "insert"+ MNormal Nonpure [refT $ objT set, t] boolT+ , makeFnMethod (ident2 "hoppy" "unordered_set" "insertAndGetIterator")+ "insertAndGetIterator" MNormal Nonpure [refT $ objT set, t] $ toGcT $ objT iterator+ -- lower_bound: find is good enough.+ , mkConstMethod' "max_size" "maxSize" [] sizeT+ , mkConstMethod "size" [] sizeT+ , mkMethod "swap" [refT $ objT set] voidT+ -- upper_bound: find is good enough.+ ]++ -- Unordered set iterators are always constant, because modifying elements+ -- in place will break the internal order of the set. That said,+ -- 'iterator' and 'const_iterator' aren't guaranteed to be the same type+ -- (indeed they're not for g++ 7.2.0 on Kubuntu 17.10 amd64); only that+ -- 'iterator' is convertible to 'const_iterator'.+ iterator =+ addReqs reqs $+ makeForwardIterator Constant (Just t) $+ makeClass (identT' [("std", Nothing), ("unordered_set", Just [t]), ("iterator", Nothing)])+ (Just $ toExtName iteratorName) [] []++ constIterator =+ addReqs reqs $+ makeForwardIterator Constant (Just t) $+ makeClass (identT' [("std", Nothing),+ ("unordered_set", Just [t]),+ ("const_iterator", Nothing)])+ (Just $ toExtName iteratorName) [] []++ -- The addendum for the unordered_set class contains HasContents and FromContents+ -- instances.+ makeAddendum conversion = do+ addImports $ mconcat [hsImport1 "Prelude" "($)",+ hsImportForPrelude,+ hsImportForRuntime]+ when (conversion == ConvertValue) $+ addImports $ mconcat [hsImport1 "Prelude" "(=<<)"]++ hsDataNameConst <- toHsDataTypeName Const set+ hsDataName <- toHsDataTypeName Nonconst set+ [hsValueTypeConst, hsValueType] <- forM [Const, Nonconst] $ \cst ->+ cppTypeToHsTypeAndUse HsHsSide $+ (case conversion of+ ConvertPtr -> ptrT+ ConvertValue -> id) $+ case cst of+ Const -> constT t+ Nonconst -> t++ setConstCast <- toHsCastMethodName Const set+ setEmpty <- toHsClassEntityName set "empty"+ setBeginConst <- toHsClassEntityName set "beginConst"+ setEndConst <- toHsClassEntityName set "endConst"+ iterEq <- toHsClassEntityName iterator OpEq+ iterGetConst <- toHsClassEntityName iterator "getConst"+ iterNext <- toHsClassEntityName iterator "next"++ -- 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' <- ", setEmpty, " this'"]+ sayLn "if empty' then HoppyP.return [] else do"+ indent $ do+ saysLn ["end' <- ", setEndConst, " this'"]+ saysLn ["iter' <- ", setBeginConst, " this'"]+ sayLn "go' iter' end' []"+ sayLn "where"+ indent $ do+ sayLn "go' iter' end' acc' = do"+ indent $ do+ saysLn ["stop' <- ", iterEq, " iter' end'"]+ sayLn "if stop' then HoppyP.return (HoppyP.reverse acc') else do"+ indent $ do+ saysLn ["_ <- ", iterNext, " iter'"]+ saysLn ["value' <- ",+ case conversion of+ ConvertPtr -> ""+ ConvertValue -> "HoppyFHR.decode =<< ",+ iterGetConst, " iter'"]+ sayLn "go' iter' end' $ value':acc'"+ ln+ saysLn ["instance HoppyFHR.HasContents ", hsDataName,+ " (", prettyPrint hsValueTypeConst, ") where"]+ indent $+ saysLn ["toContents = HoppyFHR.toContents . ", setConstCast]++ -- Only generate a nonconst FromContents instance.+ ln+ saysLn ["instance HoppyFHR.FromContents ", hsDataName,+ " (", prettyPrint hsValueType, ") where"]+ indent $ do+ sayLn "fromContents values' = do"+ indent $ do+ setNew <- toHsClassEntityName set "new"+ setInsert <- toHsClassEntityName set "insert"+ saysLn ["set' <- ", setNew]+ saysLn ["HoppyP.mapM_ (", setInsert, " set') values'"]+ sayLn "HoppyP.return set'"++ in Contents+ { c_set = set+ , 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_set, c_iterator, c_constIterator]