diff options
Diffstat (limited to 'lambdacube-ir.haskell/src')
l--------- | lambdacube-ir.haskell/src/IR.hs | 1 | ||||
l--------- | lambdacube-ir.haskell/src/LambdaCube/IR.hs | 1 | ||||
-rw-r--r-- | lambdacube-ir.haskell/src/LambdaCube/Linear.hs (renamed from lambdacube-ir.haskell/src/Linear.hs) | 2 | ||||
l--------- | lambdacube-ir.haskell/src/LambdaCube/Mesh.hs | 1 | ||||
l--------- | lambdacube-ir.haskell/src/LambdaCube/PipelineSchema.hs | 1 | ||||
-rw-r--r-- | lambdacube-ir.haskell/src/LambdaCube/PipelineSchemaUtil.hs | 20 |
6 files changed, 24 insertions, 2 deletions
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 @@ | |||
1 | ../../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 @@ | |||
1 | {-# LANGUAGE DeriveFunctor, OverloadedStrings #-} | 1 | {-# LANGUAGE DeriveFunctor, OverloadedStrings #-} |
2 | module Linear where | 2 | module LambdaCube.Linear where |
3 | 3 | ||
4 | import Data.Int | 4 | import Data.Int |
5 | import Data.Word | 5 | 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 @@ | |||
1 | {-# LANGUAGE FlexibleContexts, TypeSynonymInstances, FlexibleInstances #-} | ||
2 | module LambdaCube.PipelineSchemaUtil where | ||
3 | |||
4 | import Control.Monad.Writer | ||
5 | import qualified Data.Map as Map | ||
6 | import LambdaCube.PipelineSchema | ||
7 | |||
8 | a @: b = tell [(a,b)] | ||
9 | defObjectArray n p m = mapM_ tell [PipelineSchema (Map.singleton n $ ObjectArraySchema p $ Map.singleton a t) mempty | (a,t) <- execWriter m] | ||
10 | defUniforms m = tell $ PipelineSchema mempty $ Map.fromList $ execWriter m | ||
11 | makeSchema a = execWriter a :: PipelineSchema | ||
12 | |||
13 | unionObjectArraySchema (ObjectArraySchema a1 b1) (ObjectArraySchema a2 b2) = | ||
14 | ObjectArraySchema (if a1 == a2 then a1 else error $ "object array schema primitive mismatch " ++ show (a1,a2)) | ||
15 | (Map.unionWith (\a b -> if a == b then a else error $ "object array schema attribute type mismatch " ++ show (a,b)) b1 b2) | ||
16 | |||
17 | instance Monoid PipelineSchema where | ||
18 | mempty = PipelineSchema mempty mempty | ||
19 | mappend (PipelineSchema a1 b1) (PipelineSchema a2 b2) = | ||
20 | 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) | ||