├── .gitignore ├── README.md ├── cabal.project ├── linear-common ├── linear-common.cabal └── src │ ├── DataL.hs │ ├── PreludeL.hs │ ├── PreludeL │ └── RebindableSyntax.hs │ └── StateL.hs ├── linear-tests ├── linear-tests.cabal └── src │ └── Tests.hs ├── linear-watertight ├── linear-watertight.cabal └── src │ ├── Obj.hs │ └── WatertightL.hs └── run_tests_continuously.sh /.gitignore: -------------------------------------------------------------------------------- 1 | dist-newstyle 2 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # linear-examples 2 | 3 | The goal is to write a few example libraries using [tweag's implementation of linear types for GHC](https://github.com/tweag/ghc/tree/linear-types#readme), in order to fuel the [discussion page about the linear types proposal](https://github.com/ghc-proposals/ghc-proposals/pull/91#issuecomment-346721678). 4 | 5 | So far, there is only one example, a Haskell implementation of [my blog post about watertight 3D models](https://www.spiria.com/en/blog/desktop-software/making-non-manifold-models-unrepresentable). In a nutshell, the goal is to prevent holes in 3D surfaces by making sure that every edge is bound by exactly two faces. This is accomplished by guaranteeing that each edge is used exactly twice, which is in turn accomplished by generating two co-edges at a time and using linear types to make sure that each one is used by exactly one face. So the following compiles: 6 | 7 | makeWatertight3dModel $ do 8 | Unrestricted pA <- addPoint (1,2,3) 9 | Unrestricted pB <- addPoint (4,5,6) 10 | Unrestricted pC <- addPoint (7,8,9) 11 | (coedgeAB, coedgeBA) <- addCoEdges pA pB 12 | (coedgeBC, coedgeCB) <- addCoEdges pB pC 13 | (coedgeCA, coedgeAC) <- addCoEdges pC pA 14 | addFace [coedgeAB, coedgeBC, coedgeCA] 15 | addFace [coedgeAC, coedgeCB, coedgeBA] 16 | 17 | But if the last line is commented out, the compiler complains that many co-edges are never used, which is exactly what we want since that means the corresponding edges are bordering a hole in the surface. 18 | 19 | ## Build instructions 20 | 21 | [Build ghc-HEAD](https://ghc.dev/) (or use ghc-10.12 if it's out by the time you 22 | read this), then build linear-watertight: 23 | 24 | $ cabal v2-build linear-watertight 25 | -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | packages: linear-common/*.cabal linear-watertight/*.cabal 2 | -------------------------------------------------------------------------------- /linear-common/linear-common.cabal: -------------------------------------------------------------------------------- 1 | name: linear-common 2 | version: 0.1.0.0 3 | license: PublicDomain 4 | author: Samuel Gélineau 5 | maintainer: gelisam+github@gmail.com 6 | build-type: Simple 7 | cabal-version: >=1.10 8 | 9 | library 10 | exposed-modules: DataL 11 | , PreludeL 12 | , PreludeL.RebindableSyntax 13 | , StateL 14 | build-depends: base 15 | hs-source-dirs: src 16 | default-language: Haskell2010 17 | ghc-options: -W -Wall 18 | -------------------------------------------------------------------------------- /linear-common/src/DataL.hs: -------------------------------------------------------------------------------- 1 | -- Types which consist only of data, no functions, can be consumed by 2 | -- pattern-matching down to their leaves and reconstructed unrestricted. 3 | {-# LANGUAGE LinearTypes, ScopedTypeVariables #-} 4 | module DataL where 5 | 6 | import PreludeL 7 | 8 | 9 | class DataL a where 10 | unrestrict :: a #-> Unrestricted a 11 | 12 | skip :: DataL a => a -> () 13 | skip x = unrestrict x &. \(Unrestricted _) 14 | -> () 15 | 16 | dup :: DataL a => a #-> (a, a) 17 | dup x = unrestrict x &. \(Unrestricted x') 18 | -> (x', x') 19 | 20 | 21 | instance DataL () where 22 | unrestrict () = Unrestricted () 23 | 24 | instance DataL (Unrestricted a) where 25 | unrestrict (Unrestricted x) = Unrestricted (Unrestricted x) 26 | 27 | 28 | unrestrictPair :: (a #-> Unrestricted a) 29 | -> (b #-> Unrestricted b) 30 | -> (a, b) #-> Unrestricted (a, b) 31 | unrestrictPair unrestrictX unrestrictY (x, y) 32 | = unrestrictX x &. \(Unrestricted x') 33 | -> unrestrictY y &. \(Unrestricted y') 34 | -> Unrestricted (x', y') 35 | 36 | instance (DataL a, DataL b) => DataL (a, b) where 37 | unrestrict = unrestrictPair unrestrict unrestrict 38 | 39 | 40 | unrestrictEither :: (a #-> Unrestricted a) 41 | -> (b #-> Unrestricted b) 42 | -> Either a b #-> Unrestricted (Either a b) 43 | unrestrictEither unrestrictX _ (Left x) = unrestrictX x &. \(Unrestricted x') 44 | -> Unrestricted (Left x') 45 | unrestrictEither _ unrestrictY (Right y) = unrestrictY y &. \(Unrestricted y') 46 | -> Unrestricted (Right y') 47 | 48 | instance (DataL a, DataL b) => DataL (Either a b) where 49 | unrestrict = unrestrictEither unrestrict unrestrict 50 | 51 | 52 | unrestrictList :: forall a 53 | . (a #-> Unrestricted a) 54 | -> [a] #-> Unrestricted [a] 55 | unrestrictList unrestrictX = go 56 | where 57 | go :: [a] #-> Unrestricted [a] 58 | go [] = Unrestricted [] 59 | go (x:xs) = unrestrictX x &. \(Unrestricted x') 60 | -> go xs &. \(Unrestricted xs') 61 | -> Unrestricted (x':xs') 62 | 63 | instance DataL a => DataL [a] where 64 | unrestrict = unrestrictList unrestrict 65 | -------------------------------------------------------------------------------- /linear-common/src/PreludeL.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GADTs, LinearTypes #-} 2 | module PreludeL where 3 | 4 | import Prelude hiding ((>>), (>>=)) 5 | 6 | 7 | -- | 8 | -- Marks variables which can be consumed zero or multiple times, even within 9 | -- a linear computation. So this compiles: 10 | -- 11 | -- >>> :{ 12 | -- let f :: (a, Unrestricted b) #-> (a, b, b) 13 | -- f (x, Unrestricted y) = (x, y, y) 14 | -- :} 15 | -- 16 | -- But this does not: 17 | -- 18 | -- >>> :{ 19 | -- let f :: (a, b) #-> (a, b, b) 20 | -- f (x, y) = (x, y, y) 21 | -- :} 22 | -- ... 23 | -- ...Couldn't match expected weight ‘1’ of variable ‘y’ with actual weight ‘ω’ 24 | -- ... 25 | data Unrestricted a where 26 | Unrestricted :: a -> Unrestricted a 27 | deriving (Eq, Show) 28 | 29 | getUnrestricted :: Unrestricted a #-> a 30 | getUnrestricted (Unrestricted x) = x 31 | 32 | 33 | -- | 34 | -- let doesn't yet preserve multiplicity: 35 | -- 36 | -- >>> :{ 37 | -- let f :: a #-> a 38 | -- f x = let x' = x in x' 39 | -- :} 40 | -- ... 41 | -- ...Couldn't match expected weight ‘1’ of variable ‘x’ with actual weight ‘ω’ 42 | -- ... 43 | -- 44 | -- so I need a lambda to pattern-match instead: 45 | -- 46 | -- >>> :{ 47 | -- let f :: a #-> a 48 | -- f x = x &. \x' -> x' 49 | -- :} 50 | -- 51 | infixl 1 &. 52 | (&.) :: a #-> ((a #-> b) #-> b) 53 | x &. f = f x 54 | 55 | 56 | -- | 57 | -- A variant of Functor in which the output must be used (or returned) 58 | -- exactly once. So this compiles: 59 | -- 60 | -- >>> :{ 61 | -- let linear :: FunctorL f => f (a, b) -> f (b, a) 62 | -- linear = fmapL (\(x, y) -> (y, x)) 63 | -- :} 64 | -- 65 | -- But this does not: 66 | -- 67 | -- >>> :{ 68 | -- let notLinear :: FunctorL f => f (a, b) -> f (a, a) 69 | -- notLinear = fmapL (\(x, y) -> (x, x)) 70 | -- :} 71 | -- ... 72 | -- ...Couldn't match expected weight ‘1’ of variable ‘x’ with actual weight ‘ω’ 73 | -- ... 74 | class FunctorL f where 75 | fmapL :: (a #-> b) -> f a #-> f b 76 | 77 | infixl 4 <$>. 78 | (<$>.) :: FunctorL f => (a #-> b) -> f a #-> f b 79 | (<$>.) = fmapL 80 | 81 | -- | 82 | -- A variant of Applicative in which every output must be used (or returned) 83 | -- exactly once. So this compiles: 84 | -- 85 | -- >>> :{ 86 | -- let linear :: ApplicativeL f => f a -> f b -> f (a, b) 87 | -- linear fx fy = (\x y -> (x, y)) <$>. fx <*>. fy 88 | -- :} 89 | -- 90 | -- But this does not: 91 | -- 92 | -- >>> :{ 93 | -- let notLinear :: ApplicativeL f => f a -> f b -> f (a, a) 94 | -- notLinear fx fy = (\x y -> (x, x)) <$>. fx <*>. fy 95 | -- :} 96 | -- ... 97 | -- ...Couldn't match expected weight ‘1’ of variable ‘x’ with actual weight ‘ω’ 98 | -- ... 99 | infixl 4 <*>. 100 | class FunctorL f => ApplicativeL f where 101 | pureL :: a #-> f a 102 | (<*>.) :: f (a #-> b) #-> f a #-> f b 103 | 104 | -- | 105 | -- A variant of Monad in which every bound variable must be used (or returned) 106 | -- exactly once. So this compiles: 107 | -- 108 | -- >>> :set -XRebindableSyntax 109 | -- >>> import PreludeL.RebindableSyntax 110 | -- >>> :{ 111 | -- let linear :: MonadL m => m a -> (a #-> m ()) -> m a 112 | -- linear gen consume = do 113 | -- consumed <- gen 114 | -- returned <- gen 115 | -- consume consumed 116 | -- pureL returned 117 | -- :} 118 | -- 119 | -- But this does not: 120 | -- 121 | -- >>> :{ 122 | -- let notLinear :: MonadL m => m a -> (a #-> m ()) -> m a 123 | -- notLinear gen consume = do 124 | -- consumed <- gen 125 | -- _notConsumed <- gen 126 | -- returned <- gen 127 | -- consume consumed 128 | -- pureL returned 129 | -- :} 130 | -- ... 131 | -- ...Couldn't match expected weight ‘1’ of variable ‘_notConsumed’ with actual weight ‘0’ 132 | -- ... 133 | class ApplicativeL m => MonadL m where 134 | (>>=.) :: m a #-> (a #-> m b) #-> m b 135 | 136 | (>>.) :: MonadL m => m () #-> m a #-> m a 137 | munit >>. mx = munit >>=. \() -> mx 138 | -------------------------------------------------------------------------------- /linear-common/src/PreludeL/RebindableSyntax.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LinearTypes #-} 2 | module PreludeL.RebindableSyntax where 3 | 4 | import Prelude hiding ((>>), (>>=)) 5 | import PreludeL 6 | 7 | 8 | (>>=) :: MonadL m => m a #-> (a #-> m b) #-> m b 9 | (>>=) = (>>=.) 10 | 11 | (>>) :: MonadL m => m () #-> m a #-> m a 12 | (>>) = (>>.) 13 | -------------------------------------------------------------------------------- /linear-common/src/StateL.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- A variant of the State monad which has a MonadL instance instead. Note that 3 | -- it is only the bound variables which must be used linearly, the state itself 4 | -- is unrestricted. After all, it is possible to call `getL` multiple times to 5 | -- get multiple copies of the state: 6 | -- 7 | -- >>> :set -XRebindableSyntax 8 | -- >>> import PreludeL.RebindableSyntax 9 | -- >>> :{ 10 | -- let dup1 = do 11 | -- s1 <- getL 12 | -- s2 <- getL 13 | -- pureL (s1, s2) 14 | -- :} 15 | -- 16 | -- For this reason `getL` returns an unrestricted value, so you only need to 17 | -- call `getL` once. 18 | -- 19 | -- >>> :{ 20 | -- let dup2 = do 21 | -- Unrestricted s <- getL 22 | -- pureL (s, s) 23 | -- :} 24 | {-# LANGUAGE FlexibleContexts, InstanceSigs, LinearTypes, MultiParamTypeClasses, RebindableSyntax, ScopedTypeVariables #-} 25 | module StateL where 26 | 27 | import Prelude hiding ((>>), (>>=)) 28 | import PreludeL 29 | 30 | 31 | data StateL s a = StateL 32 | { unStateL :: Unrestricted s #-> (Unrestricted s, a) } 33 | 34 | instance FunctorL (StateL s) where 35 | fmapL :: (a #-> b) -> StateL s a #-> StateL s b 36 | fmapL f (StateL body) = StateL (\s 37 | -> body s &. \(s', x) 38 | -> (s', f x)) 39 | 40 | instance ApplicativeL (StateL s) where 41 | pureL x = StateL (\s -> (s, x)) 42 | StateL bodyF <*>. StateL bodyX = StateL (\s 43 | -> bodyF s &. \(s', f) 44 | -> bodyX s' &. \(s'', x) 45 | -> (s'', f x)) 46 | 47 | 48 | instance MonadL (StateL s) where 49 | (>>=.) :: StateL s a #-> (a #-> StateL s b) #-> StateL s b 50 | StateL bodyX >>=. cc = StateL (\s 51 | -> bodyX s &. \(s', x) 52 | -> cc x &. \(StateL bodyY) 53 | -> bodyY s') 54 | 55 | getL :: StateL s (Unrestricted s) 56 | getL = StateL $ \(Unrestricted s) 57 | -> (Unrestricted s, Unrestricted s) 58 | 59 | modifyL :: (s -> s) -> StateL s () 60 | modifyL body = StateL $ \(Unrestricted s) 61 | -> (Unrestricted (body s), ()) 62 | 63 | execStateL :: StateL s () #-> s -> s 64 | execStateL (StateL body) s = body (Unrestricted s) &. \(Unrestricted s', ()) 65 | -> s' 66 | -------------------------------------------------------------------------------- /linear-tests/linear-tests.cabal: -------------------------------------------------------------------------------- 1 | name: linear-tests 2 | version: 0.1.0.0 3 | license: PublicDomain 4 | author: Samuel Gélineau 5 | maintainer: gelisam+github@gmail.com 6 | build-type: Simple 7 | cabal-version: >=1.10 8 | 9 | library 10 | exposed-modules: Tests 11 | build-depends: base 12 | , doctest 13 | hs-source-dirs: src 14 | default-language: Haskell2010 15 | ghc-options: -W -Wall 16 | -------------------------------------------------------------------------------- /linear-tests/src/Tests.hs: -------------------------------------------------------------------------------- 1 | module Tests where 2 | 3 | import Test.DocTest 4 | 5 | 6 | -- | 7 | -- >>> :{ 8 | -- let linear :: (a, b) ->. (b, a) 9 | -- linear (x, y) = (y, x) 10 | -- :} 11 | -- 12 | -- >>> :{ 13 | -- let nonlinear :: (a, b) ->. (a, a) 14 | -- nonlinear (x, _) = (x, x) 15 | -- :} 16 | -- ... 17 | -- ...Couldn't match expected weight ‘1’ of variable ‘x’ with actual weight ‘ω’ 18 | -- ... 19 | runTests :: IO () 20 | runTests = doctest [ "linear-common/src/DataL.hs" 21 | , "linear-common/src/PreludeL.hs" 22 | , "linear-common/src/PreludeL/RebindableSyntax.hs" 23 | , "linear-common/src/StateL.hs" 24 | , "linear-tests/src/Tests.hs" 25 | , "linear-watertight/src/Obj.hs" 26 | , "linear-watertight/src/WatertightL.hs" 27 | ] 28 | -------------------------------------------------------------------------------- /linear-watertight/linear-watertight.cabal: -------------------------------------------------------------------------------- 1 | name: linear-watertight 2 | version: 0.1.0.0 3 | license: PublicDomain 4 | author: Samuel Gélineau 5 | maintainer: gelisam+github@gmail.com 6 | build-type: Simple 7 | cabal-version: >=1.10 8 | 9 | library 10 | exposed-modules: Obj 11 | , WatertightL 12 | build-depends: base 13 | , containers 14 | , linear-common 15 | hs-source-dirs: src 16 | default-language: Haskell2010 17 | ghc-options: -W -Wall 18 | -------------------------------------------------------------------------------- /linear-watertight/src/Obj.hs: -------------------------------------------------------------------------------- 1 | module Obj where 2 | 3 | import Data.Foldable 4 | import Data.Sequence (Seq) 5 | import Text.Printf 6 | 7 | -- $setup 8 | -- >>> import qualified Data.Sequence as Seq 9 | 10 | 11 | -- the standard .obj format for 3D meshes, 12 | -- does not guarantee that the model is watertight 13 | type Vertex = (Float, Float, Float) 14 | type Face = [Int] 15 | data Obj = Obj 16 | { objVertices :: Seq Vertex 17 | , objFaces :: Seq Face 18 | } 19 | deriving Show 20 | 21 | -- | 22 | -- >>> printObj $ Obj (Seq.fromList [(1,2,3),(4,5,6),(7,8,9)]) (Seq.fromList [[1,2,3]]) 23 | -- v 1.0 2.0 3.0 24 | -- v 4.0 5.0 6.0 25 | -- v 7.0 8.0 9.0 26 | -- f 1 2 3 27 | printObj :: Obj -> IO () 28 | printObj (Obj vertices faces) = do 29 | for_ vertices $ \(x,y,z) -> do 30 | printf "v %f %f %f\n" x y z 31 | for_ faces $ \indices -> do 32 | printf "f" 33 | for_ indices $ \index -> do 34 | printf " %d" index 35 | printf "\n" 36 | -------------------------------------------------------------------------------- /linear-watertight/src/WatertightL.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Unlike Objs, Watertight3dModels are guaranteed to be watertight, that is, all 3 | -- edges are bound by exactly two faces, so there cannot be any hole in the 4 | -- surface. 5 | -- 6 | -- This is accomplished by guaranteeing that each edge is used exactly twice, 7 | -- which is in turn accomplished by generating two co-edges at a time and using 8 | -- linear types to make sure that each one is used by exactly one face. So the 9 | -- following compiles: 10 | -- 11 | -- >>> :set -XRebindableSyntax 12 | -- >>> :{ 13 | -- printObj . renderWatertight3dModel . makeWatertight3dModel $ do 14 | -- Unrestricted pA <- addPoint (1,2,3) 15 | -- Unrestricted pB <- addPoint (4,5,6) 16 | -- Unrestricted pC <- addPoint (7,8,9) 17 | -- (coedgeAB, coedgeBA) <- addCoEdges pA pB 18 | -- (coedgeBC, coedgeCB) <- addCoEdges pB pC 19 | -- (coedgeCA, coedgeAC) <- addCoEdges pC pA 20 | -- addFace [coedgeAB, coedgeBC, coedgeCA] 21 | -- addFace [coedgeAC, coedgeCB, coedgeBA] 22 | -- :} 23 | -- v 1.0 2.0 3.0 24 | -- v 4.0 5.0 6.0 25 | -- v 7.0 8.0 9.0 26 | -- f 1 2 3 27 | -- f 1 3 2 28 | -- 29 | -- While the following does not: 30 | -- 31 | -- >>> :set -XRebindableSyntax 32 | -- >>> :{ 33 | -- printObj . renderWatertight3dModel . makeWatertight3dModel $ do 34 | -- Unrestricted pA <- addPoint (1,2,3) 35 | -- Unrestricted pB <- addPoint (4,5,6) 36 | -- Unrestricted pC <- addPoint (7,8,9) 37 | -- (coedgeAB, coedgeBA) <- addCoEdges pA pB 38 | -- (coedgeBC, coedgeCB) <- addCoEdges pB pC 39 | -- (coedgeCA, coedgeAC) <- addCoEdges pC pA 40 | -- addFace [coedgeAB, coedgeBC, coedgeCA] 41 | -- :} 42 | -- ... 43 | -- ...Couldn't match expected weight ‘1’ of variable ‘coedgeBA’ with actual weight ‘0’ 44 | -- ... 45 | {-# LANGUAGE GeneralizedNewtypeDeriving, GADTs, LinearTypes, RebindableSyntax #-} 46 | module WatertightL 47 | ( ModelBuilding 48 | , Point, addPoint 49 | , CoEdge, addCoEdges 50 | , addFace 51 | , Watertight3dModel, makeWatertight3dModel, renderWatertight3dModel 52 | ) where 53 | 54 | import Prelude hiding ((>>), (>>=)) 55 | import qualified Data.Sequence as Seq 56 | 57 | import DataL 58 | import Obj 59 | import PreludeL 60 | import PreludeL.RebindableSyntax 61 | import StateL 62 | 63 | 64 | newtype ModelBuilding a = PrivateModelBuilding 65 | { unModelBuilding :: StateL Obj a } 66 | deriving (FunctorL, ApplicativeL, MonadL) 67 | 68 | newtype Point = PrivatePoint 69 | { unPoint :: Int } 70 | deriving (Eq, Show) 71 | 72 | data CoEdge = PrivateCoEdge 73 | { coEdgePoint1 :: Unrestricted Point 74 | , coEdgePoint2 :: Unrestricted Point 75 | } 76 | deriving Show 77 | 78 | newtype Watertight3dModel = PrivateWatertight3dModel 79 | { unWatertight3dModel :: Obj } 80 | deriving Show 81 | 82 | addPoint :: Vertex -> ModelBuilding (Unrestricted Point) 83 | addPoint v = PrivateModelBuilding $ do 84 | modifyL $ \obj -> obj { objVertices = objVertices obj <> Seq.singleton v } 85 | Unrestricted obj <- getL 86 | pureL (Unrestricted . PrivatePoint 87 | . length 88 | . objVertices 89 | $ obj) 90 | 91 | addCoEdges :: Point -> Point -> ModelBuilding (CoEdge, CoEdge) 92 | addCoEdges p1 p2 = pureL (PrivateCoEdge u1 u2, PrivateCoEdge u2 u1) 93 | where 94 | u1 = Unrestricted p1 95 | u2 = Unrestricted p2 96 | 97 | -- no DataL instance because we can't make it private to this module 98 | unrestrictCoEdge :: CoEdge #-> Unrestricted CoEdge 99 | unrestrictCoEdge (PrivateCoEdge x y) = unrestrict x &. \(Unrestricted x') 100 | -> unrestrict y &. \(Unrestricted y') 101 | -> Unrestricted (PrivateCoEdge x' y') 102 | 103 | addFace :: [CoEdge] #-> ModelBuilding () 104 | addFace coedges 105 | = unrestrictList unrestrictCoEdge coedges &. \(Unrestricted coedges') 106 | -> PrivateModelBuilding $ do 107 | let points1 = map (\pt -> getUnrestricted (coEdgePoint1 pt)) coedges' 108 | points2 = map (\pt -> getUnrestricted (coEdgePoint2 pt)) coedges' 109 | offsetPoints1 = take (length points1) . drop 1 . cycle $ points1 110 | face = map unPoint points1 111 | case offsetPoints1 == points2 of 112 | True -> 113 | modifyL $ \obj -> obj 114 | { objFaces = objFaces obj <> Seq.singleton face } 115 | False -> 116 | error $ "consecutive coedge points should match: " ++ show (points1, points2, offsetPoints1, face) 117 | 118 | makeWatertight3dModel :: ModelBuilding () -> Watertight3dModel 119 | makeWatertight3dModel = PrivateWatertight3dModel 120 | . (\body -> execStateL body (Obj mempty mempty)) 121 | . unModelBuilding 122 | 123 | renderWatertight3dModel :: Watertight3dModel -> Obj 124 | renderWatertight3dModel = unWatertight3dModel 125 | -------------------------------------------------------------------------------- /run_tests_continuously.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | set -e 3 | stack install ghcid 4 | ~/.local/bin/ghcid --command="stack ghci" --test=Tests.runTests 5 | --------------------------------------------------------------------------------