# 2007-09-27 CrT: I've merged this into src/lib/regex/glue/regular-expression-matcher-g.pkg# so this code is mostly historical at this point.
# I've left it here for now as a forwarding pointer
# for when I get around to studying the ml-grinder
# code generally.
# A lazy man's interface to the regexp library.
package reg_exp_lib :> Regexp_Lib {
package re
=
regular_expression_matcher_g (
package p = perl_regex_parser;
package e = perl_regex_engine;
);
package m = regex_match_result;
# For caching compiled regexp
#
package h
=
typelocked_hashtable_g (
type Hash_Key = String
hash_value = hash_string::hash_string
same_key = op= : String * String -> Bool
);
type regexp = String and text = String
cache
=
h::makeTable (16, Match) : h::Hashtable( re::regexp )
fun compile regexp
=
case h::find cache regexp
of THE re => re
| NULL
=>
{ re = re::compile_string regexp
in h::set cache (regexp, re);
re
end
fun search regexp text
=
number_string::scan_string (re::find (compile regexp)) text
fun getArgs text children
=
{ fun walk (m::Match (THE { pos, len }, children))
=
{ s = string::substring (text, pos, len);
s . list::cat (map walk children);
?
| walk (m::Match (NULL, children))
=
"" . list::cat (map walk children);
list::cat (map walk children);
}
fun grep regexp text
=
case search regexp text
of NULL => NULL
| THE (m::Match(_, children)) => THE (getArgs text children)
fun extractGroup regexp i text
=
case search regexp text
of NULL => ""
| THE m => ( case m::nth (m, i)
of NULL => ""
| THE { pos, len } => string::substring (text, pos, len)
)
except _ => ""
fun extract regexp
=
extractGroup regexp 0
fun look regexp text
=
{ n = size text;
fun getc i
=
if i >= n then NULL
else THE (string::get_byte_as_char (text, i), i+1);
re::find (compile regexp) getc;
}
fun findAllGroup regexp g text
=
{ look = look regexp text;
fun loop s
=
case look s
of THE (m, s)
=>
(case m::nth (m, g) of
THE { pos, len } => string::substring (text, pos, len) . loop s
| NULL => loop s
)
| NULL => [];
loop 0;
}
fun findAll regexp
=
findAllGroup regexp 0
fun matches regexp text
=
null_or::not_null (search regexp text)
fun match text { cases, default }
=
{ fun loop []
=
default ()
| loop((regexp, action) . rest)
=
case grep regexp text
of NULL => loop rest
| THE args => action args;
loop cases;
}
fun subst regexp f text
=
case search regexp text
of NULL => text
| THE (m::Match (THE { pos, len }, children))
=>
{ prefix = string::extract (text, 0, THE pos);
suffix = string::extract (text, pos+len, NULL);
prefix + f (getArgs text children) + suffix;
}
| THE _ => raise exception INDEX_OUT_OF_BOUNDS
fun substAll regexp f text
=
{ look = look regexp text;
fun loop s
=
case look s
of NULL => [if s == 0 then text else string::extract (text, s, NULL)]
| THE (m::Match (THE { pos, len }, children), s')
=>
{ prefix = string::substring (text, s, pos-s);
prefix . f (getArgs text children) . loop s';
}
| THE _ => raise exception INDEX_OUT_OF_BOUNDS;
string::cat (loop 0);
}
fun replace regexp s = subst regexp (\\ _ => s)
fun replaceAll regexp s = substAll regexp (\\ _ => s)
};