ghc/lib/misc/MatchPS.lhs

   1 \section[match]{PackedString functions for matching}
   2
   3 This module provides regular expression matching and substitution
   4 at the PackedString level. It is built on top of the GNU Regex
   5 library modified to handle perl regular expression syntax.
   6 For a complete description of the perl syntax, do `man perlre`
   7 or have a gander in (Programming|Learning) Perl. Here's
   8 a short summary:
   9
  10 ^     matches the beginning of line
  11 $     matches end of line
  12 \b    matches word boundary
  13 \B    matches non-word boundary
  14 \w    matches a word(alpha-numeric) character
  15 \W    matches a non-word character
  16 \d    matches a digit
  17 \D    matches a non-digit
  18 \s    matches whitespace
  19 \S    matches non-whitespace
  20 \A    matches beginning of buffer
  21 \Z    matches end-of-buffer
  22 .     matches any (bar newline in single-line mode)
  23 +     matches 1 or more times
  24 *     matches 0 or more times
  25 ?     matches 0 or 1
  26 {n,m} matches >=n and <=m atoms
  27 {n,}  matches at least n times
  28 {n}   matches n times
  29 [..]  matches any character member of char class.
  30 (..)  if pattern inside parens match, then the ith group is bound
  31       to the matched string
  32 \digit matches whatever the ith group matched.
  33
  34 Backslashed letters
  35 \n      newline
  36 \r      carriage return
  37 \t      tab
  38 \f      formfeed
  39 \v      vertical tab
  40 \a      alarm bell
  41 \e      escape
  42
  43
  44 \begin{code}
  45 module MatchPS
  46
  47       (
  48         matchPS,
  49         searchPS,
  50         substPS,
  51         replacePS,
  52
  53         match2PS,
  54         search2PS,
  55
  56         getMatchesNo,
  57         getMatchedGroup,
  58         getWholeMatch,
  59         getLastMatch,
  60         getAfterMatch,
  61
  62         findPS,
  63         rfindPS,
  64         chopPS,
  65
  66         matchPrefixPS,
  67
  68         REmatch(..)
  69       ) where
  70
  71 import GlaExts
  72 import PackedString
  73
  74 import Array    ((!), bounds)
  75 import Char     ( isDigit, ord )
  76 import PrelBase ( Char(..) )
  77
  78 import Regex
  79
  80 \end{code}
  81
  82 \subsection[ps-matching]{PackedString matching}
  83
  84 Posix matching, returning an array of the the intervals that
  85 the individual groups matched within the string.
  86
  87 \begin{code}
  88
  89 matchPS :: PackedString         -- reg. exp
  90         -> PackedString                 -- string to match
  91         -> [Char]                       -- flags
  92         -> Maybe REmatch
  93 matchPS reg str flags
  94  = let
  95     insensitive = 'i' `elem` flags
  96     mode = 's' `elem` flags
  97    in
  98     unsafePerformIO (do
  99       pat <- re_compile_pattern reg mode insensitive
 100       re_match pat str 0 True)
 101
 102
 103 match2PS :: PackedString                -- reg. exp
 104          -> PackedString                -- string1 to match
 105          -> PackedString                -- string2 to match
 106          -> [Char]                      -- flags
 107          -> Maybe REmatch
 108 match2PS reg str1 str2 flags
 109  = let
 110     insensitive = 'i' `elem` flags
 111     mode = 's' `elem` flags
 112     len1 = lengthPS str1
 113     len2 = lengthPS str2
 114    in
 115     unsafePerformIO (do
 116       pat <- re_compile_pattern reg mode insensitive
 117       re_match2 pat str1 str2 0 (len1+len2) True)
 118
 119 \end{code}
 120
 121 PackedString front-end to searching with GNU Regex
 122
 123 \begin{code}
 124
 125 searchPS :: PackedString                -- reg. exp
 126          -> PackedString                -- string to match
 127          -> [Char]                      -- flags
 128          -> Maybe REmatch
 129 searchPS reg str flags
 130  = let
 131     insensitive = 'i' `elem` flags
 132     mode = 's' `elem` flags
 133    in
 134     unsafePerformIO (do
 135       pat <- re_compile_pattern reg mode insensitive
 136       re_search pat str
 137                     0
 138                     (lengthPS str)
 139                     True)
 140
 141
 142
 143 search2PS :: PackedString               -- reg. exp
 144           -> PackedString               -- string to match
 145           -> PackedString               -- string to match
 146           -> [Char]                     -- flags
 147           -> Maybe REmatch
 148 search2PS reg str1 str2 flags
 149  = let
 150     insensitive = 'i' `elem` flags
 151     mode = 's' `elem` flags
 152     len1 = lengthPS str1
 153     len2 = lengthPS str2
 154     len  = len1+len2
 155    in
 156     unsafePerformIO (do
 157       pat <- re_compile_pattern reg mode insensitive
 158       re_search2 pat
 159                  str1
 160                  str2
 161                  0
 162                  len
 163                  len
 164                  True)
 165
 166
 167
 168 \end{code}
 169
 170 @substrPS s st end@ cuts out the chunk in \tr{s} between \tr{st} and \tr{end}, inclusive.
 171 The \tr{Regex} registers represent substrings by storing the start and the end point plus
 172 one( st==end => empty string) , so we use @chunkPS@ instead.
 173
 174
 175 \begin{code}
 176
 177 chunkPS :: PackedString
 178          -> (Int,Int)
 179          -> PackedString
 180 chunkPS str (st,end)
 181  = if st==end then
 182       nilPS
 183    else
 184       substrPS str st (max 0 (end-1))
 185
 186 \end{code}
 187
 188 Perl-like match and substitute
 189
 190 \begin{code}
 191
 192 substPS :: PackedString   -- reg. exp
 193         -> PackedString   -- replacement
 194         -> [Char]          -- flags
 195         -> PackedString   -- string
 196         -> PackedString
 197 substPS rexp repl flags pstr = search pstr
 198    where
 199     global = 'g' `elem` flags
 200     case_insensitive = 'i' `elem` flags
 201     mode = 's' `elem` flags     -- single-line mode
 202     pat  = unsafePerformIO (
 203               re_compile_pattern rexp mode case_insensitive)
 204
 205     search str
 206      = let
 207         search_res
 208          = unsafePerformIO (re_search pat str 0 (lengthPS str) True)
 209        in
 210         case search_res of
 211           Nothing  -> str
 212           Just matcher@(REmatch _ before match after _) ->
 213             let
 214              (st,en) = match
 215              prefix  = chunkPS str before
 216              suffix
 217               | global && (st /= en) = search (dropPS en str)
 218               | otherwise            = chunkPS str after
 219             in
 220              concatPS [prefix,
 221                         replace matcher repl str,
 222                         suffix]
 223
 224
 225 replace :: REmatch
 226         -> PackedString
 227         -> PackedString
 228         -> PackedString
 229 replace (REmatch arr (_,b_end) match after lst)
 230         replacement
 231         str
 232  = concatPS (reverse acc) -- ToDo: write a `reversed' version of concatPS
 233    where
 234     (_,b) = bounds arr
 235
 236     acc = replace' [] replacement False
 237
 238     single :: Char -> PackedString
 239     single x = consPS x nilPS
 240
 241     replace' :: [PackedString]
 242              -> PackedString
 243              -> Bool
 244              -> [PackedString]
 245     replace' acc repl escaped
 246       | nullPS repl = acc
 247       | otherwise   =
 248          let
 249           x  = headPS repl
 250           x# = case x of { C# c -> c }
 251           xs = tailPS repl
 252          in
 253           case x# of
 254             '\\'# ->
 255                if escaped then
 256                   replace' acc xs True
 257                else
 258                   replace' ((single x):acc) xs (not escaped)
 259             '$'#  ->
 260               if (not escaped) then
 261                let
 262                 x'           = headPS xs
 263                 xs'          = tailPS xs
 264                 ith_ival     = arr!num
 265                 (num,xs_num) = getNumber ((ord x') - ord '0') xs'
 266                in
 267                 if (isDigit x') && (num<=b) then
 268                   replace' ((chunkPS str ith_ival):acc) xs_num escaped
 269                 else if x' == '&' then
 270                   replace' ((chunkPS str match):acc) xs' escaped
 271                 else if x' == '+' then
 272                   replace' ((chunkPS str lst):acc) xs' escaped
 273                 else if x' == '`' then
 274                   replace' ((chunkPS str (0,b_end)):acc) xs' escaped
 275                 else if x' == '\'' then
 276                   replace' ((chunkPS str after):acc) xs' escaped
 277                 else -- ignore
 278                   replace' acc xs escaped
 279               else
 280                 replace' ((single x):acc) xs False
 281
 282             _ -> if escaped then
 283                    (case x# of
 284                      'n'# ->   -- newline
 285                          replace' ((single '\n'):acc)
 286                      'f'# ->   -- formfeed
 287                          replace' ((single '\f'):acc)
 288                      'r'# ->   -- carriage return
 289                          replace' ((single '\r'):acc)
 290                      't'# ->   -- (horiz) tab
 291                          replace' ((single '\t'):acc)
 292                      'v'# ->   -- vertical tab
 293                          replace' ((single '\v'):acc)
 294                      'a'# ->   -- alarm bell
 295                          replace' ((single '\a'):acc)
 296                      'e'# ->   -- escape
 297                          replace' ((single '\033'):acc)
 298                      _    ->
 299                          replace' ((single x):acc))    xs False
 300                  else
 301                    replace' ((single x):acc) xs False
 302
 303
 304 getNumber :: Int -> PackedString -> (Int,PackedString)
 305 getNumber acc ps
 306  = if nullPS ps then
 307       (acc,ps)
 308    else
 309      let
 310       x = headPS  ps
 311       xs = tailPS ps
 312      in
 313       if (isDigit x) then
 314          getNumber (acc*10+(ord x - ord '0')) xs
 315       else
 316          (acc,ps)
 317
 318 \end{code}
 319
 320 Just like substPS, but no prefix and suffix.
 321
 322 \begin{code}
 323
 324 replacePS :: PackedString   -- reg. exp
 325           -> PackedString   -- replacement
 326           -> [Char]        -- flags
 327           -> PackedString   -- string
 328           -> PackedString
 329 replacePS rexp
 330           repl
 331           flags
 332           str
 333  = search str
 334    where
 335     case_insensitive = 'i' `elem` flags
 336     mode = 's' `elem` flags     -- single-line mode
 337     pat  = unsafePerformIO (
 338               re_compile_pattern rexp mode case_insensitive)
 339
 340     search str
 341      = let
 342         search_res
 343          = unsafePerformIO (re_search pat str 0 (lengthPS str) True)
 344        in
 345         case search_res of
 346           Nothing  -> str
 347           Just matcher@(REmatch arr _ match _ lst) ->
 348              replace matcher repl str
 349
 350 \end{code}
 351
 352 Picking matched groups out of string
 353
 354 \begin{code}
 355
 356 getMatchesNo :: REmatch
 357              -> Int
 358 getMatchesNo (REmatch arr _ _ _ _)
 359  = snd (bounds arr)
 360
 361 getMatchedGroup :: REmatch
 362                 -> Int
 363                 -> PackedString
 364                 -> PackedString
 365 getMatchedGroup (REmatch arr bef mtch _ lst) nth str
 366  | (nth >= 1) && (nth <= grps) = chunkPS str (arr!nth)
 367  | otherwise                   = error "getMatchedGroup: group out of range"
 368   where
 369     (1,grps) = bounds arr
 370
 371 getWholeMatch :: REmatch -> PackedString -> PackedString
 372 getWholeMatch (REmatch _ _  mtch _ _) str
 373  = chunkPS str mtch
 374
 375 getLastMatch :: REmatch
 376               -> PackedString
 377               -> PackedString
 378 getLastMatch (REmatch _ _ _ _ lst) str
 379  = chunkPS str lst
 380
 381 getAfterMatch :: REmatch
 382               -> PackedString
 383               -> PackedString
 384 getAfterMatch (REmatch _ _ _ aft _) str
 385  = chunkPS str aft
 386
 387 \end{code}
 388
 389
 390 More or less straight translation of a brute-force string matching
 391 function written in C. (Sedgewick ch. 18)
 392
 393 This is intended to provide much the same facilities as index/rindex in perl.
 394
 395 \begin{code}
 396
 397
 398 findPS :: PackedString
 399        -> PackedString
 400        -> Maybe Int
 401 findPS str substr
 402  = let
 403     m = lengthPS substr
 404     n = lengthPS str
 405
 406     loop i j
 407      | j>=m || i>=n = if j==m then (Just (i-m)) else Nothing
 408      | otherwise
 409         = inner_loop i j
 410
 411     inner_loop i j
 412      = if j<m && i<n && (indexPS str i /= indexPS substr j) then
 413           inner_loop (i-j+1) 0
 414        else
 415           loop (i+1) (j+1)
 416    in
 417     loop 0 0
 418
 419 rfindPS :: PackedString
 420         -> PackedString
 421         -> Maybe Int
 422 rfindPS str substr
 423  = let
 424     m = lengthPS substr - 1
 425     n = lengthPS str - 1
 426
 427     loop i j
 428      | j<0 || i<0 = if j<0 then (Just (i+1)) else Nothing
 429      | otherwise
 430         = inner_loop i j
 431
 432     inner_loop i j
 433      = if j>=0 && i>=0 && (indexPS str i /= indexPS substr j) then
 434           inner_loop (i+(m-j)-1) m
 435        else
 436           loop (i-1) (j-1)
 437    in
 438     loop n m
 439
 440
 441 \end{code}
 442
 443 \begin{code}
 444
 445 chopPS :: PackedString -> PackedString
 446 chopPS str = if nullPS str then
 447                 nilPS
 448              else
 449                 chunkPS  str (0,lengthPS str-1)
 450
 451 \end{code}
 452
 453 Tries to match as much as possible of strA starting from the beginning of strB
 454 (handy when matching fancy literals in parsers)
 455
 456 \begin{code}
 457 matchPrefixPS :: PackedString
 458               -> PackedString
 459               -> Int
 460 matchPrefixPS pref str
 461  = matchPrefixPS' pref str 0
 462    where
 463     matchPrefixPS' pref str n
 464      = if (nullPS pref) || (nullPS str) then
 465           n
 466        else if (headPS pref) == (headPS str) then
 467           matchPrefixPS' (tailPS pref) (tailPS str) (n+1)
 468        else
 469           n
 470
 471 \end{code}