on master help sign in
Keep finer distinctions between variables in the AST
50a6265Evan Czaplicki
src/AST/Source.hs+10−4
@@ -1,6 +1,6 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2module AST.Source
2module AST.Source
3− ( Expr, Expr_(..)
3+ ( Expr, Expr_(..), VarType(..)
4 , Decl, Decl_(..)
4 , Decl, Decl_(..)
5 , Def(..)
5 , Def(..)
6 , Pattern, Pattern_(..)
6 , Pattern, Pattern_(..)
@@ -39,7 +39,8 @@ data Expr_
39 | Str Text
39 | Str Text
40 | Int Int
40 | Int Int
41 | Float Double
41 | Float Double
42− | Var (Maybe N.Name) N.Name
42+ | Var VarType N.Name
43+ | VarQual VarType N.Name N.Name
43 | List [Expr]
44 | List [Expr]
44 | Op N.Name
45 | Op N.Name
45 | Negate Expr
46 | Negate Expr
@@ -58,6 +59,9 @@ data Expr_
58 | Shader Text Text Shader.Shader
59 | Shader Text Text Shader.Shader
59
60
60
61
62+data VarType = Value | Ctor
63+
64+
61
65
62-- DEFINITIONS
66-- DEFINITIONS
63
67
@@ -82,7 +86,8 @@ data Pattern_
82 | PAlias Pattern (A.Located N.Name)
86 | PAlias Pattern (A.Located N.Name)
83 | PUnit
87 | PUnit
84 | PTuple Pattern Pattern [Pattern]
88 | PTuple Pattern Pattern [Pattern]
89+ | PCtor R.Region N.Name [Pattern]
85− | PCtor R.Region (Maybe N.Name) N.Name [Pattern]
90+ | PCtorQual R.Region N.Name N.Name [Pattern]
86 | PList [Pattern]
91 | PList [Pattern]
87 | PCons Pattern Pattern
92 | PCons Pattern Pattern
88 | PChr Text
93 | PChr Text
@@ -101,7 +106,8 @@ type Type =
101data Type_
106data Type_
102 = TLambda Type Type
107 = TLambda Type Type
103 | TVar N.Name
108 | TVar N.Name
104− | TType R.Region (Maybe N.Name) N.Name [Type]
109+ | TType R.Region N.Name [Type]
110+ | TTypeQual R.Region N.Name N.Name [Type]
105 | TRecord [(A.Located N.Name, Type)] (Maybe Type)
111 | TRecord [(A.Located N.Name, Type)] (Maybe Type)
106 | TUnit
112 | TUnit
107 | TTuple Type Type [Type]
113 | TTuple Type Type [Type]
src/Parse/Expression.hs+2−2
@@ -83,9 +83,9 @@ accessor start =
83
83
84variable :: R.Position -> Parser Src.Expr
84variable :: R.Position -> Parser Src.Expr
85variable start =
85variable start =
86− do (maybePrefix, name) <- Var.foreignAlpha
86+ do var <- Var.foreignAlpha
87 end <- getPosition
87 end <- getPosition
88− return (A.at start end (Src.Var maybePrefix name))
88+ return (A.at start end var)
89
89
90
90
91accessible :: R.Position -> Src.Expr -> Parser Src.Expr
91accessible :: R.Position -> Src.Expr -> Parser Src.Expr
src/Parse/Pattern.hs+22−9
@@ -51,10 +51,16 @@ termHelp start =
51 end <- getPosition
51 end <- getPosition
52 return (A.at start end (Src.PVar name))
52 return (A.at start end (Src.PVar name))
53 ,
53 ,
54− do (maybePrefix, name) <- Var.foreignUpper
54+ do upper <- Var.foreignUpper
55 end <- getPosition
55 end <- getPosition
56− let ctor = Src.PCtor (R.Region start end) maybePrefix name []
56+ let region = R.Region start end
57− return (A.at start end ctor)
57+ return $ A.at start end $
58+ case upper of
59+ Var.Unqualified name ->
60+ Src.PCtor region name []
61+
62+ Var.Qualified home name ->
63+ Src.PCtorQual region home name []
58 ,
64 ,
59 do number <- Number.number
65 do number <- Number.number
60 end <- getPosition
66 end <- getPosition
@@ -234,8 +240,9 @@ exprTerm =
234 oneOf
240 oneOf
235 [
241 [
236 do start <- getPosition
242 do start <- getPosition
237− pair <- Var.foreignUpper
243+ upper <- Var.foreignUpper
244+ end <- getPosition
238− exprTermHelp start pair []
245+ exprTermHelp (R.Region start end) upper start []
239 ,
246 ,
240 do t@(A.At (R.Region _ end) _) <- term
247 do t@(A.At (R.Region _ end) _) <- term
241 pos <- whitespace
248 pos <- whitespace
@@ -243,16 +250,22 @@ exprTerm =
243 ]
250 ]
244
251
245
252
246−exprTermHelp :: R.Position -> (Maybe N.Name, N.Name) -> [Src.Pattern] -> SParser Src.Pattern
253+exprTermHelp :: R.Region -> Var.Upper -> R.Position -> [Src.Pattern] -> SParser Src.Pattern
247−exprTermHelp start pair@(maybePrefix, name) args =
254+exprTermHelp region upper start revArgs =
248 do end <- getPosition
255 do end <- getPosition
249 sPos <- whitespace
256 sPos <- whitespace
250 oneOf
257 oneOf
251 [ do checkSpace sPos
258 [ do checkSpace sPos
252 arg <- term
259 arg <- term
253− exprTermHelp start pair (arg:args)
260+ exprTermHelp region upper start (arg:revArgs)
254 , return
261 , return
255− ( A.at start end (Src.PCtor (R.Region start end) maybePrefix name (reverse args))
262+ ( A.at start end $
263+ case upper of
264+ Var.Unqualified name ->
265+ Src.PCtor region name (reverse revArgs)
266+
267+ Var.Qualified home name ->
268+ Src.PCtorQual region home name (reverse revArgs)
256 , end
269 , end
257 , sPos
270 , sPos
258 )
271 )
src/Parse/Primitives/Variable.hs+30−24
@@ -4,6 +4,7 @@ module Parse.Primitives.Variable
4 ( lower
4 ( lower
5 , upper
5 , upper
6 , moduleName
6 , moduleName
7+ , Upper(..)
7 , foreignUpper
8 , foreignUpper
8 , foreignAlpha
9 , foreignAlpha
9 , chompInnerChars
10 , chompInnerChars
@@ -15,14 +16,14 @@ module Parse.Primitives.Variable
15
16
16import Control.Exception (assert)
17import Control.Exception (assert)
17import Data.Bits ((.&.), (.|.), shiftL)
18import Data.Bits ((.&.), (.|.), shiftL)
18−import qualified Data.ByteString.Internal as B
19import qualified Data.Char as Char
19import qualified Data.Char as Char
20import qualified Data.Set as Set
20import qualified Data.Set as Set
21import Data.Text (Text)
21import Data.Text (Text)
22−import qualified Data.Text.Encoding as Text
23import Foreign.ForeignPtr (ForeignPtr)
22import Foreign.ForeignPtr (ForeignPtr)
24import GHC.Word (Word8)
23import GHC.Word (Word8)
25
24
25+import qualified AST.Source as Src
26+import qualified Elm.Name as N
26import Parse.Primitives.Internals (Parser(..), State(..), expect, noError, unsafeIndex)
27import Parse.Primitives.Internals (Parser(..), State(..), expect, noError, unsafeIndex)
27import qualified Reporting.Error.Syntax as E
28import qualified Reporting.Error.Syntax as E
28
29
@@ -38,8 +39,8 @@ upper =
38 if offset == newOffset then
39 if offset == newOffset then
39 eerr (expect row col ctx E.CapVar)
40 eerr (expect row col ctx E.CapVar)
40 else
41 else
41− let !variable = Text.decodeUtf8 (B.PS fp offset (newOffset - offset)) in
42+ let !name = N.fromForeignPtr fp offset (newOffset - offset) in
42− cok variable (State fp newOffset terminal indent row newCol ctx) noError
43+ cok name (State fp newOffset terminal indent row newCol ctx) noError
43
44
44
45
45
46
@@ -53,11 +54,11 @@ lower =
53 if offset == newOffset then
54 if offset == newOffset then
54 eerr (expect row col ctx E.LowVar)
55 eerr (expect row col ctx E.LowVar)
55 else
56 else
56− let !variable = Text.decodeUtf8 (B.PS fp offset (newOffset - offset)) in
57+ let !name = N.fromForeignPtr fp offset (newOffset - offset) in
57− if Set.member variable reservedWords then
58+ if Set.member name reservedWords then
58 eerr (expect row col ctx E.LowVar)
59 eerr (expect row col ctx E.LowVar)
59 else
60 else
60− cok variable (State fp newOffset terminal indent row newCol ctx) noError
61+ cok name (State fp newOffset terminal indent row newCol ctx) noError
61
62
62
63
63{-# NOINLINE reservedWords #-}
64{-# NOINLINE reservedWords #-}
@@ -89,7 +90,7 @@ moduleName =
89
90
90 Good end endCol ->
91 Good end endCol ->
91 let
92 let
92− !name = Text.decodeUtf8 (B.PS fp offset (end - offset))
93+ !name = N.fromForeignPtr fp offset (end - offset)
93 !newState = State fp end terminal indent row endCol ctx
94 !newState = State fp end terminal indent row endCol ctx
94 in
95 in
95 cok name newState noError
96 cok name newState noError
@@ -118,7 +119,12 @@ moduleNameHelp fp offset terminal col =
118-- FOREIGN UPPER
119-- FOREIGN UPPER
119
120
120
121
122+data Upper
123+ = Unqualified N.Name
124+ | Qualified N.Name N.Name
125+
126+
121−foreignUpper :: Parser (Maybe Text, Text)
127+foreignUpper :: Parser Upper
122foreignUpper =
128foreignUpper =
123 Parser $ \(State fp offset terminal indent row col ctx) cok _ _ eerr ->
129 Parser $ \(State fp offset terminal indent row col ctx) cok _ _ eerr ->
124 let (# start, end, newCol #) = foreignUpperHelp fp offset terminal col in
130 let (# start, end, newCol #) = foreignUpperHelp fp offset terminal col in
@@ -127,13 +133,13 @@ foreignUpper =
127 else
133 else
128 let
134 let
129 !newState = State fp end terminal indent row newCol ctx
135 !newState = State fp end terminal indent row newCol ctx
130− !variable = Text.decodeUtf8 (B.PS fp start (end - start))
136+ !name = N.fromForeignPtr fp start (end - start)
131 !foreign =
137 !foreign =
132 if start == offset then
138 if start == offset then
133− (Nothing, variable)
139+ Unqualified name
134 else
140 else
135− let !home = Text.decodeUtf8 (B.PS fp offset ((start - 1) - offset)) in
141+ let !home = N.fromForeignPtr fp offset ((start - 1) - offset) in
136− (Just home, variable)
142+ Qualified home name
137 in
143 in
138 cok foreign newState noError
144 cok foreign newState noError
139
145
@@ -157,47 +163,47 @@ foreignUpperHelp fp offset terminal col =
157-- FOREIGN ALPHA
163-- FOREIGN ALPHA
158
164
159
165
160−foreignAlpha :: Parser (Maybe Text, Text)
166+foreignAlpha :: Parser Src.Expr_
161foreignAlpha =
167foreignAlpha =
162 Parser $ \(State fp offset terminal indent row col ctx) cok _ _ eerr ->
168 Parser $ \(State fp offset terminal indent row col ctx) cok _ _ eerr ->
163− let (# start, end, newCol #) = foreignAlphaHelp fp offset terminal col in
169+ let (# start, end, newCol, varType #) = foreignAlphaHelp fp offset terminal col in
164 if start == end then
170 if start == end then
165 eerr (E.ParseError row newCol (E.Theories ctx [E.LowVar, E.CapVar]))
171 eerr (E.ParseError row newCol (E.Theories ctx [E.LowVar, E.CapVar]))
166 else
172 else
167 let
173 let
168 !newState = State fp end terminal indent row newCol ctx
174 !newState = State fp end terminal indent row newCol ctx
169− !variable = Text.decodeUtf8 (B.PS fp start (end - start))
175+ !name = N.fromForeignPtr fp start (end - start)
170 in
176 in
171 if start == offset then
177 if start == offset then
172− if Set.member variable reservedWords then
178+ if Set.member name reservedWords then
173 eerr noError
179 eerr noError
174 else
180 else
175− cok (Nothing, variable) newState noError
181+ cok (Src.Var varType name) newState noError
176 else
182 else
177− let !home = Text.decodeUtf8 (B.PS fp offset ((start - 1) - offset)) in
183+ let !home = N.fromForeignPtr fp offset ((start - 1) - offset) in
178− cok (Just home, variable) newState noError
184+ cok (Src.VarQual varType home name) newState noError
179
185
180
186
181−foreignAlphaHelp :: ForeignPtr Word8 -> Int -> Int -> Int -> (# Int, Int, Int #)
187+foreignAlphaHelp :: ForeignPtr Word8 -> Int -> Int -> Int -> (# Int, Int, Int, Src.VarType #)
182foreignAlphaHelp fp offset terminal col =
188foreignAlphaHelp fp offset terminal col =
183 let
189 let
184 (# lowerOffset, lowerCol #) = chompLower fp offset terminal col
190 (# lowerOffset, lowerCol #) = chompLower fp offset terminal col
185 in
191 in
186 if offset < lowerOffset then
192 if offset < lowerOffset then
187− (# offset, lowerOffset, lowerCol #)
193+ (# offset, lowerOffset, lowerCol, Src.Value #)
188
194
189 else
195 else
190 let
196 let
191 (# upperOffset, upperCol #) = chompUpper fp offset terminal col
197 (# upperOffset, upperCol #) = chompUpper fp offset terminal col
192 in
198 in
193 if offset == upperOffset then
199 if offset == upperOffset then
194− (# offset, offset, col #)
200+ (# offset, offset, col, Src.Ctor #)
195
201
196 else if isDot fp upperOffset terminal then
202 else if isDot fp upperOffset terminal then
197 foreignAlphaHelp fp (upperOffset + 1) terminal (upperCol + 1)
203 foreignAlphaHelp fp (upperOffset + 1) terminal (upperCol + 1)
198
204
199 else
205 else
200− (# offset, upperOffset, upperCol #)
206+ (# offset, upperOffset, upperCol, Src.Ctor #)
201
207
202
208
203
209
src/Parse/Type.hs+20−5
@@ -74,19 +74,34 @@ expression =
74app0 :: Parser Src.Type
74app0 :: Parser Src.Type
75app0 =
75app0 =
76 do start <- getPosition
76 do start <- getPosition
77− (maybeQualifier, name) <- Var.foreignUpper
77+ upper <- Var.foreignUpper
78 end <- getPosition
78 end <- getPosition
79+ let region = R.Region start end
79− return $ A.at start end $
80+ return $ A.At region $
80− Src.TType (R.Region start end) maybeQualifier name []
81+ case upper of
82+ Var.Unqualified name ->
83+ Src.TType region name []
84+
85+ Var.Qualified home name ->
86+ Src.TTypeQual region home name []
81
87
82
88
83app :: R.Position -> SParser Src.Type
89app :: R.Position -> SParser Src.Type
84app start =
90app start =
85− do (maybeQualifier, name) <- Var.foreignUpper
91+ do upper <- Var.foreignUpper
86 nameEnd <- getPosition
92 nameEnd <- getPosition
87 namePos <- whitespace
93 namePos <- whitespace
88 (args, end, pos) <- eatArgs [] nameEnd namePos
94 (args, end, pos) <- eatArgs [] nameEnd namePos
95+
89− let tipe = Src.TType (R.Region start nameEnd) maybeQualifier name args
96+ let region = R.Region start nameEnd
97+ let tipe =
98+ case upper of
99+ Var.Unqualified name ->
100+ Src.TType region name args
101+
102+ Var.Qualified home name ->
103+ Src.TTypeQual region home name args
104+
90 return ( A.at start end tipe, end, pos )
105 return ( A.at start end tipe, end, pos )
91
106
92
107