git.haldean.org del / 30e5126 src / Language / Del / TypeTable.hs
30e5126

Tree @30e5126 (Download .tar.gz)

TypeTable.hs @30e5126 — raw · history · blame 

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
{-# LANGUAGE OverloadedStrings #-}

module Language.Del.TypeTable where

import qualified Data.Map.Strict as Map
import qualified Data.Text as T

data Type
    = NamedType T.Text
    | FuncType [Type] Type
    | BoolType
    | Bool2Type
    | Bool3Type
    | Bool4Type
    | ColorType
    | DoubleType
    | Double2Type
    | Double3Type
    | Double4Type
    | DoubleMatrix Int Int
    | FloatType
    | Float2Type
    | Float3Type
    | Float4Type
    | FloatMatrix Int Int
    | IntType
    | Int2Type
    | Int3Type
    | Int4Type
    | LIntType
    | LInt2Type
    | LInt3Type
    | LInt4Type
    | LUIntType
    | LUInt2Type
    | LUInt3Type
    | LUInt4Type
    | UIntType
    | UInt2Type
    | UInt3Type
    | UInt4Type
    deriving Eq

data TypeInfo
    -- First argument is type constructor, second is Del type, third is GLSL
    -- type
    = TypeInfo Type T.Text T.Text

typeinfos :: [TypeInfo]
typeinfos =
    [ TypeInfo BoolType "b" "bool"
    , TypeInfo Bool2Type "b2" "bvec2"
    , TypeInfo Bool3Type "b3" "bvec3"
    , TypeInfo Bool4Type "b4" "bvec4"
    , TypeInfo ColorType "color" "vec4"
    , TypeInfo DoubleType "d" "double"
    , TypeInfo Double2Type "d2" "dvec2"
    , TypeInfo Double3Type "d3" "dvec3"
    , TypeInfo Double4Type "d4" "dvec4"
    , TypeInfo (DoubleMatrix 2 2) "d2x2" "dmat2"
    , TypeInfo (DoubleMatrix 2 3) "d2x3" "dmat2x3"
    , TypeInfo (DoubleMatrix 2 4) "d2x4" "dmat2x4"
    , TypeInfo (DoubleMatrix 3 2) "d3x2" "dmat3x2"
    , TypeInfo (DoubleMatrix 3 3) "d3x3" "dmat3"
    , TypeInfo (DoubleMatrix 3 4) "d3x4" "dmat3x4"
    , TypeInfo (DoubleMatrix 4 2) "d4x2" "dmat4x2"
    , TypeInfo (DoubleMatrix 4 3) "d4x3" "dmat4x3"
    , TypeInfo (DoubleMatrix 4 2) "d4x4" "dmat4"
    , TypeInfo FloatType "f" "float"
    , TypeInfo Float2Type "f2" "vec2"
    , TypeInfo Float3Type "f3" "vec3"
    , TypeInfo Float4Type "f4" "vec4"
    , TypeInfo (FloatMatrix 2 2) "f2x2" "fmat2"
    , TypeInfo (FloatMatrix 2 3) "f2x3" "fmat2x3"
    , TypeInfo (FloatMatrix 2 4) "f2x4" "fmat2x4"
    , TypeInfo (FloatMatrix 3 2) "f3x2" "fmat3x2"
    , TypeInfo (FloatMatrix 3 3) "f3x3" "fmat3"
    , TypeInfo (FloatMatrix 3 4) "f3x4" "fmat3x4"
    , TypeInfo (FloatMatrix 4 2) "f4x2" "fmat4x2"
    , TypeInfo (FloatMatrix 4 3) "f4x3" "fmat4x3"
    , TypeInfo (FloatMatrix 4 2) "f4x4" "fmat4"
    , TypeInfo IntType "i" "int"
    , TypeInfo Int2Type "i2" "ivec2"
    , TypeInfo Int3Type "i3" "ivec3"
    , TypeInfo Int4Type "i4" "ivec4"
    , TypeInfo LIntType "l" "int64_t"
    , TypeInfo LInt2Type "l2" "i64vec2"
    , TypeInfo LInt3Type "l3" "i64vec3"
    , TypeInfo LInt4Type "l4" "i64vec4"
    , TypeInfo LUIntType "lu" "uint64_t"
    , TypeInfo LUInt2Type "lu2" "u64vec2"
    , TypeInfo LUInt3Type "lu3" "u64vec3"
    , TypeInfo LUInt4Type "lu4" "u64vec4"
    , TypeInfo UIntType "u" "uint"
    , TypeInfo UInt2Type "u2" "uvec2"
    , TypeInfo UInt3Type "u3" "uvec3"
    , TypeInfo UInt4Type" u4" "uvec4"
    ]

delmap :: Map.Map T.Text TypeInfo
delmap = Map.fromList $ map (\ti@(TypeInfo _ t _) -> (t, ti)) typeinfos

glslmap :: Map.Map T.Text TypeInfo
glslmap = Map.fromList $ map (\ti@(TypeInfo _ _ t) -> (t, ti)) typeinfos

findType :: Type -> Maybe TypeInfo
findType = find typeinfos
    where find (x@(TypeInfo t _ _):xs) typ
              = if t == typ then Just x else find xs typ
          find [] _ = Nothing

findGlslType :: T.Text -> Maybe TypeInfo
findGlslType = flip Map.lookup $ glslmap

findDelType :: T.Text -> Maybe TypeInfo
findDelType = flip Map.lookup $ delmap

instance Show Type where
    show (NamedType t) = show t
    show (FuncType args ret) = show args ++ " -> " ++ show ret
    show x = case findType x of
                  Just (TypeInfo _ n _) -> T.unpack n
                  Nothing -> undefined