hylogen 0.1.0.10 → 0.1.0.11
raw patch · 7 files changed
+436/−45 lines, 7 filesdep +containersdep +hashabledep +mtl
Dependencies added: containers, hashable, mtl
Files
- README.md +1/−1
- app/Main.hs +23/−10
- hylogen.cabal +5/−1
- src/Hylogen.hs +23/−10
- src/Hylogen/CSE.hs +129/−0
- src/Hylogen/Globals.hs +3/−0
- src/Hylogen/Types.hs +252/−23
README.md view
@@ -1,6 +1,6 @@ # [*H Y L O G E N*](https://hylogen.com) -Hylogen is a language [embedded in Haskell](https://wiki.haskell.org/Embedded_domain_specific_language) for live-coding fragment shaders.+Hylogen is a purely functional language [embedded in Haskell](https://wiki.haskell.org/Embedded_domain_specific_language) for live-coding fragment shaders. ## Setup ```
app/Main.hs view
@@ -12,6 +12,7 @@ import System.FilePath import System.FSNotify import System.Process+import System.Exit (ExitCode(ExitFailure, ExitSuccess)) import Network.Wai import Network.Wai.Handler.Warp@@ -25,35 +26,47 @@ _ -> error "Name a file to watch!" main' :: FilePath -> IO ()-main' pathToWatch = withManager $ \mgr -> do- _ <- forkIO $ serveIndex- runServer "127.0.0.1" 8080 $ handleConnection pathToWatch mgr+main' pathToWatch = do+ _ <- forkIO serveIndex+ withManager+ $ runServer "127.0.0.1" 8080+ . handleConnection pathToWatch handleConnection :: FilePath -> WatchManager -> PendingConnection -> IO () handleConnection pathToWatch mgr pending = do- let (dirToWatch, fileToWatch) = splitFileName pathToWatch+ let (dirToWatch, _) = splitFileName pathToWatch connection <- acceptRequest pending - (sendTextData connection . T.pack) =<< getNewSource pathToWatch+ let update = do+ maybeNewSource <- getNewSource pathToWatch+ case maybeNewSource of+ Just source -> sendTextData connection . T.pack $ source+ Nothing -> return ()+ update let onChange e = case e of- Modified _ _ -> (sendTextData connection . T.pack) =<< getNewSource pathToWatch+ Modified _ _ -> update _ -> return () _ <- watchDir mgr dirToWatch (const True) onChange _ <- getLine -- temp hack to keep the socket open return () -getNewSource :: FilePath -> IO String+getNewSource :: FilePath -> IO (Maybe String) getNewSource pathToWatch = do -- TODO: more robust paths!: -- c <- readFile pathToWatch let (dirToWatch, fileToWatch) = splitFileName pathToWatch- c <- readProcess "runghc" [+ (ec, stdout, stderr) <- readProcessWithExitCode "runghc" [ "-i"++dirToWatch , pathToWatch ] ""- putStrLn "updated"- return c+ case ec of+ ExitSuccess -> do+ putStrLn "updated"+ return (Just stdout)+ ExitFailure i -> do+ putStrLn stderr+ return Nothing serveIndex :: IO () serveIndex = do
hylogen.cabal view
@@ -1,5 +1,5 @@ name: hylogen-version: 0.1.0.10+version: 0.1.0.11 synopsis: an EDSL for live-coding fragment shaders description: an EDSL for live-coding fragment shaders homepage: https://hylogen.com@@ -19,8 +19,12 @@ exposed-modules: Hylogen , Hylogen.Types , Hylogen.Globals+ , Hylogen.CSE build-depends: base >=4.8 && <4.9 , vector-space+ , containers+ , hashable+ , mtl hs-source-dirs: src default-language: Haskell2010
src/Hylogen.hs view
@@ -19,16 +19,29 @@ ) where -import Hylogen.Types ( Vec1 (X, Y, Z, W)- , Vec2- , Vec3- , Vec4- , Vec (select, fromVec1, toList)- )+import Data.Monoid+import Data.List+import Hylogen.CSE (glslToAssignments, getTopLevel, genGLSL) import Hylogen.Globals+import Hylogen.Types (Vec (fromVec1, select, toList),+ Vec1 (W, X, Y, Z), Vec2, Vec3, Vec4) +toGLSL' :: Vec4 -> String+toGLSL' v = unlines [ "void main() {"+ , " gl_FragColor = " <> show v<> ";"+ , "}"+ ]++ toGLSL :: Vec4 -> String-toGLSL x = unlines $ [ "void main() {"- , " gl_FragColor = " ++ show x ++ ";"- , "}"- ]+toGLSL v = unlines [ "void main() {"+ , assignments+ , ""+ , " gl_FragColor = " <> show topLevel <> ";"+ , "}"+ ]+ where+ assignments = mconcat . fmap ("\n "<>) $ glslToAssignments glsl+ glsl = genGLSL v+ topLevel = getTopLevel glsl+
+ src/Hylogen/CSE.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+module Hylogen.CSE where++import qualified Data.Map as Map+import Data.Monoid++import Hylogen.Types+import Control.Monad.State.Lazy+import Data.List++type Id = Int+type Count = Int++-- | Add if in first, variabalize!+newtype GLSL = GLSL (Map.Map Id Expr, Map.Map Hash (Id, Count))++getTopLevel :: GLSL -> Expr+getTopLevel (GLSL (id2expr, _)) = case Map.maxViewWithKey id2expr of+ Nothing -> error "must have top level?"+ Just ((k, e), _) -> Uniform (getType e) ("_" <> show k)++++type GLSLState = State GLSL++addNode:: Hash -> Expr -> GLSLState Id+addNode hashish expr = do+ GLSL (id2expr, hash2id) <- get+ let newid = case Map.maxViewWithKey id2expr of+ Nothing -> 0+ Just ((k, _), _) -> k + 1++ if Map.member hashish hash2id+ then do+ modify (\(GLSL (foo, bar)) -> GLSL ( foo+ , Map.adjust (\(a, b) -> (a, b+1)) hashish bar+ ))+ return $ fst $ hash2id Map.! hashish+ else do+ modify (\(GLSL (foo, bar)) -> GLSL ( Map.insert newid expr foo+ , Map.insert hashish (newid, 1) bar+ ))+ return $ newid++addTree :: HashTree -> GLSLState ()+addTree ht = case ht of+ Leaf h e -> do+ -- _ <- addNode h e+ return ()+ Branch h e subTrees -> do+ -- | post-order traversal guarantees topological ordering!+ forM_ subTrees addTree+ i <- addNode h e+ newExpr <- variablize e subTrees+ modify (\(GLSL (foo, bar)) -> GLSL ( Map.adjust (const newExpr) i foo+ , bar ))++genGLSL :: (Expressible a) => a -> GLSL+genGLSL x = execState (addTree . toHashTree . toExpr $ x ) initialGLSL+ where+ initialGLSL :: GLSL+ initialGLSL = GLSL (Map.empty, Map.empty)++glslToAssignments:: GLSL -> [String]+glslToAssignments glsl = do+ let (GLSL (id2expr, _)) = glsl+ fmap assign $ Map.toList id2expr+ where+ assign :: (Id, Expr) -> String+ assign (i, e) = show (getType e) <> " " <> "_" <> show i <> " = " <> show e <> ";"+++getName :: HashTree -> GLSLState String+getName ht = do+ let h = case ht of+ Leaf h _ -> h+ Branch h _ _ -> h+ GLSL (_, hash2id) <- get+ return $ "_" <> show (fst $ hash2id Map.! h)++variablize :: Expr -> [HashTree] -> GLSLState Expr+variablize expr subTrees = case expr of+ Uniform ty st+ -> return $ Uniform ty st+ UnaryOp ty st x+ -> UnaryOp ty st+ <$> f x (subTrees !! 0)+ UnaryOpPre ty st x+ -> UnaryOpPre ty st+ <$> f x (subTrees !! 0)+ BinaryOp ty st x y+ -> BinaryOp ty st+ <$> f x (subTrees !! 0)+ <*> f y (subTrees !! 1)+ BinaryOpPre ty st x y+ -> BinaryOpPre ty st+ <$> f x (subTrees !! 0)+ <*> f y (subTrees !! 1)+ TernaryOpPre ty st x y z+ -> TernaryOpPre ty st+ <$> f x (subTrees !! 0)+ <*> f y (subTrees !! 1)+ <*> f z (subTrees !! 2)+ QuaternaryOpPre ty st x y z w+ -> QuaternaryOpPre ty st+ <$> f x (subTrees !! 0)+ <*> f y (subTrees !! 1)+ <*> f z (subTrees !! 2)+ <*> f w (subTrees !! 3)+ Select ty x y z+ -> Select ty+ <$> f x (subTrees !! 0)+ <*> f y (subTrees !! 1)+ <*> f z (subTrees !! 2)+ Access ty st x+ -> Access ty st+ <$> f x (subTrees !! 0)+ where+ f :: Expr -> HashTree -> GLSLState Expr+ f x ht = do+ let h = case ht of+ Leaf h _ -> h+ Branch h _ _ -> h+ (GLSL (_, hash2id)) <- get+ if Map.member h hash2id+ then Uniform (getType x) <$> (getName ht)+ else return x
src/Hylogen/Globals.hs view
@@ -66,6 +66,9 @@ backBuffer :: Texture backBuffer = Tu "backBuffer" +channel1 :: Texture+channel1 = Tu "channel1"+ mix :: Vec1 -> Vec4 -> Vec4 -> Vec4 mix p a b = p *^ a + (1 - p) *^ b
src/Hylogen/Types.hs view
@@ -9,6 +9,8 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-} module Hylogen.Types where @@ -16,21 +18,37 @@ import Data.Monoid import Data.VectorSpace import GHC.Exts (Constraint)+import Data.Hashable+import GHC.Generics -class (ConstructFrom' tuple hprim, Show tuple, Vec hprim) => ConstructFrom tuple hprim-instance ConstructFrom Float Vec1-instance ConstructFrom (Vec1, Vec1) Vec2-instance ConstructFrom (Vec1, Vec1, Vec1) Vec3-instance ConstructFrom (Vec2, Vec1) Vec3-instance ConstructFrom (Vec1, Vec2) Vec3-instance ConstructFrom (Vec1, Vec1, Vec1, Vec1) Vec4-instance ConstructFrom (Vec2, Vec1, Vec1) Vec4-instance ConstructFrom (Vec1, Vec2, Vec1) Vec4-instance (a ~ Vec1, b ~ Vec1) => ConstructFrom (a, b, Vec2) Vec4-instance ConstructFrom (Vec3, Vec1) Vec4-instance (a ~ Vec1) => ConstructFrom (a, Vec3) Vec4-instance (a ~ Vec2) => ConstructFrom (a, Vec2) Vec4+class (ConstructFrom' tuple hprim, Show tuple, Vec hprim) => ConstructFrom tuple hprim where+ exprFormFromTuple :: tuple -> hprim -> Expr +instance ConstructFrom Float Vec1 where+ exprFormFromTuple x _ = Uniform GLSLFloat (show x) -- TODO: this is a hack!+instance ConstructFrom (Vec1, Vec1) Vec2 where+ exprFormFromTuple (x, y) _ = BinaryOpPre GLSLVec2 "vec2" (toExpr x) (toExpr y)+instance ConstructFrom (Vec1, Vec1, Vec1) Vec3 where+ exprFormFromTuple (x, y, z) _ = TernaryOpPre GLSLVec3 "vec3" (toExpr x) (toExpr y) (toExpr z)+instance ConstructFrom (Vec2, Vec1) Vec3 where+ exprFormFromTuple (x, y) _ = BinaryOpPre GLSLVec3 "vec3" (toExpr x) (toExpr y)+instance ConstructFrom (Vec1, Vec2) Vec3 where+ exprFormFromTuple (x, y) _ = BinaryOpPre GLSLVec3 "vec3" (toExpr x) (toExpr y)+instance ConstructFrom (Vec1, Vec1, Vec1, Vec1) Vec4 where+ exprFormFromTuple (x, y, z, w) _ = QuaternaryOpPre GLSLVec4 "vec4" (toExpr x) (toExpr y) (toExpr z) (toExpr w)+instance ConstructFrom (Vec2, Vec1, Vec1) Vec4 where+ exprFormFromTuple (x, y, z) _ = TernaryOpPre GLSLVec4 "vec4" (toExpr x) (toExpr y) (toExpr z)+instance ConstructFrom (Vec1, Vec2, Vec1) Vec4 where+ exprFormFromTuple (x, y, z) _ = TernaryOpPre GLSLVec4 "vec4" (toExpr x) (toExpr y) (toExpr z)+instance (a ~ Vec1, b ~ Vec1) => ConstructFrom (a, b, Vec2) Vec4 where+ exprFormFromTuple (x, y, z) _ = TernaryOpPre GLSLVec4 "vec4" (toExpr x) (toExpr y) (toExpr z)+instance ConstructFrom (Vec3, Vec1) Vec4 where+ exprFormFromTuple (x, y) _ = BinaryOpPre GLSLVec4 "vec4" (toExpr x) (toExpr y)+instance (a ~ Vec1) => ConstructFrom (a, Vec3) Vec4 where+ exprFormFromTuple (x, y) _ = BinaryOpPre GLSLVec4 "vec4" (toExpr x) (toExpr y)+instance (a ~ Vec2) => ConstructFrom (a, Vec2) Vec4 where+ exprFormFromTuple (x, y) _ = BinaryOpPre GLSLVec4 "vec4" (toExpr x) (toExpr y)+ type family (ConstructFrom' tuple hprim) :: Constraint where ConstructFrom' a Vec1 = a ~ Float ConstructFrom' (a, b) Vec2 = (a ~ Vec1, b ~ Vec1)@@ -55,7 +73,9 @@ -class (Show v) => Vec v where+++class (Expressible v, Show v) => Vec v where vec :: (ConstructFrom tuple v) => tuple -> v vu :: String -> v vuop :: String -> v -> v@@ -68,7 +88,7 @@ -class Show a => HasX a+class (Expressible a, Show a) => HasX a class HasX a => HasY a class HasY a => HasZ a class HasZ a => HasW a@@ -175,6 +195,7 @@ V2bops :: String -> Vec1 -> Vec2 -> Vec2 V2select :: Booly -> Vec2 -> Vec2 -> Vec2 + instance Vec Vec2 where vec = Vec2 vu = V2u@@ -459,13 +480,221 @@ | otherwise = Bu "false" -data Variable where- VVec1 :: Vec1 -> Variable- VVec2 :: Vec2 -> Variable- VVec3 :: Vec3 -> Variable- VBooly :: Booly -> Variable --- instance Num (Context Vec1) where --- data Expr a where--- Node a :: ID -> a+instance Hashable Vec1 where+ hashWithSalt salt x = hashWithSalt salt $ ("vec1", show x)+instance Hashable Vec2 where+ hashWithSalt salt x = hashWithSalt salt $ ("vec2", show x)+instance Hashable Vec3 where+ hashWithSalt salt x = hashWithSalt salt $ ("vec3", show x)+instance Hashable Vec4 where+ hashWithSalt salt x = hashWithSalt salt $ ("vec4", show x)+instance Hashable Booly where+ hashWithSalt salt x = hashWithSalt salt $ ("booly", show x)++instance Hashable Texture where+ hashWithSalt salt x = hashWithSalt salt $ ("texture2D", show x)++-- TODO: textures cannot be saved as variable!++++data GLSLType = GLSLFloat+ | GLSLVec2+ | GLSLVec3+ | GLSLVec4+ | GLSLBool+ | GLSLTexture+ deriving (Generic, Hashable, Eq, Ord)++instance Show GLSLType where+ show x = case x of+ GLSLFloat -> "float"+ GLSLVec2 -> "vec2"+ GLSLVec3 -> "vec3"+ GLSLVec4 -> "vec4"+ GLSLBool -> "bool"+ GLSLTexture -> "(texture)" -- this should never be variablized++newtype Hash = Hash Int+ deriving (Generic, Hashable, Eq, Ord)+instance Show Hash where+ show (Hash i) = "h_" <> show i++data HashTree = Leaf Hash Expr | Branch Hash Expr [HashTree]+ deriving (Generic, Hashable, Show, Eq, Ord)++class (Show a) => Expressible a where+ toExpr :: a -> Expr++++-- TODO: get rid of Vec?, replace with Expr? at least get rid of all the duplicate show statements in my primitives!++data Expr = Uniform GLSLType String+ | UnaryOp GLSLType String Expr+ | UnaryOpPre GLSLType String Expr+ | BinaryOp GLSLType String Expr Expr+ | BinaryOpPre GLSLType String Expr Expr+ | TernaryOpPre GLSLType String Expr Expr Expr+ | QuaternaryOpPre GLSLType String Expr Expr Expr Expr+ | Select GLSLType Expr Expr Expr -- for ternary selection+ | Access GLSLType String Expr -- field accessor+ deriving (Generic, Hashable, Eq, Ord)++-- TODO: is there any way to do this automatically?+getType :: Expr -> GLSLType+getType x = case x of+ Uniform ty _ -> ty+ UnaryOp ty _ _ -> ty+ UnaryOpPre ty _ _ -> ty+ BinaryOp ty _ _ _ -> ty+ BinaryOpPre ty _ _ _ -> ty+ TernaryOpPre ty _ _ _ _ -> ty+ QuaternaryOpPre ty _ _ _ _ _ -> ty+ Select ty _ _ _ -> ty+ Access ty _ _ -> ty++instance Show Expr where+ show foo = case foo of+ Uniform _ x -> x+ UnaryOp _ u x -> u <> "(" <> show x <> ")"+ UnaryOpPre _ u x -> "(" <> u <> show x <> ")"+ BinaryOp _ b x y -> "(" <> show x <> " " <> b <> " " <> show y <> ")"+ BinaryOpPre _ b x y -> b <> "(" <> show x <> ", " <> show y <> ")"+ TernaryOpPre _ b x y z -> b <> "(" <> show x <> ", " <> show y <> ", " <> show z <> ")"+ QuaternaryOpPre _ b x y z w -> b <> "(" <> show x <> ", " <> show y <> ", " <> show z <> ", " <> show w <> ")"+ Select _ b x y -> "( " <> show b <> " ? " <> show x <> " : " <> show y <> ")"+ Access _ field x -> show x <> "." <> field++-- Type information?+-- STring information?+toHashTree :: Expr -> HashTree+toHashTree exprForm = case exprForm of+ a@(Uniform ty str) -> mkLeaf (ty, str) a+ UnaryOp ty str x -> mkBranch1 (ty, str) exprForm x+ UnaryOpPre ty str x -> mkBranch1 (ty, str) exprForm x+ BinaryOp ty str x y -> mkBranch2 (ty, str) exprForm x y+ BinaryOpPre ty str x y -> mkBranch2 (ty, str) exprForm x y+ TernaryOpPre ty str x y z -> mkBranch3 (ty, str) exprForm x y z+ QuaternaryOpPre ty str x y z w -> mkBranch4 (ty, str) exprForm x y z w+ Select ty b x y -> mkBranch3 (ty, "?:") exprForm b x y+ Access ty str x -> mkBranch1 (ty, "." <> str) exprForm x++type HashContext = (GLSLType, String)++mkLeaf :: HashContext -> Expr -> HashTree+mkLeaf hc expr = Leaf (Hash $ hash (expr, hc)) expr++mkBranch1 :: HashContext -> Expr -> Expr -> HashTree+mkBranch1 hc expr x = Branch (Hash $ hash (expr, hc, subTrees)) expr subTrees+ where+ subTrees = [toHashTree x]++mkBranch2 :: HashContext -> Expr -> Expr -> Expr -> HashTree+mkBranch2 hc expr x y = Branch (Hash $ hash (expr, hc, subTrees)) expr subTrees+ where+ subTrees = [toHashTree x, toHashTree y]++mkBranch3 :: HashContext -> Expr -> Expr -> Expr -> Expr -> HashTree+mkBranch3 hc expr x y z = Branch (Hash $ hash (expr, hc, subTrees)) expr subTrees+ where+ subTrees = [toHashTree x, toHashTree y, toHashTree z]++mkBranch4 :: HashContext -> Expr -> Expr -> Expr -> Expr -> Expr -> HashTree+mkBranch4 hc expr x y z w = Branch (Hash $ hash (expr, hc, subTrees)) expr subTrees+ where+ subTrees = [toHashTree x, toHashTree y, toHashTree z, toHashTree w]++-- TODO: tag strings so hash is correct++instance Expressible Vec1 where+ toExpr foo = case foo of+ Vec1 x -> exprFormFromTuple x foo+ V1u str -> Uniform ty str+ V1uop str x -> UnaryOp ty str (toExpr x)+ V1uoppre str x -> UnaryOpPre ty str (toExpr x)+ V1bop str x y -> BinaryOp ty str (toExpr x) (toExpr y)+ V1boppre str x y -> BinaryOpPre ty str (toExpr x) (toExpr y)+ V1select b x y -> Select ty (toExpr b) (toExpr x) (toExpr y)+ Dot x y -> BinaryOpPre ty "dot" (toExpr x) (toExpr y)+ X x -> Access ty "x" (toExpr x)+ Y x -> Access ty "y" (toExpr x)+ Z x -> Access ty "z" (toExpr x)+ W x -> Access ty "w" (toExpr x)+ where+ ty = GLSLFloat++instance Expressible Vec2 where+ toExpr foo = case foo of+ Vec2 x -> exprFormFromTuple x foo+ V2u str -> Uniform ty str+ V2uop str x -> UnaryOp ty str (toExpr x)+ V2uoppre str x -> UnaryOpPre ty str (toExpr x)+ V2bop str x y -> BinaryOp ty str (toExpr x) (toExpr y)+ V2boppre str x y -> BinaryOpPre ty str (toExpr x) (toExpr y)+ V2bops str x y -> BinaryOp ty str (toExpr x) (toExpr y)+ V2select b x y -> Select ty (toExpr b) (toExpr x) (toExpr y)+ where+ ty = GLSLVec2++instance Expressible Vec3 where+ toExpr foo = case foo of+ Vec3 x -> exprFormFromTuple x foo+ V3u str -> Uniform ty str+ V3uop str x -> UnaryOp ty str (toExpr x)+ V3uoppre str x -> UnaryOpPre ty str (toExpr x)+ V3bop str x y -> BinaryOp ty str (toExpr x) (toExpr y)+ V3boppre str x y -> BinaryOpPre ty str (toExpr x) (toExpr y)+ V3bops str x y -> BinaryOp ty str (toExpr x) (toExpr y)+ V3select b x y -> Select ty (toExpr b) (toExpr x) (toExpr y)+ where+ ty = GLSLVec3++instance Expressible Vec4 where+ toExpr foo = case foo of+ Vec4 x -> exprFormFromTuple x foo+ V4u str -> Uniform ty str+ V4uop str x -> UnaryOp ty str (toExpr x)+ V4uoppre str x -> UnaryOpPre ty str (toExpr x)+ V4bop str x y -> BinaryOp ty str (toExpr x) (toExpr y)+ V4boppre str x y -> BinaryOpPre ty str (toExpr x) (toExpr y)+ V4bops str x y -> BinaryOp ty str (toExpr x) (toExpr y)+ V4select b x y -> Select ty (toExpr b) (toExpr x) (toExpr y)+ Texture2D t x -> BinaryOpPre ty "texture2D" (toExpr t) (toExpr x)+ where+ ty = GLSLVec4++instance Expressible Booly where+ toExpr foo = case foo of+ Bu str -> Uniform ty str+ Buop str x -> UnaryOp ty str (toExpr x)+ Buoppre str x -> UnaryOpPre ty str (toExpr x)+ Bbop str x y -> BinaryOp ty str (toExpr x) (toExpr y)+ Bcomp_ str x y -> BinaryOp ty str (toExpr x) (toExpr y)+ Bcomp str x y -> toExpr . product $ zipWith (Bcomp_ str) (toList x) (toList y)+ where+ ty = GLSLBool++instance Expressible Texture where+ toExpr (Tu str) = Uniform ty str+ where+ ty = GLSLTexture++-- | Existential+-- data Expr where+-- ToExpr :: (Expressible a) => a -> Expr++-- instance Show Expr where+-- show (ToExpr a) = show (getType a) <> " blah = " <> show a <> ";"+++ -- TODO: implement Variable as a contructor for Expression+-- data Variable where+-- VVec1 :: Vec1 -> Variable+-- VVec2 :: Vec2 -> Variable+-- VVec3 :: Vec3 -> Variable+-- VBooly :: Booly -> Variable++-- instance Num (Context Vec1) where