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
 198         repl
 199         flags
 200         str
 201  = search str
 202    where
 203     global = 'g' `elem` flags
 204     case_insensitive = 'i' `elem` flags
 205     mode = 's' `elem` flags     -- single-line mode
 206     pat  = unsafePerformIO (
 207               re_compile_pattern rexp mode case_insensitive)
 208
 209     search str
 210      = let
 211         search_res
 212          = unsafePerformIO (re_search pat str 0 (lengthPS str) True)
 213        in
 214         case search_res of
 215           Nothing  -> str
 216           Just matcher@(REmatch arr before match after lst) ->
 217             let
 218              (st,en) = match
 219              prefix = chunkPS str before
 220              suffix
 221               = if global && (st /= en) then
 222                    search (dropPS en str)
 223                 else
 224                    chunkPS str after
 225             in
 226              concatPS [prefix,
 227                         replace matcher repl str,
 228                         suffix]
 229
 230
 231 replace :: REmatch
 232         -> PackedString
 233         -> PackedString
 234         -> PackedString
 235 replace (REmatch arr before@(_,b_end) match after lst)
 236         replacement
 237         str
 238  = concatPS (reverse acc) -- ToDo: write a `reversed' version of concatPS
 239    where
 240     (_,b) = bounds arr
 241
 242     acc = replace' [] replacement False
 243
 244     single :: Char -> PackedString
 245     single x = consPS x nilPS
 246
 247     replace' :: [PackedString]
 248              -> PackedString
 249              -> Bool
 250              -> [PackedString]
 251     replace' acc repl escaped
 252      = if (nullPS repl) then
 253          acc
 254        else
 255          let
 256           x  = headPS repl
 257           x# = case x of { C# c -> c }
 258           xs = tailPS repl
 259          in
 260           case x# of
 261             '\\'# ->
 262                if escaped then
 263                   replace' acc xs True
 264                else
 265                   replace' ((single x):acc) xs (not escaped)
 266             '$'#  ->
 267               if (not escaped) then
 268                let
 269                 x'           = headPS xs
 270                 xs'          = tailPS xs
 271                 ith_ival     = arr!num
 272                 (num,xs_num) = getNumber ((ord x') - ord '0') xs'
 273                in
 274                 if (isDigit x') && (num<=b) then
 275                   replace' ((chunkPS str ith_ival):acc) xs_num escaped
 276                 else if x' == '&' then
 277                   replace' ((chunkPS str match):acc) xs' escaped
 278                 else if x' == '+' then
 279                   replace' ((chunkPS str lst):acc) xs' escaped
 280                 else if x' == '`' then
 281                   replace' ((chunkPS str (0,b_end)):acc) xs' escaped
 282                 else if x' == '\'' then
 283                   replace' ((chunkPS str after):acc) xs' escaped
 284                 else -- ignore
 285                   replace' acc xs escaped
 286               else
 287                 replace' ((single x):acc) xs False
 288
 289             _ -> if escaped then
 290                    (case x# of
 291                      'n'# ->   -- newline
 292                          replace' ((single '\n'):acc)
 293                      'f'# ->   -- formfeed
 294                          replace' ((single '\f'):acc)
 295                      'r'# ->   -- carriage return
 296                          replace' ((single '\r'):acc)
 297                      't'# ->   -- (horiz) tab
 298                          replace' ((single '\t'):acc)
 299                      'v'# ->   -- vertical tab
 300                          replace' ((single '\v'):acc)
 301                      'a'# ->   -- alarm bell
 302                          replace' ((single '\a'):acc)
 303                      'e'# ->   -- escape
 304                          replace' ((single '\033'):acc)
 305                      _    ->
 306                          replace' ((single x):acc))    xs False
 307                  else
 308                    replace' ((single x):acc) xs False
 309
 310
 311 getNumber :: Int -> PackedString -> (Int,PackedString)
 312 getNumber acc ps
 313  = if nullPS ps then
 314       (acc,ps)
 315    else
 316      let
 317       x = headPS  ps
 318       xs = tailPS ps
 319      in
 320       if (isDigit x) then
 321          getNumber (acc*10+(ord x - ord '0')) xs
 322       else
 323          (acc,ps)
 324
 325 \end{code}
 326
 327 Just like substPS, but no prefix and suffix.
 328
 329 \begin{code}
 330
 331 replacePS :: PackedString   -- reg. exp
 332           -> PackedString   -- replacement
 333           -> [Char]        -- flags
 334           -> PackedString   -- string
 335           -> PackedString
 336 replacePS rexp
 337           repl
 338           flags
 339           str
 340  = search str
 341    where
 342     global = 'g' `elem` flags
 343     case_insensitive = 'i' `elem` flags
 344     mode = 's' `elem` flags     -- single-line mode
 345     pat  = unsafePerformIO (
 346               re_compile_pattern rexp mode case_insensitive)
 347
 348     search str
 349      = let
 350         search_res
 351          = unsafePerformIO (re_search pat str 0 (lengthPS str) True)
 352        in
 353         case search_res of
 354           Nothing  -> str
 355           Just matcher@(REmatch arr before match after lst) ->
 356              replace matcher repl str
 357
 358 \end{code}
 359
 360 Picking matched groups out of string
 361
 362 \begin{code}
 363
 364 getMatchesNo :: REmatch
 365              -> Int
 366 getMatchesNo (REmatch arr _ _ _ _)
 367  = snd (bounds arr)
 368
 369 getMatchedGroup :: REmatch
 370                 -> Int
 371                 -> PackedString
 372                 -> PackedString
 373 getMatchedGroup (REmatch arr bef mtch after lst) nth str
 374  = let
 375     (1,grps) = bounds arr
 376    in
 377     if (nth >= 1) && (nth <= grps) then
 378        chunkPS str (arr!nth)
 379     else
 380        error "getMatchedGroup: group out of range"
 381
 382 getWholeMatch :: REmatch
 383               -> PackedString
 384               -> PackedString
 385 getWholeMatch (REmatch _ _  mtch _ _) str
 386  = chunkPS str mtch
 387
 388 getLastMatch :: REmatch
 389               -> PackedString
 390               -> PackedString
 391 getLastMatch (REmatch _ _ _ _ lst) str
 392  = chunkPS str lst
 393
 394 getAfterMatch :: REmatch
 395               -> PackedString
 396               -> PackedString
 397 getAfterMatch (REmatch _ _ _ aft _) str
 398  = chunkPS str aft
 399
 400 \end{code}
 401
 402
 403 More or less straight translation of a brute-force string matching
 404 function written in C. (Sedgewick ch. 18)
 405
 406 This is intended to provide much the same facilities as index/rindex in perl.
 407
 408 \begin{code}
 409
 410
 411 findPS :: PackedString
 412        -> PackedString
 413        -> Maybe Int
 414 findPS str substr
 415  = let
 416     m = lengthPS substr
 417     n = lengthPS str
 418
 419     loop i j
 420      | j>=m || i>=n = if j==m then (Just (i-m)) else Nothing
 421      | otherwise
 422         = inner_loop i j
 423
 424     inner_loop i j
 425      = if j<m && i<n && (indexPS str i /= indexPS substr j) then
 426           inner_loop (i-j+1) 0
 427        else
 428           loop (i+1) (j+1)
 429    in
 430     loop 0 0
 431
 432 rfindPS :: PackedString
 433         -> PackedString
 434         -> Maybe Int
 435 rfindPS str substr
 436  = let
 437     m = lengthPS substr - 1
 438     n = lengthPS str - 1
 439
 440     loop i j
 441      | j<0 || i<0 = if j<0 then (Just (i+1)) else Nothing
 442      | otherwise
 443         = inner_loop i j
 444
 445     inner_loop i j
 446      = if j>=0 && i>=0 && (indexPS str i /= indexPS substr j) then
 447           inner_loop (i+(m-j)-1) m
 448        else
 449           loop (i-1) (j-1)
 450    in
 451     loop n m
 452
 453
 454 \end{code}
 455
 456 \begin{code}
 457
 458 chopPS :: PackedString -> PackedString
 459 chopPS str = if nullPS str then
 460                 nilPS
 461              else
 462                 chunkPS  str (0,lengthPS str-1)
 463
 464 \end{code}
 465
 466 Tries to match as much as possible of strA starting from the beginning of strB
 467 (handy when matching fancy literals in parsers)
 468
 469 \begin{code}
 470 matchPrefixPS :: PackedString
 471               -> PackedString
 472               -> Int
 473 matchPrefixPS pref str
 474  = matchPrefixPS' pref str 0
 475    where
 476     matchPrefixPS' pref str n
 477      = if (nullPS pref) || (nullPS str) then
 478           n
 479        else if (headPS pref) == (headPS str) then
 480           matchPrefixPS' (tailPS pref) (tailPS str) (n+1)
 481        else
 482           n
 483
 484 \end{code}