jyapayne/flitter
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Replace pfff with flitter

Browse source
This commit is contained in:
Joey Yakimowich-Payne 2018-06-04 13:03:46 +09:00
commit c8efc2a088
27 changed files with 295 additions and 293 deletions
Download patch file Download diff file Expand all files Collapse all files

2
h_program-lang/Makefile
View file

@ -56,7 +56,7 @@ beforedepend:: archi_code_lexer.ml
##############################################################################
# install
##############################################################################
LIBNAME=pfff-h_program-lang
LIBNAME=flitter-h_program-lang
EXPORTSRC=\
ast_fuzzy.mli \
meta_ast_generic.mli \

38
h_program-lang/archi_code.ml
View file

@ -6,7 +6,7 @@
* modify it under the terms of the GNU Lesser General Public License
* version 2.1 as published by the Free Software Foundation, with the
* special exception on linking described in file license.txt.
*
*
* This library is distributed in the hope that it will be useful, but
* WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file
@ -17,18 +17,18 @@ open Common
(*****************************************************************************)
(* Prelude *)
(*****************************************************************************)
(*
(*
* Categorizing a source file according to recurring architecture "aspects"
* (really a directory structure) of a project. We often have some tests/,
* some commons/ library, some include/, etc.
*
*
* A file may belong to multiple categories at once.
*
*
* Right now the "aspects" are slightly modeled according to my
* own code and facebook flib code.
*
* This is used by codemap to colorize files. This is also used
* mainly for its AutoGenerated category in pfff -test_loc to
* mainly for its AutoGenerated category in flitter -test_loc to
* not count auto generated code in the LOC of a project. This
* can also be used in the deadcode detector to not count auto
* generated files (e.g. visitor_xxx.ml) as real users of an entity.
@ -38,7 +38,7 @@ open Common
(* Types *)
(*****************************************************************************)
(* coupling: if add category, dont forget to extend the source_archi_list
(* coupling: if add category, dont forget to extend the source_archi_list
* below
*)
type source_archi =
@ -47,7 +47,7 @@ type source_archi =
| Interface
(* I put Test and Logging together because if some dirs do not have some
* unit tests, but have some code to logs his action, then it's quite
* unit tests, but have some code to logs his action, then it's quite
* similar. Such code should be more robust and it's good to see it
* visually.
*)
@ -57,7 +57,7 @@ type source_archi =
| Core
| Utils (* utils base common *)
| Constants
| Constants
| GetSet (* mutators, accessors *)
| Configuration (* settings *)
@ -68,9 +68,9 @@ type source_archi =
| Ui (* ui render display *)
| Storage (* storage db *)
| Parsing (* scanner, parser *)
| Security
| Security
| I18n
(* todo?
(* todo?
* Memory (e.g. malloc, buffer), Fonts (font, charset)
* IO (e.g. keyboard, mouse)
* Strings (e.g. regex
@ -80,14 +80,14 @@ type source_archi =
| OS (* e.g. win32, macos, unix *)
| Network (* e.g. protocols ssh, ftp *)
| Ffi
| Ffi
| ThirdParty (* external *)
| Legacy (* legacy, deprecated *)
| AutoGenerated
| BoilerPlate
(* a project often contains itself some infrastructure to run tests or
(* a project often contains itself some infrastructure to run tests or
* benchmarks.
*)
| Unittester
@ -103,14 +103,14 @@ type source_archi =
let source_archi_list = [
Main; Init;
Main; Init;
Interface;
Test; Logging;
Core; Utils;
Configuration; Building;
Test; Logging;
Core; Utils;
Configuration; Building;
Doc; Data;
Constants;
GetSet;
Constants;
GetSet;
Ui; Storage; Parsing; Security; I18n;
Architecture; OS; Network;
Script;
@ -176,7 +176,7 @@ let find_duplicate_dirname dir =
let h = Hashtbl.create 101 in
let dups = Common2.hash_with_default (fun () -> 0) in
let rec aux path =
let rec aux path =
let subdirs = Common2.readdir_to_dir_list path +> List.sort compare in
subdirs +> List.iter (fun dir ->

142
h_program-lang/database_code.ml
View file

@ -6,7 +6,7 @@
* modify it under the terms of the GNU Lesser General Public License
* version 2.1 as published by the Free Software Foundation, with the
* special exception on linking described in file license.txt.
*
*
* This library is distributed in the hope that it will be useful, but
* WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file
@ -21,7 +21,7 @@ module HC = Highlight_code
(*****************************************************************************)
(* Prelude *)
(*****************************************************************************)
(*
(*
* This module provides a generic "database" of semantic information
* on a codebase (a la CIA [1]). The goal is to give access to
* information computed by a set of global static or dynamic analysis
@ -29,11 +29,11 @@ module HC = Highlight_code
* is the test coverage of a file', etc. This is mainly used by codemap
* to give semantic visual feedback on the code. See also layer_code.ml
* for complementary semantic information about a codebase.
*
*
* update: prolog_code.pl and Prolog may now be the prefered way to
* represent a code database, but for codemap it's still good to use
* this database.
*
*
* Each programming language analysis library usually provides
* a more powerful database (e.g. analyze_php/database/database_php.mli)
* with more information. Such a database is usually also efficiently stored
@ -42,7 +42,7 @@ module HC = Highlight_code
* database. Moreover, when we have codebase with multiple langages
* (e.g. PHP and javascript), having a common type can help for some
* analysis or visualization.
*
*
* Note that by storing this toy database in a JSON format or with Marshall,
* this database can also easily be read by multiple
* process at the same time (there is currently a few problems with
@ -51,39 +51,39 @@ module HC = Highlight_code
* This also avoids forcing the user to spend time running all
* the global analysis on his own codebase. We can factorize the essential
* results of such long computation in a single file.
*
*
* An alternative would be to use the TAGS file or information from
* cscope. But this would require to implement a reader for those
* two formats. Moreover ctags/cscope do just lexical-based analysis
* so it's not a good basis and it contains only defition->position
* information.
*
* history:
*
* history:
* - started when working for eurosys'06 in patchparse/ in a file called
* c_info.ml
* - extended for eurosys'08 for coccinelle/ in coccinelle/extra/
* and use it to discover some .c .h mapping and generate some crazy
* - extended for eurosys'08 for coccinelle/ in coccinelle/extra/
* and use it to discover some .c .h mapping and generate some crazy
* graphs and also to detect drivers splitted in multiple files.
* - extended it for aComment in 2008 and 2009, to feed information to some
* - extended it for aComment in 2008 and 2009, to feed information to some
* inter-procedural analysis.
* - rewrite it for PHP in Nov 2009
* - adapted in Jan 2010 for flib_navigator
* - make it generic in Aug 2010 for my code/treemap visualizer
* - added comments about Prolog database which may be a better db for
* certain use cases.
*
*
* history bis:
* - Before, I was optimizing stuff by caching the ast in
* some xxx_raw files. But there was lots of small raw files;
* - Before, I was optimizing stuff by caching the ast in
* some xxx_raw files. But there was lots of small raw files;
* get lots of ast files and waste space. Also not good for random
* access to the asts. So better to use berkeley DB. My experience with
* LFS helped me a little as I was already using berkeley DB and glimpse.
*
*
* - I was also using glimpse and I tried to accelerate even more coccinelle
* to generate some mini C files so that glimpse can directly tell us
* the toplevel elements to look for. But this generates lots of
* the toplevel elements to look for. But this generates lots of
* very small mini C files which also waste lots of disk space.
*
*
* References:
* [1] CIA, the C Information Abstractor
*)
@ -110,28 +110,28 @@ type entity = {
e_file: Common.filename;
e_pos: Common2.filepos;
(* Semantic information that can be leverage by a code visualizer.
* The fields are set as mutable because usually we compute
* the set of all entities in a first phase and then we
* do another pass where we adjust numbers of other entity references.
*)
(* todo: could give more importance when used externally not just
* from another file but from another directory!
* or could refine this int with more information.
*)
mutable e_number_external_users: int;
(* Usually the id of a unit test of pleac file.
(* Usually the id of a unit test of pleac file.
*
* Indeed a simple algorithm to compute this list is:
* just look at the callers, filter the one in unit test or pleac files,
* just look at the callers, filter the one in unit test or pleac files,
* then for each caller, look at the number of callees, and take
* the one with best ratio.
*
*
* With references to good examples of use, we can offer
* what Perl programmers had for years with their function
* what Perl programmers had for years with their function
* documentations.
* If there is no examples_of_use then the user can visually
* see that some functions should be unit tested :)
@ -163,13 +163,13 @@ type database = {
(* Such list can be used in a search box powered by completion.
* The int is for the total number of times this files is
* externally referenced. Can be use for instance in the treemap
* to artificially augment the size of what is probably a more
* to artificially augment the size of what is probably a more
* "important" file.
*)
dirs: (Common.filename * int) list;
(* see also build_top_k_sorted_entities_per_file for dynamically
* computed summary information for a file
* computed summary information for a file
*)
files: (Common.filename * int) list;
@ -184,8 +184,8 @@ let empty_database () = {
entities = Array.of_list [];
}
let default_db_name =
"PFFF_DB.marshall"
let default_db_name =
"FLITTER_DB.marshall"
(*****************************************************************************)
@ -196,7 +196,7 @@ let default_db_name =
(* json -> X *)
(*---------------------------------------------------------------------------*)
let json_of_filepos x =
let json_of_filepos x =
J.Array [J.Int x.Common2.l; J.Int x.Common2.c]
let json_of_property x =
@ -206,7 +206,7 @@ let json_of_property x =
| TakeArgNByRef i -> J.Array [J.String "TakeArgNByRef"; J.Int i]
| _ -> raise Todo
let json_of_entity e =
let json_of_entity e =
J.Object [
"k", J.String (string_of_entity_kind e.e_kind);
"n", J.String e.e_name;
@ -219,14 +219,14 @@ let json_of_entity e =
"ps", J.Array (e.e_properties +> List.map json_of_property);
]
let json_of_database db =
let json_of_database db =
J.Object [
"root", J.String db.root;
"dirs", J.Array (db.dirs +> List.map (fun (x, i) ->
J.Array([J.String x; J.Int i])));
"files", J.Array (db.files +> List.map (fun (x, i) ->
J.Array([J.String x; J.Int i])));
"entities", J.Array (db.entities +>
"entities", J.Array (db.entities +>
Array.to_list +> List.map json_of_entity);
]
@ -242,7 +242,7 @@ let ids_of_json json =
)
| _ -> failwith "bad json"
let filepos_of_json json =
let filepos_of_json json =
match json with
| J.Array [J.Int l; J.Int c] ->
{ Common2.l = l; Common2.c = c }
@ -289,7 +289,7 @@ let entity_of_json2 json =
}
| _ -> failwith "Bad json"
let entity_of_json a =
let entity_of_json a =
Common.profile_code "Db.entity_of_json" (fun () ->
entity_of_json2 a)
@ -303,7 +303,7 @@ let database_of_json2 json =
"entities", J.Array db_entities;
] -> {
root = db_root;
dirs = db_dirs +> List.map (fun json ->
match json with
| J.Array([J.String x; J.Int i]) ->
@ -317,14 +317,14 @@ let database_of_json2 json =
x, i
| _ -> failwith "Bad json"
);
entities =
entities =
db_entities +> List.map entity_of_json +> Array.of_list
}
| _ -> failwith "Bad json"
let database_of_json json =
Common.profile_code "Db.database_of_json" (fun () ->
Common.profile_code "Db.database_of_json" (fun () ->
database_of_json2 json
)
@ -340,7 +340,7 @@ let load_database2 file =
* to store big database. This should be used only when
* one wants to have a readable database.
*)
let json =
let json =
Common.profile_code "Json_in.load_json" (fun () ->
Json_in.load_json file
) in
@ -352,14 +352,14 @@ let load_database file =
(* We allow to save in JSON format because it may be useful to let
* the user edit read the generated data.
*
*
* less: could use the more efficient json pretty printer, but really
* marshall is probably better. Only biniou could be a valid alternative.
*)
let save_database database file =
if File_type.is_json_filename file
then
database +> json_of_database
database +> json_of_database
+> Json_io.string_of_json ~compact:false ~recursive:false ~allow_nan:true
+> Common.write_file ~file
else Common2.write_value database file
@ -369,12 +369,12 @@ let save_database database file =
(* Entities categories *)
(*****************************************************************************)
(* coupling: if you add a new kind of entity, then
(* coupling: if you add a new kind of entity, then
* don't forget to modify size_font_multiplier_of_categ in code_map/
*
*
* How sure this list is exhaustive ? C-c for usedef2
*)
let entity_kind_of_highlight_category_def categ =
let entity_kind_of_highlight_category_def categ =
match categ with
| HC.Entity (kind, HC.Def2 _) -> Some kind
@ -385,11 +385,11 @@ let entity_kind_of_highlight_category_def categ =
(* todo: what about other Def ? like Label, Parameter, etc ? *)
| _ -> None
let is_entity_def_category categ =
let is_entity_def_category categ =
entity_kind_of_highlight_category_def categ <> None
(* less: merge with other function? *)
let entity_kind_of_highlight_category_use categ =
let entity_kind_of_highlight_category_use categ =
match categ with
| HC.Entity (kind, HC.Use2 _) -> Some kind
| HC.FunctionDecl _ -> Some Function
@ -420,7 +420,7 @@ let matching_use_categ_kind categ kind =
| GlobalExtern, HC.Entity (Global, _)
| Method, HC.StaticMethod _
| ClassConstant, HC.Entity (Constant, _)
(* tofix at some point, wrong tokenizer *)
| Constant, HC.Local _
| Global, HC.Local _
@ -436,11 +436,11 @@ let matching_use_categ_kind categ kind =
| Function, HC.Entity (Global, _)
(* function calls to pointer function via direct syntax *)
| GlobalExtern, HC.Entity (Function, _)
| Global, HC.UseOfRef
| Field, HC.UseOfRef
-> true
| _ -> false
@ -453,7 +453,7 @@ let matching_use_categ_kind categ kind =
* non valid entities.
*)
let entity_and_highlight_category_correpondance entity categ =
let entity_kind_use =
let entity_kind_use =
Common2.some (entity_kind_of_highlight_category_use categ) in
entity.e_kind = entity_kind_use
@ -470,15 +470,15 @@ let entity_and_highlight_category_correpondance entity categ =
* php file in flib/herald but files in flib/herald/lib/foo.php.
* Having flib/herald/lib is not enough. Enter alldirs_and_parent_dirs_of_dirs
* which will compute all the directories.
*
*
* It's a kind of 'find -type d' but reversed, using a set of complete dirs
* as the starting point. In fact we could define a
* as the starting point. In fact we could define a
* Common.dirs_of_dirs but then directory without any interesting files
* would be listed.
*)
let alldirs_and_parent_dirs_of_relative_dirs dirs =
dirs
+> List.map Common2.inits_of_relative_dir
dirs
+> List.map Common2.inits_of_relative_dir
+> List.flatten +> Common2.uniq_eff
@ -497,13 +497,13 @@ let merge_databases db1 db2 =
* entities requires care.
*)
let length_entities1 = Array.length db1.entities in
let db2_entities = db2.entities in
let db2_entities_adjusted =
let db2_entities_adjusted =
db2_entities +> Array.map (fun e ->
{ e with
e_good_examples_of_use =
e.e_good_examples_of_use
e_good_examples_of_use =
e.e_good_examples_of_use
+> List.map (fun id -> id + length_entities1);
}
)
@ -511,7 +511,7 @@ let merge_databases db1 db2 =
{
root = db1.root;
dirs = (db1.dirs @ db2.dirs)
dirs = (db1.dirs @ db2.dirs)
+> Common.group_assoc_bykey_eff
+> List.map (fun (file, xs) ->
file, Common2.sum xs
@ -522,7 +522,7 @@ let merge_databases db1 db2 =
let build_top_k_sorted_entities_per_file2 ~k xs =
xs
xs
+> Array.to_list
+> List.map (fun e -> e.e_file, e)
+> Common.group_assoc_bykey_eff
@ -540,7 +540,7 @@ let build_top_k_sorted_entities_per_file ~k xs =
)
let mk_dir_entity dir n = {
let mk_dir_entity dir n = {
e_name = Common2.basename dir ^ "/";
e_fullname = "";
e_file = dir;
@ -550,7 +550,7 @@ let mk_dir_entity dir n = {
e_good_examples_of_use = [];
e_properties = [];
}
let mk_file_entity file n = {
let mk_file_entity file n = {
e_name = Common2.basename file;
e_fullname = "";
e_file = file;
@ -574,7 +574,7 @@ let mk_multi_dirs_entity name dirs_entities =
e_pos = { Common2.l = 1; c = 0 };
e_kind = MultiDirs;
e_number_external_users =
e_number_external_users =
(* todo? *)
(List.length dirs_fullnames);
e_good_examples_of_use = [];
@ -610,14 +610,14 @@ let files_and_dirs_database_from_files ~root files =
let files_and_dirs_and_sorted_entities_for_completion2
~threshold_too_many_entities
db
db
=
let nb_entities = Array.length db.entities in
let dirs =
let dirs =
db.dirs +> List.map (fun (dir, n) -> mk_dir_entity dir n)
in
let files =
let files =
db.files +> List.map (fun (file, n) -> mk_file_entity file n)
in
let multidirs = multi_dirs_entities_of_dirs dirs in
@ -625,17 +625,17 @@ let files_and_dirs_and_sorted_entities_for_completion2
let xs =
multidirs @ dirs @ files @
(if nb_entities > threshold_too_many_entities
then begin
then begin
pr2 "Too many entities. Completion just for filenames";
[]
end else
(db.entities +> Array.to_list +> List.map (fun e ->
end else
(db.entities +> Array.to_list +> List.map (fun e ->
(* we used to return 2 entities per entity by having
* both an entity with the short name and one with the long
* name, but now that we do a suffix search, no need
* to keep the short one
*)
if e.e_fullname = ""
if e.e_fullname = ""
then e
else { e with e_name = e.e_fullname }
)
@ -657,7 +657,7 @@ let files_and_dirs_and_sorted_entities_for_completion2
) +> Common.sort_by_key_highfirst
+> List.map snd
let files_and_dirs_and_sorted_entities_for_completion
~threshold_too_many_entities a =
Common.profile_code "Db.sorted_entities" (fun () ->
@ -673,7 +673,7 @@ let files_and_dirs_and_sorted_entities_for_completion
let adjust_method_or_field_external_users ~verbose entities =
(* phase1: collect all method counts *)
let h_method_def_count = Common2.hash_with_default (fun () -> 0) in
entities +> Array.iter (fun e ->
match e.e_kind with
| Method | Field ->

182
h_program-lang/layer_code.ml
View file

@ -6,7 +6,7 @@
* modify it under the terms of the GNU Lesser General Public License
* version 2.1 as published by the Free Software Foundation, with the
* special exception on linking described in file license.txt.
*
*
* This library is distributed in the hope that it will be useful, but
* WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file
@ -22,81 +22,81 @@ open Common
* code "layers" (a.k.a. code "aspects"). The idea is to imitate google
* earth layers (e.g. the wikipedia layer, panoramio layer, etc), but
* for code. One can have a deadcode layer, a test coverage layer,
* and then can display those layers or not on an existing codebase in
* codemap. The layer is basically some mapping from files to a
* set of lines with a specific color code.
*
*
* and then can display those layers or not on an existing codebase in
* codemap. The layer is basically some mapping from files to a
* set of lines with a specific color code.
*
*
* A few design choices:
*
* - one could store such information directly into database_xxx.ml
* and have pfff_db compute such information (for instance each function
* could have a set of properties like unit_test, or dead) but this
* would force people to build their own db to visualize the results.
* One could compute this information in database_light_xxx.ml, but this
*
* - one could store such information directly into database_xxx.ml
* and have flitter_db compute such information (for instance each function
* could have a set of properties like unit_test, or dead) but this
* would force people to build their own db to visualize the results.
* One could compute this information in database_light_xxx.ml, but this
* will augment the size of the light db slowing down the codemap launch
* even when the people don't use the layers. So it's more flexible to just
* separate layer_code.ml from database_code.ml and have multiple persistent
* files for each information. Also it's quite convenient to have
* utilities like sgrep to be easily extendable to transform a query result
* into a layer.
*
*
* - How to represent a layer at the macro and micro level in codemap ?
*
*
* At the micro-level one has just to display the line with the
* requested color. At the macro-level have to either do a majority
* scheme or mixing scheme where for instance draw half of the
* treemap rectangle in red and the other in green.
*
* scheme or mixing scheme where for instance draw half of the
* treemap rectangle in red and the other in green.
*
* Because different layers could have different composition needs
* it is simpler to just have the layer say how it should be displayed
* at the macro_level. See the 'macro_level' field below.
*
*
* - how to have a layer data-structure that can cope with many
* needs ?
*
* needs ?
*
* Here are some examples of layers and how they are "encoded" by the
* 'layer' type below:
*
*
* * deadcode (dead function, dead class, dead statement, dead assignnements)
*
*
* How? dead lines in red color. At the macro_level one can give
* a grey_xxx color with a percentage (e.g. grey53).
*
*
* * test coverage (static or dynamic)
*
*
* How? covered lines in green, not covered in red ? Also
* convey a GreyLevel visualization by setting the 'macro_level' field.
*
*
* * age of file
*
*
* How? 2010 in green, 2009 in yelow, 2008 in red and so on.
* At the macro_level can do a mix of colors.
*
*
* * bad smells
*
*
* How? each bad smell could have a different color and macro_level
* showing a percentage of the rectangle with the right color
* for each smells in the file.
*
*
* * security patterns (bad smells)
*
* * activity ?
*
*
* * activity ?
*
* How whow add and delete information ?
* At the micro_level can't show the delete, but at macro_level
* could divide the treemap_rectangle in 2 where percentage of
* add and delete, and also maybe white to show the amount of add
* and delete. Could also use my big circle scheme.
* How link to commit message ? TODO
*
*
* later:
*
*
* later:
* - could associate more than just a color, e.g. a commit message when want
* to display a version-control layer, or some filling-patterns in
* addition to the color.
* - Could have better precision than the line.
*
*
* history:
* - I was writing some treemap generator specific for the deadcode
* analysis, the static coverage, the dynamic coverage, and the activity
@ -104,7 +104,7 @@ open Common
* way to visualize the result (DegradeArchiColor | GreyLevel | YesNo).
* It was working fine but there was no easy way to combine 2
* visualisations, like the age "layer" and the "deadcode" layer
* to see correlations. Also adding simple layers like
* to see correlations. Also adding simple layers like
* visualizing all calls to HTML() or XHP was requiring to
* write another treemap generator. To be more generic and flexible require
* a real 'layer' type.
@ -118,19 +118,19 @@ type color = string (* Simple_color.emacs_color *)
(* note: the filenames must be in readable format so layer files can be reused
* by multiple users.
*
*
* alternatives:
* - could have line range ? useful for layer matching lots of
* consecutive lines in a file ?
* - todo? have more precision than just the line ? precise pos range ?
*
*
* - could for the lines instead of a 'kind' to have a 'count',
* and then some mappings from range of values to a color.
* For instance on a coverage layer one could say that from X to Y
* then choose this color, from Y to Z another color.
* But can emulate that by having a "coverage1", "coverage2"
* kind with the current scheme.
*
*
* - have a macro_level_composing_scheme: Majority | Mixed
* that is then interpreted in codemap instead of forcing
* the layer creator to specific how to show the micro_level
@ -149,7 +149,7 @@ type layer = {
(* The list can be empty in which case codemap can use
* the micro_level information and show a mix of colors.
*
*
* The list can have just one element too and have a kind
* different than the one used in the micro_level. For instance
* for the coverage one can have red/green at micro_level
@ -220,16 +220,16 @@ let heat_map_properties = [
(*****************************************************************************)
(* Am I reinventing database indexing ? Should use a real database
* to store layer information so one can then just use SQL to
* to store layer information so one can then just use SQL to
* fastly get all the information relevant to a file and a line ?
* I doubt MySQL can be as fast and light as my JSON + hashtbl indexing.
*)
let build_index_of_layers ~root layers =
let build_index_of_layers ~root layers =
let hmicro = Common2.hash_with_default (fun () -> Hashtbl.create 101) in
let hmacro = Common2.hash_with_default (fun () -> []) in
layers
+> List.filter (fun (_layer, active) -> active)
layers
+> List.filter (fun (_layer, active) -> active)
+> List.iter (fun (layer, _active) ->
let hkind = Common.hash_of_list layer.kinds in
@ -237,33 +237,33 @@ let build_index_of_layers ~root layers =
let file = Filename.concat root file in
(* todo? v is supposed to be a float representing a percentage of
(* todo? v is supposed to be a float representing a percentage of
* the rectangle but below we will add the macro info of multiple
* layers together which mean the float may not represent percentage
* anynore. They still represent a part of the file though.
* The caller would have to first recompute the sum of all those
* floats to recompute the actual multi-layer percentage.
*)
let color_macro_level =
let color_macro_level =
finfo.macro_level +> Common.map_filter (fun (kind, v) ->
(* some sanity checking *)
try Some (v, Hashtbl.find hkind kind)
with Not_found ->
with Not_found ->
(* I was originally doing a failwith, but it can be convenient
* to be able to filter kinds in codemap by just editing the
* JSON file and removing certain kind definitions
*)
pr2_once (spf "PB: kind %s was not defined" kind);
None
)
)
in
hmacro#update file (fun old -> color_macro_level @ old);
finfo.micro_level +> List.iter (fun (line, kind) ->
try
try
let color = Hashtbl.find hkind kind in
hmicro#update file (fun oldh ->
hmicro#update file (fun oldh ->
(* We add so the same line could be assigned multiple colors.
* The order of the layer could determine which color should
* have priority.
@ -369,36 +369,36 @@ open Ocaml
module J = Json_type
(*
let stag_incorrect_n_args _loc tag _v =
let stag_incorrect_n_args _loc tag _v =
failwith ("stag_incorrect_n_args on: " ^ tag)
*)
(*
let unexpected_stag loc v =
let unexpected_stag loc v =
failwith ("unexpected_stag:")
*)
(*
let record_only_pairs_expected loc v =
let record_only_pairs_expected loc v =
failwith ("record_only_pairs_expected:")
*)
let record_duplicate_fields _loc _dup_flds _v =
let record_duplicate_fields _loc _dup_flds _v =
failwith ("record_duplicate_fields:")
let record_extra_fields _loc _flds _v =
failwith ("record_extra_fields:")
let record_undefined_elements _loc _v _xs =
let record_undefined_elements _loc _v _xs =
failwith ("record_undefined_elements:")
let record_list_instead_atom _loc _v =
let record_list_instead_atom _loc _v =
failwith ("record_list_instead_atom:")
let tuple_of_size_n_expected _loc n v =
let tuple_of_size_n_expected _loc n v =
failwith (spf "tuple_of_size_n_expected: %d, got %s" n (Common2.dump v))
let rec json_of_v v =
let rec json_of_v v =
match v with
| VString s -> J.String s
| VSum ((s, vs)) ->J.Array ((J.String s)::(List.map json_of_v vs ))
@ -414,7 +414,7 @@ let rec json_of_v v =
| VBool b -> J.Bool b
(* Note that 'Inf' can be used as a constructor but is also recognized
* by float_of_string as a float (infinity), so when I was implementing
* by float_of_string as a float (infinity), so when I was implementing
* this code by reverse engineering the generated sexp, it was important
* to guard certain code.
*)
@ -427,7 +427,7 @@ let rec json_of_v v =
| VArrow _v1 ->
failwith "json_of_v: VArrow not handled"
(*
(*
* Assumes the json was generated via 'ocamltarzan -choice json_of', which
* have certain conventions on how to encode variants for instance.
*)
@ -439,7 +439,7 @@ let rec (v_of_json: Json_type.json_type -> v) = fun j ->
| J.Bool b -> VBool b
| J.Null -> raise Todo
(* Arrays are used for represent constructors or regular list. Have to
(* Arrays are used for represent constructors or regular list. Have to
* go sligtly deeper to disambiguate.
*)
| J.Array xs ->
@ -448,7 +448,7 @@ let rec (v_of_json: Json_type.json_type -> v) = fun j ->
* of strings where the first element is a string that happen to
* look like a constructor. With this ugly code we currently
* not handle that :(
*
*
* update: in the layer json file, one can have a filename
* like Makefile and we don't want it to be a constructor ...
* so for now I just generate constructors strings like
@ -465,7 +465,7 @@ let rec (v_of_json: Json_type.json_type -> v) = fun j ->
s, v_of_json fld
))
let save_json file json =
let save_json file json =
let s = Json_out.string_of_json json in
Common.write_file ~file s
@ -671,8 +671,8 @@ let save_layer layer file =
* subdirs and so on.
*)
let simple_layer_of_parse_infos ~root ~title ?(description="") xs kinds =
let ranks_kinds =
kinds +> List.map (fun (k, _color) -> k)
let ranks_kinds =
kinds +> List.map (fun (k, _color) -> k)
+> Common.index_list_1 +> Common.hash_of_list
in
@ -680,48 +680,48 @@ let simple_layer_of_parse_infos ~root ~title ?(description="") xs kinds =
let files_and_lines = xs +> List.map (fun (tok, kind) ->
let file = Parse_info.file_of_info tok in
let line = Parse_info.line_of_info tok in
let file' = Common2.relative_to_absolute file in
let file' = Common2.relative_to_absolute file in
Common.readable ~root file', (line, kind)
)
in
let (group_by_file: (Common.filename * (int * kind) list) list) =
Common.group_assoc_bykey_eff files_and_lines
let (group_by_file: (Common.filename * (int * kind) list) list) =
Common.group_assoc_bykey_eff files_and_lines
in
{
{
title = title;
description = description;
kinds = kinds;
files = group_by_file +> List.map (fun (file, lines_and_kinds) ->
let (group_by_line: (int * kind list) list) =
Common.group_assoc_bykey_eff lines_and_kinds
let (group_by_line: (int * kind list) list) =
Common.group_assoc_bykey_eff lines_and_kinds
in
let all_kinds_in_file =
let all_kinds_in_file =
group_by_line +> List.map snd +> List.flatten +> Common2.uniq in
(file, {
micro_level =
group_by_line +> List.map (fun (line, kinds) ->
(file, {
micro_level =
group_by_line +> List.map (fun (line, kinds) ->
let kinds = Common2.uniq kinds in
(* many kinds om same line, keep highest prio *)
match kinds with
| [] -> raise Impossible
| [x] -> line, x
| _ ->
let sorted = kinds +> List.map (fun x ->
let sorted = kinds +> List.map (fun x ->
x, Hashtbl.find ranks_kinds x) +> Common.sort_by_val_lowfirst
in
line, List.hd sorted +> fst
);
macro_level =
macro_level =
(* we could give a percentage per kind but right now
* we instead give a priority based on the rank of the kinds
* in the kind list
*)
all_kinds_in_file +> List.map (fun kind ->
all_kinds_in_file +> List.map (fun kind ->
(kind, 1. /. (float_of_int (Hashtbl.find ranks_kinds kind)))
)
})
@ -729,26 +729,26 @@ let simple_layer_of_parse_infos ~root ~title ?(description="") xs kinds =
}
(* old: superseded by Layer_code.layer.files and file_info
* type stat_per_file =
(* old: superseded by Layer_code.layer.files and file_info
* type stat_per_file =
* (string (* a property *), int list (* lines *)) Common.assoc
*
* type stats =
*
* type stats =
* (Common.filename, stat_per_file) Hashtbl.t
*
*
*
* old:
* let (print_statistics: stats -> unit) = fun h ->
* let xxs = Common.hash_to_list h in
* pr2_gen (xxs);
* ()
*
* let gen_security_layer xs =
* let gen_security_layer xs =
* let _root = Common.common_prefix_of_files_or_dirs xs in
* let files = Lib_parsing_php.find_php_files_of_dir_or_files xs in
*
*
* let h = Hashtbl.create 101 in
*
*
* files +> Common.index_list_and_total +> List.iter (fun (file, i, total) ->
* pr2 (spf "processing: %s (%d/%d)" file i total);
* let ast = Parse_php.parse_program file in
@ -778,8 +778,8 @@ let layer_red_green_and_heatmap ~root ~output xs =
*)
let stat_of_layer layer =
let h = Common2.hash_with_default (fun () -> 0) in
layer.kinds +> List.iter (fun (kind, _color) ->
layer.kinds +> List.iter (fun (kind, _color) ->
h#add kind 0
);
layer.files +> List.iter (fun (_file, finfo) ->
@ -791,6 +791,6 @@ let stat_of_layer layer =
let filter_layer f layer =
{ layer with
{ layer with
files = layer.files +> List.filter (fun (file, _) -> f file);
}

2
h_program-lang/parse_info.ml
View file

@ -18,7 +18,7 @@ open Common
(* Prelude *)
(*****************************************************************************)
(*
* Some helpers for the different lexers and parsers in pfff.
* Some helpers for the different lexers and parsers in flitter.
* The main types are:
* ('token_location' < 'token_origin' < 'token_mutable') * token_kind
*