50a6265 · elk · git.iko.soy

git.iko.soy/elk

Keep finer distinctions between variables in the AST

Track qualified and unqualified variables as separate AST nodes, and mark whether the names are uppercase or lowercase (i.e. constructors or normal values) This avoids a couple allocations in parsing and makes the AST a bit easier to deal with during canonicalization.

commit50a626598203075c9df0445d6cfcf4a254932bc7 authorEvan Czaplicki <evancz@users.noreply.github.com> dateWed 10 Jan 2018, 01:55 (9 years ago) parent1e6121a

5 files changed+84−44

compare with master

unifiedsplit

src/AST/Source.hs+10−4 src/Parse/Expression.hs+2−2 src/Parse/Pattern.hs+22−9 src/Parse/Primitives/Variable.hs+30−24 src/Parse/Type.hs+20−5

src/AST/Source.hs+10−4

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

11{-# OPTIONS_GHC -Wall #-}

22module AST.Source

3− ( Expr, Expr_(..)

3+ ( Expr, Expr_(..), VarType(..)

44 , Decl, Decl_(..)

55 , Def(..)

66 , Pattern, Pattern_(..)

@@ -39,7 +39,8 @@ data Expr_

3939 | Str Text

4040 | Int Int

4141 | Float Double

42− | Var (Maybe N.Name) N.Name

42+ | Var VarType N.Name

43+ | VarQual VarType N.Name N.Name

4344 | List [Expr]

4445 | Op N.Name

4546 | Negate Expr

@@ -58,6 +59,9 @@ data Expr_

5859 | Shader Text Text Shader.Shader

5960

6061

62+data VarType = Value | Ctor

63+

64+

6165

6266-- DEFINITIONS

6367

@@ -82,7 +86,8 @@ data Pattern_

8286 | PAlias Pattern (A.Located N.Name)

8387 | PUnit

8488 | PTuple Pattern Pattern [Pattern]

85− | PCtor R.Region (Maybe N.Name) N.Name [Pattern]

89+ | PCtor R.Region N.Name [Pattern]

90+ | PCtorQual R.Region N.Name N.Name [Pattern]

8691 | PList [Pattern]

8792 | PCons Pattern Pattern

8893 | PChr Text

@@ -101,7 +106,8 @@ type Type =

101106data Type_

102107 = TLambda Type Type

103108 | 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]

105111 | TRecord [(A.Located N.Name, Type)] (Maybe Type)

106112 | TUnit

107113 | TTuple Type Type [Type]

src/Parse/Expression.hs+2−2

@@ -83,9 +83,9 @@ accessor start =

8383

8484variable :: R.Position -> Parser Src.Expr

8585variable start =

86− do (maybePrefix, name) <- Var.foreignAlpha

86+ do var <- Var.foreignAlpha

8787 end <- getPosition

88− return (A.at start end (Src.Var maybePrefix name))

88+ return (A.at start end var)

8989

9090

9191accessible :: R.Position -> Src.Expr -> Parser Src.Expr

src/Parse/Pattern.hs+22−9

@@ -51,10 +51,16 @@ termHelp start =

5151 end <- getPosition

5252 return (A.at start end (Src.PVar name))

5353 ,

54− do (maybePrefix, name) <- Var.foreignUpper

54+ do upper <- Var.foreignUpper

5555 end <- getPosition

56− let ctor = Src.PCtor (R.Region start end) maybePrefix name []

57− return (A.at start end ctor)

56+ let region = R.Region start end

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 []

5864 ,

5965 do number <- Number.number

6066 end <- getPosition

@@ -234,8 +240,9 @@ exprTerm =

234240 oneOf

235241 [

236242 do start <- getPosition

237− pair <- Var.foreignUpper

238− exprTermHelp start pair []

243+ upper <- Var.foreignUpper

244+ end <- getPosition

245+ exprTermHelp (R.Region start end) upper start []

239246 ,

240247 do t@(A.At (R.Region _ end) _) <- term

241248 pos <- whitespace

@@ -243,16 +250,22 @@ exprTerm =

243250 ]

244251

245252

246−exprTermHelp :: R.Position -> (Maybe N.Name, N.Name) -> [Src.Pattern] -> SParser Src.Pattern

247−exprTermHelp start pair@(maybePrefix, name) args =

253+exprTermHelp :: R.Region -> Var.Upper -> R.Position -> [Src.Pattern] -> SParser Src.Pattern

254+exprTermHelp region upper start revArgs =

248255 do end <- getPosition

249256 sPos <- whitespace

250257 oneOf

251258 [ do checkSpace sPos

252259 arg <- term

253− exprTermHelp start pair (arg:args)

260+ exprTermHelp region upper start (arg:revArgs)

254261 , 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)

256269 , end

257270 , sPos

258271 )

src/Parse/Primitives/Variable.hs+30−24

@@ -4,6 +4,7 @@ module Parse.Primitives.Variable

44 ( lower

55 , upper

66 , moduleName

7+ , Upper(..)

78 , foreignUpper

89 , foreignAlpha

910 , chompInnerChars

@@ -15,14 +16,14 @@ module Parse.Primitives.Variable

1516

1617import Control.Exception (assert)

1718import Data.Bits ((.&.), (.|.), shiftL)

18−import qualified Data.ByteString.Internal as B

1919import qualified Data.Char as Char

2020import qualified Data.Set as Set

2121import Data.Text (Text)

22−import qualified Data.Text.Encoding as Text

2322import Foreign.ForeignPtr (ForeignPtr)

2423import GHC.Word (Word8)

2524

25+import qualified AST.Source as Src

26+import qualified Elm.Name as N

2627import Parse.Primitives.Internals (Parser(..), State(..), expect, noError, unsafeIndex)

2728import qualified Reporting.Error.Syntax as E

2829

@@ -38,8 +39,8 @@ upper =

3839 if offset == newOffset then

3940 eerr (expect row col ctx E.CapVar)

4041 else

41− let !variable = Text.decodeUtf8 (B.PS fp offset (newOffset - offset)) in

42− cok variable (State fp newOffset terminal indent row newCol ctx) noError

42+ let !name = N.fromForeignPtr fp offset (newOffset - offset) in

43+ cok name (State fp newOffset terminal indent row newCol ctx) noError

4344

4445

4546

@@ -53,11 +54,11 @@ lower =

5354 if offset == newOffset then

5455 eerr (expect row col ctx E.LowVar)

5556 else

56− let !variable = Text.decodeUtf8 (B.PS fp offset (newOffset - offset)) in

57− if Set.member variable reservedWords then

57+ let !name = N.fromForeignPtr fp offset (newOffset - offset) in

58+ if Set.member name reservedWords then

5859 eerr (expect row col ctx E.LowVar)

5960 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

6162

6263

6364{-# NOINLINE reservedWords #-}

@@ -89,7 +90,7 @@ moduleName =

8990

9091 Good end endCol ->

9192 let

92− !name = Text.decodeUtf8 (B.PS fp offset (end - offset))

93+ !name = N.fromForeignPtr fp offset (end - offset)

9394 !newState = State fp end terminal indent row endCol ctx

9495 in

9596 cok name newState noError

@@ -118,7 +119,12 @@ moduleNameHelp fp offset terminal col =

118119-- FOREIGN UPPER

119120

120121

121−foreignUpper :: Parser (Maybe Text, Text)

122+data Upper

123+ = Unqualified N.Name

124+ | Qualified N.Name N.Name

125+

126+

127+foreignUpper :: Parser Upper

122128foreignUpper =

123129 Parser $ \(State fp offset terminal indent row col ctx) cok _ _ eerr ->

124130 let (# start, end, newCol #) = foreignUpperHelp fp offset terminal col in

@@ -127,13 +133,13 @@ foreignUpper =

127133 else

128134 let

129135 !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)

131137 !foreign =

132138 if start == offset then

133− (Nothing, variable)

139+ Unqualified name

134140 else

135− let !home = Text.decodeUtf8 (B.PS fp offset ((start - 1) - offset)) in

136− (Just home, variable)

141+ let !home = N.fromForeignPtr fp offset ((start - 1) - offset) in

142+ Qualified home name

137143 in

138144 cok foreign newState noError

139145

@@ -157,47 +163,47 @@ foreignUpperHelp fp offset terminal col =

157163-- FOREIGN ALPHA

158164

159165

160−foreignAlpha :: Parser (Maybe Text, Text)

166+foreignAlpha :: Parser Src.Expr_

161167foreignAlpha =

162168 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

164170 if start == end then

165171 eerr (E.ParseError row newCol (E.Theories ctx [E.LowVar, E.CapVar]))

166172 else

167173 let

168174 !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)

170176 in

171177 if start == offset then

172− if Set.member variable reservedWords then

178+ if Set.member name reservedWords then

173179 eerr noError

174180 else

175− cok (Nothing, variable) newState noError

181+ cok (Src.Var varType name) newState noError

176182 else

177− let !home = Text.decodeUtf8 (B.PS fp offset ((start - 1) - offset)) in

178− cok (Just home, variable) newState noError

183+ let !home = N.fromForeignPtr fp offset ((start - 1) - offset) in

184+ cok (Src.VarQual varType home name) newState noError

179185

180186

181−foreignAlphaHelp :: ForeignPtr Word8 -> Int -> Int -> Int -> (# Int, Int, Int #)

187+foreignAlphaHelp :: ForeignPtr Word8 -> Int -> Int -> Int -> (# Int, Int, Int, Src.VarType #)

182188foreignAlphaHelp fp offset terminal col =

183189 let

184190 (# lowerOffset, lowerCol #) = chompLower fp offset terminal col

185191 in

186192 if offset < lowerOffset then

187− (# offset, lowerOffset, lowerCol #)

193+ (# offset, lowerOffset, lowerCol, Src.Value #)

188194

189195 else

190196 let

191197 (# upperOffset, upperCol #) = chompUpper fp offset terminal col

192198 in

193199 if offset == upperOffset then

194− (# offset, offset, col #)

200+ (# offset, offset, col, Src.Ctor #)

195201

196202 else if isDot fp upperOffset terminal then

197203 foreignAlphaHelp fp (upperOffset + 1) terminal (upperCol + 1)

198204

199205 else

200− (# offset, upperOffset, upperCol #)

206+ (# offset, upperOffset, upperCol, Src.Ctor #)

201207

202208

203209

src/Parse/Type.hs+20−5

@@ -74,19 +74,34 @@ expression =

7474app0 :: Parser Src.Type

7575app0 =

7676 do start <- getPosition

77− (maybeQualifier, name) <- Var.foreignUpper

77+ upper <- Var.foreignUpper

7878 end <- getPosition

79− return $ A.at start end $

80− Src.TType (R.Region start end) maybeQualifier name []

79+ let region = R.Region start end

80+ return $ A.At region $

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 []

8187

8288

8389app :: R.Position -> SParser Src.Type

8490app start =

85− do (maybeQualifier, name) <- Var.foreignUpper

91+ do upper <- Var.foreignUpper

8692 nameEnd <- getPosition

8793 namePos <- whitespace

8894 (args, end, pos) <- eatArgs [] nameEnd namePos

89− let tipe = Src.TType (R.Region start nameEnd) maybeQualifier name args

95+

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+

90105 return ( A.at start end tipe, end, pos )

91106

92107