Statistics: |
|
|
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| Evaluation of binary operations and comparaison of values
000012| Various helper functions for expression evaluation
000013|
000014| @author Tony BenBrahim < tony.benbrahim at gmail.com >
000015|
000016| *)
000017|
000018| open Ast
000019| open RuntimeError
000020|
000021| (**
000022| Converts a MapValue array to a list of values
000023| @param arr array
000024| @return a list of values
000025| *)
000026| let list_of_array arr =
000027| match arr with
000028| | RMapValue(h, ArraySubtype) -> (
000029| match Hashtbl.find h "length" with
000030| | RIntegerValue(0) ->(*[38]*)[]
000031| | RIntegerValue(len) ->
000032| (*[772]*)let rec loop lst ind =
000033| ((*[1950]*)let lst = (Hashtbl.find h (string_of_int ind)):: lst in
000034| (*[1950]*)if ind = 0 then (*[772]*)lst else ((*[1178]*)loop lst (ind - 1)))
000035| in (*[772]*)loop [] (len - 1)
000036| | _ -> (*[0]*)raise (RuntimeError.InternalError "inconsistent array/length not found")
000038| | _ -> (*[0]*)raise (RuntimeError.InternalError "inconsistent array/not an array")
000040| (**
000041| Converts a value to a string
000042| @param value the value to convert
000043| @return a string representing the value
000044| *)
000045| let rec string_of_value = function
000046| | RStringValue(s) -> (*[4182]*)s
000047| | RIntegerValue(i) -> (*[142]*)string_of_int i
000048| | RFloatValue(f) -> (*[6]*)string_of_float f
000049| | RBooleanValue(b) -> (*[4]*)string_of_bool b
000050| | RMapValue(t, ArraySubtype) as v ->
000051| (*[2]*)let lst = list_of_array v
000052| in (*[2]*)let rec loop s = function
000053| | [] -> (*[2]*)s^"]"
000054| | v::[] -> (*[2]*)loop (s^(string_of_value v)) []
000055| | v:: tl -> (*[0]*)loop (s^(string_of_value v)^", ") tl
000057| | RMapValue(t, MapSubtype) ->
000058| (*[40]*)(Hashtbl.fold (fun prop v s ->
000059| (*[102]*)s^prop^": "^(string_of_value v)^";") t "{")^"}"
000060| | RFunctionValue(_, _, _, _, _, _, _) | RLibraryFunction(_) -> (*[100]*)"function"
000061| | RVoid -> (*[2]*)"void"
000062| | RUndefined -> (*[0]*)"undefined"
000064| (**
000065| enumeration of a value's possible types
000066| *)
000067| type valuetype =
000068| | IntegerType
000069| | FloatType
000070| | BooleanType
000071| | StringType
000072| | FunctionType
000073| | LibraryCallType
000074| | MapType
000075| | ArrayType
000076| | VoidType
000077| | NaNType
000078| | UndefinedType
000079|
000080| (**
000081| Returns a value's type
000082| @param a value
000083| @return the value's type
000084| *)
000085| let value_type = function
000086| | RIntegerValue(_) -> (*[11546]*)IntegerType
000087| | RFloatValue(_) -> (*[0]*)FloatType
000090| | RFunctionValue(_, _, _, _, _, _, _) -> (*[0]*)FunctionType
000091| | RLibraryFunction(_) -> (*[0]*)LibraryCallType
000093| | RMapValue(_, ArraySubtype _) -> (*[2]*)ArrayType
000094| | RVoid -> (*[0]*)VoidType
000095| | RUndefined -> (*[0]*)UndefinedType
000097| (**
000098| returns a string name for a value's type
000099| @param value a value
000100| @return string name for the value's type
000101| *)
000102| let string_of_value_type = function
000103| | RStringValue(s) -> (*[2]*)"string"
000104| | RIntegerValue(i) -> (*[16]*)"integer"
000105| | RFloatValue(f) -> (*[0]*)"float"
000107| | RMapValue(_, ArraySubtype) ->(*[2]*)"array"
000108| | RMapValue(_, MapSubtype) -> (*[0]*)"map"
000109| | RFunctionValue(_, _, _, _, _, _, _) | RLibraryFunction(_) -> (*[0]*)"function"
000110| | RVoid -> (*[0]*)"void"
000111| | RUndefined -> (*[0]*)"undefined"
000113| (** type to hold the result of casting two values to the same type *)
000114| type cast_type =
000115| | IntegerCast of int * int
000116| | FloatCast of float * float
000117| | StringCast of string * string
000118| | BoolCast of bool * bool
000119|
000120| let cast_to_integer value =
000121| match value with
000122| | RIntegerValue(i) -> (*[2022]*)i
000123| | _ -> (*[0]*)raise (EInvalidCast (string_of_value_type value,"integer"))
000127| | RFloatValue(f) -> (*[0]*)f
000128| | RIntegerValue(i) -> (*[0]*)float_of_int i
000129| | _ -> (*[0]*)raise (EInvalidCast (string_of_value_type value,"float"))
000131| (**
000132| Evaluate the operation
000133| @param value1 the first value
000134| @param value2 the second value
000135| @param operator the operator
000136| @return the value that results from the operation
000137| *)
000138| let evaluate_op value1 value2 operator =
000139| (*[6650]*)let string_of_operator = function
000140| | Plus -> (*[2]*)"+"
000141| | Minus -> (*[0]*)"-"
000142| | Times -> (*[0]*)"*"
000143| | Divide -> (*[0]*)"/"
000144| | Modulo -> (*[0]*)"%"
000145| | Or -> (*[0]*)"||"
000147| in (*[6650]*)let string_op s1 s2 =
000148| (match operator with
000149| | Plus -> (*[60]*)RStringValue(s1 ^ s2)
000150| | _ -> (*[0]*)raise (EInvalidOperation (string_of_operator operator,"string"))
000152| in (*[6650]*)let float_op f1 f2 = ((*[18]*)let f = (match operator with
000153| | Plus -> (*[6]*)f1 +. f2
000154| | Minus -> (*[4]*)f1 -. f2
000155| | Times -> (*[2]*)f1 *. f2
000156| | Divide -> (*[6]*)f1 /. f2
000157| | _ -> (*[0]*)raise (EInvalidOperation (string_of_operator operator,"float"))) in
000159| )
000160| in match (value1, value2) with
000161| | (RIntegerValue(i1), RIntegerValue(i2)) ->
000162| (match operator with
000163| | Plus -> (*[5744]*)RIntegerValue( i1 + i2 )
000164| | Minus -> (*[26]*)RIntegerValue( i1 - i2)
000165| | Times -> (*[12]*)RIntegerValue( i1 * i2)
000166| | Divide -> (*[8]*)RIntegerValue( i1 / i2)
000167| | Modulo -> (*[404]*)RIntegerValue( i1 mod i2)
000168| | _ -> (*[2]*)raise (EInvalidOperation (string_of_operator operator,"integer"))
000169| )
000170| | (RBooleanValue(b1), RBooleanValue(b2)) ->
000171| (match operator with
000172| | And -> (*[334]*)RBooleanValue((*[334]*)b1 && (*[334]*)b2)
000173| | Or -> (*[38]*)RBooleanValue((*[38]*)b1 || (*[30]*)b2)
000174| | _ -> (*[2]*)raise (EInvalidOperation (string_of_operator operator,"boolean"))
000175| )
000176| | (RFloatValue(f1), RFloatValue(f2)) -> (*[8]*)float_op f1 f2
000177| | (RFloatValue(f1), RIntegerValue(i2)) -> (*[6]*)float_op f1 (float_of_int i2)
000178| | (RIntegerValue(i1), RFloatValue(f2)) -> (*[4]*)float_op (float_of_int i1) f2
000179| | (RStringValue(s1), RStringValue(s2)) -> (*[56]*)string_op s1 s2
000180| | (RStringValue(s1), v2) -> (*[2]*)string_op s1 (string_of_value v2)
000181| | (v1, RStringValue(s2)) -> (*[2]*)string_op (string_of_value v1) s2
000182| | (value1, value2) -> (*[2]*)raise (EIncompatibleTypes(string_of_value_type value1, string_of_value_type value2))
000183|
000184| (**
000185| Implements comparaison of two values, according to the following semantics:
000186|
000187| Value 1 type Value 2 type Operator Result
000188| -------------- -------------- ----------- -----------------------------------------------------------------------
000189| Integer Integer Any Comparison of integer values
000190| Float Float Any Comparison of float values
000191| Float Integer Any Comparison of float values
000192| String any type Float comparison of first value to second value,
000193| Integer with non string values converted to strings
000194| String
000195| Both types are Booleans,
000196| maps, arrays, functions,
000197| NaN or void == and != comparison of first value to second value,
000198| observing the semantics of equality described below.
000199| Different types not listed
000200| above == and != == always returns false != always returns true
000201|
000202| @param v1 the first value to compare
000203| @param op the comparaison operator
000204| @param v2 the second value to compare
000205| @return a boolean value type
000206| *)
000207| let rec compare v1 op v2 =
000208| match v1 with
000209| | RIntegerValue(i1) ->
000210| (match v2 with
000211| | RIntegerValue(i2) ->
000212| (match op with
000213| | Equal -> (*[750]*)RBooleanValue(i1 = i2)
000214| | NotEqual -> (*[2046]*)RBooleanValue(i1 <> i2)
000215| | LessThan -> (*[2462]*)RBooleanValue(i1 < i2)
000216| | LessThanEqual -> (*[6]*)RBooleanValue(i1 <= i2)
000217| | GreaterThan -> (*[2]*)RBooleanValue(i1 > i2)
000218| | GreaterThanEqual -> (*[48]*)RBooleanValue(i1 >= i2) )
000219| | RFloatValue(f2) -> (*[16]*)compare (RFloatValue (float_of_int i1)) op v2
000220| | RStringValue(s2) -> (*[16]*)compare (RStringValue (string_of_int i1)) op v2
000221| | _ -> (*[2]*)mismatched_compare v1 op v2 )
000222| | RStringValue(s1) ->
000223| (match v2 with
000224| | RStringValue(s2) ->
000225| (match op with
000226| | Equal -> (*[184]*)RBooleanValue(s1 = s2)
000227| | NotEqual -> (*[324]*)RBooleanValue(s1 <> s2)
000228| | LessThan -> (*[10]*)RBooleanValue(s1 < s2)
000229| | LessThanEqual -> (*[20]*)RBooleanValue(s1 <= s2)
000230| | GreaterThan -> (*[10]*)RBooleanValue(s1 > s2)
000231| | GreaterThanEqual -> (*[20]*)RBooleanValue(s1 >= s2) )
000232| | RIntegerValue(i2) -> (*[16]*)compare v1 op (RStringValue(string_of_int i2))
000233| | RFloatValue(f2) -> (*[16]*)compare v1 op (RStringValue(string_of_float f2))
000234| | _ -> (*[2]*)mismatched_compare v1 op v2 )
000235| | RBooleanValue(b1) ->
000236| (match v2 with
000237| | RBooleanValue(b2) -> (
000238| match op with
000239| | Equal -> (*[12]*)RBooleanValue(b1 = b2)
000240| | NotEqual -> (*[2]*)RBooleanValue(b1 <> b2)
000241| | _ -> (*[2]*)raise (EInvalidComparaison(opname op, string_of_value_type v1, string_of_value_type v2)) )
000242| | _ -> (*[10]*)mismatched_compare v1 op v2 )
000243| | RVoid ->
000244| (match v2 with
000245| | RVoid -> (
000246| match op with
000247| | Equal -> (*[8]*)RBooleanValue(true)
000248| | NotEqual -> (*[2]*)RBooleanValue(false)
000249| | _ -> (*[0]*)raise (EInvalidComparaison(opname op, string_of_value_type v1, string_of_value_type v2)) )
000251| | RFloatValue(f1) ->
000252| (match v2 with
000253| | RFloatValue(f2) ->
000254| (match op with
000255| | Equal -> (*[32]*)RBooleanValue(f1 = f2)
000256| | NotEqual -> (*[6]*)RBooleanValue(f1 <> f2)
000257| | LessThan -> (*[6]*)RBooleanValue(f1 < f2)
000258| | LessThanEqual -> (*[12]*)RBooleanValue(f1 <= f2)
000259| | GreaterThan -> (*[6]*)RBooleanValue(f1 > f2)
000260| | GreaterThanEqual -> (*[12]*)RBooleanValue(f1 >= f2) )
000261| | RIntegerValue(i2) -> (*[18]*)compare v1 op (RFloatValue (float_of_int i2))
000262| | RStringValue(s2) -> (*[16]*)compare (RStringValue(string_of_float f1)) op v2
000263| | _ -> (*[2]*)mismatched_compare v1 op v2 )
000264| | RMapValue(h1, ArraySubtype) ->
000265| (match v2 with
000266| | RMapValue(h2, ArraySubtype) -> (
000267| match op with
000268| | Equal -> (*[38]*)RBooleanValue(hashtbl_equal h1 h2)
000269| | NotEqual -> (*[6]*)RBooleanValue(not (hashtbl_equal h1 h2))
000270| | _ -> (*[0]*)raise (EInvalidComparaison(opname op,
000272| string_of_value_type v2)) )
000273| | _ -> (*[2]*)mismatched_compare v1 op v2 )
000274| | RMapValue(h1, MapSubtype) ->
000275| (match v2 with
000276| | RMapValue(h2, MapSubtype) -> (
000277| match op with
000278| | Equal -> (*[14]*)RBooleanValue(hashtbl_equal h1 h2)
000279| | NotEqual -> (*[6]*)RBooleanValue(not (hashtbl_equal h1 h2))
000280| | _ -> (*[0]*)raise (EInvalidComparaison(opname op,
000282| string_of_value_type v2)) )
000283| | _ -> (*[2]*)mismatched_compare v1 op v2 )
000284| | RFunctionValue(size1, depth1, len1, varargs1, stmts1, clos1, inline1) ->
000285| (match v2 with
000286| | RFunctionValue(size2, depth2, len2, varargs2, stmts2, clos2, inline2) -> (
000287| match op with
000288| | Equal -> (*[2]*)RBooleanValue((*[2]*)size1 = size2 && (*[2]*)stmts1 = stmts2)
000289| | NotEqual -> (*[6]*)RBooleanValue(not ((*[6]*)size1 = size2 && (*[6]*)stmts1 = stmts2))
000290| | _ -> (*[0]*)raise (EInvalidComparaison(opname op,
000292| string_of_value_type v2)) )
000293| | _ -> (*[2]*)mismatched_compare v1 op v2 )
000294| | RLibraryFunction(def1) ->
000295| (match v2 with
000296| | RLibraryFunction(def2) ->
000297| ( match op with
000298| | Equal -> (*[2]*)RBooleanValue(def1 == def2)
000299| | NotEqual -> (*[6]*)RBooleanValue(not (def1 == def2))
000300| | _ -> (*[0]*)raise (EInvalidComparaison(opname op,
000302| string_of_value_type v2)) )
000303| | _ -> (*[2]*)mismatched_compare v1 op v2 )
000304| | RUndefined -> (*[0]*)raise (RuntimeError.InternalError "unexpected value in compare")
000306| | LessThan -> (*[0]*)"<"
000307| | LessThanEqual -> (*[0]*)"<="
000308| | Equal -> (*[0]*)"=="
000309| | NotEqual ->(*[0]*)"!="
000310| | GreaterThanEqual -> (*[0]*)">="
000312| and hashtbl_equal h1 h2 =
000313| (*[64]*)(Hashtbl.length h1) = (Hashtbl.length h2) &&
000314| (*[64]*)try
000315| (*[64]*)Hashtbl.fold (fun k v init -> (*[232]*)init && (*[194]*)(compare (Hashtbl.find h2 k) Equal v) = RBooleanValue(true) ) h1 true
000316| with
000317| | Not_found -> (*[2]*)false
000318| and mismatched_compare v1 op v2 =
000319| match op with
000320| | Equal -> (*[6]*)RBooleanValue(false)
000321| | NotEqual -> (*[22]*)RBooleanValue(true)
000322| | _ -> (*[0]*)raise (EInvalidComparaison(opname op, string_of_value_type v1, string_of_value_type v2))
000324| Makes a stack frame from the supplied value list
000325| @param size size of stack frame
000326| @param vararg true if the last argument is a vararg, false otherwise
000327| @param value_list list of values to add to the stack frame
000328| @param this the value of this
000329| @return a stack frame (an array of values)
000330| *)
000331| and make_stackframe size numargs vararg value_list this =
000332| (*[3842]*)let stackframe = Array.make (size + 1) RUndefined
000333| in (*[3842]*)let rec loop_single_values = function
000334| | (0, _, rest) -> (*[3838]*)rest
000335| | (num_left, ind, value:: rest) ->
000336| (*[2826]*)stackframe.(ind) <- value;
000337| (*[2826]*)loop_single_values (num_left - 1, ind + 1, rest)
000338| | (num_left, ind,[]) -> (*[4]*)raise (EMismatchedFunctionArgs (numargs, List.length value_list))
000339| in (*[3842]*)let rest = loop_single_values ((if vararg then (*[730]*)numargs - 1 else (*[3112]*)numargs), 1, value_list)
000340| in ((match (rest, vararg) with
000341| | (list, true) -> (*[730]*)stackframe.(numargs) <- array_of_value_list(list)
000342| | ([] , false) -> (*[3106]*)()
000343| | (_, false) ->
000344| (*[2]*)raise (EMismatchedFunctionArgs (numargs, List.length value_list))));
000345| (*[3836]*)stackframe.(0) <- this;
000346| (*[3836]*)stackframe
000347| (**
000348| Creates an Array from a list of values
000349| @param value_list a list of values
000350| @return a MapValue with the array
000351| *)
000352| and array_of_value_list value_list =
000353| (*[730]*)let rec loop = function
000354| | (_,[], h) -> (*[730]*)h
000355| | (ind, value:: rest, h) ->
000356| (*[1560]*)Hashtbl.replace h (string_of_int ind) value;
000357| (*[1560]*)loop (ind + 1, rest, h)
000358| in (*[730]*)let length = List.length value_list
000359| in (*[730]*)let h = Hashtbl.create (length + 1)
000360| in (*[730]*)Hashtbl.replace h "length" (RIntegerValue(length));
000361| (*[730]*)RMapValue(loop (0, value_list, h), ArraySubtype)