7 files changed, 31 insertions, 5 deletions

diff --git a/lambdacube-ir.haskell/lambdacube-ir.cabal b/lambdacube-ir.haskell/lambdacube-ir.cabal
index 1389a9c..4ff27ed 100644
--- a/lambdacube-ir.haskell/lambdacube-ir.cabal
+++ b/lambdacube-ir.haskell/lambdacube-ir.cabal
@@ -2,7 +2,7 @@
 -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                lambdacube-ir
-version:             0.1.0.0
+version:             0.2.0.0
 -- synopsis:            
 -- description:         
 license:             BSD3
@@ -16,10 +16,14 @@ build-type:          Simple
 cabal-version:       >=1.10
 
 library
-  exposed-modules:     IR, Linear
+  exposed-modules:     LambdaCube.Linear
+                       LambdaCube.IR
+                       LambdaCube.Mesh
+                       LambdaCube.PipelineSchema
+                       LambdaCube.PipelineSchemaUtil
   -- other-modules:       
   other-extensions:    OverloadedStrings, RecordWildCards, DeriveFunctor
   -- CAUTION: When the build-depends change, please bump the git submodule in lambdacube-docker repository
-  build-depends:       base >=4.8 && <4.9, containers >=0.5 && <0.6, vector >=0.11 && <0.12, text >=1.2 && <1.3, aeson >=0.9 && <0.11
+  build-depends:       base >=4.8 && <4.9, containers >=0.5 && <0.6, vector >=0.11 && <0.12, text >=1.2 && <1.3, aeson >=0.9 && <0.11, mtl >=2.2 && <2.3
   hs-source-dirs:      src
   default-language:    Haskell2010
diff --git a/lambdacube-ir.haskell/src/IR.hs b/lambdacube-ir.haskell/src/IR.hs
deleted file mode 120000
index e256d2b..0000000
--- a/lambdacube-ir.haskell/src/IR.hs
+++ /dev/null
@@ -1 +0,0 @@
-../../ddl/out/IR.hs
\ No newline at end of file
diff --git a/lambdacube-ir.haskell/src/LambdaCube/IR.hs b/lambdacube-ir.haskell/src/LambdaCube/IR.hs
new file mode 120000
index 0000000..7b90d33
--- /dev/null
+++ b/lambdacube-ir.haskell/src/LambdaCube/IR.hs
@@ -0,0 +1 @@
+../../../ddl/out/LambdaCube.IR.hs
\ No newline at end of file
diff --git a/lambdacube-ir.haskell/src/Linear.hs b/lambdacube-ir.haskell/src/LambdaCube/Linear.hs
index 1329841..286cc93 100644
--- a/lambdacube-ir.haskell/src/Linear.hs
+++ b/lambdacube-ir.haskell/src/LambdaCube/Linear.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveFunctor, OverloadedStrings #-}
-module Linear where
+module LambdaCube.Linear where
 
 import Data.Int
 import Data.Word
diff --git a/lambdacube-ir.haskell/src/LambdaCube/Mesh.hs b/lambdacube-ir.haskell/src/LambdaCube/Mesh.hs
new file mode 120000
index 0000000..9dfc009
--- /dev/null
+++ b/lambdacube-ir.haskell/src/LambdaCube/Mesh.hs
@@ -0,0 +1 @@
+../../../ddl/out/LambdaCube.Mesh.hs
\ No newline at end of file
diff --git a/lambdacube-ir.haskell/src/LambdaCube/PipelineSchema.hs b/lambdacube-ir.haskell/src/LambdaCube/PipelineSchema.hs
new file mode 120000
index 0000000..afe52ef
--- /dev/null
+++ b/lambdacube-ir.haskell/src/LambdaCube/PipelineSchema.hs
@@ -0,0 +1 @@
+../../../ddl/out/LambdaCube.PipelineSchema.hs
\ No newline at end of file
diff --git a/lambdacube-ir.haskell/src/LambdaCube/PipelineSchemaUtil.hs b/lambdacube-ir.haskell/src/LambdaCube/PipelineSchemaUtil.hs
new file mode 100644
index 0000000..a5eac55
--- /dev/null
+++ b/lambdacube-ir.haskell/src/LambdaCube/PipelineSchemaUtil.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE FlexibleContexts, TypeSynonymInstances, FlexibleInstances #-}
+module LambdaCube.PipelineSchemaUtil where
+
+import Control.Monad.Writer
+import qualified Data.Map as Map
+import LambdaCube.PipelineSchema
+
+a @: b = tell [(a,b)]
+defObjectArray n p m = mapM_ tell [PipelineSchema (Map.singleton n $ ObjectArraySchema p $ Map.singleton a t) mempty | (a,t) <- execWriter m]
+defUniforms m = tell $ PipelineSchema mempty $ Map.fromList $ execWriter m
+makeSchema a = execWriter a :: PipelineSchema
+
+unionObjectArraySchema (ObjectArraySchema a1 b1) (ObjectArraySchema a2 b2) =
+  ObjectArraySchema (if a1 == a2 then a1 else error $ "object array schema primitive mismatch " ++ show (a1,a2))
+                    (Map.unionWith (\a b -> if a == b then a else error $ "object array schema attribute type mismatch " ++ show (a,b)) b1 b2)
+
+instance Monoid PipelineSchema where
+  mempty = PipelineSchema mempty mempty
+  mappend (PipelineSchema a1 b1) (PipelineSchema a2 b2) =
+    PipelineSchema (Map.unionWith unionObjectArraySchema a1 a2) (Map.unionWith (\a b -> if a == b then a else error $ "schema type mismatch " ++ show (a,b)) b1 b2)