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