
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)