viewcvs.cgi/web/regexp.cd

type regexp = 
  <chr> Char 
| <seq> (regexp,regexp) 
| <alt> (regexp,regexp) 
| <star> regexp

type f = String -> Bool

let loop (re : regexp, k : f) : f = fun (s : String) : Bool =  match re with
| <chr> p -> (match s with (c,s) -> (c = p) && (k s) | _ -> `false)
| <seq> (r1,r2) -> loop (r1, (loop (r2,k))) s
| <alt> (r1,r2) -> loop (r1,k) s || loop (r2,k) s
| <star> r -> loop (r,(loop (re,k))) s || k s

let accept (re : regexp) : f =
  loop (re, fun (String -> Bool) [] -> `true | _ -> `false)

let re = <seq> (<star> <chr>'a', <star><chr>'b')
let strs = [ "aaabbb" "abba" "aaab" "a" "" ]
let [] = print ((string_of (map strs with x -> (x,accept re x))) @ ['\n'])
1	type regexp =
2	<chr> Char
3	\| <seq> (regexp,regexp)
4	\| <alt> (regexp,regexp)
5	\| <star> regexp
6
7	type f = String -> Bool
8
9	let loop (re : regexp, k : f) : f = fun (s : String) : Bool = match re with
10	\| <chr> p -> (match s with (c,s) -> (c = p) && (k s) \| _ -> `false)
11	\| <seq> (r1,r2) -> loop (r1, (loop (r2,k))) s
12	\| <alt> (r1,r2) -> loop (r1,k) s \|\| loop (r2,k) s
13	\| <star> r -> loop (r,(loop (re,k))) s \|\| k s
14
15	let accept (re : regexp) : f =
16	loop (re, fun (String -> Bool) [] -> `true \| _ -> `false)
17
18	let re = <seq> (<star> <chr>'a', <star><chr>'b')
19	let strs = [ "aaabbb" "abba" "aaab" "a" "" ]
20	let [] = print ((string_of (map strs with x -> (x,accept re x))) @ ['\n'])