Commits

camlspotter committed 724acec

added opt methods

Comments (0)

Files changed (6)

opam/orakuda.1.0.0/descr

-ORakuda, Perlish string literals
+ORakuda, Perlish string literals in OCaml
+ORakuda is a small library, CamlP4 extensions and an optional tiny
+patch to CamlP4 which provides a handy way to write OCaml scripts a la
+Perl (or other scripting language). It provides syntax like:
+
+* PCRE expression and matching of Perl like syntax $/.../ or <:m<...>>
+* Variable and expression references in string $"..." or <:qq<...>>
+* Sub-shell call by back-quotes $`...` or <:qx<...>>
+* Easy hashtbl access tbl${key}

opam/orakuda.1.0.0/url

-archive: "https://bitbucket.org/camlspotter/orakuda/downloads/orakuda-1.0.0.tar.gz"
+archive: "https://bitbucket.org/camlspotter/orakuda/get/1.0.0.tar.gz"
 	     <:expr<self#_unsafe_group $ExInt(_loc, string_of_int n)$>>,
 	     TyNil _loc)
       in
+      let num_opt n =
+	CrMth(_loc, sprintf "_%dopt" n, OvNil, PrNil, 
+	     <:expr<self#_unsafe_group_opt $ExInt(_loc, string_of_int n)$>>,
+	     TyNil _loc)
+      in
       let rec f n =
 	if n < 0 then []
-	else num n :: f (n-1)
+	else num n :: num_opt n :: f (n-1)
       in
       f n
     in
   string : string;
   pcre : Pcre.regexp;
   (* typ : typ; *)
-  binder : left:string -> right:string -> last:string -> string array -> 'a;
+  binder : left:string -> right:string -> last:string option -> string option array -> 'a;
 }
 
 module Internal_use_only = struct
 
-  class virtual group named_groups ~left ~right ~last groups = 
-    let named_groups = 
-      List.map (fun (n,pos) -> n, Array.unsafe_get groups pos) named_groups
+  class virtual group named_groups ~left ~right ~last groups_opt = 
+    let named_groups_opt = 
+      List.map (fun (n,pos) -> n, Array.unsafe_get groups_opt pos) named_groups
+    in
+    let def = function
+      | Some v -> v 
+      | None -> ""
     in
     object
-    method _groups = (groups : string array)
-    method _named_groups = (named_groups : (string * string) list)
-    method _group n = groups.(n)
-    method _unsafe_group n = Array.unsafe_get groups n
-    method _named_group s = List.assoc s named_groups
-    method _left : string = left
-    method _right : string = right
-    method _last : string = last
+      method _groups = (Array.map def groups_opt : string array)
+      method _groups_opt = (groups_opt : string option array)
+      method _named_groups = (List.map (fun (x,y) -> x, def y) named_groups_opt : (string * string) list)
+      method _named_groups_opt = (named_groups_opt : (string * string option) list)
+      method _group n = def groups_opt.(n)
+      method _group_opt n = groups_opt.(n)
+      method _unsafe_group n = def (Array.unsafe_get groups_opt n)
+      method _unsafe_group_opt n = Array.unsafe_get groups_opt n
+      method _named_group s = def (List.assoc s named_groups_opt)
+      method _named_group_opt s = List.assoc s named_groups_opt
+      method _left     : string = left
+      method _right    : string = right
+      method _last     : string = def last
+      method _last_opt : string option = last
   end
 
   let create string ~flags binder =
   
   let make_group_obj rex s substrs =
   
-    let subject_start, subject_end = Pcre.get_substring_ofs substrs 0 in
+    let subject_start, subject_end = Pcre.get_substring_ofs substrs 0 in (* may raise an exception *)
     let left = String.sub s 0 subject_start in
     let right = 
       String.sub s subject_end (String.length s - subject_end)
     in
-    let groups = Pcre.get_substrings substrs ~full_match:true in
+    let groups = Pcre.get_opt_substrings substrs ~full_match:true in
     let last =  (* probably wrong *)
       let rec find n = 
-        if n = 0 then ""
-        else if groups.(n) <> "" then groups.(n)
+        if n = 0 then None
+        else if groups.(n) <> None then groups.(n)
         else find (n-1)
       in
       find (Array.length groups - 1)
 
   (** group object to access matched groups *)
   class virtual group : 
-      (string * int) list (* named groups *)
-      -> left:string (* $` *)
+    (string * int) list (* named groups *)
+    -> left:  string (* $` *)
     -> right: string (* $' *)
-    -> last: string (* $+ *)
-    -> string array (* groups *) 
+    -> last:  string option (* $+ *)
+    -> string option array (* groups *) 
     -> object
-      method _groups : string array
-      method _named_groups : (string * string) list
-      method _group : int -> string
-      method _unsafe_group : int -> string
-      method _named_group : string -> string
-      method _left : string
-      method _right : string
-      method _last : string
+      method _groups           : string array
+      method _groups_opt       : string option array
+      method _named_groups     : (string * string) list
+      method _named_groups_opt : (string * string option) list
+      method _group            : int -> string
+      method _group_opt        : int -> string option
+      method _unsafe_group     : int -> string
+      method _unsafe_group_opt : int -> string option
+      method _named_group      : string -> string
+      method _named_group_opt  : string -> string option (** It still may raise an exception if the name does not exist *)
+      method _left     : string
+      method _right    : string
+      method _last     : string
+      method _last_opt : string option
     end
     
   val create : 
     string 
     -> flags: cflag list
-    -> (left: string -> right: string -> last: string -> string array -> 'a) 
+    -> (left: string -> right: string -> last: string option -> string option array -> 'a) 
     -> 'a t
 end

test/test_regexp_case.ml

   let res = 
     "world bye universe" 
     |! $/([^ ]+) ([^ ]+) ([^ ]+)/ as x -> x#_1
+    |! $/([^ ]+) ([^ ]+) ([^ ]+)/ as x -> (match x#_1opt with Some v -> v | None -> "")
     | $/(.*)/ as x -> x#_1
     | _ -> "default"
   in