git.iko.soy/elk
on master help sign in
Produce the correct type for shaders and textures
06bc194Evan Czaplicki
src/AST/Literal.hs+23−11
compare with master
unifiedsplit
@@ -5,12 +5,14 @@ import AST.PrettyPrint
5import Data.Map (Map)
5import Data.Map (Map)
6import qualified Text.PrettyPrint as PP
6import qualified Text.PrettyPrint as PP
7
7
8−data Literal = IntNum Int
8+data Literal
9+ = IntNum Int
9− | FloatNum Double
10+ | FloatNum Double
10− | Chr Char
11+ | Chr Char
11− | Str String
12+ | Str String
12− | Boolean Bool
13+ | Boolean Bool
13− deriving (Eq, Ord, Show)
14+ deriving (Eq, Ord, Show)
15+
14
16
15instance Pretty Literal where
17instance Pretty Literal where
16 pretty literal =
18 pretty literal =
@@ -21,8 +23,17 @@ instance Pretty Literal where
21 Str s -> PP.text . show $ s
23 Str s -> PP.text . show $ s
22 Boolean bool -> PP.text (show bool)
24 Boolean bool -> PP.text (show bool)
23
25
26+
24−data GLTipe = Int | Float | V2 | V3 | V4 | M4 | Texture
27+data GLTipe
28+ = Int
29+ | Float
30+ | V2
31+ | V3
32+ | V4
33+ | M4
34+ | Texture
25− deriving (Show)
35+ deriving (Show)
36+
26
37
27glTipeName :: GLTipe -> String
38glTipeName :: GLTipe -> String
28glTipeName glTipe =
39glTipeName glTipe =
@@ -33,11 +44,12 @@ glTipeName glTipe =
33 V3 -> "Math.Vector3.Vec3"
44 V3 -> "Math.Vector3.Vec3"
34 V4 -> "Math.Vector4.Vec4"
45 V4 -> "Math.Vector4.Vec4"
35 M4 -> "Math.Matrix4.Mat4"
46 M4 -> "Math.Matrix4.Mat4"
36− Texture -> "Graphics.WebGL.Texture"
47+ Texture -> "WebGL.Texture"
48+
37
49
38data GLShaderTipe = GLShaderTipe
50data GLShaderTipe = GLShaderTipe
39 { attribute :: Map String GLTipe
51 { attribute :: Map String GLTipe
40 , uniform :: Map String GLTipe
52 , uniform :: Map String GLTipe
41 , varying :: Map String GLTipe
53 , varying :: Map String GLTipe
54+ }
42− } deriving (Show)
55+ deriving (Show)
43−
src/Type/Constrain/Expression.hs+15−8
@@ -20,8 +20,12 @@ import qualified Type.Environment as Env
20import qualified Type.Constrain.Literal as Literal
20import qualified Type.Constrain.Literal as Literal
21import qualified Type.Constrain.Pattern as Pattern
21import qualified Type.Constrain.Pattern as Pattern
22
22
23+
24+constrain
23−constrain :: Env.Environment -> Canonical.Expr -> Type
25+ :: Env.Environment
26+ -> Canonical.Expr
27+ -> Type
24− -> ErrorT [PP.Doc] IO TypeConstraint
28+ -> ErrorT [PP.Doc] IO TypeConstraint
25constrain env (A region expr) tipe =
29constrain env (A region expr) tipe =
26 let list t = Env.get env Env.types "List" <| t
30 let list t = Env.get env Env.types "List" <| t
27 and = A region . CAnd
31 and = A region . CAnd
@@ -37,7 +41,7 @@ constrain env (A region expr) tipe =
37 exists $ \attr ->
41 exists $ \attr ->
38 exists $ \unif ->
42 exists $ \unif ->
39 let
43 let
40− shaderTipe a u v = Env.get env Env.types "Graphics.WebGL.Shader" <| a <| u <| v
44+ shaderTipe a u v = Env.get env Env.types "WebGL.Shader" <| a <| u <| v
41 glTipe = Env.get env Env.types . Lit.glTipeName
45 glTipe = Env.get env Env.types . Lit.glTipeName
42 makeRec accessor baseRec =
46 makeRec accessor baseRec =
43 let decls = accessor gltipe
47 let decls = accessor gltipe
@@ -166,6 +170,7 @@ constrain env (A region expr) tipe =
166 PortOut _ _ signal ->
170 PortOut _ _ signal ->
167 constrain env signal tipe
171 constrain env signal tipe
168
172
173+
169constrainDef env info (Canonical.Definition pattern expr maybeTipe) =
174constrainDef env info (Canonical.Definition pattern expr maybeTipe) =
170 let qs = [] -- should come from the def, but I'm not sure what would live there...
175 let qs = [] -- should come from the def, but I'm not sure what would live there...
171 (schemes, rigidQuantifiers, flexibleQuantifiers, headers, c2, c1) = info
176 (schemes, rigidQuantifiers, flexibleQuantifiers, headers, c2, c1) = info
@@ -205,6 +210,7 @@ constrainDef env info (Canonical.Definition pattern expr maybeTipe) =
205
210
206 _ -> error ("problem in constrainDef with " ++ show pattern)
211 _ -> error ("problem in constrainDef with " ++ show pattern)
207
212
213+
208expandPattern :: Canonical.Def -> [Canonical.Def]
214expandPattern :: Canonical.Def -> [Canonical.Def]
209expandPattern def@(Canonical.Definition pattern lexpr@(A r _) maybeType) =
215expandPattern def@(Canonical.Definition pattern lexpr@(A r _) maybeType) =
210 case pattern of
216 case pattern of
@@ -216,9 +222,10 @@ expandPattern def@(Canonical.Definition pattern lexpr@(A r _) maybeType) =
216 mkVar = A r . localVar
222 mkVar = A r . localVar
217 toDef y = Canonical.Definition (P.Var y) (A r $ Case (mkVar x) [(pattern, mkVar y)]) Nothing
223 toDef y = Canonical.Definition (P.Var y) (A r $ Case (mkVar x) [(pattern, mkVar y)]) Nothing
218
224
225+
219try :: Region -> ErrorT (Region -> PP.Doc) IO a -> ErrorT [PP.Doc] IO a
226try :: Region -> ErrorT (Region -> PP.Doc) IO a -> ErrorT [PP.Doc] IO a
220−try region computation = do
227+try region computation =
221− result <- liftIO $ runErrorT computation
228+ do result <- liftIO $ runErrorT computation
222− case result of
229+ case result of
223− Left err -> throwError [err region]
230+ Left err -> throwError [err region]
224− Right value -> return value
231+ Right value -> return value