26ec347 · elk · git.iko.soy

git.iko.soy/elk

Change how whitespace is checked

Need to produce a column, that way indentation can be checked multiple times. Needed when you have nested case expressions, so when one fails, you do not see BeforeIndent on the outer case! This commit also fixes a number of small errors in the parser: - Offset and length are computed correctly for Char - Multiline strings work - Keywords peek for _ at the end as well as alphaNum characters All the error messages are still bad, so another pass will be needed to clean that up!

commit26ec347027e6507af54337502fc8a5876e9ff96c authorEvan Czaplicki <evancz@users.noreply.github.com> dateMon 5 Dec 2016, 12:32 (10 years ago) parentea2a61e

2 files changed+128−68

compare with master

unifiedsplit

src/Parse/Helpers.hs+38−22 src/Parse/Primitives.hs+90−46

src/Parse/Helpers.hs+38−22

@@ -4,10 +4,10 @@ module Parse.Helpers

44 ( module Parse.Primitives

55 , SParser

66 , qualifiedVar, qualifiedCapVar

7− , equals, rightArrow, hasType, comma, pipe, cons, dot, underscore, lambda

7+ , equals, rightArrow, hasType, comma, pipe, cons, dot, minus, underscore, lambda

88 , leftParen, rightParen, leftSquare, rightSquare, leftCurly, rightCurly

99 , addLocation

10− , spaces, checkSpaces

10+ , spaces, checkSpace, checkAligned, checkFreshline

1111 )

1212 where

1313

@@ -25,7 +25,7 @@ import qualified Reporting.Region as R

2525

2626

2727type SParser a =

28− Parser (a, R.Position, Space)

28+ Parser (a, R.Position, SPos)

2929

3030

3131

@@ -55,7 +55,7 @@ qualifiedVarHelp allCaps vars =

5555 [ do var <- capVar

5656 qualifiedVarHelp allCaps (var:vars)

5757 , if allCaps then

58− failure (error "TODO")

58+ failure False -- TODO

5959 else

6060 do var <- lowVar

6161 return (Text.intercalate "." (reverse (var:vars)))

@@ -117,6 +117,12 @@ dot =

117117 Prim.text "."

118118

119119

120+{-# INLINE minus #-}

121+minus :: Parser ()

122+minus =

123+ Prim.text "-"

124+

125+

120126{-# INLINE underscore #-}

121127underscore :: Parser ()

122128underscore =

@@ -190,21 +196,31 @@ addLocation parser =

190196

191197spaces :: Parser ()

192198spaces =

193− do space <- whitespace

194− case space of

195− None -> return ()

196− AfterIndent -> return ()

197− BeforeIndent -> failure (error "TODO")

198− Aligned -> failure (error "TODO")

199− Freshline -> failure (error "TODO")

200−

201−

202−checkSpaces :: Space -> Parser ()

203−checkSpaces space =

204− case space of

205− None -> return ()

206− AfterIndent -> return ()

207− BeforeIndent -> deadend (error "TODO")

208− Aligned -> deadend (error "TODO")

209− Freshline -> deadend (error "TODO")

210−

199+ do (SPos (R.Position _ col)) <- whitespace

200+ indent <- getIndent

201+ if col > indent && col > 1

202+ then return ()

203+ else failure False -- TODO

204+

205+

206+checkSpace :: SPos -> Parser ()

207+checkSpace (SPos (R.Position _ col)) =

208+ do indent <- getIndent

209+ if col > indent && col > 1

210+ then return ()

211+ else deadend False -- TODO

212+

213+

214+checkAligned :: SPos -> Parser ()

215+checkAligned (SPos (R.Position _ col)) =

216+ do indent <- getIndent

217+ if col == indent

218+ then return ()

219+ else deadend False -- TODO

220+

221+

222+checkFreshline :: SPos -> Parser ()

223+checkFreshline (SPos (R.Position _ col)) =

224+ if col == 1

225+ then return ()

226+ else deadend False -- TODO

src/Parse/Primitives.hs+90−46

@@ -9,7 +9,7 @@ module Parse.Primitives

99 , lowVar, capVar, infixOp

1010 , getPosition, getCol

1111 , getIndent, setIndent

12− , Space(..), whitespace

12+ , SPos(..), whitespace

1313 , docComment

1414 , string, character

1515 , digit, number

@@ -166,8 +166,8 @@ oneOf parsers =

166166

167167allTheOptionsFailed :: Parser a

168168allTheOptionsFailed =

169− Parser $ \_ _ _ _ eerr ->

170− eerr $ error "TODO allTheOptionsFailed"

169+ Parser $ \(State _ _ _ _ row col) _ _ _ eerr ->

170+ eerr (Error row col)

171171

172172

173173oneOfHelp :: Parser a -> Parser a -> Parser a

@@ -177,7 +177,7 @@ oneOfHelp parser1 parser2 =

177177 meerr err =

178178 let

179179 neok y state' = eok y state'

180− neerr err' = eerr (error "TODO oneOfHelp" err err')

180+ neerr _err' = eerr err -- TODO merge things properly

181181 in

182182 _run parser2 state cok cerr neok neerr

183183 in

@@ -199,14 +199,14 @@ instance Monad Parser where

199199 cok' x state1 =

200200 let

201201 peok y state2 = cok y state2

202− peerr err = cerr (error "TODO >>= cok" err)

202+ peerr err = cerr err -- TODO is this correct?

203203 in

204204 _run (callback x) state1 cok cerr peok peerr

205205

206206 eok' x state1 =

207207 let

208208 peok y state2 = eok y state2

209− peerr err = eerr (error "TODO >>= eok" err)

209+ peerr err = eerr err -- TODO is this correct?

210210 in

211211 _run (callback x) state1 cok cerr peok peerr

212212 in

@@ -228,7 +228,7 @@ text (Text.Text tArray tOffset tLen) =

228228 cok () (State array (offset + tLen) (length - tLen) indent newRow newCol)

229229

230230 else

231− eerr (error "TODO text")

231+ eerr (Error row col)

232232

233233

234234moveCursor :: Text.Array -> Int -> Int -> Int -> Int -> (# Int, Int #)

@@ -259,7 +259,7 @@ keyword (Text.Text tArray tOffset tLen) =

259259 Parser $ \(State array offset length indent row col) cok _ _ eerr ->

260260 if tLen <= length && Text.equal tArray tOffset array offset tLen then

261261

262− if Char.isAlphaNum (peekChar array (offset + tLen)) then

262+ if isInnerVarChar (peekChar array (offset + tLen)) then

263263 eerr (error "TODO keyword 1")

264264 else

265265 let

@@ -269,7 +269,7 @@ keyword (Text.Text tArray tOffset tLen) =

269269 cok () (State array (offset + tLen) (length - tLen) indent newRow newCol)

270270

271271 else

272− eerr (error "TODO keyword 2")

272+ eerr (Error row col)

273273

274274

275275keywords :: Set.Set Text

@@ -369,13 +369,19 @@ varPrimHelp array offset length col =

369369 let

370370 (Text.Iter char size) = peek array offset -- TODO look for latin chars directly?

371371 in

372− if Char.isAlphaNum char || char == '_' then

372+ if isInnerVarChar char then

373373 varPrimHelp array (offset + size) (length - size) (col + 1)

374374

375375 else

376376 (# offset, length, col #)

377377

378378

379+{-# INLINE isInnerVarChar #-}

380+isInnerVarChar :: Char -> Bool

381+isInnerVarChar char =

382+ Char.isAlphaNum char || char == '_'

383+

384+

379385

380386-- INFIX OPS

381387

@@ -461,16 +467,11 @@ setIndent indent =

461467-- WHITESPACE

462468

463469

464−data Space

465− = None

466− | Freshline

467− | BeforeIndent

468− | Aligned

469− | AfterIndent

470− deriving (Eq)

470+newtype SPos =

471+ SPos Region.Position

471472

472473

473−whitespace :: Parser Space

474+whitespace :: Parser SPos

474475whitespace =

475476 Parser $ \(State array offset length indent row col) cok cerr _ _ ->

476477 case eatSpaces array offset length row col of

@@ -478,20 +479,9 @@ whitespace =

478479 cerr err

479480

480481 Right (newOffset, newLength, newRow, newCol) ->

481− let

482− !space =

483− if newOffset == offset then

484− None -- TODO empty success?

485− else if newCol == 1 then

486− Freshline

487− else if newCol > indent then

488− AfterIndent

489− else if newCol == indent then

490− Aligned

491− else

492− BeforeIndent

493− in

494− cok space (State array newOffset newLength indent newRow newCol)

482+ cok

483+ (SPos (Region.Position newRow newCol))

484+ (State array newOffset newLength indent newRow newCol)

495485

496486

497487eatSpaces :: Text.Array -> Int -> Int -> Int -> Int -> Either Error ( Int, Int, Int, Int )

@@ -661,16 +651,26 @@ string =

661651 if word /= 0x0022 {- " -} then

662652 eerr (Error row col)

663653

664− else if Text.unsafeIndex array (offset + 1) == 0x0022 {- " -} && Text.unsafeIndex array (offset + 2) == 0x0022 {- " -} then

665− error "TODO multiString"

666−

667654 else

668− case singleString array (offset + 1) (length - 1) row (col + 1) (offset + 1) mempty of

669− Left msg ->

670− cerr msg

655+ let

656+ stringResult =

657+ if length >= 3 && isQuote array (offset + 1) && isQuote array (offset + 2) then

658+ multiString array (offset + 3) (length - 3) row (col + 3) (offset + 3) mempty

659+ else

660+ singleString array (offset + 1) (length - 1) row (col + 1) (offset + 1) mempty

661+ in

662+ case stringResult of

663+ Left msg ->

664+ cerr msg

665+

666+ Right ( newOffset, newLength, newCol, str ) ->

667+ cok str (State array newOffset newLength indent row newCol)

671668

672− Right ( newOffset, newLength, newCol, str ) ->

673− cok str (State array newOffset newLength indent row newCol)

669+

670+{-# INLINE isQuote #-}

671+isQuote :: Text.Array -> Int -> Bool

672+isQuote array offset =

673+ Text.unsafeIndex array offset == 0x0022 {- " -}

674674

675675

676676

@@ -744,7 +744,7 @@ eatEscape array offset length row col =

744744

745745 Just (newOffset, code) ->

746746 if code <= 0x10FFFF then

747− Right ( newOffset - offset + 1, toEnum (fromInteger code) )

747+ Right ( 1 + (newOffset - offset), toEnum (fromInteger code) )

748748 else

749749 Left (Error row col)

750750

@@ -754,7 +754,7 @@ eatEscape array offset length row col =

754754

755755eatHex :: Text.Array -> Int -> Int -> Integer -> Maybe ( Int, Integer )

756756eatHex array offset length n =

757− if length == 0 then

757+ if length < 3 then

758758 Nothing

759759

760760 else

@@ -775,6 +775,50 @@ eatHex array offset length n =

775775

776776

777777

778+-- MULTI STRINGS

779+

780+

781+multiString :: Text.Array -> Int -> Int -> Int -> Int -> Int -> LB.Builder -> Either Error ( Int, Int, Int, Text.Text )

782+multiString array offset length row col initialOffset builder =

783+ if length == 0 then

784+ Left (Error row col)

785+

786+ else

787+ let

788+ !word = Text.unsafeIndex array offset

789+ in

790+ if word == 0x0022 {- " -} && isQuote array (offset + 1) && isQuote array (offset + 2) then

791+ let

792+ finalBuilder =

793+ mappend builder $ LB.fromText $

794+ Text.Text array initialOffset (offset - initialOffset)

795+

796+ str =

797+ LT.toStrict (LB.toLazyTextWith (offset - initialOffset) finalBuilder)

798+ in

799+ Right ( offset + 3, length - 3, col + 3, str )

800+

801+ else if word == 0x005C {- \ -} then

802+ case eatEscape array (offset + 1) (length - 1) row (col + 1) of

803+ Left err ->

804+ Left err

805+

806+ Right ( size, char ) ->

807+ let

808+ !newOffset = offset + size

809+ chunk = Text.Text array initialOffset (offset - initialOffset)

810+ newBuilder = mappend builder (mappend (LB.fromText chunk) (LB.singleton char))

811+ in

812+ multiString array newOffset (length - size) row (col + size) newOffset newBuilder

813+

814+ else if word < 0xD800 || word > 0xDBFF then

815+ multiString array (offset + 1) (length - 1) row (col + 1) initialOffset builder

816+

817+ else

818+ multiString array (offset + 2) (length - 2) row (col + 1) initialOffset builder

819+

820+

821+

778822-- CHARACTER

779823

780824

@@ -798,14 +842,14 @@ character =

798842

799843 Right ( size, char ) ->

800844 let

801− !newOffset = offset + size

802− !newLength = length + size

845+ !newOffset = offset + size + 1

846+ !newLength = length - size - 1

803847 in

804848 if newLength == 0 then

805849 cerr (Error row col)

806850

807851 else if Text.unsafeIndex array newOffset == 0x0027 {- ' -} then

808− cok char (State array newOffset newLength indent row (col + size + 2))

852+ cok char (State array (newOffset + 1) (newLength - 1) indent row (col + size + 2))

809853

810854 else

811855 cerr (Error row col)

@@ -828,7 +872,7 @@ characterHelp array offset length row col =

828872 else if word < 0xD800 || word > 0xDBFF then

829873 Right (1, unsafeChr word)

830874

831− else if length > 0 then

875+ else if length > 2 then

832876 Right (2, chr2 word (Text.unsafeIndex array offset))

833877

834878 else