Skip to content

Commit

Permalink
fix: licence, isolate cfg_types, rename shatter
Browse files Browse the repository at this point in the history
  • Loading branch information
@NeoKaios
NeoKaios committed Oct 22, 2024
1 parent a3d4346 commit 617734a
Show file tree
Hide file tree
Showing 12 changed files with 158 additions and 188 deletions.
13 changes: 13 additions & 0 deletions assets/cfg-arc-renderer.html
View file
Original file line number Diff line number Diff line change
@@ -1,3 +1,16 @@
<!-- ----------------------------------------------------------------------- -->
<!-- -->
<!-- SuperBOL OSS Studio -->
<!-- -->
<!-- -->
<!-- Copyright (c) 2024 OCamlPro SAS -->
<!-- -->
<!-- All rights reserved. -->
<!-- This source code is licensed under the MIT license found in the -->
<!-- LICENSE.md file in the root directory of this source tree. -->
<!-- -->
<!-- ----------------------------------------------------------------------- -->

<!-- Base html file used to render arc cfg variant -->
<!DOCTYPE html>
<head>
Expand Down
14 changes: 14 additions & 0 deletions assets/cfg-arc.css
View file
Original file line number Diff line number Diff line change
@@ -1,3 +1,17 @@
/* -----------------------------------------------------------------------
*
* SuperBOL OSS Studio
*
*
* Copyright (c) 2024 OCamlPro SAS
*
* All rights reserved.
* This source code is licensed under the MIT license found in the
* LICENSE.md file in the root directory of this source tree.
*
* -----------------------------------------------------------------------
*/

html, body {
height: 100%;
}
Expand Down
13 changes: 13 additions & 0 deletions assets/cfg-arc.js
View file
Original file line number Diff line number Diff line change
@@ -1,3 +1,16 @@
// -----------------------------------------------------------------------
//
// SuperBOL OSS Studio
//
//
// Copyright (c) 2024 OCamlPro SAS
//
// All rights reserved.
// This source code is licensed under the MIT license found in the
// LICENSE.md file in the root directory of this source tree.
//
// -----------------------------------------------------------------------
//
// JS file attached to cfg-arc-renderer.html

const vscode = acquireVsCodeApi()
Expand Down
17 changes: 15 additions & 2 deletions assets/cfg-dot-renderer.html
View file
Original file line number Diff line number Diff line change
@@ -1,3 +1,16 @@
<!-- ----------------------------------------------------------------------- -->
<!-- -->
<!-- SuperBOL OSS Studio -->
<!-- -->
<!-- -->
<!-- Copyright (c) 2024 OCamlPro SAS -->
<!-- -->
<!-- All rights reserved. -->
<!-- This source code is licensed under the MIT license found in the -->
<!-- LICENSE.md file in the root directory of this source tree. -->
<!-- -->
<!-- ----------------------------------------------------------------------- -->

<!-- Credit @beicause in https://github.com/beicause/call-graph/blob/master/src/html.ts -->
<!-- Base html file for rendering graphviz cfg variant -->
<!DOCTYPE html>
Expand Down Expand Up @@ -31,8 +44,8 @@ <h2 id="title">Title</h2>
<label for="unreachable">Remove unreachable nodes</label></div>
<div><input type="checkbox" id="fallthru" />
<label for="fallthru">Collapse fallthrough transitions</label></div>
<div><input type="checkbox" id="hubshatter"/>
<label for="hubshatter">Split nodes with more than
<div><input type="checkbox" id="in_degree_upper_limit"/>
<label for="in_degree_upper_limit">Split nodes with more than
<input type="number" id="hubcount" value="20" /> incoming edges</label>
</div>
<hr/>
Expand Down
14 changes: 14 additions & 0 deletions assets/cfg-dot.css
View file
Original file line number Diff line number Diff line change
@@ -1,3 +1,17 @@
/* -----------------------------------------------------------------------
*
* SuperBOL OSS Studio
*
*
* Copyright (c) 2024 OCamlPro SAS
*
* All rights reserved.
* This source code is licensed under the MIT license found in the
* LICENSE.md file in the root directory of this source tree.
*
* -----------------------------------------------------------------------
*/

html, body {
height: 100%;
}
Expand Down
31 changes: 22 additions & 9 deletions assets/cfg-dot.js
View file
Original file line number Diff line number Diff line change
@@ -1,3 +1,16 @@
// -----------------------------------------------------------------------
//
// SuperBOL OSS Studio
//
//
// Copyright (c) 2024 OCamlPro SAS
//
// All rights reserved.
// This source code is licensed under the MIT license found in the
// LICENSE.md file in the root directory of this source tree.
//
// -----------------------------------------------------------------------
//
// JS file attached to cfg-dot-renderer.html

const legend = `digraph legend {
Expand Down Expand Up @@ -39,7 +52,7 @@ const defaultOptions = {
split_nodes: [],
hide_unreachable: false,
collapse_fallthru: false,
shatter_hubs: undefined,
in_degree_upper_limit: undefined,
}
var renderOptions = defaultOptions;
var rendering = d3.select('#rendering')
Expand Down Expand Up @@ -112,12 +125,12 @@ function setRenderOptions(renderOptions_) {
renderOptions.hide_unreachable;
document.getElementById("fallthru").checked =
renderOptions.collapse_fallthru;
document.getElementById("hubshatter").checked =
renderOptions.shatter_hubs != undefined;
document.getElementById("in_degree_upper_limit").checked =
renderOptions.in_degree_upper_limit != undefined;
document.getElementById("hubcount").value =
renderOptions.shatter_hubs == undefined
renderOptions.in_degree_upper_limit == undefined
? "20"
: String(renderOptions.shatter_hubs);
: String(renderOptions.in_degree_upper_limit);
const nodeElements = document.querySelectorAll(".nodes-list > p");
for (let p of nodeElements) {
p.remove();
Expand All @@ -137,17 +150,17 @@ function setRenderOptions(renderOptions_) {
function rerender() {
var collapse_fallthru = document.getElementById('fallthru').checked;
var hide_unreachable = document.getElementById('unreachable').checked;
if(document.getElementById('hubshatter').checked) {
var shatter_hubs = Number(document.getElementById('hubcount').value)
if(document.getElementById('in_degree_upper_limit').checked) {
var in_degree_upper_limit = Number(document.getElementById('hubcount').value)
}
else {
var shatter_hubs = undefined;
var in_degree_upper_limit = undefined;
}
renderOptions = {
...renderOptions,
hide_unreachable,
collapse_fallthru,
shatter_hubs,
in_degree_upper_limit,
};
vscode.postMessage({ type: 'graph_update', renderOptions })
}
Expand Down
48 changes: 7 additions & 41 deletions src/lsp/cobol_cfg/cfg_builder.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,6 +13,7 @@ open Cobol_common.Srcloc.INFIX
open Cobol_common.Srcloc.TYPES
open Cobol_unit.Types
open Cfg_jumps
open Cfg_types
module NEL = Cobol_common.Basics.NEL

(* TYPES AND HELPERS *)
Expand Down Expand Up @@ -55,48 +56,11 @@ let entry_stmt_to_string_loc = function

(* CFG MODULE *)

type node_type =
| External of string
| Entry of [`Point | `Paragraph | `Section of string | `Statement of string]
| Normal of string * string (* fullname * display_name *)
| Collapsed of string NEL.t
| Split of string

type node = {
id: int;
section_name: string;
loc: srcloc option;
typ: node_type;
jumps: Jumps.t;
will_fallthru: bool;
terminal: bool; (* unused atm *)
}

let is_entry n =
match n.typ with
| External _ | Normal _ | Collapsed _ | Split _ -> false
| Entry _ -> true

type edge =
| FallThrough
| Perform
| Go

module Node = struct
type t = node
let compare node other = Int.compare node.id other.id
let hash node = Hashtbl.hash node.id
let equal node other = Int.equal node.id other.id
end

module Edge = struct
type t = edge
let compare = Stdlib.compare
let default = FallThrough
end

module Cfg = Graph.Persistent.Digraph.ConcreteLabeled(Node)(Edge)

(* DEFAULT CFG BUILDER FUNCTION *)

let node_idx = ref 0
Expand Down Expand Up @@ -346,8 +310,8 @@ let do_hide_unreachable g =
let clone_node node =
{ node with id = next_node_idx (); }

let do_shatter_nodes ~ids ~limit g =
let shatter_typ { typ; _ } =
let do_split_nodes ~ids ~limit g =
let split_typ { typ; _ } =
match typ with
| External name -> Some (External name, true)
| Normal (_, name) -> Some (Split name, false)
Expand All @@ -359,7 +323,7 @@ let do_shatter_nodes ~ids ~limit g =
| None -> false
in
Cfg.fold_vertex begin fun n cfg ->
match shatter_typ n with
match split_typ n with
| Some (typ, remove_original)
when is_above_limit n || List.mem n.id ids ->
let cfg = Cfg.fold_pred_e begin fun edge cfg ->
Expand Down Expand Up @@ -447,7 +411,9 @@ let handle_cfg_options ~(options: Cfg_options.t) cfg =
|> (match options.hidden_nodes with
| [] -> Fun.id
| l -> remove_nodes l)
|> do_shatter_nodes ~ids:options.split_nodes ~limit:options.shatter_hubs
|> do_split_nodes
~ids:options.split_nodes
~limit:options.in_degree_upper_limit
|> (if options.collapse_fallthru then do_collapse_fallthru else Fun.id)

(* GRAPH OUTPUT FORMAT *)
Expand Down
130 changes: 1 addition & 129 deletions src/lsp/cobol_cfg/cfg_builder.mli
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,135 +8,7 @@
(* *)
(******************************************************************************)

open Cfg_jumps

type node_type =
| External of string
| Entry of [`Point | `Paragraph | `Section of string | `Statement of string]
| Normal of string * string (* fullname * display_name *)
| Collapsed of string Cobol_common.Basics.NEL.t
| Split of string

type node = {
id: int;
section_name: string;
loc: Cobol_common.srcloc option;
typ: node_type;
jumps: Jumps.t;
will_fallthru: bool;
terminal: bool; (* unused atm *)
}

module Node: sig
type t = node

val compare : node -> node -> int
val hash : node -> int
val equal : node -> node -> bool
end

type edge =
| FallThrough
| Perform
| Go

module Edge: sig
type t = edge

val compare : 'a -> 'a -> int
val default : edge
end

module Cfg :
sig
type t

module V : sig
type t = node

val compare : t -> t -> int
val hash : t -> int
val equal : t -> t -> bool

type label = t

val create : label -> t
val label : t -> label
end

type vertex = node

module E : sig
type t = vertex * edge * vertex

val compare : t -> t -> int

type vertex = node

val src : t -> vertex
val dst : t -> vertex

type label = edge

val create : vertex -> label -> vertex -> t
val label : t -> label
end

type edge = E.t

val is_directed : bool
val is_empty : t -> bool
val nb_vertex : t -> int
val nb_edges : t -> int
val out_degree : t -> vertex -> int
val in_degree : t -> vertex -> int
val mem_vertex : t -> vertex -> bool
val mem_edge : t -> vertex -> vertex -> bool
val mem_edge_e : t -> edge -> bool
val find_edge : t -> vertex -> vertex -> edge
val find_all_edges : t -> vertex -> vertex -> edge list
val succ : t -> vertex -> vertex list
val pred : t -> vertex -> vertex list
val succ_e : t -> vertex -> edge list
val pred_e : t -> vertex -> edge list
val iter_vertex : (vertex -> unit) -> t -> unit
val fold_vertex : (vertex -> 'a -> 'a) -> t -> 'a -> 'a
val iter_edges : (vertex -> vertex -> unit) -> t -> unit

val fold_edges :
(vertex -> vertex -> 'a -> 'a) -> t -> 'a -> 'a

val iter_edges_e : (edge -> unit) -> t -> unit
val fold_edges_e : (edge -> 'a -> 'a) -> t -> 'a -> 'a
val map_vertex : (vertex -> vertex) -> t -> t
val iter_succ : (vertex -> unit) -> t -> vertex -> unit
val iter_pred : (vertex -> unit) -> t -> vertex -> unit

val fold_succ :
(vertex -> 'a -> 'a) -> t -> vertex -> 'a -> 'a

val fold_pred :
(vertex -> 'a -> 'a) -> t -> vertex -> 'a -> 'a

val iter_succ_e : (edge -> unit) -> t -> vertex -> unit

val fold_succ_e :
(edge -> 'a -> 'a) -> t -> vertex -> 'a -> 'a

val iter_pred_e : (edge -> unit) -> t -> vertex -> unit

val fold_pred_e :
(edge -> 'a -> 'a) -> t -> vertex -> 'a -> 'a

val empty : t
val add_vertex : t -> vertex -> t
val remove_vertex : t -> vertex -> t
val add_edge : t -> vertex -> vertex -> t
val add_edge_e : t -> edge -> t
val remove_edge : t -> vertex -> vertex -> t
val remove_edge_e : t -> edge -> t
end

open Cfg_types

val make
: options:Cfg_options.t
Expand Down
Loading

0 comments on commit 617734a

Please sign in to comment.