on master help sign in
Move the wildcard parser into Parse.Pattern
1709f1cEvan Czaplicki
compiler/src/Parse/Pattern.hs+25−3
@@ -1,5 +1,5 @@
1{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
1{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
2−{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE BangPatterns, UnboxedTuples, OverloadedStrings #-}
3module Parse.Pattern
3module Parse.Pattern
4 ( term
4 ( term
5 , expression
5 , expression
@@ -10,12 +10,12 @@ module Parse.Pattern
10import qualified Data.List as List
10import qualified Data.List as List
11import qualified Data.Name as Name
11import qualified Data.Name as Name
12import qualified Data.Utf8 as Utf8
12import qualified Data.Utf8 as Utf8
13+import Foreign.Ptr (plusPtr)
13
14
14import qualified AST.Source as Src
15import qualified AST.Source as Src
15import qualified Parse.Keyword as Keyword
16import qualified Parse.Keyword as Keyword
16import qualified Parse.Number as Number
17import qualified Parse.Number as Number
17import qualified Parse.Space as Space
18import qualified Parse.Space as Space
18−import qualified Parse.Symbol as Symbol
19import qualified Parse.Utf8 as Utf8
19import qualified Parse.Utf8 as Utf8
20import qualified Parse.Variable as Var
20import qualified Parse.Variable as Var
21import qualified Parse.Primitives as P
21import qualified Parse.Primitives as P
@@ -43,7 +43,7 @@ termHelp :: A.Position -> Parser E.Pattern Src.Pattern
43termHelp start =
43termHelp start =
44 oneOf E.PStart
44 oneOf E.PStart
45 [
45 [
46− do Symbol.wildcard
46+ do wildcard
47 addEnd start Src.PAnything
47 addEnd start Src.PAnything
48 ,
48 ,
49 do name <- Var.lower E.PStart
49 do name <- Var.lower E.PStart
@@ -79,6 +79,28 @@ termHelp start =
79
79
80
80
81
81
82+-- WILDCARD
83+
84+
85+wildcard :: Parser E.Pattern ()
86+wildcard =
87+ P.Parser $ \(P.State pos end indent row col) cok _ cerr eerr ->
88+ if pos == end || P.unsafeIndex pos /= 0x5F {- _ -} then
89+ eerr row col E.PStart
90+ else
91+ let
92+ !newPos = plusPtr pos 1
93+ !newCol = col + 1
94+ in
95+ if Var.getInnerWidth newPos end > 0 then
96+ let (# _, badCol #) = Var.chompInnerChars newPos end newCol in
97+ cerr row col (E.PWildcardNotVar (fromIntegral (badCol - col)))
98+ else
99+ let !newState = P.State newPos end indent row newCol in
100+ cok () newState
101+
102+
103+
82-- RECORDS
104-- RECORDS
83
105
84
106
compiler/src/Parse/Symbol.hs+17−32
@@ -1,8 +1,9 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2−{-# LANGUAGE BangPatterns, UnboxedTuples, OverloadedStrings #-}
2+{-# LANGUAGE BangPatterns, OverloadedStrings #-}
3module Parse.Symbol
3module Parse.Symbol
4− ( wildcard
5− , operator
4+ ( operator
5+ , BadOperator(..)
6+ , binopCharSet
6 )
7 )
7 where
8 where
8
9
@@ -15,38 +16,22 @@ import Foreign.Ptr (Ptr, plusPtr, minusPtr)
15import GHC.Word (Word8)
16import GHC.Word (Word8)
16
17
17import Parse.Primitives (Parser, Row, Col)
18import Parse.Primitives (Parser, Row, Col)
18−import qualified Parse.Variable as Var
19import qualified Parse.Primitives as P
19import qualified Parse.Primitives as P
20−import qualified Reporting.Error.Syntax as E
21
20
22
21
23
22
24−-- UNDERSCORE
23+-- OPERATOR
25−
26−
27−wildcard :: Parser E.Pattern ()
28−wildcard =
29− P.Parser $ \(P.State pos end indent row col) cok _ cerr eerr ->
30− if pos == end || P.unsafeIndex pos /= 0x5F {- _ -} then
31− eerr row col E.PStart
32− else
33− let
34− !newPos = plusPtr pos 1
35− !newCol = col + 1
36− in
37− if Var.getInnerWidth newPos end > 0 then
38− let (# _, badCol #) = Var.chompInnerChars newPos end newCol in
39− cerr row col (E.PWildcardNotVar (fromIntegral (badCol - col)))
40− else
41− let !newState = P.State newPos end indent row newCol in
42− cok () newState
43−
44
24
45
25
46−-- OPERATOR
26+data BadOperator
27+ = BadDot
28+ | BadPipe
29+ | BadArrow
30+ | BadEquals
31+ | BadHasType
47
32
48
33
49−operator :: (Row -> Col -> x) -> (E.Operator -> Row -> Col -> x) -> Parser x Name.Name
34+operator :: (Row -> Col -> x) -> (BadOperator -> Row -> Col -> x) -> Parser x Name.Name
50operator toExpectation toError =
35operator toExpectation toError =
51 P.Parser $ \(P.State pos end indent row col) cok _ cerr eerr ->
36 P.Parser $ \(P.State pos end indent row col) cok _ cerr eerr ->
52 let !newPos = chompOps pos end in
37 let !newPos = chompOps pos end in
@@ -55,11 +40,11 @@ operator toExpectation toError =
55
40
56 else
41 else
57 case Name.fromPtr pos newPos of
42 case Name.fromPtr pos newPos of
58− "." -> cerr row col (toError E.OpDot)
43+ "." -> cerr row col (toError BadDot)
59− "|" -> cerr row col (toError E.OpPipe)
44+ "|" -> cerr row col (toError BadPipe)
60− "->" -> cerr row col (toError E.OpArrow)
45+ "->" -> cerr row col (toError BadArrow)
61− "=" -> cerr row col (toError E.OpEquals)
46+ "=" -> cerr row col (toError BadEquals)
62− ":" -> cerr row col (toError E.OpHasType)
47+ ":" -> cerr row col (toError BadHasType)
63 op ->
48 op ->
64 let
49 let
65 !newCol = col + fromIntegral (minusPtr newPos pos)
50 !newCol = col + fromIntegral (minusPtr newPos pos)