on master help sign in
Update parsers for dissolution of AST.Literal
6f43061Evan Czaplicki
src/Parse/Expression.hs+31−7
@@ -12,11 +12,13 @@ import qualified AST.Expression.Source as Src
12import qualified Elm.Name as N
12import qualified Elm.Name as N
13import Parse.Primitives
13import Parse.Primitives
14import qualified Parse.Primitives.Keyword as Keyword
14import qualified Parse.Primitives.Keyword as Keyword
15+import qualified Parse.Primitives.Number as Number
15import qualified Parse.Primitives.Symbol as Symbol
16import qualified Parse.Primitives.Symbol as Symbol
17+import qualified Parse.Primitives.Utf8 as Utf8
16import qualified Parse.Primitives.Variable as Var
18import qualified Parse.Primitives.Variable as Var
17import qualified Parse.Primitives.Whitespace as W
19import qualified Parse.Primitives.Whitespace as W
18−import qualified Parse.Literal as Literal
19import qualified Parse.Pattern as Pattern
20import qualified Parse.Pattern as Pattern
21+import qualified Parse.Shader as Shader
20import qualified Parse.Type as Type
22import qualified Parse.Type as Type
21import qualified Reporting.Annotation as A
23import qualified Reporting.Annotation as A
22import qualified Reporting.Error.Syntax as E
24import qualified Reporting.Error.Syntax as E
@@ -33,20 +35,42 @@ term =
33 do start <- getPosition
35 do start <- getPosition
34 oneOf
36 oneOf
35 [ variable start >>= accessible start
37 [ variable start >>= accessible start
36− , literal start
38+ , string start
39+ , number start
37− , Literal.shader start
40+ , Shader.shader start
38 , list start
41 , list start
39 , record start >>= accessible start
42 , record start >>= accessible start
40 , tuple start >>= accessible start
43 , tuple start >>= accessible start
41 , accessor start
44 , accessor start
45+ , character start
42 ]
46 ]
43
47
44
48
45−literal :: R.Position -> Parser Src.Expr
49+string :: R.Position -> Parser Src.Expr
46−literal start =
50+string start =
47− do value <- Literal.literal
51+ do str <- Utf8.string
48 end <- getPosition
52 end <- getPosition
49− return (A.at start end (Src.Literal value))
53+ return (A.at start end (Src.Str str))
54+
55+
56+character :: R.Position -> Parser Src.Expr
57+character start =
58+ do chr <- Utf8.character
59+ end <- getPosition
60+ return (A.at start end (Src.Chr chr))
61+
62+
63+number :: R.Position -> Parser Src.Expr
64+number start =
65+ do nmbr <- Number.number
66+ end <- getPosition
67+ return $ A.at start end $
68+ case nmbr of
69+ Number.Int int ->
70+ Src.Int int
71+
72+ Number.Float float ->
73+ Src.Float float
50
74
51
75
52accessor :: R.Position -> Parser Src.Expr
76accessor :: R.Position -> Parser Src.Expr
src/Parse/Pattern.hs+17−3
@@ -11,10 +11,11 @@ import qualified Data.List as List
11
11
12import qualified AST.Expression.Source as Src
12import qualified AST.Expression.Source as Src
13import qualified Elm.Name as N
13import qualified Elm.Name as N
14−import qualified Parse.Literal as Literal
15import Parse.Primitives (Parser, SParser, SPos, addLocation, checkSpace, getPosition, hint, inContext, spaces, oneOf)
14import Parse.Primitives (Parser, SParser, SPos, addLocation, checkSpace, getPosition, hint, inContext, spaces, oneOf)
16import qualified Parse.Primitives.Keyword as Keyword
15import qualified Parse.Primitives.Keyword as Keyword
16+import qualified Parse.Primitives.Number as Number
17import qualified Parse.Primitives.Symbol as Symbol
17import qualified Parse.Primitives.Symbol as Symbol
18+import qualified Parse.Primitives.Utf8 as Utf8
18import qualified Parse.Primitives.Variable as Var
19import qualified Parse.Primitives.Variable as Var
19import Parse.Primitives.Whitespace (whitespace)
20import Parse.Primitives.Whitespace (whitespace)
20import qualified Reporting.Annotation as A
21import qualified Reporting.Annotation as A
@@ -55,9 +56,22 @@ termHelp start =
55 let ctor = Src.PCtor (R.Region start end) maybePrefix name []
56 let ctor = Src.PCtor (R.Region start end) maybePrefix name []
56 return (A.at start end ctor)
57 return (A.at start end ctor)
57 ,
58 ,
58− do lit <- Literal.literal
59+ do number <- Number.number
59 end <- getPosition
60 end <- getPosition
61+ case number of
62+ Number.Int int ->
60− return (A.at start end (Src.PLiteral lit))
63+ return (A.at start end (Src.PInt int))
64+
65+ Number.Float _ ->
66+ error "TODO floats are not allowed in pattern matches"
67+ ,
68+ do str <- Utf8.string
69+ end <- getPosition
70+ return (A.at start end (Src.PStr str))
71+ ,
72+ do chr <- Utf8.character
73+ end <- getPosition
74+ return (A.at start end (Src.PChr chr))
61 ]
75 ]
62
76
63
77
src/Parse/Primitives/Number.hs+10−5
@@ -1,7 +1,8 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE BangPatterns, UnboxedTuples #-}
2{-# LANGUAGE BangPatterns, UnboxedTuples #-}
3module Parse.Primitives.Number
3module Parse.Primitives.Number
4+ ( Number(..)
4− ( number
5+ , number
5 , chompHex
6 , chompHex
6 )
7 )
7 where
8 where
@@ -13,7 +14,6 @@ import qualified Data.ByteString.Internal as B
13import Foreign.ForeignPtr (ForeignPtr)
14import Foreign.ForeignPtr (ForeignPtr)
14import GHC.Word (Word8)
15import GHC.Word (Word8)
15
16
16−import qualified AST.Literal as L
17import Parse.Primitives.Internals (Parser(..), State(..), noError)
17import Parse.Primitives.Internals (Parser(..), State(..), noError)
18import qualified Parse.Primitives.Internals as I
18import qualified Parse.Primitives.Internals as I
19import qualified Parse.Primitives.Variable as Var
19import qualified Parse.Primitives.Variable as Var
@@ -39,7 +39,12 @@ isDecimalDigit word =
39-- NUMBERS
39-- NUMBERS
40
40
41
41
42+data Number
43+ = Int Int
44+ | Float Double
45+
46+
42−number :: Parser L.Literal
47+number :: Parser Number
43number =
48number =
44 Parser $ \(State fp offset terminal indent row col ctx) cok cerr _ eerr ->
49 Parser $ \(State fp offset terminal indent row col ctx) cok cerr _ eerr ->
45 if offset >= terminal then
50 if offset >= terminal then
@@ -64,7 +69,7 @@ number =
64
69
65 OkInt newOffset n ->
70 OkInt newOffset n ->
66 let
71 let
67− !integer = L.IntNum n
72+ !integer = Int n
68 !newState = State fp newOffset terminal indent row (col + (newOffset - offset)) ctx
73 !newState = State fp newOffset terminal indent row (col + (newOffset - offset)) ctx
69 in
74 in
70 cok integer newState noError
75 cok integer newState noError
@@ -72,7 +77,7 @@ number =
72 OkFloat newOffset ->
77 OkFloat newOffset ->
73 let
78 let
74 !length = newOffset - offset
79 !length = newOffset - offset
75− !float = L.FloatNum $ read $ Char8.unpack $ B.PS fp offset length
80+ !float = Float $ read $ Char8.unpack $ B.PS fp offset length
76 !newState = State fp newOffset terminal indent row (col + length) ctx
81 !newState = State fp newOffset terminal indent row (col + length) ctx
77 in
82 in
78 cok float newState noError
83 cok float newState noError
src/Parse/Literal.hs → src/Parse/Shader.hsrenamed+24−35
@@ -1,5 +1,9 @@
1−{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
1+{-# OPTIONS_GHC -Wall #-}
2−module Parse.Literal (literal, shader) where
2+module Parse.Shader
3+ ( shader
4+ )
5+ where
6+
3
7
4import qualified Data.List as List
8import qualified Data.List as List
5import qualified Data.Map as Map
9import qualified Data.Map as Map
@@ -10,26 +14,11 @@ import qualified Text.Parsec as Parsec
10import qualified Text.Parsec.Error as Parsec
14import qualified Text.Parsec.Error as Parsec
11
15
12import qualified AST.Expression.Source as Src
16import qualified AST.Expression.Source as Src
13−import qualified AST.Literal as L
17+import qualified AST.Shader as Shader
14import qualified Reporting.Annotation as A
18import qualified Reporting.Annotation as A
15import qualified Reporting.Region as R
19import qualified Reporting.Region as R
16−import Parse.Primitives (Parser, getPosition, oneOf)
20+import Parse.Primitives (Parser, getPosition)
17−import qualified Parse.Primitives.Number as Number
18import qualified Parse.Primitives.Shader as Shader
21import qualified Parse.Primitives.Shader as Shader
19−import qualified Parse.Primitives.Utf8 as Utf8
20−
21−
22−
23−-- LITERALS
24−
25−
26−literal :: Parser L.Literal
27−literal =
28− oneOf
29− [ L.Str <$> Utf8.string
30− , L.Chr <$> Utf8.character
31− , Number.number
32− ]
33
22
34
23
35
24
@@ -42,10 +31,10 @@ shader start@(R.Position row col) =
42 shdr <- parseSource row col (Text.unpack src)
31 shdr <- parseSource row col (Text.unpack src)
43 end@(R.Position row2 col2) <- getPosition
32 end@(R.Position row2 col2) <- getPosition
44 let uid = List.intercalate ":" (map show [row, col, row2, col2])
33 let uid = List.intercalate ":" (map show [row, col, row2, col2])
45− return (A.at start end (Src.GLShader (Text.pack uid) src shdr))
34+ return (A.at start end (Src.Shader (Text.pack uid) src shdr))
46
35
47
36
48−parseSource :: Int -> Int -> String -> Parser L.Shader
37+parseSource :: Int -> Int -> String -> Parser Shader.Shader
49parseSource startRow startCol src =
38parseSource startRow startCol src =
50 case GLP.parse src of
39 case GLP.parse src of
51 Right (GLS.TranslationUnit decls) ->
40 Right (GLS.TranslationUnit decls) ->
@@ -71,27 +60,27 @@ parseSource startRow startCol src =
71 Shader.failure (startRow + row - 1) col (Text.pack msg)
60 Shader.failure (startRow + row - 1) col (Text.pack msg)
72
61
73
62
74−emptyShader :: L.Shader
63+emptyShader :: Shader.Shader
75emptyShader =
64emptyShader =
76− L.Shader Map.empty Map.empty Map.empty
65+ Shader.Shader Map.empty Map.empty Map.empty
77
66
78
67
79−addInput :: (GLS.StorageQualifier, L.GLType, Text.Text) -> L.Shader -> L.Shader
68+addInput :: (GLS.StorageQualifier, Shader.Type, Text.Text) -> Shader.Shader -> Shader.Shader
80addInput ( qual, tipe, name ) glDecls =
69addInput ( qual, tipe, name ) glDecls =
81 case qual of
70 case qual of
82 GLS.Attribute ->
71 GLS.Attribute ->
83− glDecls { L.attribute = Map.insert name tipe (L.attribute glDecls) }
72+ glDecls { Shader._attribute = Map.insert name tipe (Shader._attribute glDecls) }
84
73
85 GLS.Uniform ->
74 GLS.Uniform ->
86− glDecls { L.uniform = Map.insert name tipe (L.uniform glDecls) }
75+ glDecls { Shader._uniform = Map.insert name tipe (Shader._uniform glDecls) }
87
76
88 GLS.Varying ->
77 GLS.Varying ->
89− glDecls { L.varying = Map.insert name tipe (L.varying glDecls) }
78+ glDecls { Shader._varying = Map.insert name tipe (Shader._varying glDecls) }
90
79
91 _ -> error "Should never happen due to below filter"
80 _ -> error "Should never happen due to below filter"
92
81
93
82
94−extractInputs :: GLS.ExternalDeclaration -> [(GLS.StorageQualifier, L.GLType, Text.Text)]
83+extractInputs :: GLS.ExternalDeclaration -> [(GLS.StorageQualifier, Shader.Type, Text.Text)]
95extractInputs decl =
84extractInputs decl =
96 case decl of
85 case decl of
97 GLS.Declaration
86 GLS.Declaration
@@ -106,12 +95,12 @@ extractInputs decl =
106 False -> []
95 False -> []
107 True ->
96 True ->
108 case tipe of
97 case tipe of
109− GLS.Vec2 -> [(qual, L.V2, Text.pack name)]
98+ GLS.Vec2 -> [(qual, Shader.V2, Text.pack name)]
110− GLS.Vec3 -> [(qual, L.V3, Text.pack name)]
99+ GLS.Vec3 -> [(qual, Shader.V3, Text.pack name)]
111− GLS.Vec4 -> [(qual, L.V4, Text.pack name)]
100+ GLS.Vec4 -> [(qual, Shader.V4, Text.pack name)]
112− GLS.Mat4 -> [(qual, L.M4, Text.pack name)]
101+ GLS.Mat4 -> [(qual, Shader.M4, Text.pack name)]
113− GLS.Int -> [(qual, L.Int, Text.pack name)]
102+ GLS.Int -> [(qual, Shader.Int, Text.pack name)]
114− GLS.Float -> [(qual, L.Float, Text.pack name)]
103+ GLS.Float -> [(qual, Shader.Float, Text.pack name)]
115− GLS.Sampler2D -> [(qual, L.Texture, Text.pack name)]
104+ GLS.Sampler2D -> [(qual, Shader.Texture, Text.pack name)]
116 _ -> []
105 _ -> []
117 _ -> []
106 _ -> []