File: build/library_string.ml (return to index)



Statistics:  
kind coverage
binding 34 / 34 (100 %)
sequence 5 / 5 (100 %)
for 0 / 0 (- %)
if/then 10 / 10 (100 %)
try 3 / 3 (100 %)
while 0 / 0 (- %)
match/function 39 / 39 (100 %)
kind coverage
class expression 0 / 0 (- %)
class initializer 0 / 0 (- %)
class method 0 / 0 (- %)
class value 0 / 0 (- %)
toplevel expression 0 / 0 (- %)
lazy operator 0 / 0 (- %)



Source:

fold all unfold all
000001| (**
000002| This program is free software; you can redistribute it and / or modify
000003| it under the terms of the GNU General Public License as published by
000004| the Free Software Foundation; version 3 of the License.
000005|  
000006| This program is distributed in the hope that it will be useful,
000007| but WITHOUT ANY WARRANTY; without even the implied warranty of
000008| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
000009| GNU General Public License for more details.
000010|  
000011| String library implementation
000012|  
000013| @author Tony BenBrahim < tony.benbrahim at gmail.com >
000014|  
000015| *)
000016| open Environment
000017| open Ast
000018| open Expression
000019| open RuntimeError
000020|  
000021| (**
000022| Returns the value of this as a string
000023| @param env the runtime environment
000024| @return the string value of this
000025| @throws InternalError is this is not a string
000026| *)
000027| let get_this env =
000028|         match env.stackframes.(0).(0) with
000029|         | RStringValue(s) -> (*[72]*)s
000030|         | v -> (*[2]*)raise (RuntimeError.InternalError "mismatched this in call to String.prototype.length")
000031|  
000032| (**
000033| Returns the positing of a substring within a string
000034| @param str the string to search
000035| @param substr the substring to find
000036| @return the position of the substring in the string, or - 1 if not found
000037| *)
000038| let indexOf str substr =
000039|         (*[70]*)let ssl = String.length substr in
000040|         (*[70]*)let max = String.length str - ssl in
000041|         (*[70]*)let rec loop i =
000042|                 ((*[268]*)if i > max then (*[26]*)- 1
000043|                         else(
000044|                                 (*[242]*)if String.sub str i ssl = substr then (*[44]*)i
000045|                                 else (*[198]*)loop (i + 1))
000046|                 )
000047|         in (*[70]*)loop 0
000048|  
000049| (**
000050| Entry point for library initialization
000051| @return a list of exported functions
000052| *)
000053| let initialize env =
000054|         ((*[2]*)[{
000055|                         name = ["String";"prototype";"length"];
000056|                         args = [];
000057|                         num_args = 0;
000058|                         vararg = false;
000059|                         code = fun env -> (*[28]*)raise (CFReturn (RIntegerValue(String.length (get_this env))))
000060|                 };
000061|                 {
000062|                         name =["String";"prototype";"toUppercase"];
000063|                         args = [];
000064|                         num_args = 0;
000065|                         vararg = false;
000066|                         code = fun env -> (*[2]*)raise (CFReturn (RStringValue(String.uppercase (get_this env))))
000067|                 };
000068|                 {
000069|                         name =["String";"prototype";"toLowercase"];
000070|                         args = [];
000071|                         num_args = 0;
000072|                         vararg = false;
000073|                         code = fun env -> (*[2]*)raise (CFReturn (RStringValue(String.lowercase (get_this env))))
000074|                 };
000075|                 {
000076|                         name =["String";"prototype";"toFirstUpper"];
000077|                         args = [];
000078|                         num_args = 0;
000079|                         vararg = false;
000080|                         code = fun env -> (*[2]*)raise (CFReturn (RStringValue(String.capitalize (get_this env))))
000081|                 };
000082|                 {
000083|                         name =["String";"prototype";"toFirstLower"];
000084|                         args = [];
000085|                         num_args = 0;
000086|                         vararg = false;
000087|                         code = fun env -> (*[2]*)raise (CFReturn (RStringValue(String.uncapitalize (get_this env))))
000088|                 };
000089|                 {
000090|                         name =["String";"prototype";"charAt"];
000091|                         args = ["index"];
000092|                         num_args = 1;
000093|                         vararg = false;
000094|                         code = fun env ->
000095|                                                 match env.stackframes.(0).(1) with
000096|                                                         RIntegerValue(index) ->
000097|                                                                 ((*[4]*)try
000098|                                                                         (*[4]*)raise (CFReturn (RStringValue (String.make 1 (String.get (get_this env) index))))
000099|                                                                 with
000100|                                                                 | Invalid_argument _ -> (*[2]*)raise (LibraryError ("invalid index "^(string_of_int index)^" in call to charAt")))
000101|                                                 | _ -> (*[2]*)raise (LibraryError "argument index in charAt should be an integer")
000102|                 };
000103|                 {
000104|                         name =["String";"prototype";"indexOf"];
000105|                         args = ["substring"];
000106|                         num_args = 1;
000107|                         vararg = false;
000108|                         code = fun env ->
000109|                                                 (*[4]*)let substring = string_of_value (env.stackframes.(0).(1))
000110|                                                 in (*[4]*)raise (CFReturn (RIntegerValue(indexOf (get_this env) substring)))
000111|                 };
000112|                 {
000113|                         name =["String";"prototype";"substr"];
000114|                         args = ["start";"length"];
000115|                         num_args = 2;
000116|                         vararg = false;
000117|                         code = fun env ->
000118|                                                 match env.stackframes.(0).(1) with
000119|                                                 | RIntegerValue(start) ->
000120|                                                                 (match env.stackframes.(0).(2) with
000121|                                                                         | RIntegerValue(length) -> (*[4]*)raise (CFReturn (RStringValue(String.sub (get_this env) start length)))
000122|                                                                         | _ -> (*[2]*)raise (LibraryError "length in substr should be an integer"))
000123|                                                 | _ -> (*[2]*)raise (LibraryError "start in substr should be an integer")
000124|                 };
000125|                 {
000126|                         name =["String";"prototype";"startsWith"];
000127|                         args = ["substring"];
000128|                         num_args = 1;
000129|                         vararg = false;
000130|                         code = fun env ->
000131|                                                 (*[4]*)let substring = string_of_value (env.stackframes.(0).(1))
000132|                                                 in (*[4]*)raise (CFReturn (RBooleanValue(substring = String.sub (get_this env) 0 (String.length substring))))
000133|                 };
000134|                 {
000135|                         name =["String";"prototype";"endsWith"];
000136|                         args = ["substring"];
000137|                         num_args = 1;
000138|                         vararg = false;
000139|                         code = fun env ->
000140|                                                 (*[4]*)let ss = string_of_value (env.stackframes.(0).(1))
000141|                                                 in (*[4]*)let s = get_this env
000142|                                                 in (*[4]*)raise (CFReturn (RBooleanValue(ss = String.sub s (String.length s - String.length ss) (String.length ss))))
000143|                 };
000144|                 {
000145|                         name =["String";"prototype";"replaceAll"];
000146|                         args = ["substring";"replacement"];
000147|                         num_args = 2;
000148|                         vararg = false;
000149|                         code = fun env ->
000150|                                                 (*[6]*)let substr = string_of_value (env.stackframes.(0).(1))
000151|                                                 in (*[6]*)let repl = string_of_value (env.stackframes.(0).(2))
000152|                                                 in (*[6]*)let s = get_this env
000153|                                                 in (*[6]*)let ssl = String.length substr in
000154|                                                 (*[6]*)let rec loop str =
000155|                                                         match indexOf str substr with
000156|                                                         | - 1 -> (*[6]*)raise (CFReturn(RStringValue str))
000157|                                                         | i -> (*[16]*)loop ((String.sub str 0 i)^ repl ^
000158|                                                                                         (String.sub str (i + ssl)
000159|                                                                                                         (String.length str - ssl - i)))
000160|                                                 in (*[6]*)loop s
000161|                 };
000162|                 {
000163|                         name =["String";"prototype";"split"];
000164|                         args = ["delim"];
000165|                         num_args = 1;
000166|                         vararg = false;
000167|                         code = fun env ->
000168|                                                 (*[2]*)let str = get_this env
000169|                                                 in (*[2]*)let substr = string_of_value (env.stackframes.(0).(1))
000170|                                                 in (*[2]*)let result = Hashtbl.create 10
000171|                                                 in (*[2]*)let rec loop s ind =
000172|                                                         match indexOf s substr with
000173|                                                         | - 1 -> (*[2]*)Hashtbl.add result (string_of_int ind) (RStringValue(s));
000174|                                                                         (*[2]*)Hashtbl.add result "length" (RIntegerValue(ind + 1));
000175|                                                                         (*[2]*)raise (CFReturn (RMapValue(result, ArraySubtype)))
000176|                                                         | i -> (*[6]*)let offset = i + String.length substr in
000177|                                                                         (*[6]*)Hashtbl.add result (string_of_int ind) (RStringValue(String.sub s 0 i));
000178|                                                                         (*[6]*)loop (String.sub s offset (String.length s - offset)) (ind + 1) in
000179|                                                 (*[2]*)loop str 0
000180|                 };
000181|                 {
000182|                         name =["String";"prototype";"parseInt"];
000183|                         args = [];
000184|                         num_args = 0;
000185|                         vararg = false;
000186|                         code = fun env ->
000187|                                                 (*[6]*)raise (CFReturn( try (*[6]*)RIntegerValue(int_of_string (get_this env)) with Failure _ -> (*[4]*)RVoid ))
000188|                 };
000189|                 {
000190|                         name =["String";"prototype";"parseFloat"];
000191|                         args = [];
000192|                         num_args = 0;
000193|                         vararg = false;
000194|                         code = fun env ->
000195|                                                 (*[4]*)raise (CFReturn( try (*[4]*)RFloatValue(float_of_string (get_this env)) with Failure _ -> (*[2]*)RVoid ))
000196|                 };
000197|                 {
000198|                         name =["String";"prototype";"mreplace"];
000199|                         args =["substrings";"values"];
000200|                         num_args = 2;
000201|                         vararg = false;
000202|                         code = fun env ->
000203|                                                 (*[24]*)let rec make_array result = function
000204|                                                         | [] -> (*[48]*)Array.of_list(List.rev result)
000205|                                                         | v:: tl -> (*[38]*)make_array ((string_of_value v):: result) tl
000206|                                                 in (*[24]*)let string = string_of_value env.stackframes.(0).(0)
000207|                                                 in (*[24]*)let substrings = make_array [] ( list_of_array env.stackframes.(0).(1))
000208|                                                 in (*[24]*)let values = make_array [] (list_of_array env.stackframes.(0).(2))
000209|                                                 in (*[24]*)let len = Array.length substrings
000210|                                                 in (*[24]*)if len!= Array.length values then
000211|                                                         (*[2]*)raise (LibraryError "substrings and values arrays should have the same length in String.prototype.mreplace")
000212|                                                 else
000213|                                                         (*[22]*)let rec loop_replacements result ind =
000214|                                                                 (*[38]*)if ind = len then
000215|                                                                         (*[22]*)result
000216|                                                                 else
000217|                                                                         (*[16]*)let substring = substrings.(ind)
000218|                                                                         in (*[16]*)let len = String.length substring
000219|                                                                         in (*[16]*)let rec loop_string string result offset =
000220|                                                                                 match indexOf string substring with
000221|                                                                                 | - 1 -> (*[16]*)result
000222|                                                                                 | pos ->
000223|                                                                                                 (*[20]*)if pos + len!= String.length string then
000224|                                                                                                         (*[18]*)loop_string (String.sub string (pos + len) ((String.length string) - pos - len) ) (pos + offset:: result) (offset + pos + len)
000225|                                                                                                 else
000226|                                                                                                         (*[2]*)loop_string "" (pos + offset:: result) (offset + pos + len)
000227|                                                                         in (*[16]*)let positions = loop_string string [] 0
000228|                                                                         in (*[16]*)loop_replacements ((values.(ind), len, positions) :: result) (ind + 1)
000229|                                                         in (*[22]*)let replacements = loop_replacements [] 0
000230|                                                         in (*[22]*)let replace str i ssl repl =
000231|                                                                 (*[20]*)(String.sub str 0 i)^ repl ^ (String.sub str (i + ssl) (String.length str - ssl - i))
000232|                                                         in (*[22]*)let rec loop_values result_string offset = function
000233|                                                                 | [] -> (*[22]*)result_string
000234|                                                                 | repl:: tl ->
000235|                                                                                 (*[16]*)let (value, len, positions) = repl
000236|                                                                                 in (*[16]*)let delta = String.length value - len
000237|                                                                                 in (*[16]*)let rec loop_repl result_string offset = function
000238|                                                                                         | [] -> ((*[16]*)offset, result_string)
000239|                                                                                         | pos:: tl ->
000240|                                                                                                         (*[20]*)loop_repl (replace result_string pos len value) (offset+delta) tl
000241|                                                                                 in (*[16]*)let (offset, result_string) = loop_repl result_string offset positions
000242|                                                                                 in (*[16]*)loop_values result_string offset tl
000243|                                                         in (*[22]*)let result = loop_values string 0 replacements
000244|                                                         in (*[22]*)raise (CFReturn(RStringValue(result)))
000245|                 };
000246|                 ], env)

Legend:
   some code - line containing no point
   some code - line containing only visited points
   some code - line containing only unvisited points
   some code - line containing both visited and unvisited points