
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;

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)))

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

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

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 =

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 =

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) ->

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|