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



Statistics:  
kind coverage
binding 18 / 19 (94 %)
sequence 8 / 8 (100 %)
for 0 / 0 (- %)
if/then 7 / 10 (70 %)
try 5 / 5 (100 %)
while 0 / 0 (- %)
match/function 50 / 57 (87 %)
kind coverage
class expression 0 / 0 (- %)
class initializer 0 / 0 (- %)
class method 0 / 0 (- %)
class value 0 / 0 (- %)
toplevel expression 0 / 0 (- %)
lazy operator 2 / 2 (100 %)



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| Operations on AST analysis and runtime environments
000012|  
000013| @author Tony BenBrahim < tony.benbrahim at gmail.com >
000014|  
000015| *)
000016|  
000017| open Ast
000018|  
000019| module StringMap = Map.Make(String)
000020|  
000021| (**
000022| @param field1 index into scope
000023| @param field2 unique id
000024| *)
000025| type var_info = (int * int)
000026|  
000027| (**
000028| represents variables map in a global or local scope, and reference to parent scope
000029| *)
000030| type rec_varmap ={
000031|         variable_map: var_info StringMap.t;
000032|         parent: rec_varmap option;
000033| }
000034|  
000035| (**
000036| Properties of variable locations
000037| *)
000038| type var_prop ={
000039|         written_after_declared: bool;
000040|         read_after_declared: bool;
000041|         declaration_loc: string * int;
000042| }
000043|  
000044| type label_pos = int * int * int * int
000045|  
000046| type template_spec_def = (template_spec list * (string , label_pos ) Hashtbl.t * (string * int))
000047|  
000048| (**
000049| The analysis environment
000050| *)
000051| type analysis_env ={
000052|         globals: rec_varmap;
000053|         num_globals: int;
000054|         locals: rec_varmap list; (* one item for each stackframe depth, head is current *)
000055|         num_locals: int list;
000056|         sdepth: int;
000057|         max_depth: int;
000058|         errors: string list;
000059|         warnings: string list;
000060|         unique_id: int;
000061|         names: string list;
000062|         varprops: (int, var_prop) Hashtbl.t;
000063|         imported: string list;
000064|         templates: (string, template_spec_def) Hashtbl.t;
000065|         constants: (int, runtime_variable_value) Hashtbl.t;
000066| }
000067|  
000068| (**
000069| returns a newly initialized analysis environment
000070| @return analysis_env
000071| *)
000072| let new_analysis_environment () =
000073|         (*[2]*){
000074|                 globals ={ variable_map = StringMap.empty; parent = None };
000075|                 num_globals = 0;
000076|                 locals =[];
000077|                 num_locals = [];
000078|                 sdepth = 0;
000079|                 max_depth = 0;
000080|                 errors =[];
000081|                 warnings =[];
000082|                 unique_id = 0;
000083|                 varprops = Hashtbl.create 10;
000084|                 names =[];
000085|                 imported =[];
000086|                 templates = Hashtbl.create 1;
000087|                 constants = Hashtbl.create 10;
000088|         }
000089|  
000090| (**
000091| sets the declaration value for a variable
000092| @param env analysis environment
000093| @param uid unique id of variable
000094| @param value runtime value of variable
000095| @return unit
000096| *)
000097| let set_constant_value env uid value =
000098|         (*[364]*)Hashtbl.replace env.constants uid value
000099|  
000100| (**
000101| gets the constant value for a variable
000102| @param env analysis environment
000103| @param uid unique id of variable
000104| @return runtime value of variable
000105| *)
000106| let get_constant_value env uid =
000107|         (*[602]*)Hashtbl.find env.constants uid
000108|  
000109| (**
000110| returns whether the variable is a constant
000111| @param env analysis environment
000112| @param uid unique id of variable
000113| @return true if the variable is a constant
000114| *)
000115| let is_constant env uid =
000116|         (*[1412]*)let varprop = Hashtbl.find env.varprops uid
000117|         in (*[1412]*)let (_, line) = varprop.declaration_loc
000118|         in (*[1412]*)not varprop.written_after_declared && (*[930]*)line!= 0
000119|         
000120| (**
000121| declare a variable if it does not exist or create a new entry and return new index
000122| @param name name of variable to declare
000123| @param env analysis environment
000124| @return a tuple of the modified environment and uid
000125| *)
000126| let declare_variable env name =
000127|         (*[1006]*)let find_or_declare varmaps nextind uid =
000128|                 (*[1006]*)try (*[1006]*)let (_, uid) = StringMap.find name varmaps in ((*[16]*)varmaps, 0, uid)
000129|                 with Not_found -> ((*[990]*)StringMap.add name (nextind, uid) varmaps, 1, uid)
000130|         in
000131|         match env.locals with
000132|         | [] ->
000133|                         (*[48]*)let ( map, num_added, uid) = find_or_declare env.globals.variable_map env.num_globals env.unique_id
000134|                         in
000135|                         ((*[48]*){ globals ={ variable_map = map; parent = env.globals.parent };
000136|                                         num_globals = env.num_globals + num_added;
000137|                                         locals = env.locals;
000138|                                         num_locals = env.num_locals;
000139|                                         sdepth = env.sdepth;
000140|                                         max_depth = env.max_depth;
000141|                                         errors = env.errors;
000142|                                         warnings = env.warnings;
000143|                                         unique_id = env.unique_id + num_added;
000144|                                         names = if num_added = 0 then (*[0]*)env.names else (*[48]*)name:: env.names;
000145|                                         varprops = env.varprops;
000146|                                         imported = env.imported;
000147|                                         templates = env.templates;
000148|                                         constants = env.constants;
000149|                                 }, uid)
000150|         | _ ->
000151|                         (*[958]*)let (map, num_added, uid) = find_or_declare (List.hd env.locals).variable_map (List.hd env.num_locals) env.unique_id
000152|                         in
000153|                         ((*[958]*){ globals = env.globals;
000154|                                         num_globals = env.num_globals;
000155|                                         locals ={ variable_map = map; parent = (List.hd env.locals).parent }:: List.tl env.locals;
000156|                                         num_locals = ((List.hd env.num_locals) + num_added):: List.tl env.num_locals;
000157|                                         sdepth = env.sdepth;
000158|                                         max_depth = env.max_depth;
000159|                                         errors = env.errors;
000160|                                         warnings = env.warnings;
000161|                                         unique_id = env.unique_id + num_added;
000162|                                         names = if num_added = 0 then (*[16]*)env.names else (*[942]*)name:: env.names;
000163|                                         varprops = env.varprops;
000164|                                         imported = env.imported;
000165|                                         templates = env.templates;
000166|                                         constants = env.constants;
000167|                                 }, uid)
000168|  
000169| (**
000170| declare a variable if it does not exist or create a new entry and return new index,
000171| then sets constant value
000172| @param name name of variable to declare
000173| @param env analysis environment
000174| @param value
000175| @return the modified environment
000176| *)
000177| let declare_variable_and_value name env value =
000178|         (*[42]*)let (env, uid) = declare_variable name env
000179|         in (*[42]*)set_constant_value env uid value; (*[42]*)env
000180|  
000181| (** internal exception used during analysis *)
000182| exception Variable_not_found of string
000183|  
000184| (**
000185| Find variable in analysis scope
000186| @param name the variable name
000187| @param env the analysis environment
000188| @return location
000189| @throws Variable_not_found when the variable is not found
000190| *)
000191| let resolve_variable name env =
000192|         (*[1840]*)let rec find scopes =
000193|                 (*[2848]*)try
000194|                         (*[2848]*)let (ind, uid) = StringMap.find name scopes.variable_map
000195|                         in ((*[1840]*)uid, ind)
000196|                 with Not_found ->
000197|                                 (match scopes.parent with
000198|                                         | Some parent -> (*[634]*)find parent
000199|                                         | None -> (*[374]*)raise Not_found)
000200|         in
000201|         (*[1840]*)let rec find_in_stackframes = function
000202|                 | [] -> (*[204]*)raise Not_found
000203|                 | scope:: tl ->
000204|                                 (*[1918]*)try
000205|                                         (*[1918]*)let (uid, ind) = find scope
000206|                                         in ((*[1544]*)LocalVar(uid, List.length tl, ind))
000207|                                 with
000208|                                 | Not_found -> (*[374]*)find_in_stackframes tl
000209|         in
000210|         (*[1840]*)try
000211|                 match env.locals with
000212|                 | [] -> (*[92]*)let (uid, ind) = find env.globals in ((*[92]*)GlobalVar(uid, ind))
000213|                 | _ -> ((*[1748]*)try
000214|                                         (*[1748]*)find_in_stackframes env.locals
000215|                                 with Not_found ->
000216|                                                 (*[204]*)let (uid, ind) = find env.globals in ((*[204]*)GlobalVar(uid, ind)))
000217|         with Not_found -> (*[0]*)raise (Variable_not_found name)
000218|  
000219| (**
000220| returns uid from location
000221| @param loc the variable location
000222| @return uid
000223| *)
000224| let uid_from_loc = function
000225|         | GlobalVar(uid, _) -> (*[302]*)uid
000226|         | LocalVar(uid, _, _) -> (*[1296]*)uid
000227|  
000228| (**
000229| Find variable and value in analysis scope
000230| @param name the variable name
000231| @param env the analysis environment
000232| @return tuple of value and location
000233| @throws Variable_not_found when the variable is not found
000234| *)
000235| let resolve_variable_value name env =
000236|         (*[84]*)let loc = resolve_variable name env
000237|         in (*[84]*)let uid = uid_from_loc loc
000238|         in ( (*[84]*)get_constant_value env uid, loc)
000239|  
000240| (**
000241| Setups a new scope within the same global or local scope
000242| @param env analysis environment
000243| @return a new analysis environment setup for the new scope
000244| *)
000245| let new_analysis_scope env =
000246|         match env.locals with
000247|         | [] ->(*[0]*){
000248|                                 globals = { variable_map = StringMap.empty; parent = Some env.globals };
000249|                                 num_globals = env.num_globals;
000250|                                 locals =[];
000251|                                 num_locals = env.num_locals;
000252|                                 sdepth = env.sdepth;
000253|                                 max_depth = env.max_depth;
000254|                                 errors = env.errors;
000255|                                 warnings = env.warnings;
000256|                                 unique_id = env.unique_id;
000257|                                 names = env.names;
000258|                                 varprops = env.varprops;
000259|                                 imported = env.imported;
000260|                                 templates = env.templates;
000261|                                 constants = env.constants;
000262|                         }
000263|         | hd:: tl -> (*[620]*){
000264|                                 globals = env.globals;
000265|                                 num_globals = env.num_globals;
000266|                                 locals ={ variable_map = StringMap.empty; parent = Some hd }:: tl;
000267|                                 num_locals = env.num_locals; (* on new scope, same number of locals *)
000268|                                 sdepth = env.sdepth;
000269|                                 max_depth = env.max_depth;
000270|                                 errors = env.errors;
000271|                                 warnings = env.warnings;
000272|                                 unique_id = env.unique_id;
000273|                                 names = env.names;
000274|                                 varprops = env.varprops;
000275|                                 imported = env.imported;
000276|                                 templates = env.templates;
000277|                                 constants = env.constants;
000278|                         }
000279| (**
000280| Pops the analysis scope
000281| @param env analysis environment
000282| @param old old analysis environment
000283| @return a new environment with the last scope popped
000284| *)
000285| let pop_scope env =
000286|         match env.locals with
000287|         | [] ->
000288|                         (match env.globals.parent with
000289|                                 | Some old_globals -> (*[0]*){
000290|                                                         globals = old_globals;
000291|                                                         num_globals = env.num_globals;
000292|                                                         locals = env.locals;
000293|                                                         num_locals = env.num_locals;
000294|                                                         sdepth = env.sdepth;
000295|                                                         max_depth = env.max_depth;
000296|                                                         errors = env.errors;
000297|                                                         warnings = env.warnings;
000298|                                                         unique_id = env.unique_id;
000299|                                                         names = env.names;
000300|                                                         varprops = env.varprops;
000301|                                                         imported = env.imported;
000302|                                                         templates = env.templates;
000303|                                                         constants = env.constants;
000304|                                                 }
000305|                                 | None -> (*[0]*)raise (RuntimeError.InternalError "popping a top level scope"))
000306|         | local:: tl ->
000307|                         match local.parent with
000308|                         | Some old_parent -> (*[620]*){
000309|                                                 globals = env.globals;
000310|                                                 num_globals = env.num_globals;
000311|                                                 locals = old_parent:: tl;
000312|                                                 num_locals = env.num_locals; (* preserve, we are still in the same stack frame *)
000313|                                                 sdepth = env.sdepth;
000314|                                                 max_depth = env.max_depth;
000315|                                                 errors = env.errors;
000316|                                                 warnings = env.warnings;
000317|                                                 unique_id = env.unique_id;
000318|                                                 names = env.names;
000319|                                                 varprops = env.varprops;
000320|                                                 imported = env.imported;
000321|                                                 templates = env.templates;
000322|                                                 constants = env.constants;
000323|                                         }
000324|                         | None -> (*[360]*){
000325|                                                 globals = env.globals;
000326|                                                 num_globals = env.num_globals;
000327|                                                 locals = tl;
000328|                                                 num_locals = List.tl env.num_locals; (* exiting stack frame, restore old number of locals *)
000329|                                                 sdepth = env.sdepth - 1;
000330|                                                 max_depth = env.max_depth;
000331|                                                 errors = env.errors;
000332|                                                 warnings = env.warnings;
000333|                                                 unique_id = env.unique_id;
000334|                                                 names = env.names;
000335|                                                 varprops = env.varprops;
000336|                                                 imported = env.imported;
000337|                                                 templates = env.templates;
000338|                                                 constants = env.constants;
000339|                                         }
000340|  
000341| (**
000342| Create a new stackframe
000343| @param env analysis environment
000344| @return a new analysis environment with a new stackframe
000345| *)
000346| let new_analysis_stackframe env =
000347|         (*[360]*){
000348|                 globals = env.globals;
000349|                 num_globals = env.num_globals;
000350|                 locals ={ variable_map = StringMap.empty; parent = None }:: env.locals;
000351|                 num_locals = 0:: env.num_locals; (* push new stackframe number of locals *)
000352|                 sdepth = env.sdepth + 1;
000353|                 max_depth = if env.sdepth + 1 > env.max_depth then (*[10]*)env.sdepth + 1 else (*[350]*)env.max_depth;
000354|                 errors = env.errors;
000355|                 warnings = env.warnings;
000356|                 unique_id = env.unique_id;
000357|                 names = env.names;
000358|                 varprops = env.varprops;
000359|                 imported = env.imported;
000360|                 templates = env.templates;
000361|                 constants = env.constants;
000362|         }
000363|  
000364| (**
000365| Returns the depth of the current stack frame
000366| @param env analysis environment
000367| @return the depth of the current stack frame, 0 indexed
000368| *)
000369| let get_depth env =
000370|         (*[720]*)(List.length env.locals) - 1
000371|  
000372| (**
000373| Add an error to the analysis environemnt
000374| @param env the analysis environment
000375| @param codeloc a filename, line number tuple
000376| @param message the error message
000377| @return an analysis environment with the error added
000378| *)
000379| let add_error env codeloc message =
000380|         (*[0]*)let (filename, line_number) = codeloc
000381|         in        (*[0]*){
000382|                 globals = env.globals;
000383|                 num_globals = env.num_globals;
000384|                 locals = env.locals;
000385|                 num_locals = env.num_locals;
000386|                 errors = ("At line "^(string_of_int line_number)^" in "^(Filename.basename filename)^": "^message):: env.errors;
000387|                 sdepth = env.sdepth;
000388|                 max_depth = env.max_depth;
000389|                 warnings = env.warnings;
000390|                 unique_id = env.unique_id;
000391|                 names = env.names;
000392|                 varprops = env.varprops;
000393|                 imported = env.imported;
000394|                 templates = env.templates;
000395|                 constants = env.constants;
000396|         }
000397|  
000398| (**
000399| Add a warning to the analysis environemnt
000400| @param env the analysis environment
000401| @param codeloc a filename, line number tuple
000402| @param message the warning message
000403| @return an analysis environment with the warning added
000404| *)
000405| let add_warning env codeloc message =
000406|         (*[74]*)let (filename, line_number) = codeloc
000407|         in        (*[74]*){
000408|                 globals = env.globals;
000409|                 num_globals = env.num_globals;
000410|                 locals = env.locals;
000411|                 num_locals = env.num_locals;
000412|                 sdepth = env.sdepth;
000413|                 max_depth = env.max_depth;
000414|                 errors = env.errors;
000415|                 warnings = ("At line "^(string_of_int line_number)^" in "^(Filename.basename filename)^": "^message):: env.warnings;
000416|                 unique_id = env.unique_id;
000417|                 names = env.names;
000418|                 varprops = env.varprops;
000419|                 imported = env.imported;
000420|                 templates = env.templates;
000421|                 constants = env.constants;
000422|         }
000423|  
000424| (**
000425| Returns true if there are errors in the environment
000426| @param env the analysis environment
000427| @return true if there are errors, false otherwise
000428| *)
000429| let has_errors env =
000430|         (*[0]*)env.errors!=[]
000431|  
000432| (**
000433| adds an import to the list of imports
000434| @param env analysis environment
000435| @param filename the filename
000436| @return the modified environment
000437| *)
000438| let add_import env filename =
000439|         (*[18]*){
000440|                 globals = env.globals;
000441|                 num_globals = env.num_globals;
000442|                 locals = env.locals;
000443|                 num_locals = env.num_locals;
000444|                 sdepth = env.sdepth;
000445|                 max_depth = env.max_depth;
000446|                 errors = env.errors;
000447|                 warnings = env.warnings;
000448|                 unique_id = env.unique_id;
000449|                 names = env.names;
000450|                 varprops = env.varprops;
000451|                 imported = filename:: env.imported;
000452|                 templates = env.templates;
000453|                 constants = env.constants;
000454|         }
000455|  
000456| (**
000457| type of operation performed on variable
000458| *)
000459| type var_op_type =
000460|         | ReadOp
000461|         | WriteOp
000462|         | DeclareOp of (string * int)
000463|         | DeclareWriteOp of (string * int)
000464|  
000465| (**
000466| Records a variables property
000467| @param env analysis environment
000468| @param loc variable location
000469| @param operation
000470| @return unit
000471| *)
000472| let record_usage env loc op =
000473|         (*[2830]*)let uid = match loc with
000474|                 | GlobalVar(uid, _) -> (*[212]*)uid
000475|                 | LocalVar(uid, _, _) -> (*[2618]*)uid
000476|         in (*[2830]*)let props =
000477|                 try (*[2830]*)Hashtbl.find env.varprops uid
000478|                 with Not_found ->
000479|                                 (*[916]*){ written_after_declared = false;
000480|                                         read_after_declared = false;
000481|                                         declaration_loc = ("", 0);
000482|                                 }
000483|         in (*[2830]*)let new_props =
000484|                 match op with
000485|                 | ReadOp ->
000486|                                 (*[1404]*){ written_after_declared = props.written_after_declared;
000487|                                         read_after_declared = true;
000488|                                         declaration_loc = props.declaration_loc;
000489|                                 }
000490|                 | WriteOp ->
000491|                                 (*[580]*){        written_after_declared = true;
000492|                                         read_after_declared = props.read_after_declared;
000493|                                         declaration_loc = props.declaration_loc;
000494|                                 }
000495|                 | DeclareOp(loc) ->
000496|                                 (match props.declaration_loc with
000497|                                         | ("", 0) ->
000498|                                                         (*[828]*){ written_after_declared = false;
000499|                                                                 read_after_declared = props.read_after_declared;
000500|                                                                 declaration_loc = loc
000501|                                                         }
000502|                                         | _ ->
000503|                                                         (*[16]*){ written_after_declared = true;
000504|                                                                 read_after_declared = props.read_after_declared;
000505|                                                                 declaration_loc = props.declaration_loc
000506|                                                         })
000507|                 | DeclareWriteOp(loc) ->
000508|                                 match props.declaration_loc with
000509|                                 | ("", 0) ->
000510|                                                 (*[0]*){ written_after_declared = true;
000511|                                                         read_after_declared = true;
000512|                                                         declaration_loc = loc
000513|                                                 }
000514|                                 | _ ->
000515|                                                 (*[2]*){ written_after_declared = true;
000516|                                                         read_after_declared = true;
000517|                                                         declaration_loc = props.declaration_loc
000518|                                                 }
000519|         in (*[2830]*)Hashtbl.replace env.varprops uid new_props
000520|  
000521| (**
000522| Adds a template to the environment
000523| @param runtime environment
000524| @param name template name
000525| @param spec_list list of line specifications
000526| @param labels label positions
000527| @return a new environment
000528| **)
000529| let add_template env name spec_list labels cloc =
000530|         (*[4]*)let env = if Hashtbl.mem env.templates name then
000531|                         (*[0]*)add_warning env cloc ("Duplicate template definition '" ^ name ^ "'")
000532|                 else
000533|                         (*[4]*)env
000534|         in (*[4]*)Hashtbl.replace env.templates name (spec_list, labels, cloc); (*[4]*)env
000535|  
000536| (**
000537| checks if a file has already been imported
000538| @param env analysis environment
000539| @param filename the filename to check
000540| @return true if already imported, false otherwise
000541| *)
000542| let has_import env filename =
000543|         (*[18]*)let rec loop = function
000544|                 | [] -> (*[18]*)false
000545|                 | s:: tl -> (*[72]*)if s = filename then (*[0]*)true else (*[72]*)loop tl
000546|         in (*[18]*)loop env.imported
000547|  
000548| (**
000549| Retrieves a value at a location
000550| @param env a runtime environment
000551| @param loc the location of the variable
000552| @return the value at the selected location
000553| *)
000554| let get_value env = function
000555|         | GlobalVar(uid, ind) -> (*[3458]*)let (_, value) = env.heap.(ind) in (*[3458]*)value
000556|         | LocalVar(uid, depth, ind) ->
000557|                         match env.closure_vars with
000558|                         | None -> (*[21132]*)env.stackframes.(depth).(ind)
000559|                         | Some h ->
000560|                                         (*[138]*)try match Hashtbl.find h (depth, ind) with
000561|                                                 | RUndefined -> (*[12]*)env.stackframes.(depth).(ind) (* needed for recursive function defs *)
000562|                                                 | value -> (*[30]*)value
000563|                                         with Not_found -> (*[96]*)env.stackframes.(depth).(ind)
000564|  
000565| (**
000566| Sets a value at a location
000567| @param env a runtime environment
000568| @param value the value to set
000569| @param loc the location of the variable
000570| @return the value that was set
000571| *)
000572| let set_value env value = function
000573|         | GlobalVar(uid, ind) -> (*[8]*)env.heap.(ind) <- (uid, value); (*[8]*)value
000574|         | LocalVar(uid, depth, ind) -> (*[9782]*)env.stackframes.(depth).(ind) <- value; (*[9782]*)value
000575|  
000576| (**
000577| Returns the name of a location
000578| @param env the runtime environment
000579| @param loc the location of the variable
000580| @return the name of the variable at location loc
000581| *)
000582| let get_loc_name env = function
000583|         | GlobalVar(uid, _)        | LocalVar(uid, _, _) -> (*[2]*)env.gnames.(uid)
000584|  

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