712f824 · elk · git.iko.soy

compiler/Generate/JavaScript.hs+1−1

compare with master

unifiedsplit

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

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

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

198

199− GLShader _ src ->

199+ GLShader _uid src _tipe ->

200 return . literal $ Str src

201

202 PortIn name _ _ handler ->

compiler/Parse/Expression.hs+2−2

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

60 glShader' = do

61 pos <- getPosition

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

63− rawSrc <- glShader

63+ (rawSrc, tipe) <- glShader

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

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

65

66 span uid index =

67 "<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

11import qualified Language.GLSL.Parser as GLP

12import Language.GLSL.Syntax

13import SourceSyntax.Helpers as Help

14+import SourceSyntax.Literal as Literal

14import SourceSyntax.Location as Location

15import SourceSyntax.Location as Location

15import SourceSyntax.Expression

16import SourceSyntax.Expression

16import SourceSyntax.PrettyPrint

17import SourceSyntax.PrettyPrint

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

328 closeMarkdown (md ++ [c]) stuff

329 closeMarkdown (md ++ [c]) stuff

329 ]

330 ]

330

331

331−glShader :: IParser String

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

333+glShader = do

334+ do

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

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

333 closeShader src = choice

340 closeShader src = choice

334− [ do

341+ [ do

335− try (string "|]")

342+ try (string "|]")

336− return src

343+ return src

337− , do

344+ , do

338− c <- anyChar

345+ c <- anyChar

339− closeShader (src ++ [c])

346+ closeShader (src ++ [c])

340− ]

347+ ]

341−

348+

342−data GLTipe = V3 | M4

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

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

356glSource src =

350glSource src =

357 case GLP.parse src of

351 case GLP.parse src of

358 Right (TranslationUnit decls) ->

352 Right (TranslationUnit decls) ->

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

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

360− Left e -> Nothing

354+ Left e -> Left e

361 where

355 where

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

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

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

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

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

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

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

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

compiler/SourceSyntax/Expression.hs+2−2

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

49 -- for type checking and code gen only

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

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

52− | GLShader String String

52+ | GLShader String String Literal.GLShaderTipe

53

54type ParseExpr = Expr' ParseDef

55type LParseExpr = LExpr' ParseDef

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

137

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

139

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

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

141

142 PortIn _ _ _ handler -> pretty handler

143

compiler/SourceSyntax/Literal.hs+14

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

1{-# OPTIONS_GHC -Wall #-}

2module SourceSyntax.Literal where

3

4+import Data.Map (Map)

4import SourceSyntax.PrettyPrint

5import SourceSyntax.PrettyPrint

5import qualified Text.PrettyPrint as PP

6import qualified Text.PrettyPrint as PP

6

7

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

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

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

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

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

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

22 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) =

174

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

176

177− GLShader _ _ -> return expr

177+ GLShader _ _ _ -> return expr

178

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

180renamePattern env pattern =

compiler/Transform/Expression.hs+1−1

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

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

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

50 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

52 PortIn name st tt handler ->

53 do portInCheck name st tt

54 PortIn name st tt <$> go handler

compiler/Transform/SafeNames.hs+1−1

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

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

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

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

52− GLShader _ _ -> expr

52+ GLShader _ _ _ -> expr

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

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

55

compiler/Transform/SortDefinitions.hs+1−1

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

83

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

85

86− GLShader _ _ -> return expr

86+ GLShader _ _ _ -> return expr

87

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

89

compiler/Transform/Substitute.hs+1−1

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

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

39 Literal _ -> expr

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

41− GLShader _ _ -> expr

41+ GLShader _ _ _ -> expr

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

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

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

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

8import qualified Control.Monad as Monad

9import Control.Monad.Error

10import qualified Text.PrettyPrint as PP

11−import qualified Parse.Helpers as PH

11+import SourceSyntax.Literal as Lit

12import SourceSyntax.Location as Loc

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

14import SourceSyntax.Expression

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

31 case expr of

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

33

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

34+ GLShader _uid _src gltipe ->

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

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

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

37 where

36 where

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

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

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

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

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

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

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

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

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

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

43−

44

42

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

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

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

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