712f824 · elk · git.iko.soy

git.iko.soy/elk

moved all GLSL tipe stuff out of constrain and into Parse Helper

commit712f824e44ff8bc6998e086f9d2b0ff01bc9ed16 authorJohn P Mayer Jr <john.p.mayer.jr@gmail.com> dateTue 7 Jan 2014, 21:04 (13 years ago) parent3e63279

11 files changed+52−46

compare with master

unifiedsplit

compiler/Generate/JavaScript.hs+1−1 compiler/Parse/Expression.hs+2−2 compiler/Parse/Helpers.hs+21−27 compiler/SourceSyntax/Expression.hs+2−2 compiler/SourceSyntax/Literal.hs+14 compiler/Transform/Canonicalize.hs+1−1 compiler/Transform/Expression.hs+1−1 compiler/Transform/SafeNames.hs+1−1 compiler/Transform/SortDefinitions.hs+1−1 compiler/Transform/Substitute.hs+1−1 compiler/Type/Constrain/Expression.hs+7−9

compiler/Generate/JavaScript.hs+1−1

@@ -196,7 +196,7 @@ expression (L span expr) =

196196 pad = "<div style=\"height:0;width:0;\"> </div>"

197197 md = pad ++ MD.toHtml doc ++ pad

198198

199− GLShader _ src ->

199+ GLShader _uid src _tipe ->

200200 return . literal $ Str src

201201

202202 PortIn name _ _ handler ->

compiler/Parse/Expression.hs+2−2

@@ -60,8 +60,8 @@ listTerm = markdown' <|> glShader' <|> braces (try range <|> ExplicitList <$> co

6060 glShader' = do

6161 pos <- getPosition

6262 let uid = show (sourceLine pos) ++ ":" ++ show (sourceColumn pos)

63− rawSrc <- glShader

64− return $ GLShader uid (filter (/='\r') rawSrc)

63+ (rawSrc, tipe) <- glShader

64+ return $ GLShader uid (filter (/='\r') rawSrc) tipe

6565

6666 span uid index =

6767 "<span id=\"md-" ++ uid ++ "-" ++ show index ++ "\">{{ markdown interpolation is in the pipeline, but still needs more testing }}</span>"

compiler/Parse/Helpers.hs+21−27

@@ -11,6 +11,7 @@ import qualified Data.Map as Map

1111import qualified Language.GLSL.Parser as GLP

1212import Language.GLSL.Syntax

1313import SourceSyntax.Helpers as Help

14+import SourceSyntax.Literal as Literal

1415import SourceSyntax.Location as Location

1516import SourceSyntax.Expression

1617import SourceSyntax.PrettyPrint

@@ -328,38 +329,31 @@ markdown interpolation = try (string "[markdown|") >> closeMarkdown "" []

328329 closeMarkdown (md ++ [c]) stuff

329330 ]

330331

331−glShader :: IParser String

332−glShader = try (string "[glShader|") >> closeShader "" where

332+glShader :: IParser (String, Literal.GLShaderTipe)

333+glShader = do

334+ do

335+ rawSrc <- try (string "[glShader|") >> closeShader ""

336+ case glSource rawSrc of

337+ Left err -> parserFail . show $ err

338+ Right tipe -> return (rawSrc, tipe)

339+ where

333340 closeShader src = choice

334− [ do

335− try (string "|]")

336− return src

337− , do

338− c <- anyChar

339− closeShader (src ++ [c])

340− ]

341−

342−data GLTipe = V3 | M4

343−

344−glTipeName :: GLTipe -> String

345−glTipeName V3 = "MJS.V3"

346−glTipeName M4 = "MJS.M4x4"

347−

348−data GLShaderDecls = GLShaderDecls

349− { attribute :: Map String GLTipe

350− , uniform :: Map String GLTipe

351− , varying :: Map String GLTipe

352− }

353−

354−--glSource :: String -> Maybe [(StorageQualifier, GLTipe, String)]

355−glSource :: String -> Maybe GLShaderDecls

341+ [ do

342+ try (string "|]")

343+ return src

344+ , do

345+ c <- anyChar

346+ closeShader (src ++ [c])

347+ ]

348+

349+glSource :: String -> Either ParseError Literal.GLShaderTipe

356350glSource src =

357351 case GLP.parse src of

358352 Right (TranslationUnit decls) ->

359− Just . foldr addGLinput emptyDecls . join . map extractGLinputs $ decls

360− Left e -> Nothing

353+ Right . foldr addGLinput emptyDecls . join . map extractGLinputs $ decls

354+ Left e -> Left e

361355 where

362− emptyDecls = GLShaderDecls Map.empty Map.empty Map.empty

356+ emptyDecls = Literal.GLShaderTipe Map.empty Map.empty Map.empty

363357 addGLinput (qual,tipe,name) glDecls = case qual of

364358 Attribute -> glDecls { attribute = Map.insert name tipe $ attribute glDecls }

365359 Uniform -> glDecls { uniform = Map.insert name tipe $ uniform glDecls }

compiler/SourceSyntax/Expression.hs+2−2

@@ -49,7 +49,7 @@ data Expr' def

4949 -- for type checking and code gen only

5050 | PortIn String SrcType.Type Type.Variable (LExpr' def)

5151 | PortOut String SrcType.Type (LExpr' def)

52− | GLShader String String

52+ | GLShader String String Literal.GLShaderTipe

5353

5454type ParseExpr = Expr' ParseDef

5555type LParseExpr = LExpr' ParseDef

@@ -137,7 +137,7 @@ instance Pretty def => Pretty (Expr' def) where

137137

138138 Markdown _ _ _ -> P.text "[markdown| ... |]"

139139

140− GLShader _ _ -> P.text "[glShader| ... |]"

140+ GLShader _ _ _ -> P.text "[glShader| ... |]"

141141

142142 PortIn _ _ _ handler -> pretty handler

143143

compiler/SourceSyntax/Literal.hs+14

@@ -1,6 +1,7 @@

11{-# OPTIONS_GHC -Wall #-}

22module SourceSyntax.Literal where

4+import Data.Map (Map)

45import SourceSyntax.PrettyPrint

56import qualified Text.PrettyPrint as PP

@@ -19,3 +20,16 @@ instance Pretty Literal where

1920 Chr c -> PP.quotes (PP.char c)

2021 Str s -> PP.text (show s)

2122 Boolean bool -> PP.text (show bool)

23+

24+data GLTipe = V3 | M4

25+

26+glTipeName :: GLTipe -> String

27+glTipeName V3 = "MJS.V3"

28+glTipeName M4 = "MJS.M4x4"

29+

30+data GLShaderTipe = GLShaderTipe

31+ { attribute :: Map String GLTipe

32+ , uniform :: Map String GLTipe

33+ , varying :: Map String GLTipe

34+ }

35+

compiler/Transform/Canonicalize.hs+1−1

@@ -174,7 +174,7 @@ rename env (L s expr) =

174174

175175 PortOut name st signal -> PortOut name <$> renameType' env st <*> rnm signal

176176

177− GLShader _ _ -> return expr

177+ GLShader _ _ _ -> return expr

178178

179179renamePattern :: Env -> P.Pattern -> Either String P.Pattern

180180renamePattern env pattern =

compiler/Transform/Expression.hs+1−1

@@ -48,7 +48,7 @@ crawl portInCheck portOutCheck defsTransform = go

4848 Record fields -> Record <$> mapM (\(k,v) -> (,) k <$> go v) fields

4949 Markdown uid md es -> Markdown uid md <$> mapM go es

5050 Let defs body -> Let <$> defsTransform defs <*> go body

51− GLShader uid src -> return (GLShader uid src)

51+ GLShader uid src gltipe -> return $ GLShader uid src gltipe

5252 PortIn name st tt handler ->

5353 do portInCheck name st tt

5454 PortIn name st tt <$> go handler

compiler/Transform/SafeNames.hs+1−1

@@ -49,7 +49,7 @@ expression (L loc expr) =

4949 Modify r fs -> Modify (f r) (map (var *** f) fs)

5050 Record fs -> Record (map (var *** f) fs)

5151 Markdown uid md es -> Markdown uid md (map f es)

52− GLShader _ _ -> expr

52+ GLShader _ _ _ -> expr

5353 PortIn name st tt handler -> PortIn name st tt (f handler)

5454 PortOut name st signal -> PortOut name st (f signal)

5555

compiler/Transform/SortDefinitions.hs+1−1

@@ -83,7 +83,7 @@ reorder (L s expr) =

8383

8484 Markdown uid md es -> Markdown uid md <$> mapM reorder es

8585

86− GLShader _ _ -> return expr

86+ GLShader _ _ _ -> return expr

8787

8888 PortOut name st signal -> PortOut name st <$> reorder signal

8989

compiler/Transform/Substitute.hs+1−1

@@ -38,6 +38,6 @@ subst old new expr =

3838 Record fs -> Record (map (second f) fs)

3939 Literal _ -> expr

4040 Markdown uid md es -> Markdown uid md (map f es)

41− GLShader _ _ -> expr

41+ GLShader _ _ _ -> expr

4242 PortIn name st tt handler -> PortIn name st tt (f handler)

4343 PortOut name st signal -> PortOut name st (f signal)

compiler/Type/Constrain/Expression.hs+7−9

@@ -8,7 +8,7 @@ import Control.Applicative ((<$>))

88import qualified Control.Monad as Monad

99import Control.Monad.Error

1010import qualified Text.PrettyPrint as PP

11−import qualified Parse.Helpers as PH

11+import SourceSyntax.Literal as Lit

1212import SourceSyntax.Location as Loc

1313import SourceSyntax.Pattern (Pattern(PVar), boundVars)

1414import SourceSyntax.Expression

@@ -31,16 +31,14 @@ constrain env (L span expr) tipe =

3131 case expr of

3232 Literal lit -> liftIO $ Literal.constrain env span lit tipe

3333

34− GLShader uid src -> case PH.glSource src of

35− Nothing -> throwError [PP.text $ "Some sort of GLSL parse error" ++ uid]

36− Just sourceDecls -> return . L span $ CEqual tipe (shaderTipe attribute uniform varying)

34+ GLShader _uid _src gltipe ->

35+ return . L span $ CEqual tipe (shaderTipe attribute uniform varying)

3736 where

3837 shaderTipe a u v = Env.get env Env.types "Graphics.WebGL.Shader" <| a <| u <| v

39− glTipe = Env.get env Env.types . PH.glTipeName

40− attribute = record (Map.map (\t -> [glTipe t]) $ PH.attribute sourceDecls) (TermN EmptyRecord1)

41− uniform = record (Map.map (\t -> [glTipe t]) $ PH.uniform sourceDecls) (TermN EmptyRecord1)

42− varying = record (Map.map (\t -> [glTipe t]) $ PH.varying sourceDecls) (TermN EmptyRecord1)

43−

38+ glTipe = Env.get env Env.types . Lit.glTipeName

39+ attribute = record (Map.map (\t -> [glTipe t]) $ Lit.attribute gltipe) (TermN EmptyRecord1)

40+ uniform = record (Map.map (\t -> [glTipe t]) $ Lit.uniform gltipe) (TermN EmptyRecord1)

41+ varying = record (Map.map (\t -> [glTipe t]) $ Lit.varying gltipe) (TermN EmptyRecord1)

4442

4543 Var name | name == saveEnvName -> return (L span CSaveEnv)

4644 | otherwise -> return (name <? tipe)