git.iko.soy/elk
on master help sign in
Produce the correct type for shaders and textures
commit06bc1948bcff7e03a57ff5dba0ee3e616a95770e authorEvan Czaplicki <info@elm-lang.org> dateSat 6 Dec 2014, 17:29 (12 years ago) parentcfaeff9
2 files changed+38−19
compare with master
unifiedsplit
src/AST/Literal.hs+23−11 src/Type/Constrain/Expression.hs+15−8
src/AST/Literal.hs+23−11
@@ -5,12 +5,14 @@ import AST.PrettyPrint
55import Data.Map (Map)
66import qualified Text.PrettyPrint as PP
77
8−data Literal = IntNum Int
9− | FloatNum Double
10− | Chr Char
11− | Str String
12− | Boolean Bool
13− deriving (Eq, Ord, Show)
8+data Literal
9+ = IntNum Int
10+ | FloatNum Double
11+ | Chr Char
12+ | Str String
13+ | Boolean Bool
14+ deriving (Eq, Ord, Show)
15+
1416
1517instance Pretty Literal where
1618 pretty literal =
@@ -21,8 +23,17 @@ instance Pretty Literal where
2123 Str s -> PP.text . show $ s
2224 Boolean bool -> PP.text (show bool)
2325
24−data GLTipe = Int | Float | V2 | V3 | V4 | M4 | Texture
25− deriving (Show)
26+
27+data GLTipe
28+ = Int
29+ | Float
30+ | V2
31+ | V3
32+ | V4
33+ | M4
34+ | Texture
35+ deriving (Show)
36+
2637
2738glTipeName :: GLTipe -> String
2839glTipeName glTipe =
@@ -33,11 +44,12 @@ glTipeName glTipe =
3344 V3 -> "Math.Vector3.Vec3"
3445 V4 -> "Math.Vector4.Vec4"
3546 M4 -> "Math.Matrix4.Mat4"
36− Texture -> "Graphics.WebGL.Texture"
47+ Texture -> "WebGL.Texture"
48+
3749
3850data GLShaderTipe = GLShaderTipe
3951 { attribute :: Map String GLTipe
4052 , uniform :: Map String GLTipe
4153 , varying :: Map String GLTipe
42− } deriving (Show)
43−
54+ }
55+ deriving (Show)
src/Type/Constrain/Expression.hs+15−8
@@ -20,8 +20,12 @@ import qualified Type.Environment as Env
2020import qualified Type.Constrain.Literal as Literal
2121import qualified Type.Constrain.Pattern as Pattern
2222
23−constrain :: Env.Environment -> Canonical.Expr -> Type
24− -> ErrorT [PP.Doc] IO TypeConstraint
23+
24+constrain
25+ :: Env.Environment
26+ -> Canonical.Expr
27+ -> Type
28+ -> ErrorT [PP.Doc] IO TypeConstraint
2529constrain env (A region expr) tipe =
2630 let list t = Env.get env Env.types "List" <| t
2731 and = A region . CAnd
@@ -37,7 +41,7 @@ constrain env (A region expr) tipe =
3741 exists $ \attr ->
3842 exists $ \unif ->
3943 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
4145 glTipe = Env.get env Env.types . Lit.glTipeName
4246 makeRec accessor baseRec =
4347 let decls = accessor gltipe
@@ -166,6 +170,7 @@ constrain env (A region expr) tipe =
166170 PortOut _ _ signal ->
167171 constrain env signal tipe
168172
173+
169174constrainDef env info (Canonical.Definition pattern expr maybeTipe) =
170175 let qs = [] -- should come from the def, but I'm not sure what would live there...
171176 (schemes, rigidQuantifiers, flexibleQuantifiers, headers, c2, c1) = info
@@ -205,6 +210,7 @@ constrainDef env info (Canonical.Definition pattern expr maybeTipe) =
205210
206211 _ -> error ("problem in constrainDef with " ++ show pattern)
207212
213+
208214expandPattern :: Canonical.Def -> [Canonical.Def]
209215expandPattern def@(Canonical.Definition pattern lexpr@(A r _) maybeType) =
210216 case pattern of
@@ -216,9 +222,10 @@ expandPattern def@(Canonical.Definition pattern lexpr@(A r _) maybeType) =
216222 mkVar = A r . localVar
217223 toDef y = Canonical.Definition (P.Var y) (A r $ Case (mkVar x) [(pattern, mkVar y)]) Nothing
218224
225+
219226try :: Region -> ErrorT (Region -> PP.Doc) IO a -> ErrorT [PP.Doc] IO a
220−try region computation = do
221− result <- liftIO $ runErrorT computation
222− case result of
223− Left err -> throwError [err region]
224− Right value -> return value
227+try region computation =
228+ do result <- liftIO $ runErrorT computation
229+ case result of
230+ Left err -> throwError [err region]
231+ Right value -> return value