git.iko.soy/elk
on master help sign in
Move Parse.Utils to Parse.Space

Making its contents more obvious

commit7410fc9fefe294d519e8b3510b8e88105e5a513e authorEvan Czaplicki <evancz@users.noreply.github.com> dateThu 25 Apr 2019, 16:35 (8 years ago) parentcb2368f
2 files changed+268−259
compare with master
unifiedsplit
compiler/src/Parse/Space.hs+268 compiler/src/Parse/Utils.hs−259
compiler/src/Parse/Space.hsnew file+268
@@ -0,0 +1,268 @@
1+{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
2+{-# LANGUAGE BangPatterns, UnboxedTuples, OverloadedStrings #-}
3+module Parse.Space
4+ ( Parser
5+ --
6+ , chomp
7+ , chompAndCheckIndent
8+ --
9+ , checkIndent
10+ , checkAligned
11+ , checkFreshLine
12+ --
13+ , docComment
14+ )
15+ where
16+
17+
18+import Data.Word (Word8, Word16)
19+import Foreign.Ptr (Ptr, plusPtr)
20+
21+import Parse.Primitives (Row, Col)
22+import qualified Parse.Primitives as P
23+import qualified Reporting.Annotation as A
24+import qualified Reporting.Error.Syntax as E
25+
26+
27+
28+-- SPACE PARSING
29+
30+
31+type Parser x a =
32+ P.Parser x (a, A.Position)
33+
34+
35+
36+-- CHOMP
37+
38+
39+chomp :: (E.Space -> Row -> Col -> x) -> P.Parser x ()
40+chomp toError =
41+ P.Parser $ \(P.State pos end indent row col) cok _ cerr _ ->
42+ let
43+ (# status, newPos, newRow, newCol #) = eatSpaces pos end row col
44+ in
45+ case status of
46+ Good ->
47+ let
48+ !newState = P.State newPos end indent newRow newCol
49+ in
50+ cok () newState
51+
52+ HasTab -> cerr newRow newCol (toError E.HasTab)
53+ EndlessMultiComment -> cerr newRow newCol (toError E.EndlessMultiComment)
54+ UnexpectedDocComment -> cerr newRow newCol (toError E.UnexpectedDocComment)
55+
56+
57+
58+-- CHECKS -- to be called right after a `chomp`
59+
60+
61+checkIndent :: A.Position -> (Row -> Col -> x) -> P.Parser x ()
62+checkIndent (A.Position endRow endCol) toError =
63+ P.Parser $ \state@(P.State _ _ indent _ col) _ eok _ eerr ->
64+ if col > indent && col > 1
65+ then eok () state
66+ else eerr endRow endCol toError
67+
68+
69+checkAligned :: (Word16 -> Row -> Col -> x) -> P.Parser x ()
70+checkAligned toError =
71+ P.Parser $ \state@(P.State _ _ indent row col) _ eok _ eerr ->
72+ if col == indent
73+ then eok () state
74+ else eerr row col (toError indent)
75+
76+
77+checkFreshLine :: (Row -> Col -> x) -> P.Parser x ()
78+checkFreshLine toError =
79+ P.Parser $ \state@(P.State _ _ _ row col) _ eok _ eerr ->
80+ if col == 1
81+ then eok () state
82+ else eerr row col toError
83+
84+
85+
86+-- CHOMP AND CHECK
87+
88+
89+chompAndCheckIndent :: (E.Space -> Row -> Col -> x) -> (Row -> Col -> x) -> P.Parser x ()
90+chompAndCheckIndent toWhitespaceError toIndentError =
91+ P.Parser $ \(P.State pos end indent row col) cok _ cerr _ ->
92+ let
93+ (# status, newPos, newRow, newCol #) = eatSpaces pos end row col
94+ in
95+ case status of
96+ Good ->
97+ if newCol > indent && newCol > 1
98+ then
99+
100+ let
101+ !newState = P.State newPos end indent newRow newCol
102+ in
103+ cok () newState
104+
105+ else
106+ cerr row col toIndentError
107+
108+ HasTab -> cerr newRow newCol (toWhitespaceError E.HasTab)
109+ EndlessMultiComment -> cerr newRow newCol (toWhitespaceError E.EndlessMultiComment)
110+ UnexpectedDocComment -> cerr newRow newCol (toWhitespaceError E.UnexpectedDocComment)
111+
112+
113+
114+-- EAT SPACES
115+
116+
117+data Status
118+ = Good
119+ | HasTab
120+ | EndlessMultiComment
121+ | UnexpectedDocComment
122+
123+
124+eatSpaces :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> (# Status, Ptr Word8, Row, Col #)
125+eatSpaces pos end row col =
126+ if pos >= end then
127+ (# Good, pos, row, col #)
128+
129+ else
130+ case P.unsafeIndex pos of
131+ 0x20 {- -} ->
132+ eatSpaces (plusPtr pos 1) end row (col + 1)
133+
134+ 0x0A {- \n -} ->
135+ eatSpaces (plusPtr pos 1) end (row + 1) 1
136+
137+ 0x7B {- { -} ->
138+ eatMultiComment pos end row col
139+
140+ 0x2D {- - -} ->
141+ let !pos1 = plusPtr pos 1 in
142+ if pos1 < end && P.unsafeIndex pos1 == 0x2D {- - -} then
143+ eatLineComment (plusPtr pos 2) end row (col + 2)
144+ else
145+ (# Good, pos, row, col #)
146+
147+ 0x0D {- \r -} ->
148+ eatSpaces (plusPtr pos 1) end row col
149+
150+ 0x09 {- \t -} ->
151+ (# HasTab, pos, row, col #)
152+
153+ _ ->
154+ (# Good, pos, row, col #)
155+
156+
157+
158+-- LINE COMMENTS
159+
160+
161+eatLineComment :: Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> (# Status, Ptr Word8, Word16, Word16 #)
162+eatLineComment pos end row col =
163+ if pos >= end then
164+ (# Good, pos, row, col #)
165+
166+ else
167+ let !word = P.unsafeIndex pos in
168+ if word == 0x0A {- \n -} then
169+ eatSpaces (plusPtr pos 1) end (row + 1) 1
170+ else
171+ let !newPos = plusPtr pos (P.getCharWidth pos end word) in
172+ eatLineComment newPos end row (col + 1)
173+
174+
175+
176+-- MULTI COMMENTS
177+
178+
179+eatMultiComment :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> (# Status, Ptr Word8, Row, Col #)
180+eatMultiComment pos end row col =
181+ let
182+ !pos1 = plusPtr pos 1
183+ !pos2 = plusPtr pos 2
184+ in
185+ if pos2 >= end then
186+ (# Good, pos, row, col #)
187+
188+ else if P.unsafeIndex pos1 == 0x2D {- - -} then
189+
190+ if P.unsafeIndex pos2 == 0x7C {- | -} then
191+ (# UnexpectedDocComment, pos, row, col #)
192+ else
193+ let
194+ (# status, newPos, newRow, newCol #) =
195+ eatMultiCommentHelp pos2 end row (col + 2) 1
196+ in
197+ case status of
198+ MultiGood -> eatSpaces newPos end newRow newCol
199+ MultiTab -> (# HasTab, newPos, newRow, newCol #)
200+ MultiEndless -> (# EndlessMultiComment, pos, row, col #)
201+
202+ else
203+ (# Good, pos, row, col #)
204+
205+
206+data MultiStatus
207+ = MultiGood
208+ | MultiTab
209+ | MultiEndless
210+
211+
212+eatMultiCommentHelp :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> Word16 -> (# MultiStatus, Ptr Word8, Word16, Word16 #)
213+eatMultiCommentHelp pos end row col openComments =
214+ if pos >= end then
215+ (# MultiEndless, pos, row, col #)
216+
217+ else
218+ let !word = P.unsafeIndex pos in
219+ if word == 0x0A {- \n -} then
220+ eatMultiCommentHelp (plusPtr pos 1) end (row + 1) 1 openComments
221+
222+ else if word == 0x09 {- \t -} then
223+ (# MultiTab, pos, row, col #)
224+
225+ else if word == 0x2D {- - -} && P.isWord (plusPtr pos 1) end 0x7D {- } -} then
226+ if openComments == 1 then
227+ (# MultiGood, plusPtr pos 2, row, col + 2 #)
228+ else
229+ eatMultiCommentHelp (plusPtr pos 2) end row (col + 2) (openComments - 1)
230+
231+ else if word == 0x7B {- { -} && P.isWord (plusPtr pos 1) end 0x2D {- - -} then
232+ eatMultiCommentHelp (plusPtr pos 2) end row (col + 2) (openComments + 1)
233+
234+ else
235+ let !newPos = plusPtr pos (P.getCharWidth pos end word) in
236+ eatMultiCommentHelp newPos end row (col + 1) openComments
237+
238+
239+
240+-- DOCUMENTATION COMMENT
241+
242+
243+docComment :: P.Parser E.Decl ()
244+docComment =
245+ P.Parser $ \(P.State pos end indent row col) cok _ cerr eerr ->
246+ let
247+ !pos3 = plusPtr pos 3
248+ in
249+ if pos3 <= end
250+ && P.unsafeIndex ( pos ) == 0x7B {- { -}
251+ && P.unsafeIndex (plusPtr pos 1) == 0x2D {- - -}
252+ && P.unsafeIndex (plusPtr pos 2) == 0x7C {- | -}
253+ then
254+ let
255+ (# status, newPos, newRow, newCol #) =
256+ eatMultiCommentHelp pos3 end row (col + 3) 1
257+ in
258+ case status of
259+ MultiGood ->
260+ let
261+ !newState = P.State newPos end indent newRow newCol
262+ in
263+ cok () newState
264+
265+ MultiTab -> cerr newRow newCol (E.DeclSpace E.HasTab)
266+ MultiEndless -> cerr row col E.EndlessDocComment
267+ else
268+ eerr row col E.DeclDeadend
compiler/src/Parse/Utils.hsdeleted−259
@@ -1,259 +0,0 @@
1−{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
2−{-# LANGUAGE BangPatterns, UnboxedTuples, OverloadedStrings #-}
3−module Parse.Utils
4− ( Parser
5− , SParser
6− , SPos(..)
7− , spaces, noSpace, checkSpace, checkAligned, checkFreshLine
8− , whitespace
9− , docComment
10− )
11− where
12−
13−
14−import Data.Word (Word8, Word16)
15−import Foreign.Ptr (Ptr, plusPtr)
16−
17−import qualified Parse.Primitives as P
18−import qualified Reporting.Annotation as A
19−import qualified Reporting.Error.Syntax as E
20−
21−
22−
23−-- PARSERS
24−
25−
26−type Parser a =
27− P.Parser E.Context E.Expectation a
28−
29−
30−type SParser a =
31− P.Parser E.Context E.Expectation (a, A.Position, SPos)
32−
33−
34−
35−-- WHITESPACE VARIATIONS
36−
37−
38−spaces :: Parser ()
39−spaces =
40− checkSpace =<< whitespace
41−
42−
43−noSpace :: A.Position -> SPos -> Parser ()
44−noSpace pos (SPos spos) =
45− P.Parser $ \state@(P.State _ _ _ r c context) _ eok _ eerr ->
46− if pos == spos
47− then eok () state
48− else eerr r c context (E.TODO "noSpace")
49−
50−
51−checkSpace :: SPos -> Parser ()
52−checkSpace (SPos (A.Position _ col)) =
53− P.Parser $ \state@(P.State _ _ indent r c context) _ eok _ eerr ->
54− if col > indent && col > 1
55− then eok () state
56− else eerr r c context (E.TODO "checkSpace")
57−
58−
59−checkAligned :: SPos -> Parser ()
60−checkAligned (SPos (A.Position _ col)) =
61− P.Parser $ \state@(P.State _ _ indent r c context) _ eok _ eerr ->
62− if col == indent
63− then eok () state
64− else eerr r c context (E.TODO "checkAligned")
65−
66−
67−checkFreshLine :: SPos -> Parser ()
68−checkFreshLine (SPos (A.Position _ col)) =
69− P.Parser $ \state@(P.State _ _ _ r c context) _ eok _ eerr ->
70− if col == 1
71− then eok () state
72− else eerr r c context (E.TODO "checkFreshLine")
73−
74−
75−
76−-- WHITESPACE
77−
78−
79−newtype SPos = SPos A.Position
80−
81−
82−whitespace :: Parser SPos
83−whitespace =
84− P.Parser $ \(P.State pos end indent row col ctx) cok _ _ eerr ->
85− let
86− (# status, newPos, newRow, newCol #) =
87− eatSpaces pos end row col
88− in
89− case status of
90− Good ->
91− let
92− !spos = SPos (A.Position newRow newCol)
93− !newState = P.State newPos end indent newRow newCol ctx
94− in
95− cok spos newState
96−
97− HasTab ->
98− eerr newRow newCol ctx E.NoTabs
99−
100− UnendingMultiComment sr sc ->
101− eerr newRow newCol ctx (E.MultiCommentEnd sr sc)
102−
103−
104−data Status
105− = Good
106− | HasTab
107− | UnendingMultiComment Word16 Word16
108−
109−
110−
111−-- EAT SPACES
112−
113−
114−eatSpaces :: Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> (# Status, Ptr Word8, Word16, Word16 #)
115−eatSpaces pos end row col =
116− if pos >= end then
117− (# Good, pos, row, col #)
118−
119− else
120− case P.unsafeIndex pos of
121− 0x20 {- -} ->
122− eatSpaces (plusPtr pos 1) end row (col + 1)
123−
124− 0x0A {- \n -} ->
125− eatSpaces (plusPtr pos 1) end (row + 1) 1
126−
127− 0x7B {- { -} ->
128− eatMultiComment pos end row col
129−
130− 0x2D {- - -} ->
131− let !pos1 = plusPtr pos 1 in
132− if pos1 < end && P.unsafeIndex pos1 == 0x2D {- - -} then
133− eatLineComment (plusPtr pos 2) end row (col + 2)
134− else
135− (# Good, pos, row, col #)
136−
137− 0x0D {- \r -} ->
138− eatSpaces (plusPtr pos 1) end row col
139−
140− 0x09 {- \t -} ->
141− (# HasTab, pos, row, col #)
142−
143− _ ->
144− (# Good, pos, row, col #)
145−
146−
147−
148−-- LINE COMMENTS
149−
150−
151−eatLineComment :: Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> (# Status, Ptr Word8, Word16, Word16 #)
152−eatLineComment pos end row col =
153− if pos >= end then
154− (# Good, pos, row, col #)
155−
156− else
157− let !word = P.unsafeIndex pos in
158− if word == 0x0A {- \n -} then
159− eatSpaces (plusPtr pos 1) end (row + 1) 1
160− else
161− let !newPos = plusPtr pos (P.getCharWidth pos end word) in
162− eatLineComment newPos end row (col + 1)
163−
164−
165−
166−-- MULTI COMMENTS
167−
168−
169−eatMultiComment :: Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> (# Status, Ptr Word8, Word16, Word16 #)
170−eatMultiComment pos end row col =
171− let
172− !pos1 = plusPtr pos 1
173− !pos2 = plusPtr pos 2
174− in
175− if pos2 >= end then
176− (# Good, pos, row, col #)
177−
178− else
179− let
180− !yesDash = P.unsafeIndex pos1 == 0x2D {- - -}
181− !noBar = P.unsafeIndex pos2 /= 0x7C {- | -}
182− in
183− if yesDash && noBar then
184− let
185− (# status, newPos, newRow, newCol #) =
186− eatMultiCommentHelp pos2 end row (col + 2) 1 row col
187− in
188− case status of
189− Good ->
190− eatSpaces newPos end newRow newCol
191−
192− HasTab ->
193− (# status, newPos, newRow, newCol #)
194−
195− UnendingMultiComment _ _ ->
196− (# status, newPos, newRow, newCol #)
197−
198− else
199− (# Good, pos, row, col #)
200−
201−
202−eatMultiCommentHelp :: Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> Int -> Word16 -> Word16 -> (# Status, Ptr Word8, Word16, Word16 #)
203−eatMultiCommentHelp pos end row col openComments sr sc =
204− if pos >= end then
205− (# UnendingMultiComment sr sc, pos, row, col #)
206−
207− else
208− let !word = P.unsafeIndex pos in
209− if word == 0x0A {- \n -} then
210− eatMultiCommentHelp (plusPtr pos 1) end (row + 1) 1 openComments sr sc
211−
212− else if word == 0x2D {- - -} && P.isWord (plusPtr pos 1) end 0x7D {- } -} then
213− if openComments == 1 then
214− (# Good, plusPtr pos 2, row, col + 2 #)
215− else
216− eatMultiCommentHelp (plusPtr pos 2) end row (col + 2) (openComments - 1) sr sc
217−
218− else if word == 0x7B {- { -} && P.isWord (plusPtr pos 1) end 0x2D {- - -} then
219− eatMultiCommentHelp (plusPtr pos 2) end row (col + 2) (openComments + 1) sr sc
220−
221− else
222− let !newPos = plusPtr pos (P.getCharWidth pos end word) in
223− eatMultiCommentHelp newPos end row (col + 1) openComments sr sc
224−
225−
226−
227−-- DOCUMENTATION COMMENT
228−
229−
230−docComment :: Parser ()
231−docComment =
232− P.Parser $ \(P.State pos end indent row col ctx) cok _ _ eerr ->
233− let
234− !pos3 = plusPtr pos 3
235− in
236− if pos3 <= end
237− && P.unsafeIndex ( pos ) == 0x7B {- { -}
238− && P.unsafeIndex (plusPtr pos 1) == 0x2D {- - -}
239− && P.unsafeIndex (plusPtr pos 2) == 0x7C {- | -}
240− then
241− let
242− (# status, newPos, newRow, newCol #) =
243− eatMultiCommentHelp pos3 end row (col + 3) 1 row col
244− in
245− case status of
246− Good ->
247− let
248− !newState = P.State newPos end indent newRow newCol ctx
249− in
250− cok () newState
251−
252− HasTab ->
253− eerr newRow newCol ctx E.NoTabs
254−
255− UnendingMultiComment sr sc ->
256− eerr newRow newCol ctx (E.MultiCommentEnd sr sc)
257−
258− else
259− eerr row col ctx E.DocComment