Re
Reference: OPAM Re
Setup
#require "re"Re.Str.string_match
Determine if the string beginning at position x matahces the regex expression.
1let regex = Re.Str.regexp "^ap+le$";;
2Re.Str.string_match regex "apple" 0;;- : bool = true1let regex = Re.Str.regexp "^ap+le$";;
2Re.Str.string_match regex "apple" 1;;- : bool = false1let regex = Re.Str.regexp "p+";;
2Re.Str.string_match regex "apple" 0;;- : bool = false1let regex = Re.Str.regexp "p+";;
2Re.Str.string_match regex "apple" 1;;- : bool = trueRe.Str.search_forward
Starting at position x search a string and determine if there is a match for regex. Return the location index.
1let regex = Re.Str.regexp "ap+";;
2Re.Str.search_forward regex "apple" 0;;- : int = 01let regex = Re.Str.regexp "p+";;
2Re.Str.search_forward regex "apple" 0;;- : int = 1Re.Str.matched_string
Not sure how this works, but it seems like ocmal retains the starting position and number of characters that matched the pattern.
1let regex = Re.Str.regexp "ap+";;
2Re.Str.search_forward regex "apple" 0;;- : int = 01Re.Str.matched_string "apple";;- : string = "app"Re.Str.matched_string "axxxxpppple";;- : string = "axx"….
1let mac = "aaaa.bbbb.cccc";;
2let regex = Re.Str.regexp "\\([0-9a-f]+\\)";;
3Re.Str.string_match regex mac 0;- : bool = true1Re.Str.matched_string mac;;- : string = "aaaa"Re.Posix
1let mac = "aaaa.bbbb.cccc";;
2let regex = Re.compile ( Re.Posix.re "[0-9a-f]" );;
3let substrings = Re.exec regex mac;;
4Re.Group.all substrings;;- : string array = [|"a"|];;1let mac = "aaaa.bbbb.cccc";;
2let regex = Re.compile ( Re.Posix.re "([0-9a-f]{2})([0-9a-f]{2})\\.([0-9a-f]{2})([0-9a-f]{2})\\.([0-9a-f]{2})([0-9a-f]{2})" );;
3let substrings = Re.exec regex mac;;
4let matches : string Core.Array.t = Re.Group.all substrings;;matches;;
- : string array = [|"aaaa.bbbb.cccc"; "aa"; "aa"; "bb"; "bb"; "cc"; "cc"|]#typeof "matches";;
val matches : string Core.Array.tmatches.(3);;
- : string = "bb"1let new_mac =
2 let m = matches in
3 m.(1) ^ ":" ^ m.(2) ^ ":" ^ m.(3) ^ ":" ^ m.(4) ^ ":" ^ m.(5) ^ ":" ^ m.(6)
4 |> Core.String.uppercase;;new_mac;;
- : string = "AA:AA:BB:BB:CC:CC"Alternative to the Posix using Re.set
1let regex =
2 let hex = "0123456789abcdef" in
3 let hex_set = Re.set hex in
4 Re.(compile (repn hex_set 2 (Some 2)));;
5
6let matches = Re.matches regex mac;;
7matches;;- : string list = ["aa"; "11"; "bb"; "22"; "33"; "cc"]let (hd,tl) = match matches with
| [] -> ("",[])
| hd :: tl -> (hd,tl) in
List.fold_left (fun a b -> a ^ ":" ^ b) hd tl
|> Core.String.uppercase;;- : string = "AA:11:BB:22:33:CC"Another alternative is this using Re.alt…
let mac3 = "a1b2.c34d.5e6f";;1let matches =
2 let s1 = Re.rg 'a' 'f' in
3 let s2 = Re.rg '0' '9' in
4 let hex_alt = Re.alt [s1; s2] in
5 let regex = Re.compile Re.(repn hex_alt 2 (Some 2)) in
6 Re.matches regex mac2;;
7
8matches;;- : string list = ["a1"; "b2"; "c3"; "4d"; "5e"; "6f"]Re.Seq
1let regex = Re.compile Re.(seq [ word( rep alpha ) ] );;
2Re.matches regex mac;;- : string list = ["aaaa"; "bbbb"; "cccc"]1let regex = Re.compile Re.(seq [ (rep alpha ) ] );;
2Re.matches regex mac;;- : string list = ["aaaa"; "bbbb"; "cccc"]1let regex = Re.compile Re.(seq [ word( rep1 (char 'b') ) ] );;
2Re.matches regex mac;;- : string list = ["bbbb"]1let regex = Re.compile Re.(seq [ word( rep1 (char 'b') ) ] );;
2Re.matches regex mac;;- : string list = ["b"; "b"; "b"; "b"]1let regex = Re.compile Re.(seq [ (rep (char 'b')) ] );;
2Re.matches regex mac;;- : string list = [""; ""; ""; ""; ""; "bbbb"; ""; ""; ""; ""; ""]Re.opt
1let regex = Re.compile Re.(opt (str "a"));;
2Re.matches regex mac;;- : string list = ["a"; "a"; "a"; "a"; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""]1let regex = Re.compile Re.(greedy( opt (str "a")));;
2Re.matches regex mac;;- : string list = ["a"; "a"; "a"; "a"; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""]1let regex = Re.compile Re.(non_greedy (opt (str "a")));;
2Re.matches regex mac;;- : string list = [""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""]Re.set
1let regex = Re.compile Re.( set "ac" );;
2Re.matches regex mac;;- : string list = ["a"; "a"; "a"; "a"; "c"; "c"; "c"; "c"]1let regex = Re.compile Re.( set "cb" );;
2Re.matches regex mac;;- : string list = ["b"; "b"; "b"; "b"; "c"; "c"; "c"; "c"]Re.rg
1let regex = Re.compile Re.( rg 'a' 'c' );;
2Re.matches regex mac;;- : string list = ["a"; "a"; "a"; "a"; "b"; "b"; "b"; "b"; "c"; "c"; "c"; "c"]1let regex = Re.compile Re.( rep (rg 'a' 'c') );;
2Re.matches regex mac;;- : string list = ["aaaa"; "bbbb"; "cccc"]Re.compl
Setup…
let mac2 = "aa11.bb22.33cc";;1let regex = Re.compile Re.( compl [(rg 'a' 'c'); (rg '1' '3')] );;
2Re.matches regex mac2;;- : string list = ["."; "."]1let regex = Re.compile Re.( seq [(rg 'a' 'c'); (rg '1' '3')] );;
2Re.matches regex mac2;;- : string list = ["a1"; "b2"]Re.greedy
Setup…
let mac = "aaaa.bbbb.cccc";;
let mac2 = "aa11.bb22.33cc";;1let regex = Re.compile Re.( rep digit );;
2Re.matches regex mac2;;- : string list = [""; ""; "11"; ""; ""; "22"; "33"; ""; ""]1let regex = Re.compile Re.( greedy (rep digit) );;
2Re.matches regex mac2;;- : string list = [""; ""; "11"; ""; ""; "22"; "33"; ""; ""]1let regex = Re.compile Re.( non_greedy (rep digit) );;
2Re.matches regex mac2;;- : string list = [""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""]1let regex = Re.compile Re.( non_greedy (rep1 digit) );;
2Re.matches regex mac2;;- : string list = ["1"; "1"; "2"; "2"; "3"; "3"]1let regex = Re.compile Re.( greedy (rep1 digit) );;
2Re.matches regex mac2;;- : string list = ["11"; "22"; "33"]Re.repn
Setup…
let mac = "aaaa.bbbb.cccc";;
let mac2 = "aa11.bb22.33cc";;1let regex = Re.compile Re.( repn alpha 2 (Some 3) );;
2Re.matches regex mac;;- : string list = ["aaa"; "a"; "bbb"; "b"; "ccc"; "c"]1let regex = Re.compile Re.( repn alpha 2 (Some 2) );;
2Re.matches regex mac;;- : string list = ["aa"; "aa"; "bb"; "bb"; "cc"; "cc"]