02a7ce0 · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

No more Bool literals / add locations to more pattern vars

02a7ce0Evan Czaplicki9 years ago

src/AST/Literal.hs−10

compare with master

unifiedsplit

@@ -30,7 +30,6 @@ data Literal

30 | Str Text

31 | IntNum Int

32 | FloatNum Double

33− | Boolean Bool

34 deriving (Eq, Ord)

33 deriving (Eq, Ord)

@@ -41,7 +40,6 @@ toBuilder literal =

41 Str s -> fromText ("\"" <> s <> "\"")

40 Str s -> fromText ("\"" <> s <> "\"")

42 IntNum n -> decimal n

41 IntNum n -> decimal n

43 FloatNum n -> realFloat n

42 FloatNum n -> realFloat n

44− Boolean bool -> if bool then "True" else "False"

@@ -104,12 +102,6 @@ instance Binary Literal where

104 FloatNum n ->

102 FloatNum n ->

105 putWord8 3 >> put n

103 putWord8 3 >> put n

106

104

107− Boolean True ->

108− putWord8 4

109−

110− Boolean False ->

111− putWord8 5

112−

113 get =

105 get =

114 do word <- getWord8

106 do word <- getWord8

115 case word of

107 case word of

@@ -117,6 +109,4 @@ instance Binary Literal where

117 1 -> Str <$> get

109 1 -> Str <$> get

118 2 -> IntNum <$> get

110 2 -> IntNum <$> get

119 3 -> FloatNum <$> get

111 3 -> FloatNum <$> get

120− 4 -> pure $ Boolean True

121− 5 -> pure $ Boolean False

122 _ -> error "bad binary for AST.Literal"

112 _ -> error "bad binary for AST.Literal"

src/AST/Pattern.hs+14−72

@@ -5,20 +5,15 @@ module AST.Pattern

5 , Raw_(..)

6 , Canonical

7 , Canonical_(..)

8− , boundVars

9− , member

10− , boundVarSet

11− , boundVarList

12 )

8 )

13 where

9 where

16−import qualified Data.Set as Set

12+import qualified AST.Literal as Literal

17−import Data.Text (Text)

18−

19−import qualified AST.Literal as L

13+import qualified AST.Module.Name as ModuleName

20−import qualified AST.Variable as Var

14+import qualified Elm.Name as N

21import qualified Reporting.Annotation as A

15import qualified Reporting.Annotation as A

16+import qualified Reporting.Region as R

@@ -29,16 +24,16 @@ type Raw = A.Located Raw_

31data Raw_

26data Raw_

32− = RCtor (Maybe Text) Text [Raw]

27+ = RCtor R.Region (Maybe N.Name) N.Name [Raw]

33− | RRecord [Text]

28+ | RRecord [A.Located N.Name]

34 | RUnit

29 | RUnit

35 | RTuple Raw Raw [Raw]

30 | RTuple Raw Raw [Raw]

36 | RList [Raw]

31 | RList [Raw]

37 | RCons Raw Raw

32 | RCons Raw Raw

38− | RAlias Text Raw

33+ | RAlias Raw (A.Located N.Name)

39− | RVar Text

34+ | RVar N.Name

40 | RAnything

35 | RAnything

41− | RLiteral L.Literal

36+ | RLiteral Literal.Literal

@@ -49,64 +44,11 @@ type Canonical = A.Located Canonical_

51data Canonical_

46data Canonical_

52− = Ctor Var.Canonical [Canonical]

47+ = Ctor ModuleName.Canonical N.Name [Canonical]

53− | Record [Text]

48+ | Record [N.Name]

54 | Unit

49 | Unit

55 | Tuple Canonical Canonical [Canonical]

50 | Tuple Canonical Canonical [Canonical]

56− | Alias Text Canonical

51+ | Alias Canonical N.Name

57− | Var Text

52+ | Var N.Name

58 | Anything

53 | Anything

59− | Literal L.Literal

54+ | Literal Literal.Literal

60−

61−

62−

63−-- FIND VARIABLES

64−

65−

66−boundVars :: Raw -> [A.Located Text]

67−boundVars (A.A region pattern) =

68− case pattern of

69− RVar name ->

70− [ A.A region name ]

71−

72− RAlias name realPattern ->

73− A.A region name : boundVars realPattern

74−

75− RCtor _ _ patterns ->

76− concatMap boundVars patterns

77−

78− RRecord fields ->

79− map (A.A region) fields

80−

81− RUnit ->

82− []

83−

84− RTuple a b cs ->

85− concatMap boundVars (a:b:cs)

86−

87− RList xs ->

88− concatMap boundVars xs

89−

90− RCons a b ->

91− boundVars a ++ boundVars b

92−

93− RAnything ->

94− []

95−

96− RLiteral _ ->

97− []

98−

99−

100−member :: Text -> Raw -> Bool

101−member name pattern =

102− elem name (map A.drop (boundVars pattern))

103−

104−

105−boundVarSet :: Raw -> Set.Set Text

106−boundVarSet pattern =

107− Set.fromList (map A.drop (boundVars pattern))

108−

109−

110−boundVarList :: Raw -> [Text]

111−boundVarList pattern =

112− Set.toList (boundVarSet pattern)

src/Parse/Pattern.hs+31−30

@@ -8,12 +8,11 @@ module Parse.Pattern

10import qualified Data.List as List

11−import Data.Text (Text)

13−import qualified AST.Literal as L

14import qualified AST.Pattern as P

12import qualified AST.Pattern as P

13+import qualified Elm.Name as N

15import qualified Parse.Literal as Literal

14import qualified Parse.Literal as Literal

16−import Parse.Primitives (Parser, SParser, SPos, checkSpace, getPosition, hint, inContext, spaces, oneOf)

15+import Parse.Primitives (Parser, SParser, SPos, addLocation, checkSpace, getPosition, hint, inContext, spaces, oneOf)

17import qualified Parse.Primitives.Keyword as Keyword

16import qualified Parse.Primitives.Keyword as Keyword

18import qualified Parse.Primitives.Symbol as Symbol

17import qualified Parse.Primitives.Symbol as Symbol

19import qualified Parse.Primitives.Variable as Var

18import qualified Parse.Primitives.Variable as Var

@@ -41,28 +40,28 @@ term =

42termHelp :: R.Position -> Parser P.Raw

41termHelp :: R.Position -> Parser P.Raw

43termHelp start =

42termHelp start =

44− do pattern <-

45− oneOf

43+ oneOf

44+ [

46− [ Symbol.underscore >> return P.RAnything

45+ do Symbol.underscore

46+ end <- getPosition

47+ return (A.at start end P.RAnything)

48+ ,

47− , P.RVar <$> Var.lower

49+ do name <- Var.lower

50+ end <- getPosition

51+ return (A.at start end (P.RVar name))

52+ ,

48− , upperTerm <$> Var.foreignUpper

53+ do (maybePrefix, name) <- Var.foreignUpper

49− , P.RLiteral <$> Literal.literal

54+ end <- getPosition

50− ]

55+ let ctor = P.RCtor (R.Region start end) maybePrefix name []

51− end <- getPosition

52− return (A.at start end pattern)

56+ return (A.at start end ctor)

53−

55−upperTerm :: (Maybe Text, Text) -> P.Raw_

58+ ,

56−upperTerm pair =

59+ do lit <- Literal.literal

57− case pair of

60+ end <- getPosition

58− (Nothing, "True") ->

61+ return (A.at start end (P.RLiteral lit))

59− P.RLiteral (L.Boolean True)

62+ ]

61− (Nothing, "False") ->

62− P.RLiteral (L.Boolean False)

64− (maybePrefix, name) ->

65− P.RCtor maybePrefix name []

@@ -75,7 +74,7 @@ record start =

75 inContext start E.ExprRecord $

74 inContext start E.ExprRecord $

76 do spaces

75 do spaces

77 oneOf

76 oneOf

78− [ do var <- Var.lower

77+ [ do var <- addLocation Var.lower

79 spaces

78 spaces

80 recordHelp start [var]

79 recordHelp start [var]

81 , do Symbol.rightCurly

80 , do Symbol.rightCurly

@@ -84,12 +83,12 @@ record start =

84 ]

83 ]

87−recordHelp :: R.Position -> [Text] -> Parser P.Raw

86+recordHelp :: R.Position -> [A.Located N.Name] -> Parser P.Raw

88recordHelp start vars =

87recordHelp start vars =

89 oneOf

88 oneOf

90 [ do Symbol.comma

89 [ do Symbol.comma

91 spaces

90 spaces

92− var <- Var.lower

91+ var <- addLocation Var.lower

93 spaces

92 spaces

94 recordHelp start (var:vars)

93 recordHelp start (var:vars)

95 , do Symbol.rightCurly

94 , do Symbol.rightCurly

@@ -192,11 +191,13 @@ exprHelp start patterns (pattern, _end, sPos) =

192 , do checkSpace sPos

191 , do checkSpace sPos

193 Keyword.as_

192 Keyword.as_

194 spaces

193 spaces

194+ nameStart <- getPosition

195− alias <- Var.lower

195+ name <- Var.lower

196 newEnd <- getPosition

197 newSpace <- whitespace

198+ let alias = A.at nameStart newEnd name

198 return

199 return

199− ( A.at start newEnd (P.RAlias alias (List.foldl' cons pattern patterns))

200+ ( A.at start newEnd (P.RAlias (List.foldl' cons pattern patterns) alias)

200 , newSpace

201 , newSpace

201 )

202 )

202 , return

203 , return

@@ -226,8 +227,8 @@ exprTerm =

226 ]

227 ]

227

228

229

229−exprTermHelp :: R.Position -> (Maybe Text, Text) -> [P.Raw] -> SParser P.Raw

230+exprTermHelp :: R.Position -> (Maybe N.Name, N.Name) -> [P.Raw] -> SParser P.Raw

230−exprTermHelp start pair@(prefix, name) args =

231+exprTermHelp start pair@(maybePrefix, name) args =

231 do end <- getPosition

232 do end <- getPosition

232 sPos <- whitespace

233 sPos <- whitespace

233 oneOf

234 oneOf

@@ -235,7 +236,7 @@ exprTermHelp start pair@(prefix, name) args =

235 arg <- term

236 arg <- term

236 exprTermHelp start pair (arg:args)

237 exprTermHelp start pair (arg:args)

237 , return

238 , return

238− ( A.at start end (P.RCtor prefix name (reverse args))

239+ ( A.at start end (P.RCtor (R.Region start end) maybePrefix name (reverse args))

239 , end

240 , end

240 , sPos

241 , sPos

241 )

242 )