git.iko.soy/elk
on master help sign in
Get parser for GLSL blocks working again
d93da6dEvan Czaplicki
elm-compiler.cabal+2
compare with master
unifiedsplit
@@ -151,6 +151,7 @@ Library
151 filepath >= 1 && < 2.0,
151 filepath >= 1 && < 2.0,
152 language-glsl >= 0.0.2 && < 0.3,
152 language-glsl >= 0.0.2 && < 0.3,
153 mtl >= 2.2 && < 3,
153 mtl >= 2.2 && < 3,
154+ parsec,
154 pretty >= 1.0 && < 2.0,
155 pretty >= 1.0 && < 2.0,
155 process,
156 process,
156 text >= 1 && < 2,
157 text >= 1 && < 2,
@@ -221,6 +222,7 @@ Test-Suite compiler-tests
221 filepath >= 1 && < 2.0,
222 filepath >= 1 && < 2.0,
222 language-glsl >= 0.0.2 && < 0.3,
223 language-glsl >= 0.0.2 && < 0.3,
223 mtl >= 2.2 && < 3,
224 mtl >= 2.2 && < 3,
225+ parsec,
224 pretty >= 1.0 && < 2.0,
226 pretty >= 1.0 && < 2.0,
225 process,
227 process,
226 text >= 1 && < 2,
228 text >= 1 && < 2,
src/Parse/Expression.hs+1
@@ -28,6 +28,7 @@ term =
28 oneOf
28 oneOf
29 [ variable start >>= accessible start
29 [ variable start >>= accessible start
30 , literal start
30 , literal start
31+ , Literal.shader start
31 , list start
32 , list start
32 , record start >>= accessible start
33 , record start >>= accessible start
33 , tuple start
34 , tuple start
src/Parse/Literal.hs+91−75
@@ -1,17 +1,22 @@
1{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
1{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
2−module Parse.Literal (literal) where
2+module Parse.Literal (literal, shader) where
3
3
4−--import Prelude hiding (exponent)
5−--import Control.Monad (join)
6−--import qualified Data.Char as Char
4+import qualified Data.List as List
7−--import qualified Data.List as List
5+import qualified Data.Map as Map
8−--import qualified Data.Map as Map
6+import qualified Data.Text as Text
9−--import qualified Language.GLSL.Parser as GLP
7+import qualified Language.GLSL.Parser as GLP
10−--import qualified Language.GLSL.Syntax as GLS
8+import qualified Language.GLSL.Syntax as GLS
9+import qualified Text.Parsec as Parsec
10+import qualified Text.Parsec.Error as Parsec
11
11
12+import qualified AST.Expression.Source as Src
12import qualified AST.Literal as L
13import qualified AST.Literal as L
14+import qualified Reporting.Annotation as A
15+import qualified Reporting.Region as R
16+import Parse.Helpers
13−import Parse.Helpers (Parser, string, character, number, oneOf)
17+ ( Parser, character, getPosition, number, oneOf
14−--import qualified Reporting.Error.Syntax as Error
18+ , shaderSource, shaderFailure, string
19+ )
15
20
16
21
17
22
@@ -28,74 +33,85 @@ literal =
28
33
29
34
30
35
31−{-- SHADERS
36+-- SHADERS
32
37
33
38
34−shader :: Parser (String, L.GLShaderTipe)
39+shader :: R.Position -> Parser Src.RawExpr
35−shader =
40+shader start@(R.Position row col) =
36− do text "[glsl|"
41+ do src <- shaderSource
37− rawSrc <- closeShader id
42+ shdr <- parseSource row col (Text.unpack src)
38− case stringToShader rawSrc of
43+ end@(R.Position row2 col2) <- getPosition
39− Left err -> parserFail . show $ err
44+ let uid = List.intercalate ":" (map show [row, col, row2, col2])
40− Right tipe -> return (rawSrc, tipe)
45+ return (A.at start end (Src.GLShader (Text.pack uid) src shdr))
41
46
42
47
43−closeShader :: (String -> a) -> Parser a
48+parseSource :: Int -> Int -> String -> Parser L.Shader
44−closeShader builder =
49+parseSource startRow startCol src =
45− choice
46− [ do try (string "|]")
47− return (builder "")
48− , do c <- anyChar
49− closeShader (builder . (c:))
50− ]
51−
52−
53−stringToShader :: String -> Either ParseError L.Shader
54−stringToShader src =
55 case GLP.parse src of
50 case GLP.parse src of
56− Left e ->
57− Left e
58−
59 Right (GLS.TranslationUnit decls) ->
51 Right (GLS.TranslationUnit decls) ->
60− Right $ foldr addGLinput emptyDecls $ join $
52+ return (foldr addInput emptyShader (concatMap extractInputs decls))
61− map extractGLinputs decls
53+
62− where
54+ Left err ->
55+ let
56+ pos = Parsec.errorPos err
57+ row = Parsec.sourceLine pos
58+ col = Parsec.sourceColumn pos
59+ msg =
60+ Parsec.showErrorMessages
61+ "or"
62+ "unknown parse error"
63+ "expecting"
64+ "unexpected"
65+ "end of input"
66+ (Parsec.errorMessages err)
67+ in
68+ if row == 1 then
69+ shaderFailure startRow (startCol + 6 + col) (Text.pack msg)
70+ else
71+ shaderFailure (startRow + row - 1) col (Text.pack msg)
72+
73+
74+emptyShader :: L.Shader
75+emptyShader =
63− emptyDecls = L.GLShaderTipe Map.empty Map.empty Map.empty
76+ L.Shader Map.empty Map.empty Map.empty
64−
77+
78+
79+addInput :: (GLS.StorageQualifier, L.GLType, Text.Text) -> L.Shader -> L.Shader
65− addGLinput (qual,tipe,name) glDecls =
80+addInput ( qual, tipe, name ) glDecls =
66− case qual of
81+ case qual of
67− GLS.Attribute ->
82+ GLS.Attribute ->
68− glDecls { L.attribute = Map.insert name tipe $ L.attribute glDecls }
83+ glDecls { L.attribute = Map.insert name tipe (L.attribute glDecls) }
69−
84+
70− GLS.Uniform ->
85+ GLS.Uniform ->
71− glDecls { L.uniform = Map.insert name tipe $ L.uniform glDecls }
86+ glDecls { L.uniform = Map.insert name tipe (L.uniform glDecls) }
72−
87+
73− GLS.Varying ->
88+ GLS.Varying ->
74− glDecls { L.varying = Map.insert name tipe $ L.varying glDecls }
89+ glDecls { L.varying = Map.insert name tipe (L.varying glDecls) }
75−
90+
76− _ -> error "Should never happen due to below filter"
91+ _ -> error "Should never happen due to below filter"
77−
92+
78− extractGLinputs decl =
93+
94+extractInputs :: GLS.ExternalDeclaration -> [(GLS.StorageQualifier, L.GLType, Text.Text)]
95+extractInputs decl =
79− case decl of
96+ case decl of
80− GLS.Declaration
97+ GLS.Declaration
81− (GLS.InitDeclaration
98+ (GLS.InitDeclaration
82− (GLS.TypeDeclarator
99+ (GLS.TypeDeclarator
83− (GLS.FullType
100+ (GLS.FullType
84− (Just (GLS.TypeQualSto qual))
101+ (Just (GLS.TypeQualSto qual))
85− (GLS.TypeSpec _prec (GLS.TypeSpecNoPrecision tipe _mexpr1))))
102+ (GLS.TypeSpec _prec (GLS.TypeSpecNoPrecision tipe _mexpr1))))
86− [GLS.InitDecl name _mexpr2 _mexpr3]
103+ [GLS.InitDecl name _mexpr2 _mexpr3]
87− ) ->
104+ ) ->
88− case elem qual [GLS.Attribute, GLS.Varying, GLS.Uniform] of
105+ case elem qual [GLS.Attribute, GLS.Varying, GLS.Uniform] of
89− False -> []
106+ False -> []
90− True ->
107+ True ->
91− case tipe of
108+ case tipe of
92− GLS.Vec2 -> return (qual, L.V2, name)
109+ GLS.Vec2 -> [(qual, L.V2, Text.pack name)]
93− GLS.Vec3 -> return (qual, L.V3, name)
110+ GLS.Vec3 -> [(qual, L.V3, Text.pack name)]
94− GLS.Vec4 -> return (qual, L.V4, name)
111+ GLS.Vec4 -> [(qual, L.V4, Text.pack name)]
95− GLS.Mat4 -> return (qual, L.M4, name)
112+ GLS.Mat4 -> [(qual, L.M4, Text.pack name)]
96− GLS.Int -> return (qual, L.Int, name)
113+ GLS.Int -> [(qual, L.Int, Text.pack name)]
97− GLS.Float -> return (qual, L.Float, name)
114+ GLS.Float -> [(qual, L.Float, Text.pack name)]
98− GLS.Sampler2D -> return (qual, L.Texture, name)
115+ GLS.Sampler2D -> [(qual, L.Texture, Text.pack name)]
99− _ -> []
116+ _ -> []
100− _ -> []
117+ _ -> []
101−-}
src/Parse/Primitives.hs+50
@@ -13,6 +13,7 @@ module Parse.Primitives
13 , docComment
13 , docComment
14 , string, character
14 , string, character
15 , digit, number
15 , digit, number
16+ , shaderSource, shaderFailure
16 )
17 )
17 where
18 where
18
19
@@ -120,6 +121,12 @@ failure problem =
120 cerr (ParseError row col problem)
121 cerr (ParseError row col problem)
121
122
122
123
124+shaderFailure :: Int -> Int -> Text -> Parser a
125+shaderFailure row col msg =
126+ Parser $ \_ _ cerr _ _ ->
127+ cerr (ParseError row col (BadShader msg))
128+
129+
123deadend :: Theory -> Parser a
130deadend :: Theory -> Parser a
124deadend theory =
131deadend theory =
125 Parser $ \(State _ _ _ _ row col) _ _ _ eerr ->
132 Parser $ \(State _ _ _ _ row col) _ _ _ eerr ->
@@ -1119,3 +1126,46 @@ readFloat :: Text.Array -> Int -> Int -> L.Literal
1119readFloat array startOffset endOffset =
1126readFloat array startOffset endOffset =
1120 L.FloatNum $ read $ Text.unpack $
1127 L.FloatNum $ read $ Text.unpack $
1121 Text.Text array startOffset (endOffset - startOffset)
1128 Text.Text array startOffset (endOffset - startOffset)
1129+
1130+
1131+
1132+-- SHADER
1133+
1134+
1135+shaderSource :: Parser Text
1136+shaderSource =
1137+ do symbol "[glsl|"
1138+ Parser $ \(State array offset length indent row col) cok cerr _ _ ->
1139+ case eatShader array offset length row col of
1140+ Nothing ->
1141+ cerr (ParseError row col EndOfFile_Shader)
1142+
1143+ Just ( shaderEndOffset, newRow, newCol ) ->
1144+ let
1145+ !size = shaderEndOffset - offset
1146+ in
1147+ cok
1148+ (copyText array offset size)
1149+ (State array (shaderEndOffset + 2) (length - size - 2) indent newRow newCol)
1150+
1151+
1152+eatShader :: Text.Array -> Int -> Int -> Int -> Int -> Maybe (Int, Int, Int)
1153+eatShader array offset length row col =
1154+ if length < 2 then
1155+ Nothing
1156+
1157+ else
1158+ let
1159+ !word = Text.unsafeIndex array offset
1160+ in
1161+ if word == 0x007C {- | -} && Text.unsafeIndex array (offset + 1) == 0x005D {- ] -} then
1162+ Just ( offset, row, col + 2 )
1163+
1164+ else if word == 0x000A {- \n -} then
1165+ eatShader array (offset + 1) (length - 1) (row + 1) 1
1166+
1167+ else if word < 0xD800 || word > 0xDBFF then
1168+ eatShader array (offset + 1) (length - 1) row (col + 1)
1169+
1170+ else
1171+ eatShader array (offset + 2) (length - 2) row (col + 1)
src/Reporting/Error/Syntax.hs+14
@@ -61,6 +61,7 @@ data ParseError
61data Problem
61data Problem
62 = Tab
62 = Tab
63 | EndOfFile_Comment
63 | EndOfFile_Comment
64+ | EndOfFile_Shader
64 | EndOfFile_String
65 | EndOfFile_String
65 | EndOfFile_MultiString
66 | EndOfFile_MultiString
66 | NewLineInString
67 | NewLineInString
@@ -71,6 +72,7 @@ data Problem
71 | BadNumberExp
72 | BadNumberExp
72 | BadNumberHex
73 | BadNumberHex
73 | BadNumberZero
74 | BadNumberZero
75+ | BadShader Text
74 | BadChunkInQualifiedCapVar
76 | BadChunkInQualifiedCapVar
75 | HasType
77 | HasType
76 | Equals
78 | Equals
@@ -377,6 +379,13 @@ problemToReport problem =
377 ]
379 ]
378 )
380 )
379
381
382+ EndOfFile_Shader ->
383+ parseReport
384+ "I got to the end of the file while parsing a GLSL block."
385+ (reflowParagraph $
386+ "A shader should be defined in a block like this: [glsl| ... |]"
387+ )
388+
380 EndOfFile_String ->
389 EndOfFile_String ->
381 parseReport
390 parseReport
382 "I got to the end of the file while parsing a string."
391 "I got to the end of the file while parsing a string."
@@ -469,6 +478,11 @@ problemToReport problem =
469 "Only numbers like 0x0040 or 0.25 can start with a zero."
478 "Only numbers like 0x0040 or 0.25 can start with a zero."
470 )
479 )
471
480
481+ BadShader msg ->
482+ parseReport
483+ "I ran into a problem while parsing this GLSL block."
484+ (reflowParagraph msg)
485+
472 BadChunkInQualifiedCapVar ->
486 BadChunkInQualifiedCapVar ->
473 error "TODO"
487 error "TODO"
474
488